subroutine ESMF_GridSetCmmitShapeTileIrreg(grid, name,coordTypeKind, &
minIndex, countsPerDEDim1, countsPerDeDim2, &
keywordEnforcer, countsPerDEDim3, connflagDim1, connflagDim2, connflagDim3, &
poleStaggerLoc1, poleStaggerLoc2, poleStaggerLoc3, &
bipolePos1, bipolePos2, bipolePos3, &
coordDep1, coordDep2, coordDep3, &
gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
gridMemLBound, indexflag, petMap, rc)
!
! !ARGUMENTS:
type (ESMF_Grid) :: grid
character (len=*), intent(in), optional :: name
type(ESMF_TypeKind_Flag), intent(in), optional :: coordTypeKind
integer, intent(in), optional :: minIndex(:)
integer, intent(in) :: countsPerDEDim1(:)
integer, intent(in) :: countsPerDEDim2(:)
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
integer, intent(in), optional :: countsPerDEDim3(:)
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(:,:,:)
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This method sets information into an empty Grid and then commits it to
! create a single tile, irregularly distributed grid
! (see Figure \ref{fig:GridDecomps}).
! To specify the irregular distribution, the user passes in an array
! for each grid dimension, where the length of the array is the number
! of DEs in the dimension. Up to three dimensions can be specified,
! using the countsPerDEDim1, countsPerDEDim2, countsPerDEDim3 arguments.
! The index of each array element corresponds to a DE number. The
! array value at the index is the number of grid cells on the DE in
! that dimension. The dimCount of the grid is equal to the number of
! countsPerDEDim arrays that are specified.
!
! Section \ref{example:2DIrregUniGrid} shows an example
! of using this method to create a 2D Grid with uniformly spaced
! coordinates. This creation method can also be used as the basis for
! grids with rectilinear coordinates or curvilinear coordinates.
!
! For consistency's sake the {\tt ESMF\_GridSetCommitShapeTile()} call
! should be executed in the same set or a subset of the PETs in which the
! {\tt ESMF\_GridEmptyCreate()} call was made. If the call
! is made in a subset, the Grid objects outside that subset will
! still be "empty" and not usable.
!
! The arguments are:
! \begin{description}
! \item[{grid}]
! The empty {\tt ESMF\_Grid} to set information into and then commit.
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \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[{[minIndex]}]
! Tuple to start the index ranges at. If not present, defaults
! to /1,1,1,.../.
! \item[{countsPerDEDim1}]
! This arrays specifies the number of cells per DE for index dimension 1
! for the exclusive region (the center stagger location).
! If the array has only one entry, then the dimension is undistributed.
! \item[{countsPerDEDim2}]
! This array specifies the number of cells per DE for index dimension 2
! for the exclusive region (center stagger location).
! If the array has only one entry, then the dimension is undistributed.
! \item[{[countsPerDEDim3]}]
! This array specifies the number of cells per DE for index dimension 3
! for the exclusive region (center stagger location).
! If not specified then grid is 2D. Also, If the array has only one entry,
! then the dimension is undistributed.
! \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.
! If not present, the default is the edge.
! 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]}]
! \begin{sloppypar}
! Sets the mapping of pets to the created DEs. This 3D
! should be of size size(countsPerDEDim1) x size(countsPerDEDim2) x
! size(countsPerDEDim3). If countsPerDEDim3 isn't present, then
! the last dimension is of size 1.
! \end{sloppypar}
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
type(ESMF_DistGrid) :: distgrid
type(ESMF_DELayout) :: delayout
integer, pointer :: petList(:)
integer, pointer :: coordDimCount(:)
integer, pointer :: coordDimMap(:,:)
integer :: localrc
integer :: dimCount,i,maxSizeDEDim
integer, pointer :: distgridToGridMap(:), deDimCount(:)
integer, pointer :: minIndexLocal(:)
integer, pointer :: maxIndexLocal(:)
integer, pointer :: gridEdgeLWidthLocal(:)
integer, pointer :: gridEdgeUWidthLocal(:)
integer, pointer :: gridAlignLocal(:)
integer, pointer :: countsPerDEDim1Local(:)
integer, pointer :: countsPerDEDim2Local(:)
integer, pointer :: countsPerDEDim3Local(:)
integer, pointer :: deBlockList(:,:,:),minPerDEDim(:,:),maxPerDEDim(:,:)
integer :: deCount
integer :: d,i1,i2,i3,k
type(ESMF_GridConn_Flag) :: connflagDim1Local(2)
type(ESMF_GridConn_Flag) :: connflagDim2Local(2)
type(ESMF_GridConn_Flag) :: connflagDim3Local(2)
integer :: connCount, petListCount
integer :: top
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Compute the Grid DimCount and Derivatives ---------------------------------------------------
! dimCount
if (present(countsPerDEDim3)) then
dimCount=3
else
dimCount=2
endif
! Argument Consistency Checking --------------------------------------------------------------
if (size(countsPerDEDim1) .lt. 1) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- size 0 countsPerDEDim1 not allowed", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (size(countsPerDEDim2) .lt. 1) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- size 0 countsPerDEDim2 not allowed", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (present(countsPerDEDim3)) then
if (size(countsPerDEDim3) .lt. 1) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- size 0 countsPerDEDim3 not allowed", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
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
if (present(petMap)) then
if (dimCount > 2) then
if ((size(petMap,1) /= size(countsPerDEDim1)) .or. &
(size(petMap,2) /= size(countsPerDEDim2)) .or. &
(size(petMap,3) /= size(countsPerDEDim3))) 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) /= size(countsPerDEDim1)) .or. &
(size(petMap,2) /= size(countsPerDEDim2)) .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
! 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
! Copy vales for countsPerDEDim --------------------------------------------
allocate(countsPerDEDim1Local(size(countsPerDEDim1)), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating minIndexLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
countsPerDEDim1Local=countsPerDEDim1
allocate(countsPerDEDim2Local(size(countsPerDEDim2)), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating minIndexLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
countsPerDEDim2Local=countsPerDEDim2
if (dimCount > 2) then
allocate(countsPerDEDim3Local(size(countsPerDEDim3)), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating minIndexLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
countsPerDEDim3Local=countsPerDEDim3
endif
! 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 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
! Make alterations to size due to GridEdgeWidths ----------------------------
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 lower size
countsPerDEDim1Local(1)=countsPerDEDim1Local(1)+gridEdgeLWidthLocal(1)
countsPerDEDim2Local(1)=countsPerDEDim2Local(1)+gridEdgeLWidthLocal(2)
if (dimCount > 2) then
countsPerDEDim3Local(1)=countsPerDEDim3Local(1)+gridEdgeLWidthLocal(3)
endif
! Modify upper size
top=size(countsPerDEDim1Local)
countsPerDEDim1Local(top)=countsPerDEDim1Local(top)+gridEdgeUWidthLocal(1)
top=size(countsPerDEDim2Local)
countsPerDEDim2Local(top)=countsPerDEDim2Local(top)+gridEdgeUWidthLocal(2)
if (dimCount > 2) then
top=size(countsPerDEDim3Local)
countsPerDEDim3Local(top)=countsPerDEDim3Local(top)+gridEdgeUWidthLocal(3)
endif
#endif
! Calc minIndex,maxIndex,distgridToGridMap for DistGrid -----------------------------------
! Set default for maxIndex
allocate(maxIndexLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating maxIndexLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
maxIndexLocal(1)=sum(countsPerDEDim1Local)+minIndexLocal(1)-1
maxIndexLocal(2)=sum(countsPerDEDim2Local)+minIndexLocal(2)-1
if (dimCount > 2) then
maxIndexLocal(3)=sum(countsPerDEDim3Local)+minIndexLocal(3)-1
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 deBlockList for DistGrid ------------------------------------------------
! count de blocks
deCount=1
deCount=deCount*size(countsPerDEDim1Local)
deCount=deCount*size(countsPerDEDim2Local)
if (dimCount > 2) then
deCount=deCount*size(countsPerDEDim3Local)
endif
! Calc the max size of a DEDim
maxSizeDEDim=1
if (size(countsPerDEDim1Local) > maxSizeDEDim) then
maxSizeDEDim=size(countsPerDEDim1Local)
endif
if (size(countsPerDEDim2Local) > maxSizeDEDim) then
maxSizeDEDim=size(countsPerDEDim2Local)
endif
if (dimCount > 2) then
if (size(countsPerDEDim3Local) > maxSizeDEDim) then
maxSizeDEDim=size(countsPerDEDim3Local)
endif
endif
! generate deblocklist
allocate(maxPerDEDim(dimCount,maxSizeDEDim), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating maxPerDEDim", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(minPerDEDim(dimCount,maxSizeDEDim), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating minPerDEDim", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(deDimCount(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating maxPerDEDim", &
ESMF_CONTEXT, rcToReturn=rc)) return
! Calc the maximum end of each DE in a Dim, and the size of each DEDim
d=1
deDimCount(d)=size(countsPerDEDim1Local)
minPerDeDim(d,1)=minIndexLocal(d)
maxPerDeDim(d,1)=minIndexLocal(d)+countsPerDEDim1Local(1)-1
do i=2,deDimCount(d)
minPerDEDim(d,i)=maxPerDEDim(d,i-1)+1
maxPerDEDim(d,i)=minPerDEDim(d,i)+countsPerDEDim1Local(i)-1
enddo
d=2
deDimCount(d)=size(countsPerDEDim2Local)
minPerDeDim(d,1)=minIndexLocal(d)
maxPerDeDim(d,1)=minIndexLocal(d)+countsPerDEDim2Local(1)-1
do i=2,deDimCount(d)
minPerDEDim(d,i)=maxPerDEDim(d,i-1)+1
maxPerDEDim(d,i)=minPerDEDim(d,i)+countsPerDEDim2Local(i)-1
enddo
if (dimCount > 2) then
d=3
deDimCount(d)=size(countsPerDEDim3Local)
minPerDeDim(d,1)=minIndexLocal(d)
maxPerDeDim(d,1)=minIndexLocal(d)+countsPerDEDim3Local(1)-1
do i=2,deDimCount(d)
minPerDEDim(d,i)=maxPerDEDim(d,i-1)+1
maxPerDEDim(d,i)=minPerDEDim(d,i)+countsPerDEDim3Local(i)-1
enddo
endif
! allocate deblocklist
allocate(deBlockList(dimCount,2,deCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating deBlockList", &
ESMF_CONTEXT, rcToReturn=rc)) return
! Fill in DeBlockList
if (dimCount == 2) then
k=1
do i2=1,deDimCount(2)
do i1=1,deDimCount(1)
deBlockList(1,1,k)=minPerDEDim(1,i1)
deBlockList(1,2,k)=maxPerDEDim(1,i1)
deBlockList(2,1,k)=minPerDEDim(2,i2)
deBlockList(2,2,k)=maxPerDEDim(2,i2)
k=k+1
enddo
enddo
else if (dimCount == 3) then
k=1
do i3=1,deDimCount(3)
do i2=1,deDimCount(2)
do i1=1,deDimCount(1)
deBlockList(1,1,k)=minPerDEDim(1,i1)
deBlockList(1,2,k)=maxPerDEDim(1,i1)
deBlockList(2,1,k)=minPerDEDim(2,i2)
deBlockList(2,2,k)=maxPerDEDim(2,i2)
deBlockList(3,1,k)=minPerDEDim(3,i3)
deBlockList(3,2,k)=maxPerDEDim(3,i3)
k=k+1
enddo
enddo
enddo
endif
! do i=1,deCount
! write(*,*) i,"min=",deBlockList(:,1,i)," max=",deBlockList(:,2,i)
! enddo
! Setup Connections between tile sides ----------------------------------------
! CONNECTIONS DON'T WORK YET SO NOT IMPLEMENTED
! Process 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,size(countsPerDEDim3Local)
do i2=1,size(countsPerDEDim2Local)
do i1=1,size(countsPerDEDim1Local)
petList(k)=petMap(i1,i2,i3)
k=k+1
enddo
enddo
enddo
else
k=1
do i3=1,1
do i2=1,size(countsPerDEDim2Local)
do i1=1,size(countsPerDEDim1Local)
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, &
deBlockList=deBlockList, delayout=delayout, indexflag=indexflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! 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
! Create Grid from specification -----------------------------------------------
call ESMF_GridSetFromDistGrid(grid, coordTypeKind=coordTypeKind, &
distgrid=distgrid, distgridToGridMap=distgridToGridMap, &
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(grid,destroy=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridSetDestroyDELayout(grid,destroy=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Commit Grid -----------------------------------------------------------------
call ESMF_GridCommit(grid, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Clean up memory
deallocate(maxIndexLocal)
deallocate(minIndexLocal)
deallocate(coordDimCount)
deallocate(coordDimMap)
deallocate(distgridToGridMap)
deallocate(maxPerDEDim)
deallocate(minPerDEDim)
deallocate(deDimCount)
deallocate(deBlockList)
deallocate(gridEdgeLWidthLocal)
deallocate(gridEdgeUWidthLocal)
deallocate(gridAlignLocal)
deallocate(countsPerDEDim1Local)
deallocate(countsPerDEDim2Local)
if (dimCount > 2) then
deallocate(countsPerDEDim3Local)
endif
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridSetCmmitShapeTileIrreg