openacc.f90 27 KB

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