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) | :: | SysNum | |||
logical, | intent(in) | :: | FirstHVACIteration | |||
integer, | intent(in) | :: | ZoneNum | |||
integer, | intent(in) | :: | ZoneNodeNum |
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 SimVAV(SysNum,FirstHVACIteration, ZoneNum, ZoneNodeNum)
! SUBROUTINE INFORMATION:
! AUTHOR Richard J. Liesen
! DATE WRITTEN January 2000
! MODIFIED Fred Buhl: added reverse action damper heating action: August 2001
! KHL/TH 7/2010: revise to support dual max
! FB/KHL/TH 9/2010: added maximum supply air temperature leaving reheat coil
! TH 3/2012: added supply air flow adjustment based on zone maximum outdoor
! air fraction - a TRACE feature
! Brent Griffith, 5/2012, general cleanup, fix negatives CR 8767, fix phantom coil flows CR 8854
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine simulates the simple single duct volume VAV.
! METHODOLOGY EMPLOYED:
! There is method to this madness.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataZoneEnergyDemands
!unused USE DataHeatBalFanSys, ONLY: Mat
USE WaterCoils, ONLY:SimulateWaterCoilComponents
USE HeatingCoils, ONLY:SimulateHeatingCoilComponents
USE SteamCoils, ONLY: SimulateSteamCoilComponents
USE DataDefineEquip, ONLY: AirDistUnit
!unused USE DataAirLoop, ONLY: AirLoopControlInfo
USE PlantUtilities, ONLY: SetActuatedBranchFlowRate
USE DataHVACGlobals, ONLY: SmallLoad
USE DataAirflowNetwork, ONLY: SimulateAirflowNetwork,AirflowNetworkFanActivated,AirflowNetworkControlMultizone,VAVTerminalRatio
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: SysNum
INTEGER, INTENT(IN) :: ZoneNum
INTEGER, INTENT(IN) :: ZoneNodeNum
LOGICAL, INTENT(IN) :: FirstHVACIteration
! SUBROUTINE PARAMETER DEFINITIONS:
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: MassFlow ! [kg/sec] Total Mass Flow Rate from Hot & Cold Inlets
REAL(r64) :: QTotLoad ! [Watts] Remaining load required for this zone
REAL(r64) :: QZnReq ! [Watts] Load calculated for heating coil
REAL(r64) :: QToHeatSetPt ! [W] remaining load to heating setpoint
INTEGER :: ADUNum ! index of air distribution unit for this terminal unit
REAL(r64) :: CpAirZn
REAL(r64) :: CpAirSysIn
REAL(r64) :: DeltaTemp
INTEGER :: SysOutletNode ! The node number of the terminal unit outlet node
INTEGER :: SysInletNode ! the node number of the terminal unit inlet node
INTEGER :: WaterControlNode !This is the Actuated Reheat Control Node
REAL(r64) :: MaxFlowWater !This is the value passed to the Controller depending if FirstHVACIteration or not
REAL(r64) :: MinFlowWater !This is the value passed to the Controller depending if FirstHVACIteration or not
REAL(r64) :: QActualHeating ! the heating load seen by the reheat coil
REAL(r64) :: QHeatingDelivered ! the actual output from heating coil
REAL(r64) :: LeakLoadMult ! load multiplier to adjust for downstream leaks
REAL(r64) :: MinFlowFrac ! minimum flow fraction (and minimum damper position)
REAL(r64) :: MinAirMassFlowRevAct=0.0D0 ! minimum air mass flow rate used in "reverse action" air mass flow rate calculation
REAL(r64) :: MaxAirMassFlowRevAct=0.0D0 ! maximum air mass flow rate used in "reverse action" air mass flow rate calculation
REAL(r64) :: MassFlowBasedOnOA ! supply air mass flow rate based on zone OA requirements
REAL(r64) :: AirLoopOAFrac ! fraction of outside air entering air loop
REAL(r64) :: DummyMdot ! temporary mass flow rate argument
REAL(r64) :: ZoneTemp = 0.0D0 ! zone air temperature [C]
REAL(r64) :: MaxHeatTemp = 0.0D0 ! maximum supply air temperature [C]
REAL(r64) :: MaxDeviceAirMassFlowReheat = 0.0D0 ! air mass flow rate required to meet the coil heating load [W]
REAL(r64) :: MassFlowReqToLimitLeavingTemp = 0.0D0 ! air mass flow rate actually used [W]
REAL(r64) :: QZoneMaxRHTempLimit = 0.0D0 ! maximum zone heat addition rate given constraints of MaxHeatTemp and max
! available air mass flow rate [W]
REAL(r64) :: MinMassAirFlow = 0.0D0 ! the air flow rate during heating for normal acting damper
REAL(r64) :: QZoneMax2 = 0.0D0 ! temporary variable
! Note to the perplexed
!
! The SINGLE DUCT:VAV:REHEAT terminal unit originally contained 2 components: a damper
! and a reheat coil. The damper has become a virtual component - it consists only of
! an air inlet node and an air outlet node. The damper is upstream of the heating coil.
!
! Sys(SysNum)%InletNodeNum is the inlet node to the terminal unit and the damper
! Sys(SysNum)%OutletNodeNum is the outlet node of the damper and the inlet node of the heating coil
! Sys(SysNum)%ReheatAirOutletNode is the outlet node of the terminal unit and the heating coil
! The calculated load from the Heat Balance
ADUNum = Sys(SysNum)%ADUNum
LeakLoadMult = AirDistUnit(ADUNum)%LeakLoadMult
QTotLoad=ZoneSysEnergyDemand(ZoneNum)%RemainingOutputRequired * LeakLoadMult
QToHeatSetPt=ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToHeatSP * LeakLoadMult
SysOutletNode = Sys(SysNum)%ReheatAirOutletNode
SysInletNode = Sys(SysNum)%InletNodeNum
CpAirZn = PsyCpAirFnWTdb(Node(ZoneNodeNum)%HumRat,Node(ZoneNodeNum)%Temp)
MinFlowFrac = Sys(SysNum)%ZoneMinAirFrac
MassFlowBasedOnOA = 0.0d0
ZoneTemp = Node(ZoneNodeNum)%Temp
MinMassAirFlow = MinFlowFrac * StdRhoAir * Sys(SysNum)%MaxAirVolFlowRate
!Then depending on if the Load is for heating or cooling it is handled differently. First
! the massflow rate for cooling is determined to meet the entire load. Then
! if the massflow is below the minimum or greater than the Max it is set to either the Min
! or the Max as specified for the VAV model.
If( (QTotLoad < 0.0D0) .AND. (SysInlet(SysNum)%AirMassFlowRateMaxAvail > 0.0D0) .AND. &
(TempControlType(ZoneNum) .NE. SingleHeatingSetPoint) ) THEN
! Calculate the flow required for cooling
CpAirSysIn = PsyCpAirFnWTdb(SysInlet(SysNum)%AirHumRat,SysInlet(SysNum)%AirTemp)
DeltaTemp = CpAirSysIn*SysInlet(SysNum)%AirTemp - CpAirZn*ZoneTemp
!Need to check DeltaTemp and ensure that it is not zero
If (DeltaTemp .ne. 0.0D0) THEN
MassFlow= QTotLoad/DeltaTemp
ELSE
MassFlow = SysInlet(SysNum)%AirMassFlowRateMaxAvail
END IF
! Apply the zone maximum outdoor air fraction FOR VAV boxes - a TRACE feature
IF (ZoneSysEnergyDemand(ZoneNum)%SupplyAirAdjustFactor > 1.0D0) THEN
MassFlow = MassFlow * ZoneSysEnergyDemand(ZoneNum)%SupplyAirAdjustFactor
ENDIF
! calculate supply air flow rate based on user specified OA requirement
CALL CalcOAMassFlow(SysNum, MassFlowBasedOnOA, AirLoopOAFrac)
MassFlow = MAX(MassFlow, MassFlowBasedOnOA)
! used for normal acting damper
MinMassAirFlow = MAX(MinMassAirFlow, MassFlowBasedOnOA)
MinMassAirFlow = MAX(MinMassAirFlow,SysInlet(SysNum)%AirMassFlowRateMinAvail)
MinMassAirFlow = MIN(MinMassAirFlow,SysInlet(SysNum)%AirMassFlowRateMaxAvail)
! limit the OA based supply air flow rate based on optional user input
!Check to see if the flow is < the Min or > the Max air Fraction to the zone; then set to min or max
MassFlow = MAX(MassFlow,SysInlet(SysNum)%AirMassFlowRateMinAvail)
MassFlow = MIN(MassFlow,SysInlet(SysNum)%AirMassFlowRateMaxAvail)
If (SimulateAirflowNetwork .gt. AirflowNetworkControlMultizone .AND. AirflowNetworkFanActivated &
.AND. VAVTerminalRatio .GT. 0.0d0) then
MassFlow = MassFlow * VAVTerminalRatio
If (MassFlow .gt. Node(Sys(SysNum)%InletNodeNum)%MassFlowRate) Then
MassFlow = Node(Sys(SysNum)%InletNodeNum)%MassFlowRate
End If
End If
ELSE IF ((SysInlet(SysNum)%AirMassFlowRateMaxAvail > 0.0D0) .AND. (QTotLoad >= 0.0D0 .OR. &
TempControlType(ZoneNum) .EQ. SingleHeatingSetPoint) ) THEN
! IF (Sys(SysNum)%DamperHeatingAction .EQ. ReverseAction .AND. SysInlet(SysNum)%AirMassFlowRateMinAvail <= SmallMassFlow) THEN
! special case for heating: reverse action and damper allowed to close - set the minimum flow rate to a small but nonzero value
! MassFlow = 0.01d0*SysInlet(SysNum)%AirMassFlowRateMaxAvail
! ELSE
! usual case for heating: set the air mass flow rate to the minimum
MassFlow = SysInlet(SysNum)%AirMassFlowRateMinAvail
! END IF
! Apply the zone maximum outdoor air fraction for VAV boxes - a TRACE feature
IF (ZoneSysEnergyDemand(ZoneNum)%SupplyAirAdjustFactor > 1.0d0) THEN
MassFlow = MassFlow * ZoneSysEnergyDemand(ZoneNum)%SupplyAirAdjustFactor
ENDIF
! calculate supply air flow rate based on user specified OA requirement
CALL CalcOAMassFlow(SysNum, MassFlowBasedOnOA, AirLoopOAFrac)
MassFlow = MAX(MassFlow, MassFlowBasedOnOA)
!Check to see if the flow is < the Min or > the Max air Fraction to the zone; then set to min or max
IF(MassFlow <= SysInlet(SysNum)%AirMassFlowRateMinAvail) THEN
MassFlow = SysInlet(SysNum)%AirMassFlowRateMinAvail
ELSE IF (MassFlow >= SysInlet(SysNum)%AirMassFlowRateMaxAvail) THEN
MassFlow = SysInlet(SysNum)%AirMassFlowRateMaxAvail
END IF
! the AirflowNetwork model overrids the mass flow rate value
If (SimulateAirflowNetwork .gt. AirflowNetworkControlMultizone .AND. AirflowNetworkFanActivated &
.AND. VAVTerminalRatio .GT. 0.0d0) then
MassFlow = MassFlow * VAVTerminalRatio
If (MassFlow .gt. Node(Sys(SysNum)%InletNodeNum)%MassFlowRate) Then
MassFlow = Node(Sys(SysNum)%InletNodeNum)%MassFlowRate
End If
End If
ELSE
! System is Off set massflow to 0.0
MassFlow = 0.0D0
AirLoopOAFrac = 0.0D0
END IF
! look for bang-bang condition: flow rate oscillating between 2 values during the air loop / zone
! equipment iteration. If detected, set flow rate to previous value.
IF ( ( (ABS(MassFlow-MassFlow2(SysNum)) < MassFlowDiff(SysNum)) .OR. &
(ABS(MassFlow-MassFlow3(SysNum)) < MassFlowDiff(SysNum)) ) .AND. &
(ABS(MassFlow-MassFlow1(SysNum)) >= MassFlowDiff(SysNum)) ) THEN
IF (MassFlow > 0.0D0) MassFlow = MassFlow1(SysNum)
END IF
!Move data to the damper outlet node
SysOutlet(SysNum)%AirTemp = SysInlet(SysNum)%AirTemp
SysOutlet(SysNum)%AirHumRat = SysInlet(SysNum)%AirHumRat
SysOutlet(SysNum)%AirMassFlowRate = MassFlow
SysOutlet(SysNum)%AirMassFlowRateMaxAvail = SysInlet(SysNum)%AirMassFlowRateMaxAvail
SysOutlet(SysNum)%AirMassFlowRateMinAvail = SysInlet(SysNum)%AirMassFlowRateMinAvail
SysOutlet(SysNum)%AirEnthalpy = SysInlet(SysNum)%AirEnthalpy
! ! Calculate the Damper Position when there is a Max air flow specified.
! If (MassFlow == 0.0D0) THEN
! Sys(SysNum)%DamperPosition = 0.0D0
! ELSE IF (SysInlet(SysNum)%AirMassFlowRateMaxAvail > SysInlet(SysNum)%AirMassFlowRateMinAvail) THEN
! Sys(SysNum)%DamperPosition = ((MassFlow-SysInlet(SysNum)%AirMassFlowRateMinAvail) / &
! (SysInlet(SysNum)%AirMassFlowRateMaxAvail-SysInlet(SysNum)%AirMassFlowRateMinAvail)) * &
! (1.0d0-MinFlowFrac) + MinFlowFrac
! ELSE
! Sys(SysNum)%DamperPosition = 1.0D0
! END IF
IF (MassFlow == 0.0D0) THEN
Sys(SysNum)%DamperPosition = 0.0D0
ELSEIF ((MassFlow > 0.0D0) .AND. (MassFlow < Sys(SysNum)%AirMassFlowRateMax)) THEN
Sys(SysNum)%DamperPosition = MassFlow / Sys(SysNum)%AirMassFlowRateMax
ELSEIF (MassFlow == Sys(SysNum)%AirMassFlowRateMax) THEN
Sys(SysNum)%DamperPosition = 1.d0
ENDIF
!Need to make sure that the damper outlets are passed to the coil inlet
CALL UpdateSys(SysNum)
! At the current air mass flow rate, calculate heating coil load
QActualHeating = QToHeatSetPt - Massflow * CpAirZn * (SysInlet(SysNum)%AirTemp-ZoneTemp) ! reheat needed
! do the reheat calculation if there's some air nass flow (or the damper action is "reverse action"), the flow is <= minimum ,
! there's a heating requirement, and there's a thermostat with a heating setpoint
! Reverse damper option is working only for water coils for now.
IF((MassFlow > SmallMassFlow ) .AND. &
(QActualHeating > 0.0D0) .AND. (TempControlType(ZoneNum) .NE. SingleCoolingSetPoint) ) THEN
! At this point we know that there is a heating requirement: i.e., the heating coil needs to
! be activated (there's a zone heating load or there's a reheat requirement). There are 3 possible
! situations: 1) the coil load can be met by variable temperature air (below the max heat temp) at
! the minimum air mass flow rate; 2) the coil load can be met by variable air flow rate with the air
! temperature fixed at the max heat temp; 3) the load cannot be met (we will run at max air temp and
! max air flow rate). We check for condition 2 by assuming the air temperatute is at the max heat temp
! and solving for the air mass flow rate that will meet the load. If the flow rate is between the min and
! max we are in condition 2.
QZoneMax2 = QToHeatSetPt
! fill dual-max reheat flow limit, if any
IF (Sys(SysNum)%DamperHeatingAction .EQ. ReverseAction) THEN
IF (Sys(SysNum)%AirMassFlowDuringReheatMax > 0.0D0 ) THEN
MaxDeviceAirMassFlowReheat = Sys(SysNum)%AirMassFlowDuringReheatMax
ELSE
MaxDeviceAirMassFlowReheat = Sys(SysNum)%AirMassFlowRateMax
END IF
ELSE
MaxDeviceAirMassFlowReheat = Sys(SysNum)%AirMassFlowRateMax
END IF
! determine flow based on leaving reheat temperature limit
IF (Sys(SysNum)%MaxReheatTempSetByUser) THEN
MaxHeatTemp = Sys(SysNum)%MaxReheatTemp
IF (QToHeatSetPt > SmallLoad) THEN ! zone has a postive load to heating setpoint
MassFlowReqToLimitLeavingTemp = QToHeatSetPt/(CpAirZn*(MaxHeatTemp - ZoneTemp))
ELSE
MassFlowReqToLimitLeavingTemp = 0.0D0
ENDIF
ENDIF
! (re)apply limits to find air mass flow
MassFlow = MAX(MassFlow, MassFlowReqToLimitLeavingTemp)
MassFlow = MIN(MassFlow, MaxDeviceAirMassFlowReheat)
MassFlow = MAX(MassFlow, MassFlowBasedOnOA)
MassFlow = MIN(MassFlow, SysInlet(SysNum)%AirMassFlowRateMaxAvail)
MassFlow = MAX(MassFlow, SysInlet(SysNum)%AirMassFlowRateMinAvail)
If (SimulateAirflowNetwork .gt. AirflowNetworkControlMultizone .AND. AirflowNetworkFanActivated &
.AND. VAVTerminalRatio .GT. 0.0d0) then
MassFlow = MassFlow * VAVTerminalRatio
If (MassFlow .gt. Node(Sys(SysNum)%InletNodeNum)%MassFlowRate) Then
MassFlow = Node(Sys(SysNum)%InletNodeNum)%MassFlowRate
End If
End If
! now make any corrections to heating coil loads
IF (Sys(SysNum)%MaxReheatTempSetByUser) THEN
QZoneMaxRHTempLimit = CpAirZn*MassFlow*(MaxHeatTemp - ZoneTemp)
QZoneMax2 = MIN(QZoneMaxRHTempLimit,QToHeatSetPt)
ENDIF
SysOutlet(SysNum)%AirMassFlowRate = MassFlow
CALL UpdateSys(SysNum)
! Now do the heating coil calculation for each heating coil type
SELECT CASE(Sys(SysNum)%ReheatComp_Num) ! Reverse damper option is working only for water coils for now.
! hot water heating coil
CASE(HCoilType_SimpleHeating) ! COIL:WATER:SIMPLEHEATING
! Determine the load required to pass to the Component controller
! Although this equation looks strange (using temp instead of deltaT), it is corrected later in ControlCompOutput
! and is working as-is, temperature setpoints are maintained as expected.
QZnReq = QZoneMax2 + MassFlow*CpAirZn*ZoneTemp
! Initialize hot water flow rate to zero.
DummyMdot = 0.0D0
CALL SetActuatedBranchFlowRate(DummyMdot,Sys(SysNum)%ReheatControlNode, &
Sys(SysNum)%HWLoopNum,Sys(SysNum)%HWLoopSide, Sys(SysNum)%HWBranchIndex, .TRUE. )
!On the first HVAC iteration the system values are given to the controller, but after that
! the demand limits are in place and there needs to be feedback to the Zone Equipment
IF (FirstHVACIteration) THEN
MaxFlowWater = Sys(SysNum)%MaxReheatWaterFlow
MinFlowWater = Sys(SysNum)%MinReheatWaterFlow
ELSE
WaterControlNode = Sys(SysNum)%ReheatControlNode
MaxFlowWater = Node(WaterControlNode)%MassFlowRateMaxAvail
MinFlowWater = Node(WaterControlNode)%MassFlowRateMinAvail
ENDIF
! Simulate the reheat coil at constant air flow. Control by varying the
! hot water flow rate.
!FB use QActualHeating, change ControlCompOutput to use new
CALL ControlCompOutput(CompName=Sys(SysNum)%ReheatName, &
CompType=Sys(SysNum)%ReheatComp, &
CompNum=Sys(SysNum)%ReheatComp_Index, &
FirstHVACIteration=FirstHVACIteration, &
QZnReq=QZnReq, &
ActuatedNode=Sys(SysNum)%ReheatControlNode, &
MaxFlow=MaxFlowWater, &
MinFlow=MinFlowWater, &
TempOutNode=SysOutletNode, &
ControlOffSet=Sys(SysNum)%ControllerOffset, &
AirMassFlow=Massflow, &
ControlCompTypeNum=Sys(SysNum)%ControlCompTypeNum, &
CompErrIndex=Sys(SysNum)%CompErrIndex, &
LoopNum = Sys(SysNum)%HWLoopNum, &
LoopSide = Sys(SysNum)%HWLoopSide, &
BranchIndex = Sys(SysNum)%HWBranchIndex)
! If reverse action damper and the hot water flow is at maximum, simulate the
! hot water coil with fixed (maximum) hot water flow but allow the air flow to
! vary up to the maximum (air damper opens to try to meet zone load)
IF (Sys(SysNum)%DamperHeatingAction .EQ. ReverseAction) THEN
IF (Node(Sys(SysNum)%ReheatControlNode)%MassFlowRate .EQ. MaxFlowWater) THEN
! fill limits for air flow for controller
MinAirMassFlowRevAct = Sys(SysNum)%AirMassFlowRateMax * Sys(SysNum)%ZoneMinAirFrac
MinAirMassFlowRevAct = MIN(MinAirMassFlowRevAct, SysInlet(SysNum)%AirMassFlowRateMaxAvail)
MinAirMassFlowRevAct = MAX(MinAirMassFlowRevAct, SysInlet(SysNum)%AirMassFlowRateMinAvail)
MaxAirMassFlowRevAct = Sys(SysNum)%AirMassFlowRateMax
MaxAirMassFlowRevAct = MIN(MaxAirMassFlowRevAct,MaxDeviceAirMassFlowReheat)
MaxAirMassFlowRevAct = MAX(MaxAirMassFlowRevAct, MinAirMassFlowRevAct)
MaxAirMassFlowRevAct = MIN(MaxAirMassFlowRevAct, SysInlet(SysNum)%AirMassFlowRateMaxAvail)
Node(Sys(SysNum)%OutletNodeNum)%MassFlowRateMaxAvail = MaxAirMassFlowRevAct ! suspect, check how/if used in ControlCompOutput
CALL ControlCompOutput(CompName=Sys(SysNum)%ReheatName, &
CompType=Sys(SysNum)%ReheatComp, &
CompNum=Sys(SysNum)%ReheatComp_Index, &
FirstHVACIteration=FirstHVACIteration, &
QZnReq= QZoneMax2 , & ! why not QZnReq ?
ActuatedNode=Sys(SysNum)%OutletNodeNum, &
MaxFlow=MaxAirMassFlowRevAct, &
MinFlow=MinAirMassFlowRevAct, &
TempOutNode=SysOutletNode, &
TempInNode=ZoneNodeNum, &
ControlOffSet=Sys(SysNum)%ControllerOffset, &
ControlCompTypeNum=Sys(SysNum)%ControlCompTypeNum, &
CompErrIndex=Sys(SysNum)%CompErrIndex )
! air flow controller, not on plant, don't pass plant topology info
! reset terminal unit inlet air mass flow to new value.
Node(Sys(SysNum)%OutletNodeNum)%MassFlowRateMaxAvail = SysInlet(SysNum)%AirMassFlowRateMaxAvail
MassFlow = Node(SysOutletNode)%MassFlowRate
! ! look for bang-bang condition: flow rate oscillating between 2 values during the air loop / zone
! ! equipment iteration. If detected, set flow rate to previous value and recalc HW flow.
IF ( ( (ABS(MassFlow-MassFlow2(SysNum)) < MassFlowDiff(SysNum)) .OR. &
(ABS(MassFlow-MassFlow3(SysNum)) < MassFlowDiff(SysNum)) ) .AND. &
(ABS(MassFlow-MassFlow1(SysNum)) >= MassFlowDiff(SysNum)) ) THEN
IF (MassFlow > 0.0D0) MassFlow = MassFlow1(SysNum)
SysOutlet(SysNum)%AirMassFlowRate = MassFlow
CALL UpdateSys(SysNum)
! Although this equation looks strange (using temp instead of deltaT), it is corrected later in ControlCompOutput
! and is working as-is, temperature setpoints are maintained as expected.
QZnReq = QZoneMax2 + MassFlow*CpAirZn*ZoneTemp
CALL ControlCompOutput(CompName=Sys(SysNum)%ReheatName, &
CompType=Sys(SysNum)%ReheatComp, &
CompNum=Sys(SysNum)%ReheatComp_Index, &
FirstHVACIteration=FirstHVACIteration, &
QZnReq=QZnReq, &
ActuatedNode=Sys(SysNum)%ReheatControlNode, &
MaxFlow=MaxFlowWater, &
MinFlow=MinFlowWater, &
TempOutNode=SysOutletNode, &
ControlOffSet=Sys(SysNum)%ControllerOffset, &
AirMassFlow=Massflow, &
ControlCompTypeNum=Sys(SysNum)%ControlCompTypeNum, &
CompErrIndex=Sys(SysNum)%CompErrIndex, &
LoopNum = Sys(SysNum)%HWLoopNum, &
LoopSide = Sys(SysNum)%HWLoopSide, &
BranchIndex = Sys(SysNum)%HWBranchIndex)
END IF
SysOutlet(SysNum)%AirMassFlowRate = MassFlow
! reset OA report variable
CALL UpdateSys(SysNum)
END IF ! IF (Node(Sys(SysNum)%ReheatControlNode)%MassFlowRate .EQ. MaxFlowWater) THEN
END IF ! IF (Sys(SysNum)%DamperHeatingAction .EQ. ReverseAction) THEN
! Recalculate the Damper Position.
IF (MassFlow == 0.0D0) THEN
Sys(SysNum)%DamperPosition = 0.0D0
ELSEIF ((MassFlow > 0.0D0) .AND. (MassFlow < Sys(SysNum)%AirMassFlowRateMax)) THEN
Sys(SysNum)%DamperPosition = MassFlow / Sys(SysNum)%AirMassFlowRateMax
ELSEIF (MassFlow == Sys(SysNum)%AirMassFlowRateMax) THEN
Sys(SysNum)%DamperPosition = 1.d0
ENDIF
CASE(HCoilType_SteamAirHeating) ! ! COIL:STEAM:AIRHEATING
! Determine the load required to pass to the Component controller
QZnReq = QZoneMax2 - Massflow * CpAirZn * (SysInlet(SysNum)%AirTemp - ZoneTemp)
! Simulate reheat coil for the VAV system
CALL SimulateSteamCoilComponents (CompName=Sys(SysNum)%ReheatName, &
CompIndex=Sys(SysNum)%ReheatComp_Index, &
FirstHVACIteration=FirstHVACIteration, &
QCoilReq=QZnReq)
CASE(HCoilType_Electric) ! COIL:ELECTRIC:HEATING
! Determine the load required to pass to the Component controller
QZnReq = QZoneMax2 - Massflow * CpAirZn * (SysInlet(SysNum)%AirTemp - ZoneTemp)
! Simulate reheat coil for the VAV system
CALL SimulateHeatingCoilComponents(CompName=Sys(SysNum)%ReheatName, &
CompIndex=Sys(SysNum)%ReheatComp_Index, &
FirstHVACIteration=FirstHVACIteration, &
QCoilReq=QZnReq)
CASE(HCoilType_Gas) ! COIL:GAS:HEATING
! Determine the load required to pass to the Component controller
QZnReq = QZoneMax2 - Massflow * CpAirZn * (SysInlet(SysNum)%AirTemp - ZoneTemp)
! Simulate reheat coil for the VAV system
CALL SimulateHeatingCoilComponents(CompName=Sys(SysNum)%ReheatName, &
CompIndex=Sys(SysNum)%ReheatComp_Index, &
FirstHVACIteration=FirstHVACIteration, &
QCoilReq=QZnReq,QCoilActual=QHeatingDelivered)
CASE(HCoilType_None) ! blank
! I no reheat is defined then assume that the damper is the only component.
! If something else is there that is not a reheat coil or a blank then give the error message
CASE DEFAULT
CALL ShowFatalError('Invalid Reheat Component='//TRIM(Sys(SysNum)%ReheatComp))
END SELECT
!the COIL is OFF the properties are calculated for this special case.
ELSE
SELECT CASE(Sys(SysNum)%ReheatComp_Num)
CASE(HCoilType_SimpleHeating) ! COIL:WATER:SIMPLEHEATING
! Simulate reheat coil for the Const Volume system
! Node(Sys(SysNum)%ReheatControlNode)%MassFlowRate = 0.0D0 !DSU
DummyMdot = 0.0D0
CALL SetActuatedBranchFlowRate(DummyMdot,Sys(SysNum)%ReheatControlNode, &
Sys(SysNum)%HWLoopNum,Sys(SysNum)%HWLoopSide, Sys(SysNum)%HWBranchIndex, .TRUE. )
!call the reheat coil with the NO FLOW condition to make sure that the Node values
! are passed through to the coil outlet correctly
CALL SimulateWaterCoilComponents(Sys(SysNum)%ReheatName,FirstHVACIteration, &
CompIndex=Sys(SysNum)%ReheatComp_Index)
CASE(HCoilType_SteamAirHeating) ! COIL:STEAM:AIRHEATING
! Simulate reheat coil for the VAV system
CALL SimulateSteamCoilComponents(CompName=Sys(SysNum)%ReheatName, &
FirstHVACIteration=FirstHVACIteration, &
QCoilReq=0.0d0, &
CompIndex=Sys(SysNum)%ReheatComp_Index)
CASE(HCoilType_Electric) ! COIL:ELECTRIC:HEATING
! Simulate reheat coil for the VAV system
CALL SimulateHeatingCoilComponents(CompName=Sys(SysNum)%ReheatName, &
FirstHVACIteration=FirstHVACIteration, &
QCoilReq=0.0d0, &
CompIndex=Sys(SysNum)%ReheatComp_Index)
CASE(HCoilType_Gas) ! COIL:GAS:HEATING
! Simulate reheat coil for the VAV system
CALL SimulateHeatingCoilComponents(CompName=Sys(SysNum)%ReheatName, &
FirstHVACIteration=FirstHVACIteration, &
QCoilReq=0.0d0, &
CompIndex=Sys(SysNum)%ReheatComp_Index)
CASE(HCoilType_None) ! blank
! If no reheat is defined then assume that the damper is the only component.
! If something else is that is not a reheat coil or a blank then give the error message
CASE DEFAULT
CALL ShowFatalError('Invalid Reheat Component='//TRIM(Sys(SysNum)%ReheatComp))
END SELECT
END IF
! set OA report variable
Sys(SysNum)%OutdoorAirFlowRate = (MassFlow/StdRhoAir) * AirLoopOAFrac
! push the flow rate history
MassFlow3(SysNum) = MassFlow2(SysNum)
MassFlow2(SysNum) = MassFlow1(SysNum)
MassFlow1(SysNum) = MassFlow
RETURN
END SUBROUTINE SimVAV