f_esmf_regridstorefile Subroutine

subroutine f_esmf_regridstorefile(srcField, dstField, fileName, srcMaskValues, len1, dstMaskValues, len2, routehandle, regridmethod, polemethod, regridPoleNPnts, linetype, normtype, vectorRegrid, unmappedaction, ignoreDegenerate, createRoutehandle, filemode, srcFile, dstFile, srcFileType, dstFileType, largeFileFlag, srcFracField, dstFracField, rc)

Uses

  • proc~~f_esmf_regridstorefile~~UsesGraph proc~f_esmf_regridstorefile f_esmf_regridstorefile ESMF_FieldCreateMod ESMF_FieldCreateMod proc~f_esmf_regridstorefile->ESMF_FieldCreateMod ESMF_FieldGetMod ESMF_FieldGetMod proc~f_esmf_regridstorefile->ESMF_FieldGetMod module~esmf_basemod ESMF_BaseMod proc~f_esmf_regridstorefile->module~esmf_basemod module~esmf_fieldmod ESMF_FieldMod proc~f_esmf_regridstorefile->module~esmf_fieldmod module~esmf_fieldregridmod ESMF_FieldRegridMod proc~f_esmf_regridstorefile->module~esmf_fieldregridmod module~esmf_geommod ESMF_GeomMod proc~f_esmf_regridstorefile->module~esmf_geommod module~esmf_gridmod ESMF_GridMod proc~f_esmf_regridstorefile->module~esmf_gridmod module~esmf_ioscripmod ESMF_IOScripMod proc~f_esmf_regridstorefile->module~esmf_ioscripmod module~esmf_locstreammod ESMF_LocStreamMod proc~f_esmf_regridstorefile->module~esmf_locstreammod module~esmf_logerrmod ESMF_LogErrMod proc~f_esmf_regridstorefile->module~esmf_logerrmod module~esmf_meshmod ESMF_MeshMod proc~f_esmf_regridstorefile->module~esmf_meshmod module~esmf_rhandlemod ESMF_RHandleMod proc~f_esmf_regridstorefile->module~esmf_rhandlemod module~esmf_staggerlocmod ESMF_StaggerLocMod proc~f_esmf_regridstorefile->module~esmf_staggerlocmod module~esmf_utilrwgmod ESMF_UtilRWGMod proc~f_esmf_regridstorefile->module~esmf_utilrwgmod module~esmf_utiltypesmod ESMF_UtilTypesMod proc~f_esmf_regridstorefile->module~esmf_utiltypesmod module~esmf_vmmod ESMF_VMMod proc~f_esmf_regridstorefile->module~esmf_vmmod module~esmf_xgridmod ESMF_XGridMod proc~f_esmf_regridstorefile->module~esmf_xgridmod

Arguments

Type IntentOptional Attributes Name
type(ESMF_Field) :: srcField
type(ESMF_Field) :: dstField
character(len=*), intent(in) :: fileName
integer, optional :: srcMaskValues(len1)
integer :: len1
integer, optional :: dstMaskValues(len2)
integer :: len2
type(ESMF_RouteHandle) :: routehandle
type(ESMF_RegridMethod_Flag), optional :: regridmethod
type(ESMF_PoleMethod_Flag), optional :: polemethod
integer, optional :: regridPoleNPnts
type(ESMF_LineType_Flag), optional :: linetype
type(ESMF_NormType_Flag), optional :: normtype
type(ESMF_Logical), optional :: vectorRegrid
type(ESMF_UnmappedAction_Flag), optional :: unmappedaction
type(ESMF_Logical), optional :: ignoreDegenerate
type(ESMF_Logical), optional :: createRoutehandle
type(ESMF_FileMode_Flag), optional :: filemode
character(len=*), optional :: srcFile
character(len=*), optional :: dstFile
type(ESMF_FileFormat_Flag), optional :: srcFileType
type(ESMF_FileFormat_Flag), optional :: dstFileType
type(ESMF_Logical), optional :: largeFileFlag
type(ESMF_Field), optional :: srcFracField
type(ESMF_Field), optional :: dstFracField
integer :: rc

Calls

proc~~f_esmf_regridstorefile~~CallsGraph proc~f_esmf_regridstorefile f_esmf_regridstorefile esmf_fieldget esmf_fieldget proc~f_esmf_regridstorefile->esmf_fieldget interface~esmf_fieldregridstore ESMF_FieldRegridStore proc~f_esmf_regridstorefile->interface~esmf_fieldregridstore interface~esmf_gridgetcoord ESMF_GridGetCoord proc~f_esmf_regridstorefile->interface~esmf_gridgetcoord interface~esmf_vmget ESMF_VMGet proc~f_esmf_regridstorefile->interface~esmf_vmget proc~computeareagrid computeAreaGrid proc~f_esmf_regridstorefile->proc~computeareagrid proc~computeareamesh computeAreaMesh proc~f_esmf_regridstorefile->proc~computeareamesh proc~esmf_logfounderror ESMF_LogFoundError proc~f_esmf_regridstorefile->proc~esmf_logfounderror proc~esmf_logseterror ESMF_LogSetError proc~f_esmf_regridstorefile->proc~esmf_logseterror proc~esmf_meshget ESMF_MeshGet proc~f_esmf_regridstorefile->proc~esmf_meshget proc~esmf_outputscripweightfile ESMF_OutputScripWeightFile proc~f_esmf_regridstorefile->proc~esmf_outputscripweightfile proc~esmf_routehandlecopythis ESMF_RouteHandleCopyThis proc~f_esmf_regridstorefile->proc~esmf_routehandlecopythis proc~esmf_sparsematrixwrite ESMF_SparseMatrixWrite proc~f_esmf_regridstorefile->proc~esmf_sparsematrixwrite proc~esmf_vmgetcurrent ESMF_VMGetCurrent proc~f_esmf_regridstorefile->proc~esmf_vmgetcurrent

Source Code

  subroutine f_esmf_regridstorefile(srcField, dstField, fileName, &
                                    srcMaskValues, len1, &
                                    dstMaskValues, len2, &
                                    routehandle, &
                                    regridmethod, &
                                    polemethod, &
                                    regridPoleNPnts, &
                                    linetype, &
                                    normtype, &
                                    vectorRegrid, &
                                    unmappedaction, &
                                    ignoreDegenerate, &
                                    createRoutehandle, &
                                    filemode, &
                                    srcFile, &
                                    dstFile, &
                                    srcFileType, &
                                    dstFileType, &
                                    largeFileFlag, &
                                    srcFracField, &
                                    dstFracField, &
                                    rc)

    use ESMF_UtilTypesMod
    use ESMF_BaseMod
    use ESMF_LogErrMod
    use ESMF_RHandleMod
    use ESMF_FieldRegridMod
    use ESMF_FieldMod
    use ESMF_FieldCreateMod
    use ESMF_FieldGetMod
    use ESMF_IOScripMod
    use ESMF_GeomMod
    use ESMF_GridMod
    use ESMF_MeshMod
    use ESMF_LocStreamMod
    use ESMF_XGridMod
    use ESMF_StaggerLocMod
    use ESMF_VMMod
    use ESMF_UtilRWGMod

    implicit none

    type(ESMF_Field)                        :: srcField
    type(ESMF_Field)                        :: dstField
    character(*), intent(in)                :: fileName
    integer                                 :: len1, len2
    integer,optional                        :: srcMaskValues(len1), &
                                               dstMaskValues(len2)
    type(ESMF_RouteHandle)                  :: routehandle
    type(ESMF_RegridMethod_Flag),optional   :: regridmethod
    type(ESMF_PoleMethod_Flag),optional     :: polemethod
    integer,optional                        :: regridPoleNPnts

    type(ESMF_LineType_Flag),optional       :: linetype
    type(ESMF_NormType_Flag),optional       :: normtype
    type(ESMF_Logical),optional             :: vectorRegrid
    type(ESMF_UnmappedAction_Flag),optional :: unmappedaction
    type(ESMF_Logical), optional            :: ignoreDegenerate
    type(ESMF_Logical), optional            :: createRoutehandle  ! Note that createRoutehandle defaults to true

    type(ESMF_FileMode_Flag),   optional    :: filemode
    character(len=*),           optional    :: srcFile
    character(len=*),           optional    :: dstFile
    type(ESMF_FileFormat_Flag), optional    :: srcFileType
    type(ESMF_FileFormat_Flag), optional    :: dstFileType

    type(ESMF_Logical), optional            :: largeFileFlag

    type(ESMF_Field), optional              :: srcFracField
    type(ESMF_Field), optional              :: dstFracField

    integer                                 :: rc

    !--------------------------------------------------------------------------

    real(ESMF_KIND_R8), pointer             :: srcArea(:), dstArea(:)
    type(ESMF_GeomType_Flag)                :: srcgt, dstgt
    type(ESMF_TypeKind_Flag)                :: srctk, dsttk
    type(ESMF_Grid)                         :: srcgrid, dstgrid
    type(ESMF_Mesh)                         :: srcmesh, dstmesh
    integer                                 :: srcslc, dstslc
    logical                                 :: ecip

    type(ESMF_VM)                           :: vm
    integer                                 :: localPet, petCount
    
    integer :: localrc
    type(ESMF_RouteHandle) :: l_routehandle
    logical :: l_vectorRegrid
    logical :: l_ignoreDegenerate
    logical :: l_createRoutehandle
    logical :: l_largeFileFlag

    real(ESMF_KIND_R8), pointer :: localFactorList(:)
    integer(ESMF_KIND_I4), pointer :: localFactorIndexList(:,:)
    
    type(ESMF_FileMode_Flag) :: filemode_local

    !--------------------------------------------------------------------------
    
    ! initialize return code; assume routine not implemented
    rc = ESMF_RC_NOT_IMPL
    localrc = ESMF_RC_NOT_IMPL

    if (present(vectorRegrid)) then
      l_vectorRegrid = vectorRegrid
    else
      l_vectorRegrid = .false.
    end if
    if (present(ignoreDegenerate)) then
      l_ignoreDegenerate = ignoreDegenerate
    else
      l_ignoreDegenerate = .false.
    end if
    if (present(createRoutehandle)) then
      l_createRoutehandle = createRoutehandle
    else
      ! Note that createRoutehandle defaults to true
      l_createRoutehandle = .true.
    end if
    if (present(largeFileFlag)) then
      l_largeFileFlag = largeFileFlag
    else
      l_largeFileFlag = .false.
    end if
    
    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=localPet, petCount=petCount, rc=localrc)
    if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return

    if (.not. l_createRoutehandle) then
      call ESMF_FieldRegridStore(srcField, dstField, &
                                 srcMaskValues=srcMaskValues, &
                                 dstMaskValues=dstMaskValues, &
                                 regridmethod=regridmethod, &
                                 polemethod=polemethod, &
                                 regridPoleNPnts=regridPoleNPnts, &
                                 lineType=linetype, &
                                 normType=normtype, &
                                 vectorRegrid=l_vectorRegrid, &
                                 unmappedaction=unmappedaction, &
                                 ignoreDegenerate=l_ignoreDegenerate, &
                                 factorList=localFactorList, &
                                 factorIndexList=localFactorIndexList, &
                                 srcFracField=srcFracField, &
                                 dstFracField=dstFracField, &
                                 rc=localrc)
      if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return
    else  ! l_createRoutehandle is .true.
      call ESMF_FieldRegridStore(srcField, dstField, &
                                 srcMaskValues=srcMaskValues, &
                                 dstMaskValues=dstMaskValues, &
                                 regridmethod=regridmethod, &
                                 polemethod=polemethod, &
                                 regridPoleNPnts=regridPoleNPnts, &
                                 lineType=linetype, &
                                 normType=normtype, &
                                 vectorRegrid=l_vectorRegrid, &
                                 unmappedaction=unmappedaction, &
                                 ignoreDegenerate=l_ignoreDegenerate, &
                                 routehandle=l_routehandle, &
                                 factorList=localFactorList, &
                                 factorIndexList=localFactorIndexList, &
                                 srcFracField=srcFracField, &
                                 dstFracField=dstFracField, &
                                 rc=localrc)
      if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return
    endif

    ! write the weights to file
    filemode_local = ESMF_FILEMODE_BASIC
    if (present(filemode)) then
      filemode_local = filemode
    endif
    
    if (filemode_local == ESMF_FILEMODE_BASIC) then
      call ESMF_SparseMatrixWrite(localFactorList, localFactorIndexList, &
                                  fileName, rc=localrc)
      if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return
    elseif (filemode_local == ESMF_FILEMODE_WITHAUX) then
      ! query field for geom type
      call ESMF_FieldGet(srcField, geomType=srcgt, typekind=srctk, rc=localrc)
      if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return
      
      ! determine which stagger locations are available
      srcslc = 0
      if (srcgt == ESMF_GEOMTYPE_GRID) then
        call ESMF_FieldGet(srcField, grid=srcgrid, rc=localrc)
        if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
            
        call ESMF_GridGetCoord(srcgrid, staggerloc=ESMF_STAGGERLOC_CENTER, &
                               isPresent=ecip, rc=localrc)
        if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return

        if (ecip .eqv. .true.) srcslc = 1
        
        call ESMF_GridGetCoord(srcgrid, staggerloc=ESMF_STAGGERLOC_CORNER, &
                               isPresent=ecip, rc=localrc)
        if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return

        if (ecip .eqv. .true.) srcslc = 2
      else if (srcgt == ESMF_GEOMTYPE_MESH) then
        call ESMF_FieldGet(srcField, mesh=srcmesh, rc=localrc)
        if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
        
        ecip = .false.
        call ESMF_MeshGet(srcmesh, elementCoordsIsPresent=ecip, rc=localrc)
        if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
            
        srcslc = 1
        if (ecip .eqv. .true.) srcslc = 2
      else if (srcgt == ESMF_GEOMTYPE_XGRID) then
        call ESMF_LogSetError(rcToCheck=ESMF_RC_NOT_IMPL, &
                            msg="- xgrid cannot retrieve areas", &
                            ESMF_CONTEXT, rcToReturn=rc)
      endif
      
      ! query field for geom type
      call ESMF_FieldGet(dstField, geomType=dstgt, typekind=dsttk, rc=localrc)
      if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return
      
      ! determine which stagger locations are available
      dstslc = 0
      if (dstgt == ESMF_GEOMTYPE_GRID) then
        call ESMF_FieldGet(dstField, grid=dstgrid, rc=localrc)
        if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return

        call ESMF_GridGetCoord(dstgrid, staggerloc=ESMF_STAGGERLOC_CENTER, &
                               isPresent=ecip, rc=localrc)
        if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return

        if (ecip .eqv. .true.) dstslc = 1
        
        call ESMF_GridGetCoord(dstgrid, staggerloc=ESMF_STAGGERLOC_CORNER, &
                               isPresent=ecip, rc=localrc)
        if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return

        if (ecip .eqv. .true.) dstslc = 2
      else if (dstgt == ESMF_GEOMTYPE_MESH) then
        call ESMF_FieldGet(dstField, mesh=dstmesh, rc=localrc)
        if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
        
        ecip = .false.
        call ESMF_MeshGet(dstmesh, elementCoordsIsPresent=ecip, rc=localrc)
        if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return

        dstslc = 1
        if (ecip .eqv. .true.) dstslc = 2
      else if (dstgt == ESMF_GEOMTYPE_XGRID) then
        call ESMF_LogSetError(rcToCheck=ESMF_RC_NOT_IMPL, &
                            msg="- xgrid cannot retrieve areas", &
                            ESMF_CONTEXT, rcToReturn=rc)
      endif

      ! compute the areas
      if (srcslc > 1) then
        if (srcgt == ESMF_GEOMTYPE_GRID) then
          call computeAreaGrid(srcgrid, localPet, srcarea, 0, localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
              ESMF_CONTEXT, rcToReturn=rc)) return
        else if (srcgt == ESMF_GEOMTYPE_MESH) then
          call computeAreaMesh(srcmesh, vm, localPet, petCount, srcarea, localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
              ESMF_CONTEXT, rcToReturn=rc)) return
        endif
      endif

      if (dstslc > 1) then
        if (dstgt == ESMF_GEOMTYPE_GRID) then
          call computeAreaGrid(dstgrid, petCount, dstarea, 0, localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
              ESMF_CONTEXT, rcToReturn=rc)) return
        else if (dstgt == ESMF_GEOMTYPE_MESH) then
          call computeAreaMesh(dstmesh, vm, localPet, petCount, dstarea, localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
              ESMF_CONTEXT, rcToReturn=rc)) return
        endif
      endif

      ! write the weight file
      if (srcslc > 1 .and. dstslc > 1) then
        call ESMF_OutputScripWeightFile(fileName, &
                                        localFactorList, localFactorIndexList, &
                                        srcFile=srcFile, dstFile=dstFile, &
                                        srcFileType=srcFileType, &
                                        dstFileType=dstFileType, &
                                        srcArea=srcArea, &
                                        dstArea=dstArea, &
                                        largeFileFlag=l_largeFileFlag, &
                                        rc=localrc)
        if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
      else if (srcslc > 1 .and. dstslc == 1) then
        call ESMF_OutputScripWeightFile(fileName, &
                                        localFactorList, localFactorIndexList, &
                                        srcFile=srcFile, dstFile=dstFile, &
                                        srcFileType=srcFileType, &
                                        dstFileType=dstFileType, &
                                        srcArea=srcArea, &
                                        largeFileFlag=l_largeFileFlag, &
                                        rc=localrc)
        if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
      else if (srcslc == 1 .and. dstslc > 1) then
        call ESMF_OutputScripWeightFile(fileName, &
                                        localFactorList, localFactorIndexList, &
                                        srcFile=srcFile, dstFile=dstFile, &
                                        srcFileType=srcFileType, &
                                        dstFileType=dstFileType, &
                                        dstArea=dstArea, &
                                        largeFileFlag=l_largeFileFlag, &
                                        rc=localrc)
        if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
      else if (srcslc == 1 .and. dstslc == 1) then
        call ESMF_OutputScripWeightFile(fileName, &
                                        localFactorList, localFactorIndexList, &
                                        srcFile=srcFile, dstFile=dstFile, &
                                        srcFileType=srcFileType, &
                                        dstFileType=dstFileType, &
                                        largeFileFlag=l_largeFileFlag, &
                                        rc=localrc)
        if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
      else
        call ESMF_LogSetError(rcToCheck=ESMF_RC_VAL_OUTOFRANGE, &
                              msg="- unrecognized area field options", &
                              ESMF_CONTEXT, rcToReturn=rc)
      endif
    else
      call ESMF_LogSetError(rcToCheck=ESMF_RC_VAL_OUTOFRANGE, &
                            msg="- filemode not recognized", &
                            ESMF_CONTEXT, rcToReturn=rc)
    endif
    if (ESMF_LogFoundError(localrc, &
      ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return

    ! because ESMF_RouteHandle.this is private, it cannot be accessed directly
    ! we use the public interface to do the ptr copy;
    ! the RouteHandle object returned to the C interface must consist only of
    ! the 'this' pointer. It must not contain the isInit member.
    if (l_createRoutehandle) then
      call ESMF_RoutehandleCopyThis(l_routehandle, routehandle, localrc)
      if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return
    endif

    deallocate(localFactorList)
    deallocate(localFactorIndexList)

    rc = ESMF_SUCCESS

  end subroutine f_esmf_regridstorefile