libgomp/testsuite/libgomp.oacc-fortran/lib-8.f90

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