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 CreateStormWindowConstructions
! SUBROUTINE INFORMATION:
! AUTHOR Fred Winkelmann
! DATE WRITTEN Jan 2004
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! For windows with an associated StormWindow object, creates a construction
! consisting of the base construction plus a storm window and air gap on the outside.
! If the window has an interior or between-glass shade/blind, also creates a
! construction consisting of the storm window added to the shaded construction.
! METHODOLOGY EMPLOYED:na
! REFERENCES:na
! USE STATEMENTS:
USE InputProcessor, ONLY: FindItemInList
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! SUBROUTINE PARAMETER DEFINITIONS:na
! INTERFACE BLOCK SPECIFICATIONS;na
! DERIVED TYPE DEFINITIONS:na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: SurfNum ! Surface number
INTEGER :: StormWinNum ! Number of StormWindow object
INTEGER :: ConstrNum ! Number of unshaded construction
INTEGER :: ConstrNumSh ! Number of shaded construction
INTEGER :: ConstrOld ! Number of old construction (unshaded or shaded)
INTEGER :: ConstrNewSt ! Number of unshaded storm window construction that is created
INTEGER :: ConstrNewStSh ! Number of shaded storm window construction that is created
INTEGER :: ConstrNew ! Number of new construction with storm window (unshaded or shaded)
INTEGER :: MatNewStAir ! Number of created air layer material
CHARACTER(len=MaxNameLength) :: ConstrName ! Name of original unshaded window construction
CHARACTER(len=MaxNameLength) :: ConstrNameSh ! Name of original shaded window construction
CHARACTER(len=MaxNameLength) :: ConstrNameSt ! Name of unshaded construction with storm window
CHARACTER(len=MaxNameLength) :: ConstrNameStsh ! Name of shaded construction with storm window
CHARACTER(len=MaxNameLength) :: MatNameStAir ! Name of created air layer material
INTEGER :: StormWinMatNum ! Material number of storm window glass layer
INTEGER :: IntDistance ! Thickness of air gap between storm window and rest of window (mm)
CHARACTER(len=20) :: ChrIntDistance ! Character representation of IntDistance
CHARACTER(len=29) :: ChrNum ! Character representation of storm window number
INTEGER :: TotLayers ! Total layers in a construction
INTEGER :: TotGlassLayers ! Total glass layers in a construction
INTEGER :: TotLayersOld ! Total layers in old (without storm window) construction
INTEGER :: MatIntSh ! Material number of interior shade or blind
INTEGER :: MatBGsh ! Material number of between-glass shade or blind
INTEGER :: loop ! DO loop index
LOGICAL :: ShAndSt ! True if unshaded and shaded window can have a storm window
! INTEGER :: LenName ! Name length
CALL DisplayString('Creating Storm Window Constructions')
DO StormWinNum = 1,TotStormWin
SurfNum = StormWindow(StormWinNum)%BaseWindowNum
ConstrNum = Surface(SurfNum)%Construction
! Fatal error if base construction has more than three glass layers
IF(Construct(ConstrNum)%TotGlassLayers > 3) THEN
CALL ShowFatalError('Window='//TRIM(Surface(SurfNum)%Name) &
//' has more than 3 glass layers; a storm window cannot be applied.')
END IF
ConstrNumSh = Surface(SurfNum)%ShadedConstruction
ConstrName = Construct(ConstrNum)%Name
StormWinMatNum = StormWindow(StormWinNum)%StormWinMaterialNum
IntDistance = INT(1000*StormWindow(StormWinNum)%StormWinDistance)
WRITE(ChrIntDistance,*) IntDistance
ChrIntDistance = ADJUSTL(ChrIntDistance)
! Set ShAndSt, which is true if the window has a shaded construction to which a storm window
! can be added. (A storm window can be added if there is an interior shade or blind and up to three
! glass layers, or there is a between-glass shade or blind and two glass layers.)
ShAndSt = .false.
IF(ConstrNumSh > 0) THEN
ConstrNameSh = Construct(ConstrNumSh)%Name
TotLayers = Construct(ConstrNumSh)%TotLayers
TotGlassLayers = Construct(ConstrNumSh)%TotGlassLayers
MatIntSh = Construct(ConstrNumSh)%LayerPoint(TotLayers)
MatBGsh = 0
IF(TotLayers == 5) MatBGsh = Construct(ConstrNumSh)%LayerPoint(3)
IF(TotGlassLayers <= 3 .AND. (Material(MatIntSh)%Group == Shade .OR. &
Material(MatIntSh)%Group == WindowBlind)) ShAndSt = .true.
IF(MatBGsh > 0) THEN
IF(Material(MatBGsh)%Group == Shade .OR. Material(MatBGsh)%Group == WindowBlind) ShAndSt = .true.
END IF
IF(.not.ShAndSt) THEN
CALL ShowContinueError('Window='//TRIM(Surface(SurfNum)%Name) &
//' has a shaded construction to which a storm window cannot be applied.')
CALL ShowContinueError('Storm windows can only be applied to shaded constructions that:')
CALL ShowContinueError('have an interior shade or blind and up to three glass layers, or')
CALL ShowContinueError('have a between-glass shade or blind and two glass layers.')
CALL ShowFatalError('EnergyPlus is exiting due to reason stated above.')
END IF
END IF
! Loop over unshaded (loop=1) and shaded (loop=2) constructions and create new constructions
! with storm window and air gap added on outside
DO loop = 1,2
IF(loop == 1) THEN
WRITE(ChrNum,*) StormWinNum
ChrNum = ADJUSTL(ChrNum)
ConstrNameSt = 'BARECONSTRUCTIONWITHSTORMWIN:'//TRIM(ChrNum)
! If this construction name already exists, set the surface's storm window construction number to it
ConstrNewSt = FindIteminList(ConstrNameSt,Construct%Name,TotConstructs)
ConstrNewStSh=0
IF(ConstrNewSt > 0) Surface(SurfNum)%StormWinConstruction = ConstrNewSt
ELSE
IF(.not.ShAndSt) EXIT
ConstrNameStSh = 'SHADEDCONSTRUCTIONWITHSTORMWIN:'//TRIM(ChrNum)
ConstrNewStSh = FindIteminList(ConstrNameStSh,Construct%Name,TotConstructs)
IF(ConstrNewStSh > 0) Surface(SurfNum)%StormWinShadedConstruction = ConstrNewStSh
END IF
IF(loop==1 .AND. ConstrNewSt==0) THEN
! If necessary, create new material corresponding to the air layer between the storm winddow
! and the rest of the window
MatNameStAir = 'AIR:STORMWIN:'//TRIM(ChrIntDistance)//'MM'
MatNewStAir = FindItemInList(MatNameStAir,Material%Name,TotMaterials)
IF(MatNewStAir == 0) THEN
! Create new material
MatNewStAir = TotMaterials + 1
ALLOCATE(MaterialSave(TotMaterials))
ALLOCATE(NominalRSave(TotMaterials))
MaterialSave(1:TotMaterials) = Material(1:TotMaterials)
NominalRSave(1:TotMaterials) = NominalR(1:TotMaterials)
DEALLOCATE(Material)
DEALLOCATE(NominalR)
TotMaterials = MatNewStAir
ALLOCATE(Material(TotMaterials))
ALLOCATE(NominalR(TotMaterials))
Material(1:TotMaterials-1) = MaterialSave(1:TotMaterials-1)
NominalR(1:TotMaterials-1) = NominalRSave(1:TotMaterials-1)
DEALLOCATE(MaterialSave)
DEALLOCATE(NominalRSave)
Material(TotMaterials)%Name = MatNameStAir
Material(TotMaterials)%Group = WindowGas
Material(TotMaterials)%Roughness = 3
Material(TotMaterials)%Conductivity = 0.0d0
Material(TotMaterials)%Density = 0.0d0
Material(TotMaterials)%IsoMoistCap = 0.0d0
Material(TotMaterials)%Porosity = 0.0d0
Material(TotMaterials)%Resistance = 0.0d0
Material(TotMaterials)%SpecHeat = 0.0d0
Material(TotMaterials)%ThermGradCoef = 0.0d0
Material(TotMaterials)%Thickness = StormWindow(StormWinNum)%StormWinDistance
Material(TotMaterials)%VaporDiffus = 0.0d0
Material(TotMaterials)%GasType = 0
Material(TotMaterials)%GasCon = 0.0d0
Material(TotMaterials)%GasVis = 0.0d0
Material(TotMaterials)%GasCp = 0.0d0
Material(TotMaterials)%GasWght = 0.0d0
Material(TotMaterials)%GasFract = 0.0d0
Material(TotMaterials)%GasType(1) = 1
Material(TotMaterials)%GlassSpectralDataPtr = 0
Material(TotMaterials)%NumberOfGasesInMixture = 1
Material(TotMaterials)%GasCon(1,1) = 2.873d-3
Material(TotMaterials)%GasCon(1,2) = 7.760d-5
Material(TotMaterials)%GasVis(1,1) = 3.723d-6
Material(TotMaterials)%GasVis(1,2) = 4.940d-8
Material(TotMaterials)%GasCp(1,1) = 1002.737d0
Material(TotMaterials)%GasCp(1,2) = 1.2324d-2
Material(TotMaterials)%GasWght(1) = 28.97d0
Material(TotMaterials)%GasFract(1) = 1.0d0
Material(TotMaterials)%AbsorpSolar = 0.0d0
Material(TotMaterials)%AbsorpThermal = 0.0d0
Material(TotMaterials)%AbsorpVisible = 0.0d0
Material(TotMaterials)%Trans = 0.0d0
Material(TotMaterials)%TransVis = 0.0d0
Material(TotMaterials)%GlassTransDirtFactor = 0.0d0
Material(TotMaterials)%ReflectShade = 0.0d0
Material(TotMaterials)%ReflectShadeVis = 0.0d0
Material(TotMaterials)%AbsorpThermalBack = 0.0d0
Material(TotMaterials)%AbsorpThermalFront = 0.0d0
Material(TotMaterials)%ReflectSolBeamBack = 0.0d0
Material(TotMaterials)%ReflectSolBeamFront = 0.0d0
Material(TotMaterials)%ReflectSolDiffBack = 0.0d0
Material(TotMaterials)%ReflectSolDiffFront = 0.0d0
Material(TotMaterials)%ReflectVisBeamBack = 0.0d0
Material(TotMaterials)%ReflectVisBeamFront = 0.0d0
Material(TotMaterials)%ReflectVisDiffBack = 0.0d0
Material(TotMaterials)%ReflectVisDiffFront = 0.0d0
Material(TotMaterials)%TransSolBeam = 0.0d0
Material(TotMaterials)%TransThermal = 0.0d0
Material(TotMaterials)%TransVisBeam = 0.0d0
Material(TotMaterials)%BlindDataPtr = 0
Material(TotMaterials)%WinShadeToGlassDist = 0.0d0
Material(TotMaterials)%WinShadeTopOpeningMult = 0.0d0
Material(TotMaterials)%WinShadeBottomOpeningMult = 0.0d0
Material(TotMaterials)%WinShadeLeftOpeningMult = 0.0d0
Material(TotMaterials)%WinShadeRightOpeningMult = 0.0d0
Material(TotMaterials)%WinShadeAirFlowPermeability = 0.0d0
Material(TotMaterials)%EMPDVALUE = 0.0d0
Material(TotMaterials)%MoistACoeff = 0.0d0
Material(TotMaterials)%MoistBCoeff = 0.0d0
Material(TotMaterials)%MoistCCoeff = 0.0d0
Material(TotMaterials)%MoistDCoeff = 0.0d0
Material(TotMaterials)%EMPDaCoeff = 0.0d0
Material(TotMaterials)%EMPDbCoeff = 0.0d0
Material(TotMaterials)%EMPDcCoeff = 0.0d0
Material(TotMaterials)%EMPDdCoeff = 0.0d0
END IF ! End of check if new air layer material has to be created
END IF
IF((loop==1.AND.ConstrNewSt==0).OR.(loop==2.AND.ConstrNewStSh==0)) THEN
! Create new constructions
ConstrNew = TotConstructs + 1
IF(loop==1) THEN
Surface(SurfNum)%StormWinConstruction = ConstrNew
ELSE
Surface(SurfNum)%StormWinShadedConstruction = ConstrNew
END IF
ALLOCATE(ConstructSave(TotConstructs))
ALLOCATE(NominalRSave(TotConstructs))
ALLOCATE(NominalUSave(TotConstructs))
ConstructSave(1:TotConstructs) = Construct(1:TotConstructs)
NominalRSave(1:TotConstructs) = NominalRforNominalUCalculation(1:TotConstructs)
NominalUSave(1:TotConstructs) = NominalU(1:TotConstructs)
DEALLOCATE(Construct)
DEALLOCATE(NominalRforNominalUCalculation)
DEALLOCATE(NominalU)
TotConstructs = ConstrNew
ALLOCATE(Construct(TotConstructs))
ALLOCATE(NominalRforNominalUCalculation(TotConstructs))
ALLOCATE(NominalU(TotConstructs))
Construct(1:TotConstructs-1) = ConstructSave(1:TotConstructs-1)
NominalRforNominalUCalculation(1:TotConstructs-1) = NominalRSave(1:TotConstructs-1)
NominalU(1:TotConstructs-1) = NominalUSave(1:TotConstructs-1)
DEALLOCATE(ConstructSave)
DEALLOCATE(NominalRSave)
DEALLOCATE(NominalUSave)
ConstrOld = ConstrNum
IF(loop==2) ConstrOld = ConstrNumSh
TotLayersOld = Construct(ConstrOld)%TotLayers
Construct(ConstrNew)%LayerPoint(1:MaxLayersInConstruct) = 0
Construct(ConstrNew)%LayerPoint(1) = StormWinMatNum
Construct(ConstrNew)%LayerPoint(2) = MatNewStAir
Construct(ConstrNew)%LayerPoint(3:TotLayersOld + 2) = Construct(ConstrOld)%LayerPoint(1:TotLayersOld)
Construct(ConstrNew)%Name = ConstrNameSt
IF(loop==2) Construct(ConstrNew)%Name = ConstrNameStSh
Construct(ConstrNew)%TotLayers = TotLayersOld + 2
Construct(ConstrNew)%TotSolidLayers = Construct(ConstrOld)%TotSolidLayers + 1
Construct(ConstrNew)%TotGlassLayers = Construct(ConstrOld)%TotGlassLayers + 1
Construct(ConstrNew)%TypeIsWindow = .true.
Construct(ConstrNew)%InsideAbsorpVis = 0.0d0
Construct(ConstrNew)%OutsideAbsorpVis = 0.0d0
Construct(ConstrNew)%InsideAbsorpSolar = 0.0d0
Construct(ConstrNew)%OutsideAbsorpSolar = 0.0d0
Construct(ConstrNew)%InsideAbsorpThermal = Construct(ConstrOld)%InsideAbsorpThermal
Construct(ConstrNew)%OutsideAbsorpThermal = Material(StormWinMatNum)%AbsorpThermalFront
Construct(ConstrNew)%OutSideRoughness = VerySmooth
Construct(ConstrNew)%DayltPropPtr = 0
Construct(ConstrNew)%CTFCross = 0.0D0
Construct(ConstrNew)%CTFFlux = 0.0D0
Construct(ConstrNew)%CTFInside = 0.0D0
Construct(ConstrNew)%CTFOutside = 0.0D0
Construct(ConstrNew)%CTFSourceIn = 0.0D0
Construct(ConstrNew)%CTFSourceOut = 0.0D0
Construct(ConstrNew)%CTFTimeStep = 0.0D0
Construct(ConstrNew)%CTFTSourceOut = 0.0D0
Construct(ConstrNew)%CTFTSourceIn = 0.0D0
Construct(ConstrNew)%CTFTSourceQ = 0.0D0
Construct(ConstrNew)%CTFTUserOut = 0.0D0
Construct(ConstrNew)%CTFTUserIn = 0.0D0
Construct(ConstrNew)%CTFTUserSource = 0.0D0
Construct(ConstrNew)%NumHistories = 0
Construct(ConstrNew)%NumCTFTerms = 0
Construct(ConstrNew)%UValue = 0.0d0
Construct(ConstrNew)%SourceSinkPresent = .false.
Construct(ConstrNew)%SolutionDimensions = 0
Construct(ConstrNew)%SourceAfterLayer = 0
Construct(ConstrNew)%TempAfterLayer = 0
Construct(ConstrNew)%ThicknessPerpend = 0.0d0
Construct(ConstrNew)%AbsDiffIn = 0.0d0
Construct(ConstrNew)%AbsDiffOut = 0.0d0
Construct(ConstrNew)%AbsDiff = 0.0d0
Construct(ConstrNew)%AbsDiffBack = 0.0d0
Construct(ConstrNew)%AbsDiffShade = 0.0d0
Construct(ConstrNew)%AbsDiffBackShade = 0.0d0
Construct(ConstrNew)%ShadeAbsorpThermal = 0.0d0
Construct(ConstrNew)%AbsBeamCoef = 0.0d0
Construct(ConstrNew)%AbsBeamBackCoef = 0.0d0
Construct(ConstrNew)%AbsBeamShadeCoef = 0.0d0
Construct(ConstrNew)%TransDiff = 0.0d0
Construct(ConstrNew)%TransDiffVis = 0.0d0
Construct(ConstrNew)%ReflectSolDiffBack = 0.0d0
Construct(ConstrNew)%ReflectSolDiffFront = 0.0d0
Construct(ConstrNew)%ReflectVisDiffBack = 0.0d0
Construct(ConstrNew)%ReflectVisDiffFront = 0.0d0
Construct(ConstrNew)%TransSolBeamCoef = 0.0d0
Construct(ConstrNew)%TransVisBeamCoef = 0.0d0
Construct(ConstrNew)%ReflSolBeamFrontCoef= 0.0d0
Construct(ConstrNew)%ReflSolBeamBackCoef = 0.0d0
Construct(ConstrNew)%W5FrameDivider = 0
Construct(ConstrNew)%FromWindow5DataFile = .false.
Construct(ConstrNew)%W5FileMullionWidth = 0.0d0
Construct(ConstrNew)%W5FileMullionOrientation = 0
Construct(ConstrNew)%W5FileGlazingSysWidth = 0.0d0
Construct(ConstrNew)%W5FileGlazingSysHeight = 0.0d0
END IF ! End of check if new window constructions have to be created
END DO ! End of loop over unshaded and shaded window constructions
END DO ! End of loop over storm window objects
RETURN
END SUBROUTINE CreateStormWindowConstructions