libgomp/testsuite/libgomp.fortran/examples-4/async_target-1.f90

   1 ! { dg-do run }
   2
   3 module e_55_1_mod
   4   integer, parameter :: N = 100000, CHUNKSZ = 10000
   5   real :: Y(N), Z(N)
   6 end module
   7
   8 subroutine init ()
   9   use e_55_1_mod, only : Y, Z, N
  10   integer :: i
  11   do i = 1, N
  12     Y(i) = 0.1 * i
  13     Z(i) = Y(i)
  14   end do
  15 end subroutine
  16
  17 subroutine check ()
  18   use e_55_1_mod, only : Y, Z, N
  19   real :: err
  20   real, parameter :: EPS = 0.00001
  21   integer :: i
  22   do i = 1, N
  23     if (Y(i) == 0.0) then
  24       err = Z(i)
  25     else if (Z(i) == 0.0) then
  26       err = Y(i)
  27     else
  28       err = (Y(i) - Z(i)) / Z(i)
  29     end if
  30     if (err > EPS .or. err < -EPS) STOP 1
  31   end do
  32 end subroutine
  33
  34 real function F (z)
  35   !$omp declare target
  36   real, intent(in) :: z
  37   F = -z
  38 end function
  39
  40 subroutine pipedF ()
  41   use e_55_1_mod, only: Z, N, CHUNKSZ
  42   integer :: C, i
  43   real :: F
  44   do C = 1, N, CHUNKSZ
  45     !$omp task
  46       !$omp target map(Z(C:C+CHUNKSZ-1))
  47         !$omp parallel do
  48         do i = C, C+CHUNKSZ-1
  49           Z(i) = F (Z(i))
  50         end do
  51       !$omp end target
  52     !$omp end task
  53   end do
  54 end subroutine
  55
  56 subroutine pipedF_ref ()
  57   use e_55_1_mod, only: Y, N
  58   integer :: i
  59   real :: F
  60   do i = 1, N
  61     Y(i) = F (Y(i))
  62   end do
  63 end subroutine
  64
  65 program e_55_1
  66   call init ()
  67   call pipedF ()
  68   call pipedF_ref ()
  69   call check ()
  70 end program