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