subroutine copyFracsIntoOutputField(regridField, regridMesh, outFracField, rc)
type(ESMF_Field), intent(in) :: regridField
type(ESMF_Mesh), intent(inout) :: regridMesh
type(ESMF_Field), intent(inout) :: outFracField
integer, intent(out), optional :: rc
integer :: localrc
type(ESMF_GeomType_Flag) :: regridGeomtype, fracGeomtype
type(ESMF_Grid) :: grid
type(ESMF_Mesh) :: tmpMesh
type(ESMF_MeshLoc) :: regridMeshloc, fracMeshLoc
type(ESMF_StaggerLoc) :: regridStaggerLoc, fracStaggerLoc
type(ESMF_StaggerLoc) :: g2MStaggerLoc
type(ESMF_Array) :: fracArray
real(ESMF_KIND_R8), pointer :: fracFptr(:)
integer :: gridDimCount, fracLocalDECount
! Get information from regrid field
call ESMF_FieldGet(regridField, geomtype=regridGeomtype, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Get information from frac field
call ESMF_FieldGet(outFracField, geomtype=fracGeomtype, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Make sure frac field matches
if (regridGeomtype .ne. fracGeomType) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="Fraction Field isn't built on same geometry type as regrid Field (e.g. srcField is different than srcFracField).", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Copy fractions based on geometry
if (fracGeomtype .eq. ESMF_GEOMTYPE_GRID) then
! Get info from regrid Field
call ESMF_FieldGet(regridField, staggerloc=regridStaggerloc, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Get info from frac Field
call ESMF_FieldGet(outFracField, array=fracArray, staggerloc=fracStaggerloc, &
grid=grid, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Make sure the staggerlocs match
if (fracStaggerloc .ne. regridStaggerloc) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="Fraction Field staggerloc doesn't match regrid Field staggerloc (e.g. srcField is different than srcFracField).", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Get staggerStaggerLocG2M
call ESMF_GridGet(grid=grid, dimCount=gridDimCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Figure out staggerloc based on dimension
if (gridDimCount .eq. 2) then
g2MStaggerLoc=ESMF_STAGGERLOC_CORNER
else if (gridDimCount .eq. 3) then
g2MStaggerLoc=ESMF_STAGGERLOC_CORNER_VFACE
else
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="Can currently only do conservative regridding on 2D or 3D grids", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Copy frac from Mesh field into fracArray
call ESMF_RegridGetFrac(grid, mesh=regridMesh, array=fracArray, &
staggerloc=g2MStaggerLoc, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else if (fracGeomtype .eq. ESMF_GEOMTYPE_MESH) then
! Get information from regridField
call ESMF_FieldGet(regridField, meshloc=regridMeshloc, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Get information from fracField
call ESMF_FieldGet(outFracField, meshloc=fracMeshloc, &
localDECount=fracLocalDECount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Make sure the locs match
if (fracMeshLoc .ne. regridMeshLoc) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="Fraction Field meshloc doesn't match regrid Field meshloc (e.g. srcField is different than srcFracField).", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Make sure the mesh loc is on elements
if (fracMeshLoc .ne. ESMF_MESHLOC_ELEMENT) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="Fraction Fields built on a Mesh must be created with meshloc=ESMF_MESHLOC_ELEMENT.", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! We don't support multiple DEs in a fraction Field built on a mesh right now
if (fracLocalDECount .gt. 1) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="Fraction Fields built on a Mesh that contain more than one local DE currently not supported in regridding.", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! get frac pointer
call ESMF_FieldGet(outFracField, localDE=0, farrayPtr=fracFptr, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Get Frac info
call ESMF_MeshGetElemFrac(regridMesh, fracList=fracFptr, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
end subroutine copyFracsIntoOutputField