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) lastprivate (c, d, e, f, g, h, i, j, k) & 45!$omp & lastprivate (s, t, u, v) reduction (.or.:l) num_threads (6) & 46!$omp private (p, q, r, w, x, y) schedule (static) shared (z2) 47 do 110 z = 0, omp_get_num_threads () - 1 48 if (omp_get_thread_num () .eq. 0) z2 = omp_get_num_threads () 49 x = omp_get_thread_num () 50 w = '' 51 if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0' 52 if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1' 53 if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2' 54 if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3' 55 if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4' 56 if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5' 57 c = w(8:19) 58 d = w(1:7) 59 forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r 60 forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r 61 forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19) 62 forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38) 63 forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7) 64 forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26) 65 forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r 66 forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r 67 forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r 68 s = w(20:26) 69 forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r 70 forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r 71 forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7) 72 forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26) 73 call GOMP_barrier 74 y = '' 75 if (x .eq. 0) y = '0' 76 if (x .eq. 1) y = '1' 77 if (x .eq. 2) y = '2' 78 if (x .eq. 3) y = '3' 79 if (x .eq. 4) y = '4' 80 if (x .eq. 5) y = '5' 81 l = l .or. w(7:7) .ne. y 82 l = l .or. w(19:19) .ne. y 83 l = l .or. w(26:26) .ne. y 84 l = l .or. w(38:38) .ne. y 85 l = l .or. c .ne. w(8:19) 86 l = l .or. d .ne. w(1:7) 87 l = l .or. s .ne. w(20:26) 88 do 103, p = 1, 2 89 do 103, q = 3, 7 90 do 103, r = 1, 7 91 if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r 92 l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r 93 if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19) 94 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38) 95 if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7) 96 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26) 97 if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r 98 l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r 99 if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7) 100 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26) 101103 continue 102 do 104, p = 3, 5 103 do 104, q = 2, 6 104 do 104, r = 1, 7 105 l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r 106 l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r 107104 continue 108 do 105, p = 1, 5 109 do 105, q = 4, 6 110 l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q 111105 continue 112 call check (size (e, 1), 2, l) 113 call check (size (e, 2), 3, l) 114 call check (size (e, 3), 7, l) 115 call check (size (e), 42, l) 116 call check (size (f, 1), 2, l) 117 call check (size (f, 2), 5, l) 118 call check (size (f, 3), 7, l) 119 call check (size (f), 70, l) 120 call check (size (g, 1), 5, l) 121 call check (size (g, 2), 5, l) 122 call check (size (g), 25, l) 123 call check (size (h, 1), 5, l) 124 call check (size (h, 2), 5, l) 125 call check (size (h), 25, l) 126 call check (size (i, 1), 3, l) 127 call check (size (i, 2), 5, l) 128 call check (size (i, 3), 7, l) 129 call check (size (i), 105, l) 130 call check (size (j, 1), 4, l) 131 call check (size (j, 2), 5, l) 132 call check (size (j, 3), 7, l) 133 call check (size (j), 140, l) 134 call check (size (k, 1), 5, l) 135 call check (size (k, 2), 1, l) 136 call check (size (k, 3), 3, l) 137 call check (size (k), 15, l) 138110 continue 139!$omp end parallel do 140 if (l) STOP 1 141 if (z2 == 6) then 142 x = 5 143 w = 'thread5thr_number_5THREAD5THR_NUMBER_5' 144 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 if (l) STOP 2 177 end if 178 end subroutine foo 179 180 subroutine test 181 character (len = 12) :: c 182 character (len = 7) :: d 183 integer, dimension (2, 3:5, 7) :: e 184 integer, dimension (2, 3:7, 7) :: f 185 character (len = 12), dimension (5, 3:7) :: g 186 character (len = 7), dimension (5, 3:7) :: h 187 real, dimension (3:5, 2:6, 1:7) :: i 188 double precision, dimension (3:6, 2:6, 1:7) :: j 189 integer, dimension (1:5, 7:7, 4:6) :: k 190 integer :: p, q, r 191 c = 'abcdefghijkl' 192 d = 'ABCDEFG' 193 forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 + p + q + 2 * r 194 forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 + p + q + 2 * r 195 forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = '0123456789AB' 196 forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = '9876543210ZY' 197 forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = '0123456' 198 forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = '9876543' 199 forall (p = 3:5, q = 2:6, r = 1:7) i(p, q, r) = 7.5 * p * q * r 200 forall (p = 3:6, q = 2:6, r = 1:7) j(p, q, r) = 9.5 * p * q * r 201 forall (p = 1:5, q = 7:7, r = 4:6) k(p, q, r) = 19 + p + q + 3 * r 202 call foo (c, d, e, f, g, h, i, j, k, 7) 203 end subroutine test 204end 205