Nodes of different colours represent the following:
Solid arrows point from a parent (sub)module to the submodule which is descended from it. Dashed arrows point from a module being used to the module or program unit using it. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
logical, | intent(inout) | :: | ErrorsFound | |||
integer, | intent(inout) | :: | SurfNum | |||
integer, | intent(in) | :: | TotHTSubs | |||
character(len=*), | intent(in), | DIMENSION(:) | :: | SubSurfCls | ||
integer, | intent(in), | DIMENSION(:) | :: | SubSurfIDs | ||
integer, | intent(inout) | :: | AddedSubSurfaces | |||
integer, | intent(out) | :: | NeedToAddSurfaces |
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
SUBROUTINE GetHTSubSurfaceData(ErrorsFound,SurfNum,TotHTSubs,SubSurfCls,SubSurfIDs,AddedSubSurfaces,NeedToAddSurfaces)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN May 2000
! MODIFIED August 2012 - line up subsurfaces with base surface types
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine gets the HeatTransfer Sub Surface Data,
! checks it for errors, etc.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! Heat Transfer Subsurface Definition
! FenestrationSurface:Detailed,
! \min-fields 19
! \memo Used for windows, doors, glass doors, tubular daylighting devices
! \format vertices
! A1 , \field Name
! \required-field
! \type alpha
! A2 , \field Surface Type
! \required-field
! \type choice
! \key Window
! \key Door
! \key GlassDoor
! \key TubularDaylightDome
! \key TubularDaylightDiffuser
! A3 , \field Construction Name
! \required-field
! \note To be matched with a construction in this input file
! \type object-list
! \object-list ConstructionNames
! A4 , \field Building Surface Name
! \required-field
! \type object-list
! \object-list SurfaceNames
! A5, \field Outside Boundary Condition Object
! \type object-list
! \object-list OutFaceEnvNames
! \note Non-blank only if base surface field Outside Boundary Condition is
! \note Surface or OtherSideCoefficients
! \note If Base Surface's Surface, specify name of corresponding subsurface in adjacent zone or
! \note specify current subsurface name for internal partition separating like zones
! \note If OtherSideCoefficients, specify name of SurfaceProperty:OtherSideCoefficients
! \note or leave blank to inherit Base Surface's OtherSide Coefficients
! N1, \field View Factor to Ground
! \type real
! \note From the exterior of the surface
! \note Unused if one uses the "reflections" options in Solar Distribution in Building input
! \note unless a DaylightingDevice:Shelf or DaylightingDevice:Tubular object has been specified.
! \note autocalculate will automatically calculate this value from the tilt of the surface
! \autocalculatable
! \minimum 0.0
! \maximum 1.0
! \default autocalculate
! A6, \field Shading Control Name
! \note enter the name of a WindowProperty:ShadingControl object
! \type object-list
! \object-list WindowShadeControlNames
! \note used for windows and glass doors only
! \note If not specified, window or glass door has no shading (blind, roller shade, etc.)
! A7, \field Frame and Divider Name
! \note Enter the name of a WindowProperty:FrameAndDivider object
! \type object-list
! \object-list WindowFrameAndDividerNames
! \note Used only for exterior windows (rectangular) and glass doors.
! \note Unused for triangular windows.
! \note If not specified (blank), window or glass door has no frame or divider
! \note and no beam solar reflection from reveal surfaces.
! N2 , \field Multiplier
! \note Used only for Surface Type = WINDOW, GLASSDOOR or DOOR
! \note Non-integer values will be truncated to integer
! \default 1.0
! \minimum 1.0
! N3 , \field Number of Vertices
! \minimum 3
! \maximum 4
! \autocalculatable
! \default autocalculate
! \note vertices are given in GlobalGeometryRules coordinates -- if relative, all surface coordinates
! \note are "relative" to the Zone Origin. If world, then building and zone origins are used
! \note for some internal calculations, but all coordinates are given in an "absolute" system.
! N4-15 as indicated by the N3 value
! USE STATEMENTS:
USE DataIPShortCuts
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, FindItemInList, VerifyName, GetObjectDefMaxArgs
USE General, ONLY: TrimSigDigits,RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(INOUT) :: ErrorsFound ! Error flag indicator (true if errors found)
INTEGER, INTENT(INOUT) :: SurfNum ! Count of Current SurfaceNumber
INTEGER, INTENT(IN) :: TotHTSubs ! Number of Heat Transfer SubSurfaces to obtain
CHARACTER(len=*), DIMENSION(:), INTENT(IN) :: SubSurfCls ! Valid Classes for Sub Surfaces
INTEGER, DIMENSION(:), INTENT(IN) :: SubSurfIDs ! ID Assignments for valid sub surface classes
INTEGER, INTENT(INOUT) :: AddedSubSurfaces ! Subsurfaces added when windows reference Window5
! data file entry with two glazing systems
INTEGER, INTENT(OUT) :: NeedToAddSurfaces ! Number of surfaces to add, based on unentered IZ surfaces
! 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
INTEGER :: SurfaceNumAlpha ! Number of material alpha names being passed
INTEGER :: SurfaceNumProp ! Number of material properties being passed
INTEGER :: Found ! For matching interzone surfaces
INTEGER :: Loop
LOGICAL :: ErrorInName
LOGICAL :: IsBlank
INTEGER :: ValidChk
INTEGER :: numSides
CALL GetWindowShadingControlData(ErrorsFound)
cCurrentModuleObject='FenestrationSurface:Detailed'
CALL GetObjectDefMaxArgs(cCurrentModuleObject,Loop,SurfaceNumAlpha,SurfaceNumProp)
IF (SurfaceNumAlpha /= 7) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': Object Definition indicates '// &
'not = 7 Alpha Objects, Number Indicated='// &
TRIM(TrimSigDigits(SurfaceNumAlpha)))
ErrorsFound=.true.
ENDIF
IF (SurfaceNumProp /= 15) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': Object Definition indicates '// &
'> 15 Numeric Objects, Number Indicated='// &
TRIM(TrimSigDigits(SurfaceNumAlpha)))
ErrorsFound=.true.
ENDIF
NeedToAddSurfaces=0
DO Loop=1,TotHTSubs
CALL GetObjectItem(cCurrentModuleObject,Loop,cAlphaArgs,SurfaceNumAlpha,rNumericArgs,SurfaceNumProp,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ErrorInName=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),SurfaceTmp%Name,SurfNum,ErrorInName,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (ErrorInName) THEN
CALL ShowContinueError('...each surface name must not duplicate other surface names (of any type)')
ErrorsFound=.true.
CYCLE
ENDIF
IF (SurfaceNumProp < 12) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", Too few number of numeric args=['//TRIM(TrimSigDigits(SurfaceNumProp))//'].')
ErrorsFound=.true.
ENDIF
SurfNum=SurfNum+1
SurfaceTmp(SurfNum)%Name = cAlphaArgs(1) ! Set the Surface Name in the Derived Type
ValidChk=FindItemInList(cAlphaArgs(2),SubSurfCls,6)
IF (ValidChk == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cAlphaFieldNames(2))//'="'//TRIM(cAlphaArgs(2)))
ErrorsFound=.true.
ELSE
SurfaceTmp(SurfNum)%Class = SubSurfIDs(ValidChk) ! Set class number
ENDIF
SurfaceTmp(SurfNum)%Construction=FindIteminList(cAlphaArgs(3),Construct%Name,TotConstructs)
IF(SurfaceTmp(SurfNum)%Construction == 0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cAlphaFieldNames(3))//'="'//TRIM(cAlphaArgs(3))//'".')
ELSE
Construct(SurfaceTmp(SurfNum)%Construction)%IsUsed=.true.
SurfaceTmp(SurfNum)%ConstructionStoredInputValue = SurfaceTmp(SurfNum)%Construction
END IF
IF(SurfaceTmp(SurfNum)%Class.EQ.SurfaceClass_Window.OR.SurfaceTmp(SurfNum)%Class.EQ.SurfaceClass_GlassDoor &
.OR.SurfaceTmp(SurfNum)%Class.EQ.SurfaceClass_TDD_Diffuser.OR.SurfaceTmp(SurfNum)%Class.EQ.SurfaceClass_TDD_Dome) THEN
IF (SurfaceTmp(SurfNum)%Construction /= 0) THEN
IF (.NOT.Construct(SurfaceTmp(SurfNum)%Construction)%TypeIsWindow) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'" has an opaque surface construction; it should have a window construction.')
ENDIF
ENDIF
ELSEIF (SurfaceTmp(SurfNum)%Construction /= 0) THEN
IF (Construct(SurfaceTmp(SurfNum)%Construction)%TypeIsWindow) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cAlphaFieldNames(3))//'="'//TRIM(cAlphaArgs(3))// &
'" - has Window materials.')
CALL ShowContinueError('...because '//TRIM(cAlphaFieldNames(2))//'='//TRIM(cAlphaArgs(2)))
ENDIF
ENDIF
SurfaceTmp(SurfNum)%HeatTransSurf=.true.
SurfaceTmp(SurfNum)%BaseSurfName=cAlphaArgs(4)
! The subsurface inherits properties from the base surface
! Exterior conditions, Zone, etc.
! We can figure out the base surface though, because they've all been entered
Found=FindIteminList(SurfaceTmp(SurfNum)%BaseSurfName,SurfaceTmp%Name,TotSurfaces)
IF (Found > 0) THEN
SurfaceTmp(SurfNum)%BaseSurf=Found
SurfaceTmp(SurfNum)%ExtBoundCond=SurfaceTmp(Found)%ExtBoundCond
SurfaceTmp(SurfNum)%ExtBoundCondName=SurfaceTmp(Found)%ExtBoundCondName
SurfaceTmp(SurfNum)%ExtSolar=SurfaceTmp(Found)%ExtSolar
SurfaceTmp(SurfNum)%ExtWind=SurfaceTmp(Found)%ExtWind
SurfaceTmp(SurfNum)%Zone=SurfaceTmp(Found)%Zone
SurfaceTmp(SurfNum)%ZoneName=SurfaceTmp(Found)%ZoneName
SurfaceTmp(SurfNum)%OSCPtr=SurfaceTmp(Found)%OSCPtr
IF (SurfaceTmp(Found)%ExtBoundCond == UnreconciledZoneSurface .and. &
SurfaceTmp(Found)%ExtBoundCondName == SurfaceTmp(Found)%Name) THEN ! Adiabatic surface, no windows or doors allowed
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cAlphaFieldNames(4))//'="'//TRIM(cAlphaArgs(4))//'".')
CALL ShowContinueError('... adiabatic surfaces cannot have windows or doors.')
CALL ShowContinueError('... no solar transmission will result for these windows or doors. '// &
'You must have interior windows or doors on Interzone surfaces for transmission to result.')
ENDIF
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cAlphaFieldNames(4))//'="'//TRIM(cAlphaArgs(4)))
SurfaceTmp(SurfNum)%ZoneName='Unknown Zone'
ErrorsFound=.true.
ENDIF
IF (SurfaceTmp(SurfNum)%Class.EQ.SurfaceClass_TDD_Dome.OR.SurfaceTmp(SurfNum)%Class.EQ.SurfaceClass_TDD_Diffuser) THEN
SurfaceTmp(SurfNum)%ExtBoundCond = ExternalEnvironment
END IF
IF (SurfaceTmp(SurfNum)%ExtBoundCond == ExternalEnvironment) THEN
IF (.not. lAlphaFieldBlanks(5)) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid field '//TRIM(cAlphaFieldNames(5)))
CALL ShowContinueError('...when Base surface uses "Outdoors" as '//trim(cAlphaFieldNames(5))// &
', subsurfaces need to be blank to inherit the outdoor characteristics.')
CALL ShowContinueError('...Surface external characteristics changed to reflect base surface.')
ENDIF
ENDIF
IF (SurfaceTmp(SurfNum)%ExtBoundCond == UnreconciledZoneSurface) THEN ! "Surface" Base Surface
IF (.not. lAlphaFieldBlanks(5)) THEN
SurfaceTmp(SurfNum)%ExtBoundCondName=cAlphaArgs(5)
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid blank '//TRIM(cAlphaFieldNames(5)))
CALL ShowContinueError('...when Base surface uses "Surface" as '//trim(cAlphaFieldNames(5))// &
', subsurfaces must also specify specific surfaces in the adjacent zone.')
SurfaceTmp(SurfNum)%ExtBoundCondName=cAlphaArgs(5) ! putting it as blank will not confuse things later.
ErrorsFound=.true.
ENDIF
ENDIF
IF (SurfaceTmp(SurfNum)%ExtBoundCond == UnenteredAdjacentZoneSurface) THEN ! "Zone" - unmatched interior surface
NeedToAddSurfaces=NeedToAddSurfaces+1
! ignoring window5datafiles for now -- will need to add.
ENDIF
IF (SurfaceTmp(SurfNum)%ExtBoundCond == OtherSideCoefNoCalcExt .or. &
SurfaceTmp(SurfNum)%ExtBoundCond == OtherSideCoefCalcExt) THEN
IF (.not. lAlphaFieldBlanks(5)) THEN ! Otherside Coef special Name
Found=FindItemInList(cAlphaArgs(5),OSC%Name,TotOSC)
IF (Found == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cAlphaFieldNames(5))//'="'//TRIM(cAlphaArgs(5))//'".')
CALL ShowContinueError('...base surface requires that this subsurface have OtherSideCoefficients -- not found.')
ErrorsFound=.true.
ELSE ! found
! The following allows for a subsurface that has different characteristics than
! the base surface with OtherSide Coeff -- do we want that or is it an error?
SurfaceTmp(SurfNum)%OSCPtr=Found
SurfaceTmp(SurfNum)%ExtBoundCondName=cAlphaArgs(5)
IF (OSC(Found)%SurfFilmCoef > 0.0d0) THEN
SurfaceTmp(SurfNum)%ExtBoundCond=OtherSideCoefCalcExt
ELSE
SurfaceTmp(SurfNum)%ExtBoundCond = OtherSideCoefNoCalcExt
ENDIF
ENDIF
ENDIF
ENDIF
IF (SurfaceTmp(SurfNum)%ExtBoundCond == OtherSideCondModeledExt) THEN
SurfaceTmp(SurfNum)%ExtBoundCond = ExternalEnvironment
ENDIF
IF (SurfaceTmp(SurfNum)%ExtBoundCondName == Blank) THEN
SurfaceTmp(SurfNum)%ExtBoundCondName=SurfaceTmp(SurfNum)%Name
ENDIF
SurfaceTmp(SurfNum)%ViewFactorGround = rNumericArgs(1)
IF (lNumericFieldBlanks(1)) SurfaceTmp(SurfNum)%ViewFactorGround = AutoCalculate
IF (lNumericFieldBlanks(3) .or. rNumericArgs(3) == AutoCalculate) THEN
rNumericArgs(3)=(SurfaceNumProp-3)/3
SurfaceTmp(SurfNum)%Sides=rNumericArgs(3)
IF (MOD(SurfaceNumProp-3,3) /= 0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", '//TRIM(cNumericFieldNames(3))// &
' not even multiple of 3. Will read in '// &
TRIM(TrimSigDigits(SurfaceTmp(SurfNum)%Sides)))
ENDIF
IF (rNumericArgs(3) < 3) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", '//TRIM(cNumericFieldNames(3))//' (autocalculate) must be >= 3. Only '// &
TRIM(TrimSigDigits(SurfaceTmp(SurfNum)%Sides))//' provided.')
ErrorsFound=.true.
CYCLE
ENDIF
ELSE
numSides=(SurfaceNumProp-2)/3
SurfaceTmp(SurfNum)%Sides=rNumericArgs(3)
IF (numSides > SurfaceTmp(SurfNum)%Sides) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", field '//TRIM(cNumericFieldNames(3))//'='//TRIM(TrimSigDigits(SurfaceTmp(SurfNum)%Sides)))
CALL ShowContinueError('...but '//TRIM(TrimSigDigits(numSides))//' were entered. Only the indicated '// &
TRIM(cNumericFieldNames(3))//' will be used.')
ENDIF
ENDIF
ALLOCATE(SurfaceTmp(SurfNum)%Vertex(SurfaceTmp(SurfNum)%Sides))
IF(SurfaceTmp(SurfNum)%Class.EQ.SurfaceClass_Window .or. SurfaceTmp(SurfNum)%Class.EQ.SurfaceClass_GlassDoor .or. &
SurfaceTmp(SurfNum)%Class.EQ.SurfaceClass_Door) &
SurfaceTmp(SurfNum)%Multiplier = INT(rNumericArgs(2))
! Only windows, glass doors and doors can have Multiplier > 1:
IF ( (SurfaceTmp(SurfNum)%Class .NE. SurfaceClass_Window .and. SurfaceTmp(SurfNum)%Class .ne. SurfaceClass_GlassDoor .and. &
SurfaceTmp(SurfNum)%Class .NE. SurfaceClass_Door) .AND. rNumericArgs(2) > 1.0d0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cNumericFieldNames(2))//'=['//TRIM(TrimSigDigits(rNumericArgs(2),1))//'].')
CALL ShowContinueError('...because '//TRIM(cAlphaFieldNames(2))//'='//TRIM(cAlphaArgs(2))// &
' multiplier will be set to 1.0.')
SurfaceTmp(SurfNum)%Multiplier = 1.0d0
END IF
CALL GetVertices(SurfNum,SurfaceTmp(SurfNum)%Sides,rNumericArgs(4:))
CALL CheckConvexity(SurfNum,SurfaceTmp(SurfNum)%Sides)
SurfaceTmp(SurfNum)%WindowShadingControlPtr = 0
IF(SurfaceTmp(SurfNum)%Class.EQ.SurfaceClass_Window.OR.SurfaceTmp(SurfNum)%Class.EQ.SurfaceClass_GlassDoor &
.OR.SurfaceTmp(SurfNum)%Class.EQ.SurfaceClass_TDD_Diffuser.OR.SurfaceTmp(SurfNum)%Class.EQ.SurfaceClass_TDD_Dome) THEN
IF (SurfaceTmp(SurfNum)%ExtBoundCond == OtherSideCoefNoCalcExt .or. &
SurfaceTmp(SurfNum)%ExtBoundCond == OtherSideCoefCalcExt) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", Other side coefficients are not allowed with windows.')
ErrorsFound=.true.
END IF
IF (SurfaceTmp(SurfNum)%ExtBoundCond == Ground) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", Exterior boundary condition = Ground is not be allowed with windows.')
ErrorsFound=.true.
END IF
IF (cAlphaArgs(6) /= Blank) THEN
IF (TotWinShadingControl > 0) THEN
SurfaceTmp(SurfNum)%WindowShadingControlPtr = &
FindIteminList(cAlphaArgs(6),WindowShadingControl%Name,TotWinShadingControl)
ENDIF
IF(SurfaceTmp(SurfNum)%WindowShadingControlPtr == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cAlphaFieldNames(6))//'="'//TRIM(cAlphaArgs(6))//'".')
ErrorsFound=.true.
END IF
! Error if this is not an exterior window and shading device has been specified
! PETER: should doors be disallowed too?
IF (SurfaceTmp(SurfNum)%WindowShadingControlPtr > 0 .AND. &
SurfaceTmp(SurfNum)%ExtBoundCond /= ExternalEnvironment) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cAlphaFieldNames(6))//' because it is not an exterior window.')
ErrorsFound=.true.
ELSEIF (Construct(SurfaceTmp(SurfNum)%Construction)%WindowTypeEQL .AND. &
SurfaceTmp(SurfNum)%WindowShadingControlPtr > 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cAlphaFieldNames(6))//'="'//TRIM(cAlphaArgs(6))//'".')
CALL ShowContinueError('.. equivalent layer window model does not use shading control object.')
CALL ShowContinueError('.. Shading control is set to none or zero, and simulation continues.')
SurfaceTmp(SurfNum)%WindowShadingControlPtr = 0
END IF
END IF
CALL CheckWindowShadingControlFrameDivider('GetHTSubSurfaceData',ErrorsFound,SurfNum,7)
IF(SurfaceTmp(SurfNum)%Sides == 3) THEN ! Triangular window
IF(cAlphaArgs(7) /= Blank) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cAlphaFieldNames(7))//'="'//TRIM(cAlphaArgs(7))//'".')
CALL ShowContinueError('.. because it is a triangular window and cannot have a frame or divider or reveal reflection.')
CALL ShowContinueError('Frame, divider and reveal reflection will be ignored for this window.')
END IF
SurfaceTmp(SurfNum)%FrameDivider = 0
END IF ! End of check if window is triangular or rectangular
END IF ! check on non-opaquedoor subsurfaces
CALL CheckSubSurfaceMiscellaneous('GetHTSubSurfaceData',ErrorsFound,SurfNum,cAlphaArgs(1),cAlphaArgs(3),AddedSubSurfaces)
ENDDO ! End of main loop over subsurfaces
RETURN
END SUBROUTINE GetHTSubSurfaceData