1! { dg-do run } 2! { dg-timeout-factor 2.0 } 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, z 32 character (len = 1) :: y 33 l = .false. 34!$omp parallel default (none) private (c, d, e, f, g, h, i, j, k) & 35!$omp & private (s, t, u, v) reduction (.or.:l) num_threads (6) & 36!$omp private (p, q, r, w, x, y) shared (z) 37 x = omp_get_thread_num () 38 w = '' 39 if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0' 40 if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1' 41 if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2' 42 if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3' 43 if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4' 44 if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5' 45 c = w(8:19) 46 d = w(1:7) 47 forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r 48 forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r 49 forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19) 50 forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38) 51 forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7) 52 forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26) 53 forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r 54 forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r 55 forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r 56 s = w(20:26) 57 forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r 58 forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r 59 forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7) 60 forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26) 61!$omp barrier 62 y = '' 63 if (x .eq. 0) y = '0' 64 if (x .eq. 1) y = '1' 65 if (x .eq. 2) y = '2' 66 if (x .eq. 3) y = '3' 67 if (x .eq. 4) y = '4' 68 if (x .eq. 5) y = '5' 69 l = l .or. w(7:7) .ne. y 70 l = l .or. w(19:19) .ne. y 71 l = l .or. w(26:26) .ne. y 72 l = l .or. w(38:38) .ne. y 73 l = l .or. c .ne. w(8:19) 74 l = l .or. d .ne. w(1:7) 75 l = l .or. s .ne. w(20:26) 76 do 103, p = 1, 2 77 do 103, q = 3, 7 78 do 103, r = 1, 7 79 if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r 80 l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r 81 if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19) 82 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38) 83 if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7) 84 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26) 85 if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r 86 l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r 87 if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7) 88 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26) 89103 continue 90 do 104, p = 3, 5 91 do 104, q = 2, 6 92 do 104, r = 1, 7 93 l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r 94 l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r 95104 continue 96 do 105, p = 1, 5 97 do 105, q = 4, 6 98 l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q 99105 continue 100 call check (size (e, 1), 2, l) 101 call check (size (e, 2), 3, l) 102 call check (size (e, 3), 7, l) 103 call check (size (e), 42, l) 104 call check (size (f, 1), 2, l) 105 call check (size (f, 2), 5, l) 106 call check (size (f, 3), 7, l) 107 call check (size (f), 70, l) 108 call check (size (g, 1), 5, l) 109 call check (size (g, 2), 5, l) 110 call check (size (g), 25, l) 111 call check (size (h, 1), 5, l) 112 call check (size (h, 2), 5, l) 113 call check (size (h), 25, l) 114 call check (size (i, 1), 3, l) 115 call check (size (i, 2), 5, l) 116 call check (size (i, 3), 7, l) 117 call check (size (i), 105, l) 118 call check (size (j, 1), 4, l) 119 call check (size (j, 2), 5, l) 120 call check (size (j, 3), 7, l) 121 call check (size (j), 140, l) 122 call check (size (k, 1), 5, l) 123 call check (size (k, 2), 1, l) 124 call check (size (k, 3), 3, l) 125 call check (size (k), 15, l) 126!$omp single 127 z = omp_get_thread_num () 128!$omp end single copyprivate (c, d, e, f, g, h, i, j, k, s, t, u, v) 129 w = '' 130 x = z 131 if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0' 132 if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1' 133 if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2' 134 if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3' 135 if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4' 136 if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5' 137 y = '' 138 if (x .eq. 0) y = '0' 139 if (x .eq. 1) y = '1' 140 if (x .eq. 2) y = '2' 141 if (x .eq. 3) y = '3' 142 if (x .eq. 4) y = '4' 143 if (x .eq. 5) y = '5' 144 l = l .or. w(7:7) .ne. y 145 l = l .or. w(19:19) .ne. y 146 l = l .or. w(26:26) .ne. y 147 l = l .or. w(38:38) .ne. y 148 l = l .or. c .ne. w(8:19) 149 l = l .or. d .ne. w(1:7) 150 l = l .or. s .ne. w(20:26) 151 do 113, p = 1, 2 152 do 113, q = 3, 7 153 do 113, r = 1, 7 154 if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r 155 l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r 156 if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19) 157 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38) 158 if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7) 159 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26) 160 if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r 161 l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r 162 if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7) 163 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26) 164113 continue 165 do 114, p = 3, 5 166 do 114, q = 2, 6 167 do 114, r = 1, 7 168 l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r 169 l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r 170114 continue 171 do 115, p = 1, 5 172 do 115, q = 4, 6 173 l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q 174115 continue 175 x = omp_get_thread_num () 176 w = '' 177 if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0' 178 if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1' 179 if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2' 180 if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3' 181 if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4' 182 if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5' 183 c = w(8:19) 184 d = w(1:7) 185 forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r 186 forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r 187 forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19) 188 forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38) 189 forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7) 190 forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26) 191 forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r 192 forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r 193 forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r 194 s = w(20:26) 195 forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r 196 forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r 197 forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7) 198 forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26) 199!$omp barrier 200 y = '' 201 if (x .eq. 0) y = '0' 202 if (x .eq. 1) y = '1' 203 if (x .eq. 2) y = '2' 204 if (x .eq. 3) y = '3' 205 if (x .eq. 4) y = '4' 206 if (x .eq. 5) y = '5' 207 l = l .or. w(7:7) .ne. y 208 l = l .or. w(19:19) .ne. y 209 l = l .or. w(26:26) .ne. y 210 l = l .or. w(38:38) .ne. y 211 l = l .or. c .ne. w(8:19) 212 l = l .or. d .ne. w(1:7) 213 l = l .or. s .ne. w(20:26) 214 do 123, p = 1, 2 215 do 123, q = 3, 7 216 do 123, r = 1, 7 217 if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r 218 l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r 219 if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19) 220 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38) 221 if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7) 222 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26) 223 if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r 224 l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r 225 if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7) 226 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26) 227123 continue 228 do 124, p = 3, 5 229 do 124, q = 2, 6 230 do 124, r = 1, 7 231 l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r 232 l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r 233124 continue 234 do 125, p = 1, 5 235 do 125, q = 4, 6 236 l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q 237125 continue 238!$omp end parallel 239 if (l) STOP 1 240 end subroutine foo 241 242 subroutine test 243 character (len = 12) :: c 244 character (len = 7) :: d 245 integer, dimension (2, 3:5, 7) :: e 246 integer, dimension (2, 3:7, 7) :: f 247 character (len = 12), dimension (5, 3:7) :: g 248 character (len = 7), dimension (5, 3:7) :: h 249 real, dimension (3:5, 2:6, 1:7) :: i 250 double precision, dimension (3:6, 2:6, 1:7) :: j 251 integer, dimension (1:5, 7:7, 4:6) :: k 252 integer :: p, q, r 253 call foo (c, d, e, f, g, h, i, j, k, 7) 254 end subroutine test 255end 256