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) | :: | TotRectExtWalls | |||
integer, | intent(in) | :: | TotRectIntWalls | |||
integer, | intent(in) | :: | TotRectIZWalls | |||
integer, | intent(in) | :: | TotRectUGWalls | |||
integer, | intent(in) | :: | TotRectRoofs | |||
integer, | intent(in) | :: | TotRectCeilings | |||
integer, | intent(in) | :: | TotRectIZCeilings | |||
integer, | intent(in) | :: | TotRectGCFloors | |||
integer, | intent(in) | :: | TotRectIntFloors | |||
integer, | intent(in) | :: | TotRectIZFloors | |||
integer, | intent(in), | DIMENSION(:) | :: | BaseSurfIDs | ||
integer, | intent(inout) | :: | 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 GetRectSurfaces(ErrorsFound,SurfNum,TotRectExtWalls,TotRectIntWalls,TotRectIZWalls,TotRectUGWalls, &
TotRectRoofs,TotRectCeilings,TotRectIZCeilings,TotRectGCFloors,TotRectIntFloors,TotRectIZFloors, &
BaseSurfIDs,NeedToAddSurfaces)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN December 2008
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Get simple (rectangular, LLC corner specified) walls
! 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) :: TotRectExtWalls ! Number of Exterior Walls to obtain
INTEGER, INTENT(IN) :: TotRectIntWalls ! Number of Adiabatic Walls to obtain
INTEGER, INTENT(IN) :: TotRectIZWalls ! Number of Interzone Walls to obtain
INTEGER, INTENT(IN) :: TotRectUGWalls ! Number of Underground to obtain
INTEGER, INTENT(IN) :: TotRectRoofs ! Number of Roofs to obtain
INTEGER, INTENT(IN) :: TotRectCeilings ! Number of Adiabatic Ceilings to obtain
INTEGER, INTENT(IN) :: TotRectIZCeilings ! Number of Interzone Ceilings to obtain
INTEGER, INTENT(IN) :: TotRectGCFloors ! Number of Floors with Ground Contact to obtain
INTEGER, INTENT(IN) :: TotRectIntFloors ! Number of Adiabatic Walls to obtain
INTEGER, INTENT(IN) :: TotRectIZFloors ! Number of Interzone Floors to obtain
INTEGER, DIMENSION(:), INTENT(IN) :: BaseSurfIDs ! ID Assignments for valid surface classes
INTEGER, INTENT(INOUT) :: NeedToAddSurfaces ! Number of surfaces to add, based on unentered IZ surfaces
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER, DIMENSION(10) :: cModuleObjects= &
(/'Wall:Exterior ', &
'Wall:Adiabatic ', &
'Wall:Interzone ', &
'Wall:Underground ', &
'Roof ', &
'Ceiling:Adiabatic ', &
'Ceiling:Interzone ', &
'Floor:GroundContact', &
'Floor:Adiabatic ', &
'Floor:Interzone '/)
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
! na
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 :: OtherSurfaceField
INTEGER :: ExtBoundCondition
INTEGER :: ClassItem
INTEGER :: ZoneNum
DO Item=1,10
cCurrentModuleObject=cModuleObjects(Item)
IF (Item == 1) THEN
ItemsToGet=TotRectExtWalls
GettingIZSurfaces=.false.
OtherSurfaceField=0
ExtBoundCondition=ExternalEnvironment
ClassItem=1
ELSEIF (Item == 2) THEN
ItemsToGet=TotRectIntWalls
GettingIZSurfaces=.false.
OtherSurfaceField=0
ExtBoundCondition=UnreconciledZoneSurface
ClassItem=1
ELSEIF (Item == 3) THEN
ItemsToGet=TotRectIZWalls
GettingIZSurfaces=.true.
OtherSurfaceField=4
ExtBoundCondition=UnreconciledZoneSurface
ClassItem=1
ELSEIF (Item == 4) THEN
ItemsToGet=TotRectUGWalls
GettingIZSurfaces=.false.
OtherSurfaceField=0
ExtBoundCondition=Ground
ClassItem=1
ELSEIF (Item == 5) THEN
ItemsToGet=TotRectRoofs
GettingIZSurfaces=.false.
OtherSurfaceField=0
ExtBoundCondition=ExternalEnvironment
ClassItem=3
ELSEIF (Item == 6) THEN
ItemsToGet=TotRectCeilings
GettingIZSurfaces=.false.
OtherSurfaceField=0
ExtBoundCondition=UnreconciledZoneSurface
ClassItem=3
ELSEIF (Item == 7) THEN
ItemsToGet=TotRectIZCeilings
GettingIZSurfaces=.false.
OtherSurfaceField=4
ExtBoundCondition=UnreconciledZoneSurface
ClassItem=3
ELSEIF (Item == 8) THEN
ItemsToGet=TotRectGCFloors
GettingIZSurfaces=.false.
OtherSurfaceField=0
ExtBoundCondition=Ground
ClassItem=2
ELSEIF (Item == 9) THEN
ItemsToGet=TotRectIntFloors
GettingIZSurfaces=.false.
OtherSurfaceField=0
ExtBoundCondition=UnreconciledZoneSurface
ClassItem=2
ELSE !IF (Item == 10) THEN
ItemsToGet=TotRectIZFloors
GettingIZSurfaces=.true.
OtherSurfaceField=4
ExtBoundCondition=UnreconciledZoneSurface
ClassItem=2
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 < 7) 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 = BaseSurfIDs(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))//'".')
ELSEIF (Construct(SurfaceTmp(SurfNum)%Construction)%TypeIsWindow) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cAlphaFieldNames(3))//'="'//TRIM(cAlphaArgs(2))// &
'" - has Window materials.')
CALL ShowContinueError('...because '//TRIM(cAlphaFieldNames(2))//'='//TRIM(cAlphaArgs(2)))
ELSE
Construct(SurfaceTmp(SurfNum)%Construction)%IsUsed=.true.
SurfaceTmp(SurfNum)%ConstructionStoredInputValue = SurfaceTmp(SurfNum)%Construction
END IF
SurfaceTmp(SurfNum)%HeatTransSurf=.true.
SurfaceTmp(SurfNum)%BaseSurf = SurfNum
SurfaceTmp(SurfNum)%BaseSurfName=SurfaceTmp(SurfNum)%Name
SurfaceTmp(SurfNum)%ZoneName=cAlphaArgs(3)
ZoneNum=FindItemInList(SurfaceTmp(SurfNum)%ZoneName,Zone%Name,NumOfZones)
IF (ZoneNum /= 0) THEN
SurfaceTmp(SurfNum)%Zone = ZoneNum
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cAlphaFieldNames(3))//'="'//TRIM(cAlphaArgs(3))//'".')
SurfaceTmp(SurfNum)%Class=SurfaceTmp(SurfNum)%Class+100
SurfaceTmp(SurfNum)%ZoneName='Unknown Zone'
ErrorsFound=.true.
ENDIF
SurfaceTmp(SurfNum)%ExtBoundCond = ExtBoundCondition
IF (SurfaceTmp(SurfNum)%Construction > 0) THEN
IF (SurfaceTmp(SurfNum)%Class == SurfaceClass_Wall .and. &
Construct(SurfaceTmp(SurfNum)%Construction)%TypeIsCfactorWall .and. &
SurfaceTmp(SurfNum)%ExtBoundCond == Ground) THEN
SurfaceTmp(SurfNum)%ExtBoundCond = GroundFCfactorMethod
ELSEIF (Construct(SurfaceTmp(SurfNum)%Construction)%TypeIsCfactorWall) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", Construction type is "Construction:CfactorUndergroundWall" but invalid for this object.')
ENDIF
IF (SurfaceTmp(SurfNum)%Class == SurfaceClass_Floor .and. &
Construct(SurfaceTmp(SurfNum)%Construction)%TypeIsFfactorFloor .and. &
SurfaceTmp(SurfNum)%ExtBoundCond == Ground) THEN
SurfaceTmp(SurfNum)%ExtBoundCond = GroundFCfactorMethod
ELSEIF (Construct(SurfaceTmp(SurfNum)%Construction)%TypeIsFfactorFloor) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", Construction type is "Construction:FfactorGroundFloor" but invalid for this object.')
ENDIF
ENDIF
SurfaceTmp(SurfNum)%ExtSolar=.false.
SurfaceTmp(SurfNum)%ExtWind=.false.
SurfaceTmp(SurfNum)%ViewFactorGround = AutoCalculate
IF (SurfaceTmp(SurfNum)%ExtBoundCond == ExternalEnvironment) THEN
SurfaceTmp(SurfNum)%ExtSolar=.true.
SurfaceTmp(SurfNum)%ExtWind=.true.
!Set the logical flag for the EcoRoof presented, this is only based on the flag in the construction type
IF (SurfaceTmp(SurfNum)%Construction > 0) &
SurfaceTmp(SurfNum)%ExtEcoRoof=Construct(SurfaceTmp(SurfNum)%Construction)%TypeIsEcoRoof
Else If (SurfaceTmp(SurfNum)%ExtBoundCond == UnreconciledZoneSurface) THEN
IF (GettingIZSurfaces) THEN
SurfaceTmp(SurfNum)%ExtBoundCondName=cAlphaArgs(OtherSurfaceField)
Found=FindItemInList(SurfaceTmp(SurfNum)%ExtBoundCondName,Zone%Name,NumOfZones)
! see if match to zone, then it's an unentered other surface, else reconciled later
IF (Found > 0) THEN
NeedToAddSurfaces=NeedToAddSurfaces+1
SurfaceTmp(SurfNum)%ExtBoundCond = UnenteredAdjacentZoneSurface
ENDIF
ELSE
SurfaceTmp(SurfNum)%ExtBoundCondName=SurfaceTmp(SurfNum)%Name
ENDIF
Else If (SurfaceTmp(SurfNum)%ExtBoundCond == Ground) THEN
IF (NoGroundTempObjWarning) THEN
IF (.not. GroundTempObjInput) THEN
CALL ShowWarningError('GetRectSurfaces: Surfaces with interface to Ground found '// &
'but no "Ground Temperatures" were input.')
CALL ShowContinueError('Found first in surface='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Defaults, constant throughout the year of ('//TRIM(RoundSigDigits(GroundTemp,1))// &
') will be used.')
ENDIF
NoGroundTempObjWarning=.false.
ENDIF
Else If (SurfaceTmp(SurfNum)%ExtBoundCond == GroundFCfactorMethod) THEN
IF (NoFCGroundTempObjWarning) THEN
IF (.not. FCGroundTemps) THEN
CALL ShowSevereError('GetRectSurfaces: Surfaces with interface to GroundFCfactorMethod found '// &
'but no "FC Ground Temperatures" were input.')
CALL ShowContinueError('Found first in surface='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Either add a "Site:GroundTemperature:FCfactorMethod" object or '// &
' use a weather file with Ground Temperatures.')
ErrorsFound=.true.
NoFCGroundTempObjWarning=.false.
ENDIF
End IF
End If ! ... End of the ExtBoundCond logical IF Block
SurfaceTmp(SurfNum)%Azimuth=rNumericArgs(1)
SurfaceTmp(SurfNum)%Tilt=rNumericArgs(2)
IF (.not. WorldCoordSystem) THEN
IF (ZoneNum /= 0) THEN
SurfaceTmp(SurfNum)%Azimuth=SurfaceTmp(SurfNum)%Azimuth+BuildingAzimuth+Zone(ZoneNum)%RelNorth
ENDIF
ENDIF
IF (ZoneNum /= 0) THEN
SurfaceTmp(SurfNum)%Azimuth=SurfaceTmp(SurfNum)%Azimuth+BuildingRotationAppendixG
ENDIF
SurfaceTmp(SurfNum)%Sides=4
ALLOCATE(SurfaceTmp(SurfNum)%Vertex(SurfaceTmp(SurfNum)%Sides))
CALL MakeRectangularVertices(SurfNum,rNumericArgs(3), &
rNumericArgs(4),rNumericArgs(5),rNumericArgs(6),rNumericArgs(7),RectSurfRefWorldCoordSystem)
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
!Check wall height for the CFactor walls
IF (SurfaceTmp(SurfNum)%Class == SurfaceClass_Wall .and. SurfaceTmp(SurfNum)%ExtBoundCond == GroundFCfactorMethod) THEN
IF (ABS(SurfaceTmp(SurfNum)%Height - Construct(SurfaceTmp(SurfNum)%Construction)%Height)>0.05d0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", underground Wall Height = '//TRIM(TrimSigDigits(SurfaceTmp(SurfNum)%Height,2)))
CALL ShowContinueError('..which deos not match its construction height.')
ENDIF
ENDIF
!Check area and perimeter for the FFactor floors
IF (SurfaceTmp(SurfNum)%Class == SurfaceClass_Floor .and. SurfaceTmp(SurfNum)%ExtBoundCond == GroundFCfactorMethod) THEN
IF (ABS(SurfaceTmp(SurfNum)%Area - Construct(SurfaceTmp(SurfNum)%Construction)%Area)>0.1d0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", underground Floor Area = '//TRIM(TrimSigDigits(SurfaceTmp(SurfNum)%Area,2)))
CALL ShowContinueError('..which does not match its construction area.')
ENDIF
IF (SurfaceTmp(SurfNum)%Perimeter < Construct(SurfaceTmp(SurfNum)%Construction)%PerimeterExposed - 0.1d0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", underground Floor Perimeter = '//TRIM(TrimSigDigits(SurfaceTmp(SurfNum)%Perimeter,2)))
CALL ShowContinueError('..which is less than its construction exposed perimeter.')
ENDIF
ENDIF
ENDDO ! Getting Items
ENDDO
RETURN
END SUBROUTINE GetRectSurfaces