1! { dg-do run }
2! { dg-timeout-factor 2.0 }
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    integer :: n
15    character (len = *) :: c
16    character (len = n) :: d
17    integer, dimension (2, 3:5, n) :: e
18    integer, dimension (2, 3:n, n) :: f
19    character (len = *), dimension (5, 3:n) :: g
20    character (len = n), dimension (5, 3:n) :: h
21    real, dimension (:, :, :) :: i
22    double precision, dimension (3:, 5:, 7:) :: j
23    integer, dimension (:, :, :) :: k
24    logical :: l
25    integer :: p, q, r
26    character (len = n) :: s
27    integer, dimension (2, 3:5, n) :: t
28    integer, dimension (2, 3:n, n) :: u
29    character (len = n), dimension (5, 3:n) :: v
30    character (len = 2 * n + 24) :: w
31    integer :: x, z
32    character (len = 1) :: y
33    l = .false.
34!$omp parallel default (none) private (c, d, e, f, g, h, i, j, k) &
35!$omp & private (s, t, u, v) reduction (.or.:l) num_threads (6) &
36!$omp private (p, q, r, w, x, y) shared (z)
37    x = omp_get_thread_num ()
38    w = ''
39    if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0'
40    if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1'
41    if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2'
42    if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3'
43    if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4'
44    if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
45    c = w(8:19)
46    d = w(1:7)
47    forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r
48    forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r
49    forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19)
50    forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38)
51    forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7)
52    forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26)
53    forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r
54    forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r
55    forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r
56    s = w(20:26)
57    forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r
58    forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r
59    forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7)
60    forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26)
61!$omp barrier
62    y = ''
63    if (x .eq. 0) y = '0'
64    if (x .eq. 1) y = '1'
65    if (x .eq. 2) y = '2'
66    if (x .eq. 3) y = '3'
67    if (x .eq. 4) y = '4'
68    if (x .eq. 5) y = '5'
69    l = l .or. w(7:7) .ne. y
70    l = l .or. w(19:19) .ne. y
71    l = l .or. w(26:26) .ne. y
72    l = l .or. w(38:38) .ne. y
73    l = l .or. c .ne. w(8:19)
74    l = l .or. d .ne. w(1:7)
75    l = l .or. s .ne. w(20:26)
76    do 103, p = 1, 2
77      do 103, q = 3, 7
78	do 103, r = 1, 7
79	  if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
80	  l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
81	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
82	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
83	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
84	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
85	  if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
86	  l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
87	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
88	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
89103 continue
90    do 104, p = 3, 5
91      do 104, q = 2, 6
92	do 104, r = 1, 7
93	  l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
94	  l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
95104 continue
96    do 105, p = 1, 5
97      do 105, q = 4, 6
98	l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
99105 continue
100    call check (size (e, 1), 2, l)
101    call check (size (e, 2), 3, l)
102    call check (size (e, 3), 7, l)
103    call check (size (e), 42, l)
104    call check (size (f, 1), 2, l)
105    call check (size (f, 2), 5, l)
106    call check (size (f, 3), 7, l)
107    call check (size (f), 70, l)
108    call check (size (g, 1), 5, l)
109    call check (size (g, 2), 5, l)
110    call check (size (g), 25, l)
111    call check (size (h, 1), 5, l)
112    call check (size (h, 2), 5, l)
113    call check (size (h), 25, l)
114    call check (size (i, 1), 3, l)
115    call check (size (i, 2), 5, l)
116    call check (size (i, 3), 7, l)
117    call check (size (i), 105, l)
118    call check (size (j, 1), 4, l)
119    call check (size (j, 2), 5, l)
120    call check (size (j, 3), 7, l)
121    call check (size (j), 140, l)
122    call check (size (k, 1), 5, l)
123    call check (size (k, 2), 1, l)
124    call check (size (k, 3), 3, l)
125    call check (size (k), 15, l)
126!$omp single
127    z = omp_get_thread_num ()
128!$omp end single copyprivate (c, d, e, f, g, h, i, j, k, s, t, u, v)
129    w = ''
130    x = z
131    if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0'
132    if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1'
133    if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2'
134    if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3'
135    if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4'
136    if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
137    y = ''
138    if (x .eq. 0) y = '0'
139    if (x .eq. 1) y = '1'
140    if (x .eq. 2) y = '2'
141    if (x .eq. 3) y = '3'
142    if (x .eq. 4) y = '4'
143    if (x .eq. 5) y = '5'
144    l = l .or. w(7:7) .ne. y
145    l = l .or. w(19:19) .ne. y
146    l = l .or. w(26:26) .ne. y
147    l = l .or. w(38:38) .ne. y
148    l = l .or. c .ne. w(8:19)
149    l = l .or. d .ne. w(1:7)
150    l = l .or. s .ne. w(20:26)
151    do 113, p = 1, 2
152      do 113, q = 3, 7
153	do 113, r = 1, 7
154	  if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
155	  l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
156	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
157	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
158	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
159	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
160	  if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
161	  l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
162	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
163	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
164113 continue
165    do 114, p = 3, 5
166      do 114, q = 2, 6
167	do 114, r = 1, 7
168	  l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
169	  l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
170114 continue
171    do 115, p = 1, 5
172      do 115, q = 4, 6
173	l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
174115 continue
175    x = omp_get_thread_num ()
176    w = ''
177    if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0'
178    if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1'
179    if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2'
180    if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3'
181    if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4'
182    if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
183    c = w(8:19)
184    d = w(1:7)
185    forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r
186    forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r
187    forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19)
188    forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38)
189    forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7)
190    forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26)
191    forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r
192    forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r
193    forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r
194    s = w(20:26)
195    forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r
196    forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r
197    forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7)
198    forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26)
199!$omp barrier
200    y = ''
201    if (x .eq. 0) y = '0'
202    if (x .eq. 1) y = '1'
203    if (x .eq. 2) y = '2'
204    if (x .eq. 3) y = '3'
205    if (x .eq. 4) y = '4'
206    if (x .eq. 5) y = '5'
207    l = l .or. w(7:7) .ne. y
208    l = l .or. w(19:19) .ne. y
209    l = l .or. w(26:26) .ne. y
210    l = l .or. w(38:38) .ne. y
211    l = l .or. c .ne. w(8:19)
212    l = l .or. d .ne. w(1:7)
213    l = l .or. s .ne. w(20:26)
214    do 123, p = 1, 2
215      do 123, q = 3, 7
216	do 123, r = 1, 7
217	  if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
218	  l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
219	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
220	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
221	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
222	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
223	  if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
224	  l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
225	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
226	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
227123 continue
228    do 124, p = 3, 5
229      do 124, q = 2, 6
230	do 124, r = 1, 7
231	  l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
232	  l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
233124 continue
234    do 125, p = 1, 5
235      do 125, q = 4, 6
236	l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
237125 continue
238!$omp end parallel
239    if (l) STOP 1
240  end subroutine foo
241
242  subroutine test
243    character (len = 12) :: c
244    character (len = 7) :: d
245    integer, dimension (2, 3:5, 7) :: e
246    integer, dimension (2, 3:7, 7) :: f
247    character (len = 12), dimension (5, 3:7) :: g
248    character (len = 7), dimension (5, 3:7) :: h
249    real, dimension (3:5, 2:6, 1:7) :: i
250    double precision, dimension (3:6, 2:6, 1:7) :: j
251    integer, dimension (1:5, 7:7, 4:6) :: k
252    integer :: p, q, r
253    call foo (c, d, e, f, g, h, i, j, k, 7)
254  end subroutine test
255end
256