1! Program to test arrays
2! The program outputs a series of numbers.
3! Two digit numbers beginning with 0, 1, 2 or 3 is a normal.
4! Three digit numbers starting with 4 indicate an error.
5! Using 1D arrays isn't a sufficient test, the first dimension is often
6! handled specially.
7
8! Fixed size parameter
9subroutine f1 (a)
10   implicit none
11   integer, dimension (5, 8) :: a
12
13   if (a(1, 1) .ne. 42) call abort
14
15   if (a(5, 8) .ne. 43) call abort
16end subroutine
17
18
19program testprog
20   implicit none
21   integer, dimension(3:7, 4:11) :: a
22   a(:,:) = 0
23   a(3, 4) = 42
24   a(7, 11) = 43
25   call test(a)
26contains
27subroutine test (parm)
28   implicit none
29   ! parameter
30   integer, dimension(2:, 3:) :: parm
31   ! Known size arry
32   integer, dimension(5, 8) :: a
33   ! Known size array with different bounds
34   integer, dimension(4:8, 3:10) :: b
35   ! Unknown size arrays
36   integer, dimension(:, :), allocatable :: c, d, e
37   ! Vectors
38   integer, dimension(5) :: v1
39   integer, dimension(10, 10) :: v2
40   integer n
41   external f1
42
43   ! Same size
44   allocate (c(5,8))
45   ! Same size, different bounds
46   allocate (d(11:15, 12:19))
47   ! A larger array
48   allocate (e(15, 24))
49   a(:,:) = 0
50   b(:,:) = 0
51   c(:,:) = 0
52   d(:,:) = 0
53   a(1,1) = 42
54   b(4, 3) = 42
55   c(1,1) = 42
56   d(11,12) = 42
57   a(5, 8) = 43
58   b(8, 10) = 43
59   c(5, 8) = 43
60   d(15, 19) = 43
61
62   v2(:, :) = 0
63   do n=1,5
64     v1(n) = n
65   end do
66
67   v2 (3, 1::2) = v1 (5:1:-1)
68   v1 = v1 + 1
69
70   if (v1(1) .ne. 2) call abort
71   if (v2(3, 3) .ne. 4) call abort
72
73   ! Passing whole arrays
74   call f1 (a)
75   call f1 (b)
76   call f1 (c)
77   call f2 (a)
78   call f2 (b)
79   call f2 (c)
80   ! passing expressions
81   a(1,1) = 41
82   a(5,8) = 42
83   call f1(a+1)
84   call f2(a+1)
85   a(1,1) = 42
86   a(5,8) = 43
87   call f1 ((a + b) / 2)
88   call f2 ((a + b) / 2)
89   ! Passing whole arrays as sections
90   call f1 (a(:,:))
91   call f1 (b(:,:))
92   call f1 (c(:,:))
93   call f2 (a(:,:))
94   call f2 (b(:,:))
95   call f2 (c(:,:))
96   ! Passing sections
97   e(:,:) = 0
98   e(2, 3) = 42
99   e(6, 10) = 43
100   n = 3
101   call f1 (e(2:6, n:10))
102   call f2 (e(2:6, n:10))
103   ! Vector subscripts
104   ! v1= index plus one, v2(3, ::2) = reverse of index
105   e(:,:) = 0
106   e(2, 3) = 42
107   e(6, 10) = 43
108   call f1 (e(v1, n:10))
109   call f2 (e(v1, n:10))
110   ! Double vector subscript
111   e(:,:) = 0
112   e(6, 3) = 42
113   e(2, 10) = 43
114   !These are not resolved properly
115   call f1 (e(v1(v2(3, ::2)), n:10))
116   call f2 (e(v1(v2(3, ::2)), n:10))
117   ! non-contiguous sections
118   e(:,:) = 0
119   e(1, 1) = 42
120   e(13, 22) = 43
121   n = 3
122   call f1 (e(1:15:3, 1:24:3))
123   call f2 (e(::3, ::n))
124   ! non-contiguous sections with bounds
125   e(:,:) = 0
126   e(3, 4) = 42
127   e(11, 18) = 43
128   n = 19
129   call f1 (e(3:11:2, 4:n:2))
130   call f2 (e(3:11:2, 4:n:2))
131
132   ! Passing a dummy variable
133   call f1 (parm)
134   call f2 (parm)
135end subroutine
136! Assumed shape parameter
137subroutine f2 (a)
138   integer, dimension (1:, 1:) :: a
139
140   if (a(1, 1) .ne. 42) call abort
141
142   if (a(5, 8) .ne. 43) call abort
143end subroutine
144end program
145
146