subroutine MAPL_GridGet(GRID, globalCellCountPerDim, localCellCountPerDim, layout, RC)
type (ESMF_Grid), intent(IN) :: GRID
integer, optional, intent(INout) :: globalCellCountPerDim(:)
integer, optional, intent(INout) :: localCellCountPerDim(:)
integer, optional, intent(inout) :: layout(2)
integer, optional, intent( OUT) :: RC
! local vars
integer :: status
integer :: mincounts(ESMF_MAXDIM)
integer :: maxcounts(ESMF_MAXDIM)
integer :: gridRank
integer :: UNGRID
integer :: sz, tileCount, dimCount, deCount
logical :: plocal, pglobal, lxtradim
logical :: isPresent,hasDE
type(ESMF_DistGrid) :: distGrid
integer, allocatable :: maxindex(:,:),minindex(:,:)
integer, pointer :: ims(:),jms(:)
pglobal = present(globalCellCountPerDim)
plocal = present(localCellCountPerDim)
if (pglobal .or. plocal) then
call ESMF_GridGet(grid, dimCount=gridRank, _RC)
!ALT kludge
lxtradim = .false.
if (gridRank == 1) then
call ESMF_AttributeGet(grid, name='GRID_EXTRADIM', isPresent=isPresent, _RC)
if (isPresent) then
call ESMF_AttributeGet(grid, name='GRID_EXTRADIM', value=UNGRID, _RC)
lxtradim = .true.
end if
else if (gridRank == 2) then
call ESMF_AttributeGet(grid, name='GRID_LM', isPresent=isPresent, _RC)
if (isPresent) then
call ESMF_AttributeGet(grid, name='GRID_LM', value=UNGRID, _RC)
lxtradim = .true.
end if
end if
end if
if (pglobal) then
globalCellCountPerDim = 1
call ESMF_GridGet(grid, tileCount=tileCount,_RC)
call ESMF_GridGet(grid, tile=1, staggerLoc=ESMF_STAGGERLOC_CENTER, &
minIndex=mincounts, &
maxIndex=maxcounts, &
_RC )
sz = min(gridRank, ESMF_MAXDIM, size(globalCellCountPerDim))
globalCellCountPerDim(1:sz) = maxcounts(1:sz)-mincounts(1:sz)+1
! kludge for new cube sphere from ESMF
if (tileCount == 6) then
if (globalCellCountPerDim(1) /= 1) then ! kludge-on-the-kludge for Single-Column case
globalCellCountPerDim(2)=globalCellCountPerDim(2)*6
end if
end if
if (lxtradim ) then
globalCellCountPerDim(gridRank+1) = UNGRID
end if
end if
if (plocal) then
localCellCountPerDim = 1
HasDE = MAPL_GridHasDE(grid,_RC)
if (HasDE) then
call ESMF_GridGet(GRID, localDE=0, &
staggerloc=ESMF_STAGGERLOC_CENTER, &
exclusiveCount=localCellCountPerDim, _RC)
end if
if (lxtradim ) then
localCellCountPerDim(gridRank+1) = UNGRID
end if
end if
if (present(layout)) then
call ESMF_GridGet(grid,distgrid=distgrid,dimCount=dimCount,_RC)
call ESMF_DistGridGet(distgrid,deCount=deCount,_RC)
allocate(minindex(dimCount,decount),maxindex(dimCount,decount))
call MAPL_DistGridGet(distgrid, &
minIndex=minindex, &
maxIndex=maxindex, _RC)
nullify(ims,jms)
call MAPL_GetImsJms(Imins=minindex(1,:),Imaxs=maxindex(1,:),&
Jmins=minindex(2,:),Jmaxs=maxindex(2,:),Ims=ims,Jms=jms,_RC)
layout(1) = size(ims)
layout(2) = size(jms)
deallocate(ims,jms)
end if
_RETURN(ESMF_SUCCESS)
end subroutine MAPL_GridGet