MAPL_TileMaskGet Subroutine

public subroutine MAPL_TileMaskGet(GRID, mask, RC)

Arguments

Type IntentOptional Attributes Name
type(ESMF_Grid), intent(inout) :: GRID
integer, pointer :: mask(:)
integer, intent(out), optional :: RC

Calls

proc~~mapl_tilemaskget~~CallsGraph proc~mapl_tilemaskget MAPL_TileMaskGet ESMF_DELayoutGet ESMF_DELayoutGet proc~mapl_tilemaskget->ESMF_DELayoutGet ESMF_DistGridGet ESMF_DistGridGet proc~mapl_tilemaskget->ESMF_DistGridGet ESMF_GridGet ESMF_GridGet proc~mapl_tilemaskget->ESMF_GridGet ESMF_VMBarrier ESMF_VMBarrier proc~mapl_tilemaskget->ESMF_VMBarrier ESMF_VMGet ESMF_VMGet proc~mapl_tilemaskget->ESMF_VMGet interface~mapl_allocnodearray MAPL_AllocNodeArray proc~mapl_tilemaskget->interface~mapl_allocnodearray interface~mapl_am_i_root MAPL_Am_I_Root proc~mapl_tilemaskget->interface~mapl_am_i_root interface~mapl_assert MAPL_Assert proc~mapl_tilemaskget->interface~mapl_assert interface~mapl_broadcasttonodes MAPL_BroadcastToNodes proc~mapl_tilemaskget->interface~mapl_broadcasttonodes interface~mapl_commsallgatherv MAPL_CommsAllGatherV proc~mapl_tilemaskget->interface~mapl_commsallgatherv interface~mapl_commsgatherv MAPL_CommsGatherV proc~mapl_tilemaskget->interface~mapl_commsgatherv interface~mapl_sort MAPL_Sort proc~mapl_tilemaskget->interface~mapl_sort interface~mapl_syncsharedmemory MAPL_SyncSharedMemory proc~mapl_tilemaskget->interface~mapl_syncsharedmemory proc~mapl_distgridget MAPL_DistGridGet proc~mapl_tilemaskget->proc~mapl_distgridget proc~mapl_gridget MAPL_GridGet proc~mapl_tilemaskget->proc~mapl_gridget proc~mapl_return MAPL_Return proc~mapl_tilemaskget->proc~mapl_return proc~mapl_verify MAPL_Verify proc~mapl_tilemaskget->proc~mapl_verify proc~mapl_distgridget->ESMF_DistGridGet proc~mapl_distgridget->proc~mapl_verify proc~mapl_gridget->ESMF_DistGridGet proc~mapl_gridget->ESMF_GridGet proc~mapl_gridget->proc~mapl_distgridget proc~mapl_gridget->proc~mapl_return proc~mapl_gridget->proc~mapl_verify ESMF_AttributeGet ESMF_AttributeGet proc~mapl_gridget->ESMF_AttributeGet proc~mapl_getimsjms MAPL_GetImsJms proc~mapl_gridget->proc~mapl_getimsjms proc~mapl_gridhasde MAPL_GridHasDE proc~mapl_gridget->proc~mapl_gridhasde at at proc~mapl_return->at insert insert proc~mapl_return->insert proc~mapl_throw_exception MAPL_throw_exception proc~mapl_return->proc~mapl_throw_exception proc~mapl_verify->proc~mapl_throw_exception proc~mapl_getimsjms->interface~mapl_assert proc~mapl_getimsjms->interface~mapl_sort proc~mapl_getimsjms->proc~mapl_return proc~mapl_getimsjms->proc~mapl_verify proc~mapl_gridhasde->ESMF_DELayoutGet proc~mapl_gridhasde->ESMF_DistGridGet proc~mapl_gridhasde->ESMF_GridGet proc~mapl_gridhasde->proc~mapl_return proc~mapl_gridhasde->proc~mapl_verify

Source Code

  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