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 SkipEPlusWFHeader
! SUBROUTINE INFORMATION:
! AUTHOR Linda K. Lawrie
! DATE WRITTEN August 2000
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine skips the initial header records on the EnergyPlus Weather File (in.epw).
! METHODOLOGY EMPLOYED:
! List directed reads, as possible.
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: MakeUPPERCase, ProcessNumber
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: AFormat="(A)"
CHARACTER(len=*), PARAMETER :: Header="DATA PERIODS"
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER Pos
CHARACTER(len=255) Line
integer HdPos
logical StillLooking
integer, external :: FindNonSpace
INTEGER NumHdArgs
INTEGER Count
INTEGER CurCount
INTEGER CurOne
INTEGER NumPeriods
LOGICAL IOStatus
INTEGER endcol
! Read in Header Information
! Headers should come in order
StillLooking=.true.
DO WHILE (StillLooking)
READ(WeatherFileUnitNumber,AFormat,END=9998) line
Pos=FindNonSpace(line)
line=MakeUPPERCase(line)
HdPos=INDEX(line,TRIM(Header))
IF (HdPos /= 0) EXIT
ENDDO
! Dummy process Data Periods line
! 'DATA PERIODS'
! N1, \field Number of Data Periods
! N2, \field Number of Records per hour
! A1, \field Data Period 1 Name/Description
! A2, \field Data Period 1 Start Day of Week
! \type choice
! \key Sunday
! \key Monday
! \key Tuesday
! \key Wednesday
! \key Thursday
! \key Friday
! \key Saturday
! A3, \field Data Period 1 Start Day
! A4, \field Data Period 1 End Day
NumHdArgs=2
Count=1
DO WHILE (Count <= NumHdArgs)
Line=ADJUSTL(Line)
Pos=INDEX(Line,',')
IF (Pos == 0) THEN
IF (LEN_TRIM(Line) == 0) THEN
DO WHILE (Pos == 0)
READ(WeatherFileUnitNumber,AFormat) Line
IF (StripCR) THEN
endcol=LEN_TRIM(Line)
IF (endcol > 0) THEN
IF (ICHAR(Line(endcol:endcol)) == iASCII_CR) Line(endcol:endcol)=Blank
ENDIF
ENDIF
Line=ADJUSTL(Line)
Line=MakeUPPERCase(Line)
Pos=INDEX(Line,',')
ENDDO
ELSE
Pos=LEN_TRIM(Line)+1
ENDIF
ENDIF
SELECT CASE(Count)
CASE(1)
NumPeriods=ProcessNumber(Line(1:Pos-1),IOStatus)
NumHdArgs=NumHdArgs+4*NumPeriods
CurCount=0
CASE(2)
CASE(3:)
CurOne=MOD(Count-3,4)
SELECT CASE(CurOne)
CASE(0)
! Description of Data Period
CurCount=CurCount+1
CASE(1:3)
END SELECT
END SELECT
Line=Line(Pos+1:)
Count=Count+1
ENDDO
RETURN
9998 CALL ShowFatalError('Unexpected End-of-File on EPW Weather file, while reading header information, looking for header='// &
TRIM(Header),OutputFileStandard)
RETURN
END SUBROUTINE SkipEPlusWFHeader