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

   1 ! { dg-do run }
   2
   3 program 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   call acc_init (acc_device_default)
  19
  20   call set3d (.FALSE., a_3d_i, a_3d_c, a_3d_r)
  21
  22   call acc_copyin (a_3d_i)
  23   call acc_copyin (a_3d_c)
  24   call acc_copyin (a_3d_r)
  25
  26   if (acc_is_present (a_3d_i) .neqv. .TRUE.) STOP 1
  27   if (acc_is_present (a_3d_c) .neqv. .TRUE.) STOP 2
  28   if (acc_is_present (a_3d_r) .neqv. .TRUE.) STOP 3
  29
  30   do i = 1, 10
  31     do j = 1, 10
  32       do k = 1, 10
  33         if (acc_is_present (a_3d_i(i, j, k), i_size) .neqv. .TRUE.) STOP 4
  34         if (acc_is_present (a_3d_c(i, j, k), i_size) .neqv. .TRUE.) STOP 5
  35         if (acc_is_present (a_3d_r(i, j, k), i_size) .neqv. .TRUE.) STOP 6
  36       end do
  37     end do
  38   end do
  39
  40 contains
  41
  42   subroutine set3d (clear, a_i, a_c, a_r)
  43   logical clear
  44   integer, dimension (:,:,:), intent (inout) :: a_i
  45   complex, dimension (:,:,:), intent (inout) :: a_c
  46   real, dimension (:,:,:), intent (inout) :: a_r
  47
  48   integer i, j, k
  49   integer lb1, ub1, lb2, ub2, lb3, ub3
  50
  51   lb1 = lbound (a_i, 1)
  52   ub1 = ubound (a_i, 1)
  53
  54   lb2 = lbound (a_i, 2)
  55   ub2 = ubound (a_i, 2)
  56
  57   lb3 = lbound (a_i, 3)
  58   ub3 = ubound (a_i, 3)
  59
  60   do i = lb1, ub1
  61     do j = lb2, ub2
  62       do k = lb3, ub3
  63         if (clear) then
  64           a_i(i, j, k) = 0
  65           a_c(i, j, k) = cmplx (0.0, 0.0)
  66           a_r(i, j, k) = 0.0
  67         else
  68           a_i(i, j, k) = i
  69           a_c(i, j, k) = cmplx (i, j)
  70           a_r(i, j, k) = i
  71         end if
  72       end do
  73     end do
  74   end do
  75
  76   end subroutine
  77
  78 end program