| ! { dg-do run } |
| ! { dg-options "-std=legacy" } |
| |
| call test |
| contains |
| subroutine check (x, y, l) |
| integer :: x, y |
| logical :: l |
| l = l .or. x .ne. y |
| end subroutine check |
| |
| subroutine foo (c, d, e, f, g, h, i, j, k, n) |
| use omp_lib |
| integer :: n |
| character (len = *) :: c |
| character (len = n) :: d |
| integer, dimension (2, 3:5, n) :: e |
| integer, dimension (2, 3:n, n) :: f |
| character (len = *), dimension (5, 3:n) :: g |
| character (len = n), dimension (5, 3:n) :: h |
| real, dimension (:, :, :) :: i |
| double precision, dimension (3:, 5:, 7:) :: j |
| integer, dimension (:, :, :) :: k |
| logical :: l |
| integer :: p, q, r |
| character (len = n) :: s |
| integer, dimension (2, 3:5, n) :: t |
| integer, dimension (2, 3:n, n) :: u |
| character (len = n), dimension (5, 3:n) :: v |
| character (len = 2 * n + 24) :: w |
| integer :: x |
| character (len = 1) :: y |
| l = .false. |
| !$omp parallel default (none) private (c, d, e, f, g, h, i, j, k) & |
| !$omp & private (s, t, u, v) reduction (.or.:l) num_threads (6) & |
| !$omp private (p, q, r, w, x, y) |
| x = omp_get_thread_num () |
| w = '' |
| if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0' |
| if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1' |
| if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2' |
| if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3' |
| if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4' |
| if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5' |
| c = w(8:19) |
| d = w(1:7) |
| forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r |
| forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r |
| forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19) |
| forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38) |
| forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7) |
| forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26) |
| forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r |
| forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r |
| forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r |
| s = w(20:26) |
| forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r |
| forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r |
| forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7) |
| forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26) |
| !$omp barrier |
| y = '' |
| if (x .eq. 0) y = '0' |
| if (x .eq. 1) y = '1' |
| if (x .eq. 2) y = '2' |
| if (x .eq. 3) y = '3' |
| if (x .eq. 4) y = '4' |
| if (x .eq. 5) y = '5' |
| l = l .or. w(7:7) .ne. y |
| l = l .or. w(19:19) .ne. y |
| l = l .or. w(26:26) .ne. y |
| l = l .or. w(38:38) .ne. y |
| l = l .or. c .ne. w(8:19) |
| l = l .or. d .ne. w(1:7) |
| l = l .or. s .ne. w(20:26) |
| do 103, p = 1, 2 |
| do 103, q = 3, 7 |
| do 103, r = 1, 7 |
| if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r |
| l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r |
| if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19) |
| if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38) |
| if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7) |
| if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26) |
| if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r |
| l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r |
| if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7) |
| if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26) |
| 103 continue |
| do 104, p = 3, 5 |
| do 104, q = 2, 6 |
| do 104, r = 1, 7 |
| l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r |
| l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r |
| 104 continue |
| do 105, p = 1, 5 |
| do 105, q = 4, 6 |
| l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q |
| 105 continue |
| call check (size (e, 1), 2, l) |
| call check (size (e, 2), 3, l) |
| call check (size (e, 3), 7, l) |
| call check (size (e), 42, l) |
| call check (size (f, 1), 2, l) |
| call check (size (f, 2), 5, l) |
| call check (size (f, 3), 7, l) |
| call check (size (f), 70, l) |
| call check (size (g, 1), 5, l) |
| call check (size (g, 2), 5, l) |
| call check (size (g), 25, l) |
| call check (size (h, 1), 5, l) |
| call check (size (h, 2), 5, l) |
| call check (size (h), 25, l) |
| call check (size (i, 1), 3, l) |
| call check (size (i, 2), 5, l) |
| call check (size (i, 3), 7, l) |
| call check (size (i), 105, l) |
| call check (size (j, 1), 4, l) |
| call check (size (j, 2), 5, l) |
| call check (size (j, 3), 7, l) |
| call check (size (j), 140, l) |
| call check (size (k, 1), 5, l) |
| call check (size (k, 2), 1, l) |
| call check (size (k, 3), 3, l) |
| call check (size (k), 15, l) |
| !$omp end parallel |
| if (l) stop 1 |
| end subroutine foo |
| |
| subroutine test |
| character (len = 12) :: c |
| character (len = 7) :: d |
| integer, dimension (2, 3:5, 7) :: e |
| integer, dimension (2, 3:7, 7) :: f |
| character (len = 12), dimension (5, 3:7) :: g |
| character (len = 7), dimension (5, 3:7) :: h |
| real, dimension (3:5, 2:6, 1:7) :: i |
| double precision, dimension (3:6, 2:6, 1:7) :: j |
| integer, dimension (1:5, 7:7, 4:6) :: k |
| integer :: p, q, r |
| call foo (c, d, e, f, g, h, i, j, k, 7) |
| end subroutine test |
| end |
