subroutine ESMF_FieldRegridStoreX(xgrid, srcField, dstField, keywordEnforcer, &
regridmethod, &
srcTermProcessing, pipeLineDepth, &
routehandle, &
factorList, factorIndexList, &
srcFracField, dstFracField, &
srcMergeFracField, dstMergeFracField, rc)
!
! !ARGUMENTS:
type(ESMF_XGrid), intent(in) :: xgrid
type(ESMF_Field), intent(in) :: srcField
type(ESMF_Field), intent(inout) :: dstField
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type(ESMF_RegridMethod_Flag), intent(in), optional :: regridmethod
integer, intent(inout), optional :: srcTermProcessing
integer, intent(inout), optional :: pipeLineDepth
type(ESMF_RouteHandle), intent(inout), optional :: routehandle
real(ESMF_KIND_R8), pointer, optional :: factorList(:)
integer(ESMF_KIND_I4), pointer, optional :: factorIndexList(:,:)
type(ESMF_Field), intent(inout), optional :: srcFracField
type(ESMF_Field), intent(inout), optional :: dstFracField
type(ESMF_Field), intent(inout), optional :: srcMergeFracField
type(ESMF_Field), intent(inout), optional :: dstMergeFracField
integer, intent(out), optional :: rc
!
! !STATUS:
! \begin{itemize}
! \item\apiStatusCompatibleVersion{5.2.0r}
! \item\apiStatusModifiedSinceVersion{5.2.0r}
! \begin{description}
! \item[5.3.0] Added arguments {\tt srcFracField}, {\tt dstFracField}, {\tt srcMergeFracField}, and {\tt dstMergeFracField}.
! These fraction Fields allow a user to calculate correct flux regridded through {\tt ESMF\_XGrid}.
! \item[7.1.0r] Added argument {\tt regridmethod}. This new argument allows the user to choose the regrid method
! to apply when computing the routehandle.
! \item[8.5.0] Added arguments {\tt srcTermProcessing} and {\tt pipelineDepth} to
! provide access to the tuning parameters affecting the sparse matrix
! execution. See the text for details on the impact
! {\tt srcTermProcessing} can have on bit-for-bit reproducibility.
! \item[8.9.0] Added arguments {\tt factorList} and {\tt factorIndexList} to allow user
! to retrieve regridding weights.
!
! \end{description}
! \end{itemize}
!
! !DESCRIPTION:
! \begin{sloppypar}
! This method creates a RouteHandle to do conservative interpolation specifically between a
! Field built on an XGrid and a Field build on one of the Grids or Meshes used to create that XGrid.
! (To do more general interpolation use the {\tt ESMF\_FieldRegridStore()} method
! in section~\ref{api:esmf_fieldregridstorenx}.) The RouteHandle produced by this method can then be used in the call
! {\tt ESMF\_FieldRegrid()} to interpolate from the {\tt srcField} to the {\tt dstField}.
! \end{sloppypar}
!
! The RouteHandle generated by this call is based just on the
! coordinates in the Grids, XGrids, or Meshes contained in the Fields. If those
! coordinates don't change the RouteHandle can
! be used repeatedly to interpolate from the source Field to the
! destination Field. This is true even if the data in the Fields
! changes. The RouteHandle may also be used to interpolate between any
! source and destination Field which are created
! on the same Grid, XGrid, or Mesh as the original Fields.
!
! When it's no longer needed the RouteHandle should be destroyed by
! using {\tt ESMF\_FieldRegridRelease()} to free the memory it's using.
!
! Note, as a side effect, that this call may change the data in {\tt dstField}. If
! this is undesirable, then an easy work around is to create a second temporary Field
! with the same structure as {\tt dstField} and pass that in instead.
!
! The arguments are:
! \begin{description}
! \item [xgrid]
! Exchange Grid.
! \item [srcField]
! Source Field built on either {\tt xgrid} or one of the Grids or Meshes used to create {\tt xgrid}.
! \item [dstField]
! Destination Field built on either {\tt xgrid} or one of the Grids or Meshes used to create {\tt xgrid}.
! The data in this Field may be overwritten by this call.
! \item [{[regridmethod]}]
! The type of interpolation. For this method only
! {\tt ESMF\_REGRIDMETHOD\_CONSERVE} and {\tt ESMF\_REGRIDMETHOD\_CONSERVE\_2ND} are
! supported. If not specified, defaults to {\tt ESMF\_REGRIDMETHOD\_CONSERVE}.
! \item [{[srcTermProcessing]}]
! The {\tt srcTermProcessing} parameter controls how many source terms,
! located on the same PET and summing into the same destination element,
! are summed into partial sums on the source PET before being transferred
! to the destination PET. A value of 0 indicates that the entire arithmetic
! is done on the destination PET; source elements are neither multiplied
! by their factors nor added into partial sums before being sent off by the
! source PET. A value of 1 indicates that source elements are multiplied
! by their factors on the source side before being sent to the destination
! PET. Larger values of {\tt srcTermProcessing} indicate the maximum number
! of terms in the partial sums on the source side.
!
! Note that partial sums may lead to bit-for-bit differences in the results.
! See section \ref{RH:bfb} for an in-depth discussion of {\em all}
! bit-for-bit reproducibility aspects related to route-based communication
! methods.
!
! \begin{sloppypar}
! The {\tt ESMF\_FieldRegridStore()} method implements an auto-tuning scheme
! for the {\tt srcTermProcessing} parameter. The intent on the
! {\tt srcTermProcessing} argument is "{\tt inout}" in order to
! support both overriding and accessing the auto-tuning parameter.
! If an argument $>= 0$ is specified, it is used for the
! {\tt srcTermProcessing} parameter, and the auto-tuning phase is skipped.
! In this case the {\tt srcTermProcessing} argument is not modified on
! return. If the provided argument is $< 0$, the {\tt srcTermProcessing}
! parameter is determined internally using the auto-tuning scheme. In this
! case the {\tt srcTermProcessing} argument is re-set to the internally
! determined value on return. Auto-tuning is also used if the optional
! {\tt srcTermProcessing} argument is omitted.
! \end{sloppypar}
!
! \item [{[pipelineDepth]}]
! The {\tt pipelineDepth} parameter controls how many messages a PET
! may have outstanding during a sparse matrix exchange. Larger values
! of {\tt pipelineDepth} typically lead to better performance. However,
! on some systems too large a value may lead to performance degradation,
! or runtime errors.
!
! Note that the pipeline depth has no effect on the bit-for-bit
! reproducibility of the results. However, it may affect the performance
! reproducibility of the exchange.
!
! The {\tt ESMF\_FieldRegridStore()} method implements an auto-tuning scheme
! for the {\tt pipelineDepth} parameter. The intent on the
! {\tt pipelineDepth} argument is "{\tt inout}" in order to
! support both overriding and accessing the auto-tuning parameter.
! If an argument $>= 0$ is specified, it is used for the
! {\tt pipelineDepth} parameter, and the auto-tuning phase is skipped.
! In this case the {\tt pipelineDepth} argument is not modified on
! return. If the provided argument is $< 0$, the {\tt pipelineDepth}
! parameter is determined internally using the auto-tuning scheme. In this
! case the {\tt pipelineDepth} argument is re-set to the internally
! determined value on return. Auto-tuning is also used if the optional
! {\tt pipelineDepth} argument is omitted.
! \item [{[routehandle]}]
! The handle that implements the regrid and that can be used in later
! {\tt ESMF\_FieldRegrid}.
! \item [{[srcFracField]}]
! The fraction of each source cell participating in the regridding returned from this call.
! This Field needs to be created on the same Grid and location (e.g staggerloc)
! as the srcField.
! \item [{[dstFracField]}]
! The fraction of each destination cell participating in the regridding returned from this call.
! This Field needs to be created on the same Grid and location (e.g staggerloc)
! as the dstField.
! \item [{[srcMergeFracField]}]
! The fraction of each source cell as a result of Grid merge returned from this call.
! This Field needs to be created on the same Grid and location (e.g staggerloc)
! as the srcField.
! \item [{[dstMergeFracField]}]
! The fraction of each destination cell as a result of Grid merge returned from this call.
! This Field needs to be created on the same Grid and location (e.g staggerloc)
! as the dstField.
! \item [{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
integer :: localrc, i
type(ESMF_GeomType_Flag) :: geomtype, srcgeomtype, dstgeomtype
type(ESMF_XGrid) :: srcXGrid, dstXGrid
type(ESMF_Mesh) :: srcMesh, dstMesh
type(ESMF_Array) :: srcArray, dstArray
integer :: srcIdx, dstIdx, ngrid_a, ngrid_b
integer :: sideAGC, sideAMC, sideBGC, sideBMC
type(ESMF_XGridSide_Flag) :: srcSide, dstSide
type(ESMF_XGridGeomBase), allocatable :: gridA(:), gridB(:)
type(ESMF_Grid) :: srcGrid
type(ESMF_Grid) :: dstGrid
type(ESMF_XGridSpec) :: sparseMat
logical :: found, match
type(ESMF_Array) :: srcFracArray
type(ESMF_Array) :: dstFracArray
type(ESMF_STAGGERLOC):: interpFieldStaggerloc, fracFieldStaggerloc
type(ESMF_MESHLOC) :: interpFieldMeshloc, fracFieldMeshloc
type(ESMF_RegridMethod_Flag) :: lregridmethod
type(ESMF_Mesh) :: xgridMesh, sideMesh
logical :: sideMeshDestroy
integer :: xgridSide, xgridInd, sideMeshSide, sideMeshInd
type(ESMF_PointList) :: dstPointList, srcPointList
type(ESMF_Array) :: statusArray
integer(ESMF_KIND_I4), pointer :: tmpFactorIndexList(:,:)
real(ESMF_KIND_R8), pointer :: tmpFactorList(:)
! Initialize return code; assume failure until success is certain
localrc = ESMF_SUCCESS
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Set optional method argument
if (present(regridmethod)) then
Lregridmethod=regridmethod
else
lregridmethod=ESMF_REGRIDMETHOD_CONSERVE
endif
! Only conservative methods supported for now
if ((lregridmethod .ne. ESMF_REGRIDMETHOD_CONSERVE) .and. &
(lregridmethod .ne. ESMF_REGRIDMETHOD_CONSERVE_2ND)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- Only conservative regrid methods supported through XGrid", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! look for the correct Grid to use
! first Get necessary information from XGrid and Fields
call ESMF_XGridGet(xgrid, &
sideAGridCount=sideAGC, sideAMeshCount=sideAMC, &
sideBGridCount=sideBGC, sideBMeshCount=sideBMC, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
ngrid_a = sideAGC + sideAMC
ngrid_b = sideBGC + sideBMC
allocate(gridA(ngrid_a), gridB(ngrid_b))
call ESMF_XGridGet(xgrid, gridA, gridB, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_FieldGet(srcField, geomtype=geomtype, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
srcgeomtype = geomtype
! locate the Grid or XGrid contained in srcField
if(geomtype == ESMF_GEOMTYPE_GRID) then
call ESMF_FieldGet(srcField, grid=srcGrid, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
found = .false.
do i = 1, ngrid_a
!if(ESMF_GridMatch(srcGrid, gridA(i)%gbcp%grid, &
! globalflag=.true.) >=ESMF_GRIDMATCH_EXACT) then
if(srcGrid == gridA(i)%gbcp%grid) then
srcIdx = i
srcSide = ESMF_XGRIDSIDE_A
found = .true.
exit
endif
enddo
do i = 1, ngrid_b
!if(ESMF_GridMatch(srcGrid, gridB(i)%gbcp%grid, &
! globalflag=.true.) >=ESMF_GRIDMATCH_EXACT) then
if(srcGrid == gridB(i)%gbcp%grid) then
if(found) then
! TODO: maybe we should attach standard attibute
! to differentiate src and dst side for regridding
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- duplication of Grid found in XGrid", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
srcIdx = i
srcSide = ESMF_XGRIDSIDE_B
found = .true.
exit
endif
enddo
! If found create Mesh from Grid
if(.not. found) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- cannot Locate src Field Grid in XGrid", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
else if(geomtype == ESMF_GEOMTYPE_MESH) then
call ESMF_FieldGet(srcField, mesh=srcMesh, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
found = .false.
do i = 1, ngrid_a
!if(ESMF_MeshMatch(srcMesh, gridA(i)%gbcp%mesh)) then
if(srcMesh == gridA(i)%gbcp%mesh) then
srcIdx = i
srcSide = ESMF_XGRIDSIDE_A
found = .true.
exit
endif
enddo
do i = 1, ngrid_b
!if(ESMF_MeshMatch(srcMesh, gridB(i)%gbcp%mesh)) then
if(srcMesh == gridB(i)%gbcp%mesh) then
if(found) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- duplication of Mesh found in XGrid", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
srcIdx = i
srcSide = ESMF_XGRIDSIDE_B
found = .true.
exit
endif
enddo
if(.not. found) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- cannot Locate src Field Mesh in XGrid", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
else if(geomtype == ESMF_GEOMTYPE_XGRID) then
call ESMF_FieldGet(srcField, xgrid=srcXGrid, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
match = ESMF_XGridMatch(xgrid, srcXGrid, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if(match) then
srcSide = ESMF_XGRIDSIDE_BALANCED
srcIdx = 1
else
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- XGrid in srcField doesn't match the input XGrid", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
else
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- src Field is not built on Grid, Mesh, or XGrid", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! locate the Grid or XGrid contained in dstField
call ESMF_FieldGet(dstField, geomtype=geomtype, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
dstgeomtype = geomtype
if(geomtype == ESMF_GEOMTYPE_GRID) then
call ESMF_FieldGet(dstField, grid=dstGrid, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
found = .false.
do i = 1, ngrid_a
!if(ESMF_GridMatch(dstGrid, gridA(i)%gbcp%grid, &
! globalflag=.true.) >=ESMF_GRIDMATCH_EXACT) then
if(dstGrid == gridA(i)%gbcp%grid) then
dstIdx = i
dstSide = ESMF_XGRIDSIDE_A
found = .true.
exit
endif
enddo
do i = 1, ngrid_b
!if(ESMF_GridMatch(dstGrid, gridB(i)%gbcp%grid, &
! globalflag=.true.) >=ESMF_GRIDMATCH_EXACT) then
if(dstGrid == gridB(i)%gbcp%grid) then
if(found) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- duplication of Grid found in XGrid", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
dstIdx = i
dstSide = ESMF_XGRIDSIDE_B
found = .true.
exit
endif
enddo
if(.not. found) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- cannot Locate dst Field Grid in XGrid", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
else if(geomtype == ESMF_GEOMTYPE_MESH) then
call ESMF_FieldGet(dstField, mesh=dstMesh, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
found = .false.
do i = 1, ngrid_a
!if(ESMF_MeshMatch(dstMesh, gridA(i)%gbcp%mesh)) then
if(dstMesh == gridA(i)%gbcp%mesh) then
dstIdx = i
dstSide = ESMF_XGRIDSIDE_A
found = .true.
exit
endif
enddo
do i = 1, ngrid_b
!if(ESMF_MeshMatch(dstMesh, gridB(i)%gbcp%mesh)) then
if(dstMesh == gridB(i)%gbcp%mesh) then
if(found) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- duplication of Mesh found in XGrid", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
dstIdx = i
dstSide = ESMF_XGRIDSIDE_B
found = .true.
exit
endif
enddo
if(.not. found) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- cannot Locate dst Field Mesh in XGrid", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
else if(geomtype == ESMF_GEOMTYPE_XGRID) then
call ESMF_FieldGet(dstField, xgrid=dstXGrid, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
match = ESMF_XGridMatch(xgrid, dstXGrid, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if(match) then
dstSide = ESMF_XGRIDSIDE_BALANCED
dstIdx = 1
else
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- XGrid in dstField doesn't match the input XGrid", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
else
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- src Field is not built on Grid or XGrid", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! src and dst Fields should not be on the same side
if ( srcSide == dstSide ) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- src and dst Fields should not be on same side of the XGrid", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! retrieve regridding fraction Fields on demand
if(present(srcFracField)) then
if(srcgeomtype == ESMF_GEOMTYPE_GRID) then
call ESMF_FieldGet(srcFracField, staggerloc=fracFieldStaggerloc, &
array=srcFracArray, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_FieldGet(srcField, staggerloc=interpFieldStaggerloc, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Make sure the staggerlocs match
if (interpFieldStaggerloc .ne. fracFieldStaggerloc) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- fracField Field staggerloc must match interpField staggerloc", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
else if(srcgeomtype == ESMF_GEOMTYPE_MESH) then
call ESMF_FieldGet(srcFracField, meshloc=fracFieldMeshloc, &
array=srcFracArray, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_FieldGet(srcField, meshloc=interpFieldMeshloc, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Make sure the staggerlocs match
if (interpFieldMeshloc .ne. fracFieldMeshloc) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- fracField Field Meshloc must match interpField Meshloc", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
else
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- src Field has unrecognized geom type", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
call ESMF_XGridGet(xgrid, srcSide, srcIdx, &
dstSide, dstIdx, srcFracArray=srcFracArray, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if(present(dstFracField)) then
if(dstgeomtype == ESMF_GEOMTYPE_GRID) then
call ESMF_FieldGet(dstFracField, staggerloc=fracFieldStaggerloc, &
array=dstFracArray, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_FieldGet(dstField, staggerloc=interpFieldStaggerloc, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Make sure the staggerlocs match
if (interpFieldStaggerloc .ne. fracFieldStaggerloc) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- fracField Field staggerloc must match interpField staggerloc", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
else if(dstgeomtype == ESMF_GEOMTYPE_MESH) then
call ESMF_FieldGet(dstFracField, meshloc=fracFieldMeshloc, &
array=dstFracArray, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_FieldGet(dstField, meshloc=interpFieldMeshloc, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Make sure the staggerlocs match
if (interpFieldMeshloc .ne. fracFieldMeshloc) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- fracField Field Meshloc must match interpField Meshloc", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
else
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- dst Field has unrecognized geom type", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
call ESMF_XGridGet(xgrid, srcSide, srcIdx, &
dstSide, dstIdx, dstFracArray=dstFracArray, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! retrieve regridding fraction2 Fields on demand
if(present(srcMergeFracField)) then
if(srcgeomtype == ESMF_GEOMTYPE_GRID) then
call ESMF_FieldGet(srcMergeFracField, staggerloc=fracFieldStaggerloc, &
array=srcFracArray, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_FieldGet(srcField, staggerloc=interpFieldStaggerloc, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Make sure the staggerlocs match
if (interpFieldStaggerloc .ne. fracFieldStaggerloc) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- fracField Field staggerloc must match interpField staggerloc", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
else if(srcgeomtype == ESMF_GEOMTYPE_MESH) then
call ESMF_FieldGet(srcFracField, meshloc=fracFieldMeshloc, &
array=srcFracArray, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_FieldGet(srcField, meshloc=interpFieldMeshloc, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Make sure the staggerlocs match
if (interpFieldMeshloc .ne. fracFieldMeshloc) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- fracField Field Meshloc must match interpField Meshloc", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
else
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- src Field has unrecognized geom type", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
call ESMF_XGridGet(xgrid, srcSide, srcIdx, &
dstSide, dstIdx, srcFrac2Array=srcFracArray, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if(present(dstMergeFracField)) then
if(dstgeomtype == ESMF_GEOMTYPE_GRID) then
call ESMF_FieldGet(dstMergeFracField, staggerloc=fracFieldStaggerloc, &
array=dstFracArray, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_FieldGet(dstField, staggerloc=interpFieldStaggerloc, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Make sure the staggerlocs match
if (interpFieldStaggerloc .ne. fracFieldStaggerloc) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- fracField Field staggerloc must match interpField staggerloc", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
else if(dstgeomtype == ESMF_GEOMTYPE_MESH) then
call ESMF_FieldGet(dstFracField, meshloc=fracFieldMeshloc, &
array=dstFracArray, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_FieldGet(dstField, meshloc=interpFieldMeshloc, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Make sure the staggerlocs match
if (interpFieldMeshloc .ne. fracFieldMeshloc) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- fracField Field Meshloc must match interpField Meshloc", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
else
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- dst Field has unrecognized geom type", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
call ESMF_XGridGet(xgrid, srcSide, srcIdx, &
dstSide, dstIdx, dstFrac2Array=dstFracArray, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! Create routehandle based on regrid method
if (lregridmethod .eq. ESMF_REGRIDMETHOD_CONSERVE) then
! retrieve the correct sparseMat structure
call ESMF_XGridGet(xgrid, srcSide, srcIdx, &
dstSide, dstIdx, sparseMat=sparseMat, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! If routeHandle requested, create that
if (present(routeHandle)) then
! call FieldSMMStore
call ESMF_FieldSMMStore(srcField, dstField, routehandle, &
sparseMat%factorList, sparseMat%factorIndexList, &
srcTermProcessing=srcTermProcessing, &
pipeLineDepth=pipeLineDepth, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! If factorList requested, copy that
if (present(factorList)) then
! Allocate space
allocate(factorList(size(sparseMat%factorList)))
! Copy
factorList=sparseMat%factorList
endif
! If factorIndexList requested, copy that
if (present(factorIndexList)) then
! Allocate space
allocate(factorIndexList(size(sparseMat%factorIndexList,1),size(sparseMat%factorIndexList,2)))
! Copy
factorIndexList=sparseMat%factorIndexList
endif
else if (lregridmethod .eq. ESMF_REGRIDMETHOD_CONSERVE_2ND) then
! Get Super Mesh
call ESMF_XGridGet(xgrid, mesh=xgridMesh, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set XGrid side and ind information
xgridSide=3
xgridInd=0
call c_esmc_meshsetxgridinfo(xgridMesh, xgridSide, xgridInd, localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Init side info
sideMeshDestroy=.false.
sideMeshSide=0
sideMeshInd=0
! Get srcMesh
if (srcSide == ESMF_XGRIDSIDE_BALANCED) then ! Src is XGrid
! SrcMesh is super mesh
srcMesh=xgridMesh
else ! src is side mesh
! Set side info
sideMeshSide=1 ! side A
if (srcSide == ESMF_XGRIDSIDE_B) sideMeshSide=2 ! side B
sideMeshInd=srcIdx
! Get/create sideMesh
call ESMF_FieldGet(srcField, geomtype=geomtype, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (geomtype == ESMF_GEOMTYPE_GRID) then
call ESMF_FieldGet(srcField, grid=srcGrid, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Create Mesh from Grid
sideMesh=conserve_GridToMesh(srcGrid, &
!maskValues, turnedOnMeshElemMask, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Record that we created the mesh
sideMeshDestroy=.true.
! srcMesh is sideMesh
srcMesh=sideMesh
else if (geomtype == ESMF_GEOMTYPE_MESH) then
! Get side Mesh
call ESMF_FieldGet(srcField, mesh=sideMesh, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! srcMesh is sideMesh
srcMesh=sideMesh
else
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="srcField is not built on Grid, or Mesh.", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
! Get srcArray
call ESMF_FieldGet(srcField, array=srcArray, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Get dstMesh
if (dstSide == ESMF_XGRIDSIDE_BALANCED) then ! Dst is XGrid
! DstMesh is super mesh
dstMesh=xgridMesh
else ! dst is side mesh
! Set side info
sideMeshSide=1 ! side A
if (dstSide == ESMF_XGRIDSIDE_B) sideMeshSide=2 ! side B
sideMeshInd=dstIdx
! Get/create sideMesh
call ESMF_FieldGet(dstField, geomtype=geomtype, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (geomtype == ESMF_GEOMTYPE_GRID) then
call ESMF_FieldGet(dstField, grid=dstGrid, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Create Mesh from Grid
sideMesh=conserve_GridToMesh(dstGrid, &
!maskValues, turnedOnMeshElemMask, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Record that we created the mesh
sideMeshDestroy=.true.
! dstMesh is sideMesh
dstMesh=sideMesh
else if (geomtype == ESMF_GEOMTYPE_MESH) then
! Get side Mesh
call ESMF_FieldGet(dstField, mesh=sideMesh, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! dstMesh is sideMesh
dstMesh=sideMesh
else
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="dstField is not built on Grid, or Mesh.", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
! Get dstArray
call ESMF_FieldGet(dstField, array=dstArray, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set side Mesh info
call c_esmc_meshsetxgridinfo(sideMesh, sideMeshSide, sideMeshInd, localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Generate routehandle for 2nd order conservative
if (present(factorList) .or. present(factorIndexList)) then ! Do weight matrix and maybe rh
call ESMF_RegridStore(srcMesh, srcArray, &
srcPointList, .false., &
dstMesh, dstArray, &
dstPointList, .false. , &
regridMethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, &
lineType=ESMF_LINETYPE_GREAT_CIRCLE, &
normType=ESMF_NORMTYPE_DSTAREA, &
vectorRegrid=.false., &
polemethod=ESMF_POLEMETHOD_NONE, regridPoleNPnts=4, &
hasStatusArray=.false., statusArray=statusArray, &
extrapMethod=ESMF_EXTRAPMETHOD_NONE, &
extrapNumSrcPnts=8, extrapDistExponent=2.0_ESMF_KIND_R8, &
extrapNumLevels=2, extrapNumInputLevels=2, &
unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & ! Otherwise, dst = sideMesh will often lead to unmapped errors
ignoreDegenerate=.true., &
srcTermProcessing=srcTermProcessing, &
pipeLineDepth=pipeLineDepth, &
routehandle=routeHandle, &
indices=tmpFactorIndexList, &
weights=tmpFactorList, &
checkFlag=.false., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! attach sparse matrix to appropriate output variable
if (present(factorList)) factorList=>tmpFactorList
if (present(factorIndexList)) factorIndexList=>tmpFactorIndexList
! deallocate if not being passed out
if (.not. present(factorList)) deallocate(tmpfactorList)
if (.not. present(factorIndexList)) deallocate(tmpfactorIndexList)
else ! Just do routeHandle
call ESMF_RegridStore(srcMesh, srcArray, &
srcPointList, .false., &
dstMesh, dstArray, &
dstPointList, .false. , &
regridMethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, &
lineType=ESMF_LINETYPE_GREAT_CIRCLE, &
normType=ESMF_NORMTYPE_DSTAREA, &
vectorRegrid=.false., &
polemethod=ESMF_POLEMETHOD_NONE, regridPoleNPnts=4, &
hasStatusArray=.false., statusArray=statusArray, &
extrapMethod=ESMF_EXTRAPMETHOD_NONE, &
extrapNumSrcPnts=8, extrapDistExponent=2.0_ESMF_KIND_R8, &
extrapNumLevels=2, extrapNumInputLevels=2, &
unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & ! Otherwise, dst = sideMesh will often lead to unmapped errors
ignoreDegenerate=.true., &
srcTermProcessing=srcTermProcessing, &
pipeLineDepth=pipeLineDepth, &
routehandle=routeHandle, &
checkFlag=.false., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! The fraction information should be the same as stored in the XGrid. However,
! use the version actually calculated during 2nd order calc, so that it matches more
! precisely the values used during that calculation.
! If present, copy src fraction information
if (present(srcFracField)) then
call copyFracsIntoOutputField(srcField, srcMesh, srcFracField, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! If present, copy dst fraction information
if (present(dstFracField)) then
call copyFracsIntoOutputField(dstField, dstMesh, dstFracField, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! Reset Mesh side info so that it doesn't interfere elsewhere
call c_esmc_meshsetxgridinfo(xgridMesh, -1, -1, localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call c_esmc_meshsetxgridinfo(sideMesh, -1, -1, localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Get rid of temporary sideMesh if necessary
if (sideMeshDestroy) then
call ESMF_MeshDestroy(sideMesh, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
else
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg=" unsupported regridMethod with XGrid version of ESMF_FieldRegridStore().", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Return success
if(present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_FieldRegridStoreX