subroutine MAPL_TileMaskGet(grid, mask, rc)
type (ESMF_Grid), intent(INout) :: GRID
integer, pointer :: mask(:)
integer, optional , intent( OUT) :: RC
! Local variables
integer :: STATUS
integer, pointer :: tileIndex(:)
integer :: gcount(2), lcount(2)
integer :: gsize, lsize
integer :: gridRank
integer :: n
type (ESMF_DistGrid) :: distGrid
integer, allocatable :: AL(:,:)
integer, allocatable :: AU(:,:)
integer, allocatable, dimension(:) :: recvcounts, displs
integer :: de, deId
integer :: nDEs
integer :: sendcount
integer :: I
integer :: I1, IN
integer, allocatable :: var(:)
type (ESMF_DELayout) :: layout
type(ESMF_VM) :: vm
logical :: amIRoot
call ESMF_GridGet(grid, dimCount=gridRank, distGrid=distGrid, _RC)
_ASSERT(gridRank == 1, 'gridRank must be 1')
call MAPL_GridGet(grid, globalCellCountPerDim=gcount, &
localCellCountPerDim=lcount, _RC)
gsize = gcount(1)
lsize = lcount(1)
call ESMF_DistGridGet(distgrid, localDe=0, elementCount=n, rc=status)
_ASSERT(lsize == n, ' inconsistent lsize')
allocate(tileIndex(lsize), _STAT)
call ESMF_DistGridGet(distgrid, localDe=0, seqIndexList=tileIndex, _RC)
call ESMF_DistGridGet(distGRID, delayout=layout, _RC)
call ESMF_DELayoutGet(layout, vm=vm, _RC)
call ESMF_VmGet(vm, localPet=deId, petCount=nDEs, _RC)
amIRoot = MAPL_AM_I_Root(vm)
call ESMF_VmBarrier(vm, _RC)
if (.not. MAPL_ShmInitialized) then
allocate(mask(gsize), _STAT)
else
call MAPL_AllocNodeArray(mask,(/gsize/),_RC)
end if
allocate (AL(gridRank,0:nDEs-1), _STAT)
allocate (AU(gridRank,0:nDEs-1), _STAT)
call MAPL_DistGridGet(distgrid, &
minIndex=AL, maxIndex=AU, _RC)
allocate (recvcounts(0:nDEs-1), displs(0:nDEs), _STAT)
if (.not. MAPL_ShmInitialized .or. amIRoot) then
allocate(VAR(0:gsize-1), _STAT)
else
allocate(VAR(0), _STAT)
end if
displs(0) = 0
do I = 0,nDEs-1
de = I
I1 = AL(1,I)
IN = AU(1,I)
recvcounts(I) = (IN - I1 + 1)
if (de == deId) then
sendcount = recvcounts(I) ! Count I will send
endif
displs(I+1) = displs(I) + recvcounts(I)
enddo
#ifdef NEW
_FAIL( 'unsupported code block') !ALT this section is questionable
do I = 0,nDEs-1
de = I
I1 = AL(1,I)
IN = AU(1,I)
var(I1:IN) = -9999
if (de == deId) then
var(I1:IN) = tileindex
endif
do II=I1,IN
mmax=var(II)
call MAPL_CommsAllReduceMax(vm, mmax, var(II), 1, _RC)
enddo
end do
#else
if (MAPL_ShmInitialized) then
call MAPL_CommsGatherV(layout, tileindex, sendcount, &
var, recvcounts, displs, MAPL_Root, _RC)
else
call MAPL_CommsAllGatherV(layout, tileindex, sendcount, &
var, recvcounts, displs, _RC)
endif
#endif
if (.not. MAPL_ShmInitialized .or. amIRoot) then
do I = 0,nDEs-1
mask(displs(I)+1:displs(I+1)) = I
end do
call MAPL_SORT(var,MASK)
end if
! clean up
deallocate(var)
deallocate (recvcounts, displs)
deallocate (AU)
deallocate (AL)
deallocate(tileIndex)
! mask is deallocated in the caller routine
call MAPL_BroadcastToNodes(MASK, N=gsize, ROOT=MAPL_Root, _RC)
call MAPL_SyncSharedMemory(_RC)
_RETURN(ESMF_SUCCESS)
end subroutine MAPL_TileMaskGet