function ESMF_GridCreateFrmGrid(grid, minIndex, maxIndex, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreateFrmGrid
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
integer, intent(in), optional :: minIndex
integer, intent(in) :: maxIndex
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This function creates a new 3D {\tt ESMF\_Grid} object by adding an
! undistributed vertical dimension to an existing 2D {\tt ESMF\_Grid} object.
! A maximum and, optionally, a minimum value are provided by the user for
! the vertical dimension index. The coordinates from the input 2D grid are
! included in the final 3D grid, while values for the undistributed vertical
! coordinate must be set subsequently.
!
! The arguments are:
! \begin{description}
! \item[grid]
! The original 2D {\tt ESMF\_Grid} object.
! \item[{[minIndex]}]
! Minimum index value for the undistributed vertical dimension. If omitted,
! defaults to 1.
! \item[maxIndex]
! Maximum index value for the undistributed vertical dimension.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
! local variables
integer :: localrc
integer :: connectionCount, deCount, dimCount, itemCount, tileCount
integer :: ldimCount, localDe, localDeCount, minIndx
integer :: item
integer :: tileIndexA, tileIndexB
integer, dimension(:), pointer :: positionVector, orientationVector
integer, dimension(:), pointer :: newPositionVector, newOrientationVector
integer, dimension(:), allocatable :: coordDimCount, distgridToGridMap
integer, dimension(:), allocatable :: newcoordDimCount, newdistgridToGridMap
integer, dimension(:,:), allocatable :: coordDimMap, minIndexPTile, maxIndexPTile
integer, dimension(:,:), allocatable :: newcoordDimMap, newminIndexPTile, newmaxIndexPTile
real(ESMF_KIND_R8), dimension(:), pointer :: fptrIn1d, fptrOut1d
real(ESMF_KIND_R8), dimension(:,:), pointer :: fptrIn2d, fptrOut2d
type(ESMF_DistGridConnection), dimension(:), allocatable :: connectionList, newconnectionList
type(ESMF_DistGrid) :: distgrid, newdistgrid
type(ESMF_Grid) :: newgrid
type(ESMF_Index_Flag) :: indexflag
type(ESMF_CoordSys_Flag) :: coordSys
character(len=ESMF_MAXSTR) :: gridName
! begin
if (present(rc)) rc = ESMF_SUCCESS
! check additional dimension bounds
minIndx = 1
if (present(minIndex)) then
minIndx = minIndex
end if
if (maxIndex <= minIndx) then
call ESMF_LogSetError(ESMF_RC_NOT_VALID, &
msg="maxIndex must be > minIndex", &
ESMF_CONTEXT, rcToReturn=rc)
return
end if
! get grid parameters and associated DistGrid object
call ESMF_GridGet(grid, distgrid=distgrid, name=gridName, &
dimCount=dimCount, coordSys=coordSys, indexflag=indexflag, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (dimCount /= 2) then
call ESMF_LogSetError(ESMF_RC_NOT_VALID, &
msg="Grid object in field MUST have 2 dimensions", &
ESMF_CONTEXT, rcToReturn=rc)
return
end if
! get 2D distribution information from Grid's DistGrid object
allocate(coordDimCount(dimCount), &
distgridToGridMap(dimCount), &
coordDimMap(dimCount,dimCount), &
stat=localrc)
if (ESMF_LogFoundAllocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGet(grid, coordDimCount=coordDimCount, &
distgridToGridMap=distgridToGridMap, &
coordDimMap=coordDimMap, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! increment dimension count by one to build local 3D Grid
ldimCount = dimCount + 1
! create mapping arrays for 3D Grid by extending original ones from 2D Grid
allocate(newcoordDimCount(ldimCount), &
newdistgridToGridMap(ldimCount), &
newcoordDimMap(ldimCount,ldimCount), &
stat=localrc)
if (ESMF_LogFoundAllocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
newcoordDimCount(1:dimCount) = coordDimCount
newcoordDimCount(ldimCount) = 3
newdistgridToGridMap(1:dimCount) = distgridToGridMap
newdistgridToGridMap(ldimCount) = 3
newcoordDimMap(1:dimCount,1:dimCount) = coordDimMap
newcoordDimMap(:, ldimCount) = 1
newcoordDimMap(ldimCount, :) = (/ 1, 2, 3 /)
deallocate(coordDimCount, distgridToGridMap, coordDimMap, stat=localrc)
if (ESMF_LogFoundDeallocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! in a similar fashion, extend index/tile arrays and connection settings
! for DistGrid object in new 3D Grid
! get original DistGrid information
call ESMF_DistGridGet(distgrid, &
tileCount=tileCount, connectionCount=connectionCount, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(minIndexPTile(dimCount, tileCount), &
maxIndexPTile(dimCount, tileCount), &
connectionList(connectionCount), &
stat=localrc)
if (ESMF_LogFoundAllocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! get original index arrays and connection list
call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, &
maxIndexPTile=maxIndexPTile, connectionList=connectionList, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! create new index arrays
allocate(newminIndexPTile(ldimCount, tileCount), &
newmaxIndexPTile(ldimCount, tileCount), &
stat=localrc)
if (ESMF_LogFoundAllocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
newminIndexPTile(1:dimCount,:) = minIndexPTile
newmaxIndexPTile(1:dimCount,:) = maxIndexPTile
newminIndexPTile(ldimCount, :) = minIndx
newmaxIndexPTile(ldimCount, :) = maxIndex
deallocate(minIndexPTile, maxIndexPTile, stat=localrc)
if (ESMF_LogFoundDeallocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! extend connection list for new Grid
allocate(newConnectionList(connectionCount), &
newPositionVector(ldimCount), newOrientationVector(ldimCount), &
positionVector(dimCount), orientationVector(dimCount), &
stat=localrc)
if (ESMF_LogFoundAllocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
do item = 1, connectionCount
call ESMF_DistGridConnectionGet(connectionList(item), &
tileIndexA=tileIndexA, tileIndexB=tileIndexB, &
positionVector=positionVector, orientationVector=orientationVector, &
rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
newPositionVector(1:dimCount) = positionVector
newPositionVector( ldimCount) = 0
newOrientationVector(1:dimCount) = orientationVector
newOrientationVector( ldimCount) = 3
call ESMF_DistGridConnectionSet(newConnectionList(item), &
tileIndexA=tileIndexA, tileIndexB=tileIndexB, &
positionVector=newPositionVector, orientationVector=newOrientationVector, &
rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
end do
deallocate(newPositionVector, newOrientationVector, &
positionVector, orientationVector, connectionList, stat=localrc)
if (ESMF_LogFoundDeallocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! create 3D DistGrid object
newdistgrid = ESMF_DistGridCreate(minIndexPTile=newminIndexPTile, &
maxIndexPTile=newmaxIndexPTile, connectionList=newConnectionList, &
rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_DistGridSet(distgrid, name="DG-GridFrom:"//trim(gridName), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
deallocate(newminIndexPTile, newmaxIndexPTile, newconnectionList, stat=localrc)
if (ESMF_LogFoundDeallocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! create 3D Grid object
newgrid = ESMF_GridCreate(newdistgrid, coordDimCount=newcoordDimCount, &
coordDimMap=newcoordDimMap, coordSys=coordSys, indexflag=indexflag, &
name="GridFrom:"//trim(gridName), rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
deallocate(newcoordDimMap, stat=localrc)
if (ESMF_LogFoundDeallocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! get localDeCount
call ESMF_GridGet(newgrid, localDeCount=localDeCount, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! add coordinates to 3D Grid
call ESMF_GridAddCoord(newgrid, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! load 2D coordinates
do item = 1, 2
select case (newcoordDimCount(item))
case (1)
do localDe = 0, localDeCount - 1
call ESMF_GridGetCoord(grid, coordDim=item, localDE=localDe, &
farrayPtr=fptrOut1d, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGetCoord(newgrid, coordDim=item, localDE=localDe, &
farrayPtr=fptrIn1d, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
fptrIn1d = fptrOut1d
end do
case (2)
do localDe = 0, localDeCount - 1
call ESMF_GridGetCoord(grid, coordDim=item, localDE=localDe, &
farrayPtr=fptrOut2d, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGetCoord(newgrid, coordDim=item, localDE=localDe, &
farrayPtr=fptrIn2d, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
fptrIn2d = fptrOut2d
end do
case default
call ESMF_LogSetError(ESMF_RC_INTNRL_BAD, &
msg="Internal error - should never get here!", &
ESMF_CONTEXT, rcToReturn=rc)
return
end select
end do
deallocate(newcoordDimCount, stat=localrc)
if (ESMF_LogFoundDeallocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
ESMF_GridCreateFrmGrid = newgrid
end function ESMF_GridCreateFrmGrid