ESMF_CompWait Subroutine

public subroutine ESMF_CompWait(compp, syncflag, timeout, userRc, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_CompClass), pointer :: compp
type(ESMF_Sync_Flag), intent(in), optional :: syncflag
integer, intent(in), optional :: timeout
integer, intent(out), optional :: userRc
integer, intent(out), optional :: rc

Source Code

  subroutine ESMF_CompWait(compp, syncflag, timeout, userRc, rc)
!
! !ARGUMENTS:
    type(ESMF_CompClass), pointer               :: compp
    type(ESMF_Sync_Flag), intent(in),  optional :: syncflag
    integer,              intent(in),  optional :: timeout
    integer,              intent(out), optional :: userRc
    integer,              intent(out), optional :: rc
!
! !DESCRIPTION:
! Wait for component to return
!
! The arguments are:
! \begin{description}
! \item[compp] 
!   component object
! \item[{[syncflag]}]
!   The blocking behavior determines exactly what this call waits for. The
!   default is {\tt ESMF\_SYNC\_VASBLOCKING} which blocks PETs across each VAS.
!   See section \ref{const:sync} for a list of valid blocking options.
! \item[{[timeout]}]
!   The maximum period in seconds the actual component is allowed to execute
!   a previously invoked component method before it must communicate back to
!   the dual component. If the actual component does not communicate back in
!   the specified time, a timeout condition is raised on the dual side (this
!   side). The default is 3600, i.e. 1 hour.
! \item[{[userRc]}]
!   Return code set by {\tt userRoutine} before returning.
! \item[{[rc]}] 
!   Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
!------------------------------------------------------------------------------
    integer                 :: localrc      ! local return code
    integer                 :: localUserRc  ! return code from user code
    type(ESMF_Sync_Flag)    :: blocking     ! local blocking flag
    type(ESMF_VM)           :: vm           ! VM for current context
    type(ESMF_Status)       :: baseStatus
    integer                 :: timeoutArg
    real(ESMF_KIND_R8)      :: usedTime
    
    ! Initialize return code; assume failure until success is certain
    localrc = ESMF_RC_NOT_IMPL
    if (present(rc)) rc = ESMF_RC_NOT_IMPL

    ! Check input
    if (.not.associated(compp)) then
      call ESMF_LogSetError(ESMF_RC_OBJ_BAD, &
        msg="uninitialized or destroyed Component object", &
        ESMF_CONTEXT, rcToReturn=rc) 
      return
    endif

    ! Check init status of arguments
    ESMF_INIT_CHECK_DEEP(ESMF_CompClassGetInit, compp, rc)

    call ESMF_BaseGetStatus(compp%base, baseStatus, rc=localrc)
    if (ESMF_LogFoundError(localrc, &
        ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return
        
    if (baseStatus /= ESMF_STATUS_READY) then
      call ESMF_LogSetError(ESMF_RC_OBJ_BAD, &
        msg="uninitialized or destroyed Component object", &
        ESMF_CONTEXT, rcToReturn=rc) 
      return
    endif

    ! set the default mode to ESMF_SYNC_VASBLOCKING
    if (present(syncflag)) then
      blocking = syncflag
    else
      blocking = ESMF_SYNC_VASBLOCKING
    endif

    localUserRc = ESMF_SUCCESS  ! initialize to success
    
    timeoutArg = ESMF_DEFAULT_TIMEOUT ! default 1h
    if (present(timeout)) timeoutArg = timeout
    
    ! check if the child VM, i.e. the VM of this component, is currently marked
    ! as running...
    if (compp%vm_released) then
      ! check if the calling PET has a present VM (i.e. was SetServices called)
      if (compp%compStatus%vmIsPresent) then
        ! wait for all child PETs that run in this parent's PET VAS to finish
        ! determine how long the component has been released already
        call ESMF_VMWTime(usedTime, rc=localrc)
        if (ESMF_LogFoundError(localrc, &
          ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return
        usedTime = usedTime - compp%startTime
        ! allow remaining time for timeout, but at least 1 second to wrap up
        timeoutArg = max(timeoutArg - int(usedTime), 1)
!print *, "ESMF_CompWait(), calling c_ESMC_CompWait(): usedTime=",usedTime,"timeoutArg=",timeoutArg
        call c_ESMC_CompWait(compp%vm_parent, compp%vmplan, compp%vm_info, &
          compp%vm_cargo, timeoutArg, compp%vm_recursionCount, localUserRc, &
          localrc)
        ! localUserRc - return code of registered user callback method
        ! localrc     - return code of ESMF internal callback stack
        if (ESMF_LogFoundError(localrc, &
          ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return
      endif
      ! reset the released flag
      compp%vm_released = .false.       ! indicate child VM has been caught
      ! for ESMF_SYNC_BLOCKING _all_ parent PETs will be synced on exit
      if (blocking == ESMF_SYNC_BLOCKING) then
        ! the current context _is_ the parent context...
        call ESMF_VMGetCurrent(vm=vm, rc=localrc)  ! determine current VM
        if (ESMF_LogFoundError(localrc, &
          ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return
        call ESMF_VMBarrier(vm=vm, rc=localrc) ! barrier across parent VM
        if (ESMF_LogFoundError(localrc, &
          ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return
      endif
    endif

    ! pass back userRc
    if (present(userRc)) userRc = localUserRc

    ! return successfully
    if (present(rc)) rc = ESMF_SUCCESS

  end subroutine ESMF_CompWait