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) | :: | TotHTSurfs | |||
integer, | intent(in) | :: | TotDetailedWalls | |||
integer, | intent(in) | :: | TotDetailedRoofs | |||
integer, | intent(in) | :: | TotDetailedFloors | |||
character(len=*), | intent(in), | DIMENSION(:) | :: | BaseSurfCls | ||
integer, | intent(in), | DIMENSION(:) | :: | BaseSurfIDs | ||
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 GetHTSurfaceData(ErrorsFound,SurfNum,TotHTSurfs,TotDetailedWalls,TotDetailedRoofs,TotDetailedFloors, &
BaseSurfCls,BaseSurfIDs,NeedToAddSurfaces)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN May 2000
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine gets the HeatTransfer Surface Data,
! checks it for errors, etc.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! Heat Transfer Surface Definition
!BuildingSurface:Detailed,
! \extensible:3 -- duplicate last set of x,y,z coordinates (last 3 fields), remembering to remove ; from "inner" fields.
! \format vertices
! A1 , \field Name
! \required-field
! \type alpha
! \reference SurfaceNames
! \reference SurfAndSubSurfNames
! \reference AllHeatTranSurfNames
! \reference HeatTranBaseSurfNames
! \reference OutFaceEnvNames
! \reference AllHeatTranAngFacNames
! \reference RadGroupAndSurfNames
! \reference SurfGroupAndHTSurfNames
! \reference AllShadingAndHTSurfNames
! A2 , \field Surface Type
! \required-field
! \type choice
! \key Floor
! \key Wall
! \key Ceiling
! \key Roof
! 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 Zone Name
! \required-field
! \note Zone the surface is a part of
! \type object-list
! \object-list ZoneNames
! A5 , \field Outside Boundary Condition
! \required-field
! \type choice
! \key Adiabatic
! \key Surface
! \key Zone
! \key Outdoors
! \key Ground
! \key GroundFCfactorMethod
! \key OtherSideCoefficients
! \key OtherSideConditionsModel
! \key GroundSlabPreprocessorAverage
! \key GroundSlabPreprocessorCore
! \key GroundSlabPreprocessorPerimeter
! \key GroundBasementPreprocessorAverageWall
! \key GroundBasementPreprocessorAverageFloor
! \key GroundBasementPreprocessorUpperWall
! \key GroundBasementPreprocessorLowerWall
! A6, \field Outside Boundary Condition Object
! \type object-list
! \object-list OutFaceEnvNames
! \note Non-blank only if the field Outside Boundary Condition is Surface,
! \note Zone, OtherSideCoefficients or OtherSideConditionsModel
! \note If Surface, specify name of corresponding surface in adjacent zone or
! \note specify current surface name for internal partition separating like zones
! \note If Zone, specify the name of the corresponding zone and
! \note the program will generate the corresponding interzone surface
! \note If OtherSideCoefficients, specify name of SurfaceProperty:OtherSideCoefficients
! \note If OtherSideConditionsModel, specify name of SurfaceProperty:OtherSideConditionsModel
! A7 , \field Sun Exposure
! \required-field
! \type choice
! \key SunExposed
! \key NoSun
! \default SunExposed
! A8, \field Wind Exposure
! \required-field
! \type choice
! \key WindExposed
! \key NoWind
! \default WindExposed
! 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
! N2 , \field Number of Vertices
! \note shown with 120 vertex coordinates -- extensible object
! \note "extensible" -- duplicate last set of x,y,z coordinates (last 3 fields),
! \note remembering to remove ; from "inner" fields.
! \note for clarity in any error messages, renumber the fields as well.
! \note (and changing z terminator to a comma "," for all but last one which needs a semi-colon ";")
! \autocalculatable
! \minimum 3
! \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.
! N3-xx as indicated by the N3 value
! USE STATEMENTS:
USE DataIPShortCuts
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, FindItemInList, VerifyName, SameString, GetObjectDefMaxArgs
USE General, ONLY: RoundSigDigits,TrimSigDigits
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) :: TotHTSurfs ! Number of Heat Transfer Base Surfaces to obtain
INTEGER, INTENT(IN) :: TotDetailedWalls ! Number of Wall:Detailed items to obtain
INTEGER, INTENT(IN) :: TotDetailedRoofs ! Number of RoofCeiling:Detailed items to obtain
INTEGER, INTENT(IN) :: TotDetailedFloors ! Number of Floor:Detailed items to obtain
CHARACTER(len=*), DIMENSION(:), INTENT(IN) :: BaseSurfCls ! Valid Classes for Base Surfaces
INTEGER, DIMENSION(:), INTENT(IN) :: BaseSurfIDs
INTEGER, INTENT(OUT) :: NeedToAddSurfaces ! Number of surfaces to add, based on unentered IZ surfaces
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER, DIMENSION(4) :: cModuleObjects= &
(/'BuildingSurface:Detailed', &
'Wall:Detailed ', &
'Floor:Detailed ', &
'RoofCeiling:Detailed '/)
! 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 :: ZoneNum ! DO loop counter (zones)
INTEGER :: Found ! For matching interzone surfaces
INTEGER :: Loop
LOGICAL :: ErrorInName
LOGICAL :: IsBlank
INTEGER :: Item
INTEGER :: ItemsToGet
INTEGER :: ClassItem
INTEGER :: ArgPointer
INTEGER :: numSides
CALL GetOSCData(ErrorsFound)
Call GetOSCMData(ErrorsFound)
NeedToAddSurfaces=0
DO Item=1,4
cCurrentModuleObject=cModuleObjects(Item)
IF (Item == 1) THEN
ItemsToGet=TotHTSurfs
ClassItem=0
ELSEIF (Item == 2) THEN
ItemsToGet=TotDetailedWalls
ClassItem=1
ELSEIF (Item == 3) THEN
ItemsToGet=TotDetailedFloors
ClassItem=2
ELSE !IF (Item == 4) THEN
ItemsToGet=TotDetailedRoofs
ClassItem=3
ENDIF
CALL GetObjectDefMaxArgs(cCurrentModuleObject,Loop,SurfaceNumAlpha,SurfaceNumProp)
IF (Item == 1) THEN
IF (SurfaceNumAlpha /= 8) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': Object Definition indicates '// &
'not = 8 Alpha Objects, Number Indicated='// &
TRIM(TrimSigDigits(SurfaceNumAlpha)))
ErrorsFound=.true.
ENDIF
ELSE
IF (SurfaceNumAlpha /= 7) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//': Object Definition indicates '// &
'not = 7 Alpha Objects, Number Indicated='// &
TRIM(TrimSigDigits(SurfaceNumAlpha)))
ErrorsFound=.true.
ENDIF
ENDIF
DO Loop=1,ItemsToGet
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
SurfNum=SurfNum+1
SurfaceTmp(SurfNum)%Name = cAlphaArgs(1) ! Set the Surface Name in the Derived Type
ArgPointer=2
IF (Item == 1) THEN
IF (cAlphaArgs(2) == 'CEILING') cAlphaArgs(2)='ROOF'
ClassItem=FindItemInList(cAlphaArgs(2),BaseSurfCls,3)
IF (ClassItem == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cAlphaFieldNames(2))//'="'//TRIM(cAlphaArgs(2)))
ErrorsFound=.true.
ELSE
SurfaceTmp(SurfNum)%Class = BaseSurfIDs(ClassItem)
ENDIF
ArgPointer=ArgPointer+1
ELSE
SurfaceTmp(SurfNum)%Class = BaseSurfIDs(ClassItem)
ENDIF
SurfaceTmp(SurfNum)%Construction=FindIteminList(cAlphaArgs(ArgPointer),Construct%Name,TotConstructs)
IF(SurfaceTmp(SurfNum)%Construction == 0) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cAlphaFieldNames(ArgPointer))//'="'//TRIM(cAlphaArgs(ArgPointer))//'".')
ELSEIF (Construct(SurfaceTmp(SurfNum)%Construction)%TypeIsWindow) THEN
ErrorsFound = .true.
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cAlphaFieldNames(ArgPointer))//'="'//TRIM(cAlphaArgs(ArgPointer))// &
'" - has Window materials.')
IF (Item == 1) THEN
CALL ShowContinueError('...because '//TRIM(cAlphaFieldNames(2))//'='//TRIM(cAlphaArgs(2)))
ELSE
CALL ShowContinueError('...because Surface Type='//trim(BaseSurfCls(ClassItem)))
ENDIF
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
ArgPointer=ArgPointer+1
SurfaceTmp(SurfNum)%ZoneName=cAlphaArgs(ArgPointer)
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(ArgPointer))//'="'//TRIM(cAlphaArgs(ArgPointer))//'".')
SurfaceTmp(SurfNum)%Class=SurfaceTmp(SurfNum)%Class+100
SurfaceTmp(SurfNum)%ZoneName='Unknown Zone'
ErrorsFound=.true.
ENDIF
! Get the ExteriorBoundaryCondition flag from input There are 4 conditions that
! can take place. The conditions are set with a 0, -1, or -2, or all of the
! zone names have to be looked at and generate the interzone array number
ArgPointer=ArgPointer+1
SurfaceTmp(SurfNum)%ExtBoundCondName=cAlphaArgs(ArgPointer+1)
If(SameString(cAlphaArgs(ArgPointer),'Outdoors')) Then
SurfaceTmp(SurfNum)%ExtBoundCond = ExternalEnvironment
Else If(SameString(cAlphaArgs(ArgPointer),'Adiabatic')) Then
SurfaceTmp(SurfNum)%ExtBoundCond = UnreconciledZoneSurface
SurfaceTmp(SurfNum)%ExtBoundCondName=SurfaceTmp(SurfNum)%Name
Else If(SameString(cAlphaArgs(ArgPointer),'Ground')) Then
SurfaceTmp(SurfNum)%ExtBoundCond = Ground
IF (NoGroundTempObjWarning) THEN
IF (.not. GroundTempObjInput) THEN
CALL ShowWarningError('GetHTSurfaceData: 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
! Added for FCfactor method
Else If(SameString(cAlphaArgs(ArgPointer),'GroundFCfactorMethod')) Then
SurfaceTmp(SurfNum)%ExtBoundCond = GroundFCfactorMethod
IF (NoFCGroundTempObjWarning) THEN
IF (.not. FCGroundTemps) THEN
CALL ShowSevereError('GetHTSurfaceData: 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
IF (SurfaceTmp(SurfNum)%Construction > 0) THEN
IF (SurfaceTmp(SurfNum)%Class == SurfaceClass_Wall .and. &
.not. Construct(SurfaceTmp(SurfNum)%Construction)%TypeIsCfactorWall) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cAlphaFieldNames(ArgPointer)))
CALL ShowContinueError('Construction="'//trim(Construct(SurfaceTmp(SurfNum)%Construction)%Name)// &
'" is not type Construction:CfactorUndergroundWall.')
ErrorsFound=.true.
ENDIF
IF (SurfaceTmp(SurfNum)%Class == SurfaceClass_Floor .and. &
.not. Construct(SurfaceTmp(SurfNum)%Construction)%TypeIsFfactorFloor) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cAlphaFieldNames(ArgPointer)))
CALL ShowContinueError('Construction="'//trim(Construct(SurfaceTmp(SurfNum)%Construction)%Name)// &
'" is not type Construction:FfactorGroundFloor.')
ErrorsFound=.true.
ENDIF
ENDIF
Else If(SameString(cAlphaArgs(ArgPointer),'OtherSideCoefficients')) Then
Found=FindItemInList(SurfaceTmp(SurfNum)%ExtBoundCondName,OSC%Name,TotOSC)
IF (Found == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cAlphaFieldNames(ArgPointer+1))//'="'//TRIM(cAlphaArgs(ArgPointer+1))//'".')
CALL ShowContinueError(' no OtherSideCoefficients of that name.')
ErrorsFound=.true.
ELSE
SurfaceTmp(SurfNum)%OSCPtr=Found
IF (OSC(Found)%SurfFilmCoef > 0.0d0) THEN
SurfaceTmp(SurfNum)%ExtBoundCond = OtherSideCoefCalcExt
ELSE
SurfaceTmp(SurfNum)%ExtBoundCond = OtherSideCoefNoCalcExt
ENDIF
ENDIF
Else If (SameString(cAlphaArgs(ArgPointer),'Surface')) Then
! it has to be another surface which needs to be found
! this will be found on the second pass through the surface input
! for flagging, set the value to UnreconciledZoneSurface
! name (ExtBoundCondName) will be validated later.
SurfaceTmp(SurfNum)%ExtBoundCond = UnreconciledZoneSurface
IF (lAlphaFieldBlanks(ArgPointer+1)) THEN
SurfaceTmp(SurfNum)%ExtBoundCondName=SurfaceTmp(SurfNum)%Name
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cAlphaFieldNames(ArgPointer+1))//'=<blank>.')
CALL ShowContinueError('..'//trim(cAlphaFieldNames(ArgPointer))//'="Surface" must be non-blank.')
CALL ShowContinueError('..This surface will become an adiabatic surface - no doors/windows allowed.')
ENDIF
Else If (SameString(cAlphaArgs(ArgPointer),'Zone')) Then
! This is the code for an unmatched "other surface"
! will be set up later.
SurfaceTmp(SurfNum)%ExtBoundCond = UnenteredAdjacentZoneSurface
! check OutsideFaceEnvironment for legal zone
Found=FindItemInList(SurfaceTmp(SurfNum)%ExtBoundCondName,Zone%Name,NumOfZones)
NeedToAddSurfaces=NeedToAddSurfaces+1
IF (Found == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cAlphaFieldNames(ArgPointer))//'="'//TRIM(cAlphaArgs(ArgPointer))//'".')
CALL ShowContinueError('..Referenced as Zone for this surface.')
ErrorsFound=.true.
ENDIF
ELSE IF (SameString(cAlphaArgs(ArgPointer), 'OtherSideConditionsModel')) Then
Found=FindItemInList(SurfaceTmp(SurfNum)%ExtBoundCondName,OSCM%Name,TotOSCM)
IF (Found == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cAlphaFieldNames(ArgPointer))//'="'//TRIM(cAlphaArgs(ArgPointer))//'".')
ErrorsFound=.true.
ENDIF
SurfaceTmp(SurfNum)%OSCMPtr=Found
SurfaceTmp(SurfNum)%ExtBoundCond = OtherSideCondModeledExt
Else If (SameString(cAlphaArgs(ArgPointer),'GroundSlabPreprocessorAverage') .or. &
SameString(cAlphaArgs(ArgPointer),'GroundSlabPreprocessorCore') .or. &
SameString(cAlphaArgs(ArgPointer),'GroundSlabPreprocessorPerimeter') .or. &
SameString(cAlphaArgs(ArgPointer),'GroundBasementPreprocessorAverageFloor') .or. &
SameString(cAlphaArgs(ArgPointer),'GroundBasementPreprocessorAverageWall') .or. &
SameString(cAlphaArgs(ArgPointer),'GroundBasementPreprocessorUpperWall') .or. &
SameString(cAlphaArgs(ArgPointer),'GroundBasementPreprocessorLowerWall') ) Then
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cAlphaFieldNames(ArgPointer))//'="'//TRIM(cAlphaArgs(ArgPointer))//'".')
CALL ShowContinueError('The ExpandObjects program has not been run or is not in your EnergyPlus.exe folder.')
ErrorsFound=.true.
Else
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cAlphaFieldNames(ArgPointer))//'="'//TRIM(cAlphaArgs(ArgPointer))//'".')
CALL ShowContinueError('Should be one of "Outdoors", "Adiabatic", Ground", "Surface",'// &
' "OtherSideCoefficients", "OtherSideConditionsModel" or "Zone"')
ErrorsFound=.true.
End If ! ... End of the ExtBoundCond logical IF Block
ArgPointer=ArgPointer+2
!Set the logical flag for the exterior solar
IF (SameString(cAlphaArgs(ArgPointer),'SunExposed')) THEN
SurfaceTmp(SurfNum)%ExtSolar=.true.
IF ((SurfaceTmp(SurfNum)%ExtBoundCond /= ExternalEnvironment) .AND. &
(SurfaceTmp(SurfNum)%ExtBoundCond /= OtherSideCondModeledExt) ) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", '//TRIM(cAlphaFieldNames(ArgPointer))//'="'//TRIM(cAlphaArgs(ArgPointer))//'".')
CALL ShowContinueError('..This surface is not exposed to External Environment. Sun exposure has no effect.')
ENDIF
ELSE IF (SameString(cAlphaArgs(ArgPointer),'NoSun')) THEN
SurfaceTmp(SurfNum)%ExtSolar=.false.
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cAlphaFieldNames(ArgPointer))//'="'//TRIM(cAlphaArgs(ArgPointer))//'".')
ErrorsFound=.true.
END IF
ArgPointer=ArgPointer+1
!Set the logical flag for the exterior wind
If (SameString(cAlphaArgs(ArgPointer),'WindExposed')) THEN
SurfaceTmp(SurfNum)%ExtWind=.true.
ElseIf (SameString(cAlphaArgs(ArgPointer),'NoWind')) THEN
SurfaceTmp(SurfNum)%ExtWind=.false.
Else
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", invalid '//TRIM(cAlphaFieldNames(ArgPointer))//'="'//TRIM(cAlphaArgs(ArgPointer))//'".')
ErrorsFound=.true.
End If
!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
SurfaceTmp(SurfNum)%ViewFactorGround = rNumericArgs(1)
IF (lNumericFieldBlanks(1)) SurfaceTmp(SurfNum)%ViewFactorGround = AutoCalculate
IF (lNumericFieldBlanks(2) .or. rNumericArgs(2) == AutoCalculate) THEN
numSides=(SurfaceNumProp-2)/3
SurfaceTmp(SurfNum)%Sides=numSides
IF (MOD(SurfaceNumProp-2,3) /= 0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", '//TRIM(cNumericFieldNames(2))// &
' not even multiple of 3. Will read in '// &
TRIM(TrimSigDigits(SurfaceTmp(SurfNum)%Sides)))
ENDIF
IF (numSides < 3) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", '//TRIM(cNumericFieldNames(2))//' (autocalculate) must be >= 3. Only '// &
TRIM(TrimSigDigits(SurfaceTmp(SurfNum)%Sides))//' provided.')
ErrorsFound=.true.
CYCLE
ENDIF
ELSE
numSides=(SurfaceNumProp-2)/3
SurfaceTmp(SurfNum)%Sides=rNumericArgs(2)
IF (numSides > SurfaceTmp(SurfNum)%Sides) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(SurfaceTmp(SurfNum)%Name)// &
'", field '//TRIM(cNumericFieldNames(2))//'='//TRIM(TrimSigDigits(SurfaceTmp(SurfNum)%Sides)))
CALL ShowContinueError('...but '//TRIM(TrimSigDigits(numSides))//' were entered. Only the indicated '// &
TRIM(cNumericFieldNames(2))//' will be used.')
ENDIF
ENDIF
ALLOCATE(SurfaceTmp(SurfNum)%Vertex(SurfaceTmp(SurfNum)%Sides))
CALL GetVertices(SurfNum,SurfaceTmp(SurfNum)%Sides,rNumericArgs(3:))
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
CALL CheckConvexity(SurfNum,SurfaceTmp(SurfNum)%Sides)
IF (SurfaceTmp(SurfNum)%Construction > 0) THEN
!Check wall height for the CFactor walls
IF (SurfaceTmp(SurfNum)%Class == SurfaceClass_Wall .and. &
Construct(SurfaceTmp(SurfNum)%Construction)%TypeIsCfactorWall) 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 does not match its construction height.')
ENDIF
ENDIF
!Check area and perimeter for the FFactor floors
IF (SurfaceTmp(SurfNum)%Class == SurfaceClass_Floor .and. &
Construct(SurfaceTmp(SurfNum)%Construction)%TypeIsFfactorFloor) 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
ENDIF
ENDDO
ENDDO ! Item Looop
RETURN
END SUBROUTINE GetHTSurfaceData