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 SimConstVol(SysNum,FirstHVACIteration, ZoneNum, ZoneNodeNum)
! SUBROUTINE INFORMATION:
! AUTHOR Richard J. Liesen
! DATE WRITTEN February 2000
! MODIFIED FB/KHL/TH 2/2011: added maximum supply air temperature leaving reheat coil
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine simulates the simple single duct constant volume systems.
! 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 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 ! [kg/sec] Total Mass Flow Rate from Hot & Cold Inlets
REAL(r64) :: QZnReq ! [Watts]
REAL(r64) :: QToHeatSetPt ! [W] remaining load to heating setpoint
REAL(r64) :: CpAir
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) :: TAirMax = 0.0D0 ! Maximum zone supply air temperature [C]
REAL(r64) :: QMax = 0.0D0 ! Maximum heat addition rate imposed by the max zone supply air temperature [W]
REAL(r64) :: ZoneTemp = 0.0D0 ! Zone temperature [C]
REAL(r64) :: QMax2 = 0.0D0
REAL(r64) :: DummyMdot ! local fluid mass flow rate
QToHeatSetPt=ZoneSysEnergyDemand(ZoneNum)%RemainingOutputReqToHeatSP ! The calculated load from the Heat Balance
MassFlow = SysInlet(SysNum)%AirMassFlowRateMaxAvail ! System massflow is set to the Available
QMax2 = QToHeatSetPt
ZoneTemp = Node(ZoneNodeNum)%Temp
CpAir = PsyCpAirFnWTdb(Node(ZoneNodeNum)%HumRat,ZoneTemp) ! zone air specific heat
IF (Sys(SysNum)%MaxReheatTempSetByUser) THEN
TAirMax = Sys(Sysnum)%MaxReheatTemp
QMax = CpAir*MassFlow*(TAirMax-ZoneTemp)
QMax2 = MIN(QToHeatSetPt,QMax)
END IF ! IF (Sys(SysNum)%MaxReheatTempSetByUser) THEN
If(((SysInlet(SysNum)%AirMassFlowRateMaxAvail == 0.0D0) .and. &
(SysInlet(SysNum)%AirMassFlowRateMinAvail == 0.0D0)) .or. &
(SysInlet(SysNum)%AirMassFlowRate == 0.0D0)) Then
! System is Off set massflow to 0.0
MassFlow = 0.0D0
End If
! 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
! make sure the inlet node flow rate is updated if the mass flow has been limited
SysOutlet(SysNum)%AirMassFlowRate = MassFlow
SysOutlet(SysNum)%AirMassFlowRateMaxAvail = SysInlet(SysNum)%AirMassFlowRateMaxAvail
SysOutlet(SysNum)%AirMassFlowRateMinAvail = SysInlet(SysNum)%AirMassFlowRateMinAvail
Call UpdateSys(SysNum)
QActualHeating = QToHeatSetPt - Massflow * CpAir * (SysInlet(SysNum)%AirTemp-ZoneTemp) ! reheat needed
!Now the massflow for reheating has been determined. If it is zero, or in SetBack, or the
! system scheduled OFF then not operational and shut the system down.
If((MassFlow > SmallMassFlow) .AND. (QActualHeating > 0.0D0) .AND. &
(TempControlType(ZoneNum) .NE. SingleCoolingSetPoint)) Then
SELECT CASE(Sys(SysNum)%ReheatComp_Num)
CASE(HCoilType_SimpleHeating) ! COIL:WATER:SIMPLEHEATING
! Determine the load required to pass to the Component controller
QZnReq = QMax2 + Massflow * CpAir * ZoneTemp
!Before Iterating through the Reheat Coil and Controller set the flags for the
! Do Loop to initialized conditions.
! 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.)
!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 reheat coil for the Const Volume system
! Set Converged to True & when controller is not converged it will set to False.
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=Sys(SysNum)%ReheatAirOutletNode, &
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)
CASE(HCoilType_SteamAirHeating) ! COIL:STEAM:STEAMAIRHEATING
! Determine the load required to pass to the Component controller
QZnReq = QMax2 - Massflow * CpAir * (SysInlet(SysNum)%AirTemp-ZoneTemp)
! Simulate reheat coil for the VAV system
CALL SimulateSteamCoilComponents(CompName=Sys(SysNum)%ReheatName, &
FirstHVACIteration=FirstHVACIteration, &
QCoilReq=QZnReq, &
CompIndex=Sys(SysNum)%ReheatComp_Index)
CASE(HCoilType_Electric) ! COIL:ELECTRIC:HEATING
! Determine the load required to pass to the Component controller
QZnReq = QMax2 - Massflow * CpAir * (SysInlet(SysNum)%AirTemp-ZoneTemp)
! Simulate reheat coil for the VAV system
CALL SimulateHeatingCoilComponents(CompName=Sys(SysNum)%ReheatName, &
FirstHVACIteration=FirstHVACIteration, &
QCoilReq=QZnReq, &
CompIndex=Sys(SysNum)%ReheatComp_Index)
CASE(HCoilType_Gas) ! COIL:GAS:HEATING
! Determine the load required to pass to the Component controller
QZnReq = QMax2 - Massflow * CpAir * (SysInlet(SysNum)%AirTemp-ZoneTemp)
! Simulate reheat coil for the VAV system
CALL SimulateHeatingCoilComponents(CompName=Sys(SysNum)%ReheatName, &
FirstHVACIteration=FirstHVACIteration, &
QCoilReq=QZnReq, &
CompIndex=Sys(SysNum)%ReheatComp_Index)
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 Const Volume 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 Const Volume 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 Const Volume system
CALL SimulateHeatingCoilComponents(CompName=Sys(SysNum)%ReheatName, &
FirstHVACIteration=FirstHVACIteration, &
QCoilReq=0.0d0, &
CompIndex=Sys(SysNum)%ReheatComp_Index)
CASE DEFAULT
CALL ShowFatalError('Invalid Reheat Component='//TRIM(Sys(SysNum)%ReheatComp))
END SELECT
End IF
!Debugging output for model
!If((HourofDay .ge. 8) .and. (hourofDay .lt. 15)) Then
! Write(OutputFileDebug,*) 'Day of Sim Hour of Day Time'
! Write(OutputFileDebug,*) DayofSim, HourOfDay, TimeStep*TimeStepZone
! Write(OutputFileDebug,10)
!
! Write(OutputFileDebug,20)ZoneNum, SysInlet(SysNum)%AirMassFlowRate, &
! SysInlet(SysNum)%AirMassFlowRate, &
! Temperature, Mat(ZoneNum), Node(ZoneNodeNum)%Temp, QTotLoad, &
! Enthalpy
!End If
!10 Format('ZoneNum SysHot SysCold Temp &
! & MAT NodeZoneTemp QTotLoad Enthalpy')
!
!20 Format(1x,I3,3x, 5(2x, F9.4), 2(2x, F9.2))
RETURN
END SUBROUTINE SimConstVol