subroutine ESMF_GridGetArrayInfo(grid, staggerloc, &
gridToFieldMap, ungriddedLBound, ungriddedUBound, &
staggerDistgrid, distgridToArrayMap, &
undistLBound, undistUBound, &
rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type(ESMF_StaggerLoc), intent(in), optional :: staggerloc
integer, intent(in), optional :: gridToFieldMap(:)
integer, intent(in), optional :: ungriddedLBound(:)
integer, intent(in), optional :: ungriddedUBound(:)
type(ESMF_DistGrid), intent(out), optional :: staggerDistgrid
integer, intent(out) :: distgridToArrayMap(:)
integer, intent(out), optional :: undistLBound(:)
integer, intent(out), optional :: undistUBound(:)
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This subroutine gets information from a Grid which is useful in creating an
! Array corresponding to a Field. This subroutine returns the distgridToArray map and
! undistBounds which can be used to create an Array the same size and shape as the Grid.
! Optionally, the user can pass in non-grid bounds, the subroutine then
! returns a map and undistbounds which include these non-grid bounds.
!
! The arguments are:
! \begin{description}
!\item[{grid}]
! The grid to get the information from to create the Array.
!\item[{staggerloc}]
! The stagger location to build the Array for.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to
! ESMF\_STAGGERLOC\_CENTER.
!\item[staggerDistgrid]
! The class that describes the stagger locations in the grids distribution.
!\item[{[gridToFieldMap]}]
! Indicates how the grid dimension map to the field that the newly created array
! is associated with. {\tt The array gridToFieldMap} should be at least of size equal
! to the grid's dimCount. If not set defaults to (1,2,3,....). An entry of 0 indicates
! the grid dimension isn't mapped to the Array.
!\item[{[ungriddedLBound]}]
! The lower bounds of the non-grid Array dimensions.
!\item[{[ungriddedUBound]}]
! The upper bounds of the non-grid array dimensions.
!\item[{distgridToArrayMap}]
! The distgrid to Array dimension map (must be allocated to at least
! the number of dimensions of the distGrid).
!\item[{undistLBound}]
! Undistributed lower bounds (must be of size grid undistDimCount+size(ungriddedUBound))
!\item[{undistUBound}]
! Undistributed upper bounds (must be of size grid undistDimCount+size(ungriddedUBound))
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
integer :: localrc ! local error status
type(ESMF_StaggerLoc) :: localStaggerLoc
type(ESMF_GridDecompType) :: decompType
integer, pointer :: arrayDimType(:)
integer, pointer :: arrayDimInd(:)
integer, pointer :: distgridToGridMap(:)
integer :: dimCount,distDimCount, arrayDimCount
integer :: i,j,k,ungriddedDimCount, undistArrayDimCount, bndpos
integer :: gridComputationalEdgeLWidth(ESMF_MAXDIM)
integer :: gridComputationalEdgeUWidth(ESMF_MAXDIM)
integer :: tmpArrayComputationalEdgeLWidth(ESMF_MAXDIM)
integer :: tmpArrayComputationalEdgeUWidth(ESMF_MAXDIM)
integer :: localGridToFieldMap(ESMF_MAXDIM)
logical :: filled(ESMF_MAXDIM)
logical :: contains_nonzero
integer :: fieldDimCount
integer :: gridUsedDimCount
integer :: arbdim, rep_arb, rep_noarb
logical :: found
type(ESMF_DistGrid) :: distgrid
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Check init status of arguments
ESMF_INIT_CHECK_DEEP_SHORT(ESMF_GridGetInit, grid, rc)
! Get DecomposeType
call ESMF_GridGetDecompType(grid, decompType, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set Default StaggerLoc if neccessary
if (present(staggerloc)) then
localStaggerLoc=staggerloc
else
localStaggerLoc=ESMF_STAGGERLOC_CENTER
endif
! Both the bounds need to be present if either is.
if ((present(ungriddedLBound) .or. present(ungriddedUBound)) .and. &
.not. (present(ungriddedLBound) .and. present(ungriddedUBound))) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- if either ungriddedBound is present both need to be", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! The bounds need to be the same size
if (present(ungriddedLBound) .and. present(ungriddedUBound)) then
if (size(ungriddedLBound) /= size(ungriddedUBound)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- ungriddedLBound and ungriddedUBound must be the same size ", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
! Get the ungridded dimCount
ungriddedDimCount=0
if (present(ungriddedUBound)) then
ungriddedDimCount=size(ungriddedUBound)
endif
! Get info from Grid
call ESMF_GridGet(grid, dimCount=dimCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! calc undist Array DimCount
undistArrayDimCount=ungriddedDimCount
! Make sure gridToFieldMap is correct size
if (present(gridToFieldMap)) then
if (size(gridToFieldMap) < dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- gridToFieldMap needs to at least be of the Grid's dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
! Get grid distgrid
call ESMF_GridGet(grid, localStaggerLoc, distgrid=distgrid, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! if argument is present, then pass out distgrid
if (present(staggerDistGrid)) then
staggerDistGrid=distgrid
endif
! if the Grid is arbitrary, the array dimension will be different depending on how many
! grid dimensions are arbitrarily distributed
if (decompType == ESMF_GRID_NONARBITRARY) then
! calc the number of dimensions from the grid being used (e.g. with non-zero mapping)
if (present(gridToFieldMap)) then
gridUsedDimCount=0
do i=1,dimCount
if (gridToFieldMap(i) > 0) then
gridUsedDimCount=gridUsedDimCount+1
endif
enddo
else
! Default assumes all grid dims are used so add number of grid dims
gridUsedDimCount=dimCount
endif
! calc full Array DimCount
! Its the ungriddedDimCount + the number of non-zero entries in gridToFieldMap
arrayDimCount=ungriddedDimCount+gridUsedDimCount
! Make sure gridToFieldMap is correct size
if (present(gridToFieldMap)) then
do i=1,dimCount
if ((gridToFieldMap(i) <0) .or. (gridToFieldMap(i) > arrayDimCount)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- gridToFieldMap value is outside range", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
enddo
endif
! Take out the below test to allow Fields that don't have a dim that maps
! to the Grid. Take this code out for good after things have been tested for awhile.
#if 0
! Make sure gridToFieldMap contains at least one non-zero entry
if (present(gridToFieldMap)) then
contains_nonzero=.false.
do i=1,dimCount
if (gridToFieldMap(i) >0) then
contains_nonzero=.true.
endif
enddo
if (.not. contains_nonzero) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- gridToFieldMap must contains at least one value greater than 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
#endif
! Check distgridToArrayMap
if (size(distgridToArrayMap) < dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- distgridToArrayMap is too small", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! set default GridToFieldMap
if (present(gridToFieldMap)) then
localGridToFieldMap(1:dimCount)=gridToFieldMap(1:dimCount)
else
do i=1,dimCount
localGridToFieldMap(i)=i
enddo
endif
! allocate distgridToGridMap
allocate(distgridToGridMap(dimCount) , stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating distgridToGridMap", &
ESMF_CONTEXT, rcToReturn=rc)) return
! Get info from Grid
call ESMF_GridGet(grid, distgridToGridMap=distgridToGridMap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! construct distgridToArrayMap
do i=1,dimCount
distgridToArrayMap(i)=localGridToFieldMap(distgridToGridMap(i))
enddo
! construct array based on the presence of distributed dimensions
! if there are undistributed dimensions ...
if (undistArrayDimCount > 0) then
!! allocate array dim. info arrays
allocate(arrayDimType(arrayDimCount) , stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridUBound", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(arrayDimInd(arrayDimCount) , stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridUBound", &
ESMF_CONTEXT, rcToReturn=rc)) return
!! set which dimensions are used by the distgrid
arrayDimType(:)=0 ! initialize to no type
do i=1,dimCount
if (distGridToArrayMap(i) > 0) then ! skip replicated dims
arrayDimType(distGridToArrayMap(i))=1 ! set to distributed
endif
enddo
! TODO: make the below cleaner given no grid undistdim
!! Fill in ungridded bound info
bndpos=1
do i=1,arrayDimCount
if (arrayDimType(i) == 0) then
arrayDimInd(i)=bndpos
arrayDimType(i)=2 ! set to undistributed Array
bndpos=bndpos+1
endif
enddo
!! Finally setup new Array bounds based on info in arrayDimType and arrayDimInd
bndpos=1
do i=1,arrayDimCount
if (arrayDimType(i) == 2) then
if (present (undistLBound)) &
undistLBound(bndpos)=ungriddedLBound(arrayDimInd(i))
if (present (undistUBound)) &
undistUBound(bndpos)=ungriddedUBound(arrayDimInd(i))
bndpos=bndpos+1
endif
enddo
!! cleanup
deallocate(arrayDimType)
deallocate(arrayDimInd)
endif
! cleanup
deallocate(distgridToGridMap)
else
! Code for Arbitrarily Distributed Grid
call ESMF_DistGridGet(distgrid, dimCount=distDimCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(gridToFieldMap)) then
gridUsedDimCount=0
do i=1,dimCount
if (gridToFieldMap(i) > 0) then
gridUsedDimCount=gridUsedDimCount+1
endif
enddo
else
! Default assumes all grid dims are used so add number of grid dims
gridUsedDimCount=dimCount
endif
! calc full Array DimCount
! Its the ungriddedDimCount + the number of non-zero entries in gridToFieldMap
fieldDimCount=ungriddedDimCount+gridUsedDimCount
! Make sure gridToFieldMap is correct size
! check for replicated dimension
if (present(gridToFieldMap)) then
do i=1,dimCount
if ((gridToFieldMap(i) <0) .or. (gridToFieldMap(i) > fieldDimCount)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- gridToFieldMap value is outside range", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
enddo
endif
! set default GridToFieldMap
if (present(gridToFieldMap)) then
localGridToFieldMap(1:dimCount)=gridToFieldMap(1:dimCount)
else
do i=1,dimCount
localGridToFieldMap(i)=i
enddo
endif
! If there is replicated dimension, check if they are arbitrarily distributed dimension
! The array dimension varies depends whether the replicated dimensions are arb. or not
allocate(distgridToGridMap(dimCount))
call ESMF_GridGet(grid, distgridToGridMap=distgridToGridMap, &
arbDim=arbdim, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Check distgridToArrayMap
if (size(distgridToArrayMap) < distDimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- distgridToArrayMap is too small", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! count how many replicated dimensions are not arbitrary and if any of replicated dimension
! is arbitrary. Assuming if one arbitrary dim is replicated, all the arbitrary dimension
! should also be replicated. This check is done in ESMF_FieldCreate already
! initialze distgridToArrayMap
do i=1,distDimCount
distgridToArrayMap(i)= i
enddo
! if there is any replicated dimensions, reassign distgridToArrayMap
rep_arb = 0
rep_noarb = 0
if (gridUsedDimCount < dimCount) then
k = 1
do i=1,dimCount
found = .false.
if (localGridToFieldMap(i) == 0) then
do j=1,dimCount
if (distgridToGridMap(j) == i) then
found = .true.
exit
endif
enddo
if (found) then
distgridToArrayMap(arbdim) = 0
rep_arb = 1
else
rep_noarb = rep_noarb+1
if (k == arbdim) k = k + 1
distgridToArrayMap(k) = 0
k=k+1
endif
endif
enddo
j=1
do i=1,distDimCount
if (distgridToArrayMap(i) /= 0) then
distgridToArrayMap(i)= j
j=j+1
endif
enddo
endif
arrayDimCount=ungriddedDimCount+distDimCount-rep_noarb-rep_arb
deallocate(distgridToGridMap)
! construct array based on the presence of distributed dimensions
! if there are undistributed dimensions ...
if (undistArrayDimCount > 0) then
! Copy ungriddedBound to undistBound
if (present (undistLBound)) &
undistLBound(:undistArrayDimCount) = ungriddedLBound(:undistArrayDimCount)
if (present (undistUBound)) &
undistUBound(:undistArrayDimCount) = ungriddedUBound(:undistArrayDimCount)
endif
endif
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridGetArrayInfo