| 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