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 | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | SurfaceNum | |||
real(kind=r64), | intent(in), | optional | :: | Phi | ||
real(kind=r64), | intent(in), | optional | :: | Theta | ||
integer, | intent(in), | optional | :: | ScreenNumber |
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 CalcScreenTransmittance(SurfaceNum, Phi, Theta, ScreenNumber)
! FUNCTION INFORMATION:
! AUTHOR Richard Raustad
! DATE WRITTEN May 2006
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS FUNCTION:
! Calculate transmittance of window screen given azimuth and altitude angle
! of sun and surface orientation.
! METHODOLOGY EMPLOYED:
! Window screen solar beam transmittance varies as the sun moves across the sky
! due to the geometry of the screen material and the angle of incidence
! of the solar beam. Azimuth and altitude angle are calculated with respect
! to the surface outward normal. Solar beam reflectance and absorptance are also
! accounted for.
! CALLs to CalcScreenTransmittance are primarily based on surface index. A typical call is:
! CALL CalcScreenTransmittance(SurfaceNum)
! Since a single Material:WindowScreen object may be used for multiple windows, the
! screen's direct beam properties are calculated for the screen material attached to this surface.
! If a single Material:WindowScreen object is used for 3 windows then SurfaceScreens(3) is allocated.
! CALLs to CalcScreenTransmittance may be done by using the optional arguments as follows:
! CALLs to CalcScreenTransmittance at normal incidence are:
!
! CALL with a screen number and relative azimuth and altitude angles
! CALL CalcScreenTransmittance(0, Phi=0.0, Theta=0.0, ScreenNumber=ScNum)
! -OR-
! CALL same as above using the material structure
! CALL CalcScreenTransmittance(0, Phi=0.0, Theta=0.0, ScreenNumber=Material(MatShade)%ScreenDataPtr)
! -OR-
! CALL with the surface number and relative azimuth and altitude angles
! CALL CalcScreenTransmittance(SurfaceNum, Phi=0.0, Theta=0.0)
! CALL's passing the screen number without the relative azimuth and altitude angles is not allowed
! CALL CalcScreenTransmittance(0, ScreenNumber=ScNum) ! DO NOT use this syntax
! REFERENCES:
! na
! USE STATEMENTS:
USE DataGlobals, ONLY: Pi, PiOvr2, DegToRadians
USE DataInterfaces, ONLY: ShowFatalError
USE DataSurfaces, ONLY: Surface, SurfaceWindow, DoNotModel, ModelAsDiffuse, ModelAsDirectBeam
USE DataEnvironment, ONLY: SOLCOS
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! FUNCTION ARGUMENT DEFINITIONS:
INTEGER, INTENT (IN) :: SurfaceNum
! The optional arguments Phi and Theta are used to integrate over a hemisphere and are passed as pairs
REAL(r64), INTENT (IN), OPTIONAL :: Phi ! Optional sun altitude relative to surface outward normal (radians)
REAL(r64), INTENT (IN), OPTIONAL :: Theta ! Optional sun azimuth relative to surface outward normal (radians)
! The optional argument ScreenNumber is used during CalcWindowScreenProperties to integrate over a quarter hemispere
! "before" the surface # is known. Theta and Phi can be passed without ScreenNumber, but DO NOT pass ScreenNumber
! without Theta and Phi.
INTEGER, INTENT (IN), OPTIONAL :: ScreenNumber ! Optional screen number
! FUNCTION PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: small = 1.D-9 !Small Number used to approximate zero
! FUNCTION PARAMETER DEFINITIONS:
INTEGER:: ScNum ! Index to screen data
REAL(r64) :: Tdirect ! Beam solar transmitted through screen (dependent on sun angle)
REAL(r64) :: Tscattered ! Beam solar reflected through screen (dependent on sun angle)
REAL(r64) :: TscatteredVis ! Visible beam solar reflected through screen (dependent on sun angle)
REAL(r64) :: SunAzimuth ! Solar azimuth angle from north (rad)
REAL(r64) :: SunAltitude ! Solar altitude angle from horizon (rad)
REAL(r64) :: SurfaceAzimuth ! Surface azimuth angle from north (rad)
REAL(r64) :: SurfaceTilt ! Surface tilt angle from vertical (rad)
REAL(r64) :: SunAzimuthToScreenNormal ! Relative solar azimuth (sun angle from screen normal, 0 to PiOvr2, rad)
REAL(r64) :: SunAltitudeToScreenNormal ! Relative solar altitude (sun angle from screen normal, -PiOvr2 to PiOvr2, rad)
REAL(r64) :: Beta ! Compliment of relative solar azimuth (rad)
REAL(r64) :: TransXDir ! Horizontal component of direct beam transmittance
REAL(r64) :: TransYDir ! Vertical component of direct beam transmittance
REAL(r64) :: Delta ! Intermediate variable used for Tscatter calculation (deg)
REAL(r64) :: DeltaMax ! Intermediate variable used for Tscatter calculation (deg)
REAL(r64) :: Tscattermax ! Maximum solar beam scattered transmittance
REAL(r64) :: TscattermaxVis ! Maximum visible beam scattered transmittance
REAL(r64) :: ExponentInterior ! Exponent used in scattered transmittance calculation
! when Delta < DeltaMax (0,0 to peak)
REAL(r64) :: ExponentExterior ! Exponent used in scattered transmittance calculation
! when Delta > DeltaMax (peak to max)
REAL(r64) :: AlphaDblPrime, COSMu, Epsilon, Eta, MuPrime, Gamma ! Intermediate variables (used in Eng. Doc.)
REAL(r64) :: NormalAltitude ! Actual altitude angle of sun wrt surface outward normal (rad)
REAL(r64) :: NormalAzimuth ! Actual azimuth angle of sun wrt surface outward normal (rad)
REAL(r64) :: IncidentAngle ! Solar angle wrt surface outward normal to determine
! if sun is in front of screen (rad)
REAL(r64) :: PeakToPlateauRatio ! Ratio of peak scattering to plateau at 0,0 incident angle
REAL(r64) :: PeakToPlateauRatioVis ! Ratio of peak visible scattering to plateau at 0,0 incident angle
REAL(r64) :: ReflectCyl ! Screen material reflectance
REAL(r64) :: ReflectCylVis ! Screen material visible reflectance
! SurfaceScreens structure may be accessed using either the surface or screen index
! The screen index is based on the number of Surface:HeatTransfer:Sub objects using any Material:WindowScreen object
IF (PRESENT(ScreenNumber))THEN
ScNum = ScreenNumber
IF (.NOT. PRESENT(Theta) .OR. .NOT. PRESENT(Phi))THEN
CALL ShowFatalError('Syntax error, optional arguments Theta and Phi must be present when optional ScreenNumber is used.')
END IF
ELSE
ScNum = SurfaceWindow(SurfaceNum)%ScreenNumber
END IF
IF (PRESENT(Theta)) THEN
SunAzimuthToScreenNormal = ABS(Theta)
IF(SunAzimuthToScreenNormal .GT. Pi) THEN
SunAzimuthToScreenNormal = 0.0d0
ELSE
IF(SunAzimuthToScreenNormal .GT. PiOvr2) THEN
SunAzimuthToScreenNormal = Pi - SunAzimuthToScreenNormal
END IF
END IF
NormalAzimuth = SunAzimuthToScreenNormal
ELSE
SunAzimuth = ATAN2(SOLCOS(1),SOLCOS(2))
IF(SunAzimuth .LT. 0.0d0)SunAzimuth = 2.d0*Pi + SunAzimuth
SurfaceAzimuth = Surface(SurfaceNum)%Azimuth * DegToRadians
NormalAzimuth = SunAzimuth-SurfaceAzimuth
! Calculate the transmittance whether sun is in front of or behind screen, place result in BmBmTrans or BmBmTransBack
IF(ABS(SunAzimuth-SurfaceAzimuth) .GT. PiOvr2) THEN
SunAzimuthToScreenNormal = ABS(SunAzimuth-SurfaceAzimuth) - PiOvr2
ELSE
SunAzimuthToScreenNormal = ABS(SunAzimuth-SurfaceAzimuth)
END IF
END IF
IF (PRESENT(Phi)) THEN
SunAltitudeToScreenNormal = ABS(Phi)
IF(SunAltitudeToScreenNormal .GT. PiOvr2)THEN
SunAltitudeToScreenNormal = Pi - SunAltitudeToScreenNormal
END IF
SunAltitude = SunAltitudeToScreenNormal
ELSE
SunAltitude = (PiOvr2 - ACOS(SOLCOS(3)))
SurfaceTilt = Surface(SurfaceNum)%Tilt * DegToRadians
SunAltitudeToScreenNormal = ABS(SunAltitude+(SurfaceTilt-PiOvr2))
IF(SunAltitudeToScreenNormal .GT. PiOvr2) THEN
SunAltitudeToScreenNormal = SunAltitudeToScreenNormal - PiOvr2
END IF
END IF
IF(SurfaceNum .EQ. 0 .OR. .NOT. PRESENT(ScreenNumber)) THEN
NormalAltitude = SunAltitude
ELSE
NormalAltitude = SunAltitude+(SurfaceTilt-PiOvr2)
END IF
IF(NormalAltitude .NE. 0.0d0 .AND. NormalAzimuth .NE. 0.0d0)THEN
IncidentAngle = ACOS(SIN(NormalAltitude)/ (TAN(NormalAzimuth)*TAN(NormalAltitude)/SIN(NormalAzimuth)))
ELSEIF(NormalAltitude .NE. 0.0d0 .AND. NormalAzimuth .EQ. 0.0d0)THEN
IncidentAngle = NormalAltitude
ELSEIF(NormalAltitude .EQ. 0.0d0 .AND. NormalAzimuth .NE. 0.0d0)THEN
IncidentAngle = NormalAzimuth
ELSE
IncidentAngle = 0.0d0
END IF
! ratio of screen material diameter to screen material spacing
Gamma = SurfaceScreens(ScNum)%ScreenDiameterToSpacingRatio
! ************************************************************************************************
! * calculate transmittance of totally absorbing screen material (beam passing through open area)*
! ************************************************************************************************
! calculate compliment of relative solar azimuth
Beta = PiOvr2 - SunAzimuthToScreenNormal
! Catch all divide by zero instances
IF(Beta .GT. Small)THEN
IF(ABS(SunAltitudeToScreenNormal-PiOvr2) .GT. Small) THEN
AlphaDblPrime = ATAN(TAN(SunAltitudeToScreenNormal)/ &
COS(SunAzimuthToScreenNormal))
TransYDir = 1.0d0 - Gamma*(COS(AlphaDblPrime)+ &
SIN(AlphaDblPrime)* &
TAN(SunAltitudeToScreenNormal)* &
SQRT(1.d0+(1.d0/TAN(Beta))**2))
TransYDir = MAX(0.0d0,TransYDir)
ELSE
TransYDir = 0.0d0
END IF
ELSE
TransYDir = 0.0d0
END IF
COSMu = SQRT(COS(SunAltitudeToScreenNormal)**2 * &
COS(SunAzimuthToScreenNormal)**2 + &
SIN(SunAltitudeToScreenNormal)**2)
IF(CosMu .GT. Small) THEN
Epsilon = ACOS(COS(SunAltitudeToScreenNormal)*COS(SunAzimuthToScreenNormal)/COSMu)
Eta = PiOvr2 - Epsilon
IF(COS(Epsilon) .NE. 0.0d0) THEN
MuPrime = ATAN(TAN(ACOS(COSMu))/COS(Epsilon))
IF(Eta .NE. 0.0d0) THEN
TransXDir = 1.d0 - Gamma*(COS(MuPrime)+SIN(MuPrime)* &
TAN(ACOS(COSMu))* &
SQRT(1.d0+(1.d0/TAN(Eta))**2))
TransXDir = MAX(0.0d0,TransXDir)
ELSE
TransXDir = 0.0d0
END IF
ELSE
TransXDir = 0.0d0
END IF
ELSE
TransXDir = 1.0d0 - Gamma
END IF
Tdirect = MAX(0.0d0, TransXDir * TransYDir)
! *******************************************************************************
! * calculate transmittance of scattered beam due to reflecting screen material *
! *******************************************************************************
ReflectCyl = SurfaceScreens(ScNum)%ReflectCylinder
ReflectCylVis = SurfaceScreens(ScNum)%ReflectCylinderVis
IF(ABS(SunAzimuthToScreenNormal-PiOvr2) .LT. Small .OR. ABS(SunAltitudeToScreenNormal-PiOvr2) .LT. Small)THEN
Tscattered = 0.0d0
TscatteredVis = 0.0d0
ELSE
! DeltaMax and Delta are in degrees
DeltaMax = 89.7d0 - (10.0d0 * Gamma/0.16d0)
Delta = SQRT((SunAzimuthToScreenNormal/DegToRadians)**2 + (SunAltitudeToScreenNormal/DegToRadians)**2)
! Use empirical model to determine maximum (peak) scattering
Tscattermax = 0.0229d0 * Gamma + 0.2971d0 * ReflectCyl &
-0.03624d0 * Gamma**2 + 0.04763d0 * ReflectCyl**2 &
-0.44416d0 * Gamma * ReflectCyl
TscattermaxVis = 0.0229d0 * Gamma + 0.2971d0 * ReflectCylVis &
-0.03624d0 * Gamma**2 + 0.04763d0 * ReflectCylVis**2 &
-0.44416d0 * Gamma * ReflectCylVis
! Vary slope of interior and exterior surface of scattering model
ExponentInterior = (-(ABS(Delta-DeltaMax))**2.0d0)/600.0d0
ExponentExterior = (-(ABS(Delta-DeltaMax))**2.5d0)/600.0d0
! Determine ratio of scattering at 0,0 incident angle to maximum (peak) scattering
PeakToPlateauRatio = 1.0d0/(0.2d0 * (1-Gamma) * ReflectCyl)
PeakToPlateauRatioVis = 1.0d0/(0.2d0 * (1-Gamma) * ReflectCylVis)
IF(Delta .GT. DeltaMax)THEN
! Apply offset for plateau and use exterior exponential function to simulate actual scattering as a function of solar angles
Tscattered = 0.2d0 * (1.d0-Gamma) * ReflectCyl * Tscattermax * &
(1.0d0 + (PeakToPlateauRatio-1.0d0)*EXP(ExponentExterior))
TscatteredVis = 0.2d0 * (1.d0-Gamma) * ReflectCylVis * TscattermaxVis * &
(1.0d0 + (PeakToPlateauRatioVis-1.0d0)*EXP(ExponentExterior))
! Trim off offset if solar angle (delta) is greater than maximum (peak) scattering angle
Tscattered = Tscattered -(0.2d0 * (1.d0-Gamma) * ReflectCyl * Tscattermax) * &
MAX(0.0d0,(Delta-DeltaMax)/(90.0d0-DeltaMax))
TscatteredVis = TscatteredVis -(0.2d0 * (1.d0-Gamma) * ReflectCylVis * TscattermaxVis) * &
MAX(0.0d0,(Delta-DeltaMax)/(90.0d0-DeltaMax))
ELSE
! Apply offset for plateau and use interior exponential function to simulate actual scattering as a function of solar angles
Tscattered = 0.2d0 * (1.d0-Gamma) * ReflectCyl * Tscattermax * &
(1.0d0 + (PeakToPlateauRatio-1.0d0)*EXP(ExponentInterior))
TscatteredVis = 0.2d0 * (1.d0-Gamma) * ReflectCylVis * TscattermaxVis * &
(1.0d0 + (PeakToPlateauRatioVis-1.0d0)*EXP(ExponentInterior))
END IF
END IF
Tscattered = MAX(0.0d0,Tscattered)
TscatteredVis = MAX(0.0d0,TscatteredVis)
IF(SurfaceScreens(ScNum)%ScreenBeamReflectanceAccounting == DoNotModel)THEN
IF(ABS(IncidentAngle) .LE. PiOvr2)THEN
SurfaceScreens(ScNum)%BmBmTrans = Tdirect
SurfaceScreens(ScNum)%BmBmTransVis = Tdirect
SurfaceScreens(ScNum)%BmBmTransBack = 0.0d0
ELSE
SurfaceScreens(ScNum)%BmBmTrans = 0.0d0
SurfaceScreens(ScNum)%BmBmTransVis = 0.0d0
SurfaceScreens(ScNum)%BmBmTransBack = Tdirect
END IF
Tscattered = 0.0d0
TscatteredVis = 0.0d0
ELSE IF(SurfaceScreens(ScNum)%ScreenBeamReflectanceAccounting == ModelAsDirectBeam)THEN
IF(ABS(IncidentAngle) .LE. PiOvr2)THEN
SurfaceScreens(ScNum)%BmBmTrans = Tdirect + Tscattered
SurfaceScreens(ScNum)%BmBmTransVis = Tdirect + TscatteredVis
SurfaceScreens(ScNum)%BmBmTransBack = 0.0d0
ELSE
SurfaceScreens(ScNum)%BmBmTrans = 0.0d0
SurfaceScreens(ScNum)%BmBmTransVis = 0.0d0
SurfaceScreens(ScNum)%BmBmTransBack = Tdirect + Tscattered
END IF
Tscattered = 0.0d0
TscatteredVis = 0.0d0
ELSE IF(SurfaceScreens(ScNum)%ScreenBeamReflectanceAccounting == ModelAsDiffuse)THEN
IF(ABS(IncidentAngle) .LE. PiOvr2)THEN
SurfaceScreens(ScNum)%BmBmTrans = Tdirect
SurfaceScreens(ScNum)%BmBmTransVis = Tdirect
SurfaceScreens(ScNum)%BmBmTransBack = 0.0d0
ELSE
SurfaceScreens(ScNum)%BmBmTrans = 0.0d0
SurfaceScreens(ScNum)%BmBmTransVis = 0.0d0
SurfaceScreens(ScNum)%BmBmTransBack = Tdirect
END IF
END IF
IF(ABS(IncidentAngle) .LE. PiOvr2)THEN
SurfaceScreens(ScNum)%BmDifTrans = Tscattered
SurfaceScreens(ScNum)%BmDifTransVis = TscatteredVis
SurfaceScreens(ScNum)%BmDifTransBack = 0.0d0
SurfaceScreens(ScNum)%ReflectSolBeamFront = MAX(0.0d0,ReflectCyl*(1.d0- Tdirect)-Tscattered)
SurfaceScreens(ScNum)%ReflectVisBeamFront = MAX(0.0d0,ReflectCylVis*(1.d0- Tdirect)-TscatteredVis)
SurfaceScreens(ScNum)%AbsorpSolarBeamFront = MAX(0.0d0,(1.0d0-Tdirect)*(1.0d0-ReflectCyl))
SurfaceScreens(ScNum)%ReflectSolBeamBack = 0.0d0
SurfaceScreens(ScNum)%ReflectVisBeamBack = 0.0d0
SurfaceScreens(ScNum)%AbsorpSolarBeamBack = 0.0d0
ELSE
SurfaceScreens(ScNum)%BmDifTrans = 0.0d0
SurfaceScreens(ScNum)%BmDifTransVis = 0.0d0
SurfaceScreens(ScNum)%BmDifTransBack = Tscattered
SurfaceScreens(ScNum)%ReflectSolBeamBack = MAX(0.0d0,ReflectCyl*(1.d0- Tdirect)-Tscattered)
SurfaceScreens(ScNum)%ReflectVisBeamBack = MAX(0.0d0,ReflectCylVis*(1.d0- Tdirect)-TscatteredVis)
SurfaceScreens(ScNum)%AbsorpSolarBeamBack = MAX(0.0d0,(1.0d0-Tdirect)*(1.0d0-ReflectCyl))
SurfaceScreens(ScNum)%ReflectSolBeamFront = 0.0d0
SurfaceScreens(ScNum)%ReflectVisBeamFront = 0.0d0
SurfaceScreens(ScNum)%AbsorpSolarBeamFront = 0.0d0
END IF
RETURN
END SUBROUTINE CalcScreenTransmittance