libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90

   1 ! { dg-do run  { target openacc_nvidia_accel_selected } }
   2
   3 module vars
   4   implicit none
   5   integer z
   6   !$acc declare create (z)
   7 end module vars
   8
   9 subroutine subr6 (a, d)
  10   implicit none
  11   integer, parameter :: N = 8
  12   integer :: i
  13   integer :: a(N)
  14   !$acc declare deviceptr (a)
  15   integer :: d(N)
  16
  17   i = 0
  18
  19   !$acc parallel copy (d)
  20     do i = 1, N
  21       d(i) = a(i) + a(i)
  22     end do
  23   !$acc end parallel
  24
  25 end subroutine
  26
  27 subroutine subr5 (a, b, c, d)
  28   implicit none
  29   integer, parameter :: N = 8
  30   integer :: i
  31   integer :: a(N)
  32   !$acc declare present_or_copyin (a)
  33   integer :: b(N)
  34   !$acc declare present_or_create (b)
  35   integer :: c(N)
  36   !$acc declare present_or_copyout (c)
  37   integer :: d(N)
  38   !$acc declare present_or_copy (d)
  39
  40   i = 0
  41
  42   !$acc parallel
  43     do i = 1, N
  44       b(i) = a(i)
  45       c(i) = b(i)
  46       d(i) = d(i) + b(i)
  47     end do
  48   !$acc end parallel
  49
  50 end subroutine
  51
  52 subroutine subr4 (a, b)
  53   implicit none
  54   integer, parameter :: N = 8
  55   integer :: i
  56   integer :: a(N)
  57   !$acc declare present (a)
  58   integer :: b(N)
  59   !$acc declare copyout (b)
  60
  61   i = 0
  62
  63   !$acc parallel
  64   do i = 1, N
  65     b(i) = a(i)
  66   end do
  67   !$acc end parallel
  68
  69 end subroutine
  70
  71 subroutine subr3 (a, c)
  72   implicit none
  73   integer, parameter :: N = 8
  74   integer :: i
  75   integer :: a(N)
  76   !$acc declare present (a)
  77   integer :: c(N)
  78   !$acc declare copyin (c)
  79
  80   i = 0
  81
  82   !$acc parallel
  83   do i = 1, N
  84     a(i) = c(i)
  85     c(i) = 0
  86   end do
  87   !$acc end parallel
  88
  89 end subroutine
  90
  91 subroutine subr2 (a, b, c)
  92   implicit none
  93   integer, parameter :: N = 8
  94   integer :: i
  95   integer :: a(N)
  96   !$acc declare present (a)
  97   integer :: b(N)
  98   !$acc declare create (b)
  99   integer :: c(N)
 100   !$acc declare copy (c)
 101
 102   i = 0
 103
 104   !$acc parallel
 105   do i = 1, N
 106     b(i) = a(i)
 107     c(i) = b(i) + c(i) + 1
 108   end do
 109   !$acc end parallel
 110
 111 end subroutine
 112
 113 subroutine subr1 (a)
 114   implicit none
 115   integer, parameter :: N = 8
 116   integer :: i
 117   integer :: a(N)
 118   !$acc declare present (a)
 119
 120   i = 0
 121
 122   !$acc parallel
 123   do i = 1, N
 124     a(i) = a(i) + 1
 125   end do
 126   !$acc end parallel
 127
 128 end subroutine
 129
 130 subroutine test (a, e)
 131   use openacc
 132   implicit none
 133   logical :: e
 134   integer, parameter :: N = 8
 135   integer :: a(N)
 136
 137   if (acc_is_present (a) .neqv. e) call abort
 138
 139 end subroutine
 140
 141 subroutine subr0 (a, b, c, d)
 142   implicit none
 143   integer, parameter :: N = 8
 144   integer :: a(N)
 145   !$acc declare copy (a)
 146   integer :: b(N)
 147   integer :: c(N)
 148   integer :: d(N)
 149   integer :: i
 150
 151   call test (a, .true.)
 152   call test (b, .false.)
 153   call test (c, .false.)
 154
 155   call subr1 (a)
 156
 157   call test (a, .true.)
 158   call test (b, .false.)
 159   call test (c, .false.)
 160
 161   call subr2 (a, b, c)
 162
 163   call test (a, .true.)
 164   call test (b, .false.)
 165   call test (c, .false.)
 166
 167   do i = 1, N
 168     if (c(i) .ne. 8) call abort
 169   end do
 170
 171   call subr3 (a, c)
 172
 173   call test (a, .true.)
 174   call test (b, .false.)
 175   call test (c, .false.)
 176
 177   do i = 1, N
 178     if (a(i) .ne. 2) call abort
 179     if (c(i) .ne. 8) call abort
 180   end do
 181
 182   call subr4 (a, b)
 183
 184   call test (a, .true.)
 185   call test (b, .false.)
 186   call test (c, .false.)
 187
 188   do i = 1, N
 189     if (b(i) .ne. 8) call abort
 190   end do
 191
 192   call subr5 (a, b, c, d)
 193
 194   call test (a, .true.)
 195   call test (b, .false.)
 196   call test (c, .false.)
 197   call test (d, .false.)
 198
 199   do i = 1, N
 200     if (c(i) .ne. 8) call abort
 201     if (d(i) .ne. 13) call abort
 202   end do
 203
 204   call subr6 (a, d)
 205
 206   call test (a, .true.)
 207   call test (d, .false.)
 208
 209   do i = 1, N
 210     if (d(i) .ne. 16) call abort
 211   end do
 212
 213 end subroutine
 214
 215 program main
 216   use vars
 217   use openacc
 218   implicit none
 219   integer, parameter :: N = 8
 220   integer :: a(N)
 221   integer :: b(N)
 222   integer :: c(N)
 223   integer :: d(N)
 224   integer :: i
 225
 226   a(:) = 2
 227   b(:) = 3
 228   c(:) = 4
 229   d(:) = 5
 230
 231   if (acc_is_present (z) .neqv. .true.) call abort
 232
 233   call subr0 (a, b, c, d)
 234
 235   call test (a, .false.)
 236   call test (b, .false.)
 237   call test (c, .false.)
 238   call test (d, .false.)
 239
 240   do i = 1, N
 241     if (a(i) .ne. 8) call abort
 242     if (b(i) .ne. 8) call abort
 243     if (c(i) .ne. 8) call abort
 244     if (d(i) .ne. 16) call abort
 245   end do
 246
 247
 248 end program