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

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