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