function ESMF_GridCreateFrmScrip(filename, regDecomp, indexflag, keywordEnforcer, &
decompflag, isSphere, polekindflag, addCornerStagger, addUserArea, rc)
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreateFrmScrip
!
! !ARGUMENTS:
character(len=*), intent(in) :: filename
integer, intent(in) :: regDecomp(:)
type(ESMF_Index_Flag), intent(in) :: Indexflag
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type(ESMF_Decomp_Flag), intent(in), optional :: decompflag(:)
logical, intent(in), optional :: isSphere
type(ESMF_PoleKind_Flag), intent(in), optional :: polekindflag(2)
logical, intent(in), optional :: addCornerStagger
logical, intent(in), optional :: addUserArea
integer, intent(out), optional :: rc
! !DESCRIPTION:
! This function creates a {\tt ESMF\_Grid} object using the grid definition from
! a SCRIP grid file.
! To specify the 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 grid defined in the file has to be a 2D logically rectangular
! grid (i.e. {\tt grid\_rank} in the file needs to be 2).
!
! This call is {\em collective} across the current VM.
!
! The arguments are:
! \begin{description}
! \item[filename]
! The SCRIP Grid filename.
! \item[regDecomp]
! A 2 element array specifying how the grid is decomposed.
! Each entry is the number of decounts for that dimension.
! \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[{[isSphere]}]
! If .true., create a periodic Grid. If .false., create a regional Grid. Defaults to .true.
! \item[{[polekindflag]}]
! Two item array which specifies the type of connection which occurs at the pole. The value in polekindflag(1)
! specifies the connection that occurs at the minimum end of the pole dimension. The value in polekindflag(2)
! specifies the connection that occurs at the maximum end of the pole dimension. Please see
! Section~\ref{const:polekind} for a full list of options. If not specified,
! the default is {\tt ESMF\_POLEKIND\_MONOPOLE} for both.
! \item[{[addCornerStagger]}]
! Uses the information in the SCRIP file to add the Corner stagger to
! the Grid. If not specified, defaults to false.
! \item[{[addUserArea]}]
! If .true., use the cell area defined in the SCRIP file.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
#ifdef ESMF_NETCDF
integer :: ncid
integer :: ncStatus
integer :: totalpoints,totaldims
integer, pointer :: dims(:)
integer :: DimId, VarId
real(ESMF_KIND_R8), allocatable:: coordX(:),coordY(:)
real(ESMF_KIND_R8), allocatable:: area(:)
real(ESMF_KIND_R8), allocatable:: cornerX(:),cornerY(:)
real(ESMF_KIND_R8), allocatable:: cornerX2D(:,:),cornerY2D(:,:)
type(ESMF_Grid) :: grid
type(ESMF_Array) :: array
type(ESMF_VM) :: vm
integer :: numDim, buf(1), msgbuf(4)
type(ESMF_DistGrid) :: distgrid
type(ESMF_Decomp_Flag):: decompflagLocal(2)
integer :: localrc
integer :: PetNo, PetCnt
logical :: localAddCornerStagger
logical :: localAddUserArea
logical :: localIsSphere
integer :: grid_corners
integer, pointer :: minind(:,:)
integer :: cornerDims(2)
integer :: lbnd(2), ubnd(2), total(2)
real(ESMF_KIND_R8), pointer :: fptrLat(:,:), fptrLon(:,:), fptrCLon(:,:), fptrCLat(:,:)
real(ESMF_KIND_R8), pointer :: fptrArea(:,:)
integer(ESMF_KIND_I4), pointer :: fptrMask(:,:)
real(ESMF_KIND_R8), pointer :: recvbuf(:)
integer, pointer :: maskbuf(:), imask(:)
integer :: startindex
integer :: localRoot
integer :: i, j, k, ii
integer :: recv(1), centxdim, corxdim
integer :: DECount
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! get global vm information
!
call ESMF_VMGetCurrent(vm, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! set up local pet info
call ESMF_VMGet(vm, localPet=PetNo, petCount=PetCnt, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(decompFlag)) then
decompFlagLocal(:)=decompFlag(:)
else
decompFlagLocal(:)=ESMF_DECOMP_BALANCED
endif
if (present(addCornerStagger)) then
localAddCornerStagger=addCornerStagger
else
localAddCornerStagger=.false.
endif
if (present(isSphere)) then
localIsSphere=isSphere
else
localIsSphere=.true.
endif
if (present(addUserArea)) then
localAddUserArea = addUserArea
else
localAddUserArea =.false.
endif
! Get the grid rank and dimensions from the SCRIP file on PET 0, broadcast the
! data to all the PETs
allocate(dims(2))
if (PetNo == 0) then
call ESMF_ScripInq(filename, grid_dims=dims, grid_rank=totaldims, &
grid_size=totalpoints, grid_corners=grid_corners, rc=localrc)
! write(*,*) "totalpoints=",totalpoints
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! broadcast the values to other PETs
msgbuf(1)=totaldims
msgbuf(2)=dims(1)
msgbuf(3)=dims(2)
msgbuf(4)=grid_corners
call ESMF_VMBroadcast(vm, msgbuf, 4, 0, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else
call ESMF_VMBroadcast(vm, msgbuf, 4, 0, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totaldims = msgbuf(1)
dims(1)=msgbuf(2)
dims(2)=msgbuf(3)
grid_corners=msgbuf(4)
endif
! if grid_rank is not equal to 2, return error
! Does SCRIP allow 3D datasets? What will be the format??
if (totaldims /= 2) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_RANK,msg="- The grip has to be 2D", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! if user wants corners and there aren't 4 then error
if (localAddCornerStagger .and. (grid_corners /= 4)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- The SCRIP file has grid_corners/=4, so can't add Grid corners", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
#if DEBUG_POLEKIND
if(present(polekindflag)) then
print *, "ESMF_GridCreateFrmScrip", polekindflag(1), polekindflag(2), localIsSphere
endif
#endif
! Create Grid based on the input distgrid
if (localIsSphere) then
grid=ESMF_GridCreate1PeriDim(minIndex=(/1,1/), maxIndex=dims, &
regDecomp=regDecomp, decompflag=decompFlagLocal, &
coordSys=ESMF_COORDSYS_SPH_DEG, &
polekindflag=polekindflag, &
gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), &
indexflag=indexflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else
grid=ESMF_GridCreateNoPeriDim(minIndex=(/1,1/), maxIndex=dims, &
regDecomp=regDecomp, decompflag=decompFlagLocal, &
coordSys=ESMF_COORDSYS_SPH_DEG, &
gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/1,1/), &
indexflag=indexflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! Get the exclusive area from each PET
! Set coordinate tables
! Longitude
! Add coordinates
call ESMF_GridGet(grid, localDECount=DECount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridAddCoord(grid, staggerloc=ESMF_STAGGERLOC_CENTER, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (localAddCornerStagger) then
call ESMF_GridAddCoord(grid, staggerloc=ESMF_STAGGERLOC_CORNER, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
call ESMF_GridAddItem(grid, staggerloc=ESMF_STAGGERLOC_CENTER, &
itemflag=ESMF_GRIDITEM_MASK, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (localAddUserArea) then
call ESMF_GridAddItem(grid, staggerloc=ESMF_STAGGERLOC_CENTER, &
itemflag=ESMF_GRIDITEM_AREA, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if (DECount > 0) then
! if the grid size is small enough, read the data in from PET0 and scatter the data to other PEs
! Otherwise, read in the data from the first PE in each row in deDecomp
call ESMF_GridGetCoord(grid, coordDim=1, staggerloc=ESMF_STAGGERLOC_CENTER, &
farrayPtr = fptrLon, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! need to send this information to the head PET of each row
centxdim = size(fptrLon,1)
! Latitude
call ESMF_GridGetCoord(grid, coordDim=2, staggerloc=ESMF_STAGGERLOC_CENTER, &
farrayPtr = fptrLat, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Mask
call ESMF_GridGetItem(grid, staggerloc=ESMF_STAGGERLOC_CENTER, &
itemflag=ESMF_GRIDITEM_MASK, farrayPtr = fptrMask, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Put Corners into coordinates
if (localAddCornerStagger) then
! Longitude
call ESMF_GridGetCoord(grid, staggerloc=ESMF_STAGGERLOC_CORNER, coordDim=1, &
farrayptr = fptrCLon, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! need to send this information to the head PET of each row
corxdim = size(fptrCLon,1)
! Latitude
call ESMF_GridGetCoord(grid, staggerloc=ESMF_STAGGERLOC_CORNER, coordDim=2, &
farrayptr = fptrCLat, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if (localAddUserArea) then
call ESMF_GridGetItem(grid, staggerloc=ESMF_STAGGERLOC_CENTER, &
itemflag=ESMF_GRIDITEM_AREA, farrayptr = fptrArea, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if (mod(PetNo,regDecomp(1)) == 0) then
! read slab of data (in contiguous rows) from the first column of PETs in the regDecomp
! For instance, if there are 8 PETs and regDecomp = /4,2/, then PET 0 and PET 4 will be
! the reader, and each one will read in half of the input data.
allocate(minind(2,PetCnt))
call ESMF_GridGet(grid, distgrid=distgrid, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_DistGridGet(distgrid, minIndexPDe=minind, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGet(grid, ESMF_STAGGERLOC_CENTER, 0, exclusiveLBound=lbnd, &
exclusiveUBound=ubnd, exclusiveCount=total, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
total(1)=dims(1)
totalpoints = total(1)*total(2)
startindex = (minind(2,PetNo+1)-1)*total(1)+minind(1,PetNo+1)
! Get the coordinate information from the SCRIP file, if in radians, convert to degrees
if (localAddCornerStagger) then ! Get centers and corners
allocate(coordX(totalpoints), coordY(totalpoints))
allocate(imask(totalpoints), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating imask", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(cornerX2D(grid_corners,totalpoints), cornerY2D(grid_corners,totalpoints))
call ESMF_ScripGetVar(filename, grid_center_lon=coordX, &
grid_center_lat=coordY, grid_corner_lon=cornerX2D, &
grid_corner_lat=cornerY2D, grid_imask=imask, &
convertToDeg=.TRUE., start = startindex, count=totalpoints, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Calc Corner Dims
cornerDims(2)=total(2)+1
if (localIsSphere) then
cornerDims(1)=dims(1)
else
cornerDims(1)=dims(1)+1
endif
allocate(cornerX(cornerDims(1)*cornerDims(2)), cornerY(cornerDims(1)*cornerDims(2)))
call convert_corner_arrays_to_1D(localIsSphere, dims(1),total(2), cornerX2D,cornerY2D, &
cornerX,cornerY, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
deallocate(cornerX2D, cornerY2D)
else ! get just centers
allocate(coordX(totalpoints), coordY(totalpoints))
allocate(imask(totalpoints),stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating imask", &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ScripGetVar(filename, grid_center_lon=coordX, &
grid_center_lat=coordY, grid_imask=imask, &
convertToDeg=.TRUE., start=startindex, count=totalpoints, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
deallocate(dims, minind)
! pack the coordinate data and send it to the PETs in the same row (PET0 fills its
! own array and send data to PET1 to PET3, PET4 will send to 5 to 7, etc...)
! if there are more than 1 PET in the regdecomp(1)
! Get the xdim of the local array from all other PETS in the same row
allocate(dims(regdecomp(1)-1))
do i=1, regDecomp(1)-1
call ESMF_VMRecv(vm, recv, 1, PetNo+i)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
dims(i)=recv(1)
enddo
call pack_and_send_float(vm, total, regDecomp(1), PetNo, coordX, fptrLon, dims)
call pack_and_send_float(vm, total, regDecomp(1), PetNo, coordY, fptrLat, dims)
call pack_and_send_int(vm, total, regDecomp(1), PetNo, imask, fptrMask, dims)
deallocate(coordX, coordY)
deallocate(imask)
if (localAddUserArea) then
allocate(area(totalpoints), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating area", &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ScripGetVar(filename, grid_area=area, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call pack_and_send_float(vm, total, regDecomp(1), PetNo, area, &
fptrArea, dims)
deallocate(area)
end if
! pack corner coordinates and send
if (localAddCornerStagger) then
! collect the xdim of the corner stagger array from its member PETs
do i=1, regdecomp(1)-1
call ESMF_VMRecv(vm, recv, 1, PetNo+i)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
dims(i)=recv(1)
enddo
call pack_and_send_float(vm, cornerDims, regDecomp(1), PetNo, &
cornerX, fptrCLon, dims)
call pack_and_send_float(vm, cornerDims, regDecomp(1), PetNo, &
cornerY, fptrCLat, dims)
deallocate(cornerX, cornerY)
endif
else
localroot = (PetNo/regDecomp(1))*regDecomp(1)
call ESMF_GridGet(grid, ESMF_STAGGERLOC_CENTER, 0, exclusiveLBound=lbnd, &
exclusiveUBound=ubnd, exclusiveCount=total, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(recvbuf(total(1)*total(2)))
allocate(maskbuf(total(1)*total(2)))
! First, send the xdim of the local array to the localroot
call ESMF_VMSend(vm, total, 1, localroot)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Longitude coordinates
call ESMF_VMRecv(vm, recvbuf, total(1)*total(2), localroot, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
k=1
do i=lbnd(2),ubnd(2)
do j=lbnd(1),ubnd(1)
fptrLon(j,i) = recvbuf(k)
k=k+1
enddo
enddo
! Latitude coordinates
call ESMF_VMRecv(vm, recvbuf, total(1)*total(2), localroot, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
k=1
do i=lbnd(2),ubnd(2)
do j=lbnd(1),ubnd(1)
fptrLat(j,i) = recvbuf(k)
k=k+1
enddo
enddo
! Mask
call ESMF_VMRecv(vm, maskbuf, total(1)*total(2), localroot, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
k=1
do i=lbnd(2),ubnd(2)
do j=lbnd(1),ubnd(1)
fptrMask(j,i) = maskbuf(k)
k=k+1
enddo
enddo
deallocate(maskbuf)
if (localAddUserArea) then
call ESMF_VMRecv(vm, recvbuf, total(1)*total(2), localroot, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
k=1
do i=lbnd(2),ubnd(2)
do j=lbnd(1),ubnd(1)
fptrArea(j,i) = recvbuf(k)
k=k+1
enddo
enddo
endif
deallocate(recvbuf)
if (localAddCornerStagger) then
call ESMF_GridGet(grid, ESMF_STAGGERLOC_CORNER, 0, exclusiveLBound=lbnd, &
exclusiveUBound=ubnd, exclusiveCount=total, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(recvbuf(total(1)*total(2)))
! First, send the xdim of the local array to the localroot
call ESMF_VMSend(vm, total, 1, localroot)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Longitude coordinates
call ESMF_VMRecv(vm, recvbuf, total(1)*total(2), localroot, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
k=1
do i=lbnd(2),ubnd(2)
do j=lbnd(1),ubnd(1)
fptrCLon(j,i) = recvbuf(k)
k=k+1
enddo
enddo
! Latitude coordinates
call ESMF_VMRecv(vm, recvbuf, total(1)*total(2), localroot, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
k=1
do i=lbnd(2),ubnd(2)
do j=lbnd(1),ubnd(1)
fptrCLat(j,i) = recvbuf(k)
k=k+1
enddo
enddo
deallocate(recvbuf)
endif
endif
deallocate(dims)
endif ! if DECount > 0
ESMF_GridCreateFrmScrip = grid
if (present(rc)) rc=ESMF_SUCCESS
return
#else
call ESMF_LogSetError(rcToCheck=ESMF_RC_LIB_NOT_PRESENT, &
msg="- ESMF_NETCDF not defined when lib was compiled", &
ESMF_CONTEXT, rcToReturn=rc)
#endif
return
end function ESMF_GridCreateFrmScrip