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) STOP 1 14 15 if (a(5, 8) .ne. 43) STOP 2 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) STOP 3 71 if (v2(3, 3) .ne. 4) STOP 4 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) STOP 5 141 142 if (a(5, 8) .ne. 43) STOP 6 143end subroutine 144end program 145 146