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 ManageSimulation ! Main driver routine for this module
! SUBROUTINE INFORMATION:
! AUTHOR Rick Strand
! DATE WRITTEN January 1997
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is the main driver of the simulation manager module.
! It contains the main environment-time loops for the building
! simulation. This includes the environment loop, a day loop, an
! hour loop, and a time step loop.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataHVACGlobals, ONLY: TimeStepSys
USE DataEnvironment, ONLY: EnvironmentName,CurMnDy,CurrentOverallSimDay,TotalOverallSimDays,TotDesDays, &
TotRunDesPersDays,EndMonthFlag
USE InputProcessor, ONLY: GetNumRangeCheckErrorsFound,GetNumObjectsFound
USE SizingManager, ONLY: ManageSizing
USE ExteriorEnergyUse, ONLY: ManageExteriorEnergyUse
USE OutputReportTabular, ONLY: WriteTabularReports,OpenOutputTabularFile,CloseOutputTabularFile
USE DataErrorTracking, ONLY: AskForConnectionsReport,ExitDuringSimulations
USE OutputProcessor, ONLY: SetupTimePointers, ReportForTabularReports
USE CostEstimateManager, ONLY: SimCostEstimate
USE EconomicTariff, ONLY: ComputeTariff,WriteTabularTariffReports !added for computing annual utility costs
USE General, ONLY: TrimSigDigits
USE OutputReportPredefined, ONLY: SetPredefinedTables
USE HVACControllers, ONLY: DumpAirLoopStatistics
USE NodeInputManager, ONLY: SetupNodeVarsForReporting, CheckMarkedNodes
USE BranchNodeConnections, ONLY: CheckNodeConnections,TestCompSetInletOutletNodes
Use PollutionModule, ONLY: SetupPollutionMeterReporting, SetupPollutionCalculations, CheckPollutionMeterReporting
USE SystemReports, ONLY: ReportAirLoopConnections, CreateEnergyReportStructure
USE BranchInputManager, ONLY: ManageBranchInput,TestBranchIntegrity,InvalidBranchDefinitions
USE ManageElectricPower, ONLY: VerifyCustomMetersElecPowerMgr
USE MixedAir, ONLY: CheckControllerLists
USE EMSManager , ONLY: CheckIFAnyEMS, ManageEMS
USE EconomicLifeCycleCost, ONLY: GetInputForLifeCycleCost, ComputeLifeCycleCostAndReport
USE SQLiteProcedures, ONLY: WriteOutputToSQLite, CreateSQLiteSimulationsRecord, InitializeIndexes, &
CreateSQLiteEnvironmentPeriodRecord,CreateZoneExtendedOutput, SQLiteBegin, SQLiteCommit
USE DemandManager, ONLY: InitDemandManagers
USE PlantManager, ONLY: CheckIfAnyPlant
USE CurveManager, ONLY: InitCurveReporting
USE DataTimings
USE DataSystemVariables, ONLY: DeveloperFlag, TimingFlag, FullAnnualRun
USE SetPointManager, ONLY: CheckIFAnyIdealCondEntSetPoint
USE Psychrometrics, ONLY: InitializePsychRoutines
USE FaultsManager
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL, SAVE :: Available ! an environment is available to process
LOGICAL, SAVE :: ErrorsFound=.false.
LOGICAL, SAVE :: TerminalError = .FALSE.
LOGICAL :: SimsDone
LOGICAL :: ErrFound
! real(r64) :: t0,t1,st0,st1
! CHARACTER(len=70) :: tdstring
! CHARACTER(len=138) :: tdstringlong
INTEGER :: EnvCount
! FLOW:
CALL PostIPProcessing
CALL InitializePsychRoutines
BeginSimFlag = .TRUE.
BeginFullSimFlag = .FALSE.
DoOutputReporting = .FALSE.
DisplayPerfSimulationFlag=.false.
DoWeatherInitReporting=.false.
RunPeriodsInInput=(GetNumObjectsFound('RunPeriod')>0 .or. GetNumObjectsFound('RunPeriod:CustomRange')>0 .or. FullAnnualRun)
AskForConnectionsReport=.false. ! set to false until sizing is finished
CALL OpenOutputFiles
CALL CheckThreading
CALL GetProjectData
CALL CheckForMisMatchedEnvironmentSpecifications
CALL CheckForRequestedReporting
CALL SetPredefinedTables
CALL SetupTimePointers('Zone',TimeStepZone) ! Set up Time pointer for HB/Zone Simulation
Call SetupTimePointers('HVAC',TimeStepSys)
CALL CheckIFAnyEMS
CALL CheckIFAnyPlant
CALL CheckIFAnyIdealCondEntSetPoint
CALL CheckAndReadFaults
CALL ManageBranchInput ! just gets input and returns.
DoingSizing = .TRUE.
CALL ManageSizing
BeginFullSimFlag = .TRUE.
SimsDone=.false.
IF (DoDesDaySim .OR. DoWeathSim) THEN
DoOutputReporting = .TRUE.
END IF
DoingSizing = .FALSE.
IF ((DoZoneSizing .or. DoSystemSizing .or. DoPlantSizing) .and. &
.not. (DoDesDaySim .or. (DoWeathSim .and. RunPeriodsInInput) ) ) THEN
CALL ShowWarningError('ManageSimulation: Input file has requested Sizing Calculations but no Simulations are requested '// &
'(in SimulationControl object). Succeeding warnings/errors may be confusing.')
ENDIF
Available=.true.
IF (InvalidBranchDefinitions) THEN
CALL ShowFatalError('Preceding error(s) in Branch Input cause termination.')
ENDIF
CALL DisplayString('Initializing Simulation')
KickOffSimulation=.true.
CALL ResetEnvironmentCounter
CALL SetupSimulation(ErrorsFound)
CALL InitCurveReporting
AskForConnectionsReport=.true. ! set to true now that input processing and sizing is done.
KickOffSimulation=.false.
WarmupFlag=.false.
DoWeatherInitReporting=.true.
! Note: All the inputs have been 'gotten' by the time we get here.
ErrFound=.false.
IF (DoOutputReporting) THEN
CALL DisplayString('Reporting Surfaces')
CALL ReportSurfaces
CALL SetupNodeVarsForReporting
MetersHaveBeenInitialized=.true.
CALL SetupPollutionMeterReporting
CALL UpdateMeterReporting
CALL CheckPollutionMeterReporting
CALL VerifyCustomMetersElecPowerMgr
CALL SetupPollutionCalculations
CALL InitDemandManagers
CALL TestBranchIntegrity(ErrFound)
IF (ErrFound) TerminalError = .TRUE.
CALL TestAirPathIntegrity(ErrFound)
IF (ErrFound) TerminalError = .TRUE.
CALL CheckMarkedNodes(ErrFound)
IF (ErrFound) TerminalError = .TRUE.
CALL CheckNodeConnections(ErrFound)
IF (ErrFound) TerminalError = .TRUE.
CALL TestCompSetInletOutletNodes(ErrFound)
IF (ErrFound) TerminalError = .TRUE.
CALL CheckControllerLists(ErrFound)
IF (ErrFound) TerminalError = .TRUE.
IF (DoDesDaySim .OR. DoWeathSim) THEN
CALL ReportLoopConnections
CALL ReportAirLoopConnections
CALL ReportNodeConnections
! Debug reports
! CALL ReportCompSetMeterVariables
! CALL ReportParentChildren
END IF
CALL CreateEnergyReportStructure
CALL ManageEMS(emsCallFromSetupSimulation) ! point to finish setup processing EMS, sensor ready now
CALL ProduceRDDMDD
IF (TerminalError) THEN
CALL ShowFatalError('Previous Conditions cause program termination.')
END IF
END IF
IF (WriteOutputToSQLite) THEN
CALL SQLiteBegin
CALL CreateSQLiteSimulationsRecord(1)
CALL SQLiteCommit
END IF
CALL GetInputForLifeCycleCost !must be prior to WriteTabularReports -- do here before big simulation stuff.
CALL ShowMessage('Beginning Simulation')
CALL ResetEnvironmentCounter
EnvCount=0
WarmupFlag=.true.
DO WHILE (Available)
CALL GetNextEnvironment(Available,ErrorsFound)
IF (.not. Available) EXIT
IF (ErrorsFound) EXIT
IF ( (.NOT. DoDesDaySim) .AND. (KindOfSim /= ksRunPeriodWeather) ) CYCLE
IF ( (.NOT. DoWeathSim) .AND. (KindOfSim == ksRunPeriodWeather)) CYCLE
EnvCount=EnvCount+1
IF (WriteOutputToSQLite) THEN
CALL SQLiteBegin
CALL CreateSQLiteEnvironmentPeriodRecord()
CALL SQLiteCommit
END IF
ExitDuringSimulations=.true.
SimsDone=.true.
call DisplayString('Initializing New Environment Parameters')
BeginEnvrnFlag = .TRUE.
EndEnvrnFlag = .FALSE.
EndMonthFlag = .FALSE.
WarmupFlag = .TRUE.
DayOfSim = 0
DayOfSimChr ='0'
NumOfWarmupDays= 0
CALL ManageEMS(emsCallFromBeginNewEvironment) ! calling point
DO WHILE ((DayOfSim.LT.NumOfDayInEnvrn).OR.(WarmupFlag)) ! Begin day loop ...
IF (WriteOutputToSQLite) CALL SQLiteBegin ! setup for one transaction per day
DayOfSim = DayOfSim + 1
WRITE(DayOfSimChr,*) DayOfSim
DayOfSimChr=ADJUSTL(DayOfSimChr)
IF (.not. WarmUpFlag) THEN
CurrentOverallSimDay=CurrentOverallSimDay+1
CALL DisplaySimDaysProgress(CurrentOverallSimDay,TotalOverallSimDays)
ELSE
DayOfSimChr='0'
ENDIF
BeginDayFlag = .TRUE.
EndDayFlag = .FALSE.
IF (WarmupFlag) THEN
NumOfWarmupDays=NumOfWarmupDays+1
cWarmupDay=TrimSigDigits(NumOfWarmupDays)
CALL DisplayString('Warming up {'//TRIM(cWarmUpDay)//'}')
ELSEIF (DayOfSim == 1) THEN
CALL DisplayString('Starting Simulation at '//TRIM(CurMnDy)//' for '//TRIM(EnvironmentName))
WRITE(OutputFileInits,700) NumOfWarmupDays
700 FORMAT('Environment:WarmupDays,',I3)
ELSEIF (DisplayPerfSimulationFlag) THEN
CALL DisplayString('Continuing Simulation at '//TRIM(CurMnDy)//' for '//TRIM(EnvironmentName))
DisplayPerfSimulationFlag=.false.
END IF
DO HourOfDay = 1, 24 ! Begin hour loop ...
BeginHourFlag = .TRUE.
EndHourFlag = .FALSE.
DO TimeStep = 1, NumOfTimeStepInHour
BeginTimeStepFlag = .TRUE.
CALL ExternalInterfaceExchangeVariables
! Set the End__Flag variables to true if necessary. Note that
! each flag builds on the previous level. EndDayFlag cannot be
! .true. unless EndHourFlag is also .true., etc. Note that the
! EndEnvrnFlag and the EndSimFlag cannot be set during warmup.
! Note also that BeginTimeStepFlag, EndTimeStepFlag, and the
! SubTimeStepFlags can/will be set/reset in the HVAC Manager.
IF ((TimeStep.EQ.NumOfTimeStepInHour)) THEN
EndHourFlag = .TRUE.
IF (HourOfDay.EQ.24) THEN
EndDayFlag = .TRUE.
IF ((.NOT.WarmupFlag).AND.(DayOfSim.EQ.NumOfDayInEnvrn)) THEN
EndEnvrnFlag = .TRUE.
END IF
END IF
END IF
CALL ManageWeather
CALL ManageExteriorEnergyUse
CALL ManageHeatBalance
! After the first iteration of HeatBalance, all the 'input' has been gotten
IF (BeginFullSimFlag) THEN
IF (GetNumRangeCheckErrorsFound() > 0) THEN
CALL ShowFatalError('Out of "range" values found in input')
ENDIF
ENDIF
BeginHourFlag = .FALSE.
BeginDayFlag = .FALSE.
BeginEnvrnFlag = .FALSE.
BeginSimFlag = .FALSE.
BeginFullSimFlag = .FALSE.
END DO ! TimeStep loop
PreviousHour=HourOfDay
END DO ! ... End hour loop.
IF (WriteOutputToSQLite) CALL SQLiteCommit ! one transaction per day
END DO ! ... End day loop.
! Need one last call to send latest states to middleware
CALL ExternalInterfaceExchangeVariables
END DO ! ... End environment loop.
WarmupFlag=.false.
IF (.not. SimsDone .and. DoDesDaySim) THEN
IF ((TotDesDays+TotRunDesPersDays) == 0) THEN ! if sum is 0, then there was no sizing done.
CALL ShowWarningError('ManageSimulation: SizingPeriod:* were requested in SimulationControl '// &
'but no SizingPeriod:* objects in input.')
ENDIF
ENDIF
IF (.not. SimsDone .and. DoWeathSim) THEN
IF (.not. RunPeriodsInInput) THEN ! if no run period requested, and sims not done
CALL ShowWarningError('ManageSimulation: Weather Simulation was requested in SimulationControl '// &
'but no RunPeriods in input.')
ENDIF
ENDIF
IF (WriteOutputToSQLite) CALL SQLiteBegin ! for final data to write
#ifdef EP_Detailed_Timings
CALL epStartTime('Closeout Reporting=')
#endif
CALL SimCostEstimate
CALL ComputeTariff ! Compute the utility bills
CALL ReportForTabularReports ! For Energy Meters (could have other things that need to be pushed to after simulation)
CALL OpenOutputTabularFile
CALL WriteTabularReports ! Create the tabular reports at completion of each
CALL WriteTabularTariffReports
CALL ComputeLifeCycleCostAndReport !must be after WriteTabularReports and WriteTabularTariffReports
CALL CloseOutputTabularFile
CALL DumpAirLoopStatistics ! Dump runtime statistics for air loop controller simulation to csv file
#ifdef EP_Detailed_Timings
CALL epStopTime('Closeout Reporting=')
#endif
CALL CloseOutputFiles
CALL CreateZoneExtendedOutput
IF (WriteOutputToSQLite) THEN
CALL DisplayString('Writing final SQL reports')
CALL SQLiteCommit ! final transactions
CALL InitializeIndexes ! do not create indexes (SQL) until all is done.
ENDIF
IF (ErrorsFound) THEN
CALL ShowFatalError('Error condition occurred. Previous Severe Errors cause termination.')
ENDIF
RETURN
END SUBROUTINE ManageSimulation