11 integer :: Morton_no, recv_igrid, recv_ipe, send_igrid, send_ipe, igrid, ipe
13 integer :: itag, irecv, isend
14 integer,
dimension(:),
allocatable :: recvrequest, sendrequest
15 integer,
dimension(:,:),
allocatable :: recvstatus, sendstatus
18 integer,
dimension(:),
allocatable :: recvrequest_stg, sendrequest_stg
19 integer,
dimension(:,:),
allocatable :: recvstatus_stg, sendstatus_stg
21 integer,
external :: getnode
35 recvrequest=mpi_request_null
36 sendrequest=mpi_request_null
41 recvrequest_stg=mpi_request_null
42 sendrequest_stg=mpi_request_null
48 send_igrid=
sfc(1,morton_no)
49 send_ipe=
sfc(2,morton_no)
51 if (recv_ipe/=send_ipe)
then
61 if (recv_ipe==
mype)
then
62 if (recv_ipe==send_ipe)
then
71 call mpi_waitall(irecv,recvrequest,recvstatus,ierrmpi)
72 if(stagger_grid)
call mpi_waitall(irecv,recvrequest_stg,recvstatus_stg,ierrmpi)
75 call mpi_waitall(isend,sendrequest,sendstatus,ierrmpi)
76 if(stagger_grid)
call mpi_waitall(isend,sendrequest_stg,sendstatus_stg,ierrmpi)
79 deallocate(recvstatus,recvrequest,sendstatus,sendrequest)
80 if(stagger_grid)
deallocate(recvstatus_stg,recvrequest_stg,sendstatus_stg,sendrequest_stg)
83 do ipe=0,npe-1;
do morton_no=morton_start(ipe),morton_stop(ipe)
86 send_igrid=sfc(1,morton_no)
87 send_ipe=sfc(2,morton_no)
89 if (recv_ipe/=send_ipe)
then
91 call putnode(send_igrid,send_ipe)
94 {
#IFDEF EVOLVINGBOUNDARY
96 do morton_no=morton_start(mype),morton_stop(mype)
97 igrid=sfc_to_igrid(morton_no)
98 if (phyboundblock(igrid)) sfc_phybound(morton_no)=1
100 call mpi_allreduce(mpi_in_place,sfc_phybound,nleafs,mpi_integer,&
101 mpi_sum,icomm,ierrmpi)
105 call amr_morton_order()
115 {
#IFDEF EVOLVINGBOUNDARY
116 if (phyboundblock(recv_igrid))
then
117 call mpi_irecv(ps(recv_igrid)%w,1,type_block,send_ipe,itag, &
118 icomm,recvrequest(irecv),ierrmpi)
120 call mpi_irecv(ps(recv_igrid)%w,1,type_block_io,send_ipe,itag, &
121 icomm,recvrequest(irecv),ierrmpi)
123 }{
#IFNDEF EVOLVINGBOUNDARY
124 call mpi_irecv(ps(recv_igrid)%w,1,type_block_io,send_ipe,itag, &
125 icomm,recvrequest(irecv),ierrmpi)
127 if(stagger_grid)
then
128 itag=recv_igrid+max_blocks
129 call mpi_irecv(ps(recv_igrid)%ws,1,type_block_io_stg,send_ipe,itag, &
130 icomm,recvrequest_stg(irecv),ierrmpi)
139 {
#IFDEF EVOLVINGBOUNDARY
140 if (phyboundblock(send_igrid))
then
141 call mpi_isend(ps(send_igrid)%w,1,type_block,recv_ipe,itag, &
142 icomm,sendrequest(isend),ierrmpi)
144 call mpi_isend(ps(send_igrid)%w,1,type_block_io,recv_ipe,itag, &
145 icomm,sendrequest(isend),ierrmpi)
147 }{
#IFNDEF EVOLVINGBOUNDARY
148 call mpi_isend(ps(send_igrid)%w,1,type_block_io,recv_ipe,itag, &
149 icomm,sendrequest(isend),ierrmpi)
151 if(stagger_grid)
then
152 itag=recv_igrid+max_blocks
153 call mpi_isend(ps(send_igrid)%ws,1,type_block_io_stg,recv_ipe,itag, &
154 icomm,sendrequest_stg(isend),ierrmpi)
subroutine alloc_node(igrid)
allocate arrays on igrid node
integer function getnode(ipe)
Get first available igrid on processor ipe.
subroutine putnode(igrid, ipe)
subroutine change_ipe_tree_leaf(recv_igrid, recv_ipe, send_igrid, send_ipe)
Module with basic grid data structures.
integer, dimension(:), allocatable, save sfc_to_igrid
Go from a Morton number to an igrid index (for a single processor)
integer, dimension(:), allocatable, save morton_start
First Morton number per processor.
integer, dimension(:), allocatable, save morton_stop
Last Morton number per processor.
integer, dimension(:,:), allocatable, save sfc
Array to go from a Morton number to an igrid and processor index. Sfc(1:3, MN) contains [igrid,...
This module contains definitions of global parameters and variables and some generic functions/subrou...
logical stagger_grid
True for using stagger grid.
integer mype
The rank of the current MPI task.
integer npe
The number of MPI tasks.
integer max_blocks
The maximum number of grid blocks in a processor.
subroutine load_balance
reallocate blocks into processors for load balance
subroutine get_morton_range
Set the Morton range for each processor.