1! { dg-do run }
2
3program main
4  implicit none
5  include "openacc_lib.h"
6
7  integer, target :: a_3d_i(10, 10, 10)
8  complex a_3d_c(10, 10, 10)
9  real a_3d_r(10, 10, 10)
10
11  integer i, j, k
12  complex c
13  real r
14  integer, parameter :: i_size = sizeof (i)
15  integer, parameter :: c_size = sizeof (c)
16  integer, parameter :: r_size = sizeof (r)
17
18  if (acc_get_num_devices (acc_device_nvidia) .eq. 0) call exit
19
20  call acc_init (acc_device_nvidia)
21
22  call set3d (.FALSE., a_3d_i, a_3d_c, a_3d_r)
23
24  call acc_copyin (a_3d_i)
25  call acc_copyin (a_3d_c)
26  call acc_copyin (a_3d_r)
27
28  if (acc_is_present (a_3d_i) .neqv. .TRUE.) STOP 1
29  if (acc_is_present (a_3d_c) .neqv. .TRUE.) STOP 2
30  if (acc_is_present (a_3d_r) .neqv. .TRUE.) STOP 3
31
32  do i = 1, 10
33    do j = 1, 10
34      do k = 1, 10
35        if (acc_is_present (a_3d_i(i, j, k), i_size) .neqv. .TRUE.) STOP 4
36        if (acc_is_present (a_3d_c(i, j, k), i_size) .neqv. .TRUE.) STOP 5
37        if (acc_is_present (a_3d_r(i, j, k), i_size) .neqv. .TRUE.) STOP 6
38      end do
39    end do
40  end do
41
42  call acc_shutdown (acc_device_nvidia)
43
44contains
45
46  subroutine set3d (clear, a_i, a_c, a_r)
47  logical clear
48  integer, dimension (:,:,:), intent (inout) :: a_i
49  complex, dimension (:,:,:), intent (inout) :: a_c
50  real, dimension (:,:,:), intent (inout) :: a_r
51
52  integer i, j, k
53  integer lb1, ub1, lb2, ub2, lb3, ub3
54
55  lb1 = lbound (a_i, 1)
56  ub1 = ubound (a_i, 1)
57
58  lb2 = lbound (a_i, 2)
59  ub2 = ubound (a_i, 2)
60
61  lb3 = lbound (a_i, 3)
62  ub3 = ubound (a_i, 3)
63
64  do i = lb1, ub1
65    do j = lb2, ub2
66      do k = lb3, ub3
67        if (clear) then
68          a_i(i, j, k) = 0
69          a_c(i, j, k) = cmplx (0.0, 0.0)
70          a_r(i, j, k) = 0.0
71        else
72          a_i(i, j, k) = i
73          a_c(i, j, k) = cmplx (i, j)
74          a_r(i, j, k) = i
75        end if
76      end do
77    end do
78  end do
79
80  end subroutine
81
82end program
83