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 InitZoneContSetpoints
! SUBROUTINE INFORMATION:
! AUTHOR Lixing Gu
! DATE WRITTEN May 2010
! MODIFIED NA
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine initializes the data for the zone air contaminant setpoints.
! METHODOLOGY EMPLOYED:
! Uses the status flags to trigger events.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataZoneEquipment, ONLY: ZoneEquipConfig
USE DataSurfaces, ONLY: Surface
USE ScheduleManager, ONLY: GetCurrentScheduleValue
USE InternalHeatGains, ONLY: SumAllInternalCO2Gains, SumInternalCO2GainsByTypes, SumAllInternalGenericContamGains
USE DataAirflowNetwork, ONLY: MultizoneSurfaceData, AirflowNetworkNodeSimu, AirflowNetworkNumOfZones,SimulateAirflowNetwork, &
AirflowNetworkControlSimple
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 :: Loop, ZoneNum, SurfNum
LOGICAL,SAVE :: MyOneTimeFlag = .TRUE.
LOGICAL,SAVE :: MyEnvrnFlag = .TRUE.
LOGICAL,SAVE :: MyDayFlag = .TRUE.
! REAL(r64) :: CO2Gain ! Zone CO2 gain
REAL(r64) :: GCGain ! Zone generic contaminant gain
REAL(r64) :: Pi ! Pressue at zone i
REAL(r64) :: Pj ! Pressue at zone j
REAL(r64) :: Sch ! Schedule value
REAL(r64) :: Cs ! Surface concentration level for the Boundary Layer Diffusion Controlled Model
LOGICAL,SAVE :: MyConfigOneTimeFlag = .TRUE.
INTEGER :: AirLoopNum
INTEGER :: ContZoneNum
INTEGER :: I
LOGICAL :: ErrorsFound=.false.
! FLOW:
IF (Contaminant%CO2Simulation) Then
OutdoorCO2 = GetCurrentScheduleValue(Contaminant%CO2OutdoorSchedPtr)
END IF
IF (Contaminant%GenericContamSimulation) Then
OutdoorGC = GetCurrentScheduleValue(Contaminant%GenericContamOutdoorSchedPtr)
END IF
IF (MyOneTimeFlag) THEN
! CO2
IF (Contaminant%CO2Simulation) Then
ALLOCATE(ZoneCO2Setpoint(NumOfZones))
ZoneCO2Setpoint=0.0d0
ALLOCATE(CO2PredictedRate(NumOfZones))
CO2PredictedRate=0.0d0
ALLOCATE(CO2ZoneTimeMinus1(NumOfZones))
CO2ZoneTimeMinus1=0.0d0
ALLOCATE(CO2ZoneTimeMinus2(NumOfZones))
CO2ZoneTimeMinus2=0.0d0
ALLOCATE(CO2ZoneTimeMinus3(NumOfZones))
CO2ZoneTimeMinus3=0.0d0
ALLOCATE(CO2ZoneTimeMinus4(NumOfZones))
CO2ZoneTimeMinus4=0.0d0
ALLOCATE(DSCO2ZoneTimeMinus1(NumOfZones))
DSCO2ZoneTimeMinus1=0.0d0
ALLOCATE(DSCO2ZoneTimeMinus2(NumOfZones))
DSCO2ZoneTimeMinus2=0.0d0
ALLOCATE(DSCO2ZoneTimeMinus3(NumOfZones))
DSCO2ZoneTimeMinus3=0.0d0
ALLOCATE(DSCO2ZoneTimeMinus4(NumOfZones))
DSCO2ZoneTimeMinus4=0.0d0
ALLOCATE(CO2ZoneTimeMinus1Temp(NumOfZones))
CO2ZoneTimeMinus1Temp=0.0d0
ALLOCATE(CO2ZoneTimeMinus2Temp(NumOfZones))
CO2ZoneTimeMinus2Temp=0.0d0
ALLOCATE(CO2ZoneTimeMinus3Temp(NumOfZones))
CO2ZoneTimeMinus3Temp=0.0d0
ALLOCATE(ZoneCO2MX(NumOfZones))
ZoneCO2MX = 0.0d0
ALLOCATE(ZoneCO2M2(NumOfZones))
ZoneCO2M2 = 0.0d0
ALLOCATE(ZoneCO21(NumOfZones))
ZoneCO21=0.0d0
ALLOCATE(ZoneSysContDemand(NumOfZones))
ALLOCATE(ZoneCO2Gain(NumOfZones))
ZoneCO2Gain=0.0d0
ALLOCATE(ZoneCO2GainFromPeople(NumOfZones))
ZoneCO2GainFromPeople=0.0d0
ALLOCATE(MixingMassFlowCO2(NumOfZones))
MixingMassFlowCO2=0.0d0
ALLOCATE(ZoneAirDensityCO(NumOfZones))
ZoneAirDensityCO = 0.d0
!
ALLOCATE(AZ(NumOfZones))
AZ = 0.d0
ALLOCATE(BZ(NumOfZones))
BZ = 0.d0
ALLOCATE(CZ(NumOfZones))
CZ = 0.d0
END IF
ALLOCATE(CONTRAT(NumOfZones))
CONTRAT = 0.0d0
! Allocate Derived Types
DO Loop = 1, NumOfZones
! Zone CO2
IF (Contaminant%CO2Simulation) Then
CALL SetupOutputVariable('Zone Air CO2 Concentration [ppm]',ZoneAirCO2(Loop),'System','Average',Zone(Loop)%Name)
CALL SetupOutputVariable('Zone Air CO2 Predicted Load to Setpoint Mass Flow Rate [kg/s]', &
CO2PredictedRate(Loop),'System','Average',Zone(Loop)%Name)
CALL SetupOutputVariable('Zone Air CO2 Setpoint Concentration [ppm]', ZoneCO2Setpoint(Loop), &
'System','Average',Zone(Loop)%Name)
CALL SetupOutputVariable('Zone Air CO2 Internal Gain Volume Flow Rate [m3/s]', ZoneCO2Gain(Loop), &
'System','Average',Zone(Loop)%Name)
END IF
END DO ! Loop
! Generic contaminant
IF (Contaminant%GenericContamSimulation) Then
ALLOCATE(ZoneGCSetpoint(NumOfZones))
ZoneGCSetpoint=0.0d0
ALLOCATE(GCPredictedRate(NumOfZones))
GCPredictedRate=0.0d0
ALLOCATE(GCZoneTimeMinus1(NumOfZones))
GCZoneTimeMinus1=0.0d0
ALLOCATE(GCZoneTimeMinus2(NumOfZones))
GCZoneTimeMinus2=0.0d0
ALLOCATE(GCZoneTimeMinus3(NumOfZones))
GCZoneTimeMinus3=0.0d0
ALLOCATE(GCZoneTimeMinus4(NumOfZones))
GCZoneTimeMinus4=0.0d0
ALLOCATE(DSGCZoneTimeMinus1(NumOfZones))
DSGCZoneTimeMinus1=0.0d0
ALLOCATE(DSGCZoneTimeMinus2(NumOfZones))
DSGCZoneTimeMinus2=0.0d0
ALLOCATE(DSGCZoneTimeMinus3(NumOfZones))
DSGCZoneTimeMinus3=0.0d0
ALLOCATE(DSGCZoneTimeMinus4(NumOfZones))
DSGCZoneTimeMinus4=0.0d0
ALLOCATE(GCZoneTimeMinus1Temp(NumOfZones))
GCZoneTimeMinus1Temp=0.0d0
ALLOCATE(GCZoneTimeMinus2Temp(NumOfZones))
GCZoneTimeMinus2Temp=0.0d0
ALLOCATE(GCZoneTimeMinus3Temp(NumOfZones))
GCZoneTimeMinus3Temp=0.0d0
ALLOCATE(ZoneGCMX(NumOfZones))
ZoneGCMX = 0.0d0
ALLOCATE(ZoneGCM2(NumOfZones))
ZoneGCM2 = 0.0d0
ALLOCATE(ZoneGC1(NumOfZones))
ZoneGC1=0.0d0
IF(.NOT. ALLOCATED(ZoneSysContDemand)) ALLOCATE(ZoneSysContDemand(NumOfZones))
ALLOCATE(ZoneGCGain(NumOfZones))
ZoneGCGain=0.0d0
ALLOCATE(MixingMassFlowGC(NumOfZones))
MixingMassFlowGC=0.0d0
ALLOCATE(ZoneAirDensityGC(NumOfZones))
ZoneAirDensityGC = 0.d0
!
ALLOCATE(AZGC(NumOfZones))
AZGC = 0.d0
ALLOCATE(BZGC(NumOfZones))
BZGC = 0.d0
ALLOCATE(CZGC(NumOfZones))
CZGC = 0.d0
END IF
ALLOCATE(CONTRATGC(NumOfZones))
CONTRATGC = 0.0d0
! Allocate Derived Types
DO Loop = 1, NumOfZones
! Zone CO2
IF (Contaminant%GenericContamSimulation) Then
CALL SetupOutputVariable('Zone Air Generic Air Contaminant Concentration [ppm]',ZoneAirGC(Loop), &
'System','Average',Zone(Loop)%Name)
CALL SetupOutputVariable('Zone Generic Air Contaminant Predicted Load to Setpoint Mass Flow Rate [kg/s]', &
GCPredictedRate(Loop),'System','Average',Zone(Loop)%Name)
CALL SetupOutputVariable('Zone Generic Air Contaminant Setpoint Concentration [ppm]', ZoneGCSetpoint(Loop), &
'System','Average',Zone(Loop)%Name)
END IF
END DO ! Loop
MyOneTimeFlag = .FALSE.
END IF
! Do the Begin Environment initializations
IF (MyEnvrnFlag .AND. BeginEnvrnFlag) THEN
IF (Contaminant%CO2Simulation) Then
CONTRAT = 0.0d0
CO2ZoneTimeMinus1 = OutdoorCO2
CO2ZoneTimeMinus2 = OutdoorCO2
CO2ZoneTimeMinus3 = OutdoorCO2
CO2ZoneTimeMinus4 = OutdoorCO2
DSCO2ZoneTimeMinus1 = OutdoorCO2
DSCO2ZoneTimeMinus2 = OutdoorCO2
DSCO2ZoneTimeMinus3 = OutdoorCO2
DSCO2ZoneTimeMinus4 = OutdoorCO2
CO2ZoneTimeMinus1Temp = 0.0d0
CO2ZoneTimeMinus2Temp = 0.0d0
CO2ZoneTimeMinus3Temp = 0.0d0
ZoneAirCO2Temp = OutdoorCO2
ZoneCO2Setpoint = 0.0d0
CO2PredictedRate = 0.0d0
ZoneAirCO2 = OutdoorCO2
ZoneCO21 = OutdoorCO2
ZoneCO2MX = OutdoorCO2
ZoneCO2M2 = OutdoorCO2
END IF
IF (Contaminant%GenericContamSimulation) Then
CONTRAT = 0.0d0
GCZoneTimeMinus1 = OutdoorGC
GCZoneTimeMinus2 = OutdoorGC
GCZoneTimeMinus3 = OutdoorGC
GCZoneTimeMinus4 = OutdoorGC
DSGCZoneTimeMinus1 = OutdoorGC
DSGCZoneTimeMinus2 = OutdoorGC
DSGCZoneTimeMinus3 = OutdoorGC
DSGCZoneTimeMinus4 = OutdoorGC
GCZoneTimeMinus1Temp = 0.0d0
GCZoneTimeMinus2Temp = 0.0d0
GCZoneTimeMinus3Temp = 0.0d0
ZoneAirGCTemp = OutdoorGC
ZoneGCSetpoint = 0.0d0
GCPredictedRate = 0.0d0
ZoneAirGC = OutdoorGC
ZoneGC1 = OutdoorGC
ZoneGCMX = OutdoorGC
ZoneGCM2 = OutdoorGC
DO Loop = 1, TotGCBLDiff
Surface(ZoneContamGenericBLDiff(Loop)%SurfNum)%GenericContam = OutdoorGC
End Do
If (TotGCGenDecay > 0) ZoneContamGenericDecay%GCTime = 0.0d0
END IF
MyEnvrnFlag = .FALSE.
END IF
IF (.NOT. BeginEnvrnFlag) THEN
MyEnvrnFlag=.TRUE.
END IF
! Do the Begin Day initializations
IF (MyDayFlag .AND. BeginDayFlag) THEN
MyDayFlag=.FALSE.
END IF
IF (.NOT. BeginDayFlag) THEN
MyDayFlag=.TRUE.
END IF
If (ALLOCATED(ZoneEquipConfig) .AND. MyConfigOneTimeFlag) Then
DO ContZoneNum = 1, NumContControlledZones
ZoneNum = ContaminantControlledZone(ContZoneNum)%ActualZoneNum
AirLoopNum = ZoneEquipConfig(ZoneNum)%AirLoopNum
ContaminantControlledZone(ContZoneNum)%NumOfZones = 0
DO Loop = 1, NumOfZones
IF (.not. ZoneEquipConfig(Loop)%IsControlled) CYCLE
If (AirLoopNum == ZoneEquipConfig(Loop)%AirLoopNum) Then
ContaminantControlledZone(ContZoneNum)%NumOfZones=ContaminantControlledZone(ContZoneNum)%NumOfZones+1
End If
End Do
If (ContaminantControlledZone(ContZoneNum)%NumOfZones > 0) Then
ALLOCATE(ContaminantControlledZone(ContZoneNum)%ControlZoneNum(ContaminantControlledZone(ContZoneNum)%NumOfZones))
I = 1
DO Loop = 1, NumOfZones
IF (.not. ZoneEquipConfig(Loop)%IsControlled) CYCLE
If (AirLoopNum == ZoneEquipConfig(Loop)%AirLoopNum) Then
ContaminantControlledZone(ContZoneNum)%ControlZoneNum(I) = Loop
I = I + 1
End If
End Do
Else
CALL ShowSevereError('ZoneControl:ContaminantController: a corresponding AirLoopHVAC is not found for the ' &
//'controlled zone ='//Trim(Zone(ZoneNum)%Name) )
ErrorsFound = .TRUE.
End If
End Do
MyConfigOneTimeFlag = .FALSE.
IF (ErrorsFound) THEN
CALL ShowFatalError('ZoneControl:ContaminantController: Program terminates for preceding reason(s).')
ENDIF
End If
DO Loop = 1, NumContControlledZones
IF (Contaminant%CO2Simulation) Then
ZoneNum = ContaminantControlledZone(Loop)%ActualZoneNum
ZoneCO2Setpoint(ZoneNum)=GetCurrentScheduleValue(ContaminantControlledZone(Loop)%SPSchedIndex)
END IF
IF (Contaminant%GenericContamSimulation) Then
ZoneNum = ContaminantControlledZone(Loop)%ActualZoneNum
ZoneGCSetpoint(ZoneNum)=GetCurrentScheduleValue(ContaminantControlledZone(Loop)%GCSPSchedIndex)
END IF
END DO
! CO2 gain
IF (Contaminant%CO2Simulation) Then
DO Loop = 1, NumOfZones
CALL SumAllInternalCO2Gains (Loop, ZoneCO2Gain(loop) )
CALL SumInternalCO2GainsByTypes(Loop, (/IntGainTypeOf_People/), ZoneCO2GainFromPeople(loop))
ENDDO
END IF
! Generic contaminant gain
IF (Contaminant%GenericContamSimulation) Then
ZoneGCGain = 0.d0
! from constant model
Do Loop = 1, TotGCGenConstant
ZoneNum = ZoneContamGenericConstant(Loop)%ActualZoneNum
GCGain = ZoneContamGenericConstant(Loop)%GCGenerateRate * &
GetCurrentScheduleValue(ZoneContamGenericConstant(Loop)%GCGenerateRateSchedPtr) - &
ZoneContamGenericConstant(Loop)%GCRemovalCoef * &
GetCurrentScheduleValue(ZoneContamGenericConstant(Loop)%GCRemovalCoefSchedPtr) * ZoneAirGC(ZoneNum)*1.0d-6
ZoneContamGenericConstant(Loop)%GCGenRate = GCGain
End Do
! from pressure driven model
If (SimulateAirflowNetwork .GT. AirflowNetworkControlSimple) Then
Do Loop = 1, TotGCGenPDriven
SurfNum = ZoneContamGenericPDriven(Loop)%SurfNum
Pi = AirflowNetworkNodeSimu(MultizoneSurfaceData(SurfNum)%NodeNums(1))%PZ
Pj = AirflowNetworkNodeSimu(MultizoneSurfaceData(SurfNum)%NodeNums(2))%PZ
If (Pj .GE. Pi) Then
GCGain = ZoneContamGenericPDriven(Loop)%GCGenRateCoef * &
GetCurrentScheduleValue(ZoneContamGenericPDriven(Loop)%GCGenRateCoefSchedPtr) * &
(Pj - Pi)**ZoneContamGenericPDriven(Loop)%GCExpo
Else
GCGain = 0.0d0
End If
ZoneContamGenericPDriven(Loop)%GCGenRate = GCGain
End Do
End If
! from cutoff model
DO Loop = 1, TotGCGenCutoff
ZoneNum = ZoneContamGenericCutoff(Loop)%ActualZoneNum
If (ZoneAirGC(ZoneNum) < ZoneContamGenericCutoff(Loop)%GCCutoffValue) Then
GCGain = ZoneContamGenericCutoff(Loop)%GCGenerateRate * &
GetCurrentScheduleValue(ZoneContamGenericCutoff(Loop)%GCGenerateRateSchedPtr) * &
(1.d0 - ZoneAirGC(ZoneNum)/ZoneContamGenericCutoff(Loop)%GCCutoffValue)
Else
GCGain = 0.0d0
End If
ZoneContamGenericCutoff(Loop)%GCGenRate = GCGain
End Do
! From decay model
DO Loop = 1, TotGCGenDecay
Sch = GetCurrentScheduleValue(ZoneContamGenericDecay(Loop)%GCEmiRateSchedPtr)
ZoneNum = ZoneContamGenericDecay(Loop)%ActualZoneNum
If (Sch .eq. 0.0d0 .OR. BeginEnvrnFlag .OR. WarmupFlag) Then
ZoneContamGenericDecay(Loop)%GCTime = 0.0d0
Else
ZoneContamGenericDecay(Loop)%GCTime = ZoneContamGenericDecay(Loop)%GCTime + TimeStepZone*SecInHour
End If
GCGain = ZoneContamGenericDecay(Loop)%GCInitEmiRate * Sch * &
exp(-ZoneContamGenericDecay(Loop)%GCTime/ZoneContamGenericDecay(Loop)%GCDelayTime)
ZoneContamGenericDecay(Loop)%GCGenRate = GCGain
End Do
! From boudary layer diffusion
DO Loop = 1, TotGCBLDiff
SurfNum = ZoneContamGenericBLDiff(Loop)%SurfNum
ZoneNum = Surface(SurfNum)%Zone
Cs = Surface(SurfNum)%GenericContam
Sch = GetCurrentScheduleValue(ZoneContamGenericBLDiff(Loop)%GCTranCoefSchedPtr)
GCGain = ZoneContamGenericBLDiff(Loop)%GCTranCoef * Sch * Surface(SurfNum)%Area * Surface(SurfNum)%Multiplier * &
(Cs/ZoneContamGenericBLDiff(Loop)%GCHenryCoef-ZoneAirGC(ZoneNum))*1.0d-6
ZoneContamGenericBLDiff(Loop)%GCGenRate = GCGain
! Surface concentration level based on steady-state assumption
Surface(SurfNum)%GenericContam = Cs - GCGain*1.0d6/Surface(SurfNum)%Multiplier/Surface(SurfNum)%Area
End Do
! From deposition velocity sink model
DO Loop = 1, TotGCDVS
SurfNum = ZoneContamGenericDVS(Loop)%SurfNum
ZoneNum = Surface(SurfNum)%Zone
Sch = GetCurrentScheduleValue(ZoneContamGenericDVS(Loop)%GCDepoVeloPtr)
GCGain = -ZoneContamGenericDVS(Loop)%GCDepoVelo*Surface(SurfNum)%Area*Sch*ZoneAirGC(ZoneNum)* &
Surface(SurfNum)%Multiplier*1.0d-6
ZoneContamGenericDVS(Loop)%GCGenRate = GCGain
End Do
! From deposition rate sink model
DO Loop = 1, TotGCDRS
ZoneNum = ZoneContamGenericDRS(Loop)%ActualZoneNum
Sch = GetCurrentScheduleValue(ZoneContamGenericDRS(Loop)%GCDepoRatePtr)
GCGain = - ZoneContamGenericDRS(Loop)%GCDepoRate*Zone(Zonenum)%Volume*Sch*ZoneAirGC(ZoneNum)*1.0d-6
ZoneContamGenericDRS(Loop)%GCGenRate = GCGain
End Do
END IF
RETURN
END SUBROUTINE InitZoneContSetpoints