ModelFinalize Subroutine

private subroutine ModelFinalize(xdata, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_GridComp) :: xdata
integer, intent(out) :: rc

Calls

proc~~modelfinalize~~CallsGraph proc~modelfinalize ModelFinalize esmf_fieldbundlecreate esmf_fieldbundlecreate proc~modelfinalize->esmf_fieldbundlecreate esmf_fieldbundledestroy esmf_fieldbundledestroy proc~modelfinalize->esmf_fieldbundledestroy esmf_fieldbundlewrite esmf_fieldbundlewrite proc~modelfinalize->esmf_fieldbundlewrite esmf_fielddestroy esmf_fielddestroy proc~modelfinalize->esmf_fielddestroy esmf_fieldget esmf_fieldget proc~modelfinalize->esmf_fieldget esmf_stateremove esmf_stateremove proc~modelfinalize->esmf_stateremove interface~esmf_gridcompgetinternalstate ESMF_GridCompGetInternalState proc~modelfinalize->interface~esmf_gridcompgetinternalstate interface~nuopc_compget NUOPC_CompGet proc~modelfinalize->interface~nuopc_compget proc~esmf_griddestroy ESMF_GridDestroy proc~modelfinalize->proc~esmf_griddestroy proc~esmf_logfounddeallocerror ESMF_LogFoundDeallocError proc~modelfinalize->proc~esmf_logfounddeallocerror proc~esmf_logfounderror ESMF_LogFoundError proc~modelfinalize->proc~esmf_logfounderror proc~esmf_logseterror ESMF_LogSetError proc~modelfinalize->proc~esmf_logseterror proc~nuopc_getstatemembercount NUOPC_GetStateMemberCount proc~modelfinalize->proc~nuopc_getstatemembercount proc~nuopc_getstatememberlists NUOPC_GetStateMemberLists proc~modelfinalize->proc~nuopc_getstatememberlists proc~nuopc_modelget NUOPC_ModelGet proc~modelfinalize->proc~nuopc_modelget proc~nuopc_cplcompget NUOPC_CplCompGet interface~nuopc_compget->proc~nuopc_cplcompget proc~nuopc_gridcompget NUOPC_GridCompGet interface~nuopc_compget->proc~nuopc_gridcompget proc~esmf_griddestroy->proc~esmf_logfounderror c_esmc_griddestroy c_esmc_griddestroy proc~esmf_griddestroy->c_esmc_griddestroy proc~esmf_gridgetinit ESMF_GridGetInit proc~esmf_griddestroy->proc~esmf_gridgetinit proc~esmf_imerr ESMF_IMErr proc~esmf_griddestroy->proc~esmf_imerr esmf_breakpoint esmf_breakpoint proc~esmf_logfounddeallocerror->esmf_breakpoint proc~esmf_logrc2msg ESMF_LogRc2Msg proc~esmf_logfounddeallocerror->proc~esmf_logrc2msg proc~esmf_logwrite ESMF_LogWrite proc~esmf_logfounddeallocerror->proc~esmf_logwrite proc~esmf_logfounderror->esmf_breakpoint proc~esmf_logfounderror->proc~esmf_logrc2msg proc~esmf_logfounderror->proc~esmf_logwrite proc~esmf_logseterror->esmf_breakpoint proc~esmf_logseterror->proc~esmf_logrc2msg proc~esmf_logseterror->proc~esmf_logwrite proc~nuopc_getstatemembercount->proc~esmf_logfounderror proc~nuopc_getstatemembercountintrnl NUOPC_GetStateMemberCountIntrnl proc~nuopc_getstatemembercount->proc~nuopc_getstatemembercountintrnl proc~nuopc_getstatememberlists->proc~esmf_logfounderror proc~nuopc_getstatememberlists->proc~esmf_logseterror proc~nuopc_getstatememberlists->proc~nuopc_getstatemembercount esmf_stateget esmf_stateget proc~nuopc_getstatememberlists->esmf_stateget proc~esmf_logfoundallocerror ESMF_LogFoundAllocError proc~nuopc_getstatememberlists->proc~esmf_logfoundallocerror proc~nuopc_getstatememberlistsintrnl NUOPC_GetStateMemberListsIntrnl proc~nuopc_getstatememberlists->proc~nuopc_getstatememberlistsintrnl proc~nuopc_modelget->interface~nuopc_compget proc~nuopc_modelget->proc~esmf_logfounderror proc~nuopc_modelbaseget NUOPC_ModelBaseGet proc~nuopc_modelget->proc~nuopc_modelbaseget

Source Code

  subroutine ModelFinalize(xdata, rc)
    ! arguments
    type(ESMF_GridComp)  :: xdata
    integer, intent(out) :: rc
    ! local variables
    integer                    :: stat
    type(xstate_wrap)          :: is
    type(xdata_state), pointer :: xstate
    type(xdata_field), pointer :: xfield
    type(ESMF_State)           :: importState
    type(ESMF_State)           :: exportState
    integer                    :: fc
    type(ESMF_Field), pointer  :: fl(:)
    type(ESMF_FieldBundle)     :: fb
    character(ESMF_MAXSTR)     :: fieldName

    rc = ESMF_SUCCESS

    ! query component for internal state
    nullify(is%ptr)
    call ESMF_GridCompGetInternalState(xdata, is, rc)
    if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
      line=__LINE__, file=__FILE__)) return
    xstate => is%ptr
    if (.not. associated(xstate)) then
      call ESMF_LogSetError(ESMF_RC_PTR_NOTALLOC, &
        msg='XDATA: xstate has not been associated', &
        line=__LINE__, file=__FILE__, rcToReturn=rc)
      return
    endif

    ! query component for information
    call NUOPC_CompGet(xdata, name=xstate%cname, &
      verbosity=xstate%verbosity, diagnostic=xstate%diagnostic, rc=rc)
    if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
      line=__LINE__, file=__FILE__)) return

    ! access import- and exportState
    call NUOPC_ModelGet(xdata, importState=importState, &
      exportState=exportState, rc=rc)
    if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
      line=__LINE__, file=__FILE__)) return

    ! write final import and export states
    if (xstate%write_final) then
      call NUOPC_GetStateMemberCount(importState, fieldCount=fc, rc=rc)
      if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
        line=__LINE__, file=__FILE__)) return
      if (fc .gt. 0) then
        nullify(fl)
        call NUOPC_GetStateMemberLists(importState, fieldList=fl, rc=rc)
        if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
          line=__LINE__, file=__FILE__)) return
        fb = ESMF_FieldBundleCreate(fieldList=fl, rc=rc)
        if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
          line=__LINE__, file=__FILE__)) return
        call ESMF_FieldBundleWrite(fb, &
          fileName=trim(xstate%cname)//"_final_import.nc", &
          overwrite=.true., rc=rc)
        if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
          line=__LINE__, file=__FILE__)) return
        call ESMF_FieldBundleDestroy(fb, rc=rc)
        if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
          line=__LINE__, file=__FILE__)) return
        deallocate(fl)
      endif
      call NUOPC_GetStateMemberCount(exportState, fieldCount=fc, rc=rc)
      if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
        line=__LINE__, file=__FILE__)) return
      if (fc .gt. 0) then
        nullify(fl)
        call NUOPC_GetStateMemberLists(exportState, fieldList=fl, rc=rc)
        if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
          line=__LINE__, file=__FILE__)) return
        fb = ESMF_FieldBundleCreate(fieldList=fl, rc=rc)
        if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
          line=__LINE__, file=__FILE__)) return
        call ESMF_FieldBundleWrite(fb, &
          fileName=trim(xstate%cname)//"_final_export.nc", &
          overwrite=.true., rc=rc)
        if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
          line=__LINE__, file=__FILE__)) return
        call ESMF_FieldBundleDestroy(fb, rc=rc)
        if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
          line=__LINE__, file=__FILE__)) return
        deallocate(fl)
      endif
    endif

    ! remove import fields from importState and destroy
    do while (associated(xstate%imp_flds_head))
      xfield => xstate%imp_flds_head
      xstate%imp_flds_head => xfield%nfld
      call ESMF_FieldGet(xfield%efld, name=fieldName, rc=rc)
      if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
        line=__LINE__, file=__FILE__)) return
      call ESMF_StateRemove(importState, (/fieldName/), rc=rc)
      if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
        line=__LINE__, file=__FILE__)) return
      call ESMF_FieldDestroy(xfield%efld, rc=rc)
      if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
        line=__LINE__, file=__FILE__)) return
      deallocate(xfield, stat=stat)
      if (ESMF_LogFoundDeallocError(statusToCheck=stat, &
        msg=trim(xstate%cname)//': Memory deallocation failed.', &
        line=__LINE__, &
        file=__FILE__, &
        rcToReturn=rc)) return
      nullify(xfield)
    enddo
    xstate%imp_flds_tail => null()

    ! remove export fields from exportState and destroy
    do while (associated(xstate%exp_flds_head))
      xfield => xstate%exp_flds_head
      xstate%exp_flds_head => xfield%nfld
      call ESMF_FieldGet(xfield%efld, name=fieldName, rc=rc)
      if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
        line=__LINE__, file=__FILE__)) return
      call ESMF_StateRemove(exportState, (/fieldName/), rc=rc)
      if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
        line=__LINE__, file=__FILE__)) return
      call ESMF_FieldDestroy(xfield%efld, rc=rc)
      if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
        line=__LINE__, file=__FILE__)) return
      deallocate(xfield, stat=stat)
      if (ESMF_LogFoundDeallocError(statusToCheck=stat, &
        msg=trim(xstate%cname)//': Memory deallocation failed.', &
        line=__LINE__, &
        file=__FILE__, &
        rcToReturn=rc)) return
      nullify(xfield)
    enddo
    xstate%exp_flds_tail => null()

    ! destroy grid
    call ESMF_GridDestroy(xstate%grid, rc=rc)
    if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
      line=__LINE__, file=__FILE__)) return

    deallocate(is%ptr, stat=stat)
    if (ESMF_LogFoundDeallocError(statusToCheck=stat, &
      msg='XDATA: Memory deallocation failed.', &
      line=__LINE__, &
      file=__FILE__, &
      rcToReturn=rc)) return
  endsubroutine ModelFinalize