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(out) | :: | Available | |||
logical, | intent(inout) | :: | ErrorsFound |
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 GetNextEnvironment(Available,ErrorsFound)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN August 2000
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is called from the outer simulation manager and determines
! if another environment is available in the "run list" or if the end has been
! reached.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE General, ONLY: InvJulianDay, JulianDay, BetweenDates
USE DataSystemVariables
USE DataInterfaces, ONLY: SetupEMSActuator
USE DataHeatBalance, ONLY: AdaptiveComfortRequested_ASH55, AdaptiveComfortRequested_CEN15251
USE ThermalComfort, ONLY: CalcThermalComfortAdaptiveASH55,CalcThermalComfortAdaptiveCEN15251
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(OUT) :: Available ! true if there is another environment, false if the end
LOGICAL, INTENT(INOUT) :: ErrorsFound ! will be set to true if severe errors are found in inputs
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName='GetNextEnvironment: '
CHARACTER(len=*), PARAMETER :: EnvironFormat="('! <Environment>,Environment Name,Environment Type, Start Date, End Date,', &
& ' Start DayOfWeek, Duration {#days}, Source:Start DayOfWeek, ', &
& ' Use Daylight Saving, Use Holidays, Apply Weekend Holiday Rule, ', &
& ' Use Rain Values, Use Snow Values',/, &
& '! <Environment:Special Days>, Special Day Name, Special Day Type, Source, ', &
& 'Start Date, Duration {#days}',/, &
& '! <Environment:Daylight Saving>, Daylight Saving Indicator, Source,', &
& ' Start Date, End Date',/, &
& '! <Environment:WarmupDays>, NumberofWarmupDays')"
CHARACTER(len=*), PARAMETER :: EnvNameFormat="('Environment',12(',',A))"
CHARACTER(len=*), PARAMETER :: EnvDSTNFormat="('Environment:Daylight Saving,No,',A)"
CHARACTER(len=*), PARAMETER :: EnvDSTYFormat="('Environment:Daylight Saving,Yes',3(',',A))"
CHARACTER(len=*), PARAMETER :: EnvSpDyFormat="('Environment:Special Days',4(',',A),',',I3)"
CHARACTER(len=*), PARAMETER :: DateFormat="(I2.2,'/',I2.2)"
CHARACTER(len=*), PARAMETER :: DateFormatwithYear="(I2.2,'/',I2.2,'/',I4.4)"
CHARACTER(len=*), PARAMETER, DIMENSION(5) :: SpecialDayNames=(/"Holiday ","SummerDesignDay", &
"WinterDesignDay","CustomDay1 ","CustomDay2 "/)
CHARACTER(len=*), PARAMETER, DIMENSION(12) :: ValidDayNames=(/"Sunday ","Monday ","Tuesday ", &
"Wednesday ","Thursday ","Friday ", &
"Saturday ","Holiday ","SummerDesignDay", &
"WinterDesignDay","CustomDay1 ","CustomDay2 "/)
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL, SAVE :: GetInputFlag=.TRUE. ! Set to true before execution starts
LOGICAL, SAVE :: FirstCall=.true.
LOGICAL, SAVE :: PrntEnvHeaders=.true.
INTEGER :: Loop
INTEGER :: Loop1
CHARACTER(len=20) :: StDate
CHARACTER(len=20) :: EnDate
CHARACTER(len=10) :: string
CHARACTER(len=10) :: cTotalEnvDays
INTEGER :: NumDays
INTEGER :: DSTActStMon
INTEGER :: DSTActStDay
INTEGER :: DSTActEnMon
INTEGER :: DSTActEnDay
INTEGER :: RunStJDay
INTEGER :: RunEnJDay
LOGICAL :: OkRun
INTEGER :: ThisWeekDay
INTEGER :: TWeekDay
INTEGER, DIMENSION(12) :: MonWeekDay
INTEGER, DIMENSION(12) :: ActEndDayOfMonth
INTEGER :: ThisDay
INTEGER :: JDay
INTEGER :: JDay1
INTEGER :: JDay5Start
INTEGER :: JDay5End
CHARACTER(len=20) :: Source
CHARACTER(len=3) :: ApWkRule
CHARACTER(len=3) :: AlpUseDST
CHARACTER(len=3) :: AlpUseSpec
CHARACTER(len=3) :: AlpUseRain
CHARACTER(len=3) :: AlpUseSnow
CHARACTER(len=100) :: kindOfRunPeriod
REAL(r64) :: GrossApproxAvgDryBulb
IF (BeginSimFlag .and. FirstCall) THEN
PrintEndDataDictionary = .TRUE.
CALL ReportOutputFileHeaders ! Write the output file header information
! SetupOutputVariables, CurrentModuleObject='All Simulations'
CALL SetupOutputVariable('Site Outdoor Air Drybulb Temperature [C]',OutDryBulbTemp,'Zone','Average','Environment')
CALL SetupOutputVariable('Site Outdoor Air Dewpoint Temperature [C]',OutDewPointTemp,'Zone','Average','Environment')
CALL SetupOutputVariable('Site Outdoor Air Wetbulb Temperature [C]',OutWetBulbTemp,'Zone','Average','Environment')
CALL SetupOutputVariable('Site Outdoor Air Humidity Ratio [kgWater/kgDryAir]',OutHumRat,'Zone','Average','Environment')
CALL SetupOutputVariable('Site Outdoor Air Relative Humidity [%]',OutRelHum,'Zone','Average','Environment')
CALL SetupOutputVariable('Site Outdoor Air Barometric Pressure [Pa]',OutBaroPress,'Zone','Average','Environment')
CALL SetupOutputVariable('Site Wind Speed [m/s]',WindSpeed,'Zone','Average','Environment')
CALL SetupOutputVariable('Site Wind Direction [deg]',WindDir,'Zone','Average','Environment')
CALL SetupOutputVariable('Site Sky Temperature [C]',SkyTemp,'Zone','Average','Environment')
CALL SetupOutputVariable('Site Horizontal Infrared Radiation Rate per Area [W/m2]',HorizIRSky,'Zone','Average','Environment')
CALL SetupOutputVariable('Site Diffuse Solar Radiation Rate per Area [W/m2]',DifSolarRad,'Zone','Average','Environment')
CALL SetupOutputVariable('Site Direct Solar Radiation Rate per Area [W/m2]',BeamSolarRad,'Zone','Average','Environment')
CALL SetupOutputVariable('Site Precipitation Depth [m]',LiquidPrecipitation,'Zone','Sum','Environment')
CALL SetupOutputVariable('Site Ground Reflected Solar Radiation Rate per Area [W/m2]', &
GndSolarRad,'Zone','Average','Environment')
CALL SetupOutputVariable('Site Ground Temperature [C]',GroundTemp,'Zone','Average','Environment')
CALL SetupOutputVariable('Site Surface Ground Temperature [C]',GroundTemp_Surface,'Zone','Average','Environment')
CALL SetupOutputVariable('Site Deep Ground Temperature [C]',GroundTemp_Deep,'Zone','Average','Environment')
CALL SetupOutputVariable('Site Simple Factor Model Ground Temperature [C]',GroundTempFC,'Zone','Average','Environment')
CALL SetupOutputVariable('Site Outdoor Air Enthalpy [J/kg]',OutEnthalpy,'Zone','Average','Environment')
CALL SetupOutputVariable('Site Outdoor Air Density [kg/m3]',OutAirDensity,'Zone','Average','Environment')
CALL SetupOutputVariable('Site Solar Azimuth Angle [deg]',SolarAzimuthAngle,'Zone','Average','Environment')
CALL SetupOutputVariable('Site Solar Altitude Angle [deg]',SolarAltitudeAngle,'Zone','Average','Environment')
CALL SetupOutputVariable('Site Solar Hour Angle [deg]',HrAngle,'Zone','Average','Environment')
CALL SetupOutputVariable('Site Rain Status []',RptIsRain,'Zone','Average','Environment')
CALL SetupOutputVariable('Site Snow on Ground Status []',RptIsSnow,'Zone','Average','Environment')
CALL SetupOutputVariable('Site Exterior Horizontal Sky Illuminance [lux]',HISKF,'Zone','Average','Environment')
CALL SetupOutputVariable('Site Exterior Horizontal Beam Illuminance [lux]',HISUNF,'Zone','Average','Environment')
CALL SetupOutputVariable('Site Exterior Beam Normal Illuminance [lux]',HISUNFnorm,'Zone','Average','Environment')
CALL SetupOutputVariable('Site Sky Diffuse Solar Radiation Luminous Efficacy [lum/W]',PDIFLW,'Zone','Average','Environment')
CALL SetupOutputVariable('Site Beam Solar Radiation Luminous Efficacy [lum/W]',PDIRLW,'Zone','Average','Environment')
CALL SetupOutputVariable('Site Daylighting Model Sky Clearness []',SkyClearness,'Zone','Average','Environment')
CALL SetupOutputVariable('Site Daylighting Model Sky Brightness []',SkyBrightness,'Zone','Average','Environment')
CALL SetupOutputVariable('Site Daylight Saving Time Status []',DSTIndicator,'Zone','State','Environment')
CALL SetupOutputVariable('Site Day Type Index []',RptDayType,'Zone','State','Environment')
CALL SetupOutputVariable('Site Mains Water Temperature [C]',WaterMainsTemp,'Zone','Average','Environment')
IF (AnyEnergyManagementSystemInModel) THEN
CALL SetupEMSActuator('Weather Data', 'Environment', 'Outdoor Dry Bulb', '[C]', &
EMSOutDryBulbOverrideOn , EMSOutDryBulbOverrideValue )
CALL SetupEMSActuator('Weather Data', 'Environment', 'Outdoor Dew Point', '[C]', &
EMSOutDewPointTempOverrideOn , EMSOutDewPointTempOverrideValue )
CALL SetupEMSActuator('Weather Data', 'Environment', 'Outdoor Relative Humidity', '[%]', &
EMSOutRelHumOverrideOn , EMSOutRelHumOverrideValue )
CALL SetupEMSActuator('Weather Data', 'Environment', 'Diffuse Solar', '[W/m2]', &
EMSDifSolarRadOverrideOn , EMSDifSolarRadOverrideValue )
CALL SetupEMSActuator('Weather Data', 'Environment', 'Direct Solar', '[W/m2]', &
EMSBeamSolarRadOverrideOn , EMSBeamSolarRadOverrideValue )
CALL SetupEMSActuator('Weather Data', 'Environment', 'Wind Speed', '[m/s]', &
EMSWindSpeedOverrideOn , EMSWindSpeedOverrideValue )
CALL SetupEMSActuator('Weather Data', 'Environment', 'Wind Direction', '[deg]', &
EMSWindDirOverrideOn , EMSWindDirOverrideValue )
ENDIF
FirstCall=.false.
END IF ! ... end of BeginSimFlag IF-THEN block.
IF (GetInputFlag) THEN
CALL SetUpInterpolationValues
TimeStepFraction=1.d0/REAL(NumOfTimeStepInHour,r64)
CALL OpenWeatherFile(ErrorsFound) ! moved here because of possibility of special days on EPW file
CALL CloseWeatherFile
CALL ReadUserWeatherInput
CALL AllocateWeatherData
IF (NumIntervalsPerHour /= 1) THEN
IF (NumIntervalsPerHour /= NumOfTimeStepInHour) THEN
CALL ShowSevereError(RoutineName// &
'Number of intervals per hour on Weather file does not match specified number of Time Steps Per Hour')
ErrorsFound=.true.
ENDIF
ENDIF
GetInputFlag=.false.
Envrn=0
IF (NumOfEnvrn > 0) THEN
CALL ResolveLocationInformation(ErrorsFound) ! Obtain weather related info from input file
CALL CheckLocationValidity
IF (Environment(NumOfEnvrn)%KindOfEnvrn /= ksDesignDay) THEN
CALL CheckWeatherFileValidity
ENDIF
IF (ErrorsFound) THEN
CALL ShowSevereError(RoutineName//'No location specified, program will terminate.')
ENDIF
ELSE
ErrorsFound=.true.
CALL ShowSevereError(RoutineName//'No Design Days or Run Period(s) specified, program will terminate.')
ENDIF
IF (DDOnly .and. TotDesDays == 0) THEN
ErrorsFound=.true.
CALL ShowSevereError(RoutineName// &
'Requested Design Days only (DDOnly) but no Design Days specified, program will terminate.')
ENDIF
IF (ReverseDD .and. TotDesDays == 1) THEN
ErrorsFound=.true.
CALL ShowSevereError(RoutineName// &
'Requested Reverse Design Days (ReverseDD) but only 1 Design Day specified, program will terminate.')
ENDIF
CurrentOverallSimDay=0
TotalOverallSimDays=0
MaxNumberSimYears=1
DO Loop=1,NumOfEnvrn
TotalOverallSimDays=TotalOverallSimDays+Environment(Loop)%TotalDays
IF (Environment(Loop)%KindOfEnvrn == ksRunPeriodWeather) THEN
MaxNumberSimYears=MAX(MaxNumberSimYears,Environment(Loop)%NumSimYears)
ENDIF
ENDDO
CALL DisplaySimDaysProgress(CurrentOverallSimDay,TotalOverallSimDays)
ENDIF
CALL CloseWeatherFile ! will only close if opened.
Envrn=Envrn+1
DatesShouldBeReset=.false.
IF (Envrn > NumOfEnvrn) THEN
Available=.false.
Envrn = 0
CurEnvirNum = 0
ELSE
KindOfSim = Environment(Envrn)%KindOfEnvrn
DayOfYear=Environment(Envrn)%StartJDay
DayOfMonth=Environment(Envrn)%StartDay
Month=Environment(Envrn)%StartMonth
NumOfDayInEnvrn = Environment(Envrn)%TotalDays ! Set day loop maximum from DataGlobals
IF (.not. DoingSizing .and. .not. KickOffSimulation) THEN
IF (AdaptiveComfortRequested_ASH55 .or. AdaptiveComfortRequested_CEN15251) THEN
IF (KindOfSim == ksDesignDay) THEN
IF (DoDesDaySim) THEN
CALL ShowWarningError(RoutineName//'Adaptive Comfort being reported during design day.')
GrossApproxAvgDryBulb=(DesDayInput(Envrn)%MaxDryBulb+ &
(DesDayInput(Envrn)%MaxDryBulb-DesDayInput(Envrn)%DailyDBRange))/2.0d0
IF (AdaptiveComfortRequested_ASH55) CALL CalcThermalComfortAdaptiveASH55(.true.,.false.,GrossApproxAvgDryBulb)
IF (AdaptiveComfortRequested_CEN15251) CALL CalcThermalComfortAdaptiveCEN15251(.true.,.false.,GrossApproxAvgDryBulb)
ENDIF
ELSE
IF (DoWeathSim .or. DoDesDaySim) THEN
IF (AdaptiveComfortRequested_ASH55) CALL CalcThermalComfortAdaptiveASH55(.true.,.true.,0.0d0)
IF (AdaptiveComfortRequested_CEN15251) CALL CalcThermalComfortAdaptiveCEN15251(.true.,.true.,0.0d0)
ENDIF
ENDIF
ENDIF
ENDIF
IF (Envrn > TotDesDays .and. WeatherFileExists) THEN
CALL OpenEPlusWeatherFile(ErrorsFound,.false.)
ENDIF
Available=.true.
IF ((KindOfSim == ksRunPeriodWeather) .and. (.not. WeatherFileExists .and. DoWeathSim)) THEN
IF (.not. DoingSizing .and. .not. KickOffSimulation) THEN
CALL ShowSevereError('Weather Simulation requested, but no weather file attached.')
ErrorsFound=.true.
ENDIF
Envrn = 0
Available=.false.
ELSEIF ((KindOfSim == ksRunPeriodWeather) .and. (.not. WeatherFileExists .and. .not. DoWeathSim)) THEN
Available=.false.
Envrn = 0
ELSEIF ((KindOfSim == ksRunPeriodWeather) .and. DoingSizing) THEN
Available=.false.
Envrn = 0
ENDIF
IF (.not. ErrorsFound .and. Available .and. Envrn > 0) THEN
EnvironmentName = Environment(Envrn)%Title
CurEnvirNum = Envrn
RunPeriodStartDayOfWeek=0
IF ( (DoDesDaySim .and. (KindOfSim /= ksRunPeriodWeather)) .or. ((KindOfSim == ksRunPeriodWeather) .and. DoWeathSim) ) THEN
IF (PrntEnvHeaders .AND. DoWeatherInitReporting) THEN
WRITE(OutputFileInits,EnvironFormat)
PrntEnvHeaders=.false.
ENDIF
SELECT CASE(KindOfSim)
CASE (ksRunPeriodWeather,ksRunPeriodDesign)
kindOfRunPeriod = Environment(Envrn)%cKindOfEnvrn
IF (KindOfSim == ksRunPeriodWeather) THEN
RunPeriodEnvironment=.true.
ELSE
RunPeriodEnvironment=.false.
ENDIF
ActEndDayOfMonth=EndDayOfMonth
CurrentYearIsLeapYear=Environment(Envrn)%IsLeapYear
IF (CurrentYearIsLeapYear .and. WFAllowsLeapYears) THEN
LeapYearAdd=1
ELSE
LeapYearAdd=0
ENDIF
IF (CurrentYearIsLeapYear) THEN
ActEndDayOfMonth(2)=EndDayOfMonth(2)+LeapYearAdd
ENDIF
UseDaylightSaving=Environment(Envrn)%UseDST
UseSpecialDays=Environment(Envrn)%UseHolidays
UseRainValues=Environment(Envrn)%UseRain
UseSnowValues=Environment(Envrn)%UseSnow
OkRun=.false.
ThisWeekDay=0
DO Loop=1,NumDataPeriods
IF (.not. Environment(Envrn)%ActualWeather) THEN
RunStJDay=JulianDay(DataPeriods(Loop)%StMon,DataPeriods(Loop)%StDay,LeapYearAdd)
RunEnJDay=JulianDay(DataPeriods(Loop)%EnMon,DataPeriods(Loop)%EnDay,LeapYearAdd)
IF (.not. BetweenDates(Environment(Envrn)%StartJDay,RunStJDay,RunEnJDay)) CYCLE
IF (.not. BetweenDates(Environment(Envrn)%EndJDay,RunStJDay,RunEnJDay)) CYCLE
OkRun=.true.
IF (RunStJDay > Environment(Envrn)%StartJDay) THEN
NumDays=RunStJDay-Environment(Envrn)%StartJDay
ELSE
NumDays=Environment(Envrn)%StartJDay-RunStJDay
ENDIF
ThisWeekDay=MOD(DataPeriods(Loop)%WeekDay+NumDays-1,7)+1
EXIT
ELSE ! Actual Weather
RunStJDay=DataPeriods(Loop)%DataStJDay
RunEnJDay=DataPeriods(Loop)%DataEnJDay
IF (.not. DataPeriods(Loop)%HasYearData) THEN
CALL ShowSevereError('GetNextEnvironment: Runperiod:CustomRange has been entered but weatherfile '// &
' DATA PERIOD does not have year included in start/end date.')
CALL ShowContinueError('...to match the RunPeriod, the DATA PERIOD should be mm/dd/yyyy for both.')
ENDIF
IF (.not. BetweenDates(Environment(Envrn)%StartDate,RunStJDay,RunEnJDay)) CYCLE
IF (.not. BetweenDates(Environment(Envrn)%EndDate,RunStJDay,RunEnJDay)) CYCLE
OkRun=.true.
IF (RunStJDay > Environment(Envrn)%StartDate) THEN
NumDays=RunStJDay-Environment(Envrn)%StartDate
ELSE
NumDays=Environment(Envrn)%StartDate-RunStJDay
ENDIF
ThisWeekDay=MOD(DataPeriods(Loop)%WeekDay+NumDays-1,7)+1
EXIT
ENDIF
ENDDO
IF (.not. OkRun) THEN
IF (.not. Environment(Envrn)%ActualWeather) THEN
WRITE(StDate,DateFormat) Environment(Envrn)%StartMonth,Environment(Envrn)%StartDay
WRITE(EnDate,DateFormat) Environment(Envrn)%EndMonth,Environment(Envrn)%EndDay
CALL ShowSevereError(RoutineName//'Runperiod [mm/dd] (Start='//TRIM(StDate)//',End='//TRIM(EnDate)// &
') requested not within Data Period(s) from Weather File')
ELSE
WRITE(StDate,DateFormatwithYear) Environment(Envrn)%StartMonth,Environment(Envrn)%StartDay, &
Environment(Envrn)%StartYear
WRITE(EnDate,DateFormatwithYear) Environment(Envrn)%EndMonth,Environment(Envrn)%EndDay, &
Environment(Envrn)%EndYear
CALL ShowSevereError(RoutineName//'Runperiod [mm/dd/yyyy] (Start='//TRIM(StDate)//',End='//TRIM(EnDate)// &
') requested not within Data Period(s) from Weather File')
ENDIF
WRITE(StDate,DateFormat) DataPeriods(1)%StMon,DataPeriods(1)%StDay
WRITE(EnDate,DateFormat) DataPeriods(1)%EnMon,DataPeriods(1)%EnDay
IF (DataPeriods(1)%StYear > 0) THEN
string=RoundSigDigits(DataPeriods(1)%StYear)
StDate=trim(StDate)//'/'//string
ELSE
StDate=trim(StDate)//'/<noyear>'
ENDIF
IF (DataPeriods(1)%EnYear > 0) THEN
string=RoundSigDigits(DataPeriods(1)%EnYear)
EnDate=trim(EnDate)//'/'//string
ELSE
EnDate=trim(EnDate)//'/<noyear>'
ENDIF
IF (NumDataPeriods == 1) THEN
CALL ShowContinueError('Weather Data Period (Start='//TRIM(StDate)//',End='//TRIM(EnDate))
ELSE
CALL ShowContinueError('Multiple Weather Data Periods 1st (Start='//TRIM(StDate)//',End='//TRIM(EnDate)//')')
ENDIF
CALL ShowFatalError(RoutineName//'Program terminates due to preceding condition.')
ENDIF
! Following builds Environment start/end for ASHRAE 55 warnings
WRITE(StDate,DateFormat) Environment(Envrn)%StartMonth,Environment(Envrn)%StartDay
WRITE(EnDate,DateFormat) Environment(Envrn)%EndMonth,Environment(Envrn)%EndDay
IF (Environment(Envrn)%ActualWeather) THEN
string=RoundSigDigits(Environment(Envrn)%StartYear)
StDate=trim(StDate)//'/'//string
string=RoundSigDigits(Environment(Envrn)%EndYear)
EnDate=trim(EnDate)//'/'//string
ELSEIF (Environment(Envrn)%CurrentYear > 0 .and. Environment(Envrn)%TreatYearsAsConsecutive) THEN
string=RoundSigDigits(Environment(Envrn)%CurrentYear)
StDate=trim(StDate)//'/'//string
string=RoundSigDigits(Environment(Envrn)%CurrentYear+Environment(Envrn)%NumSimYears)
EnDate=trim(EnDate)//'/'//string
ENDIF
EnvironmentStartEnd=TRIM(StDate)//' - '//TRIM(EnDate)
IF (DoWeatherInitReporting) THEN
IF (Environment(Envrn)%UseDST) THEN
AlpUseDST='Yes'
ELSE
AlpUseDST='No'
ENDIF
IF (Environment(Envrn)%UseHolidays) THEN
AlpUseSpec='Yes'
ELSE
AlpUseSpec='No'
ENDIF
IF (Environment(Envrn)%ApplyWeekendRule) THEN
ApWkRule='Yes'
ELSE
ApWkRule='No'
ENDIF
IF (Environment(Envrn)%UseRain) THEN
AlpUseRain='Yes'
ELSE
AlpUseRain='No'
ENDIF
IF (Environment(Envrn)%UseSnow) THEN
AlpUseSnow='Yes'
ELSE
AlpUseSnow='No'
ENDIF
cTotalEnvDays=RoundSigDigits(Environment(Envrn)%TotalDays)
IF (Environment(Envrn)%DayOfWeek == 0) THEN ! Uses Weather file start
WRITE(OutputFileInits,EnvNameFormat) TRIM(Environment(Envrn)%Title),TRIM(kindOfRunPeriod), &
TRIM(StDate),TRIM(EnDate),TRIM(ValidDayNames(ThisWeekDay)), &
trim(cTotalEnvDays),'UseWeatherFile', &
AlpUseDST,AlpUseSpec,ApWkRule,AlpUseRain,AlpUseSnow
TWeekDay=ThisWeekDay
MonWeekDay=DataPeriods(Loop)%MonWeekDay
ELSE
WRITE(OutputFileInits,EnvNameFormat) TRIM(Environment(Envrn)%Title),TRIM(kindOfRunPeriod), &
TRIM(StDate),TRIM(EnDate),TRIM(ValidDayNames(Environment(Envrn)%DayOfWeek)), &
trim(cTotalEnvDays),'Use RunPeriod Specified Day', &
AlpUseDST,AlpUseSpec,ApWkRule,AlpUseRain,AlpUseSnow
TWeekDay=Environment(Envrn)%DayOfWeek
MonWeekDay=Environment(Envrn)%MonWeekDay
ENDIF
ELSE ! just in case
IF (Environment(Envrn)%DayOfWeek == 0) THEN ! Uses Weather file start
TWeekDay=ThisWeekDay
MonWeekDay=DataPeriods(Loop)%MonWeekDay
ELSE
TWeekDay=Environment(Envrn)%DayOfWeek
MonWeekDay=Environment(Envrn)%MonWeekDay
ENDIF
ENDIF
IF (.not. DoingSizing .and. .not. KickOffSimulation) THEN
IF ( (KindOfSim == ksRunPeriodWeather .and. DoWeathSim) ) THEN
IF (AdaptiveComfortRequested_ASH55 .or. AdaptiveComfortRequested_CEN15251) THEN
IF (WFAllowsLeapYears) THEN
CALL ShowSevereError(RoutineName// &
'AdaptiveComfort Reporting does not work correctly with leap years in weather files.')
ErrorsFound=.true.
ENDIF
IF (NumDataPeriods /= 1) THEN
CALL ShowSevereError(RoutineName// &
'AdaptiveComfort Reporting does not work correctly with multiple dataperiods in weather files.')
ErrorsFound=.true.
ENDIF
IF (DataPeriods(1)%StMon == 1 .and. DataPeriods(1)%StDay == 1) THEN
RunStJDay=JulianDay(DataPeriods(1)%StMon,DataPeriods(1)%StDay,LeapYearAdd)
RunEnJDay=JulianDay(DataPeriods(1)%EnMon,DataPeriods(1)%EnDay,LeapYearAdd)
IF (RunEnJDay-RunStJDay+1 /= 365) THEN
CALL ShowSevereError(RoutineName// &
'AdaptiveComfort Reporting does not work correctly with weather files that do not contain 365 days.')
ErrorsFound=.true.
ENDIF
ELSE
CALL ShowSevereError(RoutineName// &
'AdaptiveComfort Reporting does not work correctly with weather files that do not start on 1 January.')
ErrorsFound=.true.
ENDIF
IF (NumIntervalsPerHour /= 1) THEN
CALL ShowSevereError(RoutineName// &
'AdaptiveComfort Reporting does not work correctly with weather files '// &
'that have multiple interval records per hour.')
ErrorsFound=.true.
ENDIF
ENDIF
ENDIF
ENDIF
! Only need to set Week days for Run Days
RunPeriodStartDayOfWeek=TWeekDay
WeekDayTypes=0
JDay5Start=JulianDay(Environment(Envrn)%StartMonth,Environment(Envrn)%StartDay,LeapYearAdd)
JDay5End=JulianDay(Environment(Envrn)%EndMonth,Environment(Envrn)%EndDay,LeapYearAdd)
IF (JDay5End >= JDay5Start) THEN
curSimDayforEndofRunPeriod=DayOfSim+(JDay5End-JDay5Start)+LeapYearAdd
ELSE
curSimDayforEndofRunPeriod=DayOfSim+JulianDay(12,31,LeapYearAdd)-JDay5Start+JDay5End
ENDIF
Loop=JDay5Start
DO
WeekDayTypes(Loop)=TWeekDay
TWeekDay=MOD(TWeekDay,7)+1
Loop=Loop+1
IF (Loop > 366) Loop=1
IF (Loop == JDay5End) EXIT
ENDDO
IF (UseDaylightSaving) THEN
IF (EPWDaylightSaving) THEN
DaylightSavingIsActive=.true.
ENDIF
ELSE
DaylightSavingIsActive=.false.
ENDIF
IF (IDFDaylightSaving) THEN
DaylightSavingIsActive=.true.
ENDIF
Environment(Envrn)%SetWeekDays=.false.
IF (Environment(Envrn)%ActualWeather) THEN
curSimDayforEndofRunPeriod=Environment(Envrn)%TotalDays
ENDIF
IF (DaylightSavingIsActive) THEN
CALL SetDSTDateRanges(MonWeekDay,DSTIndex,DSTActStMon,DSTActStDay,DSTActEnMon,DSTActEnDay)
ENDIF
CALL SetSpecialDayDates(MonWeekDay)
IF (Environment(Envrn)%StartMonth /= 1 .or. Environment(Envrn)%StartDay /= 1) THEN
StartDatesCycleShouldBeReset=.true.
Jan1DatesShouldBeReset=.true.
ENDIF
IF (Environment(Envrn)%StartMonth == 1 .and. Environment(Envrn)%StartDay == 1) THEN
StartDatesCycleShouldBeReset=.false.
Jan1DatesShouldBeReset=.true.
ENDIF
IF (Environment(Envrn)%ActualWeather) THEN
StartDatesCycleShouldBeReset=.false.
Jan1DatesShouldBeReset=.true.
ENDIF
! Report Actual Dates for Daylight Saving and Special Days
IF (.not. KickoffSimulation) THEN
Source=Blank
IF (UseDaylightSaving) THEN
IF (EPWDaylightSaving) THEN
Source='WeatherFile'
ENDIF
ELSE
Source='RunPeriod Object'
ENDIF
IF (IDFDaylightSaving) THEN
Source='InputFile'
ENDIF
IF (DaylightSavingIsActive .AND. DoWeatherInitReporting) THEN
WRITE(StDate,DateFormat) DSTActStMon,DSTActStDay
WRITE(EnDate,DateFormat) DSTActEnMon,DSTActEnDay
WRITE(OutputFileInits,EnvDSTYFormat) TRIM(Source),TRIM(StDate),TRIM(EnDate)
ELSE IF (DoOutputReporting) THEN
WRITE(OutputFileInits,EnvDSTNFormat) TRIM(Source)
ENDIF
DO Loop=1,NumSpecialDays
IF (SpecialDays(Loop)%WthrFile .and. UseSpecialDays .and. DoWeatherInitReporting) THEN
WRITE(StDate,DateFormat) SpecialDays(Loop)%ActStMon,SpecialDays(Loop)%ActStDay
WRITE(OutputFileInits,EnvSpDyFormat) TRIM(SpecialDays(Loop)%Name), &
TRIM(SpecialDayNames(SpecialDays(Loop)%DayType)), &
'WeatherFile',TRIM(StDate),SpecialDays(Loop)%Duration
ENDIF
IF (.not. SpecialDays(Loop)%WthrFile .and. DoWeatherInitReporting) THEN
WRITE(StDate,DateFormat) SpecialDays(Loop)%ActStMon,SpecialDays(Loop)%ActStDay
WRITE(OutputFileInits,EnvSpDyFormat) TRIM(SpecialDays(Loop)%Name), &
TRIM(SpecialDayNames(SpecialDays(Loop)%DayType)), &
'InputFile',TRIM(StDate),SpecialDays(Loop)%Duration
ENDIF
ENDDO
ENDIF
CASE (ksDesignDay) ! Design Day
RunPeriodEnvironment=.false.
WRITE(StDate,DateFormat) DesDayInput(Envrn)%Month,DesDayInput(Envrn)%DayOfMonth
EnDate=StDate
IF (DesDayInput(Envrn)%DayType <= 7 .and. DoWeatherInitReporting) THEN
WRITE(OutputFileInits,EnvNameFormat) TRIM(Environment(Envrn)%Title),'SizingPeriod:DesignDay',TRIM(StDate), &
TRIM(EnDate),TRIM(DaysOfWeek(DesDayInput(Envrn)%DayType)),'1','N/A','N/A','N/A','N/A','N/A','N/A'
ELSE IF (DoWeatherInitReporting) THEN
WRITE(OutputFileInits,EnvNameFormat) TRIM(Environment(Envrn)%Title),'SizingPeriod:DesignDay',TRIM(StDate), &
TRIM(EnDate),TRIM(SpecialDayNames(DesDayInput(Envrn)%DayType - 7)),'1','N/A','N/A','N/A','N/A','N/A','N/A'
ENDIF
IF (DesDayInput(Envrn)%DSTIndicator == 0 .and. DoWeatherInitReporting) THEN
WRITE(OutputFileInits,EnvDSTNFormat) 'SizingPeriod:DesignDay'
ELSE IF (DoWeatherInitReporting) THEN
WRITE(OutputFileInits,EnvDSTYFormat) 'SizingPeriod:DesignDay',TRIM(StDate),TRIM(EnDate)
ENDIF
END SELECT
ENDIF
ENDIF ! ErrorsFound
ENDIF
IF (ErrorsFound .and. .not. DoingSizing .and. .not. KickOffSimulation) THEN
CALL ShowSevereError(RoutineName//'Errors found in getting a new environment')
Available=.false.
ELSEIF (ErrorsFound) THEN
Available=.false.
ENDIF
RETURN
END SUBROUTINE GetNextEnvironment