GetMaterialData Subroutine

private subroutine GetMaterialData(ErrorsFound)

proc~~getmaterialdata~~UsesGraph proc~getmaterialdata GetMaterialData module~general General module~general->proc~getmaterialdata module~dataprecisionglobals DataPrecisionGlobals module~dataprecisionglobals->module~general
Help

Arguments

Type IntentOptional AttributesName
logical, intent(inout) :: ErrorsFound

Calls

proc~~getmaterialdata~~CallsGraph proc~getmaterialdata GetMaterialData proc~displaymaterialroughness DisplayMaterialRoughness proc~getmaterialdata->proc~displaymaterialroughness 2 2 proc~getmaterialdata->2 scanforreports scanforreports proc~getmaterialdata->scanforreports finditeminlist finditeminlist proc~getmaterialdata->finditeminlist verifyname verifyname proc~getmaterialdata->verifyname calphafieldnames calphafieldnames proc~getmaterialdata->calphafieldnames roundsigdigits roundsigdigits proc~getmaterialdata->roundsigdigits interface~setupemsactuator SetupEMSActuator proc~getmaterialdata->interface~setupemsactuator proc~validatematerialroughness ValidateMaterialRoughness proc~getmaterialdata->proc~validatematerialroughness calphaargs calphaargs proc~getmaterialdata->calphaargs gasspecificheatratio gasspecificheatratio proc~getmaterialdata->gasspecificheatratio gaswght gaswght proc~getmaterialdata->gaswght samestring samestring proc~getmaterialdata->samestring gascoeffscon gascoeffscon proc~getmaterialdata->gascoeffscon interface~showcontinueerror ShowContinueError proc~getmaterialdata->interface~showcontinueerror gascoeffscp gascoeffscp proc~getmaterialdata->gascoeffscp gascoeffsvis gascoeffsvis proc~getmaterialdata->gascoeffsvis interface~showwarningerror ShowWarningError proc~getmaterialdata->interface~showwarningerror material material proc~getmaterialdata->material tcglazings tcglazings proc~getmaterialdata->tcglazings proc~setupcomplexfenestrationmaterialinput SetupComplexFenestrationMaterialInput proc~getmaterialdata->proc~setupcomplexfenestrationmaterialinput lalphafieldblanks lalphafieldblanks proc~getmaterialdata->lalphafieldblanks nominalr nominalr proc~getmaterialdata->nominalr proc~setupsimplewindowglazingsystem SetupSimpleWindowGlazingSystem proc~getmaterialdata->proc~setupsimplewindowglazingsystem rnumericargs rnumericargs proc~getmaterialdata->rnumericargs interface~showsevereerror ShowSevereError proc~getmaterialdata->interface~showsevereerror cnumericfieldnames cnumericfieldnames proc~getmaterialdata->cnumericfieldnames lnumericfieldblanks lnumericfieldblanks proc~getmaterialdata->lnumericfieldblanks blind blind proc~getmaterialdata->blind getnumobjectsfound getnumobjectsfound proc~getmaterialdata->getnumobjectsfound getobjectitem getobjectitem proc~getmaterialdata->getobjectitem 10 10 proc~getmaterialdata->10 proc~validatematerialroughness->samestring proc~validatematerialroughness->material proc~validatematerialroughness->interface~showsevereerror proc~setupcomplexfenestrationmaterialinput->finditeminlist proc~setupcomplexfenestrationmaterialinput->verifyname proc~setupcomplexfenestrationmaterialinput->calphafieldnames proc~setupcomplexfenestrationmaterialinput->roundsigdigits proc~setupcomplexfenestrationmaterialinput->calphaargs proc~setupcomplexfenestrationmaterialinput->interface~showcontinueerror proc~setupcomplexfenestrationmaterialinput->material proc~setupcomplexfenestrationmaterialinput->lalphafieldblanks proc~setupcomplexfenestrationmaterialinput->rnumericargs proc~setupcomplexfenestrationmaterialinput->interface~showsevereerror proc~setupcomplexfenestrationmaterialinput->cnumericfieldnames proc~setupcomplexfenestrationmaterialinput->getnumobjectsfound proc~setupcomplexfenestrationmaterialinput->getobjectitem supportpillar supportpillar proc~setupcomplexfenestrationmaterialinput->supportpillar interface~showfatalerror ShowFatalError proc~setupcomplexfenestrationmaterialinput->interface~showfatalerror deflectionstate deflectionstate proc~setupcomplexfenestrationmaterialinput->deflectionstate complexshade complexshade proc~setupcomplexfenestrationmaterialinput->complexshade proc~setupsimplewindowglazingsystem->interface~showwarningerror proc~setupsimplewindowglazingsystem->material proc~setupsimplewindowglazingsystem->nominalr proc~setupsimplewindowglazingsystem->interface~showsevereerror proc~setupsimplewindowglazingsystem->interface~showfatalerror
Help

Called By

proc~~getmaterialdata~~CalledByGraph proc~getmaterialdata GetMaterialData proc~getheatbalanceinput GetHeatBalanceInput proc~getheatbalanceinput->proc~getmaterialdata proc~manageheatbalance ManageHeatBalance proc~manageheatbalance->proc~getheatbalanceinput proc~setupsimulation SetupSimulation proc~setupsimulation->proc~manageheatbalance proc~managesimulation ManageSimulation proc~managesimulation->proc~manageheatbalance proc~managesimulation->proc~setupsimulation proc~setupzonesizing SetupZoneSizing proc~setupzonesizing->proc~manageheatbalance proc~managesizing ManageSizing proc~managesizing->proc~manageheatbalance proc~managesizing->proc~setupzonesizing program~energyplus EnergyPlus program~energyplus->proc~managesimulation
Help

Source Code


Source Code

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


AbortEnergyPlus AbsoluteAirMass ActivateDemandManagers ActivateEMSControls AddBlankKeys addChargesToOperand AddCompSizeTableEntry AddEndUseSubcategory AddError addFootNoteSubTable AddInstruction AddMeter addMonthlyCharge AddMonthlyFieldSetInput AddMonthlyReport AddNeighborInformation AddObjectDefandParse addOperand AddRecordFromSection AddRecordToOutputVariableStructure AddSectionDef AddShadowRelateTableEntry AddSQLiteComponentSizingRecord AddSQLiteComponentSizingRecord AddSQLiteSystemSizingRecord AddSQLiteSystemSizingRecord AddSQLiteZoneSizingRecord AddSQLiteZoneSizingRecord AddTOCEntry AddTOCZoneLoadComponentTable AddToOutputVariableList AddVariablesForMonthlyReport AddVariableSlatBlind AddWindow AdjustAirSetpointsforOpTempCntrl AdjustCBF AdjustCBF AdjustChangeInLoadByEMSControls AdjustChangeInLoadByHowServed AdjustChangeInLoadForLastStageUpperRangeLimit AdjustCoolingSetPointforTempAndHumidityControl adjusthhat AdjustPumpFlowRequestByEMSControls AdjustReportingHourAndMinutes AdjustVBGap AdvanceRootFinder AFECFR AFECOI AFECPD AFECPF AFEDMP AFEDOP AFEDWC AFEELR AFEEXF AFEFAN AFEHEX AFEHOP AFEPLR AFESCR AFESEL AFESOP AFETMU AirflowNetworkVentingControl AirMass AIRMOV AllocateAirflowNetworkData AllocateAirHeatBalArrays AllocateAndInitData AllocateAndSetUpVentReports AllocateCFSStateHourlyData AllocateForCFSRefPointsGeometry AllocateForCFSRefPointsState AllocateHeatBalArrays AllocateLoadComponentArrays AllocateModuleArrays AllocateModuleArrays AllocateSurfaceHeatBalArrays AllocateWeatherData angle_2dvector AnisoSkyViewFactors AnyPlantLoopSidesNeedSim AnyPlantSplitterMixerLacksContinuity AreaPolygon ArgCheck array_to_vector ASHRAETauModel ASHWAT_OffNormalProperties ASHWAT_Solar ASHWAT_Thermal ASSIGNMENT (=) AssignNodeNumber AssignReportNumber AssignResourceTypeNum AssignReverseConstructionNumber AssignVariablePt AttachCustomMeters AttachMeters AuditBranches AUTOTDMA BaseThermalPropertySet_Diffusivity BeginEnvrnInitializeRuntimeLanguage BetweenDates BetweenGlassForcedFlow BetweenGlassShadeForcedFlow BetweenGlassShadeNaturalFlow BisectionMethod BlindBeamBeamTrans BlindOpticsBeam BlindOpticsDiffuse BoreholeResistance BoundValueToNodeMinMaxAvail BoundValueToWithinTwoValues BracketRoot BranchPressureDrop BrentMethod BuildGap BuildKeyVarList Calc4PipeFanCoil Calc_EN673 Calc_ISO15099 CalcActiveTranspiredCollector CalcAggregateLoad CalcAirflowNetworkAirBalance CalcAirflowNetworkCO2Balance CalcAirflowNetworkGCBalance CalcAirflowNetworkHeatBalance CalcAirflowNetworkMoisBalance CalcAirFlowSimple CalcAirLoopSplitter CalcAirMixer CalcAirToAirGenericHeatExch CalcAirToAirPlateHeatExch CalcAirZoneReturnPlenum CalcAirZoneSupplyPlenum CalcAlamdariHammondStableHorizontal CalcAlamdariHammondUnstableHorizontal CalcAlamdariHammondVerticalWall CalcAngleFactorMRT CalcApproximateViewFactors CalcASHRAEDetailedIntConvCoeff CalcASHRAESimpExtConvectCoeff CalcASHRAESimpleIntConvCoeff CalcASHRAEVerticalWall CalcATMixer CalcAwbiHattonHeatedFloor CalcAwbiHattonHeatedWall CalcBasinHeaterPower CalcBasinHeaterPowerForMultiModeDXCoil CalcBeamSolarOnWinRevealSurface CalcBeamSolDiffuseReflFactors CalcBeamSolSpecularReflFactors CalcBeausoleilMorrisonMixedAssistedWall CalcBeausoleilMorrisonMixedOpposingWall CalcBeausoleilMorrisonMixedStableCeiling CalcBeausoleilMorrisonMixedStableFloor CalcBeausoleilMorrisonMixedUnstableCeiling CalcBeausoleilMorrisonMixedUnstableFloor CalcBLASTAbsorberModel CalcBlockenWindward CalcBoilerModel CalcBoilerModel CalcBottomFluxCoefficents CalcBottomSurfTemp CalcBuriedPipeSoil CalcCBF CalcCBF CalcCBVAV CalcCeilingDiffuserInletCorr CalcCeilingDiffuserIntConvCoeff CalcChillerHeaterModel CalcChillerIPLV CalcChillerModel CalcClearRoof CalcCoilUAbyEffectNTU CalcColdestSetPoint CalcComplexWindowOverlap CalcComplexWindowThermal CalcCompSuctionTempResidual CalcCondEntSetPoint CalcConnectionsDrainTemp CalcConnectionsFlowRates CalcConnectionsHeatRecovery CalcConstCOPChillerModel CalcConvCoeffAbsPlateAndWater CalcConvCoeffBetweenPlates CalcCoolBeam CalcCoolTower CalcCoordinateTransformation CalcCoPlanarNess CalcCostEstimate CalcCTGeneratorModel CalcDayltgCoefficients CalcDayltgCoeffsMapPoints CalcDayltgCoeffsRefMapPoints CalcDayltgCoeffsRefPoints CalcDesiccantBalancedHeatExch CalcDesignSpecificationOutdoorAir CalcDesuperheaterHeatingCoil CalcDesuperheaterWaterHeater CalcDetailedHcInForDVModel CalcDetailedSystem CalcDetailedTransSystem CalcDetailFlatFinCoolingCoil CalcDetIceStorLMTDstar CalcDiffTSysAvailMgr CalcDirectAir CalcDirectEvapCooler CalcDirectResearchSpecialEvapCooler CalcDoe2DXCoil CalcDOE2Leeward CalcDOE2Windward CalcDryFinEffCoef CalcDryIndirectEvapCooler CalcDuct CalcDXCoilStandardRating CalcDXHeatingCoil CalcEarthTube CalcEcoRoof CalcEffectiveness CalcEffectiveSHR CalcEffectiveSHR CalcEffectiveSHR CalcEffectiveSHR CalcElecSteamHumidifier CalcElectricBaseboard CalcElectricChillerHeatRecovery CalcElectricChillerModel CalcElectricEIRChillerModel CalcElectricHeatingCoil CalcEmmelRoof CalcEmmelVertical CalcEngineChillerHeatRec CalcEngineDrivenChillerModel CalcEQLOpticalProperty CalcEQLWindowOpticalProperty CalcEQLWindowSHGCAndTransNormal CalcEQLWindowStandardRatings CalcEQLWindowUvalue CalcEquipmentDrainTemp CalcEquipmentFlowRates CalcExhaustAbsorberChillerModel CalcExhaustAbsorberHeaterModel CalcExteriorVentedCavity CalcFisherPedersenCeilDiffuserCeiling CalcFisherPedersenCeilDiffuserFloor CalcFisherPedersenCeilDiffuserWalls CalcFluidHeatExchanger CalcFohannoPolidoriVerticalWall CalcFollowOATempSetPoint CalcFollowSysNodeTempSetPoint CalcFourPipeIndUnit CalcFrameDividerShadow CalcFuelCellAuxHeater CalcFuelCellGeneratorModel CalcFuelCellGenHeatRecovery CalcFurnaceOutput CalcFurnaceResidual CalcGasAbsorberChillerModel CalcGasAbsorberHeaterModel CalcGasCooler CalcGasHeatingCoil CalcGenericDesiccantDehumidifier CalcGoldsteinNovoselacCeilingDiffuserFloor CalcGoldsteinNovoselacCeilingDiffuserWall CalcGoldsteinNovoselacCeilingDiffuserWindow CalcGroundTempSetPoint CalcGroundwaterWell CalcGshpModel CalcGshpModel CalcGTChillerModel CalcHeatBalanceAir CalcHeatBalanceInsideSurf CalcHeatBalanceInsideSurf CalcHeatBalanceOutsideSurf CalcHeatBalanceOutsideSurf CalcHeatBalFiniteDiff CalcHeatBalHAMT CalcHeatPumpWaterHeater CalcHeatTransCoeffAndCoverTemp CalcHfExteriorSparrow CalcHighTempRadiantSystem CalcHighTempRadiantSystemSP CalcHiTurnOffSysAvailMgr CalcHiTurnOnSysAvailMgr CalcHnASHRAETARPExterior CalcHPCoolingSimple CalcHPHeatingSimple CalcHPWHDXCoil CalcHWBaseboard CalcHXAssistedCoolingCoil CalcHXEffectTerm CalcHybridVentSysAvailMgr CalcIBesselFunc CalcICEngineGeneratorModel CalcICEngineGenHeatRecovery CalcIceStorageCapacity CalcIceStorageCharge CalcIceStorageDischarge CalcIceStorageDormant CalcICSSolarCollector CalcIdealCondEntSetPoint CalcIfSetpointMet CalcIndirectAbsorberModel CalcIndirectResearchSpecialEvapCooler CalcInteriorRadExchange CalcInteriorSolarDistribution CalcInteriorSolarOverlaps CalcInteriorWinTransDifSolInitialDistribution CalcISO15099WindowIntConvCoeff CalcKaradagChilledCeiling CalcKBesselFunc CalcKhalifaEq3WallAwayFromHeat CalcKhalifaEq4CeilingAwayFromHeat CalcKhalifaEq5WallsNearHeat CalcKhalifaEq6NonHeatedWalls CalcKhalifaEq7Ceiling CalcLoadCenterThermalLoad CalcLoTurnOffSysAvailMgr CalcLoTurnOnSysAvailMgr CalcLowTempCFloRadiantSystem CalcLowTempCFloRadSysComps CalcLowTempElecRadiantSystem CalcLowTempHydrRadiantSystem CalcLowTempHydrRadSysComps CalcMatrixInverse CalcMcAdams CalcMerkelVariableSpeedTower CalcMicroCHPNoNormalizeGeneratorModel CalcMinIntWinSolidAngs CalcMitchell CalcMixedAirSetPoint CalcMoistureBalanceEMPD CalcMoreNodeInfo CalcMoWITTLeeward CalcMoWITTWindward CalcMSHeatPump CalcMTGeneratorModel CalcMultiSpeedDXCoil CalcMultiSpeedDXCoilCooling CalcMultiSpeedDXCoilHeating CalcMultiStageElectricHeatingCoil CalcMultiStageGasHeatingCoil CalcMultiZoneAverageCoolingSetPoint CalcMultiZoneAverageHeatingSetPoint CalcMultiZoneAverageMaxHumSetPoint CalcMultiZoneAverageMinHumSetPoint CalcMultiZoneMaxHumSetPoint CalcMultiZoneMinHumSetPoint CalcMundtModel CalcNCycSysAvailMgr CalcNewZoneHeatCoolFlowRates CalcNewZoneHeatOnlyFlowRates CalcNodeMassFlows CalcNominalWindowCond CalcNonDXHeatingCoils CalcNonDXHeatingCoils CalcNonDXHeatingCoils CalcNonDXHeatingCoils CalcNusselt CalcNusseltJurges CalcNVentSysAvailMgr CalcOAController CalcOAMassFlow CalcOAMassFlow CalcOAMixer CalcOAOnlyMassFlow CalcOAPretreatSetPoint CalcOAUnitCoilComps CalcObstrMultiplier CalcOptStartSysAvailMgr CalcOtherSideDemand CalcOutdoorAirUnit CalcOutsideAirSetPoint CalcOutsideSurfTemp CalcParallelPIU CalcPassiveExteriorBaffleGap CalcPassiveSystem CalcPassiveTranspiredCollector CalcPerSolarBeam CalcPipeHeatTransCoef CalcPipesHeatTransfer CalcPipeTransBeam CalcPlantValves CalcPollution CalcPolyhedronVolume CalcPolynomCoef CalcPondGroundHeatExchanger CalcPredictedHumidityRatio CalcPredictedSystemLoad CalcPTUnit CalcPumps CalcPurchAirLoads CalcPurchAirMinOAMassFlow CalcPurchAirMixedAir CalcPVTcollectors CalcQiceChargeMaxByChiller CalcQiceChargeMaxByITS CalcQiceDischageMax CalcRABFlowSetPoint CalcRackSystem CalcRadSysHXEffectTerm CalcRadTemp CalcRainCollector CalcReformEIRChillerModel CalcResearchSpecialPartLoad CalcReturnAirPath CalcRfFlrCoordinateTransformation CalcSandiaPV CalcSatVapPressFromTemp CalcSchedOffSysAvailMgr CalcSchedOnSysAvailMgr CalcSchedSysAvailMgr CalcScheduledDualSetPoint CalcScheduledSetPoint CalcScreenTransmittance CalcScriptF CalcSeriesPIU CalcSetpointTempTarget CalcSHRUserDefinedCurves CalcSimpleController CalcSimpleHeatingCoil CalcSimplePV CalcSingleSpeedEvapFluidCooler CalcSingleSpeedTower CalcSingZoneClSetPoint CalcSingZoneHtSetPoint CalcSingZoneMaxHumSetPoint CalcSingZoneMinHumSetPoint CalcSingZoneRhSetPoint CalcSkySolDiffuseReflFactors CalcSolarCollector CalcSolarFlux CalcSolidDesiccantDehumidifier CalcSourceFlux CalcSourceTempCoefficents CalcSparrowLeeward CalcSparrowWindward CalcSpecialDayTypes CalcStandAloneERV CalcStandardRatings CalcStaticProperties CalcSteamAirCoil CalcSteamBaseboard CalcSurfaceCentroid CalcSurfaceGroundHeatExchanger CalcSystemEnergyUse CalcSZOneStageCoolingSetPt CalcSZOneStageHeatingSetPt CalcTankTemp CalcTDDTransSolAniso CalcTDDTransSolHorizon CalcTDDTransSolIso CalcTempDistModel CalcTempIntegral CalcTESCoilChargeOnlyMode CalcTESCoilCoolingAndChargeMode CalcTESCoilCoolingAndDischargeMode CalcTESCoilCoolingOnlyMode CalcTESCoilDischargeOnlyMode CalcTESCoilOffMode CalcTESIceStorageTank CalcTESWaterStorageTank CalcThermalChimney CalcThermalComfortAdaptiveASH55 CalcThermalComfortAdaptiveCEN15251 CalcThermalComfortFanger CalcThermalComfortKSU CalcThermalComfortPierce CalcThermalComfortSimpleASH55 CalcTimeNeeded CalcTopFluxCoefficents CalcTopSurfTemp CalcTotalFLux CalcTotCapSHR CalcTotCapSHR_VSWSHP CalcTransAbsorProduct CalcTransRefAbsOfCover CalcTRNSYSPV CalcTrombeWallIntConvCoeff CalcTwoSpeedDXCoilIEERResidual CalcTwoSpeedDXCoilStandardRating CalcTwoSpeedEvapFluidCooler CalcTwoSpeedTower CalcUAIce CalcUCSDCV CalcUCSDDV CalcUCSDUE CalcUCSDUI CalculateAirChillerSets CalculateBasisLength CalculateCase CalculateCoil CalculateCompressors CalculateCondensers CalculateCTFs CalculateDailySolarCoeffs CalculateDayOfWeek CalculateEpsFromNTUandZ CalculateExponentialMatrix CalculateFuncResults CalculateGammas CalculateInverseMatrix CalculateMoodyFrictionFactor CalculateNTUfromEpsAndZ CalculatePollution CalculateSecondary CalculateSubcoolers CalculateSunDirectionCosines CalculateTransCompressors CalculateWalkIn CalculateWaterUseage CalculateWaterUseage CalculateWindowBeamProperties CalculateZoneMRT CalculateZoneVolume CalcUnitaryCoolingSystem CalcUnitaryHeatingSystem CalcUnitarySuppHeatingSystem CalcUnitarySuppSystemtoSP CalcUnitarySystemLoadResidual CalcUnitarySystemToLoad CalcUnitHeater CalcUnitHeaterComponents CalcUnitVentilator CalcUnitVentilatorComponents CalcUnmetPlantDemand CalcUpdateHeatRecovery CalcUpdateHeatRecovery CalcUserDefinedInsideHcModel CalcUserDefinedOutsideHcModel CalcVariableSpeedTower CalcVarSpeedCoilCooling CalcVarSpeedCoilHeating CalcVarSpeedHeatPump CalcVarSpeedHeatPump CalcVAVVS CalcVentilatedSlab CalcVentilatedSlabComps CalcVentilatedSlabRadComps CalcVentSlabHXEffectTerm CalcVerticalGroundHeatExchanger CalcViewFactorToShelf CalcVRF CalcVRFCondenser CalcVRFCoolingCoil CalcVSTowerApproach CalcWallCoordinateTransformation CalcWaltonStableHorizontalOrTilt CalcWaltonUnstableHorizontalOrTilt CalcWarmestSetPoint CalcWarmestSetPointTempFlow CalcWaterMainsTemp CalcWaterSource CalcWaterStorageTank CalcWaterThermalTankMixed CalcWaterThermalTankStratified CalcWaterThermalTankZoneGains CalcWaterToAirHeatpump CalcWatertoAirHPCooling CalcWatertoAirHPHeating CalcWaterToAirResidual CalcWatertoWaterHPCooling CalcWatertoWaterHPHeating CalcWaterUseZoneGains CalcWetIndirectEvapCooler CalcWindowACOutput CalcWindowBlindProperties CalcWindowHeatBalance CalcWindowProfileAngles CalcWindowScreenProperties CalcWindowStaticProperties CalcWindPressure CalcWindPressureCoeffs CalcWindTurbine CalcWinFrameAndDividerTemps CalcWinTransDifSolInitialDistribution CalcWrapperModel CalcZoneAirComfortSetpoints CalcZoneAirTempSetpoints CalcZoneComponentLoadSums CalcZoneDehumidifier CalcZoneEvaporativeCoolerUnit CalcZoneLeavingConditions CalcZoneMassBalance CalcZonePipesHeatGain CalcZoneSums CartesianPipeCellInformation_ctor CellType_IsFieldCell CFSHasControlledShade CFSNGlz CFSRefPointPosFactor CFSRefPointSolidAngle CFSShadeAndBeamInitialization CFSUFactor cGetCoilAirOutletNode cGetCoilSteamInletNode cGetCoilSteamOutletNode CharPreDefTableEntry CheckActuatorNode CheckAndAddAirNodeNumber CheckAndFixCFSLayer CheckAndReadCustomSprectrumData CheckAndReadFaults CheckAndSetConstructionProperties CheckBracketRoundOff CheckBranchForOASys CheckCachedIPErrors CheckCFSStates CheckCoilWaterInletNode CheckControllerListOrder CheckControllerLists CheckConvexity CheckCostEstimateInput CheckCreatedZoneItemName CheckCurveLimitsForIPLV CheckCurveLimitsForStandardRatings CheckDayScheduleValueMinMax CheckDXCoolingCoilInOASysExists CheckFDSurfaceTempLimits CheckFFSchedule CheckFluidPropertyName CheckForActualFileName CheckForBalancedFlow CheckForControllerWaterCoil CheckForGeometricTransform CheckForGeometricTransform CheckForMisMatchedEnvironmentSpecifications CheckForOutOfRangeTempResult CheckForOutOfRangeTemps CheckForRequestedReporting CheckForRunawayPlantTemps CheckForSensorAndSetpointNode CheckGasCoefs CheckHeatingCoilSchedule CheckHXAssistedCoolingCoilSchedule CheckIFAnyEMS CheckIFAnyIdealCondEntSetPoint CheckIfAnyPlant CheckIfNodeSetpointManagedByEMS CheckIncrementRoundOff CheckInternalConsistency CheckLightsReplaceableMinMaxForZone CheckLocationValidity CheckLoopExitNode CheckLowerUpperBracket CheckMarkedNodes CheckMaxActiveController CheckMaxConstraint CheckMicroCHPThermalBalance CheckMinActiveController CheckMinConstraint checkMinimumMonthlyCharge CheckMinMaxCurveBoundaries CheckMinMaxRange CheckModelBoundOutput_HumRat CheckModelBoundOutput_Temp CheckModelBounds CheckModelBoundsHumRatEq CheckModelBoundsRH_HumRatEq CheckModelBoundsRH_TempEq CheckModelBoundsTempEq CheckNodeConnections CheckNodeSetPoint CheckNonSingularity CheckOAControllerName CheckOutAirNodeNumber CheckPlantConvergence CheckPlantMixerSplitterConsistency CheckPlantOnAbort CheckPollutionMeterReporting CheckRefrigerationInput CheckReportVariable CheckRootFinderCandidate CheckRootFinderConvergence CheckScheduledSurfaceGains CheckScheduleValue CheckScheduleValueMinMax Checksetpoints CheckSimpleController CheckSlope CheckSteamCoilSchedule CheckSubSurfaceMiscellaneous CheckSysSizing CheckSystemBranchFlow CheckTDDsAndLightShelvesInDaylitZones CheckThisAirSystemForSizing CheckThisZoneForSizing CheckThreading CheckUniqueNodes CheckUnitarySysCoilInOASysExists CheckUsedConstructions CheckValidSimulationObjects CheckWarmupConvergence CheckWaterCoilSchedule CheckWeatherFileValidity CheckWindowShadingControlFrameDivider CheckZoneEquipmentList CheckZoneSizing CHKBKS CHKGSS CHKSBS CLIP CLIPPOLY CloseDFSFile CloseMiscOpenFiles CloseMoistureBalanceEMPD CloseOutOpenFiles CloseOutputFiles CloseOutputTabularFile CloseReportIllumMaps CloseSocket CloseWeatherFile CoilAreaFracIter CoilCompletelyDry CoilCompletelyWet CoilOutletStreamCondition CoilPartWetPartDry COMMAND_ARGUMENT_COUNT CompactObjectsCheck CompareTwoVectors ComplexFenestrationLuminances ComputeDelayedComponents ComputeDifSolExcZonesWIZWindows ComputeIntSolarAbsorpFactors ComputeIntSWAbsorpFactors ComputeIntThermalAbsorpFactors ComputeLifeCycleCostAndReport ComputeLoadComponentDecayCurve ComputeNominalUwithConvCoeffs ComputePresentValue ComputeTariff ComputeTaxAndDepreciation ComputeWinShadeAbsorpFactors CondOutTempResidual ConstructBasis ControlCBVAVOutput ControlCompOutput ControlCompOutput ControlCoolBeam ControlCoolingSystem ControlCycWindACOutput ControlDesiccantDehumidifier ControlDXHeatingSystem ControlDXSystem ControlFluidHeatExchanger ControlHeatingSystem ControlHumidifier ControlMSHPOutput ControlPTUnitOutput ControlPVTcollector ControlReformEIRChillerModel ControlSuppHeatSystem ControlUnitarySystemOutput ControlUnitarySystemtoLoad ControlUnitarySystemtoSP ControlVRF ControlVSEvapUnitToMeetLoad ControlVSHPOutput ControlVSHPOutput ConvectionFactor ConvertCasetoLower ConvertCasetoUpper ConvertIP ConvertIPdelta ConvertToElementTag ConvertToEscaped CoolBeamResidual CoolingCoil CoolWaterHumRatResidual CoolWaterTempResidual CoolWatertoAirHPHumRatResidual CoolWatertoAirHPTempResidual CorrectZoneAirTemp CorrectZoneContaminants CorrectZoneHumRat CostInfoOut CPCW CPHW CreateBoundaryList CreateBoundaryListCount CreateCategoryNativeVariables CreateCellArray CreateCurrentDateTimeString CreateDefaultComputation CreateEnergyReportStructure CreateFCfactorConstructions CreateHVACStepFullString CreateHVACTimeIntervalString CreateHVACTimeString CreateNewellAreaVector CreateNewellSurfaceNormalVector CreatePartitionCenterList CreatePartitionRegionList CreatePredefinedMonthlyReports CreateRegionList CreateRegionListCount CreateShadedWindowConstruction CreateSQLiteConstructionsTable CreateSQLiteConstructionsTable CreateSQLiteDatabase CreateSQLiteDatabase CreateSQLiteDaylightMap CreateSQLiteDaylightMap CreateSQLiteDaylightMapTitle CreateSQLiteDaylightMapTitle CreateSQLiteEnvironmentPeriodRecord CreateSQLiteEnvironmentPeriodRecord CreateSQLiteErrorRecord CreateSQLiteErrorRecord CreateSQLiteInfiltrationTable CreateSQLiteInfiltrationTable CreateSQLiteMaterialsTable CreateSQLiteMaterialsTable CreateSQLiteMeterDictionaryRecord CreateSQLiteMeterDictionaryRecord CreateSQLiteMeterRecord CreateSQLiteMeterRecord CreateSQLiteNominalBaseboardHeatTable CreateSQLiteNominalBaseboardHeatTable CreateSQLiteNominalElectricEquipmentTable CreateSQLiteNominalElectricEquipmentTable CreateSQLiteNominalGasEquipmentTable CreateSQLiteNominalGasEquipmentTable CreateSQLiteNominalHotWaterEquipmentTable CreateSQLiteNominalHotWaterEquipmentTable CreateSQLiteNominalLightingTable CreateSQLiteNominalLightingTable CreateSQLiteNominalOtherEquipmentTable CreateSQLiteNominalOtherEquipmentTable CreateSQLiteNominalPeopleTable CreateSQLiteNominalPeopleTable CreateSQLiteNominalSteamEquipmentTable CreateSQLiteNominalSteamEquipmentTable CreateSQLiteReportVariableDataRecord CreateSQLiteReportVariableDataRecord CreateSQLiteReportVariableDictionaryRecord CreateSQLiteReportVariableDictionaryRecord CreateSQLiteRoomAirModelTable CreateSQLiteRoomAirModelTable CreateSQLiteSchedulesTable CreateSQLiteSimulationsRecord CreateSQLiteSimulationsRecord CreateSQLiteStringTableRecord CreateSQLiteSurfacesTable CreateSQLiteSurfacesTable CreateSQLiteTabularDataRecords CreateSQLiteTabularDataRecords CreateSQLiteTimeIndexRecord CreateSQLiteTimeIndexRecord CreateSQLiteVentilationTable CreateSQLiteVentilationTable CreateSQLiteZoneGroupTable CreateSQLiteZoneGroupTable CreateSQLiteZoneListTable CreateSQLiteZoneListTable CreateSQLiteZoneTable CreateSQLiteZoneTable CreateStormWindowConstructions CreateSysTimeIntervalString CreateTCConstructions CreateTimeIntervalString CreateTimeString CreatExtBooundCondName CreateZoneExtendedOutput CreateZoneExtendedOutput CrossProduct CrossProduct cSurfaceClass CTRANS CurveValue DateToString DateToStringWithMonth DaylghtAltAndAzimuth DayltgAveInteriorReflectance DayltgClosestObstruction DayltgCrossProduct DayltgCurrentExtHorizIllum DayltgDirectIllumComplexFenestration DayltgDirectSunDiskComplexFenestration DayltgElecLightingControl DayltgExtHorizIllum DayltgGlare DayltgGlarePositionFactor DayltgGlareWithIntWins DayltgHitBetWinObstruction DayltgHitInteriorObstruction DayltgHitObstruction DayltgInteriorIllum DayltgInteriorMapIllum DayltgInteriorTDDIllum DayltgInterReflectedIllum DayltgInterReflectedIllumComplexFenestration DayltgInterReflIllFrIntWins DayltgLuminousEfficacy DayltgPierceSurface DayltgSetupAdjZoneListsAndPointers DayltgSkyLuminance DayltgSurfaceLumFromSun dCheckScheduleValueMinMax1 dCheckScheduleValueMinMax2 DeallocateLoadComponentArrays DebugRootFinder DecodeHHMMField DecodeMonDayHrMin DeflectionTemperatures DeflectionWidths DegradF DElightDaylightCoefficients DElightDaylightCoefficients DElightElecLtgCtrl DElightElecLtgCtrl DElightFreeMemory DElightFreeMemory DElightInputGenerator DElightInputGenerator DElightOutputGenerator DElightOutputGenerator DensityCFSFillGas Depth DERIV DetailsForSurfaces DetectOscillatingZoneTemp DetermineAzimuthAndTilt DetermineBranchFlowRequest DetermineBuildingFloorArea DetermineDateTokens DetermineFrequency DetermineIndexGroupFromMeterGroup DetermineIndexGroupKeyFromMeterName DetermineMaxBackSurfaces DetermineMeterIPUnits DetermineMinuteForReporting DeterminePolygonOverlap DetermineShadowingCombinations DetermineSunUpDown DevelopMesh DiffuseAverage DiffuseAverageProfAngGnd DiffuseAverageProfAngSky DisplayMaterialRoughness DisplayNumberandString DisplaySimDaysProgress DisplayString distance DistributeBBElecRadGains DistributeBBRadGains DistributeBBSteamRadGains DistributeHTRadGains DistributePlantLoad DistributePressureOnBranch DistributeTDDAbsorbedSolar DistributeUserDefinedPlantLoad DL_RES_r2 DLAG DOE2DXCoilHumRatResidual DOE2DXCoilHumRatResidual DOE2DXCoilResidual DOE2DXCoilResidual DOE2DXCoilResidual DoEndOfIterationOperations DomainRectangle_Contains DOMakeUPPERCase DoOneTimeInitializations DOSameString DoShadeControl DoStartOfTimeStepInitializations DownInterpolate4HistoryValues DumpAirLoopStatistics DumpCurrentLineBuffer DUMPVD DUMPVR DXCoilCyclingHumRatResidual DXCoilCyclingHumRatResidual DXCoilCyclingResidual DXCoilCyclingResidual DXCoilVarSpeedHumRatResidual DXCoilVarSpeedHumRatResidual DXCoilVarSpeedResidual DXCoilVarSpeedResidual DXFOut DXFOutLines DXFOutWireFrame DXHeatingCoilResidual DXHeatingCoilResidual DXHeatingCoilResidual DynamicClothingModel DynamicExtConvSurfaceClassification DynamicIntConvSurfaceClassification EchoOutActuatorKeyChoices EchoOutInternalVariableChoices EffectiveEPSLB EffectiveEPSLF EIRChillerHeatRecovery EN673ISO10292 EncodeMonDayHrMin EndEnergyPlus EndUniqueNodeCheck EnthalpyResidual epElapsedTime epGetTimeUsed epGetTimeUsedperCall epStartTime epStopTime epSummaryTimes eptime EQLWindowInsideEffectiveEmiss EQLWindowOutsideEffectiveEmiss EQLWindowSurfaceHeatBalance EquationsSolver ERF EstimateHEXSurfaceArea EvalInsideMovableInsulation EvalOutsideMovableInsulation EvaluateAdiabaticSurfaceTemperature EvaluateBasementCellTemperature EvaluateCellNeighborDirections evaluateChargeBlock evaluateChargeSimple EvaluateExpression EvaluateExtHcModels EvaluateFarfieldBoundaryTemperature EvaluateFarfieldCharacteristics EvaluateFieldCellTemperature EvaluateGroundSurfaceTemperature EvaluateIntHcModels EvaluateLoopSetPointLoad EvaluateNeighborCharacteristics evaluateQualify evaluateRatchet EvaluateSoilRhoCp EvaluateStack EvolveParaUCSDCV ExitCalcController ExpandComplexState ExpressAsCashFlows ExtendObjectDefinition ExteriorBCEqns ExternalInterfaceExchangeVariables ExternalInterfaceInitializeErlVariable ExternalInterfaceSetErlVariable ExternalInterfaceSetSchedule ExtOrIntShadeNaturalFlow Fabric_EstimateDiffuseProps FACSKY FalsePositionMethod FEQX FI FigureACAncillaries FigureAirEnthalpy FigureAirHeatCap FigureAuxilHeatGasHeatCap FigureBeamSolDiffuseReflFactors FigureBeamSolSpecularReflFactors FigureConstGradPattern FigureDayltgCoeffsAtPointsForSunPosition FigureDayltgCoeffsAtPointsForWindowElements FigureDayltgCoeffsAtPointsSetupForWindow FigureElectricalStorageZoneGains FigureFuelCellZoneGains FigureFuelEnthalpy FigureFuelHeatCap FigureGaseousWaterEnthalpy FigureHeightPattern FigureHXleavingGasHeatCap FigureInverterZoneGains FigureLHVofFuel FigureLiquidWaterEnthalpy FigureLiquidWaterHeatCap FigureMapPointDayltgFactorsToAddIllums FigureMicroCHPZoneGains FigureNDheightInZone FigurePowerConditioningLosses FigureProductGasesEnthalpy FigureProductGasHeatCap FigureRefPointDayltgFactorsToAddIllums FigureRefrigerationZoneGains FigureSolarBeamAtTimestep FigureSunCosines FigureSurfMapPattern FigureTDDZoneGains FigureTransformerZoneGains FigureTransientConstraints FigureTwoGradInterpPattern FILJAC FillBasisElement FillDefaultsSWP FillRemainingPredefinedEntries FillWeatherPredefinedEntries film filmg filmi filmPillar FILSKY FinalizeCFS FinalizeCFSLAYER FinalRateCoils FindAirLoopBranchConnection FindAirPlantCondenserLoopFromBranchList FindAllNumbersinList FindArrayIndex FindCompSPInput FindCompSPLoad FindCondenserLoopBranchConnection FindControlledZoneIndexFromSystemNodeNumberForZone FindDeltaTempRangeInput FindDemandSideMatch FindEMSVariable FindFirstLastPtr FindFirstRecord FindGlycol FindHXDemandSideLoopFlow FindInBasis FindItem FindIteminList FindIteminSortedList FindItemInVariableList FindLoopSideInCallingOrder FindNextRecord FindNonSpace FindNumberinList FindOAMixerMatchForOASystem FindPlantLoopBranchConnection FindRangeBasedOrUncontrolledInput FindRangeVariable FindRefrigerant FindRootSimpleController FindStratifiedTankSensedTemp FindTariffIndex FindTDDPipe FindUnitNumber FinishDebugOutputFiles FixViewFactors FluidCellInformation_ctor FM_BEAM FM_DIFF FM_F FNU forcedventilation FourPipeInductionUnitHasMixer FourPipeIUCoolingResidual FourPipeIUHeatingResidual FRA FrostControl FrostControlSetPointLimit FrostControlSetPointLimit FuelCellProductGasEnthResidual FUN FuncDetermineCoolantWaterExitTemp FuncDetermineCWMdotForInternalFlowControl FuncDetermineEngineTemp FV GasElecHeatingCoilResidual GASSES90 GassesLow GatherBEPSResultsForTimestep GatherBinResultsForTimestep GatherComponentLoadsHVAC GatherComponentLoadsIntGain GatherComponentLoadsSurfAbsFact GatherComponentLoadsSurface GatherForEconomics GatherForPredefinedReport GatherHeatGainReport GatherMonthlyResultsForTimestep GatherPeakDemandForTimestep GatherSourceEnergyEndUseResultsForTimestep GaussElimination generate_ears GenerateDElightDaylightCoefficients GenerateDElightDaylightCoefficients GeneratorPowerOutput GenericCrack GenOutputVariablesAuditReport Get2DMatrix Get2DMatrixDimensions GET_COMMAND GET_COMMAND_ARGUMENT Get_Environment_Variable GetActualDXCoilIndex GetAirBranchIndex GetAirFlowFlag GetAirflowNetworkInput GetAirHeatBalanceInput GetAirLoopAvailabilityManager GetAirModelDatas GetAirNodeData GetAirPathData GetAngleFactorList GetATMixer GetATMixerOutNode GetATMixerPriNode GetATMixers GetATMixerSecNode GetAttShdSurfaceData GetAverageTempByType GetBaseboardInput GetBaseboardInput GetBasementFloorHeatFlux GetBasementWallHeatFlux GetBLASTAbsorberInput GetBoilerInput GetBoilerInput GetBranchData GetBranchFanTypeName GetBranchFlow GetBranchInput GetBranchList GetBranchListInput GetBuildingData GetCBVAV GetCellWidths GetCellWidthsCount GetChildrenData GetChillerheaterInput GetCoilAirFlowRate GetCoilAirFlowRateVariableSpeed GetCoilAirInletNode GetCoilAirOutletNode GetCoilAvailScheduleIndex GetCoilCapacity GetCoilCapacity GetCoilCapacity GetCoilCapacity GetCoilCapacity GetCoilCapacity GetCoilCapacityByIndexType GetCoilCapacityVariableSpeed GetCoilCondenserInletNode GetCoilControlNodeNum GetCoilGroupTypeNum GetCoilIndex GetCoilIndex GetCoilIndex GetCoilIndexVariableSpeed GetCoilInletNode GetCoilInletNode GetCoilInletNode GetCoilInletNode GetCoilInletNode GetCoilInletNode GetCoilInletNodeVariableSpeed GetCoilMaxSteamFlowRate GetCoilMaxWaterFlowRate GetCoilMaxWaterFlowRate GetCoilMaxWaterFlowRate GetCoilObjectTypeNum GetCoilOutletNode GetCoilOutletNode GetCoilOutletNode GetCoilOutletNode GetCoilOutletNode GetCoilOutletNode GetCoilOutletNodeVariableSpeed GetCoilSteamInletNode GetCoilSteamOutletNode GetCoilTypeNum GetCoilWaterInletNode GetCoilWaterInletNode GetCoilWaterOutletNode GetColumnUsingTabs GetComfortSetpoints GetComponentData GetCondFDInput GetConductivityGlycol GetConnectorList GetConnectorListInput GetConstCOPChillerInput GetConstructData GetControlledZoneIndex GetControllerActuatorNodeNum GetControllerInput GetCoolBeams GetCoolingCoilTypeNameAndIndex GetCooltower GetCostEstimateInput GetCrossVentData GetCTGeneratorInput GetCTGeneratorResults GetCurrentHVACTime GetCurrentMeterValue GetCurrentScheduleValue GetCurveCheck GetCurveIndex GetCurveInput GetCurveMinMaxValues GetCurveName GetCurveObjectTypeNum GetCurveType GetCustomMeterInput GetDaylightingParametersDetaild GetDaylightingParametersInput GetDayScheduleIndex GetDemandManagerInput GetDemandManagerListInput GetDensityGlycol GetDesiccantDehumidifierInput GetDesignDayData GetDesignLightingLevelForZone GetDetShdSurfaceData GetDirectAirInput GetDisplacementVentData GetDSTData GetDualDuctInput GetDualDuctOutdoorAirRecircUse GetDuctInput GetDXCoilAirFlow GetDXCoilAvailSchPtr GetDXCoilBypassedFlowFrac GetDXCoilCapFTCurveIndex GetDXCoilIndex GetDXCoilNumberOfSpeeds GetDXCoils GetDXCoolingSystemInput GetDXHeatPumpSystemInput GetEarthTube GetElecReformEIRChillerInput GetElectricBaseboardInput GetElectricChillerInput GetElectricEIRChillerInput GetEMSInput GetEngineDrivenChillerInput GetEnvironmentalImpactFactorInfo GetEvapFluidCoolerInput GetEvapInput GetExhaustAbsorberInput GetExhaustAirInletNode GetExteriorEnergyUseInput GetExtVentedCavityIndex GetExtVentedCavityIndex GetExtVentedCavityTsColl GetExtVentedCavityTsColl GetFanAvailSchPtr GetFanCoilIndex GetFanCoilInletAirNode GetFanCoilMixedAirNode GetFanCoilOutAirNode GetFanCoilReturnAirNode GetFanCoilUnits GetFanCoilZoneInletAirNode GetFanDesignVolumeFlowRate GetFanIndex GetFanIndexForTwoSpeedCoil GetFanInletNode GetFanInput GetFanOutletNode GetFanPower GetFanSpeedRatioCurveIndex GetFanType GetFanVolFlow GetFarfieldTemp GetFirstBranchInletNodeName GetFluidCoolerInput GetFluidDensityTemperatureLimits GetFluidHeatExchangerInput GetFluidPropertiesData GetFluidSpecificHeatTemperatureLimits GetFrameAndDividerData GetFuelCellGeneratorInput GetFuelCellGeneratorResults GetFuelFactorInfo GetFurnaceInput GetGasAbsorberInput GetGeneratorFuelSupplyInput GetGeometryParameters GetGlycolNameByIndex GetGroundheatExchangerInput GetGroundReflectances GetGroundTemps GetGshpInput GetGshpInput GetGTChillerInput GetHeatBalanceInput GetHeatBalHAMTInput GetHeatExchangerObjectTypeNum GetHeatingCoilIndex GetHeatingCoilInput GetHeatingCoilNumberOfStages GetHeatingCoilPLFCurveIndex GetHeatingCoilTypeNum GetHeatReclaimSourceIndex GetHeatRecoveryInput GetHighTempRadiantSystem GetHPCoolingCoilIndex GetHTSubSurfaceData GetHTSurfaceData GetHTSurfExtVentedCavityData GetHumidifierInput GetHVACSingleDuctSysIndex GetHWBaseboardInput GetHXAssistedCoolingCoilInput GetHXCoilAirFlowRate GetHXCoilType GetHXCoilTypeAndName GetHXDXCoilIndex GetHXDXCoilName GetHybridVentilationControlStatus GetHybridVentilationInputs GetICEGeneratorResults GetICEngineGeneratorInput GetIceStorageInput GetIDFRecordsStats GetIndirectAbsorberInput GetIndUnits GetInputEconomicsChargeBlock GetInputEconomicsChargeSimple GetInputEconomicsComputation GetInputEconomicsCurrencyType GetInputEconomicsQualify GetInputEconomicsRatchet GetInputEconomicsTariff GetInputEconomicsVariable GetInputForLifeCycleCost GetInputFuelAndPollutionFactors GetInputLifeCycleCostNonrecurringCost GetInputLifeCycleCostParameters GetInputLifeCycleCostRecurringCosts GetInputLifeCycleCostUseAdjustment GetInputLifeCycleCostUsePriceEscalation GetInputTabularMonthly GetInputTabularPredefined GetInputTabularStyle GetInputTabularTimeBins GetInputViewFactors GetInputViewFactorsbyName GetInputZoneEvaporativeCoolerUnit GetInstantMeterValue GetInternalBranchData GetInternalHeatGainsInput GetInternalVariableValue GetInternalVariableValue GetInternalVariableValueExternalInterface GetInternalVariableValueExternalInterface GetInterpolatedSatProp GetInterpValue GetIntMassSurfaceData GetLastBranchOutletNodeName GetLastWord GetLightWellData GetListOfObjectsInIDD GetListofSectionsinInput GetLocationInfo GetLoopMixer GetLoopSidePumpIndex GetLoopSplitter GetLowTempRadiantSystem GetMaterialData GetMatrixInput getMaxAndSum GetMeteredVariables GetMeterIndex GetMeterResourceType GetMicroCHPGeneratorInput GetMicroCHPGeneratorResults GetMinOATCompressor GetMixerInput GetMixerInput GetMoistureBalanceEMPDInput GetMonthlyCostForResource GetMovableInsulationData GetMSHeatPumpInput GetMTGeneratorExhaustNode GetMTGeneratorInput GetMTGeneratorResults GetMundtData GetNewUnitNumber GetNextEnvironment GetNodeConnectionType GetNodeList GetNodeListsInput GetNodeNums GetNTUforCrossFlowBothUnmixed GetNumberOfSchedules GetNumberOfSurfaceLists GetNumberOfSurfListVentSlab GetNumChildren GetNumMeteredVariables GetNumOAControllers GetNumOAMixers GetNumOASystems GetNumObjectsFound GetNumObjectsInIDD GetNumRangeCheckErrorsFound GetNumSectionsFound GetNumSectionsinInput GetNumSegmentsForHorizontalTrenches GetNumSplitterMixerInConntrList GetOACompListNumber GetOACompName GetOACompType GetOACompTypeNum GetOAControllerInputs GetOAMixerIndex GetOAMixerInletNodeNumber GetOAMixerInputs GetOAMixerMixedNodeNumber GetOAMixerNodeNumbers GetOAMixerReliefNodeNumber GetOAMixerReturnNodeNumber GetOARequirements GetOASysControllerListIndex GetOASysNumCoolingCoils GetOASysNumHeatingCoils GetOASysNumSimpControllers GetOASystemNumber GetObjectDefInIDD GetObjectDefMaxArgs GetObjectItem GetObjectItemfromFile GetObjectItemNum GetOnlySingleNode GetOperationSchemeInput GetOSCData GetOSCMData GetOutAirNodesInput GetOutdoorAirUnitInputs GetOutdoorAirUnitOutAirNode GetOutdoorAirUnitReturnAirNode GetOutdoorAirUnitZoneInletNode GetOutsideAirSysInputs GetOutsideEnergySourcesInput GetParentData GetPipeInput GetPipesHeatTransfer GetPipingSystemsInput GetPIUs GetPlantAvailabilityManager GetPlantInput GetPlantLoopData GetPlantOperationInput GetPlantProfileInput GetPlantSizingInput GetPlantValvesInput GetPollutionFactorInput GetPondGroundHeatExchanger GetPowerManagerInput GetPressureCurveTypeAndIndex GetPressureSystemInput GetPreviousHVACTime GetProjectControlData GetProjectData GetPTUnit GetPTUnitMixedAirNode GetPTUnitOutAirNode GetPTUnitReturnAirNode GetPTUnitZoneInletAirNode GetPumpInput GetPurchasedAir GetPurchasedAirMixedAirHumRat GetPurchasedAirMixedAirTemp GetPurchasedAirOutAirMassFlow GetPurchasedAirReturnAirNode GetPurchasedAirZoneInletAirNode GetPVGeneratorResults GetPVInput GetPVTcollectorsInput GetPVTThermalPowerProduction GetQualityRefrig GetRecordLocations GetRectDetShdSurfaceData GetRectSubSurfaces GetRectSurfaces GetRefrigeratedRackIndex GetRefrigerationInput GetReportVariableInput GetRequiredMassFlowRate GetResidCrossFlowBothUnmixed GetResourceTypeChar GetReturnAirNodeForZone GetReturnAirPathInput GetRoomAirModelParameters GetRunPeriodData GetRunPeriodDesignData GetRuntimeLanguageUserInput GetSatDensityRefrig GetSatEnthalpyRefrig GetSatPressureRefrig GetSatSpecificHeatRefrig GetSatTemperatureRefrig GetScheduledSurfaceGains GetScheduleIndex GetScheduleMaxValue GetScheduleMinValue GetScheduleName GetScheduleType GetScheduleValuesForDay GetSecondaryInletNode GetSecondaryOutletNode GetSetPointManagerInputs GetShadingSurfReflectanceData GetShadowingInput GetShelfInput GetSimpleAirModelInputs GetSimpleShdSurfaceData GetSimpleWatertoAirHPInput GetSingleDayScheduleValues GetSiteAtmosphereData GetSizingParams GetSnowGroundRefModifiers GetSolarCollectorInput GetSpecialDayPeriodData GetSpecificHeatGlycol getSpecificUnitDivider getSpecificUnitIndex getSpecificUnitMultiplier GetSplitterInput GetSplitterInput GetSplitterNodeNumbers GetSplitterOutletNumber GetStandAloneERV GetStandAloneERVNodes GetStandAloneERVOutAirNode GetStandAloneERVReturnAirNode GetStandAloneERVZoneInletAirNode GetStandardMeterResourceType GetSteamBaseboardInput GetSteamCoilAvailScheduleIndex GetSteamCoilControlNodeNum GetSteamCoilIndex GetSteamCoilInput GetSTM GetStormWindowData GetSupHeatDensityRefrig GetSupHeatEnthalpyRefrig GetSupHeatPressureRefrig GetSupplyAirFlowRate GetSupplyAirFlowRate GetSupplyAirInletNode GetSupplyInletNode GetSupplyOutletNode GetSurfaceCountForOSCM GetSurfaceData GetSurfaceGroundHeatExchanger GetSurfaceHeatTransferAlgorithmOverrides GetSurfaceIndecesForOSCM GetSurfaceListsInputs GetSurfHBDataForMundtModel GetSurfHBDataForTempDistModel GetSysAvailManagerInputs GetSysAvailManagerListInputs GetSysInput GetSystemNodeNumberForZone GetSystemSizingInput GetTDDInput GetTESCoilIndex GetTESCoilInput GetThermalChimney GetTowerInput GetTranspiredCollectorIndex GetTranspiredCollectorInput GetTypeOfCoil GetUFADZoneData GetUnitarySystemDXCoolingCoilIndex GetUnitarySystemInput GetUnitarySystemOAHeatCoolCoil GetUnitConversion GetUnitHeaterInput GetUnitsString GetUnitSubString GetUnitVentilatorInput GetUnitVentilatorMixedAirNode GetUnitVentilatorOutAirNode GetUnitVentilatorReturnAirNode GetUnitVentilatorZoneInletAirNode GetUserConvectionCoefficients GetUserDefinedComponents GetUserDefinedOpSchemeInput GetUserDefinedPatternData GetUTSCTsColl GetVariableKeyCountandType GetVariableKeyCountandType GetVariableKeys GetVariableKeys GetVariableTypeAndIndex GetVariableUnitsString GetVarSpeedCoilInput GetVentilatedSlabInput GetVertices GetViscosityGlycol GetVRFInput GetVSCoilCondenserInletNode GetVSCoilMinOATCompressor GetVSCoilNumOfSpeeds GetWaterCoilAvailScheduleIndex GetWaterCoilCapacity GetWaterCoilIndex GetWaterCoilInput GetWaterMainsTemperatures GetWaterManagerInput GetWaterSource GetWaterThermalTankInput GetWatertoAirHPInput GetWatertoWaterHPInput GetWaterUseInput GetWeatherProperties GetWeatherStation GetWindowAC GetWindowACMixedAirNode GetWindowACOutAirNode GetWindowACReturnAirNode GetWindowACZoneInletAirNode GetWindowGapAirflowControlData GetWindowGlassSpectralData GetWindowShadingControlData GetWindTurbineInput GetWrapperInput GetWTGeneratorResults GetZoneAirDistribution GetZoneAirLoopEquipment GetZoneAirSetpoints GetZoneAndZoneListNames GetZoneContaminanInputs GetZoneContaminanSetpoints GetZoneData GetZoneDehumidifierInput GetZoneDehumidifierNodeNumber GetZoneEqAvailabilityManager GetZoneEquipment GetZoneEquipmentData GetZoneEquipmentData1 GetZoneInfilAirChangeRate GetZoneLoads GetZonePlenumInput GetZoneSizingInput GLtoAMB GoAhead guess HasFractionalScheduleValue hatter HCInWindowStandardRatings HConvGap HcUCSDCV HcUCSDDV HcUCSDUF HeatingCoilVarSpeedCycResidual HeatingCoilVarSpeedResidual HeatPumpRunFrac HeatPumpRunFrac HeatPumpRunFrac HeatWatertoAirHPTempResidual Height HEMINT HIC_ASHRAE HotWaterCoilResidual HotWaterCoilResidual HotWaterCoilResidual HotWaterCoilResidual HotWaterCoilResidual HotWaterHeatingCoilResidual HRadPar HTRANS HTRANS0 HTRANS1 HWBaseboardUAResidual HXAssistDXCoilResidual HXAssistedCoolCoilHRResidual HXAssistedCoolCoilHRResidual HXAssistedCoolCoilTempResidual HXAssistedCoolCoilTempResidual HXDemandSideLoopFlowResidual HybridVentilationControl IAM iCheckScheduleValue ICSCollectorAnalyticalSoluton iGetCoilAirOutletNode iGetCoilSteamInletNode iGetCoilSteamOutletNode INCLOS incrementEconVar IncrementInstMeterCache incrementSteps incrementTableEntry InitAirflowNetwork InitAirflowNetworkData InitAirHeatBalance InitAirLoops InitAirLoopSplitter InitAirMixer InitAirTerminalUserDefined InitAirZoneReturnPlenum InitAirZoneSupplyPlenum InitATMixer InitBaseboard InitBaseboard InitBLASTAbsorberModel InitBoiler InitBoiler InitBoreholeHXSimVars InitBSDFWindows InitCBVAV InitCoilUserDefined InitComplexWindows InitComponentNodes InitConductionTransferFunctions InitConnections InitConstCOPChiller InitController InitCoolBeam InitCTGenerators InitCurveReporting InitDaylightingDevices InitDemandManagers InitDesiccantDehumidifier InitDetailedIceStorage InitDirectAir InitDualDuct InitDuct InitDXCoil InitDXCoolingSystem InitDXHeatPumpSystem InitElecReformEIRChiller InitElectricBaseboard InitElectricChiller InitElectricEIRChiller InitEMS InitEMSControlledConstructions InitEMSControlledSurfaceProperties InitEnergyReports InitEngineDrivenChiller InitEquivalentLayerWindowCalculations InitEvapCooler InitEvapFluidCooler InitExhaustAbsorber InitExteriorConvectionCoeff InitFan InitFanCoilUnits InitFluidCooler InitFluidHeatExchanger InitFuelCellGenerators InitFurnace InitGasAbsorber InitGlassOpticalCalculations InitGshp InitGshp InitGTChiller InitHeatBalance InitHeatBalFiniteDiff InitHeatBalHAMT InitHeatingCoil InitHeatRecovery InitHighTempRadiantSystem InitHumidifier InitHWBaseboard InitHXAssistedCoolingCoil InitHybridVentSysAvailMgr InitialInitHeatBalFiniteDiff InitializeCFSDaylighting InitializeCFSStateData InitializeComponentSizingTable InitializeConstructionsTables InitializeDaylightMapTables InitializeEnvironmentPeriodsTable InitializeErrorsTable InitializeGlycolTempLimits InitializeHeatTransferPipes InitializeIndexes InitializeIndexes InitializeLoops InitializeMaterialsTable InitializeMeters initializeMonetaryUnit InitializeNominalBaseboardHeatTable InitializeNominalElectricEquipmentTable InitializeNominalGasEquipmentTable InitializeNominalHotWaterEquipmentTable InitializeNominalInfiltrationTable InitializeNominalLightingTable InitializeNominalOtherEquipmentTable InitializeNominalPeopleTable InitializeNominalSteamEquipmentTable InitializeNominalVentilationTable InitializeOperatingMode InitializeOutput InitializePipes InitializePredefinedMonthlyTitles InitializePsychRoutines InitializePumps InitializeRefrigerantLimits InitializeReportMeterDataDictionaryTable InitializeReportMeterDataTables InitializeReportVariableDataDictionaryTable InitializeReportVariableDataTables InitializeRoomAirModelTable InitializeRootFinder InitializeRuntimeLanguage InitializeSchedulesTable InitializeSimulationsTable InitializeSQLiteTables InitializeSurfacesTable InitializeSystemSizingTable InitializeTabularDataTable InitializeTabularDataTable InitializeTabularDataView InitializeTabularDataView InitializeTabularMonthly InitializeTimeIndicesTable InitializeViews InitializeWeather InitializeZoneGroupTable InitializeZoneInfoTable InitializeZoneListTable InitializeZoneSizingTable InitICEngineGenerators InitIndirectAbsorpChiller InitIndUnit InitInteriorConvectionCoeffs InitInteriorRadExchange InitInternalHeatGains InitIntSolarDistribution InitLoadBasedControl InitLoadDistribution InitLowTempRadiantSystem InitMicroCHPNoNormalizeGenerators InitMoistureBalanceEMPD InitMSHeatPump InitMTGenerators InitMundtModel InitOAController InitOAMixer InitOneTimePlantSizingInfo InitOutAirNodes InitOutdoorAirUnit InitOutsideAirSys InitPipesHeatTransfer InitPipingSystems InitPIU InitPlantProfile InitPlantUserComponent InitPlantValves InitPollutionMeterReporting InitPondGroundHeatExchanger InitPressureDrop InitPTUnit InitPurchasedAir InitPVTcollectors InitRefrigeration InitRefrigerationPlantConnections InitReturnAirPath InitSecretObjects InitSetPointManagers InitSimpleIceStorage InitSimpleMixingConvectiveHeatGains InitSimpleWatertoAirHP InitSimVars InitSimVars InitSimVars InitSimVars InitSolarCalculations InitSolarCollector InitSolarHeatGains InitSolReflRecSurf InitStandAloneERV InitSteamBaseboard InitSteamCoil InitSurfaceGroundHeatExchanger InitSurfaceHeatBalance InitSys InitSysAvailManagers InitSystemOutputRequired InitTempDistModel InitTESCoil InitThermalAndFluxHistories InitThermalComfort InitTower InitTranspiredCollector InitTRNSYSPV InitUCSDCV InitUCSDDV InitUCSDUF InitUniqueNodeCheck InitUnitarySystems InitUnitHeater InitUnitVentilator InitVarSpeedCoil InitVentilatedSlab InitVRF InitWaterCoil InitWaterSource InitWaterThermalTank InitWatertoAirHP InitWatertoWaterHP InitWindowAC InitWindTurbine InitWrapper InitZoneAirLoopEquipment InitZoneAirSetpoints InitZoneAirUserDefined InitZoneContSetpoints InitZoneDehumidifier InitZoneEquipment InitZoneEvaporativeCoolerUnit InPolygon InsertCurrencySymbol int_times_vector INTCPT Integer_IsInRange IntegerIsWithinTwoValues IntegerToString InterConnectTwoPlantLoopSides InteriorBCEqns InteriorNodeEqns InternalRangeCheck InternalSetupTankDemandComponent InternalSetupTankSupplyComponent interp INTERP InterpBlind InterpDefValuesForGlycolConc Interpolate Interpolate_Lagrange InterpolateBetweenFourValues InterpolateBetweenTwoValues InterpolatePipeTransBeam InterpProfAng InterpProfSlatAng InterpretWeatherDataLine InterpSlatAng InterpSw InterpValuesForGlycolConc IntInterfaceNodeEqns IntPreDefTableEntry IntToStr Invert3By3Matrix InvertMatrix InvJulianDay IPTrimSigDigits iRoundSigDigits IS_BEAM IS_DIFF IS_DSRATIO IS_F IS_LWP IS_OPENNESS IS_SWP isCompLoadRepReq IsControlledShade IsConverged_CurrentToPrevIteration IsConverged_PipeCurrentToPrevIteration IsCurveInputTypeValid IsCurveOutputTypeValid isExternalInterfaceErlVariable IsGlazeLayerX IsGZSLayer isInQuadrilateral IsInRange isInTriangle IsLeapYear IsNodeOnSetPtManager IsParentObject IsParentObjectCompSet IsShadingLayer IssueSevereAlphaInputFieldError IssueSevereInputFieldError IssueSevereRealInputFieldError IsValidConnectionType IsVBLayer isWithinRange ITERATE IterateRootFinder iTrimSigDigits JGDate JulianDay LClimb LDSumMax LDSumMean LEEDtariffReporting LimitCoilCapacity LimitController LimitTUCapacity LinesOut linint LoadEquipList LoadInterface LogicalToInteger LogicalToInteger LogPlantConvergencePoints lookupOperator LookUpScheduleValue LookUpSeason LookupSItoIP lubksb LUBKSB ludcmp LUDCMP LUdecomposition LUsolution MakeAnchorName MakeHVACTimeIntervalString MakeMirrorSurface MakeRectangularVertices MakeRelativeRectangularVertices MakeTransition MakeUPPERCase ManageAirflowNetworkBalance ManageAirHeatBalance ManageAirLoops ManageAirModel ManageBranchInput ManageControllers ManageCoolTower ManageDemand ManageEarthTube ManageElectCenterStorageInteractions ManageElectricLoadCenters ManageElectStorInteractions ManageEMS ManageExteriorEnergyUse ManageGeneratorControlState ManageGeneratorFuelFlow ManageHeatBalance ManageHeatBalFiniteDiff ManageHeatBalHAMT ManageHVAC ManageHybridVentilation ManageInsideAdaptiveConvectionAlgo ManageInternalHeatGains ManageInverter ManageMundtModel ManageNonZoneEquipment ManageOutsideAdaptiveConvectionAlgo ManageOutsideAirSystem ManagePlantLoadDistribution ManagePlantLoops ManageRefrigeratedCaseRacks ManageSetPoints ManageSimulation ManageSingleCommonPipe ManageSizing ManageSurfaceHeatBalance ManageSystemAvailability ManageThermalChimney ManageThermalComfort ManageTransformers ManageTwoWayCommonPipe ManageUCSDCVModel ManageUCSDDVModel ManageUCSDUFModels ManageUserDefinedPatterns ManageWater ManageWaterInits ManageWeather ManageZoneAirLoopEquipment ManageZoneAirUpdates ManageZoneContaminanUpdates ManageZoneEquipment MapExtConvClassificationToHcModels MapIntConvClassificationToHcModels MarkNode MatchAndSetColorTextString MatchPlantSys MatrixIndex matrixQBalance MeshPartition_CompareByDimension MeshPartition_SelectionSort MeshPartitionArray_Contains MinePlantStructForInfo MixedAirControlTempResidual ModifyWindow Modulus MonthToMonthNumber MovingAvg MRXINV MSHPCyclingResidual MSHPHeatRecovery MSHPVarSpeedResidual MultiModeDXCoilHumRatResidual MultiModeDXCoilHumRatResidual MultiModeDXCoilResidual MultiModeDXCoilResidual MultiModeDXCoilResidual MultiSpeedDXCoolingCoilStandardRatings MultiSpeedDXHeatingCoilStandardRatings MULTOL MyPlantSizingIndex NeighborInformationArray_Value NETRAD NewEMSVariable NewExpression newPreDefColumn newPreDefReport newPreDefSubTable NEWTON NodeHasSPMCtrlVarType NormalArea NumBranchesInBranchList NumCompsInBranch nusselt NusseltNumber OpenEPlusWeatherFile OPENNESS_LW OpenOutputFiles OpenOutputTabularFile OpenWeatherFile OPERATOR (*) OPERATOR (+) OPERATOR (-) OPERATOR (.dot.) OPERATOR (.twodcross.) OPERATOR (.twoddot.) OPERATOR (/) ORDER OutBaroPressAt OutDewPointTempAt OutDryBulbTempAt OutsidePipeHeatTransCoef OutWetBulbTempAt P01 PanesDeflection ParametricObjectsCheck parseComputeLine ParseExpression ParseStack ParseTime PartLoadFactor PassiveGapNusseltNumber PassPressureAcrossInterface PassPressureAcrossMixer PassPressureAcrossSplitter PD_BEAM PD_BEAM_CASE_I PD_BEAM_CASE_II PD_BEAM_CASE_III PD_BEAM_CASE_IV PD_BEAM_CASE_V PD_BEAM_CASE_VI PD_DIFF PD_LW PD_LWP PD_SWP PerformanceCurveObject PerformanceTableObject PerformIterationLoop PerformPipeCellSimulation PerformPipeCircuitSimulation PerformSolarCalculations PerformTemperatureFieldUpdate PierceSurface PierceSurfaceVector PipeCircuitInfo_InitInOutCells PipeSegmentInfo_InitPipeCells PIUInducesPlenumAir PIUnitHasMixer PlaneEquation PlantHalfLoopSolver PlantMassFlowRatesFunc PLRResidual PLRResidual PLRResidualMixedTank PLRResidualStratifiedTank PMVResidual POLY1F POLY2F POLYF polygon_contains_point_2d popStack pos PostIPProcessing POWER PreDefTableEntry PredictSystemLoads PredictZoneContaminants PreparePipeCircuitSimulation PrepDebugFilesAndVariables PreProcessorCheck PrepVariablesISO15099 PreScanReportingVariables PresProfile PressureCurveValue ProcessDataDicFile ProcessDateString ProcessEMSInput ProcessEPWHeader ProcessForDayTypes ProcessInput ProcessInputDataFile ProcessIntervalFields ProcessMinMaxDefLine ProcessNumber ProcessScheduleInput ProcessSurfaceVertices ProcessTokens ProduceMinMaxString ProduceMinMaxStringWStartMinute ProduceRDDMDD ProfileAngle PropagateResolvedFlow PStack PsyCpAirFnWTdb PsyHfgAirFnWTdb PsyHFnTdbRhPb PsyHFnTdbW PsyHgAirFnWTdb PsyPsatFnTemp PsyPsatFnTemp_raw PsyRhFnTdbRhov PsyRhFnTdbRhovLBnd0C PsyRhFnTdbWPb PsyRhoAirFnPbTdbW PsyRhovFnTdbRh PsyRhovFnTdbRhLBnd0C PsyRhovFnTdbWPb PsyTdbFnHW PsyTdpFnTdbTwbPb PsyTdpFnWPb PsyTsatFnHPb PsyTsatFnPb PsyTwbFnTdbWPb PsyTwbFnTdbWPb_raw PsyVFnTdbWPb PsyWFnTdbH PsyWFnTdbRhPb PsyWFnTdbTwbPb PsyWFnTdpPb psz Pt2Plane PullCompInterconnectTrigger PumpDataForTable PushBranchFlowCharacteristics PushInnerTimeStepArrays pushStack PushSystemTimestepHistories PushSystemTimestepHistories PushZoneTimestepHistories PushZoneTimestepHistories QsortC QsortPartition RadialCellInfo_XY_CrossSectArea RadialCellInformation_ctor RadialSizing_Thickness Rainflow RangeCheck RB_BEAM RB_DIFF RB_F RB_LWP RB_SWP rCheckDayScheduleValueMinMax rCheckScheduleValue rCheckScheduleValueMinMax1 rCheckScheduleValueMinMax2 ReadEnergyMeters ReadEPlusWeatherForDay ReadGeneralDomainInputs ReadHorizontalTrenchInputs ReadINIFile ReadInputLine ReadPipeCircuitInputs ReadPipeSegmentInputs ReadTableData ReadUserWeatherInput ReadWeatherForDay Real_ConstrainTo Real_IsInRange real_times_vector ReAllocateAndPreserveOutputVariablesForSimulation ReallocateIntegerArray ReallocateIVar ReallocateRealArray ReallocateRVar RealPreDefTableEntry RealToStr RecKeepHeatBalance RecordOutput RectangleF_Contains ReformEIRChillerCondInletTempResidual ReformEIRChillerHeatRecovery RegisterNodeConnection RegisterPlantCompDesignFlow RegulateCondenserCompFlowReqOp ReInitPlantLoopsAtFirstHVACIteration RemoveSpaces RemoveTrailingZeros reorder ReplaceBlanksWithUnderscores ReplaceBlanksWithUnderscores ReportAirflowNetwork ReportAirHeatBalance ReportAirLoopConnections ReportAirTerminalUserDefined ReportAndTestGlycols ReportAndTestRefrigerants ReportBaseboard ReportBaseboard ReportCBVAV ReportChillerIPLV ReportCoilUserDefined ReportCompSetMeterVariables ReportController ReportCoolBeam ReportCoolTower ReportCTFs ReportCWTankInits ReportDemandManagerList ReportDesiccantDehumidifier ReportDetailedIceStorage ReportDirectAir ReportDualDuct ReportDualDuctConnections ReportDuct ReportDXCoil ReportDXCoilRating ReportDYMeters ReportEarthTube ReportEconomicVariable ReportElectricBaseboard ReportEMS ReportEvapCooler ReportEvapFluidCooler ReportExteriorEnergyUse ReportFan ReportFanCoilUnit ReportFatalGlycolErrors ReportFatalRefrigerantErrors ReportFiniteDiffInits ReportFluidCooler ReportFluidHeatExchanger ReportForTabularReports ReportFurnace ReportGlass ReportHeatBalance ReportHeatingCoil ReportHeatRecovery ReportHighTempRadiantSystem ReportHRMeters ReportHumidifier ReportHWBaseboard ReportIllumMap ReportingFreqName ReportingThisVariable ReportInternalHeatGains ReportLoopConnections ReportLowTempRadiantSystem ReportMaxVentilationLoads ReportMeterDetails ReportMissing_RangeData ReportMixer ReportMNMeters ReportMoistureBalanceEMPD ReportMSHeatPump ReportNodeConnections ReportOAController ReportOAMixer ReportOrphanFluids ReportOrphanRecordObjects ReportOrphanSchedules ReportOutdoorAirUnit ReportOutputFileHeaders ReportParentChildren ReportPipesHeatTransfer ReportPIU ReportPlantProfile ReportPlantUserComponent ReportPlantValves ReportPondGroundHeatExchanger ReportPTUnit ReportPumps ReportPurchasedAir ReportPV ReportRackSystem ReportRefrigerationComponents ReportReturnAirPath ReportRuntimeLanguage ReportScheduleDetails ReportScheduleValues ReportSizingOutput ReportSMMeters ReportSolarCollector ReportSplitter ReportStandAloneERV ReportStandAloneWaterUse ReportSteamBaseboard ReportSteamCoil ReportSurfaceErrors ReportSurfaceGroundHeatExchngr ReportSurfaceHeatBalance ReportSurfaces ReportSurfaceShading ReportSys ReportSysSizing ReportSystemEnergyUse ReportThermalChimney ReportTowers ReportTSMeters ReportUnitarySystem ReportUnitHeater ReportUnitVentilator ReportVentilatedSlab ReportVRFCondenser ReportVRFTerminalUnit ReportWarmupConvergence ReportWaterCoil ReportWaterManager ReportWaterThermalTank ReportWaterUse ReportWeatherAndTimeInformation ReportWindowAC ReportWindTurbine ReportZoneAirLoopEquipment ReportZoneAirUserDefined ReportZoneDehumidifier ReportZoneEquipment ReportZoneEvaporativeCoolerUnit ReportZoneMeanAirTemp ReportZoneReturnPlenum ReportZoneSizing ReportZoneSupplyPlenum ResetAllPlantInterConnectFlags ResetController ResetEnvironmentCounter ResetHVACControl ResetNodeData ResetPerformanceCurveOutput ResetRootFinder ResetTerminalUnitFlowLimits ResetWeekDaysByMonth Resimulate resist ReSolveAirLoopControllers ResolveAirLoopFlowLimits ResolveLocationInformation ResolveLockoutFlags ResolveLoopFlowVsPressure ResolveParallelFlows ResolveSysFlow ReverseAndRecalculate RevertZoneTimestepHistories RevertZoneTimestepHistories RevisePlantCallingOrder RezeroZoneSizingArrays RhoH2O RHtoVP RKG RoundSigDigits rRoundSigDigits rTrimSigDigits SafeCopyPlantNode SafeDiv SafeDivide SameString SandiaCellTemperature SandiaEffectiveIrradiance SandiaF1 SandiaF2 SandiaImp SandiaIsc SandiaIx SandiaIxx SandiaModuleTemperature SandiaTcellFromTmodule SandiaVmp SandiaVoc SaveSimpleController ScanForReports ScanPlantLoopsForNodeNum ScanPlantLoopsForObject sCheckDayScheduleValueMinMax ScheduleAverageHoursPerWeek SEARCH SearchAscTable SearchWindow5DataFile SecantFormula SecantMethod selectTariff SetActuatedBranchFlowRate SetAdditionalNeighborData SetAllFlowLocks SetAllPlantSimFlagsToValue SetATMixerPriFlow SetATMixerPriFlow SetAverageAirFlow SetAverageAirFlow SetAverageAirFlow SetAverageAirFlow SetAverageAirFlow SetAverageAirFlow SetCoilDesFlow SetCoilSystemCoolingData SetCoilSystemHeatingDXFlag SetCompFlowRate SetComponentFlowRate SetCurrentWeather SetCurveOutputMinMaxValues SetDSTDateRanges SetDXCoilTypeData SetDXCoolingCoilData SetEquivalentLayerWindowProperties SetErlValueNumber SetExtConvectionCoeff SetFanData SetHeatExchangerData SetHeatToReturnAirFlag SetInitialMeterReportingAndOutputNames SetIntConvectionCoeff SetInternalVariableValue SetMinMax setNativeVariables SetNodeResult SetOAControllerData SetOnOffMassFlowRate SetOnOffMassFlowRate SetOnOffMassFlowRate SetOnOffMassFlowRateVSCoil SetOnOffMassFlowRateVSCoil SetOutAirNodes SetOutBulbTempAt SetPredefinedTables SetSimpleWSHPData SETSKY SetSpecialDayDates SetSpeedVariables SetStormWindowControl SetSurfHBDataForMundtModel SetSurfHBDataForTempDistModel SetSurfTmeanAir SETUP4x4_A SetupAdaptiveConvectionRadiantSurfaceData SetupAdaptiveConvectionStaticMetaData SetupAirLoopControllersTracer SetupAllOutputVariables SetUpAndSort SetupBranchControlTypes SetupCellNeighbors SetupCommonPipes SetupComplexFenestrationMaterialInput SetupComplexFenestrationStateInput SetupComplexWindowStateGeometry SetUpCompSets SetupDElightOutput4EPlus SetupDElightOutput4EPlus SetUpDesignDay SetupEMSActuator SetupEMSIntegerActuator SetupEMSIntegerInternalVariable SetupEMSInternalVariable SetupEMSLogicalActuator SetupEMSRealActuator SetupEMSRealInternalVariable SetupEnvironmentTypes SetupFuelConstituentData SetupGeneratorControlStateManager SetupIndividualControllerTracer SetupInitialPlantCallingOrder SetupIntegerOutputVariable SetupInterpolationValues SetupLoopFlowRequest SetupMeteredVarsForSetPt SetupMundtModel SetupNodeSetpointsAsActuators SetupNodeVarsForReporting SetupOutputVariable SetupPipeCircuitInOutCells SetupPlantEMSActuators SetupPollutionCalculations SetupPollutionMeterReporting SetupPossibleOperators SetupPrimaryAirSystemAvailMgrAsActuators SetupPumpMinMaxFlows SetupRealOutputVariable SetupRealOutputVariable_IntKey SetupReportInput SetupReports SetupRootFinder SetUpSchemeColors SetupShadeSurfacesForSolarCalcs SetupSimpleWindowGlazingSystem SetupSimulation SetupStratifiedNodes SetupSurfaceConstructionActuators SetupSurfaceConvectionActuators SetupSurfaceOutdoorBoundaryConditionActuators SetUpSysSizingArrays SetupTankDemandComponent SetupTankSupplyComponent SetupThermostatActuators SetupTimePointers SetupUnitConversions SetupWeekDaysByMonth SetupWindowShadingControlActuators SetupZoneEquipmentForConvectionFlowRegime SetupZoneGeometry SetupZoneInfoAsInternalDataAvail SetupZoneInternalGain SetupZoneInternalGain SetupZoneSizing SetUpZoneSizingArrays SetUTSCQdotSource SetVarSpeedCoilData SetVentedModuleQdotSource SetVSHPAirFlow SetVSHPAirFlow SetWindSpeedAt SetZoneEquipSimOrder shading shadingedge shadingin SHADOW SharedDVCVUFDataInit SHDBKS SHDGSS SHDRVL SHDSBS shift ShiftPipeTemperaturesForNewIteration ShiftPlantLoopSideCallingOrder ShiftTemperaturesForNewIteration ShiftTemperaturesForNewTimeStep ShowAuditErrorMessage ShowBranchesOnLoop ShowContinueError ShowContinueError ShowContinueErrorTimeStamp ShowContinueErrorTimeStamp ShowErrorMessage ShowErrorMessage ShowFatalError ShowFatalError ShowMessage ShowMessage ShowPsychrometricSummary ShowRecurringContinueErrorAtEnd ShowRecurringContinueErrorAtEnd ShowRecurringErrors ShowRecurringSevereErrorAtEnd ShowRecurringSevereErrorAtEnd ShowRecurringWarningErrorAtEnd ShowRecurringWarningErrorAtEnd ShowSevereError ShowSevereError ShowSevereMessage ShowSevereMessage ShowWarningError ShowWarningError ShowWarningMessage ShowWarningMessage showWarningsBasedOnTotal Sim4PipeFanCoil SimAirChillerSet SimAirLoop SimAirLoopComponent SimAirLoopComponents SimAirLoops SimAirLoopSplitter SimAirMixer SimAirTerminalUserDefined SimAirZonePlenum SimATMixer SimBaseboard SimBLASTAbsorber SimBoiler SimCBVAV SimCBVAV SimCentralGroundSourceHeatPump SimChiller SimCoilUserDefined SimComponentModelFan SimConstVol SimCoolBeam SimCostEstimate SimCTGenerator SimCTPlantHeatRecovery SimCyclingWindowAC SimDesiccantDehumidifier SimDetailedIceStorage SimDirectAir SimDistrictEnergy SimDualDuctConstVol SimDualDuctVarVol SimDualDuctVAVOutdoorAir SimDuct SimDXCoil SimDXCoilMultiMode SimDXCoilMultiSpeed SimDXCoolingSystem SimDXHeatPumpSystem SimElecBaseBoard SimElectricBaseBoard SimElectricConvective SimElectricEIRChiller SimEvapCooler SimEvapFluidCoolers SimExhaustAbsorber SimFanCoilUnit SimFluidCoolers SimFluidHeatExchanger SimFourPipeIndUnit SimFuelCellGenerator SimFuelCellPlantHeatRecovery SimFurnace SimGasAbsorber SimGroundHeatExchangers SimHeatPumpWaterHeater SimHeatRecovery SimHighTempRadiantSystem SimHPWatertoWaterCOOLING SimHPWatertoWaterHEATING SimHPWatertoWaterSimple SimHumidifier SimHVAC SimHWBaseboard SimHWConvective SimHXAssistedCoolingCoil SimICEngineGenerator SimICEPlantHeatRecovery SimIceStorage SimIndirectAbsorber SimIndUnit SimLowTempRadiantSystem SimMicroCHPGenerator SimMicroCHPPlantHeatRecovery SimMSHeatPump SimMSHP SimMTGenerator SimMTPlantHeatRecovery SimMultiSpeedCoils SimOAComponent SimOAController SimOAMixer SimOnOffFan SimOutdoorAirEquipComps SimOutdoorAirUnit SimOutsideAirSys SimOutsideEnergy SimPackagedTerminalUnit SimPipes SimPipesHeatTransfer SimPipingSystemCircuit SimPIU SimPlantEquip SimPlantValves SimpleCoolingCoilUAResidual SimpleEvapFluidCoolerUAResidual SimpleFluidCoolerUAResidual SimpleHeatingCoilUAResidual SimpleTowerApproachResidual SimpleTowerTrResidual SimpleTowerUAResidual SimPondGroundHeatExchanger SimPressureDropSystem SimPTUnit SimPumps SimPurchasedAir SimPVGenerator SimPVTcollectors SimReformulatedEIRChiller SimRefrigCondenser SimReturnAirPath SimSelectedEquipment SimSetPointManagers SimSimpleEvapFluidCooler SimSimpleFan SimSimpleFluidCooler SimSimpleTower SimSolarCollector SimStandAloneERV SimSteamBaseboard SimSteamBoiler SimSteamCoils SimSurfaceGroundHeatExchanger SimSysAvailManager SimTESCoil SimTowers SimTranspiredCollector SimulateAllInteriorRadialSoilSlices SimulateAllLoopSideBranches SimulateAllLoopSidePumps SimulateDemandManagerList SimulateDetailedRefrigerationSystems SimulateDetailedTransRefrigSystems SimulateDualDuct SimulateFanComponents SimulateFluidCell SimulateHeatingCoilComponents SimulateInnerMostRadialSoilSlice SimulateLoopSideBranchGroup SimulateOuterMostRadialSoilSlice SimulatePlantProfile SimulateRadialInsulationCell SimulateRadialPipeCell SimulateRadialToCartesianInterface SimulateSingleDuct SimulateSteamCoilComponents SimulateVRF SimulateWaterCoilComponents SimulateWaterHeaterStandAlone SimulateWaterUse SimulateWaterUseConnection SimUnitaryBypassVAV SimUnitarySystem SimUnitHeater SimUnitVentilator SimUnitVentOAMixer SimUserDefinedPlantComponent SimVariableSpeedCoils SimVariableSpeedHP SimVariableSpeedHP SimVariableTower SimVariableVolumeFan SimVAV SimVAVVS SimVentilatedSlab SimVentSlabOAMixer SimVRF SimVRFCondenserPlant SimWaterCoils SimWaterSource SimWaterThermalTank SimWatertoAirHP SimWatertoAirHPSimple SimWindowAC SimWindTurbine SimZoneAirLoopEquipment SimZoneAirUserDefined SimZoneDehumidifier SimZoneEquipment SimZoneEvaporativeCoolerUnit SimZoneExhaustFan SimZoneOutAirUnitComps SingelSpeedDXCoolingCoilStandardRatings SingleSpeedDXHeatingCoilStandardRatings SingleSpeedFluidCooler SizeAbsorpChiller SizeAirLoopBranches SizeAirLoops SizeBaseboard SizeBoiler SizeBoiler SizeCBVAV SizeConstCOPChiller SizeController SizeCoolBeam SizeDemandSidePlantConnections SizeDirectAir SizeDualDuct SizeDXCoil SizeElecReformEIRChiller SizeElectricBaseboard SizeElectricBaseboard SizeElectricChiller SizeElectricEIRChiller SizeEngineDrivenChiller SizeEvapCooler SizeEvapFluidCooler SizeExhaustAbsorber SizeFan SizeFanCoilUnit SizeFluidCooler SizeFluidHeatExchanger SizeFurnace SizeGasAbsorber SizeGTChiller SizeHeatingCoil SizeHeatRecovery SizeHighTempRadiantSystem SizeHumidifier SizeHVACWaterToAir SizeHWBaseboard SizeIndirectAbsorpChiller SizeIndUnit SizeLowTempRadiantSystem SizeMSHeatPump SizeOAController SizeOutdoorAirUnit SizePIU SizePlantLoop SizePTUnit SizePump SizePurchasedAir SizePVT SizeStandAloneERV SizeStandAloneWaterHeater SizeSteamBaseboard SizeSteamCoil SizeSupplySidePlantConnections SizeSys SizeTankForDemandSide SizeTankForSupplySide SizeTESCoil SizeTower SizeUCSDUF SizeUnitarySystem SizeUnitHeater SizeUnitVentilator SizeVarSpeedCoil SizeVentilatedSlab SizeVRF SizeVRFCondenser SizeVSMerkelTower SizeWaterCoil SizeWaterManager SizeWaterSource SizeWindowAC SizeWrapper SizeZoneDehumidifier SizeZoneEquipment SizeZoneEvaporativeCoolerUnit SkipEPlusWFHeader SkyDifSolarShading SkyGndWeight SkyWeight SLtoAMB SLtoGL SLVSKY solar_EN673 solarISO15099 SolarSprectrumAverage SOLMATS SolveAirLoopControllers SolveForWindowTemperatures SolveRegression SolveRegulaFalsi SolverMoistureBalanceEMPD SOLVZP SortHistory Specular_Adjust Specular_EstimateDiffuseProps Specular_F Specular_OffNormal Specular_RATDiff Specular_SWP SQLiteBegin SQLiteBegin SQLiteBindDouble SQLiteBindInteger SQLiteBindLogicalMacro SQLiteBindNULL SQLiteBindText SQLiteBindTextMacro SQLiteClearBindings SQLiteCloseDatabase SQLiteColumnInt SQLiteColumnIntMacro SQLiteCommit SQLiteCommit SQLiteExecuteCommand SQLiteExecuteCommandMacro SQLiteFinalizeCommand SQLiteOpenDatabase SQLiteOpenDatabaseMacro SQLitePrepareStatement SQLitePrepareStatementMacro SQLiteResetCommand SQLiteStepCommand SQLiteWriteMessage SQLiteWriteMessageMacro SQLiteWriteMessageMacro StandardIndexTypeKey StandardVariableTypeKey StartingWindowTemps StartingWinTempsForNominalCond SteamHeatingCoilResidual StorageType StoreAPumpOnCurrentTempLoop storeIterationResults StoreRecurringErrorMessage StringValue StrToReal SumAllInternalCO2Gains SumAllInternalConvectionGains SumAllInternalGenericContamGains SumAllInternalLatentGains SumAllInternalRadiationGains SumAllReturnAirConvectionGains SumAllReturnAirLatentGains SumHATsurf SumHATsurf SumHATsurf SumHATsurf SumHATsurf SumHATsurf SumInternalCO2GainsByTypes SumInternalConvectionGainsByTypes SumInternalLatentGainsByTypes SumInternalRadiationGainsByTypes SummarizeErrors SumReturnAirConvectionGainsByTypes SumZoneImpacts SUN3 SUN4 SupSATResidual SurfaceScheduledSolarInc SurveyDemandManagers SystemPropertiesAtLambdaAndPhi SystemSpectralPropertiesAtPhi TableLookupObject TARCOG90 TBND TdbFnHRhPb TDMA TDMA_R TellMeHowManyObjectItemArgs TemperaturesFromEnergy TempIPtoSI TempSItoIP terpld TESCoilHumRatResidual TESCoilResidual TestAirPathIntegrity TestBranchIntegrity TestCompSet TestCompSetInletOutletNodes TestInletOutletNodes TestReturnAirPathIntegrity TestSupplyAirPathIntegrity therm1d TightenNodeMinMaxAvails TimestepInitComplexFenestration TimestepTypeName TraceAirLoopController TraceAirLoopControllers TraceIndividualController TraceIterationStamp TrackAirLoopController TrackAirLoopControllers TRadC TransAndReflAtPhi TransformVertsByAspect TransTDD Triangulate TrimSigDigits TurnOffLoopEquipment TurnOffLoopSideEquipment TurnOffReportRangeCheckErrors TurnOnPlantLoopPipes TurnOnReportRangeCheckErrors TwoSpeedFluidCooler UnitarySystemHeatRecovery UpdateAbsorberChillerComponentGeneratorSide UpdateAirflowNetwork UpdateAirMixer UpdateAirSysCompPtrArray UpdateAirSysSubCompPtrArray UpdateAirSysSubSubCompPtrArray UpdateAirZoneReturnPlenum UpdateAirZoneSupplyPlenum UpdateAnyLoopDemandAlterations UpdateATMixer UpdateBaseboard UpdateBaseboardPlantConnection UpdateBasementSurfaceTemperatures UpdateBBElecRadSourceValAvg UpdateBBRadSourceValAvg UpdateBBSteamRadSourceValAvg UpdateBLASTAbsorberRecords UpdateBoilerRecords UpdateBoilerRecords UpdateBracket UpdateBranchConnections UpdateChillerComponentCondenserSide UpdateChillerheaterRecords UpdateChillerRecords UpdateColdWeatherProtection UpdateCommonPipe UpdateComplexWindows UpdateComponentHeatRecoverySide UpdateConstCOPChillerRecords UpdateController UpdateCoolBeam UpdateCoolTower UpdateCTGeneratorRecords UpdateDataandReport UpdateDemandManagers UpdateDesiccantDehumidifier UpdateDetailedIceStorage UpdateDualDuct UpdateDuct UpdateDXCoil UpdateElectricBaseboard UpdateElectricChillerRecords UpdateElectricEIRChillerRecords UpdateEMSTrendVariables UpdateEngineDrivenChiller UpdateEvapCooler UpdateEvapFluidCooler UpdateEvaporativeCondenserBasinHeater UpdateEvaporativeCondenserWaterUse UpdateExhaustAbsorberCoolRecords UpdateExhaustAbsorberHeatRecords UpdateExhaustAirFlows UpdateFan UpdateFinalSurfaceHeatBalance UpdateFluidCooler UpdateFluidHeatExchanger UpdateFuelCellGeneratorRecords UpdateGasAbsorberCoolRecords UpdateGasAbsorberHeatRecords UpdateGSHPRecords UpdateGSHPRecords UpdateGSHPRecords UpdateGTChillerRecords UpdateHalfLoopInletTemp UpdateHeatBalHAMT UpdateHeatingCoil UpdateHeatRecovery UpdateHighTempRadiantSystem UpdateHistories UpdateHistory UpdateHTRadSourceValAvg UpdateHumidifier UpdateHVACInterface UpdateHWBaseboard UpdateHWBaseboardPlantConnection UpdateIceFractions UpdateICEngineGeneratorRecords UpdateIndirectAbsorberRecords UpdateInternalGainValues UpdateIrrigation UpdateLoadCenterRecords UpdateLoopSideReportVars UpdateLowTempRadiantSystem UpdateMeterReporting UpdateMeters UpdateMeterValues UpdateMicroCHPGeneratorRecords UpdateMinMax UpdateMixedAirSetPoints UpdateMoistureBalanceEMPD UpdateMoistureBalanceFD UpdateMSHeatPump UpdateMTGeneratorRecords UpdateNode UpdateNodeThermalHistory UpdateOAController UpdateOAMixer UpdateOAPretreatSetPoints UpdatePipesHeatTransfer UpdatePipingSystems UpdatePlantLoopInterface UpdatePlantMixer UpdatePlantProfile UpdatePlantSplitter UpdatePlantValves UpdatePondGroundHeatExchanger UpdatePrecipitation UpdatePressureDrop UpdatePurchasedAir UpdatePVTcollectors UpdateRadSysSourceValAvg UpdateRecords UpdateReformEIRChillerRecords UpdateRefrigCondenser UpdateReportWaterSystem UpdateRootFinder UpdateScheduleValues UpdateSetPointManagers UpdateSimpleWatertoAirHP UpdateSoilProps UpdateSolarCollector UpdateSplitter UpdateSQLiteErrorRecord UpdateSQLiteErrorRecord UpdateSQLiteSimulationRecord UpdateSQLiteSimulationRecord UpdateSteamBaseboard UpdateSteamBaseboardPlantConnection UpdateSteamCoil UpdateSurfaceGroundHeatExchngr UpdateSys UpdateSysSizing UpdateSystemOutputRequired UpdateTabularReports UpdateTEStorage UpdateThermalHistories UpdateTowers UpdateTranspiredCollector UpdateUnitarySystemControl UpdateUtilityBills UpdateVarSpeedCoil UpdateVentilatedSlab UpdateVerticalGroundHeatExchanger UpdateVRFCondenser UpdateWaterCoil UpdateWaterConnections UpdateWaterManager UpdateWaterSource UpdateWaterThermalTank UpdateWaterToAirCoilPlantConnection UpdateWatertoAirHP UpdateWeatherData UpdateWholeBuildingRecords UpdateZoneAirLoopEquipment UpdateZoneCompPtrArray UpdateZoneDehumidifier UpdateZoneEquipment UpdateZoneInletConvergenceLog UpdateZoneListAndGroupLoads UpdateZoneSizing UpdateZoneSubCompPtrArray UpdateZoneSubSubCompPtrArray ValidateAndSetSysAvailabilityManagerType ValidateComponent ValidateDistributionSystem ValidateEMSProgramName ValidateEMSVariableName ValidateExhaustFanInput ValidateFlowControlPaths ValidateFuelType ValidateIndexType ValidateMaterialRoughness ValidateMonthDay ValidateNStandardizeMeterTitles ValidateObjectandParse ValidatePipeConstruction ValidatePLFCurve ValidateSection ValidateSectionsInput ValidateVariableType value_to_vector ValueToString VAVVSCoolingResidual VAVVSHCFanOnResidual VAVVSHWFanOnResidual VAVVSHWNoFanResidual VB_CriticalSlatAngle VB_DIFF VB_LWP VB_ShadeControl VB_SLAT_RADIUS_RATIO VB_SOL4 VB_SOL46_CURVE VB_SOL6 VB_SWP vec2d_cross_product vec2d_dot_product vec_cross_product vec_dot_product VecLength VecNegate VecNormalize VecRound VecSquaredLength vector_add vector_div_int vector_div_real vector_subtract vector_times_int vector_times_real vector_to_array VerifyControlledZoneForThermostat VerifyCustomMetersElecPowerMgr VerifyHeatExchangerParent VerifyName VerifySetPointManagers VerifyThermostatInZone VerifyUniqueBaseboardName VerifyUniqueBoilerName VerifyUniqueChillerName VerifyUniqueCoilName ViewFac VisibleSprectrumAverage Volume VRMLOut VSCoilCyclingHumResidual VSCoilCyclingResidual VSCoilCyclingResidual VSCoilSpeedHumResidual VSCoilSpeedResidual VSCoilSpeedResidual VSEvapUnitLoadResidual VSHPCyclingResidual VSHPCyclingResidual VSHPSpeedResidual VSHPSpeedResidual VSMerkelResidual W5InitGlassParameters W5LsqFit W5LsqFit2 W6CoordsFromWorldVect warnIfNativeVarname WetCoilOutletCondition WhichCompSet WhichParentCompSet WhichParentSet Width WindowGapAirflowControl WindowGasConductance WindowGasPropertiesAtTemp WindowHeatBalanceEquations WindowScheduledSolarAbs WindowShadingManager WindowTempsForNominalCond WindSpeedAt Windward WorldVectFromW6 WriteAdaptiveComfortTable WriteAirLoopStatistics WriteBEPSTable WriteCompCostTable WriteComponentSizing WriteCumulativeReportMeterData WriteDaylightMapTitle WriteDemandEndUseSummary WriteInputArguments WriteIntegerData WriteIntegerVariableOutput WriteMeterDictionaryItem WriteModifiedArguments WriteMonthlyTables WriteOutputArguments WriteOutputEN673 WritePoint WritePredefinedTables WriteRealData WriteRealVariableOutput WriteReportHeaders WriteReportIntegerData WriteReportMeterData WriteReportRealData WriteReportVariableDictionaryItem WriteRootFinderStatus WriteRootFinderTrace WriteRootFinderTraceHeader WriteSourceEnergyEndUseSummary writeSubtitle WriteSurfaceShadowing WriteTable WriteTableOfContents WriteTabularLifeCycleCostReport WriteTabularReports WriteTabularTariffReports WriteTARCOGInputFile writeTextLine WriteTimeBinTables WriteTimeStampFormatData WriteTrace WriteVeriSumTable WriteZoneLoadComponentTable WVDC XNormalArea XYRectangle XZRectangle YNormalArea YZRectangle ZeroHVACValues ZNormalArea