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) call abort
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) call abort
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