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 ProcessInput
! SUBROUTINE INFORMATION:
! AUTHOR Linda K. Lawrie
! DATE WRITTEN August 1997
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine processes the input for EnergyPlus. First, the
! input data dictionary is read and interpreted. Using the structure
! from the data dictionary, the actual simulation input file is read.
! This file is processed according to the "rules" in the data dictionary
! and stored in a local data structure which will be used during the simulation.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE SortAndStringUtilities, ONLY: SetupAndSort
USE DataOutputs, ONLY: iNumberOfRecords,iNumberOfDefaultedFields,iTotalFieldsWithDefaults, &
iNumberOfAutosizedFields,iTotalAutoSizableFields,iNumberOfAutoCalcedFields,iTotalAutoCalculatableFields
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:
LOGICAL FileExists ! Check variable for .idd/.idf files
LOGICAL :: ErrorsInIDD=.false. ! to check for any errors flagged during data dictionary processing
INTEGER :: Loop
INTEGER :: CountErr
INTEGER :: Num1
INTEGER :: Which
INTEGER :: endcol
INTEGER :: write_stat
INTEGER :: read_stat
CALL InitSecretObjects
EchoInputFile=GetNewUnitNumber()
OPEN(unit=EchoInputFile,file='eplusout.audit',action='write',iostat=write_stat)
IF (write_stat /= 0) THEN
CALL DisplayString('Could not open (write) eplusout.audit.')
CALL ShowFatalError('ProcessInput: Could not open file "eplusout.audit" for output (write).')
ENDIF
INQUIRE(FILE='eplusout.iperr',EXIST=FileExists)
IF (FileExists) THEN
CacheIPErrorFile=GetNewUnitNumber()
open(unit=CacheIPErrorFile,file='eplusout.iperr',action='read', iostat=read_stat)
IF (read_stat /= 0) THEN
CALL ShowFatalError('EnergyPlus: Could not open file "eplusout.iperr" for input (read).')
ENDIF
close(unit=CacheIPErrorFile,status='delete')
ENDIF
CacheIPErrorFile=GetNewUnitNumber()
OPEN(unit=CacheIPErrorFile,file='eplusout.iperr',action='write',iostat=write_stat)
IF (write_stat /= 0) THEN
CALL DisplayString('Could not open (write) eplusout.iperr.')
CALL ShowFatalError('ProcessInput: Could not open file "eplusout.audit" for output (write).')
ENDIF
! FullName from StringGlobals is used to build file name with Path
IF (LEN_TRIM(ProgramPath) == 0) THEN
FullName='Energy+.idd'
ELSE
FullName=ProgramPath(1:LEN_TRIM(ProgramPath))//'Energy+.idd'
ENDIF
INQUIRE(file=FullName,EXIST=FileExists)
IF (.not. FileExists) THEN
CALL DisplayString('Missing '//TRIM(FullName))
CALL ShowFatalError('ProcessInput: Energy+.idd missing. Program terminates. Fullname='//TRIM(FullName))
ENDIF
IDDFile=GetNewUnitNumber()
StripCR=.false.
Open (unit=IDDFile, file=FullName, action='read', iostat=read_stat)
IF (read_stat /= 0) THEN
CALL DisplayString('Could not open (read) Energy+.idd.')
CALL ShowFatalError('ProcessInput: Could not open file "Energy+.idd" for input (read).')
ENDIF
READ(Unit=IDDFile, FMT=fmta) InputLine
endcol=LEN_TRIM(InputLine)
IF (endcol > 0) THEN
IF (ICHAR(InputLine(endcol:endcol)) == iASCII_CR) THEN
StripCR=.true.
ENDIF
IF (ICHAR(InputLine(endcol:endcol)) == iUnicode_end) THEN
CALL ShowSevereError('ProcessInput: "Energy+.idd" appears to be a Unicode or binary file.')
CALL ShowContinueError('...This file cannot be read by this program. Please save as PC or Unix file and try again')
CALL ShowFatalError('Program terminates due to previous condition.')
ENDIF
ENDIF
BACKSPACE(Unit=IDDFile)
NumLines=0
DoingInputProcessing=.true.
WRITE(EchoInputFile,*) ' Processing Data Dictionary (Energy+.idd) File -- Start'
CALL DisplayString('Processing Data Dictionary')
ProcessingIDD=.true.
Call ProcessDataDicFile(ErrorsInIDD)
ALLOCATE (ListofObjects(NumObjectDefs))
ListofObjects=ObjectDef(1:NumObjectDefs)%Name
IF (SortedIDD) THEN
ALLOCATE (iListofObjects(NumObjectDefs))
iListOfObjects=0
CALL SetupAndSort(ListOfObjects,iListOfObjects)
ENDIF
ALLOCATE (ObjectStartRecord(NumObjectDefs))
ObjectStartRecord=0
ALLOCATE (ObjectGotCount(NumObjectDefs))
ObjectGotCount=0
Close (unit=IDDFile)
IF (NumObjectDefs == 0) THEN
CALL ShowFatalError('ProcessInput: No objects found in IDD. Program will terminate.')
ErrorsInIDD=.true.
ENDIF
! If no fatal to here, rewind EchoInputFile -- only keep processing data...
IF (.not. ErrorsInIDD) THEN
REWIND(Unit=EchoInputFile)
ENDIF
ProcessingIDD=.false.
WRITE(EchoInputFile,*) ' Processing Data Dictionary (Energy+.idd) File -- Complete'
WRITE(EchoInputFile,*) ' Maximum number of Alpha Args=',MaxAlphaArgsFound
WRITE(EchoInputFile,*) ' Maximum number of Numeric Args=',MaxNumericArgsFound
WRITE(EchoInputFile,*) ' Number of Object Definitions=',NumObjectDefs
WRITE(EchoInputFile,*) ' Number of Section Definitions=',NumSectionDefs
WRITE(EchoInputFile,*) ' Total Number of Alpha Fields=',NumAlphaArgsFound
WRITE(EchoInputFile,*) ' Total Number of Numeric Fields=',NumNumericArgsFound
WRITE(EchoInputFile,*) ' Total Number of Fields=',NumAlphaArgsFound+NumNumericArgsFound
WRITE(EchoInputFile,*) ' Processing Input Data File (in.idf) -- Start'
INQUIRE(file='in.idf',EXIST=FileExists)
IF (.not. FileExists) THEN
CALL DisplayString('Missing '//TRIM(CurrentWorkingFolder)//'in.idf')
CALL ShowFatalError('ProcessInput: in.idf missing. Program terminates.')
ENDIF
StripCR=.false.
IDFFile=GetNewUnitNumber()
Open (unit=IDFFile, file='in.idf', action='READ', iostat=read_stat)
IF (read_stat /= 0) THEN
CALL DisplayString('Could not open (read) in.idf.')
CALL ShowFatalError('ProcessInput: Could not open file "in.idf" for input (read).')
ENDIF
READ(Unit=IDFFile, FMT=fmta) InputLine
endcol=LEN_TRIM(InputLine)
IF (endcol > 0) THEN
IF (ICHAR(InputLine(endcol:endcol)) == iASCII_CR) THEN
StripCR=.true.
ENDIF
IF (ICHAR(InputLine(endcol:endcol)) == iUnicode_end) THEN
CALL ShowSevereError('ProcessInput: "in.idf" appears to be a Unicode or binary file.')
CALL ShowContinueError('...This file cannot be read by this program. Please save as PC or Unix file and try again')
CALL ShowFatalError('Program terminates due to previous condition.')
ENDIF
ENDIF
BACKSPACE(Unit=IDFFile)
NumLines=0
EchoInputLine=.true.
CALL DisplayString('Processing Input File')
Call ProcessInputDataFile
ALLOCATE (ListofSections(NumSectionDefs))
ListofSections=SectionDef(1:NumSectionDefs)%Name
Close (unit=IDFFile)
ALLOCATE(cAlphaFieldNames(MaxAlphaIDFDefArgsFound))
cAlphaFieldNames=Blank
ALLOCATE(cAlphaArgs(MaxAlphaIDFDefArgsFound))
cAlphaArgs=Blank
ALLOCATE(lAlphaFieldBlanks(MaxAlphaIDFDefArgsFound))
lAlphaFieldBlanks=.false.
ALLOCATE(cNumericFieldNames(MaxNumericIDFDefArgsFound))
cNumericFieldNames=Blank
ALLOCATE(rNumericArgs(MaxNumericIDFDefArgsFound))
rNumericArgs=0.0d0
ALLOCATE(lNumericFieldBlanks(MaxNumericIDFDefArgsFound))
lNumericFieldBlanks=.false.
ALLOCATE(IDFRecordsGotten(NumIDFRecords))
IDFRecordsGotten=.false.
WRITE(EchoInputFile,*) ' Processing Input Data File (in.idf) -- Complete'
! WRITE(EchoInputFile,*) ' Number of IDF "Lines"=',NumIDFRecords
WRITE(EchoInputFile,*) ' Maximum number of Alpha IDF Args=',MaxAlphaIDFArgsFound
WRITE(EchoInputFile,*) ' Maximum number of Numeric IDF Args=',MaxNumericIDFArgsFound
CALL GetIDFRecordsStats(iNumberOfRecords,iNumberOfDefaultedFields,iTotalFieldsWithDefaults, &
iNumberOfAutosizedFields,iTotalAutoSizableFields, &
iNumberOfAutoCalcedFields,iTotalAutoCalculatableFields)
WRITE(EchoInputFile,*) ' Number of IDF "Lines"=',iNumberOfRecords
WRITE(EchoInputFile,*) ' Number of Defaulted Fields=',iNumberOfDefaultedFields
WRITE(EchoInputFile,*) ' Number of Fields with Defaults=',iTotalFieldsWithDefaults
WRITE(EchoInputFile,*) ' Number of Autosized Fields=',iNumberOfAutosizedFields
WRITE(EchoInputFile,*) ' Number of Autosizable Fields =',iTotalAutoSizableFields
WRITE(EchoInputFile,*) ' Number of Autocalculated Fields=',iNumberOfAutoCalcedFields
WRITE(EchoInputFile,*) ' Number of Autocalculatable Fields =',iTotalAutoCalculatableFields
CountErr=0
DO Loop=1,NumIDFSections
IF (SectionsonFile(Loop)%LastRecord /= 0) CYCLE
IF (MakeUPPERCase(SectionsonFile(Loop)%Name) == 'REPORT VARIABLE DICTIONARY') CYCLE
IF (CountErr == 0) THEN
CALL ShowSevereError('IP: Potential errors in IDF processing -- see .audit file for details.')
WRITE(EchoInputFile,fmta) ' Potential errors in IDF processing:'
ENDIF
CountErr=CountErr+1
Which=SectionsOnFile(Loop)%FirstRecord
IF (Which > 0) THEN
IF (SortedIDD) THEN
Num1=FindItemInSortedList(IDFRecords(Which)%Name,ListOfObjects,NumObjectDefs)
IF (Num1 /= 0) Num1=iListOfObjects(Num1)
ELSE
Num1=FindItemInList(IDFRecords(Which)%Name,ListOfObjects,NumObjectDefs)
ENDIF
IF (ObjectDef(Num1)%NameAlpha1 .and. IDFRecords(Which)%NumAlphas > 0) THEN
WRITE(EchoInputFile,fmta) ' Potential "semi-colon" misplacement='// &
TRIM(SectionsonFile(Loop)%Name)// &
', at about line number=['//TRIM(IPTrimSigDigits(SectionsonFile(Loop)%FirstLineNo))// &
'], Object Type Preceding='//TRIM(IDFRecords(Which)%Name)// &
', Object Name='//TRIM(IDFRecords(Which)%Alphas(1))
ELSE
WRITE(EchoInputFile,fmta) ' Potential "semi-colon" misplacement='// &
TRIM(SectionsonFile(Loop)%Name)// &
', at about line number=['//TRIM(IPTrimSigDigits(SectionsonFile(Loop)%FirstLineNo))// &
'], Object Type Preceding='//TRIM(IDFRecords(Which)%Name)// &
', Name field not recorded for Object.'
ENDIF
ELSE
WRITE(EchoInputFile,fmta) ' Potential "semi-colon" misplacement='// &
TRIM(SectionsonFile(Loop)%Name)// &
', at about line number=['//TRIM(IPTrimSigDigits(SectionsonFile(Loop)%FirstLineNo))// &
'], No prior Objects.'
ENDIF
ENDDO
IF (NumIDFRecords == 0) THEN
CALL ShowSevereError('IP: The IDF file has no records.')
NumMiscErrorsFound=NumMiscErrorsFound+1
ENDIF
! Check for required objects
DO Loop=1,NumObjectDefs
IF (.not. ObjectDef(Loop)%RequiredObject) CYCLE
IF (ObjectDef(Loop)%NumFound > 0) CYCLE
CALL ShowSevereError('IP: Required Object="'//trim(ObjectDef(Loop)%Name)//'" not found in IDF.')
NumMiscErrorsFound=NumMiscErrorsFound+1
ENDDO
IF (TotalAuditErrors > 0) THEN
CALL ShowWarningError('IP: Note -- Some missing fields have been filled with defaults.'// &
' See the audit output file for details.')
ENDIF
IF (NumOutOfRangeErrorsFound > 0) THEN
CALL ShowSevereError('IP: Out of "range" values found in input')
ENDIF
IF (NumBlankReqFieldFound > 0) THEN
CALL ShowSevereError('IP: Blank "required" fields found in input')
ENDIF
IF (NumMiscErrorsFound > 0) THEN
CALL ShowSevereError('IP: Other miscellaneous errors found in input')
ENDIF
IF (OverallErrorFlag) THEN
CALL ShowSevereError('IP: Possible incorrect IDD File')
CALL ShowContinueError('IDD Version:"'//TRIM(IDDVerString)//'"')
DO Loop=1,NumIDFRecords
IF (SameString(IDFRecords(Loop)%Name,'Version')) THEN
Num1=LEN_TRIM(MatchVersion)
IF (MatchVersion(Num1:Num1) == '0') THEN
Which=INDEX(IDFRecords(Loop)%Alphas(1)(1:Num1-2),MatchVersion(1:Num1-2))
ELSE
Which=INDEX(IDFRecords(Loop)%Alphas(1),MatchVersion)
ENDIF
IF (Which /= 1) THEN
CALL ShowContinueError('Version in IDF="'//TRIM(IDFRecords(Loop)%Alphas(1))// &
'" not the same as expected="'//TRIM(MatchVersion)//'"')
ENDIF
EXIT
ENDIF
ENDDO
CALL ShowContinueError('Possible Invalid Numerics or other problems')
! Fatal error will now occur during post IP processing check in Simulation manager.
ENDIF
RETURN
END SUBROUTINE ProcessInput