! { dg-do run } 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 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) !$omp 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) call abort 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) call abort 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