SUBROUTINE SearchWindow5DataFile(DesiredFileName,DesiredConstructionName,ConstructionFound,EOFonFile,ErrorsFound)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Winkelmann
! DATE WRITTEN August 2001
! MODIFIED June 2002, FW: do all reallocation here for constructions found on
! data file; 1 new construction of entry has one glazing system;
! 2 new constructions if entry has two glazing systems.
! Nov 2002, FW: skip read of mullion data line if one glazing system;
! add error messages for bad data; increase length of input line
! from 132 to 200 to handle case where Window5 puts in extra blanks
! in gas data line.
! Feb 2007, LKL: Add more checks on Window5DataFile
! Jan 2008, LKL: Change Edge/Cond ratio check.
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Searches the WINDOW5 data file for a window with the name "DesiredConstructionName,"
! which is the name of an idf Construction input using CONSTRUCTION FROM WINDOW5 DATA FILE.
! (The WINDOW5 data file contains data for one or more complete windows --
! glazing, frame, mullion, and divider.
! WINDOW5 writes the data file for export to EnergyPlus so that an annual energy
! analysis can be done on exactly the same window without having to re-input into
! EnergyPlus.)
! If a match is found, a Construction is created and the Material objects associated with
! the Construction are created. If there is an associated frame or
! divider in the Window5 data file for this Construction, a FrameAndDivider object will
! also be created.
! If the window on the data file has two glazing systems, a second Construction (and its
! associated materials) corresponding to the second glazing system is created.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: MakeUPPERcase
USE DataStringGlobals
USE General, ONLY: POLYF,TrimSigDigits ! POLYF ! Polynomial in cosine of angle of incidence
USE DataSystemVariables, ONLY: iASCII_CR, iUnicode_end,GoodIOStatValue,TempFullFileName,CheckForActualFileName
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*),INTENT(IN) :: DesiredFileName ! File name that contains the Window5 constructions.
CHARACTER(len=*),INTENT(IN) :: DesiredConstructionName ! Name that will be searched for in the Window5 data file
LOGICAL, INTENT(OUT) :: ConstructionFound ! True if DesiredConstructionName is in the Window5 data file
LOGICAL, INTENT(INOUT) :: ErrorsFound ! True if there is a problem with the entry requested from the data file
LOGICAL, INTENT(OUT) :: EOFonFile ! True if EOF during file read
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*),PARAMETER :: NumName(5)=(/'1','2','3','4','5'/)
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER, SAVE :: W5DataFileNum
INTEGER :: FileLineCount ! counter for number of lines read (used in some error messages)
CHARACTER(len=200) :: DataLine(100) ! Array of data lines
CHARACTER(len=200) :: NextLine ! Line of data
CHARACTER(len=MaxNameLength) :: WindowNameInW5DataFile, W5Name
CHARACTER(len=10) :: GasName(3) ! Gas name from data file
CHARACTER(len=20) :: LayerName ! Layer name from data file
CHARACTER(len=10) :: MullionOrientation ! Horizontal, vertical or none
INTEGER :: LineNum
INTEGER :: ReadStat ! File read status
INTEGER :: NGlass(2) ! Number of glass layers in glazing system
INTEGER :: NumGases(2,4) ! Number of gases in each gap of a glazing system
INTEGER :: MaterNumSysGlass(2,5) ! Material numbers for glazing system / glass combinations
INTEGER :: MaterNumSysGap(2,4) ! Material numbers for glazing system / gap combinations
INTEGER :: TotMaterialsPrev ! Number of materials before adding ones from W5DataFile
INTEGER :: TotFrameDividerPrev ! Number of FrameAndDivider objects before adding ones from W5DataFile
INTEGER :: NGaps(2) ! Number of gaps in window construction
INTEGER :: NGlSys ! Number of glazing systems (normally 1, but 2 for mullioned window
! with two different glazing systems
INTEGER :: loop ! DO loop counter
INTEGER :: ILine ! Line counter
INTEGER :: ConstrNum ! Construction number
INTEGER :: IGlass ! Glass layer counter
INTEGER :: IGap ! Gap counter
INTEGER :: IGas ! Gas counter
! INTEGER :: ICoeff ! Gas property coefficient counter
INTEGER :: IGlSys ! Glazing system counter
INTEGER :: MaterNum,MatNum ! Material number
INTEGER :: FrDivNum ! FrameDivider number
LOGICAL :: exists ! True if Window5 data file exists
REAL(r64) :: WinHeight(2),WinWidth(2) ! Height, width for glazing system (m)
REAL(r64) :: UValCenter(2) ! Center of glass U-value (W/m2-K) for glazing system
REAL(r64) :: SCCenter(2) ! Center of glass shading coefficient for glazing system
REAL(r64) :: SHGCCenter(2) ! Center of glass solar heat gain coefficient for glazing system
REAL(r64) :: TVisCenter(2) ! Center of glass visible transmittance for glazing system
REAL(r64) :: Tsol(11) ! Solar transmittance vs incidence angle; diffuse trans.
REAL(r64) :: AbsSol(5,11) ! Solar absorptance vs inc. angle in each glass layer
REAL(r64) :: Rfsol(11) ! Front solar reflectance vs inc. angle
REAL(r64) :: Rbsol(11) ! Back solar reflectance vs inc. angle
REAL(r64) :: Tvis(11) ! Visible transmittance vs inc. angle
REAL(r64) :: Rfvis(11) ! Front visible reflectance vs inc. angle
REAL(r64) :: Rbvis(11) ! Back visible reflectance vs inc. angle
REAL(r64) :: CosPhiIndepVar(10) ! Cosine of incidence angle from 0 to 90 deg in 10 deg increments
INTEGER :: IPhi ! Incidence angle counter
REAL(r64) :: Phi ! Incidence angle (deg)
REAL(r64) :: CosPhi ! Cosine of incidence angle
REAL(r64) :: tsolFit(10) ! Fitted solar transmittance vs incidence angle
REAL(r64) :: tvisFit(10) ! Fitted visible transmittance vs incidence angle
REAL(r64) :: rfsolFit(10) ! Fitted solar front reflectance vs incidence angle
REAL(r64) :: solabsFit(10,5) ! Fitted solar absorptance vs incidence angle for each glass layer
INTEGER,EXTERNAL :: GetNewUnitNumber
CHARACTER(len=20) :: DividerType(2) ! Divider type: DividedLite or Suspended
REAL(r64) :: FrameWidth
REAL(r64) :: MullionWidth
REAL(r64) :: FrameProjectionOut
REAL(r64) :: FrameProjectionIn
REAL(r64) :: FrameConductance
REAL(r64) :: FrEdgeToCenterGlCondRatio
REAL(r64) :: FrameSolAbsorp
REAL(r64) :: FrameVisAbsorp
REAL(r64) :: FrameEmis
INTEGER :: HorDividers(2) ! For divider: number horizontal for each glazing system
INTEGER :: VertDividers(2) ! For divider: number vertical for each glazing system
REAL(r64) :: DividerWidth(2)
REAL(r64) :: DividerProjectionOut(2)
REAL(r64) :: DividerProjectionIn(2)
REAL(r64) :: DividerConductance(2)
REAL(r64) :: DivEdgeToCenterGlCondRatio(2)
REAL(r64) :: DividerSolAbsorp(2)
REAL(r64) :: DividerVisAbsorp(2)
REAL(r64) :: DividerEmis(2)
INTEGER :: endcol
LOGICAL :: StripCR
TYPE (FrameDividerProperties), ALLOCATABLE, DIMENSION(:) :: FrameDividerSave
! In the following four gas-related data sets, the first
! index is gas type (1=air, 2=Argon, 3=Krypton, 4=Xenon)
! and the second index gives a,b,c in the expression
! property value = a + bT(K) + cT(K)**2, where T is mean
! gap temperature in deg K.
ConstructionFound = .FALSE.
!ErrorsFound = .FALSE.
EOFonFile = .FALSE.
CALL CheckForActualFileName(DesiredFileName,exists,TempFullFileName)
!INQUIRE(FILE=TRIM(DesiredFileName), EXIST=exists)
IF(.NOT.exists) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: '// &
'Could not locate Window5 Data File, expecting it as file name='//TRIM(DesiredFileName))
CALL ShowContinueError('Certain run environments require a full path to be included with the file name in the input field.')
CALL ShowContinueError('Try again with putting full path and file name in the field.')
CALL ShowFatalError('Program terminates due to these conditions.')
ENDIF
W5DataFileNum = GetNewUnitNumber()
OPEN(UNIT=W5DataFileNum, FILE=TempFullFileName, Action='read', Err=999)
StripCR=.false.
READ(Unit=W5DataFileNum, FMT=fmtA) NextLine
endcol=LEN_TRIM(NextLine)
IF (endcol > 0) THEN
IF (ICHAR(NextLine(endcol:endcol)) == iASCII_CR) THEN
StripCR=.true.
ENDIF
IF (ICHAR(NextLine(endcol:endcol)) == iUnicode_end) THEN
CALL ShowSevereError('SearchWindow5DataFile: For "'//TRIM(DesiredConstructionName)//'" in '//TRIM(DesiredFileName)// &
' fiile, appears to be a Unicode or binary file.')
CALL ShowContinueError('...This file cannot be read by this program. Please save as PC or Unix file and try again')
CALL ShowFatalError('Program terminates due to previous condition.')
ENDIF
ENDIF
REWIND(W5DataFileNum)
FileLineCount=0
READ(W5DataFileNum,fmtA,IOSTAT=ReadStat) NextLine
IF(ReadStat < GoodIOStatValue) GO TO 1000
IF (StripCR) THEN
endcol=LEN_TRIM(NextLine)
IF (endcol > 0) NextLine(endcol:endcol)=Blank
ENDIF
FileLineCount=FileLineCount+1
IF(MakeUPPERCase(NextLine(1:7)) /= 'WINDOW5') THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Error in Data File='//TRIM(DesiredFileName))
CALL ShowFatalError('Error reading Window5 Data File: first word of window entry is "' &
//TRIM(NextLine(1:7))//'", should be Window5.')
END IF
10 DO LineNum = 2,5
READ(W5DataFileNum,'(A)',IOSTAT=ReadStat) DataLine(LineNum)
IF(ReadStat < GoodIOStatValue) GO TO 1000
IF (StripCR) THEN
endcol=LEN_TRIM(DataLine(LineNum))
IF (endcol > 0) DataLine(LineNum)(endcol:endcol)=Blank
ENDIF
FileLineCount=FileLineCount+1
END DO
! Get window name and check for match
READ(Dataline(4)(20:),fmtA) W5Name
WindowNameInW5DataFile = MakeUPPERcase(W5Name)
IF(TRIM(DesiredConstructionName) /= TRIM(WindowNameInW5DataFile)) THEN
! Doesn't match; read through file until next window entry is found
20 READ(W5DataFileNum,fmtA,IOSTAT=ReadStat) NextLine
IF(ReadStat < GoodIOStatValue) GO TO 1000
IF (StripCR) THEN
endcol=LEN_TRIM(NextLine)
IF (endcol > 0) NextLine(endcol:endcol)=Blank
ENDIF
FileLineCount=FileLineCount+1
IF (MakeUPPERCase(NextLine(1:7)) /= 'WINDOW5') GOTO 20
! Beginning of next window entry found
GO TO 10
ELSE
! Match found
ConstructionFound = .TRUE.
! Create Material:WindowGlass, Material:WindowGas, Construction
! and WindowFrameAndDividerObjects for this window
READ(W5DataFileNum,fmtA,IOSTAT=ReadStat) NextLine
IF(ReadStat < GoodIOStatValue) GO TO 1000
IF (StripCR) THEN
endcol=LEN_TRIM(NextLine)
IF (endcol > 0) NextLine(endcol:endcol)=Blank
ENDIF
FileLineCount=FileLineCount+1
READ(NextLine(20:),*) NGlSys
IF(NGlSys <= 0 .OR. NGlSys > 2) THEN
CALL ShowFatalError('Construction='//TRIM(DesiredConstructionName)// &
' from the Window5 data file cannot be used: it has '&
//TRIM(TrimSigDigits(NGlSys))//' glazing systems; only 1 or 2 are allowed.')
END IF
READ(W5DataFileNum,fmtA,IOSTAT=ReadStat) NextLine
IF(ReadStat < GoodIOStatValue) GO TO 1000
IF (StripCR) THEN
endcol=LEN_TRIM(NextLine)
IF (endcol > 0) NextLine(endcol:endcol)=Blank
ENDIF
FileLineCount=FileLineCount+1
DO IGlSys = 1, NGlSys
READ(W5DataFileNum,fmtA,IOSTAT=ReadStat) NextLine
IF(ReadStat < GoodIOStatValue) GO TO 1000
IF (StripCR) THEN
endcol=LEN_TRIM(NextLine)
IF (endcol > 0) NextLine(endcol:endcol)=Blank
ENDIF
FileLineCount=FileLineCount+1
READ(NextLine(20:),*,IOSTAT=ReadStat) WinHeight(IGlSys),WinWidth(IGlSys),NGlass(IGlSys),UvalCenter(IGlSys), &
SCCenter(IGlSys),SHGCCenter(IGlSys),TvisCenter(IGlSys)
IF (ReadStat /= 0) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Error in Read of glazing system values.'// &
' For glazing system='//TRIM(TrimSigDigits(IGlSys)))
CALL ShowContinueError('Line (~'//TRIM(TrimSigDigits(FileLineCount))//') in error (first 100 characters)='// &
TRIM(NextLine(1:100)))
ErrorsFound=.true.
ENDIF
IF(WinHeight(IGlSys) == 0.0d0 .OR. WinWidth(IGlSys) == 0.0d0) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Construction='//TRIM(DesiredConstructionName)// &
' from the Window5 data file cannot be used:'// &
' it has window height or width = 0 for glazing system '//TRIM(TrimSigDigits(IGlSys)))
ErrorsFound = .TRUE.
END IF
IF(NGlass(IGlSys) <= 0 .OR. NGlass(IGlSys) > 4) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Construction='//TRIM(DesiredConstructionName)// &
' from the Window5 data file cannot be used:'// &
' it has 0 or more than 4 glass layers in glazing system '//TRIM(TrimSigDigits(IGlSys)))
ErrorsFound = .TRUE.
END IF
IF( UvalCenter(IGlSys) <= 0.0d0) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Construction='//TRIM(DesiredConstructionName)// &
' from the Window5 data file cannot be used:'// &
' it has Center-of-Glass U-value <= 0 in glazing system '//TRIM(TrimSigDigits(IGlSys)))
ErrorsFound = .TRUE.
END IF
IF(SCCenter(IGlSys) <= 0.0d0) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Construction='//TRIM(DesiredConstructionName)// &
' from the Window5 data file cannot be used:'// &
' it has Shading Coefficient <= 0 in glazing system '//TRIM(TrimSigDigits(IGlSys)))
ErrorsFound = .TRUE.
END IF
IF(SHGCCenter(IGlSys) <= 0.0d0) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Construction='//TRIM(DesiredConstructionName)// &
' from the Window5 data file cannot be used:'// &
' it has SHGC <= 0 in glazing system '//TRIM(TrimSigDigits(IGlSys)))
ErrorsFound = .TRUE.
END IF
WinHeight(IGlSys) = 0.001d0*WinHeight(IGlSys)
WinWidth(IGlSys) = 0.001d0*WinWidth(IGlSys)
END DO
DO LineNum = 1,11
READ(W5DataFileNum,fmtA,IOSTAT=ReadStat) DataLine(LineNum)
IF(ReadStat == -1) GO TO 1000
IF (StripCR) THEN
endcol=LEN_TRIM(DataLine(LineNum))
IF (endcol > 0) DataLine(LineNum)(endcol:endcol)=Blank
ENDIF
END DO
! Mullion width and orientation
MullionWidth = 0.0d0
MullionOrientation = 'Vertical'
IF(NGlSys == 2) THEN
READ(Dataline(10)(20:),*,IOSTAT=ReadStat) MullionWidth
IF (ReadStat /= 0) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Error in Read of Mullion Width.')
CALL ShowContinueError('Line (~'//TRIM(TrimSigDigits(FileLineCount+10))//') in error (first 100 characters)='// &
TRIM(DataLine(10)(1:100)))
ErrorsFound=.true.
ENDIF
MullionWidth = 0.001d0*MullionWidth
READ(Dataline(10)(89:),*,IOSTAT=ReadStat) MullionOrientation
IF (ReadStat /= 0) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Error in Read of Mullion Orientation.')
CALL ShowContinueError('Line (~'//TRIM(TrimSigDigits(FileLineCount+10))//') in error (first 100 characters)='// &
TRIM(DataLine(10)(1:100)))
ErrorsFound=.true.
ENDIF
END IF
! Frame data; if there are two glazing systems, the frame is assumed to be
! the same for both.
FrameWidth=0.0d0
FrameProjectionOut=0.0d0
FrameProjectionIn=0.0d0
FrameConductance=0.0d0
FrEdgeToCenterGlCondRatio=0.0d0
FrameSolAbsorp=0.0d0
FrameVisAbsorp=0.0d0
FrameEmis=0.0d0
READ(DataLine(11)(20:),*,IOStat=ReadStat) FrameWidth,FrameProjectionOut,FrameProjectionIn,FrameConductance, &
FrEdgeToCenterGlCondRatio,FrameSolAbsorp,FrameVisAbsorp,FrameEmis
IF (ReadStat /= 0) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Error in Read of frame data values.')
CALL ShowContinueError('Line (~'//TRIM(TrimSigDigits(FileLineCount+11))//') in error (first 100 characters)='// &
TRIM(DataLine(11)(1:100)))
ErrorsFound=.true.
ENDIF
IF(FrameWidth > 0.0d0) THEN
IF(FrameConductance <= 0.0d0) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Construction='//TRIM(DesiredConstructionName)// &
' from the Window5 data file cannot be used: it has Frame Conductance <= 0.0')
ErrorsFound = .TRUE.
END IF
! Relax this check for Window5 data: 1/28/2008.
! IF(FrEdgeToCenterGlCondRatio < 1.0) THEN
! CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Construction='//TRIM(DesiredConstructionName)// &
! ' from the Window5 data file cannot be used: it has Frame Edge-of-Glass Conduction Ratio < 1.0')
! ErrorsFound = .TRUE.
! END IF
IF(FrameSolAbsorp < 0.0d0 .OR. FrameSolAbsorp > 1.0d0) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Construction='//TRIM(DesiredConstructionName)// &
' from the Window5 data file cannot be used: it has Frame Solar Absorptance < 0.0 or > 1.0')
ErrorsFound = .TRUE.
END IF
IF(FrameEmis <= 0.0d0 .OR. FrameEmis >= 1.0d0) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Construction='//TRIM(DesiredConstructionName)// &
' from the Window5 data file cannot be used: it has Frame Emissivity <= 0.0 or >= 1.0')
ErrorsFound = .TRUE.
END IF
END IF
FrameWidth = 0.001d0*FrameWidth
FrameProjectionOut = 0.001d0*FrameProjectionOut
FrameProjectionIn = 0.001d0*FrameProjectionIn
FileLineCount=FileLineCount+11
READ(W5DataFileNum,fmtA,IOSTAT=ReadStat) NextLine
IF(ReadStat < GoodIOStatValue) GO TO 1000
IF (StripCR) THEN
endcol=LEN_TRIM(NextLine)
IF (endcol > 0) NextLine(endcol:endcol)=Blank
ENDIF
FileLineCount=FileLineCount+1
! Divider data for each glazing system
DO IGlSys = 1,NGlSys
READ(W5DataFileNum,fmtA,IOSTAT=ReadStat) NextLine
IF(ReadStat < GoodIOStatValue) GO TO 1000
FileLineCount=FileLineCount+1
READ(NextLine(20:),*,IOSTAT=ReadStat) DividerWidth(IGlSys),DividerProjectionOut(IGlSys),DividerProjectionIn(IGlSys), &
DividerConductance(IGlSys),DivEdgeToCenterGlCondRatio(IGlSys),DividerSolAbsorp(IGlSys),DividerVisAbsorp(IGlSys), &
DividerEmis(IGlSys),DividerType(IGlSys),HorDividers(IGlSys),VertDividers(IGlSys)
IF (ReadStat /= 0) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Error in Read of divider data values. '// &
'For Glazing System='//TRIM(TrimSigDigits(IGLSys)))
CALL ShowContinueError('Line (~'//TRIM(TrimSigDigits(FileLineCount+11))//') in error (first 100 characters)='// &
TRIM(NextLine(1:100)))
ErrorsFound=.true.
ENDIF
DividerType(IGlSys) = MakeUpperCase(DividerType(IGlSys))
IF(DividerWidth(IGlSys) > 0.0d0) THEN
IF(HorDividers(IGlSys) == 0 .AND. VertDividers(IGlSys) == 0) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Construction='//TRIM(DesiredConstructionName)// &
' from the Window5 data file cannot be used:')
CALL ShowContinueError('glazing system '//TRIM(TrimSigDigits(IGLSys))// &
' has a divider but number of horizontal and vertical divider elements = 0')
ErrorsFound = .TRUE.
END IF
IF(DividerConductance(IGlSys) <= 0.0d0) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Construction='//TRIM(DesiredConstructionName)// &
' from the Window5 data file cannot be used:')
CALL ShowContinueError('glazing system '//TRIM(TrimSigDigits(IGLSys))//' has Divider Conductance <= 0.0')
ErrorsFound = .TRUE.
END IF
IF(DivEdgeToCenterGlCondRatio(IGlSys) < 1.0d0) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Construction='//TRIM(DesiredConstructionName)// &
' from the Window5 data file cannot be used:')
CALL ShowContinueError('glazing system '//TRIM(TrimSigDigits(IGLSys))// &
' has Divider Edge-Of-Glass Conduction Ratio < 1.0')
ErrorsFound = .TRUE.
END IF
IF(DividerSolAbsorp(IGlSys) < 0.0d0 .OR. DividerSolAbsorp(IGlSys) > 1.0d0) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Construction='//TRIM(DesiredConstructionName)// &
' from the Window5 data file cannot be used:')
CALL ShowContinueError('glazing system '//TRIM(TrimSigDigits(IGLSys))// &
' has Divider Solar Absorptance < 0.0 or > 1.0')
ErrorsFound = .TRUE.
END IF
IF(DividerEmis(IGlSys) <= 0.0d0 .OR. DividerEmis(IGlSys) >= 1.0d0) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Construction='//TRIM(DesiredConstructionName)// &
' from the Window5 data file cannot be used:')
CALL ShowContinueError('glazing system '//TRIM(TrimSigDigits(IGLSys))// &
' has Divider Emissivity <= 0.0 or >= 1.0')
ErrorsFound = .TRUE.
END IF
IF(DividerType(IGlSys) /= 'DIVIDEDLITE' .AND. DividerType(IGlSys) /= 'SUSPENDED') THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Construction='//TRIM(DesiredConstructionName)// &
' from the Window5 data file cannot be used:')
CALL ShowContinueError('glazing system '//TRIM(TrimSigDigits(IGLSys))// &
' has Divider Type = '//TRIM(DividerType(IGlSys))// &
'; it should be DIVIDEDLITE or SUSPENDED.')
ErrorsFound = .TRUE.
END IF
END IF
DividerWidth(IGlSys) = 0.001d0*DividerWidth(IGlSys)
IF(DividerType(IGlSys) == 'DIVIDEDLITE') THEN
DividerProjectionOut(IGlSys) = 0.001d0*DividerProjectionOut(IGlSys)
DividerProjectionIn(IGlSys) = 0.001d0*DividerProjectionIn(IGlSys)
ELSE
DividerProjectionOut(IGlSys) = 0.0d0
DividerProjectionIn(IGlSys) = 0.0d0
END IF
END DO
IF(ErrorsFound) &
CALL ShowFatalError('HeatBalanceManager: SearchWindow5DataFile: Construction='//TRIM(DesiredConstructionName)// &
' from the Window5 data file cannot be used because of above errors')
TotMaterialsPrev = TotMaterials
DO IGlSys = 1,NGlSys
NGaps(IGlSys) = NGlass(IGlSys)-1
TotMaterials = TotMaterials + NGlass(IGlSys) + NGaps(IGlSys)
END DO
! Create Material objects
! reallocate Material type
ALLOCATE(MaterialSave(TotMaterialsPrev))
ALLOCATE(NominalRSave(TotMaterialsPrev))
NominalRSave=NominalR
DO loop = 1,TotMaterialsPrev
MaterialSave(loop) = Material(loop)
! NominalRSave(loop) = NominalR(loop)
END DO
DEALLOCATE(Material)
DEALLOCATE(NominalR)
ALLOCATE(Material(TotMaterials))
ALLOCATE(NominalR(TotMaterials))
NominalR=0.0d0
NominalR(1:TotMaterialsPrev)=NominalRSave
DO loop = 1,TotMaterialsPrev
Material(loop) = MaterialSave(loop)
! NominalR(loop) = NominalRSave(loop)
END DO
DEALLOCATE(MaterialSave)
DEALLOCATE(NominalRSave)
! Initialize new materials
DO loop = TotMaterialsPrev+1,TotMaterials
Material(loop)%Name=' '
Material(loop)%Group=-1
Material(loop)%Roughness=0
Material(loop)%Conductivity=0.0d0
Material(loop)%Density=0.0d0
Material(loop)%IsoMoistCap=0.0d0
Material(loop)%Porosity=0.0d0
Material(loop)%Resistance=0.0d0
Material(loop)%SpecHeat=0.0d0
Material(loop)%ThermGradCoef=0.0d0
Material(loop)%Thickness=0.0d0
Material(loop)%VaporDiffus=0.0d0
Material(loop)%AbsorpSolar=0.0d0
Material(loop)%AbsorpThermal=0.0d0
Material(loop)%AbsorpVisible=0.0d0
Material(loop)%ReflectShade=0.0d0
Material(loop)%Trans=0.0d0
Material(loop)%ReflectShadeVis=0.0d0
Material(loop)%TransVis=0.0d0
Material(loop)%GlassTransDirtFactor=1.0d0
Material(loop)%SolarDiffusing=.false.
Material(loop)%AbsorpThermalBack=0.0d0
Material(loop)%AbsorpThermalFront=0.0d0
Material(loop)%ReflectSolBeamBack=0.0d0
Material(loop)%ReflectSolBeamFront=0.0d0
Material(loop)%ReflectSolDiffBack=0.0d0
Material(loop)%ReflectSolDiffFront=0.0d0
Material(loop)%ReflectVisBeamBack=0.0d0
Material(loop)%ReflectVisBeamFront=0.0d0
Material(loop)%ReflectVisDiffBack=0.0d0
Material(loop)%ReflectVisDiffFront=0.0d0
Material(loop)%TransSolBeam=0.0d0
Material(loop)%TransThermal=0.0d0
Material(loop)%TransVisBeam=0.0d0
Material(loop)%GlassSpectralDataPtr=0
Material(loop)%NumberOfGasesInMixture=0
Material(loop)%GasCon=0.0d0
Material(loop)%GasVis=0.0d0
Material(loop)%GasCp=0.0d0
Material(loop)%GasType=0
Material(loop)%GasWght=0.0d0
Material(loop)%GasSpecHeatRatio=0.0d0
Material(loop)%GasFract=0.0d0
Material(loop)%WinShadeToGlassDist=0.0d0
Material(loop)%WinShadeTopOpeningMult=0.0d0
Material(loop)%WinShadeBottomOpeningMult=0.0d0
Material(loop)%WinShadeLeftOpeningMult=0.0d0
Material(loop)%WinShadeRightOpeningMult=0.0d0
Material(loop)%WinShadeAirFlowPermeability=0.0d0
Material(loop)%BlindDataPtr=0
Material(loop)%EMPDVALUE=0.0d0
Material(loop)%MoistACoeff=0.0d0
Material(loop)%MoistBCoeff=0.0d0
Material(loop)%MoistCCoeff=0.0d0
Material(loop)%MoistDCoeff=0.0d0
END DO
! Glass objects
READ(W5DataFileNum,fmtA,IOSTAT=ReadStat) NextLine
IF(ReadStat < GoodIOStatValue) GO TO 1000
IF (StripCR) THEN
endcol=LEN_TRIM(NextLine)
IF (endcol > 0) NextLine(endcol:endcol)=Blank
ENDIF
FileLineCount=FileLineCount+1
MaterNum = TotMaterialsPrev
DO IGlSys = 1,NGlSys
DO IGlass = 1,NGlass(IGlSys)
MaterNum = MaterNum + 1
MaterNumSysGlass(IGlSys,IGlass) = MaterNum
Material(MaterNum)%Group = WindowGlass
READ(W5DataFileNum,'(A)',IOSTAT=ReadStat) NextLine
FileLineCount=FileLineCount+1
READ(NextLine(26:),*) &
Material(MaterNum)%Thickness, &
Material(MaterNum)%Conductivity, &
Material(MaterNum)%Trans, &
Material(MaterNum)%ReflectSolBeamFront, &
Material(MaterNum)%ReflectSolBeamBack, &
Material(MaterNum)%TransVis, &
Material(MaterNum)%ReflectVisBeamFront, &
Material(MaterNum)%ReflectVisBeamBack, &
Material(MaterNum)%TransThermal, &
Material(MaterNum)%AbsorpThermalFront, &
Material(MaterNum)%AbsorpThermalBack, &
LayerName
Material(MaterNum)%Thickness = 0.001d0*Material(MaterNum)%Thickness
IF (Material(MaterNum)%Thickness <= 0.0d0) THEN
ENDIF
IF(NGlSys == 1) THEN
Material(MaterNum)%Name = &
'W5:'//TRIM(DesiredConstructionName)//':GLASS'//NumName(IGlass)
ELSE
Material(MaterNum)%Name = &
'W5:'//TRIM(DesiredConstructionName)//':'//NumName(IGlSys)//':GLASS'//NumName(IGlass)
END IF
Material(MaterNum)%Roughness = VerySmooth
Material(MaterNum)%AbsorpThermal = Material(MaterNum)%AbsorpThermalBack
IF (Material(MaterNum)%Thickness <= 0.0d0) THEN
CALL ShowSevereError('SearchWindow5DataFile: Material="'//trim(Material(MaterNum)%Name)// &
'" has thickness of 0.0. Will be set to thickness = .001 but inaccuracies may result.')
CALL ShowContinueError('Line being read='//trim(NextLine))
CALL ShowContinueError('Thickness field starts at column 26='//trim(NextLine(26:)))
Material(MaterNum)%Thickness=.001d0
ENDIF
END DO
END DO
! Gap objects
READ(W5DataFileNum,fmtA,IOSTAT=ReadStat) NextLine
IF(ReadStat < GoodIOStatValue) GO TO 1000
IF (StripCR) THEN
endcol=LEN_TRIM(NextLine)
IF (endcol > 0) NextLine(endcol:endcol)=Blank
ENDIF
FileLineCount=FileLineCount+1
DO IGlSys = 1,NGlSys
DO IGap = 1,NGaps(IGlSys)
MaterNum = MaterNum + 1
MaterNumSysGap(IGlSys,IGap) = MaterNum
READ(W5DataFileNum,fmtA,IOSTAT=ReadStat) NextLine
FileLineCount=FileLineCount+1
READ(NextLine(24:),*) Material(MaterNum)%Thickness,NumGases(IGlSys,IGap)
IF(NGlSys == 1) THEN
Material(MaterNum)%Name = &
'W5:'//TRIM(DesiredConstructionName)//':GAP'//NumName(IGap)
ELSE
Material(MaterNum)%Name = &
'W5:'//TRIM(DesiredConstructionName)//':'//NumName(IGlSys)//':GAP'//NumName(IGap)
END IF
Material(MaterNum)%Thickness = 0.001d0*Material(MaterNum)%Thickness
Material(MaterNum)%RoughNess = MediumRough ! Unused
END DO
END DO
READ(W5DataFileNum,fmtA,IOSTAT=ReadStat) NextLine
IF(ReadStat < GoodIOStatValue) GO TO 1000
IF (StripCR) THEN
endcol=LEN_TRIM(NextLine)
IF (endcol > 0) NextLine(endcol:endcol)=Blank
ENDIF
FileLineCount=FileLineCount+1
DO IGlSys = 1,NGlSys
DO IGap = 1,NGaps(IGlSys)
MaterNum = MaterNumSysGap(IGlSys,IGap)
Material(MaterNum)%NumberOfGasesInMixture = NumGases(IGlSys,IGap)
Material(MaterNum)%Group = WindowGas
IF(NumGases(IGlSys,IGap) > 1) Material(MaterNum)%Group = WindowGasMixture
DO IGas = 1,NumGases(IGlSys,IGap)
READ(W5DataFileNum,'(A)',IOSTAT=ReadStat) NextLine
FileLineCount=FileLineCount+1
READ(NextLine(20:),*) &
GasName(IGas),Material(MaterNum)%GasFract(IGas),Material(MaterNum)%GasWght(IGas), &
Material(MaterNum)%GasCon(IGas,:),Material(MaterNum)%GasVis(IGas,:),Material(MaterNum)%GasCp(IGas,:)
! 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.d0)
END DO
END DO
END DO
! Construction objects
! reallocate Construct types
ALLOCATE(ConstructSave(TotConstructs))
ALLOCATE(NominalRSave(TotConstructs))
ALLOCATE(NominalUSave(TotConstructs))
DO loop = 1,TotConstructs
ConstructSave(loop) = Construct(loop)
NominalRSave(loop) = NominalRforNominalUCalculation(loop)
NominalUSave(loop) = NominalU(loop)
END DO
DEALLOCATE(Construct)
DEALLOCATE(NominalRforNominalUCalculation)
DEALLOCATE(NominalU)
TotConstructs = TotConstructs + NGlSys
ALLOCATE(Construct(TotConstructs))
ALLOCATE(NominalRforNominalUCalculation(TotConstructs))
ALLOCATE(NominalU(TotConstructs))
DO loop = 1,TotConstructs-NGlSys
Construct(loop) = ConstructSave(loop)
NominalRforNominalUCalculation(loop) = NominalRSave(loop)
NominalU(loop) = NominalUSave(loop)
END DO
DEALLOCATE(ConstructSave)
DEALLOCATE(NominalRSave)
DEALLOCATE(NominalUSave)
READ(W5DataFileNum,fmtA,IOSTAT=ReadStat) NextLine
IF(ReadStat < GoodIOStatValue) GO TO 1000
IF (StripCR) THEN
endcol=LEN_TRIM(NextLine)
IF (endcol > 0) NextLine(endcol:endcol)=Blank
ENDIF
FileLineCount=FileLineCount+1
DO IGlSys = 1,NGlSys
ConstrNum = TotConstructs - NGlSys + IGlSys
IF(IGlSys == 1) THEN
Construct(ConstrNum)%Name = TRIM(DesiredConstructionName)
ELSE
Construct(ConstrNum)%Name = TRIM(DesiredConstructionName)//':2'
END IF
DO loop = 1,MaxLayersInConstruct
Construct(ConstrNum)%LayerPoint(loop) = 0
END DO
Construct(ConstrNum)%InsideAbsorpSolar = 0.0d0
Construct(ConstrNum)%OutsideAbsorpSolar = 0.0d0
Construct(ConstrNum)%DayltPropPtr = 0
Construct(ConstrNum)%CTFCross = 0.0D0
Construct(ConstrNum)%CTFFlux = 0.0D0
Construct(ConstrNum)%CTFInside = 0.0D0
Construct(ConstrNum)%CTFOutside = 0.0D0
Construct(ConstrNum)%CTFSourceIn = 0.0D0
Construct(ConstrNum)%CTFSourceOut = 0.0D0
Construct(ConstrNum)%CTFTimeStep = 0.0D0
Construct(ConstrNum)%CTFTSourceOut = 0.0D0
Construct(ConstrNum)%CTFTSourceIn = 0.0D0
Construct(ConstrNum)%CTFTSourceQ = 0.0D0
Construct(ConstrNum)%CTFTUserOut = 0.0D0
Construct(ConstrNum)%CTFTUserIn = 0.0D0
Construct(ConstrNum)%CTFTUserSource = 0.0D0
Construct(ConstrNum)%NumHistories = 0
Construct(ConstrNum)%NumCTFTerms = 0
Construct(ConstrNum)%UValue = 0.0d0
Construct(ConstrNum)%SourceSinkPresent = .FALSE.
Construct(ConstrNum)%SolutionDimensions = 0
Construct(ConstrNum)%SourceAfterLayer = 0
Construct(ConstrNum)%TempAfterLayer = 0
Construct(ConstrNum)%ThicknessPerpend = 0.0d0
Construct(ConstrNum)%AbsDiff = 0.0d0
Construct(ConstrNum)%AbsDiffBack = 0.0d0
Construct(ConstrNum)%AbsDiffShade = 0.0d0
Construct(ConstrNum)%AbsDiffBackShade = 0.0d0
Construct(ConstrNum)%ShadeAbsorpThermal = 0.0d0
Construct(ConstrNum)%AbsBeamCoef = 0.0d0
Construct(ConstrNum)%AbsBeamBackCoef = 0.0d0
Construct(ConstrNum)%AbsBeamShadeCoef = 0.0d0
Construct(ConstrNum)%AbsDiffIn = 0.0d0
Construct(ConstrNum)%AbsDiffOut = 0.0d0
Construct(ConstrNum)%TransDiff = 0.0d0
Construct(ConstrNum)%TransDiffVis = 0.0d0
Construct(ConstrNum)%ReflectSolDiffBack = 0.0d0
Construct(ConstrNum)%ReflectSolDiffFront = 0.0d0
Construct(ConstrNum)%ReflectVisDiffBack = 0.0d0
Construct(ConstrNum)%ReflectVisDiffFront = 0.0d0
Construct(ConstrNum)%TransSolBeamCoef = 0.0d0
Construct(ConstrNum)%TransVisBeamCoef = 0.0d0
Construct(ConstrNum)%ReflSolBeamFrontCoef= 0.0d0
Construct(ConstrNum)%ReflSolBeamBackCoef = 0.0d0
Construct(ConstrNum)%W5FrameDivider = 0
Construct(ConstrNum)%TotLayers = NGlass(IGlSys) + NGaps(IGlSys)
Construct(ConstrNum)%TotGlassLayers = NGlass(IGlSys)
Construct(ConstrNum)%TotSolidLayers = NGlass(IGlSys)
DO IGlass = 1,NGlass(IGlSys)
Construct(ConstrNum)%LayerPoint(2*IGlass-1) = MaterNumSysGlass(IGlSys,IGlass)
IF(IGlass < NGlass(IGlSys)) Construct(ConstrNum)%LayerPoint(2*IGlass) = MaterNumSysGap(IGlSys,IGlass)
END DO
Construct(ConstrNum)%OutsideRoughness = VerySmooth
Construct(ConstrNum)%InsideAbsorpThermal = Material(TotMaterialsPrev+NGlass(IGlSys))%AbsorpThermalBack
Construct(ConstrNum)%OutsideAbsorpThermal= Material(TotMaterialsPrev+1)%AbsorpThermalFront
Construct(ConstrNum)%TypeIsWindow = .TRUE.
Construct(ConstrNum)%FromWindow5DataFile = .TRUE.
Construct(ConstrNum)%W5FileGlazingSysHeight = WinHeight(IGlSys)
Construct(ConstrNum)%W5FileGlazingSysWidth = WinWidth(IGlSys)
IF (SameString(MullionOrientation,'Vertical')) THEN
Construct(ConstrNum)%W5FileMullionOrientation = Vertical
ELSEIF (SameString(MullionOrientation,'Horizontal')) THEN
Construct(ConstrNum)%W5FileMullionOrientation = Horizontal
ELSE
ENDIF
Construct(ConstrNum)%W5FileMullionWidth = MullionWidth
! Fill Construct with system transmission, reflection and absorption properties
DO IPhi = 1,10
CosPhiIndepVar(IPhi) = COS((IPhi-1)*10.0d0*DegToRadians)
END DO
READ(W5DataFileNum,fmtA,IOSTAT=ReadStat) NextLine
IF(ReadStat < GoodIOStatValue) GO TO 1000
IF (StripCR) THEN
endcol=LEN_TRIM(NextLine)
IF (endcol > 0) NextLine(endcol:endcol)=Blank
ENDIF
FileLineCount=FileLineCount+1
IF(IGlSys == 1) THEN
READ(W5DataFileNum,fmtA,IOSTAT=ReadStat) NextLine
IF(ReadStat < GoodIOStatValue) GO TO 1000
IF (StripCR) THEN
endcol=LEN_TRIM(NextLine)
IF (endcol > 0) NextLine(endcol:endcol)=Blank
ENDIF
FileLineCount=FileLineCount+1
ENDIF
READ(W5DataFileNum,fmtA,IOSTAT=ReadStat) NextLine
IF(ReadStat < GoodIOStatValue) GO TO 1000
IF (StripCR) THEN
endcol=LEN_TRIM(NextLine)
IF (endcol > 0) NextLine(endcol:endcol)=Blank
ENDIF
FileLineCount=FileLineCount+1
READ(NextLine(6:),*,IOSTAT=ReadStat) Tsol
IF (ReadStat /= 0) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Error in Read of TSol values.')
CALL ShowContinueError('Line (~'//TRIM(TrimSigDigits(FileLineCount))//') in error (first 100 characters)='// &
TRIM(NextLine(1:100)))
ErrorsFound=.true.
ELSEIF (ANY(Tsol < 0.0d0) .or. ANY(TSol > 1.0d0)) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Error in Read of TSol values. (out of range [0,1])')
CALL ShowContinueError('Line (~'//TRIM(TrimSigDigits(FileLineCount))//') in error (first 100 characters)='// &
TRIM(NextLine(1:100)))
ErrorsFound=.true.
ENDIF
DO IGlass = 1,NGlass(IGlSys)
READ(W5DataFileNum,fmtA,IOSTAT=ReadStat) NextLine
IF (StripCR) THEN
endcol=LEN_TRIM(NextLine)
IF (endcol > 0) NextLine(endcol:endcol)=Blank
ENDIF
FileLineCount=FileLineCount+1
READ(NextLine(6:),*,IOSTAT=ReadStat) AbsSol(IGlass,:)
IF (ReadStat /= 0) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Error in Read of AbsSol values. For Glass='// &
TRIM(TrimSigDigits(IGlass)))
CALL ShowContinueError('Line (~'//TRIM(TrimSigDigits(FileLineCount))//') in error (first 100 characters)='// &
TRIM(NextLine(1:100)))
ErrorsFound=.true.
ELSEIF (ANY(AbsSol(IGlass,:) < 0.0d0) .or. ANY(AbsSol(IGlass,:) > 1.0d0)) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Error in Read of AbsSol values. '// &
'(out of range [0,1]) For Glass='//TRIM(TrimSigDigits(IGlass)))
CALL ShowContinueError('Line (~'//TRIM(TrimSigDigits(FileLineCount))//') in error (first 100 characters)='// &
TRIM(NextLine(1:100)))
ErrorsFound=.true.
ENDIF
END DO
DO ILine = 1,5
READ(W5DataFileNum,fmtA,IOSTAT=ReadStat) DataLine(ILine)
IF (StripCR) THEN
endcol=LEN_TRIM(DataLine(ILine))
IF (endcol > 0) DataLine(ILine)(endcol:endcol)=Blank
ENDIF
END DO
READ(DataLine(1)(6:),*,IOSTAT=ReadStat) Rfsol
IF (ReadStat /= 0) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Error in Read of RfSol values.')
CALL ShowContinueError('Line (~'//TRIM(TrimSigDigits(FileLineCount+1))//') in error (first 100 characters)='// &
TRIM(DataLine(1)(1:100)))
ErrorsFound=.true.
ELSEIF (ANY(Rfsol < 0.0d0) .or. ANY(RfSol > 1.0d0)) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Error in Read of RfSol values. (out of range [0,1])')
CALL ShowContinueError('Line (~'//TRIM(TrimSigDigits(FileLineCount+1))//') in error (first 100 characters)='// &
TRIM(DataLine(1)(1:100)))
ErrorsFound=.true.
ENDIF
READ(DataLine(2)(6:),*,IOSTAT=ReadStat) Rbsol
IF (ReadStat /= 0) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Error in Read of RbSol values.')
CALL ShowContinueError('Line (~'//TRIM(TrimSigDigits(FileLineCount+2))//') in error (first 100 characters)='// &
TRIM(DataLine(2)(1:100)))
ErrorsFound=.true.
ELSEIF (ANY(Rbsol < 0.0d0) .or. ANY(RbSol > 1.0d0)) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Error in Read of RbSol values. (out of range [0,1])')
CALL ShowContinueError('Line (~'//TRIM(TrimSigDigits(FileLineCount+2))//') in error (first 100 characters)='// &
TRIM(DataLine(2)(1:100)))
ErrorsFound=.true.
ENDIF
READ(DataLine(3)(6:),*,IOSTAT=ReadStat) Tvis
IF (ReadStat /= 0) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Error in Read of Tvis values.')
CALL ShowContinueError('Line (~'//TRIM(TrimSigDigits(FileLineCount+3))//') in error (first 100 characters)='// &
TRIM(DataLine(3)(1:100)))
ErrorsFound=.true.
ELSEIF (ANY(Tvis < 0.0d0) .or. ANY(Tvis > 1.0d0)) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Error in Read of Tvis values. (out of range [0,1])')
CALL ShowContinueError('Line (~'//TRIM(TrimSigDigits(FileLineCount+3))//') in error (first 100 characters)='// &
TRIM(DataLine(3)(1:100)))
ErrorsFound=.true.
ENDIF
READ(DataLine(4)(6:),*,IOSTAT=ReadStat) Rfvis
IF (ReadStat /= 0) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Error in Read of Rfvis values.')
CALL ShowContinueError('Line (~'//TRIM(TrimSigDigits(FileLineCount+4))//') in error (first 100 characters)='// &
TRIM(DataLine(4)(1:100)))
ErrorsFound=.true.
ELSEIF (ANY(Rfvis < 0.0d0) .or. ANY(Rfvis > 1.0d0)) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Error in Read of Rfvis values. (out of range [0,1])')
CALL ShowContinueError('Line (~'//TRIM(TrimSigDigits(FileLineCount+4))//') in error (first 100 characters)='// &
TRIM(DataLine(4)(1:100)))
ErrorsFound=.true.
ENDIF
READ(DataLine(5)(6:),*,IOSTAT=ReadStat) Rbvis
IF (ReadStat /= 0) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Error in Read of Rbvis values.')
CALL ShowContinueError('Line (~'//TRIM(TrimSigDigits(FileLineCount+5))//') in error (first 100 characters)='// &
TRIM(DataLine(5)(1:100)))
ErrorsFound=.true.
ELSEIF (ANY(Rbvis < 0.0d0) .or. ANY(Rbvis > 1.0d0)) THEN
CALL ShowSevereError('HeatBalanceManager: SearchWindow5DataFile: Error in Read of Rbvis values. (out of range [0,1])')
CALL ShowContinueError('Line (~'//TRIM(TrimSigDigits(FileLineCount+5))//') in error (first 100 characters)='// &
TRIM(DataLine(5)(1:100)))
ErrorsFound=.true.
ENDIF
FileLineCount=FileLineCount+5
IF(ErrorsFound) &
CALL ShowFatalError('HeatBalanceManager: SearchWindow5DataFile: Construction='//TRIM(DesiredConstructionName)// &
' from the Window5 data file cannot be used because of above errors')
! Hemis
Construct(ConstrNum)%TransDiff = Tsol(11)
Construct(ConstrNum)%TransDiffVis = Tvis(11)
Construct(ConstrNum)%ReflectSolDiffFront = Rfsol(11)
Construct(ConstrNum)%ReflectSolDiffBack = Rbsol(11)
Construct(ConstrNum)%ReflectVisDiffFront = Rfvis(11)
Construct(ConstrNum)%ReflectVisDiffBack = Rbvis(11)
CALL W5LsqFit(CosPhiIndepVar,Tsol,6,1,10,Construct(ConstrNum)%TransSolBeamCoef)
CALL W5LsqFit(CosPhiIndepVar,Tvis,6,1,10,Construct(ConstrNum)%TransVisBeamCoef)
CALL W5LsqFit(CosPhiIndepVar,Rfsol,6,1,10,Construct(ConstrNum)%ReflSolBeamFrontCoef)
DO IGlass = 1,NGlass(IGlSys)
CALL W5LsqFit(CosPhiIndepVar,AbsSol(IGlass,:),6,1,10,Construct(ConstrNum)%AbsBeamCoef(IGlass,:))
END DO
! For comparing fitted vs. input distribution in incidence angle
DO IPhi = 1,10
Phi = REAL(IPhi-1,r64)*10.d0
CosPhi = COS(Phi*DegToRadians)
if (abs(CosPhi) < .0001d0) CosPhi=0.0d0
tsolFit(IPhi) = POLYF(CosPhi,Construct(ConstrNum)%TransSolBeamCoef(1:6))
tvisFit(IPhi) = POLYF(CosPhi,Construct(ConstrNum)%TransVisBeamCoef(1:6))
rfsolFit(IPhi)= POLYF(CosPhi,Construct(ConstrNum)%ReflSolBeamFrontCoef(1:6))
DO IGlass = 1,NGlass(IGlSys)
solabsFit(IPhi,IGlass) = POLYF(CosPhi,Construct(ConstrNum)%AbsBeamCoef(IGlass,1:6))
END DO
END DO
! end
! NominalRforNominalUCalculation of this construction (actually the total resistance of all of its layers; gas layer
! conductivity here ignores convective efffects in gap.)
NominalRforNominalUCalculation(ConstrNum) = 0.0d0
DO loop = 1,NGlass(IGlSys)+NGaps(IGlSys)
MatNum = Construct(ConstrNum)%LayerPoint(loop)
IF(Material(MatNum)%Group == WindowGlass) THEN
NominalRforNominalUCalculation(ConstrNum) = NominalRforNominalUCalculation(ConstrNum) + &
Material(MatNum)%Thickness/Material(MatNum)%Conductivity
ELSE IF(Material(MatNum)%Group == WindowGas .OR. Material(MatNum)%Group == WindowGasMixture) THEN
! If mixture, use conductivity of first gas in mixture
NominalRforNominalUCalculation(ConstrNum) = NominalRforNominalUCalculation(ConstrNum) + &
Material(MatNum)%Thickness / &
(Material(MatNum)%GasCon(1,1) + Material(MatNum)%GasCon(1,2)*300.0d0 + &
Material(MatNum)%GasCon(1,3)*90000.0d0)
END IF
END DO
END DO ! End of loop over glazing systems
! WindowFrameAndDivider objects
TotFrameDividerPrev = TotFrameDivider
DO IGlSys = 1,NGlSys
IF(FrameWidth > 0.0d0 .OR. DividerWidth(IGlSys) > 0.0d0) THEN
TotFrameDivider = TotFrameDivider + 1
Construct(TotConstructs-NGlSys+IGlSys)%W5FrameDivider = TotFrameDivider
END IF
END DO
IF(TotFrameDivider > TotFrameDividerPrev) THEN
ALLOCATE(FrameDividerSave(TotFrameDividerPrev))
DO loop = 1,TotFrameDividerPrev
FrameDividerSave(loop) = FrameDivider(loop)
END DO
DEALLOCATE(FrameDivider)
ALLOCATE(FrameDivider(TotFrameDivider))
DO loop = 1,TotFrameDividerPrev
FrameDivider(loop) = FrameDividerSave(loop)
END DO
DEALLOCATE(FrameDividerSave)
END IF
DO IGlSys = 1,NGlSys
IF(FrameWidth > 0.0d0 .OR. DividerWidth(IGlSys) > 0.0d0) THEN
FrDivNum = Construct(TotConstructs-NGlSys+IGlSys)%W5FrameDivider
FrameDivider(FrDivNum)%FrameWidth = FrameWidth
FrameDivider(FrDivNum)%FrameProjectionOut = FrameProjectionOut
FrameDivider(FrDivNum)%FrameProjectionIn = FrameProjectionIn
FrameDivider(FrDivNum)%FrameConductance = FrameConductance
FrameDivider(FrDivNum)%FrEdgeToCenterGlCondRatio = FrEdgeToCenterGlCondRatio
FrameDivider(FrDivNum)%FrameSolAbsorp = FrameSolAbsorp
FrameDivider(FrDivNum)%FrameVisAbsorp = FrameVisAbsorp
FrameDivider(FrDivNum)%FrameEmis = FrameEmis
FrameDivider(FrDivNum)%FrameEdgeWidth = 0.06355d0 ! 2.5 in
IF (SameString(MullionOrientation,'Vertical')) THEN
FrameDivider(FrDivNum)%MullionOrientation = Vertical
ELSEIF (SameString(MullionOrientation,'Horizontal')) THEN
FrameDivider(FrDivNum)%MullionOrientation = Horizontal
ENDIF
IF (SameString(DividerType(IGlSys),'DividedLite')) THEN
FrameDivider(FrDivNum)%DividerType = DividedLite
ELSEIF (SameString(DividerType(IGlSys),'Suspended')) THEN
FrameDivider(FrDivNum)%DividerType = Suspended
ENDIF
FrameDivider(FrDivNum)%DividerWidth = DividerWidth(IGlSys)
FrameDivider(FrDivNum)%HorDividers = HorDividers(IGlSys)
FrameDivider(FrDivNum)%VertDividers = VertDividers(IGlSys)
FrameDivider(FrDivNum)%DividerProjectionOut = DividerProjectionOut(IGlSys)
FrameDivider(FrDivNum)%DividerProjectionIn = DividerProjectionIn(IGlSys)
FrameDivider(FrDivNum)%DividerConductance = DividerConductance(IGlSys)
FrameDivider(FrDivNum)%DivEdgeToCenterGlCondRatio = DivEdgeToCenterGlCondRatio(IGlSys)
FrameDivider(FrDivNum)%DividerSolAbsorp = DividerSolAbsorp(IGlSys)
FrameDivider(FrDivNum)%DividerVisAbsorp = DividerVisAbsorp(IGlSys)
FrameDivider(FrDivNum)%DividerEmis = DividerEmis(IGlSys)
FrameDivider(FrDivNum)%DividerEdgeWidth = 0.06355d0 ! 2.5 in
IF(NGlSys == 1) THEN
FrameDivider(FrDivNum)%Name = 'W5:'//TRIM(DesiredConstructionName)
ELSE
FrameDivider(FrDivNum)%Name = 'W5:'//TRIM(DesiredConstructionName)//':'//NumName(IGlSys)
END IF
END IF
END DO
IF(FrameWidth > 0.0d0 .AND. DividerWidth(1) > 0.0d0) THEN
CALL DisplayString('--Construction and associated frame and divider found')
ELSE IF(FrameWidth > 0.0d0) THEN
CALL DisplayString('--Construction and associated frame found')
ELSE IF(DividerWidth(1) > 0.0d0) THEN
CALL DisplayString('--Construction and associated divider found')
ELSE
CALL DisplayString('--Construction without frame or divider found')
END IF
END IF
CLOSE (W5DataFileNum)
RETURN
999 CALL ShowFatalError('HeatBalanceManager: SearchWindow5DataFile: '// &
'Could not open Window5 Data File, expecting it as file name='//TRIM(DesiredFileName))
RETURN
1000 EOFonFile = .TRUE.
CLOSE (W5DataFileNum)
RETURN
END SUBROUTINE SearchWindow5DataFile