| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| real(kind=r64), | intent(in) | :: | cs | |||
| real(kind=r64), | intent(in) | :: | tf0 | |||
| real(kind=r64), | intent(in) | :: | rf0 | |||
| real(kind=r64), | intent(in) | :: | rb0 | |||
| real(kind=r64), | intent(out) | :: | tfp | |||
| real(kind=r64), | intent(out) | :: | rfp | |||
| real(kind=r64), | intent(out) | :: | rbp | |||
| logical, | intent(in) | :: | SimpleGlazingSystem | |||
| real(kind=r64), | intent(in) | :: | SimpleGlazingSHGC | |||
| real(kind=r64), | intent(in) | :: | SimpleGlazingU |
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 TransAndReflAtPhi(cs,tf0,rf0,rb0,tfp,rfp,rbp,SimpleGlazingSystem, SimpleGlazingSHGC, SimpleGlazingU)
! SUBROUTINE INFORMATION:
! AUTHOR F. Winkelmann
! DATE WRITTEN January 2000
! MODIFIED 5 June 2003, FCW: modify to correspond to WINDOW 4 and WINDOW 5.
! Original routine was based on the method in E.U. Finlayson et al,
! "WINDOW 4.0: Documentation of Calculation Procedures," LBL-33943,
! July 1993, which is not used in either WINDOW 4 or WINDOW 5.
! The current routine is based on ASHRAE Handbook of Fundamentals,
! 2001, pp. 30.20-23, "Optical Properties of Single Glazing Layers."
! Original routine underpredicted transmittance at angles of
! incidence > 60 degrees.
! June 2009. Brent Griffith. add simple window correlation
! newer model from LBNL windows group 5/15/2009
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! For a single glazing layer, calculate transmittance and reflectance at an arbitrary
! angle of incidence given transmittance and reflectance at zero incidence angle.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! ASHRAE Handbook of Fundamentals, 2001, pp. 30.20-23,
! "Optical Properties of Single Glazing Layers."
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
REAL(r64), INTENT(IN) :: cs ! Cosine of incidence angle
REAL(r64), INTENT(IN) :: tf0 ! Transmittance at zero incidence angle
REAL(r64), INTENT(IN) :: rf0 ! Front reflectance at zero incidence angle
REAL(r64), INTENT(IN) :: rb0 ! Back reflectance at zero incidence angle
REAL(r64), INTENT(OUT) :: tfp ! Transmittance at cs
REAL(r64), INTENT(OUT) :: rfp ! Front reflectance at cs
REAL(r64), INTENT(OUT) :: rbp ! Back reflectance at cs
LOGICAL, INTENT(IN) :: SimpleGlazingSystem ! .TRUE. if simple block model being used
REAL(r64), INTENT(IN) :: SimpleGlazingSHGC ! SHGC value to use in alternate model for simple glazing system
REAL(r64), INTENT(IN) :: SimpleGlazingU ! U-factor value to use in alternate model for simple glazing system
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: tfp1,tfp2 ! Transmittance at cs for each polarization
REAL(r64) :: rfp1,rfp2 ! Front reflectance at cs for each polarization
REAL(r64) :: rbp1,rbp2 ! Back reflectance at cs for each polarization
REAL(r64) :: betaf,betab ! Intermediate variables
REAL(r64) :: t0f,t0b,r0f,r0b,abf,abb ! Intermediate variables
REAL(r64) :: ngf,ngb ! Front and back index of refraction
REAL(r64) :: cgf,cgb ! Intermediate variables
REAL(r64) :: rpf1,rpb1,tpf1,tpb1 ! Front and back air/glass interface reflectivity
! and transmittivity for first polarization
REAL(r64) :: rpf2,rpb2,tpf2,tpb2 ! Front and back air/glass interface reflectivity
! and transmittivity for second polarization
REAL(r64) :: tcl,rcl ! Transmittance and reflectance for clear glass
REAL(r64) :: tbnz,rbnz ! Transmittance and reflectance for bronze glass
REAL(r64) :: expmabfdivcgf
REAL(r64) :: expm2abfdivcgf
REAL(r64) :: expmabbdivcgb
REAL(r64) :: TransCurveA ! result for curve A for Transmission as a function of angle
REAL(r64) :: TransCurveB ! result for curve B for Transmission as a function of angle
REAL(r64) :: TransCurveC ! result for curve C for Transmission as a function of angle
REAL(r64) :: TransCurveD ! result for curve D for Transmission as a function of angle
REAL(r64) :: TransCurveE ! result for curve E for Transmission as a function of angle
REAL(r64) :: TransCurveF ! result for curve F for Transmission as a function of angle
REAL(r64) :: TransCurveG ! result for curve G for Transmission as a function of angle
REAL(r64) :: TransCurveH ! result for curve H for Transmission as a function of angle
REAL(r64) :: TransCurveI ! result for curve I for Transmission as a function of angle
REAL(r64) :: TransCurveJ ! result for curve J for Transmission as a function of angle
REAL(r64) :: ReflectCurveA ! result for curve A for Reflectance as a function of angle
REAL(r64) :: ReflectCurveB ! result for curve B for Reflectance as a function of angle
REAL(r64) :: ReflectCurveC ! result for curve C for Reflectance as a function of angle
REAL(r64) :: ReflectCurveD ! result for curve D for Reflectance as a function of angle
REAL(r64) :: ReflectCurveE ! result for curve E for Reflectance as a function of angle
REAL(r64) :: ReflectCurveF ! result for curve F for Reflectance as a function of angle
REAL(r64) :: ReflectCurveG ! result for curve G for Reflectance as a function of angle
REAL(r64) :: ReflectCurveH ! result for curve H for Reflectance as a function of angle
REAL(r64) :: ReflectCurveI ! result for curve I for Reflectance as a function of angle
REAL(r64) :: ReflectCurveJ ! result for curve J for Reflectance as a function of angle
REAL(r64) :: TransCurveFGHI ! average of curves F, G, H, and I
REAL(r64) :: ReflectCurveFGHI ! average of curves F, G, H, and I
REAL(r64) :: TransCurveFH ! average of curves F and H
REAL(r64) :: ReflectCurveFH ! average of curves F and H
REAL(r64) :: TransCurveBDCD ! average of curves B, D, C, and D (again)
REAL(r64) :: ReflectCurveBDCD ! average of curves B, D, C, and D (again)
REAL(r64) :: TransTmp ! temporary value for normalized transmission (carry out of if blocks)
REAL(r64) :: ReflectTmp ! temporary value for normalized reflectance (carry out of if blocks)
real(r64) :: testval ! temporary value for calculations
real(r64) :: tmp1 ! temporary value for calculations
real(r64) :: tmp2 ! temporary value for calculations
real(r64) :: tmp3 ! temporary value for calculations
real(r64) :: tmp4 ! temporary value for calculations
real(r64) :: tmp5 ! temporary value for calculations
real(r64) :: tmp6 ! temporary value for calculations
real(r64) :: tmp7 ! temporary value for calculations
real(r64) :: tmp8 ! temporary value for calculations
real(r64) :: tmp9 ! temporary value for calculations
! FLOW
IF (SimpleGlazingSystem) Then ! use alternate angular dependence model for block model of simple glazing input
TransCurveA = 1.4703D-02*cs**4 + 1.4858D0*cs**3 - 3.852D0*cs**2 + 3.3549D0*cs - 1.4739D-03
TransCurveB = 5.5455D-01*cs**4 + 3.563D-02*cs**3 - 2.4157D0*cs**2 + 2.8305D0*cs - 2.0373D-03
TransCurveC = 7.7087D-01*cs**4 - 6.3831D-01*cs**3 - 1.5755D0*cs**2 + 2.4482D0*cs - 2.042D-03
TransCurveD = 3.4624D-01*cs**4 + 3.9626D-01*cs**3 - 2.5819D0*cs**2 + 2.845D0*cs - 2.8036D-04
TransCurveE = 2.8825D0*cs**4 - 5.8734D0*cs**3 + 2.4887D0*cs**2 + 1.510D0*cs - 2.5766D-03
TransCurveF = 3.0254D0*cs**4 - 6.3664D0*cs**3 + 3.1371D0*cs**2 + 1.213D0*cs - 1.3667D-03
TransCurveG = 3.2292D0*cs**4 - 6.844D0*cs**3 + 3.5351D0*cs**2 + 1.0881D0*cs - 2.8905D-03
TransCurveH = 3.3341D0*cs**4 - 7.1306D0*cs**3 + 3.8287D0*cs**2 + 9.7663D-01*cs - 2.9521D-03
TransCurveI = 3.1464D0*cs**4 - 6.8549D0*cs**3 + 3.9311D0*cs**2 + 7.85950D-01*cs - 2.9344D-03
TransCurveJ = 3.744D0*cs**4 - 8.8364D0*cs**3 + 6.0178D0*cs**2 + 8.4071D-02*cs + 4.825D-04
TransCurveFGHI = (TransCurveF + TransCurveG + TransCurveH + TransCurveI) / 4.0D0
TransCurveFH = (TransCurveF + TransCurveH) / 2.0D0
TransCurveBDCD = (TransCurveB + TransCurveD + TransCurveC + TransCurveD) / 4.0D0
ReflectCurveA = 1.6322D+01*cs**4 - 5.7819D+01*cs**3 + 7.9244D+01*cs**2 - 5.0081D+01*cs + 1.3335D+01
ReflectCurveB = 4.0478D+01*cs**4 - 1.1934D+02*cs**3 + 1.3477D+02*cs**2 - 7.0973D+01*cs + 1.6112D+01
ReflectCurveC = 5.749D+01*cs**4 - 1.6451D+02*cs**3 + 1.780D+02*cs**2 - 8.8748D+01*cs + 1.8839D+01
ReflectCurveD = 5.7139D0*cs**4 - 1.6666D+01*cs**3 + 1.8627D+01*cs**2 - 9.7561D0*cs + 3.0743D0
ReflectCurveE = -5.4884D-01*cs**4 - 6.4976D0*cs**3 + 2.11990D+01*cs**2 - 2.0971D+01*cs + 7.8138D0
ReflectCurveF = 4.2902D0*cs**4 - 1.2671D+01*cs**3 + 1.4656D+01*cs**2 - 8.1534D0*cs + 2.8711D0
ReflectCurveG = 2.174D+01*cs**4 - 6.4436D+01*cs**3 + 7.4893D+01*cs**2 - 4.1792D+01*cs + 1.0624D+01
ReflectCurveH = 4.3405D0*cs**4 - 1.280D+01*cs**3 + 1.4777D+01*cs**2 - 8.2034D0*cs + 2.8793D0
ReflectCurveI = 4.1357D+01*cs**4 - 1.1775D+02*cs**3 + 1.2756D+02*cs**2 - 6.4373D+01*cs + 1.426D+01
ReflectCurveJ = 4.4901D0*cs**4 - 1.2658D+01*cs**3 + 1.3969D+01*cs**2 - 7.501D0 *cs + 2.6928D0
ReflectCurveFGHI = (ReflectCurveF + ReflectCurveG + ReflectCurveH + ReflectCurveI) / 4.0D0
ReflectCurveFH = (ReflectCurveF + ReflectCurveH) / 2.0D0
ReflectCurveBDCD = (ReflectCurveB + ReflectCurveD + ReflectCurveC + ReflectCurveD) / 4.0D0
If (SimpleGlazingU < 1.4195D0) THEN ! cell 1, 2, or 3
IF (SimpleGlazingSHGC > 0.45D0) THEN
! cell # 1
! Curve E
TransTmp = TransCurveE
ReflectTmp = ReflectCurveE
ELSEIF ((0.35D0 <= SimpleGlazingSHGC) .AND. (SimpleGlazingSHGC <= 0.45D0)) THEN
! cell # 2
! 2 way interpolation between Curve E and Curve J
TransTmp = InterpolateBetweenTwoValues(SimpleGlazingSHGC, 0.35D0, 0.45D0, TransCurveJ, TransCurveE)
ReflectTmp = InterpolateBetweenTwoValues(SimpleGlazingSHGC, 0.35D0, 0.45D0, ReflectCurveJ, ReflectCurveE)
ELSEIF (SimpleGlazingSHGC < 0.35d0) THEN
! cell # 3
! Curve J
TransTmp = TransCurveJ
ReflectTmp = ReflectCurveJ
ENDIF
ELSEIF ((1.4195D0 <= SimpleGlazingU) .AND. (SimpleGlazingU <= 1.7034D0)) THEN ! cell 4, 5 , 6, 7, 8, 9, or 10
IF (SimpleGlazingSHGC > 0.55D0) THEN
! cell # 4
! Curve E
TransTmp = TransCurveE
ReflectTmp = ReflectCurveE
ELSEIF ((0.5D0 < SimpleGlazingSHGC) .AND. (SimpleGlazingSHGC <= 0.55D0)) THEN
! cell # 5
! 4 way interpolation between Curve E , Curve E, Curve E and Curve FGHI
TransTmp = InterpolateBetweenFourValues(SimpleGlazingU, SimpleGlazingSHGC, &
1.4195D0, 1.7034D0 , 0.50D0, 0.55D0, &
TransCurveE, TransCurveE, TransCurveFGHI, TransCurveE)
ReflectTmp = InterpolateBetweenFourValues(SimpleGlazingU, SimpleGlazingSHGC, &
1.4195D0, 1.7034D0, 0.50D0, 0.55D0, &
ReflectCurveE, ReflectCurveE, ReflectCurveFGHI, ReflectCurveE)
ELSEIF ((0.45D0 < SimpleGlazingSHGC) .AND. (SimpleGlazingSHGC <= 0.5D0)) THEN
! cell # 6
! 2 way interpolation between Curve E and Curve FGHI
TransTmp = InterpolateBetweenTwoValues(SimpleGlazingU, 1.4195D0, 1.7034D0, TransCurveE, TransCurveFGHI)
ReflectTmp = InterpolateBetweenTwoValues(SimpleGlazingU, 1.4195D0, 1.7034D0, ReflectCurveE, ReflectCurveFGHI)
ELSEIF ((0.35D0 < SimpleGlazingSHGC) .AND. (SimpleGlazingSHGC <= 0.45D0)) THEN
! cell # 7
! 4 way interpolation between Curve E , Curve FGHI, Curve J and Curve FGHI
TransTmp = InterpolateBetweenFourValues(SimpleGlazingU, SimpleGlazingSHGC, &
1.4195D0, 1.7034D0, 0.35D0, 0.45D0, &
TransCurveJ, TransCurveE, TransCurveFGHI, TransCurveFGHI)
ReflectTmp = InterpolateBetweenFourValues(SimpleGlazingU, SimpleGlazingSHGC, &
1.4195D0, 1.7034D0, 0.35D0, 0.45D0, &
ReflectCurveJ, ReflectCurveE, ReflectCurveFGHI, ReflectCurveFGHI)
ELSEIF ((0.3D0 < SimpleGlazingSHGC) .AND. (SimpleGlazingSHGC <= 0.35D0)) THEN
! cell # 8
! 2 way interpolation between Curve J and Curve FGHI
TransTmp = InterpolateBetweenTwoValues(SimpleGlazingU, 1.4195D0, 1.7034D0, TransCurveJ, TransCurveFGHI)
ReflectTmp = InterpolateBetweenTwoValues(SimpleGlazingU, 1.4195D0, 1.7034D0, ReflectCurveJ, ReflectCurveFGHI)
ELSEIF ((0.25D0 < SimpleGlazingSHGC) .AND. (SimpleGlazingSHGC <= 0.3D0)) THEN
! cell # 9
! 4 way interpolation between Curve J, Curve FGHI, Curve J and Curve FH
TransTmp = InterpolateBetweenFourValues(SimpleGlazingU, SimpleGlazingSHGC, &
1.4195D0, 1.7034D0, 0.25D0, 0.3D0, &
TransCurveJ, TransCurveJ, TransCurveFH, TransCurveFGHI)
ReflectTmp = InterpolateBetweenFourValues(SimpleGlazingU, SimpleGlazingSHGC, &
1.4195D0, 1.7034D0, 0.25D0, 0.3D0, &
ReflectCurveJ, ReflectCurveJ, ReflectCurveFH, ReflectCurveFGHI)
ELSEIF (SimpleGlazingSHGC <= 0.25D0) THEN
! cell # 10
! 2 way interpolation between Curve J and Curve FH
TransTmp = InterpolateBetweenTwoValues(SimpleGlazingU, 1.4195D0, 1.7034D0, TransCurveJ, TransCurveFH)
ReflectTmp = InterpolateBetweenTwoValues(SimpleGlazingU, 1.4195D0, 1.7034D0, ReflectCurveJ, ReflectCurveFH)
ENDIF
ELSEIF ((1.7034D0 < SimpleGlazingU) .AND. (SimpleGlazingU < 3.4068D0)) THEN ! cell 11, 12, 13, 14, or 15
IF (SimpleGlazingSHGC > 0.55D0) THEN
! cell # 11
! Curve E
TransTmp = TransCurveE
ReflectTmp = ReflectCurveE
ELSEIF ((0.5D0 <= SimpleGlazingSHGC) .AND. (SimpleGlazingSHGC <= 0.55D0)) THEN
! cell # 12
! 2 way interpolation between Curve E and Curve FGHI
TransTmp = InterpolateBetweenTwoValues(SimpleGlazingSHGC, 0.5D0, 0.55D0, TransCurveFGHI, TransCurveE)
ReflectTmp = InterpolateBetweenTwoValues(SimpleGlazingSHGC, 0.5D0, 0.55D0, ReflectCurveFGHI, ReflectCurveE)
ELSEIF ((0.3D0 < SimpleGlazingSHGC) .AND. (SimpleGlazingSHGC < 0.5D0)) THEN
! cell # 13
! Curve FGHI
TransTmp = TransCurveFGHI
ReflectTmp = ReflectCurveFGHI
ELSEIF ((0.25D0 <= SimpleGlazingSHGC) .AND. (SimpleGlazingSHGC <= 0.3D0)) THEN
! cell # 14
! 2 way interpolation between Curve FGHI and Curve FH
TransTmp = InterpolateBetweenTwoValues(SimpleGlazingSHGC, 0.25D0, 0.30D0, TransCurveFH, TransCurveFGHI)
ReflectTmp = InterpolateBetweenTwoValues(SimpleGlazingSHGC, 0.25D0, 0.30D0, ReflectCurveFH, ReflectCurveFGHI)
ELSEIF (SimpleGlazingSHGC < 0.25D0) THEN
! cell # 15
!Curve FH
TransTmp = TransCurveFH
ReflectTmp = ReflectCurveFH
ENDIF
ELSEIF ((3.4068D0 <= SimpleGlazingU) .AND. (SimpleGlazingU <= 4.5424D0)) THEN ! cell 16, 17, 18, 19, 20, 21, 22, or 23
IF (SimpleGlazingSHGC > 0.65D0) THEN
! cell # 16
! 2 way interpolation between Curve E and Curve A
TransTmp = InterpolateBetweenTwoValues(SimpleGlazingU, 3.4068D0, 4.5424D0, TransCurveE, TransCurveA)
ReflectTmp = InterpolateBetweenTwoValues(SimpleGlazingU, 3.4068D0, 4.5424D0, ReflectCurveE, ReflectCurveA)
ELSEIF ((0.6D0 < SimpleGlazingSHGC) .AND. (SimpleGlazingSHGC <= 0.65D0)) THEN
! cell # 17
! 4 way interpolation between Curve E , Curve E, Curve A, and Curve BDCD
TransTmp = InterpolateBetweenFourValues(SimpleGlazingU, SimpleGlazingSHGC, &
3.4068D0, 4.5424D0, 0.6D0, 0.65D0, &
TransCurveE, TransCurveE, TransCurveBDCD, TransCurveA)
ReflectTmp = InterpolateBetweenFourValues(SimpleGlazingU, SimpleGlazingSHGC, &
3.4068D0, 4.5424D0, 0.6D0, 0.65D0, &
ReflectCurveE, ReflectCurveE, ReflectCurveBDCD, ReflectCurveA)
ELSEIF ((0.55D0 < SimpleGlazingSHGC) .AND. (SimpleGlazingSHGC <= 0.6D0)) THEN
! cell # 18
! 2 way interpolation between Curve E and Curve BDCD
TransTmp = InterpolateBetweenTwoValues(SimpleGlazingU, 3.4068D0, 4.5424D0, TransCurveE, TransCurveBDCD)
ReflectTmp = InterpolateBetweenTwoValues(SimpleGlazingU, 3.4068D0, 4.5424D0, ReflectCurveE, ReflectCurveBDCD)
ELSEIF ((0.5D0 < SimpleGlazingSHGC) .AND. (SimpleGlazingSHGC <= 0.55D0)) THEN
! cell # 19
! 4 way interpolation between Curve E , Curve FGHI, Curve BDCD and Curve BDCD
TransTmp = InterpolateBetweenFourValues(SimpleGlazingU, SimpleGlazingSHGC, &
3.4068D0, 4.5424D0, 0.5D0, 0.55D0, &
TransCurveFGHI, TransCurveE, TransCurveBDCD, TransCurveBDCD)
ReflectTmp = InterpolateBetweenFourValues(SimpleGlazingU, SimpleGlazingSHGC, &
3.4068D0, 4.5424D0, 0.5D0, 0.55D0, &
ReflectCurveFGHI, ReflectCurveE, ReflectCurveBDCD, ReflectCurveBDCD)
ELSEIF ((0.45D0 < SimpleGlazingSHGC) .AND. (SimpleGlazingSHGC <= 0.5D0)) THEN
! cell # 20
! 2 way interpolation between Curve FGHI and Curve BDCD
TransTmp = InterpolateBetweenTwoValues(SimpleGlazingU, 3.4068D0, 4.5424D0, TransCurveFGHI, TransCurveBDCD)
ReflectTmp = InterpolateBetweenTwoValues(SimpleGlazingU, 3.4068D0, 4.5424D0, ReflectCurveFGHI, ReflectCurveBDCD)
ELSEIF ((0.3D0 < SimpleGlazingSHGC) .AND. (SimpleGlazingSHGC <= 0.45D0)) THEN
! cell # 21
! 4 way interpolation between Curve FGHI, Curve FGHI, Curve BDCD, and Curve D
TransTmp = InterpolateBetweenFourValues(SimpleGlazingU, SimpleGlazingSHGC, &
3.4068D0, 4.5424D0, 0.3D0, 0.45D0, &
TransCurveFGHI, TransCurveFGHI, TransCurveD, TransCurveBDCD)
ReflectTmp = InterpolateBetweenFourValues(SimpleGlazingU, SimpleGlazingSHGC, &
3.4068D0, 4.5424D0, 0.3D0, 0.45D0, &
ReflectCurveFGHI, ReflectCurveFGHI, ReflectCurveD, ReflectCurveBDCD)
ELSEIF ((0.25D0 < SimpleGlazingSHGC) .AND. (SimpleGlazingSHGC <= 0.3D0)) THEN
! cell # 22
! 4 way interpolation between Curve FGHI, Curve FH, Curve D, and Curve D
TransTmp = InterpolateBetweenFourValues(SimpleGlazingU, SimpleGlazingSHGC, &
3.4068D0, 4.5424D0, 0.25D0, 0.3D0, &
TransCurveFH, TransCurveFGHI, TransCurveD, TransCurveD)
ReflectTmp = InterpolateBetweenFourValues(SimpleGlazingU, SimpleGlazingSHGC, &
3.4068D0, 4.5424D0, 0.25D0, 0.3D0, &
ReflectCurveFH, ReflectCurveFGHI, ReflectCurveD, ReflectCurveD)
ELSEIF (SimpleGlazingSHGC <= 0.25D0) THEN
! cell # 23
! 2 way interpolation between Curve FH and Curve D
TransTmp = InterpolateBetweenTwoValues(SimpleGlazingU, 3.4068D0, 4.5424D0, TransCurveFH, TransCurveD)
ReflectTmp = InterpolateBetweenTwoValues(SimpleGlazingU, 3.4068D0, 4.5424D0, ReflectCurveFH, ReflectCurveD)
ENDIF
ELSEIF (SimpleGlazingU > 4.5424D0) THEN ! cell 24, 25, 26, 27, or 28
IF (SimpleGlazingSHGC > 0.65D0) THEN
! cell # 24
! Curve A
TransTmp = TransCurveA
ReflectTmp = ReflectCurveA
ELSEIF ((0.6D0 <= SimpleGlazingSHGC) .AND. (SimpleGlazingSHGC <= 0.65D0)) THEN
! cell # 25
! 2 way interpolation between Curve A and Curve BDCD
TransTmp = InterpolateBetweenTwoValues(SimpleGlazingSHGC, 0.6D0, 0.65D0, TransCurveBDCD, TransCurveA)
ReflectTmp = InterpolateBetweenTwoValues(SimpleGlazingSHGC, 0.6D0, 0.65D0, ReflectCurveBDCD, ReflectCurveA)
ELSEIF ((0.45D0 < SimpleGlazingSHGC) .AND. (SimpleGlazingSHGC < 0.6D0)) THEN
! cell # 26
! Curve BDCD
TransTmp = TransCurveBDCD
ReflectTmp = ReflectCurveBDCD
ELSEIF ((0.3D0 <= SimpleGlazingSHGC) .AND. (SimpleGlazingSHGC <= 0.45D0)) THEN
! cell # 27
! 2 way interpolation between Curve BDCD and Curve D
TransTmp = InterpolateBetweenTwoValues(SimpleGlazingSHGC, 0.3D0, 0.45D0, TransCurveD, TransCurveBDCD)
ReflectTmp = InterpolateBetweenTwoValues(SimpleGlazingSHGC, 0.3D0, 0.45D0, ReflectCurveD, ReflectCurveBDCD)
ELSEIF (SimpleGlazingSHGC < 0.3D0) THEN
! cell # 28
! Curve D
TransTmp = TransCurveD
ReflectTmp = ReflectCurveD
ENDIF
ENDIF
IF ( cs == 1.0D0) Then ! at 0 deg incident, TransTmp should be 1.0
TransTmp = 1.0D0
ENDIF
! now apply normalization factors to zero incidence angle properties
tfp = tf0 * TransTmp
IF (tfp < 0.0D0) tfp = 0.0D0
IF (tfp > 1.0D0) tfp = 1.0D0
rfp = rf0 * ReflectTmp
IF (rfp < 0.0D0) rfp = 0.0D0
IF (rfp > 1.0D0) rfp = 1.0D0
rbp = rb0 * ReflectTmp
IF (rbp < 0.0D0) rbp = 0.0D0
IF (rbp > 1.0D0) rbp = 1.0D0
IF ( cs == 0.0D0 ) THEN ! at 90 degree incident, reflectance should be 1.0
rfp = 1.0D0
rbp = 1.0D0
ENDIF
! older model, was in Version 3.1
! IncidenceAngle = ACOS(cs)
! CoefFuncSHGC = 0.768d0 +0.817d0*SimpleGlazingSHGC**4
!
! tfp = tf0 * cs * (1 + CoefFuncSHGC*(Sin(IncidenceAngle)**3))
!
! f1 = (((2.403d0*cs - 6.192d0)*cs + 5.625d0)*cs - 2.095d0) * cs + 1
! f2 = (((-1.188d0* cs + 2.022d0)* cs + 0.137d0) * cs - 1.71d0) * cs
! Rfit_o = 0.7413d0 - (0.7396d0 * SQRT(SimpleGlazingSHGC))
!
! rfp = rf0 * (f1 + f2*SQRT(SimpleGlazingSHGC))/Rfit_o
! rbp = rfp ! uncoated assumption, back equal front
RETURN
ENDIF
IF (tf0 .LE. 0.0d0) THEN
! This is an opaque window. For all angles, set transmittance to 0; set reflectance to that at zero incidence angle.
tfp = 0.0d0
rfp = rf0
rbp = rb0
ELSE
betaf = tf0**2 - rf0**2 + 2.0d0*rf0 + 1.0d0
betab = tf0**2 - rb0**2 + 2.0d0*rb0 + 1.0d0
r0f = (betaf-sqrt(betaf**2-4.0d0*(2.0d0-rf0)*rf0))/(2.0d0*(2.0d0-rf0))
r0b = (betab-sqrt(betab**2-4.0d0*(2.0d0-rb0)*rb0))/(2.0d0*(2.0d0-rb0))
tmp1=abs(r0f-r0b)
if (tmp1 /= 0.0d0) then
testval=abs(r0f-r0b)/(r0f+r0b)
else
testval=0.0d0
endif
IF (testval.LT.0.001d0) THEN ! CR8830, CR8942, implications of relaxation of glazing properties CR8413
! UNCOATED GLASS
tmp1=r0f*tf0
if (tmp1 /= 0.0d0) then
abf=log(tmp1/(rf0-r0f))
else
abf=0.0d0
endif
tmp2=r0b*tf0
if (tmp2 /= 0.0d0) then
abb=log(tmp2/(rb0-r0b))
else
abb = 0.0d0
endif
ngf = (1.0d0+sqrt(r0f))/(1.0d0-sqrt(r0f))
ngb = (1.0d0+sqrt(r0b))/(1.0d0-sqrt(r0b))
cgf = sqrt(1.0d0-(1.0d0-cs*cs)/(ngf**2))
cgb = sqrt(1.0d0-(1.0d0-cs*cs)/(ngb**2))
tmp3=ngf*cs-cgf
if (tmp3 /= 0.0d0) then
rpf1 = (tmp3/(ngf*cs+cgf))**2
else
rpf1 = 0.0d0
endif
tmp4=ngf*cgf-cs
if (tmp4 /= 0.0d0) then
rpf2 = (tmp4/(ngf*cgf+cs))**2
else
rpf2=0.0d0
endif
tpf1 = 1 - rpf1
tpf2 = 1 - rpf2
tmp5=ngb*cs-cgb
if (tmp5 /= 0.0d0) then
rpb1 = (tmp5/(ngb*cs+cgb))**2
else
rpb1 = 0.0d0
endif
tmp6=ngb*cgb-cs
if (tmp6 /= 0.0d0) then
rpb2 = (tmp6/(ngb*cgb+cs))**2
else
rpb2 = 0.0d0
endif
tpb1 = 1 - rpf1
tpb2 = 1 - rpf2
tmp7=-abf
if (tmp7 /= 0.0d0) THEN
expmabfdivcgf=exp(tmp7/cgf)
else
expmabfdivcgf=0.0d0
endif
tmp8=-2.0d0*abf
if (tmp8 /= 0.0d0) then
expm2abfdivcgf=exp(tmp8/cgf)
else
expm2abfdivcgf=0.0d0
endif
if (tpf1 /= 0.0d0) then
tfp1 = tpf1**2*expmabfdivcgf/(1.0d0-rpf1**2*expm2abfdivcgf)
else
tfp1 = 0.0d0
endif
rfp1 = rpf1*(1.0d0+tfp1*expmabfdivcgf)
if (tpf2 /= 0.0d0) then
tfp2 = tpf2**2*expmabfdivcgf/(1.0d0-rpf2**2*expm2abfdivcgf)
else
tfp2 = 0.0d0
endif
rfp2 = rpf2*(1.0d0+tfp2*expmabfdivcgf)
tfp = 0.5d0*(tfp1+tfp2)
rfp = 0.5d0*(rfp1+rfp2)
tmp9=-abb
if (tmp9 /= 0.0d0) then
expmabbdivcgb=exp((tmp9/cgb))
else
expmabbdivcgb=0.0d0
endif
rbp1 = rpb1*(1.0d0+tfp1*expmabbdivcgb)
rbp2 = rpb2*(1.0d0+tfp2*expmabbdivcgb)
rbp = 0.5d0*(rbp1+rbp2)
ELSE
! COATED GLASS
IF (tf0.GT.0.645d0) THEN
! Use clear glass angular distribution.
! Normalized clear glass transmittance and reflectance distribution
IF(cs > 0.999d0) THEN ! Angle of incidence = 0 deg
tcl = 1.0d0
rcl = 0.0d0
ELSE IF(cs < 0.001d0) THEN ! Angle of incidence = 90 deg
tcl = 0.0d0
rcl = 1.0d0
ELSE
tcl = -0.0015d0 + ( 3.355d0+(-3.840d0+( 1.460d0 +0.0288d0*cs)*cs)*cs)*cs
rcl = 0.999d0 + (-0.563d0+( 2.043d0+(-2.532d0 +1.054d0 *cs)*cs)*cs)*cs-tcl
END IF
tfp = tf0*tcl
rfp = rf0*(1.0d0-rcl)+rcl
rbp = rb0*(1.0d0-rcl)+rcl
ELSE
! Use bronze glass angular distribution.
! Normalized bronze tinted glass transmittance and reflectance distribution
IF(cs > 0.999d0) THEN ! Angle of incidence = 0 deg
tbnz = 1.0d0
rbnz = 0.0d0
ELSE IF(cs < 0.001d0) THEN ! Angle of incidence = 90 deg
tbnz = 0.0d0
rbnz = 1.0d0
ELSE
tbnz = -0.002d0 + ( 2.813d0+(-2.341d0+(-0.05725d0+0.599d0 *cs)*cs)*cs)*cs
rbnz = 0.997d0 + (-1.868d0+( 6.513d0+(-7.862d0 +3.225d0 *cs)*cs)*cs)*cs-tbnz
END IF
tfp = tf0*tbnz
rfp = rf0*(1.d0-rbnz)+rbnz
rbp = rb0*(1.d0-rbnz)+rbnz
END IF
END IF
END IF
RETURN
END SUBROUTINE TransAndReflAtPhi