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

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