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