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.
!PH/WFB/LKL (UCDV model) MassFlowRate = SysOutputProvided / (CpAir*DeltaTemp)
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 SizeZoneEquipment
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN December 2000
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Performs the zone sizing calculations and fills the zone sizing
! data arrays with the results of the calculation.
! METHODOLOGY EMPLOYED:
! Using the input from Zone Sizing objects and the Zone Equipment input,
! for each controlled zone this subroutine performs a "purchased air" calculation
! and saves the results in the zone sizing data arrays.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataHeatBalFanSys, ONLY: NonAirSystemResponse, SysDepZoneLoads, TempZoneThermostatSetPoint
USE DataZoneEnergyDemands, ONLY: ZoneSysEnergyDemand, DeadBandOrSetback
USE DataLoopNode, ONLY: Node
USE DataHVACGlobals, ONLY: SmallLoad, SmallTempDiff
USE General, ONLY: RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL,SAVE :: MyOneTimeFlag = .TRUE.
INTEGER :: ControlledZoneNum ! controlled zone index
INTEGER :: ActualZoneNum ! index into Zone array (all zones)
INTEGER :: SupplyAirNode ! node number of zone supply air node
INTEGER :: ZoneNode ! node number of controlled zone
INTEGER :: ReturnNode ! node number of controlled zone return node
REAL(r64) :: DeltaTemp ! difference between supply air temp and zone temp [C]
REAL(r64) :: CpAir ! heat capacity of air [J/kg-C]
REAL(r64) :: SysOutputProvided ! system sensible output [W]
REAL(r64) :: LatOutputProvided ! system latent output [kg/s]
REAL(r64) :: Temp ! inlet temperature [C]
REAL(r64) :: HumRat ! inlet humidity ratio [kg water/kg dry air]
REAL(r64) :: Enthalpy ! inlet specific enthalpy [J/kg]
REAL(r64) :: MassFlowRate ! inlet mass flow rate [kg/s]
REAL(r64) :: RetTemp ! zone return temperature [C]
IF (MyOneTimeFlag) THEN
CALL SetUpZoneSizingArrays
MyOneTimeFlag = .FALSE.
END IF
DO ControlledZoneNum = 1, NumOfZones
IF (.not. ZoneEquipConfig(ControlledZoneNum)%IsControlled) CYCLE
ActualZoneNum = CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%ActualZoneNum
NonAirSystemResponse(ActualZoneNum) = 0.0d0
SysDepZoneLoads(ActualZoneNum) = 0.0d0
CALL InitSystemOutputRequired(ActualZoneNum, SysOutputProvided, LatOutputProvided)
SupplyAirNode = CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%SupplyAirNode
ZoneNode = ZoneEquipConfig(ControlledZoneNum)%ZoneNode
! Sign convention: SysOutputProvided <0 Supply air is heated on entering zone (zone is cooled)
! SysOutputProvided >0 Supply air is cooled on entering zone (zone is heated)
IF ( .NOT. DeadBandOrSetback(ActualZoneNum) .AND. &
ABS(ZoneSysEnergyDemand(ActualZoneNum)%RemainingOutputRequired) .GT. SmallLoad) THEN
! Determine design supply air temperture and design supply air temperature difference
IF (ZoneSysEnergyDemand(ActualZoneNum)%RemainingOutputRequired < 0.0d0) THEN ! Cooling case
! If the user specify the design cooling supply air temperature, then
IF (CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%ZnCoolDgnSAMethod == SupplyAirTemperature) THEN
Temp = CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%CoolDesTemp
HumRat = CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%CoolDesHumRat
DeltaTemp = Temp - Node(ZoneNode)%Temp
! If the user specify the design cooling supply air temperature difference, then
ELSE
DeltaTemp = -ABS(CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%CoolDesTempDiff)
Temp = DeltaTemp + Node(ZoneNode)%Temp
HumRat = CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%CoolDesHumRat
END IF
ELSE ! Heating Case
! If the user specify the design heating supply air temperature, then
IF (CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%ZnHeatDgnSAMethod == SupplyAirTemperature) THEN
Temp = CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%HeatDesTemp
HumRat = CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%HeatDesHumRat
DeltaTemp = Temp - Node(ZoneNode)%Temp
! If the user specify the design heating supply air temperature difference, then
ELSE
DeltaTemp = ABS(CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%HeatDesTempDiff)
Temp = DeltaTemp + Node(ZoneNode)%Temp
HumRat = CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%HeatDesHumRat
END IF
END IF
Enthalpy = PsyHFnTdbW(Temp,HumRat)
SysOutputProvided = ZoneSysEnergyDemand(ActualZoneNum)%RemainingOutputRequired
CpAir = PsyCpAirFnWTdb(HumRat,Temp)
IF ( ABS(DeltaTemp) > SmallTempDiff ) THEN
!!!PH/WFB/LKL (UCDV model) MassFlowRate = SysOutputProvided / (CpAir*DeltaTemp)
MassFlowRate = MAX( SysOutputProvided/(CpAir*DeltaTemp), 0.0d0)
ELSE
MassFlowRate = 0.0d0
ENDIF
IF (CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%SupplyAirAdjustFactor > 1.0d0) THEN
MassFlowRate = MassFlowRate * CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%SupplyAirAdjustFactor
ENDIF
ELSE
Temp = Node(ZoneNode)%Temp
HumRat = Node(ZoneNode)%HumRat
Enthalpy = Node(ZoneNode)%Enthalpy
MassFlowRate = 0.0d0
END IF
CALL UpdateSystemOutputRequired(ActualZoneNum, SysOutputProvided, LatOutputProvided)
IF (SysOutputProvided > 0.0d0) THEN
CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%HeatLoad = SysOutputProvided
CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%HeatMassFlow = MassFlowRate
CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%HeatZoneTemp = Node(ZoneNode)%Temp
CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%HeatZoneHumRat = Node(ZoneNode)%HumRat
CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%HeatOutTemp = OutDryBulbTemp
CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%HeatOutHumRat = OutHumRat
CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%CoolLoad = 0.0d0
CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%CoolMassFlow = 0.0d0
CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%CoolZoneTemp = 0.0d0
CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%CoolZoneHumRat = 0.0d0
ELSE
CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%CoolLoad = -SysOutputProvided
CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%CoolMassFlow = MassFlowRate
CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%CoolZoneTemp = Node(ZoneNode)%Temp
CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%CoolZoneHumRat = Node(ZoneNode)%HumRat
CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%CoolOutTemp = OutDryBulbTemp
CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%CoolOutHumRat = OutHumRat
CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%HeatLoad = 0.0d0
CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%HeatMassFlow = 0.0d0
CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%HeatZoneTemp = 0.0d0
CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%HeatZoneHumRat = 0.0d0
END IF
IF (SupplyAirNode > 0) THEN
Node(SupplyAirNode)%Temp = Temp
Node(SupplyAirNode)%HumRat = HumRat
Node(SupplyAirNode)%Enthalpy = Enthalpy
Node(SupplyAirNode)%MassFlowRate = MassFlowRate
ELSE
NonAirSystemResponse(ActualZoneNum) = SysOutputProvided
END IF
END DO
CALL CalcZoneMassBalance
CALL CalcZoneLeavingConditions
DO ControlledZoneNum = 1, NumOfZones
IF (.not. ZoneEquipConfig(ControlledZoneNum)%IsControlled) CYCLE
ReturnNode = ZoneEquipConfig(ControlledZoneNum)%ReturnAirNode
ZoneNode = ZoneEquipConfig(ControlledZoneNum)%ZoneNode
IF (ReturnNode > 0) THEN
RetTemp = Node(ReturnNode)%Temp
ELSE
RetTemp = Node(ZoneNode)%Temp
END IF
IF (CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%HeatLoad > 0.0d0) THEN
CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%HeatZoneRetTemp = RetTemp
CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%HeatTstatTemp = TempZoneThermostatSetPoint(ActualZoneNum)
ELSE
CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%CoolZoneRetTemp = RetTemp
CalcZoneSizing(ControlledZoneNum,CurOverallSimDay)%CoolTstatTemp = TempZoneThermostatSetPoint(ActualZoneNum)
END IF
END DO
RETURN
END SUBROUTINE SizeZoneEquipment