1! { dg-do run }
2! { dg-options "-std=legacy" }
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
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)
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 end parallel
127    if (l) stop 1
128  end subroutine foo
129
130  subroutine test
131    character (len = 12) :: c
132    character (len = 7) :: d
133    integer, dimension (2, 3:5, 7) :: e
134    integer, dimension (2, 3:7, 7) :: f
135    character (len = 12), dimension (5, 3:7) :: g
136    character (len = 7), dimension (5, 3:7) :: h
137    real, dimension (3:5, 2:6, 1:7) :: i
138    double precision, dimension (3:6, 2:6, 1:7) :: j
139    integer, dimension (1:5, 7:7, 4:6) :: k
140    integer :: p, q, r
141    call foo (c, d, e, f, g, h, i, j, k, 7)
142  end subroutine test
143end
144