SUBROUTINE CalcAirFlowSimple(SysTimestepLoop)
! SUBROUTINE INFORMATION:
! AUTHOR Legacy Code
! DATE WRITTEN na
! MODIFIED Shirey, Jan 2008 (MIXING objects, use avg. conditions for Cp, Air Density and Hfg)
! MODIFIED L. Lawrie and L. GU, Jan. 2008 (Allow multiple infiltration and ventilation objects)
! B. Griffith. Jan 2009 add infiltration, residential basic/sherman-grimsrud and enhanced/AIM2
! L. Lawrie - March 2009 - move ventilation electric calculation to this routine (for
! Electricity Net.
! L. Gu - Dec. 2009 - Added a new ventilation object to calculate flow rate based on wind and stack
! effect through an opening.
! MODIFIED Stovall - Aug 2011 (add refrigerator door mixing)
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine calculates the air component of the heat balance.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataEnvironment, ONLY: OutBaroPress, OutHumRat, OutEnthalpy, WindSpeed
USE DataHeatBalFanSys
USE DataHeatBalance
USE Psychrometrics, ONLY:PsyRhoAirFnPbTdbW,PsyCpAirFnWTdb,PsyTdbFnHW
USE DataRoomAirModel, ONLY: ZTJET,AirModel,RoomAirModel_UCSDDV,RoomAirModel_UCSDCV
USE ScheduleManager, ONLY: GetCurrentScheduleValue
USE DataAirflowNetwork, ONLY: SimulateAirflowNetwork,AirflowNetworkControlSimple,AirflowNetworkControlSimpleADS, &
AirflowNetworkZoneFlag
USE EarthTube, ONLY : ManageEarthTube
USE CoolTower, ONLY: ManageCoolTower
USE ThermalChimney, ONLY : ManageThermalChimney
USE DataZoneEquipment, ONLY: ZoneEquipAvail
USE DataHVACGlobals, ONLY: CycleOn, CycleOnZoneFansOnly
USE DataContaminantBalance, ONLY: Contaminant, ZoneAirCO2, MixingMassFlowCO2, ZoneAirGC, MixingMassFlowGC
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN), OPTIONAL :: SysTimestepLoop ! System time step index
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: StdGravity = 9.80665d0 ! The acceleration of gravity at the sea level (m/s2)
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) MCP
REAL(r64) MCPxM
REAL(r64) MCPxN
REAL(r64) TZM ! Temperature of From Zone
REAL(r64) TZN ! Temperature of this zone
REAL(r64) TD ! Delta Temp limit of Mixing statement
REAL(r64) Tavg ! Average temperature in two zones exchanging air
REAL(r64) Wavg ! Average humidity ratio in two zones exchanging air
INTEGER M ! Index to From Zone
INTEGER N ! Index of this zone
INTEGER J ! Loop Counter
INTEGER NZ ! A pointer
INTEGER I ! Ventilation master object index
INTEGER NH ! Hybrid controlled zone number
REAL(r64) AirDensity ! Density of air (kg/m^3)
REAL(r64) CpAir ! Heat capacity of air (J/kg-C)
REAL(r64) OutletAirEnthalpy ! Enthlapy of outlet air (VENTILATION objects)
REAL(r64) :: TempExt
REAL(r64) :: WindExt
LOGICAL MixingLimitFlag
REAL(r64) :: MixingTmin
REAL(r64) :: MixingTmax
REAL(r64) :: IVF !DESIGN INFILTRATION FLOW RATE (M**3/SEC)
REAL(r64) :: VVF !DESIGN VENTILATION FLOW RATE (M**3/SEC)
REAL(r64) :: MCpI_temp
REAL(r64) :: VAMFL_temp
REAL(r64), ALLOCATABLE, SAVE, DIMENSION(:) :: ZMAT ! Zone air temperature
REAL(r64), ALLOCATABLE, SAVE, DIMENSION(:) :: ZHumRat ! Zone air humidity ratio
REAL(r64) :: Cw ! Opening effectivenss
REAL(r64) :: Cd ! Discharge coefficent
REAL(r64) :: Angle ! Angle between wind direction and effective angle
REAL(r64) :: Qw ! Volumetric flow driven by wind
REAL(r64) :: Qst ! Volumetric flow driven by stack effect
REAL(r64) :: MassFlowDiff
!following variables used for refrigeration door mixing and all defined in EngRef
INTEGER :: ZoneA
INTEGER :: ZoneB
REAL(r64) :: TZoneA
REAL(r64) :: TZoneB
REAL(r64) :: HumRatZoneA
REAL(r64) :: HumRatZoneB
REAL(r64) :: AirDensityZoneA
REAL(r64) :: CpAirZoneA
REAL(r64) :: AirDensityZoneB
REAL(r64) :: CpAirZoneB
REAL(r64) :: AirDensityAvg
REAL(r64) :: MassFlowDryAir
REAL(r64) :: SchedDoorOpen
REAL(r64) :: DoorHeight
REAL(r64) :: DoorArea
REAL(r64) :: DoorProt
REAL(r64) :: FDens
REAL(r64) :: Fb
REAL(r64) :: FFlow
REAL(r64) :: MassFlowToA
REAL(r64) :: MassFlowToB
REAL(r64) :: MassFlowXCpToA
REAL(r64) :: MassFlowXCpToB
REAL(r64) :: MassFlowXCpXTempToA
REAL(r64) :: MassFlowXCpXTempToB
REAL(r64) :: MassFlowXHumRatToA
REAL(r64) :: MassFlowXHumRatToB
!
! Allocate the ZMAT and ZHumRat arrays
IF (.NOT. ALLOCATED(ZMAT)) ALLOCATE(ZMAT(NumOfZones))
IF (.NOT. ALLOCATED(ZHumRat)) ALLOCATE(ZHumRat(NumOfZones))
IF (.NOT. ALLOCATED(VentMCP)) ALLOCATE(VentMCP(TotVentilation))
! Allocate module level logical arrays for MIXING and CROSS MIXING reporting
IF (.NOT. ALLOCATED(CrossMixingReportFlag)) ALLOCATE(CrossMixingReportFlag(TotCrossMixing))
IF (.NOT. ALLOCATED(MixingReportFlag)) ALLOCATE(MixingReportFlag(TotMixing))
IF (.not. ALLOCATED(MCPTThermChim)) ALLOCATE(MCPTThermChim(NumOfZones))
IF (.not. ALLOCATED(MCPThermChim)) ALLOCATE(MCPThermChim(NumOfZones))
IF (.not. ALLOCATED(ThermChimAMFL)) ALLOCATE(ThermChimAMFL(NumOfZones))
! COMPUTE ZONE AIR MIXINGS
!
MCPM=0.0d0
MCPTM=0.0d0
MixingMassFlowZone = 0.0d0
MixingMassFlowXHumRat = 0.0d0
CrossMixingFlag = .FALSE.
CrossMixingReportFlag = .FALSE.
MixingReportFlag = .FALSE.
IF (Contaminant%CO2Simulation .AND. TotMixing+TotCrossMixing+TotRefDoorMixing > 0) MixingMassFlowCO2 = 0.0d0
IF (Contaminant%GenericContamSimulation .AND. TotMixing+TotCrossMixing+TotRefDoorMixing > 0) MixingMassFlowGC = 0.0d0
IVF = 0.0d0
MCPTI = 0.0d0
MCPI = 0.0d0
OAMFL = 0.0d0
VVF = 0.0d0
MCPTV = 0.0d0
MCPV = 0.0d0
VAMFL = 0.0d0
VentMCP = 0.0d0
MDotCPOA = 0.0d0
MDotOA = 0.0d0
MCPThermChim = 0.0d0
ThermChimAMFL = 0.0d0
MCPTThermChim = 0.0d0
IF (AirFlowFlag .NE. UseSimpleAirFlow) RETURN
! AirflowNetwork Multizone field /= SIMPLE
IF (.NOT. (SimulateAirflowNetwork .EQ. AirflowNetworkControlSimple .OR. &
SimulateAirflowNetwork .EQ. AirflowNetworkControlSimpleADS)) RETURN
CALL ManageEarthTube
CALL ManageCoolTower
CALL ManageThermalChimney
! Assign zone air temperature
DO J=1,NumOfZones
ZMAT(J) = MAT(J)
ZHumRat(J) = ZoneAirHumRat(J)
! This is only temperory fix for CR8867. (L. Gu 8/12)
If (PRESENT(SysTimestepLoop) .AND. SysTimestepLoop == 1) Then
ZMAT(J) = XMPT(J)
ZHumRat(J) = WZoneTimeMinusP(J)
End If
END DO
! Process the scheduled Ventilation for air heat balance
IF (TotVentilation > 0) THEN
ZnAirRpt%VentilFanElec=0.0d0
ENDIF
! Initialization of ZoneAirBalance
If (TotZoneAirBalance .gt. 0) Then
ZoneAirBalance%BalMassFlowRate =0.0d0
ZoneAirBalance%InfMassFlowRate =0.0d0
ZoneAirBalance%NatMassFlowRate =0.0d0
ZoneAirBalance%ExhMassFlowRate =0.0d0
ZoneAirBalance%IntMassFlowRate =0.0d0
ZoneAirBalance%ERVMassFlowRate =0.0d0
End If
DO J = 1, TotVentilation
NZ = Ventilation(J)%ZonePtr
Ventilation(J)%FanPower = 0.0d0
TempExt = Zone(NZ)%OutDryBulbTemp
WindExt = Zone(NZ)%WindSpeed
AirDensity = PsyRhoAirFnPbTdbW(OutBaroPress,TempExt,OutHumRat)
CpAir = PsyCpAirFnWTdb(OutHumRat,TempExt)
!CR7751 should maybe use code below, indoor conditions instead of outdoor conditions
! AirDensity = PsyRhoAirFnPbTdbW(OutBaroPress, ZMAT(NZ), ZHumRat(NZ))
! CpAir = PsyCpAirFnWTdb(ZHumRat(NZ),ZMAT(NZ))
! Hybrid ventilation global control
If (Ventilation(J)%HybridControlType == HybridControlTypeGlobal .AND. Ventilation(J)%HybridControlMasterNum > 0) Then
I = Ventilation(J)%HybridControlMasterNum
NH = Ventilation(I)%ZonePtr
If (J .eq. I) Ventilation(J)%HybridControlMasterStatus = .FALSE.
Else
I = J
NH = NZ
End If
! Check scheduled temperatures
If (Ventilation(I)%MinIndoorTempSchedPtr > 0) Then
Ventilation(I)%MinIndoorTemperature = GetCurrentScheduleValue(Ventilation(I)%MinIndoorTempSchedPtr)
End If
If (Ventilation(I)%MaxIndoorTempSchedPtr > 0) Then
Ventilation(I)%MaxIndoorTemperature = GetCurrentScheduleValue(Ventilation(I)%MaxIndoorTempSchedPtr)
End If
! Ensure the minimum indoor temperature <= the maximum indoor temperature
If (Ventilation(I)%MinIndoorTempSchedPtr > 0 .OR. Ventilation(I)%MaxIndoorTempSchedPtr > 0) Then
If (Ventilation(I)%MinIndoorTemperature > Ventilation(I)%MaxIndoorTemperature) Then
Ventilation(I)%IndoorTempErrCount = Ventilation(I)%IndoorTempErrCount + 1
if (Ventilation(I)%IndoorTempErrCount< 2) then
CALL ShowWarningError('Ventilation indoor temperature control: The minimum indoor temperature is above '// &
'the maximum indoor temperature in '//TRIM(Ventilation(I)%Name))
CALL ShowContinueError('The minimum indoor temperature is set to the maximum indoor temperature. ' &
//'Simulation continues.')
CALL ShowContinueErrorTimeStamp(' Occurrence info: ')
else
CALL ShowRecurringWarningErrorAtEnd('The minimum indoor temperature is still above '// &
'the maximum indoor temperature',Ventilation(I)%IndoorTempErrIndex, &
Ventilation(I)%MinIndoorTemperature, Ventilation(I)%MinIndoorTemperature)
end if
Ventilation(I)%MinIndoorTemperature = Ventilation(I)%MaxIndoorTemperature
End If
End If
If (Ventilation(I)%MinOutdoorTempSchedPtr > 0) Then
Ventilation(I)%MinOutdoorTemperature = GetCurrentScheduleValue(Ventilation(I)%MinOutdoorTempSchedPtr)
End If
If (Ventilation(I)%MaxOutdoorTempSchedPtr > 0) Then
Ventilation(I)%MaxOutdoorTemperature = GetCurrentScheduleValue(Ventilation(I)%MaxOutdoorTempSchedPtr)
End If
! Ensure the minimum outdoor temperature <= the maximum outdoor temperature
If (Ventilation(I)%MinOutdoorTempSchedPtr > 0 .OR. Ventilation(I)%MaxOutdoorTempSchedPtr > 0) Then
If (Ventilation(I)%MinOutdoorTemperature > Ventilation(I)%MaxOutdoorTemperature) Then
Ventilation(I)%OutdoorTempErrCount = Ventilation(I)%OutdoorTempErrCount + 1
if (Ventilation(I)%OutdoorTempErrCount< 2) then
CALL ShowWarningError('Ventilation outdoor temperature control: The minimum outdoor temperature is above '// &
'the maximum outdoor temperature in '//TRIM(Ventilation(I)%Name))
CALL ShowContinueError('The minimum outdoor temperature is set to the maximum outdoor temperature. ' &
//'Simulation continues.')
CALL ShowContinueErrorTimeStamp(' Occurrence info: ')
else
CALL ShowRecurringWarningErrorAtEnd('The minimum outdoor temperature is still above '// &
'the maximum outdoor temperature',Ventilation(I)%OutdoorTempErrIndex, &
Ventilation(I)%MinOutdoorTemperature, Ventilation(I)%MinOutdoorTemperature)
end if
Ventilation(I)%MinIndoorTemperature = Ventilation(I)%MaxIndoorTemperature
End If
End If
If (Ventilation(I)%DeltaTempSchedPtr > 0) Then
Ventilation(I)%DelTemperature = GetCurrentScheduleValue(Ventilation(I)%DeltaTempSchedPtr)
End If
! Skip this if the zone is below the minimum indoor temperature limit
IF ((ZMAT(NH) < Ventilation(I)%MinIndoorTemperature) .AND. (.NOT. Ventilation(J)%EMSSimpleVentOn ))CYCLE
! Skip this if the zone is above the maximum indoor temperature limit
IF ((ZMAT(NH) > Ventilation(I)%MaxIndoorTemperature) .AND. (.NOT. Ventilation(J)%EMSSimpleVentOn ))CYCLE
! Skip if below the temperature difference limit (3/12/03 Negative DelTemperature allowed now)
IF (((ZMAT(NH)-TempExt) < Ventilation(I)%DelTemperature) .AND. (.NOT. Ventilation(J)%EMSSimpleVentOn ))CYCLE
! Skip this if the outdoor temperature is below the minimum outdoor temperature limit
IF ((TempExt < Ventilation(I)%MinOutdoorTemperature) .AND. (.NOT. Ventilation(J)%EMSSimpleVentOn ))CYCLE
! Skip this if the outdoor temperature is above the maximum outdoor temperature limit
IF ((TempExt > Ventilation(I)%MaxOutdoorTemperature) .AND. (.NOT. Ventilation(J)%EMSSimpleVentOn ))CYCLE
! Skip this if the outdoor wind speed is above the maximum windspeed limit
IF ((WindExt > Ventilation(I)%MaxWindSpeed) .AND. (.NOT. Ventilation(J)%EMSSimpleVentOn ))CYCLE
! Hybrid ventilation controls
If ((Ventilation(J)%HybridControlType == HybridControlTypeClose) .AND. (.NOT. Ventilation(J)%EMSSimpleVentOn ))Cycle
If (Ventilation(J)%HybridControlType == HybridControlTypeGlobal .AND. Ventilation(J)%HybridControlMasterNum > 0) Then
If (J .EQ. I) Ventilation(J)%HybridControlMasterStatus = .TRUE.
End IF
IF (Ventilation(J)%ModelType == VentilationDesignFlowRate) Then
! CR6845 if calculated < 0, don't propagate.
VVF = Ventilation(J)%DesignLevel*GetCurrentScheduleValue(Ventilation(J)%SchedPtr)
IF (Ventilation(J)%EMSSimpleVentOn) VVF = Ventilation(J)%EMSimpleVentFlowRate
IF (VVF < 0.0d0) VVF=0.0d0
VentMCP(J)=VVF*AirDensity*CpAir*( Ventilation(J)%ConstantTermCoef &
+ ABS(TempExt-ZMAT(NZ))*Ventilation(J)%TemperatureTermCoef &
+ WindExt*(Ventilation(J)%VelocityTermCoef + WindExt*Ventilation(J)%VelocitySQTermCoef) )
IF (VentMCP(J) < 0.0d0) VentMCP(J)=0.0d0
VAMFL_temp=VentMCP(J)/CpAir
If (Ventilation(J)%QuadratureSum) Then
SELECT CASE (Ventilation(J)%FanType) ! ventilation type based calculation
CASE (ExhaustVentilation)
ZoneAirBalance(Ventilation(J)%OABalancePtr)%ExhMassFlowRate = &
ZoneAirBalance(Ventilation(J)%OABalancePtr)%ExhMassFlowRate + VentMCP(J)/CpAir
CASE (IntakeVentilation)
ZoneAirBalance(Ventilation(J)%OABalancePtr)%IntMassFlowRate = &
ZoneAirBalance(Ventilation(J)%OABalancePtr)%IntMassFlowRate + VentMCP(J)/CpAir
CASE (NaturalVentilation)
ZoneAirBalance(Ventilation(J)%OABalancePtr)%NatMassFlowRate = &
ZoneAirBalance(Ventilation(J)%OABalancePtr)%NatMassFlowRate + VentMCP(J)/CpAir
CASE (BalancedVentilation)
ZoneAirBalance(Ventilation(J)%OABalancePtr)%BalMassFlowRate = &
ZoneAirBalance(Ventilation(J)%OABalancePtr)%BalMassFlowRate + VentMCP(J)/CpAir
END SELECT
Else
MCPV(NZ) = MCPV(NZ)+VentMCP(J)
VAMFL(NZ) = VAMFL(NZ)+VAMFL_temp
End If
IF (Ventilation(J)%FanEfficiency > 0.0d0) THEN
Ventilation(J)%FanPower = VAMFL_temp*Ventilation(J)%FanPressure/(Ventilation(J)%FanEfficiency*AirDensity)
IF (Ventilation(J)%FanType == BalancedVentilation) Ventilation(J)%FanPower = 2.0d0*Ventilation(J)%FanPower
! calc electric
IF (SimulateAirflowNetwork .EQ. AirflowNetworkControlSimpleADS) THEN
! CR7608 IF (.not. TurnFansOn .or. .not. AirflowNetworkZoneFlag(NZ)) &
IF (.not. KickOffSimulation) THEN
IF (.not. (ZoneEquipAvail(NZ).EQ.CycleOn .OR. ZoneEquipAvail(NZ).EQ.CycleOnZoneFansOnly) .or. &
.not. AirflowNetworkZoneFlag(NZ)) &
ZnAirRpt(NZ)%VentilFanElec = ZnAirRpt(NZ)%VentilFanElec+Ventilation(J)%FanPower*TimeStepSys*SecInHour
ELSEIF (.not. AirflowNetworkZoneFlag(NZ)) THEN
ZnAirRpt(NZ)%VentilFanElec = ZnAirRpt(NZ)%VentilFanElec+Ventilation(J)%FanPower*TimeStepSys*SecInHour
ENDIF
ELSE
ZnAirRpt(NZ)%VentilFanElec = ZnAirRpt(NZ)%VentilFanElec+Ventilation(J)%FanPower*TimeStepSys*SecInHour
END IF
END IF
! Intake fans will add some heat to the air, raising the temperature for an intake fan...
IF (Ventilation(J)%FanType == IntakeVentilation .OR. Ventilation(J)%FanType == BalancedVentilation) THEN
IF (VAMFL_temp == 0.0d0) Then
OutletAirEnthalpy = OutEnthalpy
ELSE
IF (Ventilation(J)%FanPower > 0.0d0) THEN
If (Ventilation(J)%FanType == BalancedVentilation) Then
OutletAirEnthalpy = OutEnthalpy + Ventilation(J)%FanPower/VAMFL_temp/2.0d0 ! Half fan power to calculate inlet T
Else
OutletAirEnthalpy = OutEnthalpy + Ventilation(J)%FanPower/VAMFL_temp
End If
ELSE
OutletAirEnthalpy = OutEnthalpy
ENDIF
END IF
Ventilation(J)%AirTemp = PsyTdbFnHW(OutletAirEnthalpy,OutHumRat)
ELSE
Ventilation(J)%AirTemp = TempExt
END IF
If (.NOT. Ventilation(J)%QuadratureSum) MCPTV(NZ) = MCPTV(NZ)+VentMCP(J)*Ventilation(J)%AirTemp
END IF
If (Ventilation(J)%ModelType == VentilationWindAndStack) Then
If (Ventilation(J)%OpenEff /= AutoCalculate) Then
Cw = Ventilation(J)%OpenEff
Else
! linear interpolation between effective angle and wind direction
angle = abs(WindDir - Ventilation(J)%EffAngle)
If (angle > 180.d0) angle = angle - 180.d0
Cw = 0.55d0 + angle/180.d0*(0.3d0-0.55d0)
End If
If (Ventilation(J)%DiscCoef /= AutoCalculate) Then
Cd = Ventilation(J)%DiscCoef
Else
Cd = 0.40d0 + 0.0045d0*ABS(TempExt-ZMAT(NZ))
End If
Qw = Cw*Ventilation(J)%OpenArea*GetCurrentScheduleValue(Ventilation(J)%OpenAreaSchedPtr)*WindExt
Qst = Cd*Ventilation(J)%OpenArea*GetCurrentScheduleValue(Ventilation(J)%OpenAreaSchedPtr)* &
SQRT(2.d0*9.81d0*Ventilation(J)%DH*ABS(TempExt-ZMAT(NZ))/(ZMAT(NZ)+273.15d0))
VVF = SQRT(Qw*Qw + Qst*Qst)
IF (Ventilation(J)%EMSSimpleVentOn) VVF = Ventilation(J)%EMSimpleVentFlowRate
IF (VVF < 0.0d0) VVF=0.0d0
VentMCP(J)=VVF*AirDensity*CpAir
IF (VentMCP(J) < 0.0d0) VentMCP(J)=0.0d0
If (Ventilation(J)%QuadratureSum) Then
ZoneAirBalance(Ventilation(J)%OABalancePtr)%NatMassFlowRate = &
ZoneAirBalance(Ventilation(J)%OABalancePtr)%NatMassFlowRate + VentMCP(J)/CpAir
Else
MCPV(NZ) = MCPV(NZ)+VentMCP(J)
VAMFL_temp=VentMCP(J)/CpAir
VAMFL(NZ) = VAMFL(NZ)+VAMFL_temp
Ventilation(J)%AirTemp = TempExt
MCPTV(NZ) = MCPTV(NZ)+VentMCP(J)*Ventilation(J)%AirTemp
End If
End If
END DO
! Process Mixing
DO J=1,TotMixing
N=Mixing(J)%ZonePtr
M=Mixing(J)%FromZone
TD=Mixing(J)%DeltaTemperature
! Get scheduled delta temperature
If (Mixing(J)%DeltaTempSchedPtr > 0) Then
TD = GetCurrentScheduleValue(Mixing(J)%DeltaTempSchedPtr)
End If
TZN=ZMAT(N)
TZM=ZMAT(M)
! Hybrid ventilation controls
If (Mixing(J)%HybridControlType == HybridControlTypeClose) Cycle
! Check temperature limit
MixingLimitFlag = .FALSE.
! Hybrid ventilation global control
If (Mixing(J)%HybridControlType == HybridControlTypeGlobal .AND. Mixing(J)%HybridControlMasterNum > 0) Then
I = Mixing(J)%HybridControlMasterNum
If (.NOT. Ventilation(I)%HybridControlMasterStatus) Cycle
Else
! Ensure the minimum indoor temperature <= the maximum indoor temperature
If (Mixing(J)%MinIndoorTempSchedPtr > 0) MixingTmin = GetCurrentScheduleValue(Mixing(J)%MinIndoorTempSchedPtr)
If (Mixing(J)%MaxIndoorTempSchedPtr > 0) MixingTmax = GetCurrentScheduleValue(Mixing(J)%MaxIndoorTempSchedPtr)
If (Mixing(J)%MinIndoorTempSchedPtr > 0 .AND. Mixing(J)%MaxIndoorTempSchedPtr > 0) Then
If (MixingTmin > MixingTmax) Then
Mixing(J)%IndoorTempErrCount = Mixing(J)%IndoorTempErrCount + 1
if (Mixing(J)%IndoorTempErrCount< 2) then
CALL ShowWarningError('Mixing zone temperature control: The minimum zone temperature is above '// &
'the maximum zone temperature in '//TRIM(Mixing(J)%Name))
CALL ShowContinueError('The minimum zone temperature is set to the maximum zone temperature. ' &
//'Simulation continues.')
CALL ShowContinueErrorTimeStamp(' Occurrence info: ')
else
CALL ShowRecurringWarningErrorAtEnd('The minimum zone temperature is still above '// &
'the maximum zone temperature',Mixing(J)%IndoorTempErrIndex, MixingTmin, MixingTmin)
end if
MixingTmin = MixingTmax
End If
End If
If (Mixing(J)%MinIndoorTempSchedPtr > 0) Then
If (TZN < MixingTmin) MixingLimitFlag = .TRUE.
End If
If (Mixing(J)%MaxIndoorTempSchedPtr > 0) Then
If (TZN > MixingTmax) MixingLimitFlag = .TRUE.
End If
! Ensure the minimum source temperature <= the maximum source temperature
If (Mixing(J)%MinSourceTempSchedPtr > 0) MixingTmin = GetCurrentScheduleValue(Mixing(J)%MinSourceTempSchedPtr)
If (Mixing(J)%MaxSourceTempSchedPtr > 0) MixingTmax = GetCurrentScheduleValue(Mixing(J)%MaxSourceTempSchedPtr)
If (Mixing(J)%MinSourceTempSchedPtr > 0 .AND. Mixing(J)%MaxSourceTempSchedPtr > 0) Then
If (MixingTmin > MixingTmax) Then
Mixing(J)%SourceTempErrCount = Mixing(J)%SourceTempErrCount + 1
if (Mixing(J)%SourceTempErrCount< 2) then
CALL ShowWarningError('Mixing source temperature control: The minimum source temperature is above '// &
'the maximum source temperature in '//TRIM(Mixing(J)%Name))
CALL ShowContinueError('The minimum source temperature is set to the maximum source temperature. ' &
//'Simulation continues.')
CALL ShowContinueErrorTimeStamp(' Occurrence info: ')
else
CALL ShowRecurringWarningErrorAtEnd('The minimum source temperature is still above '// &
'the maximum source temperature',Mixing(J)%SourceTempErrIndex, MixingTmin, MixingTmin)
end if
MixingTmin = MixingTmax
End If
End If
If (Mixing(J)%MinSourceTempSchedPtr > 0) Then
If (TZM < MixingTmin) MixingLimitFlag = .TRUE.
End If
If (Mixing(J)%MaxSourceTempSchedPtr > 0) Then
If (TZM > MixingTmax) MixingLimitFlag = .TRUE.
End If
! Ensure the minimum outdoor temperature <= the maximum outdoor temperature
TempExt = Zone(N)%OutDryBulbTemp
If (Mixing(J)%MinOutdoorTempSchedPtr > 0) MixingTmin = GetCurrentScheduleValue(Mixing(J)%MinOutdoorTempSchedPtr)
If (Mixing(J)%MaxOutdoorTempSchedPtr > 0) MixingTmax = GetCurrentScheduleValue(Mixing(J)%MaxOutdoorTempSchedPtr)
If (Mixing(J)%MinOutdoorTempSchedPtr > 0 .AND. Mixing(J)%MaxOutdoorTempSchedPtr > 0) Then
If (MixingTmin > MixingTmax) Then
Mixing(J)%OutdoorTempErrCount = Mixing(J)%OutdoorTempErrCount + 1
if (Mixing(J)%OutdoorTempErrCount< 2) then
CALL ShowWarningError('Mixing outdoor temperature control: The minimum outdoor temperature is above '// &
'the maximum outdoor temperature in '//TRIM(Mixing(J)%Name))
CALL ShowContinueError('The minimum outdoor temperature is set to the maximum source temperature. ' &
//'Simulation continues.')
CALL ShowContinueErrorTimeStamp(' Occurrence info: ')
else
CALL ShowRecurringWarningErrorAtEnd('The minimum outdoor temperature is still above '// &
'the maximum outdoor temperature',Mixing(J)%OutdoorTempErrIndex, MixingTmin, MixingTmin)
end if
MixingTmin = MixingTmax
End If
End If
If (Mixing(J)%MinOutdoorTempSchedPtr > 0) Then
If (TempExt < MixingTmin) MixingLimitFlag = .TRUE.
End If
If (Mixing(J)%MaxOutdoorTempSchedPtr > 0) Then
If (TempExt > MixingTmax) MixingLimitFlag = .TRUE.
End If
End IF
If (Mixing(J)%HybridControlType /= HybridControlTypeGlobal .AND. MixingLimitFlag) Cycle
If (Mixing(J)%HybridControlType == HybridControlTypeGlobal) TD = 0.0d0
! If TD equals zero (default) set coefficients for full mixing otherwise test
! for mixing conditions if user input delta temp > 0, then from zone temp (TZM)
! must be td degrees warmer than zone temp (TZN). If user input delta temp < 0,
! then from zone temp (TZM) must be TD degrees cooler than zone temp (TZN).
IF (TD < 0.0d0) THEN
IF (TZM < TZN+TD) THEN
! Per Jan 17, 2008 conference call, agreed to use average conditions for Rho, Cp and Hfg
! RhoAirM = PsyRhoAirFnPbTdbW(OutBaroPress,tzm,ZHumRat(m))
! MCP=Mixing(J)%DesiredAirFlowRate * PsyCpAirFnWTdb(ZHumRat(m),tzm) * RhoAirM
AirDensity = PsyRhoAirFnPbTdbW(OutBaroPress,(tzn+tzm)/2.0d0,(ZHumRat(n)+ZHumRat(m))/2.0d0)
CpAir = PsyCpAirFnWTdb((ZHumRat(n)+ZHumRat(m))/2.0d0,(tzn+tzm)/2.0d0) ! Use average conditions
MCP=Mixing(J)%DesiredAirFlowRate * CpAir * AirDensity
MCPM(N)=MCPM(N)+MCP
MCPTM(N)=MCPTM(N)+MCP*TZM
! Now to determine the moisture conditions
MixingMassFlowZone(N) = MixingMassFlowZone(N) + Mixing(J)%DesiredAirFlowRate * AirDensity
MixingMassFlowXHumRat(N) = MixingMassFlowXHumRat(N) + Mixing(J)%DesiredAirFlowRate * AirDensity * ZHumRat(M)
IF (Contaminant%CO2Simulation) Then
MixingMassFlowCO2(N) = MixingMassFlowCO2(N) + Mixing(J)%DesiredAirFlowRate * AirDensity * ZoneAirCO2(M)
END IF
IF (Contaminant%GenericContamSimulation) Then
MixingMassFlowGC(N) = MixingMassFlowGC(N) + Mixing(J)%DesiredAirFlowRate * AirDensity * ZoneAirGC(M)
END IF
MixingReportFlag(J) = .TRUE.
END IF
END IF
IF (TD > 0.0d0) THEN
IF (TZM > TZN+TD) THEN
! RhoAirM = PsyRhoAirFnPbTdbW(OutBaroPress,tzm,ZHumRat(m))
! MCP=Mixing(J)%DesiredAirFlowRate * PsyCpAirFnWTdb(ZHumRat(m),tzm) * RhoAirM
AirDensity = PsyRhoAirFnPbTdbW(OutBaroPress,(tzn+tzm)/2.0d0,(ZHumRat(n)+ZHumRat(m))/2.0d0) ! Use avg conditions
CpAir = PsyCpAirFnWTdb((ZHumRat(n)+ZHumRat(m))/2.0d0,(tzn+tzm)/2.0d0) ! Use average conditions
MCP=Mixing(J)%DesiredAirFlowRate * CpAir * AirDensity
MCPM(N)=MCPM(N)+MCP
MCPTM(N)=MCPTM(N)+MCP*TZM
! Now to determine the moisture conditions
MixingMassFlowZone(N) = MixingMassFlowZone(N) + Mixing(J)%DesiredAirFlowRate * AirDensity
MixingMassFlowXHumRat(N) = MixingMassFlowXHumRat(N) + Mixing(J)%DesiredAirFlowRate * AirDensity * ZHumRat(M)
IF (Contaminant%CO2Simulation) Then
MixingMassFlowCO2(N) = MixingMassFlowCO2(N) + Mixing(J)%DesiredAirFlowRate * AirDensity * ZoneAirCO2(M)
END IF
IF (Contaminant%GenericContamSimulation) Then
MixingMassFlowGC(N) = MixingMassFlowGC(N) + Mixing(J)%DesiredAirFlowRate * AirDensity * ZoneAirGC(M)
END IF
MixingReportFlag(J) = .TRUE.
END IF
END IF
IF (TD == 0.0d0) THEN
! RhoAirM = PsyRhoAirFnPbTdbW(OutBaroPress,tzm,ZHumRat(m))
! MCP=Mixing(J)%DesiredAirFlowRate * PsyCpAirFnWTdb(ZHumRat(m),tzm) * RhoAirM
AirDensity = PsyRhoAirFnPbTdbW(OutBaroPress,(tzn+tzm)/2.0d0,(ZHumRat(n)+ZHumRat(m))/2.0d0, &
calledfrom='CalcAirFlowSimple:Mixing') ! Use avg conditions
CpAir = PsyCpAirFnWTdb((ZHumRat(n)+ZHumRat(m))/2.0d0,(tzn+tzm)/2.0d0, &
calledfrom='CalcAirFlowSimple:Mixing') ! Use average conditions
MCP=Mixing(J)%DesiredAirFlowRate * CpAir * AirDensity
MCPM(N)=MCPM(N)+MCP
MCPTM(N)=MCPTM(N)+MCP*TZM
! Now to determine the moisture conditions
MixingMassFlowZone(N) = MixingMassFlowZone(N) + Mixing(J)%DesiredAirFlowRate * AirDensity
MixingMassFlowXHumRat(N) = MixingMassFlowXHumRat(N) + Mixing(J)%DesiredAirFlowRate * AirDensity * ZHumRat(M)
IF (Contaminant%CO2Simulation) Then
MixingMassFlowCO2(N) = MixingMassFlowCO2(N) + Mixing(J)%DesiredAirFlowRate * AirDensity * ZoneAirCO2(M)
END IF
IF (Contaminant%GenericContamSimulation) Then
MixingMassFlowGC(N) = MixingMassFlowGC(N) + Mixing(J)%DesiredAirFlowRate * AirDensity * ZoneAirGC(M)
END IF
MixingReportFlag(J) = .TRUE.
END IF
END DO
! COMPUTE CROSS ZONE
! AIR MIXING
DO J=1,TotCrossMixing
N=CrossMixing(J)%ZonePtr
M=CrossMixing(J)%FromZone
TD=MTC(J)
! Get scheduled delta temperature
If (CrossMixing(J)%DeltaTempSchedPtr > 0) Then
TD = GetCurrentScheduleValue(CrossMixing(J)%DeltaTempSchedPtr)
End If
IF (TD .GE. 0.0d0) THEN
!
TZN=ZMAT(N)
TZM=ZMAT(M)
! Check temperature limit
MixingLimitFlag = .FALSE.
! Ensure the minimum indoor temperature <= the maximum indoor temperature
If (CrossMixing(J)%MinIndoorTempSchedPtr > 0) MixingTmin = GetCurrentScheduleValue(CrossMixing(J)%MinIndoorTempSchedPtr)
If (CrossMixing(J)%MaxIndoorTempSchedPtr > 0) MixingTmax = GetCurrentScheduleValue(CrossMixing(J)%MaxIndoorTempSchedPtr)
If (CrossMixing(J)%MinIndoorTempSchedPtr > 0 .AND. CrossMixing(J)%MaxIndoorTempSchedPtr > 0) Then
If (MixingTmin > MixingTmax) Then
CrossMixing(J)%IndoorTempErrCount = CrossMixing(J)%IndoorTempErrCount + 1
if (CrossMixing(J)%IndoorTempErrCount< 2) then
CALL ShowWarningError('CrossMixing zone temperature control: The minimum zone temperature is above '// &
'the maximum zone temperature in '//TRIM(CrossMixing(J)%Name))
CALL ShowContinueError('The minimum zone temperature is set to the maximum zone temperature. ' &
//'Simulation continues.')
CALL ShowContinueErrorTimeStamp(' Occurrence info: ')
else
CALL ShowRecurringWarningErrorAtEnd('The minimum zone temperature is still above '// &
'the maximum zone temperature',CrossMixing(J)%IndoorTempErrIndex, MixingTmin, MixingTmin)
end if
MixingTmin = MixingTmax
End If
End If
If (CrossMixing(J)%MinIndoorTempSchedPtr > 0) Then
If (TZN < MixingTmin) MixingLimitFlag = .TRUE.
End If
If (CrossMixing(J)%MaxIndoorTempSchedPtr > 0) Then
If (TZN > MixingTmax) MixingLimitFlag = .TRUE.
End If
! Ensure the minimum source temperature <= the maximum source temperature
If (CrossMixing(J)%MinSourceTempSchedPtr > 0) MixingTmin = GetCurrentScheduleValue(CrossMixing(J)%MinSourceTempSchedPtr)
If (CrossMixing(J)%MaxSourceTempSchedPtr > 0) MixingTmax = GetCurrentScheduleValue(CrossMixing(J)%MaxSourceTempSchedPtr)
If (CrossMixing(J)%MinSourceTempSchedPtr > 0 .AND. CrossMixing(J)%MaxSourceTempSchedPtr > 0) Then
If (MixingTmin > MixingTmax) Then
CrossMixing(J)%SourceTempErrCount = CrossMixing(J)%SourceTempErrCount + 1
if (CrossMixing(J)%SourceTempErrCount< 2) then
CALL ShowWarningError('CrossMixing source temperature control: The minimum source temperature is above '// &
'the maximum source temperature in '//TRIM(CrossMixing(J)%Name))
CALL ShowContinueError('The minimum source temperature is set to the maximum source temperature. ' &
//'Simulation continues.')
CALL ShowContinueErrorTimeStamp(' Occurrence info: ')
else
CALL ShowRecurringWarningErrorAtEnd('The minimum source temperature is still above '// &
'the maximum source temperature',CrossMixing(J)%SourceTempErrIndex, MixingTmin, MixingTmin)
end if
MixingTmin = MixingTmax
End If
End If
If (CrossMixing(J)%MinSourceTempSchedPtr > 0) Then
If (TZM < MixingTmin) MixingLimitFlag = .TRUE.
End If
If (CrossMixing(J)%MaxSourceTempSchedPtr > 0) Then
If (TZM > MixingTmax) MixingLimitFlag = .TRUE.
End If
! Ensure the minimum outdoor temperature <= the maximum outdoor temperature
TempExt = Zone(N)%OutDryBulbTemp
If (CrossMixing(J)%MinOutdoorTempSchedPtr > 0) MixingTmin = GetCurrentScheduleValue(CrossMixing(J)%MinOutdoorTempSchedPtr)
If (CrossMixing(J)%MaxOutdoorTempSchedPtr > 0) MixingTmax = GetCurrentScheduleValue(CrossMixing(J)%MaxOutdoorTempSchedPtr)
If (CrossMixing(J)%MinOutdoorTempSchedPtr > 0 .AND. CrossMixing(J)%MaxOutdoorTempSchedPtr > 0) Then
If (MixingTmin > MixingTmax) Then
CrossMixing(J)%OutdoorTempErrCount = CrossMixing(J)%OutdoorTempErrCount + 1
if (CrossMixing(J)%OutdoorTempErrCount< 2) then
CALL ShowWarningError('CrossMixing outdoor temperature control: The minimum outdoor temperature is above '// &
'the maximum outdoor temperature in '//TRIM(Mixing(J)%Name))
CALL ShowContinueError('The minimum outdoor temperature is set to the maximum source temperature. ' &
//'Simulation continues.')
CALL ShowContinueErrorTimeStamp(' Occurrence info: ')
else
CALL ShowRecurringWarningErrorAtEnd('The minimum outdoor temperature is still above '// &
'the maximum outdoor temperature',CrossMixing(J)%OutdoorTempErrIndex, MixingTmin, MixingTmin)
end if
MixingTmin = MixingTmax
End If
End If
If (CrossMixing(J)%MinOutdoorTempSchedPtr > 0) Then
If (TempExt < MixingTmin) MixingLimitFlag = .TRUE.
End If
If (CrossMixing(J)%MaxOutdoorTempSchedPtr > 0) Then
If (TempExt > MixingTmax) MixingLimitFlag = .TRUE.
End If
If (MixingLimitFlag) Cycle
IF ( ( TD .EQ. 0.0d0 .OR. ( TD .GT. 0.0d0 .AND. (TZM-TZN) .GE. TD) ) ) THEN
CrossMixingReportFlag(J) = .TRUE. ! set reporting flag
END IF
IF ( ( TD .LE. 0.0d0 .AND. (.NOT. CrossMixingFlag(N) .AND. .NOT. CrossMixingFlag(M) ) &
.OR. ( TD .GT. 0.0d0 .AND. (TZM-TZN) .GE. TD) ) ) THEN
! SET COEFFICIENTS .
CrossMixingFlag(N) = .TRUE.
CrossMixingFlag(M) = .TRUE.
Tavg = (tzn+tzm)/2.0d0
Wavg = (ZHumRat(n)+ZHumRat(m))/2.0d0
AirDensity = PsyRhoAirFnPbTdbW(OutBaroPress,Tavg,Wavg,calledfrom='CalcAirFlowSimple:CrossMixing')
CpAir = PsyCpAirFnWTdb(Wavg,Tavg,calledfrom='CalcAirFlowSimple:CrossMixing')
MCPxN=MVFC(J) * CpAir * AirDensity
MCPM(N)=MCPM(N)+MCPxN
MCPxM=MVFC(J) * CpAir * AirDensity
MCPM(M)=MCPM(M)+MCPxM
MCPTM(N)=MCPTM(N)+MCPxM*TZM
MCPTM(M)=MCPTM(M)+MCPxN*TZN
! Now to determine the moisture conditions
MixingMassFlowZone(M) = MixingMassFlowZone(M) + MVFC(J)*AirDensity
MixingMassFlowXHumRat(M) = MixingMassFlowXHumRat(M) + MVFC(J) * AirDensity * ZHumRat(n)
MixingMassFlowZone(N) = MixingMassFlowZone(N) + MVFC(J)*AirDensity
MixingMassFlowXHumRat(N) = MixingMassFlowXHumRat(N) + MVFC(J)*AirDensity*ZHumRat(m)
IF (Contaminant%CO2Simulation) Then
MixingMassFlowCO2(M) = MixingMassFlowCO2(M) + MVFC(J) * AirDensity * ZoneAirCO2(n)
MixingMassFlowCO2(N) = MixingMassFlowCO2(N) + MVFC(J) * AirDensity * ZoneAirCO2(m)
END IF
IF (Contaminant%GenericContamSimulation) Then
MixingMassFlowGC(M) = MixingMassFlowGC(M) + MVFC(J) * AirDensity * ZoneAirGC(n)
MixingMassFlowGC(N) = MixingMassFlowGC(N) + MVFC(J) * AirDensity * ZoneAirGC(m)
END IF
END IF
END IF
END DO
! COMPUTE REFRIGERATION DOOR
! AIR MIXING
IF(TotRefDoorMixing > 0) THEN
!Zone loops structured in getinput so only do each pair of zones bounding door once, even if multiple doors in one zone
DO ZoneA=1,(NumofZones - 1)
IF(.NOT. RefDoorMixing(ZoneA)%RefDoorMixFlag)CYCLE
DO J=1,RefDoorMixing(ZoneA)%NumRefDoorConnections
ZoneB = RefDoorMixing(ZoneA)%MateZonePtr(J)
TZoneA=ZMAT(ZoneA)
TZoneB=ZMAT(ZoneB)
HumRatZoneA=ZHumRat(ZoneA)
HumRatZoneB=ZHumRat(ZoneB)
AirDensityZoneA = PsyRhoAirFnPbTdbW(OutBaroPress,TZoneA,HumRatZoneA,calledfrom='CalcAirFlowSimple:RefrigerationDoorMixing')
CpAirZoneA = PsyCpAirFnWTdb(HumRatZoneA,TZoneA)
AirDensityZoneB = PsyRhoAirFnPbTdbW(OutBaroPress,TZoneB,HumRatZoneB,calledfrom='CalcAirFlowSimple:RefrigerationDoorMixing')
CpAirZoneB = PsyCpAirFnWTdb(HumRatZoneB,TZoneB,calledfrom='CalcAirFlowSimple:RefrigerationDoorMixing')
Tavg = (TZoneA + TZoneB)/2.0d0
Wavg = (HumRatZoneA + HumRatZoneB)/2.0d0
AirDensityAvg = PsyRhoAirFnPbTdbW(OutBaroPress,Tavg,Wavg,calledfrom='CalcAirFlowSimple:RefrigerationDoorMixing')
IF(RefDoorMixing(ZoneA)%EMSRefDoorMixingOn(J)) THEN
MassFlowDryAir = RefDoorMixing(ZoneA)%VolRefDoorFlowRate(J) * AirDensityAvg
ELSE
SchedDoorOpen = GetCurrentScheduleValue(RefDoorMixing(ZoneA)%OpenSchedPtr(J))
IF(SchedDoorOpen == 0.d0) CYCLE
DoorHeight = RefDoorMixing(ZoneA)%DoorHeight(J)
DoorArea = RefDoorMixing(ZoneA)%DoorArea(J)
DoorProt = RefDoorMixing(ZoneA)%Protection(J)
IF(AirDensityZoneA .GE. AirDensityZoneB) THEN
! Mass of dry air flow between zones is equal,
! but have to calc directionally to avoid sqrt(neg number)
FDens = (2.d0/(1.d0+((AirDensityZoneA/AirDensityZoneB)**(1.d0/3.d0))))**1.5d0
FB = 0.221d0 * DoorArea * AirDensityZoneA * FDens * &
SQRT((1.d0-AirDensityZoneB/AirDensityZoneA)*StdGravity*DoorHeight)
ELSE !ZoneADens < ZoneBDens
FDens = (2.d0/(1.d0+((AirDensityZoneB/AirDensityZoneA)**(1.d0/3.d0))))**1.5d0
FB = 0.221d0 * DoorArea * AirDensityZoneB * FDens * &
SQRT((1.d0-AirDensityZoneA/AirDensityZoneB)*StdGravity*DoorHeight)
END IF !ZoneADens .GE. ZoneBDens
! FFlow = Doorway flow factor, is determined by temperature difference
FFlow = 1.1d0
IF(ABS(TZoneA - TZoneB) > 11.d0)FFlow = 0.8d0
MassFlowDryAir = FB *SchedDoorOpen * FFlow * (1.d0 - DoorProt)
RefDoorMixing(ZoneA)%VolRefDoorFlowRate(J) = MassFlowDryAir/AirDensityAvg
!Note - VolRefDoorFlowRate is used ONLY for reporting purposes, where it is
! used with the avg density to generate a reported mass flow
! Considering the small values typical for HumRat, this is not far off.
END IF ! EMSRefDoorMixingOn
MassFlowToA = MassFlowDryAir * (1.d0 + HumRatZoneB)
MassFlowToB = MassFlowDryAir * (1.d0 + HumRatZoneA)
MassFlowXCpToA = MassFlowToA * CpAirZoneB
MassFlowXCpToB = MassFlowToB * CpAirZoneA
MassFlowXCpXTempToA = MassFlowXCpToA * TZoneB
MassFlowXCpXTempToB = MassFlowXCpToB * TZoneA
MassFlowXHumRatToA = MassFlowToA * HumRatZoneB
MassFlowXHumRatToB = MassFlowToB * HumRatZoneA
MCPM(ZoneA) = MCPM(ZoneA) + MassFlowXCpToA
MCPM(ZoneB) = MCPM(ZoneB) + MassFlowXCpToB
MCPTM(ZoneA) = MCPTM(ZoneA)+ MassFlowXCpXTempToA
MCPTM(ZoneB) = MCPTM(ZoneB)+ MassFlowXCpXTempToB
! Now to determine the moisture conditions
MixingMassFlowZone(ZoneA) = MixingMassFlowZone(ZoneA) + MassFlowToA
MixingMassFlowZone(ZoneB) = MixingMassFlowZone(ZoneB) + MassFlowToB
MixingMassFlowXHumRat(ZoneA) = MixingMassFlowXHumRat(ZoneA) + MassFlowXHumRatToA
MixingMassFlowXHumRat(ZoneB) = MixingMassFlowXHumRat(ZoneB) + MassFlowXHumRatToB
! Now to determine the CO2 and generic contaminant conditions
IF (Contaminant%CO2Simulation) Then
MixingMassFlowCO2(ZoneA) = MixingMassFlowCO2(ZoneA) + MassFlowToA * ZoneAirCO2(ZoneB)
MixingMassFlowCO2(ZoneB) = MixingMassFlowCO2(ZoneB) + MassFlowToB * ZoneAirCO2(ZoneA)
END IF
IF (Contaminant%GenericContamSimulation) Then
MixingMassFlowCO2(ZoneA) = MixingMassFlowCO2(ZoneA) + MassFlowToA * ZoneAirGC(ZoneB)
MixingMassFlowCO2(ZoneB) = MixingMassFlowCO2(ZoneB) + MassFlowToB * ZoneAirGC(ZoneA)
END IF
END DO ! J=1,RefDoorMixing(ZoneA)%NumRefDoorConnections
END DO !ZoneA=1,(NumofZones - 1)
END IF !(TotRefrigerationDoorMixing > 0) THEN
! Process the scheduled Infiltration for air heat balance depending on model type
DO J=1,TotInfiltration
NZ=Infiltration(J)%ZonePtr
TempExt = Zone(NZ)%OutDryBulbTemp
WindExt = Zone(NZ)%WindSpeed
AirDensity = PsyRhoAirFnPbTdbW(OutBaroPress,TempExt,OutHumRat,calledfrom='CalcAirFlowSimple:Infiltration')
CpAir = PsyCpAirFnWTdb(OutHumRat,TempExt)
!CR7751 should maybe use code below, indoor conditions instead of outdoor conditions
! AirDensity = PsyRhoAirFnPbTdbW(OutBaroPress, ZMAT(NZ), ZHumRat(NZ))
! CpAir = PsyCpAirFnWTdb(ZHumRat(NZ),ZMAT(NZ))
Select Case (Infiltration(J)%ModelType)
CASE (InfiltrationDesignFlowRate)
IVF=Infiltration(J)%DesignLevel*GetCurrentScheduleValue(Infiltration(J)%SchedPtr)
! CR6845 if calculated < 0.0, don't propagate
IF (IVF < 0.0d0) IVF=0.0D0
MCpI_temp=IVF*AirDensity*CpAir*( Infiltration(J)%ConstantTermCoef &
+ ABS(TempExt-ZMAT(NZ))*Infiltration(J)%TemperatureTermCoef &
+ WindExt*(Infiltration(J)%VelocityTermCoef + WindExt*Infiltration(J)%VelocitySQTermCoef) )
IF (MCpI_temp < 0.0D0) MCpI_temp=0.0D0
CASE (InfiltrationShermanGrimsrud)
! Sherman Grimsrud model as formulated in ASHRAE HoF
WindExt = WindSpeed ! formulated to use wind at Meterological Station rather than local
IVF=GetCurrentScheduleValue(Infiltration(J)%SchedPtr) &
* Infiltration(J)%LeakageArea / 1000.0D0 &
* SQRT( Infiltration(J)%BasicStackCoefficient * ABS(TempExt-ZMAT(NZ)) &
+ Infiltration(J)%BasicWindCoefficient * WindExt**2 )
IF (IVF < 0.0D0) IVF=0.0D0
MCpI_temp=IVF*AirDensity*CpAir
IF (MCpI_temp < 0.0d0) MCpI_temp=0.0D0
CASE (InfiltrationAIM2)
! Walker Wilson model as formulated in ASHRAE HoF
IVF=GetCurrentScheduleValue(Infiltration(J)%SchedPtr) &
* SQRT( ( Infiltration(J)%FlowCoefficient * Infiltration(J)%AIM2StackCoefficient &
* (ABS(TempExt-ZMAT(NZ)) )**Infiltration(J)%PressureExponent)**2 &
+ (Infiltration(J)%FlowCoefficient * Infiltration(J)%AIM2WindCoefficient &
* (Infiltration(J)%ShelterFactor * WindExt)**(2.0D0*Infiltration(J)%PressureExponent) )**2 )
IF (IVF < 0.0D0) IVF=0.0D0
MCpI_temp=IVF*AirDensity*CpAir
IF (MCpI_temp < 0.0d0) MCpI_temp=0.0d0
END SELECT
IF (Infiltration(J)%EMSOverrideOn) THEN
IVF= Infiltration(J)%EMSAirFlowRateValue
IF (IVF < 0.0D0) IVF=0.0D0
MCpI_temp=IVF*AirDensity*CpAir
IF (MCpI_temp < 0.0D0) MCpI_temp=0.0D0
ENDIF
If (Infiltration(J)%QuadratureSum) Then
ZoneAirBalance(Infiltration(J)%OABalancePtr)%InfMassFlowRate = &
ZoneAirBalance(Infiltration(J)%OABalancePtr)%InfMassFlowRate + MCpI_temp/CpAir
Else
MCPI(NZ) = MCPI(NZ)+MCpI_temp
OAMFL(NZ)=OAMFL(NZ)+MCpI_temp/CpAir
MCPTI(NZ)=MCPTI(NZ)+MCpI_temp*TempExt
End If
ENDDO
! Add infiltration rate enhanced by the existence of thermal chimney
DO NZ=1,NumOfZones
MCPI(NZ)= MCPI(NZ) + MCPThermChim(NZ)
OAMFL(NZ)= OAMFL(NZ) + ThermChimAMFL(NZ)
MCPTI(NZ)= MCPTI(NZ) + MCPTThermChim(NZ)
END DO
! Calculate combined outdoor air flows
Do J =1, TotZoneAirBalance
IF (ZoneAirBalance(J)%BalanceMethod== AirBalanceQuadrature) THEN
IF (.NOT. ZoneAirBalance(j)%OneTimeFlag) Call GetStandAloneERVNodes(J)
If (ZoneAirBalance(J)%NumOfERVs > 0) Then
Do I=1,ZoneAirBalance(j)%NumOfERVs
MassFlowDiff = Node(ZoneAirBalance(j)%ERVExhaustNode(I))%MassFlowRate - &
Node(ZoneAirBalance(j)%ERVInletNode(I))%MassFlowRate
If (MassFlowDiff > 0.d0) Then
ZoneAirBalance(J)%ERVMassFlowRate = ZoneAirBalance(J)%ERVMassFlowRate + MassFlowDiff
End If
End Do
End If
NZ = ZoneAirBalance(j)%ZonePtr
AirDensity = PsyRhoAirFnPbTdbW(OutBaroPress,Zone(NZ)%OutDryBulbTemp,OutHumRat,calledfrom='CalcAirFlowSimple:ZoneAirBalance')
CpAir = PsyCpAirFnWTdb(OutHumRat,Zone(NZ)%OutDryBulbTemp)
ZoneAirBalance(J)%ERVMassFlowRate = AirDensity*ZoneAirBalance(J)%ERVMassFlowRate
MdotOA(NZ) = SQRT((ZoneAirBalance(j)%NatMassFlowRate)**2 + (ZoneAirBalance(j)%IntMassFlowRate)**2 + &
(ZoneAirBalance(j)%ExhMassFlowRate)**2 + (ZoneAirBalance(j)%ERVMassFlowRate)**2 + &
(ZoneAirBalance(j)%InfMassFlowRate)**2 + &
(AirDensity*ZoneAirBalance(j)%InducedAirRate*GetCurrentScheduleValue(ZoneAirBalance(J)%InducedAirSchedPtr))**2) + &
ZoneAirBalance(j)%BalMassFlowRate
MdotCPOA(NZ) = MdotOA(NZ)*CpAir
END IF
End Do
RETURN
END SUBROUTINE CalcAirFlowSimple