! { 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) firstprivate (c, d, e, f, g, h, i, j, k) &
!$omp & firstprivate (s, t, u, v) reduction (.or.:l) num_threads (6) &
!$omp private (p, q, r, w, x, y) schedule (static) shared (z2) &
!$omp lastprivate (c, d, e, f, g, h, i, j, k, s, t, u, v)
    do 110 z = 0, omp_get_num_threads () - 1
    if (omp_get_thread_num () .eq. 0) z2 = omp_get_num_threads ()
    l = l .or. c .ne. 'abcdefghijkl'
    l = l .or. d .ne. 'ABCDEFG'
    l = l .or. s .ne. 'PQRSTUV'
    do 100, p = 1, 2
      do 100, q = 3, 7
	do 100, r = 1, 7
	  if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 + p + q + 2 * r
	  l = l .or. f(p, q, r) .ne. 25 + p + q + 2 * r
	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. '0123456789AB'
	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. '9876543210ZY'
	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. '0123456'
	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. '9876543'
	  if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + p - q + 2 * r
	  l = l .or. u(p, q, r) .ne. 30 - p + q - 2 * r
	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. '_+|/Oo_'
	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. '///|||!'
100 continue
    do 101, p = 3, 5
      do 101, q = 2, 6
	do 101, r = 1, 7
	  l = l .or. i(p - 2, q - 1, r) .ne. 7.5 * p * q * r
	  l = l .or. j(p, q + 3, r + 6) .ne. 9.5 * p * q * r
101 continue
    do 102, p = 1, 5
      do 102, q = 4, 6
	l = l .or. k(p, 1, q - 3) .ne. 19 + p + 7 + 3 * q
102 continue
    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