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    integer :: n
14    character (len = *) :: c
15    character (len = n) :: d
16    integer, dimension (2, 3:5, n) :: e
17    integer, dimension (2, 3:n, n) :: f
18    character (len = *), dimension (5, 3:n) :: g
19    character (len = n), dimension (5, 3:n) :: h
20    real, dimension (:, :, :) :: i
21    double precision, dimension (3:, 5:, 7:) :: j
22    integer, dimension (:, :, :) :: k
23    logical :: l
24    integer :: p, q, r
25    character (len = n) :: s
26    integer, dimension (2, 3:5, n) :: t
27    integer, dimension (2, 3:n, n) :: u
28    character (len = n), dimension (5, 3:n) :: v
29    character (len = 2 * n + 24) :: w
30    integer :: x
31    character (len = 1) :: y
32    l = .false.
33!$omp parallel default (none) private (c, d, e, f, g, h, i, j, k) &
34!$omp & private (s, t, u, v) reduction (.or.:l) num_threads (6) &
35!$omp private (p, q, r, w, x, y)
36    x = omp_get_thread_num ()
37    w = ''
38    if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0'
39    if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1'
40    if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2'
41    if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3'
42    if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4'
43    if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
44    c = w(8:19)
45    d = w(1:7)
46    forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r
47    forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r
48    forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19)
49    forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38)
50    forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7)
51    forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26)
52    forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r
53    forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r
54    forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r
55    s = w(20:26)
56    forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r
57    forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r
58    forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7)
59    forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26)
60!$omp barrier
61    y = ''
62    if (x .eq. 0) y = '0'
63    if (x .eq. 1) y = '1'
64    if (x .eq. 2) y = '2'
65    if (x .eq. 3) y = '3'
66    if (x .eq. 4) y = '4'
67    if (x .eq. 5) y = '5'
68    l = l .or. w(7:7) .ne. y
69    l = l .or. w(19:19) .ne. y
70    l = l .or. w(26:26) .ne. y
71    l = l .or. w(38:38) .ne. y
72    l = l .or. c .ne. w(8:19)
73    l = l .or. d .ne. w(1:7)
74    l = l .or. s .ne. w(20:26)
75    do 103, p = 1, 2
76      do 103, q = 3, 7
77	do 103, r = 1, 7
78	  if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
79	  l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
80	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
81	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
82	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
83	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
84	  if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
85	  l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
86	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
87	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
88103 continue
89    do 104, p = 3, 5
90      do 104, q = 2, 6
91	do 104, r = 1, 7
92	  l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
93	  l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
94104 continue
95    do 105, p = 1, 5
96      do 105, q = 4, 6
97	l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
98105 continue
99    call check (size (e, 1), 2, l)
100    call check (size (e, 2), 3, l)
101    call check (size (e, 3), 7, l)
102    call check (size (e), 42, l)
103    call check (size (f, 1), 2, l)
104    call check (size (f, 2), 5, l)
105    call check (size (f, 3), 7, l)
106    call check (size (f), 70, l)
107    call check (size (g, 1), 5, l)
108    call check (size (g, 2), 5, l)
109    call check (size (g), 25, l)
110    call check (size (h, 1), 5, l)
111    call check (size (h, 2), 5, l)
112    call check (size (h), 25, l)
113    call check (size (i, 1), 3, l)
114    call check (size (i, 2), 5, l)
115    call check (size (i, 3), 7, l)
116    call check (size (i), 105, l)
117    call check (size (j, 1), 4, l)
118    call check (size (j, 2), 5, l)
119    call check (size (j, 3), 7, l)
120    call check (size (j), 140, l)
121    call check (size (k, 1), 5, l)
122    call check (size (k, 2), 1, l)
123    call check (size (k, 3), 3, l)
124    call check (size (k), 15, l)
125!$omp end parallel
126    if (l) STOP 1
127  end subroutine foo
128
129  subroutine test
130    character (len = 12) :: c
131    character (len = 7) :: d
132    integer, dimension (2, 3:5, 7) :: e
133    integer, dimension (2, 3:7, 7) :: f
134    character (len = 12), dimension (5, 3:7) :: g
135    character (len = 7), dimension (5, 3:7) :: h
136    real, dimension (3:5, 2:6, 1:7) :: i
137    double precision, dimension (3:6, 2:6, 1:7) :: j
138    integer, dimension (1:5, 7:7, 4:6) :: k
139    integer :: p, q, r
140    call foo (c, d, e, f, g, h, i, j, k, 7)
141  end subroutine test
142end
143