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 | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | SurfNum | |||
logical, | intent(inout) | :: | ErrorsFound | |||
integer, | intent(inout) | :: | AddedSubSurfaces |
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 ModifyWindow(SurfNum,ErrorsFound,AddedSubSurfaces)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Winkelmann
! DATE WRITTEN Feb 2002
! MODIFIED June 2004, FCW: SinAzim, CosAzim, SinTilt, CosTilt, OutNormVec, GrossArea
! and Perimeter weren't being set for created window for case when
! window from Window5DataFile had two different glazing systems. Also,
! GrossArea and Perimeter of original window were not being recalculated.
! October 2007, LKL: Net area for shading calculations was not being
! recalculated.
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! If a window from the Window5DataFile has one glazing system, modify the
! vertex coordinates of the original window to correspond to the dimensions
! of the glazing system on the Data File.
! If a window from the Window5DataFile has two different glazing systems, split
! the window into two separate windows with different properties and adjust the
! vertices of these windows taking into account the dimensions of the glazing systems
! on the Data File and the width and orientation of the mullion that separates
! the glazing systems.
! METHODOLOGY EMPLOYED:na
! REFERENCES:na
! USE STATEMENTS:
USE InputProcessor, ONLY: FindItemInList
USE General, ONLY: RoundSigDigits
USE Vectors
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: SurfNum ! SurfNum has construction of glazing system from Window5 Data File;
! If there is a second glazing systme on the Data File, SurfNum+1
! has the construction of the second glazing system.
LOGICAL, INTENT(INOUT) :: ErrorsFound ! Set to true if errors found
INTEGER, INTENT(INOUT) :: AddedSubSurfaces ! Subsurfaces added when window references a
! 2-glazing system Window5 data file entry
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
type rectangularwindow
type(vector), dimension(4) :: Vertex
end type rectangularwindow
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
!unused1208 INTEGER :: TotSurfacesPrev ! Total number of surfaces before splitting window
!unused1208 INTEGER :: loop ! DO loop index
REAL(r64) :: H,W ! Height and width of original window (m)
!unused1208 REAL(r64) :: MulWidth ! Mullion width (m)
REAL(r64) :: h1,w1 ! height and width of first glazing system (m)
!unused1208 REAL(r64) :: h2,w2 ! height and width of second glazing system (m)
type (vector) TVect
!unused1208 type (rectangularwindow) :: NewCoord
type (rectangularwindow) :: OriginalCoord
INTEGER :: IConst ! Construction number of first glazing system
INTEGER :: IConst2 ! Construction number of second glazing system
CHARACTER(len=MaxNameLength) :: Const2Name ! Name of construction of second glazing system
!unused1208 REAL(r64) :: AreaNew ! Sum of areas of the two glazing systems (m2)
IConst = SurfaceTmp(SurfNum)%Construction
! Height and width of original window
TVect=SurfaceTmp(SurfNum)%Vertex(3)-SurfaceTmp(SurfNum)%Vertex(2)
W = VecLength(TVect) !SQRT((X(3)-X(2))**2 + (Y(3)-Y(2))**2 + (Z(3)-Z(2))**2)
TVect=SurfaceTmp(SurfNum)%Vertex(2)-SurfaceTmp(SurfNum)%Vertex(1)
H = VecLength(TVect) !SQRT((X(1)-X(2))**2 + (Y(1)-Y(2))**2 + (Z(1)-Z(2))**2)
! Save coordinates of original window in case Window 5 data overwrites.
OriginalCoord%Vertex(1:SurfaceTmp(SurfNum)%Sides)=SurfaceTmp(SurfNum)%Vertex(1:SurfaceTmp(SurfNum)%Sides)
! Height and width of first glazing system
h1 = Construct(IConst)%W5FileGlazingSysHeight
w1 = Construct(IConst)%W5FileGlazingSysWidth
Const2Name = TRIM(Construct(IConst)%Name)//':2'
IConst2 = FindItemInList(Const2Name, Construct%Name,TotConstructs)
IF(IConst2 == 0) THEN ! Only one glazing system on Window5 Data File for this window.
! So... original dimensions and area of window are used (entered in IDF)
! Warning if dimensions of original window differ from those on Data File by more than 10%
IF(ABS((H-h1)/H) > 0.10d0 .OR. ABS((W-w1)/W) > 0.10d0) THEN
IF (DisplayExtraWarnings) THEN
CALL ShowWarningError('SurfaceGeometry: ModifyWindow: Window '//TRIM(SurfaceTmp(SurfNum)%Name)// &
' uses the Window5 Data File Construction '//TRIM(Construct(IConst)%Name))
CALL ShowContinueError('The height '//TRIM(RoundSigDigits(H,3))//'(m) or width '// &
TRIM(RoundSigDigits(W,3))//' (m) of this window differs by more than 10%')
CALL ShowContinueError('from the corresponding height '//TRIM(RoundSigDigits(h1,3))// &
' (m) or width '//TRIM(RoundSigDigits(w1,3))//' (m) on the Window5 Data file.')
CALL ShowContinueError('This will affect the frame heat transfer calculation if the frame in the Data File entry')
CALL ShowContinueError('is not uniform, i.e., has sections with different geometry and/or thermal properties.')
ELSE
Warning1Count=Warning1Count+1
ENDIF
END IF
! Calculate net area for base surface
SurfaceTmp(SurfaceTmp(SurfNum)%BaseSurf)%Area = &
SurfaceTmp(SurfaceTmp(SurfNum)%BaseSurf)%Area - SurfaceTmp(SurfNum)%Area
IF (SurfaceTmp(SurfaceTmp(SurfNum)%BaseSurf)%Area <= 0.0d0) THEN
CALL ShowSevereError('Subsurfaces have too much area for base surface='// &
TRIM(SurfaceTmp(SurfaceTmp(SurfNum)%BaseSurf)%Name))
CALL ShowContinueError('Subsurface creating error='//TRIM(SurfaceTmp(SurfNum)%Name))
ErrorsFound=.true.
ENDIF
! Net area of base surface with unity window multipliers (used in shadowing checks)
SurfaceTmp(SurfaceTmp(SurfNum)%BaseSurf)%NetAreaShadowCalc = &
SurfaceTmp(SurfaceTmp(SurfNum)%BaseSurf)%NetAreaShadowCalc - &
SurfaceTmp(SurfNum)%Area/SurfaceTmp(SurfNum)%Multiplier
ELSE ! Two glazing systems on Window5 data file for this window
! if exterior window, okay.
IF (SurfaceTmp(SurfNum)%ExtBoundCond == ExternalEnvironment) THEN
!There are two glazing systems (separated by a vertical or horizontal mullion) on the Window5 Data File.
! Fill in geometry data for the second window (corresponding to the second glazing system on the data file.
! The first glazing system is assumed to be at left for vertical mullion, at bottom for horizontal mullion.
! The second glazing system is assumed to be at right for vertical mullion, at top for horizontal mullion.
! The lower left-hand corner of the original window (its vertex #2) is assumed to coincide with
! vertex #2 of the first glazing system.
IF (DisplayExtraWarnings) THEN
CALL ShowMessage('SurfaceGeometry: ModifyWindow: Window '// &
TRIM(SurfaceTmp(SurfNum)%Name)//' has been replaced with the Window 5/6 two glazing system="'// &
TRIM(Construct(IConst)%Name)//'".')
CALL ShowContinueError('Note that originally entered dimensions are overridden.')
ELSE
Warning2Count=Warning2Count+1
ENDIF
! Allocate another window
CALL AddWindow(SurfNum,ErrorsFound,AddedSubSurfaces)
ELSEIF (SurfaceTmp(SurfNum)%ExtBoundCond > 0) THEN ! Interior window, specified ! not external environment
IF (DisplayExtraWarnings) THEN
CALL ShowWarningError('SurfaceGeometry: ModifyWindow: Interior Window '// &
TRIM(SurfaceTmp(SurfNum)%Name)//' has been replaced with the Window 5/6 two glazing system="'// &
TRIM(Construct(IConst)%Name)//'".')
CALL ShowContinueError('Please check to make sure interior window is correct. '// &
'Note that originally entered dimensions are overridden.')
ELSE
Warning3Count=Warning3Count+1
ENDIF
CALL AddWindow(SurfNum,ErrorsFound,AddedSubSurfaces)
ELSE ! Interior window, specified not entered
CALL ShowSevereError('SurfaceGeometry: ModifyWindow: Interior Window '// &
TRIM(SurfaceTmp(SurfNum)%Name)//' is a window in an adjacent zone.')
CALL ShowContinueError('Attempted to add/reverse Window 5/6 multiple glazing system="'// &
TRIM(Construct(IConst)%Name)//'".')
CALL ShowContinueError('Cannot use these Window 5/6 constructs for these Interior Windows. Program will terminate.')
ErrorsFound=.true.
ENDIF
END IF ! End of check if one or two glazing systems are on the Window5 Data File
END SUBROUTINE ModifyWindow