! { dg-do run } ! { dg-options "-std=legacy" } call test contains subroutine check (x, y, l) integer :: x, y logical :: l l = l .or. x .ne. y end subroutine check subroutine foo (c, d, e, f, g, h, i, j, k, n) use omp_lib interface subroutine GOMP_barrier () bind(c, name="GOMP_barrier") end subroutine end interface integer :: n character (len = *) :: c character (len = n) :: d integer, dimension (2, 3:5, n) :: e integer, dimension (2, 3:n, n) :: f character (len = *), dimension (5, 3:n) :: g character (len = n), dimension (5, 3:n) :: h real, dimension (:, :, :) :: i double precision, dimension (3:, 5:, 7:) :: j integer, dimension (:, :, :) :: k logical :: l integer :: p, q, r character (len = n) :: s integer, dimension (2, 3:5, n) :: t integer, dimension (2, 3:n, n) :: u character (len = n), dimension (5, 3:n) :: v character (len = 2 * n + 24) :: w integer :: x, z, z2 character (len = 1) :: y s = 'PQRSTUV' forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + p - q + 2 * r forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - p + q - 2 * r forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = '_+|/Oo_' forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = '///|||!' l = .false. call omp_set_dynamic (.false.) call omp_set_num_threads (6) !$omp parallel do default (none) lastprivate (c, d, e, f, g, h, i, j, k) & !$omp & lastprivate (s, t, u, v) reduction (.or.:l) num_threads (6) & !$omp private (p, q, r, w, x, y) schedule (static) shared (z2) do 110 z = 0, omp_get_num_threads () - 1 if (omp_get_thread_num () .eq. 0) z2 = omp_get_num_threads () x = omp_get_thread_num () w = '' if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0' if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1' if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2' if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3' if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4' if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5' c = w(8:19) d = w(1:7) forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19) forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38) forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7) forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26) forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r s = w(20:26) forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7) forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26) call GOMP_barrier y = '' if (x .eq. 0) y = '0' if (x .eq. 1) y = '1' if (x .eq. 2) y = '2' if (x .eq. 3) y = '3' if (x .eq. 4) y = '4' if (x .eq. 5) y = '5' l = l .or. w(7:7) .ne. y l = l .or. w(19:19) .ne. y l = l .or. w(26:26) .ne. y l = l .or. w(38:38) .ne. y l = l .or. c .ne. w(8:19) l = l .or. d .ne. w(1:7) l = l .or. s .ne. w(20:26) do 103, p = 1, 2 do 103, q = 3, 7 do 103, r = 1, 7 if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19) if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38) if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7) if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26) if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7) if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26) 103 continue do 104, p = 3, 5 do 104, q = 2, 6 do 104, r = 1, 7 l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r 104 continue do 105, p = 1, 5 do 105, q = 4, 6 l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q 105 continue call check (size (e, 1), 2, l) call check (size (e, 2), 3, l) call check (size (e, 3), 7, l) call check (size (e), 42, l) call check (size (f, 1), 2, l) call check (size (f, 2), 5, l) call check (size (f, 3), 7, l) call check (size (f), 70, l) call check (size (g, 1), 5, l) call check (size (g, 2), 5, l) call check (size (g), 25, l) call check (size (h, 1), 5, l) call check (size (h, 2), 5, l) call check (size (h), 25, l) call check (size (i, 1), 3, l) call check (size (i, 2), 5, l) call check (size (i, 3), 7, l) call check (size (i), 105, l) call check (size (j, 1), 4, l) call check (size (j, 2), 5, l) call check (size (j, 3), 7, l) call check (size (j), 140, l) call check (size (k, 1), 5, l) call check (size (k, 2), 1, l) call check (size (k, 3), 3, l) call check (size (k), 15, l) 110 continue !$omp end parallel do if (l) stop 1 if (z2 == 6) then x = 5 w = 'thread5thr_number_5THREAD5THR_NUMBER_5' y = '5' l = l .or. w(7:7) .ne. y l = l .or. w(19:19) .ne. y l = l .or. w(26:26) .ne. y l = l .or. w(38:38) .ne. y l = l .or. c .ne. w(8:19) l = l .or. d .ne. w(1:7) l = l .or. s .ne. w(20:26) do 113, p = 1, 2 do 113, q = 3, 7 do 113, r = 1, 7 if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19) if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38) if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7) if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26) if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7) if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26) 113 continue do 114, p = 3, 5 do 114, q = 2, 6 do 114, r = 1, 7 l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r 114 continue do 115, p = 1, 5 do 115, q = 4, 6 l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q 115 continue if (l) stop 2 end if end subroutine foo subroutine test character (len = 12) :: c character (len = 7) :: d integer, dimension (2, 3:5, 7) :: e integer, dimension (2, 3:7, 7) :: f character (len = 12), dimension (5, 3:7) :: g character (len = 7), dimension (5, 3:7) :: h real, dimension (3:5, 2:6, 1:7) :: i double precision, dimension (3:6, 2:6, 1:7) :: j integer, dimension (1:5, 7:7, 4:6) :: k integer :: p, q, r c = 'abcdefghijkl' d = 'ABCDEFG' forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 + p + q + 2 * r forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 + p + q + 2 * r forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = '0123456789AB' forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = '9876543210ZY' forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = '0123456' forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = '9876543' forall (p = 3:5, q = 2:6, r = 1:7) i(p, q, r) = 7.5 * p * q * r forall (p = 3:6, q = 2:6, r = 1:7) j(p, q, r) = 9.5 * p * q * r forall (p = 1:5, q = 7:7, r = 4:6) k(p, q, r) = 19 + p + q + 3 * r call foo (c, d, e, f, g, h, i, j, k, 7) end subroutine test end