subroutine MAPL_CollectiveGather3D(Grid, LocArray, GlobArray, &
CoresPerNode, rc)
type (ESMF_Grid), intent(INout) :: Grid
real, intent(IN ) :: LocArray(:,:,:)
real, pointer :: GlobArray(:,:,:)
integer, optional, intent(In ) :: CoresPerNode
integer, optional, intent( OUT) :: rc
! Locals
!-------
integer :: status
type (MAPL_CommRequest) :: reqs(size(LocArray,3))
integer :: root(size(LocArray,3))
integer :: Nnodes
integer :: nn
integer :: LM, L, nc, npes, mype, dims(5)
type(ESMF_VM) :: VM
integer :: comm
! Begin
!------
_ASSERT(.not.associated(GlobArray), 'GlobalArray already associated')
call ESMF_VMGetCurrent(VM, RC=STATUS)
_VERIFY(STATUS)
call ESMF_VMGet(VM, petcount=npes, localpet=MYPE, mpiCommunicator=comm, RC=STATUS)
_VERIFY(STATUS)
LM = size(LocArray,3)
nNodes = size(MAPL_NodeRankList)
call MAPL_RoundRobinPEList(Root, nNodes, RC=STATUS)
_VERIFY(STATUS)
if(any(root==mype)) then
call MAPL_GridGet ( grid, globalCellCountPerDim=DIMS, RC=STATUS)
_VERIFY(STATUS)
nc = count(Root==mype)
allocate(GlobArray(dims(1),dims(2),nc),stat=STATUS)
_VERIFY(STATUS)
else
allocate(GlobArray(1,1,1) ,stat=STATUS)
_VERIFY(STATUS)
endif
nn = 0
do L=1,LM
if(root(L) == mype) then
nn = nn + 1
call MAPL_CreateRequest(GRID, Root(L), reqs(L), tag=L, &
RequestType=MAPL_IsGather, &
DstArray=GlobArray(:,:,nn), &
PrePost=.true., RC=STATUS)
_VERIFY(STATUS)
else
call MAPL_CreateRequest(GRID, Root(L), reqs(L), tag=L, &
RequestType=MAPL_IsGather, &
DstArray=GlobArray(:,:,1), &
PrePost=.true., RC=STATUS)
_VERIFY(STATUS)
end if
enddo ! Do not fuse with next
do L=1,LM
call MAPL_ArrayIGather (LocArray(:,:,L), reqs(L), RC=STATUS)
_VERIFY(STATUS)
enddo ! Do not fuse with next
do L=1,LM
call MAPL_CollectiveWait(reqs(L), rc=status)
_VERIFY(STATUS)
end do
_RETURN(ESMF_SUCCESS)
_UNUSED_DUMMY(corespernode)
end subroutine MAPL_CollectiveGather3D