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(in) | :: | FirstHVACIteration | |||
logical, | intent(in) | :: | DoWarmRestartFlag | |||
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 ResetController(ControlNum, FirstHVACIteration, DoWarmRestartFlag, IsConvergedFlag)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN April 2004
! MODIFIED Dimitri Curtil (LBNL), Feb 2006
! - Added capability for speculative warm restart
! Brent Griffith (NREL), Feb 2010
! - use SetActuatedBranchFlowRate in Plant Utilities (honor hardware min > 0.0)
! - add FirstHVACIteration logic, don't reset if false,
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine resets the actuator inlet flows.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE PlantUtilities, ONLY : SetActuatedBranchFlowRate
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: ControlNum
LOGICAL, INTENT(IN) :: FirstHVACIteration
LOGICAL, INTENT(IN) :: DoWarmRestartFlag
LOGICAL, INTENT(OUT) :: IsConvergedFlag
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: ActuatedNode
INTEGER :: SensedNode
REAL(r64) :: NoFlowResetValue
ActuatedNode = ControllerProps(ControlNum)%ActuatedNode
SensedNode = ControllerProps(ControlNum)%SensedNode
! Set again in ReportController() to ControllerProps(ControlNum)%NextActuatedValue
! IF (FirstHVACIteration) THEN
!DSU3 Node(ActuatedNode)%MassFlowRate = 0.0d0
NoFlowResetValue = 0.0d0
CALL SetActuatedBranchFlowRate(NoFlowResetValue, &
ControllerProps(ControlNum)%ActuatedNode , &
ControllerProps(ControlNum)%ActuatedNodePlantLoopNum, &
ControllerProps(ControlNum)%ActuatedNodePlantLoopSide, &
ControllerProps(ControlNum)%ActuatedNodePlantLoopBranchNum, &
.TRUE.)
! ENDIF
! Reset iteration counter and internal variables
ControllerProps(ControlNum)%NumCalcCalls = 0
ControllerProps(ControlNum)%DeltaSensed = 0.0d0
ControllerProps(ControlNum)%SensedValue = 0.0d0
ControllerProps(ControlNum)%ActuatedValue = 0.0d0
! Reset setpoint-related quantities
ControllerProps(ControlNum)%SetPointValue = 0.0d0
ControllerProps(ControlNum)%IsSetPointDefinedFlag = .FALSE.
! MinAvailActuated and MaxAvailActuated set in InitController()
ControllerProps(ControlNum)%MinAvailActuated = 0.0d0
ControllerProps(ControlNum)%MinAvailSensed = 0.0d0
ControllerProps(ControlNum)%MaxAvailActuated = 0.0d0
ControllerProps(ControlNum)%MaxAvailSensed = 0.0d0
! Restart from previous solution if speculative warm restart flag set
! Keep same mode and next actuated value unchanged from last controller simulation.
IF ( DoWarmRestartFlag ) THEN
ControllerProps(ControlNum)%DoWarmRestartFlag = .TRUE.
ELSE
ControllerProps(ControlNum)%DoWarmRestartFlag = .FALSE.
! If no speculative warm restart then reset stored mode and actucated value
ControllerProps(ControlNum)%Mode = iModeNone
ControllerProps(ControlNum)%NextActuatedValue = 0.0d0
END IF
! Only set once per HVAC iteration.
! Might be overwritten in the InitController() routine.
!
! Allow reusing the previous solution while identifying brackets if
! this is not the first HVAC step of the environment
ControllerProps(ControlNum)%ReusePreviousSolutionFlag = .TRUE.
! Always reset to false by default. Set in CalcSimpleController() on the first controller iteration.
ControllerProps(ControlNum)%ReuseIntermediateSolutionFlag = .FALSE.
! By default not converged
IsConvergedFlag = .FALSE.
! Reset root finder
! This is independent of the processing in InitializeRootFinder() performed in Calc() routine.
RootFinders(ControlNum)%StatusFlag = iStatusNone
RootFinders(ControlNum)%CurrentMethodType = iMethodNone
RootFinders(ControlNum)%CurrentPoint%DefinedFlag = .FALSE.
RootFinders(ControlNum)%CurrentPoint%X = 0.0d0
RootFinders(ControlNum)%CurrentPoint%Y = 0.0d0
RootFinders(ControlNum)%MinPoint%DefinedFlag = .FALSE.
RootFinders(ControlNum)%MaxPoint%DefinedFlag = .FALSE.
RootFinders(ControlNum)%LowerPoint%DefinedFlag = .FALSE.
RootFinders(ControlNum)%UpperPoint%DefinedFlag = .FALSE.
RETURN
END SUBROUTINE ResetController