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.
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 CalcZoneLeavingConditions
! SUBROUTINE INFORMATION:
! AUTHOR Richard Liesen
! DATE WRITTEN January 2001
! MODIFIED June 2003, FCW: add heat from airflow window to return air
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Perform zone upate of the leaving conditions.
! METHODOLOGY EMPLOYED:
! Energy Balance.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataLoopNode, ONLY : Node
USE DataHeatBalance, ONLY: ZoneIntGain, RefrigCaseCredit, Zone
USE DataHeatBalFanSys, ONLY: SysDepZoneLoads, ZoneLatentGain
USE DataSurfaces, ONLY: Surface, SurfaceWindow, AirFlowWindow_Destination_ReturnAir
USE DataEnvironment, ONLY: OutBaroPress
USE DataRoomAirModel, ONLY: AirPatternZoneInfo
USE DataZoneEnergyDemands, ONLY: ZoneSysEnergyDemand, DeadbandOrSetback, CurDeadbandOrSetback, ZoneSysMoistureDemand
USE DataContaminantBalance, ONLY: Contaminant
USE InternalHeatGains , ONLY: SumAllReturnAirConvectionGains, SumAllReturnAirLatentGains
USE DataHVACGlobals, ONLY: RetTempMax, RetTempMin
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:
REAL(r64) :: qretair ! Heat to return air from lights
REAL(r64) :: cpair ! Air heat capacity [J/kg-K]
REAL(r64) :: TempRetAir ! Return air temperature [C]
REAL(r64) :: TempZoneAir ! Zone air temperature [C]
INTEGER :: ZoneNum ! Controlled zone number
INTEGER :: ActualZoneNum ! Zone number
INTEGER :: ZoneNode ! Node number of controlled zone
INTEGER :: ReturnNode ! Node number of controlled zone's return air
INTEGER :: SurfNum ! Surface number
REAL(r64) :: MassFlowRA ! Return air mass flow [kg/s]
REAL(r64) :: FlowThisTS ! Window gap air mass flow [kg/s]
REAL(r64) :: WinGapFlowtoRA ! Mass flow to return air from all airflow windows in zone [kg/s]
REAL(r64) :: WinGapFlowTtoRA ! Sum of mass flow times outlet temp for all airflow windows in zone [(kg/s)-C]
REAL(r64) :: WinGapTtoRA ! Temp of outlet flow mixture to return air from all airflow windows in zone [C]
REAL(r64) :: H2OHtOfVap ! Heat of vaporization of water (W/kg)
REAL(r64) :: RhoAir ! Density of air (Kg/m3)
REAL(r64) :: ZoneMult ! zone multiplier
REAL(r64) :: SumRetAirLatentGainRate
DO ZoneNum = 1, NumOfZones
IF (.not. ZoneEquipConfig(ZoneNum)%IsControlled) CYCLE
ActualZoneNum=ZoneEquipConfig(ZoneNum)%ActualZoneNum
!A return air system may not exist for certain systems; Therefore when no return node exits
! there is no update. OF course if there is no return air system then you cannot update
! the energy for the return air heat gain from the lights statements.
ReturnNode = ZoneEquipConfig(ZoneNum)%ReturnAirNode
ZoneNode = ZoneEquipConfig(ZoneNum)%ZoneNode
ZoneMult = Zone(ActualZoneNum)%Multiplier * Zone(ActualZoneNum)%ListMultiplier
IF(ReturnNode > 0) Then
!RETURN AIR HEAT GAIN from the Lights statement; this heat gain is stored in
! Add sensible heat gain from refrigerated cases with under case returns
CALL SumAllReturnAirConvectionGains(ActualZoneNum, QRetAir)
CpAir = PsyCpAirFnWTdb(Node(ZoneNode)%HumRat, Node(ZoneNode)%Temp)
! Need to add the energy to the return air from lights and from airflow windows. Where the heat
! is added depends on if there is system flow or not. If there is system flow the heat is added
! to the Zone Return Node. If there is no system flow then the heat is added back to the zone in the
! Correct step through the SysDepZoneLoads variable.
MassFlowRA = Node(ReturnNode)%MassFlowRate / ZoneMult
! user defined room air model may feed temp that differs from zone node
IF (ALLOCATED(AirPatternZoneInfo)) THEN !
IF ((AirPatternZoneInfo(ActualZoneNum)%IsUsed) .and. (.not. BeginEnvrnFlag)) THEN
TempZoneAir = AirPatternZoneInfo(ActualZoneNum)%Tleaving
TempRetAir = TempZoneAir
ELSE
TempZoneAir = Node(ZoneNode)%Temp
TempRetAir = TempZoneAir
ENDIF
ELSE
TempZoneAir = Node(ZoneNode)%Temp
TempRetAir = TempZoneAir
ENDIF
WinGapFlowtoRA = 0.0d0
WinGapTtoRA = 0.0d0
WinGapFlowTtoRA = 0.0d0
DO SurfNum = Zone(ActualZoneNum)%SurfaceFirst,Zone(ActualZoneNum)%SurfaceLast
IF(SurfaceWindow(SurfNum)%AirFlowThisTS > 0.0d0 .AND. &
SurfaceWindow(SurfNum)%AirflowDestination == AirFlowWindow_Destination_ReturnAir) THEN
FlowThisTS = PsyRhoAirFnPbTdbW(OutBaroPress,SurfaceWindow(SurfNum)%TAirFlowGapOutlet, Node(ZoneNode)%HumRat) * &
SurfaceWindow(SurfNum)%AirFlowThisTS * Surface(SurfNum)%Width
WinGapFlowtoRA = WinGapFlowtoRA + FlowThisTS
WinGapFlowTtoRA = WinGapFlowTtoRA + FlowThisTS * SurfaceWindow(SurfNum)%TAirFlowGapOutlet
END IF
END DO
IF(WinGapFlowtoRA > 0.0d0) WinGapTtoRA = WinGapFlowTtoRA / WinGapFlowtoRA
! the flag NoHeatToReturnAir is TRUE if the system is zonal only or is central with on/off air flow. In these
! cases the heat to return air is treated as a zone heat gain and dealt with in CalcZoneSums in
! MODULE ZoneTempPredictorCorrector.
IF (.NOT. Zone(ActualZoneNum)%NoHeatToReturnAir) THEN
IF(MassFlowRA > 0.0d0) Then
IF(WinGapFlowtoRA > 0.0d0) THEN
! Add heat-to-return from window gap airflow
IF(MassFlowRA >= WinGapFlowtoRA) THEN
TempRetAir = (WinGapFlowTtoRA + (MassFlowRA-WinGapFlowtoRA)*TempZoneAir)/MassFlowRA
ELSE
! All of return air comes from flow through airflow windows
TempRetAir = WinGapTtoRA
! Put heat from window airflow that exceeds return air flow into zone air
SysDepZoneLoads(ActualZoneNum) = SysDepZoneLoads(ActualZoneNum) + &
(WinGapFlowToRA - MassFlowRA) * CpAir*(WinGapTtoRA - TempZoneAir)
END IF
END IF
! Add heat-to-return from lights
TempRetAir = TempRetAir + QRetAir/(MassFlowRA * CpAir)
IF (TempRetAir > RetTempMax) THEN
Node(ReturnNode)%Temp = RetTempMax
IF (.not. ZoneSizingCalc) THEN
SysDepZoneLoads(ActualZoneNum) = SysDepZoneLoads(ActualZoneNum) + CpAir*MassFlowRA*(TempRetAir-RetTempMax)
END IF
ELSE IF (TempRetAir < RetTempMin) THEN
Node(ReturnNode)%Temp = RetTempMin
IF (.not. ZoneSizingCalc) THEN
SysDepZoneLoads(ActualZoneNum) = SysDepZoneLoads(ActualZoneNum) + CpAir*MassFlowRA*(TempRetAir-RetTempMin)
END IF
ELSE
Node(ReturnNode)%Temp = TempRetAir
END IF
ELSE ! No return air flow
! Assign all heat-to-return from window gap airflow to zone air
IF(WinGapFlowToRA > 0.0d0) &
SysDepZoneLoads(ActualZoneNum) = SysDepZoneLoads(ActualZoneNum) + &
WinGapFlowToRA * CpAir * (WinGapTtoRA - TempZoneAir)
! Assign all heat-to-return from lights to zone air
IF(QRetAir > 0.0d0) &
SysDepZoneLoads(ActualZoneNum) = SysDepZoneLoads(ActualZoneNum) + QRetAir
Node(ReturnNode)%Temp = Node(ZoneNode)%Temp
END IF
ELSE
! update the return air node for zonal and central on/off systems
Node(ReturnNode)%Temp = Node(ZoneNode)%Temp
END IF
! Update the rest of the Return Air Node conditions, if the return air system exists!
Node(ReturnNode)%Press = Node(ZoneNode)%Press
H2OHtOfVap = PsyHgAirFnWTdb(Node(ZoneNode)%HumRat,Node(ReturnNode)%Temp)
RhoAir = PsyRhoAirFnPbTdbW(OutBaroPress,Node(ReturnNode)%Temp,Node(ZoneNode)%HumRat)
! Include impact of under case returns for refrigerated display case when updating the return air node humidity
IF (.NOT. Zone(ActualZoneNum)%NoHeatToReturnAir) THEN
IF (MassFlowRA > 0) THEN
CALL SumAllReturnAirLatentGains(ZoneNum, SumRetAirLatentGainRate)
Node(ReturnNode)%HumRat = Node(ZoneNode)%HumRat + (SumRetAirLatentGainRate / &
(H2OHtOfVap * MassFlowRA))
ELSE
! If no mass flow rate exists, include the latent HVAC case credit with the latent Zone case credit
Node(ReturnNode)%HumRat = Node(ZoneNode)%HumRat
RefrigCaseCredit(ActualZoneNum)%LatCaseCreditToZone = RefrigCaseCredit(ActualZoneNum)%LatCaseCreditToZone + &
RefrigCaseCredit(ActualZoneNum)%LatCaseCreditToHVAC
! shouldn't the HVAC term be zeroed out then?
CALL SumAllReturnAirLatentGains(ZoneNum, SumRetAirLatentGainRate)
ZoneLatentGain(ActualZoneNum) = ZoneLatentGain(ActualZoneNum) + SumRetAirLatentGainRate
END IF
ELSE
Node(ReturnNode)%HumRat = Node(ZoneNode)%HumRat
RefrigCaseCredit(ActualZoneNum)%LatCaseCreditToZone = RefrigCaseCredit(ActualZoneNum)%LatCaseCreditToZone + &
RefrigCaseCredit(ActualZoneNum)%LatCaseCreditToHVAC
! shouldn't the HVAC term be zeroed out then?
CALL SumAllReturnAirLatentGains(ZoneNum, SumRetAirLatentGainRate)
ZoneLatentGain(ActualZoneNum) = ZoneLatentGain(ActualZoneNum) + SumRetAirLatentGainRate
END IF
Node(ReturnNode)%Enthalpy = PsyHFnTdbW(Node(ReturnNode)%Temp,Node(ReturnNode)%HumRat)
IF (Contaminant%CO2Simulation) Node(ReturnNode)%CO2 = Node(ZoneNode)%CO2
IF (Contaminant%GenericContamSimulation) Node(ReturnNode)%GenContam = Node(ZoneNode)%GenContam
End If !End of check for a return air node, which implies a return air system.
! Reset current deadband flags, remaining output required, so no impact beyond zone equipment
ZoneSysEnergyDemand(ActualZoneNum)%RemainingOutputRequired = &
ZoneSysEnergyDemand(ActualZoneNum)%TotalOutputRequired
ZoneSysEnergyDemand(ActualZoneNum)%RemainingOutputReqToHeatSP = &
ZoneSysEnergyDemand(ActualZoneNum)%OutputRequiredToHeatingSP
ZoneSysEnergyDemand(ActualZoneNum)%RemainingOutputReqToCoolSP = &
ZoneSysEnergyDemand(ActualZoneNum)%OutputRequiredToCoolingSP
ZoneSysMoistureDemand(ActualZoneNum)%RemainingOutputRequired = &
ZoneSysMoistureDemand(ActualZoneNum)%TotalOutputRequired
ZoneSysMoistureDemand(ActualZoneNum)%RemainingOutputReqToHumidSP = &
ZoneSysMoistureDemand(ActualZoneNum)%OutputRequiredToHumidifyingSP
ZoneSysMoistureDemand(ActualZoneNum)%RemainingOutputReqToDehumidSP = &
ZoneSysMoistureDemand(ActualZoneNum)%OutputRequiredToDehumidifyingSP
CurDeadbandOrSetback(ActualZoneNum) = DeadbandOrSetback(ActualZoneNum)
END DO
RETURN
END SUBROUTINE CalcZoneLeavingConditions