Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | ConstrNum |
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 SetEquivalentLayerWindowProperties(ConstrNum)
! SUBROUTINE INFORMATION:
! AUTHOR Bereket Nigusse
! DATE WRITTEN May 2013
! MODIFIED na
!
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Polpulates the the equivalent layer window model optical and thermal
! properties, fills default values and shades geomterical calculations
! METHODOLOGY EMPLOYED:
! uses some routine developed for ASHRAE RP-1311 (ASHWAT Model)
!
! REFERENCES:
! na
! USE STATEMENTS:
! na
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: ConstrNum
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS
INTEGER :: Layer ! layer index
INTEGER :: MaterNum ! material index of a layer in a construction
INTEGER :: gLayer ! gap layer index
INTEGER :: sLayer ! glazing and shade layers (non-gas layers) index
INTEGER :: EQLNum ! equivalent layer window construction index
INTEGER :: NumGLayers ! number of gap layers
INTEGER :: NumSLayers ! number of glazing and shade layers (non-gas layers)
INTEGER :: DoWhat ! DoWhat =1, index for diffuse, and =2 index for beam
REAL(r64) :: SysAbs1(CFSMAXNL+1,2) ! layers absorptance and system transmittance
! Flow
IF (.NOT. ALLOCATED( CFSLayers) ) ALLOCATE( CFSLayers(Construct(ConstrNum)%TotLayers))
sLayer = 0
gLayer = 0
EQLNum = Construct(ConstrNum)%EQLConsPtr
CFS(EQLNum)%Name = Construct(ConstrNum)%Name
DO Layer = 1, Construct(ConstrNum)%TotLayers
MaterNum=Construct(ConstrNum)%LayerPoint(Layer)
IF(Material(Construct(ConstrNum)%LayerPoint(1))%Group /= GlassEquivalentLayer .AND. &
Material(Construct(ConstrNum)%LayerPoint(1))%Group /= ShadeEquivalentLayer .AND. &
Material(Construct(ConstrNum)%LayerPoint(1))%Group /= DrapeEquivalentLayer .AND. &
Material(Construct(ConstrNum)%LayerPoint(1))%Group /= ScreenEquivalentLayer.AND. &
Material(Construct(ConstrNum)%LayerPoint(1))%Group /= BlindEquivalentLayer .AND. &
Material(Construct(ConstrNum)%LayerPoint(1))%Group /= GapEquivalentLayer) CYCLE
IF(Material(MaterNum)%Group == GapEquivalentLayer )THEN
! Gap or Gas Layer
gLayer = gLayer + 1
ELSE
! Solid (Glazing or Shade) Layer
sLayer = sLayer + 1
CFS(EQLNum)%L(sLayer)%Name = TRIM(Material(MaterNum)%Name)
! longwave property input
CFS(EQLNum)%L(sLayer)%LWP_MAT%EPSLF=Material(MaterNum)%EmissThermalFront
CFS(EQLNum)%L(sLayer)%LWP_MAT%EPSLB=Material(MaterNum)%EmissThermalBack
CFS(EQLNum)%L(sLayer)%LWP_MAT%TAUL= Material(MaterNum)%TausThermal
ENDIF
IF (Material(MaterNum)%Group == BlindEquivalentLayer) THEN
IF (Material(MaterNum)%SlatOrientation == Horizontal) THEN
CFS(EQLNum)%L(sLayer)%LTYPE = ltyVBHOR
ELSEIF(Material(MaterNum)%SlatOrientation == Vertical) THEN
CFS(EQLNum)%L(sLayer)%LTYPE = ltyVBVER
ENDIF
CFS(EQLNum)%L(sLayer)%SWP_MAT%RHOSFBD=Material(MaterNum)%ReflFrontBeamDiff
CFS(EQLNum)%L(sLayer)%SWP_MAT%RHOSBBD=Material(MaterNum)%ReflBackBeamDiff
CFS(EQLNum)%L(sLayer)%SWP_MAT%TAUSFBD=Material(MaterNum)%TausFrontBeamDiff
CFS(EQLNum)%L(sLayer)%SWP_MAT%TAUSBBD=Material(MaterNum)%TausBackBeamDiff
CFS(EQLNum)%L(sLayer)%SWP_MAT%RHOSFDD=Material(MaterNum)%ReflFrontDiffDiff
CFS(EQLNum)%L(sLayer)%SWP_MAT%RHOSBDD=Material(MaterNum)%ReflBackDiffDiff
CFS(EQLNum)%L(sLayer)%SWP_MAT%TAUS_DD=Material(MaterNum)%TausDiffDiff
CFS(EQLNum)%L(sLayer)%PHI_DEG=Material(MaterNum)%SlatAngle
CFS(EQLNum)%L(sLayer)%S=Material(MaterNum)%SlatSeparation
CFS(EQLNum)%L(sLayer)%W=Material(MaterNum)%SlatWidth
CFS(EQLNum)%L(sLayer)%C=Material(MaterNum)%SlatCrown
ELSEIF (Material(MaterNum)%Group == GlassEquivalentLayer) THEN
! glazing
CFS(EQLNum)%L(sLayer)%LTYPE = ltyGLAZE
CFS(EQLNum)%L(sLayer)%SWP_MAT%RHOSFBB=Material(MaterNum)%ReflFrontBeamBeam
CFS(EQLNum)%L(sLayer)%SWP_MAT%RHOSBBB=Material(MaterNum)%ReflBackBeamBeam
CFS(EQLNum)%L(sLayer)%SWP_MAT%TAUSFBB=Material(MaterNum)%TausFrontBeamBeam
CFS(EQLNum)%L(sLayer)%SWP_MAT%RHOSFBD=Material(MaterNum)%ReflFrontBeamDiff
CFS(EQLNum)%L(sLayer)%SWP_MAT%RHOSBBD=Material(MaterNum)%ReflBackBeamDiff
CFS(EQLNum)%L(sLayer)%SWP_MAT%TAUSFBD=Material(MaterNum)%TausFrontBeamDiff
CFS(EQLNum)%L(sLayer)%SWP_MAT%TAUSBBD=Material(MaterNum)%TausBackBeamDiff
CFS(EQLNum)%L(sLayer)%SWP_MAT%RHOSFDD=Material(MaterNum)%ReflFrontDiffDiff
CFS(EQLNum)%L(sLayer)%SWP_MAT%RHOSBDD=Material(MaterNum)%ReflBackDiffDiff
CFS(EQLNum)%L(sLayer)%SWP_MAT%TAUS_DD=Material(MaterNum)%TausDiffDiff
ELSEIF (Material(MaterNum)%Group == ShadeEquivalentLayer) THEN
! roller blind
CFS(EQLNum)%L(sLayer)%LTYPE = ltyROLLB
CFS(EQLNum)%L(sLayer)%SWP_MAT%TAUSFBB=Material(MaterNum)%TausFrontBeamBeam
CFS(EQLNum)%L(sLayer)%SWP_MAT%TAUSBBB=Material(MaterNum)%TausBackBeamBeam
CFS(EQLNum)%L(sLayer)%SWP_MAT%RHOSFBD=Material(MaterNum)%ReflFrontBeamDiff
CFS(EQLNum)%L(sLayer)%SWP_MAT%RHOSBBD=Material(MaterNum)%ReflBackBeamDiff
CFS(EQLNum)%L(sLayer)%SWP_MAT%TAUSFBD=Material(MaterNum)%TausFrontBeamDiff
CFS(EQLNum)%L(sLayer)%SWP_MAT%TAUSBBD=Material(MaterNum)%TausBackBeamDiff
ELSEIF (Material(MaterNum)%Group == DrapeEquivalentLayer) THEN
! drapery fabric
CFS(EQLNum)%L(sLayer)%LTYPE = ltyDRAPE
CFS(EQLNum)%L(sLayer)%SWP_MAT%TAUSFBB=Material(MaterNum)%TausFrontBeamBeam
CFS(EQLNum)%L(sLayer)%SWP_MAT%TAUSBBB=Material(MaterNum)%TausBackBeamBeam
CFS(EQLNum)%L(sLayer)%SWP_MAT%RHOSFBD=Material(MaterNum)%ReflFrontBeamDiff
CFS(EQLNum)%L(sLayer)%SWP_MAT%RHOSBBD=Material(MaterNum)%ReflBackBeamDiff
CFS(EQLNum)%L(sLayer)%SWP_MAT%TAUSFBD=Material(MaterNum)%TausFrontBeamDiff
CFS(EQLNum)%L(sLayer)%SWP_MAT%TAUSBBD=Material(MaterNum)%TausBackBeamDiff
CFS(EQLNum)%L(sLayer)%S=Material(MaterNum)%PleatedDrapeLength
CFS(EQLNum)%L(sLayer)%W=Material(MaterNum)%PleatedDrapeWidth
!
! init diffuse SWP to force default derivation
CFS(EQLNum)%L(sLayer)%SWP_MAT%RHOSFDD = -1.0d0
CFS(EQLNum)%L(sLayer)%SWP_MAT%RHOSBDD = -1.0d0
CFS(EQLNum)%L(sLayer)%SWP_MAT%TAUS_DD = -1.0d0
ELSEIF (Material(MaterNum)%Group == ScreenEquivalentLayer) THEN
! insect screen
CFS(EQLNum)%L(sLayer)%LTYPE = ltyINSCRN
CFS(EQLNum)%L(sLayer)%SWP_MAT%TAUSFBB=Material(MaterNum)%TausFrontBeamBeam
CFS(EQLNum)%L(sLayer)%SWP_MAT%TAUSBBB=Material(MaterNum)%TausBackBeamBeam
CFS(EQLNum)%L(sLayer)%SWP_MAT%RHOSFBD=Material(MaterNum)%ReflFrontBeamDiff
CFS(EQLNum)%L(sLayer)%SWP_MAT%RHOSBBD=Material(MaterNum)%ReflBackBeamDiff
CFS(EQLNum)%L(sLayer)%SWP_MAT%TAUSFBD=Material(MaterNum)%TausFrontBeamDiff
CFS(EQLNum)%L(sLayer)%SWP_MAT%TAUSBBD=Material(MaterNum)%TausBackBeamDiff
! wire geometry
CFS(EQLNum)%L(sLayer)%S=Material(MaterNum)%ScreenWireSpacing
CFS(EQLNum)%L(sLayer)%W=Material(MaterNum)%ScreenWireDiameter
ELSE IF(Material(MaterNum)%Group == GapEquivalentLayer )THEN
! This layer is a gap. Fill in the parameters
CFS(EQLNum)%G(gLayer)%Name = TRIM(Material(MaterNum)%Name)
CFS(EQLNum)%G(gLayer)%GType = Material(MaterNum)%GapVentType
CFS(EQLNum)%G(gLayer)%TAS = Material(MaterNum)%Thickness
CFS(EQLNum)%G(gLayer)%FG%Name = TRIM(Material(MaterNum)%GasName)
CFS(EQLNum)%G(gLayer)%FG%AK = Material(MaterNum)%GasCon(1,1)
CFS(EQLNum)%G(gLayer)%FG%BK = Material(MaterNum)%GasCon(1,2)
CFS(EQLNum)%G(gLayer)%FG%CK = Material(MaterNum)%GasCon(1,3)
CFS(EQLNum)%G(gLayer)%FG%ACp = Material(MaterNum)%GasCp(1,1)
CFS(EQLNum)%G(gLayer)%FG%BCp = Material(MaterNum)%GasCp(1,2)
CFS(EQLNum)%G(gLayer)%FG%CCp = Material(MaterNum)%GasCp(1,3)
CFS(EQLNum)%G(gLayer)%FG%AVisc = Material(MaterNum)%GasVis(1,1)
CFS(EQLNum)%G(gLayer)%FG%BVisc = Material(MaterNum)%GasVis(1,2)
CFS(EQLNum)%G(gLayer)%FG%CVisc = Material(MaterNum)%GasVis(1,3)
CFS(EQLNum)%G(gLayer)%FG%MHAT = Material(MaterNum)%GasWght(1)
! fills gas density and effective gap thickness
CALL BuildGap(CFS(EQLNum)%G(gLayer), &
CFS(EQLNum)%G(gLayer)%GType, &
CFS(EQLNum)%G(gLayer)%TAS )
ELSE
CFS(EQLNum)%L(sLayer)%LTYPE = ltyNONE
END IF
! beam beam transmittance is the same for front and back side
CFS(EQLNum)%L(sLayer)%SWP_MAT%TAUSBBB = CFS(EQLNum)%L(sLayer)%SWP_MAT%TAUSFBB
NumSLayers = sLayer
NumGLayers = gLayer
CFS(EQLNum)%NL = sLayer
! checks optical properties and fill in default values for diffuse optical
! properties by calculating from other optical inputs, also fills in geometrical inputs
CALL CheckAndFixCFSLayer(CFS(EQLNum)%L(sLayer))
END DO ! end do for Construct(ConstrNum)%TotLayers
! Finalize CFS after get input. Correct effective gap thickness for VB
CALL FinalizeCFS( CFS(EQLNum))
! get total solid layers (glazing layers + shade layers)
Construct(ConstrNum)%TotSolidLayers = CFS(EQLNum)%NL
! Calculate layers diffuse absorptance and system diffuse transmittance
CALL CalcEQLWindowOpticalProperty( CFS(EQLNum), isDIFF, SysAbs1, 0.0d0, 0.0d0, 0.0d0)
Construct(ConstrNum)%TransDiffFrontEQL = SysAbs1(CFS(EQLNum)%NL+1,1)
CFSDiffAbsTrans(EQLNum,:,:) = SysAbs1
Construct(ConstrNum)%AbsDiffFrontEQL(1:CFSMAXNL) = SysAbs1(1:CFSMAXNL,1)
Construct(ConstrNum)%AbsDiffBackEQL(1:CFSMAXNL) = SysAbs1(1:CFSMAXNL,2)
! get construction front and back diffuse effective reflectance
Construct(ConstrNum)%ReflectSolDiffFront = CFS(EQLNum)%L(1)%SWP_EL%RHOSFDD
Construct(ConstrNum)%ReflectSolDiffBack = CFS(EQLNum)%L(CFS(EQLNum)%NL)%SWP_EL%RHOSBDD
! calculate U-Value, SHGC and Normal Transmittance of EQL Window
Call CalcEQLWindowStandardRatings(ConstrNum)
IF ( CFSHasControlledShade(CFS(EQLNum)) > 0 ) CFS(EQLNum)%ISControlled = .TRUE. ! is controlled
RETURN
END SUBROUTINE SetEquivalentLayerWindowProperties