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 ReportAirHeatBalance
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN July 2000
! MODIFIED Shirey, Jan 2008 (MIXING/CROSS MIXING outputs)
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine updates the report variables for the AirHeatBalance.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataGlobals, ONLY: SecInHour
USE DataEnvironment, ONLY: StdBaroPress, OutBaroPress, OutHumRat, StdRhoAir
USE DataHeatBalance, ONLY: Zone, TotVentilation, Ventilation, ZnAirRpt, TotMixing, TotCrossMixing, Mixing, CrossMixing, MVFC, &
TotZoneAirBalance, ZoneAirBalance, AirBalanceQuadrature, TotRefDoorMixing, RefDoorMixing
USE DataHVACGlobals, ONLY: CycleOn, CycleOnZoneFansOnly
USE DataHeatBalFanSys, ONLY: MCPI, MCPV, MdotOA, MdotCPOA !, MCPTI, MCPTV, MCPM, MCPTM, MixingMassFlowZone
USE Psychrometrics, ONLY:PsyRhoAirFnPbTdbW,PsyCpAirFnWTdb,PsyHgAirFnWTdb
USE AirflowNetworkBalanceManager, ONLY: ReportAirflowNetwork
USE DataAirflowNetwork, ONLY: SimulateAirflowNetwork,AirflowNetworkZoneFlag,AirflowNetworkControlSimple, &
AirflowNetworkControlSimpleADS
USE DataZoneEquipment, ONLY: ZoneEquipAvail
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:
INTEGER :: ZoneLoop ! Counter for the # of zones (nz)
INTEGER :: ZoneA ! Mated zone number for pair pf zones sharing refrigeration door opening
INTEGER :: ZoneB ! Mated zone number for pair pf zones sharing refrigeration door opening
INTEGER :: VentNum ! Counter for ventilation statements
REAL(r64) :: AirDensity ! Density of air (kg/m^3)
REAL(r64) :: CpAir ! Heat capacity of air (J/kg-C)
REAL(r64) :: ADSCorrectionFactor ! Correction factor of air flow model values when ADS is simulated
REAL(r64) :: H2OHtOfVap ! Heat of vaporization of air
REAL(r64) :: TotalLoad ! Total loss or gain
INTEGER :: MixNum ! Counter for MIXING and Cross Mixing statements
REAL(r64),ALLOCATABLE,DIMENSION(:),SAVE :: MixSenLoad ! Mixing sensible loss or gain
REAL(r64),ALLOCATABLE,DIMENSION(:),SAVE :: MixLatLoad ! Mixing latent loss or gain
INTEGER :: J ! Index in a do-loop
INTEGER :: VentZoneNum ! Number of ventilation object per zone
REAL(r64) :: VentZoneMassflow ! Total mass flow rate per zone
REAL(r64) :: VentZoneAirTemp ! Average Zone inlet temperature
LOGICAL, SAVE :: FirstTime=.true.
! Ensure no airflownetwork and simple calculations
IF (SimulateAirflowNetwork .eq. 0) RETURN
IF (SimulateAirflowNetwork .GT. AirflowNetworkControlSimple) CALL ReportAirflowNetwork
! Report results for SIMPLE option only
IF (.NOT. (SimulateAirflowNetwork .EQ. AirflowNetworkControlSimple .OR. &
SimulateAirflowNetwork .EQ. AirflowNetworkControlSimpleADS)) RETURN
IF (FirstTime) THEN
ALLOCATE(MixSenLoad(NumOfZones))
ALLOCATE(MixLatLoad(NumOfZones))
FirstTime=.false.
END IF
DO ZoneLoop = 1, NumOfZones ! Start of zone loads report variable update loop ...
! Break the infiltration load into heat gain and loss components
ADSCorrectionFactor = 1.0d0
IF (SimulateAirflowNetwork .EQ. AirflowNetworkControlSimpleADS) THEN
! CR7608 IF (TurnFansOn .AND. AirflowNetworkZoneFlag(ZoneLoop)) ADSCorrectionFactor=0
IF ((ZoneEquipAvail(ZoneLoop).EQ.CycleOn .OR. &
ZoneEquipAvail(ZoneLoop).EQ.CycleOnZoneFansOnly) .AND. &
AirflowNetworkZoneFlag(ZoneLoop)) ADSCorrectionFactor=0
END IF
IF (MAT(ZoneLoop) > Zone(ZoneLoop)%OutDryBulbTemp) THEN
ZnAirRPT(ZoneLoop)%InfilHeatLoss = 0.001d0*MCPI(ZoneLoop)*(MAT(ZoneLoop)-Zone(ZoneLoop)%OutDryBulbTemp)* &
TimeStepSys*SecInHour*1000.0d0*ADSCorrectionFactor
ZnAirRPT(ZoneLoop)%InfilHeatGain=0.0d0
ELSE IF (MAT(ZoneLoop) <= Zone(ZoneLoop)%OutDryBulbTemp) THEN
ZnAirRPT(ZoneLoop)%InfilHeatGain = 0.001d0*MCPI(ZoneLoop)*(Zone(ZoneLoop)%OutDryBulbTemp-MAT(ZoneLoop))* &
TimeStepSys*SecInHour*1000.0d0*ADSCorrectionFactor
ZnAirRPT(ZoneLoop)%InfilHeatLoss =0.0d0
END IF
! Report infiltration latent gains and losses
CpAir = PsyCpAirFnWTdb(OutHumRat,Zone(ZoneLoop)%OutDryBulbTemp,calledfrom='ReportAirHeatBalance')
H2OHtOfVap = PsyHgAirFnWTdb(OutHumRat, Zone(ZoneLoop)%OutDryBulbTemp,calledfrom='ReportAirHeatBalance:1')
IF (ZoneAirHumRat(ZoneLoop) > OutHumRat) THEN
ZnAirRPT(ZoneLoop)%InfilLatentLoss = 0.001d0*MCPI(ZoneLoop)/CpAir*(ZoneAirHumRat(ZoneLoop)-OutHumRat)*H2OHtOfVap* &
TimeStepSys*SecInHour*1000.0d0*ADSCorrectionFactor
ZnAirRPT(ZoneLoop)%InfilLatentGain=0.0d0
ELSE IF (ZoneAirHumRat(ZoneLoop) <= OutHumRat) THEN
ZnAirRPT(ZoneLoop)%InfilLatentGain = 0.001d0*MCPI(ZoneLoop)/CpAir*(OutHumRat-ZoneAirHumRat(ZoneLoop))*H2OHtOfVap* &
TimeStepSys*SecInHour*1000.0d0*ADSCorrectionFactor
ZnAirRPT(ZoneLoop)%InfilLatentLoss =0.0d0
END IF
! Total infiltration losses and gains
TotalLoad = ZnAirRPT(ZoneLoop)%InfilHeatGain + ZnAirRPT(ZoneLoop)%InfilLatentGain - &
ZnAirRPT(ZoneLoop)%InfilHeatLoss - ZnAirRPT(ZoneLoop)%InfilLatentLoss
IF (TotalLoad > 0) THEN
ZnAirRPT(ZoneLoop)%InfilTotalGain = TotalLoad*ADSCorrectionFactor
ZnAirRPT(ZoneLoop)%InfilTotalLoss = 0.0d0
ELSE
ZnAirRPT(ZoneLoop)%InfilTotalGain = 0.0d0
ZnAirRPT(ZoneLoop)%InfilTotalLoss = -TotalLoad*ADSCorrectionFactor
END IF
! first calculate mass flows using outside air heat capacity for consistency with input to heat balance
CpAir = PsyCpAirFnWTdb(OutHumRat,Zone(ZoneLoop)%OutDryBulbTemp,calledfrom='ReportAirHeatBalance:2')
ZnAirRpt(ZoneLoop)%InfilMass = (MCPI(ZoneLoop)/CpAir)*TimeStepSys*SecInHour*ADSCorrectionFactor
ZnAirRpt(ZoneLoop)%VentilMass = (MCPV(ZoneLoop)/CpAir)*TimeStepSys*SecInHour*ADSCorrectionFactor
!CR7751 second, calculate using indoor conditions for density property
AirDensity = PsyRhoAirFnPbTdbW(OutBaroPress, MAT(ZoneLoop), ZoneAirHumRatAvg(ZoneLoop),calledfrom='ReportAirHeatBalance:3')
CpAir = PsyCpAirFnWTdb(ZoneAirHumRatAvg(ZoneLoop),MAT(ZoneLoop),calledfrom='ReportAirHeatBalance:4')
ZnAirRpt(ZoneLoop)%InfilVolumeCurDensity = (MCPI(ZoneLoop)/CpAir/AirDensity)*TimeStepSys*SecInHour*ADSCorrectionFactor
ZnAirRpt(ZoneLoop)%InfilAirChangeRate = ZnAirRpt(ZoneLoop)%InfilVolumeCurDensity/(TimeStepSys*Zone(ZoneLoop)%Volume)
ZnAirRpt(ZoneLoop)%InfilVdotCurDensity = (MCPI(ZoneLoop)/CpAir/AirDensity)*ADSCorrectionFactor
ZnAirRpt(ZoneLoop)%VentilVolumeCurDensity = (MCPV(ZoneLoop)/CpAir/AirDensity)*TimeStepSys*SecInHour*ADSCorrectionFactor
ZnAirRpt(ZoneLoop)%VentilAirChangeRate = ZnAirRpt(ZoneLoop)%VentilVolumeCurDensity/(TimeStepSys*Zone(ZoneLoop)%Volume)
ZnAirRpt(ZoneLoop)%VentilVdotCurDensity = (MCPV(ZoneLoop)/CpAir/AirDensity)*ADSCorrectionFactor
!CR7751 third, calculate using standard dry air at nominal elevation
AirDensity = StdRhoAir
ZnAirRpt(ZoneLoop)%InfilVolumeStdDensity = (MCPI(ZoneLoop)/CpAir/AirDensity)*TimeStepSys*SecInHour*ADSCorrectionFactor
ZnAirRpt(ZoneLoop)%InfilVdotStdDensity = (MCPI(ZoneLoop)/CpAir/AirDensity)*ADSCorrectionFactor
ZnAirRpt(ZoneLoop)%VentilVolumeStdDensity = (MCPV(ZoneLoop)/CpAir/AirDensity)*TimeStepSys*SecInHour*ADSCorrectionFactor
ZnAirRpt(ZoneLoop)%VentilVdotStdDensity = (MCPV(ZoneLoop)/CpAir/AirDensity)*ADSCorrectionFactor
! ZnAirRpt(ZoneLoop)%VentilFanElec = 0.0
ZnAirRpt(ZoneLoop)%VentilAirTemp = 0.0d0
ZnAirRpt(ZoneLoop)%VentilHeatLoss = 0.0d0
ZnAirRPT(ZoneLoop)%VentilHeatGain =0.0d0
VentZoneNum = 0
VentZoneMassflow = 0.0d0
VentZoneAirTemp = 0.0d0
DO VentNum = 1, TotVentilation
IF (Ventilation(VentNum)%ZonePtr == ZoneLoop) THEN
! moved into CalcAirFlowSimple
! ZnAirRpt(ZoneLoop)%VentilFanElec = ZnAirRpt(ZoneLoop)%VentilFanElec+Ventilation(VentNum)%FanPower*TimeStepSys*SecInHour &
! *ADSCorrectionFactor
IF (ADSCorrectionFactor > 0) THEN
ZnAirRpt(ZoneLoop)%VentilAirTemp = ZnAirRpt(ZoneLoop)%VentilAirTemp+Ventilation(VentNum)%AirTemp*VentMCP(VentNum)
VentZoneMassflow = VentZoneMassflow+VentMCP(VentNum)
VentZoneAirTemp = VentZoneAirTemp + Ventilation(VentNum)%AirTemp
ELSE
ZnAirRpt(ZoneLoop)%VentilAirTemp = Zone(ZoneLoop)%OutDryBulbTemp
END IF
! Break the ventilation load into heat gain and loss components
IF (MAT(ZoneLoop) > Ventilation(VentNum)%AirTemp) THEN
ZnAirRpt(ZoneLoop)%VentilHeatLoss = ZnAirRpt(ZoneLoop)%VentilHeatLoss+VentMCP(VentNum)*(MAT(ZoneLoop)- &
Ventilation(VentNum)%AirTemp)*TimeStepSys*SecInHour*ADSCorrectionFactor
ELSE IF (MAT(ZoneLoop) <= Ventilation(VentNum)%AirTemp) THEN
ZnAirRpt(ZoneLoop)%VentilHeatGain = ZnAirRpt(ZoneLoop)%VentilHeatGain+VentMCP(VentNum)* &
(Ventilation(VentNum)%AirTemp-MAT(ZoneLoop))*TimeStepSys*SecInHour*ADSCorrectionFactor
END IF
VentZoneNum = VentZoneNum+1
IF (VentZoneNum > 1) CYCLE
! Report ventilation latent gains and losses
H2OHtOfVap = PsyHgAirFnWTdb(OutHumRat, Zone(ZoneLoop)%OutDryBulbTemp,calledfrom='ReportAirHeatBalance:5')
IF (ZoneAirHumRat(ZoneLoop) > OutHumRat) THEN
ZnAirRPT(ZoneLoop)%VentilLatentLoss = 0.001d0*MCPV(ZoneLoop)/CpAir*(ZoneAirHumRat(ZoneLoop)-OutHumRat)*H2OHtOfVap* &
TimeStepSys*SecInHour*1000.0d0*ADSCorrectionFactor
ZnAirRPT(ZoneLoop)%VentilLatentGain=0.0d0
ELSE IF (ZoneAirHumRat(ZoneLoop) <= OutHumRat) THEN
ZnAirRPT(ZoneLoop)%VentilLatentGain = 0.001d0*MCPV(ZoneLoop)/CpAir*(OutHumRat-ZoneAirHumRat(ZoneLoop))*H2OHtOfVap* &
TimeStepSys*SecInHour*1000.0d0*ADSCorrectionFactor
ZnAirRPT(ZoneLoop)%VentilLatentLoss =0.0d0
END IF
! Total ventilation losses and gains
TotalLoad = ZnAirRPT(ZoneLoop)%VentilHeatGain + ZnAirRPT(ZoneLoop)%VentilLatentGain - &
ZnAirRPT(ZoneLoop)%VentilHeatLoss - ZnAirRPT(ZoneLoop)%VentilLatentLoss
IF (TotalLoad > 0) THEN
ZnAirRPT(ZoneLoop)%VentilTotalGain = TotalLoad*ADSCorrectionFactor
ZnAirRPT(ZoneLoop)%VentilTotalLoss = 0.0d0
ELSE
ZnAirRPT(ZoneLoop)%VentilTotalGain = 0.0d0
ZnAirRPT(ZoneLoop)%VentilTotalLoss = -TotalLoad*ADSCorrectionFactor
END IF
END IF
END DO
IF (ADSCorrectionFactor > 0 .AND. VentZoneNum > 1 .AND. VentZoneMassflow > 0.0d0) Then
ZnAirRpt(ZoneLoop)%VentilAirTemp = ZnAirRpt(ZoneLoop)%VentilAirTemp/VentZoneMassflow
ELse If (ADSCorrectionFactor > 0 .AND. VentZoneNum .eq. 1) Then
ZnAirRpt(ZoneLoop)%VentilAirTemp = VentZoneAirTemp
Else ! Just in case
ZnAirRpt(ZoneLoop)%VentilAirTemp = Zone(ZoneLoop)%OutDryBulbTemp
End If
! Report mixing sensible and latent loads
MixSenLoad = 0.0d0 ! Initialize arrays to zero before starting to sum
MixLatLoad = 0.0d0
ZnAirRpt(ZoneLoop)%MixVolume = 0.0d0 ! zero reported volume prior to summations below
ZnAirRpt(ZoneLoop)%MixMass = 0.0d0 ! ! zero reported mass prior to summations below
! MixingLoad = 0.0d0
DO MixNum=1,TotMixing
IF ((Mixing(MixNum)%ZonePtr .eq. ZoneLoop) .AND. MixingReportFlag(MixNum)) THEN
! MixSenLoad(ZoneLoop) = MixSenLoad(ZoneLoop)+MCPM(ZoneLoop)*MAT(Mixing(MixNum)%FromZone)
! H2OHtOfVap = PsyHgAirFnWTdb(ZoneAirHumRat(ZoneLoop), MAT(ZoneLoop))
! Per Jan 17, 2008 conference call, agreed to use average conditions for Rho, Cp and Hfg
! and to recalculate the report variable using end of time step temps and humrats
AirDensity = PsyRhoAirFnPbTdbW(OutBaroPress, (MAT(ZoneLoop)+MAT(Mixing(MixNum)%FromZone))/2.0d0, &
(ZoneAirHumRat(ZoneLoop)+ZoneAirHumRat(Mixing(MixNum)%FromZone))/2.0d0)
CpAir = PsyCpAirFnWTdb((ZoneAirHumRat(ZoneLoop)+ZoneAirHumRat(Mixing(MixNum)%FromZone))/2.0d0, &
(MAT(ZoneLoop)+MAT(Mixing(MixNum)%FromZone))/2.0d0)
ZnAirRpt(ZoneLoop)%MixVolume = ZnAirRpt(ZoneLoop)%MixVolume + &
Mixing(MixNum)%DesiredAirFlowRate*TimeStepSys*SecInHour*ADSCorrectionFactor
ZnAirRpt(ZoneLoop)%MixMass = ZnAirRpt(ZoneLoop)%MixMass + &
Mixing(MixNum)%DesiredAirFlowRate * AirDensity * TimeStepSys * SecInHour * ADSCorrectionFactor
MixSenLoad(ZoneLoop) = MixSenLoad(ZoneLoop)+Mixing(MixNum)%DesiredAirFlowRate * AirDensity * CpAir * &
(MAT(ZoneLoop) - MAT(Mixing(MixNum)%FromZone))
H2OHtOfVap = PsyHgAirFnWTdb((ZoneAirHumRat(ZoneLoop)+ZoneAirHumRat(Mixing(MixNum)%FromZone))/2.0d0, &
(MAT(ZoneLoop)+MAT(Mixing(MixNum)%FromZone))/2.0d0,'ReportAirHeatBalance:Mixing')
! MixLatLoad(ZoneLoop) = MixLatLoad(ZoneLoop)+MixingMassFlowZone(ZoneLoop)*(ZoneAirHumRat(ZoneLoop)- &
! ZoneAirHumRat(Mixing(MixNum)%FromZone))*H2OHtOfVap
MixLatLoad(ZoneLoop) = MixLatLoad(ZoneLoop)+ Mixing(MixNum)%DesiredAirFlowRate * AirDensity * &
(ZoneAirHumRat(ZoneLoop)-ZoneAirHumRat(Mixing(MixNum)%FromZone))*H2OHtOfVap
END IF
END DO
DO MixNum=1,TotCrossMixing
IF ((CrossMixing(MixNum)%ZonePtr .eq. ZoneLoop) .AND. CrossMixingReportFlag(MixNum)) THEN
! MixSenLoad(ZoneLoop) = MixSenLoad(ZoneLoop)+MCPM(ZoneLoop)*MAT(CrossMixing(MixNum)%FromZone)
! Per Jan 17, 2008 conference call, agreed to use average conditions for Rho, Cp and Hfg
! and to recalculate the report variable using end of time step temps and humrats
AirDensity = PsyRhoAirFnPbTdbW(OutBaroPress, (MAT(ZoneLoop)+MAT(CrossMixing(MixNum)%FromZone))/2.0d0, &
(ZoneAirHumRat(ZoneLoop)+ZoneAirHumRat(CrossMixing(MixNum)%FromZone))/2.0d0)
CpAir = PsyCpAirFnWTdb((ZoneAirHumRat(ZoneLoop)+ZoneAirHumRat(CrossMixing(MixNum)%FromZone))/2.0d0, &
(MAT(ZoneLoop)+MAT(CrossMixing(MixNum)%FromZone))/2.0d0)
ZnAirRpt(ZoneLoop)%MixVolume = ZnAirRpt(ZoneLoop)%MixVolume + &
MVFC(MixNum)*TimeStepSys*SecInHour*ADSCorrectionFactor
ZnAirRpt(ZoneLoop)%MixMass = ZnAirRpt(ZoneLoop)%MixMass + &
MVFC(MixNum) * AirDensity * TimeStepSys * SecInHour * ADSCorrectionFactor
MixSenLoad(ZoneLoop) = MixSenLoad(ZoneLoop)+ MVFC(MixNum) * AirDensity * CpAir * &
(MAT(ZoneLoop) - MAT(CrossMixing(MixNum)%FromZone))
H2OHtOfVap = PsyHgAirFnWTdb((ZoneAirHumRat(ZoneLoop)+ZoneAirHumRat(CrossMixing(MixNum)%FromZone))/2.0d0, &
(MAT(ZoneLoop)+MAT(CrossMixing(MixNum)%FromZone))/2.0d0,'ReportAirHeatBalance:XMixing')
! MixLatLoad(ZoneLoop) = MixLatLoad(ZoneLoop)+MixingMassFlowZone(ZoneLoop)*(ZoneAirHumRat(ZoneLoop)- &
! ZoneAirHumRat(CrossMixing(MixNum)%FromZone))*H2OHtOfVap
MixLatLoad(ZoneLoop) = MixLatLoad(ZoneLoop)+ MVFC(MixNum) * AirDensity * &
(ZoneAirHumRat(ZoneLoop)-ZoneAirHumRat(CrossMixing(MixNum)%FromZone))*H2OHtOfVap
END IF
END DO
IF (TotRefDoorMixing .GT. 0) THEN
!IF(ZoneLoop .NE. NumofZones)THEN !Refrigeration Door Mixing
!Note - do each Pair a Single time, so must do increment reports for both zones
! Can't have a pair that has ZoneA zone number = NumofZones because organized
! in input with lowest zone # first no matter how input in idf
IF(RefDoorMixing(ZoneLoop)%RefDoorMixFlag) THEN ! .TRUE. for both zoneA and zoneB
IF (RefDoorMixing(ZoneLoop)%ZonePtr .EQ. ZoneLoop) THEN
DO J=1,RefDoorMixing(ZoneLoop)%NumRefDoorConnections
! Capture impact when zoneloop is the 'primary zone'
! that is, the zone of a pair with the lower zone number
IF(RefDoorMixing(ZoneLoop)%VolRefDoorFlowRate(J).GT. 0.d0) THEN
ZoneB = RefDoorMixing(ZoneLoop)%MateZonePtr(J)
AirDensity = PsyRhoAirFnPbTdbW(OutBaroPress, (MAT(ZoneLoop)+MAT(ZoneB))/2.0d0, &
(ZoneAirHumRat(ZoneLoop)+ZoneAirHumRat(ZoneB))/2.0d0)
CpAir = PsyCpAirFnWTdb((ZoneAirHumRat(ZoneLoop)+ZoneAirHumRat(ZoneB))/2.0d0, &
(MAT(ZoneLoop)+MAT(ZoneB))/2.0d0)
H2OHtOfVap = PsyHgAirFnWTdb((ZoneAirHumRat(ZoneLoop)+ZoneAirHumRat(ZoneB))/2.0d0, &
(MAT(ZoneLoop)+MAT(ZoneB))/2.0d0,'ReportAirHeatBalance:XMixing')
ZnAirRpt(ZoneLoop)%MixVolume = ZnAirRpt(ZoneLoop)%MixVolume + &
RefDoorMixing(ZoneLoop)%VolRefDoorFlowRate(J)*&
TimeStepSys*SecInHour*ADSCorrectionFactor
ZnAirRpt(ZoneLoop)%MixMass = ZnAirRpt(ZoneLoop)%MixMass + &
RefDoorMixing(ZoneLoop)%VolRefDoorFlowRate(J) * &
AirDensity * TimeStepSys * SecInHour * ADSCorrectionFactor
MixSenLoad(ZoneLoop) = MixSenLoad(ZoneLoop)+ RefDoorMixing(ZoneLoop)%VolRefDoorFlowRate(J) * &
AirDensity * CpAir * (MAT(ZoneLoop) - MAT(ZoneB))
MixLatLoad(ZoneLoop) = MixLatLoad(ZoneLoop)+ RefDoorMixing(ZoneLoop)%VolRefDoorFlowRate(J) * AirDensity * &
(ZoneAirHumRat(ZoneLoop)-ZoneAirHumRat(ZoneB))*H2OHtOfVap
END IF !flow > 0
END DO ! J-1, numref connections
END IF ! zone A (zoneptr = zoneloop)
DO ZoneA = 1,(ZoneLoop - 1)
! Capture impact when zoneloop is the 'mating zone'
! that is, the zone of a pair with the higher zone number(matezoneptr = zoneloop)
IF(RefDoorMixing(ZoneA)%RefDoorMixFlag) THEN
DO J=1,RefDoorMixing(ZoneA)%NumRefDoorConnections
IF (RefDoorMixing(ZoneA)%MateZonePtr(J) .EQ. ZoneLoop) THEN
IF (RefDoorMixing(ZoneA)%VolRefDoorFlowRate(J).GT. 0.d0) THEN
AirDensity = PsyRhoAirFnPbTdbW(OutBaroPress, (MAT(ZoneLoop)+MAT(ZoneA))/2.0d0, &
(ZoneAirHumRat(ZoneLoop)+ZoneAirHumRat(ZoneA))/2.0d0)
CpAir = PsyCpAirFnWTdb((ZoneAirHumRat(ZoneLoop)+ZoneAirHumRat(ZoneA))/2.0d0, &
(MAT(ZoneLoop)+MAT(ZoneA))/2.0d0)
H2OHtOfVap = PsyHgAirFnWTdb((ZoneAirHumRat(ZoneLoop)+ZoneAirHumRat(ZoneA))/2.0d0, &
(MAT(ZoneLoop)+MAT(ZoneA))/2.0d0,'ReportAirHeatBalance:XMixing')
ZnAirRpt(ZoneLoop)%MixVolume = ZnAirRpt(ZoneLoop)%MixVolume + &
RefDoorMixing(ZoneA)%VolRefDoorFlowRate(J)*&
TimeStepSys*SecInHour*ADSCorrectionFactor
ZnAirRpt(ZoneLoop)%MixMass = ZnAirRpt(ZoneLoop)%MixMass + &
RefDoorMixing(ZoneA)%VolRefDoorFlowRate(J) * &
AirDensity * TimeStepSys * SecInHour * ADSCorrectionFactor
MixSenLoad(ZoneLoop) = MixSenLoad(ZoneLoop)+ RefDoorMixing(ZoneA)%VolRefDoorFlowRate(J) * &
AirDensity * CpAir * (MAT(ZoneLoop) - MAT(ZoneA))
MixLatLoad(ZoneLoop) = MixLatLoad(ZoneLoop)+ RefDoorMixing(ZoneA)%VolRefDoorFlowRate(J) * AirDensity * &
(ZoneAirHumRat(ZoneLoop)-ZoneAirHumRat(ZoneA))*H2OHtOfVap
END IF ! volflowrate > 0
END IF ! matezoneptr (zoneB) = Zonelooop
END DO ! NumRefDoorConnections
END IF ! Refdoormix flag on ZoneA
END DO ! zone A from 1 to (zoneloop - 1)
END IF ! Refdoormix flag on zoneloop
END IF !(TotRefDoorMixing .GT. 0)
!end refrigeration door mixing reports
! MixingLoad(ZoneLoop) = MCPM(ZoneLoop)*MAT(ZoneLoop) - MixSenLoad(ZoneLoop)
IF (MixSenLoad(ZoneLoop) > 0.0d0) THEN
ZnAirRpt(ZoneLoop)%MixHeatLoss = MixSenLoad(ZoneLoop)*TimeStepSys*SecInHour*ADSCorrectionFactor
ZnAirRpt(ZoneLoop)%MixHeatGain = 0.0d0
ELSE
ZnAirRpt(ZoneLoop)%MixHeatLoss = 0.0d0
ZnAirRpt(ZoneLoop)%MixHeatGain = -MixSenLoad(ZoneLoop)*TimeStepSys*SecInHour*ADSCorrectionFactor
END IF
! Report mixing latent loads
! MixingLoad(ZoneLoop) = MixLatLoad(ZoneLoop)
IF (MixLatLoad(ZoneLoop) > 0.0d0) THEN
ZnAirRpt(ZoneLoop)%MixLatentLoss = MixLatLoad(ZoneLoop)*TimeStepSys*SecInHour*ADSCorrectionFactor
ZnAirRpt(ZoneLoop)%MixLatentGain = 0.0d0
ELSE
ZnAirRpt(ZoneLoop)%MixLatentLoss = 0.0d0
ZnAirRpt(ZoneLoop)%MixLatentGain = -MixLatLoad(ZoneLoop)*TimeStepSys*SecInHour*ADSCorrectionFactor
END IF
! Total Mixing losses and gains
TotalLoad = ZnAirRPT(ZoneLoop)%MixHeatGain + ZnAirRPT(ZoneLoop)%MixLatentGain - &
ZnAirRPT(ZoneLoop)%MixHeatLoss - ZnAirRPT(ZoneLoop)%MixLatentLoss
IF (TotalLoad > 0) THEN
ZnAirRPT(ZoneLoop)%MixTotalGain = TotalLoad*ADSCorrectionFactor
ZnAirRPT(ZoneLoop)%MixTotalLoss = 0.0d0
ELSE
ZnAirRPT(ZoneLoop)%MixTotalGain = 0.0d0
ZnAirRPT(ZoneLoop)%MixTotalLoss = -TotalLoad*ADSCorrectionFactor
END IF
! Reporting combined outdoor air flows
Do J=1, TotZoneAirBalance
IF (ZoneAirBalance(j)%BalanceMethod== AirBalanceQuadrature .AND. ZoneLoop == ZoneAirBalance(j)%ZonePtr) THEN
IF (MAT(ZoneLoop) > Zone(ZoneLoop)%OutDryBulbTemp) THEN
ZnAirRpt(ZoneLoop)%OABalanceHeatLoss = MdotCPOA(ZoneLoop)*(MAT(ZoneLoop)- &
Zone(ZoneLoop)%OutDryBulbTemp)*TimeStepSys*SecInHour*ADSCorrectionFactor
ZnAirRpt(ZoneLoop)%OABalanceHeatGain = 0.0d0
ELSE
ZnAirRpt(ZoneLoop)%OABalanceHeatLoss = 0.0d0
ZnAirRpt(ZoneLoop)%OABalanceHeatGain = -MdotCPOA(ZoneLoop)*(MAT(ZoneLoop)- &
Zone(ZoneLoop)%OutDryBulbTemp)*TimeStepSys*SecInHour*ADSCorrectionFactor
END IF
H2OHtOfVap = PsyHgAirFnWTdb(OutHumRat, Zone(ZoneLoop)%OutDryBulbTemp,'ReportAirHeatBalance:2')
IF (ZoneAirHumRat(ZoneLoop) > OutHumRat) THEN
ZnAirRPT(ZoneLoop)%OABalanceLatentLoss = 0.001d0*MdotOA(ZoneLoop)*(ZoneAirHumRat(ZoneLoop)-OutHumRat)*H2OHtOfVap* &
TimeStepSys*SecInHour*1000.0d0*ADSCorrectionFactor
ZnAirRPT(ZoneLoop)%OABalanceLatentGain=0.0d0
ELSE IF (ZoneAirHumRat(ZoneLoop) <= OutHumRat) THEN
ZnAirRPT(ZoneLoop)%OABalanceLatentGain = 0.001d0*MdotOA(ZoneLoop)*(OutHumRat-ZoneAirHumRat(ZoneLoop))*H2OHtOfVap* &
TimeStepSys*SecInHour*1000.0d0*ADSCorrectionFactor
ZnAirRPT(ZoneLoop)%OABalanceLatentLoss =0.0d0
END IF
! Total ventilation losses and gains
TotalLoad = ZnAirRPT(ZoneLoop)%OABalanceHeatGain + ZnAirRPT(ZoneLoop)%OABalanceLatentGain - &
ZnAirRPT(ZoneLoop)%OABalanceHeatLoss - ZnAirRPT(ZoneLoop)%OABalanceLatentLoss
IF (TotalLoad > 0) THEN
ZnAirRPT(ZoneLoop)%OABalanceTotalGain = TotalLoad*ADSCorrectionFactor
ZnAirRPT(ZoneLoop)%OABalanceTotalLoss = 0.0d0
ELSE
ZnAirRPT(ZoneLoop)%OABalanceTotalGain = 0.0d0
ZnAirRPT(ZoneLoop)%OABalanceTotalLoss = -TotalLoad*ADSCorrectionFactor
END IF
ZnAirRpt(ZoneLoop)%OABalanceMass = (MdotOA(ZoneLoop))*TimeStepSys*SecInHour*ADSCorrectionFactor
AirDensity = PsyRhoAirFnPbTdbW(OutBaroPress, MAT(ZoneLoop), ZoneAirHumRatAvg(ZoneLoop))
ZnAirRpt(ZoneLoop)%OABalanceVolumeCurDensity = (MdotOA(ZoneLoop)/AirDensity)*TimeStepSys*SecInHour*ADSCorrectionFactor
ZnAirRpt(ZoneLoop)%OABalanceAirChangeRate =ZnAirRpt(ZoneLoop)%OABalanceVolumeCurDensity/(TimeStepSys*Zone(ZoneLoop)%Volume)
ZnAirRpt(ZoneLoop)%OABalanceVdotCurDensity = (MdotOA(ZoneLoop)/AirDensity)*ADSCorrectionFactor
AirDensity = StdRhoAir
ZnAirRpt(ZoneLoop)%OABalanceVolumeStdDensity = (MdotOA(ZoneLoop)/AirDensity)*TimeStepSys*SecInHour*ADSCorrectionFactor
ZnAirRpt(ZoneLoop)%OABalanceVdotStdDensity = (MdotOA(ZoneLoop)/AirDensity)*ADSCorrectionFactor
ZnAirRpt(ZoneLoop)%OABalanceFanElec = ZnAirRpt(ZoneLoop)%VentilFanElec
END IF
End Do
END DO
RETURN
END SUBROUTINE ReportAirHeatBalance