libgomp/openacc.f90

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