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