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