SUBROUTINE SetupComplexFenestrationStateInput(ConstrNum,ErrorsFound)
! SUBROUTINE INFORMATION:
! AUTHOR B. Griffith
! DATE WRITTEN June 2010
! MODIFIED January 2012 (Simon Vidanovic)
! MODIFIED May 2012 (Simon Vidanovic)
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! get input for complex fenestration construction
! METHODOLOGY EMPLOYED:
! usual GetInput processing. Matrix input from MatrixDataManager
! REFERENCES:
! na
! USE STATEMENTS:
USE DataIPShortCuts
USE InputProcessor, ONLY: GetObjectDefMaxArgs
USE MatrixDataManager
USE DataBSDFWindow
USE General, ONLY : RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
Integer, Intent(InOut) :: ConstrNum ! num of construction items thus far
Logical, Intent(InOut) :: ErrorsFound
! SUBROUTINE PARAMETER DEFINITIONS:
character(len=*), parameter :: RoutineName = 'SetupComlexFenestrationStateInput: '
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
!The following moved to DataBSDFWindow module:
!INTEGER :: TotComplexFenStates ! Number of complex fenestration construction definitions
INTEGER :: I !do loop index
INTEGER :: Loop ! do loop counter
INTEGER :: NumAlphas ! Number of Alphas for each GetObjectItem call
INTEGER :: NumNumbers ! Number of Numbers for each GetObjectItem call
INTEGER :: TotalArgs ! Number of fields for each GetObjectItem call
INTEGER :: IOStatus ! Used in GetObjectItem
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
INTEGER :: iMatGlass ! number of glass layers
INTEGER :: NumRows ! temporary size of matrix
INTEGER :: NumCols ! temporary size of matrix
INTEGER :: NBasis !temporary number of elements in basis
INTEGER :: Layer ! loop counter for material layers
INTEGER :: AlphaIndex
INTEGER :: ThConstNum !number of thermal construction
INTEGER :: ThermalModelNum ! number of thermal model parameters object
integer :: NumOfTotalLayers ! total number of layers in the construction
integer :: NumOfOpticalLayers ! number of optical layers in the construction (excluding gasses and gas mixtures)
integer :: currentOpticalLayer ! current optical layer number. This is important since optical structures should
! be loaded only with optical layers
! When reading Construction:ComplexFenestrationState, there is a call of GetMatrix2D which also uses same
! variables from DataIPShortCuts. Since this can cause some errors in reading, it is important
! to declare local variables for reading Construction:ComplexFenestrationState object(s)
character(len=MaxNameLength+40), allocatable, dimension(:) :: locAlphaFieldNames
character(len=MaxNameLength+40), allocatable, dimension(:) :: locNumericFieldNames
logical, allocatable, dimension(:) :: locNumericFieldBlanks
logical, allocatable, dimension(:) :: locAlphaFieldBlanks
character(len=MaxNameLength), allocatable, dimension(:) :: locAlphaArgs
real(r64), allocatable, dimension(:) :: locNumericArgs
character(len=MaxNameLength) :: locCurrentModuleObject
!Reading WindowThermalModel:Params
cCurrentModuleObject = 'WindowThermalModel:Params'
TotThermalModels = GetNumObjectsFound(cCurrentModuleObject)
ALLOCATE(WindowThermalModel(TotThermalModels))
DO Loop = 1, TotThermalModels
CALL GetObjectItem(cCurrentModuleObject, Loop, cAlphaArgs, NumAlphas, rNumericArgs, NumNumbers , IOStatus, &
NumBlank=lNumericFieldBlanks,AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames )
IsNotOK=.FALSE.
IsBlank=.FALSE.
CALL VerifyName(cAlphaArgs(1), WindowThermalModel%Name, TotThermalModels - 1, IsNotOK, IsBlank, &
TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
CYCLE
ENDIF
WindowThermalModel(Loop)%Name = cAlphaArgs(1)
WindowThermalModel(Loop)%SDScalar = rNumericArgs(1)
IF((rNumericArgs(1) < 0.0d0).or.(rNumericArgs(1) > 1.0d0)) THEN
ErrorsFound = .true.
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//', object. Illegal value for '// &
TRIM(cNumericFieldNames(1))//' has been found.')
CALL ShowContinueError(TRIM(cNumericFieldNames(1))//' should be >= 0.0 and <= 1.0, entered value = '// &
TRIM(RoundSigDigits(rNumericArgs(1),2)))
END IF
SELECT CASE (cAlphaArgs(2))
CASE ('ISO15099')
WindowThermalModel(Loop)%CalculationStandard = csISO15099
CASE ('EN673DECLARED')
WindowThermalModel(Loop)%CalculationStandard = csEN673Declared
CASE ('EN673DESIGN')
WindowThermalModel(Loop)%CalculationStandard = csEN673Design
CASE DEFAULT
ErrorsFound = .true.
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//', object. Illegal value for '// &
TRIM(cAlphaFieldNames(2))//' has been found.')
CALL ShowContinueError(TRIM(cAlphaFieldNames(2))//' entered value = "'//TRIM(cAlphaArgs(2))// &
'" should be ISO15099, EN673Declared or EN673Design.')
END SELECT
SELECT CASE (cAlphaArgs(3))
CASE ('ISO15099')
WindowThermalModel(Loop)%ThermalModel = tmISO15099
CASE ('SCALEDCAVITYWIDTH')
WindowThermalModel(Loop)%ThermalModel = tmScaledCavityWidth
CASE ('CONVECTIVESCALARMODEL_NOSDTHICKNESS')
WindowThermalModel(Loop)%ThermalModel = tmConvectiveScalarModel_NoSDThickness
CASE ('CONVECTIVESCALARMODEL_WITHSDTHICKNESS')
WindowThermalModel(Loop)%ThermalModel = tmConvectiveScalarModel_WithSDThickness
CASE DEFAULT
ErrorsFound = .true.
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//', object. Illegal value for '// &
TRIM(cAlphaFieldNames(3))//' has been found.')
CALL ShowContinueError(trim(cAlphaFieldNames(3))//' entered value = "'//TRIM(cAlphaArgs(3))// &
'" should be ISO15099, ScaledCavityWidth, ConvectiveScalarModel_NoSDThickness or ConvectiveScalarModel_WithSDThickness.')
END SELECT
SELECT CASE (cAlphaArgs(4))
CASE('NODEFLECTION')
WindowThermalModel(Loop)%DeflectionModel = dmNoDeflection
CASE('TEMPERATUREANDPRESSUREINPUT')
WindowThermalModel(Loop)%DeflectionModel = dmTemperatureAndPressureInput
CASE('MEASUREDDEFLECTION')
WindowThermalModel(Loop)%DeflectionModel = dmMeasuredDeflection
CASE DEFAULT
ErrorsFound = .true.
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//', object. Illegal value for '// &
TRIM(cAlphaFieldNames(4))//' has been found.')
CALL ShowContinueError(trim(cAlphaFieldNames(4))//' entered value = "'//TRIM(cAlphaArgs(4))// &
'" should be NoDeflection, TemperatureAndPressureInput or MeasuredDeflection.')
END SELECT
if (WindowThermalModel(Loop)%DeflectionModel == dmTemperatureAndPressureInput) then
WindowThermalModel(Loop)%VacuumPressureLimit = rNumericArgs(2)
IF(rNumericArgs(2) <= 0.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//', object. Illegal value for '// &
TRIM(cNumericFieldNames(2))//' has been found.')
CALL ShowContinueError(trim(cNumericFieldNames(2))//' must be > 0, entered value = '// &
TRIM(RoundSigDigits(rNumericArgs(2),2)))
END IF
WindowThermalModel(Loop)%InitialTemperature = rNumericArgs(3)
IF(rNumericArgs(3) <= 0.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//', object. Illegal value for '// &
TRIM(cNumericFieldNames(3))//' has been found.')
CALL ShowContinueError(trim(cNumericFieldNames(3))//' must be > 0, entered value = '// &
TRIM(RoundSigDigits(rNumericArgs(3),2)))
END IF
WindowThermalModel(Loop)%InitialPressure = rNumericArgs(4)
IF(rNumericArgs(4) <= 0.0d0) THEN
ErrorsFound = .true.
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//', object. Illegal value for '// &
TRIM(cNumericFieldNames(4))//' has been found.')
CALL ShowContinueError(trim(cNumericFieldNames(4))//' must be > 0, entered value = '// &
TRIM(RoundSigDigits(rNumericArgs(4),2)))
END IF
end if
END DO !DO Loop = 1, TotThermalModels
!Reading Construction:ComplexFenestrationState
locCurrentModuleObject = 'Construction:ComplexFenestrationState'
TotComplexFenStates = GetNumObjectsFound(locCurrentModuleObject)
call GetObjectDefMaxArgs(locCurrentModuleObject, TotalArgs, NumAlphas, NumNumbers)
if (.not. allocated(locAlphaFieldNames)) allocate(locAlphaFieldNames(NumAlphas))
if (.not. allocated(locNumericFieldNames)) allocate(locNumericFieldNames(NumNumbers))
if (.not. allocated(locNumericFieldBlanks)) allocate(locNumericFieldBlanks(NumNumbers))
if (.not. allocated(locAlphaFieldBlanks)) allocate(locAlphaFieldBlanks(NumAlphas))
if (.not. allocated(locAlphaArgs)) allocate(locAlphaArgs(NumAlphas))
if (.not. allocated(locNumericArgs)) allocate(locNumericArgs(NumNumbers))
FirstBSDF=ConstrNum+1 ! Location of first BSDF construction input (They will be consecutive)
DO Loop = 1, TotComplexFenStates
CALL GetObjectItem(locCurrentModuleObject, Loop, locAlphaArgs, NumAlphas, locNumericArgs, NumNumbers , IOStatus, &
NumBlank=locNumericFieldBlanks,AlphaFieldnames=locAlphaFieldNames,NumericFieldNames=locNumericFieldNames )
ConstrNum = ConstrNum + 1
IsNotOK=.FALSE.
IsBlank=.FALSE.
CALL VerifyName(locAlphaArgs(1), Construct%Name, ConstrNum - 1, IsNotOK, IsBlank, TRIM(locCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
CYCLE
ENDIF
!Glass layer counter
iMatGlass = 0
!Simon TODO: This is to be confirmed. If this is just initial value, then we might want to make better guess
NominalRforNominalUCalculation(ConstrNum) = 0.1d0
!Simon TODO: If I do not put this, then it is considered that surface is NOT window
Construct(ConstrNum)%TransDiff = 0.1d0 !This is a place holder to flag
!the construction as a window until
!the correct value is entered in WindowComplexManager
!Now override the deraults as appropriate
Construct(ConstrNum)%Name = locAlphaArgs(1)
! ALLOCATE(Construct(ConstrNum)%BSDFInput)
!Construct(ConstrNum)%BSDFInput%ThermalConstruction = ThConstNum
SELECT CASE (locAlphaArgs(2)) ! Basis Type Keyword
CASE ('LBNLWINDOW')
Construct(ConstrNum)%BSDFInput%BasisType = BasisType_WINDOW
CASE ('USERDEFINED')
Construct(ConstrNum)%BSDFInput%BasisType = BasisType_Custom
CASE DEFAULT
! throw error
ErrorsFound=.true.
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//', object. Illegal value for '// &
TRIM(locAlphaFieldNames(2))//' has been found.')
CALL ShowContinueError(TRIM(locAlphaFieldNames(2))//' entered value="'//TRIM(locAlphaArgs(2))// &
'" should be LBNLWindow or UserDefined.')
END SELECT
SELECT CASE (locAlphaArgs(3)) ! Basis Symmetry Keyword
CASE ('AXISYMMETRIC')
Construct(ConstrNum)%BSDFInput%BasisSymmetryType = BasisSymmetry_Axisymmetric
CASE ('NONE')
Construct(ConstrNum)%BSDFInput%BasisSymmetryType = BasisSymmetry_None
CASE DEFAULT
! throw error
ErrorsFound=.true.
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//', object. Illegal value for '// &
TRIM(locAlphaFieldNames(3))//' has been found.')
CALL ShowContinueError(trim(locAlphaFieldNames(3))//' entered value = "'//TRIM(locAlphaArgs(3))// &
'" should be Axisymmetric or None.')
END SELECT
!Simon: Assign thermal model number
ThermalModelNum = FindIteminList(locAlphaArgs(4), WindowThermalModel%Name, TotThermalModels)
IF (ThermalModelNum == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//', object. Illegal value for '// &
TRIM(locAlphaFieldNames(4))//' has been found.')
CALL ShowContinueError(trim(locAlphaFieldNames(4))//' entered value = "'//TRIM(locAlphaArgs(4))// &
'" no corresponding thermal model (WindowThermalModel:Params) found in the input file.')
ELSE
Construct(ConstrNum)%BSDFInput%ThermalModel = ThermalModelNum
ENDIF
! ***************************************************************************************
! Basis matrix
! ***************************************************************************************
Construct(ConstrNum)%BSDFInput%BasisMatIndex = MatrixIndex(locAlphaArgs(5))
CALL Get2DMatrixDimensions(Construct(ConstrNum)%BSDFInput%BasisMatIndex, NumRows, NumCols)
Construct(ConstrNum)%BSDFInput%BasisMatNrows=NumRows
Construct(ConstrNum)%BSDFInput%BasisMatNcols=NumCols
IF (NumCols /= 2 .AND. NumCols /= 1) THEN
ErrorsFound=.true.
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//', object. Illegal value for '// &
TRIM(locAlphaFieldNames(5))//' has been found.')
CALL ShowContinueError(trim(locAlphaFieldNames(5))//' entered value="'//TRIM(locAlphaArgs(5))// &
'" invalid matrix dimensions. Basis matrix dimension can only be 2 x 1.')
END IF
ALLOCATE (Construct(ConstrNum)%BSDFInput%BasisMat( NumRows, NumCols) )
CALL Get2DMatrix(Construct(ConstrNum)%BSDFInput%BasisMatIndex, Construct(ConstrNum)%BSDFInput%BasisMat)
IF( Construct(ConstrNum)%BSDFInput%BasisType == BasisType_WINDOW ) &
CALL CalculateBasisLength ( Construct(ConstrNum)%BSDFInput, ConstrNum , Construct(ConstrNum)%BSDFInput%NBasis )
!determine number of layers and optical layers
NumOfTotalLayers = (NumAlphas - 9)/3
Construct(ConstrNum)%TotLayers = NumOfTotalLayers
NumOfOpticalLayers = NumOfTotalLayers/2 + 1
Construct(ConstrNum)%BSDFInput%NumLayers = NumOfOpticalLayers
ALLOCATE(Construct(ConstrNum)%BSDFInput%Layer(NumOfOpticalLayers))
! check for incomplete field set
IF (Mod((NumAlphas - 9), 3) /= 0) Then
!throw warning if incomplete field set
ErrorsFound = .true.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//', object.'// &
' Incomplete field set found.')
CALL ShowContinueError(TRIM(locAlphaArgs(1))//' is missing some of the layers or/and gaps.')
ENDIF
IF ( Construct(ConstrNum)%BSDFInput%BasisSymmetryType == BasisSymmetry_None ) THEN
!Non-Symmetric basis
NBasis=Construct(ConstrNum)%BSDFInput%NBasis
! *******************************************************************************
! Solar front transmittance
! *******************************************************************************
Construct(ConstrNum)%BSDFInput%SolFrtTransIndex = MatrixIndex(locAlphaArgs(6))
CALL Get2DMatrixDimensions(Construct(ConstrNum)%BSDFInput%SolFrtTransIndex, NumRows, NumCols)
Construct(ConstrNum)%BSDFInput%SolFrtTransNrows=NumRows
Construct(ConstrNum)%BSDFInput%SolFrtTransNcols=NumCols
IF (NumRows /= NBasis) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//', object.'// &
' Illegal matrix size has been found.')
CALL ShowContinueError('Solar front transmittance matrix "'//TRIM(locAlphaArgs(6))//'" is not the same size'// &
' as it is defined by basis definition. Basis size is defined by Matrix:TwoDimension = "'// &
TRIM(locAlphaArgs(5))//'".')
ENDIF
IF (NumRows /= NumCols) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//'", object.'// &
' Invalid BSDF matrix dimensions.')
CALL ShowContinueError('Solar front transmittance matrix "'//TRIM(locAlphaArgs(6))//'" must have'// &
' the same number of rows and columns.')
END IF
IF ( Construct(ConstrNum)%BSDFInput%BasisType == BasisType_Custom ) THEN
Construct(ConstrNum)%BSDFInput%NBasis =NumRows ! For custom basis, no rows in transmittance
! matrix defines the basis length
ENDIF
ALLOCATE (Construct(ConstrNum)%BSDFInput%SolFrtTrans( NumRows, NumCols) )
IF (Construct(ConstrNum)%BSDFInput%SolFrtTransIndex == 0) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//', object.'// &
' Referenced Matrix:TwoDimension is missing from the input file.')
CALL ShowContinueError('Solar front transmittance Matrix:TwoDimension = "'//TRIM(locAlphaArgs(6))// &
'" is missing from the input file.')
ELSE
CALL Get2DMatrix(Construct(ConstrNum)%BSDFInput%SolFrtTransIndex, Construct(ConstrNum)%BSDFInput%SolFrtTrans)
END IF
! *******************************************************************************
! Solar back reflectance
! *******************************************************************************
Construct(ConstrNum)%BSDFInput%SolBkReflIndex = MatrixIndex(locAlphaArgs(7))
CALL Get2DMatrixDimensions(Construct(ConstrNum)%BSDFInput%SolBkReflIndex, NumRows, NumCols)
Construct(ConstrNum)%BSDFInput%SolBkReflNrows=NumRows
Construct(ConstrNum)%BSDFInput%SolBkReflNcols=NumCols
IF (NumRows /= NBasis) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//', object.'// &
' Illegal matrix size has been found.')
CALL ShowContinueError('Solar back reflectance matrix "'//TRIM(locAlphaArgs(7))//'" is not the same size'// &
' as it is defined by basis definition. Basis size is defined by Matrix:TwoDimension = "'// &
TRIM(locAlphaArgs(5))//'".')
ENDIF
IF (NumRows /= NumCols) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//'", object.'// &
' Invalid BSDF matrix dimensions.')
CALL ShowContinueError('Solar bakc reflectance matrix "'//TRIM(locAlphaArgs(7))//'" must have'// &
' the same number of rows and columns.')
END IF
ALLOCATE (Construct(ConstrNum)%BSDFInput%SolBkRefl( NumRows, NumCols) )
IF (Construct(ConstrNum)%BSDFInput%SolBkReflIndex == 0) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//', object.'// &
' Referenced Matrix:TwoDimension is missing from the input file.')
CALL ShowContinueError('Solar back reflectance Matrix:TwoDimension = "'//TRIM(locAlphaArgs(7))// &
'" is missing from the input file.')
ELSE
CALL Get2DMatrix(Construct(ConstrNum)%BSDFInput%SolBkReflIndex, Construct(ConstrNum)%BSDFInput%SolBkRefl)
END IF
! *******************************************************************************
! Visible front transmittance
! *******************************************************************************
Construct(ConstrNum)%BSDFInput%VisFrtTransIndex = MatrixIndex(locAlphaArgs(8))
CALL Get2DMatrixDimensions(Construct(ConstrNum)%BSDFInput%VisFrtTransIndex, NumRows, NumCols)
Construct(ConstrNum)%BSDFInput%VisFrtTransNrows=NumRows
Construct(ConstrNum)%BSDFInput%VisFrtTransNcols=NumCols
IF (NumRows /= NBasis) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//', object.'// &
' Illegal matrix size has been found.')
CALL ShowContinueError('Visible front transmittance matrix "'//TRIM(locAlphaArgs(8))//'" is not the same size'// &
' as it is defined by basis definition. Basis size is defined by Matrix:TwoDimension = "'// &
TRIM(locAlphaArgs(5))//'".')
ENDIF
IF (NumRows /= NumCols) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//'", object.'// &
' Invalid BSDF matrix dimensions.')
CALL ShowContinueError('Visible front transmittance matrix "'//TRIM(locAlphaArgs(8))//'" must have'// &
' the same number of rows and columns.')
END IF
ALLOCATE (Construct(ConstrNum)%BSDFInput%VisFrtTrans( NumRows, NumCols) )
IF (Construct(ConstrNum)%BSDFInput%VisFrtTransIndex == 0) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//', object.'// &
' Referenced Matrix:TwoDimension is missing from the input file.')
CALL ShowContinueError('Visible front transmittance Matrix:TwoDimension = "'//TRIM(locAlphaArgs(8))// &
'" is missing from the input file.')
ELSE
CALL Get2DMatrix(Construct(ConstrNum)%BSDFInput%VisFrtTransIndex, Construct(ConstrNum)%BSDFInput%VisFrtTrans)
END IF
! *******************************************************************************
! Visible back reflectance
! *******************************************************************************
Construct(ConstrNum)%BSDFInput%VisBkReflIndex = MatrixIndex(locAlphaArgs(9))
CALL Get2DMatrixDimensions(Construct(ConstrNum)%BSDFInput%VisBkReflIndex, NumRows, NumCols)
Construct(ConstrNum)%BSDFInput%VisBkReflNrows=NumRows
Construct(ConstrNum)%BSDFInput%VisBkReflNcols=NumCols
IF (NumRows /= NBasis) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//', object.'// &
' Illegal matrix size has been found.')
CALL ShowContinueError('Visible back reflectance matrix "'//TRIM(locAlphaArgs(9))//'" is not the same size'// &
' as it is defined by basis definition. Basis size is defined by Matrix:TwoDimension = "'// &
TRIM(locAlphaArgs(5))//'".')
ENDIF
IF (NumRows /= NumCols) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//'", object.'// &
' Invalid BSDF matrix dimensions.')
CALL ShowContinueError('Visible back reflectance "'//TRIM(locAlphaArgs(9))//'" must have'// &
' the same number of rows and columns.')
END IF
ALLOCATE (Construct(ConstrNum)%BSDFInput%VisBkRefl( NumRows, NumCols) )
IF (Construct(ConstrNum)%BSDFInput%VisBkReflIndex == 0) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//', object.'// &
' Referenced Matrix:TwoDimension is missing from the input file.')
CALL ShowContinueError('Visble back reflectance Matrix:TwoDimension = "'//TRIM(locAlphaArgs(9))// &
'" is missing from the input file.')
ELSE
CALL Get2DMatrix(Construct(ConstrNum)%BSDFInput%VisBkReflIndex, Construct(ConstrNum)%BSDFInput%VisBkRefl )
END IF
!ALLOCATE(Construct(ConstrNum)%BSDFInput%Layer(NumOfOpticalLayers))
DO layer = 1, Construct(ConstrNum)%TotLayers
AlphaIndex = 9 + (layer * 3) - 2
currentOpticalLayer = int(layer/2) + 1
!Material info is contained in the thermal construct
Construct(ConstrNum)%LayerPoint(Layer) = FindIteminList(locAlphaArgs(AlphaIndex),Material%Name,TotMaterials)
!Simon: Load only if optical layer
if (Mod(Layer, 2) /= 0) then
Construct(ConstrNum)%BSDFInput%Layer(currentOpticalLayer)%MaterialIndex = Construct(ConstrNum)%LayerPoint(Layer)
AlphaIndex = AlphaIndex + 1
! *******************************************************************************
! Front absorptance matrix
! *******************************************************************************
Construct(ConstrNum)%BSDFInput%Layer(currentOpticalLayer)%FrtAbsIndex = MatrixIndex(locAlphaArgs(AlphaIndex))
CALL Get2DMatrixDimensions(Construct(ConstrNum)%BSDFInput%Layer(currentOpticalLayer)%FrtAbsIndex, NumRows, NumCols)
IF (NumRows /= 1) THEN
ErrorsFound=.true.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//' = "'//TRIM(locAlphaArgs(1))//'", object.' &
//' Incorrect matrix dimension.')
CALL ShowContinueError('Front absorbtance Matrix:TwoDimension = "'//TRIM(locAlphaArgs(AlphaIndex))// &
'" for layer '//TRIM(RoundSigDigits(currentOpticalLayer))//' must have only one row.')
END IF
IF (NumCols /= NBasis) THEN
ErrorsFound=.true.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//' = "'//TRIM(locAlphaArgs(1))//'", object.' &
//' Incorrect matrix dimension.')
CALL ShowContinueError('Front absorbtance Matrix:TwoDimension = "'//TRIM(locAlphaArgs(AlphaIndex))// &
'" for layer '//TRIM(RoundSigDigits(currentOpticalLayer))// &
' must have same number of columns as it is defined by basis matrix.')
CALL ShowContinueError('Matrix has '//TRIM(RoundSigDigits(NumCols))//' number of columns, while basis'// &
' definition specifies '//TRIM(RoundSigDigits(NBasis))//' number of columns.')
ENDIF
Construct(ConstrNum)%BSDFInput%Layer(currentOpticalLayer)%AbsNcols=NumCols
ALLOCATE (Construct(ConstrNum)%BSDFInput%Layer(currentOpticalLayer)%FrtAbs( NumRows, NumCols) )
IF (Construct(ConstrNum)%BSDFInput%Layer(currentOpticalLayer)%FrtAbsIndex == 0) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//', object.'// &
' Referenced Matrix:TwoDimension is missing from the input file.')
CALL ShowContinueError('Front absorbtance Matrix:TwoDimension = "'//TRIM(locAlphaArgs(AlphaIndex))// &
'" for layer '//Trim(RoundSigDigits(currentOpticalLayer))//' is missing from the input file.')
ELSE
CALL Get2DMatrix(Construct(ConstrNum)%BSDFInput%Layer(currentOpticalLayer)%FrtAbsIndex, &
Construct(ConstrNum)%BSDFInput%Layer(currentOpticalLayer)%FrtAbs)
END IF
AlphaIndex = AlphaIndex + 1
! *******************************************************************************
! Back absorptance matrix
! *******************************************************************************
Construct(ConstrNum)%BSDFInput%Layer(currentOpticalLayer)%BkAbsIndex = MatrixIndex(locAlphaArgs(AlphaIndex))
CALL Get2DMatrixDimensions(Construct(ConstrNum)%BSDFInput%Layer(currentOpticalLayer)%BkAbsIndex, NumRows, NumCols)
IF (NumRows /= 1) THEN
ErrorsFound=.true.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//' = "'//TRIM(locAlphaArgs(1))//'", object.' &
//' Incorrect matrix dimension.')
CALL ShowContinueError('Back absorbtance Matrix:TwoDimension = "'//TRIM(locAlphaArgs(AlphaIndex))// &
'" for layer '//TRIM(RoundSigDigits(currentOpticalLayer))//' must have only one row.')
END IF
IF (NumCols /= NBasis) THEN
ErrorsFound=.true.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//' = "'//TRIM(locAlphaArgs(1))//'", object.' &
//' Incorrect matrix dimension.')
CALL ShowContinueError('Back absorbtance Matrix:TwoDimension = "'//TRIM(locAlphaArgs(AlphaIndex))// &
'" for layer '//TRIM(RoundSigDigits(currentOpticalLayer))// &
' must have same number of columns as it is defined by basis matrix.')
CALL ShowContinueError('Matrix has '//TRIM(RoundSigDigits(NumCols))//' number of columns, while basis'// &
' definition specifies '//TRIM(RoundSigDigits(NBasis))//' number of columns.')
ENDIF
ALLOCATE (Construct(ConstrNum)%BSDFInput%Layer(currentOpticalLayer)%BkAbs( NumRows, NumCols) )
IF (Construct(ConstrNum)%BSDFInput%Layer(currentOpticalLayer)%BkAbsIndex == 0) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//', object.'// &
' Referenced Matrix:TwoDimension is missing from the input file.')
CALL ShowContinueError('Back absorbtance Matrix:TwoDimension = "'//TRIM(locAlphaArgs(AlphaIndex))// &
'" for layer '//Trim(RoundSigDigits(currentOpticalLayer))//' is missing from the input file.')
ELSE
CALL Get2DMatrix(Construct(ConstrNum)%BSDFInput%Layer(currentOpticalLayer)%BkAbsIndex, &
Construct(ConstrNum)%BSDFInput%Layer(currentOpticalLayer)%BkAbs)
END IF
end if !if (Mod(Layer, 2) <> 0) then
ENDDO
ELSE
!Axisymmetric basis
NBasis=Construct(ConstrNum)%BSDFInput%NBasis !Basis length has already been calculated
ALLOCATE (BSDFTempMtrx( 1 , NBasis))
! *******************************************************************************
! Solar front transmittance
! *******************************************************************************
Construct(ConstrNum)%BSDFInput%SolFrtTransIndex = MatrixIndex(locAlphaArgs(6))
CALL Get2DMatrixDimensions(Construct(ConstrNum)%BSDFInput%SolFrtTransIndex, NumRows, NumCols)
Construct(ConstrNum)%BSDFInput%SolFrtTransNrows=NBasis
Construct(ConstrNum)%BSDFInput%SolFrtTransNcols=NBasis
IF (NumRows /= NBasis) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//', object.'// &
' Illegal matrix size has been found.')
CALL ShowContinueError('Solar front transmittance matrix "'//TRIM(locAlphaArgs(6))//'" is not the same size'// &
' as it is defined by basis definition. Basis size is defined by Matrix:TwoDimension = "'// &
TRIM(locAlphaArgs(5))//'".')
ENDIF
IF (NumRows /= NumCols) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//'", object.'// &
' Invalid BSDF matrix dimensions.')
CALL ShowContinueError('Solar front transmittance matrix "'//TRIM(locAlphaArgs(6))//'" must have'// &
' the same number of rows and columns.')
END IF
ALLOCATE (Construct(ConstrNum)%BSDFInput%SolFrtTrans( NBasis, NBasis) )
IF (Construct(ConstrNum)%BSDFInput%SolFrtTransIndex == 0) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//', object.'// &
' Referenced Matrix:TwoDimension is missing from the input file.')
CALL ShowContinueError('Solar front transmittance Matrix:TwoDimension = "'//TRIM(locAlphaArgs(6))// &
'" is missing from the input file.')
ELSE
CALL Get2DMatrix(Construct(ConstrNum)%BSDFInput%SolFrtTransIndex, BSDFTempMtrx)
Construct(ConstrNum)%BSDFInput%SolFrtTrans = 0.
FORALL (I = 1 : NBasis )
Construct(ConstrNum)%BSDFInput%SolFrtTrans(I , I ) = BSDFTempMtrx(1,I)
END FORALL
END IF
! *******************************************************************************
! Solar back reflectance
! *******************************************************************************
Construct(ConstrNum)%BSDFInput%SolBkReflIndex = MatrixIndex(locAlphaArgs(7))
CALL Get2DMatrixDimensions(Construct(ConstrNum)%BSDFInput%SolBkReflIndex, NumRows, NumCols)
Construct(ConstrNum)%BSDFInput%SolBkReflNrows=NBasis
Construct(ConstrNum)%BSDFInput%SolBkReflNcols=NBasis
IF (NumRows /= NBasis) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//', object.'// &
' Illegal matrix size has been found.')
CALL ShowContinueError('Solar back reflectance matrix "'//TRIM(locAlphaArgs(7))//'" is not the same size'// &
' as it is defined by basis definition. Basis size is defined by Matrix:TwoDimension = "'// &
TRIM(locAlphaArgs(5))//'".')
ENDIF
IF (NumRows /= NumCols) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//'", object.'// &
' Invalid BSDF matrix dimensions.')
CALL ShowContinueError('Solar back reflectance matrix "'//TRIM(locAlphaArgs(7))//'" must have'// &
' the same number of rows and columns.')
END IF
ALLOCATE (Construct(ConstrNum)%BSDFInput%SolBkRefl( NBasis, NBasis) )
IF (Construct(ConstrNum)%BSDFInput%SolBkReflIndex == 0) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//', object.'// &
' Referenced Matrix:TwoDimension is missing from the input file.')
CALL ShowContinueError('Solar back reflectance Matrix:TwoDimension = "'//TRIM(locAlphaArgs(7))// &
'" is missing from the input file.')
ELSE
CALL Get2DMatrix(Construct(ConstrNum)%BSDFInput%SolBkReflIndex, BSDFTempMtrx)
Construct(ConstrNum)%BSDFInput%SolBkRefl = 0.
FORALL (I = 1 : NBasis )
Construct(ConstrNum)%BSDFInput%SolBkRefl(I , I ) = BSDFTempMtrx(1,I)
END FORALL
END IF
! *******************************************************************************
! Visible front transmittance
! *******************************************************************************
Construct(ConstrNum)%BSDFInput%VisFrtTransIndex = MatrixIndex(locAlphaArgs(8))
CALL Get2DMatrixDimensions(Construct(ConstrNum)%BSDFInput%VisFrtTransIndex, NumRows, NumCols)
Construct(ConstrNum)%BSDFInput%VisFrtTransNrows=NBasis
Construct(ConstrNum)%BSDFInput%VisFrtTransNcols=NBasis
IF (NumRows /= NBasis) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//', object.'// &
' Illegal matrix size has been found.')
CALL ShowContinueError('Visible front transmittance matrix "'//TRIM(locAlphaArgs(8))//'" is not the same size'// &
' as it is defined by basis definition. Basis size is defined by Matrix:TwoDimension = "'// &
TRIM(locAlphaArgs(5))//'".')
ENDIF
IF (NumRows /= NumCols) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//'", object.'// &
' Invalid BSDF matrix dimensions.')
CALL ShowContinueError('Visible front transmittance matrix "'//TRIM(locAlphaArgs(8))//'" must have'// &
' the same number of rows and columns.')
END IF
ALLOCATE (Construct(ConstrNum)%BSDFInput%VisFrtTrans( NBasis , NBasis ) )
IF (Construct(ConstrNum)%BSDFInput%VisFrtTransIndex == 0) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//', object.'// &
' Referenced Matrix:TwoDimension is missing from the input file.')
CALL ShowContinueError('Visible front transmittance Matrix:TwoDimension = "'//TRIM(locAlphaArgs(8))// &
'" is missing from the input file.')
ELSE
CALL Get2DMatrix(Construct(ConstrNum)%BSDFInput%VisFrtTransIndex, BSDFTempMtrx)
Construct(ConstrNum)%BSDFInput%VisFrtTrans = 0.
FORALL (I = 1 : NBasis )
Construct(ConstrNum)%BSDFInput%VisFrtTrans(I , I ) = BSDFTempMtrx(1,I)
END FORALL
END IF
! *******************************************************************************
! Visible back reflectance
! *******************************************************************************
Construct(ConstrNum)%BSDFInput%VisBkReflIndex = MatrixIndex(locAlphaArgs(9))
CALL Get2DMatrixDimensions(Construct(ConstrNum)%BSDFInput%VisBkReflIndex, NumRows, NumCols)
Construct(ConstrNum)%BSDFInput%VisBkReflNrows=NBasis
Construct(ConstrNum)%BSDFInput%VisBkReflNcols=NBasis
IF (NumRows /= NBasis) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//', object.'// &
' Illegal matrix size has been found.')
CALL ShowContinueError('Visible back reflectance matrix "'//TRIM(locAlphaArgs(9))//'" is not the same size'// &
' as it is defined by basis definition. Basis size is defined by Matrix:TwoDimension = "'// &
TRIM(locAlphaArgs(5))//'".')
ENDIF
IF (NumRows /= NumCols) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//'", object.'// &
' Invalid BSDF matrix dimensions.')
CALL ShowContinueError('Visible back reflectance matrix "'//TRIM(locAlphaArgs(9))//'" must have'// &
' the same number of rows and columns.')
END IF
ALLOCATE (Construct(ConstrNum)%BSDFInput%VisBkRefl( NBasis , NBasis ) )
IF (Construct(ConstrNum)%BSDFInput%VisBkReflIndex == 0) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//', object.'// &
' Referenced Matrix:TwoDimension is missing from the input file.')
CALL ShowContinueError('Visible back reflectance Matrix:TwoDimension = "'//TRIM(locAlphaArgs(9))// &
'" is missing from the input file.')
ELSE
CALL Get2DMatrix(Construct(ConstrNum)%BSDFInput%VisBkReflIndex, BSDFTempMtrx )
Construct(ConstrNum)%BSDFInput%VisBkRefl = 0.
FORALL (I = 1 : NBasis )
Construct(ConstrNum)%BSDFInput%VisBkRefl(I , I ) = BSDFTempMtrx(1,I)
END FORALL
END IF
!determine number of layers
!Construct(ConstrNum)%TotLayers = (NumAlphas - 9)/3
! check for incomplete field set
!IF (Mod((NumAlphas - 9), 3) /= 0) Then
!throw warning if incomplete field set
! CALL ShowWarningError ('Construction:ComplexFenestrationState: Axisymmetric properties have incomplete field &
! & set')
!ENDIF
!ALLOCATE(Construct(ConstrNum)%BSDFInput%Layer(NumOfOpticalLayers))
DO layer = 1, Construct(ConstrNum)%TotLayers
AlphaIndex = 9 + (layer * 3) - 2
currentOpticalLayer = int(layer/2) + 1
Construct(ConstrNum)%LayerPoint(Layer) = FindIteminList(locAlphaArgs(AlphaIndex),Material%Name,TotMaterials)
if (Mod(Layer, 2) /= 0) then
Construct(ConstrNum)%BSDFInput%Layer(currentOpticalLayer)%MaterialIndex = Construct(ConstrNum)%LayerPoint(Layer)
! *******************************************************************************
! Front absorptance matrix
! *******************************************************************************
AlphaIndex = AlphaIndex + 1
Construct(ConstrNum)%BSDFInput%Layer(currentOpticalLayer)%FrtAbsIndex = MatrixIndex(locAlphaArgs(AlphaIndex))
CALL Get2DMatrixDimensions(Construct(ConstrNum)%BSDFInput%Layer(currentOpticalLayer)%FrtAbsIndex, NumRows, NumCols)
IF (NumRows /= 1) THEN
ErrorsFound=.true.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//' = "'//TRIM(locAlphaArgs(1))//'", object.' &
//' Incorrect matrix dimension.')
CALL ShowContinueError('Front absorbtance Matrix:TwoDimension = "'//TRIM(locAlphaArgs(AlphaIndex))// &
'" for layer '//TRIM(RoundSigDigits(currentOpticalLayer))//' must have only one row.')
END IF
IF (NumCols /= NBasis) THEN
ErrorsFound=.true.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//' = "'//TRIM(locAlphaArgs(1))//'", object.' &
//' Incorrect matrix dimension.')
CALL ShowContinueError('Front absorbtance Matrix:TwoDimension = "'//TRIM(locAlphaArgs(AlphaIndex))// &
'" for layer '//TRIM(RoundSigDigits(currentOpticalLayer))// &
' must have same number of columns as it is defined by basis matrix.')
CALL ShowContinueError('Matrix has '//TRIM(RoundSigDigits(NumCols))//' number of columns, while basis'// &
' definition specifies '//TRIM(RoundSigDigits(NBasis))//' number of columns.')
ENDIF
Construct(ConstrNum)%BSDFInput%Layer(currentOpticalLayer)%AbsNcols=NumCols
ALLOCATE (Construct(ConstrNum)%BSDFInput%Layer(currentOpticalLayer)%FrtAbs( NumRows, NumCols) )
IF (Construct(ConstrNum)%BSDFInput%Layer(currentOpticalLayer)%FrtAbsIndex == 0) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//', object.'// &
' Referenced Matrix:TwoDimension is missing from the input file.')
CALL ShowContinueError('Front absorbtance Matrix:TwoDimension = "'//TRIM(locAlphaArgs(AlphaIndex))// &
'" for layer '//Trim(RoundSigDigits(currentOpticalLayer))//' is missing from the input file.')
ELSE
CALL Get2DMatrix(Construct(ConstrNum)%BSDFInput%Layer(currentOpticalLayer)%FrtAbsIndex, &
Construct(ConstrNum)%BSDFInput%Layer(currentOpticalLayer)%FrtAbs)
END IF
! *******************************************************************************
! Back absorptance matrix
! *******************************************************************************
AlphaIndex = AlphaIndex + 1
Construct(ConstrNum)%BSDFInput%Layer(currentOpticalLayer)%BkAbsIndex = MatrixIndex(locAlphaArgs(AlphaIndex))
CALL Get2DMatrixDimensions(Construct(ConstrNum)%BSDFInput%Layer(currentOpticalLayer)%BkAbsIndex, NumRows, NumCols)
IF (NumRows /= 1) THEN
ErrorsFound=.true.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//' = "'//TRIM(locAlphaArgs(1))//'", object.' &
//' Incorrect matrix dimension.')
CALL ShowContinueError('Back absorbtance Matrix:TwoDimension = "'//TRIM(locAlphaArgs(AlphaIndex))// &
'" for layer '//TRIM(RoundSigDigits(currentOpticalLayer))//' must have only one row.')
END IF
IF (NumCols /= NBasis) THEN
ErrorsFound=.true.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//' = "'//TRIM(locAlphaArgs(1))//'", object.' &
//' Incorrect matrix dimension.')
CALL ShowContinueError('Back absorbtance Matrix:TwoDimension = "'//TRIM(locAlphaArgs(AlphaIndex))// &
'" for layer '//TRIM(RoundSigDigits(currentOpticalLayer))// &
' must have same number of columns as it is defined by basis matrix.')
CALL ShowContinueError('Matrix has '//TRIM(RoundSigDigits(NumCols))//' number of columns, while basis'// &
' definition specifies '//TRIM(RoundSigDigits(NBasis))//' number of columns.')
ENDIF
ALLOCATE (Construct(ConstrNum)%BSDFInput%Layer(currentOpticalLayer)%BkAbs( NumRows, NumCols) )
IF (Construct(ConstrNum)%BSDFInput%Layer(currentOpticalLayer)%BkAbsIndex == 0) THEN
ErrorsFound = .TRUE.
CALL ShowSevereError(RoutineName//TRIM(locCurrentModuleObject)//'="'//TRIM(locAlphaArgs(1))//', object.'// &
' Referenced Matrix:TwoDimension is missing from the input file.')
CALL ShowContinueError('Back absorbtance Matrix:TwoDimension = "'//TRIM(locAlphaArgs(AlphaIndex))// &
'" for layer '//Trim(RoundSigDigits(currentOpticalLayer))//' is missing from the input file.')
ELSE
CALL Get2DMatrix(Construct(ConstrNum)%BSDFInput%Layer(currentOpticalLayer)%BkAbsIndex, &
Construct(ConstrNum)%BSDFInput%Layer(currentOpticalLayer)%BkAbs)
END IF
end if ! if (Mod(Layer, 2) <> 0) then
ENDDO
DEALLOCATE (BSDFTempMtrx )
ENDIF
Construct(ConstrNum)%TypeIsWindow = .TRUE.
Construct(ConstrNum)%WindowTypeBSDF = .TRUE.
ENDDO
! Do not forget to deallocate localy allocated variables
if (allocated(locAlphaFieldNames)) deallocate(locAlphaFieldNames)
if (allocated(locNumericFieldNames)) deallocate(locNumericFieldNames)
if (allocated(locNumericFieldBlanks)) deallocate(locNumericFieldBlanks)
if (allocated(locAlphaFieldBlanks)) deallocate(locAlphaFieldBlanks)
if (allocated(locAlphaArgs)) deallocate(locAlphaArgs)
if (allocated(locNumericArgs)) deallocate(locNumericArgs)
IF (ErrorsFound) CALL ShowFatalError('Error in complex fenestration input.')
RETURN
END SUBROUTINE SetupComplexFenestrationStateInput