function ESMF_GridCreateCopyFromReg(grid, keywordEnforcer, &
regDecomp, decompFlag, name, copyAttributes, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreateCopyFromReg
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
integer, intent(in), optional :: regDecomp(:)
type(ESMF_Decomp_Flag), intent(in), optional :: decompflag(:)
character (len=*), intent(in), optional :: name
logical, intent(in), optional :: copyAttributes
integer, intent(out), optional :: rc
!
! !STATUS:
! \begin{itemize}
! \item\apiStatusCompatibleVersion{5.2.0r}
! \item\apiStatusModifiedSinceVersion{5.2.0r}
! \begin{description}
! \item[7.1.0r] Added argument {\tt copyAttributes} to support attribute
! propagation from the existing to the newly created grid object.
! \end{description}
! \end{itemize}
!
! !DESCRIPTION:
!
! This method creates a copy of an existing Grid, the new Grid is
! regularly distributed (see Figure \ref{fig:GridDecomps}).
! To specify the new 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[grid]
! {\tt ESMF\_Grid} to copy.
! \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[{[name]}]
! Name of the new Grid. If not specified, a new unique name will be
! created for the Grid.
! \item[{[copyAttributes]}]
! A flag to indicate whether to copy the attributes of the existing grid
! to the new grid. The default value is .false..
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
type(ESMF_DistGrid) :: distgrid
type(ESMF_DistGrid) :: oldDistgrid
type(ESMF_DELayout) :: delayout
type(ESMF_VM) :: vm
integer, pointer :: petList(:)
integer :: localrc
integer :: dimCount,i
integer, pointer :: regDecompLocal(:)
type(ESMF_Decomp_Flag), pointer :: decompflagLocal(:)
integer :: deCount
integer :: i1,i2,i3,k, tileCount
integer,pointer :: minIndexPDimPTile(:,:)
integer,pointer :: maxIndexPDimPTile(:,:)
integer,pointer :: minIndexLocal(:)
integer,pointer :: maxIndexLocal(:)
type(ESMF_Index_Flag) :: indexflag
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Get the Grid DimCount ---------------------------------------------------
call ESMF_GridGet(grid, dimCount=dimCount, indexflag=indexflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! 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
! Get min/max Index from old grid ------------------------------------------------------------------
! Get old distgrid
call ESMF_GridGet(grid, distgrid=oldDistgrid, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Get a couple of sizes
call ESMF_DistgridGet(oldDistgrid, tileCount=tileCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Get Index info from DistGrid
allocate(minIndexPDimPTile(dimCount,tileCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating minIndexPDimTile", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(maxIndexPDimPTile(dimCount,tileCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating maxIndexPDimTile", &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_DistgridGet(oldDistgrid, &
minIndexPTile=minIndexPDimPTile, &
maxIndexPTile=maxIndexPDimPTile, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! This doesn't work right now for Multitile Grids
if (tileCount > 1) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- GridCopy with reg distribution not supported for multitile grids", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Set minIndex
allocate(minIndexLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating minIndexLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
minIndexLocal(1:dimCount)=minIndexPDimPTile(1:dimCount,1)
! Set maxIndex
allocate(maxIndexLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating maxIndexLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
maxIndexLocal(1:dimCount)=maxIndexPDimPTile(1:dimCount,1)
! Free memory from distgrid get
deallocate(minIndexPDimPTile)
deallocate(maxIndexPDimPTile)
! 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 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
! Process PetMap --------------------------------------------------------------
!! Calculate deCount
deCount=1
do i=1,dimCount
deCount=deCount*regDecompLocal(i)
enddo
#if 0
! create DELayout based on presence of petMap
if (present(petMap)) then
!! Allocate petList
allocate(petList(deCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, "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
#endif
!! create a default delayout
delayout=ESMF_DELayoutCreate(deCount=deCount,rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
#if 0
endif
#endif
! Create DistGrid --------------------------------------------------------------
distgrid=ESMF_DistGridCreate(minIndex=minIndexLocal, maxIndex=maxIndexLocal, &
regDecomp=regDecompLocal, decompFlag=decompFlagLocal, delayout=delayout,&
indexflag=indexflag, &
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
ESMF_GridCreateCopyFromReg=ESMF_GridCreate(grid, distgrid, &
name=name, copyAttributes=copyAttributes, 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
! Clean up memory
deallocate(regDecompLocal)
deallocate(decompFlagLocal)
deallocate(minIndexLocal)
deallocate(maxIndexLocal)
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridCreateCopyFromReg