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 SimCBVAV(SysNum,FirstHVACIteration, ZoneNum, ZoneNodeNum)
! SUBROUTINE INFORMATION:
! AUTHOR Richard Raustad
! DATE WRITTEN August 2006
! MODIFIED KHL/TH 10/2010: added maximum supply air temperature leaving reheat coil
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine simulates the VAV box with varying airflow in heating and cooling.
! Modified version of SimVAV.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataZoneEnergyDemands
USE DataHVACGlobals, ONLY: SmallLoad
!unused USE DataHeatBalFanSys, ONLY: Mat
USE WaterCoils, ONLY: SimulateWaterCoilComponents
USE HeatingCoils, ONLY: SimulateHeatingCoilComponents
USE SteamCoils, ONLY: SimulateSteamCoilComponents
USE DataDefineEquip, ONLY: AirDistUnit
!unused USE DataHeatBalFanSys, ONLY: ZoneThermostatSetPointHi, ZoneThermostatSetPointLo
USE PlantUtilities, ONLY: SetActuatedBranchFlowRate
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 ! Total Mass Flow Rate from Hot & Cold Inlets [kg/sec]
REAL(r64) :: QTotLoad ! Total load based on thermostat setpoint temperature [Watts]
REAL(r64) :: QZnReq ! Total load to be met by terminal heater [Watts]
REAL(r64) :: QToHeatSetPt ! Remaining load to heating setpoint [W]
REAL(r64) :: QSupplyAir ! Zone load met by VAVHeatandCool system
REAL(r64) :: CpAirZn ! Specific heat of zone air [J/kg-C]
REAL(r64) :: CpAirSysIn ! Specific heat of VAVHeatandCool box entering air [J/kg-C]
REAL(r64) :: DeltaTemp ! Temperature difference multiplied by specific heat [J/kg]
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) :: LeakLoadMult ! Load multiplier to adjust for downstream leaks
INTEGER :: ADUNum ! Index of air distribution unit for this terminal unit
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) :: DummyMdot
REAL(r64) :: QActualHeating
REAL(r64) :: MinFlowFrac ! minimum flow fraction (and minimum damper position)
REAL(r64) :: ZoneTemp = 0.0D0 ! zone air temperature [C]
REAL(r64) :: MaxHeatTemp = 0.0D0 ! maximum supply air temperature [C]
REAL(r64) :: MassFlowReq = 0.0D0 ! air mass flow rate required to meet the coil heating load [W]
REAL(r64) :: MassFlowActual = 0.0D0 ! air mass flow rate actually used [W]
REAL(r64) :: QZoneMax = 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
REAL(r64) :: QZoneMax3 = 0.0D0 ! temporary variable
! 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
MinMassAirFlow = MinFlowFrac * StdRhoAir * Sys(SysNum)%MaxAirVolFlowRate
ZoneTemp = Node(ZoneNodeNum)%Temp
!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(SysInlet(SysNum)%AirMassFlowRateMaxAvail .GT. 0.0D0) 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
!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)
Else
! System is Off set massflow to 0.0
MassFlow = 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
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(Sys(Sysnum)%AirMassFlowRateMax == 0.0D0) Then
Sys(Sysnum)%DamperPosition = 0.0D0
Else
Sys(Sysnum)%DamperPosition = MassFlow/Sys(Sysnum)%AirMassFlowRateMax
End If
!Need to make sure that the damper outlets are passed to the coil inlet
Call UpdateSys(SysNum)
QActualHeating = QToHeatSetPt - Massflow * CpAirZn * (SysInlet(SysNum)%AirTemp-ZoneTemp)
If( (MassFlow > SmallMassFlow) .AND. &
(QActualHeating > 0.0D0) .AND. (TempControlType(ZoneNum) .NE. SingleCoolingSetPoint) ) Then
! VAVHeatandCool boxes operate at varying mass flow rates when reheating, VAV boxes operate at min flow
! (MassFlow <= SysInlet(SysNum)%AirMassFlowRateMinAvail) .AND. &
! Per Fred Buhl, don't use DeadBandOrSetback to determine if heaters operate
! (.NOT. DeadBandOrSetback(ZoneNum))) 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
IF (Sys(SysNum)%MaxReheatTempSetByUser) THEN
MaxHeatTemp = Sys(SysNum)%MaxReheatTemp
IF (QToHeatSetPt > SmallLoad) THEN ! zone has a postive load to heating setpoint
MassFlowReq = QToHeatSetPt/(CpAirZn*(MaxHeatTemp - ZoneTemp))
ELSE
MassFlowReq = MassFlow
ENDIF
QZoneMax3 = CpAirZn * (MaxHeatTemp - ZoneTemp) * MassFlow
MassFlowActual = MassFlow
IF (QZoneMax3 < QToHeatSetPt) THEN
MassFlowActual = MassFlowReq
! QZoneMax3 = CpAirZn * (MaxHeatTemp - ZoneTemp) * MassFlowActual
END IF
IF (MassFlowActual <= MinMassAirFlow) THEN
MassFlowActual = MinMassAirFlow
ELSE IF (MassFlowActual >= Sys(Sysnum)%AirMassFlowRateMax) THEN
MassFlowActual = Sys(Sysnum)%AirMassFlowRateMax
END IF
QZoneMax = CpAirZn*MassFlowActual*(MaxHeatTemp - ZoneTemp)
! temporary variable
QZoneMax2 = MIN(QZoneMax,QToHeatSetPt)
MassFlow = MassFlowActual
END IF ! IF (Sys(SysNum)%MaxReheatTempSetByUser) THEN
SysOutlet(SysNum)%AirMassFlowRate = MassFlow
Call UpdateSys(SysNum)
SELECT CASE(Sys(SysNum)%ReheatComp_Num)
! 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 * Node(ZoneNodeNum)%Temp
IF(QZnReq .LT. SmallLoad)QZnReq = 0.0D0
! Initialize hot water flow rate to zero.
! Node(Sys(SysNum)%ReheatControlNode)%MassFlowRate = 0.0D0
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.
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. Sys(SysNum)%MaxReheatWaterFlow) THEN
CALL ControlCompOutput(CompName=Sys(SysNum)%ReheatName, &
CompType=Sys(SysNum)%ReheatComp, &
CompNum=Sys(SysNum)%ReheatComp_Index, &
FirstHVACIteration=FirstHVACIteration, &
QZnReq=QZoneMax2, &
ActuatedNode=Sys(SysNum)%OutletNodeNum, &
MaxFlow=SysInlet(SysNum)%AirMassFlowRateMaxAvail, &
MinFlow=SysInlet(SysNum)%AirMassFlowRateMinAvail, &
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.
MassFlow = Node(SysOutletNode)%MassFlowRate
SysOutlet(SysNum)%AirMassFlowRate = MassFlow
Call UpdateSys(SysNum)
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 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
MassFlow = MassFlow1(SysNum)
SysOutlet(SysNum)%AirMassFlowRate = MassFlow
Call UpdateSys(SysNum)
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
! recalculate damper position
If(Sys(Sysnum)%AirMassFlowRateMax == 0.0D0) Then
Sys(Sysnum)%DamperPosition = 0.0D0
Else
Sys(Sysnum)%DamperPosition = MassFlow/Sys(Sysnum)%AirMassFlowRateMax
End If
END IF
CASE(HCoilType_SteamAirHeating) ! ! COIL:STEAM:AIRHEATING
! Determine the load required to pass to the Component controller
QZnReq = QZoneMax2 - Massflow * CpAirZn * (SysInlet(SysNum)%AirTemp-ZoneTemp)
IF(QZnReq .LT. SmallLoad)QZnReq = 0.0D0
! 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
QSupplyAir = Massflow * CpAirZn * (SysInlet(SysNum)%AirTemp-ZoneTemp)
QZnReq = QZoneMax2 - QSupplyAir
IF(QZnReq .LT. SmallLoad)QZnReq = 0.0D0
! 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)
IF(QZnReq .LT. SmallLoad)QZnReq = 0.0D0
! Simulate reheat coil for the VAV system
CALL SimulateHeatingCoilComponents(CompName=Sys(SysNum)%ReheatName, &
CompIndex=Sys(SysNum)%ReheatComp_Index, &
FirstHVACIteration=FirstHVACIteration, &
QCoilReq=QZnReq)
CASE(HCoilType_None) ! blank
! If no reheat is defined then assume that the damper is the only component.
! If something else is there that is not a reheat coil then give the error message below.
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
! 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. )
!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 there that is not a reheat coil then give the error message
CASE DEFAULT
CALL ShowFatalError('Invalid Reheat Component='//TRIM(Sys(SysNum)%ReheatComp))
END SELECT
End IF
! push the flow rate history
MassFlow3(SysNum) = MassFlow2(SysNum)
MassFlow2(SysNum) = MassFlow1(SysNum)
MassFlow1(SysNum) = MassFlow
RETURN
END SUBROUTINE SimCBVAV