ModelFinalize Subroutine

  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