Line data Source code
1 : !!****m* ABINIT/m_gputk
2 : !! NAME
3 : !! m_gputk
4 : !!
5 : !! FUNCTION
6 : !! Low-level procedures for GPUs.
7 : !!
8 : !! COPYRIGHT
9 : !! Copyright (C) 2012-2025 ABINIT group (LNguyen,FDahm,MT)
10 : !! This file is distributed under the terms of the
11 : !! GNU General Public License, see ~abinit/COPYING
12 : !! or http://www.gnu.org/copyleft/gpl.txt .
13 : !!
14 : !! SOURCE
15 :
16 : #if defined HAVE_CONFIG_H
17 : #include "config.h"
18 : #endif
19 :
20 : #include "abi_common.h"
21 :
22 : module m_gputk
23 :
24 : use, intrinsic :: iso_c_binding
25 : USE_MPI
26 : use defs_basis
27 : use m_errors
28 : use m_abicore
29 : use m_xomp
30 : !use m_xomp
31 : !#if defined HAVE_GPU
32 : ! use m_gpu_toolbox
33 : !#endif
34 : !
35 : #if defined HAVE_MPI1
36 : include 'mpif.h'
37 : #endif
38 :
39 : implicit none
40 :
41 : private
42 : !!***
43 :
44 : !----------------------------------------------------------------------
45 :
46 : public :: gpu_set_to_zero
47 : public :: gpu_set_to_zero_sp
48 : public :: gpu_set_to_zero_complex
49 : public :: gpu_set_to_zero_complex_sp
50 : public :: gpu_copy
51 : public :: gpu_copy_sp
52 : public :: gpu_copy_complex
53 : public :: gpu_copy_complex_sp
54 :
55 : !----------------------------------------------------------------------
56 :
57 : #ifdef HAVE_GPU
58 : interface
59 : subroutine check_gpu_mem(str) bind(c, name="check_gpu_mem_")
60 : use, intrinsic :: iso_c_binding
61 : character (KIND=c_char), intent(in) :: str(*)
62 : end subroutine check_gpu_mem
63 :
64 : subroutine alloc_on_gpu(gpu_ptr,size_in_bytes) bind(c, name="alloc_on_gpu_cpp_")
65 : use, intrinsic :: iso_c_binding
66 : type(c_ptr), intent(inout) :: gpu_ptr
67 : integer(kind=c_size_t), intent(in) :: size_in_bytes
68 : end subroutine alloc_on_gpu
69 :
70 : subroutine dealloc_on_gpu(gpu_ptr) bind(c, name="dealloc_on_gpu_cpp_")
71 : use, intrinsic :: iso_c_binding
72 : type(c_ptr), intent(inout) :: gpu_ptr
73 : end subroutine dealloc_on_gpu
74 :
75 : subroutine copy_gpu_to_gpu(dest_gpu_ptr, src_gpu_ptr, size_in_bytes) bind(c, name="copy_gpu_to_gpu_cpp_")
76 : use, intrinsic :: iso_c_binding
77 : type(c_ptr) :: dest_gpu_ptr
78 : type(c_ptr) :: src_gpu_ptr
79 : integer(kind=c_size_t), intent(in) :: size_in_bytes
80 : end subroutine copy_gpu_to_gpu
81 :
82 : subroutine gpu_memset(gpu_ptr, val, size_in_bytes) bind(c, name="gpu_memset_cpp_")
83 : use, intrinsic :: iso_c_binding
84 : type(c_ptr), intent(in) :: gpu_ptr
85 : integer(kind=c_int32_t), intent(in) :: val
86 : integer(kind=c_size_t), intent(in) :: size_in_bytes
87 : end subroutine gpu_memset
88 :
89 : ! logical(kind=c_bool) function gpu_allocated(gpu_ptr) bind(c, name="gpu_allocated_")
90 : ! use, intrinsic :: iso_c_binding
91 : ! type(c_ptr), intent(in) :: gpu_ptr
92 : ! end function gpu_allocated
93 :
94 : subroutine gpu_allocated_impl(gpu_ptr, is_allocated) bind(c, name="gpu_allocated_impl_")
95 : use, intrinsic :: iso_c_binding
96 : type(c_ptr), intent(in) :: gpu_ptr
97 : logical(kind=c_bool), intent(out) :: is_allocated
98 : end subroutine gpu_allocated_impl
99 :
100 : subroutine gpu_managed_ptr_status(gpu_ptr, str) bind(c, name="gpu_managed_ptr_status_")
101 : use, intrinsic :: iso_c_binding
102 : type(c_ptr), intent(in) :: gpu_ptr
103 : character (KIND=c_char), intent(in) :: str(*)
104 : end subroutine gpu_managed_ptr_status
105 :
106 : end interface
107 :
108 : #else
109 : !dummy routines replace gpu helper routines
110 : public :: gpu_device_synchronize
111 : public :: check_gpu_mem
112 : public :: copy_from_gpu
113 : public :: copy_on_gpu
114 : public :: gpu_allocated_impl
115 : public :: gpu_managed_ptr_status
116 : #endif
117 :
118 : public :: alloc_on_gpu
119 : public :: dealloc_on_gpu
120 :
121 : public :: copy_gpu_to_gpu
122 : public :: gpu_memset
123 : public :: gpu_allocated
124 :
125 :
126 : CONTAINS !===========================================================
127 : !!***
128 :
129 : !!
130 : !! this is just a wrapper arround gpu_allocated_cuda, because (strangely)
131 : !! I can't manage to bind a function (not a subroutine) through iso_c_binding
132 : !!
133 0 : function gpu_allocated(gpu_ptr) result(is_allocated)
134 :
135 : !Arguments ------------------------------------
136 : type(c_ptr), intent(in) :: gpu_ptr
137 : logical(kind=c_bool) :: is_allocated
138 :
139 0 : call gpu_allocated_impl(gpu_ptr, is_allocated)
140 :
141 0 : end function gpu_allocated
142 :
143 : !----------------------------------------------------------------------
144 :
145 : #ifndef HAVE_GPU
146 :
147 : !!****f* m_gputk/gpu_device_synchronize
148 : !! NAME
149 : !! gpu_device_synchronize
150 : !!
151 : !! FUNCTION
152 : !! Wait for any running operation, compute and memory transfer, to complete on GPU.
153 : !!
154 : !! INPUTS
155 : !! None
156 : !!
157 : !! OUTPUT
158 : !! None
159 : !!
160 : !! SIDE EFFECTS
161 : !! WARNING! : this routine is a dummy one when HAVE_GPU is not enabled
162 : !! the correct one is in 17_gpu_toolbox/dev_spec.cu
163 : !!
164 : !! SOURCE
165 :
166 0 : subroutine gpu_device_synchronize()
167 : use, intrinsic :: iso_c_binding
168 : implicit none
169 0 : end subroutine gpu_device_synchronize
170 : !!***
171 :
172 :
173 : !!****f* m_gputk/check_gpu_mem
174 : !! NAME
175 : !! check_gpu_mem
176 : !!
177 : !! FUNCTION
178 : !! Print information about amount of free memory on GPU and total amount of memory on GPU (current device).
179 : !!
180 : !! INPUTS
181 : !! str is a string message (character array).
182 : !!
183 : !! OUTPUT
184 : !! None
185 : !!
186 : !! SIDE EFFECTS
187 : !! WARNING! : this routine is a dummy one when HAVE_GPU is not enabled
188 : !! the correct one is in 17_gpu_toolbox/dev_spec.cu
189 : !!
190 : !! SOURCE
191 :
192 0 : subroutine check_gpu_mem(str)
193 :
194 : !Arguments ------------------------------------
195 : character (KIND=c_char), intent(in), target :: str(*)
196 : !Local variables ------------------------------
197 : type(c_ptr) :: dummy
198 :
199 : if(.false.) dummy=c_loc(str)
200 :
201 0 : end subroutine check_gpu_mem
202 : !!***
203 :
204 : !!****f* m_gputk/alloc_on_gpu
205 : !! NAME
206 : !! alloc_on_gpu
207 : !!
208 : !! FUNCTION
209 : !! Allocate size byte in gpu memory and returns in gpu_ptr this location
210 : !!
211 : !! INPUTS
212 : !! size= size in byte to allocate
213 : !!
214 : !! OUTPUT
215 : !! gpu_ptr= C_PTR on gpu memory location that has been allocated
216 : !!
217 : !! SIDE EFFECTS
218 : !! WARNING! : this routine is a dummy one when HAVE_GPU is not enabled
219 : !! the correct one is in 17_gpu_toolbox/dev_spec.cu
220 : !!
221 : !! SOURCE
222 :
223 0 : subroutine alloc_on_gpu(gpu_ptr,size)
224 :
225 : !Arguments ------------------------------------
226 : type(c_ptr), intent(inout) :: gpu_ptr
227 : integer(kind=c_size_t), intent(in) :: size ! size in bytes to allocate
228 :
229 : ABI_UNUSED(gpu_ptr)
230 : ABI_UNUSED(size)
231 :
232 0 : end subroutine alloc_on_gpu
233 : !!***
234 :
235 : !!****f* m_gputk/copy_from_gpu
236 : !! NAME
237 : !! copy_from_gpu
238 : !!
239 : !! FUNCTION
240 : !! copy size byte from gpu memory (pointed by gpu_ptr) to cpu memory (pointed by cpu_ptr)
241 : !!
242 : !! INPUTS
243 : !! size_in_bytes = size in bytes to allocate
244 : !! gpu_ptr = C_PTR on gpu memory location that has been allocated
245 : !!
246 : !! OUTPUT
247 : !! dtab = fortran tab which will contains data
248 : !!
249 : !! SIDE EFFECTS
250 : !! WARNING! : this routine is a dummy one when HAVE_GPU is not enabled
251 : !! the correct one is in 17_gpu_toolbox/dev_spec.cu
252 : !!
253 : !! SOURCE
254 :
255 0 : subroutine copy_from_gpu(dtab,gpu_ptr,size_in_bytes)
256 :
257 : !Arguments ------------------------------------
258 : real(dp),dimension(*) :: dtab
259 : type(c_ptr) :: gpu_ptr
260 : integer(kind=c_size_t), intent(in) :: size_in_bytes ! size in byte (to be transfered)
261 :
262 : !Local variables ------------------------------
263 : type(c_ptr) :: cpu_ptr
264 :
265 : if(.false.) write(std_out,*) dtab(1)
266 : ABI_UNUSED(cpu_ptr)
267 : ABI_UNUSED(gpu_ptr)
268 : ABI_UNUSED(size_in_bytes)
269 :
270 0 : end subroutine copy_from_gpu
271 : !!***
272 :
273 : !!****f* m_gputk/copy_on_gpu
274 : !! NAME
275 : !! copy_on_gpu
276 : !!
277 : !! FUNCTION
278 : !! copy size byte from cpu (pointed by cpu_ptr) to gpu memory (pointed by gpu_ptr)
279 : !!
280 : !! INPUTS
281 : !! size_in_bytes = size in bytes to allocate
282 : !! dtab = fortran tab to copy
283 : !!
284 : !! OUTPUT
285 : !! gpu_ptr= C_PTR on gpu memory location
286 : !!
287 : !! SIDE EFFECTS
288 : !! WARNING! : this routine is a dummy one when HAVE_GPU is not enabled
289 : !! the correct one is in 17_gpu_toolbox/dev_spec.cu
290 : !!
291 : !! SOURCE
292 :
293 0 : subroutine copy_on_gpu(dtab,gpu_ptr,size_in_bytes)
294 :
295 : !Arguments ------------------------------------
296 : real(dp),dimension(*) :: dtab
297 : type(c_ptr) :: gpu_ptr
298 : integer(kind=c_size_t), intent(in) :: size_in_bytes ! size in byte (to be transfered)
299 :
300 : !Local variables ------------------------------
301 : type(c_ptr) :: cpu_ptr
302 :
303 : if(.false.) write(std_out,*) dtab(1)
304 : ABI_UNUSED(cpu_ptr)
305 : ABI_UNUSED(gpu_ptr)
306 : ABI_UNUSED(size_in_bytes)
307 :
308 0 : end subroutine copy_on_gpu
309 : !!***
310 :
311 : !!****f* m_gputk/copy_gpu_to_gpu
312 : !! NAME
313 : !! copy_gpu_to_gpu
314 : !!
315 : !! FUNCTION
316 : !! copy size byte from gpu (src) to gpu (dest)
317 : !!
318 : !! INPUTS
319 : !! size_in_bytes = size in bytes to copy
320 : !! src_gpu_ptr = C_PTR on gpu memory
321 : !!
322 : !! OUTPUT
323 : !! dest_gpu_ptr = C_PTR on gpu memory
324 : !!
325 : !! SIDE EFFECTS
326 : !! WARNING! : this routine is a dummy one when HAVE_GPU_CUDA is not enabled
327 : !! the correct one is in 17_gpu_toolbox/dev_spec.cu
328 : !!
329 : !! SOURCE
330 :
331 0 : subroutine copy_gpu_to_gpu(cpu_ptr,gpu_ptr,size_in_bytes)
332 :
333 : !Arguments ------------------------------------
334 : type(c_ptr) :: cpu_ptr
335 : type(c_ptr) :: gpu_ptr
336 : integer(kind=c_size_t), intent(in) :: size_in_bytes ! size in byte (to be transfered)
337 :
338 : ABI_UNUSED(cpu_ptr)
339 : ABI_UNUSED(gpu_ptr)
340 : ABI_UNUSED(size_in_bytes)
341 :
342 0 : end subroutine copy_gpu_to_gpu
343 : !!***
344 :
345 : !!****f* m_gputk/dealloc_on_gpu
346 : !! NAME
347 : !! dealloc_on_gpu
348 : !!
349 : !! FUNCTION
350 : !! free memory location pointed by gpu_ptr
351 : !!
352 : !! INPUTS
353 : !!
354 : !! OUTPUT
355 : !! gpu_ptr= C_PTR on gpu memory location that has been allocated
356 : !!
357 : !! SIDE EFFECTS
358 : !! WARNING! : this routine is a dummy one when HAVE_GPU is not enabled
359 : !! the correct one is in 17_gpu_toolbox/dev_spec.cu
360 : !!
361 : !! SOURCE
362 :
363 0 : subroutine dealloc_on_gpu(gpu_ptr)
364 :
365 : !Arguments ------------------------------------
366 : type(c_ptr) :: gpu_ptr
367 :
368 : ABI_UNUSED(gpu_ptr)
369 :
370 0 : end subroutine dealloc_on_gpu
371 : !!***
372 :
373 : !!****f* m_gputk/gpu_memset
374 : !! NAME
375 : !! gpu_memset
376 : !!
377 : !! FUNCTION
378 : !! Initializes or sets device memory to a value.
379 : !!
380 : !! INPUTS
381 : !! gpu_ptr= C_PTR on gpu memory location
382 : !! val= value used to initialized each bytes
383 : !! size= number of bytes to initialize
384 : !!
385 : !! OUTPUT
386 : !! gpu_ptr= C_PTR on gpu memory location
387 : !!
388 : !! SIDE EFFECTS
389 : !! WARNING! : this routine is a dummy one when HAVE_GPU is not enabled
390 : !! the correct one is in 17_gpu_toolbox/dev_spec.cu
391 : !!
392 : !! SOURCE
393 :
394 0 : subroutine gpu_memset(gpu_ptr, val, array_size)
395 :
396 : !Arguments ------------------------------------
397 : type(c_ptr) :: gpu_ptr
398 : integer(kind=c_int32_t), intent(in) :: val
399 : integer(kind=c_size_t), intent(in) :: array_size
400 :
401 : ABI_UNUSED(gpu_ptr)
402 : ABI_UNUSED(val)
403 : ABI_UNUSED(array_size)
404 :
405 0 : end subroutine gpu_memset
406 : !!***
407 :
408 : !!****f* m_gputk/gpu_allocated_impl
409 : !! NAME
410 : !! gpu_allocated_impl
411 : !!
412 : !! FUNCTION
413 : !! Check if pointer points to allocated gpu device memory.
414 : !!
415 : !! INPUTS
416 : !! gpu_ptr= C_PTR on gpu memory location
417 : !!
418 : !! OUTPUT
419 : !! is_allocate= logical(c_bool) : true (if allocated), false (if not allocated)
420 : !!
421 : !! SIDE EFFECTS
422 : !! WARNING! : this routine is a dummy one when HAVE_GPU is not enabled
423 : !! the correct one is in 17_gpu_toolbox/dev_spec.cu
424 : !!
425 : !! SOURCE
426 :
427 0 : subroutine gpu_allocated_impl(gpu_ptr, is_allocated)
428 :
429 : !Arguments ------------------------------------
430 : type(c_ptr) :: gpu_ptr
431 : logical(kind=c_bool), intent(out) :: is_allocated
432 :
433 : ABI_UNUSED(gpu_ptr)
434 :
435 0 : is_allocated = .false.
436 :
437 0 : end subroutine gpu_allocated_impl
438 : !!***
439 :
440 : !!****f* m_gputk/gpu_managed_ptr_status
441 : !! NAME
442 : !! gpu_managed_ptr_status_impl
443 : !!
444 : !! FUNCTION
445 : !! Print information about a managed pointer (host or device address when accessible).
446 : !!
447 : !! INPUTS
448 : !! gpu_ptr= C_PTR on gpu memory location
449 : !!
450 : !! OUTPUT
451 : !!
452 : !! SIDE EFFECTS
453 : !! WARNING! : this routine is a dummy one when HAVE_GPU is not enabled
454 : !! the correct one is in 17_gpu_toolbox/dev_spec.cu
455 : !!
456 : !! SOURCE
457 :
458 0 : subroutine gpu_managed_ptr_status(gpu_ptr, str)
459 :
460 : !Arguments ------------------------------------
461 : type(c_ptr) :: gpu_ptr
462 : character (KIND=c_char), intent(in), target :: str(*)
463 : !Local variables ------------------------------
464 : type(c_ptr) :: dummy
465 :
466 : ABI_UNUSED(gpu_ptr)
467 : if(.false.) dummy=c_loc(str)
468 :
469 0 : end subroutine gpu_managed_ptr_status
470 : !!***
471 : #endif
472 :
473 : !------------------------------------------------------------------------------
474 : !!****f* m_gputk/gpu_set_to_zero
475 : !! NAME
476 : !! gpu_set_to_zero
477 : !!
478 : !! FUNCTION
479 : !! Set array content to zero
480 : !!
481 : !! INPUTS
482 : !! size = size of array
483 : !!
484 : !! OUTPUT
485 : !! array = array to be set to zero
486 : !!
487 : !! SOURCE
488 :
489 0 : subroutine gpu_set_to_zero(array, sizea)
490 : integer(c_size_t),intent(in) :: sizea
491 : real(dp),target,intent(out) :: array(sizea)
492 : ! *********************************************************************
493 :
494 : #if defined HAVE_OPENMP_OFFLOAD
495 : integer(c_size_t) :: i
496 :
497 : #if defined HAVE_GPU_CUDA
498 : !$OMP TARGET DATA USE_DEVICE_ADDR(array)
499 : call gpu_memset(c_loc(array), 0, sizea*dp)
500 : !$OMP END TARGET DATA
501 : #elif defined HAVE_GPU_HIP
502 : !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO PRIVATE(i) MAP(to:array)
503 : do i=1,sizea
504 : array(i)=zero
505 : end do
506 : #endif
507 :
508 : #endif
509 :
510 0 : end subroutine gpu_set_to_zero
511 : !!***
512 :
513 : !------------------------------------------------------------------------------
514 : !!****f* m_gputk/gpu_set_to_zero_sp
515 : !! NAME
516 : !! gpu_set_to_zero_sp
517 : !!
518 : !! FUNCTION
519 : !! Set array content to zero
520 : !!
521 : !! INPUTS
522 : !! size = size of array
523 : !!
524 : !! OUTPUT
525 : !! array = array to be set to zero
526 : !!
527 : !! SOURCE
528 :
529 0 : subroutine gpu_set_to_zero_sp(array, sizea)
530 : integer(c_size_t),intent(in) :: sizea
531 : real(sp),target,intent(out) :: array(sizea)
532 : ! *********************************************************************
533 :
534 : #if defined HAVE_OPENMP_OFFLOAD
535 : integer(c_size_t) :: i
536 :
537 : #if defined HAVE_GPU_CUDA
538 : !$OMP TARGET DATA USE_DEVICE_ADDR(array)
539 : call gpu_memset(c_loc(array), 0, sizea*sp)
540 : !$OMP END TARGET DATA
541 : #elif defined HAVE_GPU_HIP
542 : !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO PRIVATE(i) MAP(to:array)
543 : do i=1,sizea
544 : array(i)=zero_sp
545 : end do
546 : #endif
547 :
548 : #endif
549 :
550 0 : end subroutine gpu_set_to_zero_sp
551 : !!***
552 :
553 : !------------------------------------------------------------------------------
554 : !!****f* m_gputk/gpu_set_to_zero_complex
555 : !! NAME
556 : !! gpu_set_to_zero_complex
557 : !!
558 : !! FUNCTION
559 : !! Set array content to zero
560 : !!
561 : !! INPUTS
562 : !! size = size of array
563 : !!
564 : !! OUTPUT
565 : !! array = array to be set to zero
566 : !!
567 : !! SOURCE
568 :
569 0 : subroutine gpu_set_to_zero_complex(array, sizea)
570 : integer(c_size_t),intent(in) :: sizea
571 : complex(dp),target,intent(out) :: array(sizea)
572 : ! *********************************************************************
573 :
574 : #if defined HAVE_OPENMP_OFFLOAD
575 : integer(c_size_t) :: i
576 :
577 : #if defined HAVE_GPU_CUDA
578 : !$OMP TARGET DATA USE_DEVICE_ADDR(array)
579 : call gpu_memset(c_loc(array), 0, sizea*dp*2)
580 : !$OMP END TARGET DATA
581 : #elif defined HAVE_GPU_HIP
582 : !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO PRIVATE(i) MAP(to:array)
583 : do i=1,sizea
584 : array(i)=czero
585 : end do
586 : #endif
587 :
588 : #endif
589 :
590 0 : end subroutine gpu_set_to_zero_complex
591 : !!***
592 :
593 : !!****f* m_gputk/gpu_set_to_zero_complex_sp
594 : !! NAME
595 : !! gpu_set_to_zero_complex_sp
596 : !!
597 : !! FUNCTION
598 : !! Set array content to zero
599 : !!
600 : !! INPUTS
601 : !! size = size of array
602 : !!
603 : !! OUTPUT
604 : !! array = array to be set to zero
605 : !!
606 : !! SOURCE
607 :
608 0 : subroutine gpu_set_to_zero_complex_sp(array, sizea)
609 : integer(c_size_t),intent(in) :: sizea
610 : complex(sp),target,intent(out) :: array(sizea)
611 : ! *********************************************************************
612 :
613 : #if defined HAVE_OPENMP_OFFLOAD
614 : integer(c_size_t) :: i
615 :
616 : #if defined HAVE_GPU_CUDA
617 : !$OMP TARGET DATA USE_DEVICE_ADDR(array)
618 : call gpu_memset(c_loc(array), 0, sizea*sp*2)
619 : !$OMP END TARGET DATA
620 : #elif defined HAVE_GPU_HIP
621 : !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO PRIVATE(i) MAP(to:array)
622 : do i=1,sizea
623 : array(i)=czero_sp
624 : end do
625 : #endif
626 :
627 : #endif
628 :
629 0 : end subroutine gpu_set_to_zero_complex_sp
630 : !!***
631 :
632 : !------------------------------------------------------------------------------
633 :
634 : !!****f* m_gputk/gpu_copy
635 : !! NAME
636 : !! gpu_copy
637 : !!
638 : !! FUNCTION
639 : !! Copy array content on GPU to another
640 : !!
641 : !! INPUTS
642 : !! src = array to be copied
643 : !! size = size of src and dest
644 : !!
645 : !! OUTPUT
646 : !! dest = array to be set
647 : !!
648 : !! SOURCE
649 :
650 0 : subroutine gpu_copy(dest, src, sizea)
651 : integer(c_size_t),intent(in) :: sizea
652 : real(dp),target,intent(in) :: src(sizea)
653 : real(dp),target,intent(out) :: dest(sizea)
654 : ! *********************************************************************
655 :
656 : #if defined HAVE_OPENMP_OFFLOAD
657 : integer(c_size_t) :: i
658 :
659 : #if defined HAVE_GPU_CUDA
660 : !$OMP TARGET DATA USE_DEVICE_ADDR(dest,src)
661 : call copy_gpu_to_gpu(c_loc(dest), c_loc(src), sizea*dp)
662 : !$OMP END TARGET DATA
663 : #elif defined HAVE_GPU_HIP
664 : !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO PRIVATE(i) MAP(to:src,dest)
665 : do i=1,sizea
666 : dest(i)=src(i)
667 : end do
668 : #endif
669 :
670 : #else
671 : ! Make testfarm happy
672 : ABI_UNUSED((/src,dest/))
673 : #endif
674 :
675 0 : end subroutine gpu_copy
676 : !!***
677 :
678 : !!****f* m_gputk/gpu_copy_sp
679 : !! NAME
680 : !! gpu_copy_sp
681 : !!
682 : !! FUNCTION
683 : !! Copy array content on GPU to another (single precision version)
684 : !!
685 : !! INPUTS
686 : !! src = array to be copied
687 : !! size = size of src and dest
688 : !!
689 : !! OUTPUT
690 : !! dest = array to be set
691 : !!
692 : !! SOURCE
693 :
694 0 : subroutine gpu_copy_sp(dest, src, sizea)
695 : integer(c_size_t),intent(in) :: sizea
696 : real(sp),target,intent(in) :: src(sizea)
697 : real(sp),target,intent(out) :: dest(sizea)
698 : ! *********************************************************************
699 :
700 : #if defined HAVE_OPENMP_OFFLOAD
701 : integer(c_size_t) :: i
702 :
703 : #if defined HAVE_GPU_CUDA
704 : !$OMP TARGET DATA USE_DEVICE_ADDR(dest,src)
705 : call copy_gpu_to_gpu(c_loc(dest), c_loc(src), sizea*sp)
706 : !$OMP END TARGET DATA
707 : #elif defined HAVE_GPU_HIP
708 : !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO PRIVATE(i) MAP(to:src,dest)
709 : do i=1,sizea
710 : dest(i)=src(i)
711 : end do
712 : #endif
713 :
714 : #else
715 : ! Make testfarm happy
716 : ABI_UNUSED((/src,dest/))
717 : #endif
718 :
719 0 : end subroutine gpu_copy_sp
720 : !!***
721 :
722 : !!****f* m_gputk/gpu_copy_complex
723 : !! NAME
724 : !! gpu_copy_complex
725 : !!
726 : !! FUNCTION
727 : !! Copy array content on GPU to another
728 : !!
729 : !! INPUTS
730 : !! src = array to be copied
731 : !! size = size of src and dest
732 : !!
733 : !! OUTPUT
734 : !! dest = array to be set
735 : !!
736 : !! SOURCE
737 :
738 0 : subroutine gpu_copy_complex(dest, src, sizea)
739 : integer(c_size_t),intent(in) :: sizea
740 : complex(dp),target,intent(in) :: src(sizea)
741 : complex(dp),target,intent(out) :: dest(sizea)
742 : ! *********************************************************************
743 :
744 : #if defined HAVE_OPENMP_OFFLOAD
745 : integer(c_size_t) :: i
746 :
747 : #if defined HAVE_GPU_CUDA
748 : !$OMP TARGET DATA USE_DEVICE_ADDR(dest,src)
749 : call copy_gpu_to_gpu(c_loc(dest), c_loc(src), sizea*dp*2)
750 : !$OMP END TARGET DATA
751 : #elif defined HAVE_GPU_HIP
752 : !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO PRIVATE(i) MAP(to:src,dest)
753 : do i=1,sizea
754 : dest(i)=src(i)
755 : end do
756 : #endif
757 :
758 : #else
759 : ! Make testfarm happy
760 : ABI_UNUSED((/src,dest/))
761 : #endif
762 :
763 0 : end subroutine gpu_copy_complex
764 : !!***
765 :
766 : !!****f* m_gputk/gpu_copy_complex_sp
767 : !! NAME
768 : !! gpu_copy_complex_sp
769 : !!
770 : !! FUNCTION
771 : !! Copy array content on GPU to another (single precision version)
772 : !!
773 : !! INPUTS
774 : !! src = array to be copied
775 : !! size = size of src and dest
776 : !!
777 : !! OUTPUT
778 : !! dest = array to be set
779 : !!
780 : !! SOURCE
781 :
782 0 : subroutine gpu_copy_complex_sp(dest, src, sizea)
783 : integer(c_size_t),intent(in) :: sizea
784 : complex(sp),target,intent(in) :: src(sizea)
785 : complex(sp),target,intent(out) :: dest(sizea)
786 : ! *********************************************************************
787 :
788 : #if defined HAVE_OPENMP_OFFLOAD
789 : integer(c_size_t) :: i
790 :
791 : #if defined HAVE_GPU_CUDA
792 : !$OMP TARGET DATA USE_DEVICE_ADDR(dest,src)
793 : call copy_gpu_to_gpu(c_loc(dest), c_loc(src), sizea*sp*2)
794 : !$OMP END TARGET DATA
795 : #elif defined HAVE_GPU_HIP
796 : !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO PRIVATE(i) MAP(to:src,dest)
797 : do i=1,sizea
798 : dest(i)=src(i)
799 : end do
800 : #endif
801 :
802 : #else
803 : ! Make testfarm happy
804 : ABI_UNUSED((/src,dest/))
805 : #endif
806 :
807 0 : end subroutine gpu_copy_complex_sp
808 : !!***
809 :
810 : end module m_gputk
811 : !!***
|
