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) | :: | SurfNum | |||
integer, | intent(in) | :: | iter | |||
real(kind=r64), | intent(inout) | :: | VGap | |||
real(kind=r64), | intent(inout) | :: | TGapNew(2) | |||
real(kind=r64) | :: | TGapOutletAve | ||||
real(kind=r64), | intent(inout) | :: | hcv(2) | |||
real(kind=r64), | intent(inout) | :: | QConvTot |
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 BetweenGlassShadeForcedFlow(SurfNum,iter,VGap,TGapNew,TGapOutletAve,hcv,QConvTot)
! SUBROUTINE INFORMATION:
! AUTHOR F. Winkelmann
! DATE WRITTEN February 2003
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Called by SolveForWindowTemperatures for airflow windows with a
! between-glass shade or blind over which fan-forced air flows.
! Based on the air flow velocity (which is assumed to be the same in the
! gaps on either side of the shade/blind), finds, for each gap: the average
! air temperature, the shade/blind or glass surface to air convective heat
! transfer coefficient, the gap outlet temperature, and the outlet convective heat flow.
! Called only for double and triple glazing. For triple glazing the airflow
! is assumed to be between the inner two layers of glass (glass layers 2 and 3),
! between which the shade/blind is located.
! METHODOLOGY EMPLOYED:
! Based on ISO/DIS 15099, "Thermal Performance of Windows, Doors and Shading Devices --
! Detailed Calculations," 1/12/2000, Chapter 7, "Shading Devices."
! REFERENCES:
! na
USE InputProcessor, ONLY: SameString
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT (IN) :: SurfNum ! Surface number
INTEGER, INTENT (IN) :: iter ! Iteration number for glass heat balance calculation
REAL(r64), INTENT (INOUT) :: VGap ! Air velocity in each gap (m/s)
REAL(r64), INTENT (INOUT) :: TGapNew(2) ! Current-iteration average gas temp in gaps (K)
REAL(r64) :: TGapOutletAve ! Average of TGapOutlet(1) and TGapOutlet(2) (K)
REAL(r64), INTENT (INOUT) :: hcv(2) ! Convection coefficient from gap glass or shade to gap gas (W/m2-K)
REAL(r64), INTENT (INOUT) :: QConvTot ! Sum of convective heat flow from gaps (W)
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: ConstrNumSh ! Shaded construction number
INTEGER :: MatNumSh ! Material number of shade/blind layer
! In the following, "gaps" refer to the gaps on either side of the shade/blind
REAL(r64) :: TGlassFace(2) ! Temperature of glass surfaces facing gaps (K)
REAL(r64) :: TShadeFace(2) ! Temperature of shade surfaces facing gaps (K)
REAL(r64) :: hGapStill(2) ! Still-air conduction/convection coeffs for the gaps (W/m2-K)
REAL(r64) :: TGapOld(2) ! Previous-iteration average gas temp in gaps (K)
REAL(r64) :: GapHeight ! Vertical length of glass-shade/blind gap (m)
REAL(r64) :: GapDepth ! Distance from shade/blind to glass; assumed same for both gaps (m)
REAL(r64) :: RhoAir(2) ! Density of gap air (kg/m3)
REAL(r64) :: AGap ! Cross sectional area of each gap (m2); for vertical window, this
! is in horizontal plane normal to window.
REAL(r64) :: TGapInlet ! Gap inlet air temperature (K)
REAL(r64) :: TGapOutlet(2) ! Gap outlet air temperature (K)
REAL(r64) :: QConvGap(2) ! Convective heat flow from each gap (W)
REAL(r64) :: GapHeightChar(2) ! Characteristic height of the gap air temperature profile (m)
REAL(r64) :: TAve(2) ! Average of TGlass and TShade for the gaps (K)
REAL(r64) :: con ! Gap air conductivity and derivative
REAL(r64) :: gr ! Gap air Grashof number
REAL(r64) :: pr ! Gap air Prandtl number
REAL(r64) :: nu ! Gap air Nusselt number
INTEGER :: ShadeFlag ! Shading flag
INTEGER :: IGap ! Gap counter; 1 = gap on outer side of shade/blind, 2 = gap on inner side.
INTEGER :: IGapInc ! Gap increment; =0, double glass, =1, triple glass
!REAL(r64) :: AirProps(8) ! Air properties
! Air properties
! Dens dDens/dT Con dCon/dT Vis dVis/dT Prandtl dPrandtl/dT
!DATA AirProps / 1.29, -0.4e-2, 2.41e-2, 7.6e-5, 1.73e-5, 1.0e-7, 0.72, 1.8e-3 /
ConstrNumSh = Surface(SurfNum)%ShadedConstruction
ShadeFlag = SurfaceWindow(SurfNum)%ShadingFlag
IF(Construct(ConstrNumSh)%TotGlassLayers == 2) THEN ! Double glazing
MatNumSh = Construct(ConstrNumSh)%LayerPoint(3)
IGapInc = 0
DO IGap = 1,2
TGlassFace(IGap) = thetas(IGap+1)
TShadeFace(IGap) = thetas(IGap+4)
END DO
ELSE ! Triple glazing
MatNumSh = Construct(ConstrNumSh)%LayerPoint(5)
IGapInc = 1
DO IGap = 1,2
TGlassFace(IGap) = thetas(IGap+3)
TShadeFace(IGap) = thetas(IGap+6)
END DO
END IF
IF (SurfaceWindow(SurfNum)%AirFlowSource == AirFlowWindow_Source_IndoorAir) THEN
TGapInlet = tin
ELSE
TGapInlet = tout
END IF
GapHeight = Surface(SurfNum)%Height
GapDepth = gap(1+IGapInc)
AGap = GapDepth * Surface(SurfNum)%Width
! Factor of 2 below assumes gaps on either side of shade/blind have same depth
VGap = SurfaceWindow(SurfNum)%AirFlowThisTS/(2.d0*GapDepth)
DO IGap = 1,2
TAve(IGap) = 0.5d0*(TGlassFace(IGap) + TShadeFace(IGap))
IF(iter == 0) THEN
TGapOld(IGap) = TAve(IGap)
ELSE
TGapOld(IGap) = TGapNew(IGap)
END IF
! Conductance of gaps on either side of shade/blind assuming gaps are sealed
CALL WindowGasConductance(TGlassFace(IGap),TShadeFace(IGap),IGap+IGapInc,con,pr,gr)
CALL NusseltNumber(SurfNum,TGlassFace(IGap),TShadeFace(IGap),IGap+IGapInc,gr,pr,nu)
hGapStill(IGap) = con/gap(IGap+IGapInc)*nu
! Shade/blind or glass surface to air convection coefficient
hcv(IGap) = 2.d0*hGapStill(IGap) + 4.d0*VGap
RhoAir(IGap) = AirProps(1) + AirProps(2)*(TGapOld(IGap)-TKelvin)
hcv(IGap) = 2.d0*hGapStill(IGap) + 4.d0*VGap
GapHeightChar(IGap) = RhoAir(IGap) * 1008.d0 * GapDepth * VGap/(2.d0*hcv(IGap))
! The following avoids divide by zero and exponential underflow
IF(GapHeightChar(IGap) == 0.0d0) THEN
TGapOutlet(IGap) = TAve(IGap)
ELSE IF((GapHeight/GapHeightChar(IGap)) > 15.d0) THEN
TGapOutlet(IGap) = TAve(IGap)
ELSE
TGapOutlet(IGap) = TAve(IGap) - (TAve(IGap)-TGapInlet)*EXP(-GapHeight/GapHeightChar(IGap))
END IF
TGapNew(IGap) = TAve(IGap) - (GapHeightChar(IGap)/GapHeight) * (TGapOutlet(IGap)-TGapInlet)
! Convective heat flow from gap [W]
RhoAir(IGap) = AirProps(1) + AirProps(2)*(TGapNew(IGap)-TKelvin)
QConvGap(IGap) = RhoAir(IGap) * AGap * VGap * 1008.d0 * (TGapOutlet(IGap) - TGapInlet)
END DO
QConvTot = QConvGap(1) + QConvGap(2)
TGapOutletAve = 0.5d0*(TGapOutlet(1)+TGapOutlet(2))
RETURN
END SUBROUTINE BetweenGlassShadeForcedFlow