Mercurial > hg > CbC > CbC_gcc
view libgomp/testsuite/libgomp.fortran/task2.f90 @ 158:494b0b89df80 default tip
...
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Mon, 25 May 2020 18:13:55 +0900 |
parents | 1830386684a0 |
children |
line wrap: on
line source
! { dg-do run } ! { dg-options "-std=legacy" } integer :: err err = 0 !$omp parallel num_threads (4) default (none) shared (err) !$omp single call test !$omp end single !$omp end parallel if (err.ne.0) stop 1 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, z 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) = '///|||!' !$omp task default (none) firstprivate (c, d, e, f, g, h, i, j, k) & !$omp & firstprivate (s, t, u, v) private (l, p, q, r, w, x, y) shared (err) l = .false. 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 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) if (l) then !$omp atomic err = err + 1 end if !$omp end task c = '' d = '' e(:, :, :) = 199 f(:, :, :) = 198 g(:, :) = '' h(:, :) = '' i(:, :, :) = 7.0 j(:, :, :) = 8.0 k(:, :, :) = 9 s = '' t(:, :, :) = 10 u(:, :, :) = 11 v(:, :) = '' 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