1!  OpenACC Runtime Library Definitions.
2
3!  Copyright (C) 2014-2018 Free Software Foundation, Inc.
4
5!  Contributed by Tobias Burnus <burnus@net-b.de>
6!              and Mentor Embedded.
7
8!  This file is part of the GNU Offloading and Multi Processing Library
9!  (libgomp).
10
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.
15
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.
20
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.
24
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/>.
29
30module openacc_kinds
31  use iso_fortran_env, only: int32
32  implicit none
33
34  private :: int32
35  public :: acc_device_kind
36
37  integer, parameter :: acc_device_kind = int32
38
39  public :: acc_device_none, acc_device_default, acc_device_host
40  public :: acc_device_not_host, acc_device_nvidia
41
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
49
50  public :: acc_handle_kind
51
52  integer, parameter :: acc_handle_kind = int32
53
54  public :: acc_async_noval, acc_async_sync
55
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
59
60end module
61
62module openacc_internal
63  use openacc_kinds
64  implicit none
65
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
72
73    subroutine acc_set_device_type_h (d)
74      import
75      integer (acc_device_kind) d
76    end subroutine
77
78    function acc_get_device_type_h ()
79      import
80      integer (acc_device_kind) acc_get_device_type_h
81    end function
82
83    subroutine acc_set_device_num_h (n, d)
84      import
85      integer n
86      integer (acc_device_kind) d
87    end subroutine
88
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
94
95    function acc_async_test_h (a)
96      logical acc_async_test_h
97      integer a
98    end function
99
100    function acc_async_test_all_h ()
101      logical acc_async_test_all_h
102    end function
103
104    subroutine acc_wait_h (a)
105      integer a
106    end subroutine
107
108    subroutine acc_wait_async_h (a1, a2)
109      integer a1, a2
110    end subroutine
111
112    subroutine acc_wait_all_h ()
113    end subroutine
114
115    subroutine acc_wait_all_async_h (a)
116      integer a
117    end subroutine
118
119    subroutine acc_init_h (d)
120      import
121      integer (acc_device_kind) d
122    end subroutine
123
124    subroutine acc_shutdown_h (d)
125      import
126      integer (acc_device_kind) d
127    end subroutine
128
129    function acc_on_device_h (d)
130      import
131      integer (acc_device_kind) d
132      logical acc_on_device_h
133    end function
134
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
141
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
148
149    subroutine acc_copyin_array_h (a)
150      type (*), dimension (..), contiguous :: a
151    end subroutine
152
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
159
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
166
167    subroutine acc_present_or_copyin_array_h (a)
168      type (*), dimension (..), contiguous :: a
169    end subroutine
170
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
177
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
184
185    subroutine acc_create_array_h (a)
186      type (*), dimension (..), contiguous :: a
187    end subroutine
188
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
195
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
202
203    subroutine acc_present_or_create_array_h (a)
204      type (*), dimension (..), contiguous :: a
205    end subroutine
206
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
213
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
220
221    subroutine acc_copyout_array_h (a)
222      type (*), dimension (..), contiguous :: a
223    end subroutine
224
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
231
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
238
239    subroutine acc_delete_array_h (a)
240      type (*), dimension (..), contiguous :: a
241    end subroutine
242
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
249
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
256
257    subroutine acc_update_device_array_h (a)
258      type (*), dimension (..), contiguous :: a
259    end subroutine
260
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
267
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
274
275    subroutine acc_update_self_array_h (a)
276      type (*), dimension (..), contiguous :: a
277    end subroutine
278
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
286
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
294
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
300
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
308
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
314
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
320
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
326
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
333
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
340
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
346
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
352
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
358
359    subroutine acc_wait_all_l () &
360        bind (C, name = "acc_wait_all")
361      use iso_c_binding, only: c_int
362    end subroutine
363
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
369
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
375
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
381
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
388
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
396
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
404
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
412
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
420
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
428
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
436
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
444
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
452
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
462end module
463
464module openacc
465  use openacc_kinds
466  use openacc_internal
467  implicit none
468
469  public :: openacc_version
470
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
474  public :: acc_wait, acc_async_wait, acc_wait_async
475  public :: acc_wait_all, acc_async_wait_all, acc_wait_all_async
476  public :: acc_init, acc_shutdown, acc_on_device
477  public :: acc_copyin, acc_present_or_copyin, acc_pcopyin, acc_create
478  public :: acc_present_or_create, acc_pcreate, acc_copyout, acc_delete
479  public :: acc_update_device, acc_update_self, acc_is_present
480
481  integer, parameter :: openacc_version = 201306
482
483  interface acc_get_num_devices
484    procedure :: acc_get_num_devices_h
485  end interface
486
487  interface acc_set_device_type
488    procedure :: acc_set_device_type_h
489  end interface
490
491  interface acc_get_device_type
492    procedure :: acc_get_device_type_h
493  end interface
494
495  interface acc_set_device_num
496    procedure :: acc_set_device_num_h
497  end interface
498
499  interface acc_get_device_num
500    procedure :: acc_get_device_num_h
501  end interface
502
503  interface acc_async_test
504    procedure :: acc_async_test_h
505  end interface
506
507  interface acc_async_test_all
508    procedure :: acc_async_test_all_h
509  end interface
510
511  interface acc_wait
512    procedure :: acc_wait_h
513  end interface
514
515  ! acc_async_wait is an OpenACC 1.0 compatibility name for acc_wait.
516  interface acc_async_wait
517    procedure :: acc_wait_h
518  end interface
519
520  interface acc_wait_async
521    procedure :: acc_wait_async_h
522  end interface
523
524  interface acc_wait_all
525    procedure :: acc_wait_all_h
526  end interface
527
528  ! acc_async_wait_all is an OpenACC 1.0 compatibility name for acc_wait_all.
529  interface acc_async_wait_all
530    procedure :: acc_wait_all_h
531  end interface
532
533  interface acc_wait_all_async
534    procedure :: acc_wait_all_async_h
535  end interface
536
537  interface acc_init
538    procedure :: acc_init_h
539  end interface
540
541  interface acc_shutdown
542    procedure :: acc_shutdown_h
543  end interface
544
545  interface acc_on_device
546    procedure :: acc_on_device_h
547  end interface
548
549  ! acc_malloc: Only available in C/C++
550  ! acc_free: Only available in C/C++
551
552  ! As vendor extension, the following code supports both 32bit and 64bit
553  ! arguments for "size"; the OpenACC standard only permits default-kind
554  ! integers, which are of kind 4 (i.e. 32 bits).
555  ! Additionally, the two-argument version also takes arrays as argument.
556  ! and the one argument version also scalars. Note that the code assumes
557  ! that the arrays are contiguous.
558
559  interface acc_copyin
560    procedure :: acc_copyin_32_h
561    procedure :: acc_copyin_64_h
562    procedure :: acc_copyin_array_h
563  end interface
564
565  interface acc_present_or_copyin
566    procedure :: acc_present_or_copyin_32_h
567    procedure :: acc_present_or_copyin_64_h
568    procedure :: acc_present_or_copyin_array_h
569  end interface
570
571  interface acc_pcopyin
572    procedure :: acc_present_or_copyin_32_h
573    procedure :: acc_present_or_copyin_64_h
574    procedure :: acc_present_or_copyin_array_h
575  end interface
576
577  interface acc_create
578    procedure :: acc_create_32_h
579    procedure :: acc_create_64_h
580    procedure :: acc_create_array_h
581  end interface
582
583  interface acc_present_or_create
584    procedure :: acc_present_or_create_32_h
585    procedure :: acc_present_or_create_64_h
586    procedure :: acc_present_or_create_array_h
587  end interface
588
589  interface acc_pcreate
590    procedure :: acc_present_or_create_32_h
591    procedure :: acc_present_or_create_64_h
592    procedure :: acc_present_or_create_array_h
593  end interface
594
595  interface acc_copyout
596    procedure :: acc_copyout_32_h
597    procedure :: acc_copyout_64_h
598    procedure :: acc_copyout_array_h
599  end interface
600
601  interface acc_delete
602    procedure :: acc_delete_32_h
603    procedure :: acc_delete_64_h
604    procedure :: acc_delete_array_h
605  end interface
606
607  interface acc_update_device
608    procedure :: acc_update_device_32_h
609    procedure :: acc_update_device_64_h
610    procedure :: acc_update_device_array_h
611  end interface
612
613  interface acc_update_self
614    procedure :: acc_update_self_32_h
615    procedure :: acc_update_self_64_h
616    procedure :: acc_update_self_array_h
617  end interface
618
619  ! acc_map_data: Only available in C/C++
620  ! acc_unmap_data: Only available in C/C++
621  ! acc_deviceptr: Only available in C/C++
622  ! acc_hostptr: Only available in C/C++
623
624  interface acc_is_present
625    procedure :: acc_is_present_32_h
626    procedure :: acc_is_present_64_h
627    procedure :: acc_is_present_array_h
628  end interface
629
630  ! acc_memcpy_to_device: Only available in C/C++
631  ! acc_memcpy_from_device: Only available in C/C++
632
633end module
634
635function acc_get_num_devices_h (d)
636  use openacc_internal, only: acc_get_num_devices_l
637  use openacc_kinds
638  integer acc_get_num_devices_h
639  integer (acc_device_kind) d
640  acc_get_num_devices_h = acc_get_num_devices_l (d)
641end function
642
643subroutine acc_set_device_type_h (d)
644  use openacc_internal, only: acc_set_device_type_l
645  use openacc_kinds
646  integer (acc_device_kind) d
647  call acc_set_device_type_l (d)
648end subroutine
649
650function acc_get_device_type_h ()
651  use openacc_internal, only: acc_get_device_type_l
652  use openacc_kinds
653  integer (acc_device_kind) acc_get_device_type_h
654  acc_get_device_type_h = acc_get_device_type_l ()
655end function
656
657subroutine acc_set_device_num_h (n, d)
658  use openacc_internal, only: acc_set_device_num_l
659  use openacc_kinds
660  integer n
661  integer (acc_device_kind) d
662  call acc_set_device_num_l (n, d)
663end subroutine
664
665function acc_get_device_num_h (d)
666  use openacc_internal, only: acc_get_device_num_l
667  use openacc_kinds
668  integer acc_get_device_num_h
669  integer (acc_device_kind) d
670  acc_get_device_num_h = acc_get_device_num_l (d)
671end function
672
673function acc_async_test_h (a)
674  use openacc_internal, only: acc_async_test_l
675  logical acc_async_test_h
676  integer a
677  if (acc_async_test_l (a) .eq. 1) then
678    acc_async_test_h = .TRUE.
679  else
680    acc_async_test_h = .FALSE.
681  end if
682end function
683
684function acc_async_test_all_h ()
685  use openacc_internal, only: acc_async_test_all_l
686  logical acc_async_test_all_h
687  if (acc_async_test_all_l () .eq. 1) then
688    acc_async_test_all_h = .TRUE.
689  else
690    acc_async_test_all_h = .FALSE.
691  end if
692end function
693
694subroutine acc_wait_h (a)
695  use openacc_internal, only: acc_wait_l
696  integer a
697  call acc_wait_l (a)
698end subroutine
699
700subroutine acc_wait_async_h (a1, a2)
701  use openacc_internal, only: acc_wait_async_l
702  integer a1, a2
703  call acc_wait_async_l (a1, a2)
704end subroutine
705
706subroutine acc_wait_all_h ()
707  use openacc_internal, only: acc_wait_all_l
708  call acc_wait_all_l ()
709end subroutine
710
711subroutine acc_wait_all_async_h (a)
712  use openacc_internal, only: acc_wait_all_async_l
713  integer a
714  call acc_wait_all_async_l (a)
715end subroutine
716
717subroutine acc_init_h (d)
718  use openacc_internal, only: acc_init_l
719  use openacc_kinds
720  integer (acc_device_kind) d
721  call acc_init_l (d)
722end subroutine
723
724subroutine acc_shutdown_h (d)
725  use openacc_internal, only: acc_shutdown_l
726  use openacc_kinds
727  integer (acc_device_kind) d
728  call acc_shutdown_l (d)
729end subroutine
730
731function acc_on_device_h (d)
732  use openacc_internal, only: acc_on_device_l
733  use openacc_kinds
734  integer (acc_device_kind) d
735  logical acc_on_device_h
736  if (acc_on_device_l (d) .eq. 1) then
737    acc_on_device_h = .TRUE.
738  else
739    acc_on_device_h = .FALSE.
740  end if
741end function
742
743subroutine acc_copyin_32_h (a, len)
744  use iso_c_binding, only: c_int32_t, c_size_t
745  use openacc_internal, only: acc_copyin_l
746  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
747  type (*), dimension (*) :: a
748  integer (c_int32_t) len
749  call acc_copyin_l (a, int (len, kind = c_size_t))
750end subroutine
751
752subroutine acc_copyin_64_h (a, len)
753  use iso_c_binding, only: c_int64_t, c_size_t
754  use openacc_internal, only: acc_copyin_l
755  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
756  type (*), dimension (*) :: a
757  integer (c_int64_t) len
758  call acc_copyin_l (a, int (len, kind = c_size_t))
759end subroutine
760
761subroutine acc_copyin_array_h (a)
762  use openacc_internal, only: acc_copyin_l
763  type (*), dimension (..), contiguous :: a
764  call acc_copyin_l (a, sizeof (a))
765end subroutine
766
767subroutine acc_present_or_copyin_32_h (a, len)
768  use iso_c_binding, only: c_int32_t, c_size_t
769  use openacc_internal, only: acc_present_or_copyin_l
770  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
771  type (*), dimension (*) :: a
772  integer (c_int32_t) len
773  call acc_present_or_copyin_l (a, int (len, kind = c_size_t))
774end subroutine
775
776subroutine acc_present_or_copyin_64_h (a, len)
777  use iso_c_binding, only: c_int64_t, c_size_t
778  use openacc_internal, only: acc_present_or_copyin_l
779  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
780  type (*), dimension (*) :: a
781  integer (c_int64_t) len
782  call acc_present_or_copyin_l (a, int (len, kind = c_size_t))
783end subroutine
784
785subroutine acc_present_or_copyin_array_h (a)
786  use openacc_internal, only: acc_present_or_copyin_l
787  type (*), dimension (..), contiguous :: a
788  call acc_present_or_copyin_l (a, sizeof (a))
789end subroutine
790
791subroutine acc_create_32_h (a, len)
792  use iso_c_binding, only: c_int32_t, c_size_t
793  use openacc_internal, only: acc_create_l
794  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
795  type (*), dimension (*) :: a
796  integer (c_int32_t) len
797  call acc_create_l (a, int (len, kind = c_size_t))
798end subroutine
799
800subroutine acc_create_64_h (a, len)
801  use iso_c_binding, only: c_int64_t, c_size_t
802  use openacc_internal, only: acc_create_l
803  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
804  type (*), dimension (*) :: a
805  integer (c_int64_t) len
806  call acc_create_l (a, int (len, kind = c_size_t))
807end subroutine
808
809subroutine acc_create_array_h (a)
810  use openacc_internal, only: acc_create_l
811  type (*), dimension (..), contiguous :: a
812  call acc_create_l (a, sizeof (a))
813end subroutine
814
815subroutine acc_present_or_create_32_h (a, len)
816  use iso_c_binding, only: c_int32_t, c_size_t
817  use openacc_internal, only: acc_present_or_create_l
818  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
819  type (*), dimension (*) :: a
820  integer (c_int32_t) len
821  call acc_present_or_create_l (a, int (len, kind = c_size_t))
822end subroutine
823
824subroutine acc_present_or_create_64_h (a, len)
825  use iso_c_binding, only: c_int64_t, c_size_t
826  use openacc_internal, only: acc_present_or_create_l
827  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
828  type (*), dimension (*) :: a
829  integer (c_int64_t) len
830  call acc_present_or_create_l (a, int (len, kind = c_size_t))
831end subroutine
832
833subroutine acc_present_or_create_array_h (a)
834  use openacc_internal, only: acc_present_or_create_l
835  type (*), dimension (..), contiguous :: a
836  call acc_present_or_create_l (a, sizeof (a))
837end subroutine
838
839subroutine acc_copyout_32_h (a, len)
840  use iso_c_binding, only: c_int32_t, c_size_t
841  use openacc_internal, only: acc_copyout_l
842  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
843  type (*), dimension (*) :: a
844  integer (c_int32_t) len
845  call acc_copyout_l (a, int (len, kind = c_size_t))
846end subroutine
847
848subroutine acc_copyout_64_h (a, len)
849  use iso_c_binding, only: c_int64_t, c_size_t
850  use openacc_internal, only: acc_copyout_l
851  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
852  type (*), dimension (*) :: a
853  integer (c_int64_t) len
854  call acc_copyout_l (a, int (len, kind = c_size_t))
855end subroutine
856
857subroutine acc_copyout_array_h (a)
858  use openacc_internal, only: acc_copyout_l
859  type (*), dimension (..), contiguous :: a
860  call acc_copyout_l (a, sizeof (a))
861end subroutine
862
863subroutine acc_delete_32_h (a, len)
864  use iso_c_binding, only: c_int32_t, c_size_t
865  use openacc_internal, only: acc_delete_l
866  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
867  type (*), dimension (*) :: a
868  integer (c_int32_t) len
869  call acc_delete_l (a, int (len, kind = c_size_t))
870end subroutine
871
872subroutine acc_delete_64_h (a, len)
873  use iso_c_binding, only: c_int64_t, c_size_t
874  use openacc_internal, only: acc_delete_l
875  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
876  type (*), dimension (*) :: a
877  integer (c_int64_t) len
878  call acc_delete_l (a, int (len, kind = c_size_t))
879end subroutine
880
881subroutine acc_delete_array_h (a)
882  use openacc_internal, only: acc_delete_l
883  type (*), dimension (..), contiguous :: a
884  call acc_delete_l (a, sizeof (a))
885end subroutine
886
887subroutine acc_update_device_32_h (a, len)
888  use iso_c_binding, only: c_int32_t, c_size_t
889  use openacc_internal, only: acc_update_device_l
890  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
891  type (*), dimension (*) :: a
892  integer (c_int32_t) len
893  call acc_update_device_l (a, int (len, kind = c_size_t))
894end subroutine
895
896subroutine acc_update_device_64_h (a, len)
897  use iso_c_binding, only: c_int64_t, c_size_t
898  use openacc_internal, only: acc_update_device_l
899  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
900  type (*), dimension (*) :: a
901  integer (c_int64_t) len
902  call acc_update_device_l (a, int (len, kind = c_size_t))
903end subroutine
904
905subroutine acc_update_device_array_h (a)
906  use openacc_internal, only: acc_update_device_l
907  type (*), dimension (..), contiguous :: a
908  call acc_update_device_l (a, sizeof (a))
909end subroutine
910
911subroutine acc_update_self_32_h (a, len)
912  use iso_c_binding, only: c_int32_t, c_size_t
913  use openacc_internal, only: acc_update_self_l
914  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
915  type (*), dimension (*) :: a
916  integer (c_int32_t) len
917  call acc_update_self_l (a, int (len, kind = c_size_t))
918end subroutine
919
920subroutine acc_update_self_64_h (a, len)
921  use iso_c_binding, only: c_int64_t, c_size_t
922  use openacc_internal, only: acc_update_self_l
923  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
924  type (*), dimension (*) :: a
925  integer (c_int64_t) len
926  call acc_update_self_l (a, int (len, kind = c_size_t))
927end subroutine
928
929subroutine acc_update_self_array_h (a)
930  use openacc_internal, only: acc_update_self_l
931  type (*), dimension (..), contiguous :: a
932  call acc_update_self_l (a, sizeof (a))
933end subroutine
934
935function acc_is_present_32_h (a, len)
936  use iso_c_binding, only: c_int32_t, c_size_t
937  use openacc_internal, only: acc_is_present_l
938  logical acc_is_present_32_h
939  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
940  type (*), dimension (*) :: a
941  integer (c_int32_t) len
942  if (acc_is_present_l (a, int (len, kind = c_size_t)) .eq. 1) then
943    acc_is_present_32_h = .TRUE.
944  else
945    acc_is_present_32_h = .FALSE.
946  end if
947end function
948
949function acc_is_present_64_h (a, len)
950  use iso_c_binding, only: c_int64_t, c_size_t
951  use openacc_internal, only: acc_is_present_l
952  logical acc_is_present_64_h
953  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
954  type (*), dimension (*) :: a
955  integer (c_int64_t) len
956  if (acc_is_present_l (a, int (len, kind = c_size_t)) .eq. 1) then
957    acc_is_present_64_h = .TRUE.
958  else
959    acc_is_present_64_h = .FALSE.
960  end if
961end function
962
963function acc_is_present_array_h (a)
964  use openacc_internal, only: acc_is_present_l
965  logical acc_is_present_array_h
966  type (*), dimension (..), contiguous :: a
967  acc_is_present_array_h = acc_is_present_l (a, sizeof (a)) == 1
968end function
969