! module test for generic interfaces and assumed-size
module m_test1

interface test_assumedsize
  module procedure test_assumedsize_i, test_assumedsize_s
end interface

contains

subroutine test_assumedsize_i(n,a)
  integer, intent(in) :: n
  integer, intent(in) :: a(*)
  integer :: i

  do i=1,n
    write(*,'(i5)') a(i)
  enddo
end subroutine

subroutine test_assumedsize_s(n,a)
  integer, intent(in) :: n
  real,    intent(in) :: a(*)
  integer :: i

  do i=1,n
    write(*,'(f7.3)') a(i)
  enddo
end subroutine


! -----------------------------------------------------------------------------
subroutine test_bounds()
  integer :: i,j
  integer, parameter :: n= 100000, m= 1000
  real :: a(n),b(n),c(2,2)
  real :: t1,t2

  do i=1,n
    call random_number(a(i))
    b(i)=a(i)
  enddo

  call cpu_time(t1)
  do i=1,m
  call test_bounds1(size(a,1),a)
  enddo
  write(*,*) a(n/2),a(n)
  call cpu_time(t2)
  write(*,'(a,f7.3)') "1 time (explicit n)  : ", t2-t1

  a= b

  call cpu_time(t1)
  do i=1,m
  call test_bounds2(b)
  enddo
  write(*,*) b(n/2),b(n)
  call cpu_time(t2)
  write(*,'(a,f7.3)') "2 time (l/ubound)    : ", t2-t1

  b= a
  call cpu_time(t1)
  do i=1,m
  call test_bounds3(a)
  enddo
  write(*,*) a(n/2),a(n)
  call cpu_time(t2)
  write(*,'(a,f7.3)') "3 time (size)        : ", t2-t1

  a= b
  call cpu_time(t1)
  do i=1,m
  call test_bounds4(b)
  enddo
  write(*,*) b(n/2),b(n)
  call cpu_time(t2)
  write(*,'(a,f7.3)') "4 time (l/ubound var): ", t2-t1

  call cpu_time(t1)
  do i=1,m
  call test_bounds5(n-1,a(2:) )
  enddo
  write(*,*) a(n/2),a(n)
  call cpu_time(t2)
  write(*,'(a,f7.3)') "5 time (assumed size): ", t2-t1

  call test_bounds5(4,c)

end subroutine

subroutine test_bounds1(n,a)
  integer, intent(in   ) :: n
  real,    intent(inout) :: a(n)
  integer  :: i

  do i=2,n-1
    a(i)= a(i)-1
    a(i)= a(i-1)+a(i)-a(i+1)
    a(i)= a(i)+1
  enddo

end subroutine

subroutine test_bounds2(a)
  real, intent(inout) :: a(:)
  integer  :: i

  do i=lbound(a,1)+1,ubound(a,1)-1
    a(i)= a(i)-1
    a(i)= a(i-1)+a(i)-a(i+1)
    a(i)= a(i)+1
  enddo

end subroutine

subroutine test_bounds3(a)
  real, intent(inout) :: a(:)
  integer  :: i

  do i=2,size(a,1)-1
    a(i)= a(i)-1
    a(i)= a(i-1)+a(i)-a(i+1)
    a(i)= a(i)+1
  enddo

end subroutine

subroutine test_bounds4(a)
  real, intent(inout) :: a(:)
  integer  :: i,lb,ub

  lb= lbound(a,1)+1
  ub= ubound(a,1)-1
  do i=lb,ub
    a(i)= a(i)-1
    a(i)= a(i-1)+a(i)-a(i+1)
    a(i)= a(i)+1
  enddo

end subroutine

subroutine test_bounds5(n,a)
  integer, intent(in) :: n
  real, intent(inout) :: a(*)
  integer  :: i

  do i=2,n-1
    a(i)= a(i)-1
    a(i)= a(i-1)+a(i)-a(i+1)
    a(i)= a(i)+1
  enddo

end subroutine

end module

! ------------------------------------------------------------------------------
!! HERE is the main program
! ------------------------------------------------------------------------------
program test_reshape
  use m_test1
  integer, parameter :: n= 5
  integer :: a(2,n)
  integer :: i

  do i=1,n
    a(1,i)= i
    a(2,i)=-i
  enddo

  ! 1. reshape test
  write(*,*) "reshape and explicit shape"
  call test_reshape1(2*n,reshape(a,(/2*n/)))
  write(*,*) "assumed-size"
  call test_reshape2(2*n,a)

  ! 2. assumed size
!   call test_assumedsize(n,a)

end program

subroutine test_reshape1(n,a)
  integer, intent(in) :: n
  integer, intent(in) :: a(n)
  integer :: i

  do i=1,n
    write(*,'(i5)') a(i)
  enddo
end subroutine

subroutine test_reshape2(n,a)
  integer, intent(in) :: n
  integer, intent(in) :: a(*)
  integer :: i

  do i=1,n
    write(*,'(i5)') a(i)
  enddo
end subroutine
