ModelAdvance Subroutine

private subroutine ModelAdvance(xdata, rc)

Arguments

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

Source Code

  subroutine ModelAdvance(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_Clock)           :: modelClock
    type(ESMF_State)           :: importState
    type(ESMF_State)           :: exportState
    character(len=160)         :: clockString
    integer                    :: errCount

    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

    ! query component for import and export states
    call NUOPC_ModelGet(xdata, modelClock=modelClock, &
      importState=importState, exportState=exportState, rc=rc)
    if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
      line=__LINE__, file=__FILE__)) return
    call ESMF_ClockPrint(modelClock, options="currTime", &
      unit=clockString, rc=rc)
    if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
      line=__LINE__, file=__FILE__)) return

    ! write to standard out
    if (xstate%myid .eq. xstate%outid) then
      write(*,'(A,X,A)') trim(xstate%cname)//": Model Advance",trim(clockString)
    endif

    ! sum import data from all PETs
    xfield => xstate%imp_flds_head
    errCount = 0
    if (xstate%myid .eq. xstate%outid) then
      write(*,'(A)') trim(xstate%cname)//": Import Fields"
      write(*,'(A,X,A25,X,A9,3(X,A9),X,A4)') &
        trim(xstate%cname)//":", "FIELD", &
        "COUNT", "MEAN", &
        "MIN", "MAX", &
        "OKAY"
    endif
    do while (associated(xfield))
      call x_comp_check_field(xstate, xfield, rc=rc)
      if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
        line=__LINE__, file=__FILE__)) return
      if (xstate%myid .eq. xstate%outid) then
        write(*,'(A,X,A25,X,I9,3(X,E9.2),X,L4)') &
          trim(xstate%cname)//":", trim(xfield%stdn), &
          int(xfield%gsum(2)), xfield%gavg, &
          xfield%gmin(1), xfield%gmax(1), &
          xfield%okay
        if (.not. xfield%okay) errCount = errCount + 1
      endif
      xfield => xfield%nfld
    enddo

    ! sum export data from all PETs
    xfield => xstate%exp_flds_head
    if (xstate%myid .eq. xstate%outid) then
      write(*,'(A)') trim(xstate%cname)//": Export Fields"
      write(*,'(A,X,A25,X,A9,3(X,A9))') &
        trim(xstate%cname)//":", "FIELD", &
        "COUNT", "MEAN", &
        "MIN", "MAX"
    endif
    do while (associated(xfield))
      call x_comp_check_field(xstate, xfield, rc=rc)
      if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
        line=__LINE__, file=__FILE__)) return
      if (xstate%myid .eq. xstate%outid) then
        write(*,'(A,X,A25,X,I9,3(X,E9.2))') &
          trim(xstate%cname)//":", trim(xfield%stdn), &
          int(xfield%gsum(2)), xfield%gavg, &
          xfield%gmin(1), xfield%gmax(1)
      endif
      xfield => xfield%nfld
    enddo

    ! check for errors
    if (errCount .gt. 0) then
      write(*,'(A)') trim(xstate%cname)//": ERROR - check import fields"
      call ESMF_LogSetError(ESMF_RC_VAL_OUTOFRANGE, &
        msg=trim(xstate%cname)//": import field error, check output", &
        line=__LINE__, file=__FILE__, rcToReturn=rc)
      return
    endif

  endsubroutine ModelAdvance