1! { dg-do run } 2! { dg-options "-std=legacy" } 3 4 call test 5contains 6 subroutine check (x, y, l) 7 integer :: x, y 8 logical :: l 9 l = l .or. x .ne. y 10 end subroutine check 11 12 subroutine foo (c, d, e, f, g, h, i, j, k, n) 13 use omp_lib 14 integer :: n 15 character (len = *) :: c 16 character (len = n) :: d 17 integer, dimension (2, 3:5, n) :: e 18 integer, dimension (2, 3:n, n) :: f 19 character (len = *), dimension (5, 3:n) :: g 20 character (len = n), dimension (5, 3:n) :: h 21 real, dimension (:, :, :) :: i 22 double precision, dimension (3:, 5:, 7:) :: j 23 integer, dimension (:, :, :) :: k 24 logical :: l 25 integer :: p, q, r 26 character (len = n) :: s 27 integer, dimension (2, 3:5, n) :: t 28 integer, dimension (2, 3:n, n) :: u 29 character (len = n), dimension (5, 3:n) :: v 30 character (len = 2 * n + 24) :: w 31 integer :: x 32 character (len = 1) :: y 33 s = 'PQRSTUV' 34 forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + p - q + 2 * r 35 forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - p + q - 2 * r 36 forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = '_+|/Oo_' 37 forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = '///|||!' 38 l = .false. 39!$omp parallel default (none) firstprivate (c, d, e, f, g, h, i, j, k) & 40!$omp & firstprivate (s, t, u, v) reduction (.or.:l) num_threads (6) & 41!$omp private (p, q, r, w, x, y) 42 l = l .or. c .ne. 'abcdefghijkl' 43 l = l .or. d .ne. 'ABCDEFG' 44 l = l .or. s .ne. 'PQRSTUV' 45 do 100, p = 1, 2 46 do 100, q = 3, 7 47 do 100, r = 1, 7 48 if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 + p + q + 2 * r 49 l = l .or. f(p, q, r) .ne. 25 + p + q + 2 * r 50 if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. '0123456789AB' 51 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. '9876543210ZY' 52 if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. '0123456' 53 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. '9876543' 54 if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + p - q + 2 * r 55 l = l .or. u(p, q, r) .ne. 30 - p + q - 2 * r 56 if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. '_+|/Oo_' 57 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. '///|||!' 58100 continue 59 do 101, p = 3, 5 60 do 101, q = 2, 6 61 do 101, r = 1, 7 62 l = l .or. i(p - 2, q - 1, r) .ne. 7.5 * p * q * r 63 l = l .or. j(p, q + 3, r + 6) .ne. 9.5 * p * q * r 64101 continue 65 do 102, p = 1, 5 66 do 102, q = 4, 6 67 l = l .or. k(p, 1, q - 3) .ne. 19 + p + 7 + 3 * q 68102 continue 69 x = omp_get_thread_num () 70 w = '' 71 if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0' 72 if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1' 73 if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2' 74 if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3' 75 if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4' 76 if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5' 77 c = w(8:19) 78 d = w(1:7) 79 forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r 80 forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r 81 forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19) 82 forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38) 83 forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7) 84 forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26) 85 forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r 86 forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r 87 forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r 88 s = w(20:26) 89 forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r 90 forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r 91 forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7) 92 forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26) 93!$omp barrier 94 y = '' 95 if (x .eq. 0) y = '0' 96 if (x .eq. 1) y = '1' 97 if (x .eq. 2) y = '2' 98 if (x .eq. 3) y = '3' 99 if (x .eq. 4) y = '4' 100 if (x .eq. 5) y = '5' 101 l = l .or. w(7:7) .ne. y 102 l = l .or. w(19:19) .ne. y 103 l = l .or. w(26:26) .ne. y 104 l = l .or. w(38:38) .ne. y 105 l = l .or. c .ne. w(8:19) 106 l = l .or. d .ne. w(1:7) 107 l = l .or. s .ne. w(20:26) 108 do 103, p = 1, 2 109 do 103, q = 3, 7 110 do 103, r = 1, 7 111 if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r 112 l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r 113 if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19) 114 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38) 115 if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7) 116 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26) 117 if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r 118 l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r 119 if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7) 120 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26) 121103 continue 122 do 104, p = 3, 5 123 do 104, q = 2, 6 124 do 104, r = 1, 7 125 l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r 126 l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r 127104 continue 128 do 105, p = 1, 5 129 do 105, q = 4, 6 130 l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q 131105 continue 132 call check (size (e, 1), 2, l) 133 call check (size (e, 2), 3, l) 134 call check (size (e, 3), 7, l) 135 call check (size (e), 42, l) 136 call check (size (f, 1), 2, l) 137 call check (size (f, 2), 5, l) 138 call check (size (f, 3), 7, l) 139 call check (size (f), 70, l) 140 call check (size (g, 1), 5, l) 141 call check (size (g, 2), 5, l) 142 call check (size (g), 25, l) 143 call check (size (h, 1), 5, l) 144 call check (size (h, 2), 5, l) 145 call check (size (h), 25, l) 146 call check (size (i, 1), 3, l) 147 call check (size (i, 2), 5, l) 148 call check (size (i, 3), 7, l) 149 call check (size (i), 105, l) 150 call check (size (j, 1), 4, l) 151 call check (size (j, 2), 5, l) 152 call check (size (j, 3), 7, l) 153 call check (size (j), 140, l) 154 call check (size (k, 1), 5, l) 155 call check (size (k, 2), 1, l) 156 call check (size (k, 3), 3, l) 157 call check (size (k), 15, l) 158!$omp end parallel 159 if (l) stop 1 160 end subroutine foo 161 162 subroutine test 163 character (len = 12) :: c 164 character (len = 7) :: d 165 integer, dimension (2, 3:5, 7) :: e 166 integer, dimension (2, 3:7, 7) :: f 167 character (len = 12), dimension (5, 3:7) :: g 168 character (len = 7), dimension (5, 3:7) :: h 169 real, dimension (3:5, 2:6, 1:7) :: i 170 double precision, dimension (3:6, 2:6, 1:7) :: j 171 integer, dimension (1:5, 7:7, 4:6) :: k 172 integer :: p, q, r 173 c = 'abcdefghijkl' 174 d = 'ABCDEFG' 175 forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 + p + q + 2 * r 176 forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 + p + q + 2 * r 177 forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = '0123456789AB' 178 forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = '9876543210ZY' 179 forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = '0123456' 180 forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = '9876543' 181 forall (p = 3:5, q = 2:6, r = 1:7) i(p, q, r) = 7.5 * p * q * r 182 forall (p = 3:6, q = 2:6, r = 1:7) j(p, q, r) = 9.5 * p * q * r 183 forall (p = 1:5, q = 7:7, r = 4:6) k(p, q, r) = 19 + p + q + 3 * r 184 call foo (c, d, e, f, g, h, i, j, k, 7) 185 end subroutine test 186end 187