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 interface 15 subroutine GOMP_barrier () bind(c, name="GOMP_barrier") 16 end subroutine 17 end interface 18 integer :: n 19 character (len = *) :: c 20 character (len = n) :: d 21 integer, dimension (2, 3:5, n) :: e 22 integer, dimension (2, 3:n, n) :: f 23 character (len = *), dimension (5, 3:n) :: g 24 character (len = n), dimension (5, 3:n) :: h 25 real, dimension (:, :, :) :: i 26 double precision, dimension (3:, 5:, 7:) :: j 27 integer, dimension (:, :, :) :: k 28 logical :: l 29 integer :: p, q, r 30 character (len = n) :: s 31 integer, dimension (2, 3:5, n) :: t 32 integer, dimension (2, 3:n, n) :: u 33 character (len = n), dimension (5, 3:n) :: v 34 character (len = 2 * n + 24) :: w 35 integer :: x, z, z2 36 character (len = 1) :: y 37 s = 'PQRSTUV' 38 forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + p - q + 2 * r 39 forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - p + q - 2 * r 40 forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = '_+|/Oo_' 41 forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = '///|||!' 42 l = .false. 43 call omp_set_dynamic (.false.) 44 call omp_set_num_threads (6) 45!$omp parallel do default (none) firstprivate (c, d, e, f, g, h, i, j, k) & 46!$omp & firstprivate (s, t, u, v) reduction (.or.:l) num_threads (6) & 47!$omp private (p, q, r, w, x, y) schedule (static) shared (z2) & 48!$omp lastprivate (c, d, e, f, g, h, i, j, k, s, t, u, v) 49 do 110 z = 0, omp_get_num_threads () - 1 50 if (omp_get_thread_num () .eq. 0) z2 = omp_get_num_threads () 51 l = l .or. c .ne. 'abcdefghijkl' 52 l = l .or. d .ne. 'ABCDEFG' 53 l = l .or. s .ne. 'PQRSTUV' 54 do 100, p = 1, 2 55 do 100, q = 3, 7 56 do 100, r = 1, 7 57 if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 + p + q + 2 * r 58 l = l .or. f(p, q, r) .ne. 25 + p + q + 2 * r 59 if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. '0123456789AB' 60 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. '9876543210ZY' 61 if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. '0123456' 62 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. '9876543' 63 if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + p - q + 2 * r 64 l = l .or. u(p, q, r) .ne. 30 - p + q - 2 * r 65 if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. '_+|/Oo_' 66 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. '///|||!' 67100 continue 68 do 101, p = 3, 5 69 do 101, q = 2, 6 70 do 101, r = 1, 7 71 l = l .or. i(p - 2, q - 1, r) .ne. 7.5 * p * q * r 72 l = l .or. j(p, q + 3, r + 6) .ne. 9.5 * p * q * r 73101 continue 74 do 102, p = 1, 5 75 do 102, q = 4, 6 76 l = l .or. k(p, 1, q - 3) .ne. 19 + p + 7 + 3 * q 77102 continue 78 x = omp_get_thread_num () 79 w = '' 80 if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0' 81 if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1' 82 if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2' 83 if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3' 84 if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4' 85 if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5' 86 c = w(8:19) 87 d = w(1:7) 88 forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r 89 forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r 90 forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19) 91 forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38) 92 forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7) 93 forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26) 94 forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r 95 forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r 96 forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r 97 s = w(20:26) 98 forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r 99 forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r 100 forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7) 101 forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26) 102 call GOMP_barrier 103 y = '' 104 if (x .eq. 0) y = '0' 105 if (x .eq. 1) y = '1' 106 if (x .eq. 2) y = '2' 107 if (x .eq. 3) y = '3' 108 if (x .eq. 4) y = '4' 109 if (x .eq. 5) y = '5' 110 l = l .or. w(7:7) .ne. y 111 l = l .or. w(19:19) .ne. y 112 l = l .or. w(26:26) .ne. y 113 l = l .or. w(38:38) .ne. y 114 l = l .or. c .ne. w(8:19) 115 l = l .or. d .ne. w(1:7) 116 l = l .or. s .ne. w(20:26) 117 do 103, p = 1, 2 118 do 103, q = 3, 7 119 do 103, r = 1, 7 120 if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r 121 l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r 122 if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19) 123 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38) 124 if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7) 125 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26) 126 if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r 127 l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r 128 if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7) 129 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26) 130103 continue 131 do 104, p = 3, 5 132 do 104, q = 2, 6 133 do 104, r = 1, 7 134 l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r 135 l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r 136104 continue 137 do 105, p = 1, 5 138 do 105, q = 4, 6 139 l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q 140105 continue 141 call check (size (e, 1), 2, l) 142 call check (size (e, 2), 3, l) 143 call check (size (e, 3), 7, l) 144 call check (size (e), 42, l) 145 call check (size (f, 1), 2, l) 146 call check (size (f, 2), 5, l) 147 call check (size (f, 3), 7, l) 148 call check (size (f), 70, l) 149 call check (size (g, 1), 5, l) 150 call check (size (g, 2), 5, l) 151 call check (size (g), 25, l) 152 call check (size (h, 1), 5, l) 153 call check (size (h, 2), 5, l) 154 call check (size (h), 25, l) 155 call check (size (i, 1), 3, l) 156 call check (size (i, 2), 5, l) 157 call check (size (i, 3), 7, l) 158 call check (size (i), 105, l) 159 call check (size (j, 1), 4, l) 160 call check (size (j, 2), 5, l) 161 call check (size (j, 3), 7, l) 162 call check (size (j), 140, l) 163 call check (size (k, 1), 5, l) 164 call check (size (k, 2), 1, l) 165 call check (size (k, 3), 3, l) 166 call check (size (k), 15, l) 167110 continue 168!$omp end parallel do 169 if (l) stop 1 170 if (z2 == 6) then 171 x = 5 172 w = 'thread5thr_number_5THREAD5THR_NUMBER_5' 173 y = '5' 174 l = l .or. w(7:7) .ne. y 175 l = l .or. w(19:19) .ne. y 176 l = l .or. w(26:26) .ne. y 177 l = l .or. w(38:38) .ne. y 178 l = l .or. c .ne. w(8:19) 179 l = l .or. d .ne. w(1:7) 180 l = l .or. s .ne. w(20:26) 181 do 113, p = 1, 2 182 do 113, q = 3, 7 183 do 113, r = 1, 7 184 if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r 185 l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r 186 if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19) 187 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38) 188 if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7) 189 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26) 190 if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r 191 l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r 192 if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7) 193 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26) 194113 continue 195 do 114, p = 3, 5 196 do 114, q = 2, 6 197 do 114, r = 1, 7 198 l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r 199 l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r 200114 continue 201 do 115, p = 1, 5 202 do 115, q = 4, 6 203 l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q 204115 continue 205 if (l) stop 2 206 end if 207 end subroutine foo 208 209 subroutine test 210 character (len = 12) :: c 211 character (len = 7) :: d 212 integer, dimension (2, 3:5, 7) :: e 213 integer, dimension (2, 3:7, 7) :: f 214 character (len = 12), dimension (5, 3:7) :: g 215 character (len = 7), dimension (5, 3:7) :: h 216 real, dimension (3:5, 2:6, 1:7) :: i 217 double precision, dimension (3:6, 2:6, 1:7) :: j 218 integer, dimension (1:5, 7:7, 4:6) :: k 219 integer :: p, q, r 220 c = 'abcdefghijkl' 221 d = 'ABCDEFG' 222 forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 + p + q + 2 * r 223 forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 + p + q + 2 * r 224 forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = '0123456789AB' 225 forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = '9876543210ZY' 226 forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = '0123456' 227 forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = '9876543' 228 forall (p = 3:5, q = 2:6, r = 1:7) i(p, q, r) = 7.5 * p * q * r 229 forall (p = 3:6, q = 2:6, r = 1:7) j(p, q, r) = 9.5 * p * q * r 230 forall (p = 1:5, q = 7:7, r = 4:6) k(p, q, r) = 19 + p + q + 3 * r 231 call foo (c, d, e, f, g, h, i, j, k, 7) 232 end subroutine test 233end 234