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 | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | ControllerName | |||
integer, | intent(inout) | :: | ControllerIndex | |||
logical, | intent(in) | :: | FirstHVACIteration | |||
integer, | intent(in) | :: | AirLoopNum | |||
integer, | intent(in) | :: | AirLoopPass | |||
integer, | intent(in) | :: | Operation | |||
logical, | intent(out) | :: | IsConvergedFlag | |||
logical, | intent(inout) | :: | IsUpToDateFlag | |||
logical, | intent(out), | optional | :: | AllowWarmRestartFlag |
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 ManageControllers( &
ControllerName, ControllerIndex, &
FirstHVACIteration, AirLoopNum, AirLoopPass, &
Operation, IsConvergedFlag, IsUpToDateFlag, AllowWarmRestartFlag )
! SUBROUTINE INFORMATION:
! AUTHOR Richard Liesen
! DATE WRITTEN July 1998
! MODIFIED Dimitri Curtil, February 2006
! - Added air loop information
! - Added tracing to csv files
! - Added primitive operations to replace mixed
! bag of ResetController, FirstCallConvergenceTest, ...
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine manages Controller component simulation.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataSystemVariables
USE InputProcessor, ONLY: FindItemInList
USE General, ONLY: TrimSigDigits
USE DataPlant, ONLY: PlantLoop, FlowLocked
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(LEN=*), INTENT(IN) :: ControllerName
INTEGER, INTENT(INOUT) :: ControllerIndex
! TRUE if first full HVAC iteration in an HVAC time step
LOGICAL, INTENT(IN) :: FirstHVACIteration
! Current air loop num 1...NumPrimaryAirSys
INTEGER, INTENT(IN) :: AirLoopNum !unused1208
! Current pass counter in SimAirLoop()
INTEGER, INTENT(IN) :: AirLoopPass
! Operation to execute
INTEGER, INTENT(IN) :: Operation
! TRUE if controller is converged
LOGICAL, INTENT(OUT) :: IsConvergedFlag
! TRUE if air loop is up-to-date meaning that the current node values are consistent (air loop evaluated)
! Only used within the Calc routines
LOGICAL, INTENT(INOUT) :: IsUpToDateFlag
! TRUE if speculative warm restart is supported by this controller
LOGICAL, INTENT(OUT), OPTIONAL :: AllowWarmRestartFlag
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
! The Controller that you are currently loading input into
INTEGER :: ControlNum
INTEGER :: ControllerType
! FLOW:
! Obtains and Allocates Controller related parameters from input file
IF (GetControllerInputFlag) THEN !First time subroutine has been entered
CALL GetControllerInput
GetControllerInputFlag = .FALSE.
END IF
IF (ControllerIndex == 0) THEN
ControlNum = FindItemInList(ControllerName, ControllerProps%ControllerName, NumControllers)
IF (ControlNum == 0) THEN
CALL ShowFatalError( &
'ManageControllers: Invalid controller='//TRIM(ControllerName)// &
'. The only valid controller type'// &
' for an AirLoopHVAC is Controller:WaterCoil.' &
)
ENDIF
ControllerIndex = ControlNum
ELSE
ControlNum = ControllerIndex
IF (ControlNum > NumControllers .OR. ControlNum < 1) THEN
CALL ShowFatalError( &
'ManageControllers: Invalid ControllerIndex passed='// &
TRIM(TrimSigDigits(ControlNum))// &
', Number of controllers='//TRIM(TrimSigDigits(NumControllers))// &
', Controller name='//TRIM(ControllerName) &
)
ENDIF
IF (CheckEquipName(ControlNum)) THEN
IF (ControllerName /= ControllerProps(ControlNum)%ControllerName) THEN
CALL ShowFatalError( &
'ManageControllers: Invalid ControllerIndex passed='// &
TRIM(TrimSigDigits(ControlNum))// &
', Controller name='//TRIM(ControllerName)// &
', stored Controller Name for that index='// &
TRIM(ControllerProps(ControlNum)%ControllerName) &
)
ENDIF
CheckEquipName(ControlNum)=.false.
ENDIF
ENDIF
! Find the correct ControllerNumber with the AirLoop & CompNum from AirLoop Derived Type
!ControlNum = AirLoopEquip(AirLoopNum)%ComponentOfTypeNum(CompNum)
! detect if plant is locked and flow cannot change
IF (ControllerProps(ControlNum)%ActuatedNodePlantLoopNum > 0) THEN
IF (PlantLoop(ControllerProps(ControlNum)%ActuatedNodePlantLoopNum)% &
LoopSide(ControllerProps(ControlNum)%ActuatedNodePlantLoopSide)%Flowlock == FlowLocked) THEN
! plant is rigid so controller cannot change anything.
! Update the current Controller to the outlet nodes
CALL UpdateController(ControlNum)
IsConvergedFlag = .TRUE.
RETURN
ENDIF
ENDIF
! Detect if speculative warm restart is supported by this computer
IF ( PRESENT(AllowWarmRestartFlag) ) THEN
! NOTE: Never allow speculative warm restart with dual humidity ratio and temperature control
! because the actual setpoint depends on the current temperature and max hum ratio at
! the sensed node, and therefore might not be known until after one air loop simulation.
IF ( ControllerProps(ControlNum)%ControlVar == iTemperatureAndHumidityRatio ) THEN
AllowWarmRestartFlag = .FALSE.
ELSE
AllowWarmRestartFlag = .TRUE.
END IF
END IF
IF(ControllerProps(ControlNum)%InitFirstPass)THEN
! Coil must first be sized to:
! Initialize ControllerProps(ControlNum)%MinActuated and ControllerProps(ControlNum)%MaxActuated
CALL InitController(ControlNum, FirstHVACIteration, IsConvergedFlag)
ControllerProps(ControlNum)%InitFirstPass = .FALSE.
END IF
! Perform requested operation
! Note that InitController() is not called upon START/RESTART ops in order to avoid
! side-effects on the calculation of Node(ActuatedNode)%MassFlowRateMaxAvail used to
! determine ControllerProps(ControlNum)%MaxAvailActuated.
! Plant upgrades for V7 added init to these cases because MassFlowRateMaxAvail is better controlled
ControllerOp : SELECT CASE (Operation)
CASE (iControllerOpColdStart)
! If a iControllerOpColdStart call, reset the actuator inlet flows
CALL ResetController(ControlNum, FirstHVACIteration, .FALSE., IsConvergedFlag)
! CALL InitController(ControlNum, FirstHVACIteration, IsConvergedFlag)
! Update the current Controller to the outlet nodes
CALL UpdateController(ControlNum)
! Report the current Controller
CALL ReportController(ControlNum)
CASE (iControllerOpWarmRestart)
! If a iControllerOpWarmRestart call, set the actuator inlet flows to previous solution
CALL ResetController(ControlNum, FirstHVACIteration,.TRUE., IsConvergedFlag)
! CALL InitController(ControlNum, FirstHVACIteration, IsConvergedFlag)
! Update the current Controller to the outlet nodes
CALL UpdateController(ControlNum)
! Report the current Controller
CALL ReportController(ControlNum)
CASE (iControllerOpIterate)
! With the correct ControlNum Initialize all Controller related parameters
CALL InitController(ControlNum, FirstHVACIteration, IsConvergedFlag)
! No initialization needed: should have been done before
! Simulate the correct Controller with the current ControlNum
ControllerType = ControllerProps(ControlNum)%ControllerType_Num
ControllerCalc: SELECT CASE (ControllerType)
CASE (ControllerSimple_Type) ! 'Controller:WaterCoil'
CALL CalcSimpleController(ControlNum, FirstHVACIteration, IsConvergedFlag, IsUpToDateFlag, ControllerName)
CASE DEFAULT
CALL ShowFatalError( &
'Invalid controller type in ManageControllers='// &
TRIM(ControllerProps(ControlNum)%ControllerType) &
)
END SELECT ControllerCalc
! Update the current Controller to the outlet nodes
CALL UpdateController(ControlNum)
! Report the current Controller
CALL ReportController(ControlNum)
CASE (iControllerOpEnd)
! With the correct ControlNum Initialize all Controller related parameters
CALL InitController(ControlNum, FirstHVACIteration, IsConvergedFlag)
! No initialization needed: should have been done before
! Check convergence for the correct Controller with the current ControlNum
ControllerType = ControllerProps(ControlNum)%ControllerType_Num
ControllerCheck: SELECT CASE (ControllerType)
CASE (ControllerSimple_Type) ! 'Controller:WaterCoil'
CALL CheckSimpleController(ControlNum, IsConvergedFlag)
CALL SaveSimpleController(ControlNum, FirstHVACIteration, IsConvergedFlag)
CASE DEFAULT
CALL ShowFatalError( &
'Invalid controller type in ManageControllers='// &
TRIM(ControllerProps(ControlNum)%ControllerType) &
)
END SELECT ControllerCheck
! Report the current Controller
CALL ReportController(ControlNum)
CASE DEFAULT
CALL ShowFatalError( &
'ManageControllers: Invalid Operation passed='//TRIM(TrimSigDigits(Operation))// &
', Controller name='//TRIM(ControllerName) &
)
END SELECT ControllerOp
! Write detailed diagnostic for individual controller
!
! To enable generating an individual, detailed trace file for each controller on each air loop,
! define the environment variable TRACE_CONTROLLER=YES or TRACE_CONTROLLER=Y
IF ( TraceHVACControllerEnvFlag ) THEN
CALL TraceIndividualController( &
ControlNum, &
FirstHVACIteration, &
AirLoopPass, &
Operation, &
IsConvergedFlag )
END IF
RETURN
END SUBROUTINE ManageControllers