SetServices Subroutine

public subroutine SetServices(drvr, rc)

Arguments

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

Calls

proc~~setservices~14~~CallsGraph proc~setservices~14 SetServices interface~nuopc_compderive NUOPC_CompDerive proc~setservices~14->interface~nuopc_compderive interface~nuopc_compspecialize NUOPC_CompSpecialize proc~setservices~14->interface~nuopc_compspecialize proc~esmf_logfounderror ESMF_LogFoundError proc~setservices~14->proc~esmf_logfounderror proc~nuopc_cplcompderive NUOPC_CplCompDerive interface~nuopc_compderive->proc~nuopc_cplcompderive proc~nuopc_gridcompderive NUOPC_GridCompDerive interface~nuopc_compderive->proc~nuopc_gridcompderive proc~nuopc_cplcompspecialize NUOPC_CplCompSpecialize interface~nuopc_compspecialize->proc~nuopc_cplcompspecialize proc~nuopc_gridcompspecialize NUOPC_GridCompSpecialize interface~nuopc_compspecialize->proc~nuopc_gridcompspecialize esmf_breakpoint esmf_breakpoint proc~esmf_logfounderror->esmf_breakpoint proc~esmf_logrc2msg ESMF_LogRc2Msg proc~esmf_logfounderror->proc~esmf_logrc2msg proc~esmf_logwrite ESMF_LogWrite proc~esmf_logfounderror->proc~esmf_logwrite c_esmc_loggeterrormsg c_esmc_loggeterrormsg proc~esmf_logrc2msg->c_esmc_loggeterrormsg c_esmc_vmwtime c_esmc_vmwtime proc~esmf_logwrite->c_esmc_vmwtime proc~esmf_logclose ESMF_LogClose proc~esmf_logwrite->proc~esmf_logclose proc~esmf_logflush ESMF_LogFlush proc~esmf_logwrite->proc~esmf_logflush proc~esmf_logopenfile ESMF_LogOpenFile proc~esmf_logwrite->proc~esmf_logopenfile proc~esmf_utiliounitflush ESMF_UtilIOUnitFlush proc~esmf_logwrite->proc~esmf_utiliounitflush proc~esmf_utilstring2array ESMF_UtilString2Array proc~esmf_logwrite->proc~esmf_utilstring2array proc~nuopc_cplcompderive->proc~esmf_logfounderror proc~esmf_cplcompget ESMF_CplCompGet proc~nuopc_cplcompderive->proc~esmf_cplcompget proc~nuopc_cplcompspecialize->proc~esmf_logfounderror interface~esmf_methodaddreplace ESMF_MethodAddReplace proc~nuopc_cplcompspecialize->interface~esmf_methodaddreplace interface~nuopc_compattributeget NUOPC_CompAttributeGet proc~nuopc_cplcompspecialize->interface~nuopc_compattributeget interface~nuopc_compsearchphasemap NUOPC_CompSearchPhaseMap proc~nuopc_cplcompspecialize->interface~nuopc_compsearchphasemap proc~nuopc_cplcompspecialize->proc~esmf_cplcompget proc~esmf_logseterror ESMF_LogSetError proc~nuopc_cplcompspecialize->proc~esmf_logseterror proc~nuopc_gridcompderive->proc~esmf_logfounderror proc~esmf_gridcompget ESMF_GridCompGet proc~nuopc_gridcompderive->proc~esmf_gridcompget proc~nuopc_gridcompspecialize->proc~esmf_logfounderror proc~nuopc_gridcompspecialize->interface~esmf_methodaddreplace proc~nuopc_gridcompspecialize->interface~nuopc_compattributeget proc~nuopc_gridcompspecialize->interface~nuopc_compsearchphasemap proc~nuopc_gridcompspecialize->proc~esmf_gridcompget proc~nuopc_gridcompspecialize->proc~esmf_logseterror

Source Code

  subroutine SetServices(model, rc)
    type(ESMF_GridComp)  :: model
    integer, intent(out) :: rc

    rc = ESMF_SUCCESS

    ! derive from NUOPC_Model
    call NUOPC_CompDerive(model, modelSS, rc=rc)
    if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
      line=__LINE__, &
      file=__FILE__)) &
      return  ! bail out

    ! specialize model
    call NUOPC_CompSpecialize(model, specLabel=label_Advertise, &
      specRoutine=Advertise, rc=rc)
    if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
      line=__LINE__, &
      file=__FILE__)) &
      return  ! bail out
    call NUOPC_CompSpecialize(model, specLabel=label_RealizeProvided, &
      specRoutine=Realize, rc=rc)
    if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
      line=__LINE__, &
      file=__FILE__)) &
      return  ! bail out
    call NUOPC_CompSpecialize(model, specLabel=label_Advance, &
      specRoutine=Advance, rc=rc)
    if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
      line=__LINE__, &
      file=__FILE__)) &
      return  ! bail out

  end subroutine

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

  subroutine Advertise(model, rc)
    type(ESMF_GridComp)  :: model
    integer, intent(out) :: rc

    rc = ESMF_SUCCESS

    ! Eventually, you will advertise your model's import and
    ! export fields in this phase.  For now, however, call
    ! your model's initialization routine(s).

    ! call my_model_init()

  end subroutine

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

  subroutine Realize(model, rc)
    type(ESMF_GridComp)  :: model
    integer, intent(out) :: rc

    rc = ESMF_SUCCESS  

    ! Eventually, you will realize your model's fields here,
    ! but leave empty for now.

  end subroutine

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

  subroutine Advance(model, rc)
    type(ESMF_GridComp)  :: model
    integer, intent(out) :: rc
    
    ! local variables
    type(ESMF_Clock)              :: clock
    type(ESMF_State)              :: importState, exportState

    rc = ESMF_SUCCESS
    
    ! query the Component for its clock, importState and exportState
    call NUOPC_ModelGet(model, modelClock=clock, importState=importState, &
      exportState=exportState, rc=rc)
    if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
      line=__LINE__, &
      file=__FILE__)) &
      return  ! bail out

    ! HERE THE MODEL ADVANCES: currTime -> currTime + timeStep
    
    ! Because of the way that the internal Clock was set by default,
    ! its timeStep is equal to the parent timeStep. As a consequence the
    ! currTime + timeStep is equal to the stopTime of the internal Clock
    ! for this call of the Advance() routine.

    call ESMF_ClockPrint(clock, options="currTime", &
      preString="------>Advancing MODEL from: ", rc=rc)
    if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
      line=__LINE__, &
      file=__FILE__)) &
      return  ! bail out
    
    call ESMF_ClockPrint(clock, options="stopTime", &
      preString="--------------------------------> to: ", rc=rc)
    if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
      line=__LINE__, &
      file=__FILE__)) &
      return  ! bail out

    ! Call your model's timestep routine here
    
    ! call my_model_update()
      
  end subroutine

end module

!EOC


! A basic NUOPC Driver
module DRIVER

  use ESMF
  use NUOPC
  use NUOPC_Driver, &
       driver_routine_SS             => SetServices, &
       driver_label_SetModelServices => label_SetModelServices

  use MYMODEL, only: mymodelSS => SetServices

  implicit none

  private

  integer, parameter            :: stepCount = 5
  real(ESMF_KIND_R8), parameter :: stepTime  = 30.D0  ! step time [s]


  public :: SetServices

  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------

  subroutine SetServices(drvr, rc)
    type(ESMF_GridComp)  :: drvr
    integer, intent(out) :: rc

    rc = ESMF_SUCCESS

    ! NUOPC_Driver registers the generic methods
    call NUOPC_CompDerive(drvr, driver_routine_SS, rc=rc)
    if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
         line=__LINE__, &
         file=__FILE__)) &
         return  ! bail out

    ! attach specializing method(s)
    call NUOPC_CompSpecialize(drvr, specLabel=driver_label_SetModelServices, &
         specRoutine=SetModelServices, rc=rc)
    if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
         line=__LINE__, &
         file=__FILE__)) &
         return  ! bail out

  end subroutine SetServices