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 ComputeIntSWAbsorpFactors
! SUBROUTINE INFORMATION:
! AUTHOR Legacy (George Walton)
! DATE WRITTEN Legacy (December 1980)
! MODIFIED Nov. 99, FW; now called every time step to account for movable
! window shades and insulation
! Mar. 00, FW; change name from ComputeVisLightingAbsorpFactors
! to ComputeIntSWAbsorpFactors
! May 00, FW; add window frame and divider effects
! June 01, FW: account for window blinds
! Nov 01, FW: account for absorptance of exterior shades and interior or exterior blinds
! Jan 03, FW: add between-glass shade/blind
! May 06, RR: account for exterior window screens
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Computes VMULT, the inverse of the sum of area*(short-wave absorptance+transmittance) for
! the surfaces in a zone. VMULT is used to calculate the zone interior diffuse short-wave radiation
! absorbed by the inside of opaque zone surfaces or by the glass and shade/blind layers of zone windows.
! Sets VCONV to zero (VCONV was formerly used to calculate convective gain due to short-wave
! radiation absorbed by interior window shades).
! METHODOLOGY EMPLOYED:
! <description>
! REFERENCES:
! BLAST Routine - CIVAF - Compute Surface Absorption Factors For Short Wave Radiation
! From Zone Lights And Diffuse Solar.
! USE STATEMENTS:
USE HeatBalanceMovableInsulation
USE General, ONLY: InterpSw, InterpSlatAng
USE DataWindowEquivalentLayer
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: SmallestAreaAbsProductAllowed = 0.01d0 ! Avoid a division by zero of the user has entered a bunch
! of surfaces with zero absorptivity on the inside
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER ConstrNum ! DO loop counter for constructions
INTEGER FirstZoneSurf ! Index of first surface in current zone
INTEGER LastZoneSurf ! Index of last surface in current zone
REAL(r64) SUM1 ! Intermediate calculation value for solar absorbed and transmitted
! by windows (including shade, blind or insulation, if present)
INTEGER SurfNum ! DO loop counter for zone surfaces
INTEGER ZoneNum ! Loop counter for Zones
INTEGER ShadeFlag ! Shading flag
INTEGER ConstrNumSh ! Shaded construction number
REAL(r64) SwitchFac ! Switching factor
INTEGER Lay ! Layer number
REAL(r64) AbsDiffLayWin ! Window layer short-wave absorptance
REAL(r64) AbsDiffTotWin ! Sum of window layer short-wave absorptances
REAL(r64) TransDiffWin ! Window diffuse short-wave transmittance
REAL(r64) DiffAbsShade ! Diffuse short-wave shade or blind absorptance
REAL(r64) AbsIntSurf, AbsInt ! Inside surface short-wave absorptance
REAL(r64) HMovInsul ! Conductance of movable insulation
REAL(r64) DividerAbs ! Window divider solar absorptance
INTEGER MatNumgl ! Glass material number
REAL(r64) TransGl,ReflGl,AbsGl ! Glass layer short-wave transmittance, reflectance, absorptance
REAL(r64) DividerRefl ! Window divider short-wave reflectance
LOGICAL, SAVE :: FirstTime = .TRUE. ! First time through routine
LOGICAL, ALLOCATABLE, DIMENSION(:), SAVE :: FirstCalcZone ! for error message
! FLOW:
IF (.NOT. ALLOCATED(VMULT)) THEN
ALLOCATE(VMULT(NumOfZones))
VMULT=0.0d0
ALLOCATE(VCONV(NumOfZones))
VCONV=0.0d0
ENDIF
IF (FirstTime) THEN
ALLOCATE(FirstCalcZone(NumOfZones))
FirstCalcZone=.true.
FirstTime=.false.
ENDIF
DO ZoneNum = 1, NumOfZones
SUM1 = 0.0D0
FirstZoneSurf=Zone(ZoneNum)%SurfaceFirst
LastZoneSurf=Zone(ZoneNum)%SurfaceLast
DO SurfNum = FirstZoneSurf, LastZoneSurf
IF (.not. Surface(SurfNum)%HeatTransSurf) CYCLE
ConstrNum=Surface(SurfNum)%Construction
IF (Construct(ConstrNum)%TransDiff <= 0.0d0) THEN
! Opaque surface
AbsIntSurf = Construct(ConstrNum)%InsideAbsorpSolar
HMovInsul = 0.0d0
IF (Surface(SurfNum)%MaterialMovInsulInt > 0) &
CALL EvalInsideMovableInsulation(SurfNum,HMovInsul,AbsInt)
IF (HMovInsul > 0.0d0) AbsIntSurf = AbsInt
SUM1 = SUM1 + Surface(SurfNum)%Area*AbsIntSurf
ELSE
! Window
IF ( .NOT. Construct(Surface(SurfNum)%Construction)%WindowTypeEQL) THEN
ShadeFlag = SurfaceWindow(SurfNum)%ShadingFlag
AbsDiffTotWin = 0.0d0
ConstrNumSh = Surface(SurfNum)%ShadedConstruction
IF(SurfaceWindow(SurfNum)%StormWinFlag==1) THEN
ConstrNum = Surface(SurfNum)%StormWinConstruction
ConstrNumSh = Surface(SurfNum)%StormWinShadedConstruction
END IF
SwitchFac = SurfaceWindow(SurfNum)%SwitchingFactor
! Sum of absorptances of glass layers
DO Lay = 1,Construct(ConstrNum)%TotGlassLayers
AbsDiffLayWin = Construct(ConstrNum)%AbsDiffBack(Lay)
! Window with shade, screen or blind
IF(ShadeFlag == IntShadeOn .OR. ShadeFlag == ExtShadeOn .OR. ShadeFlag == BGShadeOn &
.OR. ShadeFlag == ExtScreenOn) THEN
AbsDiffLayWin = Construct(ConstrNumSh)%AbsDiffBack(Lay)
ELSE IF(ShadeFlag == IntBlindOn .OR. ShadeFlag == ExtBlindOn .OR. ShadeFlag == BGBlindOn) THEN
AbsDiffLayWin = InterpSlatAng(SurfaceWindow(SurfNum)%SlatAngThisTS, &
SurfaceWindow(SurfNum)%MovableSlats,Construct(ConstrNumSh)%BlAbsDiffBack(Lay,1:MaxSlatAngs))
END IF
! Switchable glazing
IF(ShadeFlag == SwitchableGlazing) AbsDiffLayWin = &
InterpSw(SwitchFac, AbsDiffLayWin, Construct(ConstrNumSh)%AbsDiffBack(Lay))
AbsDiffTotWin = AbsDiffTotWin + AbsDiffLayWin
END DO
TransDiffWin = Construct(ConstrNum)%TransDiff
DiffAbsShade = 0.0d0
! Window with shade, screen or blind
IF(ShadeFlag == IntShadeOn .OR. ShadeFlag == ExtShadeOn .OR. ShadeFlag == BGShadeOn .OR. ShadeFlag == ExtScreenOn) THEN
TransDiffWin = Construct(ConstrNumSh)%TransDiff
DiffAbsShade = Construct(ConstrNumSh)%AbsDiffBackShade
ELSE IF(ShadeFlag == IntBlindOn .OR. ShadeFlag == ExtBlindOn .OR. ShadeFlag == BGBlindOn) THEN
TransDiffWin = InterpSlatAng(SurfaceWindow(SurfNum)%SlatAngThisTS, &
SurfaceWindow(SurfNum)%MovableSlats,Construct(ConstrNumSh)%BlTransDiff)
DiffAbsShade = InterpSlatAng(SurfaceWindow(SurfNum)%SlatAngThisTS, &
SurfaceWindow(SurfNum)%MovableSlats,Construct(ConstrNumSh)%AbsDiffBackBlind)
END IF
! Switchable glazing
IF(ShadeFlag == SwitchableGlazing) TransDiffWin = &
InterpSw(SwitchFac, TransDiffWin, Construct(ConstrNumSh)%TransDiff)
SUM1 = SUM1 + Surface(SurfNum)%Area*(TransDiffWin + AbsDiffTotWin + DiffAbsShade)
! Window frame and divider effects (shade area is glazed area plus divider area)
IF(SurfaceWindow(SurfNum)%FrameArea > 0.0d0) SUM1 = SUM1 + SurfaceWindow(SurfNum)%FrameArea * &
SurfaceWindow(SurfNum)%FrameSolAbsorp * (1.0d0+0.5d0*SurfaceWindow(SurfNum)%ProjCorrFrIn)
IF(SurfaceWindow(SurfNum)%DividerArea > 0.0d0) THEN
DividerAbs = SurfaceWindow(SurfNum)%DividerSolAbsorp
IF(SurfaceWindow(SurfNum)%DividerType == Suspended) THEN
!Suspended (between-glass) divider: account for glass on inside of divider
MatNumGl = Construct(ConstrNum)%LayerPoint(Construct(ConstrNum)%TotLayers)
TransGl = Material(MatNumGl)%Trans
ReflGl = Material(MatNumGl)%ReflectSolBeamBack
AbsGl = 1.0d0-TransGl-ReflGl
DividerRefl = 1.0d0 - DividerAbs
DividerAbs = AbsGl + TransGl*(DividerAbs + DividerRefl*AbsGl)/(1.0d0-DividerRefl*ReflGl)
END IF
IF(ShadeFlag==IntShadeOn.OR.ShadeFlag==IntBlindOn) THEN
SUM1 = SUM1 + SurfaceWindow(SurfNum)%DividerArea * (DividerAbs + DiffAbsShade)
ELSE
SUM1 = SUM1 + SurfaceWindow(SurfNum)%DividerArea * &
(1.0d0+SurfaceWindow(SurfNum)%ProjCorrDivIn) * DividerAbs
END IF
END IF
ELSE ! equivalent layer window
! In equivalent layer window solid layers (Glazing and shades) are treated equally
! frames and dividers are not supported
AbsDiffTotWin = 0.0d0
AbsDiffLayWin = 0.0d0
TransDiffWin = Construct(ConstrNum)%TransDiff
DO Lay = 1, CFS(Construct(ConstrNum)%EQLConsPtr)%NL
AbsDiffLayWin = Construct(ConstrNum)%AbsDiffBackEQL(Lay)
AbsDiffTotWin = AbsDiffTotWin + AbsDiffLayWin
END DO
SUM1 = SUM1 + Surface(SurfNum)%Area*(TransDiffWin + AbsDiffTotWin)
ENDIF
END IF ! End of check if opaque surface or window
END DO ! End of loop over surfaces in zone
IF (SUM1 > SmallestAreaAbsProductAllowed) THEN ! Everything is okay, proceed with the regular calculation
VMULT(ZoneNum) = 1.0d0/SUM1
ELSE ! the sum of area*solar absorptance for all surfaces in the zone is zero--either the user screwed up
! or they really want to disallow any solar from being absorbed on the inside surfaces. Fire off a
! nasty warning message and then assume that no solar is ever absorbed (basically everything goes
! back out whatever window is there. Note that this also assumes that the shade has no effect.
! That's probably not correct, but how correct is it to assume that no solar is absorbed anywhere
! in the zone?
IF (FirstCalcZone(ZoneNum)) THEN
CALL ShowWarningError('ComputeIntSWAbsorbFactors: Sum of area times inside solar absorption '// &
'for all surfaces is zero in Zone: '//TRIM(Zone(ZoneNum)%Name))
FirstCalcZone(ZoneNum) = .FALSE.
END IF
VMULT(ZoneNum) = 0.0d0
END IF
END DO ! End of zone loop
RETURN
END SUBROUTINE ComputeIntSWAbsorpFactors