Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real(kind=r64) | :: | DiffLumEff | ||||
real(kind=r64) | :: | DirLumEff |
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 DayltgLuminousEfficacy (DiffLumEff,DirLumEff)
!
! SUBROUTINE INFORMATION:
! AUTHOR Fred Winkelmann
! DATE WRITTEN July 1997
! MODIFIED August 2009, BG fixed upper bound for sky clearness bin 7
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Uses diffuse horizontal solar irradiance, direct normal solar
! irradiance, atmospheric moisture and sun position
! to determine the luminous efficacy in lumens/watt
! of sky diffuse solar radiation and direct normal solar radiation.
! Based on an empirical method described in
! R. Perez, P. Ineichen, R. Seals, J. Michalsky and R. Stewart,
! "Modeling daylight availability and irradiance components from direct
! global irradiance components from direct and global irradiance,"
! Solar Energy 44 (1990) 271-289.
! Called by DayltgCurrentExtHorizIllum.
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER, DIMENSION(8) :: ADiffLumEff= & ! Diffuse luminous efficacy coefficients
(/97.24d0, 107.22d0, 104.97d0, 102.39d0, 100.71d0, 106.42d0, 141.88d0, 152.23d0/)
REAL(r64), PARAMETER, DIMENSION(8) :: BDiffLumEff= &
(/-0.46d0, 1.15d0, 2.96d0, 5.59d0, 5.94d0, 3.83d0, 1.90d0, 0.35d0 /)
REAL(r64), PARAMETER, DIMENSION(8) :: CDiffLumEff= &
(/12.00d0, 0.59d0, -5.53d0, -13.95d0, -22.75d0, -36.15d0, -53.24d0, -45.27d0/)
REAL(r64), PARAMETER, DIMENSION(8) :: DDiffLumEff= &
(/-8.91d0, -3.95d0, -8.77d0, -13.90d0, -23.74d0, -28.83d0, -14.03d0, -7.98d0 /)
REAL(r64), PARAMETER, DIMENSION(8) :: ADirLumEff= & ! Direct luminous efficacy coefficients
(/57.20d0, 98.99d0, 109.83d0, 110.34d0, 106.36d0, 107.19d0, 105.75d0, 101.18d0/)
REAL(r64), PARAMETER, DIMENSION(8) :: BDirLumEff= &
(/-4.55d0, -3.46d0, -4.90d0, -5.84d0, -3.97d0, -1.25d0, 0.77d0, 1.58d0 /)
REAL(r64), PARAMETER, DIMENSION(8) :: CDirLumEff= &
(/-2.98d0, -1.21d0, -1.71d0, -1.99d0, -1.75d0, -1.51d0, -1.26d0, -1.10d0 /)
REAL(r64), PARAMETER, DIMENSION(8) :: DDirLumEff= &
(/117.12d0,12.38d0, -8.81d0, -4.56d0, -6.16d0, -26.73d0, -34.44d0, -8.29d0 /)
REAL(r64), PARAMETER, DIMENSION(12) :: ExtraDirNormIll= & ! Monthly exterrestrial direct normal illuminance (lum/m2)
(/131153.d0,130613.d0,128992.d0,126816.d0,124731.d0,123240.d0, &
122652.d0,123120.d0,124576.d0,126658.d0,128814.d0,130471.d0/)
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: DirLumEff ! Luminous efficacy of beam solar radiation (lum/W)
REAL(r64) :: DiffLumEff ! Luminous efficacy of sky diffuse solar radiation (lum/W)
REAL(r64) :: SunZenith ! Solar zenith angle (radians)
REAL(r64) :: SunAltitude ! Solar altitude angle (radians)
REAL(r64) :: SinSunAltitude ! Sine of the solar altitude angle
REAL(r64) :: Zeta
INTEGER :: ISkyClearness ! Sky clearness bin
REAL(r64) :: AirMass ! Relative optical air mass
REAL(r64) :: AtmosMoisture ! Atmospheric moisture (cm of precipitable water)
! FLOW:
!
!
SunZenith = ACOS (SOLCOS(3))
SunAltitude = PiOvr2 - SunZenith
SinSunAltitude = SIN(SunAltitude)
!
! Clearness of sky. SkyClearness close to 1.0 corresponds to an overcast sky.
! SkyClearness > 6 is a clear sky.
! DifSolarRad is the diffuse horizontal irradiance.
! BeamSolarRad is the direct normal irradiance.
!
Zeta = 1.041d0*SunZenith**3
SkyClearness = ( (DifSolarRad + BeamSolarRad)/(DifSolarRad + 0.0001d0) + Zeta )/(1.0d0+Zeta)
AirMass = (1.d0-0.1d0*Elevation/1000.d0) / (SinSunAltitude + 0.15d0/(SunAltitude/DegToRadians + 3.885d0)**1.253d0)
!
! In the following, 93.73 is the extraterrestrial luminous efficacy
!
SkyBrightness = (DifSolarRad * 93.73d0)* AirMass / ExtraDirNormIll(Month)
!
IF(SkyClearness.LE.1.065d0) THEN
ISkyClearness = 1
ELSE IF(SkyClearness.GT.1.065d0.AND.SkyClearness.LE.1.23d0) THEN
ISkyClearness = 2
ELSE IF(SkyClearness.GT.1.23d0.AND.SkyClearness.LE.1.50d0) THEN
ISkyClearness = 3
ELSE IF(SkyClearness.GT.1.50d0.AND.SkyClearness.LE.1.95d0) THEN
ISkyClearness = 4
ELSE IF(SkyClearness.GT.1.95d0.AND.SkyClearness.LE.2.80d0) THEN
ISkyClearness = 5
ELSE IF(SkyClearness.GT.2.80d0.AND.SkyClearness.LE.4.50d0) THEN
ISkyClearness = 6
ELSE IF(SkyClearness.GT.4.50d0.AND.SkyClearness.LE.6.20d0) THEN
ISkyClearness = 7
ELSE
ISkyClearness = 8
END IF
!
AtmosMoisture = EXP (0.07d0*OutDewPointTemp - 0.075d0)
!
! Sky diffuse luminous efficacy
!
IF(SkyBrightness.LE.0.0d0) THEN
DiffLumEff = 0.d0
ELSE
DiffLumEff = ADiffLumEff(ISkyClearness) + BDiffLumEff(ISkyClearness)*AtmosMoisture + &
CDiffLumEff(ISkyClearness)*SOLCOS(3) + &
DDiffLumEff(ISkyClearness)*LOG(SkyBrightness)
ENDIF
!
! Direct normal luminous efficacy
!
IF(SkyBrightness.LE.0.d0) THEN
DirLumEff = 0.d0
ELSE
DirLumEff = MAX(0.d0,ADirLumEff(ISkyClearness) + BDirLumEff(ISkyClearness)*AtmosMoisture + &
CDirLumEff(ISkyClearness)*EXP(5.73d0*SunZenith-5.d0) + &
DDirLumEff(ISkyClearness)*SkyBrightness)
ENDIF
RETURN
END SUBROUTINE DayltgLuminousEfficacy