libgomp/testsuite/libgomp.oacc-fortran/no_create-2.f90

   1 ! { dg-do run }
   2
   3 ! Test no_create clause with data/parallel constructs.
   4
   5 program no_create
   6   use openacc
   7   implicit none
   8   logical :: shared_memory
   9   integer, parameter :: n = 512
  10   integer :: myvar, myarr(n)
  11   integer i
  12
  13   shared_memory = .false.
  14   !$acc kernels copyin (shared_memory)
  15   shared_memory = .true.
  16   !$acc end kernels
  17
  18   myvar = 55
  19   do i = 1, n
  20     myarr(i) = 0
  21   end do
  22
  23   call do_on_target(myvar, n, myarr)
  24
  25   if (shared_memory) then
  26      if (myvar .ne. 44) stop 10
  27   else
  28      if (myvar .ne. 33) stop 11
  29   end if
  30   do i = 1, n
  31     if (shared_memory) then
  32       if (myarr(i) .ne. i * 2) stop 20
  33     else
  34       if (myarr(i) .ne. i) stop 21
  35     end if
  36   end do
  37
  38   myvar = 55
  39   do i = 1, n
  40     myarr(i) = 0
  41   end do
  42
  43   !$acc enter data copyin(myvar, myarr)
  44   call do_on_target(myvar, n, myarr)
  45   !$acc exit data copyout(myvar, myarr)
  46
  47   if (myvar .ne. 44) stop 30
  48   do i = 1, n
  49     if (myarr(i) .ne. i * 2) stop 31
  50   end do
  51 end program no_create
  52
  53 subroutine do_on_target (var, n, arr)
  54   use openacc
  55   implicit none
  56   integer :: var, n, arr(n)
  57   integer :: i
  58
  59 !$acc data no_create (var, arr)
  60
  61 if (acc_is_present(var)) then
  62   ! The no_create clause is meant for partially shared-memory machines.  This
  63   ! test is written to work on non-shared-memory machines, though this is not
  64   ! necessarily a useful way to use the no_create clause in practice.
  65
  66   !$acc parallel !no_create (var)
  67    var = 44
  68   !$acc end parallel
  69 else
  70    var = 33
  71 end if
  72 if (acc_is_present(arr)) then
  73   ! The no_create clause is meant for partially shared-memory machines.  This
  74   ! test is written to work on non-shared-memory machines, though this is not
  75   ! necessarily a useful way to use the no_create clause in practice.
  76
  77   !$acc parallel loop !no_create (arr)
  78   do i = 1, n
  79     arr(i) = i * 2
  80   end do
  81   !$acc end parallel loop
  82 else
  83   do i = 1, n
  84     arr(i) = i
  85   end do
  86 end if
  87
  88 !$acc end data
  89
  90 end subroutine do_on_target