libgomp/testsuite/libgomp.oacc-fortran/kernels-map-1.f90

   1 ! Test the copy, copyin, copyout, pcopy, pcopyin, pcopyout, and pcreate
   2 ! clauses on kernels constructs.
   3
   4 ! { dg-do run }
   5
   6 program map
   7   integer, parameter     :: n = 20, c = 10
   8   integer                :: i, a(n), b(n), d(n)
   9
  10   a(:) = 0
  11   b(:) = 0
  12
  13   ! COPY
  14
  15   !$acc kernels copy (a)
  16   !$acc loop
  17   do i = 1, n
  18      a(i) = i
  19   end do
  20   !$acc end kernels
  21
  22   do i = 1, n
  23      b(i) = i
  24   end do
  25
  26   call check (a, b, n)
  27
  28   ! COPYOUT
  29
  30   a(:) = 0
  31
  32   !$acc kernels copyout (a)
  33   !$acc loop
  34   do i = 1, n
  35      a(i) = i
  36   end do
  37   !$acc end kernels
  38
  39   do i = 1, n
  40      if (a(i) .ne. b(i)) call abort
  41   end do
  42   call check (a, b, n)
  43
  44   ! COPYIN
  45
  46   a(:) = 0
  47
  48   !$acc kernels copyout (a) copyin (b)
  49   !$acc loop
  50   do i = 1, n
  51      a(i) = i
  52   end do
  53   !$acc end kernels
  54
  55   call check (a, b, n)
  56
  57   ! PRESENT_OR_COPY
  58
  59   !$acc kernels pcopy (a)
  60   !$acc loop
  61   do i = 1, n
  62      a(i) = i
  63   end do
  64   !$acc end kernels
  65
  66   call check (a, b, n)
  67
  68   ! PRESENT_OR_COPYOUT
  69
  70   a(:) = 0
  71
  72   !$acc kernels pcopyout (a)
  73   !$acc loop
  74   do i = 1, n
  75      a(i) = i
  76   end do
  77   !$acc end kernels
  78
  79   call check (a, b, n)
  80
  81   ! PRESENT_OR_COPYIN
  82
  83   a(:) = 0
  84
  85   !$acc kernels pcopyout (a) pcopyin (b)
  86   !$acc loop
  87   do i = 1, n
  88      a(i) = i
  89   end do
  90   !$acc end kernels
  91
  92   call check (a, b, n)
  93
  94   ! PRESENT_OR_CREATE
  95
  96   a(:) = 0
  97
  98   !$acc kernels pcopyout (a) pcreate (d)
  99   !$acc loop
 100   do i = 1, n
 101      d(i) = i
 102      a(i) = d(i)
 103   end do
 104   !$acc end kernels
 105
 106   call check (a, b, n)
 107 end program map
 108
 109 subroutine check (a, b, n)
 110   integer :: n, a(n), b(n)
 111   integer :: i
 112
 113   do i = 1, n
 114      if (a(i) .ne. b(i)) call abort
 115   end do
 116 end subroutine check