Mercurial > hg > CbC > CbC_gcc
view libgomp/testsuite/libgomp.fortran/vla1.f90 @ 118:fd00160c1b76
ifdef TARGET_64BIT
author | mir3636 |
---|---|
date | Tue, 27 Feb 2018 15:01:35 +0900 |
parents | a06113de4d67 |
children | 84e7813d76e9 |
line wrap: on
line source
! { dg-do run } 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 s = 'PQRSTUV' forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + p - q + 2 * r forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - p + q - 2 * r forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = '_+|/Oo_' forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = '///|||!' l = .false. !$omp parallel default (none) firstprivate (c, d, e, f, g, h, i, j, k) & !$omp & firstprivate (s, t, u, v) reduction (.or.:l) num_threads (6) & !$omp private (p, q, r, w, x, y) l = l .or. c .ne. 'abcdefghijkl' l = l .or. d .ne. 'ABCDEFG' l = l .or. s .ne. 'PQRSTUV' do 100, p = 1, 2 do 100, q = 3, 7 do 100, r = 1, 7 if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 + p + q + 2 * r l = l .or. f(p, q, r) .ne. 25 + p + q + 2 * r if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. '0123456789AB' if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. '9876543210ZY' if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. '0123456' if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. '9876543' if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + p - q + 2 * r l = l .or. u(p, q, r) .ne. 30 - p + q - 2 * r if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. '_+|/Oo_' if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. '///|||!' 100 continue do 101, p = 3, 5 do 101, q = 2, 6 do 101, r = 1, 7 l = l .or. i(p - 2, q - 1, r) .ne. 7.5 * p * q * r l = l .or. j(p, q + 3, r + 6) .ne. 9.5 * p * q * r 101 continue do 102, p = 1, 5 do 102, q = 4, 6 l = l .or. k(p, 1, q - 3) .ne. 19 + p + 7 + 3 * q 102 continue 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) call abort 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 c = 'abcdefghijkl' d = 'ABCDEFG' forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 + p + q + 2 * r forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 + p + q + 2 * r forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = '0123456789AB' forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = '9876543210ZY' forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = '0123456' forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = '9876543' forall (p = 3:5, q = 2:6, r = 1:7) i(p, q, r) = 7.5 * p * q * r forall (p = 3:6, q = 2:6, r = 1:7) j(p, q, r) = 9.5 * p * q * r forall (p = 1:5, q = 7:7, r = 4:6) k(p, q, r) = 19 + p + q + 3 * r call foo (c, d, e, f, g, h, i, j, k, 7) end subroutine test end