openacc.f90 revision 1.1.1.4 1 1.1 mrg ! OpenACC Runtime Library Definitions.
2 1.1 mrg
3 1.1.1.4 mrg ! Copyright (C) 2014-2018 Free Software Foundation, Inc.
4 1.1 mrg
5 1.1 mrg ! Contributed by Tobias Burnus <burnus@net-b.de>
6 1.1 mrg ! and Mentor Embedded.
7 1.1 mrg
8 1.1 mrg ! This file is part of the GNU Offloading and Multi Processing Library
9 1.1 mrg ! (libgomp).
10 1.1 mrg
11 1.1 mrg ! Libgomp is free software; you can redistribute it and/or modify it
12 1.1 mrg ! under the terms of the GNU General Public License as published by
13 1.1 mrg ! the Free Software Foundation; either version 3, or (at your option)
14 1.1 mrg ! any later version.
15 1.1 mrg
16 1.1 mrg ! Libgomp is distributed in the hope that it will be useful, but WITHOUT ANY
17 1.1 mrg ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
18 1.1 mrg ! FOR A PARTICULAR PURPOSE. See the GNU General Public License for
19 1.1 mrg ! more details.
20 1.1 mrg
21 1.1 mrg ! Under Section 7 of GPL version 3, you are granted additional
22 1.1 mrg ! permissions described in the GCC Runtime Library Exception, version
23 1.1 mrg ! 3.1, as published by the Free Software Foundation.
24 1.1 mrg
25 1.1 mrg ! You should have received a copy of the GNU General Public License and
26 1.1 mrg ! a copy of the GCC Runtime Library Exception along with this program;
27 1.1 mrg ! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
28 1.1 mrg ! <http://www.gnu.org/licenses/>.
29 1.1 mrg
30 1.1 mrg module openacc_kinds
31 1.1 mrg use iso_fortran_env, only: int32
32 1.1 mrg implicit none
33 1.1 mrg
34 1.1 mrg private :: int32
35 1.1 mrg public :: acc_device_kind
36 1.1 mrg
37 1.1 mrg integer, parameter :: acc_device_kind = int32
38 1.1 mrg
39 1.1 mrg public :: acc_device_none, acc_device_default, acc_device_host
40 1.1 mrg public :: acc_device_not_host, acc_device_nvidia
41 1.1 mrg
42 1.1 mrg ! Keep in sync with include/gomp-constants.h.
43 1.1 mrg integer (acc_device_kind), parameter :: acc_device_none = 0
44 1.1 mrg integer (acc_device_kind), parameter :: acc_device_default = 1
45 1.1 mrg integer (acc_device_kind), parameter :: acc_device_host = 2
46 1.1.1.2 mrg ! integer (acc_device_kind), parameter :: acc_device_host_nonshm = 3 removed.
47 1.1 mrg integer (acc_device_kind), parameter :: acc_device_not_host = 4
48 1.1 mrg integer (acc_device_kind), parameter :: acc_device_nvidia = 5
49 1.1 mrg
50 1.1 mrg public :: acc_handle_kind
51 1.1 mrg
52 1.1 mrg integer, parameter :: acc_handle_kind = int32
53 1.1 mrg
54 1.1 mrg public :: acc_async_noval, acc_async_sync
55 1.1 mrg
56 1.1 mrg ! Keep in sync with include/gomp-constants.h.
57 1.1 mrg integer (acc_handle_kind), parameter :: acc_async_noval = -1
58 1.1 mrg integer (acc_handle_kind), parameter :: acc_async_sync = -2
59 1.1 mrg
60 1.1 mrg end module
61 1.1 mrg
62 1.1 mrg module openacc_internal
63 1.1 mrg use openacc_kinds
64 1.1 mrg implicit none
65 1.1 mrg
66 1.1 mrg interface
67 1.1 mrg function acc_get_num_devices_h (d)
68 1.1 mrg import
69 1.1 mrg integer acc_get_num_devices_h
70 1.1 mrg integer (acc_device_kind) d
71 1.1 mrg end function
72 1.1 mrg
73 1.1 mrg subroutine acc_set_device_type_h (d)
74 1.1 mrg import
75 1.1 mrg integer (acc_device_kind) d
76 1.1 mrg end subroutine
77 1.1 mrg
78 1.1 mrg function acc_get_device_type_h ()
79 1.1 mrg import
80 1.1 mrg integer (acc_device_kind) acc_get_device_type_h
81 1.1 mrg end function
82 1.1 mrg
83 1.1 mrg subroutine acc_set_device_num_h (n, d)
84 1.1 mrg import
85 1.1 mrg integer n
86 1.1 mrg integer (acc_device_kind) d
87 1.1 mrg end subroutine
88 1.1 mrg
89 1.1 mrg function acc_get_device_num_h (d)
90 1.1 mrg import
91 1.1 mrg integer acc_get_device_num_h
92 1.1 mrg integer (acc_device_kind) d
93 1.1 mrg end function
94 1.1 mrg
95 1.1 mrg function acc_async_test_h (a)
96 1.1 mrg logical acc_async_test_h
97 1.1 mrg integer a
98 1.1 mrg end function
99 1.1 mrg
100 1.1 mrg function acc_async_test_all_h ()
101 1.1 mrg logical acc_async_test_all_h
102 1.1 mrg end function
103 1.1 mrg
104 1.1 mrg subroutine acc_wait_h (a)
105 1.1 mrg integer a
106 1.1 mrg end subroutine
107 1.1 mrg
108 1.1 mrg subroutine acc_wait_async_h (a1, a2)
109 1.1 mrg integer a1, a2
110 1.1 mrg end subroutine
111 1.1 mrg
112 1.1 mrg subroutine acc_wait_all_h ()
113 1.1 mrg end subroutine
114 1.1 mrg
115 1.1 mrg subroutine acc_wait_all_async_h (a)
116 1.1 mrg integer a
117 1.1 mrg end subroutine
118 1.1 mrg
119 1.1 mrg subroutine acc_init_h (d)
120 1.1 mrg import
121 1.1 mrg integer (acc_device_kind) d
122 1.1 mrg end subroutine
123 1.1 mrg
124 1.1 mrg subroutine acc_shutdown_h (d)
125 1.1 mrg import
126 1.1 mrg integer (acc_device_kind) d
127 1.1 mrg end subroutine
128 1.1 mrg
129 1.1 mrg function acc_on_device_h (d)
130 1.1 mrg import
131 1.1 mrg integer (acc_device_kind) d
132 1.1 mrg logical acc_on_device_h
133 1.1 mrg end function
134 1.1 mrg
135 1.1 mrg subroutine acc_copyin_32_h (a, len)
136 1.1 mrg use iso_c_binding, only: c_int32_t
137 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
138 1.1 mrg type (*), dimension (*) :: a
139 1.1 mrg integer (c_int32_t) len
140 1.1 mrg end subroutine
141 1.1 mrg
142 1.1 mrg subroutine acc_copyin_64_h (a, len)
143 1.1 mrg use iso_c_binding, only: c_int64_t
144 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
145 1.1 mrg type (*), dimension (*) :: a
146 1.1 mrg integer (c_int64_t) len
147 1.1 mrg end subroutine
148 1.1 mrg
149 1.1 mrg subroutine acc_copyin_array_h (a)
150 1.1 mrg type (*), dimension (..), contiguous :: a
151 1.1 mrg end subroutine
152 1.1 mrg
153 1.1 mrg subroutine acc_present_or_copyin_32_h (a, len)
154 1.1 mrg use iso_c_binding, only: c_int32_t
155 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
156 1.1 mrg type (*), dimension (*) :: a
157 1.1 mrg integer (c_int32_t) len
158 1.1 mrg end subroutine
159 1.1 mrg
160 1.1 mrg subroutine acc_present_or_copyin_64_h (a, len)
161 1.1 mrg use iso_c_binding, only: c_int64_t
162 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
163 1.1 mrg type (*), dimension (*) :: a
164 1.1 mrg integer (c_int64_t) len
165 1.1 mrg end subroutine
166 1.1 mrg
167 1.1 mrg subroutine acc_present_or_copyin_array_h (a)
168 1.1 mrg type (*), dimension (..), contiguous :: a
169 1.1 mrg end subroutine
170 1.1 mrg
171 1.1 mrg subroutine acc_create_32_h (a, len)
172 1.1 mrg use iso_c_binding, only: c_int32_t
173 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
174 1.1 mrg type (*), dimension (*) :: a
175 1.1 mrg integer (c_int32_t) len
176 1.1 mrg end subroutine
177 1.1 mrg
178 1.1 mrg subroutine acc_create_64_h (a, len)
179 1.1 mrg use iso_c_binding, only: c_int64_t
180 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
181 1.1 mrg type (*), dimension (*) :: a
182 1.1 mrg integer (c_int64_t) len
183 1.1 mrg end subroutine
184 1.1 mrg
185 1.1 mrg subroutine acc_create_array_h (a)
186 1.1 mrg type (*), dimension (..), contiguous :: a
187 1.1 mrg end subroutine
188 1.1 mrg
189 1.1 mrg subroutine acc_present_or_create_32_h (a, len)
190 1.1 mrg use iso_c_binding, only: c_int32_t
191 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
192 1.1 mrg type (*), dimension (*) :: a
193 1.1 mrg integer (c_int32_t) len
194 1.1 mrg end subroutine
195 1.1 mrg
196 1.1 mrg subroutine acc_present_or_create_64_h (a, len)
197 1.1 mrg use iso_c_binding, only: c_int64_t
198 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
199 1.1 mrg type (*), dimension (*) :: a
200 1.1 mrg integer (c_int64_t) len
201 1.1 mrg end subroutine
202 1.1 mrg
203 1.1 mrg subroutine acc_present_or_create_array_h (a)
204 1.1 mrg type (*), dimension (..), contiguous :: a
205 1.1 mrg end subroutine
206 1.1 mrg
207 1.1 mrg subroutine acc_copyout_32_h (a, len)
208 1.1 mrg use iso_c_binding, only: c_int32_t
209 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
210 1.1 mrg type (*), dimension (*) :: a
211 1.1 mrg integer (c_int32_t) len
212 1.1 mrg end subroutine
213 1.1 mrg
214 1.1 mrg subroutine acc_copyout_64_h (a, len)
215 1.1 mrg use iso_c_binding, only: c_int64_t
216 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
217 1.1 mrg type (*), dimension (*) :: a
218 1.1 mrg integer (c_int64_t) len
219 1.1 mrg end subroutine
220 1.1 mrg
221 1.1 mrg subroutine acc_copyout_array_h (a)
222 1.1 mrg type (*), dimension (..), contiguous :: a
223 1.1 mrg end subroutine
224 1.1 mrg
225 1.1 mrg subroutine acc_delete_32_h (a, len)
226 1.1 mrg use iso_c_binding, only: c_int32_t
227 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
228 1.1 mrg type (*), dimension (*) :: a
229 1.1 mrg integer (c_int32_t) len
230 1.1 mrg end subroutine
231 1.1 mrg
232 1.1 mrg subroutine acc_delete_64_h (a, len)
233 1.1 mrg use iso_c_binding, only: c_int64_t
234 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
235 1.1 mrg type (*), dimension (*) :: a
236 1.1 mrg integer (c_int64_t) len
237 1.1 mrg end subroutine
238 1.1 mrg
239 1.1 mrg subroutine acc_delete_array_h (a)
240 1.1 mrg type (*), dimension (..), contiguous :: a
241 1.1 mrg end subroutine
242 1.1 mrg
243 1.1 mrg subroutine acc_update_device_32_h (a, len)
244 1.1 mrg use iso_c_binding, only: c_int32_t
245 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
246 1.1 mrg type (*), dimension (*) :: a
247 1.1 mrg integer (c_int32_t) len
248 1.1 mrg end subroutine
249 1.1 mrg
250 1.1 mrg subroutine acc_update_device_64_h (a, len)
251 1.1 mrg use iso_c_binding, only: c_int64_t
252 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
253 1.1 mrg type (*), dimension (*) :: a
254 1.1 mrg integer (c_int64_t) len
255 1.1 mrg end subroutine
256 1.1 mrg
257 1.1 mrg subroutine acc_update_device_array_h (a)
258 1.1 mrg type (*), dimension (..), contiguous :: a
259 1.1 mrg end subroutine
260 1.1 mrg
261 1.1 mrg subroutine acc_update_self_32_h (a, len)
262 1.1 mrg use iso_c_binding, only: c_int32_t
263 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
264 1.1 mrg type (*), dimension (*) :: a
265 1.1 mrg integer (c_int32_t) len
266 1.1 mrg end subroutine
267 1.1 mrg
268 1.1 mrg subroutine acc_update_self_64_h (a, len)
269 1.1 mrg use iso_c_binding, only: c_int64_t
270 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
271 1.1 mrg type (*), dimension (*) :: a
272 1.1 mrg integer (c_int64_t) len
273 1.1 mrg end subroutine
274 1.1 mrg
275 1.1 mrg subroutine acc_update_self_array_h (a)
276 1.1 mrg type (*), dimension (..), contiguous :: a
277 1.1 mrg end subroutine
278 1.1 mrg
279 1.1 mrg function acc_is_present_32_h (a, len)
280 1.1 mrg use iso_c_binding, only: c_int32_t
281 1.1 mrg logical acc_is_present_32_h
282 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
283 1.1 mrg type (*), dimension (*) :: a
284 1.1 mrg integer (c_int32_t) len
285 1.1 mrg end function
286 1.1 mrg
287 1.1 mrg function acc_is_present_64_h (a, len)
288 1.1 mrg use iso_c_binding, only: c_int64_t
289 1.1 mrg logical acc_is_present_64_h
290 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
291 1.1 mrg type (*), dimension (*) :: a
292 1.1 mrg integer (c_int64_t) len
293 1.1 mrg end function
294 1.1 mrg
295 1.1 mrg function acc_is_present_array_h (a)
296 1.1 mrg logical acc_is_present_array_h
297 1.1 mrg type (*), dimension (..), contiguous :: a
298 1.1 mrg end function
299 1.1 mrg end interface
300 1.1 mrg
301 1.1 mrg interface
302 1.1 mrg function acc_get_num_devices_l (d) &
303 1.1 mrg bind (C, name = "acc_get_num_devices")
304 1.1 mrg use iso_c_binding, only: c_int
305 1.1 mrg integer (c_int) :: acc_get_num_devices_l
306 1.1 mrg integer (c_int), value :: d
307 1.1 mrg end function
308 1.1 mrg
309 1.1 mrg subroutine acc_set_device_type_l (d) &
310 1.1 mrg bind (C, name = "acc_set_device_type")
311 1.1 mrg use iso_c_binding, only: c_int
312 1.1 mrg integer (c_int), value :: d
313 1.1 mrg end subroutine
314 1.1 mrg
315 1.1 mrg function acc_get_device_type_l () &
316 1.1 mrg bind (C, name = "acc_get_device_type")
317 1.1 mrg use iso_c_binding, only: c_int
318 1.1 mrg integer (c_int) :: acc_get_device_type_l
319 1.1 mrg end function
320 1.1 mrg
321 1.1 mrg subroutine acc_set_device_num_l (n, d) &
322 1.1 mrg bind (C, name = "acc_set_device_num")
323 1.1 mrg use iso_c_binding, only: c_int
324 1.1 mrg integer (c_int), value :: n, d
325 1.1 mrg end subroutine
326 1.1 mrg
327 1.1 mrg function acc_get_device_num_l (d) &
328 1.1 mrg bind (C, name = "acc_get_device_num")
329 1.1 mrg use iso_c_binding, only: c_int
330 1.1 mrg integer (c_int) :: acc_get_device_num_l
331 1.1 mrg integer (c_int), value :: d
332 1.1 mrg end function
333 1.1 mrg
334 1.1 mrg function acc_async_test_l (a) &
335 1.1 mrg bind (C, name = "acc_async_test")
336 1.1 mrg use iso_c_binding, only: c_int
337 1.1 mrg integer (c_int) :: acc_async_test_l
338 1.1 mrg integer (c_int), value :: a
339 1.1 mrg end function
340 1.1 mrg
341 1.1 mrg function acc_async_test_all_l () &
342 1.1 mrg bind (C, name = "acc_async_test_all")
343 1.1 mrg use iso_c_binding, only: c_int
344 1.1 mrg integer (c_int) :: acc_async_test_all_l
345 1.1 mrg end function
346 1.1 mrg
347 1.1 mrg subroutine acc_wait_l (a) &
348 1.1 mrg bind (C, name = "acc_wait")
349 1.1 mrg use iso_c_binding, only: c_int
350 1.1 mrg integer (c_int), value :: a
351 1.1 mrg end subroutine
352 1.1 mrg
353 1.1 mrg subroutine acc_wait_async_l (a1, a2) &
354 1.1 mrg bind (C, name = "acc_wait_async")
355 1.1 mrg use iso_c_binding, only: c_int
356 1.1 mrg integer (c_int), value :: a1, a2
357 1.1 mrg end subroutine
358 1.1 mrg
359 1.1 mrg subroutine acc_wait_all_l () &
360 1.1 mrg bind (C, name = "acc_wait_all")
361 1.1 mrg use iso_c_binding, only: c_int
362 1.1 mrg end subroutine
363 1.1 mrg
364 1.1 mrg subroutine acc_wait_all_async_l (a) &
365 1.1 mrg bind (C, name = "acc_wait_all_async")
366 1.1 mrg use iso_c_binding, only: c_int
367 1.1 mrg integer (c_int), value :: a
368 1.1 mrg end subroutine
369 1.1 mrg
370 1.1 mrg subroutine acc_init_l (d) &
371 1.1 mrg bind (C, name = "acc_init")
372 1.1 mrg use iso_c_binding, only: c_int
373 1.1 mrg integer (c_int), value :: d
374 1.1 mrg end subroutine
375 1.1 mrg
376 1.1 mrg subroutine acc_shutdown_l (d) &
377 1.1 mrg bind (C, name = "acc_shutdown")
378 1.1 mrg use iso_c_binding, only: c_int
379 1.1 mrg integer (c_int), value :: d
380 1.1 mrg end subroutine
381 1.1 mrg
382 1.1 mrg function acc_on_device_l (d) &
383 1.1 mrg bind (C, name = "acc_on_device")
384 1.1 mrg use iso_c_binding, only: c_int
385 1.1 mrg integer (c_int) :: acc_on_device_l
386 1.1 mrg integer (c_int), value :: d
387 1.1 mrg end function
388 1.1 mrg
389 1.1 mrg subroutine acc_copyin_l (a, len) &
390 1.1 mrg bind (C, name = "acc_copyin")
391 1.1 mrg use iso_c_binding, only: c_size_t
392 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
393 1.1 mrg type (*), dimension (*) :: a
394 1.1 mrg integer (c_size_t), value :: len
395 1.1 mrg end subroutine
396 1.1 mrg
397 1.1 mrg subroutine acc_present_or_copyin_l (a, len) &
398 1.1 mrg bind (C, name = "acc_present_or_copyin")
399 1.1 mrg use iso_c_binding, only: c_size_t
400 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
401 1.1 mrg type (*), dimension (*) :: a
402 1.1 mrg integer (c_size_t), value :: len
403 1.1 mrg end subroutine
404 1.1 mrg
405 1.1 mrg subroutine acc_create_l (a, len) &
406 1.1 mrg bind (C, name = "acc_create")
407 1.1 mrg use iso_c_binding, only: c_size_t
408 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
409 1.1 mrg type (*), dimension (*) :: a
410 1.1 mrg integer (c_size_t), value :: len
411 1.1 mrg end subroutine
412 1.1 mrg
413 1.1 mrg subroutine acc_present_or_create_l (a, len) &
414 1.1 mrg bind (C, name = "acc_present_or_create")
415 1.1 mrg use iso_c_binding, only: c_size_t
416 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
417 1.1 mrg type (*), dimension (*) :: a
418 1.1 mrg integer (c_size_t), value :: len
419 1.1 mrg end subroutine
420 1.1 mrg
421 1.1 mrg subroutine acc_copyout_l (a, len) &
422 1.1 mrg bind (C, name = "acc_copyout")
423 1.1 mrg use iso_c_binding, only: c_size_t
424 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
425 1.1 mrg type (*), dimension (*) :: a
426 1.1 mrg integer (c_size_t), value :: len
427 1.1 mrg end subroutine
428 1.1 mrg
429 1.1 mrg subroutine acc_delete_l (a, len) &
430 1.1 mrg bind (C, name = "acc_delete")
431 1.1 mrg use iso_c_binding, only: c_size_t
432 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
433 1.1 mrg type (*), dimension (*) :: a
434 1.1 mrg integer (c_size_t), value :: len
435 1.1 mrg end subroutine
436 1.1 mrg
437 1.1 mrg subroutine acc_update_device_l (a, len) &
438 1.1 mrg bind (C, name = "acc_update_device")
439 1.1 mrg use iso_c_binding, only: c_size_t
440 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
441 1.1 mrg type (*), dimension (*) :: a
442 1.1 mrg integer (c_size_t), value :: len
443 1.1 mrg end subroutine
444 1.1 mrg
445 1.1 mrg subroutine acc_update_self_l (a, len) &
446 1.1 mrg bind (C, name = "acc_update_self")
447 1.1 mrg use iso_c_binding, only: c_size_t
448 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
449 1.1 mrg type (*), dimension (*) :: a
450 1.1 mrg integer (c_size_t), value :: len
451 1.1 mrg end subroutine
452 1.1 mrg
453 1.1 mrg function acc_is_present_l (a, len) &
454 1.1 mrg bind (C, name = "acc_is_present")
455 1.1 mrg use iso_c_binding, only: c_int32_t, c_size_t
456 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
457 1.1 mrg integer (c_int32_t) :: acc_is_present_l
458 1.1 mrg type (*), dimension (*) :: a
459 1.1 mrg integer (c_size_t), value :: len
460 1.1 mrg end function
461 1.1 mrg end interface
462 1.1 mrg end module
463 1.1 mrg
464 1.1 mrg module openacc
465 1.1 mrg use openacc_kinds
466 1.1 mrg use openacc_internal
467 1.1 mrg implicit none
468 1.1 mrg
469 1.1 mrg public :: openacc_version
470 1.1 mrg
471 1.1 mrg public :: acc_get_num_devices, acc_set_device_type, acc_get_device_type
472 1.1 mrg public :: acc_set_device_num, acc_get_device_num, acc_async_test
473 1.1.1.4 mrg public :: acc_async_test_all
474 1.1.1.4 mrg public :: acc_wait, acc_async_wait, acc_wait_async
475 1.1.1.4 mrg public :: acc_wait_all, acc_async_wait_all, acc_wait_all_async
476 1.1.1.4 mrg public :: acc_init, acc_shutdown, acc_on_device
477 1.1 mrg public :: acc_copyin, acc_present_or_copyin, acc_pcopyin, acc_create
478 1.1 mrg public :: acc_present_or_create, acc_pcreate, acc_copyout, acc_delete
479 1.1 mrg public :: acc_update_device, acc_update_self, acc_is_present
480 1.1 mrg
481 1.1 mrg integer, parameter :: openacc_version = 201306
482 1.1 mrg
483 1.1 mrg interface acc_get_num_devices
484 1.1 mrg procedure :: acc_get_num_devices_h
485 1.1 mrg end interface
486 1.1 mrg
487 1.1 mrg interface acc_set_device_type
488 1.1 mrg procedure :: acc_set_device_type_h
489 1.1 mrg end interface
490 1.1 mrg
491 1.1 mrg interface acc_get_device_type
492 1.1 mrg procedure :: acc_get_device_type_h
493 1.1 mrg end interface
494 1.1 mrg
495 1.1 mrg interface acc_set_device_num
496 1.1 mrg procedure :: acc_set_device_num_h
497 1.1 mrg end interface
498 1.1 mrg
499 1.1 mrg interface acc_get_device_num
500 1.1 mrg procedure :: acc_get_device_num_h
501 1.1 mrg end interface
502 1.1 mrg
503 1.1 mrg interface acc_async_test
504 1.1 mrg procedure :: acc_async_test_h
505 1.1 mrg end interface
506 1.1 mrg
507 1.1 mrg interface acc_async_test_all
508 1.1 mrg procedure :: acc_async_test_all_h
509 1.1 mrg end interface
510 1.1 mrg
511 1.1 mrg interface acc_wait
512 1.1 mrg procedure :: acc_wait_h
513 1.1 mrg end interface
514 1.1 mrg
515 1.1.1.4 mrg ! acc_async_wait is an OpenACC 1.0 compatibility name for acc_wait.
516 1.1.1.4 mrg interface acc_async_wait
517 1.1.1.4 mrg procedure :: acc_wait_h
518 1.1.1.4 mrg end interface
519 1.1.1.4 mrg
520 1.1 mrg interface acc_wait_async
521 1.1 mrg procedure :: acc_wait_async_h
522 1.1 mrg end interface
523 1.1 mrg
524 1.1 mrg interface acc_wait_all
525 1.1 mrg procedure :: acc_wait_all_h
526 1.1 mrg end interface
527 1.1 mrg
528 1.1.1.4 mrg ! acc_async_wait_all is an OpenACC 1.0 compatibility name for acc_wait_all.
529 1.1.1.4 mrg interface acc_async_wait_all
530 1.1.1.4 mrg procedure :: acc_wait_all_h
531 1.1.1.4 mrg end interface
532 1.1.1.4 mrg
533 1.1 mrg interface acc_wait_all_async
534 1.1 mrg procedure :: acc_wait_all_async_h
535 1.1 mrg end interface
536 1.1 mrg
537 1.1 mrg interface acc_init
538 1.1 mrg procedure :: acc_init_h
539 1.1 mrg end interface
540 1.1 mrg
541 1.1 mrg interface acc_shutdown
542 1.1 mrg procedure :: acc_shutdown_h
543 1.1 mrg end interface
544 1.1 mrg
545 1.1 mrg interface acc_on_device
546 1.1 mrg procedure :: acc_on_device_h
547 1.1 mrg end interface
548 1.1 mrg
549 1.1 mrg ! acc_malloc: Only available in C/C++
550 1.1 mrg ! acc_free: Only available in C/C++
551 1.1 mrg
552 1.1 mrg ! As vendor extension, the following code supports both 32bit and 64bit
553 1.1 mrg ! arguments for "size"; the OpenACC standard only permits default-kind
554 1.1 mrg ! integers, which are of kind 4 (i.e. 32 bits).
555 1.1 mrg ! Additionally, the two-argument version also takes arrays as argument.
556 1.1 mrg ! and the one argument version also scalars. Note that the code assumes
557 1.1 mrg ! that the arrays are contiguous.
558 1.1 mrg
559 1.1 mrg interface acc_copyin
560 1.1 mrg procedure :: acc_copyin_32_h
561 1.1 mrg procedure :: acc_copyin_64_h
562 1.1 mrg procedure :: acc_copyin_array_h
563 1.1 mrg end interface
564 1.1 mrg
565 1.1 mrg interface acc_present_or_copyin
566 1.1 mrg procedure :: acc_present_or_copyin_32_h
567 1.1 mrg procedure :: acc_present_or_copyin_64_h
568 1.1 mrg procedure :: acc_present_or_copyin_array_h
569 1.1 mrg end interface
570 1.1 mrg
571 1.1 mrg interface acc_pcopyin
572 1.1 mrg procedure :: acc_present_or_copyin_32_h
573 1.1 mrg procedure :: acc_present_or_copyin_64_h
574 1.1 mrg procedure :: acc_present_or_copyin_array_h
575 1.1 mrg end interface
576 1.1 mrg
577 1.1 mrg interface acc_create
578 1.1 mrg procedure :: acc_create_32_h
579 1.1 mrg procedure :: acc_create_64_h
580 1.1 mrg procedure :: acc_create_array_h
581 1.1 mrg end interface
582 1.1 mrg
583 1.1 mrg interface acc_present_or_create
584 1.1 mrg procedure :: acc_present_or_create_32_h
585 1.1 mrg procedure :: acc_present_or_create_64_h
586 1.1 mrg procedure :: acc_present_or_create_array_h
587 1.1 mrg end interface
588 1.1 mrg
589 1.1 mrg interface acc_pcreate
590 1.1 mrg procedure :: acc_present_or_create_32_h
591 1.1 mrg procedure :: acc_present_or_create_64_h
592 1.1 mrg procedure :: acc_present_or_create_array_h
593 1.1 mrg end interface
594 1.1 mrg
595 1.1 mrg interface acc_copyout
596 1.1 mrg procedure :: acc_copyout_32_h
597 1.1 mrg procedure :: acc_copyout_64_h
598 1.1 mrg procedure :: acc_copyout_array_h
599 1.1 mrg end interface
600 1.1 mrg
601 1.1 mrg interface acc_delete
602 1.1 mrg procedure :: acc_delete_32_h
603 1.1 mrg procedure :: acc_delete_64_h
604 1.1 mrg procedure :: acc_delete_array_h
605 1.1 mrg end interface
606 1.1 mrg
607 1.1 mrg interface acc_update_device
608 1.1 mrg procedure :: acc_update_device_32_h
609 1.1 mrg procedure :: acc_update_device_64_h
610 1.1 mrg procedure :: acc_update_device_array_h
611 1.1 mrg end interface
612 1.1 mrg
613 1.1 mrg interface acc_update_self
614 1.1 mrg procedure :: acc_update_self_32_h
615 1.1 mrg procedure :: acc_update_self_64_h
616 1.1 mrg procedure :: acc_update_self_array_h
617 1.1 mrg end interface
618 1.1 mrg
619 1.1 mrg ! acc_map_data: Only available in C/C++
620 1.1 mrg ! acc_unmap_data: Only available in C/C++
621 1.1 mrg ! acc_deviceptr: Only available in C/C++
622 1.1 mrg ! acc_hostptr: Only available in C/C++
623 1.1 mrg
624 1.1 mrg interface acc_is_present
625 1.1 mrg procedure :: acc_is_present_32_h
626 1.1 mrg procedure :: acc_is_present_64_h
627 1.1 mrg procedure :: acc_is_present_array_h
628 1.1 mrg end interface
629 1.1 mrg
630 1.1 mrg ! acc_memcpy_to_device: Only available in C/C++
631 1.1 mrg ! acc_memcpy_from_device: Only available in C/C++
632 1.1 mrg
633 1.1 mrg end module
634 1.1 mrg
635 1.1 mrg function acc_get_num_devices_h (d)
636 1.1 mrg use openacc_internal, only: acc_get_num_devices_l
637 1.1 mrg use openacc_kinds
638 1.1 mrg integer acc_get_num_devices_h
639 1.1 mrg integer (acc_device_kind) d
640 1.1 mrg acc_get_num_devices_h = acc_get_num_devices_l (d)
641 1.1 mrg end function
642 1.1 mrg
643 1.1 mrg subroutine acc_set_device_type_h (d)
644 1.1 mrg use openacc_internal, only: acc_set_device_type_l
645 1.1 mrg use openacc_kinds
646 1.1 mrg integer (acc_device_kind) d
647 1.1 mrg call acc_set_device_type_l (d)
648 1.1 mrg end subroutine
649 1.1 mrg
650 1.1 mrg function acc_get_device_type_h ()
651 1.1 mrg use openacc_internal, only: acc_get_device_type_l
652 1.1 mrg use openacc_kinds
653 1.1 mrg integer (acc_device_kind) acc_get_device_type_h
654 1.1 mrg acc_get_device_type_h = acc_get_device_type_l ()
655 1.1 mrg end function
656 1.1 mrg
657 1.1 mrg subroutine acc_set_device_num_h (n, d)
658 1.1 mrg use openacc_internal, only: acc_set_device_num_l
659 1.1 mrg use openacc_kinds
660 1.1 mrg integer n
661 1.1 mrg integer (acc_device_kind) d
662 1.1 mrg call acc_set_device_num_l (n, d)
663 1.1 mrg end subroutine
664 1.1 mrg
665 1.1 mrg function acc_get_device_num_h (d)
666 1.1 mrg use openacc_internal, only: acc_get_device_num_l
667 1.1 mrg use openacc_kinds
668 1.1 mrg integer acc_get_device_num_h
669 1.1 mrg integer (acc_device_kind) d
670 1.1 mrg acc_get_device_num_h = acc_get_device_num_l (d)
671 1.1 mrg end function
672 1.1 mrg
673 1.1 mrg function acc_async_test_h (a)
674 1.1 mrg use openacc_internal, only: acc_async_test_l
675 1.1 mrg logical acc_async_test_h
676 1.1 mrg integer a
677 1.1 mrg if (acc_async_test_l (a) .eq. 1) then
678 1.1 mrg acc_async_test_h = .TRUE.
679 1.1 mrg else
680 1.1 mrg acc_async_test_h = .FALSE.
681 1.1 mrg end if
682 1.1 mrg end function
683 1.1 mrg
684 1.1 mrg function acc_async_test_all_h ()
685 1.1 mrg use openacc_internal, only: acc_async_test_all_l
686 1.1 mrg logical acc_async_test_all_h
687 1.1 mrg if (acc_async_test_all_l () .eq. 1) then
688 1.1 mrg acc_async_test_all_h = .TRUE.
689 1.1 mrg else
690 1.1 mrg acc_async_test_all_h = .FALSE.
691 1.1 mrg end if
692 1.1 mrg end function
693 1.1 mrg
694 1.1 mrg subroutine acc_wait_h (a)
695 1.1 mrg use openacc_internal, only: acc_wait_l
696 1.1 mrg integer a
697 1.1 mrg call acc_wait_l (a)
698 1.1 mrg end subroutine
699 1.1 mrg
700 1.1 mrg subroutine acc_wait_async_h (a1, a2)
701 1.1 mrg use openacc_internal, only: acc_wait_async_l
702 1.1 mrg integer a1, a2
703 1.1 mrg call acc_wait_async_l (a1, a2)
704 1.1 mrg end subroutine
705 1.1 mrg
706 1.1 mrg subroutine acc_wait_all_h ()
707 1.1 mrg use openacc_internal, only: acc_wait_all_l
708 1.1 mrg call acc_wait_all_l ()
709 1.1 mrg end subroutine
710 1.1 mrg
711 1.1 mrg subroutine acc_wait_all_async_h (a)
712 1.1 mrg use openacc_internal, only: acc_wait_all_async_l
713 1.1 mrg integer a
714 1.1 mrg call acc_wait_all_async_l (a)
715 1.1 mrg end subroutine
716 1.1 mrg
717 1.1 mrg subroutine acc_init_h (d)
718 1.1 mrg use openacc_internal, only: acc_init_l
719 1.1 mrg use openacc_kinds
720 1.1 mrg integer (acc_device_kind) d
721 1.1 mrg call acc_init_l (d)
722 1.1 mrg end subroutine
723 1.1 mrg
724 1.1 mrg subroutine acc_shutdown_h (d)
725 1.1 mrg use openacc_internal, only: acc_shutdown_l
726 1.1 mrg use openacc_kinds
727 1.1 mrg integer (acc_device_kind) d
728 1.1 mrg call acc_shutdown_l (d)
729 1.1 mrg end subroutine
730 1.1 mrg
731 1.1 mrg function acc_on_device_h (d)
732 1.1 mrg use openacc_internal, only: acc_on_device_l
733 1.1 mrg use openacc_kinds
734 1.1 mrg integer (acc_device_kind) d
735 1.1 mrg logical acc_on_device_h
736 1.1 mrg if (acc_on_device_l (d) .eq. 1) then
737 1.1 mrg acc_on_device_h = .TRUE.
738 1.1 mrg else
739 1.1 mrg acc_on_device_h = .FALSE.
740 1.1 mrg end if
741 1.1 mrg end function
742 1.1 mrg
743 1.1 mrg subroutine acc_copyin_32_h (a, len)
744 1.1 mrg use iso_c_binding, only: c_int32_t, c_size_t
745 1.1 mrg use openacc_internal, only: acc_copyin_l
746 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
747 1.1 mrg type (*), dimension (*) :: a
748 1.1 mrg integer (c_int32_t) len
749 1.1 mrg call acc_copyin_l (a, int (len, kind = c_size_t))
750 1.1 mrg end subroutine
751 1.1 mrg
752 1.1 mrg subroutine acc_copyin_64_h (a, len)
753 1.1 mrg use iso_c_binding, only: c_int64_t, c_size_t
754 1.1 mrg use openacc_internal, only: acc_copyin_l
755 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
756 1.1 mrg type (*), dimension (*) :: a
757 1.1 mrg integer (c_int64_t) len
758 1.1 mrg call acc_copyin_l (a, int (len, kind = c_size_t))
759 1.1 mrg end subroutine
760 1.1 mrg
761 1.1 mrg subroutine acc_copyin_array_h (a)
762 1.1 mrg use openacc_internal, only: acc_copyin_l
763 1.1 mrg type (*), dimension (..), contiguous :: a
764 1.1 mrg call acc_copyin_l (a, sizeof (a))
765 1.1 mrg end subroutine
766 1.1 mrg
767 1.1 mrg subroutine acc_present_or_copyin_32_h (a, len)
768 1.1 mrg use iso_c_binding, only: c_int32_t, c_size_t
769 1.1 mrg use openacc_internal, only: acc_present_or_copyin_l
770 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
771 1.1 mrg type (*), dimension (*) :: a
772 1.1 mrg integer (c_int32_t) len
773 1.1 mrg call acc_present_or_copyin_l (a, int (len, kind = c_size_t))
774 1.1 mrg end subroutine
775 1.1 mrg
776 1.1 mrg subroutine acc_present_or_copyin_64_h (a, len)
777 1.1 mrg use iso_c_binding, only: c_int64_t, c_size_t
778 1.1 mrg use openacc_internal, only: acc_present_or_copyin_l
779 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
780 1.1 mrg type (*), dimension (*) :: a
781 1.1 mrg integer (c_int64_t) len
782 1.1 mrg call acc_present_or_copyin_l (a, int (len, kind = c_size_t))
783 1.1 mrg end subroutine
784 1.1 mrg
785 1.1 mrg subroutine acc_present_or_copyin_array_h (a)
786 1.1 mrg use openacc_internal, only: acc_present_or_copyin_l
787 1.1 mrg type (*), dimension (..), contiguous :: a
788 1.1 mrg call acc_present_or_copyin_l (a, sizeof (a))
789 1.1 mrg end subroutine
790 1.1 mrg
791 1.1 mrg subroutine acc_create_32_h (a, len)
792 1.1 mrg use iso_c_binding, only: c_int32_t, c_size_t
793 1.1 mrg use openacc_internal, only: acc_create_l
794 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
795 1.1 mrg type (*), dimension (*) :: a
796 1.1 mrg integer (c_int32_t) len
797 1.1 mrg call acc_create_l (a, int (len, kind = c_size_t))
798 1.1 mrg end subroutine
799 1.1 mrg
800 1.1 mrg subroutine acc_create_64_h (a, len)
801 1.1 mrg use iso_c_binding, only: c_int64_t, c_size_t
802 1.1 mrg use openacc_internal, only: acc_create_l
803 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
804 1.1 mrg type (*), dimension (*) :: a
805 1.1 mrg integer (c_int64_t) len
806 1.1 mrg call acc_create_l (a, int (len, kind = c_size_t))
807 1.1 mrg end subroutine
808 1.1 mrg
809 1.1 mrg subroutine acc_create_array_h (a)
810 1.1 mrg use openacc_internal, only: acc_create_l
811 1.1 mrg type (*), dimension (..), contiguous :: a
812 1.1 mrg call acc_create_l (a, sizeof (a))
813 1.1 mrg end subroutine
814 1.1 mrg
815 1.1 mrg subroutine acc_present_or_create_32_h (a, len)
816 1.1 mrg use iso_c_binding, only: c_int32_t, c_size_t
817 1.1 mrg use openacc_internal, only: acc_present_or_create_l
818 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
819 1.1 mrg type (*), dimension (*) :: a
820 1.1 mrg integer (c_int32_t) len
821 1.1 mrg call acc_present_or_create_l (a, int (len, kind = c_size_t))
822 1.1 mrg end subroutine
823 1.1 mrg
824 1.1 mrg subroutine acc_present_or_create_64_h (a, len)
825 1.1 mrg use iso_c_binding, only: c_int64_t, c_size_t
826 1.1 mrg use openacc_internal, only: acc_present_or_create_l
827 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
828 1.1 mrg type (*), dimension (*) :: a
829 1.1 mrg integer (c_int64_t) len
830 1.1 mrg call acc_present_or_create_l (a, int (len, kind = c_size_t))
831 1.1 mrg end subroutine
832 1.1 mrg
833 1.1 mrg subroutine acc_present_or_create_array_h (a)
834 1.1 mrg use openacc_internal, only: acc_present_or_create_l
835 1.1 mrg type (*), dimension (..), contiguous :: a
836 1.1 mrg call acc_present_or_create_l (a, sizeof (a))
837 1.1 mrg end subroutine
838 1.1 mrg
839 1.1 mrg subroutine acc_copyout_32_h (a, len)
840 1.1 mrg use iso_c_binding, only: c_int32_t, c_size_t
841 1.1 mrg use openacc_internal, only: acc_copyout_l
842 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
843 1.1 mrg type (*), dimension (*) :: a
844 1.1 mrg integer (c_int32_t) len
845 1.1 mrg call acc_copyout_l (a, int (len, kind = c_size_t))
846 1.1 mrg end subroutine
847 1.1 mrg
848 1.1 mrg subroutine acc_copyout_64_h (a, len)
849 1.1 mrg use iso_c_binding, only: c_int64_t, c_size_t
850 1.1 mrg use openacc_internal, only: acc_copyout_l
851 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
852 1.1 mrg type (*), dimension (*) :: a
853 1.1 mrg integer (c_int64_t) len
854 1.1 mrg call acc_copyout_l (a, int (len, kind = c_size_t))
855 1.1 mrg end subroutine
856 1.1 mrg
857 1.1 mrg subroutine acc_copyout_array_h (a)
858 1.1 mrg use openacc_internal, only: acc_copyout_l
859 1.1 mrg type (*), dimension (..), contiguous :: a
860 1.1 mrg call acc_copyout_l (a, sizeof (a))
861 1.1 mrg end subroutine
862 1.1 mrg
863 1.1 mrg subroutine acc_delete_32_h (a, len)
864 1.1 mrg use iso_c_binding, only: c_int32_t, c_size_t
865 1.1 mrg use openacc_internal, only: acc_delete_l
866 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
867 1.1 mrg type (*), dimension (*) :: a
868 1.1 mrg integer (c_int32_t) len
869 1.1 mrg call acc_delete_l (a, int (len, kind = c_size_t))
870 1.1 mrg end subroutine
871 1.1 mrg
872 1.1 mrg subroutine acc_delete_64_h (a, len)
873 1.1 mrg use iso_c_binding, only: c_int64_t, c_size_t
874 1.1 mrg use openacc_internal, only: acc_delete_l
875 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
876 1.1 mrg type (*), dimension (*) :: a
877 1.1 mrg integer (c_int64_t) len
878 1.1 mrg call acc_delete_l (a, int (len, kind = c_size_t))
879 1.1 mrg end subroutine
880 1.1 mrg
881 1.1 mrg subroutine acc_delete_array_h (a)
882 1.1 mrg use openacc_internal, only: acc_delete_l
883 1.1 mrg type (*), dimension (..), contiguous :: a
884 1.1 mrg call acc_delete_l (a, sizeof (a))
885 1.1 mrg end subroutine
886 1.1 mrg
887 1.1 mrg subroutine acc_update_device_32_h (a, len)
888 1.1 mrg use iso_c_binding, only: c_int32_t, c_size_t
889 1.1 mrg use openacc_internal, only: acc_update_device_l
890 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
891 1.1 mrg type (*), dimension (*) :: a
892 1.1 mrg integer (c_int32_t) len
893 1.1 mrg call acc_update_device_l (a, int (len, kind = c_size_t))
894 1.1 mrg end subroutine
895 1.1 mrg
896 1.1 mrg subroutine acc_update_device_64_h (a, len)
897 1.1 mrg use iso_c_binding, only: c_int64_t, c_size_t
898 1.1 mrg use openacc_internal, only: acc_update_device_l
899 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
900 1.1 mrg type (*), dimension (*) :: a
901 1.1 mrg integer (c_int64_t) len
902 1.1 mrg call acc_update_device_l (a, int (len, kind = c_size_t))
903 1.1 mrg end subroutine
904 1.1 mrg
905 1.1 mrg subroutine acc_update_device_array_h (a)
906 1.1 mrg use openacc_internal, only: acc_update_device_l
907 1.1 mrg type (*), dimension (..), contiguous :: a
908 1.1 mrg call acc_update_device_l (a, sizeof (a))
909 1.1 mrg end subroutine
910 1.1 mrg
911 1.1 mrg subroutine acc_update_self_32_h (a, len)
912 1.1 mrg use iso_c_binding, only: c_int32_t, c_size_t
913 1.1 mrg use openacc_internal, only: acc_update_self_l
914 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
915 1.1 mrg type (*), dimension (*) :: a
916 1.1 mrg integer (c_int32_t) len
917 1.1 mrg call acc_update_self_l (a, int (len, kind = c_size_t))
918 1.1 mrg end subroutine
919 1.1 mrg
920 1.1 mrg subroutine acc_update_self_64_h (a, len)
921 1.1 mrg use iso_c_binding, only: c_int64_t, c_size_t
922 1.1 mrg use openacc_internal, only: acc_update_self_l
923 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
924 1.1 mrg type (*), dimension (*) :: a
925 1.1 mrg integer (c_int64_t) len
926 1.1 mrg call acc_update_self_l (a, int (len, kind = c_size_t))
927 1.1 mrg end subroutine
928 1.1 mrg
929 1.1 mrg subroutine acc_update_self_array_h (a)
930 1.1 mrg use openacc_internal, only: acc_update_self_l
931 1.1 mrg type (*), dimension (..), contiguous :: a
932 1.1 mrg call acc_update_self_l (a, sizeof (a))
933 1.1 mrg end subroutine
934 1.1 mrg
935 1.1 mrg function acc_is_present_32_h (a, len)
936 1.1 mrg use iso_c_binding, only: c_int32_t, c_size_t
937 1.1 mrg use openacc_internal, only: acc_is_present_l
938 1.1 mrg logical acc_is_present_32_h
939 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
940 1.1 mrg type (*), dimension (*) :: a
941 1.1 mrg integer (c_int32_t) len
942 1.1 mrg if (acc_is_present_l (a, int (len, kind = c_size_t)) .eq. 1) then
943 1.1 mrg acc_is_present_32_h = .TRUE.
944 1.1 mrg else
945 1.1 mrg acc_is_present_32_h = .FALSE.
946 1.1 mrg end if
947 1.1 mrg end function
948 1.1 mrg
949 1.1 mrg function acc_is_present_64_h (a, len)
950 1.1 mrg use iso_c_binding, only: c_int64_t, c_size_t
951 1.1 mrg use openacc_internal, only: acc_is_present_l
952 1.1 mrg logical acc_is_present_64_h
953 1.1 mrg !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
954 1.1 mrg type (*), dimension (*) :: a
955 1.1 mrg integer (c_int64_t) len
956 1.1 mrg if (acc_is_present_l (a, int (len, kind = c_size_t)) .eq. 1) then
957 1.1 mrg acc_is_present_64_h = .TRUE.
958 1.1 mrg else
959 1.1 mrg acc_is_present_64_h = .FALSE.
960 1.1 mrg end if
961 1.1 mrg end function
962 1.1 mrg
963 1.1 mrg function acc_is_present_array_h (a)
964 1.1 mrg use openacc_internal, only: acc_is_present_l
965 1.1 mrg logical acc_is_present_array_h
966 1.1 mrg type (*), dimension (..), contiguous :: a
967 1.1 mrg acc_is_present_array_h = acc_is_present_l (a, sizeof (a)) == 1
968 1.1 mrg end function
969