function ESMF_GridCreateCopyFromNewDG(grid, distgrid, keywordEnforcer, &
name, copyAttributes, routehandle, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreateCopyFromNewDG
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type(ESMF_DistGrid), intent(in) :: distgrid
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
character (len=*), intent(in), optional :: name
logical, intent(in), optional :: copyAttributes
type(ESMF_RouteHandle),intent(out), optional :: routehandle
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. \newline
! \item[8.2.1] Added argument {\tt routehandle} providing the user with a convenient
! way to execute {\tt ESMF\_GridRedist()} repeatedly, e.g. when coordinates
! on the source grid have changed.
! \end{description}
! \end{itemize}
!
! !DESCRIPTION:
! This call allows the user to copy an existing ESMF Grid, but with a new distribution.
! All internal data from the old Grid (coords, items) are redistributed to the new Grid.
!
! The arguments are:
! \begin{description}
! \item[grid]
! The existing {\tt ESMF\_Grid} being redistributed, i.e. the "source" grid.
! \item[distgrid]
! {\tt ESMF\_DistGrid} object which describes how the newly created Grid is
! decomposed and distributed.
! \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[{[routehandle]}]
! If provided holds the mapping of coordinates between the two grids. This can
! be used in the companion method {\tt ESMF\_GridRedist()} to update coordinates.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
type(ESMF_Grid) :: newGrid
integer :: localrc ! local error status
type(ESMF_TypeKind_Flag) :: coordTypeKind
integer :: distgridToGridMap(ESMF_MAXDIM)
integer :: coordDimCount(ESMF_MAXDIM)
integer :: coordDimMap(ESMF_MAXDIM,ESMF_MAXDIM)
integer :: gridEdgeLWidth(ESMF_MAXDIM)
integer :: gridEdgeUWidth(ESMF_MAXDIM)
integer :: gridAlign(ESMF_MAXDIM)
integer :: staggerEdgeLWidth(ESMF_MAXDIM)
integer :: staggerEdgeUWidth(ESMF_MAXDIM)
integer :: staggerAlign(ESMF_MAXDIM)
integer :: staggerLBound(ESMF_MAXDIM)
type(ESMF_Index_Flag) :: indexflag, arrayIndexflag
integer :: i, j, nStaggers
#define USE_ARRAYBUNDLE
#ifdef USE_ARRAYBUNDLE
type(ESMF_ArrayBundle) :: srcAB, dstAB
#endif
type(ESMF_RouteHandle) :: rh
type(ESMF_STAGGERLOC), allocatable :: srcStaggers(:)
type(ESMF_Array), allocatable :: srcA(:), dstA(:)
type(ESMF_Array), allocatable :: srcA2D(:), dstA2D(:)
type(ESMF_DistGrid):: dg, oldDistGrid
type(ESMF_TypeKind_Flag):: tk
integer:: atodMap(1), k
real(ESMF_KIND_R8), pointer:: farrayPtr(:), farrayPtr2d(:,:)
integer:: rank, dimCount, maxNumStaggers
logical, allocatable:: srcRepl(:), dstRepl(:)
type(ESMF_GRIDITEM_FLAG) :: gridItemList(ESMF_GRIDITEM_COUNT)=(/ESMF_GRIDITEM_MASK,ESMF_GRIDITEM_AREA/)
type(ESMF_GRIDITEM_FLAG) :: gridItem
type(ESMF_CoordSys_Flag) :: coordSys
integer :: localDECount, localDE
integer :: arbDimCount, arrayDimCount, dgDimCount
integer, allocatable :: minIndex(:), maxIndex(:), indexArray(:,:)
character(len=160) :: msgString
type(ESMF_DistGridMatch_Flag) :: dgMatch
type(ESMF_Info) :: lhs, rhs
! 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_DistGridGetInit, distgrid, rc)
ESMF_INIT_CHECK_DEEP_SHORT(ESMF_GridGetInit, grid, rc)
! Get the old DistGrid
call ESMF_GridGet(grid, distgrid=oldDistGrid, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
#if 0
if (present(name)) &
call ESMF_LogWrite("ESMF_GridCreateCopyFromNewDG for: "//trim(name), &
ESMF_LOGMSG_INFO)
#endif
! Get info from old grid to create new Grid.
call ESMF_GridGet(grid, &
dimCount=dimCount, arbDimCount=arbDimCount, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Get info from target distgrid
call ESMF_DistGridGet(distgrid, dimCount=dgDimCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Get info from old grid to create new Grid.
call ESMF_GridGet(grid, &
coordTypeKind=coordTypeKind, &
coordSys=coordSys, &
staggerlocCount=maxNumStaggers, &
distgridToGridMap=distgridToGridMap(1:dimCount), &
coordDimCount=coordDimCount(1:dimCount), &
coordDimMap=coordDimMap(1:dimCount,1:dimCount), &
gridEdgeLWidth=gridEdgeLWidth(1:dimCount), &
gridEdgeUWidth=gridEdgeUWidth(1:dimCount), &
gridAlign=gridAlign(1:dimCount), &
indexFlag=indexFlag, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (arbDimCount==0) then
! no arbitrary distribution
#if 0
call ESMF_LogWrite("ESMF_GridCreateCopyFromNewDG no-arb grid", &
ESMF_LOGMSG_INFO)
#endif
! make sure new DistGrid covers the same index space as old DistGrid
dgMatch = ESMF_DistGridMatch(distgrid, oldDistGrid, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (dgMatch < ESMF_DISTGRIDMATCH_INDEXSPACE) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="Old and new DistGrids must cover the same index space.", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Create New Grid
newGrid=ESMF_GridCreate(name=name, &
coordTypeKind=coordTypeKind, &
distgrid=distgrid, &
coordSys=coordSys, &
distgridToGridMap=distgridToGridMap(1:dimCount), &
coordDimCount=coordDimCount(1:dimCount), &
coordDimMap=coordDimMap(1:dimCount,1:dimCount), &
gridEdgeLWidth=gridEdgeLWidth(1:dimCount), &
gridEdgeUWidth=gridEdgeUWidth(1:dimCount), &
gridAlign=gridAlign(1:dimCount), &
! gridMemLBound=gridMemLBound, & ! TODO: NEED TO ADD THIS TO GET
indexFlag=indexFlag, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else
! arbitrary distribution
#if 0
call ESMF_LogWrite("ESMF_GridCreateCopyFromNewDG arb grid", &
ESMF_LOGMSG_INFO)
#endif
! make sure new DistGrid has as many elements as old DistGrid
dgMatch = ESMF_DistGridMatch(distgrid, oldDistGrid, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (dgMatch < ESMF_DISTGRIDMATCH_ELEMENTCOUNT) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="Old and new DistGrids must cover the same index space.", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Two branches here:
!
! If the dimCount of the DistGrid equals the dimCount of the old grid, then a
! non-arbDist grid is being created here (from an arbitrary incoming Grid).
!
! If the dimCount of the incoming DistGrid is smaller than the original grid dimCount,
! the created Grid will also be arbDist.
if (dgDimCount==dimCount) then
! Create the new Grid as regDecomp
#if 0
call ESMF_LogWrite("ESMF_GridCreateCopyFromNewDG arb grid as regDecom", &
ESMF_LOGMSG_INFO)
#endif
newGrid=ESMF_GridCreate(name=name, &
coordTypeKind=coordTypeKind, &
distgrid=distgrid, &
coordSys=coordSys, &
indexFlag=indexFlag, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
elseif (dgDimCount < dimCount) then
! Create the new Grid as arbDistr
#if 0
call ESMF_LogWrite("ESMF_GridCreateCopyFromNewDG arb grid as arbDistr", &
ESMF_LOGMSG_INFO)
#endif
! first must set up the indexArray (which holds index space bounds)
allocate(minIndex(dimCount), maxIndex(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating minIndex, maxIndex", &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGet(grid, tile=1, staggerloc=ESMF_STAGGERLOC_CENTER, &
minIndex=minIndex, maxIndex=maxIndex, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(indexArray(2,dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating indexArray", &
ESMF_CONTEXT, rcToReturn=rc)) return
indexArray(1,:)=minIndex(:)
indexArray(2,:)=maxIndex(:)
! now create the new arbDistr grid
newGrid=ESMF_GridCreate(name=name, &
indexArray=indexArray, &
coordTypeKind=coordTypeKind, &
distgrid=distgrid, &
coordSys=coordSys, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
deallocate(minIndex, maxIndex, indexArray)
else
! problem condition -> flag error
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="Grid and DistGrid dimCounts are not compatible.", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
! Allocate to maximum number of possible staggers
allocate(srcStaggers(maxNumStaggers))
! Get list and number of active staggers
call c_ESMC_gridgetactivestaggers(grid%this, &
nStaggers, srcStaggers, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
#if 0
write (msgString,*) "ESMF_GridCreateCopyFromNewDG(): nStaggers=",nStaggers, &
" dimCount(Grid)=", dimCount
call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
#endif
! Add Coords to new grid
! TODO: handle staggerLBound
do i = 1, nStaggers
call ESMF_GridGet(grid, staggerloc=srcStaggers(i), &
staggerEdgeLWidth=staggerEdgeLWidth(1:dimCount), &
staggerEdgeUWidth=staggerEdgeUWidth(1:dimCount), &
staggerAlign=staggerAlign(1:dimCount), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridAddCoord(newGrid, staggerloc=srcStaggers(i), &
staggerEdgeLWidth=staggerEdgeLWidth(1:dimCount), &
staggerEdgeUWidth=staggerEdgeUWidth(1:dimCount), &
staggerAlign=staggerAlign(1:dimCount), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
! Create src Arraybundle
! Pull coord Arrays out of old grid and put them into Arraybundle
! for each staggerloc added above
allocate(srcA(dimCount*nStaggers), dstA(dimCount*nStaggers))
allocate(srcA2D(dimCount*nStaggers), dstA2D(dimCount*nStaggers))
allocate(srcRepl(dimCount*nStaggers), dstRepl(dimCount*nStaggers))
do i=1,dimCount
do j = 1, nStaggers
call ESMF_GridGetCoord(grid, coordDim=i, staggerloc=srcStaggers(j), &
array=srcA((i-1)*nStaggers+j), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
enddo
!TODO: gjt: The following is completely hacked for now, just to get the
!TODO: gjt: demo working. Basically the problem is that we don't currently
!TODO: gjt: support communication calls for Arrays with replicated dims.
!TODO: gjt: So I create temporary 2D Arrays, put the coordinates from the
!TODO: gjt: src Grid (1D replicated on 2D DistGrid) onto the 2D Arrays and
!TODO: gjt: Redist() to another temporary set of 2D Arrays on the dst side.
!TODO: gjt: From there it is finally copied into the 1D replicated dst side
!TODO: gjt: coordinate Arrays. - nasty ha!
! construct temporary 2D src Arrays and fill with data if necessary
do k=1, dimCount*nStaggers
call ESMF_ArrayGet(srcA(k), rank=rank, dimCount=arrayDimCount, &
localDECount=localDECount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (rank==arrayDimCount) then
! branch that assumes no replicated dims in Array
! TODO: actually there may still be replication, only
! TODO: arrayToDistGridMap conclusively provides that indication
srcRepl(k) = .false.
srcA2D(k) = srcA(k)
else
! this branch is hard-coded for 2D DistGrids with 1D replicated
! dim Arrays along one dimension
srcRepl(k) = .true.
call ESMF_ArrayGet(srcA(k), distgrid=dg, typekind=tk, &
arrayToDistGridMap=atodMap, indexflag=arrayIndexflag, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
srcA2D(k) = ESMF_ArrayCreate(distgrid=dg, typekind=tk, &
indexflag=arrayIndexflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (localDECount/=0) then
call ESMF_ArrayGet(srcA(k), farrayPtr=farrayPtr, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ArrayGet(srcA2D(k), farrayPtr=farrayPtr2D, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (atodMap(1)==1) then
do j=lbound(farrayPtr2D,2), ubound(farrayPtr2D,2)
do i=lbound(farrayPtr2D,1), ubound(farrayPtr2D,1)
farrayPtr2D(i,j) = farrayPtr(i)
enddo
enddo
else
do j=lbound(farrayPtr2D,2), ubound(farrayPtr2D,2)
do i=lbound(farrayPtr2D,1), ubound(farrayPtr2D,1)
farrayPtr2D(i,j) = farrayPtr(j)
enddo
enddo
endif
endif
endif
enddo
#ifdef USE_ARRAYBUNDLE
srcAB = ESMF_ArrayBundleCreate(arrayList=srcA2D, multiflag=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
#endif
! Create dst Arraybundle
! Pull coord Arrays out of new grid and put them into Arraybundle
! for each staggerloc added above
do i=1,dimCount
do j = 1, nStaggers
call ESMF_GridGetCoord(newGrid, coordDim=i, staggerloc=srcStaggers(j), &
array=dstA((i-1)*nStaggers+j), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
enddo
! construct temporary 2D Arrays
do k=1, dimCount*nStaggers
call ESMF_ArrayGet(dstA(k), rank=rank, dimCount=arrayDimCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (rank==arrayDimCount) then
! branch that assumes no replicated dims in Array
! TODO: actually there may still be replication, only
! TODO: arrayToDistGridMap conclusively provides that indication
dstRepl(k) = .false.
dstA2D(k) = dstA(k)
else
dstRepl(k) = .true.
call ESMF_ArrayGet(dstA(k), distgrid=dg, typekind=tk, &
indexflag=arrayIndexflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
dstA2D(k) = ESMF_ArrayCreate(distgrid=dg, typekind=tk, &
indexflag=arrayIndexflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
enddo
#ifdef USE_ARRAYBUNDLE
dstAB = ESMF_ArrayBundleCreate(arrayList=dstA2D, multiflag=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
#endif
#if 0
call ESMF_LogWrite("ESMF_GridCreateCopyFromNewDG before coord RedistStore()",&
ESMF_LOGMSG_INFO)
#endif
#ifdef USE_ARRAYBUNDLE
if (dimCount*nStaggers > 0) then
! Redist between ArrayBundles
call ESMF_ArrayBundleRedistStore(srcAB, dstAB, routehandle=rh, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ArrayBundleRedist(srcAB, dstAB, routehandle=rh, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
! Conditionally return the valid routehandle, or destroy here
if (present(routehandle)) then
routehandle = rh
else
call ESMF_ArrayBundleRedistRelease(routehandle=rh, noGarbage=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
endif
endif
! Destroy ArrayBundles
call ESMF_ArrayBundleDestroy(srcAB, noGarbage=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ArrayBundleDestroy(dstAB, noGarbage=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
#else
!gjt thinks this comment is outdates, and was due to a silly mistake that was in earlier code when
!gjt creating the ArrayBundles.
!TODO: figure out why ArrayBundleRedist() does not seem to work right for
!TODO: some of the Arrays -> use individual ArrayRedist() instead as work-around
do k=1, dimCount*nStaggers
call ESMF_ArrayRedistStore(srcA2D(k), dstA2D(k), routehandle=rh, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ArrayRedist(srcA2D(k), dstA2D(k), routehandle=rh, &
zeroregion=ESMF_REGION_TOTAL, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ArrayRedistRelease(routehandle=rh, noGarbage=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
#endif
#if 0
call ESMF_LogWrite("ESMF_GridCreateCopyFromNewDG after coord RedistStore()",&
ESMF_LOGMSG_INFO)
#endif
! Fill the replicated dimension Arrays from the 2D redist data
do k=1, dimCount*nStaggers
if (dstRepl(k)) then
call ESMF_ArrayGet(dstA(k), arrayToDistGridMap=atodMap, &
localDECount=localDECount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
do localDE=0, localDECount-1
call ESMF_ArrayGet(dstA(k), localDE=localDE, &
farrayPtr=farrayPtr, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ArrayGet(dstA2D(k), localDE=localDE, &
farrayPtr=farrayPtr2D, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (atodMap(1)==1) then
do i=lbound(farrayPtr2D,1), ubound(farrayPtr2D,1)
farrayPtr(i) = farrayPtr2D(i,lbound(farrayPtr2D,2))
enddo
else
do j=lbound(farrayPtr2D,2), ubound(farrayPtr2D,2)
farrayPtr(j) = farrayPtr2D(lbound(farrayPtr2D,1),j)
enddo
endif
enddo
endif
enddo
! clean up temporary Arrays
do k=1, dimCount*nStaggers
if (srcRepl(k)) then
call ESMF_ArrayDestroy(srcA2D(k), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if (dstRepl(k)) then
call ESMF_ArrayDestroy(dstA2D(k), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
enddo
deallocate(srcA)
deallocate(srcA2D)
deallocate(dstA)
deallocate(dstA2D)
deallocate(srcRepl)
deallocate(dstRepl)
#if 1
!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Redist Item Data
do i=1,ESMF_GRIDITEM_COUNT
! Get each grid item
gridItem=gridItemList(i)
! Get list and number of active staggersfor this item
call c_ESMC_gridgetactiveitemstag(grid%this, &
gridItem, nStaggers, srcStaggers, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! If no staggers then go to next item
if (nStaggers .eq. 0) cycle
! Add Items to new grid
do j = 1, nStaggers
call ESMF_GridAddItem(newGrid, staggerloc=srcStaggers(j), &
itemflag=gridItem, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
! allocate space to hold arrays
allocate(srcA(nStaggers), dstA(nStaggers))
! Pull item Arrays out of old grid for each staggerloc added above
do j = 1, nStaggers
call ESMF_GridGetItem(grid, staggerloc=srcStaggers(j), &
itemFlag=gridItem, array=srcA(j), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
! Pull item Arrays out of new grid for each staggerloc added above
do j = 1, nStaggers
call ESMF_GridGetItem(newGrid, staggerloc=srcStaggers(j), &
itemflag=gridItem, array=dstA(j), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
#if 0
call ESMF_LogWrite("ESMF_GridCreateCopyFromNewDG before item RedistStore()",&
ESMF_LOGMSG_INFO)
#endif
! Gerhard had a note that Arraybundle redist doesn't seem to always work
! so just do individual redists until you check with him
!srcAB = ESMF_ArrayBundleCreate(arrayList=srcA(1:nStaggers), rc=localrc)
!if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
! ESMF_CONTEXT, rcToReturn=rc)) return
!dstAB = ESMF_ArrayBundleCreate(arrayList=dstA(1:nStaggers), rc=localrc)
!if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
! ESMF_CONTEXT, rcToReturn=rc)) return
! Redist between ArrayBundles
! call ESMF_ArrayBundleRedistStore(srcAB, dstAB, routehandle=rh, rc=localrc)
! if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
! ESMF_CONTEXT, rcToReturn=rc)) return
! call ESMF_ArrayBundleRedist(srcAB, dstAB, routehandle=rh, rc=localrc)
! if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
! ESMF_CONTEXT, rcToReturn=rc)) return
do j=1, nStaggers
call ESMF_ArrayRedistStore(srcA(j), dstA(j), routehandle=rh, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ArrayRedist(srcA(j), dstA(j), routehandle=rh, &
zeroregion=ESMF_REGION_TOTAL, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ArrayRedistRelease(routehandle=rh, noGarbage=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
#if 0
call ESMF_LogWrite("ESMF_GridCreateCopyFromNewDG after item RedistStore()",&
ESMF_LOGMSG_INFO)
#endif
! Get rid of lists of arrays
deallocate(srcA)
deallocate(dstA)
! Destroy ArrayBundles and release Routehandle
! call ESMF_ArrayBundleRedistRelease(routehandle=rh, noGarbage=.true., rc=localrc)
! if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
! ESMF_CONTEXT, rcToReturn=rc)) return
!call ESMF_ArrayBundleDestroy(srcAB, rc=localrc)
!if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
! ESMF_CONTEXT, rcToReturn=rc)) return
!call ESMF_ArrayBundleDestroy(dstAB, rc=localrc)
!if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
! ESMF_CONTEXT, rcToReturn=rc)) return
enddo
#endif
! Copy Attributes
if (present(copyAttributes)) then
if (copyAttributes) then
call ESMF_InfoGetFromPointer(newGrid%this, lhs, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InfoGetFromPointer(grid%this, rhs, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InfoUpdate(lhs, rhs, recursive=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
endif
! deallocate stagger list
deallocate(srcStaggers)
! Set return value
ESMF_GridCreateCopyFromNewDG = newGrid
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridCreateCopyFromNewDG