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) | :: | TotWindows | |||
integer, | intent(in) | :: | TotDoors | |||
integer, | intent(in) | :: | TotGlazedDoors | |||
integer, | intent(in) | :: | TotIZWindows | |||
integer, | intent(in) | :: | TotIZDoors | |||
integer, | intent(in) | :: | TotIZGlazedDoors | |||
integer, | intent(in), | DIMENSION(:) | :: | SubSurfIDs | ||
integer, | intent(inout) | :: | AddedSubSurfaces | |||
integer, | intent(inout) | :: | NeedToAddSubSurfaces |
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 GetRectSubSurfaces(ErrorsFound,SurfNum,TotWindows,TotDoors,TotGlazedDoors, &
TotIZWindows,TotIZDoors,TotIZGlazedDoors, &
SubSurfIDs,AddedSubSurfaces,NeedToAddSubSurfaces)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN December 2008
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Get simple (rectangular, relative origin to base surface) windows, doors, glazed doors.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! 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) :: TotWindows ! Number of Window SubSurfaces to obtain
INTEGER, INTENT(IN) :: TotDoors ! Number of Door SubSurfaces to obtain
INTEGER, INTENT(IN) :: TotGlazedDoors ! Number of Glass Door SubSurfaces to obtain
INTEGER, INTENT(IN) :: TotIZWindows ! Number of Interzone Window SubSurfaces to obtain
INTEGER, INTENT(IN) :: TotIZDoors ! Number of Interzone Door SubSurfaces to obtain
INTEGER, INTENT(IN) :: TotIZGlazedDoors ! Number of Interzone Glass Door SubSurfaces to obtain
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(INOUT) :: NeedToAddSubSurfaces ! Number of surfaces to add, based on unentered IZ surfaces
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER, DIMENSION(6) :: cModuleObjects= &
(/'Window ', &
'Door ', &
'GlazedDoor ', &
'Window:Interzone ', &
'Door:Interzone ', &
'GlazedDoor:Interzone'/)
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: Item
INTEGER :: ItemsToGet
INTEGER :: Loop
INTEGER :: NumAlphas
INTEGER :: NumNumbers
INTEGER :: IOStat ! IO Status when calling get input subroutine
INTEGER :: Found ! For matching base surfaces
LOGICAL :: ErrorInName
LOGICAL :: IsBlank
LOGICAL :: GettingIZSurfaces
INTEGER :: WindowShadingField
INTEGER :: FrameField
INTEGER :: OtherSurfaceField
INTEGER :: ClassItem
INTEGER :: IZFound
DO Item=1,6
cCurrentModuleObject=cModuleObjects(Item)
IF (Item == 1) THEN
ItemsToGet=TotWindows
GettingIZSurfaces=.false.
WindowShadingField=4
FrameField=5
OtherSurfaceField=0
ClassItem=1
ELSEIF (Item == 2) THEN
ItemsToGet=TotDoors
GettingIZSurfaces=.false.
WindowShadingField=0
FrameField=0
OtherSurfaceField=0
ClassItem=2
ELSEIF (Item == 3) THEN
ItemsToGet=TotGlazedDoors
GettingIZSurfaces=.false.
WindowShadingField=4
FrameField=5
OtherSurfaceField=0
ClassItem=3
ELSEIF (Item == 4) THEN
ItemsToGet=TotIZWindows
GettingIZSurfaces=.true.
WindowShadingField=0
FrameField=0
OtherSurfaceField=4
ClassItem=1
ELSEIF (Item == 5) THEN
ItemsToGet=TotIZDoors
GettingIZSurfaces=.true.
WindowShadingField=0
FrameField=0
OtherSurfaceField=4
ClassItem=2
ELSE ! Item = 6
ItemsToGet=TotIZGlazedDoors
GettingIZSurfaces=.true.
WindowShadingField=0
FrameField=0
OtherSurfaceField=4
ClassItem=3
ENDIF
DO Loop=1,ItemsToGet
CALL GetObjectItem(cCurrentModuleObject,Loop,cAlphaArgs,NumAlphas,rNumericArgs,NumNumbers,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 (NumNumbers < 5) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))// &
'", Too few number of numeric args=['//TRIM(TrimSigDigits(NumNumbers))//'].')
ErrorsFound=.true.
ENDIF
SurfNum=SurfNum+1
SurfaceTmp(SurfNum)%Name = cAlphaArgs(1) ! Set the Surface Name in the Derived Type
SurfaceTmp(SurfNum)%Class = SubSurfIDs(ClassItem) ! Set class number
SurfaceTmp(SurfNum)%Construction=FindIteminList(cAlphaArgs(2),Construct%Name,TotConstructs)
IF(SurfaceTmp(SurfNum)%Construction == 0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cAlphaFieldNames(2))//'="'//TRIM(cAlphaArgs(2))//'".')
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) 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(2))//'="'//TRIM(cAlphaArgs(2))// &
'" - has Window materials.')
ENDIF
ENDIF
SurfaceTmp(SurfNum)%HeatTransSurf=.true.
SurfaceTmp(SurfNum)%BaseSurfName=cAlphaArgs(3)
! 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)%Tilt=SurfaceTmp(Found)%Tilt
SurfaceTmp(SurfNum)%Azimuth=SurfaceTmp(Found)%Azimuth
SurfaceTmp(SurfNum)%Zone=SurfaceTmp(Found)%Zone
SurfaceTmp(SurfNum)%ZoneName=SurfaceTmp(Found)%ZoneName
SurfaceTmp(SurfNum)%OSCPtr=SurfaceTmp(Found)%OSCPtr
SurfaceTmp(SurfNum)%ViewFactorGround = SurfaceTmp(Found)%ViewFactorGround
SurfaceTmp(SurfNum)%ViewFactorSky = SurfaceTmp(Found)%ViewFactorSky
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cAlphaFieldNames(3))//'="'//TRIM(cAlphaArgs(3)))
SurfaceTmp(SurfNum)%ZoneName='Unknown Zone'
ErrorsFound=.true.
CYCLE
ENDIF
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(3))//'="'//TRIM(cAlphaArgs(3))//'".')
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
IF (SurfaceTmp(SurfNum)%ExtBoundCond == UnreconciledZoneSurface) THEN ! "Surface" Base Surface
IF (.not. GettingIZSurfaces) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid use of object')
CALL ShowContinueError('...when Base surface uses "Surface" as '//trim(cAlphaFieldNames(5))// &
', subsurfaces must also specify specific surfaces in the adjacent zone.')
CALL ShowContinueError('...Please use '//trim(cCurrentModuleObject)//':Interzone to enter this surface.')
SurfaceTmp(SurfNum)%ExtBoundCondName=blank ! putting it as blank will not confuse things later.
ErrorsFound=.true.
ENDIF
ENDIF
IF (SurfaceTmp(SurfNum)%ExtBoundCond == UnreconciledZoneSurface) THEN ! "Surface" Base Surface
IF (GettingIZSurfaces) THEN
SurfaceTmp(SurfNum)%ExtBoundCondName=cAlphaArgs(OtherSurfaceField)
IZFound=FindItemInList(SurfaceTmp(SurfNum)%ExtBoundCondName,Zone%Name,NumOfZones)
IF (IZFound > 0) SurfaceTmp(SurfNum)%ExtBoundCond=UnenteredAdjacentZoneSurface
ELSE ! Interior Window
SurfaceTmp(SurfNum)%ExtBoundCondName=SurfaceTmp(SurfNum)%Name
ENDIF
ENDIF
! This is the parent's property:
IF (SurfaceTmp(SurfNum)%ExtBoundCond == UnenteredAdjacentZoneSurface) THEN ! OtherZone - unmatched interior surface
IF (GettingIZSurfaces) THEN
NeedToAddSubSurfaces=NeedToAddSubSurfaces+1
ELSE ! Interior Window
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid Interzone Surface, specify '//trim(cCurrentModuleObject)//':InterZone')
CALL ShowContinueError('...when base surface is an interzone surface, subsurface must also be an interzone surface.')
NeedToAddSubSurfaces=NeedToAddSubSurfaces+1
ErrorsFound=.true.
ENDIF
ENDIF
IF (GettingIZSurfaces) THEN
IF (lAlphaFieldBlanks(OtherSurfaceField)) THEN
! blank -- set it up for unentered adjacent zone
IF (SurfaceTmp(SurfNum)%ExtBoundCond == UnenteredAdjacentZoneSurface) THEN ! already set but need Zone
SurfaceTmp(SurfNum)%ExtBoundCondName=SurfaceTmp(Found)%ExtBoundCondName ! base surface has it
ELSEIF (SurfaceTmp(SurfNum)%ExtBoundCond == UnreconciledZoneSurface) THEN
SurfaceTmp(SurfNum)%ExtBoundCondName=SurfaceTmp(Found)%ZoneName ! base surface has it
SurfaceTmp(SurfNum)%ExtBoundCond=UnenteredAdjacentZoneSurface
ELSE ! not correct boundary condition for interzone subsurface
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid Base Surface type for Interzone Surface')
CALL ShowContinueError('...when base surface is not an interzone surface, '// &
'subsurface must also not be an interzone surface.')
ErrorsFound=.true.
ENDIF
ENDIF
ENDIF
IF (SurfaceTmp(SurfNum)%ExtBoundCond == OtherSideCondModeledExt) THEN
SurfaceTmp(SurfNum)%ExtBoundCond = ExternalEnvironment
ENDIF
! SurfaceTmp(SurfNum)%ViewFactorGround = AutoCalculate
SurfaceTmp(SurfNum)%Sides=4
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(1))
! 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(1) > 1.0d0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cNumericFieldNames(1))//'=['//TRIM(TrimSigDigits(rNumericArgs(1),1))//'].')
CALL ShowContinueError('...because '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1))// &
' multiplier will be set to 1.0.')
SurfaceTmp(SurfNum)%Multiplier = 1.0d0
END IF
CALL MakeRelativeRectangularVertices(SurfaceTmp(SurfNum)%BaseSurf,SurfNum, &
rNumericArgs(2),rNumericArgs(3),rNumericArgs(4),rNumericArgs(5))
IF (SurfaceTmp(SurfNum)%Area <= 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", Surface Area <= 0.0; Entered Area='// &
TRIM(TrimSigDigits(SurfaceTmp(SurfNum)%Area,2)))
ErrorsFound=.true.
ENDIF
SurfaceTmp(SurfNum)%WindowShadingControlPtr = 0
IF(.not. GettingIZSurfaces .and. &
(SurfaceTmp(SurfNum)%Class.EQ.SurfaceClass_Window.OR.SurfaceTmp(SurfNum)%Class.EQ.SurfaceClass_GlassDoor)) 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(WindowShadingField) /= Blank) THEN
IF (TotWinShadingControl > 0) THEN
SurfaceTmp(SurfNum)%WindowShadingControlPtr = &
FindIteminList(cAlphaArgs(WindowShadingField),WindowShadingControl%Name,TotWinShadingControl)
ENDIF
IF(SurfaceTmp(SurfNum)%WindowShadingControlPtr == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cAlphaFieldNames(WindowShadingField))//'="'//TRIM(cAlphaArgs(WindowShadingField))//'".')
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(WindowShadingField))//' because it is not an exterior window.')
ErrorsFound=.true.
END IF
END IF
CALL CheckWindowShadingControlFrameDivider('GetRectSubSurfaces',ErrorsFound,SurfNum,FrameField)
END IF ! check on non-opaquedoor subsurfaces
CALL CheckSubSurfaceMiscellaneous('GetRectSubSurfaces',ErrorsFound,SurfNum,cAlphaArgs(1),cAlphaArgs(2),AddedSubSurfaces)
ENDDO ! Getting Items
ENDDO
RETURN
END SUBROUTINE GetRectSubSurfaces