44 use mpi_f08,
only : mpi_allreduce, mpi_alltoall, mpi_integer, mpi_max
46 use,
intrinsic :: iso_c_binding, only : c_sizeof, c_int32_t, c_int64_t, &
47 c_ptr, c_null_ptr, c_size_t, c_associated
54#if defined(HAVE_CUDA) && defined(HAVE_NVSHMEM)
55 logical,
parameter,
public :: GS_DEVICE_SHMEM_AVAIL = .true.
57 logical,
parameter,
public :: gs_device_shmem_avail = .false.
62 integer,
allocatable :: ndofs(:)
63 integer,
allocatable :: offset(:)
64 integer,
allocatable :: remote_offset(:)
69 integer :: slab_stride
70 type(c_ptr) :: buf_d = c_null_ptr
71 type(c_ptr) :: buf_v_d = c_null_ptr
72 type(c_ptr) :: dof_d = c_null_ptr
83 type(c_ptr),
allocatable :: stream(:)
84 type(c_ptr),
allocatable :: event(:)
96 type(c_ptr) :: done_sig_d = c_null_ptr
97 type(c_ptr) :: ready_sig_d = c_null_ptr
101 type(c_ptr) :: pack_event = c_null_ptr
114#if defined (HAVE_CUDA) && defined(HAVE_NVSHMEM)
118 bind(c, name =
'cudamalloc_nvshmem')
119 use,
intrinsic :: iso_c_binding
122 integer(c_size_t),
value :: size
128 bind(c, name =
'cudafree_nvshmem')
129 use,
intrinsic :: iso_c_binding
137 bind(c, name =
'cuda_gs_nvshmem_pack')
138 use,
intrinsic :: iso_c_binding
140 integer(c_int),
value :: boffset, n
141 type(c_ptr),
value :: u_d, buf_d, dof_d, stream
147 ns, stream) bind(c, name = 'cuda_gs_nvshmem_pack_vec')
148 use,
intrinsic :: iso_c_binding
150 integer(c_int),
value :: boffset, n, nc, ns
151 type(c_ptr),
value :: u_d, buf_d, dof_d, stream
157 roffset, iter, done_d, ready_d, mype) &
158 bind(c, name =
'cuda_gs_push')
159 use,
intrinsic :: iso_c_binding
161 integer(c_int),
value :: n, offset, dest_rank, roffset, iter, mype
162 type(c_ptr),
value :: buf_d, stream, rbuf_d, done_d, ready_d
168 bind(c, name =
'cuda_gs_push_wait')
169 use,
intrinsic :: iso_c_binding
171 integer(c_int),
value :: iter, src_rank
172 type(c_ptr),
value :: stream, done_d
178 bind(c, name =
'cuda_gs_post_ready')
179 use,
intrinsic :: iso_c_binding
181 integer(c_int),
value :: iter, mype, src_rank
182 type(c_ptr),
value :: stream, ready_d
188 bind(c, name =
'cuda_gs_unpack')
189 use,
intrinsic :: iso_c_binding
191 integer(c_int),
value :: op, offset, n
192 type(c_ptr),
value :: u_d, buf_d, dof_d, stream
198 stream) bind(c, name = 'cuda_gs_unpack_vec')
199 use,
intrinsic :: iso_c_binding
201 integer(c_int),
value :: op, offset, n, nc, ns
202 type(c_ptr),
value :: u_d, buf_d, dof_d, stream
216 integer,
allocatable,
intent(inout) :: pe_order(:)
217 type(
stack_i4_t),
allocatable,
intent(inout) :: dof_stack(:)
218 logical,
intent(in) :: mark_dupes
219 integer,
intent(in) :: nslabs
220 integer,
allocatable :: dofs(:)
221 integer :: i, j, total, max_total
222 integer(c_size_t) :: sz
224 integer :: dupe, marked, k
225 real(c_rp) :: rp_dummy
226 integer(c_int32_t) :: i4_dummy
228 allocate(this%ndofs(
size(pe_order)))
229 allocate(this%offset(
size(pe_order)))
230 allocate(this%remote_offset(
size(pe_order)))
232 do i = 1,
size(pe_order)
233 this%remote_offset(i) = -1
237 do i = 1,
size(pe_order)
238 this%ndofs(i) = dof_stack(pe_order(i))%size()
239 this%offset(i) = total
240 total = total + this%ndofs(i)
243 call mpi_allreduce(total, max_total, 1, mpi_integer, mpi_max,
neko_comm)
246 this%slab_stride = max_total
248 sz = c_sizeof(rp_dummy) * nslabs * max_total
252 sz = c_sizeof(rp_dummy) * nslabs *
gs_vec_nc * max_total
256 sz = c_sizeof(i4_dummy) * total
259 if (mark_dupes)
call doftable%init(2*total)
260 allocate(dofs(total))
264 do i = 1,
size(pe_order)
266 select type (arr => dof_stack(pe_order(i))%data)
268 do j = 1, this%ndofs(i)
269 k = this%offset(i) + j
271 if (doftable%get(arr(j), dupe) .eq. 0)
then
272 if (dofs(dupe) .gt. 0)
then
273 dofs(dupe) = -dofs(dupe)
279 call doftable%set(arr(j), k)
300 if (
allocated(this%ndofs))
deallocate(this%ndofs)
301 if (
allocated(this%offset))
deallocate(this%offset)
302 if (
allocated(this%remote_offset))
deallocate(this%remote_offset)
308 if (c_associated(this%dof_d))
call device_free(this%dof_d)
317 integer :: i, nstrm, ierr
318 integer,
allocatable :: local_offsets(:), remote_offsets(:)
319 integer(c_size_t) :: sz
320 integer(c_int64_t) :: i64_dummy
322 call this%init_order(send_pe, recv_pe)
329 if (
size(this%send_pe) .ne.
size(this%recv_pe))
then
330 call neko_error(
'gs_device_shmem requires symmetric peer lists')
332 do i = 1,
size(this%send_pe)
333 if (this%send_pe(i) .ne. this%recv_pe(i))
then
334 call neko_error(
'gs_device_shmem requires aligned peer lists')
340 call this%send_buf%init(this%send_pe, this%send_dof, .false., 2)
341 call this%recv_buf%init(this%recv_pe, this%recv_dof, .true., 1)
349 allocate(local_offsets(0:
pe_size - 1))
350 allocate(remote_offsets(0:
pe_size - 1))
352 do i = 1,
size(this%recv_pe)
353 local_offsets(this%recv_pe(i)) = this%recv_buf%offset(i)
355 call mpi_alltoall(local_offsets, 1, mpi_integer, &
356 remote_offsets, 1, mpi_integer,
neko_comm, ierr)
357 do i = 1,
size(this%send_pe)
358 this%send_buf%remote_offset(i) = remote_offsets(this%send_pe(i))
360 deallocate(local_offsets)
361 deallocate(remote_offsets)
363#if defined(HAVE_HIP) || defined(HAVE_CUDA)
368 nstrm =
max(
size(this%send_pe),
size(this%recv_pe))
369 allocate(this%stream(nstrm))
375 allocate(this%event(nstrm))
386 sz = c_sizeof(i64_dummy) *
pe_size
393 this%vec_supported = .true.
402 call this%send_buf%free()
403 call this%recv_buf%free()
407 if (c_associated(this%done_sig_d))
then
409 this%done_sig_d = c_null_ptr
411 if (c_associated(this%ready_sig_d))
then
413 this%ready_sig_d = c_null_ptr
417 call this%free_order()
418 call this%free_dofs()
420#if defined(HAVE_HIP) || defined(HAVE_CUDA)
421 if (
allocated(this%stream))
then
422 do i = 1,
size(this%stream)
425 deallocate(this%stream)
428 if (
allocated(this%event))
then
429 do i = 1,
size(this%event)
432 deallocate(this%event)
435 if (c_associated(this%pack_event))
then
437 this%pack_event = c_null_ptr
446 integer,
intent(in) :: n
447 real(kind=
rp),
dimension(n),
intent(inout) :: u
448 integer,
intent(in) :: tag
449 type(c_ptr),
intent(inout) :: deps
450 type(c_ptr),
intent(inout) :: strm
460 this%iter = this%iter + 1
461 parity = mod(this%iter, 2)
482 this%send_buf%dof_d, parity * this%send_buf%slab_stride, &
483 this%send_buf%total, strm)
488 do i = 1,
size(this%send_pe)
500 integer,
intent(in) :: tag
510 integer,
intent(in) :: n
511 real(kind=
rp),
dimension(n),
intent(inout) :: u
512 type(c_ptr),
intent(inout) :: strm
513 integer :: op, done_req, i, parity
518 parity = mod(this%iter, 2)
523 do i = 1,
size(this%send_pe)
525 parity * this%send_buf%slab_stride + this%send_buf%offset(i), &
526 this%send_buf%ndofs(i), &
529 this%recv_buf%buf_d, &
530 this%send_buf%remote_offset(i), &
531 this%iter, this%done_sig_d, this%ready_sig_d,
pe_rank)
536 do done_req = 1,
size(this%recv_pe)
538 this%done_sig_d, this%recv_pe(done_req))
540 this%recv_buf%buf_d, &
541 this%recv_buf%dof_d, &
542 this%recv_buf%offset(done_req), &
543 this%recv_buf%ndofs(done_req), &
544 this%stream(done_req))
546 this%ready_sig_d,
pe_rank, this%recv_pe(done_req))
551 do done_req = 1,
size(this%recv_pe)
553 this%event(done_req), 0)
564 integer,
intent(in) :: n, nc
565 real(kind=
rp),
dimension(nc*n),
intent(inout) :: u
566 integer,
intent(in) :: tag
567 type(c_ptr),
intent(inout) :: deps
568 type(c_ptr),
intent(inout) :: strm
577 this%iter = this%iter + 1
578 parity = mod(this%iter, 2)
582 this%send_buf%dof_d, &
583 parity *
gs_vec_nc * this%send_buf%slab_stride, &
584 this%send_buf%total, nc, n, strm)
589 do i = 1,
size(this%send_pe)
599 integer,
intent(in) :: tag, nc
605 integer,
intent(in) :: n, nc
606 real(kind=
rp),
dimension(nc*n),
intent(inout) :: u
607 type(c_ptr),
intent(inout) :: strm
608 integer :: op, done_req, i, parity
613 parity = mod(this%iter, 2)
618 do i = 1,
size(this%send_pe)
620 parity *
gs_vec_nc * this%send_buf%slab_stride &
621 + nc * this%send_buf%offset(i), &
622 nc * this%send_buf%ndofs(i), &
625 this%recv_buf%buf_v_d, &
626 nc * this%send_buf%remote_offset(i), &
627 this%iter, this%done_sig_d, this%ready_sig_d,
pe_rank)
632 do done_req = 1,
size(this%recv_pe)
634 this%done_sig_d, this%recv_pe(done_req))
636 this%recv_buf%buf_v_d, &
637 this%recv_buf%dof_d, &
638 this%recv_buf%offset(done_req), &
639 this%recv_buf%ndofs(done_req), &
641 this%stream(done_req))
643 this%ready_sig_d,
pe_rank, this%recv_pe(done_req))
648 do done_req = 1,
size(this%recv_pe)
650 this%event(done_req), 0)
Return the device pointer for an associated Fortran array.
Copy data between host and device (or device and device)
integer, public pe_size
MPI size of communicator.
integer, public pe_rank
MPI rank.
type(mpi_comm), public neko_comm
MPI communicator.
Device abstraction, common interface for various accelerators.
subroutine, public device_event_record(event, stream)
Record a device event.
integer, parameter, public host_to_device
subroutine, public device_free(x_d)
Deallocate memory on the device.
subroutine, public device_event_destroy(event)
Destroy a device event.
subroutine, public device_alloc(x_d, s)
Allocate memory on the device.
subroutine, public device_stream_create_with_priority(stream, flags, prio)
Create a device stream/command queue with priority.
subroutine, public device_stream_wait_event(stream, event, flags)
Synchronize a device stream with an event.
subroutine, public device_event_create(event, flags)
Create a device event queue.
integer, public strm_high_prio
High priority stream setting.
subroutine, public device_stream_destroy(stream)
Destroy a device stream/command queue.
Defines a gather-scatter communication method.
integer, parameter, public gs_vec_nc
Maximum number of components handled by the fused vector (multi-component) halo exchange used by gs_o...
Defines GPU aware MPI gather-scatter communication.
subroutine gs_device_shmem_nbrecv_vec(this, tag, nc)
No-op: everything happens in nbwait_vec.
subroutine gs_device_shmem_buf_init(this, pe_order, dof_stack, mark_dupes, nslabs)
subroutine gs_device_shmem_nbwait(this, u, n, op, strm)
Wait for non-blocking operations.
subroutine gs_device_shmem_nbsend_vec(this, u, n, nc, tag, deps, strm)
Fused nc-component send. u is the compact shared device buffer (component-outer, per-component stride...
subroutine gs_device_shmem_nbsend(this, u, n, tag, deps, strm)
Post non-blocking send operations.
subroutine gs_device_shmem_nbrecv(this, tag)
Post non-blocking receive operations.
subroutine gs_device_shmem_nbwait_vec(this, u, n, nc, op, strm)
Fused nc-component push + unpack (the pack happens in nbsend_vec).
subroutine gs_device_shmem_free(this)
Deallocate MPI based communication method.
subroutine gs_device_shmem_buf_free(this)
subroutine gs_device_shmem_init(this, send_pe, recv_pe)
Initialise MPI based communication method.
Implements a hash table ADT.
integer, parameter, public c_rp
integer, parameter, public rp
Global precision used in computations.
Implements a dynamic stack ADT.
Gather-scatter communication method.
Buffers for non-blocking communication and packing/unpacking.
Gather-scatter communication using device SHMEM. The arrays are indexed per PE like send_pe and @ rec...
Integer based hash table.