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.
SUBROUTINE ManageHVAC
! SUBROUTINE INFORMATION:
! AUTHORS: Russ Taylor, Dan Fisher
! DATE WRITTEN: Jan. 1998
! MODIFIED Jul 2003 (CC) added a subroutine call for air models
! RE-ENGINEERED May 2008, Brent Griffith, revised variable time step method and zone conditions history
! PURPOSE OF THIS SUBROUTINE:
! This routine effectively replaces the IBLAST
! "SystemDriver" routine. The main function of the routine
! is to set the system timestep, "TimeStepSys", call the models related to zone
! air temperatures, and .
! METHODOLOGY EMPLOYED:
! manage calls to Predictor and Corrector and other updates in ZoneTempPredictorCorrector
! manage variable time step and when zone air histories are updated.
!
!
! REFERENCES:
! USE STATEMENTS:
USE DataConvergParams, ONLY: MinTimeStepSys, & ! =0.0166667 != 1 minute
MaxZoneTempDiff ! 0.3 C = (1% OF 300 C) =max allowable diff between ZoneAirTemp at Time=T & T-1
USE ZoneTempPredictorCorrector, ONLY: ManageZoneAirUpdates,DetectOscillatingZoneTemp
USE NodeInputManager, ONLY: CalcMoreNodeInfo
USE ZoneEquipmentManager, ONLY : UpdateZoneSizing
USE OutputReportTabular, ONLY : UpdateTabularReports,GatherComponentLoadsHVAC !added for writing tabular output reports
USE DataGlobals, ONLY : CompLoadReportIsReq
USE SystemReports, ONLY : InitEnergyReports, ReportMaxVentilationLoads, ReportSystemEnergyUse
USE PollutionModule, ONLY : CalculatePollution
USE DemandManager, ONLY : ManageDemand, UpdateDemandManagers
USE EMSManager, ONLY : ManageEMS
USE IceThermalStorage, ONLY : UpdateIceFractions
USE OutAirNodeManager, ONLY : SetOutAirNodes
USE AirflowNetworkBalanceManager, ONLY : ManageAirflowNetworkBalance
USE DataAirflowNetwork, ONLY : RollBackFlag
USE WaterManager, ONLY : ManageWater, ManageWaterInits
USE RefrigeratedCase, ONLY : ManageRefrigeratedCaseRacks
USE SystemAvailabilityManager, ONLY : ManageHybridVentilation
USE DataHeatBalFanSys, ONLY: SysDepZoneLoads, SysDepZoneLoadsLagged, ZTAVComf, ZoneAirHumRatAvgComf
USE DataSystemVariables, ONLY : ReportDuringWarmup, UpdateDataDuringWarmupExternalInterface ! added for FMI
USE PlantManager, ONLY : UpdateNodeThermalHistory
USE ZoneContaminantPredictorCorrector, ONLY: ManageZoneContaminanUpdates
USE DataContaminantBalance, ONLY: Contaminant, ZoneAirCO2, ZoneAirCO2Temp, ZoneAirCO2Avg, OutdoorCO2, &
ZoneAirGC, ZoneAirGCTemp, ZoneAirGCAvg, OutdoorGC
USE ScheduleManager, ONLY: GetCurrentScheduleValue
USE ManageElectricPower, ONLY : ManageElectricLoadCenters
USE InternalHeatGains, ONLY : UpdateInternalGainValues
IMPLICIT NONE ! Enforce explicit typing of all variables
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: EndOfHeaderFormat = "('End of Data Dictionary')" ! End of data dictionary marker
CHARACTER(len=*), PARAMETER :: EnvironmentStampFormat = "(a,',',a,3(',',f7.2),',',f7.2)" ! Format descriptor for environ stamp
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: PriorTimeStep !magnitude of time step for previous history terms
REAL(r64) :: ZoneTempChange !change in zone air temperature from timestep t-1 to t
Integer :: NodeNum
LOGICAL :: ReportDebug
LOGICAL,SAVE :: TriggerGetAFN = .TRUE.
INTEGER :: ZoneNum
LOGICAL, SAVE :: PrintedWarmup=.false.
LOGICAL,SAVE :: MyEnvrnFlag = .TRUE.
LOGICAL,SAVE :: InitVentReportFlag = .TRUE.
LOGICAL,SAVE :: DebugNamesReported=.false.
INTEGER :: ZTempTrendsNumSysSteps = 0
INTEGER :: SysTimestepLoop = 0
LOGICAL :: DummyLogical
!SYSTEM INITIALIZATION
IF (TriggerGetAFN) THEN
TriggerGetAFN = .FALSE.
CALL DisplayString('Initializing HVAC')
CALL ManageAirflowNetworkBalance ! first call only gets input and returns.
END IF
ZT = MAT
! save for use with thermal comfort control models (Fang, Pierce, and KSU)
ZTAVComf = ZTAV
ZoneAirHumRatAvgComf = ZoneAirHumRatAvg
ZTAV = 0.0D0
ZoneAirHumRatAvg = 0.0D0
PrintedWarmup=.false.
IF (Contaminant%CO2Simulation) Then
OutdoorCO2 = GetCurrentScheduleValue(Contaminant%CO2OutdoorSchedPtr)
ZoneAirCO2Avg = 0.0D0
END IF
IF (Contaminant%GenericContamSimulation) Then
OutdoorGC = GetCurrentScheduleValue(Contaminant%GenericContamOutdoorSchedPtr)
IF (ALLOCATED(ZoneAirGCAvg)) ZoneAirGCAvg = 0.0D0
END IF
IF (BeginEnvrnFlag .AND. MyEnvrnFlag) THEN
CALL ResetNodeData
AirLoopsSimOnce = .FALSE.
MyEnvrnFlag = .FALSE.
InitVentReportFlag = .TRUE.
NumOfSysTimeStepsLastZoneTimeStep = 1
PreviousTimeStep = TimeStepZone
END IF
IF (.NOT. BeginEnvrnFlag) THEN
MyEnvrnFlag = .TRUE.
END IF
SysTimeElapsed = 0.0d0
TimeStepSys = TimeStepZone
FirstTimeStepSysFlag = .TRUE.
ShortenTimeStepSys = .FALSE.
UseZoneTimeStepHistory = .TRUE.
PriorTimeStep = TimeStepZone
NumOfSysTimeSteps = 1
FracTimeStepZone = TimeStepSys/TimeStepZone
CALL ManageEMS(emsCallFromBeginTimestepBeforePredictor) !calling point
CALL SetOutAirNodes
CALL ManageRefrigeratedCaseRacks
!ZONE INITIALIZATION 'Get Zone Setpoints'
CALL ManageZoneAirUpdates(iGetZoneSetpoints,ZoneTempChange,ShortenTimeStepSys, &
UseZoneTimeStepHistory,PriorTimeStep )
If (Contaminant%SimulateContaminants) &
CALL ManageZoneContaminanUpdates(iGetZoneSetpoints,ShortenTimeStepSys,UseZoneTimeStepHistory,PriorTimeStep)
CALL ManageHybridVentilation
CALL CalcAirFlowSimple
IF (SimulateAirflowNetwork .gt. AirflowNetworkControlSimple) THEN
RollBackFlag = .FALSE.
CALL ManageAirflowNetworkBalance(.FALSE.)
END IF
CALL SetHeatToReturnAirFlag
SysDepZoneLoadsLagged = SysDepZoneLoads
CALL UpdateInternalGainValues(SuppressRadiationUpdate = .TRUE., SumLatentGains = .TRUE.)
CALL ManageZoneAirUpdates(iPredictStep,ZoneTempChange,ShortenTimeStepSys, &
UseZoneTimeStepHistory, &
PriorTimeStep )
If (Contaminant%SimulateContaminants) &
CALL ManageZoneContaminanUpdates(iPredictStep,ShortenTimeStepSys,UseZoneTimeStepHistory,PriorTimeStep)
CALL SimHVAC
IF (AnyIdealCondEntSetPointInModel .and. MetersHaveBeenInitialized .and. .NOT. WarmUpFlag) THEN
RunOptCondEntTemp = .TRUE.
DO WHILE (RunOptCondEntTemp)
CALL SimHVAC
END DO
END IF
CALL ManageWaterInits
! Only simulate once per zone timestep; must be after SimHVAC
IF (FirstTimeStepSysFlag .and. MetersHaveBeenInitialized) THEN
CALL ManageDemand
END IF
BeginTimeStepFlag = .FALSE. ! At this point, we have been through the first pass through SimHVAC so this needs to be set
CALL ManageZoneAirUpdates(iCorrectStep,ZoneTempChange,ShortenTimeStepSys, &
UseZoneTimeStepHistory, &
PriorTimeStep )
If (Contaminant%SimulateContaminants) &
CALL ManageZoneContaminanUpdates(iCorrectStep,ShortenTimeStepSys,UseZoneTimeStepHistory,PriorTimeStep)
IF (ZoneTempChange > MaxZoneTempDiff .and. .not. KickOffSimulation) THEN
!determine value of adaptive system time step
! model how many system timesteps we want in zone timestep
ZTempTrendsNumSysSteps = INT(ZoneTempChange / MaxZoneTempDiff + 1.0D0 ) ! add 1 for truncation
NumOfSysTimeSteps = MIN( ZTempTrendsNumSysSteps , LimitNumSysSteps )
!then determine timestep length for even distribution, protect div by zero
IF (NumOfSysTimeSteps > 0) TimeStepSys = TimeStepZone / NumOfSysTimeSteps
TimeStepSys = MAX( TimeStepSys , MinTimeStepSys)
UseZoneTimeStepHistory = .FALSE.
ShortenTimeStepSys = .TRUE.
ELSE
NumOfSysTimeSteps = 1
UseZoneTimeStepHistory = .TRUE.
ENDIF
If (UseZoneTimeStepHistory) PreviousTimeStep = TimeStepZone
DO SysTimestepLoop = 1, NumOfSysTimeSteps
IF (TimeStepSys .LT. TimeStepZone) THEN
CALL ManageHybridVentilation
CALL CalcAirFlowSimple(SysTimestepLoop)
if (SimulateAirflowNetwork .gt. AirflowNetworkControlSimple) then
RollBackFlag = .FALSE.
CALL ManageAirflowNetworkBalance(.FALSE.)
end if
CALL UpdateInternalGainValues(SuppressRadiationUpdate = .TRUE., SumLatentGains = .TRUE.)
CALL ManageZoneAirUpdates(iPredictStep,ZoneTempChange,ShortenTimeStepSys, &
UseZoneTimeStepHistory, &
PriorTimeStep )
If (Contaminant%SimulateContaminants) &
CALL ManageZoneContaminanUpdates(iPredictStep,ShortenTimeStepSys,UseZoneTimeStepHistory,PriorTimeStep)
CALL SimHVAC
IF (AnyIdealCondEntSetPointInModel .and. MetersHaveBeenInitialized .and. .NOT. WarmUpFlag) THEN
RunOptCondEntTemp = .TRUE.
DO WHILE (RunOptCondEntTemp)
CALL SimHVAC
END DO
END IF
CALL ManageWaterInits
!Need to set the flag back since we do not need to shift the temps back again in the correct step.
ShortenTimeStepSys = .FALSE.
CALL ManageZoneAirUpdates(iCorrectStep,ZoneTempChange,ShortenTimeStepSys, &
UseZoneTimeStepHistory, PriorTimeStep )
If (Contaminant%SimulateContaminants) &
CALL ManageZoneContaminanUpdates(iCorrectStep,ShortenTimeStepSys,UseZoneTimeStepHistory,PriorTimeStep)
CALL ManageZoneAirUpdates(iPushSystemTimeStepHistories,ZoneTempChange,ShortenTimeStepSys, &
UseZoneTimeStepHistory, PriorTimeStep )
If (Contaminant%SimulateContaminants) &
CALL ManageZoneContaminanUpdates(iPushSystemTimeStepHistories,ShortenTimeStepSys,UseZoneTimeStepHistory,PriorTimeStep)
PreviousTimeStep = TimeStepSys
END IF
FracTimeStepZone=TimeStepSys/TimeStepZone
DO ZoneNum = 1, NumofZones
ZTAV(ZoneNum) = ZTAV(ZoneNum) + ZT(ZoneNum) * FracTimeStepZone
ZoneAirHumRatAvg(ZoneNum) = ZoneAirHumRatAvg(ZoneNum) + ZoneAirHumRat(ZoneNum)* FracTimeStepZone
IF (Contaminant%CO2Simulation) &
ZoneAirCO2Avg(ZoneNum) = ZoneAirCO2Avg(ZoneNum) + ZoneAirCO2(ZoneNum)* FracTimeStepZone
IF (Contaminant%GenericContamSimulation) &
ZoneAirGCAvg(ZoneNum) = ZoneAirGCAvg(ZoneNum) + ZoneAirGC(ZoneNum)* FracTimeStepZone
END DO
CALL DetectOscillatingZoneTemp
CALL UpdateZoneListAndGroupLoads ! Must be called before UpdateDataandReport(HVACTSReporting)
CALL UpdateIceFractions ! Update fraction of ice stored in TES
CALL ManageWater
! update electricity data for net, purchased, sold etc.
DummyLogical = .FALSE.
CALL ManageElectricLoadCenters(.FALSE.,DummyLogical, .TRUE. )
! Update the plant and condenser loop capacitance model temperature history.
CALL UpdateNodeThermalHistory
CALL ManageEMS(emsCallFromEndSystemTimestepBeforeHVACReporting) ! EMS calling point
! This is where output processor data is updated for System Timestep reporting
IF (.NOT. WarmUpFlag) THEN
IF (DoOutputReporting) THEN
CALL CalcMoreNodeInfo
CALL CalculatePollution
CALL InitEnergyReports
CALL ReportSystemEnergyUse
END IF
IF (DoOutputReporting .OR. (ZoneSizingCalc .AND. CompLoadReportIsReq)) THEN
CALL ReportAirHeatBalance
IF (ZoneSizingCalc) CALL GatherComponentLoadsHVAC
END IF
IF (DoOutputReporting) THEN
CALL ReportMaxVentilationLoads
CALL UpdateDataandReport(HVACTSReporting)
CALL UpdateTabularReports(HVACTSReporting)
END IF
IF (ZoneSizingCalc) THEN
CALL UpdateZoneSizing(DuringDay)
END IF
ELSEIF (.not. KickOffSimulation .and. DoOutputReporting .and. ReportDuringWarmup) THEN
IF (BeginDayFlag .and. .not. PrintEnvrnStampWarmupPrinted) THEN
PrintEnvrnStampWarmup=.true.
PrintEnvrnStampWarmupPrinted=.true.
ENDIF
IF (.not. BeginDayFlag) PrintEnvrnStampWarmupPrinted=.false.
IF (PrintEnvrnStampWarmup) THEN
IF (PrintEndDataDictionary .AND. DoOutputReporting .and. .not. PrintedWarmup) THEN
WRITE (OutputFileStandard,EndOfHeaderFormat)
WRITE (OutputFileMeters,EndOfHeaderFormat)
PrintEndDataDictionary = .FALSE.
ENDIF
IF (DoOutputReporting .and. .not. PrintedWarmup) THEN
WRITE (OutputFileStandard,EnvironmentStampFormat) '1', &
'Warmup {'//trim(cWarmupDay)//'} '//Trim(EnvironmentName),Latitude,Longitude,TimeZoneNumber,Elevation
WRITE (OutputFileMeters,EnvironmentStampFormat) '1', &
'Warmup {'//trim(cWarmupDay)//'} '//Trim(EnvironmentName),Latitude,Longitude,TimeZoneNumber,Elevation
PrintEnvrnStampWarmup=.FALSE.
END IF
PrintedWarmup=.true.
END IF
CALL CalcMoreNodeInfo
CALL UpdateDataandReport(HVACTSReporting)
ELSEIF (UpdateDataDuringWarmupExternalInterface) THEN ! added for FMI
IF (BeginDayFlag .and. .not. PrintEnvrnStampWarmupPrinted) THEN
PrintEnvrnStampWarmup=.true.
PrintEnvrnStampWarmupPrinted=.true.
ENDIF
IF (.not. BeginDayFlag) PrintEnvrnStampWarmupPrinted=.false.
IF (PrintEnvrnStampWarmup) THEN
IF (PrintEndDataDictionary .AND. DoOutputReporting .and. .not. PrintedWarmup) THEN
WRITE (OutputFileStandard,EndOfHeaderFormat)
WRITE (OutputFileMeters,EndOfHeaderFormat)
PrintEndDataDictionary = .FALSE.
ENDIF
IF (DoOutputReporting .and. .not. PrintedWarmup) THEN
WRITE (OutputFileStandard,EnvironmentStampFormat) '1', &
'Warmup {'//trim(cWarmupDay)//'} '//Trim(EnvironmentName),Latitude,Longitude,TimeZoneNumber,Elevation
WRITE (OutputFileMeters,EnvironmentStampFormat) '1', &
'Warmup {'//trim(cWarmupDay)//'} '//Trim(EnvironmentName),Latitude,Longitude,TimeZoneNumber,Elevation
PrintEnvrnStampWarmup=.FALSE.
END IF
PrintedWarmup=.true.
ENDIF
CALL UpdateDataandReport(HVACTSReporting)
END IF
CALL ManageEMS(emsCallFromEndSystemTimestepAfterHVACReporting) ! EMS calling point
!UPDATE SYSTEM CLOCKS
SysTimeElapsed = SysTimeElapsed + TimeStepSys
FirstTimeStepSysFlag = .FALSE.
END DO !system time step loop (loops once if no downstepping)
CALL ManageZoneAirUpdates(iPushZoneTimeStepHistories,ZoneTempChange,ShortenTimeStepSys, &
UseZoneTimeStepHistory, PriorTimeStep )
If (Contaminant%SimulateContaminants) &
CALL ManageZoneContaminanUpdates(iPushZoneTimeStepHistories,ShortenTimeStepSys,UseZoneTimeStepHistory,PriorTimeStep)
NumOfSysTimeStepsLastZoneTimeStep = NumOfSysTimeSteps
CALL UpdateDemandManagers
! DO FINAL UPDATE OF RECORD KEEPING VARIABLES
! Report the Node Data to Aid in Debugging
IF (DebugOutput) THEN
IF (EvenDuringWarmup) THEN
ReportDebug = .TRUE.
ELSE
ReportDebug = .NOT. WarmupFlag
END IF
IF ((ReportDebug).AND.(DayOfSim.GT.0)) THEN ! Report the node data
IF (SIZE(node) > 0 .and. .not. DebugNamesReported) THEN
WRITE(OutputFileDebug,11)
DO NodeNum = 1, SIZE(Node)
WRITE(OutputFileDebug,30) NodeNum,trim(NodeID(NodeNum))
ENDDO
DebugNamesReported=.true.
ENDIF
IF (SIZE(node) > 0) THEN
Write(OutputFileDebug,*)
Write(OutputFileDebug,*)
Write(OutputFileDebug,*) 'Day of Sim Hour of Day Time'
Write(OutputFileDebug,*) DayofSim, HourOfDay, TimeStep*TimeStepZone
Write(OutputFileDebug,10)
END IF
DO NodeNum = 1, SIZE(Node)
WRITE(OutputFileDebug,20) NodeNum,Node(NodeNum)%Temp,Node(NodeNum)%MassFlowRateMinAvail, &
Node(NodeNum)%MassFlowRateMaxAvail,Node(NodeNum)%TempSetPoint, &
Node(NodeNum)%MassFlowRate,Node(NodeNum)%MassFlowRateMin,Node(NodeNum)%MassFlowRateMax, &
Node(NodeNum)%MassFlowRateSetPoint,Node(NodeNum)%Press,Node(NodeNum)%Enthalpy,Node(NodeNum)%HumRat, &
TRIM(ValidNodeFluidTypes(Node(NodeNum)%FluidType))
END DO
END IF
END IF
10 FORMAT('node # Temp MassMinAv MassMaxAv TempSP MassFlow MassMin ', &
'MassMax MassSP Press Enthal HumRat Fluid Type')
11 FORMAT('node # Name')
20 FORMAT(1x,I3,1x,F8.2,2(2x,F8.3),2x,F8.2,4(1x,F13.2),2x,F8.0,2x,F11.2,2x,F9.5,2x,A)
30 FORMAT(1x,I3,5x,A)
RETURN
END SUBROUTINE ManageHVAC