copyFracsIntoOutputField Subroutine

private subroutine copyFracsIntoOutputField(regridField, regridMesh, outFracField, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_Field), intent(in) :: regridField
type(ESMF_Mesh), intent(inout) :: regridMesh
type(ESMF_Field), intent(inout) :: outFracField
integer, intent(out), optional :: rc

Source Code

    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