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 SetCurrentWeather
! SUBROUTINE INFORMATION:
! AUTHOR Russ Taylor
! DATE WRITTEN March 1990
! MODIFIED Aug94 (LKL) Fixed improper weighting
! Nov98 (FCW) Added call to get exterior illuminances
! Jan02 (FCW) Changed how ground reflectance for daylighting is set
! Mar12 (LKL) Changed settings for leap years/ current years.
! RE-ENGINEERED Apr97,May97 (RKS)
! PURPOSE OF THIS SUBROUTINE:
! The purpose of this subroutine is to interpolate the hourly
! environment data for the sub-hourly time steps in EnergyPlus. In
! other words, this subroutine puts the current weather conditions
! into the proper variables. Rather than using the same data for
! each time step, environment data is interpolated as a continuum
! throughout the day.
! METHODOLOGY EMPLOYED:
! The current hour (HourOfDay) as well as the next hour are used
! to come up with environment data per time step interval. Method
! used is to assign a weighting for the current hour's data and
! (1-that weighting) to the next hour's data. Actual method is: if
! the current time step is 15 minutes into hour, the interpolated dry
! bulb temperature should be 3/4*dry bulb temperature of current hour
! and 1/4*dry bulb temperature of next environment hourly data. At
! day boundary (current hour = 24), the next hour is hour 1 of next
! weather data day (Tomorrow%).
! REFERENCES:
! INTERPOL(IBLAST) legacy code.
! USE STATEMENTS:
USE General, ONLY: JulianDay
USE ScheduleManager, ONLY: UpdateScheduleValues
use inputprocessor, only:samestring
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: TimeStmpFmt="(I2.2,'/',I2.2,' ',I2.2,':')"
CHARACTER(len=*), PARAMETER :: MnDyFmt="(I2.2,'/',I2.2)"
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER,SAVE :: NextHour
REAL(r64) TempVal
REAL(r64) TempDPVal
! FLOW:
NextHour = HourOfDay+1
IF (HourOfDay .EQ. 24) THEN
NextHour = 1
END IF
IF (HourOfDay == 1) THEN
DayOfYear_Schedule=JulianDay(Month,DayOfMonth,1)
ENDIF
CALL UpdateScheduleValues
WRITE(CurMnDyHr,TimeStmpFmt) Month,DayOfMonth,HourOfDay-1
WRITE(CurMnDy,MnDyFmt) Month,DayOfMonth
WeightNow=Interpolation(TimeStep)
WeightPreviousHour = 1.0d0-WeightNow
CurrentTime=(HourOfDay-1)+TimeStep*(TimeStepFraction)
SimTimeSteps = (DayOfSim-1)*24*NumOfTimeStepInHour + (HourOfDay-1)*NumOfTimeStepInHour + TimeStep
GroundTemp=GroundTemps(Month)
GroundTempKelvin=GroundTemp+KelvinConv
GroundTempFC=GroundTempsFC(Month)
GroundTemp_Surface=SurfaceGroundTemps(Month)
GroundTemp_Deep=DeepGroundTemps(Month)
GndReflectance=GroundReflectances(Month)
GndReflectanceForDayltg=GndReflectance
CALL CalcWaterMainsTemp
! Determine if Sun is up or down, set Solar Cosine values for time step.
CALL DetermineSunUpDown(SOLCOS)
IF (SunIsUp .and. SolarAltitudeAngle < 0.0d0) THEN
CALL ShowFatalError('SetCurrentWeather: At '//TRIM(CurMnDyHr)//' Sun is Up but Solar Altitude Angle is < 0.0')
ENDIF
OutDryBulbTemp = TodayOutDryBulbTemp(HourOfDay,TimeStep)
IF (EMSOutDryBulbOverrideOn) OutDryBulbTemp = EMSOutDryBulbOverrideValue
OutBaroPress = TodayOutBaroPress(HourOfDay,TimeStep)
OutDewPointTemp= TodayOutDewPointTemp(HourOfDay,TimeStep)
IF (EMSOutDewPointTempOverrideOn) OutDewPointTemp = EMSOutDewPointTempOverrideValue
OutRelHum = TodayOutRelHum(HourOfDay,TimeStep)
OutRelHumValue = OutRelHum/100.d0
IF (EMSOutRelHumOverrideOn) THEN
OutRelHumValue = EMSOutRelHumOverrideValue/ 100.d0
OutRelHum = EMSOutRelHumOverrideValue
ENDIF
! Humidity Ratio and Wet Bulb are derived
OutHumRat = PsyWFnTdbRhPb(OutDryBulbTemp,OutRelHumValue,OutBaroPress, 'SetCurrentWeather')
OutWetBulbTemp = PsyTwbFnTdbWPb(OutDryBulbTemp,OutHumRat,OutBaroPress)
IF (OutDryBulbTemp < OutWetBulbTemp) THEN
OutWetBulbTemp=OutDryBulbTemp
TempVal=PsyWFnTdbTwbPb(OutDryBulbTemp,OutWetBulbTemp,OutBaroPress)
TempDPVal=PsyTdpFnWPb(TempVal,OutBaroPress)
OutDewPointTemp=TempDPVal
ENDIF
IF (OutDewPointTemp > OutWetBulbTemp) THEN
OutDewPointTemp=OutWetBulbTemp
ENDIF
IF (KindOfSim == ksDesignDay) THEN
SPSiteDryBulbRangeModScheduleValue = -999.0d0 ! N/A Drybulb Temperature Range Modifier Schedule Value
SPSiteHumidityConditionScheduleValue = -999.0d0 ! N/A Humidity Condition Schedule Value
SPSiteBeamSolarScheduleValue = -999.0d0 ! N/A Beam Solar Schedule Value
SPSiteDiffuseSolarScheduleValue = -999.0d0 ! N/A Diffuse Solar Schedule Value
SPSiteSkyTemperatureScheduleValue = -999.0d0 ! N/A SkyTemperature Modifier Schedule Value
IF (DesDayInput(Envrn)%DBTempRangeType /= DDDBRangeType_Default) THEN
SPSiteDryBulbRangeModScheduleValue(Envrn) = DDDBRngModifier(Envrn,HourOfDay,TimeStep)
ENDIF
IF (DesDayInput(Envrn)%HumIndType == DDHumIndType_WBProfDef &
.or. DesDayInput(Envrn)%HumIndType == DDHumIndType_WBProfDif &
.or. DesDayInput(Envrn)%HumIndType == DDHumIndType_WBProfMul) THEN
SPSiteHumidityConditionScheduleValue(Envrn) = DDHumIndModifier(Envrn,HourOfDay,TimeStep)
ELSEIF (DesDayInput(Envrn)%HumIndType == DDHumIndType_RelHumSch) THEN
SPSiteHumidityConditionScheduleValue(Envrn) = DDHumIndModifier(Envrn,HourOfDay,TimeStep)
ENDIF
IF (DesDayInput(Envrn)%SolarModel == SolarModel_Schedule) THEN
SPSiteBeamSolarScheduleValue(Envrn) = DDBeamSolarValues(Envrn,HourOfDay,TimeStep)
SPSiteDiffuseSolarScheduleValue(Envrn) = DDDiffuseSolarValues(Envrn,HourOfDay,TimeStep)
ENDIF
IF (Environment(Envrn)%WP_Type1 /= 0) THEN
SPSiteSkyTemperatureScheduleValue(Envrn) = DDSkyTempScheduleValues(Envrn,HourOfDay,TimeStep)
ENDIF
ELSEIF (TotDesDays > 0) THEN
SPSiteDryBulbRangeModScheduleValue = -999.0d0 ! N/A Drybulb Temperature Range Modifier Schedule Value
SPSiteHumidityConditionScheduleValue = -999.0d0 ! N/A Humidity Condition Schedule Value
SPSiteBeamSolarScheduleValue = -999.0d0 ! N/A Beam Solar Schedule Value
SPSiteDiffuseSolarScheduleValue = -999.0d0 ! N/A Diffuse Solar Schedule Value
SPSiteSkyTemperatureScheduleValue = -999.0d0 ! N/A SkyTemperature Modifier Schedule Value
ENDIF
WindSpeed = TodayWindSpeed(HourOfDay,TimeStep)
IF (EMSWindSpeedOverrideOn) WindSpeed = EMSWindSpeedOverrideValue
WindDir = TodayWindDir(HourOfDay,TimeStep)
IF (EMSWindDirOverrideOn) WindDir = EMSWindDirOverrideValue
HorizIRSky = TodayHorizIRSky(HourOfDay,TimeStep)
SkyTemp = TodaySkyTemp(HourOfDay,TimeStep)
SkyTempKelvin = SkyTemp + KelvinConv
DifSolarRad = TodayDifSolarRad(HourOfDay,TimeStep)
IF (EMSDifSolarRadOverrideOn) DifSolarRad = EMSDifSolarRadOverrideValue
BeamSolarRad = TodayBeamSolarRad(HourOfDay,TimeStep)
IF (EMSBeamSolarRadOverrideOn) BeamSolarRad = EMSBeamSolarRadOverrideValue
LiquidPrecipitation = TodayLiquidPrecip(HourOfDay,TimeStep)/1000.d0 ! convert from mm to m
IF (UseRainValues) THEN
IsRain=TodayIsRain(HourOfDay,TimeStep) !.or. LiquidPrecipitation >= .8d0) ! > .8 mm
ELSE
IsRain=.false.
ENDIF
IF (UseSnowValues) THEN
IsSnow=TodayIsSnow(HourOfDay,TimeStep)
ELSE
IsSnow=.false.
ENDIF
IF (IsSnow) THEN
GndReflectance = MAX(MIN(GndReflectance*SnowGndRefModifier,1.0d0),0.0d0)
GndReflectanceForDayltg = MAX(MIN(GndReflectanceForDayltg*SnowGndRefModifierForDayltg,1.0d0),0.0d0)
ENDIF
GndSolarRad=MAX((BeamSolarRad*SOLCOS(3) + DifSolarRad)*GndReflectance,0.0D0)
IF (.not. SunIsUp) THEN
DifSolarRad = 0.0d0
BeamSolarRad = 0.0d0
GndSolarRad = 0.0d0
ENDIF
! Calc some values
OutEnthalpy=PsyHFnTdbW(OutDryBulbTemp,OutHumRat)
OutAirDensity=PsyRhoAirFnPbTdbW(OutBaroPress,OutDryBulbTemp,OutHumRat)
! Make sure outwetbulbtemp is valid. And that no error occurs here.
IF (OutDryBulbTemp < OutWetBulbTemp) OutWetBulbTemp=OutDryBulbTemp
! VALIDITY TEST.
IF (OutDewPointTemp > OutWetBulbTemp) THEN
OutDewPointTemp=OutWetBulbTemp
ENDIF
! Get exterior daylight illuminance for daylighting calculation
CALL DayltgCurrentExtHorizIllum
IF (.not. IsRain) THEN
RptIsRain=0
ELSE
RptIsRain=1
ENDIF
IF (.not. IsSnow) THEN
RptIsSnow=0
ELSE
RptIsSnow=1
ENDIF
RETURN
END SUBROUTINE SetCurrentWeather