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