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