subroutine recvflux(idimmin,idimmax)
use mod_global_parameters
use mod_comm_lib, only: mpistop
integer, intent(in) :: idimmin,idimmax
integer :: iigrid, igrid, idims, iside, i1,i2,i3, nxCo1,nxCo2,nxCo3
integer :: ic1,ic2,ic3, inc1,inc2,inc3, ipe_neighbor
integer :: pi1,pi2,pi3,mi1,mi2,mi3,ph1,ph2,ph3,mh1,mh2,mh3,idir
! One receive per peer. build_message_layout has already decided where
! each peer's run starts and how long it is, and filled ibuf_offset so
! fix_conserve can find an individual chunk inside it. The tag no longer
! identifies a chunk - (communicator, source) plus one tag per exchange is
! enough now that a peer sends exactly one message - so it only has to
! separate two exchanges with different dimension ranges.
if (n_recv_pe>0) then
fc_recvreq=MPI_REQUEST_NULL
itag=idimmin+4*idimmax
#ifndef NOGPUDIRECT
#endif
do irecv=1,n_recv_pe
call mpi_irecv_wrapper(recvbuffer(recv_pe_off(irecv)),&
recv_pe_len(irecv),MPI_DOUBLE_PRECISION,recv_pe(irecv),itag,icomm,&
fc_recvreq(irecv),ierrmpi)
end do
#ifndef NOGPUDIRECT
#endif
end if
if(stagger_grid) then
! receive corners
if (nrecv_ct>0) then
cc_recvreq=MPI_REQUEST_NULL
ibuf_cc=1
irecv_cc=0
do iigrid=1,igridstail; igrid=igrids(iigrid);
do idims= idimmin,idimmax
do iside=1,2
i1=kr(1,idims)*(2*iside-3);i2=kr(2,idims)*(2*iside-3)
i3=kr(3,idims)*(2*iside-3);
! Check if there are special corners
! (Coarse block diagonal to a fine block)
! If there are, receive.
! Tags are calculated in the same way as for
! normal fluxes, but should not overlap because
! inc^D are different
if (neighbor_type(i1,i2,i3,igrid)==3) then
do idir=idims+1,ndim
pi1=i1+kr(idir,1);pi2=i2+kr(idir,2);pi3=i3+kr(idir,3);
mi1=i1-kr(idir,1);mi2=i2-kr(idir,2);mi3=i3-kr(idir,3);
ph1=pi1-kr(idims,1)*(2*iside-3)
ph2=pi2-kr(idims,2)*(2*iside-3)
ph3=pi3-kr(idims,3)*(2*iside-3);
mh1=mi1-kr(idims,1)*(2*iside-3)
mh2=mi2-kr(idims,2)*(2*iside-3)
mh3=mi3-kr(idims,3)*(2*iside-3);
if (neighbor_type(pi1,pi2,pi3,&
igrid)==4.and.neighbor_type(ph1,ph2,ph3,&
igrid)==3.and.neighbor_pole(pi1,pi2,pi3,igrid)==0) then
! Loop on children (several in 3D)
do ic3=1+int((1-pi3)/2),2-int((1+pi3)/2)
inc3=2*pi3+ic3
do ic2=1+int((1-pi2)/2),2-int((1+pi2)/2)
inc2=2*pi2+ic2
do ic1=1+int((1-pi1)/2),2-int((1+pi1)/2)
inc1=2*pi1+ic1
ipe_neighbor=neighbor_child(2,inc1,inc2,inc3,igrid)
if (mype/=ipe_neighbor) then
irecv_cc=irecv_cc+1
itag_cc=4**3*(igrid-1)+inc1*4**(1-1)+inc2*4**(2-1)+&
inc3*4**(3-1)
call mpi_irecv_wrapper(recvbuffer_cc(ibuf_cc),&
isize_stg(idims),MPI_DOUBLE_PRECISION,ipe_neighbor,&
itag_cc,icomm,cc_recvreq(irecv_cc),ierrmpi)
ibuf_cc=ibuf_cc+isize_stg(idims)
end if
end do
end do
end do
end if
if (neighbor_type(mi1,mi2,mi3,&
igrid)==4.and.neighbor_type(mh1,mh2,mh3,&
igrid)==3.and.neighbor_pole(mi1,mi2,mi3,igrid)==0) then
! Loop on children (several in 3D)
do ic3=1+int((1-mi3)/2),2-int((1+mi3)/2)
inc3=2*mi3+ic3
do ic2=1+int((1-mi2)/2),2-int((1+mi2)/2)
inc2=2*mi2+ic2
do ic1=1+int((1-mi1)/2),2-int((1+mi1)/2)
inc1=2*mi1+ic1
ipe_neighbor=neighbor_child(2,inc1,inc2,inc3,igrid)
if (mype/=ipe_neighbor) then
irecv_cc=irecv_cc+1
itag_cc=4**3*(igrid-1)+inc1*4**(1-1)+inc2*4**(2-1)+&
inc3*4**(3-1)
call mpi_irecv_wrapper(recvbuffer_cc(ibuf_cc),&
isize_stg(idims),MPI_DOUBLE_PRECISION,ipe_neighbor,&
itag_cc,icomm,cc_recvreq(irecv_cc),ierrmpi)
ibuf_cc=ibuf_cc+isize_stg(idims)
end if
end do
end do
end do
end if
end do
end if
end do
end do
end do
end if
end if ! end if stagger grid
end subroutine recvflux