libgomp/testsuite/libgomp.oacc-fortran/no_create-3.F90

   1 ! { dg-do run }
   2
   3 program main
   4   use iso_c_binding, only: c_sizeof
   5   use openacc, only: acc_is_present
   6   implicit none
   7   integer i
   8   integer, parameter :: n = 100
   9   real*4 b(n), c(n)
  10   real :: d(n), e(n)
  11   common /BLOCK/ d, e
  12
  13   !$acc enter data create(b) create(d)
  14
  15   if (.not. acc_is_present(b, c_sizeof(b))) stop 1
  16   if (.not. acc_is_present(d, c_sizeof(d))) stop 2
  17 #if !ACC_MEM_SHARED
  18   if (acc_is_present(c, 1) .or. acc_is_present(c, c_sizeof(c))) stop 3
  19   if (acc_is_present(e, 1) .or. acc_is_present(e, c_sizeof(d))) stop 4
  20 #endif
  21
  22   !$acc parallel loop no_create(b) no_create(c) no_create(/BLOCK/)
  23   do i = 1, n
  24      b(i) = i
  25      d(i) = -i
  26   end do
  27   !$acc end parallel loop
  28
  29   if (.not. acc_is_present(b, c_sizeof(b))) stop 5
  30   if (.not. acc_is_present(d, c_sizeof(d))) stop 6
  31 #if !ACC_MEM_SHARED
  32   if (acc_is_present(c, 1) .or. acc_is_present(c, c_sizeof(c))) stop 7
  33   if (acc_is_present(e, 1) .or. acc_is_present(e, c_sizeof(e))) stop 8
  34 #endif
  35
  36   !$acc exit data copyout(b) copyout(d)
  37   if (any(abs(b - [(real(i), i = 1, n)]) > 10*epsilon(b))) stop 9
  38   if (any(abs(d - [(real(-i), i = 1, n)]) > 10*epsilon(d))) stop 10
  39 end program main