libgomp/testsuite/libgomp.oacc-fortran/host_data-2.f90

   1 ! Test host_data interoperability with CUDA blas.  This test was
   2 ! derived from libgomp.oacc-c-c++-common/host_data-1.c.
   3
   4 ! { dg-do run { target openacc_nvidia_accel_selected } }
   5 ! { dg-additional-options "-lcublas -Wall -Wextra" }
   6 ! { dg-require-effective-target openacc_cublas }
   7
   8 program test
   9   implicit none
  10
  11   integer, parameter :: N = 10
  12   integer :: i
  13   real*4 :: x_ref(N), y_ref(N), x(N), y(N), a
  14
  15   interface
  16      subroutine cublassaxpy(N, alpha, x, incx, y, incy) bind(c, name="cublasSaxpy")
  17        use iso_c_binding
  18        integer(kind=c_int), value :: N
  19        real(kind=c_float), value :: alpha
  20        type(*), dimension(*) :: x
  21        integer(kind=c_int), value :: incx
  22        type(*), dimension(*) :: y
  23        integer(kind=c_int), value :: incy
  24      end subroutine cublassaxpy
  25   end interface
  26
  27   a = 2.0
  28
  29   do i = 1, N
  30      x(i) = 4.0 * i
  31      y(i) = 3.0
  32      x_ref(i) = x(i)
  33      y_ref(i) = y(i)
  34   end do
  35
  36   call saxpy (N, a, x_ref, y_ref)
  37
  38   !$acc data copyin (x) copy (y)
  39   !$acc host_data use_device (x, y)
  40   call cublassaxpy(N, a, x, 1, y, 1)
  41   !$acc end host_data
  42   !$acc end data
  43
  44   call validate_results (N, y, y_ref)
  45
  46   !$acc data create (x) copyout (y)
  47   !$acc parallel loop
  48   do i = 1, N
  49      y(i) = 3.0
  50   end do
  51   !$acc end parallel loop
  52
  53   !$acc host_data use_device (x, y)
  54   call cublassaxpy(N, a, x, 1, y, 1)
  55   !$acc end host_data
  56   !$acc end data
  57
  58   call validate_results (N, y, y_ref)
  59
  60   y(:) = 3.0
  61
  62   !$acc data copyin (x) copyin (a) copy (y)
  63   !$acc parallel present (x) pcopy (y) present (a)
  64   call saxpy (N, a, x, y)
  65   !$acc end parallel
  66   !$acc end data
  67
  68   call validate_results (N, y, y_ref)
  69
  70   y(:) = 3.0
  71
  72   !$acc enter data copyin (x, a, y)
  73   !$acc parallel present (x) pcopy (y) present (a)
  74   call saxpy (N, a, x, y)
  75   !$acc end parallel
  76   !$acc exit data delete (x, a) copyout (y)
  77
  78   call validate_results (N, y, y_ref)
  79 end program test
  80
  81 subroutine saxpy (nn, aa, xx, yy)
  82   integer :: nn
  83   real*4 :: aa, xx(nn), yy(nn)
  84   integer i
  85   !$acc routine
  86
  87   do i = 1, nn
  88     yy(i) = yy(i) + aa * xx(i)
  89   end do
  90 end subroutine saxpy
  91
  92 subroutine validate_results (n, a, b)
  93   integer :: n
  94   real*4 :: a(n), b(n)
  95
  96   do i = 1, N
  97      if (abs(a(i) - b(i)) > 0.0001) stop 1
  98   end do
  99 end subroutine validate_results