41 use,
intrinsic :: iso_c_binding
48 type(mpi_status) :: status
49 type(mpi_request) :: request
51 real(kind=
rp),
allocatable ::
data(:)
70 class(
gs_mpi_t),
intent(inout) :: this
73 integer,
pointer :: sp(:), rp(:)
76 call this%init_order(send_pe, recv_pe)
78 allocate(this%send_buf(send_pe%size()))
81 do i = 1, send_pe%size()
82 allocate(this%send_buf(i)%data(this%send_dof(sp(i))%size()))
85 allocate(this%recv_buf(recv_pe%size()))
88 do i = 1, recv_pe%size()
89 allocate(this%recv_buf(i)%data(this%recv_dof(rp(i))%size()))
96 class(
gs_mpi_t),
intent(inout) :: this
99 if (
allocated(this%send_buf))
then
100 do i = 1,
size(this%send_buf)
101 if (
allocated(this%send_buf(i)%data))
then
102 deallocate(this%send_buf(i)%data)
105 deallocate(this%send_buf)
108 if (
allocated(this%recv_buf))
then
109 do i = 1,
size(this%recv_buf)
110 if (
allocated(this%recv_buf(i)%data))
then
111 deallocate(this%recv_buf(i)%data)
114 deallocate(this%recv_buf)
117 call this%free_order()
118 call this%free_dofs()
124 class(
gs_mpi_t),
intent(inout) :: this
125 integer,
intent(in) :: n
126 real(kind=
rp),
dimension(n),
intent(inout) :: u
127 type(c_ptr),
intent(inout) :: deps
128 type(c_ptr),
intent(inout) :: strm
129 integer :: i, j, ierr, dst, thrdid
130 integer ,
pointer :: sp(:)
135 do i = 1,
size(this%send_pe)
136 dst = this%send_pe(i)
137 sp => this%send_dof(dst)%array()
138 do j = 1, this%send_dof(dst)%size()
139 this%send_buf(i)%data(j) = u(sp(j))
144 associate(send_data => this%send_buf(i)%data)
145 call mpi_isend(send_data,
size(send_data), &
147 neko_comm, this%send_buf(i)%request, ierr)
149 this%send_buf(i)%flag = .false.
155 class(
gs_mpi_t),
intent(inout) :: this
156 integer :: i, ierr, thrdid
161 do i = 1,
size(this%recv_pe)
165 associate(recv_data => this%recv_buf(i)%data)
166 call mpi_irecv(recv_data,
size(recv_data), &
167 mpi_real_precision, this%recv_pe(i), thrdid, &
168 neko_comm, this%recv_buf(i)%request, ierr)
170 this%recv_buf(i)%flag = .false.
177 class(
gs_mpi_t),
intent(inout) :: this
178 integer,
intent(in) :: n
179 real(kind=rp),
dimension(n),
intent(inout) :: u
180 type(c_ptr),
intent(inout) :: strm
181 integer :: i, j, src, ierr
183 integer ,
pointer :: sp(:)
186 nreqs =
size(this%recv_pe)
188 do while (nreqs .gt. 0)
189 do i = 1,
size(this%recv_pe)
190 if (.not. this%recv_buf(i)%flag)
then
191 call mpi_test(this%recv_buf(i)%request, this%recv_buf(i)%flag, &
192 this%recv_buf(i)%status, ierr)
193 if (this%recv_buf(i)%flag)
then
196 src = this%recv_pe(i)
197 sp => this%recv_dof(src)%array()
201 do j = 1, this%send_dof(src)%size()
202 u(sp(j)) = u(sp(j)) + this%recv_buf(i)%data(j)
206 do j = 1, this%send_dof(src)%size()
207 u(sp(j)) = u(sp(j)) * this%recv_buf(i)%data(j)
211 do j = 1, this%send_dof(src)%size()
212 u(sp(j)) = min(u(sp(j)), this%recv_buf(i)%data(j))
216 do j = 1, this%send_dof(src)%size()
217 u(sp(j)) =
max(u(sp(j)), this%recv_buf(i)%data(j))
225 nreqs =
size(this%send_pe)
226 do while (nreqs .gt. 0)
227 do i = 1,
size(this%send_pe)
228 if (.not. this%send_buf(i)%flag)
then
229 call mpi_test(this%send_buf(i)%request, this%send_buf(i)%flag, &
230 mpi_status_ignore, ierr)
231 if (this%send_buf(i)%flag) nreqs = nreqs - 1
type(mpi_comm) neko_comm
MPI communicator.
type(mpi_datatype) mpi_real_precision
MPI type for working precision of REAL types.
Defines a gather-scatter communication method.
Defines MPI gather-scatter communication.
subroutine gs_nbwait_mpi(this, u, n, op, strm)
Wait for non-blocking operations.
subroutine gs_nbrecv_mpi(this)
Post non-blocking receive operations.
subroutine gs_mpi_init(this, send_pe, recv_pe)
Initialise MPI based communication method.
subroutine gs_mpi_free(this)
Deallocate MPI based communication method.
subroutine gs_nbsend_mpi(this, u, n, deps, strm)
Post non-blocking send operations.
Defines Gather-scatter operations.
integer, parameter, public rp
Global precision used in computations.
Implements a dynamic stack ADT.
Gather-scatter communication method.
MPI buffer for non-blocking operations.
Gather-scatter communication using MPI.