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) | :: | WSCptr | |||
integer, | intent(in) | :: | ShDevNum |
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 CreateShadedWindowConstruction(SurfNum,WSCptr,ShDevNum)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Winkelmann
! DATE WRITTEN Nov 2001
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Creates a shaded window construction for windows whose WindowShadingControl
! has a shading device specified instead of a 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:
INTEGER, INTENT(IN) :: SurfNum ! Surface number
INTEGER, INTENT(IN) :: WSCptr ! Pointer to WindowShadingControl for SurfNum
INTEGER, INTENT(IN) :: ShDevNum ! Shading device material number for WSCptr
! SUBROUTINE PARAMETER DEFINITIONS:na
! INTERFACE BLOCK SPECIFICATIONS;na
! DERIVED TYPE DEFINITIONS:na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: ConstrNum ! Number of unshaded construction
INTEGER :: ConstrNewSh ! Number of shaded construction that is created
CHARACTER(len=MaxNameLength) :: ShDevName ! Shading device material name
CHARACTER(len=MaxNameLength) :: ConstrName ! Unshaded construction name
CHARACTER(len=MaxNameLength) :: ConstrNameSh ! Shaded construction name
INTEGER :: TotLayersOld ! Total layers in old (unshaded) construction
INTEGER :: TotLayersNew ! Total layers in new (shaded) construction
! INTEGER :: loop ! DO loop index
ShDevName = Material(ShDevNum)%Name
ConstrNum = SurfaceTmp(SurfNum)%Construction
ConstrName= Construct(ConstrNum)%Name
IF(WindowShadingControl(WSCptr)%ShadingType==WSC_ST_InteriorShade.OR. &
WindowShadingControl(WSCptr)%ShadingType==WSC_ST_InteriorBlind) THEN
ConstrNameSh = TRIM(ConstrName)//':'//TRIM(ShDevName)//':'//'INT'
ELSE
ConstrNameSh = TRIM(ConstrName)//':'//TRIM(ShDevName)//':'//'EXT'
END IF
! If this construction name already exists, set the surface's shaded construction number to it
ConstrNewSh = FindIteminList(ConstrNameSh,Construct%Name,TotConstructs)
IF(ConstrNewSh > 0) THEN
SurfaceTmp(SurfNum)%ShadedConstruction = ConstrNewSh
ELSE
! Create new construction
ConstrNewSh = TotConstructs + 1
SurfaceTmp(SurfNum)%ShadedConstruction = ConstrNewSh
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 = ConstrNewSh
ALLOCATE(Construct(TotConstructs))
ALLOCATE(NominalRforNominalUCalculation(TotConstructs))
ALLOCATE(NominalU(TotConstructs))
NominalRforNominalUCalculation=0.0d0
NominalU=0.0d0
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)
TotLayersOld = Construct(ConstrNum)%TotLayers
TotLayersNew = TotLayersOld + 1
Construct(ConstrNewSh)%LayerPoint = 0
IF(WindowShadingControl(WSCptr)%ShadingType==WSC_ST_InteriorShade.OR. &
WindowShadingControl(WSCptr)%ShadingType==WSC_ST_InteriorBlind) THEN
! Interior shading device
Construct(ConstrNewSh)%LayerPoint(1:TotLayersOld) = Construct(ConstrNum)%LayerPoint(1:TotLayersOld)
Construct(ConstrNewSh)%LayerPoint(TotLayersNew) = ShDevNum
Construct(ConstrNewSh)%InsideAbsorpSolar = Material(ShDevNum)%AbsorpSolar
Construct(ConstrNewSh)%OutsideAbsorpSolar = Material(Construct(ConstrNewSh)%LayerPoint(1))%AbsorpSolar
Construct(ConstrNewSh)%OutsideAbsorpThermal = Material(Construct(ConstrNewSh)%LayerPoint(1))%AbsorpThermalFront
ELSE
! Exterior shading device
Construct(ConstrNewSh)%LayerPoint(1) = ShDevNum
Construct(ConstrNewSh)%LayerPoint(2:TotLayersNew) = Construct(ConstrNum)%LayerPoint(1:TotLayersOld)
Construct(ConstrNewSh)%InsideAbsorpSolar = &
Material(Construct(ConstrNewSh)%LayerPoint(TotLayersNew))%AbsorpSolar
Construct(ConstrNewSh)%OutsideAbsorpSolar = Material(ShDevNum)%AbsorpSolar
Construct(ConstrNewSh)%OutsideAbsorpThermal = Material(ShDevNum)%AbsorpThermalFront
END IF
! The following InsideAbsorpThermal applies only to inside glass; it is corrected
! later in InitGlassOpticalCalculations if construction has inside shade or blind.
Construct(ConstrNewSh)%InsideAbsorpThermal = &
Material(Construct(ConstrNum)%LayerPoint(TotLayersOld))%AbsorpThermalBack
Construct(ConstrNewSh)%OutSideRoughness = VerySmooth
Construct(ConstrNewSh)%DayltPropPtr = 0
Construct(ConstrNewSh)%CTFCross = 0.0D0
Construct(ConstrNewSh)%CTFFlux = 0.0D0
Construct(ConstrNewSh)%CTFInside = 0.0D0
Construct(ConstrNewSh)%CTFOutside = 0.0D0
Construct(ConstrNewSh)%CTFSourceIn = 0.0D0
Construct(ConstrNewSh)%CTFSourceOut = 0.0D0
Construct(ConstrNewSh)%CTFTimeStep = 0.0D0
Construct(ConstrNewSh)%CTFTSourceOut = 0.0D0
Construct(ConstrNewSh)%CTFTSourceIn = 0.0D0
Construct(ConstrNewSh)%CTFTSourceQ = 0.0D0
Construct(ConstrNewSh)%CTFTUserOut = 0.0D0
Construct(ConstrNewSh)%CTFTUserIn = 0.0D0
Construct(ConstrNewSh)%CTFTUserSource = 0.0D0
Construct(ConstrNewSh)%NumHistories = 0
Construct(ConstrNewSh)%NumCTFTerms = 0
Construct(ConstrNewSh)%UValue = 0.0d0
Construct(ConstrNewSh)%SourceSinkPresent = .FALSE.
Construct(ConstrNewSh)%SolutionDimensions = 0
Construct(ConstrNewSh)%SourceAfterLayer = 0
Construct(ConstrNewSh)%TempAfterLayer = 0
Construct(ConstrNewSh)%ThicknessPerpend = 0.0d0
Construct(ConstrNewSh)%AbsDiff = 0.0d0
Construct(ConstrNewSh)%AbsDiffBack = 0.0d0
Construct(ConstrNewSh)%AbsDiffShade = 0.0d0
Construct(ConstrNewSh)%AbsDiffBackShade = 0.0d0
Construct(ConstrNewSh)%ShadeAbsorpThermal = 0.0d0
Construct(ConstrNewSh)%AbsBeamCoef = 0.0d0
Construct(ConstrNewSh)%AbsBeamBackCoef = 0.0d0
Construct(ConstrNewSh)%AbsBeamShadeCoef = 0.0d0
Construct(ConstrNewSh)%TransDiff = 0.0d0
Construct(ConstrNewSh)%TransDiffVis = 0.0d0
Construct(ConstrNewSh)%ReflectSolDiffBack = 0.0d0
Construct(ConstrNewSh)%ReflectSolDiffFront = 0.0d0
Construct(ConstrNewSh)%ReflectVisDiffBack = 0.0d0
Construct(ConstrNewSh)%ReflectVisDiffFront = 0.0d0
Construct(ConstrNewSh)%TransSolBeamCoef = 0.0d0
Construct(ConstrNewSh)%TransVisBeamCoef = 0.0d0
Construct(ConstrNewSh)%ReflSolBeamFrontCoef= 0.0d0
Construct(ConstrNewSh)%ReflSolBeamBackCoef = 0.0d0
Construct(ConstrNewSh)%W5FrameDivider = 0
Construct(ConstrNewSh)%FromWindow5DataFile = .false.
Construct(ConstrNewSh)%Name = ConstrNameSh
Construct(ConstrNewSh)%TotLayers = TotLayersNew
Construct(ConstrNewSh)%TotSolidLayers = Construct(ConstrNum)%TotSolidLayers + 1
Construct(ConstrNewSh)%TotGlassLayers = Construct(ConstrNum)%TotGlassLayers
Construct(ConstrNewSh)%TypeIsWindow = .true.
Construct(ConstrNewSh)%IsUsed = .true.
END IF
RETURN
END SUBROUTINE CreateShadedWindowConstruction