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