function ESMF_GridCreateShapeTileReg(coordTypeKind, &
regDecomp, decompFlag, minIndex, maxIndex, &
keywordEnforcer, connflagDim1, connflagDim2, connflagDim3, &
poleStaggerLoc1, poleStaggerLoc2, poleStaggerLoc3, &
bipolePos1, bipolePos2, bipolePos3, &
coordDep1, coordDep2, coordDep3, &
gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
gridMemLBound, indexflag, petMap, name, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreateShapeTileReg
!
! !ARGUMENTS:
type(ESMF_TypeKind_Flag), intent(in), optional :: coordTypeKind
integer, intent(in), optional :: regDecomp(:)
type(ESMF_Decomp_Flag), intent(in), optional :: decompflag(:)
integer, intent(in), optional :: minIndex(:)
integer, intent(in) :: maxIndex(:)
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim1(:) !N. IMP.
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim2(:) !N. IMP.
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim3(:) !N. IMP.
type(ESMF_StaggerLoc),intent(in),optional::poleStaggerLoc1(2)!N. IMP.
type(ESMF_StaggerLoc),intent(in),optional::poleStaggerLoc2(2)!N. IMP.
type(ESMF_StaggerLoc),intent(in),optional::poleStaggerLoc3(2)!N. IMP.
integer, intent(in), optional :: bipolePos1(2)!N. IMP.
integer, intent(in), optional :: bipolePos2(2)!N. IMP.
integer, intent(in), optional :: bipolePos3(2)!N. IMP.
integer, intent(in), optional :: coordDep1(:)
integer, intent(in), optional :: coordDep2(:)
integer, intent(in), optional :: coordDep3(:)
integer, intent(in), optional :: gridEdgeLWidth(:)
integer, intent(in), optional :: gridEdgeUWidth(:)
integer, intent(in), optional :: gridAlign(:)
integer, intent(in), optional :: gridMemLBound(:)
type(ESMF_Index_Flag), intent(in), optional :: indexflag
integer, intent(in), optional :: petMap(:,:,:)
character (len=*), intent(in), optional :: name
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This method creates a single tile, regularly distributed grid
! (see Figure \ref{fig:GridDecomps}).
! To specify the distribution, the user passes in an array
! ({\tt regDecomp}) specifying the number of DEs to divide each
! dimension into. The array {\tt decompFlag} indicates how the division into DEs is to
! occur. The default is to divide the range as evenly as possible.
!
! The arguments are:
! \begin{description}
! \item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. All {\em numerical} types
! listed under section~\ref{const:typekind} are supported.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
! \item[{[regDecomp]}]
! List that has the same number of elements as {\tt maxIndex}.
! Each entry is the number of decounts for that dimension.
! If not specified, the default decomposition will be petCountx1x1..x1.
! \item[{[decompflag]}]
! List of decomposition flags indicating how each dimension of the
! tile is to be divided between the DEs. The default setting
! is {\tt ESMF\_DECOMP\_BALANCED} in all dimensions. Please see
! Section~\ref{const:decompflag} for a full description of the
! possible options. Note that currently the option
! {\tt ESMF\_DECOMP\_CYCLIC} isn't supported in Grid creation.
! \item[{[minIndex]}]
! The bottom extent of the grid array. If not given then the value defaults
! to /1,1,1,.../.
! \item[{maxIndex}]
! The upper extent of the grid array.
! \item[{[connflagDim1]}]
! Fortran array describing the index dimension 1 connections.
! The first element represents the minimum end of dimension 1.
! The second element represents the maximum end of dimension 1.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[connflagDim2]}]
! Fortran array describing the index dimension 2 connections.
! The first element represents the minimum end of dimension 2.
! The second element represents the maximum end of dimension 2.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[connflagDim3]}]
! Fortran array describing the index dimension 3 connections.
! The first element represents the minimum end of dimension 3.
! The second element represents the maximum end of dimension 3.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[poleStaggerLoc1]}]
! Two element array describing the index dimension 1 connections.
! The first element represents the minimum end of dimension 1.
! The second element represents the maximum end of dimension 1.
! If a pole, this describes which staggerlocation is at the pole at each end.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to ESMF\_STAGGERLOC\_CENTER.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[poleStaggerLoc2]}]
! Two element array describing the index dimension 2 connections.
! The first element represents the minimum end of dimension 2.
! The second element represents the maximum end of dimension 2.
! If a pole, this describes which staggerlocation is at the pole at each end.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to ESMF\_STAGGERLOC\_CENTER.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[poleStaggerLoc3]}]
! Two element array describing the index dimension 3 connections.
! The first element represents the minimum end of dimension 3.
! The second element represents the maximum end of dimension 3.
! If a pole, this describes which staggerlocation is at the pole at each end.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to ESMF\_STAGGERLOC\_CENTER.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[bipolePos1]}]
! Two element array describing the index dimension 1 connections.
! The first element represents the minimum end of dimension 1.
! The second element represents the maximum end of dimension 1.
! If a bipole, this gives the index position of one of the poles.
! The other is half way around. If not present, the default is 1.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[bipolePos2]}]
! Two element array describing the index dimension 2 connections.
! The first element represents the minimum end of dimension 2.
! The second element represents the maximum end of dimension 2.
! If a bipole, this gives the index position of one of the poles.
! The other is half way around. If not present, the default is 1.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[bipolePos3]}]
! Two element array describing the index dimension 3 connections.
! The first element represents the minimum end of dimension 3.
! The second element represents the maximum end of dimension 3.
! If a bipole, this gives the index position of one of the poles.
! The other is half way around. If not present, the default is 1.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[coordDep1]}]
! This array specifies the dependence of the first
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the first
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[coordDep2]}]
! This array specifies the dependence of the second
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the second
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[coordDep3]}]
! This array specifies the dependence of the third
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the third
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[gridEdgeLWidth]}]
! The padding around the lower edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 0, 0, ..., 0 (all zeros).
! \item[{[gridEdgeUWidth]}]
! The padding around the upper edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 1, 1, ..., 1 (all ones).
! \item[{[gridAlign]}]
! Specification of how the stagger locations should align with the cell
! index space (can be overridden by the individual staggerAligns). If
! the gridEdgeWidths are not specified than this argument
! implies the gridEdgeWidths. If the gridEdgeWidths are specified and this argument isn't
! then this argument is implied by the gridEdgeWidths.
! If this and the gridEdgeWidths are not specified, then defaults to
! -1, -1, ..., -1 (all negative ones).
! \item[{[gridMemLBound]}]
! Specifies the lower index range of the memory of every DE in this Grid.
! Only used when indexflag is {\tt ESMF\_INDEX\_USER}. May be overridden
! by staggerMemLBound.
! \item[{[indexflag]}]
! Indicates the indexing scheme to be used in the new Grid. Please see
! Section~\ref{const:indexflag} for the list of options. If not present,
! defaults to ESMF\_INDEX\_DELOCAL.
! \item[{[petMap]}]
! Sets the mapping of pets to the created DEs. This 3D
! should be of size regDecomp(1) x regDecomp(2) x regDecomp(3)
! If the Grid is 2D, then the last dimension is of size 1.
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
type(ESMF_DistGrid) :: distgrid
type(ESMF_DELayout) :: delayout
type(ESMF_VM) :: vm
integer, pointer :: petList(:)
integer, pointer :: coordDimCount(:)
integer, pointer :: coordDimMap(:,:)
integer :: localrc
integer :: dimCount,i
integer, pointer :: regDecompLocal(:)
type(ESMF_Decomp_Flag), pointer :: decompflagLocal(:)
integer, pointer :: distgridToGridMap(:)
integer, pointer :: minIndexLocal(:), maxIndexLocal(:)
integer, pointer :: gridEdgeLWidthLocal(:)
integer, pointer :: gridEdgeUWidthLocal(:)
integer, pointer :: gridAlignLocal(:)
integer :: deCount
integer :: i1,i2,i3,k
type(ESMF_GridConn_Flag) :: connflagDim1Local(2)
type(ESMF_GridConn_Flag) :: connflagDim2Local(2)
type(ESMF_GridConn_Flag) :: connflagDim3Local(2)
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
!DUMMY TEST TO QUIET DOWN COMPILER WARNINGS
!TODO: Remove the following test when dummy argument actually used
if (present(polestaggerloc1)) then
if (polestaggerloc1(1)==polestaggerloc1(1)) continue;
endif
!DUMMY TEST TO QUIET DOWN COMPILER WARNINGS
!TODO: Remove the following test when dummy argument actually used
if (present(polestaggerloc2)) then
if (polestaggerloc2(1)==polestaggerloc2(1)) continue;
endif
!DUMMY TEST TO QUIET DOWN COMPILER WARNINGS
!TODO: Remove the following test when dummy argument actually used
if (present(bipolepos1)) then
if (bipolepos1(1)==bipolepos1(1)) continue;
endif
!DUMMY TEST TO QUIET DOWN COMPILER WARNINGS
!TODO: Remove the following test when dummy argument actually used
if (present(bipolepos2)) then
if (bipolepos2(1)==bipolepos2(1)) continue;
endif
! Compute the Grid DimCount and Derivatives ---------------------------------------------------
! dimCount
dimCount=size(maxIndex)
if ((dimCount < 2) .or. (dimCount > 3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- maxIndex size and thus Grid dimCount must be either 2 or 3 when using create shape ", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Argument Consistency Checking --------------------------------------------------------------
if (present(regDecomp)) then
if (size(regDecomp) .lt. dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- regDecomp size doesn't match Grid dimCount ", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(decompFlag)) then
if (size(decompFlag) .lt. dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- decompFlag size doesn't match Grid dimCount ", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! CYCLIC decomposition isn't allowed when creating a Grid
do i=1,size(decompFlag)
if (decompFlag(i) == ESMF_DECOMP_CYCLIC) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_OUTOFRANGE, &
msg="- decompFlag isn't allowed to be" // &
" ESMF_DECOMP_CYCLIC when creating a Grid.", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
enddo
endif
if ((dimCount .lt. 3) .and. present(connflagDim3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- connflagDim3 not allowed when grid is less than dimCount 3", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if ((dimCount .lt. 3) .and. present(poleStaggerLoc3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- poleStaggerLoc3 not allowed when grid is less than dimCount 3", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if ((dimCount .lt. 3) .and. present(bipolePos3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- bipolePos3 not allowed when grid is less than dimCount 3", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if ((dimCount .lt. 3) .and. present(coordDep3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- coordDep3 not allowed when grid is less than dimCount 3", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (present(coordDep1)) then
if ((size(coordDep1) < 1) .or. (size(coordDep1)>dimCount)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- coordDep1 size incompatible with grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(coordDep2)) then
if ((size(coordDep2) < 1) .or. (size(coordDep2)>dimCount)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- coordDep2 size incompatible with grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(coordDep3)) then
if ((size(coordDep3) < 1) .or. (size(coordDep3)>dimCount)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- coordDep3 size incompatible with grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(minIndex)) then
if (size(minIndex) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- minIndex size must equal grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
! Check DimCount of gridWidths and Aligns
if (present(gridEdgeLWidth)) then
if (size(gridEdgeLWidth) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- gridEdgeLWidth must be of size equal to Grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(gridEdgeUWidth)) then
if (size(gridEdgeUWidth) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- gridEdgeUWidth must be of size equal to Grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(gridAlign)) then
if (size(gridAlign) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- gridAlign must be of size equal to Grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
! make sure connected dimensions don't have an edge width
if (present(connflagDim1)) then
if (size(connflagDim1) == 1) then
if (connflagDim1(1) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeLWidth)) then
if (gridEdgeLWidth(1) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have LWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(gridEdgeUWidth)) then
if (gridEdgeUWidth(1) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have UWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
else if (size(connflagDim1) == 2) then
if (connflagDim1(1) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeLWidth)) then
if (gridEdgeLWidth(1) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have LWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
if (connflagDim1(2) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeUWidth)) then
if (gridEdgeUWidth(1) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have UWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
endif
endif
! make sure connected dimensions don't have an edge width
if (present(connflagDim2)) then
if (size(connflagDim2) == 1) then
if (connflagDim2(1) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeLWidth)) then
if (gridEdgeLWidth(2) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have LWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(gridEdgeUWidth)) then
if (gridEdgeUWidth(2) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have UWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
else if (size(connflagDim2) == 2) then
if (connflagDim2(1) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeLWidth)) then
if (gridEdgeLWidth(2) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have LWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
if (connflagDim2(2) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeUWidth)) then
if (gridEdgeUWidth(2) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have UWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
endif
endif
! make sure connected dimensions don't have an edge width
if (present(connflagDim3)) then
if (size(connflagDim3) == 1) then
if (connflagDim3(1) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeLWidth)) then
if (gridEdgeLWidth(3) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have LWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(gridEdgeUWidth)) then
if (gridEdgeUWidth(3) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have UWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
else if (size(connflagDim3) == 2) then
if (connflagDim3(1) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeLWidth)) then
if (gridEdgeLWidth(3) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have LWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
if (connflagDim3(2) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeUWidth)) then
if (gridEdgeUWidth(3) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have UWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
endif
endif
! check for gridMemLBound issues
if (present(gridMemLBound)) then
if (.not. present(indexflag)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- when using gridMemLBound must specify indexflag=ESMF_INDEX_USER ", &
ESMF_CONTEXT, rcToReturn=rc)
return
else if (.not.(indexflag == ESMF_INDEX_USER)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- when using gridMemLBound must specify indexflag=ESMF_INDEX_USER ", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
else
if (present(indexflag)) then
if (indexflag == ESMF_INDEX_USER) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- when using indexflag=ESMF_INDEX_USER must provide gridMemLBound ", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
! Check for non-valid connection types here
!TODO: Consider making some of these a separate local subroutine (particularly if you're going to
! have 3 of these ShapeCreate subroutines with only minor changes
! Set Defaults ------------------------------------------------------------------
! Set default for minIndex
allocate(minIndexLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating minIndexLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(minIndex)) then
minIndexLocal(:)=minIndex(:)
else
do i=1,dimCount
minIndexLocal(i)=1
enddo
endif
! Set default for maxIndex
allocate(maxIndexLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating maxIndexLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
maxIndexLocal(:)=maxIndex(:)
! Set default for regDecomp
allocate(regDecompLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating regDecompLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(regDecomp)) then
regDecompLocal(:)=regDecomp(:)
else
! The default is 1D divided among all the Pets
call ESMF_VMGetCurrent(vm,rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_VMGet(vm,petCount=regDecompLocal(1),rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
do i=2,dimCount
regDecompLocal(i)=1
enddo
endif
! Set Default for connections (although they don't work yet in distgrid/array, so they aren't really used anywhere yet.)
if (present(connflagDim1)) then
if (size(connflagDim1) == 1) then
connflagDim1Local(1)=connflagDim1(1)
connflagDim1Local(2)=connflagDim1(1) ! if only 1 connection is specified then repeat for both ends
else if (size(connflagDim1) >= 2) then
connflagDim1Local(1)=connflagDim1(1)
connflagDim1Local(2)=connflagDim1(2)
endif
else
connflagDim1Local(1)=ESMF_GRIDCONN_NONE ! if not present then default to no connection
connflagDim1Local(2)=ESMF_GRIDCONN_NONE
endif
if (present(connflagDim2)) then
if (size(connflagDim2) == 1) then
connflagDim2Local(1)=connflagDim2(1)
connflagDim2Local(2)=connflagDim2(1) ! if only 1 connection is specified then repeat for both ends
else if (size(connflagDim2) >= 2) then
connflagDim2Local(1)=connflagDim2(1)
connflagDim2Local(2)=connflagDim2(2)
endif
else
connflagDim2Local(1)=ESMF_GRIDCONN_NONE ! if not present then default to no connection
connflagDim2Local(2)=ESMF_GRIDCONN_NONE
endif
if (present(connflagDim3)) then
if (size(connflagDim3) == 1) then
connflagDim3Local(1)=connflagDim3(1)
connflagDim3Local(2)=connflagDim3(1) ! if only 1 connection is specified then repeat for both ends
else if (size(connflagDim3) >= 2) then
connflagDim3Local(1)=connflagDim3(1)
connflagDim3Local(2)=connflagDim3(2)
endif
else
connflagDim3Local(1)=ESMF_GRIDCONN_NONE ! if not present then default to no connection
connflagDim3Local(2)=ESMF_GRIDCONN_NONE
endif
! check for not implemented functionality
if (connflagDim1Local(1) /= ESMF_GRIDCONN_NONE .or. &
connflagDim1Local(2) /= ESMF_GRIDCONN_NONE) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_NOT_IMPL, &
msg="- Only ESMF_GRIDCONN_NONE Grid connection implemented so far", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (connflagDim2Local(1) /= ESMF_GRIDCONN_NONE .or. &
connflagDim2Local(2) /= ESMF_GRIDCONN_NONE) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_NOT_IMPL, &
msg="- Only ESMF_GRIDCONN_NONE Grid connection implemented so far", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (connflagDim3Local(1) /= ESMF_GRIDCONN_NONE .or. &
connflagDim3Local(2) /= ESMF_GRIDCONN_NONE) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_NOT_IMPL, &
msg="- Only ESMF_GRIDCONN_NONE Grid connection implemented so far", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (present(petMap)) then
if (dimCount > 2) then
if ((size(petMap,1) /= regDecompLocal(1)) .or. &
(size(petMap,2) /= regDecompLocal(2)) .or. &
(size(petMap,3) /= regDecompLocal(3))) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- petMap wrong size in one or more dimensions", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
else
if ((size(petMap,1) /= regDecompLocal(1)) .or. &
(size(petMap,2) /= regDecompLocal(2)) .or. &
(size(petMap,3) /= 1)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- petMap wrong size in one or more dimensions", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
! Modify Bounds by GridEdgeUWidth and GridEdgeLWidth -------------------------
! setup maxIndexLocal to hold modified bounds
allocate(gridEdgeLWidthLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridEdgeLWidthLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(gridEdgeUWidthLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridEdgeUWidthLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(gridAlignLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridAlignLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridLUADefault(dimCount, &
gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
gridEdgeLWidthLocal, gridEdgeUWidthLocal, gridAlignLocal, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
#if 0
! Modify lower bound
do i=1,dimCount
minIndexLocal(i)=minIndexLocal(i)-gridEdgeLWidthLocal(i)
enddo
! Modify upper bound
do i=1,dimCount
maxIndexLocal(i)=maxIndexLocal(i)+gridEdgeUWidthLocal(i)
enddo
#endif
! Set default for decomp flag based on gridEdgeWidths -----------------------------------
! NOTE: This is a temporary fix until we have something better implemented in distGrid
! Set default for decompFlag
allocate(decompFlagLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating decompFlagLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(decompFlag)) then
decompFlagLocal(:)=decompFlag(:)
else
decompFlagLocal(:)=ESMF_DECOMP_BALANCED
endif
allocate(distgridToGridMap(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating distgridToGridMap", &
ESMF_CONTEXT, rcToReturn=rc)) return
do i=1,dimCount
distgridToGridMap(i)=i
enddo
! Setup Connections between tile sides ----------------------------------------
! CONNECTIONS DON'T WORK YET SO NOT IMPLEMENTED
! Process PetMap --------------------------------------------------------------
!! Calculate deCount
deCount=1
do i=1,dimCount
deCount=deCount*regDecompLocal(i)
enddo
! create DELayout based on presence of petMap
if (present(petMap)) then
!! Allocate petList
allocate(petList(deCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating petList", &
ESMF_CONTEXT, rcToReturn=rc)) return
!! copy petMap to petList
if (dimCount > 2) then
k=1
do i3=1,regDecompLocal(3)
do i2=1,regDecompLocal(2)
do i1=1,regDecompLocal(1)
petList(k)=petMap(i1,i2,i3)
k=k+1
enddo
enddo
enddo
else
k=1
do i3=1,1
do i2=1,regDecompLocal(2)
do i1=1,regDecompLocal(1)
petList(k)=petMap(i1,i2,i3)
k=k+1
enddo
enddo
enddo
endif
!! create delayout from the petList
delayout=ESMF_DELayoutCreate(petMap=petList,rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! Get rid of list
deallocate(petList)
else
!! create a default delayout
delayout=ESMF_DELayoutCreate(deCount=deCount,rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! Create DistGrid --------------------------------------------------------------
distgrid=ESMF_DistGridCreate(minIndex=minIndexLocal, maxIndex=maxIndexLocal, &
regDecomp=regDecompLocal, decompFlag=decompFlagLocal, delayout=delayout,&
indexflag=indexflag, &
#if 0
regDecompFirstExtra=gridEdgeLWidthLocal, &
regDecompLastExtra=gridEdgeUWidthLocal, &
#endif
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(name)) then
call ESMF_DistGridSet(distgrid, name="DG-"//trim(name), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! Convert coordDeps to coordDimCount and coordDimMap -------------------------------
allocate(coordDimCount(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimCount", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(coordDimMap(dimCount,dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimMap", &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(coordDep1)) then
coordDimCount(1)=size(coordDep1)
coordDimMap(1,:)=0
do i=1,size(coordDep1)
coordDimMap(1,i)=coordDep1(i)
enddo
else
coordDimCount(1)=dimCount
do i=1,dimCount
coordDimMap(1,i)=i
enddo
endif
if (present(coordDep2)) then
coordDimCount(2)=size(coordDep2)
coordDimMap(2,:)=0
do i=1,size(coordDep2)
coordDimMap(2,i)=coordDep2(i)
enddo
else
coordDimCount(2)=dimCount
do i=1,dimCount
coordDimMap(2,i)=i
enddo
endif
if (dimCount > 2) then
if (present(coordDep3)) then
coordDimCount(3)=size(coordDep3)
coordDimMap(3,:)=0
do i=1,size(coordDep3)
coordDimMap(3,i)=coordDep3(i)
enddo
else
coordDimCount(3)=dimCount
do i=1,dimCount
coordDimMap(3,i)=i
enddo
endif
endif
ESMF_GridCreateShapeTileReg=ESMF_GridCreateFrmDistGrid(distgrid, &
distgridToGridMap=distgridToGridMap, &
coordTypeKind=coordTypeKind, &
coordDimCount=coordDimCount, coordDimMap=coordDimMap, &
gridEdgeLWidth=gridEdgeLWidthLocal, &
gridEdgeUWidth=gridEdgeUWidthLocal, &
gridAlign=gridAlignLocal, &
gridMemLBound=gridMemLBound, &
indexflag=indexflag, &
name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set internal items to be destroyed with grid
call ESMF_GridSetDestroyDistgrid(ESMF_GridCreateShapeTileReg,destroy=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridSetDestroyDELayout(ESMF_GridCreateShapeTileReg,destroy=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Clean up memory
deallocate(regDecompLocal)
deallocate(decompFlagLocal)
deallocate(coordDimCount)
deallocate(coordDimMap)
deallocate(minIndexLocal)
deallocate(maxIndexLocal)
deallocate(distgridToGridMap)
deallocate(gridEdgeLWidthLocal)
deallocate(gridEdgeUWidthLocal)
deallocate(gridAlignLocal)
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridCreateShapeTileReg