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 | ||
---|---|---|---|---|---|---|
logical, | intent(inout) | :: | ErrorsFound |
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 GetConstructData(ErrorsFound)
! SUBROUTINE INFORMATION:
! AUTHOR Richard Liesen
! DATE WRITTEN September 1997
! MODIFIED January 2003, FCW: accommodate between-glass shading device
! July 2009, TH: added constructions defined with F and C factors
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This file reads the input through the input processor for Constructions.
! Data read in this routine is stored in a derived type (Construct)
! defined in the DataHeatBalance module.
! This subroutine only sets those parameters which must be obtained
! from the input file--all other portions of the Construct derived
! type are set during the initializations.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataStringGlobals
USE DataBSDFWindow, ONLY: TotComplexFenStates
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(INOUT) :: ErrorsFound ! If errors found in input
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: ConstrNum ! Counter to keep track of the construction number
INTEGER :: Layer ! loop index for each of the construction layers
INTEGER :: ConstructNumAlpha ! Number of construction alpha names being passed
INTEGER :: DummyNumProp ! dummy variable for properties being passed
INTEGER :: IOStat ! IO Status when calling get input subroutine
CHARACTER(len=MaxNameLength),DIMENSION(0:MaxLayersInConstruct) &
:: ConstructAlphas ! Construction Alpha names defined
REAL(r64), DIMENSION(4) :: DummyProps !Temporary array to transfer construction properties
LOGICAL :: ErrorInName
LOGICAL :: IsBlank
INTEGER :: Loop
INTEGER :: TotRegConstructs ! Number of "regular" constructions (no embedded sources or sinks and
INTEGER :: TotFfactorConstructs ! Number of slabs-on-grade or underground floor constructions defined with F factors
INTEGER :: TotCfactorConstructs ! Number of underground wall constructions defined with C factors
INTEGER :: TotSourceConstructs ! Number of constructions with embedded sources or sinks
INTEGER :: TotWindow5Constructs ! Number of constructions from Window5 data file
LOGICAL :: ConstructionFound ! True if input window construction name is found in the
! Window5 data file
LOGICAL :: EOFonW5File ! True if EOF encountered reading Window5 data file
LOGICAL :: NoRegularMaterialsUsed=.true.
INTEGER :: iMatGlass ! number of glass layers
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: WConstructNames
! FLOW:
!Get the Total number of Constructions from the input
TotRegConstructs = GetNumObjectsFound('Construction')
TotSourceConstructs = GetNumObjectsFound('Construction:InternalSource')
TotFfactorConstructs = GetNumObjectsFound('Construction:FfactorGroundFloor')
TotCfactorConstructs = GetNumObjectsFound('Construction:CfactorUndergroundWall')
TotComplexFenStates = GetNumObjectsFound('Construction:ComplexFenestrationState')
TotWindow5Constructs = GetNumObjectsFound('Construction:WindowDataFile')
TotWinEquivLayerConstructs = GetNumObjectsFound('Construction:WindowEquivalentLayer')
ALLOCATE(WConstructNames(TotWindow5Constructs))
WConstructNames=' '
TotConstructs = TotRegConstructs + TotFfactorConstructs + TotCfactorConstructs &
+ TotSourceConstructs + TotComplexFenStates + TotWinEquivLayerConstructs
ALLOCATE(NominalRforNominalUCalculation(TotConstructs))
NominalRforNominalUCalculation=0.0d0
ALLOCATE(NominalU(TotConstructs))
NominalU=0.0d0
!Allocate the array to the number of constructions/initialize selected variables
ALLOCATE(Construct(TotConstructs))
!Note: If TotWindow5Constructs > 0, additional constructions are created in
!subr. SearchWindow5DataFile corresponding to those found on the data file.
!Initialize CTF and History terms.
Construct%NumCTFTerms = 0
Construct%NumHistories = 0
!Initialize some heat source/sink variables
Construct%SourceSinkPresent = .FALSE. ! "default" is no source or sink present
Construct%SolutionDimensions = 1 ! "default" is 1-D heat transfer
Construct%SourceAfterLayer = 0 ! this has no meaning if a source/sink is not present
Construct%TempAfterLayer = 0 ! this has no meaning if a source/sink is not present
Construct%ThicknessPerpend = 0.0d0 ! this has no meaning if a source/sink is not present
Construct%W5FrameDivider = 0
Construct%FromWindow5DataFile = .FALSE.
ConstrNum=0
CurrentModuleObject='Construction'
DO Loop = 1, TotRegConstructs ! Loop through all constructs in the input...
!Get the object names for each construction from the input processor
CALL GetObjectItem(CurrentModuleObject,Loop,ConstructAlphas,ConstructNumAlpha,DummyProps,DummyNumProp,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
CALL VerifyName(ConstructAlphas(0),Construct%Name,ConstrNum,ErrorInName,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (ErrorInName) THEN
ErrorsFound=.true.
CYCLE
ENDIF
!Glass layer counter
iMatGlass = 0
ConstrNum=ConstrNum+1
!Assign Construction name to the Derived Type using the zeroth position of the array
Construct(ConstrNum)%Name = ConstructAlphas(0)
!Set the total number of layers for the construction
Construct(ConstrNum)%TotLayers = ConstructNumAlpha-1
! Loop through all of the layers of the construct to match the material names.
! The loop index is the number minus 1
DO Layer = 1, ConstructNumAlpha-1
!Find the material in the list of materials
Construct(ConstrNum)%LayerPoint(Layer) = FindIteminList(ConstructAlphas(Layer),Material%Name,TotMaterials)
! count number of glass layers
IF (Construct(ConstrNum)%LayerPoint(Layer)>0) THEN
IF (Material(Construct(ConstrNum)%LayerPoint(Layer))%Group == WindowGlass) iMatGlass = iMatGlass + 1
ENDIF
IF (Construct(ConstrNum)%LayerPoint(Layer) == 0) THEN
!This may be a TC GlazingGroup
Construct(ConstrNum)%LayerPoint(Layer) = FindIteminList(ConstructAlphas(Layer),TCGlazings%Name,TotTCGlazings)
IF (Construct(ConstrNum)%LayerPoint(Layer)>0) THEN
!reset layer pointer to the first glazing in the TC GlazingGroup
Construct(ConstrNum)%LayerPoint(Layer)=TCGlazings(Construct(ConstrNum)%LayerPoint(Layer))%LayerPoint(1)
Construct(ConstrNum)%TCLayer = Construct(ConstrNum)%LayerPoint(Layer)
IF (Material(Construct(ConstrNum)%LayerPoint(Layer))%Group == WindowGlass) iMatGlass = iMatGlass + 1
Construct(ConstrNum)%TCFlag = 1
Construct(ConstrNum)%TCMasterConst = ConstrNum
Construct(ConstrNum)%TCGlassID = iMatGlass ! the TC glass layer ID
Construct(ConstrNum)%TCLayerID = Layer
Construct(ConstrNum)%TypeIsWindow = .True.
ENDIF
ENDIF
IF (Construct(ConstrNum)%LayerPoint(Layer) == 0) THEN
CALL ShowSevereError('Did not find matching material for '//TRIM(CurrentModuleObject)//' '// &
TRIM(Construct(ConstrNum)%Name)//', missing material = '//TRIM(ConstructAlphas(Layer)))
ErrorsFound=.true.
ELSE
NominalRforNominalUCalculation(ConstrNum)=NominalRforNominalUCalculation(ConstrNum)+ &
NominalR(Construct(ConstrNum)%LayerPoint(Layer))
IF (Material(Construct(ConstrNum)%LayerPoint(Layer))%Group == RegularMaterial &
.and. .not. Material(Construct(ConstrNum)%LayerPoint(Layer))%ROnly) THEN
NoRegularMaterialsUsed=.false.
ENDIF
ENDIF
END DO ! ...end of the Layer DO loop
END DO ! ...end of Regular Construction DO loop
TotRegConstructs = ConstrNum
! Added TH 7/2009 for underground walls and floors constructions
IF (TotFfactorConstructs + TotCfactorConstructs >= 1) THEN
CALL CreateFCfactorConstructions(ConstrNum,ErrorsFound)
IF (ErrorsFound) THEN
CALL ShowSevereError('Errors found in creating the constructions defined with Ffactor or Cfactor method')
ENDIF
TotRegConstructs = TotRegConstructs + TotFfactorConstructs + TotCfactorConstructs
ENDIF
! Added BG 6/2010 for complex fenestration
IF (TotComplexFenStates > 0) Then
CALL SetupComplexFenestrationStateInput(ConstrNum,ErrorsFound)
IF (ErrorsFound) THEN
CALL ShowSevereError('Errors found in processing complex fenestration input')
ENDIF
TotRegConstructs = TotRegConstructs + TotComplexFenStates
ENDIF
ConstrNum=0
CurrentModuleObject='Construction:InternalSource'
DO Loop = 1, TotSourceConstructs ! Loop through all constructs with sources in the input...
!Get the object names for each construction from the input processor
CALL GetObjectItem(CurrentModuleObject,Loop,ConstructAlphas,ConstructNumAlpha,DummyProps,DummyNumProp,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
CALL VerifyName(ConstructAlphas(0),Construct%Name,TotRegConstructs+ConstrNum,ErrorInName, &
IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (ErrorInName) THEN
ErrorsFound=.true.
CYCLE
ENDIF
ConstrNum=ConstrNum+1
!Assign Construction name to the Derived Type using the zeroth position of the array
Construct(TotRegConstructs+ConstrNum)%Name = ConstructAlphas(0)
! Obtain the source/sink data
IF (DummyNumProp /= 4) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//': Wrong number of numerical inputs for '//TRIM(Construct(ConstrNum)%Name))
ErrorsFound = .TRUE.
END IF
Construct(TotRegConstructs+ConstrNum)%SourceSinkPresent = .TRUE.
Construct(TotRegConstructs+ConstrNum)%SourceAfterLayer = INT(DummyProps(1))
Construct(TotRegConstructs+ConstrNum)%TempAfterLayer = INT(DummyProps(2))
Construct(TotRegConstructs+ConstrNum)%SolutionDimensions = INT(DummyProps(3))
IF ( (Construct(TotRegConstructs+ConstrNum)%SolutionDimensions < 1) .OR. &
(Construct(TotRegConstructs+ConstrNum)%SolutionDimensions > 2) ) THEN
CALL ShowWarningError('Construction:InternalSource must be either 1- or 2-D. Reset to 1-D solution.')
CALL ShowContinueError('Construction='//TRIM(Construct(TotRegConstructs+ConstrNum)%Name)//' is affected.')
Construct(TotRegConstructs+ConstrNum)%SolutionDimensions=1
ENDIF
Construct(TotRegConstructs+ConstrNum)%ThicknessPerpend = DummyProps(4)
!Set the total number of layers for the construction
Construct(TotRegConstructs+ConstrNum)%TotLayers = ConstructNumAlpha-1
IF (Construct(TotRegConstructs+ConstrNum)%TotLayers <= 1) THEN
CALL ShowSevereError('Construction '//TRIM(Construct(TotRegConstructs+ConstrNum)%Name)// &
' has an internal source or sink and thus must have more than a single layer')
ErrorsFound=.true.
END IF
IF ( (Construct(TotRegConstructs+ConstrNum)%SourceAfterLayer >= Construct(TotRegConstructs+ConstrNum)%TotLayers) .OR. &
(Construct(TotRegConstructs+ConstrNum)%SourceAfterLayer <= 0) ) THEN
CALL ShowWarningError('Construction '//TRIM(Construct(TotRegConstructs+ConstrNum)%Name)// &
' must have a source that is between two layers')
CALL ShowContinueError('The source after layer parameter has been set to one less than the number of layers.')
Construct(TotRegConstructs+ConstrNum)%SourceAfterLayer = Construct(TotRegConstructs+ConstrNum)%TotLayers - 1
END IF
IF ( (Construct(TotRegConstructs+ConstrNum)%TempAfterLayer >= Construct(TotRegConstructs+ConstrNum)%TotLayers) .OR. &
(Construct(TotRegConstructs+ConstrNum)%TempAfterLayer <= 0) ) THEN
CALL ShowWarningError('Construction '//TRIM(Construct(TotRegConstructs+ConstrNum)%Name)// &
' must have a temperature calculation that is between two layers')
CALL ShowContinueError('The temperature calculation after layer parameter has been set '// &
'to one less than the number of layers.')
Construct(TotRegConstructs+ConstrNum)%TempAfterLayer = Construct(TotRegConstructs+ConstrNum)%TotLayers - 1
END IF
! Loop through all of the layers of the construct to match the material names.
! The loop index is the number minus 1
DO Layer = 1, ConstructNumAlpha-1
!Find the material in the list of materials
Construct(TotRegConstructs+ConstrNum)%LayerPoint(Layer) = FindIteminList(ConstructAlphas(Layer),Material%Name,TotMaterials)
IF (Construct(TotRegConstructs+ConstrNum)%LayerPoint(Layer) == 0) THEN
CALL ShowSevereError('Did not find matching material for '//TRIM(CurrentModuleObject)//' '// &
TRIM(Construct(ConstrNum)%Name)// &
', missing material = '//TRIM(ConstructAlphas(Layer)))
ErrorsFound=.true.
ELSE
NominalRforNominalUCalculation(TotRegConstructs+ConstrNum)=NominalRforNominalUCalculation(TotRegConstructs+ConstrNum)+ &
NominalR(Construct(TotRegConstructs+ConstrNum)%LayerPoint(Layer))
IF (Material(Construct(TotRegConstructs+ConstrNum)%LayerPoint(Layer))%Group == RegularMaterial &
.and. .not. Material(Construct(TotRegConstructs+ConstrNum)%LayerPoint(Layer))%ROnly) THEN
NoRegularMaterialsUsed=.false.
ENDIF
ENDIF
END DO ! ...end of the Layer DO loop
END DO ! ...end of Source Construction DO loop
TotSourceConstructs = ConstrNum
TotRegConstructs = TotRegConstructs + TotSourceConstructs
TotConstructs = TotRegConstructs
IF (TotConstructs > 0 .and. NoRegularMaterialsUsed) THEN
CALL ShowSevereError('This building has no thermal mass which can cause an unstable solution.')
CALL ShowContinueError('Use Material object for all opaque material definitions except very light insulation layers.')
ENDIF
ConstrNum=0
CurrentModuleObject='Construction:WindowEquivalentLayer'
DO Loop = 1, TotWinEquivLayerConstructs ! Loop through all constructs with Window EquivalentLayer ...
!Get the object names for each construction from the input processor
CALL GetObjectItem(CurrentModuleObject,Loop,ConstructAlphas,ConstructNumAlpha,DummyProps,DummyNumProp,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
CALL VerifyName(ConstructAlphas(0),Construct%Name,TotRegConstructs+ConstrNum,ErrorInName, &
IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (ErrorInName) THEN
ErrorsFound=.true.
CYCLE
ENDIF
ConstrNum=ConstrNum+1
!Assign Construction name to the Derived Type using the zeroth position of the array
Construct(TotRegConstructs+ConstrNum)%Name = ConstructAlphas(0)
! Set the total number of layers for the construction
Construct(TotRegConstructs+ConstrNum)%TotLayers = ConstructNumAlpha-1
IF (Construct(TotRegConstructs+ConstrNum)%TotLayers < 1) THEN
CALL ShowSevereError('Construction '//TRIM(Construct(TotRegConstructs+ConstrNum)%Name)// &
' must have at least a single layer')
ErrorsFound=.true.
END IF
! Loop through all of the layers of the construct to match the material names.
! The loop index is the number minus 1
DO Layer = 1, ConstructNumAlpha-1
!Find the material in the list of materials
Construct(TotRegConstructs+ConstrNum)%LayerPoint(Layer) = FindIteminList(ConstructAlphas(Layer),Material%Name,TotMaterials)
IF (Construct(TotRegConstructs+ConstrNum)%LayerPoint(Layer) == 0) THEN
CALL ShowSevereError('Did not find matching material for '//TRIM(CurrentModuleObject)//' '// &
TRIM(Construct(ConstrNum)%Name)// &
', missing material = '//TRIM(ConstructAlphas(Layer)))
ErrorsFound=.true.
ELSE
IF (ConstructNumAlpha <= 2)THEN
ELSE
NominalRforNominalUCalculation(TotRegConstructs+ConstrNum)=NominalRforNominalUCalculation(TotRegConstructs+ConstrNum)+ &
NominalR(Construct(TotRegConstructs+ConstrNum)%LayerPoint(Layer))
ENDIF
ENDIF
END DO ! ...end of the Layer DO loop
Construct(TotRegConstructs+ConstrNum)%EQLConsPtr = ConstrNum
Construct(TotRegConstructs+ConstrNum)%WindowTypeEQL = .TRUE.
END DO ! ...end of TotWinEquivLayerConstructs DO loop
TotWinEquivLayerConstructs = ConstrNum
TotRegConstructs = TotRegConstructs + TotWinEquivLayerConstructs
TotConstructs = TotRegConstructs
!-------------------------------------------------------------------------------
ConstrNum = 0
CurrentModuleObject='Construction:WindowDataFile'
DO Loop = 1, TotWindow5Constructs ! Loop through all Window5 constructions. These constructions come
! from the Window5 data file and can be referenced only by windows
!Get the object names for each construction from the input processor
CALL GetObjectItem(CurrentModuleObject,Loop,ConstructAlphas,ConstructNumAlpha,DummyProps,DummyNumProp,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
CALL VerifyName(ConstructAlphas(0),WConstructNames,ConstrNum,ErrorInName,IsBlank, &
TRIM(CurrentModuleObject)//' Name')
IF (ErrorInName .and. .not. IsBlank) THEN
CALL ShowContinueError('...first instance will be used.')
CYCLE
ENDIF
IF (IsBlank) THEN
ErrorsFound=.true.
CYCLE
ENDIF
ConstrNum=ConstrNum+1
WConstructNames(ConstrNum)=ConstructAlphas(0)
! Obtain the data
IF (DummyNumProp /= 0) THEN
CALL ShowSevereError('Construction From Window5 Data File: there should be no numerical inputs for '// &
TRIM(ConstructAlphas(0)))
ErrorsFound = .TRUE.
CYCLE
END IF
! See if this construction is in the W5DataFile produced by the WINDOW 5 program;
! if so, ConstructionFound will be set to true and the Material objects
! associated with the construction will be created in subr. SearchWindow5DataFile.
! (If the matching construction on the Window5 data file has two glazing systems, a
! second construction and its associated materials will be created in subr.
! SearchWindow5DataFile and TotConstructs WILL BE INCREMENTED BY 1 in that routine.
! A FrameAndDivider object will also be created if window on data file has a
! frame or divider.)
IF (ConstructAlphas(1) == ' ') THEN
FullName=TRIM(CurrentWorkingFolder)//'Window5DataFile.dat'
ELSE
FullName=ConstructAlphas(1)
ENDIF
CALL DisplayString('Searching Window5 data file for Construction=' &
//TRIM(ConstructAlphas(0)))
CALL SearchWindow5DataFile(TRIM(FullName),ConstructAlphas(0),ConstructionFound,EOFonW5File,ErrorsFound)
IF(EOFonW5File.OR..NOT.ConstructionFound) THEN
CALL DisplayString('--Construction not found')
ErrorsFound = .true.
CALL ShowSevereError('No match on WINDOW5 data file for Construction=' &
//Trim(ConstructAlphas(0))//', or error in data file.')
CALL ShowContinueError('...Looking on file='//TRIM(FullName))
CYCLE
END IF
END DO ! ...end of Window5 Constructions DO loop
DEALLOCATE(WConstructNames)
! set some (default) properties of the Construction Derived Type
DO ConstrNum = 1, TotConstructs
IF (NominalRforNominalUCalculation(ConstrNum) /= 0.0d0) THEN
NominalU(ConstrNum)=1.0d0/NominalRforNominalUCalculation(ConstrNum)
ELSE
IF (.NOT. Construct(ConstrNum)%WindowTypeEQL) THEN
CALL ShowSevereError('Nominal U is zero, for construction='//TRIM(Construct(ConstrNum)%Name))
ErrorsFound=.true.
ENDIF
ENDIF
CALL CheckAndSetConstructionProperties(ConstrNum,ErrorsFound)
END DO ! End of ConstrNum DO loop
RETURN
END SUBROUTINE GetConstructData