InterpretWeatherDataLine Subroutine

private subroutine InterpretWeatherDataLine(Line, ErrorFound, WYear, WMonth, WDay, Whour, WMinute, RField1, RField2, RField3, RField4, RField5, RField6, RField7, RField8, RField9, RField10, RField11, RField12, RField13, RField14, RField15, RField16, RField17, RField18, RField19, RField20, WObs, WCodesArr, RField22, RField23, RField24, RField25, RField26, RField27)

Arguments

Type	Intent	Attributes		Name
character(len=*),	intent(inout)		::	Line
logical,	intent(out)		::	ErrorFound
integer,	intent(out)		::	WYear
integer,	intent(out)		::	WMonth
integer,	intent(out)		::	WDay
integer,	intent(out)		::	Whour
integer,	intent(out)		::	WMinute
real(kind=r64),	intent(out)		::	RField1
real(kind=r64),	intent(out)		::	RField2
real(kind=r64),	intent(out)		::	RField3
real(kind=r64),	intent(out)		::	RField4
real(kind=r64),	intent(out)		::	RField5
real(kind=r64),	intent(out)		::	RField6
real(kind=r64),	intent(out)		::	RField7
real(kind=r64),	intent(out)		::	RField8
real(kind=r64),	intent(out)		::	RField9
real(kind=r64),	intent(out)		::	RField10
real(kind=r64),	intent(out)		::	RField11
real(kind=r64),	intent(out)		::	RField12
real(kind=r64),	intent(out)		::	RField13
real(kind=r64),	intent(out)		::	RField14
real(kind=r64),	intent(out)		::	RField15
real(kind=r64),	intent(out)		::	RField16
real(kind=r64),	intent(out)		::	RField17
real(kind=r64),	intent(out)		::	RField18
real(kind=r64),	intent(out)		::	RField19
real(kind=r64),	intent(out)		::	RField20
integer,	intent(out)		::	WObs
integer,	intent(out),	DIMENSION(9)	::	WCodesArr
real(kind=r64),	intent(out)		::	RField22
real(kind=r64),	intent(out)		::	RField23
real(kind=r64),	intent(out)		::	RField24
real(kind=r64),	intent(out)		::	RField25
real(kind=r64),	intent(out)		::	RField26
real(kind=r64),	intent(out)		::	RField27

Source Code

SUBROUTINE InterpretWeatherDataLine(Line,ErrorFound,WYear,WMonth,WDay,Whour,WMinute,  &
              RField1,RField2,RField3,RField4,RField5,RField6,RField7,RField8,RField9,  &
              RField10,RField11,RField12,RField13,RField14,RField15,RField16,RField17,  &
              RField18,RField19,RField20,WObs,WCodesArr,RField22,RField23,RField24,RField25,  &
              RField26,RField27)

          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Linda Lawrie
          !       DATE WRITTEN   April 2001
          !       MODIFIED       na
          !       RE-ENGINEERED  na

          ! PURPOSE OF THIS SUBROUTINE:
          ! This subroutine interprets the EPW weather data line because comma delimited fields
          ! may cause problems with some compilers.  (Particularly character variables in
          ! comma delimited lines.

          ! METHODOLOGY EMPLOYED:
          ! Field by field interpretation, eliminating the "data source field" which is also
          ! likely to contain blanks.  Note that the "Weatherconditions" must be a 9 character
          ! alpha field with no intervening blanks.

          ! REFERENCES:
          ! CALL InterpretWeatherDataLine(WeatherDataLine,ErrorFound,WYear,WMonth,WDay,WHour,WMinute,  &
          !       DryBulb,DewPoint,RelHum,AtmPress,ETHoriz,ETDirect,IRHoriz,GLBHoriz,            &
          !       DirectRad,DiffuseRad,GLBHorizIllum,DirectNrmIllum,DiffuseHorizIllum,ZenLum,    &
          !       WindDir,WindSpeed,TotalSkyCover,OpaqueSkyCover,Visibility,CeilHeight,          &
          !       PresWeathObs,PresWeathConds,PrecipWater,AerosolOptDepth,SnowDepth,DaysSinceLastSnow,
          !       Albedo,LiquidPrecipDepth)

          ! USE STATEMENTS:
          ! na

  IMPLICIT NONE    ! Enforce explicit typing of all variables in this routine

          ! SUBROUTINE ARGUMENT DEFINITIONS:
  CHARACTER(len=*), INTENT(INOUT) :: Line
  LOGICAL, INTENT(OUT)   :: ErrorFound
  INTEGER, INTENT(OUT)   :: WYear
  INTEGER, INTENT(OUT)   :: WMonth
  INTEGER, INTENT(OUT)   :: WDay
  INTEGER, INTENT(OUT)   :: Whour
  INTEGER, INTENT(OUT)   :: WMinute
  REAL(r64), INTENT(OUT) :: RField1            !       DryBulb
  REAL(r64), INTENT(OUT) :: RField2            !       DewPoint
  REAL(r64), INTENT(OUT) :: RField3            !       RelHum
  REAL(r64), INTENT(OUT) :: RField4            !       AtmPress
  REAL(r64), INTENT(OUT) :: RField5            !       ETHoriz
  REAL(r64), INTENT(OUT) :: RField6            !       ETDirect
  REAL(r64), INTENT(OUT) :: RField7            !       IRHoriz
  REAL(r64), INTENT(OUT) :: RField8            !       GLBHoriz
  REAL(r64), INTENT(OUT) :: RField9            !       DirectRad
  REAL(r64), INTENT(OUT) :: RField10           !       DiffuseRad
  REAL(r64), INTENT(OUT) :: RField11           !       GLBHorizIllum
  REAL(r64), INTENT(OUT) :: RField12           !       DirectNrmIllum
  REAL(r64), INTENT(OUT) :: RField13           !       DiffuseHorizIllum
  REAL(r64), INTENT(OUT) :: RField14           !       ZenLum
  REAL(r64), INTENT(OUT) :: RField15           !       WindDir
  REAL(r64), INTENT(OUT) :: RField16           !       WindSpeed
  REAL(r64), INTENT(OUT) :: RField17           !       TotalSkyCover
  REAL(r64), INTENT(OUT) :: RField18           !       OpaqueSkyCover
  REAL(r64), INTENT(OUT) :: RField19           !       Visibility
  REAL(r64), INTENT(OUT) :: RField20           !       CeilHeight
  INTEGER, INTENT(OUT)   :: WObs               !       PresWeathObs
  INTEGER, DIMENSION(9), INTENT(OUT) ::WCodesArr       !       PresWeathConds
  REAL(r64), INTENT(OUT) :: RField22           !       PrecipWater
  REAL(r64), INTENT(OUT) :: RField23           !       AerosolOptDepth
  REAL(r64), INTENT(OUT) :: RField24           !       SnowDepth
  REAL(r64), INTENT(OUT) :: RField25           !       DaysSinceLastSnow
  REAL(r64), INTENT(OUT) :: RField26           !       Albedo
  REAL(r64), INTENT(OUT) :: RField27           !       LiquidPrecip

          ! SUBROUTINE PARAMETER DEFINITIONS:
  CHARACTER(len=10), PARAMETER :: ValidDigits='0123456789'
          ! INTERFACE BLOCK SPECIFICATIONS:
          ! na

          ! DERIVED TYPE DEFINITIONS:
          ! na

          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
  CHARACTER(len=LEN(Line)) :: SaveLine
  INTEGER Pos
  CHARACTER(len=20) PresWeathCodes
  REAL(r64) RYear
  REAL(r64) RMonth
  REAL(r64) RDay
  REAL(r64) RHour
  REAL(r64) RMinute
  CHARACTER(len=32) DateError
  REAL(r64)       :: RField21
  INTEGER Count
  INTEGER, SAVE :: LCount=0
  LOGICAL :: DateInError

  LCount=LCount+1
  IF (StripCR) THEN
    Pos=LEN_TRIM(Line)
    IF (ICHAR(Line(Pos:Pos)) == iASCII_CR) Line(Pos:Pos)=Blank
  ENDIF
  ErrorFound=.false.
  SaveLine=Line   ! in case of errors

  ! Do the first five.  (To get to the DataSource field)
  READ(Line,*,ERR=900) RYear,RMonth,RDay,RHour,RMinute
  WYear=NINT(RYear)
  WMonth=NINT(RMonth)
  WDay=NINT(RDay)
  WHour=NINT(RHour)
  WMinute=NINT(RMinute)

  DateInError=.false.
  IF (WMonth >=1 .and. WMonth <=12) THEN
    ! Month number is valid
    IF (WMonth /= 2) THEN
      IF (WDay > EndDayOfMonth(WMonth)) THEN
        DateInError=.true.
      ENDIF
    ELSEIF (WDay > EndDayOfMonth(WMonth)+1) THEN  ! Whether actually used is determined by calling routine.
      DateInError=.true.
    ENDIF
  ELSE
    DateInError=.true.
  ENDIF

  IF (DateInError) THEN
    CALL ShowSevereError('Reading Weather Data Line, Invalid Date, Year='//TRIM(RoundSigDigits(WYear))//  &
        ', Month='//TRIM(RoundSigDigits(WMonth))//', Day='//TRIM(RoundSigDigits(WDay)))
    CALL ShowFatalError('Program terminates due to previous condition.')
  ENDIF

  Pos=INDEX(Line,',')  ! WYear
  IF (Pos == 0) THEN
    GOTO 902
  ENDIF
  Line=Line(Pos+1:)
  Pos=INDEX(Line,',')  ! WMonth
  Line=Line(Pos+1:)
  Pos=INDEX(Line,',')  ! WDay
  Line=Line(Pos+1:)
  Pos=INDEX(Line,',')  ! WHour
  Line=Line(Pos+1:)
  Pos=INDEX(Line,',')  ! WMinute
  Line=Line(Pos+1:)

  ! Data Source/Integrity field -- ignore
  Pos=INDEX(Line,',')
  Line=Line(Pos+1:)

  ! Now read more numerics with List Directed I/O (note there is another "character" field lurking)
  READ(Line,*,err=901) RField1,RField2,RField3,RField4,RField5,RField6,RField7,RField8,RField9,           &
               RField10,RField11,RField12,RField13,RField14,RField15,RField16,RField17,RField18,  &
               RField19,RField20,RField21
  DO Count=1,21
    Pos=INDEX(Line,',')
    Line=Line(Pos+1:)
  ENDDO
  Pos=INDEX(Line,',')
  IF (Pos > 0 .and. Pos /= 1) THEN
    PresWeathCodes=Line(1:Pos-1)
  ELSE
    PresWeathCodes='999999999'
  ENDIF
  Line=Line(Pos+1:)
  Pos=INDEX(Line,',')
  IF (Pos /= 0) THEN
    IF (Pos /= 1) THEN
      READ(Line(1:Pos-1),*,err=901) RField22
    ELSE
      RField22=999.0d0
    ENDIF
    Line=Line(Pos+1:)
    Pos=INDEX(Line,',')
    IF (Pos /= 0) THEN
      IF (Pos /= 1) THEN
        READ(Line(1:Pos-1),*,err=901) RField23
      ELSE
        RField23=999.0d0
      ENDIF
      Line=Line(Pos+1:)
      Pos=INDEX(Line,',')
      IF (Pos /= 0) THEN
        IF (Pos /= 1) THEN
          READ(Line(1:Pos-1),*,err=901) RField24
        ELSE
          RField24=999.0d0
        ENDIF
        Line=Line(Pos+1:)
        Pos=INDEX(Line,',')
        IF (Pos /= 0) THEN
          IF (Pos /= 1) THEN
            READ(Line(1:Pos-1),*,err=901) RField25
          ELSE
            RField25=999.0d0
          ENDIF
          Line=Line(Pos+1:)
          Pos=INDEX(Line,',')
          IF (Pos /= 0) THEN
            IF (Pos /= 1) THEN
              READ(Line(1:Pos-1),*,err=901) RField26
            ELSE
              RField26=999.0d0
            ENDIF
            Line=Line(Pos+1:)
            Pos=INDEX(Line,',')
            IF (Pos /= 0) THEN
              IF (Pos /= 1) THEN
                READ(Line(1:Pos-1),*,err=901) RField27
              ELSE
                RField27=999.0d0
              ENDIF
              Line=Line(Pos+1:)
              Pos=INDEX(Line,',')
            ELSE
              RField27=999.0d0
            ENDIF
          ELSE
            RField26=999.0d0
            RField27=999.0d0
          ENDIF
        ELSE
          READ(Line,*,err=901) RField25
          RField26=999.0d0
          RField27=999.0d0
        ENDIF
      ELSE
        READ(Line,*,err=901) RField24
        RField25=999.0d0
        RField26=999.0d0
        RField27=999.0d0
      ENDIF
    ELSE
      READ(Line,*,err=901) RField23
      RField24=999.0d0
      RField25=999.0d0
      RField26=999.0d0
      RField27=999.0d0
    ENDIF
  ELSE
    READ(Line,*,err=901) RField22
    RField23=999.0d0
    RField24=999.0d0
    RField25=999.0d0
    RField26=999.0d0
    RField27=999.0d0
  ENDIF
!  READ(Line,*,err=903,end=903) RField22,RField23,RField24,RField25

  WObs=NINT(RField21)
  IF (WObs == 0) THEN  ! Obs Indicator indicates Weather Codes valid
    ! Check for miscellaneous characters
    Pos=INDEX(PresWeathCodes,'''')
    DO WHILE (Pos > 0)
      PresWeathCodes(Pos:Pos)=Blank
      Pos=INDEX(PresWeathCodes,'''')
    ENDDO
    Pos=INDEX(PresWeathCodes,'"')
    DO WHILE (Pos > 0)
      PresWeathCodes(Pos:Pos)=Blank
      Pos=INDEX(PresWeathCodes,'"')
    ENDDO
    PresWeathCodes=ADJUSTL(PresWeathCodes)
    IF (LEN_TRIM(PresWeathCodes) == 9) THEN
      DO Pos=1,9
        IF (INDEX(ValidDigits,PresWeathCodes(Pos:Pos)) == 0) PresWeathCodes(Pos:Pos)='9'
      ENDDO
      READ(PresWeathCodes,'(9I1)') WCodesArr
    ELSE
      Missed%WeathCodes=Missed%WeathCodes+1
      WCodesArr=9
    ENDIF
  ELSE
    WCodesArr=9
  ENDIF


  RETURN

  900 CALL ShowSevereError('Invalid Date info in Weather Line')
      CALL ShowContinueError('Entire Data Line='//TRIM(SaveLine))
      CALL ShowFatalError('Error in Reading Weather Data')

  901 WRITE(DateError,"(I4,'/',I2,'/',I2,' Hour#=',I2,' Min#=',I2)") WYear,WMonth,WDay,WHour,WMinute
      CALL ShowSevereError('Invalid Weather Line at date='//TRIM(DateError))
      CALL ShowContinueError('Full Data Line='//trim(SaveLine))
      CALL ShowContinueError('Remainder of line='//TRIM(Line))
      CALL ShowFatalError('Error in Reading Weather Data')

  902 WRITE(DateError,"(I4,'/',I2,'/',I2,' Hour#=',I2,' Min#=',I2)") WYear,WMonth,WDay,WHour,WMinute
      CALL ShowSevereError('Invalid Weather Line (no commas) at date='//TRIM(DateError))
      CALL ShowContinueError('Full Data Line='//trim(SaveLine))
      CALL ShowContinueError('Remainder of line='//TRIM(Line))
      CALL ShowFatalError('Error in Reading Weather Data')

  903 WRITE(DateError,"(I4,'/',I2,'/',I2,' Hour#=',I2,' Min#=',I2)") WYear,WMonth,WDay,WHour,WMinute
      CALL ShowSevereError('Invalid Weather Line at date='//TRIM(DateError))
      CALL ShowContinueError('Full Data Line='//trim(SaveLine))
      CALL ShowContinueError('Partial line read; Remainder of line='//TRIM(Line))
      CALL ShowFatalError('Error in Reading Weather Data')

END SUBROUTINE InterpretWeatherDataLine

All Procedures

InterpretWeatherDataLine Subroutine

Source Code

All Procedures

Arguments

Calls

Called By

Source Code

Source Code

All Procedures