subroutine ESMF_GridRedist(srcGrid, dstGrid, routehandle, keywordEnforcer, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: srcGrid
type(ESMF_Grid), intent(inout) :: dstGrid
type(ESMF_RouteHandle),intent(inout) :: routehandle
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! This call is companion to the {\tt ESMF\_GridCreate()} that allows the user to copy an
! existing ESMF Grid, but with a new distribution. The {\tt ESMF\_GridRedist()} allows
! the user to repeatedly redistribute the coordinates from {\tt srcGrid} to {\tt dstGrid}.
!
! The arguments are:
! \begin{description}
! \item[srcGrid]
! The source grid providing the coordinates.
! \item[srcGrid]
! The destination grid receiving the coordinates from {\tt srcGrid}.
! \item[routehandle]
! The {\tt ESMF\_RouteHandle} object returned by the companion method
! {\tt ESMF\_GridCreate()} used to create {\tt dstGrid} from {\tt srcGrid}.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
integer :: localrc
type(ESMF_ArrayBundle) :: srcAB, dstAB
integer :: i, j, nStaggers
integer :: rank, dimCount, maxNumStaggers
logical, allocatable :: srcRepl(:), dstRepl(:)
type(ESMF_STAGGERLOC), allocatable :: staggers(:)
type(ESMF_Array), allocatable :: srcA(:), dstA(:)
type(ESMF_Array), allocatable :: srcA2D(:), dstA2D(:)
integer :: arrayDimCount
integer :: localDECount, localDE
integer :: atodMap(1), k
type(ESMF_DistGrid) :: dg
type(ESMF_TypeKind_Flag) :: tk
type(ESMF_Index_Flag) :: arrayIndexflag
real(ESMF_KIND_R8), pointer:: farrayPtr(:), farrayPtr2d(:,:)
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Check init status of arguments
ESMF_INIT_CHECK_DEEP_SHORT(ESMF_GridGetInit, srcGrid, rc)
ESMF_INIT_CHECK_DEEP_SHORT(ESMF_GridGetInit, dstGrid, rc)
ESMF_INIT_CHECK_DEEP_SHORT(ESMF_RouteHandleGetInit, routehandle, rc)
call ESMF_GridGet(srcGrid, dimCount=dimCount, &
staggerlocCount=maxNumStaggers, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Allocate to maximum number of possible staggers
allocate(staggers(maxNumStaggers))
! Get list and number of active staggers
call c_ESMC_gridgetactivestaggers(srcGrid%this, &
nStaggers, staggers, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! prep arrays
allocate(srcA(dimCount*nStaggers), dstA(dimCount*nStaggers))
allocate(srcA2D(dimCount*nStaggers), dstA2D(dimCount*nStaggers))
allocate(srcRepl(dimCount*nStaggers), dstRepl(dimCount*nStaggers))
! Pull coord Arrays out of srcGrid
do i=1,dimCount
do j = 1, nStaggers
call ESMF_GridGetCoord(srcGrid, coordDim=i, staggerloc=staggers(j), &
array=srcA((i-1)*nStaggers+j), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
enddo
enddo
! 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
! Pull coord Arrays out of dstGrid
do i=1,dimCount
do j = 1, nStaggers
call ESMF_GridGetCoord(dstGrid, coordDim=i, staggerloc=staggers(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
! Create ArrayBundles
srcAB = ESMF_ArrayBundleCreate(arrayList=srcA2D, multiflag=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
dstAB = ESMF_ArrayBundleCreate(arrayList=dstA2D, multiflag=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
! Redist between ArrayBundles
call ESMF_ArrayBundleRedist(srcAB, dstAB, routehandle=routehandle, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
! 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
! 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)
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridRedist