libgomp/testsuite/libgomp.fortran/examples-4/e.53.5.f90

   1 ! { dg-do run { target vect_simd_clones } }
   2 ! { dg-options "-O2" }
   3 ! { dg-additional-options "-msse2" { target sse2_runtime } }
   4 ! { dg-additional-options "-mavx" { target avx_runtime } }
   5
   6 module e_53_5_mod
   7   !$omp declare target (N, Q)
   8   integer, parameter :: N = 10000, M = 1024
   9   real :: Q(N,N)
  10 contains
  11   real function Pfun (k, i)
  12     !$omp declare simd(Pfun) uniform(i) linear(k) notinbranch
  13     !$omp declare target
  14     integer, value, intent(in) :: i, k
  15     Pfun = (Q(k,i) * Q(i,k))
  16   end function
  17 end module
  18
  19 real function accum () result (tmp)
  20   use e_53_5_mod
  21   real :: tmp1
  22   integer :: i
  23   tmp = 0.0e0
  24   !$omp target
  25     !$omp parallel do private(tmp1) reduction(+:tmp)
  26     do i = 1, N
  27       tmp1 = 0.0e0
  28       !$omp simd reduction(+:tmp1)
  29       do k = 1, M
  30         tmp1 = tmp1 + Pfun (k, i)
  31       end do
  32       tmp = tmp + tmp1
  33     end do
  34   !$omp end target
  35 end function
  36
  37 real function accum_ref () result (tmp)
  38   use e_53_5_mod
  39   real :: tmp1
  40   integer :: i
  41   tmp = 0.0e0
  42   do i = 1, N
  43     tmp1 = 0.0e0
  44     do k = 1, M
  45       tmp1 = tmp1 + Pfun (k, i)
  46     end do
  47     tmp = tmp + tmp1
  48   end do
  49 end function
  50
  51 subroutine init ()
  52   use e_53_5_mod
  53   integer :: i, j
  54   do i = 1, N
  55     do j = 1, N
  56       Q(i,j) = 0.001 * i * j
  57     end do
  58   end do
  59 end subroutine
  60
  61 subroutine check (a, b)
  62   real :: a, b, err
  63   real, parameter :: EPS = 0.00001
  64   if (b == 0.0) then
  65     err = a
  66   else if (a == 0.0) then
  67     err = b
  68   else
  69     err = (a - b) / b
  70   end if
  71   if (err > EPS .or. err < -EPS) call abort
  72 end subroutine
  73
  74 program e_53_5
  75   use e_53_5_mod
  76   real :: accum, accum_ref, d
  77   call init ()
  78   !$omp target update to(Q)
  79   call check (accum (), accum_ref ())
  80 end program