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) | :: | NoIdf | |||
logical, | intent(in) | :: | NoIDD |
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 AbortEnergyPlus(NoIdf,NoIDD)
! SUBROUTINE INFORMATION:
! AUTHOR Linda K. Lawrie
! DATE WRITTEN December 1997
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine causes the program to halt due to a fatal error.
! METHODOLOGY EMPLOYED:
! Puts a message on output files.
! Closes files.
! Stops the program.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataPrecisionGlobals
USE DataSystemVariables
USE DataTimings
USE DataErrorTracking
USE DataInterfaces, ONLY: ShowMessage
USE General, ONLY: RoundSigDigits
USE NodeInputManager, ONLY: SetupNodeVarsForReporting,CheckMarkedNodes
USE BranchInputManager, ONLY: TestBranchIntegrity
USE BranchNodeConnections, ONLY: CheckNodeConnections,TestCompSetInletOutletNodes
USE SimulationManager, ONLY: ReportLoopConnections
USE SystemReports, ONLY: ReportAirLoopConnections
USE SolarShading, ONLY: ReportSurfaceErrors
USE PlantManager, ONLY: CheckPlantOnAbort
USE ExternalInterface, ONLY: NumExternalInterfaces, CloseSocket
USE SQLiteProcedures, ONLY: UpdateSQLiteSimulationRecord, WriteOutputToSQLite
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(IN) :: NoIdf ! Set to true when "noidf" was found
LOGICAL, INTENT(IN) :: NoIDD ! Set to true when "noidd" was found
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: OutFmt="('Press ENTER to continue after reading above message>')" ! removed ,$ from string as unsupported by gfortran
CHARACTER(len=*), PARAMETER :: ETimeFmt="(I2.2,'hr ',I2.2,'min ',F5.2,'sec')"
! INTERFACE BLOCK SPECIFICATIONS
! see DataInterfaces
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER tempfl
INTEGER, EXTERNAL :: GetNewUnitNumber
CHARACTER(len=32) NumWarnings
CHARACTER(len=32) NumSevere
CHARACTER(len=32) NumWarningsDuringWarmup
CHARACTER(len=32) NumSevereDuringWarmup
CHARACTER(len=32) NumWarningsDuringSizing
CHARACTER(len=32) NumSevereDuringSizing
CHARACTER(len=32) Elapsed
INTEGER Hours ! Elapsed Time Hour Reporting
INTEGER Minutes ! Elapsed Time Minute Reporting
REAL(r64) Seconds ! Elapsed Time Second Reporting
LOGICAL ErrFound
LOGICAL TerminalError
INTEGER :: write_stat
IF( WriteOutputToSQLite ) THEN
CALL UpdateSQLiteSimulationRecord(.true.,.false.)
ENDIF
AbortProcessing=.true.
IF (AskForConnectionsReport) THEN
AskForConnectionsReport=.false. ! Set false here in case any further fatal errors in below processing...
CALL ShowMessage('Fatal error -- final processing. More error messages may appear.')
CALL SetupNodeVarsForReporting
ErrFound=.false.
TerminalError=.false.
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.
IF (.not. TerminalError) THEN
CALL ReportAirLoopConnections
CALL ReportLoopConnections
ENDIF
ELSEIF (.not. ExitDuringSimulations) THEN
CALL ShowMessage('Warning: Node connection errors not checked - most system input has not been read (see previous warning).')
CALL ShowMessage('Fatal error -- final processing. Program exited before simulations began. See previous error messages.')
ENDIF
IF (AskForSurfacesReport) THEN
CALL ReportSurfaces
ENDIF
CALL ReportSurfaceErrors
CALL CheckPlantOnAbort
CALL ShowRecurringErrors
CALL SummarizeErrors
CALL CloseMiscOpenFiles
NumWarnings=RoundSigDigits(TotalWarningErrors)
NumWarnings=ADJUSTL(NumWarnings)
NumSevere=RoundSigDigits(TotalSevereErrors)
NumSevere=ADJUSTL(NumSevere)
NumWarningsDuringWarmup=RoundSigDigits(TotalWarningErrorsDuringWarmup)
NumWarningsDuringWarmup=ADJUSTL(NumWarningsDuringWarmup)
NumSevereDuringWarmup=RoundSigDigits(TotalSevereErrorsDuringWarmup)
NumSevereDuringWarmup=ADJUSTL(NumSevereDuringWarmup)
NumWarningsDuringSizing=RoundSigDigits(TotalWarningErrorsDuringSizing)
NumWarningsDuringSizing=ADJUSTL(NumWarningsDuringSizing)
NumSevereDuringSizing=RoundSigDigits(TotalSevereErrorsDuringSizing)
NumSevereDuringSizing=ADJUSTL(NumSevereDuringSizing)
IF (NoIDD) THEN
CALL DisplayString('No EnergyPlus Data Dictionary (Energy+.idd) was found. It is possible ')
CALL DisplayString('you "double-clicked"EnergyPlus.exe rather than using one of the methods')
CALL DisplayString('to run Energyplus as found in the GettingStarted document in the')
CALL DisplayString('documentation folder. Using EP-Launch may be best -- ')
CALL DisplayString('it provides extra help for new users.')
CALL ShowMessage('No EnergyPlus Data Dictionary (Energy+.idd) was found. It is possible you "double-clicked" EnergyPlus.exe ')
CALL ShowMessage('rather than using one of the methods to run Energyplus as found in the GettingStarted document')
CALL ShowMessage('in the documentation folder. Using EP-Launch may be best -- it provides extra help for new users.')
WRITE(*,OutFmt)
READ(*,*)
ENDIF
IF (NoIdf) THEN
CALL DisplayString('No input file (in.idf) was found. It is possible you "double-clicked"')
CALL DisplayString('EnergyPlus.exe rather than using one of the methods to run Energyplus')
CALL DisplayString('as found in the GettingStarted document in the documentation folder.')
CALL DisplayString('Using EP-Launch may be best -- it provides extra help for new users.')
CALL ShowMessage('No input file (in.idf) was found. It is possible you "double-clicked" EnergyPlus.exe rather than')
CALL ShowMessage('using one of the methods to run Energyplus as found in the GettingStarted document in the documentation')
CALL ShowMessage('folder. Using EP-Launch may be best -- it provides extra help for new users.')
WRITE(*,OutFmt)
READ(*,*)
ENDIF
! catch up with timings if in middle
Time_Finish=epElapsedTime()
if (Time_Finish < Time_Start) Time_Finish=Time_Finish+24.0d0*3600.0d0
Elapsed_Time=Time_Finish-Time_Start
#ifdef EP_Detailed_Timings
CALL epStopTime('EntireRun=')
#endif
IF (Elapsed_Time < 0.0d0) Elapsed_Time=0.0d0
Hours=Elapsed_Time/3600.d0
Elapsed_Time=Elapsed_Time-Hours*3600.0d0
Minutes=Elapsed_Time/60.0d0
Elapsed_Time=Elapsed_Time-Minutes*60.0d0
Seconds=Elapsed_Time
IF (Seconds < 0.0d0) Seconds=0.0d0
WRITE(Elapsed,ETimeFmt) Hours,Minutes,Seconds
CALL ShowMessage('EnergyPlus Warmup Error Summary. During Warmup: '//TRIM(NumWarningsDuringWarmup)// &
' Warning; '//TRIM(NumSevereDuringWarmup)//' Severe Errors.')
CALL ShowMessage('EnergyPlus Sizing Error Summary. During Sizing: '//TRIM(NumWarningsDuringSizing)// &
' Warning; '//TRIM(NumSevereDuringSizing)//' Severe Errors.')
CALL ShowMessage('EnergyPlus Terminated--Fatal Error Detected. '//TRIM(NumWarnings)//' Warning; '// &
TRIM(NumSevere)//' Severe Errors;'// &
' Elapsed Time='//TRIM(Elapsed))
CALL DisplayString('EnergyPlus Run Time='//TRIM(Elapsed))
tempfl=GetNewUnitNumber()
open(tempfl,file='eplusout.end', Action='write',iostat=write_stat)
IF (write_stat /= 0) THEN
CALL DisplayString('AbortEnergyPlus: Could not open file "eplusout.end" for output (write).')
ENDIF
write(tempfl,*) 'EnergyPlus Terminated--Fatal Error Detected. '//TRIM(NumWarnings)//' Warning; '// &
TRIM(NumSevere)//' Severe Errors;'//' Elapsed Time='//TRIM(Elapsed)
close(tempfl)
#ifdef EP_Detailed_Timings
CALL epSummaryTimes(Time_Finish-Time_Start)
#endif
CALL CloseOutOpenFiles
! Close the socket used by ExternalInterface. This call also sends the flag "-1" to the ExternalInterface,
! indicating that E+ terminated with an error.
IF (NumExternalInterfaces > 0) CALL CloseSocket(-1)
STOP 'EnergyPlus Terminated--Error(s) Detected.'
RETURN
END SUBROUTINE AbortEnergyPlus