Nodes of different colours represent the following:
Solid arrows point from a parent (sub)module to the submodule which is descended from it. Dashed arrows point from a module being used to the module or program unit using it. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | ControlNum | |||
logical, | intent(out) | :: | IsConvergedFlag |
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
SUBROUTINE CheckSimpleController(ControlNum, IsConvergedFlag)
! SUBROUTINE INFORMATION:
! AUTHOR Dimitri Curtil (LBNL)
! DATE WRITTEN Feb 2006
! MODIFIED na
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! New routine used to detect whether controller can be considered converged
! depending on its mode of operation.
! Used after all controllers on an air loop have been solved in order
! to make sure that final air loop state still represents a converged
! state.
!
! PRECONDITION: Setpoint must be known. See ControllerProps%IsSetPointDefinedFlag
!
! METHODOLOGY EMPLOYED:
! REFERENCES:
! USE STATEMENTS:
USE General, ONLY : TrimSigDigits
USE RootFinder, ONLY : CheckRootFinderConvergence
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: ControlNum
LOGICAL, INTENT(OUT) :: IsConvergedFlag
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: ActuatedNode
INTEGER :: SensedNode
! Obtain actuated and sensed nodes
ActuatedNode = ControllerProps(ControlNum)%ActuatedNode
SensedNode = ControllerProps(ControlNum)%SensedNode
! Default initialization: assuming no convergence unless detected in the following code!
IsConvergedFlag = .FALSE.
SelectMode: SELECT CASE (ControllerProps(ControlNum)%Mode)
CASE (iModeOff)
! Check whether the component is running
!
! This check is perfomed by looking at the component mass flow rate at the sensed node.
! Since the components have been simulated before getting here, if they are zero they should be OFF.
IF (Node(SensedNode)%MassFlowRate == 0.0d0) THEN
IF ( ControllerProps(ControlNum)%ActuatedValue == 0.0d0 ) THEN
IsConvergedFlag = .TRUE.
RETURN
END IF
END IF
CASE (iModeInactive)
! Controller component NOT available (ie, inactive)
! Make sure that the actuated variable is still equal to the node min avail
!
! NOTE: Replaced Node(ActuatedNode)%MassFlowRateMinAvail in release 1.3
! with ControllerProps(ControlNum)%MinAvailActuated in release 1.4
IF ( ControllerProps(ControlNum)%ActuatedValue == ControllerProps(ControlNum)%MinAvailActuated) THEN
IsConvergedFlag = .TRUE.
RETURN
END IF
CASE (iModeMinActive)
! Check for min constrained convergence
IF ( CheckMinActiveController(ControlNum) ) THEN
IsConvergedFlag = .TRUE.
RETURN
END IF
! Check for unconstrained convergence assuming that there is more than one controller controlling
! the same sensed node and that the other controller was able to meet the setpoint although this one
! was min-constrained.
IF ( CheckRootFinderConvergence( RootFinders(ControlNum), ControllerProps(ControlNum)%DeltaSensed ) ) THEN
! Indicate convergence with base value (used to compute DeltaSensed!)
IsConvergedFlag = .TRUE.
RETURN
END IF
CASE (iModeMaxActive)
! Check for max constrained convergence
IF ( CheckMaxActiveController(ControlNum) ) THEN
IsConvergedFlag = .TRUE.
RETURN
END IF
! Check for unconstrained convergence assuming that there is more than one controller controlling
! the same sensed node and that the other controller was able to meet the setpoint although this one
! was max-constrained.
IF ( CheckRootFinderConvergence( RootFinders(ControlNum), ControllerProps(ControlNum)%DeltaSensed ) ) THEN
! Indicate convergence with base value (used to compute DeltaSensed!)
IsConvergedFlag = .TRUE.
RETURN
END IF
CASE (iModeActive)
! Check min constraint on actuated variable
IF ( ControllerProps(ControlNum)%ActuatedValue < ControllerProps(ControlNum)%MinAvailActuated ) THEN
IsConvergedFlag = .FALSE.
RETURN
END IF
! Check max constraint on actuated variable
IF ( ControllerProps(ControlNum)%ActuatedValue > ControllerProps(ControlNum)%MaxAvailActuated ) THEN
IsConvergedFlag = .FALSE.
RETURN
END IF
! Check for unconstrained convergence
!
! Equivalent to:
! IF ((ABS(ControllerProps(ControlNum)%DeltaSensed) .LE. ControllerProps(ControlNum)%Offset)) THEN
!
! NOTE: If setpoint has changed since last call, then the following test will most likely fail.
IF ( CheckRootFinderConvergence( RootFinders(ControlNum), ControllerProps(ControlNum)%DeltaSensed ) ) THEN
! Indicate convergence with base value (used to compute DeltaSensed!)
IsConvergedFlag = .TRUE.
RETURN
END IF
! Check for min constrained convergence
IF ( CheckMinActiveController(ControlNum) ) THEN
IsConvergedFlag = .TRUE.
RETURN
END IF
! Check for max constrained convergence
IF ( CheckMaxActiveController(ControlNum) ) THEN
IsConvergedFlag = .TRUE.
RETURN
END IF
CASE DEFAULT
! Can only happen if controller is not converged after MaxIter in SolveAirLoopControllers()
! which will produce ControllerProps(ControlNum)%Mode = iModeNone
IsConvergedFlag = .FALSE.
END SELECT SelectMode
RETURN
END SUBROUTINE CheckSimpleController