| 1 |
735 |
jeremybenn |
! { dg-do run }
|
| 2 |
|
|
|
| 3 |
|
|
call test
|
| 4 |
|
|
contains
|
| 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, z, z2
|
| 31 |
|
|
character (len = 1) :: y
|
| 32 |
|
|
s = 'PQRSTUV'
|
| 33 |
|
|
forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + p - q + 2 * r
|
| 34 |
|
|
forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - p + q - 2 * r
|
| 35 |
|
|
forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = '_+|/Oo_'
|
| 36 |
|
|
forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = '///|||!'
|
| 37 |
|
|
l = .false.
|
| 38 |
|
|
call omp_set_dynamic (.false.)
|
| 39 |
|
|
call omp_set_num_threads (6)
|
| 40 |
|
|
!$omp parallel do default (none) firstprivate (c, d, e, f, g, h, i, j, k) &
|
| 41 |
|
|
!$omp & firstprivate (s, t, u, v) reduction (.or.:l) num_threads (6) &
|
| 42 |
|
|
!$omp private (p, q, r, w, x, y) schedule (static) shared (z2) &
|
| 43 |
|
|
!$omp lastprivate (c, d, e, f, g, h, i, j, k, s, t, u, v)
|
| 44 |
|
|
do 110 z = 0, omp_get_num_threads () - 1
|
| 45 |
|
|
if (omp_get_thread_num () .eq. 0) z2 = omp_get_num_threads ()
|
| 46 |
|
|
l = l .or. c .ne. 'abcdefghijkl'
|
| 47 |
|
|
l = l .or. d .ne. 'ABCDEFG'
|
| 48 |
|
|
l = l .or. s .ne. 'PQRSTUV'
|
| 49 |
|
|
do 100, p = 1, 2
|
| 50 |
|
|
do 100, q = 3, 7
|
| 51 |
|
|
do 100, r = 1, 7
|
| 52 |
|
|
if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 + p + q + 2 * r
|
| 53 |
|
|
l = l .or. f(p, q, r) .ne. 25 + p + q + 2 * r
|
| 54 |
|
|
if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. '0123456789AB'
|
| 55 |
|
|
if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. '9876543210ZY'
|
| 56 |
|
|
if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. '0123456'
|
| 57 |
|
|
if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. '9876543'
|
| 58 |
|
|
if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + p - q + 2 * r
|
| 59 |
|
|
l = l .or. u(p, q, r) .ne. 30 - p + q - 2 * r
|
| 60 |
|
|
if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. '_+|/Oo_'
|
| 61 |
|
|
if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. '///|||!'
|
| 62 |
|
|
100 continue
|
| 63 |
|
|
do 101, p = 3, 5
|
| 64 |
|
|
do 101, q = 2, 6
|
| 65 |
|
|
do 101, r = 1, 7
|
| 66 |
|
|
l = l .or. i(p - 2, q - 1, r) .ne. 7.5 * p * q * r
|
| 67 |
|
|
l = l .or. j(p, q + 3, r + 6) .ne. 9.5 * p * q * r
|
| 68 |
|
|
101 continue
|
| 69 |
|
|
do 102, p = 1, 5
|
| 70 |
|
|
do 102, q = 4, 6
|
| 71 |
|
|
l = l .or. k(p, 1, q - 3) .ne. 19 + p + 7 + 3 * q
|
| 72 |
|
|
102 continue
|
| 73 |
|
|
x = omp_get_thread_num ()
|
| 74 |
|
|
w = ''
|
| 75 |
|
|
if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0'
|
| 76 |
|
|
if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1'
|
| 77 |
|
|
if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2'
|
| 78 |
|
|
if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3'
|
| 79 |
|
|
if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4'
|
| 80 |
|
|
if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
|
| 81 |
|
|
c = w(8:19)
|
| 82 |
|
|
d = w(1:7)
|
| 83 |
|
|
forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r
|
| 84 |
|
|
forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r
|
| 85 |
|
|
forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19)
|
| 86 |
|
|
forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38)
|
| 87 |
|
|
forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7)
|
| 88 |
|
|
forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26)
|
| 89 |
|
|
forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r
|
| 90 |
|
|
forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r
|
| 91 |
|
|
forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r
|
| 92 |
|
|
s = w(20:26)
|
| 93 |
|
|
forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r
|
| 94 |
|
|
forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r
|
| 95 |
|
|
forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7)
|
| 96 |
|
|
forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26)
|
| 97 |
|
|
!$omp barrier ! { dg-warning "may not be closely nested" }
|
| 98 |
|
|
y = ''
|
| 99 |
|
|
if (x .eq. 0) y = '0'
|
| 100 |
|
|
if (x .eq. 1) y = '1'
|
| 101 |
|
|
if (x .eq. 2) y = '2'
|
| 102 |
|
|
if (x .eq. 3) y = '3'
|
| 103 |
|
|
if (x .eq. 4) y = '4'
|
| 104 |
|
|
if (x .eq. 5) y = '5'
|
| 105 |
|
|
l = l .or. w(7:7) .ne. y
|
| 106 |
|
|
l = l .or. w(19:19) .ne. y
|
| 107 |
|
|
l = l .or. w(26:26) .ne. y
|
| 108 |
|
|
l = l .or. w(38:38) .ne. y
|
| 109 |
|
|
l = l .or. c .ne. w(8:19)
|
| 110 |
|
|
l = l .or. d .ne. w(1:7)
|
| 111 |
|
|
l = l .or. s .ne. w(20:26)
|
| 112 |
|
|
do 103, p = 1, 2
|
| 113 |
|
|
do 103, q = 3, 7
|
| 114 |
|
|
do 103, r = 1, 7
|
| 115 |
|
|
if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
|
| 116 |
|
|
l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
|
| 117 |
|
|
if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
|
| 118 |
|
|
if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
|
| 119 |
|
|
if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
|
| 120 |
|
|
if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
|
| 121 |
|
|
if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
|
| 122 |
|
|
l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
|
| 123 |
|
|
if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
|
| 124 |
|
|
if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
|
| 125 |
|
|
103 continue
|
| 126 |
|
|
do 104, p = 3, 5
|
| 127 |
|
|
do 104, q = 2, 6
|
| 128 |
|
|
do 104, r = 1, 7
|
| 129 |
|
|
l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
|
| 130 |
|
|
l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
|
| 131 |
|
|
104 continue
|
| 132 |
|
|
do 105, p = 1, 5
|
| 133 |
|
|
do 105, q = 4, 6
|
| 134 |
|
|
l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
|
| 135 |
|
|
105 continue
|
| 136 |
|
|
call check (size (e, 1), 2, l)
|
| 137 |
|
|
call check (size (e, 2), 3, l)
|
| 138 |
|
|
call check (size (e, 3), 7, l)
|
| 139 |
|
|
call check (size (e), 42, l)
|
| 140 |
|
|
call check (size (f, 1), 2, l)
|
| 141 |
|
|
call check (size (f, 2), 5, l)
|
| 142 |
|
|
call check (size (f, 3), 7, l)
|
| 143 |
|
|
call check (size (f), 70, l)
|
| 144 |
|
|
call check (size (g, 1), 5, l)
|
| 145 |
|
|
call check (size (g, 2), 5, l)
|
| 146 |
|
|
call check (size (g), 25, l)
|
| 147 |
|
|
call check (size (h, 1), 5, l)
|
| 148 |
|
|
call check (size (h, 2), 5, l)
|
| 149 |
|
|
call check (size (h), 25, l)
|
| 150 |
|
|
call check (size (i, 1), 3, l)
|
| 151 |
|
|
call check (size (i, 2), 5, l)
|
| 152 |
|
|
call check (size (i, 3), 7, l)
|
| 153 |
|
|
call check (size (i), 105, l)
|
| 154 |
|
|
call check (size (j, 1), 4, l)
|
| 155 |
|
|
call check (size (j, 2), 5, l)
|
| 156 |
|
|
call check (size (j, 3), 7, l)
|
| 157 |
|
|
call check (size (j), 140, l)
|
| 158 |
|
|
call check (size (k, 1), 5, l)
|
| 159 |
|
|
call check (size (k, 2), 1, l)
|
| 160 |
|
|
call check (size (k, 3), 3, l)
|
| 161 |
|
|
call check (size (k), 15, l)
|
| 162 |
|
|
110 continue
|
| 163 |
|
|
!$omp end parallel do
|
| 164 |
|
|
if (l) call abort
|
| 165 |
|
|
if (z2 == 6) then
|
| 166 |
|
|
x = 5
|
| 167 |
|
|
w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
|
| 168 |
|
|
y = '5'
|
| 169 |
|
|
l = l .or. w(7:7) .ne. y
|
| 170 |
|
|
l = l .or. w(19:19) .ne. y
|
| 171 |
|
|
l = l .or. w(26:26) .ne. y
|
| 172 |
|
|
l = l .or. w(38:38) .ne. y
|
| 173 |
|
|
l = l .or. c .ne. w(8:19)
|
| 174 |
|
|
l = l .or. d .ne. w(1:7)
|
| 175 |
|
|
l = l .or. s .ne. w(20:26)
|
| 176 |
|
|
do 113, p = 1, 2
|
| 177 |
|
|
do 113, q = 3, 7
|
| 178 |
|
|
do 113, r = 1, 7
|
| 179 |
|
|
if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
|
| 180 |
|
|
l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
|
| 181 |
|
|
if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
|
| 182 |
|
|
if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
|
| 183 |
|
|
if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
|
| 184 |
|
|
if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
|
| 185 |
|
|
if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
|
| 186 |
|
|
l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
|
| 187 |
|
|
if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
|
| 188 |
|
|
if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
|
| 189 |
|
|
113 continue
|
| 190 |
|
|
do 114, p = 3, 5
|
| 191 |
|
|
do 114, q = 2, 6
|
| 192 |
|
|
do 114, r = 1, 7
|
| 193 |
|
|
l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
|
| 194 |
|
|
l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
|
| 195 |
|
|
114 continue
|
| 196 |
|
|
do 115, p = 1, 5
|
| 197 |
|
|
do 115, q = 4, 6
|
| 198 |
|
|
l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
|
| 199 |
|
|
115 continue
|
| 200 |
|
|
if (l) call abort
|
| 201 |
|
|
end if
|
| 202 |
|
|
end subroutine foo
|
| 203 |
|
|
|
| 204 |
|
|
subroutine test
|
| 205 |
|
|
character (len = 12) :: c
|
| 206 |
|
|
character (len = 7) :: d
|
| 207 |
|
|
integer, dimension (2, 3:5, 7) :: e
|
| 208 |
|
|
integer, dimension (2, 3:7, 7) :: f
|
| 209 |
|
|
character (len = 12), dimension (5, 3:7) :: g
|
| 210 |
|
|
character (len = 7), dimension (5, 3:7) :: h
|
| 211 |
|
|
real, dimension (3:5, 2:6, 1:7) :: i
|
| 212 |
|
|
double precision, dimension (3:6, 2:6, 1:7) :: j
|
| 213 |
|
|
integer, dimension (1:5, 7:7, 4:6) :: k
|
| 214 |
|
|
integer :: p, q, r
|
| 215 |
|
|
c = 'abcdefghijkl'
|
| 216 |
|
|
d = 'ABCDEFG'
|
| 217 |
|
|
forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 + p + q + 2 * r
|
| 218 |
|
|
forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 + p + q + 2 * r
|
| 219 |
|
|
forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = '0123456789AB'
|
| 220 |
|
|
forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = '9876543210ZY'
|
| 221 |
|
|
forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = '0123456'
|
| 222 |
|
|
forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = '9876543'
|
| 223 |
|
|
forall (p = 3:5, q = 2:6, r = 1:7) i(p, q, r) = 7.5 * p * q * r
|
| 224 |
|
|
forall (p = 3:6, q = 2:6, r = 1:7) j(p, q, r) = 9.5 * p * q * r
|
| 225 |
|
|
forall (p = 1:5, q = 7:7, r = 4:6) k(p, q, r) = 19 + p + q + 3 * r
|
| 226 |
|
|
call foo (c, d, e, f, g, h, i, j, k, 7)
|
| 227 |
|
|
end subroutine test
|
| 228 |
|
|
end
|
