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_copyout_finalize_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_copyout_finalize_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_copyout_finalize_array_h (a)
 240       type (*), dimension (..), contiguous :: a
 241     end subroutine
 242
 243     subroutine acc_delete_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_delete_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_delete_array_h (a)
 258       type (*), dimension (..), contiguous :: a
 259     end subroutine
 260
 261     subroutine acc_delete_finalize_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_delete_finalize_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_delete_finalize_array_h (a)
 276       type (*), dimension (..), contiguous :: a
 277     end subroutine
 278
 279     subroutine acc_update_device_32_h (a, len)
 280       use iso_c_binding, only: c_int32_t
 281       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 282       type (*), dimension (*) :: a
 283       integer (c_int32_t) len
 284     end subroutine
 285
 286     subroutine acc_update_device_64_h (a, len)
 287       use iso_c_binding, only: c_int64_t
 288       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 289       type (*), dimension (*) :: a
 290       integer (c_int64_t) len
 291     end subroutine
 292
 293     subroutine acc_update_device_array_h (a)
 294       type (*), dimension (..), contiguous :: a
 295     end subroutine
 296
 297     subroutine acc_update_self_32_h (a, len)
 298       use iso_c_binding, only: c_int32_t
 299       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 300       type (*), dimension (*) :: a
 301       integer (c_int32_t) len
 302     end subroutine
 303
 304     subroutine acc_update_self_64_h (a, len)
 305       use iso_c_binding, only: c_int64_t
 306       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 307       type (*), dimension (*) :: a
 308       integer (c_int64_t) len
 309     end subroutine
 310
 311     subroutine acc_update_self_array_h (a)
 312       type (*), dimension (..), contiguous :: a
 313     end subroutine
 314
 315     function acc_is_present_32_h (a, len)
 316       use iso_c_binding, only: c_int32_t
 317       logical acc_is_present_32_h
 318       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 319       type (*), dimension (*) :: a
 320       integer (c_int32_t) len
 321     end function
 322
 323     function acc_is_present_64_h (a, len)
 324       use iso_c_binding, only: c_int64_t
 325       logical acc_is_present_64_h
 326       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 327       type (*), dimension (*) :: a
 328       integer (c_int64_t) len
 329     end function
 330
 331     function acc_is_present_array_h (a)
 332       logical acc_is_present_array_h
 333       type (*), dimension (..), contiguous :: a
 334     end function
 335   end interface
 336
 337   interface
 338     function acc_get_num_devices_l (d) &
 339         bind (C, name = "acc_get_num_devices")
 340       use iso_c_binding, only: c_int
 341       integer (c_int) :: acc_get_num_devices_l
 342       integer (c_int), value :: d
 343     end function
 344
 345     subroutine acc_set_device_type_l (d) &
 346         bind (C, name = "acc_set_device_type")
 347       use iso_c_binding, only: c_int
 348       integer (c_int), value :: d
 349     end subroutine
 350
 351     function acc_get_device_type_l () &
 352         bind (C, name = "acc_get_device_type")
 353       use iso_c_binding, only: c_int
 354       integer (c_int) :: acc_get_device_type_l
 355     end function
 356
 357     subroutine acc_set_device_num_l (n, d) &
 358         bind (C, name = "acc_set_device_num")
 359       use iso_c_binding, only: c_int
 360       integer (c_int), value :: n, d
 361     end subroutine
 362
 363     function acc_get_device_num_l (d) &
 364         bind (C, name = "acc_get_device_num")
 365       use iso_c_binding, only: c_int
 366       integer (c_int) :: acc_get_device_num_l
 367       integer (c_int), value :: d
 368     end function
 369
 370     function acc_async_test_l (a) &
 371         bind (C, name = "acc_async_test")
 372       use iso_c_binding, only: c_int
 373       integer (c_int) :: acc_async_test_l
 374       integer (c_int), value :: a
 375     end function
 376
 377     function acc_async_test_all_l () &
 378         bind (C, name = "acc_async_test_all")
 379       use iso_c_binding, only: c_int
 380       integer (c_int) :: acc_async_test_all_l
 381     end function
 382
 383     subroutine acc_wait_l (a) &
 384         bind (C, name = "acc_wait")
 385       use iso_c_binding, only: c_int
 386       integer (c_int), value :: a
 387     end subroutine
 388
 389     subroutine acc_wait_async_l (a1, a2) &
 390         bind (C, name = "acc_wait_async")
 391       use iso_c_binding, only: c_int
 392       integer (c_int), value :: a1, a2
 393     end subroutine
 394
 395     subroutine acc_wait_all_l () &
 396         bind (C, name = "acc_wait_all")
 397       use iso_c_binding, only: c_int
 398     end subroutine
 399
 400     subroutine acc_wait_all_async_l (a) &
 401         bind (C, name = "acc_wait_all_async")
 402       use iso_c_binding, only: c_int
 403       integer (c_int), value :: a
 404     end subroutine
 405
 406     subroutine acc_init_l (d) &
 407         bind (C, name = "acc_init")
 408       use iso_c_binding, only: c_int
 409       integer (c_int), value :: d
 410     end subroutine
 411
 412     subroutine acc_shutdown_l (d) &
 413         bind (C, name = "acc_shutdown")
 414       use iso_c_binding, only: c_int
 415       integer (c_int), value :: d
 416     end subroutine
 417
 418     function acc_on_device_l (d) &
 419         bind (C, name = "acc_on_device")
 420       use iso_c_binding, only: c_int
 421       integer (c_int) :: acc_on_device_l
 422       integer (c_int), value :: d
 423     end function
 424
 425     subroutine acc_copyin_l (a, len) &
 426         bind (C, name = "acc_copyin")
 427       use iso_c_binding, only: c_size_t
 428       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 429       type (*), dimension (*) :: a
 430       integer (c_size_t), value :: len
 431     end subroutine
 432
 433     subroutine acc_present_or_copyin_l (a, len) &
 434         bind (C, name = "acc_present_or_copyin")
 435       use iso_c_binding, only: c_size_t
 436       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 437       type (*), dimension (*) :: a
 438       integer (c_size_t), value :: len
 439     end subroutine
 440
 441     subroutine acc_create_l (a, len) &
 442         bind (C, name = "acc_create")
 443       use iso_c_binding, only: c_size_t
 444       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 445       type (*), dimension (*) :: a
 446       integer (c_size_t), value :: len
 447     end subroutine
 448
 449     subroutine acc_present_or_create_l (a, len) &
 450         bind (C, name = "acc_present_or_create")
 451       use iso_c_binding, only: c_size_t
 452       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 453       type (*), dimension (*) :: a
 454       integer (c_size_t), value :: len
 455     end subroutine
 456
 457     subroutine acc_copyout_l (a, len) &
 458         bind (C, name = "acc_copyout")
 459       use iso_c_binding, only: c_size_t
 460       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 461       type (*), dimension (*) :: a
 462       integer (c_size_t), value :: len
 463     end subroutine
 464
 465     subroutine acc_copyout_finalize_l (a, len) &
 466         bind (C, name = "acc_copyout_finalize")
 467       use iso_c_binding, only: c_size_t
 468       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 469       type (*), dimension (*) :: a
 470       integer (c_size_t), value :: len
 471     end subroutine
 472
 473     subroutine acc_delete_l (a, len) &
 474         bind (C, name = "acc_delete")
 475       use iso_c_binding, only: c_size_t
 476       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 477       type (*), dimension (*) :: a
 478       integer (c_size_t), value :: len
 479     end subroutine
 480
 481     subroutine acc_delete_finalize_l (a, len) &
 482         bind (C, name = "acc_delete_finalize")
 483       use iso_c_binding, only: c_size_t
 484       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 485       type (*), dimension (*) :: a
 486       integer (c_size_t), value :: len
 487     end subroutine
 488
 489     subroutine acc_update_device_l (a, len) &
 490         bind (C, name = "acc_update_device")
 491       use iso_c_binding, only: c_size_t
 492       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 493       type (*), dimension (*) :: a
 494       integer (c_size_t), value :: len
 495     end subroutine
 496
 497     subroutine acc_update_self_l (a, len) &
 498         bind (C, name = "acc_update_self")
 499       use iso_c_binding, only: c_size_t
 500       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 501       type (*), dimension (*) :: a
 502       integer (c_size_t), value :: len
 503     end subroutine
 504
 505     function acc_is_present_l (a, len) &
 506         bind (C, name = "acc_is_present")
 507       use iso_c_binding, only: c_int32_t, c_size_t
 508       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 509       integer (c_int32_t) :: acc_is_present_l
 510       type (*), dimension (*) :: a
 511       integer (c_size_t), value :: len
 512     end function
 513   end interface
 514 end module
 515
 516 module openacc
 517   use openacc_kinds
 518   use openacc_internal
 519   implicit none
 520
 521   public :: openacc_version
 522
 523   public :: acc_get_num_devices, acc_set_device_type, acc_get_device_type
 524   public :: acc_set_device_num, acc_get_device_num, acc_async_test
 525   public :: acc_async_test_all
 526   public :: acc_wait, acc_async_wait, acc_wait_async
 527   public :: acc_wait_all, acc_async_wait_all, acc_wait_all_async
 528   public :: acc_init, acc_shutdown, acc_on_device
 529   public :: acc_copyin, acc_present_or_copyin, acc_pcopyin, acc_create
 530   public :: acc_present_or_create, acc_pcreate, acc_copyout, acc_delete
 531   public :: acc_update_device, acc_update_self, acc_is_present
 532
 533   integer, parameter :: openacc_version = 201306
 534
 535   interface acc_get_num_devices
 536     procedure :: acc_get_num_devices_h
 537   end interface
 538
 539   interface acc_set_device_type
 540     procedure :: acc_set_device_type_h
 541   end interface
 542
 543   interface acc_get_device_type
 544     procedure :: acc_get_device_type_h
 545   end interface
 546
 547   interface acc_set_device_num
 548     procedure :: acc_set_device_num_h
 549   end interface
 550
 551   interface acc_get_device_num
 552     procedure :: acc_get_device_num_h
 553   end interface
 554
 555   interface acc_async_test
 556     procedure :: acc_async_test_h
 557   end interface
 558
 559   interface acc_async_test_all
 560     procedure :: acc_async_test_all_h
 561   end interface
 562
 563   interface acc_wait
 564     procedure :: acc_wait_h
 565   end interface
 566
 567   ! acc_async_wait is an OpenACC 1.0 compatibility name for acc_wait.
 568   interface acc_async_wait
 569     procedure :: acc_wait_h
 570   end interface
 571
 572   interface acc_wait_async
 573     procedure :: acc_wait_async_h
 574   end interface
 575
 576   interface acc_wait_all
 577     procedure :: acc_wait_all_h
 578   end interface
 579
 580   ! acc_async_wait_all is an OpenACC 1.0 compatibility name for acc_wait_all.
 581   interface acc_async_wait_all
 582     procedure :: acc_wait_all_h
 583   end interface
 584
 585   interface acc_wait_all_async
 586     procedure :: acc_wait_all_async_h
 587   end interface
 588
 589   interface acc_init
 590     procedure :: acc_init_h
 591   end interface
 592
 593   interface acc_shutdown
 594     procedure :: acc_shutdown_h
 595   end interface
 596
 597   interface acc_on_device
 598     procedure :: acc_on_device_h
 599   end interface
 600
 601   ! acc_malloc: Only available in C/C++
 602   ! acc_free: Only available in C/C++
 603
 604   ! As vendor extension, the following code supports both 32bit and 64bit
 605   ! arguments for "size"; the OpenACC standard only permits default-kind
 606   ! integers, which are of kind 4 (i.e. 32 bits).
 607   ! Additionally, the two-argument version also takes arrays as argument.
 608   ! and the one argument version also scalars. Note that the code assumes
 609   ! that the arrays are contiguous.
 610
 611   interface acc_copyin
 612     procedure :: acc_copyin_32_h
 613     procedure :: acc_copyin_64_h
 614     procedure :: acc_copyin_array_h
 615   end interface
 616
 617   interface acc_present_or_copyin
 618     procedure :: acc_present_or_copyin_32_h
 619     procedure :: acc_present_or_copyin_64_h
 620     procedure :: acc_present_or_copyin_array_h
 621   end interface
 622
 623   interface acc_pcopyin
 624     procedure :: acc_present_or_copyin_32_h
 625     procedure :: acc_present_or_copyin_64_h
 626     procedure :: acc_present_or_copyin_array_h
 627   end interface
 628
 629   interface acc_create
 630     procedure :: acc_create_32_h
 631     procedure :: acc_create_64_h
 632     procedure :: acc_create_array_h
 633   end interface
 634
 635   interface acc_present_or_create
 636     procedure :: acc_present_or_create_32_h
 637     procedure :: acc_present_or_create_64_h
 638     procedure :: acc_present_or_create_array_h
 639   end interface
 640
 641   interface acc_pcreate
 642     procedure :: acc_present_or_create_32_h
 643     procedure :: acc_present_or_create_64_h
 644     procedure :: acc_present_or_create_array_h
 645   end interface
 646
 647   interface acc_copyout
 648     procedure :: acc_copyout_32_h
 649     procedure :: acc_copyout_64_h
 650     procedure :: acc_copyout_array_h
 651   end interface
 652
 653   interface acc_copyout_finalize
 654     procedure :: acc_copyout_finalize_32_h
 655     procedure :: acc_copyout_finalize_64_h
 656     procedure :: acc_copyout_finalize_array_h
 657   end interface
 658
 659   interface acc_delete
 660     procedure :: acc_delete_32_h
 661     procedure :: acc_delete_64_h
 662     procedure :: acc_delete_array_h
 663   end interface
 664
 665   interface acc_delete_finalize
 666     procedure :: acc_delete_finalize_32_h
 667     procedure :: acc_delete_finalize_64_h
 668     procedure :: acc_delete_finalize_array_h
 669   end interface
 670
 671   interface acc_update_device
 672     procedure :: acc_update_device_32_h
 673     procedure :: acc_update_device_64_h
 674     procedure :: acc_update_device_array_h
 675   end interface
 676
 677   interface acc_update_self
 678     procedure :: acc_update_self_32_h
 679     procedure :: acc_update_self_64_h
 680     procedure :: acc_update_self_array_h
 681   end interface
 682
 683   ! acc_map_data: Only available in C/C++
 684   ! acc_unmap_data: Only available in C/C++
 685   ! acc_deviceptr: Only available in C/C++
 686   ! acc_hostptr: Only available in C/C++
 687
 688   interface acc_is_present
 689     procedure :: acc_is_present_32_h
 690     procedure :: acc_is_present_64_h
 691     procedure :: acc_is_present_array_h
 692   end interface
 693
 694   ! acc_memcpy_to_device: Only available in C/C++
 695   ! acc_memcpy_from_device: Only available in C/C++
 696
 697 end module
 698
 699 function acc_get_num_devices_h (d)
 700   use openacc_internal, only: acc_get_num_devices_l
 701   use openacc_kinds
 702   integer acc_get_num_devices_h
 703   integer (acc_device_kind) d
 704   acc_get_num_devices_h = acc_get_num_devices_l (d)
 705 end function
 706
 707 subroutine acc_set_device_type_h (d)
 708   use openacc_internal, only: acc_set_device_type_l
 709   use openacc_kinds
 710   integer (acc_device_kind) d
 711   call acc_set_device_type_l (d)
 712 end subroutine
 713
 714 function acc_get_device_type_h ()
 715   use openacc_internal, only: acc_get_device_type_l
 716   use openacc_kinds
 717   integer (acc_device_kind) acc_get_device_type_h
 718   acc_get_device_type_h = acc_get_device_type_l ()
 719 end function
 720
 721 subroutine acc_set_device_num_h (n, d)
 722   use openacc_internal, only: acc_set_device_num_l
 723   use openacc_kinds
 724   integer n
 725   integer (acc_device_kind) d
 726   call acc_set_device_num_l (n, d)
 727 end subroutine
 728
 729 function acc_get_device_num_h (d)
 730   use openacc_internal, only: acc_get_device_num_l
 731   use openacc_kinds
 732   integer acc_get_device_num_h
 733   integer (acc_device_kind) d
 734   acc_get_device_num_h = acc_get_device_num_l (d)
 735 end function
 736
 737 function acc_async_test_h (a)
 738   use openacc_internal, only: acc_async_test_l
 739   logical acc_async_test_h
 740   integer a
 741   if (acc_async_test_l (a) .eq. 1) then
 742     acc_async_test_h = .TRUE.
 743   else
 744     acc_async_test_h = .FALSE.
 745   end if
 746 end function
 747
 748 function acc_async_test_all_h ()
 749   use openacc_internal, only: acc_async_test_all_l
 750   logical acc_async_test_all_h
 751   if (acc_async_test_all_l () .eq. 1) then
 752     acc_async_test_all_h = .TRUE.
 753   else
 754     acc_async_test_all_h = .FALSE.
 755   end if
 756 end function
 757
 758 subroutine acc_wait_h (a)
 759   use openacc_internal, only: acc_wait_l
 760   integer a
 761   call acc_wait_l (a)
 762 end subroutine
 763
 764 subroutine acc_wait_async_h (a1, a2)
 765   use openacc_internal, only: acc_wait_async_l
 766   integer a1, a2
 767   call acc_wait_async_l (a1, a2)
 768 end subroutine
 769
 770 subroutine acc_wait_all_h ()
 771   use openacc_internal, only: acc_wait_all_l
 772   call acc_wait_all_l ()
 773 end subroutine
 774
 775 subroutine acc_wait_all_async_h (a)
 776   use openacc_internal, only: acc_wait_all_async_l
 777   integer a
 778   call acc_wait_all_async_l (a)
 779 end subroutine
 780
 781 subroutine acc_init_h (d)
 782   use openacc_internal, only: acc_init_l
 783   use openacc_kinds
 784   integer (acc_device_kind) d
 785   call acc_init_l (d)
 786 end subroutine
 787
 788 subroutine acc_shutdown_h (d)
 789   use openacc_internal, only: acc_shutdown_l
 790   use openacc_kinds
 791   integer (acc_device_kind) d
 792   call acc_shutdown_l (d)
 793 end subroutine
 794
 795 function acc_on_device_h (d)
 796   use openacc_internal, only: acc_on_device_l
 797   use openacc_kinds
 798   integer (acc_device_kind) d
 799   logical acc_on_device_h
 800   if (acc_on_device_l (d) .eq. 1) then
 801     acc_on_device_h = .TRUE.
 802   else
 803     acc_on_device_h = .FALSE.
 804   end if
 805 end function
 806
 807 subroutine acc_copyin_32_h (a, len)
 808   use iso_c_binding, only: c_int32_t, c_size_t
 809   use openacc_internal, only: acc_copyin_l
 810   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 811   type (*), dimension (*) :: a
 812   integer (c_int32_t) len
 813   call acc_copyin_l (a, int (len, kind = c_size_t))
 814 end subroutine
 815
 816 subroutine acc_copyin_64_h (a, len)
 817   use iso_c_binding, only: c_int64_t, c_size_t
 818   use openacc_internal, only: acc_copyin_l
 819   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 820   type (*), dimension (*) :: a
 821   integer (c_int64_t) len
 822   call acc_copyin_l (a, int (len, kind = c_size_t))
 823 end subroutine
 824
 825 subroutine acc_copyin_array_h (a)
 826   use openacc_internal, only: acc_copyin_l
 827   type (*), dimension (..), contiguous :: a
 828   call acc_copyin_l (a, sizeof (a))
 829 end subroutine
 830
 831 subroutine acc_present_or_copyin_32_h (a, len)
 832   use iso_c_binding, only: c_int32_t, c_size_t
 833   use openacc_internal, only: acc_present_or_copyin_l
 834   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 835   type (*), dimension (*) :: a
 836   integer (c_int32_t) len
 837   call acc_present_or_copyin_l (a, int (len, kind = c_size_t))
 838 end subroutine
 839
 840 subroutine acc_present_or_copyin_64_h (a, len)
 841   use iso_c_binding, only: c_int64_t, c_size_t
 842   use openacc_internal, only: acc_present_or_copyin_l
 843   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 844   type (*), dimension (*) :: a
 845   integer (c_int64_t) len
 846   call acc_present_or_copyin_l (a, int (len, kind = c_size_t))
 847 end subroutine
 848
 849 subroutine acc_present_or_copyin_array_h (a)
 850   use openacc_internal, only: acc_present_or_copyin_l
 851   type (*), dimension (..), contiguous :: a
 852   call acc_present_or_copyin_l (a, sizeof (a))
 853 end subroutine
 854
 855 subroutine acc_create_32_h (a, len)
 856   use iso_c_binding, only: c_int32_t, c_size_t
 857   use openacc_internal, only: acc_create_l
 858   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 859   type (*), dimension (*) :: a
 860   integer (c_int32_t) len
 861   call acc_create_l (a, int (len, kind = c_size_t))
 862 end subroutine
 863
 864 subroutine acc_create_64_h (a, len)
 865   use iso_c_binding, only: c_int64_t, c_size_t
 866   use openacc_internal, only: acc_create_l
 867   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 868   type (*), dimension (*) :: a
 869   integer (c_int64_t) len
 870   call acc_create_l (a, int (len, kind = c_size_t))
 871 end subroutine
 872
 873 subroutine acc_create_array_h (a)
 874   use openacc_internal, only: acc_create_l
 875   type (*), dimension (..), contiguous :: a
 876   call acc_create_l (a, sizeof (a))
 877 end subroutine
 878
 879 subroutine acc_present_or_create_32_h (a, len)
 880   use iso_c_binding, only: c_int32_t, c_size_t
 881   use openacc_internal, only: acc_present_or_create_l
 882   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 883   type (*), dimension (*) :: a
 884   integer (c_int32_t) len
 885   call acc_present_or_create_l (a, int (len, kind = c_size_t))
 886 end subroutine
 887
 888 subroutine acc_present_or_create_64_h (a, len)
 889   use iso_c_binding, only: c_int64_t, c_size_t
 890   use openacc_internal, only: acc_present_or_create_l
 891   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 892   type (*), dimension (*) :: a
 893   integer (c_int64_t) len
 894   call acc_present_or_create_l (a, int (len, kind = c_size_t))
 895 end subroutine
 896
 897 subroutine acc_present_or_create_array_h (a)
 898   use openacc_internal, only: acc_present_or_create_l
 899   type (*), dimension (..), contiguous :: a
 900   call acc_present_or_create_l (a, sizeof (a))
 901 end subroutine
 902
 903 subroutine acc_copyout_32_h (a, len)
 904   use iso_c_binding, only: c_int32_t, c_size_t
 905   use openacc_internal, only: acc_copyout_l
 906   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 907   type (*), dimension (*) :: a
 908   integer (c_int32_t) len
 909   call acc_copyout_l (a, int (len, kind = c_size_t))
 910 end subroutine
 911
 912 subroutine acc_copyout_64_h (a, len)
 913   use iso_c_binding, only: c_int64_t, c_size_t
 914   use openacc_internal, only: acc_copyout_l
 915   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 916   type (*), dimension (*) :: a
 917   integer (c_int64_t) len
 918   call acc_copyout_l (a, int (len, kind = c_size_t))
 919 end subroutine
 920
 921 subroutine acc_copyout_array_h (a)
 922   use openacc_internal, only: acc_copyout_l
 923   type (*), dimension (..), contiguous :: a
 924   call acc_copyout_l (a, sizeof (a))
 925 end subroutine
 926
 927 subroutine acc_copyout_finalize_32_h (a, len)
 928   use iso_c_binding, only: c_int32_t, c_size_t
 929   use openacc_internal, only: acc_copyout_finalize_l
 930   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 931   type (*), dimension (*) :: a
 932   integer (c_int32_t) len
 933   call acc_copyout_finalize_l (a, int (len, kind = c_size_t))
 934 end subroutine
 935
 936 subroutine acc_copyout_finalize_64_h (a, len)
 937   use iso_c_binding, only: c_int64_t, c_size_t
 938   use openacc_internal, only: acc_copyout_finalize_l
 939   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 940   type (*), dimension (*) :: a
 941   integer (c_int64_t) len
 942   call acc_copyout_finalize_l (a, int (len, kind = c_size_t))
 943 end subroutine
 944
 945 subroutine acc_copyout_finalize_array_h (a)
 946   use openacc_internal, only: acc_copyout_finalize_l
 947   type (*), dimension (..), contiguous :: a
 948   call acc_copyout_finalize_l (a, sizeof (a))
 949 end subroutine
 950
 951 subroutine acc_delete_32_h (a, len)
 952   use iso_c_binding, only: c_int32_t, c_size_t
 953   use openacc_internal, only: acc_delete_l
 954   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 955   type (*), dimension (*) :: a
 956   integer (c_int32_t) len
 957   call acc_delete_l (a, int (len, kind = c_size_t))
 958 end subroutine
 959
 960 subroutine acc_delete_64_h (a, len)
 961   use iso_c_binding, only: c_int64_t, c_size_t
 962   use openacc_internal, only: acc_delete_l
 963   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 964   type (*), dimension (*) :: a
 965   integer (c_int64_t) len
 966   call acc_delete_l (a, int (len, kind = c_size_t))
 967 end subroutine
 968
 969 subroutine acc_delete_array_h (a)
 970   use openacc_internal, only: acc_delete_l
 971   type (*), dimension (..), contiguous :: a
 972   call acc_delete_l (a, sizeof (a))
 973 end subroutine
 974
 975 subroutine acc_delete_finalize_32_h (a, len)
 976   use iso_c_binding, only: c_int32_t, c_size_t
 977   use openacc_internal, only: acc_delete_finalize_l
 978   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 979   type (*), dimension (*) :: a
 980   integer (c_int32_t) len
 981   call acc_delete_finalize_l (a, int (len, kind = c_size_t))
 982 end subroutine
 983
 984 subroutine acc_delete_finalize_64_h (a, len)
 985   use iso_c_binding, only: c_int64_t, c_size_t
 986   use openacc_internal, only: acc_delete_finalize_l
 987   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 988   type (*), dimension (*) :: a
 989   integer (c_int64_t) len
 990   call acc_delete_finalize_l (a, int (len, kind = c_size_t))
 991 end subroutine
 992
 993 subroutine acc_delete_finalize_array_h (a)
 994   use openacc_internal, only: acc_delete_finalize_l
 995   type (*), dimension (..), contiguous :: a
 996   call acc_delete_finalize_l (a, sizeof (a))
 997 end subroutine
 998
 999 subroutine acc_update_device_32_h (a, len)
1000   use iso_c_binding, only: c_int32_t, c_size_t
1001   use openacc_internal, only: acc_update_device_l
1002   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1003   type (*), dimension (*) :: a
1004   integer (c_int32_t) len
1005   call acc_update_device_l (a, int (len, kind = c_size_t))
1006 end subroutine
1007
1008 subroutine acc_update_device_64_h (a, len)
1009   use iso_c_binding, only: c_int64_t, c_size_t
1010   use openacc_internal, only: acc_update_device_l
1011   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1012   type (*), dimension (*) :: a
1013   integer (c_int64_t) len
1014   call acc_update_device_l (a, int (len, kind = c_size_t))
1015 end subroutine
1016
1017 subroutine acc_update_device_array_h (a)
1018   use openacc_internal, only: acc_update_device_l
1019   type (*), dimension (..), contiguous :: a
1020   call acc_update_device_l (a, sizeof (a))
1021 end subroutine
1022
1023 subroutine acc_update_self_32_h (a, len)
1024   use iso_c_binding, only: c_int32_t, c_size_t
1025   use openacc_internal, only: acc_update_self_l
1026   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1027   type (*), dimension (*) :: a
1028   integer (c_int32_t) len
1029   call acc_update_self_l (a, int (len, kind = c_size_t))
1030 end subroutine
1031
1032 subroutine acc_update_self_64_h (a, len)
1033   use iso_c_binding, only: c_int64_t, c_size_t
1034   use openacc_internal, only: acc_update_self_l
1035   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1036   type (*), dimension (*) :: a
1037   integer (c_int64_t) len
1038   call acc_update_self_l (a, int (len, kind = c_size_t))
1039 end subroutine
1040
1041 subroutine acc_update_self_array_h (a)
1042   use openacc_internal, only: acc_update_self_l
1043   type (*), dimension (..), contiguous :: a
1044   call acc_update_self_l (a, sizeof (a))
1045 end subroutine
1046
1047 function acc_is_present_32_h (a, len)
1048   use iso_c_binding, only: c_int32_t, c_size_t
1049   use openacc_internal, only: acc_is_present_l
1050   logical acc_is_present_32_h
1051   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1052   type (*), dimension (*) :: a
1053   integer (c_int32_t) len
1054   if (acc_is_present_l (a, int (len, kind = c_size_t)) .eq. 1) then
1055     acc_is_present_32_h = .TRUE.
1056   else
1057     acc_is_present_32_h = .FALSE.
1058   end if
1059 end function
1060
1061 function acc_is_present_64_h (a, len)
1062   use iso_c_binding, only: c_int64_t, c_size_t
1063   use openacc_internal, only: acc_is_present_l
1064   logical acc_is_present_64_h
1065   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1066   type (*), dimension (*) :: a
1067   integer (c_int64_t) len
1068   if (acc_is_present_l (a, int (len, kind = c_size_t)) .eq. 1) then
1069     acc_is_present_64_h = .TRUE.
1070   else
1071     acc_is_present_64_h = .FALSE.
1072   end if
1073 end function
1074
1075 function acc_is_present_array_h (a)
1076   use openacc_internal, only: acc_is_present_l
1077   logical acc_is_present_array_h
1078   type (*), dimension (..), contiguous :: a
1079   acc_is_present_array_h = acc_is_present_l (a, sizeof (a)) == 1
1080 end function