! Program to test arrays
! The program outputs a series of numbers.
! Two digit numbers beginning with 0, 1, 2 or 3 is a normal.
! Three digit numbers starting with 4 indicate an error.
! Using 1D arrays isn't a sufficient test, the first dimension is often
! handled specially.
! Fixed size parameter
subroutine f1 (a)
implicit none
integer, dimension (5, 8) :: a
if (a(1, 1) .ne. 42) call abort
if (a(5, 8) .ne. 43) call abort
end subroutine
program testprog
implicit none
integer, dimension(3:7, 4:11) :: a
a(:,:) = 0
a(3, 4) = 42
a(7, 11) = 43
call test(a)
contains
subroutine test (parm)
implicit none
! parameter
integer, dimension(2:, 3:) :: parm
! Known size arry
integer, dimension(5, 8) :: a
! Known size array with different bounds
integer, dimension(4:8, 3:10) :: b
! Unknown size arrays
integer, dimension(:, :), allocatable :: c, d, e
! Vectors
integer, dimension(5) :: v1
integer, dimension(10, 10) :: v2
integer n
external f1
! Same size
allocate (c(5,8))
! Same size, different bounds
allocate (d(11:15, 12:19))
! A larger array
allocate (e(15, 24))
a(:,:) = 0
b(:,:) = 0
c(:,:) = 0
d(:,:) = 0
a(1,1) = 42
b(4, 3) = 42
c(1,1) = 42
d(11,12) = 42
a(5, 8) = 43
b(8, 10) = 43
c(5, 8) = 43
d(15, 19) = 43
v2(:, :) = 0
do n=1,5
v1(n) = n
end do
v2 (3, 1::2) = v1 (5:1:-1)
v1 = v1 + 1
if (v1(1) .ne. 2) call abort
if (v2(3, 3) .ne. 4) call abort
! Passing whole arrays
call f1 (a)
call f1 (b)
call f1 (c)
call f2 (a)
call f2 (b)
call f2 (c)
! passing expressions
a(1,1) = 41
a(5,8) = 42
call f1(a+1)
call f2(a+1)
a(1,1) = 42
a(5,8) = 43
call f1 ((a + b) / 2)
call f2 ((a + b) / 2)
! Passing whole arrays as sections
call f1 (a(:,:))
call f1 (b(:,:))
call f1 (c(:,:))
call f2 (a(:,:))
call f2 (b(:,:))
call f2 (c(:,:))
! Passing sections
e(:,:) = 0
e(2, 3) = 42
e(6, 10) = 43
n = 3
call f1 (e(2:6, n:10))
call f2 (e(2:6, n:10))
! Vector subscripts
! v1= index plus one, v2(3, ::2) = reverse of index
e(:,:) = 0
e(2, 3) = 42
e(6, 10) = 43
call f1 (e(v1, n:10))
call f2 (e(v1, n:10))
! Double vector subscript
e(:,:) = 0
e(6, 3) = 42
e(2, 10) = 43
!These are not resolved properly
call f1 (e(v1(v2(3, ::2)), n:10))
call f2 (e(v1(v2(3, ::2)), n:10))
! non-contiguous sections
e(:,:) = 0
e(1, 1) = 42
e(13, 22) = 43
n = 3
call f1 (e(1:15:3, 1:24:3))
call f2 (e(::3, ::n))
! non-contiguous sections with bounds
e(:,:) = 0
e(3, 4) = 42
e(11, 18) = 43
n = 19
call f1 (e(3:11:2, 4:n:2))
call f2 (e(3:11:2, 4:n:2))
! Passing a dummy variable
call f1 (parm)
call f2 (parm)
end subroutine
! Assumed shape parameter
subroutine f2 (a)
integer, dimension (1:, 1:) :: a
if (a(1, 1) .ne. 42) call abort
if (a(5, 8) .ne. 43) call abort
end subroutine
end program