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