libgomp/testsuite/libgomp.fortran/examples-4/declare_target-4.f90

   1 ! { dg-do run }
   2
   3 module e_53_4_mod
   4   !$omp declare target (N, Q)
   5   integer, parameter :: N = 10
   6   real :: Q(N,N)
   7 contains
   8   real function Pfun (i, k)
   9     !$omp declare target
  10     integer, intent(in) :: i, k
  11     Pfun = (Q(i,k) * Q(k,i))
  12   end function
  13 end module
  14
  15 real function accum (k) result (tmp)
  16   use e_53_4_mod
  17   integer :: i, k
  18   tmp = 0.0e0
  19   !$omp target map(tmp)
  20     !$omp parallel do reduction(+:tmp)
  21     do i = 1, N
  22       tmp = tmp + Pfun (k, i)
  23     end do
  24   !$omp end target
  25 end function
  26
  27 real function accum_ref (k) result (tmp)
  28   use e_53_4_mod
  29   integer :: i, k
  30   tmp = 0.0e0
  31   do i = 1, N
  32     tmp = tmp + Pfun (k, i)
  33   end do
  34 end function
  35
  36 subroutine init ()
  37   use e_53_4_mod
  38   integer :: i, j
  39   do i = 1, N
  40     do j = 1, N
  41       Q(i,j) = 0.001 * i * j
  42     end do
  43   end do
  44 end subroutine
  45
  46 subroutine check (a, b)
  47   real :: a, b, err
  48   real, parameter :: EPS = 0.00001
  49   if (b == 0.0) then
  50     err = a
  51   else if (a == 0.0) then
  52     err = b
  53   else
  54     err = (a - b) / b
  55   end if
  56   if (err > EPS .or. err < -EPS) call abort
  57 end subroutine
  58
  59 program e_53_4
  60   use e_53_4_mod
  61   integer :: i
  62   real :: accum, accum_ref
  63   call init ()
  64   !$omp target update to(Q)
  65   do i = 1, N
  66     call check (accum (i), accum_ref (i))
  67   end do
  68 end program