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.
SUBROUTINE CalcWindowBlindProperties
! SUBROUTINE INFORMATION:
! AUTHOR Hans Simmler
! DATE WRITTEN July-Aug 1995
! MODIFIED Aug 2001 (FCW): adapt to EnergyPlus
! Dec 2001 (FCW): add variable slat angle
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculates solar-optical properties of a window blind
! from slat properties and solar profile angle. Assumes flat slats.
! METHODOLOGY EMPLOYED:
! The solar profile angle is varied from -90 to +90 deg and slat angle is varied from 0 to 180deg,
! covering the full range of possible profile angles and slat angles.
! (The profile angle is defined as the angle of incidence when the radiation
! source is located in a plane that (1)is perpendicular to the plane of the blinds [which is
! the same as the window plane] and (2) contains the slat normal vector.)
! In the time-step calculation,the blind properties vs. profile angle and slat angle
! that are calculated here will be applicable to windows and slats
! of arbitrary orientation, and to arbitrary sun positions, as long as the appropiate
! profile angle is used. The slat angle for a particular window with blinds is determined
! each time step in subroutine WindowShadingManager on the basis of user-specified
! slat control options.
! REFERENCES:
! "Solar-Thermal Window Blind Model for DOE-2," H. Simmler, U. Fischer and
! F. Winkelmann, Lawrence Berkeley National Laboratory, Jan. 1996.
! USE STATEMENTS:na
USE InputProcessor, ONLY: SameString
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:na
! SUBROUTINE PARAMETER DEFINITIONS:na
! INTERFACE BLOCK SPECIFICATIONS:na
! DERIVED TYPE DEFINITIONS:na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) bld_pr(15) ! Slat properties
REAL(r64) st_lay(16) ! Solar-optical blind/glazing system properties
REAL(r64) sun_el ! Solar profile angle (radians)
REAL(r64) sun_el_deg(37) ! Solar profile angle (deg) corresponding to sun_el values
REAL(r64) bld_el ! Slat angle (elevation of slat normal vector in plane
! perpendicular to window and containing the slat normal vector) (radians)
INTEGER ISolVis ! 1 = do solar and IR calculation; 2 = do visible calculation
INTEGER IProfAng ! Profile angle index
INTEGER BlindNum ! Blind number
INTEGER ISlatAng ! Slat angle index
DO BlindNum = 1,TotBlinds
BLD_PR(2) = Blind(BlindNum)%SlatWidth
BLD_PR(3) = Blind(BlindNum)%SlatSeparation
DO ISolVis = 1,2
IF(ISolVis == 1) THEN ! For solar calculation
BLD_PR( 4) = 0.0d0
BLD_PR( 5) = 0.0d0
BLD_PR( 6) = 0.0d0
BLD_PR( 7) = Blind(BlindNum)%SlatTransSolBeamDiff
BLD_PR( 8) = Blind(BlindNum)%SlatFrontReflSolBeamDiff
BLD_PR( 9) = Blind(BlindNum)%SlatBackReflSolBeamDiff
BLD_PR(10) = Blind(BlindNum)%SlatTransSolDiffDiff
BLD_PR(11) = Blind(BlindNum)%SlatFrontReflSolDiffDiff
BLD_PR(12) = Blind(BlindNum)%SlatBackReflSolDiffDiff
ELSE ! For visible calculation
BLD_PR( 4) = 0.0d0
BLD_PR( 5) = 0.0d0
BLD_PR( 6) = 0.0d0
BLD_PR( 7) = Blind(BlindNum)%SlatTransVisBeamDiff
BLD_PR( 8) = Blind(BlindNum)%SlatFrontReflVisBeamDiff
BLD_PR( 9) = Blind(BlindNum)%SlatBackReflVisBeamDiff
BLD_PR(10) = Blind(BlindNum)%SlatTransVisDiffDiff
BLD_PR(11) = Blind(BlindNum)%SlatFrontReflVisDiffDiff
BLD_PR(12) = Blind(BlindNum)%SlatBackReflVisDiffDiff
END IF
! For IR calculation
BLD_PR(13) = Blind(BlindNum)%SlatTransIR
BLD_PR(14) = Blind(BlindNum)%SlatFrontEmissIR
BLD_PR(15) = Blind(BlindNum)%SlatBackEmissIR
! Calculate diffuse properties of blind. If blind has variable slat angle, &
! vary slat angle from 0 to 180 deg in 10-deg steps (for MaxSlatAngs = 19).
! If blind has fixed slat angle, calculate properties at that angle only.
DO ISlatAng = 1,MaxSlatAngs
st_lay = 0.0d0
IF(Blind(BlindNum)%SlatAngleType == FixedSlats) THEN
bld_el = Blind(BlindNum)%SlatAngle * DegToRadians
ELSE ! Variable slat angle
bld_el = (PI/(MaxSlatAngs-1))*(ISlatAng-1) ! 0 <= bld_el <= 180 deg
END IF
CALL BlindOpticsDiffuse(BlindNum,ISolVis,BLD_PR,bld_el,st_lay)
IF(ISolVis == 1) THEN ! Fill blind diffuse solar and IR properties
Blind(BlindNum)%SolFrontDiffDiffTrans(ISlatAng) = st_lay(9)
Blind(BlindNum)%SolFrontDiffDiffRefl(ISlatAng) = st_lay(10)
Blind(BlindNum)%SolBackDiffDiffTrans(ISlatAng) = st_lay(11)
Blind(BlindNum)%SolBackDiffDiffRefl(ISlatAng) = st_lay(12)
Blind(BlindNum)%SolFrontDiffAbs(ISlatAng) = MAX(0.0d0,1.d0-st_lay(9)-st_lay(10))
Blind(BlindNum)%SolBackDiffAbs(ISlatAng) = MAX(0.0d0,1.d0-st_lay(11)-st_lay(12))
Blind(BlindNum)%IRFrontTrans(ISlatAng) = st_lay(13)
Blind(BlindNum)%IRFrontEmiss(ISlatAng) = st_lay(14)
!Blind(BlindNum)%IRBackTrans(ISlatAng) = st_lay(15)
!Blind(BlindNum)%IRBackEmiss(ISlatAng) = st_lay(16)
! Above two lines are incorrect; replaced by (FCW, 2/10/03)
Blind(BlindNum)%IRBackTrans(ISlatAng) = st_lay(13)
Blind(BlindNum)%IRBackEmiss(ISlatAng) = st_lay(15)
ELSE ! Fill blind diffuse visible properties
Blind(BlindNum)%VisFrontDiffDiffTrans(ISlatAng) = st_lay(9)
Blind(BlindNum)%VisFrontDiffDiffRefl(ISlatAng) = st_lay(10)
Blind(BlindNum)%VisBackDiffDiffTrans(ISlatAng) = st_lay(11)
Blind(BlindNum)%VisBackDiffDiffRefl(ISlatAng) = st_lay(12)
END IF
IF(Blind(BlindNum)%SlatAngleType == FixedSlats) EXIT
END DO ! End of slat angle loop
! Calculate beam properties of blind. Vary profile angle from -90 to +90 deg in 5-deg steps.
! If blind has variable slat angle, vary slat angle from 0 to 180 deg in 10-deg steps
! (for MaxSlatAngs = 19). If blind has fixed slat angle, calculate properties at that angle only.
DO IProfAng = 1,37
sun_el = -Pi/2.d0 + (Pi/36.d0)*(IProfAng-1)
sun_el_deg(IProfAng) = 57.2958d0 * sun_el
DO ISlatAng = 1,MaxSlatAngs
st_lay = 0.0d0
IF(Blind(BlindNum)%SlatAngleType == FixedSlats) THEN
bld_el = Blind(BlindNum)%SlatAngle * DegToRadians
ELSE ! Variable slat angle
bld_el = (PI/(MaxSlatAngs-1))*(ISlatAng-1) ! 0 <= bld_el <= 180 deg
END IF
! Beam solar-optical properties of blind for given profile angle and slat angle
CALL BlindOpticsBeam(BlindNum,bld_pr,bld_el,sun_el,st_lay)
IF(ISolVis == 1) THEN ! Fill blind beam solar properties
Blind(BlindNum)%SolFrontBeamBeamTrans(IProfAng,ISlatAng) = st_lay(1)
Blind(BlindNum)%SolFrontBeamBeamRefl(IProfAng,ISlatAng) = st_lay(2)
Blind(BlindNum)%SolBackBeamBeamTrans(IProfAng,ISlatAng) = st_lay(3)
Blind(BlindNum)%SolBackBeamBeamRefl(IProfAng,ISlatAng) = st_lay(4)
Blind(BlindNum)%SolFrontBeamDiffTrans(IProfAng,ISlatAng) = st_lay(5)
Blind(BlindNum)%SolFrontBeamDiffRefl(IProfAng,ISlatAng) = st_lay(6)
Blind(BlindNum)%SolBackBeamDiffTrans(IProfAng,ISlatAng) = st_lay(7)
Blind(BlindNum)%SolBackBeamDiffRefl(IProfAng,ISlatAng) = st_lay(8)
Blind(BlindNum)%SolFrontBeamAbs(IProfAng,ISlatAng) = MAX(0.0d0,1.d0-st_lay(6)-st_lay(1)-st_lay(5))
Blind(BlindNum)%SolBackBeamAbs(IProfAng,ISlatAng) = MAX(0.0d0,1.d0-st_lay(7)-st_lay(3)-st_lay(8))
ELSE ! Fill blind beam visible properties
Blind(BlindNum)%VisFrontBeamBeamTrans(IProfAng,ISlatAng) = st_lay(1)
Blind(BlindNum)%VisFrontBeamBeamRefl(IProfAng,ISlatAng) = st_lay(2)
Blind(BlindNum)%VisBackBeamBeamTrans(IProfAng,ISlatAng) = st_lay(3)
Blind(BlindNum)%VisBackBeamBeamRefl(IProfAng,ISlatAng) = st_lay(4)
Blind(BlindNum)%VisFrontBeamDiffTrans(IProfAng,ISlatAng) = st_lay(5)
Blind(BlindNum)%VisFrontBeamDiffRefl(IProfAng,ISlatAng) = st_lay(6)
Blind(BlindNum)%VisBackBeamDiffTrans(IProfAng,ISlatAng) = st_lay(7)
Blind(BlindNum)%VisBackBeamDiffRefl(IProfAng,ISlatAng) = st_lay(8)
END IF
IF(Blind(BlindNum)%SlatAngleType == FixedSlats) EXIT
END DO ! End of loop over slat angles
END DO ! End of loop over profile angles
IF(ISolVis == 1) THEN
DO ISlatAng = 1,MaxSlatAngs
Blind(BlindNum)%SolFrontDiffDiffTransGnd(ISlatAng) = &
DiffuseAverageProfAngGnd(Blind(BlindNum)%SolFrontBeamBeamTrans(1:37,ISlatAng)) + &
DiffuseAverageProfAngGnd(Blind(BlindNum)%SolFrontBeamDiffTrans(1:37,ISlatAng))
Blind(BlindNum)%SolFrontDiffDiffTransSky(ISlatAng) = &
DiffuseAverageProfAngSky(Blind(BlindNum)%SolFrontBeamBeamTrans(1:37,ISlatAng)) + &
DiffuseAverageProfAngSky(Blind(BlindNum)%SolFrontBeamDiffTrans(1:37,ISlatAng))
Blind(BlindNum)%SolFrontDiffAbsGnd(ISlatAng) = &
DiffuseAverageProfAngGnd(Blind(BlindNum)%SolFrontBeamAbs(1:37,ISlatAng))
Blind(BlindNum)%SolFrontDiffAbsSky(ISlatAng) = &
DiffuseAverageProfAngSky(Blind(BlindNum)%SolFrontBeamAbs(1:37,ISlatAng))
Blind(BlindNum)%SolFrontDiffDiffReflGnd(ISlatAng) = &
DiffuseAverageProfAngGnd(Blind(BlindNum)%SolFrontBeamDiffRefl(1:37,ISlatAng))
Blind(BlindNum)%SolFrontDiffDiffReflSky(ISlatAng) = &
DiffuseAverageProfAngSky(Blind(BlindNum)%SolFrontBeamDiffRefl(1:37,ISlatAng))
! TH 2/17/2010. Added. Loop only for movable slat blinds
IF(Blind(BlindNum)%SlatAngleType == FixedSlats) EXIT
END DO
END IF
END DO ! End of loop over solar vs. visible properties
END DO ! End of loop over blinds
END SUBROUTINE CalcWindowBlindProperties