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) | :: | CompName | |||
character(len=*), | intent(in) | :: | CompType | |||
integer, | intent(inout) | :: | CompNum | |||
logical, | intent(in) | :: | FirstHVACIteration | |||
real(kind=r64), | intent(in) | :: | QZnReq | |||
integer, | intent(in) | :: | ActuatedNode | |||
real(kind=r64), | intent(in) | :: | MaxFlow | |||
real(kind=r64), | intent(in) | :: | MinFlow | |||
integer, | intent(in), | optional | :: | TempInNode | ||
integer, | intent(in), | optional | :: | TempOutNode | ||
real(kind=r64), | intent(in) | :: | ControlOffset | |||
real(kind=r64), | intent(in), | optional | :: | AirMassFlow | ||
integer, | intent(in), | optional | :: | Action | ||
integer, | intent(inout) | :: | ControlCompTypeNum | |||
integer, | intent(inout) | :: | CompErrIndex | |||
integer, | intent(in), | optional | :: | EquipIndex | ||
integer, | intent(in), | optional | :: | LoopNum | ||
integer, | intent(in), | optional | :: | LoopSide | ||
integer, | intent(in), | optional | :: | BranchIndex | ||
integer, | intent(in), | optional | :: | ControlledZoneIndex |
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 ControlCompOutput(CompName,CompType,CompNum,FirstHVACIteration,QZnReq, &
ActuatedNode,MaxFlow,MinFlow,TempInNode,TempOutNode, &
ControlOffSet,AirMassFlow,Action,ControlCompTypeNum, &
CompErrIndex,EquipIndex,LoopNum, LoopSide, BranchIndex, &
ControlledZoneIndex)
! SUBROUTINE INFORMATION:
! AUTHOR Richard J. Liesen
! DATE WRITTEN April 2000
! MODIFIED Brent Griffith, Sept 2010 update plant interactions
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
!The purpose of this subroutine is to control the output of heating or cooling
!meet the zone load.
! METHODOLOGY EMPLOYED:
! Currently this is using an intervasl halving scheme to a control tolerance
! REFERENCES:
! na
! USE STATEMENTS:
USE DataPrecisionGlobals
USE DataLoopNode
USE DataGlobals, ONLY : WarmUpFlag
USE DataBranchAirLoopPlant, ONLY : MassFlowTolerance
USE DataInterfaces, ONLY : ShowWarningError,ShowFatalError,ShowContinueError,ShowContinueErrorTimeStamp, &
ShowRecurringWarningErrorAtEnd,ShowWarningMessage,ShowSevereError
USE InputProcessor, ONLY : FindItemInSortedList
USE WaterCoils, ONLY : SimulateWaterCoilComponents
USE FanCoilUnits, ONLY : Calc4PipeFanCoil
USE UnitVentilator, ONLY : CalcUnitVentilatorComponents
USE UnitHeater, ONLY : CalcUnitHeaterComponents
USE HWBaseboardRadiator, ONLY : CalcHWBaseboard
USE BaseboardRadiator, ONLY : SimHWConvective
USE Psychrometrics, ONLY : PsyCpAirFnWTdb
USE VentilatedSlab, ONLY : CalcVentilatedSlabComps
USE InputProcessor, ONLY : MakeUPPERCase
USE General, ONLY : TrimSigDigits, RoundSigDigits
USE SteamBaseboardRadiator, ONLY : CalcSteamBaseboard
USE OutdoorAirUnit, ONLY : CalcOAUnitCoilComps
USE PlantUtilities, ONLY : SetActuatedBranchFlowRate
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*), INTENT (IN) :: CompName ! the component Name
CHARACTER(len=*), INTENT (IN) :: CompType ! Type of component
INTEGER, INTENT (INOUT) :: CompNum ! Index of component in component array
LOGICAL, INTENT (IN) :: FirstHVACIteration ! flag for 1st HVAV iteration in the time step
REAL(r64), INTENT (IN) :: QZnReq ! zone load to be met
INTEGER, INTENT (IN) :: ActuatedNode ! node that controls unit output
REAL(r64), INTENT (IN) :: MaxFlow ! maximum water flow
REAL(r64), INTENT (IN) :: MinFlow ! minimum water flow
INTEGER, INTENT (IN), OPTIONAL :: TempInNode ! inlet node for output calculation
INTEGER, INTENT (IN), OPTIONAL :: TempOutNode ! outlet node for output calculation
REAL(r64), INTENT (IN) :: ControlOffset ! really the tolerance
REAL(r64), INTENT (IN), OPTIONAL :: AirMassFlow ! air mass flow rate
INTEGER, INTENT (IN), OPTIONAL :: Action ! 1=reverse; 2=normal
INTEGER, INTENT (INOUT) :: ControlCompTypeNum ! Internal type num for CompType
INTEGER, INTENT (INOUT) :: CompErrIndex ! for Recurring error call
INTEGER, INTENT (IN), OPTIONAL :: EquipIndex ! Identifier for equipment of Outdoor Air Unit "ONLY"
INTEGER, INTENT (IN), OPTIONAL :: LoopNum ! for plant components, plant loop index
INTEGER, INTENT (IN), OPTIONAL :: LoopSide ! for plant components, plant loop side index
INTEGER, INTENT (IN), OPTIONAL :: BranchIndex ! for plant components, plant branch index
INTEGER, INTENT (IN), OPTIONAL :: ControlledZoneIndex ! controlled zone index for the zone containing the component
! SUBROUTINE PARAMETER DEFINITIONS:
!Iteration maximum for reheat control
INTEGER, PARAMETER :: MaxIter =25
INTEGER, PARAMETER :: iReverseAction =1
INTEGER, PARAMETER :: iNormalAction =2
! Note - order in routine must match order below
! Plus -- order in ListOfComponents array must be in sorted order.
INTEGER, PARAMETER :: NumComponents=11
CHARACTER(len=*), DIMENSION(NumComponents), PARAMETER :: ListOfComponents=(/ &
'AIRTERMINAL:SINGLEDUCT:PARALLELPIU:REHEAT ', &
'AIRTERMINAL:SINGLEDUCT:SERIESPIU:REHEAT ', &
'COIL:HEATING:WATER ', &
'ZONEHVAC:BASEBOARD:CONVECTIVE:WATER ', &
'ZONEHVAC:BASEBOARD:RADIANTCONVECTIVE:STEAM', &
'ZONEHVAC:BASEBOARD:RADIANTCONVECTIVE:WATER', &
'ZONEHVAC:FOURPIPEFANCOIL ', &
'ZONEHVAC:OUTDOORAIRUNIT ', &
'ZONEHVAC:UNITHEATER ', &
'ZONEHVAC:UNITVENTILATOR ', &
'ZONEHVAC:VENTILATEDSLAB '/)
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
!Interval Half Type used for Controller
TYPE IntervalHalf
REAL(r64) ::MaxFlow
REAL(r64) ::MinFlow
REAL(r64) ::MaxResult
REAL(r64) ::MinResult
REAL(r64) ::MidFlow
REAL(r64) ::MidResult
Logical ::MaxFlowCalc
Logical ::MinFlowCalc
Logical ::MinFlowResult
Logical ::NormFlowCalc
END TYPE IntervalHalf
TYPE ZoneEquipControllerProps
REAL(r64) :: SetPoint ! Desired setpoint;
REAL(r64) :: MaxSetPoint ! The maximum setpoint; either user input or reset per time step by simulation
REAL(r64) :: MinSetPoint ! The minimum setpoint; either user input or reset per time step by simulation
REAL(r64) :: SensedValue ! The sensed control variable of any type
REAL(r64) :: CalculatedSetPoint ! The Calculated SetPoint or new control actuated value
END TYPE ZoneEquipControllerProps
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: Iter =0 ! Iteration limit for the interval halving process
REAL(r64) :: CpAir ! specific heat of air (J/kg-C)
LOGICAL :: Converged
REAL(r64) :: Denom ! the denominator of the control signal
REAL(r64) :: LoadMet ! Actual output of unit (watts)
!INTEGER, SAVE :: ErrCount=0 ! Number of times that the maximum iterations was exceeded
!INTEGER, SAVE :: ErrCount1=0 ! for recurring error
LOGICAL :: WaterCoilAirFlowControl ! True if controlling air flow through water coil, water flow fixed
INTEGER :: SimCompNum ! internal number for case statement
TYPE (IntervalHalf), SAVE :: ZoneInterHalf=IntervalHalf(0.0d0,0.0d0,0.0d0,0.0d0,0.0d0,0.0d0,.false.,.false.,.false.,.false.)
TYPE (ZoneEquipControllerProps), SAVE :: ZoneController=ZoneEquipControllerProps(0.0d0,0.0d0,0.0d0,0.0d0,0.0d0)
REAL(r64) :: HalvingPrec = 0.0d0 ! precision of halving algorithm
IF (ControlCompTypeNum /= 0) THEN
SimCompNum=ControlCompTypeNum
ELSE
SimCompNum=FindItemInSortedList(CompType,ListOfComponents,NumComponents)
ControlCompTypeNum=SimCompNum
ENDIF
Iter = 0
Converged = .False.
WaterCoilAirFlowControl = .FALSE.
LoadMet = 0.0d0
HalvingPrec = 0.0d0
!At the beginning of every time step the value is reset to the User Input
ZoneController%SetPoint = 0.0d0
!Set to converged controller
ZoneInterHalf%MaxFlowCalc = .True.
ZoneInterHalf%MinFlowCalc = .False.
ZoneInterHalf%NormFlowCalc = .False.
ZoneInterHalf%MinFlowResult = .False.
ZoneInterHalf%MaxResult = 1.0d0
ZoneInterHalf%MinResult = 0.0d0
!Start the Solution Iteration
Do While (.Not. Converged)
If(FirstHVACIteration) Then
Node(ActuatedNode)%MassFlowRateMaxAvail = MaxFlow
Node(ActuatedNode)%MassFlowRateMinAvail = MinFlow
!Check to make sure that the Minimum Flow rate is less than the max.
If(MinFlow .gt. MaxFlow)Then
CALL ShowSevereError('ControlCompOutput:'//TRIM(CompType)//':'//TRIM(CompName)// &
', Min Control Flow is > Max Control Flow')
CALL ShowContinueError('Acuated Node='//trim(NodeID(ActuatedNode))// &
' MinFlow=['//trim(TrimSigDigits(MinFlow,3))//'], Max Flow='//trim(TrimSigDigits(MaxFlow,3)))
CALL ShowContinueErrorTimeStamp(' ')
CALL ShowFatalError('Program terminates due to preceding condition.')
End If
End If ! End of FirstHVACIteration Conditional If
!The interface managers can reset the Max or Min to available values during the time step
! and these will then be the new setpoint limits for the controller to work within.
IF ( (SimCompNum ==3) .AND. ( .NOT. PRESENT(AirMassFlow)) ) THEN
ZoneController%MaxSetPoint = Node(ActuatedNode)%MassFlowRateMaxAvail
ZoneController%MinSetPoint = Node(ActuatedNode)%MassFlowRateMinAvail
ELSE
ZoneController%MaxSetPoint = MIN(Node(ActuatedNode)%MassFlowRateMaxAvail,Node(ActuatedNode)%MassFlowRateMax)
ZoneController%MinSetPoint = MAX(Node(ActuatedNode)%MassFlowRateMinAvail,Node(ActuatedNode)%MassFlowRateMin)
END IF
! The first time through run at maximum flow rate and find results
If(ZoneInterHalf%MaxFlowcalc) Then
ZoneController%CalculatedSetPoint = ZoneController%MaxSetPoint
ZoneInterHalf%MaxFlow = ZoneController%MaxSetPoint
ZoneInterHalf%MaxFlowcalc = .False.
ZoneInterHalf%MinFlowCalc = .True.
! Record the maximum flow rates and set the flow to the minimum and find results
Else If(ZoneInterHalf%MinFlowCalc) Then
ZoneInterHalf%MaxResult = ZoneController%SensedValue
ZoneController%CalculatedSetPoint = ZoneController%MinSetPoint
ZoneInterHalf%MinFlow = ZoneController%MinSetPoint
ZoneInterHalf%MinFlowCalc = .False.
ZoneInterHalf%MinFlowResult = .True.
!Record the minimum results and set flow to half way between the max and min and find results
Else If(ZoneInterHalf%MinFlowResult) Then
ZoneInterHalf%MinResult = ZoneController%SensedValue
HalvingPrec = (ZoneInterHalf%MaxResult-ZoneInterHalf%MinResult) * (1.0d0/REAL(2**(MaxIter-3)))
ZoneInterHalf%MidFlow = (ZoneInterHalf%MaxFlow + &
ZoneInterHalf%MinFlow)/2.0d0
ZoneController%CalculatedSetPoint = (ZoneInterHalf%MaxFlow + &
ZoneInterHalf%MinFlow)/2.0d0
ZoneInterHalf%MinFlowResult = .False.
ZoneInterHalf%NormFlowCalc = .True.
! Record the Mid results and check all possibilities and start interval halving procedure
Else If(ZoneInterHalf%NormFlowCalc) Then
ZoneInterHalf%MidResult = ZoneController%SensedValue
! First check to see if the component is running; if not converge and return
IF(ZoneInterHalf%MaxResult == ZoneInterHalf%MinResult) Then
!Set to converged controller
Converged = .True.
ZoneInterHalf%MaxFlowCalc = .True.
ZoneInterHalf%MinFlowCalc = .False.
ZoneInterHalf%NormFlowCalc = .False.
ZoneInterHalf%MinFlowResult = .False.
ZoneInterHalf%MaxResult = 1.0d0
ZoneInterHalf%MinResult = 0.0d0
SELECT CASE (SimCompNum)
CASE (4:6) !hot water baseboards use min flow
ZoneController%CalculatedSetPoint = 0.0d0 !CR7253
CASE Default
ZoneController%CalculatedSetPoint = ZoneInterHalf%MaxFlow !CR7253
END SELECT
!Set the Actuated node massflowrate with zero value
IF (PRESENT(LoopNum)) THEN ! this is a plant component
CALL SetActuatedBranchFlowRate(ZoneController%CalculatedSetPoint,ActuatedNode,LoopNum,LoopSide, BranchIndex, .FALSE.) !Objexx:OPTIONAL LoopSide, BranchIndex used without PRESENT check
ELSE ! assume not a plant component
Node(ActuatedNode)%MassFlowRate = ZoneController%CalculatedSetPoint
ENDIF
Return
End If
! The next series of checks is to determine what interval the current solution is in
! comparison to the setpoint and then respond appropriately.
! Normal controller assumes that MaxResult will be greater than MinResult. First check
! to make sure that this is the case
If(ZoneInterHalf%MaxResult .le. ZoneInterHalf%MinResult) Then
IF (WaterCoilAirFlowControl) THEN
ZoneController%CalculatedSetPoint = ZoneInterHalf%MaxFlow
ELSE
ZoneController%CalculatedSetPoint = ZoneInterHalf%MinFlow
END IF
!set to converged controller
Converged = .True.
ZoneInterHalf%MaxFlowCalc = .True.
ZoneInterHalf%MinFlowCalc = .False.
ZoneInterHalf%NormFlowCalc = .False.
ZoneInterHalf%MinFlowResult = .False.
ZoneInterHalf%MaxResult = 1.0d0
ZoneInterHalf%MinResult = 0.0d0
! MaxResult is greater than MinResult so simulation control algorithm may proceed normally
ElseIf(ZoneInterHalf%MaxResult .gt. ZoneInterHalf%MinResult) Then
!Now check to see if the setpoint is outside the endpoints of the control range
! First check to see if the water is too cold and if so set to the minimum flow.
If(ZoneController%SetPoint .le. ZoneInterHalf%MinResult) Then
ZoneController%CalculatedSetPoint = ZoneInterHalf%MinFlow
!Set to Converged Controller
Converged = .True.
ZoneInterHalf%MaxFlowCalc = .True.
ZoneInterHalf%MinFlowCalc = .False.
ZoneInterHalf%NormFlowCalc = .False.
ZoneInterHalf%MinFlowResult = .False.
ZoneInterHalf%MaxResult = 1.0d0
ZoneInterHalf%MinResult = 0.0d0
! Then check if too hot and if so set it to the maximum flow
Else If(ZoneController%SetPoint .ge. ZoneInterHalf%MaxResult) Then
ZoneController%CalculatedSetPoint = ZoneInterHalf%MaxFlow
!Set to Converged Controller
Converged = .True.
ZoneInterHalf%MaxFlowCalc = .True.
ZoneInterHalf%MinFlowCalc = .False.
ZoneInterHalf%NormFlowCalc = .False.
ZoneInterHalf%MinFlowResult = .False.
ZoneInterHalf%MaxResult = 1.0d0
ZoneInterHalf%MinResult = 0.0d0
! If between the max and mid set to new flow and raise min to mid
Else If((ZoneController%SetPoint .lt. ZoneInterHalf%MaxResult) .and. &
(ZoneController%SetPoint .ge. ZoneInterHalf%MidResult)) Then
ZoneController%CalculatedSetPoint = (ZoneInterHalf%MaxFlow + &
ZoneInterHalf%MidFlow)/2.0d0
ZoneInterHalf%MinFlow = ZoneInterHalf%MidFlow
ZoneInterHalf%MinResult = ZoneInterHalf%MidResult
ZoneInterHalf%MidFlow = (ZoneInterHalf%MaxFlow + &
ZoneInterHalf%MidFlow)/2.0d0
! If between the min and mid set to new flow and lower Max to mid
Else If((ZoneController%SetPoint .lt. ZoneInterHalf%MidResult) .and. &
(ZoneController%SetPoint .gt. ZoneInterHalf%MinResult)) Then
ZoneController%CalculatedSetPoint = (ZoneInterHalf%MinFlow + &
ZoneInterHalf%MidFlow)/2.0d0
ZoneInterHalf%MaxFlow = ZoneInterHalf%MidFlow
ZoneInterHalf%MaxResult = ZoneInterHalf%MidResult
ZoneInterHalf%MidFlow = (ZoneInterHalf%MinFlow + &
ZoneInterHalf%MidFlow)/2.0d0
End IF ! End of the Conditional for the actual interval halving scheme itself
EndIf ! end of max > min check
End If ! End of the Conditinal for the first 3 iterations for the interval halving
! Make sure that the Calculated setpoint falls between the minimum and maximum allowed
If(ZoneController%CalculatedSetPoint .gt. &
ZoneController%MaxSetPoint) Then
ZoneController%CalculatedSetPoint = ZoneController%MaxSetPoint
Converged = .True.
ZoneInterHalf%MaxFlowCalc = .True.
ZoneInterHalf%MinFlowCalc = .False.
ZoneInterHalf%NormFlowCalc = .False.
ZoneInterHalf%MinFlowResult = .False.
ZoneInterHalf%MaxResult = 1.0d0
ZoneInterHalf%MinResult = 0.0d0
Else If(ZoneController%CalculatedSetPoint .lt. &
ZoneController%MinSetPoint) Then
ZoneController%CalculatedSetPoint = ZoneController%MinSetPoint
Converged = .True.
ZoneInterHalf%MaxFlowCalc = .True.
ZoneInterHalf%MinFlowCalc = .False.
ZoneInterHalf%NormFlowCalc = .False.
ZoneInterHalf%MinFlowResult = .False.
ZoneInterHalf%MaxResult = 1.0d0
ZoneInterHalf%MinResult = 0.0d0
End IF
! check if hunting down around the limit of a significant mass flow in systems.
IF ((Iter > MaxIter/2) .AND. (ZoneController%CalculatedSetPoint < MassFlowTolerance) ) THEN
ZoneController%CalculatedSetPoint = ZoneController%MinSetPoint
Converged = .True.
ZoneInterHalf%MaxFlowCalc = .True.
ZoneInterHalf%MinFlowCalc = .False.
ZoneInterHalf%NormFlowCalc = .False.
ZoneInterHalf%MinFlowResult = .False.
ZoneInterHalf%MaxResult = 1.0d0
ZoneInterHalf%MinResult = 0.0d0
ENDIF
!Set the Actuated node massflowrate with the new value
IF (PRESENT(LoopNum)) THEN ! this is a plant component
CALL SetActuatedBranchFlowRate(ZoneController%CalculatedSetPoint,ActuatedNode,LoopNum,LoopSide, BranchIndex, .FALSE.) !Objexx:OPTIONAL LoopSide, BranchIndex used without PRESENT check
ELSE ! assume not a plant component, leave alone
Node(ActuatedNode)%MassFlowRate = ZoneController%CalculatedSetPoint
ENDIF
! The denominator of the control signal should be no less than 100 watts
Denom = SIGN( MAX( ABS(QZnReq), 100.d0), QZnReq)
IF (PRESENT(Action)) THEN
IF (Action .eq. iNormalAction) THEN
Denom = MAX(ABS(QZnReq),100.d0)
ELSE IF (Action .eq. iReverseAction) THEN
Denom = -MAX(ABS(QZnReq),100.d0)
ELSE
CALL ShowFatalError('ControlCompOutput: Illegal Action argument =['//trim(TrimSigDigits(Action))//']')
END IF
END IF
SELECT CASE(SimCompNum)
CASE(1) ! 'AIRTERMINAL:SINGLEDUCT:PARALLELPIU:REHEAT'
! simulate series piu reheat coil
CALL SimulateWaterCoilComponents(CompName,FirstHVACIteration,CompNum)
! Calculate the control signal (the variable we are forcing to zero)
CpAir = PsyCpAirFnWTdb(Node(TempOutNode)%HumRat,0.5d0*(Node(TempOutNode)%Temp + Node(TempInNode)%Temp)) !Objexx:OPTIONAL TempInNode, TempOutNode used without PRESENT check
LoadMet = CpAir*Node(TempOutNode)%MassFlowRate*(Node(TempOutNode)%Temp - Node(TempInNode)%Temp) !Objexx:OPTIONAL TempInNode, TempOutNode used without PRESENT check
ZoneController%SensedValue = (LoadMet - QZnReq) / Denom
CASE(2) ! 'AIRTERMINAL:SINGLEDUCT:SERIESPIU:REHEAT'
! simulate series piu reheat coil
CALL SimulateWaterCoilComponents(CompName,FirstHVACIteration,CompNum)
! Calculate the control signal (the variable we are forcing to zero)
CpAir = PsyCpAirFnWTdb(Node(TempOutNode)%HumRat,0.5d0*(Node(TempOutNode)%Temp + Node(TempInNode)%Temp)) !Objexx:OPTIONAL TempInNode, TempOutNode used without PRESENT check
LoadMet = CpAir*Node(TempOutNode)%MassFlowRate*(Node(TempOutNode)%Temp - Node(TempInNode)%Temp) !Objexx:OPTIONAL TempInNode, TempOutNode used without PRESENT check
ZoneController%SensedValue = (LoadMet - QZnReq) / Denom
CASE(3) ! 'COIL:HEATING:WATER'
! Simulate reheat coil for the VAV system
CALL SimulateWaterCoilComponents(CompName,FirstHVACIteration,CompNum)
! Calculate the control signal (the variable we are forcing to zero)
CpAir = PsyCpAirFnWTdb(Node(TempOutNode)%HumRat,Node(TempOutNode)%Temp)
IF (PRESENT(AirMassFlow)) THEN
LoadMet = AirMassflow * CpAir * Node(TempOutNode)%Temp
ZoneController%SensedValue = (LoadMet - QZnReq) / Denom
ELSE
WaterCoilAirFlowControl = .TRUE.
LoadMet = Node(TempOutNode)%MassFlowRate*CpAir*(Node(TempOutNode)%Temp - Node(TempInNode)%Temp) !Objexx:OPTIONAL TempInNode, TempOutNode used without PRESENT check
ZoneController%SensedValue = (LoadMet - QZnReq) / Denom
END IF
CASE(4) ! 'ZONEHVAC:BASEBOARD:CONVECTIVE:WATER'
! Simulate baseboard
CALL SimHWConvective(CompNum,LoadMet)
! Calculate the control signal (the variable we are forcing to zero)
ZoneController%SensedValue = (LoadMet - QZnReq) / Denom
CASE(5) ! 'ZONEHVAC:BASEBOARD:RADIANTCONVECTIVE:STEAM'
! Simulate baseboard
CALL CalcSteamBaseboard(CompNum, LoadMet)
! Calculate the control signal (the variable we are forcing to zero)
ZoneController%SensedValue = (LoadMet - QZnReq) / Denom
CASE(6) ! 'ZONEHVAC:BASEBOARD:RADIANTCONVECTIVE:WATER'
! Simulate baseboard
CALL CalcHWBaseboard(CompNum, LoadMet)
! Calculate the control signal (the variable we are forcing to zero)
ZoneController%SensedValue = (LoadMet - QZnReq) / Denom
CASE(7) ! 'ZONEHVAC:FOURPIPEFANCOIL'
! Simulate fancoil unit
CALL Calc4PipeFanCoil(CompNum,ControlledZoneIndex,FirstHVACIteration,LoadMet)
!Calculate the control signal (the variable we are forcing to zero)
ZoneController%SensedValue = (LoadMet - QZnReq) / Denom
CASE(8) !'ZONEHVAC:OUTDOORAIRUNIT'
! Simulate outdoor air unit components
CALL CalcOAUnitCoilComps(CompNum,FirstHVACIteration,EquipIndex,LoadMet) !Objexx:OPTIONAL EquipIndex used without PRESENT check
!Calculate the control signal (the variable we are forcing to zero)
ZoneController%SensedValue = (LoadMet - QZnReq) / Denom
CASE(9) ! 'ZONEHVAC:UNITHEATER'
! Simulate unit heater components
CALL CalcUnitHeaterComponents(CompNum,FirstHVACIteration,LoadMet)
!Calculate the control signal (the variable we are forcing to zero)
ZoneController%SensedValue = (LoadMet - QZnReq) / Denom
CASE(10) ! 'ZONEHVAC:UNITVENTILATOR'
! Simulate unit ventilator components
CALL CalcUnitVentilatorComponents(CompNum,FirstHVACIteration,LoadMet)
!Calculate the control signal (the variable we are forcing to zero)
ZoneController%SensedValue = (LoadMet - QZnReq) / Denom
CASE(11) ! 'ZONEHVAC:VENTILATEDSLAB'
! Simulate unit ventilator components
CALL CalcVentilatedSlabComps(CompNum,FirstHVACIteration,LoadMet)
!Calculate the control signal (the variable we are forcing to zero)
ZoneController%SensedValue = (LoadMet - QZnReq) / Denom
CASE DEFAULT
CALL ShowFatalError('ControlCompOutput: Illegal Component Number argument =['//trim(TrimSigDigits(SimCompNum))//']')
END SELECT
! Check for Controller convergence to see if within the offset
IF(ABS(ZoneController%SensedValue) .le. ControlOffset .or. ABS(ZoneController%SensedValue) .le. HalvingPrec) Then
!Set to converged controller
Converged = .True.
ZoneInterHalf%MaxFlowCalc = .True.
ZoneInterHalf%MinFlowCalc = .False.
ZoneInterHalf%NormFlowCalc = .False.
ZoneInterHalf%MinFlowResult = .False.
ZoneInterHalf%MaxResult = 1.0d0
ZoneInterHalf%MinResult = 0.0d0
Exit
End If
Iter = Iter + 1
IF ((Iter > MaxIter).AND.(.NOT.WarmUpFlag)) THEN
! IF (CompErrIndex == 0) THEN
CALL ShowWarningMessage ('ControlCompOutput: Maximum iterations exceeded for '//TRIM(CompType)//' = '//TRIM(CompName))
CALL ShowContinueError('... Load met = '//TRIM(TrimSigDigits(LoadMet,5))//' W.')
CALL ShowContinueError('... Load requested = '//TRIM(TrimSigDigits(QZnReq,5))//' W.')
CALL ShowContinueError('... Error = '//TRIM(TrimSigDigits(ABS((LoadMet-QZnReq)*100.d0/Denom),8))//' %.')
CALL ShowContinueError('... Tolerance = '//TRIM(TrimSigDigits(ControlOffset*100.d0,8))//' %.')
CALL ShowContinueError('... Error = (Load met - Load requested) / MAXIMUM(Load requested, 100)')
CALL ShowContinueError('... Actuated Node Mass Flow Rate =' &
//TRIM(RoundSigDigits(Node(ActuatedNode)%MassFlowRate, 9))//' kg/s')
CALL ShowContinueErrorTimeStamp(' ')
CALL ShowRecurringWarningErrorAtEnd('ControlCompOutput: Maximum iterations error for '//TRIM(CompType)// &
' = '//TRIM(CompName),CompErrIndex,ReportMaxOf=ABS((LoadMet-QZnReq)*100.d0/Denom),ReportMaxUnits='%', &
ReportMinOf=ABS((LoadMet-QZnReq)*100.d0/Denom),ReportMinUnits='%')
! ENDIF
CALL ShowRecurringWarningErrorAtEnd('ControlCompOutput: Maximum iterations error for '//TRIM(CompType)// &
' = '//TRIM(CompName),CompErrIndex,ReportMaxOf=ABS((LoadMet-QZnReq)*100.d0/Denom),ReportMaxUnits='%', &
ReportMinOf=ABS((LoadMet-QZnReq)*100.d0/Denom),ReportMinUnits='%')
EXIT ! It will not converge this time
ELSEIF (Iter > MaxIter*2) THEN
EXIT
END IF
End Do ! End of the Convergence Iteration
RETURN
END SUBROUTINE ControlCompOutput