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(inout) | :: | PrintEnvrnStamp |
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 InitializeWeather(PrintEnvrnStamp)
! SUBROUTINE INFORMATION:
! AUTHOR Rick Strand
! DATE WRITTEN June 1997
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is the main driver of the weather initializations.
! Most of the weather handling can be described as "initializations"
! so most of the work is done via this subroutine.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
! na
USE General, ONLY: InvJulianDay, JulianDay
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(INOUT) :: PrintEnvrnStamp ! Set to true when the environment header should be printed
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER Loop
INTEGER FirstSimDayofYear ! Variable which tells when to skip the day in a multi year simulation.
LOGICAL,SAVE :: FirstCall=.true. ! Some things should only be done once
! LOGICAL, SAVE :: SetYear=.true.
INTEGER :: JDay5Start
INTEGER :: JDay5End
INTEGER :: TWeekDay
! FLOW:
IF (BeginSimFlag .and. FirstCall) THEN
FirstCall=.false.
EndMonthFlag=.false.
END IF ! ... end of BeginSimFlag IF-THEN block.
IF (BeginEnvrnFlag) THEN
!Call and setup the Design Day environment
IF (Environment(Envrn)%KindOfEnvrn /= ksRunPeriodWeather) THEN
IF (Envrn <= TotDesDays) THEN
Call SetupDesignDay(Envrn)
ENDIF
ENDIF
NumMissing=0 ! Only used in Weather file environments
! Start over missing values with each environment
Missing%StnPres = StdBaroPress ! Initial "missing" value
Missing%DryBulb = 6.d0 ! Initial "missing" value
Missing%DewPoint = 3.d0 ! Initial "missing" value
Missing%RelHumid = 50.0d0 ! Initial "missing" value
Missing%WindSpd = 2.5d0 ! Initial "missing" value
Missing%WindDir = 180 ! Initial "missing" value
Missing%TotSkyCvr = 5 ! Initial "missing" value
Missing%OpaqSkyCvr = 5 ! Initial "missing" value
Missing%Visibility = 777.7d0 ! Initial "missing" value
Missing%Ceiling = 77777 ! Initial "missing" value
Missing%PrecipWater = 0 ! Initial "missing" value
Missing%AerOptDepth = 0.0d0 ! Initial "missing" value
Missing%SnowDepth = 0 ! Initial "missing" value
Missing%DaysLastSnow = 88 ! Initial "missing" value
Missing%Albedo = 0.0d0 ! Initial "missing" value
Missing%LiquidPrecip = 0.0d0 ! Initial "missing" value
! Counts set to 0 for each environment
Missed%StnPres = 0
Missed%DryBulb = 0
Missed%DewPoint = 0
Missed%RelHumid = 0
Missed%WindSpd = 0
Missed%WindDir = 0
Missed%TotSkyCvr = 0
Missed%OpaqSkyCvr = 0
Missed%Visibility = 0
Missed%Ceiling = 0
Missed%PrecipWater = 0
Missed%AerOptDepth = 0
Missed%SnowDepth = 0
Missed%DaysLastSnow = 0
Missed%Albedo = 0
Missed%LiquidPrecip = 0
Missed%WeathCodes = 0
Missed%DirectRad = 0
Missed%DiffuseRad = 0
! Counts set to 0 for each environment
OutOfRange%StnPres = 0
OutOfRange%DryBulb = 0
OutOfRange%DewPoint = 0
OutOfRange%RelHumid = 0
OutOfRange%WindSpd = 0
OutOfRange%WindDir = 0
OutOfRange%DirectRad = 0
OutOfRange%DiffuseRad = 0
PrintEnvrnStamp=.TRUE. ! Set this to true so that on first non-warmup day (only) the environment header will print out
! WeekDayCount=0 ! Reset weekday count (weather periods only)
DO Loop=1,NumSpecialDays
SpecialDays(Loop)%Used=.false.
ENDDO
IF (KindOfSim /= ksDesignDay) THEN
CALL ReadWeatherForDay(1,Envrn,.false.) ! Read first day's weather
ELSE
TomorrowVariables = DesignDay(Envrn)
END IF
END IF ! ... end of BeginEnvrnFlag IF-THEN block.
IF (BeginDayFlag) THEN
! Check Holidays, Daylight Saving Time, Ground Temperatures, etc.
CALL UpdateWeatherData ! Update daily weather info
! Read tomorrow's weather only if necessary. This means that the
! simulation is out of warmup, is using a weather tape for this
! environment, and is not on the last day (day after last day is
! assumed to be equal to last day).
! Following code checks whether the present day of simulation matches the start month and start day.
! In a multi year simulation with run period less than 365, we need to position the weather line
! appropriately.
IF ( (.NOT.WarmupFlag) .AND. (Environment(Envrn)%KindOfEnvrn /= ksDesignDay) ) THEN
IF (DayOfSim < NumOfDayInEnvrn) THEN
IF (DayOfSim == curSimDayforEndofRunPeriod) THEN
curSimDayforEndofRunPeriod=curSimDayforEndofRunPeriod+Environment(Envrn)%RawSimDays
IF (StartDatesCycleShouldBeReset) THEN
CALL ResetWeekDaysByMonth(Environment(Envrn)%MonWeekDay,LeapYearAdd, &
Environment(Envrn)%StartMonth,Environment(Envrn)%StartDay, &
Environment(Envrn)%EndMonth,Environment(Envrn)%EndDay,Environment(Envrn)%RollDayTypeOnRepeat)
IF (DaylightSavingIsActive) THEN
CALL SetDSTDateRanges(Environment(Envrn)%MonWeekDay,DSTIndex)
ENDIF
CALL SetSpecialDayDates(Environment(Envrn)%MonWeekDay)
ENDIF
YearofSim = YearofSim + 1
FirstSimDayofYear = 1
CALL ReadWeatherForDay(FirstSimDayofYear,Envrn,.false.) ! Read tomorrow's weather
ELSE
CALL ReadWeatherForDay(DayOfSim+1,Envrn,.false.) ! Read tomorrow's weather
ENDIF
END IF
END IF
IF (DayOfMonth == EndDayOfMonth(Month)) THEN
EndMonthFlag=.true.
ENDIF
! Set Tomorrow's date data
MonthTomorrow=TomorrowVariables%Month
DayOfMonthTomorrow=TomorrowVariables%DayOfMonth
DayOfWeekTomorrow=TomorrowVariables%DayOfWeek
HolidayIndexTomorrow=TomorrowVariables%HolidayIndex
YearTomorrow=TomorrowVariables%Year
IF (Environment(Envrn)%KindOfEnvrn == ksRunPeriodWeather) THEN
IF (Month == 1 .and. DayOfMonth == 1 .and. Environment(Envrn)%ActualWeather) THEN
IF (DatesShouldBeReset) THEN
IF (Environment(Envrn)%TreatYearsAsConsecutive) THEN
Environment(Envrn)%CurrentYear=Environment(Envrn)%CurrentYear + 1
Environment(Envrn)%IsLeapYear=IsLeapYear(Environment(Envrn)%CurrentYear)
CurrentYearIsLeapYear=Environment(Envrn)%IsLeapYear
IF (CurrentYearIsLeapYear) THEN
IF (WFAllowsLeapYears) THEN
LeapYearAdd=1
ELSE
LeapYearAdd=0
ENDIF
ELSE
LeapYearAdd=0
ENDIF
! need to reset MonWeekDay and WeekDayTypes
IF (.not. CurrentYearIsLeapYear) THEN
JDay5Start=JulianDay(Environment(Envrn)%StartMonth,Environment(Envrn)%StartDay,0)
JDay5End=JulianDay(Environment(Envrn)%EndMonth,Environment(Envrn)%EndDay,0)
ELSE
JDay5Start=JulianDay(Environment(Envrn)%StartMonth,Environment(Envrn)%StartDay,LeapYearAdd)
JDay5End=JulianDay(Environment(Envrn)%EndMonth,Environment(Envrn)%EndDay,LeapYearAdd)
ENDIF
IF (.not. Environment(Envrn)%ActualWeather) &
curSimDayforEndofRunPeriod=DayOfSim+Environment(Envrn)%RawSimDays+LeapYearAdd-1
Loop=JDay5Start
TWeekDay=DayOfWeek
DO
WeekDayTypes(Loop)=TWeekDay
TWeekDay=MOD(TWeekDay,7)+1
Loop=Loop+1
IF (Loop > 366) Loop=1
IF (Loop == JDay5End) EXIT
ENDDO
CALL ResetWeekDaysByMonth(Environment(Envrn)%MonWeekDay,LeapYearAdd, &
Environment(Envrn)%StartMonth,Environment(Envrn)%StartDay, &
Environment(Envrn)%EndMonth,Environment(Envrn)%EndDay,Environment(Envrn)%RollDayTypeOnRepeat)
IF (DaylightSavingIsActive) THEN
CALL SetDSTDateRanges(Environment(Envrn)%MonWeekDay,DSTIndex)
ENDIF
CALL SetSpecialDayDates(Environment(Envrn)%MonWeekDay)
ENDIF
ENDIF
ELSEIF ((Month == 1 .and. DayOfMonth == 1) .and. DatesShouldBeReset .and. &
(Jan1DatesShouldBeReset) ) THEN
IF (Environment(Envrn)%TreatYearsAsConsecutive) THEN
Environment(Envrn)%CurrentYear=Environment(Envrn)%CurrentYear + 1
Environment(Envrn)%IsLeapYear=IsLeapYear(Environment(Envrn)%CurrentYear)
CurrentYearIsLeapYear=Environment(Envrn)%IsLeapYear
IF (CurrentYearIsLeapYear .and. .not. WFAllowsLeapYears) CurrentYearIsLeapYear=.false.
IF (DayOfSim < curSimDayForEndOfRunPeriod .and. CurrentYearIsLeapYear) &
curSimDayforEndofRunPeriod=curSimDayforEndofRunPeriod+1
ENDIF
IF (CurrentYearIsLeapYear) THEN
IF (WFAllowsLeapYears) THEN
LeapYearAdd=1
ELSE
LeapYearAdd=0
ENDIF
ELSE
LeapYearAdd=0
ENDIF
IF (DayOfSim < curSimDayForEndOfRunPeriod) THEN
IF (Environment(Envrn)%RollDayTypeOnRepeat .or. CurrentYearIsLeapYear) THEN
CALL ResetWeekDaysByMonth(Environment(Envrn)%MonWeekDay,LeapYearAdd, &
Environment(Envrn)%StartMonth,Environment(Envrn)%StartDay, &
Environment(Envrn)%EndMonth,Environment(Envrn)%EndDay,Environment(Envrn)%RollDayTypeOnRepeat,.true.)
ELSE
CALL ResetWeekDaysByMonth(Environment(Envrn)%MonWeekDay,LeapYearAdd, &
Environment(Envrn)%StartMonth,Environment(Envrn)%StartDay, &
Environment(Envrn)%EndMonth,Environment(Envrn)%EndDay,Environment(Envrn)%RollDayTypeOnRepeat,.false.)
ENDIF
IF (DaylightSavingIsActive) THEN
CALL SetDSTDateRanges(Environment(Envrn)%MonWeekDay,DSTIndex)
ENDIF
CALL SetSpecialDayDates(Environment(Envrn)%MonWeekDay)
ENDIF
ENDIF
! SetYear=.false.
ENDIF
END IF ! ... end of BeginDayFlag IF-THEN block.
IF (.not. BeginDayFlag .and. .not. WarmupFlag .and. &
(Month /= Environment(Envrn)%StartMonth .or. DayOfMonth /= Environment(Envrn)%StartDay) &
.and. .not. DatesShouldBeReset .and. &
Environment(Envrn)%KindOfEnvrn == ksRunPeriodWeather) THEN
! SetYear=.true.
DatesShouldBeReset=.true.
ENDIF
IF (EndEnvrnFlag .and. (Environment(Envrn)%KindOfEnvrn /= ksDesignDay) ) THEN
REWIND(WeatherFileUnitNumber)
CALL SkipEPlusWFHeader
CALL ReportMissing_RangeData
ENDIF
! set the EndDesignDayEnvrnsFlag (dataGlobals)
! True at the end of the last design day environment (last time step of last hour of last day of environ which is a design day)
! added to address CR7562
EndDesignDayEnvrnsFlag = .FALSE.
IF (EndEnvrnFlag) THEN
IF (Envrn .LT. NumOfEnvrn) THEN
IF (environment(Envrn)%KindOfEnvrn .NE. environment(Envrn + 1)%KindOfEnvrn) THEN
EndDesignDayEnvrnsFlag = .TRUE.
END IF
ELSE
! if the last environment set the flag to true.
EndDesignDayEnvrnsFlag = .TRUE.
END IF
END IF
RETURN
END SUBROUTINE InitializeWeather