function ESMF_GridCreateFrmDistGridArb(distgrid, &
indexArray, distDim, &
coordSys, coordTypeKind, coordDimCount, coordDimMap, &
name, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreateFrmDistGridArb
!
! !ARGUMENTS:
type(ESMF_DistGrid), intent(in) :: distgrid
integer, intent(in) :: indexArray(:,:)
integer, intent(in), optional :: distDim(:)
type(ESMF_CoordSys_Flag), intent(in), optional :: coordSys
type(ESMF_TypeKind_Flag), intent(in), optional :: coordTypeKind
integer, intent(in), optional :: coordDimCount(:)
integer, intent(in), optional :: coordDimMap(:,:)
character (len=*), intent(in), optional :: name
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! This is the lower level function to create an arbitrarily distributed {\tt ESMF\_Grid}
! object. It allows the user to fully specify the topology and index space
! (of the distributed dimensions) using the DistGrid methods and then build a grid out
! of the resulting {\tt distgrid}. The {\tt indexArray(2,dimCount)},
! argument is required to specifies the topology of the grid.
!
! The arguments are:
! \begin{description}
! \item[distgrid]
! {\tt ESMF\_DistGrid} object that describes how the array is decomposed and
! distributed over DEs.
! \item[indexArray]
! The minIndex and maxIndex array of size {\tt 2} x {\tt dimCount}
! {\tt indexArray(1,:)} is the minIndex and {\tt indexArray(2,:)} is the maxIndex
! \item[{[distDim]}]
! This array specifies which dimensions are arbitrarily distributed.
! The size of the array specifies the total distributed dimensions.
! if not specified, the default is that all dimensions will be arbitrarily
! distributed.
! \item[{[coordSys]}]
! The coordinate system of the grid coordinate data.
! For a full list of options, please see Section~\ref{const:coordsys}.
! If not specified then defaults to ESMF\_COORDSYS\_SPH\_DEG.
! \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[{[coordDimCount]}]
! List that has dimCount elements.
! Gives the dimension of each component (e.g. x) array. This is
! to allow factorization of the coordinate arrays. If not specified
! each component is assumed to be size 1. Note, the default value is different
! from the same argument for a non-arbitrarily distributed grid.
! \item[{[coordDimMap]}]
! 2D list of size dimCount x dimCount. This array describes the
! map of each coordinate array's dimensions onto the grids
! dimensions. {\tt coordDimMap(i,j)} is the grid dimension of the jth dimension
! of the i'th coordinate array. If not specified, the default value of
! {\tt coordDimMap(i,1)} is /ESMF\_DIM\_ARB/ if the ith dimension of the grid is
! arbitrarily distributed, or {\tt i} if the ith dimension is not distributed.
! Note that if j is bigger than {\tt coordDimCount(i)} then it's ignored.
! Please see Section~\ref{const:arbdim} for a definition of ESMF\_DIM\_ARB.
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
integer :: localrc ! local error status
type(ESMF_Grid) :: grid
integer :: nameLen
type(ESMF_InterArray) :: minIndexArg ! Language Interface Helper Var
type(ESMF_InterArray) :: maxIndexArg ! Language Interface Helper Var
type(ESMF_InterArray) :: localArbIndexArg ! Language Interface Helper Var
type(ESMF_InterArray) :: distDimArg ! Language Interface Helper Var
type(ESMF_InterArray) :: coordDimCountArg ! Language Interface Helper Var
type(ESMF_InterArray) :: coordDimMapArg ! Language Interface Helper Var
integer :: intDestroyDistgrid,intDestroyDELayout
integer :: dimCount, distDimCount, undistDimCount, dimCount1
integer, pointer :: local1DIndices(:), localArbIndex(:,:), distSize(:)
integer, pointer :: undistMinIndex(:), undistMaxIndex(:)
integer, pointer :: minIndexPTile(:,:), maxIndexPTile(:,:)
integer :: tileCount, localCounts
integer, pointer :: minIndexLocal(:), maxIndexLocal(:)
logical, pointer :: isDistDim(:)
integer :: i, j, k, arbDim, ldeCount
integer, allocatable :: distDimLocal(:)
integer, allocatable :: collocation(:)
logical :: arbSeqIndexFlag
type(ESMF_DELayout) :: delayout
integer :: seqIndex, stride
! 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)
! Translate F90 arguments to C++ friendly form
!! name
nameLen=0
if (present(name)) then
nameLen=len_trim(name)
endif
!! find out grid dimension
dimCount = size(indexArray,2)
!! find out distgrid info
call ESMF_DistGridGet(distgrid, dimCount=dimCount1, tileCount=tileCount, &
delayout=delayout, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_DElayoutGet(delayout, localDeCount=ldeCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! dimCount1 should be equal or less than dimCount
if (dimCount1 > dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- distgrid dimension has to be less or equal to dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (tileCount /= 1) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- distgrid tile count has to be 1", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
distDimCount = dimCount - dimCount1 + 1
undistDimCount = dimCount - distDimCount
!! distDim is a 1D array of size distDimCount. The values are the
!! Grid dimensions that are arbitrarily distributed.
if (present(distDim)) then
if (size(distDim) /= distDimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- dimension of distDim has to be the same as the arbitrary distributed dim", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
!! fill minIndexLocal
allocate(minIndexLocal(dimCount), maxIndexLocal(dimCount))
do i=1,dimCount
minIndexLocal(i) = indexArray(1,i)
maxIndexLocal(i) = indexArray(2,i)
enddo
!! set distSize
allocate(distSize(distDimCount))
allocate(isDistDim(dimCount))
allocate(distDimLocal(distDimCount))
isDistDim(:) = .false.
if (present(distDim)) then
do i=1,distDimCount
distSize(i)=maxIndexLocal(distDim(i))-minIndexLocal(distDim(i))+1
isDistDim(distDim(i))=.true.
distDimLocal(i)=distDim(i)
enddo
else
do i=1,distDimCount
distSize(i)=maxIndexLocal(i)-minIndexLocal(i)+1
isDistDim(i)=.true.
distDimLocal(i)=i
enddo
endif
!! Arbitrary grid indices
minIndexArg = ESMF_InterArrayCreate(minIndexLocal, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
maxIndexArg = ESMF_InterArrayCreate(maxIndexLocal, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! distDim
distDimArg = ESMF_InterArrayCreate(distDimLocal, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (ldeCount > 0) then
call ESMF_DistGridGet(distgrid,localDE=0, elementCount=localCounts, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! reconstruct the localArbIndex from local1DIndices
allocate(local1DIndices(localCounts))
call ESMF_DistGridGet(distgrid,localDE=0, seqIndexList=local1DIndices, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else
localCounts = 0
allocate(local1DIndices(localCounts))
endif
!! find out the dimension
allocate(localArbIndex(localCounts,distDimCount))
!! I hope this is correct....
!! This is kind of redundant. Because if we create the grid using shapetile API, the local1DIndices
!! were calculated by the input localArbIndex and we should not need to re-calculate the localArbIndex.
!! We only need this when user creates an arbitrary grid from a distgrid. The question is (1) do we need
!! to store the localArbIndex in the Grid data structure or not? (2) shall we allow user to pass localArbIndex
!! to the ESMF_CreateGridFromDistGrid()? If we do, we have to check if the distgrid indices matches with
!! the input localArbIndex
do i=1,localCounts
!! make it 0-based first before calculations
seqIndex=local1DIndices(i)-1
do j=distDimCount, 1, -1
stride=1
do k=1, j-1
stride = stride * distSize(k)
enddo
localArbIndex(i,j) = seqIndex / stride
seqIndex = seqIndex - stride * localArbIndex(i,j)
localArbIndex(i,j) = localArbIndex(i,j) + minIndexLocal(distDimLocal(j))
enddo
enddo
localArbIndexArg = ESMF_InterArrayCreate(farray2D=localArbIndex, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! Check the non-arbitrary dimensions in DistGrid and make sure they are
!! consistent with the minIndex and maxIndex
!! First, find out which dimension in DistGrid is arbitrary
arbDim = -1
if (ldeCount > 0) then
allocate(collocation(dimCount1)) ! dimCount
call ESMF_DistGridGet(distgrid, &
collocation=collocation, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
do i=1,dimCount1
call ESMF_DistGridGet(distgrid, localDE=0, collocation=collocation(i), &
arbSeqIndexFlag=arbSeqIndexFlag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (arbSeqIndexFlag) arbDim = i
enddo
deallocate(collocation)
if (arbDim == -1) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- distgrid should contain arbitrary sequence indices", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (undistDimCount /= 0) then
allocate(minIndexPTile(dimCount1,1))
allocate(maxIndexPTile(dimCount1,1))
call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, &
maxIndexPTile=maxIndexPTile, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(undistMinIndex(undistDimCount))
allocate(undistMaxIndex(undistDimCount))
k = 1
do j=1,dimCount
if (.not. isDistDim(j)) then
undistMinIndex(k) = minIndexLocal(j)
undistMaxIndex(k) = maxIndexLocal(j)
k = k+1
endif
enddo
k = 1
do i=1,dimCount1
if (arbDim /= i) then
if ((undistMinIndex(k) /= minIndexPTile(i,1)) .or. &
(undistMaxIndex(k) /= maxIndexPTile(i,1))) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- Grid min/max index does not match with DistGrid min/max index", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
k = k + 1
endif
enddo
endif
!! Description of array factorization
coordDimCountArg = ESMF_InterArrayCreate(coordDimCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
coordDimMapArg = ESMF_InterArrayCreate(farray2D=coordDimMap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! DEfault to don't destroy, subroutine used to set actual values in other creates
intDestroyDistgrid=0
intDestroyDELayout=0
! Initialize this grid object as invalid
grid%this = ESMF_NULL_POINTER
! Call C++ Subroutine to do the create
call c_ESMC_gridcreatedistgridarb(grid%this, nameLen, name, &
coordTypeKind, distgrid, distDimArg, arbDim, &
coordSys, coordDimCountArg, coordDimMapArg, &
minIndexArg, maxIndexArg, localArbIndexArg, localCounts, &
intDestroyDistGrid, intDestroyDELayout, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Deallocate helper variables
deallocate(minIndexLocal)
deallocate(maxIndexLocal)
deallocate(distSize)
deallocate(isDistDim)
deallocate(distDimLocal)
deallocate(local1DIndices)
deallocate(localArbIndex)
if (undistDimCount /= 0) then
deallocate(minIndexPTile)
deallocate(maxIndexPTile)
deallocate(undistMinIndex)
deallocate(undistMaxIndex)
endif
call ESMF_InterArrayDestroy(distDimArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(minIndexArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(maxIndexArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(localArbIndexArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(coordDimCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(coordDimMapArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set return value
ESMF_GridCreateFrmDistGridArb = grid
! Set init status
ESMF_INIT_SET_CREATED(ESMF_GridCreateFrmDistGridArb)
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridCreateFrmDistGridArb