openacc.f90 51 KB

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