contrib/gcc-5.0/libgomp/openacc.f90

   1 !  OpenACC Runtime Library Definitions.
   2
   3 !  Copyright (C) 2014-2015 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
  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, acc_wait, acc_wait_async, acc_wait_all
 474   public :: acc_wait_all_async, acc_init, acc_shutdown, acc_on_device
 475   public :: acc_copyin, acc_present_or_copyin, acc_pcopyin, acc_create
 476   public :: acc_present_or_create, acc_pcreate, acc_copyout, acc_delete
 477   public :: acc_update_device, acc_update_self, acc_is_present
 478
 479   integer, parameter :: openacc_version = 201306
 480
 481   interface acc_get_num_devices
 482     procedure :: acc_get_num_devices_h
 483   end interface
 484
 485   interface acc_set_device_type
 486     procedure :: acc_set_device_type_h
 487   end interface
 488
 489   interface acc_get_device_type
 490     procedure :: acc_get_device_type_h
 491   end interface
 492
 493   interface acc_set_device_num
 494     procedure :: acc_set_device_num_h
 495   end interface
 496
 497   interface acc_get_device_num
 498     procedure :: acc_get_device_num_h
 499   end interface
 500
 501   interface acc_async_test
 502     procedure :: acc_async_test_h
 503   end interface
 504
 505   interface acc_async_test_all
 506     procedure :: acc_async_test_all_h
 507   end interface
 508
 509   interface acc_wait
 510     procedure :: acc_wait_h
 511   end interface
 512
 513   interface acc_wait_async
 514     procedure :: acc_wait_async_h
 515   end interface
 516
 517   interface acc_wait_all
 518     procedure :: acc_wait_all_h
 519   end interface
 520
 521   interface acc_wait_all_async
 522     procedure :: acc_wait_all_async_h
 523   end interface
 524
 525   interface acc_init
 526     procedure :: acc_init_h
 527   end interface
 528
 529   interface acc_shutdown
 530     procedure :: acc_shutdown_h
 531   end interface
 532
 533   interface acc_on_device
 534     procedure :: acc_on_device_h
 535   end interface
 536
 537   ! acc_malloc: Only available in C/C++
 538   ! acc_free: Only available in C/C++
 539
 540   ! As vendor extension, the following code supports both 32bit and 64bit
 541   ! arguments for "size"; the OpenACC standard only permits default-kind
 542   ! integers, which are of kind 4 (i.e. 32 bits).
 543   ! Additionally, the two-argument version also takes arrays as argument.
 544   ! and the one argument version also scalars. Note that the code assumes
 545   ! that the arrays are contiguous.
 546
 547   interface acc_copyin
 548     procedure :: acc_copyin_32_h
 549     procedure :: acc_copyin_64_h
 550     procedure :: acc_copyin_array_h
 551   end interface
 552
 553   interface acc_present_or_copyin
 554     procedure :: acc_present_or_copyin_32_h
 555     procedure :: acc_present_or_copyin_64_h
 556     procedure :: acc_present_or_copyin_array_h
 557   end interface
 558
 559   interface acc_pcopyin
 560     procedure :: acc_present_or_copyin_32_h
 561     procedure :: acc_present_or_copyin_64_h
 562     procedure :: acc_present_or_copyin_array_h
 563   end interface
 564
 565   interface acc_create
 566     procedure :: acc_create_32_h
 567     procedure :: acc_create_64_h
 568     procedure :: acc_create_array_h
 569   end interface
 570
 571   interface acc_present_or_create
 572     procedure :: acc_present_or_create_32_h
 573     procedure :: acc_present_or_create_64_h
 574     procedure :: acc_present_or_create_array_h
 575   end interface
 576
 577   interface acc_pcreate
 578     procedure :: acc_present_or_create_32_h
 579     procedure :: acc_present_or_create_64_h
 580     procedure :: acc_present_or_create_array_h
 581   end interface
 582
 583   interface acc_copyout
 584     procedure :: acc_copyout_32_h
 585     procedure :: acc_copyout_64_h
 586     procedure :: acc_copyout_array_h
 587   end interface
 588
 589   interface acc_delete
 590     procedure :: acc_delete_32_h
 591     procedure :: acc_delete_64_h
 592     procedure :: acc_delete_array_h
 593   end interface
 594
 595   interface acc_update_device
 596     procedure :: acc_update_device_32_h
 597     procedure :: acc_update_device_64_h
 598     procedure :: acc_update_device_array_h
 599   end interface
 600
 601   interface acc_update_self
 602     procedure :: acc_update_self_32_h
 603     procedure :: acc_update_self_64_h
 604     procedure :: acc_update_self_array_h
 605   end interface
 606
 607   ! acc_map_data: Only available in C/C++
 608   ! acc_unmap_data: Only available in C/C++
 609   ! acc_deviceptr: Only available in C/C++
 610   ! acc_hostptr: Only available in C/C++
 611
 612   interface acc_is_present
 613     procedure :: acc_is_present_32_h
 614     procedure :: acc_is_present_64_h
 615     procedure :: acc_is_present_array_h
 616   end interface
 617
 618   ! acc_memcpy_to_device: Only available in C/C++
 619   ! acc_memcpy_from_device: Only available in C/C++
 620
 621 end module
 622
 623 function acc_get_num_devices_h (d)
 624   use openacc_internal, only: acc_get_num_devices_l
 625   use openacc_kinds
 626   integer acc_get_num_devices_h
 627   integer (acc_device_kind) d
 628   acc_get_num_devices_h = acc_get_num_devices_l (d)
 629 end function
 630
 631 subroutine acc_set_device_type_h (d)
 632   use openacc_internal, only: acc_set_device_type_l
 633   use openacc_kinds
 634   integer (acc_device_kind) d
 635   call acc_set_device_type_l (d)
 636 end subroutine
 637
 638 function acc_get_device_type_h ()
 639   use openacc_internal, only: acc_get_device_type_l
 640   use openacc_kinds
 641   integer (acc_device_kind) acc_get_device_type_h
 642   acc_get_device_type_h = acc_get_device_type_l ()
 643 end function
 644
 645 subroutine acc_set_device_num_h (n, d)
 646   use openacc_internal, only: acc_set_device_num_l
 647   use openacc_kinds
 648   integer n
 649   integer (acc_device_kind) d
 650   call acc_set_device_num_l (n, d)
 651 end subroutine
 652
 653 function acc_get_device_num_h (d)
 654   use openacc_internal, only: acc_get_device_num_l
 655   use openacc_kinds
 656   integer acc_get_device_num_h
 657   integer (acc_device_kind) d
 658   acc_get_device_num_h = acc_get_device_num_l (d)
 659 end function
 660
 661 function acc_async_test_h (a)
 662   use openacc_internal, only: acc_async_test_l
 663   logical acc_async_test_h
 664   integer a
 665   if (acc_async_test_l (a) .eq. 1) then
 666     acc_async_test_h = .TRUE.
 667   else
 668     acc_async_test_h = .FALSE.
 669   end if
 670 end function
 671
 672 function acc_async_test_all_h ()
 673   use openacc_internal, only: acc_async_test_all_l
 674   logical acc_async_test_all_h
 675   if (acc_async_test_all_l () .eq. 1) then
 676     acc_async_test_all_h = .TRUE.
 677   else
 678     acc_async_test_all_h = .FALSE.
 679   end if
 680 end function
 681
 682 subroutine acc_wait_h (a)
 683   use openacc_internal, only: acc_wait_l
 684   integer a
 685   call acc_wait_l (a)
 686 end subroutine
 687
 688 subroutine acc_wait_async_h (a1, a2)
 689   use openacc_internal, only: acc_wait_async_l
 690   integer a1, a2
 691   call acc_wait_async_l (a1, a2)
 692 end subroutine
 693
 694 subroutine acc_wait_all_h ()
 695   use openacc_internal, only: acc_wait_all_l
 696   call acc_wait_all_l ()
 697 end subroutine
 698
 699 subroutine acc_wait_all_async_h (a)
 700   use openacc_internal, only: acc_wait_all_async_l
 701   integer a
 702   call acc_wait_all_async_l (a)
 703 end subroutine
 704
 705 subroutine acc_init_h (d)
 706   use openacc_internal, only: acc_init_l
 707   use openacc_kinds
 708   integer (acc_device_kind) d
 709   call acc_init_l (d)
 710 end subroutine
 711
 712 subroutine acc_shutdown_h (d)
 713   use openacc_internal, only: acc_shutdown_l
 714   use openacc_kinds
 715   integer (acc_device_kind) d
 716   call acc_shutdown_l (d)
 717 end subroutine
 718
 719 function acc_on_device_h (d)
 720   use openacc_internal, only: acc_on_device_l
 721   use openacc_kinds
 722   integer (acc_device_kind) d
 723   logical acc_on_device_h
 724   if (acc_on_device_l (d) .eq. 1) then
 725     acc_on_device_h = .TRUE.
 726   else
 727     acc_on_device_h = .FALSE.
 728   end if
 729 end function
 730
 731 subroutine acc_copyin_32_h (a, len)
 732   use iso_c_binding, only: c_int32_t, c_size_t
 733   use openacc_internal, only: acc_copyin_l
 734   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 735   type (*), dimension (*) :: a
 736   integer (c_int32_t) len
 737   call acc_copyin_l (a, int (len, kind = c_size_t))
 738 end subroutine
 739
 740 subroutine acc_copyin_64_h (a, len)
 741   use iso_c_binding, only: c_int64_t, c_size_t
 742   use openacc_internal, only: acc_copyin_l
 743   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 744   type (*), dimension (*) :: a
 745   integer (c_int64_t) len
 746   call acc_copyin_l (a, int (len, kind = c_size_t))
 747 end subroutine
 748
 749 subroutine acc_copyin_array_h (a)
 750   use openacc_internal, only: acc_copyin_l
 751   type (*), dimension (..), contiguous :: a
 752   call acc_copyin_l (a, sizeof (a))
 753 end subroutine
 754
 755 subroutine acc_present_or_copyin_32_h (a, len)
 756   use iso_c_binding, only: c_int32_t, c_size_t
 757   use openacc_internal, only: acc_present_or_copyin_l
 758   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 759   type (*), dimension (*) :: a
 760   integer (c_int32_t) len
 761   call acc_present_or_copyin_l (a, int (len, kind = c_size_t))
 762 end subroutine
 763
 764 subroutine acc_present_or_copyin_64_h (a, len)
 765   use iso_c_binding, only: c_int64_t, c_size_t
 766   use openacc_internal, only: acc_present_or_copyin_l
 767   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 768   type (*), dimension (*) :: a
 769   integer (c_int64_t) len
 770   call acc_present_or_copyin_l (a, int (len, kind = c_size_t))
 771 end subroutine
 772
 773 subroutine acc_present_or_copyin_array_h (a)
 774   use openacc_internal, only: acc_present_or_copyin_l
 775   type (*), dimension (..), contiguous :: a
 776   call acc_present_or_copyin_l (a, sizeof (a))
 777 end subroutine
 778
 779 subroutine acc_create_32_h (a, len)
 780   use iso_c_binding, only: c_int32_t, c_size_t
 781   use openacc_internal, only: acc_create_l
 782   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 783   type (*), dimension (*) :: a
 784   integer (c_int32_t) len
 785   call acc_create_l (a, int (len, kind = c_size_t))
 786 end subroutine
 787
 788 subroutine acc_create_64_h (a, len)
 789   use iso_c_binding, only: c_int64_t, c_size_t
 790   use openacc_internal, only: acc_create_l
 791   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 792   type (*), dimension (*) :: a
 793   integer (c_int64_t) len
 794   call acc_create_l (a, int (len, kind = c_size_t))
 795 end subroutine
 796
 797 subroutine acc_create_array_h (a)
 798   use openacc_internal, only: acc_create_l
 799   type (*), dimension (..), contiguous :: a
 800   call acc_create_l (a, sizeof (a))
 801 end subroutine
 802
 803 subroutine acc_present_or_create_32_h (a, len)
 804   use iso_c_binding, only: c_int32_t, c_size_t
 805   use openacc_internal, only: acc_present_or_create_l
 806   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 807   type (*), dimension (*) :: a
 808   integer (c_int32_t) len
 809   call acc_present_or_create_l (a, int (len, kind = c_size_t))
 810 end subroutine
 811
 812 subroutine acc_present_or_create_64_h (a, len)
 813   use iso_c_binding, only: c_int64_t, c_size_t
 814   use openacc_internal, only: acc_present_or_create_l
 815   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 816   type (*), dimension (*) :: a
 817   integer (c_int64_t) len
 818   call acc_present_or_create_l (a, int (len, kind = c_size_t))
 819 end subroutine
 820
 821 subroutine acc_present_or_create_array_h (a)
 822   use openacc_internal, only: acc_present_or_create_l
 823   type (*), dimension (..), contiguous :: a
 824   call acc_present_or_create_l (a, sizeof (a))
 825 end subroutine
 826
 827 subroutine acc_copyout_32_h (a, len)
 828   use iso_c_binding, only: c_int32_t, c_size_t
 829   use openacc_internal, only: acc_copyout_l
 830   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 831   type (*), dimension (*) :: a
 832   integer (c_int32_t) len
 833   call acc_copyout_l (a, int (len, kind = c_size_t))
 834 end subroutine
 835
 836 subroutine acc_copyout_64_h (a, len)
 837   use iso_c_binding, only: c_int64_t, c_size_t
 838   use openacc_internal, only: acc_copyout_l
 839   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 840   type (*), dimension (*) :: a
 841   integer (c_int64_t) len
 842   call acc_copyout_l (a, int (len, kind = c_size_t))
 843 end subroutine
 844
 845 subroutine acc_copyout_array_h (a)
 846   use openacc_internal, only: acc_copyout_l
 847   type (*), dimension (..), contiguous :: a
 848   call acc_copyout_l (a, sizeof (a))
 849 end subroutine
 850
 851 subroutine acc_delete_32_h (a, len)
 852   use iso_c_binding, only: c_int32_t, c_size_t
 853   use openacc_internal, only: acc_delete_l
 854   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 855   type (*), dimension (*) :: a
 856   integer (c_int32_t) len
 857   call acc_delete_l (a, int (len, kind = c_size_t))
 858 end subroutine
 859
 860 subroutine acc_delete_64_h (a, len)
 861   use iso_c_binding, only: c_int64_t, c_size_t
 862   use openacc_internal, only: acc_delete_l
 863   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 864   type (*), dimension (*) :: a
 865   integer (c_int64_t) len
 866   call acc_delete_l (a, int (len, kind = c_size_t))
 867 end subroutine
 868
 869 subroutine acc_delete_array_h (a)
 870   use openacc_internal, only: acc_delete_l
 871   type (*), dimension (..), contiguous :: a
 872   call acc_delete_l (a, sizeof (a))
 873 end subroutine
 874
 875 subroutine acc_update_device_32_h (a, len)
 876   use iso_c_binding, only: c_int32_t, c_size_t
 877   use openacc_internal, only: acc_update_device_l
 878   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 879   type (*), dimension (*) :: a
 880   integer (c_int32_t) len
 881   call acc_update_device_l (a, int (len, kind = c_size_t))
 882 end subroutine
 883
 884 subroutine acc_update_device_64_h (a, len)
 885   use iso_c_binding, only: c_int64_t, c_size_t
 886   use openacc_internal, only: acc_update_device_l
 887   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 888   type (*), dimension (*) :: a
 889   integer (c_int64_t) len
 890   call acc_update_device_l (a, int (len, kind = c_size_t))
 891 end subroutine
 892
 893 subroutine acc_update_device_array_h (a)
 894   use openacc_internal, only: acc_update_device_l
 895   type (*), dimension (..), contiguous :: a
 896   call acc_update_device_l (a, sizeof (a))
 897 end subroutine
 898
 899 subroutine acc_update_self_32_h (a, len)
 900   use iso_c_binding, only: c_int32_t, c_size_t
 901   use openacc_internal, only: acc_update_self_l
 902   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 903   type (*), dimension (*) :: a
 904   integer (c_int32_t) len
 905   call acc_update_self_l (a, int (len, kind = c_size_t))
 906 end subroutine
 907
 908 subroutine acc_update_self_64_h (a, len)
 909   use iso_c_binding, only: c_int64_t, c_size_t
 910   use openacc_internal, only: acc_update_self_l
 911   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 912   type (*), dimension (*) :: a
 913   integer (c_int64_t) len
 914   call acc_update_self_l (a, int (len, kind = c_size_t))
 915 end subroutine
 916
 917 subroutine acc_update_self_array_h (a)
 918   use openacc_internal, only: acc_update_self_l
 919   type (*), dimension (..), contiguous :: a
 920   call acc_update_self_l (a, sizeof (a))
 921 end subroutine
 922
 923 function acc_is_present_32_h (a, len)
 924   use iso_c_binding, only: c_int32_t, c_size_t
 925   use openacc_internal, only: acc_is_present_l
 926   logical acc_is_present_32_h
 927   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 928   type (*), dimension (*) :: a
 929   integer (c_int32_t) len
 930   if (acc_is_present_l (a, int (len, kind = c_size_t)) .eq. 1) then
 931     acc_is_present_32_h = .TRUE.
 932   else
 933     acc_is_present_32_h = .FALSE.
 934   end if
 935 end function
 936
 937 function acc_is_present_64_h (a, len)
 938   use iso_c_binding, only: c_int64_t, c_size_t
 939   use openacc_internal, only: acc_is_present_l
 940   logical acc_is_present_64_h
 941   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 942   type (*), dimension (*) :: a
 943   integer (c_int64_t) len
 944   if (acc_is_present_l (a, int (len, kind = c_size_t)) .eq. 1) then
 945     acc_is_present_64_h = .TRUE.
 946   else
 947     acc_is_present_64_h = .FALSE.
 948   end if
 949 end function
 950
 951 function acc_is_present_array_h (a)
 952   use openacc_internal, only: acc_is_present_l
 953   logical acc_is_present_array_h
 954   type (*), dimension (..), contiguous :: a
 955   acc_is_present_array_h = acc_is_present_l (a, sizeof (a)) == 1
 956 end function