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 | ||
---|---|---|---|---|---|---|
logical, | intent(in) | :: | ShortenTimeStepSys | |||
logical, | intent(in) | :: | UseZoneTimeStepHistory | |||
real(kind=r64), | intent(in) | :: | PriorTimeStep |
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 PredictZoneContaminants(ShortenTimeStepSys, UseZoneTimeStepHistory, PriorTimeStep)
! SUBROUTINE INFORMATION:
! AUTHOR Lixing Gu
! DATE WRITTEN May 2010
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine does the prediction step for contaminant control
! METHODOLOGY EMPLOYED:
! This solves for the required outdoor airflow to achieve the desired
! contaminant setpoint in the Zone
! REFERENCES:
! na
! USE STATEMENTS:
USE ScheduleManager, ONLY: GetCurrentScheduleValue
USE General, ONLY: RoundSigDigits
USE DataLoopNode, ONLY: Node
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(IN) :: ShortenTimeStepSys
LOGICAL, INTENT(IN) :: UseZoneTimeStepHistory ! if true then use zone timestep history, if false use system time step
REAL(r64), INTENT(IN) :: PriorTimeStep ! the old value for timestep length is passed for possible use in interpolating
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: CO2Gain ! Zone CO2 internal load
REAL(r64) :: RhoAir ! Zone air density
REAL(r64) :: A ! Coefficient of storage term in a zone balance equation
REAL(r64) :: B ! Coefficient of variable term in a zone balance equation
REAL(r64) :: C ! Coefficient of constnat term in a zone balance equation
REAL(r64) :: SysTimeStepInSeconds ! System time step lenght [s]
LOGICAL :: ControlledCO2ZoneFlag ! This determines whether this is a CO2 controlled zone or not
REAL(r64) :: LoadToCO2SetPoint ! CO2 load at CO2 set point
INTEGER :: ContControlledZoneNum ! The Splitter that you are currently loading input into
INTEGER :: ZoneNum
INTEGER :: I
REAL(r64) :: ZoneAirCO2Setpoint ! Zone CO2 setpoint
REAL(r64) :: LoadToGCSetPoint ! Generic contaminant load at generic contaminant set point
LOGICAL :: ControlledGCZoneFlag ! This determines whether this is a generic contaminant controlled zone or not
REAL(r64) :: ZoneAirGCSetpoint ! Zone generic contaminant setpoint
REAL(r64) :: GCGain ! Zone generic contaminant internal load
! REAL(r64) :: Temp ! Zone generic contaminant internal load
! FLOW:
! Update zone CO2
DO ZoneNum = 1, NumofZones
IF (ShortenTimeStepSys) THEN !
IF (Zone(ZoneNum)%SystemZoneNodeNumber > 0) THEN ! roll back result for zone air node,
IF (Contaminant%CO2Simulation) &
Node(Zone(ZoneNum)%SystemZoneNodeNumber)%CO2 = CO2ZoneTimeMinus1(ZoneNum)
IF (Contaminant%GenericContamSimulation) &
Node(Zone(ZoneNum)%SystemZoneNodeNumber)%GenContam = GCZoneTimeMinus1(ZoneNum)
ENDIF
IF (NumOfSysTimeSteps /= NumOfSysTimeStepsLastZoneTimeStep) THEN ! cannot reuse existing DS data, interpolate from zone time
IF (Contaminant%CO2Simulation) &
Call DownInterpolate4HistoryValues(PriorTimeStep,TimeStepSys, &
CO2ZoneTimeMinus1(ZoneNum), CO2ZoneTimeMinus2(ZoneNum), &
CO2ZoneTimeMinus3(ZoneNum), CO2ZoneTimeMinus4(ZoneNum), CO2ZoneTimeMinus4(ZoneNum),&
ZoneAirCO2(ZoneNum), DSCO2ZoneTimeMinus1(ZoneNum), DSCO2ZoneTimeMinus2(ZoneNum), &
DSCO2ZoneTimeMinus3(ZoneNum), DSCO2ZoneTimeMinus4(ZoneNum))
IF (Contaminant%GenericContamSimulation) &
Call DownInterpolate4HistoryValues(PriorTimeStep,TimeStepSys, &
GCZoneTimeMinus1(ZoneNum), GCZoneTimeMinus2(ZoneNum), &
GCZoneTimeMinus3(ZoneNum), GCZoneTimeMinus4(ZoneNum), GCZoneTimeMinus4(ZoneNum),&
ZoneAirGC(ZoneNum), DSGCZoneTimeMinus1(ZoneNum), DSGCZoneTimeMinus2(ZoneNum), &
DSGCZoneTimeMinus3(ZoneNum), DSGCZoneTimeMinus4(ZoneNum))
ELSE ! reuse history data in DS terms from last zone time step to preserve information that would be lost
! do nothing because DS history would have been pushed prior and should be ready
ENDIF
ENDIF
! now update the variables actually used in the balance equations.
IF(UseZoneTimeStepHistory) THEN
IF (Contaminant%CO2Simulation) Then
CO2ZoneTimeMinus1Temp(ZoneNum) = CO2ZoneTimeMinus1(ZoneNum)
CO2ZoneTimeMinus2Temp(ZoneNum) = CO2ZoneTimeMinus2(ZoneNum)
CO2ZoneTimeMinus3Temp(ZoneNum) = CO2ZoneTimeMinus3(ZoneNum)
End If
IF (Contaminant%GenericContamSimulation) Then
GCZoneTimeMinus1Temp(ZoneNum) = GCZoneTimeMinus1(ZoneNum)
GCZoneTimeMinus2Temp(ZoneNum) = GCZoneTimeMinus2(ZoneNum)
GCZoneTimeMinus3Temp(ZoneNum) = GCZoneTimeMinus3(ZoneNum)
End If
ELSE ! use down-stepped history
IF (Contaminant%CO2Simulation) Then
CO2ZoneTimeMinus1Temp(ZoneNum) = DSCO2ZoneTimeMinus1(ZoneNum)
CO2ZoneTimeMinus2Temp(ZoneNum) = DSCO2ZoneTimeMinus2(ZoneNum)
CO2ZoneTimeMinus3Temp(ZoneNum) = DSCO2ZoneTimeMinus3(ZoneNum)
End If
IF (Contaminant%GenericContamSimulation) Then
GCZoneTimeMinus1Temp(ZoneNum) = DSGCZoneTimeMinus1(ZoneNum)
GCZoneTimeMinus2Temp(ZoneNum) = DSGCZoneTimeMinus2(ZoneNum)
GCZoneTimeMinus3Temp(ZoneNum) = DSGCZoneTimeMinus3(ZoneNum)
End If
END IF
If (ZoneAirSolutionAlgo .NE. Use3rdOrder) Then
IF (Contaminant%CO2Simulation) Then
If (ShortenTimeStepSys .and. TimeStepSys .LT. TimeStepZone) Then
If (PreviousTimeStep < TimeStepZone) Then
ZoneCO21(ZoneNum) = ZoneCO2M2(ZoneNum)
Else
ZoneCO21(ZoneNum) = ZoneCO2MX(ZoneNum)
End If
ShortenTimeStepSysRoomAir = .TRUE.
Else
ZoneCO21(ZoneNum) = ZoneAirCO2(ZoneNum)
End If
End If
IF (Contaminant%GenericContamSimulation) Then
If (ShortenTimeStepSys .and. TimeStepSys .LT. TimeStepZone) Then
If (PreviousTimeStep < TimeStepZone) Then
ZoneGC1(ZoneNum) = ZoneGCM2(ZoneNum)
Else
ZoneGC1(ZoneNum) = ZoneGCMX(ZoneNum)
End If
ShortenTimeStepSysRoomAir = .TRUE.
Else
ZoneGC1(ZoneNum) = ZoneAirGC(ZoneNum)
End If
End If
End If
IF (Contaminant%CO2Simulation) Then
CO2PredictedRate(ZoneNum) = 0.0d0
LoadToCO2SetPoint=0.0d0
ZoneSysContDemand(ZoneNum)%OutputRequiredToCO2SP = 0.0d0
! Check to see if this is a "CO2 controlled zone"
ControlledCO2ZoneFlag = .FALSE.
! Check all the controlled zones to see if it matches the zone simulated
DO ContControlledZoneNum = 1, NumContControlledZones
IF (GetCurrentScheduleValue(ContaminantControlledZone(ContControlledZoneNum)%AvaiSchedPtr) .GT. 0.d0) Then
ZoneAirCO2Setpoint = ZoneCO2Setpoint(ContaminantControlledZone(ContControlledZoneNum)%ActualZoneNum)
IF (ContaminantControlledZone(ContControlledZoneNum)%EMSOverrideCO2SetpointOn) THEN
ZoneAirCO2Setpoint = ContaminantControlledZone(ContControlledZoneNum)%EMSOverrideCO2SetpointValue
End If
If (ContaminantControlledZone(ContControlledZoneNum)%NumOfZones > 1) Then
IF (ContaminantControlledZone(ContControlledZoneNum)%ActualZoneNum /= ZoneNum) Then
Do I=1,ContaminantControlledZone(ContControlledZoneNum)%NumOfZones
If (ContaminantControlledZone(ContControlledZoneNum)%ControlZoneNum(I) == ZoneNum) Then
ControlledCO2ZoneFlag = .TRUE.
Exit
End If
End Do
If (ControlledCO2ZoneFlag) Exit
ELSE
ControlledCO2ZoneFlag = .TRUE.
EXIT
End If
ENDIF
ENDIF
END DO ! CO2ControlledZoneNum
If (ControlledCO2ZoneFlag) Then
! The density of air
RhoAir = PsyRhoAirFnPbTdbW(OutBaroPress,ZT(ZoneNum),ZoneAirHumRat(ZoneNum),'PredictZoneContaminants')
! Calculate Co2 from infiltration + humidity added from latent load
! to determine system added/subtracted moisture.
CO2Gain = ZoneCO2Gain(ZoneNum)*RhoAir*1.0d6
SysTimeStepInSeconds = SecInHour * TimeStepSys
! Calculate the coefficients for the 3rd Order derivative for final
! zone CO2. The A, B, C coefficients are analogous to the CO2 balance.
! Assume that the system will have flow
if (SimulateAirflowNetwork == AirflowNetworkControlMultizone.OR.SimulateAirflowNetwork == AirflowNetworkControlMultiADS &
.OR. (SimulateAirflowNetwork == AirflowNetworkControlSimpleADS .AND. AirflowNetworkFanActivated)) then
! Multizone airflow calculated in AirflowNetwork
B = CO2Gain + AirflowNetworkExchangeData(ZoneNum)%SumMHrCO + &
AirflowNetworkExchangeData(ZoneNum)%SumMMHrCO
A = AirflowNetworkExchangeData(ZoneNum)%SumMHr+AirflowNetworkExchangeData(ZoneNum)%SumMMHr
else
B = CO2Gain + ((oamfl(ZoneNum) + vamfl(ZoneNum) + eamfl(ZoneNum) + ctmfl(ZoneNum)) * OutdoorCO2) + &
MixingMassFlowCO2(ZoneNum)
A = oamfl(ZoneNum) + vamfl(ZoneNum) + eamfl(ZoneNum) + ctmfl(ZoneNum) + MixingMassFlowZone(ZoneNum)
end if
C = RhoAir * Zone(ZoneNum)%Volume * ZoneVolCapMultpCO2 / SysTimeStepInSeconds
! Use a 3rd Order derivative to predict zone moisture addition or removal and
! smooth the changes using the zone air capacitance. Positive values of CO2 Load means that
! this amount of CO2 must be added to the zone to reach the setpoint. Negative values represent
! the amount of CO2 that must be removed by the system.
SELECT CASE (ZoneAirSolutionAlgo)
CASE (Use3rdOrder)
LoadToCO2SetPoint = ((11.0d0/6.0d0) * C + A) * ZoneAirCO2Setpoint - &
(B + C * (3.0d0 * CO2ZoneTimeMinus1Temp(ZoneNum) - (3.0d0/2.0d0) * CO2ZoneTimeMinus2Temp(ZoneNum) + &
(1.0d0/3.0d0) * CO2ZoneTimeMinus3Temp(ZoneNum)))
! Exact solution
CASE (UseAnalyticalSolution)
If (A .eq. 0.0d0) Then ! B=0
LoadToCO2SetPoint = C*(ZoneAirCO2Setpoint-ZoneCO21(ZoneNum)) - B
Else
LoadToCO2SetPoint = A*(ZoneAirCO2Setpoint-ZoneCO21(ZoneNum)*exp(MIN(700.d0,-A/C)))/(1.0d0-exp(MIN(700.d0,-A/C))) - B
End If
CASE (UseEulerMethod)
LoadToCO2SetPoint = C*(ZoneAirCO2Setpoint-ZoneCO21(ZoneNum)) + A*ZoneAirCO2Setpoint - B
END SELECT
If (ZoneAirCO2Setpoint .GT. OutdoorCO2 .AND. LoadToCo2SetPoint < 0.0d0) Then
ZoneSysContDemand(ZoneNum)%OutputRequiredToCO2SP = LoadToCo2SetPoint/(OutdoorCO2 - ZoneAirCO2Setpoint)
End If
End If
! Apply the Zone Multiplier to the total zone moisture load
ZoneSysContDemand(ZoneNum)%OutputRequiredToCO2SP = ZoneSysContDemand(ZoneNum)%OutputRequiredToCO2SP &
* Zone(ZoneNum)%Multiplier * Zone(ZoneNum)%ListMultiplier
CO2PredictedRate(ZoneNum) = ZoneSysContDemand(ZoneNum)%OutputRequiredToCO2SP
End If
IF (Contaminant%GenericContamSimulation) Then
GCPredictedRate(ZoneNum) = 0.0d0
LoadToGCSetPoint=0.0d0
ZoneSysContDemand(ZoneNum)%OutputRequiredToGCSP = 0.0d0
! Check to see if this is a "GC controlled zone"
ControlledGCZoneFlag = .FALSE.
! Check all the controlled zones to see if it matches the zone simulated
DO ContControlledZoneNum = 1, NumContControlledZones
IF (GetCurrentScheduleValue(ContaminantControlledZone(ContControlledZoneNum)%AvaiSchedPtr) .GT. 0.d0) Then
ZoneAirGCSetpoint = ZoneGCSetpoint(ContaminantControlledZone(ContControlledZoneNum)%ActualZoneNum)
IF (ContaminantControlledZone(ContControlledZoneNum)%EMSOverrideGCSetpointOn) THEN
ZoneAirGCSetpoint = ContaminantControlledZone(ContControlledZoneNum)%EMSOverrideGCSetpointValue
End If
If (ContaminantControlledZone(ContControlledZoneNum)%NumOfZones > 1) Then
IF (ContaminantControlledZone(ContControlledZoneNum)%ActualZoneNum /= ZoneNum) Then
Do I=1,ContaminantControlledZone(ContControlledZoneNum)%NumOfZones
If (ContaminantControlledZone(ContControlledZoneNum)%ControlZoneNum(I) == ZoneNum) Then
ControlledGCZoneFlag = .TRUE.
Exit
End If
End Do
If (ControlledGCZoneFlag) Exit
ELSE
ControlledGCZoneFlag = .TRUE.
EXIT
End If
ENDIF
ENDIF
END DO ! GCControlledZoneNum
If (ControlledGCZoneFlag) Then
! The density of air
RhoAir = PsyRhoAirFnPbTdbW(OutBaroPress,ZT(ZoneNum),ZoneAirHumRat(ZoneNum),'PredictZoneContaminants')
! Calculate generic contaminant from infiltration + humidity added from latent load
! to determine system added/subtracted moisture.
GCGain = ZoneGCGain(ZoneNum)*RhoAir*1.0d6
SysTimeStepInSeconds = SecInHour * TimeStepSys
! Calculate the coefficients for the 3rd Order derivative for final
! zone GC. The A, B, C coefficients are analogous to the GC balance.
! Assume that the system will have flow
if (SimulateAirflowNetwork == AirflowNetworkControlMultizone.OR.SimulateAirflowNetwork == AirflowNetworkControlMultiADS &
.OR. (SimulateAirflowNetwork == AirflowNetworkControlSimpleADS .AND. AirflowNetworkFanActivated)) then
! Multizone airflow calculated in AirflowNetwork
B = GCGain + AirflowNetworkExchangeData(ZoneNum)%SumMHrGC + &
AirflowNetworkExchangeData(ZoneNum)%SumMMHrGC
A = AirflowNetworkExchangeData(ZoneNum)%SumMHr+AirflowNetworkExchangeData(ZoneNum)%SumMMHr
else
B = GCGain + ((oamfl(ZoneNum) + vamfl(ZoneNum) + eamfl(ZoneNum) + ctmfl(ZoneNum)) * OutdoorGC) + &
MixingMassFlowGC(ZoneNum)
A = oamfl(ZoneNum) + vamfl(ZoneNum) + eamfl(ZoneNum) + ctmfl(ZoneNum) + MixingMassFlowZone(ZoneNum)
end if
C = RhoAir * Zone(ZoneNum)%Volume * ZoneVolCapMultpGenContam / SysTimeStepInSeconds
! Use a 3rd Order derivative to predict zone moisture addition or removal and
! smooth the changes using the zone air capacitance. Positive values of GC Load means that
! this amount of GC must be added to the zone to reach the setpoint. Negative values represent
! the amount of GC that must be removed by the system.
SELECT CASE (ZoneAirSolutionAlgo)
CASE (Use3rdOrder)
LoadToGCSetPoint = ((11.0d0/6.0d0) * C + A) * ZoneAirGCSetpoint - &
(B + C * (3.0d0 * GCZoneTimeMinus1Temp(ZoneNum) - (3.0d0/2.0d0) * GCZoneTimeMinus2Temp(ZoneNum) + &
(1.0d0/3.0d0) * GCZoneTimeMinus3Temp(ZoneNum)))
! Exact solution
CASE (UseAnalyticalSolution)
If (A .eq. 0.0d0) Then ! B=0
LoadToGCSetPoint = C*(ZoneAirGCSetpoint-ZoneGC1(ZoneNum)) - B
Else
LoadToGCSetPoint = A*(ZoneAirGCSetpoint-ZoneGC1(ZoneNum)*exp(MIN(700.d0,-A/C)))/(1.0d0-exp(MIN(700.d0,-A/C))) - B
End If
CASE (UseEulerMethod)
LoadToGCSetPoint = C*(ZoneAirGCSetpoint-ZoneGC1(ZoneNum)) + A*ZoneAirGCSetpoint - B
END SELECT
If (ZoneAirGCSetpoint .GT. OutdoorGC .AND. LoadToGCSetPoint < 0.0d0) Then
ZoneSysContDemand(ZoneNum)%OutputRequiredToGCSP = LoadToGCSetPoint/(OutdoorGC - ZoneAirGCSetpoint)
End If
End If
! Apply the Zone Multiplier to the total zone moisture load
ZoneSysContDemand(ZoneNum)%OutputRequiredToGCSP = ZoneSysContDemand(ZoneNum)%OutputRequiredToGCSP &
* Zone(ZoneNum)%Multiplier * Zone(ZoneNum)%ListMultiplier
GCPredictedRate(ZoneNum) = ZoneSysContDemand(ZoneNum)%OutputRequiredToGCSP
End If
END DO
RETURN
END SUBROUTINE PredictZoneContaminants