libgomp/openacc.f90

   1 !  OpenACC Runtime Library Definitions.
   2
   3 !  Copyright (C) 2014-2020 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 ! Keep in sync with config/accel/openacc.f90 and openacc_lib.h.
  31
  32 module openacc_kinds
  33   use iso_fortran_env, only: int32
  34   use iso_c_binding, only: c_size_t
  35   implicit none
  36
  37   public
  38   private :: int32, c_size_t
  39
  40   ! When adding items, also update 'public' setting in 'module openacc' below.
  41
  42   integer, parameter :: acc_device_kind = int32
  43
  44   ! Keep in sync with include/gomp-constants.h.
  45   integer (acc_device_kind), parameter :: acc_device_current = -3
  46   integer (acc_device_kind), parameter :: acc_device_none = 0
  47   integer (acc_device_kind), parameter :: acc_device_default = 1
  48   integer (acc_device_kind), parameter :: acc_device_host = 2
  49   ! integer (acc_device_kind), parameter :: acc_device_host_nonshm = 3 removed.
  50   integer (acc_device_kind), parameter :: acc_device_not_host = 4
  51   integer (acc_device_kind), parameter :: acc_device_nvidia = 5
  52   integer (acc_device_kind), parameter :: acc_device_radeon = 8
  53
  54   integer, parameter :: acc_device_property = c_size_t
  55
  56   ! Keep in sync with 'libgomp/libgomp-plugin.h:goacc_property'.
  57   integer (acc_device_property), parameter :: acc_property_memory = 1
  58   integer (acc_device_property), parameter :: acc_property_free_memory = 2
  59   integer (acc_device_property), parameter :: acc_property_name = int(Z'10001')
  60   integer (acc_device_property), parameter :: acc_property_vendor = int(Z'10002')
  61   integer (acc_device_property), parameter :: acc_property_driver = int(Z'10003')
  62
  63   integer, parameter :: acc_handle_kind = int32
  64
  65   ! Keep in sync with include/gomp-constants.h.
  66   integer (acc_handle_kind), parameter :: acc_async_noval = -1
  67   integer (acc_handle_kind), parameter :: acc_async_sync = -2
  68 end module openacc_kinds
  69
  70 module openacc_internal
  71   use openacc_kinds
  72   implicit none
  73
  74   interface
  75     function acc_get_num_devices_h (d)
  76       import
  77       integer acc_get_num_devices_h
  78       integer (acc_device_kind) d
  79     end function
  80
  81     subroutine acc_set_device_type_h (d)
  82       import
  83       integer (acc_device_kind) d
  84     end subroutine
  85
  86     function acc_get_device_type_h ()
  87       import
  88       integer (acc_device_kind) acc_get_device_type_h
  89     end function
  90
  91     subroutine acc_set_device_num_h (n, d)
  92       import
  93       integer n
  94       integer (acc_device_kind) d
  95     end subroutine
  96
  97     function acc_get_device_num_h (d)
  98       import
  99       integer acc_get_device_num_h
 100       integer (acc_device_kind) d
 101     end function
 102
 103     function acc_get_property_h (n, d, p)
 104       import
 105       implicit none (type, external)
 106       integer (acc_device_property) :: acc_get_property_h
 107       integer, value :: n
 108       integer (acc_device_kind), value :: d
 109       integer (acc_device_property), value :: p
 110     end function
 111
 112     subroutine acc_get_property_string_h (n, d, p, s)
 113       import
 114       implicit none (type, external)
 115       integer, value :: n
 116       integer (acc_device_kind), value :: d
 117       integer (acc_device_property), value :: p
 118       character (*) :: s
 119     end subroutine
 120
 121     function acc_async_test_h (a)
 122       logical acc_async_test_h
 123       integer a
 124     end function
 125
 126     function acc_async_test_all_h ()
 127       logical acc_async_test_all_h
 128     end function
 129
 130     subroutine acc_wait_h (a)
 131       integer a
 132     end subroutine
 133
 134     subroutine acc_wait_async_h (a1, a2)
 135       integer a1, a2
 136     end subroutine
 137
 138     subroutine acc_wait_all_h ()
 139     end subroutine
 140
 141     subroutine acc_wait_all_async_h (a)
 142       integer a
 143     end subroutine
 144
 145     subroutine acc_init_h (d)
 146       import
 147       integer (acc_device_kind) d
 148     end subroutine
 149
 150     subroutine acc_shutdown_h (d)
 151       import
 152       integer (acc_device_kind) d
 153     end subroutine
 154
 155     function acc_on_device_h (d)
 156       import
 157       integer (acc_device_kind) d
 158       logical acc_on_device_h
 159     end function
 160
 161     subroutine acc_copyin_32_h (a, len)
 162       use iso_c_binding, only: c_int32_t
 163       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 164       type (*), dimension (*) :: a
 165       integer (c_int32_t) len
 166     end subroutine
 167
 168     subroutine acc_copyin_64_h (a, len)
 169       use iso_c_binding, only: c_int64_t
 170       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 171       type (*), dimension (*) :: a
 172       integer (c_int64_t) len
 173     end subroutine
 174
 175     subroutine acc_copyin_array_h (a)
 176       type (*), dimension (..), contiguous :: a
 177     end subroutine
 178
 179     subroutine acc_present_or_copyin_32_h (a, len)
 180       use iso_c_binding, only: c_int32_t
 181       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 182       type (*), dimension (*) :: a
 183       integer (c_int32_t) len
 184     end subroutine
 185
 186     subroutine acc_present_or_copyin_64_h (a, len)
 187       use iso_c_binding, only: c_int64_t
 188       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 189       type (*), dimension (*) :: a
 190       integer (c_int64_t) len
 191     end subroutine
 192
 193     subroutine acc_present_or_copyin_array_h (a)
 194       type (*), dimension (..), contiguous :: a
 195     end subroutine
 196
 197     subroutine acc_create_32_h (a, len)
 198       use iso_c_binding, only: c_int32_t
 199       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 200       type (*), dimension (*) :: a
 201       integer (c_int32_t) len
 202     end subroutine
 203
 204     subroutine acc_create_64_h (a, len)
 205       use iso_c_binding, only: c_int64_t
 206       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 207       type (*), dimension (*) :: a
 208       integer (c_int64_t) len
 209     end subroutine
 210
 211     subroutine acc_create_array_h (a)
 212       type (*), dimension (..), contiguous :: a
 213     end subroutine
 214
 215     subroutine acc_present_or_create_32_h (a, len)
 216       use iso_c_binding, only: c_int32_t
 217       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 218       type (*), dimension (*) :: a
 219       integer (c_int32_t) len
 220     end subroutine
 221
 222     subroutine acc_present_or_create_64_h (a, len)
 223       use iso_c_binding, only: c_int64_t
 224       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 225       type (*), dimension (*) :: a
 226       integer (c_int64_t) len
 227     end subroutine
 228
 229     subroutine acc_present_or_create_array_h (a)
 230       type (*), dimension (..), contiguous :: a
 231     end subroutine
 232
 233     subroutine acc_copyout_32_h (a, len)
 234       use iso_c_binding, only: c_int32_t
 235       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 236       type (*), dimension (*) :: a
 237       integer (c_int32_t) len
 238     end subroutine
 239
 240     subroutine acc_copyout_64_h (a, len)
 241       use iso_c_binding, only: c_int64_t
 242       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 243       type (*), dimension (*) :: a
 244       integer (c_int64_t) len
 245     end subroutine
 246
 247     subroutine acc_copyout_array_h (a)
 248       type (*), dimension (..), contiguous :: a
 249     end subroutine
 250
 251     subroutine acc_copyout_finalize_32_h (a, len)
 252       use iso_c_binding, only: c_int32_t
 253       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 254       type (*), dimension (*) :: a
 255       integer (c_int32_t) len
 256     end subroutine
 257
 258     subroutine acc_copyout_finalize_64_h (a, len)
 259       use iso_c_binding, only: c_int64_t
 260       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 261       type (*), dimension (*) :: a
 262       integer (c_int64_t) len
 263     end subroutine
 264
 265     subroutine acc_copyout_finalize_array_h (a)
 266       type (*), dimension (..), contiguous :: a
 267     end subroutine
 268
 269     subroutine acc_delete_32_h (a, len)
 270       use iso_c_binding, only: c_int32_t
 271       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 272       type (*), dimension (*) :: a
 273       integer (c_int32_t) len
 274     end subroutine
 275
 276     subroutine acc_delete_64_h (a, len)
 277       use iso_c_binding, only: c_int64_t
 278       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 279       type (*), dimension (*) :: a
 280       integer (c_int64_t) len
 281     end subroutine
 282
 283     subroutine acc_delete_array_h (a)
 284       type (*), dimension (..), contiguous :: a
 285     end subroutine
 286
 287     subroutine acc_delete_finalize_32_h (a, len)
 288       use iso_c_binding, only: c_int32_t
 289       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 290       type (*), dimension (*) :: a
 291       integer (c_int32_t) len
 292     end subroutine
 293
 294     subroutine acc_delete_finalize_64_h (a, len)
 295       use iso_c_binding, only: c_int64_t
 296       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 297       type (*), dimension (*) :: a
 298       integer (c_int64_t) len
 299     end subroutine
 300
 301     subroutine acc_delete_finalize_array_h (a)
 302       type (*), dimension (..), contiguous :: a
 303     end subroutine
 304
 305     subroutine acc_update_device_32_h (a, len)
 306       use iso_c_binding, only: c_int32_t
 307       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 308       type (*), dimension (*) :: a
 309       integer (c_int32_t) len
 310     end subroutine
 311
 312     subroutine acc_update_device_64_h (a, len)
 313       use iso_c_binding, only: c_int64_t
 314       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 315       type (*), dimension (*) :: a
 316       integer (c_int64_t) len
 317     end subroutine
 318
 319     subroutine acc_update_device_array_h (a)
 320       type (*), dimension (..), contiguous :: a
 321     end subroutine
 322
 323     subroutine acc_update_self_32_h (a, len)
 324       use iso_c_binding, only: c_int32_t
 325       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 326       type (*), dimension (*) :: a
 327       integer (c_int32_t) len
 328     end subroutine
 329
 330     subroutine acc_update_self_64_h (a, len)
 331       use iso_c_binding, only: c_int64_t
 332       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 333       type (*), dimension (*) :: a
 334       integer (c_int64_t) len
 335     end subroutine
 336
 337     subroutine acc_update_self_array_h (a)
 338       type (*), dimension (..), contiguous :: a
 339     end subroutine
 340
 341     function acc_is_present_32_h (a, len)
 342       use iso_c_binding, only: c_int32_t
 343       logical acc_is_present_32_h
 344       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 345       type (*), dimension (*) :: a
 346       integer (c_int32_t) len
 347     end function
 348
 349     function acc_is_present_64_h (a, len)
 350       use iso_c_binding, only: c_int64_t
 351       logical acc_is_present_64_h
 352       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 353       type (*), dimension (*) :: a
 354       integer (c_int64_t) len
 355     end function
 356
 357     function acc_is_present_array_h (a)
 358       logical acc_is_present_array_h
 359       type (*), dimension (..), contiguous :: a
 360     end function
 361
 362     subroutine acc_copyin_async_32_h (a, len, async)
 363       use iso_c_binding, only: c_int32_t
 364       use openacc_kinds, only: acc_handle_kind
 365       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 366       type (*), dimension (*) :: a
 367       integer (c_int32_t) len
 368       integer (acc_handle_kind) async
 369     end subroutine
 370
 371     subroutine acc_copyin_async_64_h (a, len, async)
 372       use iso_c_binding, only: c_int64_t
 373       use openacc_kinds, only: acc_handle_kind
 374       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 375       type (*), dimension (*) :: a
 376       integer (c_int64_t) len
 377       integer (acc_handle_kind) async
 378     end subroutine
 379
 380     subroutine acc_copyin_async_array_h (a, async)
 381       use openacc_kinds, only: acc_handle_kind
 382       type (*), dimension (..), contiguous :: a
 383       integer (acc_handle_kind) async
 384     end subroutine
 385
 386     subroutine acc_create_async_32_h (a, len, async)
 387       use iso_c_binding, only: c_int32_t
 388       use openacc_kinds, only: acc_handle_kind
 389       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 390       type (*), dimension (*) :: a
 391       integer (c_int32_t) len
 392       integer (acc_handle_kind) async
 393     end subroutine
 394
 395     subroutine acc_create_async_64_h (a, len, async)
 396       use iso_c_binding, only: c_int64_t
 397       use openacc_kinds, only: acc_handle_kind
 398       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 399       type (*), dimension (*) :: a
 400       integer (c_int64_t) len
 401       integer (acc_handle_kind) async
 402     end subroutine
 403
 404     subroutine acc_create_async_array_h (a, async)
 405       use openacc_kinds, only: acc_handle_kind
 406       type (*), dimension (..), contiguous :: a
 407       integer (acc_handle_kind) async
 408     end subroutine
 409
 410     subroutine acc_copyout_async_32_h (a, len, async)
 411       use iso_c_binding, only: c_int32_t
 412       use openacc_kinds, only: acc_handle_kind
 413       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 414       type (*), dimension (*) :: a
 415       integer (c_int32_t) len
 416       integer (acc_handle_kind) async
 417     end subroutine
 418
 419     subroutine acc_copyout_async_64_h (a, len, async)
 420       use iso_c_binding, only: c_int64_t
 421       use openacc_kinds, only: acc_handle_kind
 422       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 423       type (*), dimension (*) :: a
 424       integer (c_int64_t) len
 425       integer (acc_handle_kind) async
 426     end subroutine
 427
 428     subroutine acc_copyout_async_array_h (a, async)
 429       use openacc_kinds, only: acc_handle_kind
 430       type (*), dimension (..), contiguous :: a
 431       integer (acc_handle_kind) async
 432     end subroutine
 433
 434     subroutine acc_delete_async_32_h (a, len, async)
 435       use iso_c_binding, only: c_int32_t
 436       use openacc_kinds, only: acc_handle_kind
 437       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 438       type (*), dimension (*) :: a
 439       integer (c_int32_t) len
 440       integer (acc_handle_kind) async
 441     end subroutine
 442
 443     subroutine acc_delete_async_64_h (a, len, async)
 444       use iso_c_binding, only: c_int64_t
 445       use openacc_kinds, only: acc_handle_kind
 446       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 447       type (*), dimension (*) :: a
 448       integer (c_int64_t) len
 449       integer (acc_handle_kind) async
 450     end subroutine
 451
 452     subroutine acc_delete_async_array_h (a, async)
 453       use openacc_kinds, only: acc_handle_kind
 454       type (*), dimension (..), contiguous :: a
 455       integer (acc_handle_kind) async
 456     end subroutine
 457
 458     subroutine acc_update_device_async_32_h (a, len, async)
 459       use iso_c_binding, only: c_int32_t
 460       use openacc_kinds, only: acc_handle_kind
 461       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 462       type (*), dimension (*) :: a
 463       integer (c_int32_t) len
 464       integer (acc_handle_kind) async
 465     end subroutine
 466
 467     subroutine acc_update_device_async_64_h (a, len, async)
 468       use iso_c_binding, only: c_int64_t
 469       use openacc_kinds, only: acc_handle_kind
 470       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 471       type (*), dimension (*) :: a
 472       integer (c_int64_t) len
 473       integer (acc_handle_kind) async
 474     end subroutine
 475
 476     subroutine acc_update_device_async_array_h (a, async)
 477       use openacc_kinds, only: acc_handle_kind
 478       type (*), dimension (..), contiguous :: a
 479       integer (acc_handle_kind) async
 480     end subroutine
 481
 482     subroutine acc_update_self_async_32_h (a, len, async)
 483       use iso_c_binding, only: c_int32_t
 484       use openacc_kinds, only: acc_handle_kind
 485       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 486       type (*), dimension (*) :: a
 487       integer (c_int32_t) len
 488       integer (acc_handle_kind) async
 489     end subroutine
 490
 491     subroutine acc_update_self_async_64_h (a, len, async)
 492       use iso_c_binding, only: c_int64_t
 493       use openacc_kinds, only: acc_handle_kind
 494       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 495       type (*), dimension (*) :: a
 496       integer (c_int64_t) len
 497       integer (acc_handle_kind) async
 498     end subroutine
 499
 500     subroutine acc_update_self_async_array_h (a, async)
 501       use openacc_kinds, only: acc_handle_kind
 502       type (*), dimension (..), contiguous :: a
 503       integer (acc_handle_kind) async
 504     end subroutine
 505   end interface
 506
 507   interface
 508     function acc_get_num_devices_l (d) &
 509         bind (C, name = "acc_get_num_devices")
 510       use iso_c_binding, only: c_int
 511       integer (c_int) :: acc_get_num_devices_l
 512       integer (c_int), value :: d
 513     end function
 514
 515     subroutine acc_set_device_type_l (d) &
 516         bind (C, name = "acc_set_device_type")
 517       use iso_c_binding, only: c_int
 518       integer (c_int), value :: d
 519     end subroutine
 520
 521     function acc_get_device_type_l () &
 522         bind (C, name = "acc_get_device_type")
 523       use iso_c_binding, only: c_int
 524       integer (c_int) :: acc_get_device_type_l
 525     end function
 526
 527     subroutine acc_set_device_num_l (n, d) &
 528         bind (C, name = "acc_set_device_num")
 529       use iso_c_binding, only: c_int
 530       integer (c_int), value :: n, d
 531     end subroutine
 532
 533     function acc_get_device_num_l (d) &
 534         bind (C, name = "acc_get_device_num")
 535       use iso_c_binding, only: c_int
 536       integer (c_int) :: acc_get_device_num_l
 537       integer (c_int), value :: d
 538     end function
 539
 540     function acc_get_property_l (n, d, p) &
 541         bind (C, name = "acc_get_property")
 542       use iso_c_binding, only: c_int, c_size_t
 543       implicit none (type, external)
 544       integer (c_size_t) :: acc_get_property_l
 545       integer (c_int), value :: n
 546       integer (c_int), value :: d
 547       integer (c_int), value :: p
 548     end function
 549
 550     function acc_get_property_string_l (n, d, p) &
 551         bind (C, name = "acc_get_property_string")
 552       use iso_c_binding, only: c_int, c_ptr
 553       implicit none (type, external)
 554       type (c_ptr) :: acc_get_property_string_l
 555       integer (c_int), value :: n
 556       integer (c_int), value :: d
 557       integer (c_int), value :: p
 558     end function
 559
 560     function acc_async_test_l (a) &
 561         bind (C, name = "acc_async_test")
 562       use iso_c_binding, only: c_int
 563       integer (c_int) :: acc_async_test_l
 564       integer (c_int), value :: a
 565     end function
 566
 567     function acc_async_test_all_l () &
 568         bind (C, name = "acc_async_test_all")
 569       use iso_c_binding, only: c_int
 570       integer (c_int) :: acc_async_test_all_l
 571     end function
 572
 573     subroutine acc_wait_l (a) &
 574         bind (C, name = "acc_wait")
 575       use iso_c_binding, only: c_int
 576       integer (c_int), value :: a
 577     end subroutine
 578
 579     subroutine acc_wait_async_l (a1, a2) &
 580         bind (C, name = "acc_wait_async")
 581       use iso_c_binding, only: c_int
 582       integer (c_int), value :: a1, a2
 583     end subroutine
 584
 585     subroutine acc_wait_all_l () &
 586         bind (C, name = "acc_wait_all")
 587       use iso_c_binding, only: c_int
 588     end subroutine
 589
 590     subroutine acc_wait_all_async_l (a) &
 591         bind (C, name = "acc_wait_all_async")
 592       use iso_c_binding, only: c_int
 593       integer (c_int), value :: a
 594     end subroutine
 595
 596     subroutine acc_init_l (d) &
 597         bind (C, name = "acc_init")
 598       use iso_c_binding, only: c_int
 599       integer (c_int), value :: d
 600     end subroutine
 601
 602     subroutine acc_shutdown_l (d) &
 603         bind (C, name = "acc_shutdown")
 604       use iso_c_binding, only: c_int
 605       integer (c_int), value :: d
 606     end subroutine
 607
 608     function acc_on_device_l (d) &
 609         bind (C, name = "acc_on_device")
 610       use iso_c_binding, only: c_int
 611       integer (c_int) :: acc_on_device_l
 612       integer (c_int), value :: d
 613     end function
 614
 615     subroutine acc_copyin_l (a, len) &
 616         bind (C, name = "acc_copyin")
 617       use iso_c_binding, only: c_size_t
 618       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 619       type (*), dimension (*) :: a
 620       integer (c_size_t), value :: len
 621     end subroutine
 622
 623     subroutine acc_present_or_copyin_l (a, len) &
 624         bind (C, name = "acc_present_or_copyin")
 625       use iso_c_binding, only: c_size_t
 626       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 627       type (*), dimension (*) :: a
 628       integer (c_size_t), value :: len
 629     end subroutine
 630
 631     subroutine acc_create_l (a, len) &
 632         bind (C, name = "acc_create")
 633       use iso_c_binding, only: c_size_t
 634       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 635       type (*), dimension (*) :: a
 636       integer (c_size_t), value :: len
 637     end subroutine
 638
 639     subroutine acc_present_or_create_l (a, len) &
 640         bind (C, name = "acc_present_or_create")
 641       use iso_c_binding, only: c_size_t
 642       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 643       type (*), dimension (*) :: a
 644       integer (c_size_t), value :: len
 645     end subroutine
 646
 647     subroutine acc_copyout_l (a, len) &
 648         bind (C, name = "acc_copyout")
 649       use iso_c_binding, only: c_size_t
 650       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 651       type (*), dimension (*) :: a
 652       integer (c_size_t), value :: len
 653     end subroutine
 654
 655     subroutine acc_copyout_finalize_l (a, len) &
 656         bind (C, name = "acc_copyout_finalize")
 657       use iso_c_binding, only: c_size_t
 658       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 659       type (*), dimension (*) :: a
 660       integer (c_size_t), value :: len
 661     end subroutine
 662
 663     subroutine acc_delete_l (a, len) &
 664         bind (C, name = "acc_delete")
 665       use iso_c_binding, only: c_size_t
 666       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 667       type (*), dimension (*) :: a
 668       integer (c_size_t), value :: len
 669     end subroutine
 670
 671     subroutine acc_delete_finalize_l (a, len) &
 672         bind (C, name = "acc_delete_finalize")
 673       use iso_c_binding, only: c_size_t
 674       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 675       type (*), dimension (*) :: a
 676       integer (c_size_t), value :: len
 677     end subroutine
 678
 679     subroutine acc_update_device_l (a, len) &
 680         bind (C, name = "acc_update_device")
 681       use iso_c_binding, only: c_size_t
 682       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 683       type (*), dimension (*) :: a
 684       integer (c_size_t), value :: len
 685     end subroutine
 686
 687     subroutine acc_update_self_l (a, len) &
 688         bind (C, name = "acc_update_self")
 689       use iso_c_binding, only: c_size_t
 690       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 691       type (*), dimension (*) :: a
 692       integer (c_size_t), value :: len
 693     end subroutine
 694
 695     function acc_is_present_l (a, len) &
 696         bind (C, name = "acc_is_present")
 697       use iso_c_binding, only: c_int32_t, c_size_t
 698       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 699       integer (c_int32_t) :: acc_is_present_l
 700       type (*), dimension (*) :: a
 701       integer (c_size_t), value :: len
 702     end function
 703
 704     subroutine acc_copyin_async_l (a, len, async) &
 705         bind (C, name = "acc_copyin_async")
 706       use iso_c_binding, only: c_size_t, c_int
 707       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 708       type (*), dimension (*) :: a
 709       integer (c_size_t), value :: len
 710       integer (c_int), value :: async
 711     end subroutine
 712
 713     subroutine acc_create_async_l (a, len, async) &
 714         bind (C, name = "acc_create_async")
 715       use iso_c_binding, only: c_size_t, c_int
 716       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 717       type (*), dimension (*) :: a
 718       integer (c_size_t), value :: len
 719       integer (c_int), value :: async
 720     end subroutine
 721
 722     subroutine acc_copyout_async_l (a, len, async) &
 723         bind (C, name = "acc_copyout_async")
 724       use iso_c_binding, only: c_size_t, c_int
 725       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 726       type (*), dimension (*) :: a
 727       integer (c_size_t), value :: len
 728       integer (c_int), value :: async
 729     end subroutine
 730
 731     subroutine acc_delete_async_l (a, len, async) &
 732         bind (C, name = "acc_delete_async")
 733       use iso_c_binding, only: c_size_t, c_int
 734       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 735       type (*), dimension (*) :: a
 736       integer (c_size_t), value :: len
 737       integer (c_int), value :: async
 738     end subroutine
 739
 740     subroutine acc_update_device_async_l (a, len, async) &
 741         bind (C, name = "acc_update_device_async")
 742       use iso_c_binding, only: c_size_t, c_int
 743       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 744       type (*), dimension (*) :: a
 745       integer (c_size_t), value :: len
 746       integer (c_int), value :: async
 747     end subroutine
 748
 749     subroutine acc_update_self_async_l (a, len, async) &
 750         bind (C, name = "acc_update_self_async")
 751       use iso_c_binding, only: c_size_t, c_int
 752       !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
 753       type (*), dimension (*) :: a
 754       integer (c_size_t), value :: len
 755       integer (c_int), value :: async
 756     end subroutine
 757   end interface
 758 end module openacc_internal
 759
 760 module openacc
 761   use openacc_kinds
 762   use openacc_internal
 763   implicit none
 764
 765   private
 766
 767   ! From openacc_kinds
 768   public :: acc_device_kind
 769   public :: acc_device_none, acc_device_default, acc_device_host
 770   public :: acc_device_not_host, acc_device_nvidia, acc_device_radeon
 771
 772   public :: acc_device_property
 773   public :: acc_property_memory, acc_property_free_memory
 774   public :: acc_property_name, acc_property_vendor, acc_property_driver
 775
 776   public :: acc_handle_kind
 777   public :: acc_async_noval, acc_async_sync
 778
 779   public :: openacc_version
 780
 781   public :: acc_get_num_devices, acc_set_device_type, acc_get_device_type
 782   public :: acc_set_device_num, acc_get_device_num
 783   public :: acc_get_property, acc_get_property_string
 784   public :: acc_async_test, acc_async_test_all
 785   public :: acc_wait, acc_async_wait, acc_wait_async
 786   public :: acc_wait_all, acc_async_wait_all, acc_wait_all_async
 787   public :: acc_init, acc_shutdown, acc_on_device
 788   public :: acc_copyin, acc_present_or_copyin, acc_pcopyin, acc_create
 789   public :: acc_present_or_create, acc_pcreate, acc_copyout, acc_delete
 790   public :: acc_update_device, acc_update_self, acc_is_present
 791   public :: acc_copyin_async, acc_create_async, acc_copyout_async
 792   public :: acc_delete_async, acc_update_device_async, acc_update_self_async
 793   public :: acc_copyout_finalize, acc_delete_finalize
 794
 795   integer, parameter :: openacc_version = 201711
 796
 797   interface acc_get_num_devices
 798     procedure :: acc_get_num_devices_h
 799   end interface
 800
 801   interface acc_set_device_type
 802     procedure :: acc_set_device_type_h
 803   end interface
 804
 805   interface acc_get_device_type
 806     procedure :: acc_get_device_type_h
 807   end interface
 808
 809   interface acc_set_device_num
 810     procedure :: acc_set_device_num_h
 811   end interface
 812
 813   interface acc_get_device_num
 814     procedure :: acc_get_device_num_h
 815   end interface
 816
 817   interface acc_get_property
 818     procedure :: acc_get_property_h
 819   end interface
 820
 821   interface acc_get_property_string
 822     procedure :: acc_get_property_string_h
 823   end interface
 824
 825   interface acc_async_test
 826     procedure :: acc_async_test_h
 827   end interface
 828
 829   interface acc_async_test_all
 830     procedure :: acc_async_test_all_h
 831   end interface
 832
 833   interface acc_wait
 834     procedure :: acc_wait_h
 835   end interface
 836
 837   ! acc_async_wait is an OpenACC 1.0 compatibility name for acc_wait.
 838   interface acc_async_wait
 839     procedure :: acc_wait_h
 840   end interface
 841
 842   interface acc_wait_async
 843     procedure :: acc_wait_async_h
 844   end interface
 845
 846   interface acc_wait_all
 847     procedure :: acc_wait_all_h
 848   end interface
 849
 850   ! acc_async_wait_all is an OpenACC 1.0 compatibility name for acc_wait_all.
 851   interface acc_async_wait_all
 852     procedure :: acc_wait_all_h
 853   end interface
 854
 855   interface acc_wait_all_async
 856     procedure :: acc_wait_all_async_h
 857   end interface
 858
 859   interface acc_init
 860     procedure :: acc_init_h
 861   end interface
 862
 863   interface acc_shutdown
 864     procedure :: acc_shutdown_h
 865   end interface
 866
 867   interface acc_on_device
 868     procedure :: acc_on_device_h
 869   end interface
 870
 871   ! acc_malloc: Only available in C/C++
 872   ! acc_free: Only available in C/C++
 873
 874   ! As vendor extension, the following code supports both 32bit and 64bit
 875   ! arguments for "size"; the OpenACC standard only permits default-kind
 876   ! integers, which are of kind 4 (i.e. 32 bits).
 877   ! Additionally, the two-argument version also takes arrays as argument.
 878   ! and the one argument version also scalars. Note that the code assumes
 879   ! that the arrays are contiguous.
 880
 881   interface acc_copyin
 882     procedure :: acc_copyin_32_h
 883     procedure :: acc_copyin_64_h
 884     procedure :: acc_copyin_array_h
 885   end interface
 886
 887   interface acc_present_or_copyin
 888     procedure :: acc_present_or_copyin_32_h
 889     procedure :: acc_present_or_copyin_64_h
 890     procedure :: acc_present_or_copyin_array_h
 891   end interface
 892
 893   interface acc_pcopyin
 894     procedure :: acc_present_or_copyin_32_h
 895     procedure :: acc_present_or_copyin_64_h
 896     procedure :: acc_present_or_copyin_array_h
 897   end interface
 898
 899   interface acc_create
 900     procedure :: acc_create_32_h
 901     procedure :: acc_create_64_h
 902     procedure :: acc_create_array_h
 903   end interface
 904
 905   interface acc_present_or_create
 906     procedure :: acc_present_or_create_32_h
 907     procedure :: acc_present_or_create_64_h
 908     procedure :: acc_present_or_create_array_h
 909   end interface
 910
 911   interface acc_pcreate
 912     procedure :: acc_present_or_create_32_h
 913     procedure :: acc_present_or_create_64_h
 914     procedure :: acc_present_or_create_array_h
 915   end interface
 916
 917   interface acc_copyout
 918     procedure :: acc_copyout_32_h
 919     procedure :: acc_copyout_64_h
 920     procedure :: acc_copyout_array_h
 921   end interface
 922
 923   interface acc_copyout_finalize
 924     procedure :: acc_copyout_finalize_32_h
 925     procedure :: acc_copyout_finalize_64_h
 926     procedure :: acc_copyout_finalize_array_h
 927   end interface
 928
 929   interface acc_delete
 930     procedure :: acc_delete_32_h
 931     procedure :: acc_delete_64_h
 932     procedure :: acc_delete_array_h
 933   end interface
 934
 935   interface acc_delete_finalize
 936     procedure :: acc_delete_finalize_32_h
 937     procedure :: acc_delete_finalize_64_h
 938     procedure :: acc_delete_finalize_array_h
 939   end interface
 940
 941   interface acc_update_device
 942     procedure :: acc_update_device_32_h
 943     procedure :: acc_update_device_64_h
 944     procedure :: acc_update_device_array_h
 945   end interface
 946
 947   interface acc_update_self
 948     procedure :: acc_update_self_32_h
 949     procedure :: acc_update_self_64_h
 950     procedure :: acc_update_self_array_h
 951   end interface
 952
 953   ! acc_map_data: Only available in C/C++
 954   ! acc_unmap_data: Only available in C/C++
 955   ! acc_deviceptr: Only available in C/C++
 956   ! acc_hostptr: Only available in C/C++
 957
 958   interface acc_is_present
 959     procedure :: acc_is_present_32_h
 960     procedure :: acc_is_present_64_h
 961     procedure :: acc_is_present_array_h
 962   end interface
 963
 964   ! acc_memcpy_to_device: Only available in C/C++
 965   ! acc_memcpy_from_device: Only available in C/C++
 966
 967   interface acc_copyin_async
 968     procedure :: acc_copyin_async_32_h
 969     procedure :: acc_copyin_async_64_h
 970     procedure :: acc_copyin_async_array_h
 971   end interface
 972
 973   interface acc_create_async
 974     procedure :: acc_create_async_32_h
 975     procedure :: acc_create_async_64_h
 976     procedure :: acc_create_async_array_h
 977   end interface
 978
 979   interface acc_copyout_async
 980     procedure :: acc_copyout_async_32_h
 981     procedure :: acc_copyout_async_64_h
 982     procedure :: acc_copyout_async_array_h
 983   end interface
 984
 985   interface acc_delete_async
 986     procedure :: acc_delete_async_32_h
 987     procedure :: acc_delete_async_64_h
 988     procedure :: acc_delete_async_array_h
 989   end interface
 990
 991   interface acc_update_device_async
 992     procedure :: acc_update_device_async_32_h
 993     procedure :: acc_update_device_async_64_h
 994     procedure :: acc_update_device_async_array_h
 995   end interface
 996
 997   interface acc_update_self_async
 998     procedure :: acc_update_self_async_32_h
 999     procedure :: acc_update_self_async_64_h
1000     procedure :: acc_update_self_async_array_h
1001   end interface
1002
1003 end module openacc
1004
1005 function acc_get_num_devices_h (d)
1006   use openacc_internal, only: acc_get_num_devices_l
1007   use openacc_kinds
1008   integer acc_get_num_devices_h
1009   integer (acc_device_kind) d
1010   acc_get_num_devices_h = acc_get_num_devices_l (d)
1011 end function
1012
1013 subroutine acc_set_device_type_h (d)
1014   use openacc_internal, only: acc_set_device_type_l
1015   use openacc_kinds
1016   integer (acc_device_kind) d
1017   call acc_set_device_type_l (d)
1018 end subroutine
1019
1020 function acc_get_device_type_h ()
1021   use openacc_internal, only: acc_get_device_type_l
1022   use openacc_kinds
1023   integer (acc_device_kind) acc_get_device_type_h
1024   acc_get_device_type_h = acc_get_device_type_l ()
1025 end function
1026
1027 subroutine acc_set_device_num_h (n, d)
1028   use openacc_internal, only: acc_set_device_num_l
1029   use openacc_kinds
1030   integer n
1031   integer (acc_device_kind) d
1032   call acc_set_device_num_l (n, d)
1033 end subroutine
1034
1035 function acc_get_device_num_h (d)
1036   use openacc_internal, only: acc_get_device_num_l
1037   use openacc_kinds
1038   integer acc_get_device_num_h
1039   integer (acc_device_kind) d
1040   acc_get_device_num_h = acc_get_device_num_l (d)
1041 end function
1042
1043 function acc_get_property_h (n, d, p)
1044   use iso_c_binding, only: c_int, c_size_t
1045   use openacc_internal, only: acc_get_property_l
1046   use openacc_kinds
1047   implicit none (type, external)
1048   integer (acc_device_property) :: acc_get_property_h
1049   integer, value :: n
1050   integer (acc_device_kind), value :: d
1051   integer (acc_device_property), value :: p
1052
1053   integer (c_int) :: pint
1054
1055   pint = int (p, c_int)
1056   acc_get_property_h = acc_get_property_l (n, d, pint)
1057 end function
1058
1059 subroutine acc_get_property_string_h (n, d, p, s)
1060   use iso_c_binding, only: c_char, c_int, c_ptr, c_f_pointer, c_associated
1061   use openacc_internal, only: acc_get_property_string_l
1062   use openacc_kinds
1063   implicit none (type, external)
1064   integer, value :: n
1065   integer (acc_device_kind), value :: d
1066   integer (acc_device_property), value :: p
1067   character (*) :: s
1068
1069   integer (c_int) :: pint
1070   type (c_ptr) :: cptr
1071   integer :: clen
1072   character (kind=c_char, len=1), pointer, contiguous :: sptr (:)
1073   integer :: slen
1074   integer :: i
1075
1076   interface
1077      function strlen (s) bind (C, name = "strlen")
1078        use iso_c_binding, only: c_ptr, c_size_t
1079        type (c_ptr), intent(in), value :: s
1080        integer (c_size_t) :: strlen
1081      end function strlen
1082   end interface
1083
1084   pint = int (p, c_int)
1085   cptr = acc_get_property_string_l (n, d, pint)
1086   s = ""
1087   if (.not. c_associated (cptr)) then
1088      return
1089   end if
1090
1091   clen = int (strlen (cptr))
1092   call c_f_pointer (cptr, sptr, [clen])
1093
1094   slen = min (clen, len (s))
1095   do i = 1, slen
1096     s (i:i) = sptr (i)
1097   end do
1098 end subroutine
1099
1100 function acc_async_test_h (a)
1101   use openacc_internal, only: acc_async_test_l
1102   logical acc_async_test_h
1103   integer a
1104   if (acc_async_test_l (a) .eq. 1) then
1105     acc_async_test_h = .TRUE.
1106   else
1107     acc_async_test_h = .FALSE.
1108   end if
1109 end function
1110
1111 function acc_async_test_all_h ()
1112   use openacc_internal, only: acc_async_test_all_l
1113   logical acc_async_test_all_h
1114   if (acc_async_test_all_l () .eq. 1) then
1115     acc_async_test_all_h = .TRUE.
1116   else
1117     acc_async_test_all_h = .FALSE.
1118   end if
1119 end function
1120
1121 subroutine acc_wait_h (a)
1122   use openacc_internal, only: acc_wait_l
1123   integer a
1124   call acc_wait_l (a)
1125 end subroutine
1126
1127 subroutine acc_wait_async_h (a1, a2)
1128   use openacc_internal, only: acc_wait_async_l
1129   integer a1, a2
1130   call acc_wait_async_l (a1, a2)
1131 end subroutine
1132
1133 subroutine acc_wait_all_h ()
1134   use openacc_internal, only: acc_wait_all_l
1135   call acc_wait_all_l ()
1136 end subroutine
1137
1138 subroutine acc_wait_all_async_h (a)
1139   use openacc_internal, only: acc_wait_all_async_l
1140   integer a
1141   call acc_wait_all_async_l (a)
1142 end subroutine
1143
1144 subroutine acc_init_h (d)
1145   use openacc_internal, only: acc_init_l
1146   use openacc_kinds
1147   integer (acc_device_kind) d
1148   call acc_init_l (d)
1149 end subroutine
1150
1151 subroutine acc_shutdown_h (d)
1152   use openacc_internal, only: acc_shutdown_l
1153   use openacc_kinds
1154   integer (acc_device_kind) d
1155   call acc_shutdown_l (d)
1156 end subroutine
1157
1158 function acc_on_device_h (d)
1159   use openacc_internal, only: acc_on_device_l
1160   use openacc_kinds
1161   integer (acc_device_kind) d
1162   logical acc_on_device_h
1163   if (acc_on_device_l (d) .eq. 1) then
1164     acc_on_device_h = .TRUE.
1165   else
1166     acc_on_device_h = .FALSE.
1167   end if
1168 end function
1169
1170 subroutine acc_copyin_32_h (a, len)
1171   use iso_c_binding, only: c_int32_t, c_size_t
1172   use openacc_internal, only: acc_copyin_l
1173   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1174   type (*), dimension (*) :: a
1175   integer (c_int32_t) len
1176   call acc_copyin_l (a, int (len, kind = c_size_t))
1177 end subroutine
1178
1179 subroutine acc_copyin_64_h (a, len)
1180   use iso_c_binding, only: c_int64_t, c_size_t
1181   use openacc_internal, only: acc_copyin_l
1182   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1183   type (*), dimension (*) :: a
1184   integer (c_int64_t) len
1185   call acc_copyin_l (a, int (len, kind = c_size_t))
1186 end subroutine
1187
1188 subroutine acc_copyin_array_h (a)
1189   use openacc_internal, only: acc_copyin_l
1190   type (*), dimension (..), contiguous :: a
1191   call acc_copyin_l (a, sizeof (a))
1192 end subroutine
1193
1194 subroutine acc_present_or_copyin_32_h (a, len)
1195   use iso_c_binding, only: c_int32_t, c_size_t
1196   use openacc_internal, only: acc_present_or_copyin_l
1197   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1198   type (*), dimension (*) :: a
1199   integer (c_int32_t) len
1200   call acc_present_or_copyin_l (a, int (len, kind = c_size_t))
1201 end subroutine
1202
1203 subroutine acc_present_or_copyin_64_h (a, len)
1204   use iso_c_binding, only: c_int64_t, c_size_t
1205   use openacc_internal, only: acc_present_or_copyin_l
1206   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1207   type (*), dimension (*) :: a
1208   integer (c_int64_t) len
1209   call acc_present_or_copyin_l (a, int (len, kind = c_size_t))
1210 end subroutine
1211
1212 subroutine acc_present_or_copyin_array_h (a)
1213   use openacc_internal, only: acc_present_or_copyin_l
1214   type (*), dimension (..), contiguous :: a
1215   call acc_present_or_copyin_l (a, sizeof (a))
1216 end subroutine
1217
1218 subroutine acc_create_32_h (a, len)
1219   use iso_c_binding, only: c_int32_t, c_size_t
1220   use openacc_internal, only: acc_create_l
1221   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1222   type (*), dimension (*) :: a
1223   integer (c_int32_t) len
1224   call acc_create_l (a, int (len, kind = c_size_t))
1225 end subroutine
1226
1227 subroutine acc_create_64_h (a, len)
1228   use iso_c_binding, only: c_int64_t, c_size_t
1229   use openacc_internal, only: acc_create_l
1230   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1231   type (*), dimension (*) :: a
1232   integer (c_int64_t) len
1233   call acc_create_l (a, int (len, kind = c_size_t))
1234 end subroutine
1235
1236 subroutine acc_create_array_h (a)
1237   use openacc_internal, only: acc_create_l
1238   type (*), dimension (..), contiguous :: a
1239   call acc_create_l (a, sizeof (a))
1240 end subroutine
1241
1242 subroutine acc_present_or_create_32_h (a, len)
1243   use iso_c_binding, only: c_int32_t, c_size_t
1244   use openacc_internal, only: acc_present_or_create_l
1245   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1246   type (*), dimension (*) :: a
1247   integer (c_int32_t) len
1248   call acc_present_or_create_l (a, int (len, kind = c_size_t))
1249 end subroutine
1250
1251 subroutine acc_present_or_create_64_h (a, len)
1252   use iso_c_binding, only: c_int64_t, c_size_t
1253   use openacc_internal, only: acc_present_or_create_l
1254   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1255   type (*), dimension (*) :: a
1256   integer (c_int64_t) len
1257   call acc_present_or_create_l (a, int (len, kind = c_size_t))
1258 end subroutine
1259
1260 subroutine acc_present_or_create_array_h (a)
1261   use openacc_internal, only: acc_present_or_create_l
1262   type (*), dimension (..), contiguous :: a
1263   call acc_present_or_create_l (a, sizeof (a))
1264 end subroutine
1265
1266 subroutine acc_copyout_32_h (a, len)
1267   use iso_c_binding, only: c_int32_t, c_size_t
1268   use openacc_internal, only: acc_copyout_l
1269   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1270   type (*), dimension (*) :: a
1271   integer (c_int32_t) len
1272   call acc_copyout_l (a, int (len, kind = c_size_t))
1273 end subroutine
1274
1275 subroutine acc_copyout_64_h (a, len)
1276   use iso_c_binding, only: c_int64_t, c_size_t
1277   use openacc_internal, only: acc_copyout_l
1278   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1279   type (*), dimension (*) :: a
1280   integer (c_int64_t) len
1281   call acc_copyout_l (a, int (len, kind = c_size_t))
1282 end subroutine
1283
1284 subroutine acc_copyout_array_h (a)
1285   use openacc_internal, only: acc_copyout_l
1286   type (*), dimension (..), contiguous :: a
1287   call acc_copyout_l (a, sizeof (a))
1288 end subroutine
1289
1290 subroutine acc_copyout_finalize_32_h (a, len)
1291   use iso_c_binding, only: c_int32_t, c_size_t
1292   use openacc_internal, only: acc_copyout_finalize_l
1293   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1294   type (*), dimension (*) :: a
1295   integer (c_int32_t) len
1296   call acc_copyout_finalize_l (a, int (len, kind = c_size_t))
1297 end subroutine
1298
1299 subroutine acc_copyout_finalize_64_h (a, len)
1300   use iso_c_binding, only: c_int64_t, c_size_t
1301   use openacc_internal, only: acc_copyout_finalize_l
1302   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1303   type (*), dimension (*) :: a
1304   integer (c_int64_t) len
1305   call acc_copyout_finalize_l (a, int (len, kind = c_size_t))
1306 end subroutine
1307
1308 subroutine acc_copyout_finalize_array_h (a)
1309   use openacc_internal, only: acc_copyout_finalize_l
1310   type (*), dimension (..), contiguous :: a
1311   call acc_copyout_finalize_l (a, sizeof (a))
1312 end subroutine
1313
1314 subroutine acc_delete_32_h (a, len)
1315   use iso_c_binding, only: c_int32_t, c_size_t
1316   use openacc_internal, only: acc_delete_l
1317   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1318   type (*), dimension (*) :: a
1319   integer (c_int32_t) len
1320   call acc_delete_l (a, int (len, kind = c_size_t))
1321 end subroutine
1322
1323 subroutine acc_delete_64_h (a, len)
1324   use iso_c_binding, only: c_int64_t, c_size_t
1325   use openacc_internal, only: acc_delete_l
1326   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1327   type (*), dimension (*) :: a
1328   integer (c_int64_t) len
1329   call acc_delete_l (a, int (len, kind = c_size_t))
1330 end subroutine
1331
1332 subroutine acc_delete_array_h (a)
1333   use openacc_internal, only: acc_delete_l
1334   type (*), dimension (..), contiguous :: a
1335   call acc_delete_l (a, sizeof (a))
1336 end subroutine
1337
1338 subroutine acc_delete_finalize_32_h (a, len)
1339   use iso_c_binding, only: c_int32_t, c_size_t
1340   use openacc_internal, only: acc_delete_finalize_l
1341   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1342   type (*), dimension (*) :: a
1343   integer (c_int32_t) len
1344   call acc_delete_finalize_l (a, int (len, kind = c_size_t))
1345 end subroutine
1346
1347 subroutine acc_delete_finalize_64_h (a, len)
1348   use iso_c_binding, only: c_int64_t, c_size_t
1349   use openacc_internal, only: acc_delete_finalize_l
1350   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1351   type (*), dimension (*) :: a
1352   integer (c_int64_t) len
1353   call acc_delete_finalize_l (a, int (len, kind = c_size_t))
1354 end subroutine
1355
1356 subroutine acc_delete_finalize_array_h (a)
1357   use openacc_internal, only: acc_delete_finalize_l
1358   type (*), dimension (..), contiguous :: a
1359   call acc_delete_finalize_l (a, sizeof (a))
1360 end subroutine
1361
1362 subroutine acc_update_device_32_h (a, len)
1363   use iso_c_binding, only: c_int32_t, c_size_t
1364   use openacc_internal, only: acc_update_device_l
1365   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1366   type (*), dimension (*) :: a
1367   integer (c_int32_t) len
1368   call acc_update_device_l (a, int (len, kind = c_size_t))
1369 end subroutine
1370
1371 subroutine acc_update_device_64_h (a, len)
1372   use iso_c_binding, only: c_int64_t, c_size_t
1373   use openacc_internal, only: acc_update_device_l
1374   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1375   type (*), dimension (*) :: a
1376   integer (c_int64_t) len
1377   call acc_update_device_l (a, int (len, kind = c_size_t))
1378 end subroutine
1379
1380 subroutine acc_update_device_array_h (a)
1381   use openacc_internal, only: acc_update_device_l
1382   type (*), dimension (..), contiguous :: a
1383   call acc_update_device_l (a, sizeof (a))
1384 end subroutine
1385
1386 subroutine acc_update_self_32_h (a, len)
1387   use iso_c_binding, only: c_int32_t, c_size_t
1388   use openacc_internal, only: acc_update_self_l
1389   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1390   type (*), dimension (*) :: a
1391   integer (c_int32_t) len
1392   call acc_update_self_l (a, int (len, kind = c_size_t))
1393 end subroutine
1394
1395 subroutine acc_update_self_64_h (a, len)
1396   use iso_c_binding, only: c_int64_t, c_size_t
1397   use openacc_internal, only: acc_update_self_l
1398   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1399   type (*), dimension (*) :: a
1400   integer (c_int64_t) len
1401   call acc_update_self_l (a, int (len, kind = c_size_t))
1402 end subroutine
1403
1404 subroutine acc_update_self_array_h (a)
1405   use openacc_internal, only: acc_update_self_l
1406   type (*), dimension (..), contiguous :: a
1407   call acc_update_self_l (a, sizeof (a))
1408 end subroutine
1409
1410 function acc_is_present_32_h (a, len)
1411   use iso_c_binding, only: c_int32_t, c_size_t
1412   use openacc_internal, only: acc_is_present_l
1413   logical acc_is_present_32_h
1414   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1415   type (*), dimension (*) :: a
1416   integer (c_int32_t) len
1417   if (acc_is_present_l (a, int (len, kind = c_size_t)) .eq. 1) then
1418     acc_is_present_32_h = .TRUE.
1419   else
1420     acc_is_present_32_h = .FALSE.
1421   end if
1422 end function
1423
1424 function acc_is_present_64_h (a, len)
1425   use iso_c_binding, only: c_int64_t, c_size_t
1426   use openacc_internal, only: acc_is_present_l
1427   logical acc_is_present_64_h
1428   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1429   type (*), dimension (*) :: a
1430   integer (c_int64_t) len
1431   if (acc_is_present_l (a, int (len, kind = c_size_t)) .eq. 1) then
1432     acc_is_present_64_h = .TRUE.
1433   else
1434     acc_is_present_64_h = .FALSE.
1435   end if
1436 end function
1437
1438 function acc_is_present_array_h (a)
1439   use openacc_internal, only: acc_is_present_l
1440   logical acc_is_present_array_h
1441   type (*), dimension (..), contiguous :: a
1442   acc_is_present_array_h = acc_is_present_l (a, sizeof (a)) == 1
1443 end function
1444
1445 subroutine acc_copyin_async_32_h (a, len, async)
1446   use iso_c_binding, only: c_int32_t, c_size_t, c_int
1447   use openacc_internal, only: acc_copyin_async_l
1448   use openacc_kinds, only: acc_handle_kind
1449   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1450   type (*), dimension (*) :: a
1451   integer (c_int32_t) len
1452   integer (acc_handle_kind) async
1453   call acc_copyin_async_l (a, int (len, kind = c_size_t), int (async, kind = c_int))
1454 end subroutine
1455
1456 subroutine acc_copyin_async_64_h (a, len, async)
1457   use iso_c_binding, only: c_int64_t, c_size_t, c_int
1458   use openacc_internal, only: acc_copyin_async_l
1459   use openacc_kinds, only: acc_handle_kind
1460   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1461   type (*), dimension (*) :: a
1462   integer (c_int64_t) len
1463   integer (acc_handle_kind) async
1464   call acc_copyin_async_l (a, int (len, kind = c_size_t), int (async, kind = c_int))
1465 end subroutine
1466
1467 subroutine acc_copyin_async_array_h (a, async)
1468   use iso_c_binding, only: c_int
1469   use openacc_internal, only: acc_copyin_async_l
1470   use openacc_kinds, only: acc_handle_kind
1471   type (*), dimension (..), contiguous :: a
1472   integer (acc_handle_kind) async
1473   call acc_copyin_async_l (a, sizeof (a), int (async, kind = c_int))
1474 end subroutine
1475
1476 subroutine acc_create_async_32_h (a, len, async)
1477   use iso_c_binding, only: c_int32_t, c_size_t, c_int
1478   use openacc_internal, only: acc_create_async_l
1479   use openacc_kinds, only: acc_handle_kind
1480   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1481   type (*), dimension (*) :: a
1482   integer (c_int32_t) len
1483   integer (acc_handle_kind) async
1484   call acc_create_async_l (a, int (len, kind = c_size_t), int (async, kind = c_int))
1485 end subroutine
1486
1487 subroutine acc_create_async_64_h (a, len, async)
1488   use iso_c_binding, only: c_int64_t, c_size_t, c_int
1489   use openacc_internal, only: acc_create_async_l
1490   use openacc_kinds, only: acc_handle_kind
1491   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1492   type (*), dimension (*) :: a
1493   integer (c_int64_t) len
1494   integer (acc_handle_kind) async
1495   call acc_create_async_l (a, int (len, kind = c_size_t), int (async, kind = c_int))
1496 end subroutine
1497
1498 subroutine acc_create_async_array_h (a, async)
1499   use iso_c_binding, only: c_int
1500   use openacc_internal, only: acc_create_async_l
1501   use openacc_kinds, only: acc_handle_kind
1502   type (*), dimension (..), contiguous :: a
1503   integer (acc_handle_kind) async
1504   call acc_create_async_l (a, sizeof (a), int (async, kind = c_int))
1505 end subroutine
1506
1507 subroutine acc_copyout_async_32_h (a, len, async)
1508   use iso_c_binding, only: c_int32_t, c_size_t, c_int
1509   use openacc_internal, only: acc_copyout_async_l
1510   use openacc_kinds, only: acc_handle_kind
1511   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1512   type (*), dimension (*) :: a
1513   integer (c_int32_t) len
1514   integer (acc_handle_kind) async
1515   call acc_copyout_async_l (a, int (len, kind = c_size_t), int (async, kind = c_int))
1516 end subroutine
1517
1518 subroutine acc_copyout_async_64_h (a, len, async)
1519   use iso_c_binding, only: c_int64_t, c_size_t, c_int
1520   use openacc_internal, only: acc_copyout_async_l
1521   use openacc_kinds, only: acc_handle_kind
1522   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1523   type (*), dimension (*) :: a
1524   integer (c_int64_t) len
1525   integer (acc_handle_kind) async
1526   call acc_copyout_async_l (a, int (len, kind = c_size_t), int (async, kind = c_int))
1527 end subroutine
1528
1529 subroutine acc_copyout_async_array_h (a, async)
1530   use iso_c_binding, only: c_int
1531   use openacc_internal, only: acc_copyout_async_l
1532   use openacc_kinds, only: acc_handle_kind
1533   type (*), dimension (..), contiguous :: a
1534   integer (acc_handle_kind) async
1535   call acc_copyout_async_l (a, sizeof (a), int (async, kind = c_int))
1536 end subroutine
1537
1538 subroutine acc_delete_async_32_h (a, len, async)
1539   use iso_c_binding, only: c_int32_t, c_size_t, c_int
1540   use openacc_internal, only: acc_delete_async_l
1541   use openacc_kinds, only: acc_handle_kind
1542   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1543   type (*), dimension (*) :: a
1544   integer (c_int32_t) len
1545   integer (acc_handle_kind) async
1546   call acc_delete_async_l (a, int (len, kind = c_size_t), int (async, kind = c_int))
1547 end subroutine
1548
1549 subroutine acc_delete_async_64_h (a, len, async)
1550   use iso_c_binding, only: c_int64_t, c_size_t, c_int
1551   use openacc_internal, only: acc_delete_async_l
1552   use openacc_kinds, only: acc_handle_kind
1553   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1554   type (*), dimension (*) :: a
1555   integer (c_int64_t) len
1556   integer (acc_handle_kind) async
1557   call acc_delete_async_l (a, int (len, kind = c_size_t), int (async, kind = c_int))
1558 end subroutine
1559
1560 subroutine acc_delete_async_array_h (a, async)
1561   use iso_c_binding, only: c_int
1562   use openacc_internal, only: acc_delete_async_l
1563   use openacc_kinds, only: acc_handle_kind
1564   type (*), dimension (..), contiguous :: a
1565   integer (acc_handle_kind) async
1566   call acc_delete_async_l (a, sizeof (a), int (async, kind = c_int))
1567 end subroutine
1568
1569 subroutine acc_update_device_async_32_h (a, len, async)
1570   use iso_c_binding, only: c_int32_t, c_size_t, c_int
1571   use openacc_internal, only: acc_update_device_async_l
1572   use openacc_kinds, only: acc_handle_kind
1573   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1574   type (*), dimension (*) :: a
1575   integer (c_int32_t) len
1576   integer (acc_handle_kind) async
1577   call acc_update_device_async_l (a, int (len, kind = c_size_t), int (async, kind = c_int))
1578 end subroutine
1579
1580 subroutine acc_update_device_async_64_h (a, len, async)
1581   use iso_c_binding, only: c_int64_t, c_size_t, c_int
1582   use openacc_internal, only: acc_update_device_async_l
1583   use openacc_kinds, only: acc_handle_kind
1584   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1585   type (*), dimension (*) :: a
1586   integer (c_int64_t) len
1587   integer (acc_handle_kind) async
1588   call acc_update_device_async_l (a, int (len, kind = c_size_t), int (async, kind = c_int))
1589 end subroutine
1590
1591 subroutine acc_update_device_async_array_h (a, async)
1592   use iso_c_binding, only: c_int
1593   use openacc_internal, only: acc_update_device_async_l
1594   use openacc_kinds, only: acc_handle_kind
1595   type (*), dimension (..), contiguous :: a
1596   integer (acc_handle_kind) async
1597   call acc_update_device_async_l (a, sizeof (a), int (async, kind = c_int))
1598 end subroutine
1599
1600 subroutine acc_update_self_async_32_h (a, len, async)
1601   use iso_c_binding, only: c_int32_t, c_size_t, c_int
1602   use openacc_internal, only: acc_update_self_async_l
1603   use openacc_kinds, only: acc_handle_kind
1604   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1605   type (*), dimension (*) :: a
1606   integer (c_int32_t) len
1607   integer (acc_handle_kind) async
1608   call acc_update_self_async_l (a, int (len, kind = c_size_t), int (async, kind = c_int))
1609 end subroutine
1610
1611 subroutine acc_update_self_async_64_h (a, len, async)
1612   use iso_c_binding, only: c_int64_t, c_size_t, c_int
1613   use openacc_internal, only: acc_update_self_async_l
1614   use openacc_kinds, only: acc_handle_kind
1615   !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
1616   type (*), dimension (*) :: a
1617   integer (c_int64_t) len
1618   integer (acc_handle_kind) async
1619   call acc_update_self_async_l (a, int (len, kind = c_size_t), int (async, kind = c_int))
1620 end subroutine
1621
1622 subroutine acc_update_self_async_array_h (a, async)
1623   use iso_c_binding, only: c_int
1624   use openacc_internal, only: acc_update_self_async_l
1625   use openacc_kinds, only: acc_handle_kind
1626   type (*), dimension (..), contiguous :: a
1627   integer (acc_handle_kind) async
1628   call acc_update_self_async_l (a, sizeof (a), int (async, kind = c_int))
1629 end subroutine