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
15module vars
16  implicit none
17  integer z
18  !$acc declare create (z)
19end module vars
20
21subroutine 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
44end subroutine
45
46subroutine 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
63end subroutine
64
65subroutine 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
83end subroutine
84
85subroutine 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
105end subroutine
106
107subroutine 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
122end subroutine
123
124subroutine 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
133end subroutine
134
135subroutine 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
198end subroutine
199
200program 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
232end program
233