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 | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | cRoutineName | |||
logical, | intent(inout) | :: | ErrorsFound | |||
integer, | intent(in) | :: | SurfNum | |||
character(len=*), | intent(in) | :: | SubSurfaceName | |||
character(len=*), | intent(in) | :: | SubSurfaceConstruction | |||
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 CheckSubSurfaceMiscellaneous(cRoutineName,ErrorsFound,SurfNum,SubSurfaceName,SubSurfaceConstruction,AddedSubSurfaces)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN December 2008
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This routine performs miscellaneous checks on subsurfaces: Windows, GlassDoors, Doors, Tubular Devices.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
! USE DataIPShortCuts
USE InputProcessor, ONLY: FindItemInList
USE General, ONLY: TrimSigDigits,RoundSigDigits
USE DataErrorTracking
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*), INTENT(IN) :: cRoutineName ! routine name calling this one (for error messages)
LOGICAL, INTENT(INOUT) :: ErrorsFound ! true if errors have been found or are found here
INTEGER, INTENT(IN) :: SurfNum ! current surface number
CHARACTER(len=*), INTENT(IN) :: SubSurfaceName ! name of the surface
CHARACTER(len=*), INTENT(IN) :: SubSurfaceConstruction ! name of the construction
INTEGER, INTENT(INOUT) :: AddedSubSurfaces
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: NumShades ! count on number of shading layers
INTEGER :: Lay ! Layer number
INTEGER :: LayerPtr ! Layer pointer
INTEGER :: ConstrNum ! Construction number
INTEGER :: Found ! when item is found
! Warning if window has multiplier > 1 and SolarDistribution = FullExterior or FullInteriorExterior
IF((SurfaceTmp(SurfNum)%Class == SurfaceClass_Window .or. SurfaceTmp(SurfNum)%Class == SurfaceClass_GlassDoor) &
.AND. SolarDistribution > MinimalShadowing .AND. SurfaceTmp(SurfNum)%Multiplier > 1.0d0) THEN
IF (DisplayExtraWarnings) THEN
CALL ShowWarningError(trim(cRoutineName)//': A Multiplier > 1.0 for window/glass door '//TRIM(SurfaceTmp(SurfNum)%Name))
CALL ShowContinueError('in conjunction with SolarDistribution = FullExterior or FullInteriorExterior')
CALL ShowContinueError('can cause inaccurate shadowing on the window and/or')
CALL ShowContinueError('inaccurate interior solar distribution from the window.')
ENDIF
TotalMultipliedWindows=TotalMultipliedWindows+1
END IF
! Require that a construction referenced by a surface that is a window
! NOT have a shading device layer; use WindowShadingControl to specify a shading device.
ConstrNum=SurfaceTmp(SurfNum)%Construction
IF(ConstrNum > 0) THEN
NumShades = 0
DO Lay = 1,Construct(ConstrNum)%TotLayers
LayerPtr = Construct(ConstrNum)%LayerPoint(Lay)
IF (LayerPtr == 0) CYCLE ! Error is caught already, will terminate later
IF(Material(LayerPtr)%Group==Shade .OR. Material(LayerPtr)%Group==WindowBlind .OR. &
Material(LayerPtr)%Group==Screen) NumShades = NumShades + 1
END DO
IF(NumShades /= 0) THEN
CALL ShowSevereError(trim(cRoutineName)//': Window "'//TRIM(SubSurfaceName)//'" must not directly reference')
CALL ShowContinueError('a Construction (i.e, "'//TRIM(SubSurfaceConstruction)//'") with a shading device.')
CALL ShowContinueError('Use WindowProperty:ShadingControl to specify a shading device for a window.')
ErrorsFound = .true.
END IF
END IF
! Disallow glass transmittance dirt factor for interior windows and glass doors
IF(SurfaceTmp(SurfNum)%ExtBoundCond /= ExternalEnvironment .AND. &
(SurfaceTmp(SurfNum)%Class == SurfaceClass_Window .OR. SurfaceTmp(SurfNum)%Class == SurfaceClass_GlassDoor)) THEN
ConstrNum = SurfaceTmp(SurfNum)%Construction
IF (ConstrNum > 0) THEN
DO Lay = 1,Construct(ConstrNum)%TotLayers
LayerPtr = Construct(ConstrNum)%LayerPoint(Lay)
IF(Material(LayerPtr)%Group == WindowGlass .AND. Material(LayerPtr)%GlassTransDirtFactor < 1.0d0) THEN
CALL ShowSevereError(trim(cRoutineName)//': Interior Window or GlassDoor '//TRIM(SubSurfaceName)// &
' has a glass layer with')
CALL ShowContinueError('Dirt Correction Factor for Solar and Visible Transmittance < 1.0')
CALL ShowContinueError('A value less than 1.0 for this factor is only allowed for exterior windows and glass doors.')
ErrorsFound = .true.
END IF
END DO
ENDIF
END IF
! If this is a window with a construction from the Window5DataFile, call routine that will
! (1) if one glazing system on Data File, give warning message if window height or width
! differ by more than 10% from those of the glazing system on the Data File;
! (2) if two glazing systems (separated by a mullion) on Data File, create a second window
! and adjust the dimensions of the original and second windows to those on the Data File
IF (SurfaceTmp(SurfNum)%Construction /= 0) THEN
IF(Construct(SurfaceTmp(SurfNum)%Construction)%FromWindow5DataFile) THEN
CALL ModifyWindow(SurfNum,ErrorsFound,AddedSubSurfaces)
ELSE
! Calculate net area for base surface (note that ModifyWindow, above, adjusts net area of
! base surface for case where window construction is from Window5 Data File
! In case there is in error in this window's base surface (i.e. none)..
IF (SurfaceTmp(SurfNum)%BaseSurf > 0) THEN
SurfaceTmp(SurfaceTmp(SurfNum)%BaseSurf)%Area = &
SurfaceTmp(SurfaceTmp(SurfNum)%BaseSurf)%Area - SurfaceTmp(SurfNum)%Area
! Subtract TDD:DIFFUSER area from other side interzone surface
IF (SurfaceTmp(SurfNum)%Class == SurfaceClass_TDD_Diffuser .AND. &
SurfaceTmp(SurfaceTmp(SurfNum)%BaseSurf)%ExtBoundCondName /= ' ') THEN ! Base surface is an interzone surface
! Lookup interzone surface of the base surface
! (Interzone surfaces have not been assigned yet, but all base surfaces should already be loaded.)
Found = FindIteminList(SurfaceTmp(SurfaceTmp(SurfNum)%BaseSurf)%ExtBoundCondName,SurfaceTmp%Name,SurfNum)
IF (Found /= 0) SurfaceTmp(Found)%Area = SurfaceTmp(Found)%Area - SurfaceTmp(SurfNum)%Area
END IF
IF (SurfaceTmp(SurfaceTmp(SurfNum)%BaseSurf)%Area <= 0.0d0) THEN
CALL ShowSevereError(trim(cRoutineName)//': Surface Openings have too much area for base surface='// &
TRIM(SurfaceTmp(SurfaceTmp(SurfNum)%BaseSurf)%Name))
CALL ShowContinueError('Opening Surface creating error='//TRIM(SurfaceTmp(SurfNum)%Name))
ErrorsFound=.true.
ENDIF
! Net area of base surface with unity window multipliers (used in shadowing checks)
! For Windows, Glass Doors and Doors, just one area is subtracted. For the rest, should be
! full area.
IF (SurfaceTmp(SurfNum)%Class == SurfaceClass_Window .OR.SurfaceTmp(SurfNum)%Class == SurfaceClass_GlassDoor) THEN
SurfaceTmp(SurfaceTmp(SurfNum)%BaseSurf)%NetAreaShadowCalc = &
SurfaceTmp(SurfaceTmp(SurfNum)%BaseSurf)%NetAreaShadowCalc - &
SurfaceTmp(SurfNum)%Area/SurfaceTmp(SurfNum)%Multiplier
ELSEIF (SurfaceTmp(SurfNum)%Class == SurfaceClass_Door) THEN ! Door, TDD:Diffuser, TDD:DOME
SurfaceTmp(SurfaceTmp(SurfNum)%BaseSurf)%NetAreaShadowCalc = &
SurfaceTmp(SurfaceTmp(SurfNum)%BaseSurf)%NetAreaShadowCalc - &
SurfaceTmp(SurfNum)%Area/SurfaceTmp(SurfNum)%Multiplier
ELSE
SurfaceTmp(SurfaceTmp(SurfNum)%BaseSurf)%NetAreaShadowCalc = &
SurfaceTmp(SurfaceTmp(SurfNum)%BaseSurf)%NetAreaShadowCalc - SurfaceTmp(SurfNum)%Area
ENDIF
ENDIF
ENDIF
ENDIF
RETURN
END SUBROUTINE CheckSubSurfaceMiscellaneous