libgomp/testsuite/libgomp.oacc-fortran/host_data-3.f

   1 ! Fixed-mode host_data interaction with CUDA BLAS.
   2
   3 ! { dg-do run { target openacc_nvidia_accel_selected } }
   4 ! { dg-additional-options "-lcublas -Wall -Wextra" }
   5 ! { dg-require-effective-target openacc_cublas }
   6
   7       include "cublas-fixed.h"
   8
   9       integer, parameter :: N = 10
  10       integer :: i
  11       real*4 :: x_ref(N), y_ref(N), x(N), y(N), a
  12
  13       a = 2.0
  14
  15       do i = 1, N
  16          x(i) = 4.0 * i
  17          y(i) = 3.0
  18          x_ref(i) = x(i)
  19          y_ref(i) = y(i)
  20       end do
  21
  22       call saxpy (N, a, x_ref, y_ref)
  23
  24 !$acc data copyin (x) copy (y)
  25 !$acc host_data use_device (x, y)
  26       call cublassaxpy(N, a, x, 1, y, 1)
  27 !$acc end host_data
  28 !$acc end data
  29
  30       call validate_results (N, y, y_ref)
  31
  32 !$acc data create (x) copyout (y)
  33 !$acc parallel loop
  34       do i = 1, N
  35          y(i) = 3.0
  36       end do
  37 !$acc end parallel loop
  38
  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       y(:) = 3.0
  47
  48 !$acc data copyin (x) copyin (a) copy (y)
  49 !$acc parallel present (x) pcopy (y) present (a)
  50       call saxpy (N, a, x, y)
  51 !$acc end parallel
  52 !$acc end data
  53
  54       call validate_results (N, y, y_ref)
  55
  56       y(:) = 3.0
  57
  58 !$acc enter data copyin (x, a, y)
  59 !$acc parallel present (x) pcopy (y) present (a)
  60       call saxpy (N, a, x, y)
  61 !$acc end parallel
  62 !$acc exit data delete (x, a) copyout (y)
  63
  64       call validate_results (N, y, y_ref)
  65       end
  66
  67       subroutine saxpy (nn, aa, xx, yy)
  68       integer :: nn
  69       real*4 :: aa, xx(nn), yy(nn)
  70       integer i
  71 !$acc routine
  72
  73       do i = 1, nn
  74          yy(i) = yy(i) + aa * xx(i)
  75       end do
  76       end subroutine saxpy
  77
  78       subroutine validate_results (n, a, b)
  79       integer :: n
  80       real*4 :: a(n), b(n)
  81
  82       do i = 1, N
  83          if (abs(a(i) - b(i)) > 0.0001) stop 1
  84       end do
  85       end subroutine validate_results
  86