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 8program 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) 79end program test 80 81subroutine 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 90end subroutine saxpy 91 92subroutine 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 99end subroutine validate_results 100