SUBROUTINE GetMaterialData(ErrorsFound)
! SUBROUTINE INFORMATION:
! AUTHOR Richard Liesen
! DATE WRITTEN September 1997
! MODIFIED April 1999; L.Lawrie
! Sept 1999, FCW, Window5 modifications
! Mar 2001, FCW, WindowShade mods
! Sep 2001, FCW, add Material:WindowGasMixture
! Oct 2001, FCW, add Material:WindowBlind
! Dec 2003, FCW, add glass solar/visible transmittance dirt factor
! Feb 2009, TH, added WindowMaterial:GlazingGroup:Thermochromic
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! The purpose of this subroutine is to serve as a transfer agent
! between the input file and the material derived type. The new input
! file is working, and this file reads the material data directly
! from the input file and transfer that information to the new data
! structure. Data read in this routine is stored in a
! derived type (Material) defined in the DataHeatBalance module.
! In April 1999, a new set of material definitions replaced the one "all-purpose"
! material definition. There are now 10 flavors of materials. Definitions from
! the IDD appear below before their counterpart "gets".
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE General, ONLY: RoundSigDigits, ScanForReports
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(INOUT) :: ErrorsFound ! set to true if errors found in input
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: IOStat ! IO Status when calling get input subroutine
CHARACTER(len=MaxNameLength),DIMENSION(5) &
:: MaterialNames ! Number of Material Alpha names defined
INTEGER :: MaterNum ! Counter to keep track of the material number
INTEGER :: MaterialNumAlpha ! Number of material alpha names being passed
INTEGER :: MaterialNumProp ! Number of material properties being passed
REAL(r64), DIMENSION(27) :: MaterialProps !Temporary array to transfer material properties
INTEGER :: RegMat ! Regular Materials -- full property definition
INTEGER :: RegRMat ! Regular Materials -- R only property definition
INTEGER :: AirMat ! Air space materias in opaque constructions
INTEGER :: IRTMat ! Infrared Transmitting Materials -- R only property definition
INTEGER :: EcoRoofMat !Materials for ecoRoof
INTEGER :: NumGas ! Index for loop over gap gases in a mixture
INTEGER :: NumGases ! Number of gasses in a mixture
INTEGER :: GasType ! Gas type index: 1=air, 2=argon, 3=krypton, 4=xenon
INTEGER :: Loop
INTEGER :: ICoeff ! Gas property coefficient index
LOGICAL :: ErrorInName
LOGICAL :: IsBlank
CHARACTER(len=MaxNameLength) :: TypeOfGas ! Type of window gas fill (Air, Argon, Krypton, &
! Xenon, or Custom
REAL(r64) :: MinSlatAngGeom, MaxSlatAngGeom ! Minimum and maximum slat angle allowed by slat geometry (deg)
REAL(r64) :: ReflectivitySol ! Glass reflectivity, solar
REAL(r64) :: ReflectivityVis ! Glass reflectivity, visible
REAL(r64) :: TransmittivitySol ! Glass transmittivity, solar
REAL(r64) :: TransmittivityVis ! Glass transmittivity, visible
LOGICAL :: DoReport=.false.
REAL(r64) :: DenomRGas ! Denominator for WindowGas calculations of NominalR
REAL(r64) :: Openness ! insect screen oppenness fraction = (1-d/s)^2
! Added TH 1/9/2009 to read the thermochromic glazings
INTEGER :: iTC = 0
INTEGER :: iMat = 0
! Added TH 7/27/2009 for constructions defined with F or C factro method
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
! FLOW:
RegMat=GetNumObjectsFound('Material')
RegRMat=GetNumObjectsFound('Material:NoMass')
IRTMat=GetNumObjectsFound('Material:InfraredTransparent')
AirMat=GetNumObjectsFound('Material:AirGap')
W5GlsMat=GetNumObjectsFound('WindowMaterial:Glazing')
W5GlsMatAlt=GetNumObjectsFound('WindowMaterial:Glazing:RefractionExtinctionMethod')
W5GasMat=GetNumObjectsFound('WindowMaterial:Gas')
W5GasMatMixture=GetNumObjectsFound('WindowMaterial:GasMixture')
TotShades=GetNumObjectsFound('WindowMaterial:Shade')
TotComplexShades=GetNumObjectsFound('WindowMaterial:ComplexShade')
TotComplexGaps=GetNumObjectsFound('WindowMaterial:Gap')
TotScreens=GetNumObjectsFound('WindowMaterial:Screen')
TotBlinds=GetNumObjectsFound('WindowMaterial:Blind')
EcoRoofMat=GetNumObjectsFound('Material:RoofVegetation')
TotSimpleWindow = GetNumObjectsFound('WindowMaterial:SimpleGlazingSystem')
W5GlsMatEQL=GetNumObjectsFound('WindowMaterial:Glazing:EquivalentLayer')
TotShadesEQL=GetNumObjectsFound('WindowMaterial:Shade:EquivalentLayer')
TotDrapesEQL=GetNumObjectsFound('WindowMaterial:Drape:EquivalentLayer')
TotBlindsEQL=GetNumObjectsFound('WindowMaterial:Blind:EquivalentLayer')
TotScreensEQL=GetNumObjectsFound('WindowMaterial:Screen:EquivalentLayer')
W5GapMatEQL=GetNumObjectsFound('WindowMaterial:Gap:EquivalentLayer')
TotMaterials=RegMat+RegRMat+AirMat+W5GlsMat+W5GlsMatAlt+W5GasMat+W5GasMatMixture+ &
TotShades+TotScreens+TotBlinds+EcoRoofMat+IRTMat+TotSimpleWindow+TotComplexShades+TotComplexGaps+ &
W5GlsMatEQL+TotShadesEQL+TotDrapesEQL+TotBlindsEQL+TotScreensEQL+W5GapMatEQL
TotFfactorConstructs = GetNumObjectsFound('Construction:FfactorGroundFloor')
TotCfactorConstructs = GetNumObjectsFound('Construction:CfactorUndergroundWall')
IF (TotFfactorConstructs + TotCfactorConstructs >=1 ) THEN
! Add a new fictitious insulation layer and a thermal mass layer for each F or C factor defined construction
TotMaterials = TotMaterials + 1 + TotFfactorConstructs + TotCfactorConstructs
ENDIF
ALLOCATE (Material(TotMaterials))! Allocate the array Size to the number of materials
ALLOCATE(NominalR(TotMaterials))
NominalR=0.0d0
MaterNum=0
! Regular Materials
CurrentModuleObject='Material'
DO Loop=1,RegMat
!Call Input Get routine to retrieve material data
CALL GetObjectItem(CurrentModuleObject,Loop,MaterialNames,MaterialNumAlpha,MaterialProps,MaterialNumProp,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
CALL VerifyName(MaterialNames(1),Material%Name,MaterNum,ErrorInName,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (ErrorInName) THEN
CALL ShowContinueError('...All Material names must be unique regardless of subtype.')
ErrorsFound=.true.
CYCLE
ENDIF
!Load the material derived type from the input data.
MaterNum=MaterNum+1
Material(MaterNum)%Group=RegularMaterial
Material(MaterNum)%Name = MaterialNames(1)
CALL ValidateMaterialRoughness(MaterNum,MaterialNames(2),ErrorsFound)
Material(MaterNum)%Thickness = MaterialProps(1)
Material(MaterNum)%Conductivity = MaterialProps(2)
Material(MaterNum)%Density = MaterialProps(3)
Material(MaterNum)%SpecHeat = MaterialProps(4)
! min fields is 6 -- previous four will be there
IF (MaterialNumProp >= 5) THEN
Material(MaterNum)%AbsorpThermal = MaterialProps(5)
Material(MaterNum)%AbsorpThermalInput = MaterialProps(5)
ELSE
Material(MaterNum)%AbsorpThermal = .9d0
Material(MaterNum)%AbsorpThermalInput = .9d0
ENDIF
IF (MaterialNumProp >= 6) THEN
Material(MaterNum)%AbsorpSolar = MaterialProps(6)
Material(MaterNum)%AbsorpSolarInput = MaterialProps(6)
ELSE
Material(MaterNum)%AbsorpSolar = .7d0
Material(MaterNum)%AbsorpSolarInput = .7d0
ENDIF
IF (MaterialNumProp >= 7) THEN
Material(MaterNum)%AbsorpVisible = MaterialProps(7)
Material(MaterNum)%AbsorpVisibleInput = MaterialProps(7)
ELSE
Material(MaterNum)%AbsorpVisible = .7d0
Material(MaterNum)%AbsorpVisibleInput = .7d0
ENDIF
IF (Material(MaterNum)%Conductivity > 0.0d0) THEN
NominalR(MaterNum) = Material(MaterNum)%Thickness/Material(MaterNum)%Conductivity
Material(MaterNum)%Resistance = NominalR(MaterNum)
ELSE
CALL ShowSevereError('Positive thermal conductivity required for material '//TRIM(Material(MaterNum)%Name))
ErrorsFound = .TRUE.
END IF
ENDDO
! Add the 6" heavy concrete for constructions defined with F or C factor method
IF (TotFfactorConstructs + TotCfactorConstructs >=1 ) THEN
MaterNum = MaterNum + 1
Material(MaterNum)%Group=RegularMaterial
Material(MaterNum)%Name = '~FC_Concrete'
Material(MaterNum)%Thickness = 0.15d0 ! m, 0.15m = 6 inches
Material(MaterNum)%Conductivity = 1.95d0 ! W/mK
Material(MaterNum)%Density = 2240.0d0 ! kg/m3
Material(MaterNum)%SpecHeat = 900.0d0 ! J/kgK
Material(MaterNum)%Roughness = MediumRough
Material(MaterNum)%AbsorpSolar = 0.7d0
Material(MaterNum)%AbsorpThermal = 0.9d0
Material(MaterNum)%AbsorpVisible = 0.7d0
NominalR(MaterNum) = Material(MaterNum)%Thickness / Material(MaterNum)%Conductivity
Material(MaterNum)%Resistance = NominalR(MaterNum)
RegMat = RegMat + 1
ENDIF
CurrentModuleObject='Material:NoMass'
DO Loop=1,RegRMat
!Call Input Get routine to retrieve material data
CALL GetObjectItem(CurrentModuleObject,Loop,MaterialNames,MaterialNumAlpha,MaterialProps,MaterialNumProp,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
CALL VerifyName(MaterialNames(1),Material%Name,MaterNum,ErrorInName,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (ErrorInName) THEN
CALL ShowContinueError('...All Material names must be unique regardless of subtype.')
ErrorsFound=.true.
CYCLE
ENDIF
!Load the material derived type from the input data.
MaterNum=MaterNum+1
Material(MaterNum)%Group=RegularMaterial
Material(MaterNum)%Name = MaterialNames(1)
CALL ValidateMaterialRoughness(MaterNum,MaterialNames(2),ErrorsFound)
Material(MaterNum)%Resistance = MaterialProps(1)
Material(MaterNum)%ROnly = .true.
IF (MaterialNumProp >= 2) THEN
Material(MaterNum)%AbsorpThermal = MaterialProps(2)
Material(MaterNum)%AbsorpThermalInput = MaterialProps(2)
ELSE
Material(MaterNum)%AbsorpThermal = .9d0
Material(MaterNum)%AbsorpThermalInput = .9d0
ENDIF
IF (MaterialNumProp >= 3) THEN
Material(MaterNum)%AbsorpSolar = MaterialProps(3)
Material(MaterNum)%AbsorpSolarInput = MaterialProps(3)
ELSE
Material(MaterNum)%AbsorpSolar = .7d0
Material(MaterNum)%AbsorpSolarInput = .7d0
ENDIF
IF (MaterialNumProp >= 4) THEN
Material(MaterNum)%AbsorpVisible = MaterialProps(4)
Material(MaterNum)%AbsorpVisibleInput = MaterialProps(4)
ELSE
Material(MaterNum)%AbsorpVisible = .7d0
Material(MaterNum)%AbsorpVisibleInput = .7d0
ENDIF
NominalR(MaterNum)=Material(MaterNum)%Resistance
ENDDO
! Add a fictitious insulation layer for each construction defined with F or C factor method
IF (TotFfactorConstructs + TotCfactorConstructs >= 1 ) THEN
DO Loop = 1, TotFfactorConstructs + TotCfactorConstructs
MaterNum = MaterNum + 1
Material(MaterNum)%Group = RegularMaterial
Material(MaterNum)%Name = '~FC_Insulation_' // RoundSigDigits(Loop,0)
Material(MaterNum)%ROnly = .true.
Material(MaterNum)%Roughness = MediumRough
Material(MaterNum)%AbsorpSolar = 0.0d0
Material(MaterNum)%AbsorpThermal = 0.0d0
Material(MaterNum)%AbsorpVisible = 0.0d0
ENDDO
RegRMat = RegRMat + TotFfactorConstructs + TotCfactorConstructs
ENDIF
! Air Materials (for air spaces in opaque constructions)
CurrentModuleObject='Material:AirGap'
DO Loop=1,AirMat
!Call Input Get routine to retrieve material data
CALL GetObjectItem(CurrentModuleObject,Loop,MaterialNames,MaterialNumAlpha,MaterialProps,MaterialNumProp,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
CALL VerifyName(MaterialNames(1),Material%Name,MaterNum,ErrorInName,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (ErrorInName) THEN
CALL ShowContinueError('...All Material names must be unique regardless of subtype.')
ErrorsFound=.true.
CYCLE
ENDIF
!Load the material derived type from the input data.
MaterNum=MaterNum+1
Material(MaterNum)%Group=Air
Material(MaterNum)%Name = MaterialNames(1)
Material(MaterNum)%Roughness=MediumRough
Material(MaterNum)%Resistance = MaterialProps(1)
Material(MaterNum)%ROnly = .true.
NominalR(MaterNum)=Material(MaterNum)%Resistance
ENDDO
CurrentModuleObject='Material:InfraredTransparent'
DO Loop=1,IRTMat
!Call Input Get routine to retrieve material data
CALL GetObjectItem(CurrentModuleObject,Loop,MaterialNames,MaterialNumAlpha,MaterialProps,MaterialNumProp,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
CALL VerifyName(MaterialNames(1),Material%Name,MaterNum,ErrorInName,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (ErrorInName) THEN
CALL ShowContinueError('...All Material names must be unique regardless of subtype.')
ErrorsFound=.true.
CYCLE
ENDIF
MaterNum=MaterNum+1
Material(MaterNum)%Group=IRTMaterial
!Load the material derived type from the input data.
Material(MaterNum)%Name = MaterialNames(1)
IF (MaterialNumProp >= 1) THEN
Material(MaterNum)%Resistance = MaterialProps(1)
Material(MaterNum)%ROnly = .true.
ELSE
Material(MaterNum)%Resistance = .01d0
ENDIF
IF (MaterialNumProp >= 2) THEN
Material(MaterNum)%AbsorpThermal = MaterialProps(2)
Material(MaterNum)%AbsorpThermalInput = MaterialProps(2)
ELSE
Material(MaterNum)%AbsorpThermal = 0.9999d0
Material(MaterNum)%AbsorpThermalInput = 0.9999d0
ENDIF
IF (MaterialNumProp >= 3) THEN
Material(MaterNum)%AbsorpSolar = MaterialProps(3)
Material(MaterNum)%AbsorpSolarInput = MaterialProps(3)
ELSE
Material(MaterNum)%AbsorpSolar = 1.d0
Material(MaterNum)%AbsorpSolarInput = 1.d0
ENDIF
IF (MaterialNumProp >= 4) THEN
Material(MaterNum)%AbsorpVisible = MaterialProps(4)
Material(MaterNum)%AbsorpVisibleInput = MaterialProps(4)
ELSE
Material(MaterNum)%AbsorpVisible = 1.d0
Material(MaterNum)%AbsorpVisibleInput = 1.d0
ENDIF
NominalR(MaterNum)=Material(MaterNum)%Resistance
ENDDO
! Glass materials, regular input: transmittance and front/back reflectance
CurrentModuleObject='WindowMaterial:Glazing'
DO Loop=1,W5GlsMat
!Call Input Get routine to retrieve material data
CALL GetObjectItem(CurrentModuleObject,Loop,MaterialNames,MaterialNumAlpha,MaterialProps,MaterialNumProp,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
CALL VerifyName(MaterialNames(1),Material%Name,MaterNum,ErrorInName,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (ErrorInName) THEN
CALL ShowContinueError('...All Material names must be unique regardless of subtype.')
ErrorsFound=.true.
CYCLE
ENDIF
MaterNum=MaterNum+1
Material(MaterNum)%Group=WindowGlass
!Load the material derived type from the input data.
Material(MaterNum)%Name = MaterialNames(1)
Material(MaterNum)%Roughness=VerySmooth
Material(MaterNum)%ROnly = .true.
Material(MaterNum)%Thickness = MaterialProps(1)
Material(MaterNum)%Trans = MaterialProps(2)
Material(MaterNum)%ReflectSolBeamFront = MaterialProps(3)
Material(MaterNum)%ReflectSolBeamBack = MaterialProps(4)
Material(MaterNum)%TransVis = MaterialProps(5)
Material(MaterNum)%ReflectVisBeamFront = MaterialProps(6)
Material(MaterNum)%ReflectVisBeamBack = MaterialProps(7)
Material(MaterNum)%TransThermal = MaterialProps(8)
Material(MaterNum)%AbsorpThermalFront = MaterialProps(9)
Material(MaterNum)%AbsorpThermalBack = MaterialProps(10)
Material(MaterNum)%Conductivity = MaterialProps(11)
Material(MaterNum)%GlassTransDirtFactor= MaterialProps(12)
Material(MaterNum)%YoungModulus = MaterialProps(13)
Material(MaterNum)%PoissonsRatio = MaterialProps(14)
IF(MaterialProps(12) == 0.0d0) Material(MaterNum)%GlassTransDirtFactor = 1.0d0
Material(MaterNum)%AbsorpThermal = Material(MaterNum)%AbsorpThermalBack
IF (Material(MaterNum)%Conductivity > 0.0d0) THEN
NominalR(MaterNum)=Material(MaterNum)%Thickness/Material(MaterNum)%Conductivity
Material(MaterNum)%Resistance = NominalR(MaterNum)
ELSE
ErrorsFound = .true.
CALL ShowSevereError('Window glass material ' //Trim(Material(MaterNum)%Name)// &
' has Conductivity = 0.0, must be >0.0, default = .9')
END IF
Material(MaterNum)%GlassSpectralDataPtr = 0
IF (TotSpectralData > 0 .and. .not. lAlphaFieldBlanks(3)) THEN
Material(MaterNum)%GlassSpectralDataPtr = FindIteminList(MaterialNames(3),SpectralData%Name,TotSpectralData)
ENDIF
IF(SameString(MaterialNames(2),'SpectralAverage')) Material(MaterNum)%GlassSpectralDataPtr = 0
! No need for spectral data for BSDF either
IF(SameString(MaterialNames(2),'BSDF')) Material(MaterNum)%GlassSpectralDataPtr = 0
IF(Material(MaterNum)%GlassSpectralDataPtr == 0 .AND. SameString(MaterialNames(2),'Spectral')) THEN
ErrorsFound = .true.
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//Trim(Material(MaterNum)%Name)// &
'" has '//TRIM(cAlphaFieldNames(2))//' = Spectral but has no matching MaterialProperty:GlazingSpectralData set')
IF (lAlphaFieldBlanks(3)) THEN
CALL ShowContinueError('...'//trim(cAlphaFieldNames(3))//' is blank.')
ELSE
CALL ShowContinueError('...'//trim(cAlphaFieldNames(3))//'="'//trim(MaterialNames(3))// &
'" not found as item in MaterialProperty:GlazingSpectralData objects.')
END IF
END IF
IF(.not. SameString(MaterialNames(2),'SpectralAverage') .AND. .not. SameString(MaterialNames(2),'Spectral') &
.AND. .not. SameString(MaterialNames(2),'BSDF')) THEN
ErrorsFound = .true.
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//Trim(Material(MaterNum)%Name)//'", invalid specification.')
CALL ShowContinueError(TRIM(cAlphaFieldNames(2))//' must be SpectralAverage, Spectral or BSDF, value='// &
TRIM(MaterialNames(2)))
END IF
! TH 8/24/2011, allow glazing properties MaterialProps(2 to 10) to equal 0 or 1: 0.0 =< Prop <= 1.0
! Fixed CR 8413 - modeling spandrel panels as glazing systems
IF(SameString(MaterialNames(2),'SpectralAverage')) THEN
IF(MaterialProps(2)+MaterialProps(3) > 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(2))//' + '//TRIM(cNumericFieldNames(3))//' not <= 1.0')
END IF
IF(MaterialProps(2)+MaterialProps(4) > 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(2))//' + '//TRIM(cNumericFieldNames(4))//' not <= 1.0')
END IF
IF(MaterialProps(5)+MaterialProps(6) > 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(5))//' + '//TRIM(cNumericFieldNames(6))//' not <= 1.0')
END IF
IF(MaterialProps(5)+MaterialProps(7) > 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(5))//' + '//TRIM(cNumericFieldNames(7))//' not <= 1.0')
END IF
IF(MaterialProps(8)+MaterialProps(9) > 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(8))//' + '//TRIM(cNumericFieldNames(9))//' not <= 1.0')
END IF
IF(MaterialProps(8)+MaterialProps(10) > 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(8))//' + '//TRIM(cNumericFieldNames(10))//' not <= 1.0')
END IF
IF(MaterialProps(2) < 0.0d0) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(2))//' not >= 0.0')
ErrorsFound=.true.
END IF
IF(MaterialProps(2) > 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(2))//' not <= 1.0')
END IF
IF(MaterialProps(3) < 0.0d0 .or. MaterialProps(3) > 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(3))//' not >= 0.0 and <= 1.0')
END IF
IF(MaterialProps(4) < 0.0d0 .or. MaterialProps(4) > 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(4))//' not >= 0.0 and <= 1.0')
END IF
IF(MaterialProps(5) < 0.0d0) THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", minimal value.')
CALL ShowWarningError(TRIM(cNumericFieldNames(5))//' not >= 0.0')
END IF
IF(MaterialProps(5) > 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(5))//' not <= 1.0')
END IF
IF(MaterialProps(6) < 0.0d0 .or. MaterialProps(6) > 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(6))//' not >= 0.0 and <= 1.0')
END IF
IF(MaterialProps(7) < 0.0d0 .or. MaterialProps(7) > 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(7))//' not >= 0.0 and <= 1.0')
END IF
END IF
IF(MaterialProps(8) > 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(8))//' not <= 1.0')
END IF
IF(MaterialProps(9) <= 0.0d0 .or. MaterialProps(9) >= 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(9))//' not > 0.0 and < 1.0')
END IF
IF(MaterialProps(10) <= 0.0d0 .or. MaterialProps(10) >= 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(10))//' not > 0.0 and < 1.0')
END IF
IF(MaterialProps(11) <= 0.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(11))//' not > 0.0')
END IF
IF(MaterialProps(13) < 0.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(13))//' not > 0.0')
END IF
IF(MaterialProps(14) < 0.0d0 .or. MaterialProps(14) >= 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(14))//' not > 0.0 and < 1.0')
END IF
IF(MaterialNames(4) == ' ') THEN
Material(MaterNum)%SolarDiffusing = .false.
ELSE IF(MaterialNames(4) == 'YES') THEN
Material(MaterNum)%SolarDiffusing = .true.
ELSE IF(MaterialNames(4) == 'NO') THEN
Material(MaterNum)%SolarDiffusing = .false.
ELSE
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(4))//' must be Yes or No, entered value='//TRIM(MaterialNames(4)))
END IF
ENDDO
! Glass materials, alternative input: index of refraction and extinction coefficient
CurrentModuleObject='WindowMaterial:Glazing:RefractionExtinctionMethod'
DO Loop=1,W5GlsMatAlt
!Call Input Get routine to retrieve material data
CALL GetObjectItem(CurrentModuleObject,Loop,MaterialNames,MaterialNumAlpha,MaterialProps,MaterialNumProp,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
CALL VerifyName(MaterialNames(1),Material%Name,MaterNum,ErrorInName,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (ErrorInName) THEN
CALL ShowContinueError('...All Material names must be unique regardless of subtype.')
ErrorsFound=.true.
CYCLE
ENDIF
MaterNum=MaterNum+1
Material(MaterNum)%Group=WindowGlass
!Load the material derived type from the input data.
Material(MaterNum)%Name = MaterialNames(1)
Material(MaterNum)%Roughness = VerySmooth
Material(MaterNum)%Thickness = MaterialProps(1)
Material(MaterNum)%ROnly = .true.
! Calculate solar and visible transmittance and reflectance at normal incidence from thickness,
! index of refraction and extinction coefficient. With the alternative input the front and back
! properties are assumed to be the same.
ReflectivitySol = ((MaterialProps(2)-1.d0)/(MaterialProps(2)+1.d0))**2
ReflectivityVis = ((MaterialProps(4)-1.d0)/(MaterialProps(4)+1.d0))**2
TransmittivitySol = EXP(-MaterialProps(3)*MaterialProps(1))
TransmittivityVis = EXP(-MaterialProps(5)*MaterialProps(1))
Material(MaterNum)%Trans = TransmittivitySol * ((1.d0-ReflectivitySol)**2) / &
(1.d0-(ReflectivitySol*TransmittivitySol)**2)
Material(MaterNum)%ReflectSolBeamFront = ReflectivitySol * (1.d0 + &
((1.d0-ReflectivitySol)**2)*(TransmittivitySol**2) / &
(1.d0-(ReflectivitySol*TransmittivitySol)**2) )
Material(MaterNum)%ReflectSolBeamBack = Material(MaterNum)%ReflectSolBeamFront
Material(MaterNum)%TransVis = TransmittivityVis * ((1.d0-ReflectivityVis)**2) / &
(1.d0-(ReflectivityVis*TransmittivityVis)**2)
Material(MaterNum)%ReflectVisBeamFront = ReflectivityVis * (1.d0 + &
((1.d0-ReflectivityVis)**2)*(TransmittivityVis**2) / &
(1.d0-(ReflectivityVis*TransmittivityVis)**2) )
Material(MaterNum)%ReflectVisBeamBack = Material(MaterNum)%ReflectSolBeamFront
Material(MaterNum)%TransThermal = MaterialProps(6)
Material(MaterNum)%AbsorpThermalFront = MaterialProps(7)
Material(MaterNum)%AbsorpThermalBack = MaterialProps(7)
Material(MaterNum)%Conductivity = MaterialProps(8)
Material(MaterNum)%GlassTransDirtFactor= MaterialProps(9)
IF(MaterialProps(9) == 0.0d0) Material(MaterNum)%GlassTransDirtFactor = 1.0d0
Material(MaterNum)%AbsorpThermal = Material(MaterNum)%AbsorpThermalBack
IF (Material(MaterNum)%Conductivity > 0.0d0) THEN
NominalR(MaterNum)=Material(MaterNum)%Thickness/Material(MaterNum)%Conductivity
Material(MaterNum)%Resistance = NominalR(MaterNum)
ENDIF
Material(MaterNum)%GlassSpectralDataPtr = 0
IF(MaterialProps(6)+MaterialProps(7) >= 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(6))//' + '//TRIM(cNumericFieldNames(7))//' not < 1.0')
END IF
IF(MaterialNames(2) == ' ') THEN
Material(MaterNum)%SolarDiffusing = .false.
ELSE IF(MaterialNames(2) == 'YES') THEN
Material(MaterNum)%SolarDiffusing = .true.
ELSE IF(MaterialNames(2) == 'NO') THEN
Material(MaterNum)%SolarDiffusing = .false.
ELSE
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(2))//' must be Yes or No, entered value='//TRIM(MaterialNames(4)))
END IF
ENDDO
! Glass materials, equivalent layer (ASHWAT) method
CurrentModuleObject='WindowMaterial:Glazing:EquivalentLayer'
DO Loop=1,W5GlsMatEQL
!Call Input Get routine to retrieve material data
CALL GetObjectItem(CurrentModuleObject,Loop,MaterialNames,MaterialNumAlpha,MaterialProps,MaterialNumProp,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
CALL VerifyName(MaterialNames(1),Material%Name,MaterNum,ErrorInName,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (ErrorInName) THEN
CALL ShowContinueError('...All Material names must be unique regardless of subtype.')
ErrorsFound=.true.
CYCLE
ENDIF
MaterNum=MaterNum+1
Material(MaterNum)%Group=GlassEquivalentLayer
!Load the material derived type from the input data.
Material(MaterNum)%Name = MaterialNames(1)
Material(MaterNum)%Roughness = VerySmooth
Material(MaterNum)%ROnly = .true.
Material(MaterNum)%TausFrontBeamBeam = MaterialProps(1)
Material(MaterNum)%TausBackBeamBeam = MaterialProps(2)
Material(MaterNum)%ReflFrontBeamBeam = MaterialProps(3)
Material(MaterNum)%ReflBackBeamBeam = MaterialProps(4)
Material(MaterNum)%TausFrontBeamBeamVis = MaterialProps(5)
Material(MaterNum)%TausBackBeamBeamVis = MaterialProps(6)
Material(MaterNum)%ReflFrontBeamBeamVis = MaterialProps(7)
Material(MaterNum)%ReflBackBeamBeamVis = MaterialProps(8)
Material(MaterNum)%TausFrontBeamDiff = MaterialProps(9)
Material(MaterNum)%TausBackBeamDiff = MaterialProps(10)
Material(MaterNum)%ReflFrontBeamDiff = MaterialProps(11)
Material(MaterNum)%ReflBackBeamDiff = MaterialProps(12)
Material(MaterNum)%TausFrontBeamDiffVis = MaterialProps(13)
Material(MaterNum)%TausBackBeamDiffVis = MaterialProps(14)
Material(MaterNum)%ReflFrontBeamDiffVis = MaterialProps(15)
Material(MaterNum)%ReflBackBeamDiffVis = MaterialProps(16)
Material(MaterNum)%TausDiffDiff = MaterialProps(17)
Material(MaterNum)%ReflFrontDiffDiff = MaterialProps(18)
Material(MaterNum)%ReflBackDiffDiff = MaterialProps(19)
Material(MaterNum)%TausDiffDiffVis = MaterialProps(20)
Material(MaterNum)%ReflFrontDiffDiffVis = MaterialProps(21)
Material(MaterNum)%ReflBackDiffDiffVis = MaterialProps(22)
Material(MaterNum)%TausThermal = MaterialProps(23)
Material(MaterNum)%EmissThermalFront = MaterialProps(24)
Material(MaterNum)%EmissThermalBack = MaterialProps(25)
! Assumes thermal emissivity is the same as thermal absorptance
Material(MaterNum)%AbsorpThermalFront = Material(MaterNum)%EmissThermalFront
Material(MaterNum)%AbsorpThermalBack = Material(MaterNum)%EmissThermalBack
Material(MaterNum)%TransThermal = Material(MaterNum)%TausThermal
IF(SameString(MaterialNames(2),'SpectralAverage')) Material(MaterNum)%GlassSpectralDataPtr = 0
!IF(Material(MaterNum)%GlassSpectralDataPtr == 0 .AND. SameString(MaterialNames(2),'Spectral')) THEN
! ErrorsFound = .true.
! CALL ShowSevereError(trim(CurrentModuleObject)//'="'//Trim(Material(MaterNum)%Name)// &
! '" has '//TRIM(cAlphaFieldNames(2))//' = Spectral but has no matching MaterialProperty:GlazingSpectralData set')
! IF (lAlphaFieldBlanks(3)) THEN
! CALL ShowContinueError('...'//trim(cAlphaFieldNames(3))//' is blank.')
! ELSE
! CALL ShowContinueError('...'//trim(cAlphaFieldNames(3))//'="'//trim(MaterialNames(3))// &
! '" not found as item in MaterialProperty:GlazingSpectralData objects.')
!END IF
!END IF
IF(.not. SameString(MaterialNames(2),'SpectralAverage') ) THEN
ErrorsFound = .true.
CALL ShowSevereError(trim(CurrentModuleObject)//'="'//Trim(Material(MaterNum)%Name)//'", invalid specification.')
CALL ShowContinueError(TRIM(cAlphaFieldNames(2))//' must be SpectralAverage, value='// &
TRIM(MaterialNames(2)))
END IF
ENDDO ! END OF DO LOOP FOR W5GlsMatEQL
! Window gas materials (for gaps with a single gas)
CurrentModuleObject='WindowMaterial:Gas'
DO Loop=1,W5GasMat
!Call Input Get routine to retrieve material data
CALL GetObjectItem(CurrentModuleObject,Loop,MaterialNames,MaterialNumAlpha,MaterialProps,MaterialNumProp,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
CALL VerifyName(MaterialNames(1),Material%Name,MaterNum,ErrorInName,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (ErrorInName) THEN
CALL ShowContinueError('...All Material names must be unique regardless of subtype.')
ErrorsFound=.true.
CYCLE
ENDIF
MaterNum=MaterNum+1
Material(MaterNum)%Group=WindowGas
Material(MaterNum)%GasType(1) = -1
Material(MaterNum)%NumberOfGasesInMixture = 1
Material(MaterNum)%GasFract(1) = 1.0d0
!Load the material derived type from the input data.
Material(MaterNum)%Name = MaterialNames(1)
Material(MaterNum)%NumberOfGasesInMixture = 1
TypeOfGas = TRIM(MaterialNames(2))
IF(TypeOfGas == 'AIR') Material(MaterNum)%GasType(1) = 1
IF(TypeOfGas == 'ARGON') Material(MaterNum)%GasType(1) = 2
IF(TypeOfGas == 'KRYPTON') Material(MaterNum)%GasType(1) = 3
IF(TypeOfGas == 'XENON') Material(MaterNum)%GasType(1) = 4
IF(TypeOfGas == 'CUSTOM') Material(MaterNum)%GasType(1) = 0
IF(Material(MaterNum)%GasType(1) == -1) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(trim(cAlphaFieldNames(2))//' entered value="'//TRIM(TypeOfGas)// &
'" should be Air, Argon, Krypton, Xenon or Custom.')
END IF
Material(MaterNum)%Roughness=MediumRough
Material(MaterNum)%Thickness = MaterialProps(1)
Material(MaterNum)%ROnly = .true.
GasType = Material(MaterNum)%GasType(1)
IF(GasType >= 1 .AND. GasType <= 4) THEN
Material(MaterNum)%GasWght(1) = GasWght(GasType)
Material(MaterNum)%GasSpecHeatRatio(1) = GasSpecificHeatRatio(GasType)
DO ICoeff = 1,3
Material(MaterNum)%GasCon(1,ICoeff) = GasCoeffsCon(GasType,ICoeff)
Material(MaterNum)%GasVis(1,ICoeff) = GasCoeffsVis(GasType,ICoeff)
Material(MaterNum)%GasCp (1,ICoeff) = GasCoeffsCp (GasType,ICoeff)
END DO
END IF
! Custom gas
IF(GasType == 0) THEN
DO ICoeff = 1,3
Material(MaterNum)%GasCon(1,ICoeff) = MaterialProps(1+ICoeff)
Material(MaterNum)%GasVis(1,ICoeff) = MaterialProps(4+ICoeff)
Material(MaterNum)%GasCp (1,ICoeff) = MaterialProps(7+ICoeff)
END DO
Material(MaterNum)%GasWght(1) = MaterialProps(11)
Material(MaterNum)%GasSpecHeatRatio(1) = MaterialProps(12)
! Check for errors in custom gas properties
! IF(Material(MaterNum)%GasCon(1,1) <= 0.0) THEN
! ErrorsFound = .true.
! CALL ShowSevereError('Conductivity Coefficient A for custom window gas='&
! //TRIM(MaterialNames(1))//' should be > 0.')
! END IF
IF(Material(MaterNum)%GasVis(1,1) <= 0.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(3+ICoeff))//' not > 0.0')
END IF
IF(Material(MaterNum)%GasCp(1,1) <= 0.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(5+ICoeff))//' not > 0.0')
END IF
IF(Material(MaterNum)%GasWght(1) <= 0.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(8))//' not > 0.0')
END IF
END IF
! Nominal resistance of gap at room temperature
IF(.not.ErrorsFound) THEN
DenomRGas=(Material(MaterNum)%GasCon(1,1) + Material(MaterNum)%GasCon(1,2)*300.0d0 + Material(MaterNum)%GasCon(1,3)*90000.0d0)
IF (DenomRGas > 0.0d0) THEN
NominalR(MaterNum)=Material(MaterNum)%Thickness/DenomRGas
ELSE
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError('Nominal resistance of gap at room temperature calculated at a negative Conductivity=['// &
trim(RoundSigDigits(DenomRGas,3))//'].')
ErrorsFound=.true.
ENDIF
ENDIF
ENDDO
! Window gap materials (for gaps with a single gas for EquivalentLayer)
CurrentModuleObject='WindowMaterial:Gap:EquivalentLayer'
DO Loop=1,W5GapMatEQL
!Call Input Get routine to retrieve material data
CALL GetObjectItem(CurrentModuleObject,Loop,MaterialNames,MaterialNumAlpha,MaterialProps,MaterialNumProp,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
CALL VerifyName(MaterialNames(1),Material%Name,MaterNum,ErrorInName,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (ErrorInName) THEN
CALL ShowContinueError('...All Material names must be unique regardless of subtype.')
ErrorsFound=.true.
CYCLE
ENDIF
MaterNum=MaterNum+1
Material(MaterNum)%Group=GapEquivalentLayer
Material(MaterNum)%GasType(1) = -1
Material(MaterNum)%NumberOfGasesInMixture = 1
Material(MaterNum)%GasFract(1) = 1.0d0
!Load the material derived type from the input data.
Material(MaterNum)%Name = MaterialNames(1)
Material(MaterNum)%NumberOfGasesInMixture = 1
TypeOfGas = TRIM(MaterialNames(2))
Material(MaterNum)%GasName = TypeOfGas
IF(TypeOfGas == 'AIR') Material(MaterNum)%GasType(1) = 1
IF(TypeOfGas == 'ARGON') Material(MaterNum)%GasType(1) = 2
IF(TypeOfGas == 'KRYPTON') Material(MaterNum)%GasType(1) = 3
IF(TypeOfGas == 'XENON') Material(MaterNum)%GasType(1) = 4
IF(TypeOfGas == 'CUSTOM') Material(MaterNum)%GasType(1) = 0
IF(Material(MaterNum)%GasType(1) == -1) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(trim(cAlphaFieldNames(2))//' entered value="'//TRIM(TypeOfGas)// &
'" should be Air, Argon, Krypton, Xenon')
END IF
Material(MaterNum)%Roughness=MediumRough
Material(MaterNum)%Thickness = MaterialProps(1)
Material(MaterNum)%ROnly = .true.
GasType = Material(MaterNum)%GasType(1)
IF(GasType >= 1 .AND. GasType <= 4) THEN
Material(MaterNum)%GasWght(1) = GasWght(GasType)
Material(MaterNum)%GasSpecHeatRatio(1) = GasSpecificHeatRatio(GasType)
DO ICoeff = 1,3
Material(MaterNum)%GasCon(1,ICoeff) = GasCoeffsCon(GasType,ICoeff)
Material(MaterNum)%GasVis(1,ICoeff) = GasCoeffsVis(GasType,ICoeff)
Material(MaterNum)%GasCp (1,ICoeff) = GasCoeffsCp (GasType,ICoeff)
END DO
END IF
IF ( .NOT. lAlphaFieldBlanks(2)) THEN
! Get gap vent type
IF (SameString(MaterialNames(3),'Sealed')) THEN
Material(MaterNum)%GapVentType = 1
ELSEIF(SameString(MaterialNames(3),'VentedIndoor')) THEN
Material(MaterNum)%GapVentType = 2
ELSEIF(SameString(MaterialNames(3),'VentedOutdoor')) THEN
Material(MaterNum)%GapVentType = 3
ELSE
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal gap vent type.')
CALL ShowContinueError('Gap vent type allowed are Sealed, VentedIndoor, or VentedOutdoor.'// &
trim(cAlphaFieldNames(3))//' entered ='//trim(MaterialNames(3)))
Material(MaterNum)%GapVentType = 1
!ErrorsFound=.true.
ENDIF
ELSE
ENDIF
IF(GasType == 0) THEN
DO ICoeff = 1,3
Material(MaterNum)%GasCon(1,ICoeff) = MaterialProps(1+ICoeff)
Material(MaterNum)%GasVis(1,ICoeff) = MaterialProps(4+ICoeff)
Material(MaterNum)%GasCp (1,ICoeff) = MaterialProps(7+ICoeff)
END DO
Material(MaterNum)%GasWght(1) = MaterialProps(11)
Material(MaterNum)%GasSpecHeatRatio(1) = MaterialProps(12)
IF(Material(MaterNum)%GasVis(1,1) <= 0.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(5))//' not > 0.0')
END IF
IF(Material(MaterNum)%GasCp(1,1) <= 0.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(8))//' not > 0.0')
END IF
IF(Material(MaterNum)%GasWght(1) <= 0.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(11))//' not > 0.0')
END IF
ENDIF
! Nominal resistance of gap at room temperature
IF(.not.ErrorsFound) THEN
DenomRGas=(Material(MaterNum)%GasCon(1,1) + Material(MaterNum)%GasCon(1,2)*300.0d0 + &
Material(MaterNum)%GasCon(1,3)*90000.0d0)
IF (DenomRGas > 0.0d0) THEN
NominalR(MaterNum)=Material(MaterNum)%Thickness/DenomRGas
ELSE
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError('Nominal resistance of gap at room temperature calculated at a negative Conductivity=['// &
trim(RoundSigDigits(DenomRGas,3))//'].')
ErrorsFound=.true.
ENDIF
ENDIF
ENDDO
! Window gas mixtures (for gaps with two or more gases)
CurrentModuleObject='WindowMaterial:GasMixture'
DO Loop=1,W5GasMatMixture
!Call Input Get routine to retrieve material data
CALL GetObjectItem(CurrentModuleObject,Loop,cAlphaArgs,MaterialNumAlpha,MaterialProps,MaterialNumProp,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),Material%Name,MaterNum,ErrorInName,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (ErrorInName) THEN
CALL ShowContinueError('...All Material names must be unique regardless of subtype.')
ErrorsFound=.true.
CYCLE
ENDIF
MaterNum=MaterNum+1
Material(MaterNum)%Group=WindowGasMixture
Material(MaterNum)%GasType = -1
!Load the material derived type from the input data.
Material(MaterNum)%Name = cAlphaArgs(1)
NumGases = MaterialProps(2)
Material(MaterNum)%NumberOfGasesInMixture = NumGases
DO NumGas = 1,NumGases
TypeOfGas = TRIM(cAlphaArgs(1+NumGas))
IF(TypeOfGas == 'AIR') Material(MaterNum)%GasType(NumGas) = 1
IF(TypeOfGas == 'ARGON') Material(MaterNum)%GasType(NumGas) = 2
IF(TypeOfGas == 'KRYPTON') Material(MaterNum)%GasType(NumGas) = 3
IF(TypeOfGas == 'XENON') Material(MaterNum)%GasType(NumGas) = 4
IF(Material(MaterNum)%GasType(NumGas) == -1) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'", Illegal value.')
CALL ShowContinueError(trim(cAlphaFieldNames(2+NumGas))//' entered value="'//TRIM(TypeOfGas)// &
'" should be Air, Argon, Krypton, or Xenon.')
END IF
END DO
Material(MaterNum)%Roughness=MediumRough ! Unused
Material(MaterNum)%Thickness = MaterialProps(1)
IF(Material(MaterNum)%Thickness .Le. 0.0d0)THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(1))//' must be greater than 0.')
ENDIF
Material(MaterNum)%ROnly = .true.
DO NumGas = 1,NumGases
GasType = Material(MaterNum)%GasType(NumGas)
IF(GasType >= 1 .AND. GasType <= 4) THEN
Material(MaterNum)%GasWght(NumGas) = GasWght(GasType)
Material(MaterNum)%GasSpecHeatRatio(NumGas) = GasSpecificHeatRatio(GasType)
Material(MaterNum)%GasFract(NumGas) = MaterialProps(2+NumGas)
DO ICoeff = 1,3
Material(MaterNum)%GasCon(NumGas,ICoeff) = GasCoeffsCon(GasType,ICoeff)
Material(MaterNum)%GasVis(NumGas,ICoeff) = GasCoeffsVis(GasType,ICoeff)
Material(MaterNum)%GasCp (NumGas,ICoeff) = GasCoeffsCp (GasType,ICoeff)
END DO
END IF
END DO
! Nominal resistance of gap at room temperature (based on first gas in mixture)
NominalR(MaterNum)=Material(MaterNum)%Thickness/(Material(MaterNum)%GasCon(1,1) + &
Material(MaterNum)%GasCon(1,2)*300.0d0 + Material(MaterNum)%GasCon(1,3)*90000.0d0)
ENDDO
! Window Shade Materials
CurrentModuleObject='WindowMaterial:Shade'
DO Loop=1,TotShades
!Call Input Get routine to retrieve material data
CALL GetObjectItem(CurrentModuleObject,Loop,MaterialNames,MaterialNumAlpha,MaterialProps,MaterialNumProp,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
CALL VerifyName(MaterialNames(1),Material%Name,MaterNum,ErrorInName,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (ErrorInName) THEN
CALL ShowContinueError('...All Material names must be unique regardless of subtype.')
ErrorsFound=.true.
CYCLE
ENDIF
MaterNum=MaterNum+1
Material(MaterNum)%Group=Shade
!Load the material derived type from the input data.
Material(MaterNum)%Name = MaterialNames(1)
Material(MaterNum)%Roughness = MediumRough
Material(MaterNum)%Trans = MaterialProps(1)
Material(MaterNum)%ReflectShade = MaterialProps(2)
Material(MaterNum)%TransVis = MaterialProps(3)
Material(MaterNum)%ReflectShadeVis = MaterialProps(4)
Material(MaterNum)%AbsorpThermal = MaterialProps(5)
Material(MaterNum)%AbsorpThermalInput = MaterialProps(5)
Material(MaterNum)%TransThermal = MaterialProps(6)
Material(MaterNum)%Thickness = MaterialProps(7)
Material(MaterNum)%Conductivity = MaterialProps(8)
Material(MaterNum)%AbsorpSolar = MAX(0.d0,1.d0- Material(MaterNum)%Trans - Material(MaterNum)%ReflectShade)
Material(MaterNum)%AbsorpSolarInput = Material(MaterNum)%AbsorpSolar
Material(MaterNum)%WinShadeToGlassDist = MaterialProps(9)
Material(MaterNum)%WinShadeTopOpeningMult = MaterialProps(10)
Material(MaterNum)%WinShadeBottomOpeningMult = MaterialProps(11)
Material(MaterNum)%WinShadeLeftOpeningMult = MaterialProps(12)
Material(MaterNum)%WinShadeRightOpeningMult = MaterialProps(13)
Material(MaterNum)%WinShadeAirFlowPermeability = MaterialProps(14)
Material(MaterNum)%ROnly = .true.
IF (Material(MaterNum)%Conductivity > 0.0d0) THEN
NominalR(MaterNum)=Material(MaterNum)%Thickness/Material(MaterNum)%Conductivity
ELSE
NominalR(MaterNum)=1.0d0
ENDIF
IF(MaterialProps(1)+MaterialProps(2) >= 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(1))//' + '//TRIM(cNumericFieldNames(2))//' not < 1.0')
END IF
IF(MaterialProps(3)+MaterialProps(4) >= 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(3))//' + '//TRIM(cNumericFieldNames(4))//' not < 1.0')
END IF
IF(MaterialProps(5)+MaterialProps(6) >= 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(5))//' + '//TRIM(cNumericFieldNames(6))//' not < 1.0')
END IF
ENDDO
! Window Shade Materials
CurrentModuleObject='WindowMaterial:Shade:EquivalentLayer'
DO Loop=1,TotShadesEQL
MaterialProps=0
!Call Input Get routine to retrieve material data
CALL GetObjectItem(CurrentModuleObject,Loop,MaterialNames,MaterialNumAlpha,MaterialProps,MaterialNumProp,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
CALL VerifyName(MaterialNames(1),Material%Name,MaterNum,ErrorInName,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (ErrorInName) THEN
CALL ShowContinueError('...All Material names must be unique regardless of subtype.')
ErrorsFound=.true.
CYCLE
ENDIF
MaterNum=MaterNum+1
Material(MaterNum)%Group=ShadeEquivalentLayer
Material(MaterNum)%Name = MaterialNames(1)
Material(MaterNum)%Roughness = MediumRough
Material(MaterNum)%ROnly = .true.
! Front side and back side have the same beam-Beam Transmittance
Material(MaterNum)%TausFrontBeamBeam = MaterialProps(1)
Material(MaterNum)%TausBackBeamBeam = MaterialProps(1)
Material(MaterNum)%TausFrontBeamDiff = MaterialProps(2)
Material(MaterNum)%TausBackBeamDiff = MaterialProps(3)
Material(MaterNum)%ReflFrontBeamDiff = MaterialProps(4)
Material(MaterNum)%ReflBackBeamDiff = MaterialProps(5)
Material(MaterNum)%TausFrontBeamBeamVis = MaterialProps(6)
Material(MaterNum)%TausFrontBeamDiffVis = MaterialProps(7)
Material(MaterNum)%ReflFrontBeamDiffVis = MaterialProps(8)
Material(MaterNum)%TausThermal = MaterialProps(9)
Material(MaterNum)%EmissThermalFront = MaterialProps(10)
Material(MaterNum)%EmissThermalBack = MaterialProps(11)
! Assumes thermal emissivity is the same as thermal absorptance
Material(MaterNum)%AbsorpThermalFront = Material(MaterNum)%EmissThermalFront
Material(MaterNum)%AbsorpThermalBack = Material(MaterNum)%EmissThermalBack
Material(MaterNum)%TransThermal = Material(MaterNum)%TausThermal
IF(MaterialProps(1)+MaterialProps(2)+MaterialProps(4) >= 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(1))//' + '//TRIM(cNumericFieldNames(2))//' + ' &
//TRIM(cNumericFieldNames(4))//'not < 1.0')
END IF
IF(MaterialProps(1)+MaterialProps(3)+MaterialProps(5) >= 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(1))//' + '//TRIM(cNumericFieldNames(3))//' + ' &
//TRIM(cNumericFieldNames(5))//'not < 1.0')
END IF
!
IF(MaterialProps(6)+MaterialProps(7)+MaterialProps(8) >= 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(6))//' + '//TRIM(cNumericFieldNames(7))//' + ' &
//TRIM(cNumericFieldNames(8))//'not < 1.0')
END IF
!
IF(MaterialProps(9)+MaterialProps(10) >= 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(9))//' + '//TRIM(cNumericFieldNames(10))//' not < 1.0')
END IF
IF(MaterialProps(9)+MaterialProps(11) >= 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(9))//' + '//TRIM(cNumericFieldNames(11))//' not < 1.0')
END IF
ENDDO ! END OF DO LOOP for TotShadesEQL
! Window drape materials
CurrentModuleObject='WindowMaterial:Drape:EquivalentLayer'
DO Loop=1,TotDrapesEQL
MaterialProps=0
!Call Input Get routine to retrieve material data
CALL GetObjectItem(CurrentModuleObject,Loop,MaterialNames,MaterialNumAlpha,MaterialProps,MaterialNumProp,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
CALL VerifyName(MaterialNames(1),Material%Name,MaterNum,ErrorInName,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (ErrorInName) THEN
CALL ShowContinueError('...All Material names must be unique regardless of subtype.')
ErrorsFound=.true.
CYCLE
ENDIF
MaterNum=MaterNum+1
Material(MaterNum)%Group=DrapeEquivalentLayer
Material(MaterNum)%Name = MaterialNames(1)
Material(MaterNum)%Roughness = MediumRough
Material(MaterNum)%ROnly = .true.
! Front side and back side have the same properties
Material(MaterNum)%TausFrontBeamBeam = MaterialProps(1)
Material(MaterNum)%TausBackBeamBeam = MaterialProps(1)
Material(MaterNum)%TausFrontBeamDiff = MaterialProps(2)
Material(MaterNum)%TausBackBeamDiff = MaterialProps(3)
Material(MaterNum)%ReflFrontBeamDiff = MaterialProps(4)
Material(MaterNum)%ReflBackBeamDiff = MaterialProps(5)
!
Material(MaterNum)%TausFrontBeamBeamVis = MaterialProps(6)
Material(MaterNum)%TausFrontBeamDiffVis = MaterialProps(7)
Material(MaterNum)%ReflFrontBeamDiffVis = MaterialProps(8)
!
Material(MaterNum)%TausThermal = MaterialProps(9)
Material(MaterNum)%EmissThermalFront = MaterialProps(10)
Material(MaterNum)%EmissThermalBack = MaterialProps(11)
! Assumes thermal emissivity is the same as thermal absorptance
Material(MaterNum)%AbsorpThermalFront = Material(MaterNum)%EmissThermalFront
Material(MaterNum)%AbsorpThermalBack = Material(MaterNum)%EmissThermalBack
Material(MaterNum)%TransThermal = Material(MaterNum)%TausThermal
IF (.NOT. lNumericFieldBlanks(12) .AND. .NOT. lNumericFieldBlanks(13) ) THEN
IF ( MaterialProps(12) /= 0.0d0 .AND. MaterialProps(13) /= 0.0d0) THEN
Material(MaterNum)%PleatedDrapeWidth = MaterialProps(12)
Material(MaterNum)%PleatedDrapeLength = MaterialProps(13)
Material(MaterNum)%ISPleatedDrape = .true.
ENDIF
ELSE
Material(MaterNum)%ISPleatedDrape = .false.
ENDIF
IF(MaterialProps(1)+MaterialProps(2)+MaterialProps(4) >= 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(1))//' + '//TRIM(cNumericFieldNames(2))//' + ' &
//TRIM(cNumericFieldNames(4))//'not < 1.0')
END IF
!
IF(MaterialProps(6)+MaterialProps(7)+MaterialProps(8) >= 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(4))//' + '//TRIM(cNumericFieldNames(5))//' + ' &
//TRIM(cNumericFieldNames(6))//'not < 1.0')
END IF
!
IF(MaterialProps(9)+MaterialProps(10) > 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(9))//' + '//TRIM(cNumericFieldNames(10))//' not < 1.0')
END IF
ENDDO ! END OF DO LOOP for TotDrapesEQL
! Window Screen Materials
CurrentModuleObject='WindowMaterial:Screen'
DO Loop=1,TotScreens
!Call GetObjectItem routine to retrieve material data
CALL GetObjectItem(CurrentModuleObject,Loop,MaterialNames,MaterialNumAlpha,MaterialProps,MaterialNumProp,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
CALL VerifyName(MaterialNames(1),Material%Name,MaterNum,ErrorInName,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (ErrorInName) THEN
CALL ShowContinueError('...All Material names must be unique regardless of subtype.')
ErrorsFound=.true.
CYCLE
ENDIF
MaterNum=MaterNum+1
Material(MaterNum)%Group=Screen
!Load the material derived type from the input data.
Material(MaterNum)%Name = MaterialNames(1)
Material(MaterNum)%ReflectanceModeling= MaterialNames(2)
IF(.NOT. (SameString(MaterialNames(2),'DoNotModel') .OR. &
SameString(MaterialNames(2),'ModelAsDirectBeam') .OR. &
SameString(MaterialNames(2),'ModelAsDiffuse')))THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cAlphaFieldNames(2))//'="'//Trim(MaterialNames(2))// &
'", must be one of DoNotModel, ModelAsDirectBeam or ModelAsDiffuse.')
END IF
Material(MaterNum)%Roughness = MediumRough
Material(MaterNum)%ReflectShade = MaterialProps(1)
IF(Material(MaterNum)%ReflectShade .LT. 0.0d0 .OR. Material(MaterNum)%ReflectShade .GT. 1.0d0)THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(1))//' must be >= 0 and <= 1')
END IF
Material(MaterNum)%ReflectShadeVis = MaterialProps(2)
IF(Material(MaterNum)%ReflectShadeVis .LT. 0.0d0 .OR. Material(MaterNum)%ReflectShadeVis .GT. 1.0d0)THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(2))//' must be >= 0 and <= 1 for material ' &
//TRIM(Material(MaterNum)%Name)//'.')
END IF
Material(MaterNum)%AbsorpThermal = MaterialProps(3)
Material(MaterNum)%AbsorpThermalInput = MaterialProps(3)
IF(Material(MaterNum)%AbsorpThermal .LT. 0.0d0 .OR. Material(MaterNum)%AbsorpThermal .GT. 1.0d0)THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(3))//' must be >= 0 and <= 1')
END IF
Material(MaterNum)%Conductivity = MaterialProps(4)
Material(MaterNum)%Thickness = MaterialProps(6) ! thickness = diameter
IF(MaterialProps(5) .GT. 0.0d0)THEN
! SurfaceScreens(ScNum)%ScreenDiameterToSpacingRatio = MaterialProps(6)/MaterialProps(5) or 1-SQRT(Material(MaterNum)%Trans
IF(MaterialProps(6)/MaterialProps(5) .GE. 1.0d0)THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(6))//' must be less than '//TRIM(cNumericFieldNames(5)))
ELSE
! Calculate direct normal transmittance (open area fraction)
Material(MaterNum)%Trans = (1.d0 - MaterialProps(6)/MaterialProps(5))**2
END IF
ELSE
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(5))//' must be > 0.')
MaterialProps(5) = 0.000000001d0
END IF
IF(MaterialProps(6) .LE. 0.0d0)THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(6))//' must be > 0.')
END IF
! Modify reflectance to account for the open area in the screen assembly
Material(MaterNum)%ReflectShade = Material(MaterNum)%ReflectShade * (1.d0 - Material(MaterNum)%Trans)
Material(MaterNum)%ReflectShadeVis = Material(MaterNum)%ReflectShadeVis * (1.d0 - Material(MaterNum)%Trans)
Material(MaterNum)%WinShadeToGlassDist = MaterialProps(7)
IF(Material(MaterNum)%WinShadeToGlassDist .LT. 0.001d0 .OR. Material(MaterNum)%WinShadeToGlassDist .GT. 1.0d0)THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(7))//' must be greater than or equal to 0.001 and less than or equal to 1.')
ENDIF
Material(MaterNum)%WinShadeTopOpeningMult = MaterialProps(8)
IF(Material(MaterNum)%WinShadeTopOpeningMult .LT. 0.0d0 .OR. Material(MaterNum)%WinShadeTopOpeningMult .GT. 1.0d0)THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(8))//' must be greater than or equal to 0 and less than or equal to 1.')
ENDIF
Material(MaterNum)%WinShadeBottomOpeningMult = MaterialProps(9)
IF(Material(MaterNum)%WinShadeBottomOpeningMult .LT. 0.0d0 .OR. Material(MaterNum)%WinShadeBottomOpeningMult .GT. 1.0d0)THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(9))//' must be greater than or equal to 0 and less than or equal to 1.')
ENDIF
Material(MaterNum)%WinShadeLeftOpeningMult = MaterialProps(10)
IF(Material(MaterNum)%WinShadeLeftOpeningMult .LT. 0.0d0 .OR. Material(MaterNum)%WinShadeLeftOpeningMult .GT. 1.0d0)THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(10))//' must be greater than or equal to 0 and less than or equal to 1.')
ENDIF
Material(MaterNum)%WinShadeRightOpeningMult = MaterialProps(11)
IF(Material(MaterNum)%WinShadeRightOpeningMult .LT. 0.0d0 .OR. Material(MaterNum)%WinShadeRightOpeningMult .GT. 1.0d0)THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(11))//' must be greater than or equal to 0 and less than or equal to 1.')
ENDIF
Material(MaterNum)%ScreenMapResolution = MaterialProps(12)
IF(Material(MaterNum)%ScreenMapResolution .LT. 0 .OR. Material(MaterNum)%ScreenMapResolution .GT. 5 .OR. &
Material(MaterNum)%ScreenMapResolution .EQ. 4)THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(12))//' must be 0, 1, 2, 3, or 5.')
ErrorsFound = .true.
ENDIF
! Default air flow permeability to open area fraction
Material(MaterNum)%WinShadeAirFlowPermeability = Material(MaterNum)%Trans
Material(MaterNum)%TransThermal = Material(MaterNum)%Trans
Material(MaterNum)%TransVis = Material(MaterNum)%Trans
Material(MaterNum)%ROnly = .true.
! Calculate absorptance accounting for the open area in the screen assembly (used only in CreateShadedWindowConstruction)
Material(MaterNum)%AbsorpSolar = MAX(0.d0,1.d0- Material(MaterNum)%Trans - Material(MaterNum)%ReflectShade)
Material(MaterNum)%AbsorpSolarInput = Material(MaterNum)%AbsorpSolar
Material(MaterNum)%AbsorpVisible = MAX(0.d0,1.d0- Material(MaterNum)%TransVis - Material(MaterNum)%ReflectShadeVis)
Material(MaterNum)%AbsorpVisibleInput = Material(MaterNum)%AbsorpVisible
Material(MaterNum)%AbsorpThermal = Material(MaterNum)%AbsorpThermal * (1.0d0 - Material(MaterNum)%Trans)
Material(MaterNum)%AbsorpThermalInput = Material(MaterNum)%AbsorpThermal
IF (Material(MaterNum)%Conductivity > 0.0d0) THEN
NominalR(MaterNum)=(1.d0-Material(MaterNum)%Trans)*Material(MaterNum)%Thickness/Material(MaterNum)%Conductivity
ELSE
NominalR(MaterNum)=1.0d0
CALL ShowWarningError('Conductivity for material="'//TRIM(Material(MaterNum)%Name)//'" must be greater than' &
//' 0 for calculating Nominal R-value, Nominal R is defaulted to 1 and the simulation continues.')
ENDIF
IF(Material(MaterNum)%Trans+Material(MaterNum)%ReflectShade >= 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError('Calculated solar transmittance + solar reflectance not < 1.0')
CALL ShowContinueError('See Engineering Reference for calculation procedure for solar transmittance.')
END IF
IF(Material(MaterNum)%TransVis+Material(MaterNum)%ReflectShadeVis >= 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError('Calculated visible transmittance + visible reflectance not < 1.0')
CALL ShowContinueError('See Engineering Reference for calculation procedure for visible solar transmittance.')
END IF
IF(Material(MaterNum)%TransThermal+Material(MaterNum)%AbsorpThermal >= 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowSevereError('Thermal hemispherical emissivity plus open area fraction (1-diameter/spacing)**2' &
//' not < 1.0')
END IF
END DO
CurrentModuleObject='WindowMaterial:Screen:EquivalentLayer'
DO Loop=1,TotScreensEQL
MaterialProps = 0
!Call GetObjectItem routine to retrieve material data
CALL GetObjectItem(CurrentModuleObject,Loop,MaterialNames,MaterialNumAlpha,MaterialProps,MaterialNumProp,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
CALL VerifyName(MaterialNames(1),Material%Name,MaterNum,ErrorInName,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (ErrorInName) THEN
CALL ShowContinueError('...All Material names must be unique regardless of subtype.')
ErrorsFound=.true.
CYCLE
ENDIF
MaterNum=MaterNum+1
Material(MaterNum)%Group=ScreenEquivalentLayer
! Load the material derived type from the input data.
! WindowMaterial:Screen:EquivalentLayer,
Material(MaterNum)%Name = MaterialNames(1)
Material(MaterNum)%Roughness = MediumRough
Material(MaterNum)%ROnly = .true.
Material(MaterNum)%TausFrontBeamBeam = MaterialProps(1)
Material(MaterNum)%TausBackBeamBeam = MaterialProps(1)
Material(MaterNum)%TausFrontBeamDiff = MaterialProps(2)
Material(MaterNum)%TausBackBeamDiff = MaterialProps(2)
Material(MaterNum)%ReflFrontBeamDiff = MaterialProps(3)
Material(MaterNum)%ReflBackBeamDiff = MaterialProps(3)
Material(MaterNum)%TausFrontBeamBeamVis = MaterialProps(4)
Material(MaterNum)%TausFrontBeamDiffVis = MaterialProps(5)
Material(MaterNum)%ReflFrontDiffDiffVis = MaterialProps(6)
Material(MaterNum)%TausThermal = MaterialProps(7)
Material(MaterNum)%EmissThermalFront = MaterialProps(8)
Material(MaterNum)%EmissThermalBack = MaterialProps(8)
! Assumes thermal emissivity is the same as thermal absorptance
Material(MaterNum)%AbsorpThermalFront = Material(MaterNum)%EmissThermalFront
Material(MaterNum)%AbsorpThermalBack = Material(MaterNum)%EmissThermalBack
Material(MaterNum)%TransThermal = Material(MaterNum)%TausThermal
IF(MaterialProps(3) .LT. 0.0d0 .OR. MaterialProps(3) .GT. 1.0d0)THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(3))//' must be >= 0 and <= 1')
END IF
IF(MaterialProps(6) .LT. 0.0d0 .OR. MaterialProps(6) .GT. 1.0d0)THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(6))//' must be >= 0 and <= 1 for material ' &
//TRIM(Material(MaterNum)%Name)//'.')
END IF
IF ( .NOT. lNumericFieldBlanks(9) ) THEN
IF(MaterialProps(9) .GT. 0.00001d0)THEN
Material(MaterNum)%ScreenWireSpacing = MaterialProps(9) ! screen wire spacing
ELSE
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(9))//' must be > 0.')
CALL ShowContinueError('...Setting screen wire spacing to a default value of 0.025m and simulation continues.')
Material(MaterNum)%ScreenWireSpacing = 0.025d0
ENDIF
ENDIF
IF ( .NOT. lNumericFieldBlanks(10) ) THEN
IF(MaterialProps(10) > 0.00001d0 .AND. MaterialProps(10) < Material(MaterNum)%ScreenWireSpacing)THEN
Material(MaterNum)%ScreenWireDiameter = MaterialProps(10) ! screen wire spacing
ELSE
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value.')
CALL ShowContinueError(TRIM(cNumericFieldNames(10))//' must be > 0.')
CALL ShowContinueError('...Setting screen wire diameter to a default value of 0.005m and simulation continues.')
Material(MaterNum)%ScreenWireDiameter = 0.005d0
ENDIF
ENDIF
IF(Material(MaterNum)%ScreenWireSpacing .GT. 0.0d0)THEN
IF(Material(MaterNum)%ScreenWireDiameter/Material(MaterNum)%ScreenWireSpacing >= 1.0d0)THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(10))//' must be less than '//TRIM(cNumericFieldNames(9)))
ELSE
! Calculate direct normal transmittance (open area fraction)
Openness = (1.0d0 - Material(MaterNum)%ScreenWireDiameter/Material(MaterNum)%ScreenWireSpacing)**2
IF ( (Material(MaterNum)%TausFrontBeamBeam - Openness)/Openness > 0.01d0) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", screen openness specified.')
CALL ShowContinueError(TRIM(cNumericFieldNames(1))//' is > 1.0% of the value calculated from input fields:')
CALL ShowContinueError(TRIM(cNumericFieldNames(9))//' and '//(TRIM(cNumericFieldNames(10))))
CALL ShowContinueError(' using the formula (1-diameter/spacing)**2')
CALL ShowContinueError(' ...the screen diameter is recalculated from the material openness specified ')
CALL ShowContinueError(' ...and wire spacing using the formula = wire spacing * (1.0 - SQRT(Opennes))')
Material(MaterNum)%ScreenWireDiameter = Material(MaterNum)%ScreenWireSpacing &
* (1.0d0 - SQRT(Material(MaterNum)%TausFrontBeamBeam))
CALL ShowContinueError(' ...Recalculated '//TRIM(cNumericFieldNames(10))//'='//&
TRIM(RoundSigDigits(Material(MaterNum)%ScreenWireDiameter,4))//' m')
ENDIF
END IF
ENDIF
IF(Material(MaterNum)%TausFrontBeamBeam+Material(MaterNum)%ReflFrontBeamDiff >= 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError('Calculated solar transmittance + solar reflectance not < 1.0')
CALL ShowContinueError('See Engineering Reference for calculation procedure for solar transmittance.')
END IF
IF(Material(MaterNum)%TausFrontBeamBeamVis+Material(MaterNum)%ReflFrontDiffDiffVis >= 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError('Calculated visible transmittance + visible reflectance not < 1.0')
CALL ShowContinueError('See Engineering Reference for calculation procedure for visible solar transmittance.')
END IF
!
IF(Material(MaterNum)%TransThermal+Material(MaterNum)%AbsorpThermal >= 1.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowSevereError('Thermal hemispherical emissivity plus open area fraction (1-diameter/spacing)**2' &
//' not < 1.0')
END IF
END DO ! END OF DO LOOP FOR TotScreensEQL
! Window Blind Materials
IF(TotBlinds > 0) THEN
ALLOCATE (Blind(TotBlinds))! Allocate the array Size to the number of blinds
ENDIF
CurrentModuleObject='WindowMaterial:Blind'
DO Loop=1,TotBlinds
!Call Input Get routine to retrieve material data
CALL GetObjectItem(CurrentModuleObject,Loop,MaterialNames,MaterialNumAlpha,MaterialProps,MaterialNumProp,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
CALL VerifyName(MaterialNames(1),Material%Name,MaterNum,ErrorInName,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (ErrorInName) THEN
CALL ShowContinueError('...All Material names must be unique regardless of subtype.')
ErrorsFound=.true.
CYCLE
ENDIF
MaterNum=MaterNum+1
Material(MaterNum)%Group=WindowBlind
!Load the material derived type from the input data.
Material(MaterNum)%Name = MaterialNames(1)
Blind(Loop)%Name = MaterialNames(1)
Material(MaterNum)%Roughness = Rough
Material(MaterNum)%BlindDataPtr = Loop
Material(MaterNum)%ROnly = .true.
Blind(Loop)%MaterialNumber = MaterNum
IF (SameString(MaterialNames(2),'Horizontal')) THEN
Blind(Loop)%SlatOrientation = Horizontal
ELSEIF (SameString(MaterialNames(2),'Vertical')) THEN
Blind(Loop)%SlatOrientation = Vertical
ENDIF
Blind(Loop)%SlatWidth = MaterialProps(1)
Blind(Loop)%SlatSeparation = MaterialProps(2)
Blind(Loop)%SlatThickness = MaterialProps(3)
Blind(Loop)%SlatAngle = MaterialProps(4)
Blind(Loop)%SlatConductivity = MaterialProps(5)
Blind(Loop)%SlatTransSolBeamDiff = MaterialProps(6)
Blind(Loop)%SlatFrontReflSolBeamDiff = MaterialProps(7)
Blind(Loop)%SlatBackReflSolBeamDiff = MaterialProps(8)
Blind(Loop)%SlatTransSolDiffDiff = MaterialProps(9)
Blind(Loop)%SlatFrontReflSolDiffDiff = MaterialProps(10)
Blind(Loop)%SlatBackReflSolDiffDiff = MaterialProps(11)
Blind(Loop)%SlatTransVisBeamDiff = MaterialProps(12)
Blind(Loop)%SlatFrontReflVisBeamDiff = MaterialProps(13)
Blind(Loop)%SlatBackReflVisBeamDiff = MaterialProps(14)
Blind(Loop)%SlatTransVisDiffDiff = MaterialProps(15)
Blind(Loop)%SlatFrontReflVisDiffDiff = MaterialProps(16)
Blind(Loop)%SlatBackReflVisDiffDiff = MaterialProps(17)
Blind(Loop)%SlatTransIR = MaterialProps(18)
Blind(Loop)%SlatFrontEmissIR = MaterialProps(19)
Blind(Loop)%SlatBackEmissIR = MaterialProps(20)
Blind(Loop)%BlindToGlassDist = MaterialProps(21)
Blind(Loop)%BlindTopOpeningMult = MaterialProps(22)
Blind(Loop)%BlindBottomOpeningMult = MaterialProps(23)
Blind(Loop)%BlindLeftOpeningMult = MaterialProps(24)
Blind(Loop)%BlindRightOpeningMult = MaterialProps(25)
Blind(Loop)%MinSlatAngle = MaterialProps(26)
Blind(Loop)%MaxSlatAngle = MaterialProps(27)
! TH 2/11/2010. For CR 8010
! By default all blinds have fixed slat angle, new blinds with variable slat angle are created if
! they are used with window shading controls that adjust slat angles like ScheduledSlatAngle or BlockBeamSolar
Blind(Loop)%SlatAngleType = FixedSlats
IF (Blind(Loop)%SlatWidth < Blind(Loop)%SlatSeparation) THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Slat Angles/Widths')
CALL ShowContinueError(TRIM(cNumericFieldNames(1))//' ['//TRIM(RoundSigDigits(Blind(Loop)%SlatWidth,2))// &
'] is less than '//TRIM(cNumericFieldNames(2))//' ['//TRIM(RoundSigDigits(Blind(Loop)%SlatSeparation,2))//'].')
CALL ShowContinueError('This will allow direct beam to be transmitted when Slat angle = 0.')
END IF
IF(.not. SameString(MaterialNames(2),'Horizontal') .AND. .not. SameString(MaterialNames(2),'Vertical')) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value')
CALL ShowContinueError(TRIM(cAlphaFieldNames(2))//'="'//trim(MaterialNames(2))//'", must be '// &
' Horizontal or Vertical.')
END IF
IF((MaterialProps(6)+MaterialProps(7) >= 1.0d0)) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(6))//' + '//TRIM(cNumericFieldNames(7))//' not < 1.0')
END IF
IF((MaterialProps(6)+MaterialProps(8) >= 1.0d0)) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(6))//' + '//TRIM(cNumericFieldNames(8))//' not < 1.0')
END IF
IF((MaterialProps(9)+MaterialProps(10) >= 1.0d0)) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(9))//' + '//TRIM(cNumericFieldNames(10))//' not < 1.0')
END IF
IF((MaterialProps(9)+MaterialProps(11) >= 1.0d0)) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(9))//' + '//TRIM(cNumericFieldNames(11))//' not < 1.0')
END IF
IF((MaterialProps(12)+MaterialProps(13) >= 1.0d0).OR.(MaterialProps(12)+MaterialProps(14) >= 1.0d0)) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(12))//' + '//TRIM(cNumericFieldNames(13))//' not < 1.0 OR')
CALL ShowContinueError(TRIM(cNumericFieldNames(12))//' + '//TRIM(cNumericFieldNames(14))//' not < 1.0')
END IF
IF((MaterialProps(12)+MaterialProps(13) >= 1.0d0)) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(12))//' + '//TRIM(cNumericFieldNames(13))//' not < 1.0')
END IF
IF((MaterialProps(12)+MaterialProps(14) >= 1.0d0)) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(12))//' + '//TRIM(cNumericFieldNames(14))//' not < 1.0')
END IF
IF((MaterialProps(15)+MaterialProps(16) >= 1.0d0)) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(15))//' + '//TRIM(cNumericFieldNames(16))//' not < 1.0')
END IF
IF((MaterialProps(15)+MaterialProps(17) >= 1.0d0)) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(15))//' + '//TRIM(cNumericFieldNames(17))//' not < 1.0')
END IF
! Require that beam and diffuse properties be the same
IF(ABS(MaterialProps(9)-MaterialProps(6)) > 1.d-5) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(6))//' must equal '//TRIM(cNumericFieldNames(9)))
END IF
IF(ABS(MaterialProps(10)-MaterialProps(7)) > 1.d-5) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(7))//' must equal '//TRIM(cNumericFieldNames(10)))
END IF
IF(ABS(MaterialProps(11)-MaterialProps(8)) > 1.d-5) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(8))//' must equal '//TRIM(cNumericFieldNames(11)))
END IF
IF(ABS(MaterialProps(15)-MaterialProps(12)) > 1.d-5) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(12))//' must equal '//TRIM(cNumericFieldNames(15)))
END IF
IF(ABS(MaterialProps(16)-MaterialProps(13)) > 1.d-5) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(13))//' must equal '//TRIM(cNumericFieldNames(16)))
END IF
IF(ABS(MaterialProps(17)-MaterialProps(14)) > 1.d-5) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(14))//' must equal '//TRIM(cNumericFieldNames(17)))
END IF
IF((MaterialProps(18)+MaterialProps(19) >= 1.0d0)) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(18))//' + '//TRIM(cNumericFieldNames(19))//' not < 1.0')
END IF
IF((MaterialProps(18)+MaterialProps(20) >= 1.0d0)) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(18))//' + '//TRIM(cNumericFieldNames(20))//' not < 1.0')
END IF
IF(Blind(Loop)%BlindToGlassDist < 0.5d0*Blind(Loop)%SlatWidth) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(21))//' is less than half of the '// &
trim(cNumericFieldNames(1)))
END IF
! Minimum and maximum slat angles allowed by slat geometry
IF(Blind(Loop)%SlatWidth > Blind(Loop)%SlatSeparation) THEN
MinSlatAngGeom = ASIN(Blind(Loop)%SlatThickness/(Blind(Loop)%SlatThickness + Blind(Loop)%SlatSeparation))/DegToRadians
ELSE
MinSlatAngGeom = 0.0d0
END IF
MaxSlatAngGeom = 180.d0- MinSlatAngGeom
! Error if input slat angle not in range allowed by slat geometry
IF((Blind(Loop)%SlatSeparation + Blind(Loop)%SlatThickness) < Blind(Loop)%SlatWidth) THEN
IF(Blind(Loop)%SlatAngle < MinSlatAngGeom) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(4))//'=['//TRIM(RoundSigDigits(Blind(Loop)%SlatAngle,1))// &
'], is less than smallest allowed by slat dimensions and spacing, ['// &
TRIM(RoundSigDigits(MinSlatAngGeom,1))//'] deg.')
ELSE IF(Blind(Loop)%SlatAngle > MaxSlatAngGeom) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(4))//'=['//TRIM(RoundSigDigits(Blind(Loop)%SlatAngle,1))// &
'], is greater than largest allowed by slat dimensions and spacing, ['// &
TRIM(RoundSigDigits(MinSlatAngGeom,1))//'] deg.')
END IF
END IF
! By default all Blinds are "fixed" slats. Only with Shading Control is one considered variable and this check
! is now done when that happens. 9.3.2009 LKL
! IF(Blind(Loop)%SlatAngleType == VariableSlats) THEN
!
! ! Error if maximum slat angle less than minimum
!
! IF(Blind(Loop)%MaxSlatAngle < Blind(Loop)%MinSlatAngle) THEN
! ErrorsFound = .true.
! CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
! CALL ShowContinueError(TRIM(cNumericFieldNames(26))//'=['//TRIM(RoundSigDigits(Blind(Loop)%MinSlatAngle,1))// &
! '], is greater than '//trim(cNumericFieldNames(27))//'=['// &
! TRIM(RoundSigDigits(Blind(Loop)%MaxSlatAngle,1))//'] deg.')
! END IF
!
! ! Error if input slat angle not in input min/max range
!
! IF(Blind(Loop)%MaxSlatAngle > Blind(Loop)%MinSlatAngle .AND. (Blind(Loop)%SlatAngle < Blind(Loop)%MinSlatAngle &
! .OR. Blind(Loop)%SlatAngle > Blind(Loop)%MaxSlatAngle)) THEN
! ErrorsFound = .true.
! CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
! CALL ShowContinueError(TRIM(cNumericFieldNames(4))//'=['//TRIM(RoundSigDigits(Blind(Loop)%SlatAngle,1))// &
! '] is outside of the input min/max range, min=['//TRIM(RoundSigDigits(Blind(Loop)%MinSlatAngle,1))// &
! '], max=['//TRIM(RoundSigDigits(Blind(Loop)%MaxSlatAngle,1))//'] deg.')
! END IF
!
! ! Error if input minimum slat angle is less than that allowed by slat geometry
!
! IF(Blind(Loop)%MinSlatAngle < MinSlatAngGeom) THEN
! CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
! CALL ShowContinueError(TRIM(cNumericFieldNames(26))//'=['//TRIM(RoundSigDigits(Blind(Loop)%MinSlatAngle,1))// &
! '] is less than the smallest allowed by slat dimensions and spacing, min=['// &
! TRIM(RoundSigDigits(MinSlatAngGeom,1))//'] deg.')
! CALL ShowContinueError('Minimum Slat Angle will be set to '//TRIM(RoundSigDigits(MinSlatAngGeom,1))//' deg.')
! Blind(Loop)%MinSlatAngle = MinSlatAngGeom
! END IF
!
! ! Error if input maximum slat angle is greater than that allowed by slat geometry
!
! IF(Blind(Loop)%MaxSlatAngle > MaxSlatAngGeom) THEN
! CALL ShowWarningError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
! CALL ShowContinueError(TRIM(cNumericFieldNames(27))//'=['//TRIM(RoundSigDigits(Blind(Loop)%MaxSlatAngle,1))// &
! '] is greater than the largest allowed by slat dimensions and spacing, ['// &
! TRIM(RoundSigDigits(MaxSlatAngGeom,1))//'] deg.')
! CALL ShowContinueError('Maximum Slat Angle will be set to '//TRIM(RoundSigDigits(MaxSlatAngGeom,1))//' deg.')
! Blind(Loop)%MaxSlatAngle = MaxSlatAngGeom
! END IF
!
! END IF ! End of check if slat angle is variable
ENDDO
! Window Blind Materials for EquivalentLayer Model
CurrentModuleObject='WindowMaterial:Blind:EquivalentLayer'
DO Loop=1,TotBlindsEQL
!Call Input Get routine to retrieve material data
CALL GetObjectItem(CurrentModuleObject,Loop,MaterialNames,MaterialNumAlpha,MaterialProps,MaterialNumProp,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
CALL VerifyName(MaterialNames(1),Material%Name,MaterNum,ErrorInName,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (ErrorInName) THEN
CALL ShowContinueError('...All Material names must be unique regardless of subtype.')
ErrorsFound=.true.
CYCLE
ENDIF
MaterNum=MaterNum+1
Material(MaterNum)%Group=BlindEquivalentLayer
Material(MaterNum)%Name = MaterialNames(1)
Material(MaterNum)%Roughness = Rough
Material(MaterNum)%ROnly = .true.
IF (SameString(MaterialNames(2),'Horizontal')) THEN
Material(MaterNum)%SlatOrientation = Horizontal
ELSEIF (SameString(MaterialNames(2),'Vertical')) THEN
Material(MaterNum)%SlatOrientation = Vertical
ENDIF
Material(MaterNum)%SlatWidth = MaterialProps(1)
Material(MaterNum)%SlatSeparation = MaterialProps(2)
Material(MaterNum)%SlatCrown = MaterialProps(3)
Material(MaterNum)%SlatAngle = MaterialProps(4)
Material(MaterNum)%TausFrontBeamDiff = MaterialProps(5)
Material(MaterNum)%TausBackBeamDiff = MaterialProps(6)
Material(MaterNum)%ReflFrontBeamDiff = MaterialProps(7)
Material(MaterNum)%ReflBackBeamDiff = MaterialProps(8)
IF (.NOT. lNumericFieldBlanks(9) .AND. .NOT. lNumericFieldBlanks(10) .AND. &
.NOT. lNumericFieldBlanks(11) .AND. .NOT. lNumericFieldBlanks(12)) THEN
Material(MaterNum)%TausFrontBeamDiffVis = MaterialProps(9)
Material(MaterNum)%TausBackBeamDiffVis = MaterialProps(10)
Material(MaterNum)%ReflFrontBeamDiffVis = MaterialProps(11)
Material(MaterNum)%ReflBackBeamDiffVis = MaterialProps(12)
ENDIF
IF (.NOT. lNumericFieldBlanks(13) .AND. .NOT. lNumericFieldBlanks(14) .AND. &
.NOT. lNumericFieldBlanks(15) ) THEN
Material(MaterNum)%TausDiffDiff = MaterialProps(13)
Material(MaterNum)%ReflFrontDiffDiff = MaterialProps(14)
Material(MaterNum)%ReflBackDiffDiff = MaterialProps(15)
ENDIF
IF (.NOT. lNumericFieldBlanks(16) .AND. .NOT. lNumericFieldBlanks(17) .AND. &
.NOT. lNumericFieldBlanks(18) ) THEN
Material(MaterNum)%TausDiffDiffVis = MaterialProps(13)
Material(MaterNum)%ReflFrontDiffDiffVis = MaterialProps(14)
Material(MaterNum)%ReflBackDiffDiffVis = MaterialProps(15)
ENDIF
IF (.NOT. lNumericFieldBlanks(19) .AND. .NOT. lNumericFieldBlanks(20) .AND. &
.NOT. lNumericFieldBlanks(21) ) THEN
Material(MaterNum)%TausThermal = MaterialProps(19)
Material(MaterNum)%EmissThermalFront = MaterialProps(20)
Material(MaterNum)%EmissThermalBack = MaterialProps(21)
ENDIF
! Assumes thermal emissivity is the same as thermal absorptance
Material(MaterNum)%AbsorpThermalFront = Material(MaterNum)%EmissThermalFront
Material(MaterNum)%AbsorpThermalBack = Material(MaterNum)%EmissThermalBack
Material(MaterNum)%TransThermal = Material(MaterNum)%TausThermal
! By default all blinds have fixed slat angle,
! they are used with window shading controls that adjust slat angles like MaximizeSolar or BlockBeamSolar
IF (.NOT. lAlphaFieldBlanks(3) ) THEN
IF (SameString(MaterialNames(3),'FixedSlatAngle')) THEN
Material(MaterNum)%SlatAngleType = 0
ELSEIF(SameString(MaterialNames(3),'MaximizeSolar')) THEN
Material(MaterNum)%SlatAngleType = 1
ELSEIF(SameString(MaterialNames(3),'BlockBeamSolar')) THEN
Material(MaterNum)%SlatAngleType = 2
ELSE
Material(MaterNum)%SlatAngleType = 0
ENDIF
ELSE
Material(MaterNum)%SlatAngleType = 0
ENDIF
IF (Material(MaterNum)%SlatWidth < Material(MaterNum)%SlatSeparation) THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Slat Seperation/Width')
CALL ShowContinueError(TRIM(cNumericFieldNames(1))//' ['//TRIM(RoundSigDigits(Material(MaterNum)%SlatWidth,2))// &
'] is less than '//TRIM(cNumericFieldNames(2))//' ['//TRIM(RoundSigDigits(Material(MaterNum)%SlatSeparation,2))//'].')
CALL ShowContinueError('This will allow direct beam to be transmitted when Slat angle = 0.')
END IF
IF (Material(MaterNum)%SlatSeparation < 0.001d0) THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Slat Seperation')
CALL ShowContinueError(TRIM(cNumericFieldNames(2))//' ['//TRIM(RoundSigDigits(Material(MaterNum)%SlatSeparation,2))// &
'].'//' Slate spacing must be > 0.0')
CALL ShowContinueError('...Setting slate spacing to default value of 0.025 m and simulation continues.')
Material(MaterNum)%SlatSeparation = 0.025d0
END IF
IF (Material(MaterNum)%SlatWidth < 0.001d0 .OR. Material(MaterNum)%SlatWidth >= 2.0d0 * Material(MaterNum)%SlatSeparation) THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Slat Width')
CALL ShowContinueError(TRIM(cNumericFieldNames(1))//' ['//TRIM(RoundSigDigits(Material(MaterNum)%SlatWidth,2))// &
'].'//' Slat width range is 0 < Width <= 2*Spacing')
CALL ShowContinueError('...Setting slate width equal to slate spacing and simulation continues.')
Material(MaterNum)%SlatWidth = Material(MaterNum)%SlatSeparation
END IF
IF (Material(MaterNum)%SlatCrown < 0.0d0 .OR. Material(MaterNum)%SlatCrown >= 0.5d0 * Material(MaterNum)%SlatWidth) THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Slat Crown')
CALL ShowContinueError(TRIM(cNumericFieldNames(3))//' ['//TRIM(RoundSigDigits(Material(MaterNum)%SlatCrown,2))// &
'].'//' Slat crwon range is 0 <= crown < 0.5*Width')
CALL ShowContinueError('...Setting slate crown to 0.0 and simulation continues.')
Material(MaterNum)%SlatCrown = 0.0d0
END IF
IF (Material(MaterNum)%SlatAngle < -90.0d0 .OR. Material(MaterNum)%SlatAngle > 90.0d0) THEN
CALL ShowWarningError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Slat Angle')
CALL ShowContinueError(TRIM(cNumericFieldNames(4))//' ['//TRIM(RoundSigDigits(Material(MaterNum)%SlatAngle,2))// &
'].'//' Slat angle range is -90.0 <= Angle < 90.0')
CALL ShowContinueError('...Setting slate angle to 0.0 and simulation continues.')
Material(MaterNum)%SlatAngle = 0.0d0
END IF
IF(.not. SameString(MaterialNames(2),'Horizontal') .AND. .not. SameString(MaterialNames(2),'Vertical')) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value')
CALL ShowContinueError(TRIM(cAlphaFieldNames(2))//'="'//trim(MaterialNames(2))//'", must be '// &
' Horizontal or Vertical.')
END IF
IF((MaterialProps(5)+MaterialProps(7) >= 1.0d0)) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(5))//' + '//TRIM(cNumericFieldNames(7))//' not < 1.0')
END IF
IF((MaterialProps(6)+MaterialProps(8) >= 1.0d0)) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(6))//' + '//TRIM(cNumericFieldNames(8))//' not < 1.0')
END IF
!
IF((MaterialProps(9)+MaterialProps(11) >= 1.0d0)) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(9))//' + '//TRIM(cNumericFieldNames(11))//' not < 1.0')
END IF
IF((MaterialProps(10)+MaterialProps(12) >= 1.0d0)) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value combination.')
CALL ShowContinueError(TRIM(cNumericFieldNames(10))//' + '//TRIM(cNumericFieldNames(12))//' not < 1.0')
END IF
!
ENDDO ! END OF DO LOOP FOR TotBlindsEQL
! EcoRoof Materials
!PSU 2006
CurrentModuleObject='Material:RoofVegetation'
DO Loop=1,EcoRoofMat
!Call Input Get Routine to retrieve material data from ecoroof
CALL GetObjectItem(CurrentModuleObject,Loop,MaterialNames,MaterialNumAlpha,MaterialProps,MaterialNumProp,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
CALL VerifyName(MaterialNames(1),Material%Name,MaterNum,ErrorInName,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (ErrorInName) THEN
CALL ShowContinueError('...All Material names must be unique regardless of subtype.')
ErrorsFound=.true.
CYCLE
ENDIF
!this part is similar to the regular material
!Load the material derived type from the input data.
MaterNum=MaterNum+1
Material(MaterNum)%Group = EcoRoof
!this part is new for Ecoroof properties,
!especially for the Plant Layer of the ecoroof
Material(MaterNum)%HeightOfPlants = MaterialProps(1)
Material(MaterNum)%LAI = MaterialProps(2)
Material(MaterNum)%Lreflectivity = MaterialProps(3) ! Albedo
Material(MaterNum)%Lemissitivity = MaterialProps(4)
Material(MaterNum)%RStomata = MaterialProps(5)
Material(MaterNum)%Name = MaterialNames(1)
!need to treat the A2 with is just the name of the soil(it is
! not important)
CALL ValidateMaterialRoughness(MaterNum,MaterialNames(3),ErrorsFound)
IF (SameString(MaterialNames(4),'Simple')) THEN
Material(MaterNum)%EcoRoofCalculationMethod = 1
ELSEIF (SameString(MaterialNames(4),'Advanced') .or. lAlphaFieldBlanks(4)) THEN
Material(MaterNum)%EcoRoofCalculationMethod = 2
ELSE
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(MaterialNames(1))//'", Illegal value')
CALL ShowContinueError(trim(cAlphaFieldNames(4))//'="'//trim(MaterialNames(4))//'".')
CALL ShowContinueError('...Valid values are "Simple" or "Advanced".')
ErrorsFound=.true.
ENDIF
Material(MaterNum)%Thickness = MaterialProps(6)
Material(MaterNum)%Conductivity = MaterialProps(7)
Material(MaterNum)%Density = MaterialProps(8)
Material(MaterNum)%SpecHeat = MaterialProps(9)
Material(MaterNum)%AbsorpThermal = MaterialProps(10) ! emissivity
Material(MaterNum)%AbsorpSolar = MaterialProps(11) ! (1 - Albedo)
Material(MaterNum)%AbsorpVisible = MaterialProps(12)
Material(MaterNum)%Porosity = MaterialProps(13)
Material(MaterNum)%MinMoisture = MaterialProps(14)
Material(MaterNum)%InitMoisture = MaterialProps(15)
IF (Material(MaterNum)%Conductivity > 0.0d0) THEN
NominalR(MaterNum) = Material(MaterNum)%Thickness/Material(MaterNum)%Conductivity
Material(MaterNum)%Resistance = NominalR(MaterNum)
ELSE
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" is not defined correctly.')
CALL ShowContinueError(trim(cNumericFieldNames(7))//' is <=0.')
ErrorsFound = .TRUE.
END IF
END DO
! Thermochromic glazing group
! get the number of WindowMaterial:GlazingGroup:Thermochromic objects in the idf file
CurrentModuleObject='WindowMaterial:GlazingGroup:Thermochromic'
TotTCGlazings = GetNumObjectsFound(CurrentModuleObject)
IF (TotTCGlazings >=1) THEN
! Read TC glazings
ALLOCATE (TCGlazings(TotTCGlazings))
DO Loop = 1, TotTCGlazings
!Get each TCGlazings from the input processor
CALL GetObjectItem(CurrentModuleObject,Loop,cAlphaArgs,MaterialNumAlpha,rNumericArgs,MaterialNumProp,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
! Verify unique names
CALL VerifyName(cAlphaArgs(1),TCGlazings%Name,Loop-1,ErrorInName,IsBlank,TRIM(CurrentModuleObject)//' Name')
IF (ErrorInName) THEN
CALL ShowContinueError('...All Thermochromic Glazing names must be unique regardless of subtype.')
ErrorsFound=.true.
CYCLE
ENDIF
IF ( MaterialNumProp + 1 /= MaterialNumAlpha ) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" is not defined correctly.')
CALL ShowContinueError('Check number of '//Trim(cAlphaFieldNames(2))// &
' compared to number of '//Trim(cNumericFieldNames(1)))
ErrorsFound=.true.
CYCLE
ENDIF
!Allocate arrays
ALLOCATE (TCGlazings(Loop)%SpecTemp(MaterialNumProp))
ALLOCATE (TCGlazings(Loop)%LayerName(MaterialNumProp))
ALLOCATE (TCGlazings(Loop)%LayerPoint(MaterialNumProp))
TCGlazings(Loop)%SpecTemp = 0.0d0
TCGlazings(Loop)%LayerName = ' '
TCGlazings(Loop)%LayerPoint = 0
TCGlazings(Loop)%Name = cAlphaArgs(1)
TCGlazings(Loop)%NumGlzMat = MaterialNumProp
DO iTC = 1, MaterialNumProp
TCGlazings(Loop)%SpecTemp(iTC)= rNumericArgs(iTC)
TCGlazings(Loop)%LayerName(iTC)= cAlphaArgs(1+iTC)
! Find this glazing material in the material list
iMat = FindIteminList(cAlphaArgs(1+iTC),Material%Name,TotMaterials)
IF (iMat /= 0) THEN
!TC glazing
Material(iMat)%SpecTemp = rNumericArgs(iTC)
Material(iMat)%TCParent = Loop
TCGlazings(Loop)%LayerPoint(iTC) = iMat
!test that named material is of the right type
IF( Material(iMat)%Group /= WindowGlass) THEN
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" is not defined correctly.')
CALL ShowContinueError('Material named: '//Trim(cAlphaArgs(1+iTC))//' is not a window glazing ')
ErrorsFound=.true.
ENDIF
ELSE ! thow error because not found
CALL ShowSevereError(TRIM(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" is not defined correctly.')
CALL ShowContinueError('Material named: '//Trim(cAlphaArgs(1+iTC))//' was not found ')
ErrorsFound=.true.
ENDIF
ENDDO
ENDDO
ENDIF
cCurrentModuleObject='WindowMaterial:SimpleGlazingSystem'
DO Loop=1, TotSimpleWindow
CALL GetObjectItem(cCurrentModuleObject, Loop, cAlphaArgs, MaterialNumAlpha, &
rNumericArgs, MaterialNumProp,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1), Material%Name,MaterNum,ErrorInName,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (ErrorInName) THEN
CALL ShowContinueError('...All Material names must be unique regardless of subtype.')
ErrorsFound=.true.
CYCLE
ENDIF
MaterNum=MaterNum+1
Material(MaterNum)%Group = WindowSimpleGlazing
Material(MaterNum)%Name = cAlphaArgs(1)
Material(MaterNum)%SimpleWindowUfactor = rNumericArgs(1)
Material(MaterNum)%SimpleWindowSHGC = rNumericArgs(2)
IF (.not. lNumericFieldBlanks(3)) THEN
Material(MaterNum)%SimpleWindowVisTran = rNumericArgs(3)
Material(MaterNum)%SimpleWindowVTinputByUser = .TRUE.
ENDIF
CALL SetupSimpleWindowGlazingSystem(MaterNum)
ENDDO
!Simon: Place to load materials for complex fenestrations
if ((TotComplexShades.gt.0).or.(TotComplexGaps.gt.0)) then
call SetupComplexFenestrationMaterialInput(MaterNum,ErrorsFound)
IF (ErrorsFound) THEN
CALL ShowSevereError('Errors found in processing complex fenestration material input')
ENDIF
end if
CALL ScanForReports('Constructions',DoReport,'Materials')
IF (DoReport) THEN
Write(OutputFileInits,'(A)') '! <Material Details>,Material Name,ThermalResistance {m2-K/w},Roughness,Thickness {m},'// &
'Conductivity {w/m-K},Density {kg/m3},Specific Heat {J/kg-K},Absorptance:Thermal,Absorptance:Solar,Absorptance:Visible'
Write(OutputFileInits,'(A)') '! <Material:Air>,Material Name,ThermalResistance {m2-K/w}'
Do MaterNum=1,TotMaterials
SELECT CASE (Material(MaterNum)%Group)
CASE (Air)
Write(OutputFileInits,702) TRIM(Material(MaterNum)%Name), &
TRIM(RoundSigDigits(Material(MaterNum)%Resistance,4))
CASE DEFAULT
Write(OutputFileInits,701) TRIM(Material(MaterNum)%Name),TRIM(RoundSigDigits(Material(MaterNum)%Resistance,4)), &
TRIM(DisplayMaterialRoughness(Material(MaterNum)%Roughness)), &
TRIM(RoundSigDigits(Material(MaterNum)%Thickness,4)), &
TRIM(RoundSigDigits(Material(MaterNum)%Conductivity,3)), &
TRIM(RoundSigDigits(Material(MaterNum)%Density,3)), &
TRIM(RoundSigDigits(Material(MaterNum)%SpecHeat,3)), &
TRIM(RoundSigDigits(Material(MaterNum)%AbsorpThermal,4)), &
TRIM(RoundSigDigits(Material(MaterNum)%AbsorpSolar,4)), &
TRIM(RoundSigDigits(Material(MaterNum)%AbsorpVisible,4))
END SELECT
end do
End If
! FORMATS.
701 FORMAT(' Material Details',10(',',A))
702 FORMAT(' Material:Air',2(',',A))
IF (AnyEnergyManagementSystemInModel) THEN ! setup surface property EMS actuators
DO MaterNum=1,TotMaterials
IF (Material(MaterNum)%Group /= RegularMaterial) CYCLE
CALL SetupEMSActuator('Material', Material(MaterNum)%Name, &
'Surface Property Solar Absorptance', '[ ]', &
Material(MaterNum)%AbsorpSolarEMSOverrideOn , &
Material(MaterNum)%AbsorpSolarEMSOverride )
CALL SetupEMSActuator('Material', Material(MaterNum)%Name, &
'Surface Property Thermal Absorptance', '[ ]', &
Material(MaterNum)%AbsorpThermalEMSOverrideOn , &
Material(MaterNum)%AbsorpThermalEMSOverride )
CALL SetupEMSActuator('Material', Material(MaterNum)%Name, &
'Surface Property Visible Absorptance', '[ ]', &
Material(MaterNum)%AbsorpVisibleEMSOverrideOn , &
Material(MaterNum)%AbsorpVisibleEMSOverride )
ENDDO
ENDIF
RETURN
END SUBROUTINE GetMaterialData