libgomp/openacc.f90

   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
  30 module 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
  60 end module
  61
  62 module 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
 462 end module
 463
 464 module 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
 633 end module
 634
 635 function 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)
 641 end function
 642
 643 subroutine 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)
 648 end subroutine
 649
 650 function 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 ()
 655 end function
 656
 657 subroutine 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)
 663 end subroutine
 664
 665 function 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)
 671 end function
 672
 673 function 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
 682 end function
 683
 684 function 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
 692 end function
 693
 694 subroutine acc_wait_h (a)
 695   use openacc_internal, only: acc_wait_l
 696   integer a
 697   call acc_wait_l (a)
 698 end subroutine
 699
 700 subroutine 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)
 704 end subroutine
 705
 706 subroutine acc_wait_all_h ()
 707   use openacc_internal, only: acc_wait_all_l
 708   call acc_wait_all_l ()
 709 end subroutine
 710
 711 subroutine 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)
 715 end subroutine
 716
 717 subroutine 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)
 722 end subroutine
 723
 724 subroutine 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)
 729 end subroutine
 730
 731 function 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
 741 end function
 742
 743 subroutine 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))
 750 end subroutine
 751
 752 subroutine 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))
 759 end subroutine
 760
 761 subroutine 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))
 765 end subroutine
 766
 767 subroutine 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))
 774 end subroutine
 775
 776 subroutine 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))
 783 end subroutine
 784
 785 subroutine 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))
 789 end subroutine
 790
 791 subroutine 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))
 798 end subroutine
 799
 800 subroutine 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))
 807 end subroutine
 808
 809 subroutine 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))
 813 end subroutine
 814
 815 subroutine 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))
 822 end subroutine
 823
 824 subroutine 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))
 831 end subroutine
 832
 833 subroutine 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))
 837 end subroutine
 838
 839 subroutine 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))
 846 end subroutine
 847
 848 subroutine 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))
 855 end subroutine
 856
 857 subroutine 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))
 861 end subroutine
 862
 863 subroutine 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))
 870 end subroutine
 871
 872 subroutine 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))
 879 end subroutine
 880
 881 subroutine 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))
 885 end subroutine
 886
 887 subroutine 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))
 894 end subroutine
 895
 896 subroutine 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))
 903 end subroutine
 904
 905 subroutine 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))
 909 end subroutine
 910
 911 subroutine 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))
 918 end subroutine
 919
 920 subroutine 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))
 927 end subroutine
 928
 929 subroutine 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))
 933 end subroutine
 934
 935 function 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
 947 end function
 948
 949 function 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
 961 end function
 962
 963 function 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
 968 end function