SUBROUTINE ReadEPlusWeatherForDay(DayToRead,Environ,BackSpaceAfterRead)
! SUBROUTINE INFORMATION:
! AUTHOR Linda K. Lawrie
! DATE WRITTEN April 1999
! MODIFIED March 2012; add actual weather read.
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine reads the appropriate day of EPW weather data.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: RangeCheck
USE General, ONLY: JulianDay,RoundSigDigits
USE ScheduleManager, ONLY: GetScheduleValuesForDay
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: DayToRead ! =1 when starting out, otherwise signifies next day
INTEGER, INTENT(IN) :: Environ ! Environment being simulated
LOGICAL, INTENT(IN) :: BackSpaceAfterRead ! True if weather file is to be backspaced after read
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: YMDHFmt="(I4.4,2('/',I2.2),1X,I2.2,':',I2.2)"
CHARACTER(len=*), PARAMETER :: YMDHFmt1="(I4.4,2('/',I2.2),1X,'hour=',I2.2,' - expected hour=',I2.2)"
CHARACTER(len=*), PARAMETER :: DataFmt="(A)"
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
TYPE HourlyWeatherData
LOGICAL, DIMENSION(24) :: IsRain = .false. ! Rain indicator, true=rain
LOGICAL, DIMENSION(24) :: IsSnow = .false. ! Snow indicator, true=snow
REAL(r64), DIMENSION(24) :: OutDryBulbTemp = 0.0d0 ! Hourly dry bulb temperature of outside air
REAL(r64), DIMENSION(24) :: OutDewPointTemp= 0.0d0 ! Hourly Dew Point Temperature of outside air
REAL(r64), DIMENSION(24) :: OutBaroPress = 0.0d0 ! Hourly barometric pressure of outside air
REAL(r64), DIMENSION(24) :: OutRelHum = 0.0d0 ! Hourly relative humidity
REAL(r64), DIMENSION(24) :: WindSpeed = 0.0d0 ! Hourly wind speed of outside air
REAL(r64), DIMENSION(24) :: WindDir = 0.0d0 ! Hourly wind direction of outside air
REAL(r64), DIMENSION(24) :: SkyTemp = 0.0d0 ! Hourly sky temperature
REAL(r64), DIMENSION(24) :: HorizIRSky = 0.0d0 ! Hourly Horizontal Infrared Radiation Intensity
REAL(r64), DIMENSION(24) :: BeamSolarRad = 0.0d0 ! Hourly direct normal solar irradiance
REAL(r64), DIMENSION(24) :: DifSolarRad = 0.0d0 ! Hourly sky diffuse horizontal solar irradiance
REAL(r64), DIMENSION(24) :: Albedo = 0.0d0 ! Albedo
REAL(r64), DIMENSION(24) :: LiquidPrecip = 0.0d0 ! Liquid Precipitation
END TYPE
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER Hour
INTEGER TS
INTEGER WYear,WMonth,WDay,WHour,WMinute
REAL(r64) DryBulb,DewPoint,RelHum,AtmPress,ETHoriz,ETDirect,IRHoriz,GLBHoriz, &
DirectRad,DiffuseRad,GLBHorizIllum,DirectNrmIllum,DiffuseHorizIllum,ZenLum,WindDir,WindSpeed, &
TotalSkyCover,OpaqueSkyCover,Visibility,CeilHeight,PrecipWater, &
AerosolOptDepth,SnowDepth,DaysSinceLastSnow,Albedo,LiquidPrecip
INTEGER PresWeathObs
INTEGER, DIMENSION(9) :: PresWeathConds
CHARACTER(len=500) WeatherDataLine
LOGICAL Ready
INTEGER CurTimeStep
INTEGER Item
TYPE (HourlyWeatherData) Wthr
REAL(r64) A,B,C,AVSC
REAL(r64) SkyTemp
INTEGER, SAVE :: CurDayOfWeek
LOGICAL, SAVE :: UseDayOfWeek
LOGICAL SkipThisDay ! Used when LeapYear is/is not in effect
LOGICAL TryAgain
INTEGER ReadStatus
INTEGER NumRewinds
CHARACTER(len=40) BadRecord
LOGICAL ErrorsFound
REAL(r64),SAVE :: CurTime
REAL(r64) HourRep
INTEGER OSky
REAL(r64) TDewK
REAL(r64) ESky
LOGICAL ErrorFound
CHARACTER(len=20) ErrOut
LOGICAL,SAVE :: LastHourSet ! for Interpolation
INTEGER NxtHour
REAL(r64) WtNow
REAL(r64) WtPrevHour
REAL(r64) WgtHourNow
REAL(r64) WgtPrevHour
REAL(r64) WgtNextHour
REAL(r64), SAVE :: LastHrOutDryBulbTemp
REAL(r64), SAVE :: LastHrOutDewPointTemp
REAL(r64), SAVE :: LastHrOutBaroPress
REAL(r64), SAVE :: LastHrOutRelHum
REAL(r64), SAVE :: LastHrWindSpeed
REAL(r64), SAVE :: LastHrWindDir
REAL(r64), SAVE :: LastHrSkyTemp
REAL(r64), SAVE :: LastHrHorizIRSky
REAL(r64), SAVE :: LastHrBeamSolarRad
REAL(r64), SAVE :: LastHrDifSolarRad
REAL(r64), SAVE :: LastHrAlbedo
REAL(r64), SAVE :: LastHrLiquidPrecip
REAL(r64), SAVE :: NextHrBeamSolarRad
REAL(r64), SAVE :: NextHrDifSolarRad
REAL(r64), SAVE :: NextHrLiquidPrecip
LOGICAL :: RecordDateMatch
INTEGER :: JDay5Start,JDay5End,Loop,TWeekDay
IF (DayToRead == 1) THEN
! Checks whether Weather file contains just one year of data. If yes then rewind and position to first
! day of weather file. The rest of code appropriately positions to the start day.
Ready=.false.
NumRewinds=0
! Must position file to proper day
! File already position to first data record
! Set Current Day of Week to "start of Data Period"
CurTime=1.d0/REAL(NumIntervalsPerHour,r64)
CurDayOfWeek=DataPeriods(1)%WeekDay-1
WYear=0
WMonth=0
WDay=0
Whour=0
WMinute=0
LastHourSet=.false.
DO WHILE (.not. Ready)
READ(WeatherFileUnitNumber,DataFmt,IOSTAT=ReadStatus) WeatherDataLine
IF(ReadStatus== 0) THEN
! Reduce ugly code
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,LiquidPrecip)
ELSEIF(ReadStatus < 0) THEN
IF (NumRewinds >0) THEN
CALL ShowSevereError('Multiple rewinds on EPW while searching for first day')
ELSE
REWIND(WeatherFileUnitNumber)
NumRewinds=NumRewinds+1
CALL SkipEPlusWFHeader
READ(WeatherFileUnitNumber,DataFmt,IOSTAT=ReadStatus) WeatherDataLine
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,LiquidPrecip)
ENDIF
ENDIF
IF (ReadStatus /= 0) THEN
BadRecord=TRIM(RoundSigDigits(WYear))//'/'//TRIM(RoundSigDigits(WMonth))//'/'//TRIM(RoundSigDigits(WDay))// &
Blank//TRIM(RoundSigDigits(WHour))//':'//TRIM(RoundSigDigits(WMinute))
WRITE(ErrOut,*) ReadStatus
ErrOut=ADJUSTL(ErrOut)
CALL ShowFatalError('Error occured on EPW while searching for first day, stopped at '//TRIM(BadRecord)// &
' IO Error='//TRIM(RoundSigDigits(ReadStatus)),OutputFileStandard)
ENDIF
IF (CurDayOfWeek <= 7) THEN
CurDayOfWeek=MOD(CurDayOfWeek,7)+1
ENDIF
IF (WMonth == Environment(Environ)%StartMonth .and. WDay == Environment(Environ)%StartDay .and. &
.not. Environment(Environ)%MatchYear) THEN
RecordDateMatch=.true.
ELSEIF (WMonth == Environment(Environ)%StartMonth .and. WDay == Environment(Environ)%StartDay .and. &
Environment(Environ)%MatchYear .and. WYear == Environment(Environ)%StartYear) THEN
RecordDateMatch=.true.
ELSE
RecordDateMatch=.false.
ENDIF
IF (RecordDateMatch) THEN
BACKSPACE(WeatherFileUnitNumber)
Ready=.true.
IF (CurDayOfWeek <= 7) THEN
CurDayOfWeek=CurDayOfWeek-1
ENDIF
! Do the range checks on the first set of fields -- no others.
ErrorsFound=.false.
IF (DryBulb >= 99.9d0) &
CALL RangeCheck(ErrorsFound,'DryBulb Temperature','WeatherFile','Severe','>= -90',(Drybulb>=-90.0d0), &
'<= 70',(DryBulb <=70.0d0),RoundSigDigits(DryBulb,2),WhatObjectName=WeatherFileLocationTitle)
IF (Dewpoint < 99.9d0) &
CALL RangeCheck(ErrorsFound,'DewPoint Temperature','WeatherFile','Severe','>= -90',(Dewpoint>=-90.0d0), &
'<= 70',(Dewpoint <=70.0d0),RoundSigDigits(Dewpoint,2),WhatObjectName=WeatherFileLocationTitle)
IF (RelHum < 999.d0) &
CALL RangeCheck(ErrorsFound,'Relative Humidity','WeatherFile','Severe','> 0',(RelHum>=0.0d0), &
'<= 110',(RelHum<=110.0d0),RoundSigDigits(RelHum,0),WhatObjectName=WeatherFileLocationTitle)
IF (AtmPress < 999999.d0) &
CALL RangeCheck(ErrorsFound,'Atmospheric Pressure','WeatherFile','Severe','> 31000',(AtmPress>31000.0d0), &
'<=120000',(AtmPress<=120000.0d0),RoundSigDigits(AtmPress,0),WhatObjectName=WeatherFileLocationTitle)
IF (DirectRad < 9999.d0) &
CALL RangeCheck(ErrorsFound,'Direct Radiation','WeatherFile','Severe','>= 0',(DirectRad>=0.0d0), &
WhatObjectName=WeatherFileLocationTitle)
IF (DiffuseRad < 9999.d0) &
CALL RangeCheck(ErrorsFound,'Diffuse Radiation','WeatherFile','Severe','>= 0',(DiffuseRad>=0.0d0), &
WhatObjectName=WeatherFileLocationTitle)
IF (WindDir < 999.d0) &
CALL RangeCheck(ErrorsFound,'Wind Direction','WeatherFile','Severe','>=0',(WindDir>=0.0d0), &
'<=360',(WindDir<=360.0d0),RoundSigDigits(WindDir,0),WhatObjectName=WeatherFileLocationTitle)
IF (WindSpeed < 999.d0) &
CALL RangeCheck(ErrorsFound,'Wind Speed','WeatherFile','Severe','>=0',(WindSpeed>=0.0d0), &
'<=40',(WindSpeed<=40.0d0),RoundSigDigits(WindSpeed,2),WhatObjectName=WeatherFileLocationTitle)
IF (ErrorsFound) THEN
CALL ShowSevereError('Out of Range errors found with initial day of WeatherFile')
ENDIF
ELSE
! Must skip this day
DO Item=2,NumIntervalsPerHour
READ(WeatherFileUnitNumber,DataFmt,IOSTAT=ReadStatus) WeatherDataLine
IF (ReadStatus /= 0) THEN
READ(WeatherDataLine,*) WYear,WMonth,WDay,WHour,WMinute
BadRecord=TRIM(RoundSigDigits(WYear))//'/'//TRIM(RoundSigDigits(WMonth))//'/'//TRIM(RoundSigDigits(WDay))// &
Blank//TRIM(RoundSigDigits(WHour))//':'//TRIM(RoundSigDigits(WMinute))
CALL ShowFatalError('Error occured on EPW while searching for first day, stopped at '//TRIM(BadRecord)// &
' IO Error='//TRIM(RoundSigDigits(ReadStatus)),OutputFileStandard)
ENDIF
ENDDO
DO Item=1,23*NumIntervalsPerHour
READ(WeatherFileUnitNumber,DataFmt,IOSTAT=ReadStatus) WeatherDataLine
IF (ReadStatus /= 0) THEN
READ(WeatherDataLine,*) WYear,WMonth,WDay,WHour,WMinute
BadRecord=TRIM(RoundSigDigits(WYear))//'/'//TRIM(RoundSigDigits(WMonth))//'/'//TRIM(RoundSigDigits(WDay))// &
Blank//TRIM(RoundSigDigits(WHour))//':'//TRIM(RoundSigDigits(WMinute))
CALL ShowFatalError('Error occured on EPW while searching for first day, stopped at '//TRIM(BadRecord)// &
' IO Error='//TRIM(RoundSigDigits(ReadStatus)),OutputFileStandard)
ENDIF
ENDDO
ENDIF
ENDDO
! Positioned to proper day
IF (.not. KickOffSimulation .and. .not. DoingSizing .and. Environment(Environ)%KindOfEnvrn == ksRunPeriodWeather) THEN
Environment(Environ)%CurrentCycle=Environment(Environ)%CurrentCycle+1
IF (.not. Environment(Environ)%RollDayTypeOnRepeat) THEN
CALL SetDayOfWeekInitialValues(Environment(Environ)%DayOfWeek,CurDayOfWeek,UseDayOfWeek)
IF (DaylightSavingIsActive) THEN
CALL SetDSTDateRanges(Environment(Envrn)%MonWeekDay,DSTIndex)
ENDIF
CALL SetSpecialDayDates(Environment(Envrn)%MonWeekDay)
ELSEIF (Environment(Environ)%CurrentCycle == 1) THEN
CALL SetDayOfWeekInitialValues(Environment(Environ)%DayOfWeek,CurDayOfWeek,UseDayOfWeek)
Environment(Environ)%SetWeekDays=.true.
IF (DaylightSavingIsActive) THEN
CALL SetDSTDateRanges(Environment(Envrn)%MonWeekDay,DSTIndex)
ENDIF
CALL SetSpecialDayDates(Environment(Envrn)%MonWeekDay)
ELSE
CurDayOfWeek=DayOfWeekTomorrow
ENDIF
ELSE
CALL SetDayOfWeekInitialValues(Environment(Environ)%DayOfWeek,CurDayOfWeek,UseDayOfWeek)
ENDIF
ENDIF
TryAgain=.true.
SkipThisDay=.false.
DO WHILE (TryAgain)
TryAgain=.false.
TomorrowOutDryBulbTemp=0.0d0
TomorrowOutDewPointTemp=0.0d0
TomorrowOutBaroPress=0.0d0
TomorrowOutRelHum=0.0d0
TomorrowWindSpeed=0.0d0
TomorrowWindDir=0.0d0
TomorrowSkyTemp=0.0d0
TomorrowHorizIRSky=0.0d0
TomorrowBeamSolarRad=0.0d0
TomorrowDifSolarRad=0.0d0
TomorrowAlbedo=0.0d0
TomorrowLiquidPrecip=0.0d0
TomorrowIsRain=.false.
TomorrowIsSnow=.false.
DO Hour=1,24
Do CurTimeStep=1,NumIntervalsPerHour
HourRep=REAL(Hour-1,r64)+(CurTime*REAL(CurTimeStep,r64))
READ(WeatherFileUnitNumber,DataFmt,IOSTAT=ReadStatus) WeatherDataLine
IF (ReadStatus /= 0) WeatherDataLine=Blank
IF (WeatherDataLine == Blank) THEN
IF (Hour == 1) THEN
ReadStatus=-1
ELSE
ReadStatus=99
ENDIF
ENDIF
IF (ReadStatus == 0) THEN
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,LiquidPrecip)
ELSE ! ReadStatus /=0
IF (ReadStatus < 0 .and. NumDataPeriods == 1) THEN ! Standard End-of-file, rewind and position to first day...
IF (DataPeriods(1)%NumDays >= NumDaysInYear) THEN
REWIND(WeatherFileUnitNumber)
CALL SkipEPlusWFHeader
READ(WeatherFileUnitNumber,DataFmt,IOSTAT=ReadStatus) WeatherDataLine
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,LiquidPrecip)
ELSE
BadRecord=TRIM(RoundSigDigits(WYear))//'/'//TRIM(RoundSigDigits(WMonth))//'/'//TRIM(RoundSigDigits(WDay))// &
Blank//TRIM(RoundSigDigits(WHour))//':'//TRIM(RoundSigDigits(WMinute))
CALL ShowFatalError('End-of-File encountered after '//TRIM(BadRecord)//', starting from first day of '// &
'Weather File would not be "next day"')
ENDIF
ELSE
BadRecord=TRIM(RoundSigDigits(WYear))//'/'//TRIM(RoundSigDigits(WMonth))//'/'//TRIM(RoundSigDigits(WDay))// &
Blank//TRIM(RoundSigDigits(WHour))//':'//TRIM(RoundSigDigits(WMinute))
CALL ShowFatalError('Unexpected error condition in middle of reading EPW file, stopped at '//TRIM(BadRecord), &
OutputFileStandard)
ENDIF
ENDIF
IF (Hour /= Whour) THEN
BadRecord=TRIM(RoundSigDigits(WYear))//'/'//TRIM(RoundSigDigits(WMonth))//'/'//TRIM(RoundSigDigits(WDay))// &
Blank//TRIM(RoundSigDigits(WHour))//':'//TRIM(RoundSigDigits(WMinute))
CALL ShowFatalError('Unexpected error condition in middle of reading EPW file, '//TRIM(BadRecord), &
OutputFileStandard)
ENDIF
! Set possible missing values
IF (ETHoriz < 0.0d0) ETHoriz=9999.d0
IF (ETDirect < 0.0d0) ETDirect=9999.d0
IF (IRHoriz <= 0.0d0) IRHoriz=9999.d0
IF (GLBHoriz < 0.0d0) GLBHoriz=9999.d0
IF (DisplayWeatherMissingDataWarnings) THEN
IF (DirectRad >= 9999.d0) THEN
Missed%DirectRad=Missed%DirectRad+1
ENDIF
IF (DiffuseRad >= 9999.d0) THEN
Missed%DiffuseRad=Missed%DirectRad+1
ENDIF
IF (DirectRad < 0.0d0) THEN
DirectRad=9999.d0
OutOfRange%DirectRad=OutOfRange%DirectRad+1
ENDIF
IF (DiffuseRad < 0.0d0) THEN
DiffuseRad=9999.d0
OutOfRange%DiffuseRad=OutOfRange%DiffuseRad+1
ENDIF
ENDIF
IF (GLBHorizIllum < 0.0d0) GLBHorizIllum=999999.d0
IF (DirectNrmIllum < 0.0d0) DirectNrmIllum=999999.d0
IF (DiffuseHorizIllum < 0.0d0) DiffuseHorizIllum=999999.d0
IF (ZenLum < 0.0d0) ZenLum=99999.d0
IF (AtmPress < 0.0d0) AtmPress=999999.d0
IF (WindSpeed < 0.0d0) WindSpeed=999.d0
IF (WindDir < -360.d0 .or. WindDir > 360.d0) WindDir=999.d0
IF (TotalSkyCover < 0.0d0) TotalSkyCover=99.d0
IF (RelHum < 0.0d0) RelHum=999.d0
IF (OpaqueSkyCover < 0.0d0) OpaqueSkyCover=99.d0
IF (Visibility < 0.0d0) Visibility=9999.d0
IF (CeilHeight < 0.0d0) CeilHeight=9999.d0
IF (PresWeathObs < 0) PresWeathObs=9.0d0
IF (PrecipWater < 0.0d0) PrecipWater=999.d0
IF (AerosolOptDepth < 0.0d0) AerosolOptDepth=999.d0
IF (SnowDepth < 0.0d0) SnowDepth=999.d0
IF (DaysSinceLastSnow < 0.0d0) DaysSinceLastSnow=99.d0
IF (Albedo < 0.0d0) Albedo=999.d0
IF (LiquidPrecip < 0.0d0) LiquidPrecip=999.d0
IF (Hour == 1 .and. CurTimeStep == 1) THEN
IF (WMonth == 2 .and. WDay == 29 .and. (.not. CurrentYearIsLeapYear .or. .not. WFAllowsLeapYears)) THEN
EndDayOfMonth(2)=28
SkipThisDay=.true.
TryAgain=.true.
CALL ShowWarningError('ReadEPlusWeatherForDay: Feb29 data encountered but will not be processed.')
IF (.not. WFAllowsLeapYears) THEN
CALL ShowContinueError('...WeatherFile does not allow Leap Years. '// &
'HOLIDAYS/DAYLIGHT SAVINGS header must indicate "Yes".')
ENDIF
CYCLE
ELSEIF (WMonth == 2 .and. WDay == 29 .and. CurrentYearIsLeapYear .and. WFAllowsLeapYears) THEN
TryAgain=.false.
SkipThisDay=.false.
ELSE
TryAgain=.false.
SkipThisDay=.false.
ENDIF
TomorrowVariables%Year=WYear
TomorrowVariables%Month=WMonth
TomorrowVariables%DayOfMonth=WDay
TomorrowVariables%DayOfYear=JulianDay(WMonth,Wday,LeapYearAdd)
CALL CalculateDailySolarCoeffs(TomorrowVariables%DayOfYear,A,B,C,AVSC,TomorrowVariables%EquationOfTime, &
TomorrowVariables%SinSolarDeclinAngle,TomorrowVariables%CosSolarDeclinAngle)
IF (CurDayOfWeek <= 7) THEN
CurDayOfWeek=MOD(CurDayOfWeek,7)+1
ENDIF
TomorrowVariables%DayOfWeek=CurDayOfWeek
TomorrowVariables%DaylightSavingIndex=DSTIndex(TomorrowVariables%DayOfYear)
TomorrowVariables%HolidayIndex=SpecialDayTypes(TomorrowVariables%DayOfYear)
ENDIF
IF (SkipThisDay) CYCLE
! Check out missing values
IF (DryBulb >= 99.9d0) THEN
DryBulb=Missing%DryBulb
Missed%DryBulb=Missed%DryBulb+1
ENDIF
IF (DryBulb < -90.d0 .or. DryBulb > 70.d0) THEN
OutOfRange%DryBulb=OutOfRange%DryBulb+1
ENDIF
IF (DewPoint >= 99.9d0) THEN
DewPoint=Missing%DewPoint
Missed%DewPoint=Missed%DewPoint+1
ENDIF
IF (DewPoint < -90.d0 .or. DewPoint > 70.d0) THEN
OutOfRange%DewPoint=OutOfRange%DewPoint+1
ENDIF
IF (RelHum >= 999.d0) THEN
RelHum=Missing%RelHumid
Missed%RelHumid=Missed%RelHumid+1
ENDIF
IF (RelHum < 0.d0 .or. RelHum > 110.d0) THEN
OutOfRange%RelHumid=OutOfRange%RelHumid+1
ENDIF
IF (AtmPress >= 999999.d0) THEN
AtmPress=Missing%StnPres
Missed%StnPres=Missed%StnPres+1
ENDIF
IF (AtmPress <= 31000.d0 .or. AtmPress > 120000.d0) THEN
OutOfRange%StnPres=OutOfRange%StnPres+1
AtmPress=Missing%StnPres
ENDIF
IF (WindDir >= 999.d0) THEN
WindDir=Missing%WindDir
Missed%WindDir=Missed%WindDir+1
ENDIF
IF (WindDir < 0.d0 .or. WindDir > 360.d0) THEN
OutOfRange%WindDir=OutOfRange%WindDir+1
ENDIF
IF (WindSpeed >= 999.d0) THEN
WindSpeed=Missing%WindSpd
Missed%WindSpd=Missed%WindSpd+1
ENDIF
IF (WindSpeed < 0.d0 .or. WindSpeed > 40.d0) THEN
OutOfRange%WindSpd=OutOfRange%WindSpd+1
ENDIF
IF (TotalSkyCover >= 99.d0) THEN
TotalSkyCover=Missing%TotSkyCvr
Missed%TotSkyCvr=Missed%TotSkyCvr+1
ENDIF
IF (OpaqueSkyCover >= 99.d0) THEN
OpaqueSkyCover=Missing%OpaqSkyCvr
Missed%OpaqSkyCvr=Missed%OpaqSkyCvr+1
ENDIF
! Some values are not used within EnergyPlus, don't keep stats on their missing data points.
! IF (Visibility >= 9999.) THEN
! Visibility=Missing%Visibility
! Missed%Visibility=Missed%Visibility+1
! ENDIF
! IF (CeilHeight >= 99999.) THEN
! CeilHeight=Missing%Ceiling
! Missed%Ceiling=Missed%Ceiling+1
! ENDIF
! IF (PrecipWater >= 999.) THEN
! PrecipWater=Missing%PrecipWater
! Missed%PrecipWater=Missed%PrecipWater+1
! ENDIF
! IF (AerosolOptDepth >= .999) THEN
! AerosolOptDepth=Missing%AerOptDepth
! Missed%AerOptDepth=Missed%AerOptDepth+1
! ENDIF
IF (SnowDepth >= 999.d0) THEN
SnowDepth=Missing%SnowDepth
Missed%SnowDepth=Missed%SnowDepth+1
ENDIF
IF (Albedo >= 999.d0) THEN
Albedo=Missing%Albedo
Missed%Albedo=Missed%Albedo+1
ENDIF
IF (LiquidPrecip >= 999.d0) THEN
LiquidPrecip=Missing%LiquidPrecip
Missed%LiquidPrecip=Missed%LiquidPrecip+1
LiquidPrecip=0.0d0
ENDIF
! IF (DaysSinceLastSnow >= 99) THEN
! DaysSinceLastSnow=Missing%DaysLastSnow
! Missed%DaysLastSnow=Missed%DaysLastSnow+1
! ENDIF
TomorrowOutDryBulbTemp(Hour,CurTimeStep)=DryBulb
TomorrowOutDewPointTemp(Hour,CurTimeStep)=DewPoint
TomorrowOutBaroPress(Hour,CurTimeStep)=AtmPress
TomorrowOutRelHum(Hour,CurTimeStep)=RelHum
RelHum=RelHum*.01d0
TomorrowWindSpeed(Hour,CurTimeStep)=WindSpeed
TomorrowWindDir(Hour,CurTimeStep)=WindDir
TomorrowLiquidPrecip(Hour,CurTimeStep)=LiquidPrecip
TomorrowHorizIRSky(Hour,CurTimeStep)=IRHoriz
IF (Environment(Envrn)%WP_Type1 == 0) THEN
! Calculate sky temperature, use IRHoriz if not missing
IF (IRHoriz >= 9999.d0) THEN
! Missing, use sky cover
OSky=OpaqueSkyCover
TDewK=MIN(DryBulb,DewPoint)+TKelvin
ESky= (.787d0 +.764d0*LOG((TDewK)/TKelvin))*(1.d0 + .0224d0*OSky - 0.0035d0*(OSky**2) + .00028d0*(OSky**3))
SkyTemp=(DryBulb+TKelvin)*(ESky**.25d0)-TKelvin
ELSE ! Valid IR from Sky
SkyTemp=(IRHoriz/Sigma)**.25d0 -TKelvin
ENDIF
ELSE
SkyTemp=0.0d0 ! dealt with later
ENDIF
TomorrowSkyTemp(Hour,CurTimeStep)=SkyTemp
IF (ETHoriz >= 9999.d0) ETHoriz=0.0d0
IF (ETDirect >= 9999.d0) ETDirect=0.0d0
IF (GLBHoriz >= 9999.d0) GLBHoriz=0.0d0
IF (DirectRad >= 9999.d0) DirectRad=0.0d0
IF (DiffuseRad >= 9999.d0) DiffuseRad=0.0d0
IF (GLBHorizIllum >= 999900.d0) GLBHorizIllum=0.0d0
IF (DirectNrmIllum >= 999900.d0) DirectNrmIllum=0.0d0
IF (DiffuseHorizIllum >= 999900.d0) DiffuseHorizIllum=0.0d0
IF (ZenLum >= 99990.d0) ZenLum=0.0d0
IF (IgnoreSolarRadiation) THEN
GLBHoriz=0.0d0
DirectRad=0.0d0
DiffuseRad=0.0d0
ENDIF
IF (IgnoreBeamRadiation) THEN
DirectRad=0.0d0
ENDIF
IF (IgnoreDiffuseRadiation) THEN
DiffuseRad=0.0d0
ENDIF
TomorrowBeamSolarRad(Hour,CurTimeStep)=DirectRad
TomorrowDifSolarRad(Hour,CurTimeStep)=DiffuseRad
TomorrowIsRain(Hour,CurTimeStep) = .false.
IF (PresWeathObs == 0) THEN
IF (PresWeathConds(1) .lt. 9 .or. &
PresWeathConds(2) .lt. 9 .or. &
PresWeathConds(3) .lt. 9) &
TomorrowIsRain(Hour,CurTimeStep)=.true.
ELSE
TomorrowIsRain(Hour,CurTimeStep) = .false.
ENDIF
TomorrowIsSnow(Hour,CurTimeStep) = (SnowDepth > 0.0d0)
! default if rain but none on weather file
IF (TomorrowIsRain(Hour,CurTimeStep) .and. &
TomorrowLiquidPrecip(Hour,CurTimeStep) == 0.0d0) &
TomorrowLiquidPrecip(Hour,CurTimeStep)=2.0d0 ! 2mm in an hour ~ .08 inch
Missing%DryBulb=DryBulb
Missing%DewPoint=DewPoint
Missing%RelHumid=RelHum*100.d0
Missing%StnPres=AtmPress
Missing%WindDir=WindDir
Missing%WindSpd=WindSpeed
Missing%TotSkyCvr=TotalSkyCover
Missing%OpaqSkyCvr=OpaqueSkyCover
Missing%Visibility=Visibility
Missing%Ceiling=CeilHeight
Missing%PrecipWater=PrecipWater
Missing%AerOptDepth=AerosolOptDepth
Missing%SnowDepth=SnowDepth
Missing%DaysLastSnow=DaysSinceLastSnow
Missing%Albedo=Albedo
! Missing%LiquidPrecip=LiquidPrecip
ENDDO ! CurTimeStep Loop
ENDDO ! Hour Loop
ENDDO ! Try Again While Loop
IF (BackSpaceAfterRead) THEN
BACKSPACE(WeatherFileUnitNumber)
ENDIF
IF (NumIntervalsPerHour == 1 .and. NumOfTimeStepInHour > 1) THEN
! Create interpolated weather for timestep orientation
! First copy ts=1 (hourly) from data arrays to Wthr structure
DO Hour=1,24
Wthr%OutDryBulbTemp(Hour)=TomorrowOutDryBulbTemp(Hour,1)
Wthr%OutDewPointTemp(Hour)=TomorrowOutDewPointTemp(Hour,1)
Wthr%OutBaroPress(Hour)=TomorrowOutBaroPress(Hour,1)
Wthr%OutRelHum(Hour)=TomorrowOutRelHum(Hour,1)
Wthr%WindSpeed(Hour)=TomorrowWindSpeed(Hour,1)
Wthr%WindDir(Hour)=TomorrowWindDir(Hour,1)
Wthr%SkyTemp(Hour)=TomorrowSkyTemp(Hour,1)
Wthr%HorizIRSky(Hour)=TomorrowHorizIRSky(Hour,1)
Wthr%BeamSolarRad(Hour)=TomorrowBeamSolarRad(Hour,1)
Wthr%DifSolarRad(Hour)=TomorrowDifSolarRad(Hour,1)
Wthr%IsRain(Hour)=TomorrowIsRain(Hour,1)
Wthr%IsSnow(Hour)=TomorrowIsSnow(Hour,1)
Wthr%Albedo(Hour)=TomorrowAlbedo(Hour,1)
Wthr%LiquidPrecip(Hour)=TomorrowLiquidPrecip(Hour,1)
ENDDO
IF (.not. LastHourSet) THEN
! For first day of weather, all time steps of the first hour will be
! equal to the first hour's value.
LastHrOutDryBulbTemp=Wthr%OutDryBulbTemp(24)
LastHrOutDewPointTemp=Wthr%OutDewPointTemp(24)
LastHrOutBaroPress=Wthr%OutBaroPress(24)
LastHrOutRelHum=Wthr%OutRelHum(24)
LastHrWindSpeed=Wthr%WindSpeed(24)
LastHrWindDir=Wthr%WindDir(24)
LastHrSkyTemp=Wthr%SkyTemp(24)
LastHrHorizIRSky=Wthr%HorizIRSky(24)
LastHrBeamSolarRad=Wthr%BeamSolarRad(24)
LastHrDifSolarRad=Wthr%DifSolarRad(24)
LastHrAlbedo=Wthr%Albedo(24)
LastHrLiquidPrecip=Wthr%LiquidPrecip(24)
LastHourSet=.true.
ENDIF
DO Hour=1,24
NxtHour = Hour+1
IF (Hour == 24) THEN
NxtHour = 1
END IF
NextHrBeamSolarRad=Wthr%BeamSolarRad(NxtHour)
NextHrDifSolarRad=Wthr%DifSolarRad(NxtHour)
NextHrLiquidPrecip=Wthr%LiquidPrecip(NxtHour)
DO TS=1,NumOfTimeStepInHour
WtNow=Interpolation(TS)
WtPrevHour = 1.0d0-WtNow
! Do Solar "weighting"
WgtHourNow=SolarInterpolation(TS)
IF (NumOfTimeStepInHour == 1) THEN
WgtNextHour=1.0d0-WgtHourNow
WgtPrevHour=0.0d0
ELSE
IF (WgtHourNow == 1.0d0) THEN
! It's at the half hour
WgtNextHour=0.0d0
WgtPrevHour=0.0d0
ELSEIF (TS*TimeStepFraction < .5d0) THEN
WgtNextHour=0.0d0
WgtPrevHour=1.0d0-WgtHourNow
ELSE ! After the half hour
WgtPrevHour=0.0d0
WgtNextHour=1.0d0-WgtHourNow
ENDIF
ENDIF
TomorrowOutDryBulbTemp(Hour,TS) = LastHrOutDryBulbTemp*WtPrevHour &
+ Wthr%OutDryBulbTemp(Hour)*WtNow
TomorrowOutBaroPress(Hour,TS) = LastHrOutBaroPress*WtPrevHour &
+ Wthr%OutBaroPress(Hour)*WtNow
TomorrowOutDewPointTemp(Hour,TS)= LastHrOutDewPointTemp*WtPrevHour &
+ Wthr%OutDewPointTemp(Hour)*WtNow
TomorrowOutRelHum(Hour,TS) = LastHrOutRelHum*WtPrevHour &
+ Wthr%OutRelHum(Hour)*WtNow
TomorrowWindSpeed(Hour,TS) = LastHrWindSpeed*WtPrevHour &
+ Wthr%WindSpeed(Hour)*WtNow
TomorrowWindDir(Hour,TS) = LastHrWindDir*WtPrevHour &
+ Wthr%WindDir(Hour)*WtNow
TomorrowHorizIRSky(Hour,TS) = LastHrHorizIRSky*WtPrevHour &
+ Wthr%HorizIRSky(Hour)*WtNow
IF (Environment(Environ)%WP_Type1 == 0) THEN
TomorrowSkyTemp(Hour,TS) = LastHrSkyTemp*WtPrevHour &
+ Wthr%SkyTemp(Hour)*WtNow
ENDIF
TomorrowDifSolarRad(Hour,TS) = LastHrDifSolarRad*WgtPrevHour &
+ Wthr%DifSolarRad(Hour)*WgtHourNow &
+ NextHrDifSolarRad*WgtNextHour
TomorrowBeamSolarRad(Hour,TS) = LastHrBeamSolarRad*WgtPrevHour &
+ Wthr%BeamSolarRad(Hour)*WgtHourNow &
+ NextHrBeamSolarRad*WgtNextHour
TomorrowLiquidPrecip(Hour,TS) = LastHrLiquidPrecip*WtPrevHour &
+ Wthr%LiquidPrecip(Hour)*WtNow
TomorrowLiquidPrecip(Hour,TS) = TomorrowLiquidPrecip(Hour,TS)/REAL(NumOfTimeStepInHour,r64)
TomorrowIsRain(Hour,TS) = (TomorrowLiquidPrecip(Hour,TS) >= .8d0/REAL(NumOfTimeStepInHour,r64)) !Wthr%IsRain(Hour)
TomorrowIsSnow(Hour,TS) = Wthr%IsSnow(Hour)
ENDDO ! End of TS Loop
LastHrOutDryBulbTemp=Wthr%OutDryBulbTemp(Hour)
LastHrOutDewPointTemp=Wthr%OutDewPointTemp(Hour)
LastHrOutBaroPress=Wthr%OutBaroPress(Hour)
LastHrOutRelHum=Wthr%OutRelHum(Hour)
LastHrWindSpeed=Wthr%WindSpeed(Hour)
LastHrWindDir=Wthr%WindDir(Hour)
LastHrSkyTemp=Wthr%SkyTemp(Hour)
LastHrBeamSolarRad=Wthr%BeamSolarRad(Hour)
LastHrDifSolarRad=Wthr%DifSolarRad(Hour)
LastHrAlbedo=Wthr%Albedo(Hour)
LastHrLiquidPrecip=Wthr%LiquidPrecip(Hour)
ENDDO ! End of Hour Loop
IF (Environment(Environ)%WP_Type1 /= 0) THEN
SELECT CASE(WPSkyTemperature(Environment(Environ)%WP_Type1)%CalculationType)
CASE (WP_ScheduleValue)
CALL GetScheduleValuesForDay(WPSkyTemperature(Environment(Environ)%WP_Type1)%SchedulePtr, &
TomorrowSkyTemp,TomorrowVariables%DayOfYear,CurDayOfWeek)
CASE (WP_DryBulbDelta)
CALL GetScheduleValuesForDay(WPSkyTemperature(Environment(Environ)%WP_Type1)%SchedulePtr, &
TomorrowSkyTemp,TomorrowVariables%DayOfYear,CurDayOfWeek)
DO Hour=1,24
DO TS=1,NumOfTimeStepInHour
TomorrowSkyTemp(Hour,TS)=TomorrowOutDryBulbTemp(Hour,TS)-TomorrowSkyTemp(Hour,TS)
ENDDO
ENDDO
CASE (WP_DewPointDelta)
CALL GetScheduleValuesForDay(WPSkyTemperature(Environment(Environ)%WP_Type1)%SchedulePtr, &
TomorrowSkyTemp,TomorrowVariables%DayOfYear,CurDayOfWeek)
DO Hour=1,24
DO TS=1,NumOfTimeStepInHour
TomorrowSkyTemp(Hour,TS)=TomorrowOutDewPointTemp(Hour,TS)-TomorrowSkyTemp(Hour,TS)
ENDDO
ENDDO
CASE DEFAULT
END SELECT
ENDIF
ENDIF
RETURN
CONTAINS
SUBROUTINE SetDayOfWeekInitialValues(EnvironDayOfWeek,CurDayOfWeek,UseDayOfWeek)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN March 2012
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Set of begin day of week for an environment. Similar sets but slightly different
! conditions. Improve code readability by having three routine calls instead of three
! IF blocks.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: EnvironDayOfWeek ! Starting Day of Week for the (Weather) RunPeriod (User Input)
INTEGER, INTENT(INOUT) :: CurDayOfWeek ! Current Day of Week
LOGICAL, INTENT(INOUT) :: UseDayOfWeek ! hmmm does not appear to be used anywhere.
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
! na
IF (EnvironDayOfWeek /= 0) THEN
IF (EnvironDayOfWeek <= 7) THEN
CurDayOfWeek=EnvironDayOfWeek-1
ELSE
CurDayOfWeek=EnvironDayOfWeek
ENDIF
UseDayOfWeek=.false.
ELSE
UseDayOfWeek=.true.
ENDIF
RETURN
END SUBROUTINE SetDayOfWeekInitialValues
END SUBROUTINE ReadEPlusWeatherForDay