SUBROUTINE GetSurfaceData(ErrorsFound)
! SUBROUTINE INFORMATION:
! AUTHOR Richard Liesen
! DATE WRITTEN November 1997
! MODIFIED April 1999, Linda Lawrie
! Dec. 2000, FW (add "one-wall zone" checks)
! RE-ENGINEERED May 2000, Linda Lawrie (breakout surface type gets)
! PURPOSE OF THIS SUBROUTINE:
! The purpose of this subroutine is to read in the surface information
! from the input data file and interpret and put in the derived type
! METHODOLOGY EMPLOYED:
! The order of surfaces does not matter and the surfaces are resorted into
! the hierarchical order:
! Detached Surfaces
! Base Surface for zone x
! Subsurfaces for base surface
! Base Surface for zone x
! etc
! Heat Transfer Surfaces and Shading surfaces are mixed in the list
! Pointers are set in the zones (First, Last)
! REFERENCES:
! This routine manages getting the input for the following Objects:
! SurfaceGeometry
! Surface:Shading:Detached
! Surface:HeatTransfer
! Surface:HeatTransfer:Sub
! Surface:Shading:Attached
! Surface:InternalMass
!
! Vertex input:
! N3 , \field Number of Surface Vertices -- Number of (X,Y,Z) groups in this surface
! \note currently limited 3 or 4, later?
! \min 3
! \max 4
! \memo vertices are given in SurfaceGeometry coordinates -- if relative, all surface coordinates
! \memo are "relative" to the Zone Origin. if WCS, then building and zone origins are used
! \memo for some internal calculations, but all coordinates are given in an "absolute" system.
! N4, \field Vertex 1 X-coordinate
! \units m
! \type real
! N5 , \field Vertex 1 Y-coordinate
! \units m
! \type real
! N6 , \field Vertex 1 Z-coordinate
! \units m
! \type real
! N7, \field Vertex 2 X-coordinate
! \units m
! \type real
! N8, \field Vertex 2 Y-coordinate
! \units m
! \type real
! N9, \field Vertex 2 Z-coordinate
! \units m
! \type real
! N10, \field Vertex 3 X-coordinate
! \units m
! \type real
! N11, \field Vertex 3 Y-coordinate
! \units m
! \type real
! N12, \field Vertex 3 Z-coordinate
! \units m
! \type real
! N13, \field Vertex 4 X-coordinate
! \units m
! \type real
! N14, \field Vertex 4 Y-coordinate
! \type real
! \units m
! N15; \field Vertex 4 Z-coordinate
! \units m
! \type real
! The vertices are stored in the surface derived type.
!
! +(1)-------------------------(4)+
! | |
! | |
! | |
! +(2)-------------------------(3)+
!
! The above diagram shows the actual coordinate points of a typical wall
! (you're on the outside looking toward the wall) as stored into
! Surface%Vertex(1:<number-of-sides>)
!
!
!
! USE STATEMENTS:
USE DataIPShortCuts
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, FindItemInList, SameString, VerifyName
USE General, ONLY: TrimSigDigits,RoundSigDigits
USE Vectors
USE ScheduleManager, ONLY: GetScheduleMinValue, GetScheduleMaxValue
USE DataErrorTracking
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(INOUT) :: ErrorsFound ! If errors found in input
! SUBROUTINE PARAMETER DEFINITIONS:
INTEGER, PARAMETER :: SurfaceClass_Moved=-1
CHARACTER(len=*), PARAMETER :: RoutineName='GetSurfaceData: '
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: ConstrNum ! Construction number
INTEGER :: SubSurfNum ! DO loop counter/index for sub-surface number
INTEGER :: SurfNum ! DO loop counter/index for surface number
INTEGER :: ZoneNum ! DO loop counter (zones)
INTEGER :: Found ! For matching interzone surfaces
INTEGER :: ConstrNumFound ! Construction number of matching interzone surface
LOGICAL :: NonMatch=.false. ! Error for non-matching interzone surfaces
INTEGER :: Lay ! Layer number
INTEGER :: MovedSurfs ! Number of Moved Surfaces (when sorting into hierarchical structure)
LOGICAL :: SurfError=.false. ! General Surface Error, causes fatal error at end of routine
INTEGER :: Loop
INTEGER :: BaseSurfNum
INTEGER :: TotLay ! Total layers in a construction
INTEGER :: TotLayFound ! Total layers in the construction of a matching interzone surface
INTEGER :: TotDetachedFixed ! Total Shading:Site:Detailed entries
INTEGER :: TotDetachedBldg ! Total Shading:Building:Detailed entries
INTEGER :: TotRectDetachedFixed ! Total Shading:Site entries
INTEGER :: TotRectDetachedBldg ! Total Shading:Building entries
INTEGER :: TotHTSurfs ! Number of BuildingSurface:Detailed items to obtain
INTEGER :: TotDetailedWalls ! Number of Wall:Detailed items to obtain
INTEGER :: TotDetailedRoofs ! Number of RoofCeiling:Detailed items to obtain
INTEGER :: TotDetailedFloors ! Number of Floor:Detailed items to obtain
INTEGER :: TotHTSubs ! Number of FenestrationSurface:Detailed items to obtain
INTEGER :: TotShdSubs ! Number of Shading:Zone:Detailed items to obtain
INTEGER :: TotIntMass ! Number of InternalMass items to obtain
! Simple Surfaces (Rectangular)
INTEGER :: TotRectExtWalls ! Number of Exterior Walls to obtain
INTEGER :: TotRectIntWalls ! Number of Adiabatic Walls to obtain
INTEGER :: TotRectIZWalls ! Number of Interzone Walls to obtain
INTEGER :: TotRectUGWalls ! Number of Underground to obtain
INTEGER :: TotRectRoofs ! Number of Roofs to obtain
INTEGER :: TotRectCeilings ! Number of Adiabatic Ceilings to obtain
INTEGER :: TotRectIZCeilings ! Number of Interzone Ceilings to obtain
INTEGER :: TotRectGCFloors ! Number of Floors with Ground Contact to obtain
INTEGER :: TotRectIntFloors ! Number of Adiabatic Walls to obtain
INTEGER :: TotRectIZFloors ! Number of Interzone Floors to obtain
INTEGER :: TotRectWindows
INTEGER :: TotRectDoors
INTEGER :: TotRectGlazedDoors
INTEGER :: TotRectIZWindows
INTEGER :: TotRectIZDoors
INTEGER :: TotRectIZGlazedDoors
INTEGER :: TotOverhangs
INTEGER :: TotOverhangsProjection
INTEGER :: TotFins
INTEGER :: TotFinsProjection
CHARACTER(len=20) ClassMsg
CHARACTER(len=20) Msg2
INTEGER :: OpaqueHTSurfs ! Number of floors, walls and roofs in a zone
INTEGER :: OpaqueHTSurfsWithWin ! Number of floors, walls and roofs with windows in a zone
INTEGER :: InternalMassSurfs ! Number of internal mass surfaces in a zone
LOGICAL :: RelWarning=.false.
INTEGER :: ConstrNumSh ! Shaded construction number for a window
INTEGER :: LayNumOutside ! Outside material numbers for a shaded construction
INTEGER :: BlNum ! Blind number
LOGICAL :: WinShadingCtrlReferenced ! True if a WindowShadingControl is referenced by at least one window
INTEGER :: ShadingCtrl ! WindowShadingControl number
INTEGER :: AddedSubSurfaces ! Subsurfaces (windows) added when windows reference Window5 Data File
! entries with two glazing systems
INTEGER :: NeedToAddSurfaces ! Surfaces that will be added due to "unentered" other zone surface
INTEGER :: NeedToAddSubSurfaces ! SubSurfaces that will be added due to "unentered" other zone surface
INTEGER :: CurNewSurf
INTEGER :: FirstTotalSurfaces
INTEGER :: NVert
INTEGER :: Vert
INTEGER :: N
REAL(r64) SurfWorldAz
REAL(r64) :: surfTilt
INTEGER :: MultFound, MultSurfNum
CHARACTER(len=20) :: MultString
LOGICAL,SAVE :: WarningDisplayed=.false.
INTEGER, SAVE :: ErrCount1=0
INTEGER, SAVE :: ErrCount2=0
INTEGER, SAVE :: ErrCount3=0
INTEGER, SAVE :: ErrCount4=0 ! counts of interzone area mismatches.
LOGICAL :: SubSurfaceSevereDisplayed
! INTEGER :: Warning4Count=0 ! counts of nonmatched flat surface subsurface orientations
! INTEGER :: Warning5Count=0 ! counts of nonmatched flat surface subsurface orientations - could not be resolved
LOGICAL :: errFlag
INTEGER :: iTmp1
INTEGER :: iTmp2
!unused INTEGER :: SchID
INTEGER :: BlNumNew
INTEGER :: WinShadingControlPtr
INTEGER :: ShadingType
!unused REAL(r64) :: SchSlatAngle = 0.0D0
!unused LOGICAL :: initmsg
INTEGER :: errCount
REAL(r64) :: diffp
! TYPE (vector), ALLOCATABLE, DIMENSION(:) :: TestVertex
! INTEGER :: Vrt
! INTEGER :: testV
! INTEGER :: testVsave
! INTEGER :: countSides
! INTEGER :: LLCVrt
! REAL(r64) :: maxX
! REAL(r64) :: maxY
! REAL(r64) :: testX
! REAL(r64) :: testY
REAL(r64) :: surfAzimuth
! LOGICAL :: Located
LOGICAL :: sameSurfNormal
LOGICAL :: izConstDiff ! differences in construction for IZ surfaces
LOGICAL :: izConstDiffMsg ! display message about hb diffs only once.
! FLOW:
! Get the total number of surfaces to allocate derived type and for surface loops
CALL GetGeometryParameters(ErrorsFound)
IF (WorldCoordSystem) THEN
IF (BuildingAzimuth /= 0.0d0) RelWarning=.true.
DO ZoneNum=1,NumOfZones
IF (Zone(ZoneNum)%RelNorth /= 0.0d0) RelWarning=.true.
ENDDO
IF (RelWarning .and. .not. WarningDisplayed) THEN
CALL ShowWarningError(RoutineName//'World Coordinate System selected. '// &
'Any non-zero Building/Zone North Axes or non-zero Zone Origins are ignored.')
CALL ShowContinueError('These may be used in daylighting reference point coordinate calculations '// &
' but not in normal geometry inputs.')
WarningDisplayed=.true.
ENDIF
RelWarning=.false.
DO ZoneNum=1,NumOfZones
IF (Zone(ZoneNum)%OriginX /= 0.0d0) RelWarning=.true.
IF (Zone(ZoneNum)%OriginY /= 0.0d0) RelWarning=.true.
IF (Zone(ZoneNum)%OriginZ /= 0.0d0) RelWarning=.true.
ENDDO
IF (RelWarning .and. .not. WarningDisplayed) THEN
CALL ShowWarningError(RoutineName//'World Coordinate System selected. '// &
'Any non-zero Building/Zone North Axes or non-zero Zone Origins are ignored.')
CALL ShowContinueError('These may be used in daylighting reference point coordinate calculations '// &
' but not in normal geometry inputs.')
WarningDisplayed=.true.
ENDIF
ENDIF
TotDetachedFixed =GetNumObjectsFound('Shading:Site:Detailed')
TotDetachedBldg =GetNumObjectsFound('Shading:Building:Detailed')
TotRectDetachedFixed =GetNumObjectsFound('Shading:Site')
TotRectDetachedBldg =GetNumObjectsFound('Shading:Building')
TotHTSurfs =GetNumObjectsFound('BuildingSurface:Detailed')
TotDetailedWalls =GetNumObjectsFound('Wall:Detailed')
TotDetailedRoofs =GetNumObjectsFound('RoofCeiling:Detailed')
TotDetailedFloors =GetNumObjectsFound('Floor:Detailed')
TotHTSubs =GetNumObjectsFound('FenestrationSurface:Detailed')
TotShdSubs =GetNumObjectsFound('Shading:Zone:Detailed')
TotOverhangs =GetNumObjectsFound('Shading:Overhang')
TotOverhangsProjection=GetNumObjectsFound('Shading:Overhang:Projection')
TotFins =GetNumObjectsFound('Shading:Fin')
TotFinsProjection =GetNumObjectsFound('Shading:Fin:Projection')
TotIntMass =GetNumObjectsFound('InternalMass')
TotRectWindows =GetNumObjectsFound('Window')
TotRectDoors =GetNumObjectsFound('Door')
TotRectGlazedDoors =GetNumObjectsFound('GlazedDoor')
TotRectIZWindows =GetNumObjectsFound('Window:Interzone')
TotRectIZDoors =GetNumObjectsFound('Door:Interzone')
TotRectIZGlazedDoors =GetNumObjectsFound('GlazedDoor:Interzone')
TotRectExtWalls =GetNumObjectsFound('Wall:Exterior')
TotRectIntWalls =GetNumObjectsFound('Wall:Adiabatic')
TotRectIZWalls =GetNumObjectsFound('Wall:Interzone')
TotRectUGWalls =GetNumObjectsFound('Wall:Underground')
TotRectRoofs =GetNumObjectsFound('Roof')
TotRectCeilings =GetNumObjectsFound('Ceiling:Adiabatic')
TotRectIZCeilings =GetNumObjectsFound('Ceiling:Interzone')
TotRectGCFloors =GetNumObjectsFound('Floor:GroundContact')
TotRectIntFloors =GetNumObjectsFound('Floor:Adiabatic ')
TotRectIZFloors =GetNumObjectsFound('Floor:Interzone')
TotOSC =0
TotSurfaces=(TotDetachedFixed+TotDetachedBldg+TotRectDetachedFixed+TotRectDetachedBldg)*2 + &
TotHTSurfs + TotHTSubs + TotShdSubs*2 + TotIntMass + &
TotOverhangs*2 + TotOverhangsProjection*2 + TotFins*4 + TotFinsProjection*4 + &
TotDetailedWalls + TotDetailedRoofs + TotDetailedFloors + &
TotRectWindows + TotRectDoors + TotRectGlazedDoors + TotRectIZWindows + TotRectIZDoors + TotRectIZGlazedDoors + &
TotRectExtWalls + TotRectIntWalls + TotRectIZWalls + TotRectUGWalls + &
TotRectRoofs + TotRectCeilings + TotRectIZCeilings + &
TotRectGCFloors + TotRectIntFloors + TotRectIZFloors
ALLOCATE (SurfaceTmp(TotSurfaces)) ! Allocate the Surface derived type appropriately
! SurfaceTmp structure is allocated via derived type initialization.
SurfNum=0
AddedSubSurfaces=0
AskForSurfacesReport=.true.
CALL GetDetShdSurfaceData(ErrorsFound,SurfNum,TotDetachedFixed,TotDetachedBldg)
CALL GetRectDetShdSurfaceData(ErrorsFound,SurfNum,TotRectDetachedFixed,TotRectDetachedBldg)
CALL GetHTSurfaceData(ErrorsFound,SurfNum,TotHTSurfs,TotDetailedWalls,TotDetailedRoofs,TotDetailedFloors, &
BaseSurfCls,BaseSurfIDs,NeedToAddSurfaces)
CALL GetRectSurfaces(ErrorsFound,SurfNum,TotRectExtWalls,TotRectIntWalls,TotRectIZWalls,TotRectUGWalls, &
TotRectRoofs,TotRectCeilings,TotRectIZCeilings,TotRectGCFloors,TotRectIntFloors,TotRectIZFloors, &
BaseSurfIDs,NeedToAddSurfaces)
CALL GetHTSubSurfaceData(ErrorsFound,SurfNum,TotHTSubs,SubSurfCls,SubSurfIDs,AddedSubSurfaces,NeedToAddSubSurfaces)
CALL GetRectSubSurfaces(ErrorsFound,SurfNum,TotRectWindows,TotRectDoors,TotRectGlazedDoors, &
TotRectIZWindows,TotRectIZDoors,TotRectIZGlazedDoors,SubSurfIDs,AddedSubSurfaces,NeedToAddSubSurfaces)
CALL GetAttShdSurfaceData(ErrorsFound,SurfNum,TotShdSubs)
CALL GetSimpleShdSurfaceData(ErrorsFound,SurfNum,TotOverhangs,TotOverhangsProjection,TotFins,TotFinsProjection)
CALL GetIntMassSurfaceData(ErrorsFound,SurfNum,TotIntMass)
CALL GetMovableInsulationData(ErrorsFound)
IF(CalcSolRefl) CALL GetShadingSurfReflectanceData(ErrorsFound)
TotSurfaces=SurfNum + AddedSubSurfaces + NeedToAddSurfaces + NeedToAddSubSurfaces
! Have to make room for added surfaces, if needed
FirstTotalSurfaces=SurfNum + AddedSubSurfaces
IF (NeedToAddSurfaces+NeedToAddSubsurfaces > 0) THEN
ALLOCATE(SurfaceTmpSave(TotSurfaces))
SurfaceTmpSave(1:FirstTotalSurfaces)=SurfaceTmp
DEALLOCATE(SurfaceTmp)
ALLOCATE(SurfaceTmp(TotSurfaces))
SurfaceTmp=SurfaceTmpSave
DEALLOCATE(SurfaceTmpSave)
ENDIF
ALLOCATE (SurfaceWindow(TotSurfaces))
! add the "need to add" surfaces
if (NeedtoAddSurfaces+NeedToAddSubSurfaces > 0) &
!Debug write(outputfiledebug,*) ' need to add ',NeedtoAddSurfaces+NeedToAddSubSurfaces
CurNewSurf=FirstTotalSurfaces
DO SurfNum=1,FirstTotalSurfaces
IF (SurfaceTmp(SurfNum)%ExtBoundCond /= UnenteredAdjacentZoneSurface) CYCLE
! Need to add surface
CurNewSurf=CurNewSurf+1
!Debug write(outputfiledebug,*) ' adding surface=',curnewsurf
SurfaceTmp(CurNewSurf)=SurfaceTmp(SurfNum)
! Basic parameters are the same for both surfaces.
Found=FindItemInList(SurfaceTmp(SurfNum)%ExtBoundCondName,Zone%Name,NumOfZones)
IF (Found == 0) CYCLE
SurfaceTmp(CurNewSurf)%Zone=Found
SurfaceTmp(CurNewSurf)%ZoneName=Zone(Found)%Name
! Reverse Construction
SurfaceTmp(CurNewSurf)%Construction=AssignReverseConstructionNumber(SurfaceTmp(SurfNum)%Construction,SurfError)
SurfaceTmp(CurNewSurf)%ConstructionStoredInputValue = SurfaceTmp(CurNewSurf)%Construction
! Reverse Vertices
NVert=SurfaceTmp(SurfNum)%Sides
DO Vert=1,SurfaceTmp(SurfNum)%Sides
SurfaceTmp(CurNewSurf)%Vertex(Vert)=SurfaceTmp(SurfNum)%Vertex(NVert)
NVert=NVert-1
ENDDO
IF (SurfaceTmp(CurNewSurf)%Sides > 2) THEN
CALL CreateNewellAreaVector(SurfaceTmp(CurNewSurf)%Vertex,SurfaceTmp(CurNewSurf)%Sides, &
SurfaceTmp(CurNewSurf)%NewellAreaVector)
SurfaceTmp(CurNewSurf)%GrossArea=VecLength(SurfaceTmp(CurNewSurf)%NewellAreaVector)
SurfaceTmp(CurNewSurf)%Area=SurfaceTmp(CurNewSurf)%GrossArea
SurfaceTmp(CurNewSurf)%NetAreaShadowCalc = SurfaceTmp(CurNewSurf)%Area
CALL CreateNewellSurfaceNormalVector(SurfaceTmp(CurNewSurf)%Vertex,SurfaceTmp(CurNewSurf)%Sides, &
SurfaceTmp(CurNewSurf)%NewellSurfaceNormalVector)
CALL DetermineAzimuthAndTilt(SurfaceTmp(CurNewSurf)%Vertex,SurfaceTmp(CurNewSurf)%Sides,SurfWorldAz,SurfTilt, &
SurfaceTmp(CurNewSurf)%lcsx,SurfaceTmp(CurNewSurf)%lcsy,SurfaceTmp(CurNewSurf)%lcsz, &
SurfaceTmp(CurNewSurf)%GrossArea,SurfaceTmp(CurNewSurf)%NewellSurfaceNormalVector)
SurfaceTmp(CurNewSurf)%Azimuth=SurfWorldAz
SurfaceTmp(CurNewSurf)%Tilt=SurfTilt
! Sine and cosine of azimuth and tilt
SurfaceTmp(CurNewSurf)%SinAzim = SIN(SurfWorldAz*DegToRadians)
SurfaceTmp(CurNewSurf)%CosAzim = COS(SurfWorldAz*DegToRadians)
SurfaceTmp(CurNewSurf)%SinTilt = SIN(SurfTilt*DegToRadians)
SurfaceTmp(CurNewSurf)%CosTilt = COS(SurfTilt*DegToRadians)
! Outward normal unit vector (pointing away from room)
SurfaceTmp(CurNewSurf)%OutNormVec = SurfaceTmp(CurNewSurf)%NewellSurfaceNormalVector
DO N=1,3
IF (ABS(SurfaceTmp(CurNewSurf)%OutNormVec(N)-1.0d0) < 1.d-06) SurfaceTmp(CurNewSurf)%OutNormVec(N) = +1.0d0
IF (ABS(SurfaceTmp(CurNewSurf)%OutNormVec(N)+1.0d0) < 1.d-06) SurfaceTmp(CurNewSurf)%OutNormVec(N) = -1.0d0
IF (ABS(SurfaceTmp(CurNewSurf)%OutNormVec(N)) < 1.d-06) SurfaceTmp(CurNewSurf)%OutNormVec(N) = 0.0d0
ENDDO
! Can perform tests on this surface here
SurfaceTmp(CurNewSurf)%ViewFactorSky=0.5d0*(1.d0+SurfaceTmp(CurNewSurf)%CosTilt)
SurfaceTmp(CurNewSurf)%ViewFactorGround=0.5d0*(1.d0-SurfaceTmp(CurNewSurf)%CosTilt)
! The following IR view factors are modified in subr. SkyDifSolarShading if there are shadowing
! surfaces
SurfaceTmp(CurNewSurf)%ViewFactorSkyIR = SurfaceTmp(CurNewSurf)%ViewFactorSky
SurfaceTmp(CurNewSurf)%ViewFactorGroundIR = 0.5d0*(1.d0-SurfaceTmp(CurNewSurf)%CosTilt)
ENDIF
! Change Name
SurfaceTmp(CurNewSurf)%Name='iz-'//TRIM(SurfaceTmp(SurfNum)%Name)
!Debug write(outputfiledebug,*) ' new surf name=',trim(SurfaceTmp(CurNewSurf)%Name)
!Debug write(outputfiledebug,*) ' new surf in zone=',trim(surfacetmp(curnewsurf)%zoneName)
SurfaceTmp(CurNewSurf)%ExtBoundCond=UnreconciledZoneSurface
SurfaceTmp(SurfNum)%ExtBoundCond=UnreconciledZoneSurface
SurfaceTmp(CurNewSurf)%ExtBoundCondName=SurfaceTmp(SurfNum)%Name
SurfaceTmp(SurfNum)%ExtBoundCondName=SurfaceTmp(CurNewSurf)%Name
IF (SurfaceTmp(CurNewSurf)%Class == SurfaceClass_Roof .or. &
SurfaceTmp(CurNewSurf)%Class == SurfaceClass_Wall .or. &
SurfaceTmp(CurNewSurf)%Class == SurfaceClass_Floor) THEN
! base surface
IF (SurfaceTmp(SurfNum)%Class == SurfaceClass_Roof) THEN
SurfaceTmp(CurNewSurf)%Class=SurfaceClass_Floor
!Debug write(outputfiledebug,*) ' new surfaces is a floor'
ELSE IF (SurfaceTmp(SurfNum)%Class == SurfaceClass_Floor) THEN
SurfaceTmp(CurNewSurf)%Class=SurfaceClass_Roof
!Debug write(outputfiledebug,*) ' new surfaces is a roof'
ENDIF
SurfaceTmp(CurNewSurf)%BaseSurf=CurNewSurf
SurfaceTmp(CurnewSurf)%BaseSurfName=SurfaceTmp(CurNewSurf)%Name
!Debug write(outputfiledebug,*) ' basesurf, extboundcondname=',trim(SurfaceTmp(CurNewSurf)%ExtBoundCondName)
ELSE
! subsurface
Found=FindIteminList('iz-'//SurfaceTmp(SurfNum)%BaseSurfName,SurfaceTmp%Name,FirstTotalSurfaces+CurNewSurf-1)
IF (Found > 0) THEN
SurfaceTmp(CurNewSurf)%BaseSurfName='iz-'//SurfaceTmp(SurfNum)%BaseSurfName
SurfaceTmp(CurNewSurf)%BaseSurf=Found
SurfaceTmp(Found)%Area = &
SurfaceTmp(Found)%Area - SurfaceTmp(CurNewSurf)%Area
IF (SurfaceTmp(CurNewSurf)%Class == SurfaceClass_Window .OR.SurfaceTmp(CurNewSurf)%Class == SurfaceClass_GlassDoor) THEN
SurfaceTmp(Found)%NetAreaShadowCalc = &
SurfaceTmp(Found)%NetAreaShadowCalc - SurfaceTmp(CurNewSurf)%Area/ &
SurfaceTmp(CurNewSurf)%Multiplier
ELSE ! Door, TDD:Diffuser, TDD:DOME
SurfaceTmp(Found)%NetAreaShadowCalc = &
SurfaceTmp(Found)%NetAreaShadowCalc - SurfaceTmp(CurNewSurf)%Area
ENDIF
SurfaceTmp(CurNewSurf)%ExtBoundCond=SurfaceTmp(Found)%ExtBoundCond
SurfaceTmp(CurNewSurf)%ExtBoundCondName=SurfaceTmp(SurfNum)%Name
SurfaceTmp(CurNewSurf)%ExtSolar=SurfaceTmp(Found)%ExtSolar
SurfaceTmp(CurNewSurf)%ExtWind=SurfaceTmp(Found)%ExtWind
SurfaceTmp(CurNewSurf)%Zone=SurfaceTmp(Found)%Zone
SurfaceTmp(CurNewSurf)%ZoneName=SurfaceTmp(Found)%ZoneName
SurfaceTmp(CurNewSurf)%OSCPtr=SurfaceTmp(Found)%OSCPtr
!Debug write(outputfiledebug,*) ' subsurf, extboundcondname=',trim(SurfaceTmp(CurNewSurf)%ExtBoundCondName)
!Debug write(outputfiledebug,*) ' subsurf, basesurf=',trim('iz-'//SurfaceTmp(SurfNum)%BaseSurfName)
ELSE
CALL ShowSevereError(RoutineName//'Adding unentered subsurface, could not find base surface='// &
TRIM('iz-'//SurfaceTmp(SurfNum)%BaseSurfName))
SurfError=.true.
ENDIF
ENDIF
ENDDO
!**********************************************************************************
! After all of the surfaces have been defined then the base surfaces for the
! sub-surfaces can be defined. Loop through surfaces and match with the sub-surface
! names.
DO SurfNum= 1, TotSurfaces
IF (.not. SurfaceTmp(SurfNum)%HeatTransSurf) CYCLE
! why are we doing this again? this should have already been done.
IF (SameString(SurfaceTmp(SurfNum)%BaseSurfName,SurfaceTmp(SurfNum)%Name)) THEN
Found=SurfNum
ELSE
Found=FindIteminList(SurfaceTmp(SurfNum)%BaseSurfName,SurfaceTmp%Name,TotSurfaces)
ENDIF
If (Found > 0) THEN
SurfaceTmp(SurfNum)%BaseSurf=Found
IF (SurfNum /= Found) THEN ! for subsurfaces
IF (SurfaceTmp(SurfNum)%HeatTransSurf) SurfaceTmp(Found)%NumSubSurfaces=SurfaceTmp(Found)%NumSubSurfaces+1
IF (SurfaceTmp(SurfNum)%Class < SurfaceClass_Window .or. &
SurfaceTmp(SurfNum)%Class > SurfaceClass_TDD_Diffuser) THEN
IF (SurfaceTmp(SurfNum)%Class == 0) THEN
CALL ShowSevereError(RoutineName//'Invalid SubSurface detected, Surface='//TRIM(SurfaceTmp(SurfNum)%Name))
ELSE
CALL ShowSevereError(RoutineName//'Invalid SubSurface detected, Surface='//TRIM(SurfaceTmp(SurfNum)%Name)// &
', class='//TRIM(BaseSurfCls(SurfaceTmp(SurfNum)%Class))//' invalid class for subsurface')
SurfError=.true.
ENDIF
ENDIF
ENDIF
End If
END DO ! ...end of the Surface DO loop for finding BaseSurf
!**********************************************************************************
!**********************************************************************************
! orientation of flat subsurfaces (window/door/etc) need to match base surface
! CR8628
! ALLOCATE(TestVertex(4)) ! subsurfaces we will look at have max of 4 vertices
DO SurfNum=1,TotSurfaces
IF (.not. SurfaceTmp(SurfNum)%HeatTransSurf) CYCLE
! If flat surface
surfAzimuth = SurfaceTmp(SurfNum)%Azimuth
surfTilt = SurfaceTmp(SurfNum)%Tilt
IF (ABS(surfTilt) <= 1.d-5 .or. ABS(surfTilt-180.d0) <= 1.d-5) THEN
! see if there are any subsurfaces on roofs/floors
DO itmp1=1,TotSurfaces
IF (itmp1 == SurfNum) CYCLE
IF (.not. SurfaceTmp(itmp1)%BaseSurf == SurfNum) CYCLE
IF (.not. SurfaceTmp(itmp1)%HeatTransSurf) CYCLE
! write(outputfiledebug,'(A)') 'roof/floor basesurface='//trim(SurfaceTmp(SurfNum)%Name)
! write(outputfiledebug,'(A,3f7.2)') 'basesurface lc vectors=',SurfaceTmp(SurfNum)%lcsx
! write(outputfiledebug,'(3f7.2)') SurfaceTmp(SurfNum)%lcsy
! write(outputfiledebug,'(3f7.2)') SurfaceTmp(SurfNum)%lcsz
! write(outputfiledebug,'(A,3f7.2)') 'basesurface surfnorm=',SurfaceTmp(SurfNum)%NewellSurfaceNormalVector
! write(outputfiledebug,'(A)') 'subsurface='//trim(SurfaceTmp(itmp1)%Name)
! write(outputfiledebug,'(A,3f7.2)') 'subsurface lc vectors=',SurfaceTmp(itmp1)%lcsx
! write(outputfiledebug,'(3f7.2)') SurfaceTmp(itmp1)%lcsy
! write(outputfiledebug,'(3f7.2)') SurfaceTmp(itmp1)%lcsz
! write(outputfiledebug,'(A,3f7.2)') 'subsurface surfnorm=',SurfaceTmp(itmp1)%NewellSurfaceNormalVector
IF (ABS(SurfaceTmp(itmp1)%Azimuth-surfAzimuth) <= 10.d0) CYCLE
CALL CompareTwoVectors(SurfaceTmp(SurfNum)%NewellSurfaceNormalVector,SurfaceTmp(itmp1)%NewellSurfaceNormalVector, &
sameSurfNormal,.001d0)
IF (sameSurfNormal) THEN ! copy lcs vectors
SurfaceTmp(itmp1)%lcsx=SurfaceTmp(SurfNum)%lcsx
SurfaceTmp(itmp1)%lcsy=SurfaceTmp(SurfNum)%lcsy
SurfaceTmp(itmp1)%lcsy=SurfaceTmp(SurfNum)%lcsy
CYCLE
ENDIF
! IF (ABS(SurfaceTmp(itmp1)%Azimuth-360.0d0) < .01d0) THEN
! SurfaceTmp(itmp1)%Azimuth=360.0d0-SurfaceTmp(itmp1)%Azimuth
! ENDIF
! IF (ABS(surfAzimuth-360.0d0) < .01d0) THEN
! surfAzimuth=360.0d0-surfAzimuth
! SurfaceTmp(SurfNum)%Azimuth=surfAzimuth
! ENDIF
! IF (ABS(SurfaceTmp(itmp1)%Azimuth-surfAzimuth) <= 10.d0) CYCLE
! have subsurface of base surface
! warning error
! Warning4Count=Warning4Count+1
! IF (Warning4Count == 1 .and. .not. DisplayExtraWarnings) THEN
! CALL ShowSevereError(Routinename//'Some Outward Facing angles of subsurfaces differ '// &
! 'significantly from flat roof/floor base surface.')
! CALL ShowContinueError('Fixes will be attempted to align subsurface with base surface.')
! CALL ShowContinueError('...use Output:Diagnostics,DisplayExtraWarnings; '// &
! 'to show more details on individual surfaces.')
! ENDIF
IF (DisplayExtraWarnings) THEN
CALL ShowSevereError(Routinename//'Outward facing angle ['// &
TRIM(RoundSigDigits(SurfaceTmp(itmp1)%Azimuth,3))// &
'] of subsurface="'//TRIM(SurfaceTmp(itmp1)%Name)// &
'" significantly different than')
CALL ShowContinueError('..facing angle ['//TRIM(RoundSigDigits(SurfaceTmp(SurfNum)%Azimuth,3))// &
'] of base surface='//TRIM(SurfaceTmp(SurfNum)%Name))
CALL ShowContinueError('..surface class of base surface='//TRIM(cSurfaceClass(SurfaceTmp(SurfNum)%Class)))
! CALL ShowContinueError('Fixes will be attempted to align subsurface with base surface.')
ENDIF
! Vrt=1
! testV=2
! testVsave=2
! Located=.false.
! DO CountSides=1,SurfaceTmp(itmp1)%Sides
! DO Vrt=1,SurfaceTmp(itmp1)%Sides
! TestVertex(Vrt)=SurfaceTmp(itmp1)%Vertex(testV)
! testV=testV+1
! if (testV > SurfaceTmp(itmp1)%Sides) testV=1
! ENDDO
! CALL CreateNewellSurfaceNormalVector(TestVertex,SurfaceTmp(itmp1)%Sides, &
! SurfaceTmp(itmp1)%NewellSurfaceNormalVector)
! CALL DetermineAzimuthAndTilt(TestVertex,SurfaceTmp(itmp1)%Sides,SurfWorldAz,surfTilt, &
! SurfaceTmp(itmp1)%lcsx,SurfaceTmp(itmp1)%lcsy,SurfaceTmp(itmp1)%lcsz, &
! SurfaceTmp(itmp1)%GrossArea,SurfaceTmp(itmp1)%NewellSurfaceNormalVector)
! IF (ABS(surfAzimuth-surfWorldAz) <= 1.d-5) THEN ! found it
! DO Vrt=1,SurfaceTmp(itmp1)%Sides
! SurfaceTmp(itmp1)%Vertex(Vrt)=TestVertex(Vrt)
! ENDDO
! SurfaceTmp(itmp1)%Azimuth=SurfWorldAz
! SurfaceTmp(itmp1)%Tilt=surfTilt
! Located=.true.
! EXIT
! ENDIF
! testV=testVsave+1
! IF (testV > SurfaceTmp(itmp1)%Sides) EXIT
! ENDDO
! IF (.not. Located) THEN
! Warning5Count=Warning5Count+1
! ! another warning
! IF (DisplayExtraWarnings) THEN
! CALL ShowContinueError('Fix could not be accomplished. Original orientation is retained.')
! ENDIF
! CALL CreateNewellSurfaceNormalVector(SurfaceTmp(itmp1)%Vertex,SurfaceTmp(itmp1)%Sides, &
! SurfaceTmp(itmp1)%NewellSurfaceNormalVector)
! CALL DetermineAzimuthAndTilt(SurfaceTmp(itmp1)%Vertex,SurfaceTmp(itmp1)%Sides,SurfWorldAz,surfTilt, &
! SurfaceTmp(itmp1)%lcsx,SurfaceTmp(itmp1)%lcsy,SurfaceTmp(itmp1)%lcsz, &
! SurfaceTmp(itmp1)%GrossArea,SurfaceTmp(itmp1)%NewellSurfaceNormalVector)
! SurfaceTmp(itmp1)%Azimuth=SurfWorldAz
! SurfaceTmp(itmp1)%Tilt=surfTilt
! ENDIF
ENDDO
ENDIF
ENDDO
! IF (Warning5Count > 0) THEN
! CALL ShowMessage(RoutineName//'There were '//trim(RoundSigDigits(Warning5Count))// &
! ' subsurfaces whose orientation (azimuth) could not be fixed to align with the base surface.')
! CALL ShowMessage('Shadowing calculations may be inaccurate. Use Output:Diagnostics,DisplayExtraWarnings; for details.')
! ENDIF
! DEALLOCATE(TestVertex)
! The surfaces need to be hierarchical. Input is allowed to be in any order. In
! this section it is reordered into:
! Detached shadowing surfaces
! For each zone:
! For each Wall
! subsurfaces (windows, doors, shading) for that wall
! For each Floor
! subsurfaces for that floor
! For each Roof
! subsurfaces for that roof/ceiling
! Internal Mass
!
! After reordering, MovedSurfs should equal TotSurfaces
MovedSurfs=0
ALLOCATE (Surface(TotSurfaces)) ! Allocate the Surface derived type appropriately
! Move all Detached Surfaces to Front
DO SurfNum=1,TotSurfaces
IF (SurfaceTmp(SurfNum)%Class /= SurfaceClass_Detached_F .and. &
SurfaceTmp(SurfNum)%Class /= SurfaceClass_Detached_B .and. &
SurfaceTmp(SurfNum)%Class /= SurfaceClass_Shading) CYCLE
! A shading surface
MovedSurfs=MovedSurfs+1
Surface(MovedSurfs)=SurfaceTmp(SurfNum)
SurfaceTmp(SurfNum)%Class=SurfaceClass_Moved !'Moved'
ENDDO
! For each zone
DO ZoneNum=1,NumOfZones
! For each Base Surface Type (Wall, Floor, Roof)
DO Loop=1,3
DO SurfNum=1,TotSurfaces
IF (SurfaceTmp(SurfNum)%Zone == 0) CYCLE
IF (.not. SameString(SurfaceTmp(SurfNum)%ZoneName,Zone(ZoneNum)%Name)) CYCLE
IF (SurfaceTmp(SurfNum)%Class /= BaseSurfIDs(Loop)) CYCLE
MovedSurfs=MovedSurfs+1
Surface(MovedSurfs)=SurfaceTmp(SurfNum)
SurfaceTmp(SurfNum)%Class=SurfaceClass_Moved ! 'Moved'
SurfaceTmp(SurfNum)%BaseSurf=-1 ! Default has base surface = base surface
BaseSurfNum=MovedSurfs
Surface(MovedSurfs)%BaseSurf=BaseSurfNum
! Find all subsurfaces to this surface
DO SubSurfNum=1,TotSurfaces
IF (SurfaceTmp(SubSurfNum)%Zone == 0) CYCLE
IF (SurfaceTmp(SubSurfNum)%BaseSurf /= SurfNum) CYCLE
MovedSurfs=MovedSurfs+1
Surface(MovedSurfs)=SurfaceTmp(SubSurfNum)
SurfaceTmp(SubSurfNum)%Class=SurfaceClass_Moved ! 'Moved'
Surface(MovedSurfs)%BaseSurf=BaseSurfNum
SurfaceTmp(SubSurfNum)%BaseSurf=-1
ENDDO
ENDDO
ENDDO
DO SurfNum=1,TotSurfaces
IF (SurfaceTmp(SurfNum)%ZoneName /= Zone(ZoneNum)%Name) CYCLE
IF (SurfaceTmp(SurfNum)%Class /= SurfaceClass_IntMass) CYCLE
MovedSurfs=MovedSurfs+1
Surface(MovedSurfs)=SurfaceTmp(SurfNum)
Surface(MovedSurfs)%BaseSurf=MovedSurfs
SurfaceTmp(SurfNum)%Class=SurfaceClass_Moved ! 'Moved'
ENDDO
ENDDO
IF (MovedSurfs /= TotSurfaces) THEN
WRITE(ClassMsg,*) MovedSurfs
ClassMsg=ADJUSTL(ClassMsg)
WRITE(Msg2,*) TotSurfaces
Msg2=ADJUSTL(Msg2)
CALL ShowSevereError(RoutineName//'Reordered # of Surfaces ('//TRIM(ClassMsg)// &
') not = Total # of Surfaces ('//TRIM(Msg2)//')')
SurfError=.true.
DO Loop=1,TotSurfaces
IF (SurfaceTmp(Loop)%Class /= SurfaceClass_Moved) THEN
IF (SurfaceTmp(Loop)%Class > 100) THEN
CALL ShowSevereError(RoutineName//'Error in Surface= "'//TRIM(SurfaceTmp(Loop)%Name)// &
'" Class='//TRIM(cSurfaceClass(SurfaceTmp(Loop)%Class-100))// &
' indicated Zone="'//TRIM(SurfaceTmp(Loop)%ZoneName)//'"')
ENDIF
ENDIF
ENDDO
CALL ShowWarningError(RoutineName//'Remaining surface checks will use "reordered number of surfaces", '// &
'not number of original surfaces')
ENDIF
DEALLOCATE (SurfaceTmp) ! DeAllocate the Temp Surface derived type
! For each Base Surface Type (Wall, Floor, Roof)
DO Loop=1,3
DO SurfNum=1,TotSurfaces
IF (Surface(SurfNum)%Zone == 0) CYCLE
IF (Surface(SurfNum)%Class /= BaseSurfIDs(Loop)) CYCLE
! Find all subsurfaces to this surface
DO SubSurfNum=1,TotSurfaces
IF (SurfNum == SubSurfNum) CYCLE
IF (Surface(SubSurfNum)%Zone == 0) CYCLE
IF (Surface(SubSurfNum)%BaseSurf /= SurfNum) CYCLE
! Check facing angle of Sub compared to base
! ignore problems of subsurfaces on roofs/ceilings/floors with azimuth
! IF (Surface(SurfNum)%Class == SurfaceClass_Roof .or. Surface(SurfNum)%Class == SurfaceClass_Floor) CYCLE
! write(outputfiledebug,'(A)') 'basesurface='//trim(surface(SurfNum)%Name)
! write(outputfiledebug,'(A,3F7.2)') 'basesurface lc vectors=',Surface(SurfNum)%lcsx
! write(outputfiledebug,'(3f7.2)') Surface(SurfNum)%lcsy
! write(outputfiledebug,'(3f7.2)') Surface(SurfNum)%lcsz
! write(outputfiledebug,'(A,3f7.2)') 'basesurface surfnorm=',Surface(SurfNum)%NewellSurfaceNormalVector
! write(outputfiledebug,'(A)') 'subsurface='//trim(surface(SubSurfNum)%Name)
! write(outputfiledebug,'(A,3F7.2)') 'subsurface lc vectors=',Surface(SubSurfNum)%lcsx
! write(outputfiledebug,'(3f7.2)') Surface(SubSurfNum)%lcsy
! write(outputfiledebug,'(3f7.2)') Surface(SubSurfNum)%lcsz
! write(outputfiledebug,'(A,3f7.2)') 'subsurface surfnorm=',Surface(SubSurfNum)%NewellSurfaceNormalVector
IF (ABS(Surface(SubSurfNum)%Azimuth-Surface(SurfNum)%Azimuth) <= 30.0d0) CYCLE
CALL CompareTwoVectors(Surface(SurfNum)%NewellSurfaceNormalVector,Surface(SubSurfNum)%NewellSurfaceNormalVector, &
sameSurfNormal,.001d0)
IF (sameSurfNormal) THEN ! copy lcs vectors
Surface(SubSurfNum)%lcsx=Surface(SurfNum)%lcsx
Surface(SubSurfNum)%lcsy=Surface(SurfNum)%lcsy
Surface(SubSurfNum)%lcsy=Surface(SurfNum)%lcsy
CYCLE
ENDIF
IF (ABS(Surface(SubSurfNum)%Azimuth-360.0d0) < .01d0) THEN
Surface(SubSurfNum)%Azimuth=360.0d0-Surface(SubSurfNum)%Azimuth
ENDIF
IF (ABS(Surface(SurfNum)%Azimuth-360.0d0) < .01d0) THEN
Surface(SurfNum)%Azimuth=360.0d0-Surface(SurfNum)%Azimuth
ENDIF
IF (ABS(Surface(SubSurfNum)%Azimuth-Surface(SurfNum)%Azimuth) > 30.0d0) THEN
IF (ABS(Surface(SurfNum)%SinTilt) > .17d0) THEN
ErrCount1=ErrCount1+1
IF (ErrCount1 == 1 .and. .not. DisplayExtraWarnings) THEN
CALL ShowSevereError(Routinename//'Some Outward Facing angles of subsurfaces differ '// &
'significantly from base surface.')
CALL ShowContinueError('...use Output:Diagnostics,DisplayExtraWarnings; '// &
'to show more details on individual surfaces.')
ENDIF
IF (DisplayExtraWarnings) THEN
CALL ShowSevereError(Routinename//'Outward facing angle ['// &
TRIM(RoundSigDigits(Surface(SubSurfNum)%Azimuth,1))// &
'] of subsurface="'//TRIM(Surface(SubSurfNum)%Name)// &
'" significantly different than')
CALL ShowContinueError('..facing angle ['//TRIM(RoundSigDigits(Surface(SurfNum)%Azimuth,1))// &
'] of base surface='//TRIM(Surface(SurfNum)%Name)//' Tilt='//TRIM(RoundSigDigits(Surface(SurfNum)%Tilt,1)))
CALL ShowContinueError('..surface class of base surface='//TRIM(cSurfaceClass(Surface(SurfNum)%Class)))
ENDIF
ENDIF
! SurfError=.true.
ENDIF
ENDDO
ENDDO
ENDDO
!**********************************************************************************
! Now, match up interzone surfaces
!
NonMatch=.false.
izConstDiffMsg=.false.
DO SurfNum= 1, MovedSurfs !TotSurfaces
! Clean up Shading Surfaces, make sure they don't go through here.
! Shading surfaces have "Zone=0", should also have "BaseSurf=0"
! PGE: Revised so that shading surfaces can have BaseSurf /= 0 if they are daylighting shelves
! or other exterior reflecting surfaces.
!IF (Surface(SurfNum)%Zone == 0) THEN
! Surface(SurfNum)%BaseSurf=0
! CYCLE
!ENDIF
IF (.not. Surface(SurfNum)%HeatTransSurf) CYCLE
! If other surface, match it up
! Both interzone and "internal" surfaces have this pointer set
! Internal surfaces point to themselves, Interzone to another
IF (Surface(SurfNum)%ExtBoundCond == UnreconciledZoneSurface) THEN
IF (Surface(SurfNum)%ExtBoundCondName /= ' ') THEN
IF (Surface(SurfNum)%ExtBoundCondName == Surface(SurfNum)%Name) THEN
Found=SurfNum
ELSE
Found=FindIteminList(Surface(SurfNum)%ExtBoundCondName,Surface%Name,MovedSurfs)
ENDIF
IF (Found /= 0) THEN
Surface(SurfNum)%ExtBoundCond=Found
! Check that matching surface is also "OtherZoneSurface"
IF (Surface(Found)%ExtBoundCond <= 0 .and. Surface(Found)%ExtBoundCond /= UnreconciledZoneSurface) THEN
CALL ShowSevereError(RoutineName//'Potential "OtherZoneSurface" is not matched correctly:')
CALL ShowContinueError('Surface='//TRIM(Surface(SurfNum)%Name)//', Zone='//TRIM(Surface(SurfNum)%ZoneName))
CALL ShowContinueError('Nonmatched Other/InterZone Surface='//TRIM(Surface(Found)%Name)//', Zone='// &
TRIM(Surface(Found)%ZoneName))
SurfError=.true.
ENDIF
! Check that matching interzone surface has construction with reversed layers
IF (Found /= SurfNum) THEN ! Interzone surface
! Make sure different zones too (CR 4110)
IF (Surface(SurfNum)%Zone == Surface(Found)%Zone) THEN
ErrCount2=ErrCount2+1
IF (ErrCount2 == 1 .and. .not. DisplayExtraWarnings) THEN
CALL ShowWarningError(RoutineName//'CAUTION -- Interzone surfaces are occuring in the same zone(s).')
CALL ShowContinueError('...use Output:Diagnostics,DisplayExtraWarnings; '// &
'to show more details on individual occurrences.')
ENDIF
IF (DisplayExtraWarnings) THEN
CALL ShowWarningError(RoutineName//'CAUTION -- Interzone surfaces are usually in different zones')
CALL ShowContinueError('Surface='//TRIM(Surface(SurfNum)%Name)//', Zone='//TRIM(Surface(SurfNum)%ZoneName))
CALL ShowContinueError('Surface='//TRIM(Surface(Found)%Name)//', Zone='//TRIM(Surface(Found)%ZoneName))
ENDIF
ENDIF
ConstrNum = Surface(SurfNum)%Construction
ConstrNumFound = Surface(Found)%Construction
IF (ConstrNum <= 0 .or. ConstrNumFound <= 0) CYCLE
IF (Construct(ConstrNum)%ReverseConstructionNumLayersWarning .and. &
Construct(ConstrNumFound)%ReverseConstructionNumLayersWarning) CYCLE
IF (Construct(ConstrNum)%ReverseConstructionLayersOrderWarning .and. &
Construct(ConstrNumFound)%ReverseConstructionLayersOrderWarning) CYCLE
TotLay = Construct(ConstrNum)%TotLayers
TotLayFound = Construct(ConstrNumFound)%TotLayers
IF(TotLay /= TotLayFound) THEN ! Different number of layers
! match on like Uvalues (nominal)
IF (ABS(NominalU(ConstrNum)-NominalU(ConstrNumFound)) > .001d0) THEN
CALL ShowSevereError(RoutineName//'Construction '//TRIM(Construct(ConstrNum)%Name)// &
' of interzone surface '//TRIM(Surface(SurfNum)%Name)// &
' does not have the same number of layers as the construction ' &
//TRIM(Construct(ConstrNumFound)%Name)// &
' of adjacent surface '//TRIM(Surface(Found)%Name))
IF (.not. Construct(ConstrNum)%ReverseConstructionNumLayersWarning .or. &
.not. Construct(ConstrNumFound)%ReverseConstructionNumLayersWarning) THEN
CALL ShowContinueError('...this problem for this pair will not be reported again.')
Construct(ConstrNum)%ReverseConstructionNumLayersWarning=.true.
Construct(ConstrNumFound)%ReverseConstructionNumLayersWarning=.true.
ENDIF
SurfError=.true.
ENDIF
ELSE ! Same number of layers; check for reverse layers
! check layers as number of layers is the same
izConstDiff=.false.
! ok if same nominal U
DO Lay = 1,TotLay
IF(Construct(ConstrNum)%LayerPoint(Lay) /= &
Construct(ConstrNumFound)%LayerPoint(TotLay-Lay+1)) THEN
izConstDiff=.true.
EXIT ! exit when diff
END IF
END DO
IF (izConstDiff .and. ABS(NominalU(ConstrNum)-NominalU(ConstrNumFound)) > .001d0) THEN
CALL ShowSevereError(RoutineName//'Construction '//TRIM(Construct(ConstrNum)%Name)// &
' of interzone surface '//TRIM(Surface(SurfNum)%Name)// &
' does not have the same materials in the reverse order as the construction ' &
//TRIM(Construct(ConstrNumFound)%Name)// &
' of adjacent surface '//TRIM(Surface(Found)%Name))
IF (.not. Construct(ConstrNum)%ReverseConstructionLayersOrderWarning .or. &
.not. Construct(ConstrNumFound)%ReverseConstructionLayersOrderWarning) THEN
CALL ShowContinueError('...this problem for this pair will not be reported again.')
Construct(ConstrNum)%ReverseConstructionLayersOrderWarning=.true.
Construct(ConstrNumFound)%ReverseConstructionLayersOrderWarning=.true.
ENDIF
SurfError=.true.
ELSEIF (izConstDiff) THEN
CALL ShowWarningError(RoutineName//'Construction '//TRIM(Construct(ConstrNum)%Name)// &
' of interzone surface '//TRIM(Surface(SurfNum)%Name)// &
' does not have the same materials in the reverse order as the construction ' &
//TRIM(Construct(ConstrNumFound)%Name)// &
' of adjacent surface '//TRIM(Surface(Found)%Name))
CALL ShowContinueError('...but Nominal U values are similar, diff=['// &
trim(RoundSigDigits(ABS(NominalU(ConstrNum)-NominalU(ConstrNumFound)),4))//'] ... simulation proceeds.')
IF (.not. izConstDiffMsg) THEN
CALL ShowContinueError('...if the two zones are expected to have significantly different temperatures, '// &
'the proper "reverse" construction should be created.')
izConstDiffMsg=.true.
ENDIF
IF (.not. Construct(ConstrNum)%ReverseConstructionLayersOrderWarning .or. &
.not. Construct(ConstrNumFound)%ReverseConstructionLayersOrderWarning) THEN
CALL ShowContinueError('...this problem for this pair will not be reported again.')
Construct(ConstrNum)%ReverseConstructionLayersOrderWarning=.true.
Construct(ConstrNumFound)%ReverseConstructionLayersOrderWarning=.true.
ENDIF
ENDIF
END IF
! If significantly different areas -- this would not be good
MultFound = Zone(Surface(Found)%Zone)%Multiplier * Zone(Surface(Found)%Zone)%ListMultiplier
MultSurfNum = Zone(Surface(SurfNum)%Zone)%Multiplier * Zone(Surface(SurfNum)%Zone)%ListMultiplier
IF (Surface(Found)%Area > 0.0d0) THEN
IF (ABS((Surface(Found)%Area*MultFound - Surface(SurfNum)%Area*MultSurfNum)/ &
Surface(Found)%Area*MultFound) > .02d0) THEN ! 2% difference in areas
ErrCount4=ErrCount4+1
IF (ErrCount4 == 1 .and. .not. DisplayExtraWarnings) THEN
CALL ShowWarningError(RoutineName//''// &
'InterZone Surface Areas do not match as expected and might not satisfy conservation of energy:')
CALL ShowContinueError('...use Output:Diagnostics,DisplayExtraWarnings; '// &
'to show more details on individual mismatches.')
ENDIF
IF (DisplayExtraWarnings) THEN
CALL ShowWarningError(RoutineName//''// &
'InterZone Surface Areas do not match as expected and might not satisfy conservation of energy:')
IF (MultFound == 1 .and. MultSurfNum == 1) THEN
CALL ShowContinueError(' Area='//TRIM(TrimSigDigits(Surface(SurfNum)%Area,1))// &
' in Surface='//TRIM(Surface(SurfNum)%Name)// &
', Zone='//TRIM(Surface(SurfNum)%ZoneName))
CALL ShowContinueError(' Area='//TRIM(TrimSigDigits(Surface(Found)%Area,1))// &
' in Surface='//TRIM(Surface(Found)%Name)// &
', Zone='//TRIM(Surface(Found)%ZoneName))
ELSE ! Show multiplier info
WRITE(MultString,*) MultSurfNum
MultString=ADJUSTL(MultString)
CALL ShowContinueError(' Area='//TRIM(TrimSigDigits(Surface(SurfNum)%Area,1))// &
', Multipliers='//TRIM(MultString)// &
', Total Area='//TRIM(TrimSigDigits(Surface(SurfNum)%Area*MultSurfNum,1))// &
' in Surface='//TRIM(Surface(SurfNum)%Name)// &
' Zone='//TRIM(Surface(SurfNum)%ZoneName))
WRITE(MultString,*) MultFound
MultString=ADJUSTL(MultString)
CALL ShowContinueError(' Area='//TRIM(TrimSigDigits(Surface(Found)%Area,1))// &
', Multipliers='//TRIM(MultString)// &
', Total Area='//TRIM(TrimSigDigits(Surface(Found)%Area*MultFound,1))// &
' in Surface='//TRIM(Surface(Found)%Name)// &
' Zone='//TRIM(Surface(Found)%ZoneName))
ENDIF
ENDIF
ENDIF
ENDIF
! Check opposites Azimuth and Tilt
! Tilt
IF (ABS(ABS(Surface(Found)%Tilt+Surface(SurfNum)%Tilt)-180.d0) > 1.0d0) THEN
CALL ShowWarningError(RoutineName//'InterZone Surface Tilts do not match as expected.')
CALL ShowContinueError(' Tilt='//TRIM(TrimSigDigits(Surface(SurfNum)%Tilt,1))// &
' in Surface='//TRIM(Surface(SurfNum)%Name)//', Zone='//TRIM(Surface(SurfNum)%ZoneName))
CALL ShowContinueError(' Tilt='//TRIM(TrimSigDigits(Surface(Found)%Tilt,1))// &
' in Surface='//TRIM(Surface(Found)%Name)//', Zone='//TRIM(Surface(Found)%ZoneName))
ENDIF
! check surface class match. interzone surface.
IF ((Surface(SurfNum)%Class == SurfaceClass_Wall .and. Surface(Found)%Class /= SurfaceClass_Wall) .or. &
(Surface(SurfNum)%Class /= SurfaceClass_Wall .and. Surface(Found)%Class == SurfaceClass_Wall) ) THEN
CALL ShowWarningError(RoutineName//'InterZone Surface Classes do not match as expected.')
CALL ShowContinueError('Surface="'//trim(Surface(SurfNum)%Name)//'", surface class='// &
TRIM(cSurfaceClass(Surface(SurfNum)%Class)))
CALL ShowContinueError('Adjacent Surface="'//trim(Surface(Found)%Name)//'", surface class='// &
TRIM(cSurfaceClass(Surface(Found)%Class)))
CALL ShowContinueError('Other errors/warnings may follow about these surfaces.')
ENDIF
IF ((Surface(SurfNum)%Class == SurfaceClass_Roof .and. Surface(Found)%Class /= SurfaceClass_Floor) .or. &
(Surface(SurfNum)%Class /= SurfaceClass_Roof .and. Surface(Found)%Class == SurfaceClass_Floor) ) THEN
CALL ShowWarningError(RoutineName//'InterZone Surface Classes do not match as expected.')
CALL ShowContinueError('Surface="'//trim(Surface(SurfNum)%Name)//'", surface class='// &
TRIM(cSurfaceClass(Surface(SurfNum)%Class)))
CALL ShowContinueError('Adjacent Surface="'//trim(Surface(Found)%Name)//'", surface class='// &
TRIM(cSurfaceClass(Surface(Found)%Class)))
CALL ShowContinueError('Other errors/warnings may follow about these surfaces.')
ENDIF
IF (Surface(SurfNum)%Class /= SurfaceClass_Roof .and. Surface(SurfNum)%Class /= SurfaceClass_Floor) THEN
! Walls, Windows, Doors, Glass Doors
IF (Surface(SurfNum)%Class /= SurfaceClass_Wall) THEN
! Surface is a Door, Window or Glass Door
IF (Surface(SurfNum)%BaseSurf == 0) CYCLE ! error detected elsewhere
IF (Surface(Surface(SurfNum)%BaseSurf)%Class == SurfaceClass_Roof .or. &
Surface(Surface(SurfNum)%BaseSurf)%Class == SurfaceClass_Floor) CYCLE
ENDIF
IF (ABS(ABS(Surface(SurfNum)%Azimuth-Surface(Found)%Azimuth)-180.d0) > 1.d0) THEN
IF (ABS(Surface(SurfNum)%SinTilt) > .5d0 .or. DisplayExtraWarnings) THEN
! if horizontal surfaces, then these are windows/doors/etc in those items.
CALL ShowWarningError(RoutineName//'InterZone Surface Azimuths do not match as expected.')
CALL ShowContinueError(' Azimuth='//TRIM(TrimSigDigits(Surface(SurfNum)%Azimuth,1))// &
', Tilt='//TRIM(TrimSigDigits(Surface(SurfNum)%Tilt,1))// &
', in Surface='//TRIM(Surface(SurfNum)%Name)//', Zone='//TRIM(Surface(SurfNum)%ZoneName))
CALL ShowContinueError(' Azimuth='//TRIM(TrimSigDigits(Surface(Found)%Azimuth,1))// &
', Tilt='//TRIM(TrimSigDigits(Surface(Found)%Tilt,1))// &
', in Surface='//TRIM(Surface(Found)%Name)//', Zone='//TRIM(Surface(Found)%ZoneName))
CALL ShowContinueError('..surface class of first surface='//TRIM(cSurfaceClass(Surface(SurfNum)%Class)))
CALL ShowContinueError('..surface class of second surface='//TRIM(cSurfaceClass(Surface(Found)%Class)))
ENDIF
ENDIF
ELSE ! Roofs, Floors
! should be looking at opposite tilts, not azimuth for roof/floor matches...
! IF (ABS(ABS(Surface(SurfNum)%Azimuth+Surface(Found)%Azimuth)-360.) > 1.0d0) THEN
! CALL ShowWarningError('InterZone Surface Azimuths do not match as expected.')
! CALL ShowContinueError(' Azimuth='//TRIM(TrimSigDigits(Surface(SurfNum)%Azimuth,1))// &
! ' in Surface='//TRIM(Surface(SurfNum)%Name)//', Zone='//TRIM(Surface(SurfNum)%ZoneName))
! CALL ShowContinueError(' Azimuth='//TRIM(TrimSigDigits(Surface(Found)%Azimuth,1))// &
! ' in Surface='//TRIM(Surface(Found)%Name)//', Zone='//TRIM(Surface(Found)%ZoneName))
! ENDIF
ENDIF
! Make sure exposures (Sun, Wind) are the same.....and are "not"
IF (Surface(SurfNum)%ExtSolar .or. Surface(Found)%ExtSolar) THEN
CALL ShowWarningError(RoutineName//'Interzone surfaces cannot be "SunExposed" -- removing SunExposed')
CALL ShowContinueError(' Surface='//TRIM(Surface(SurfNum)%Name)//', Zone='//TRIM(Surface(SurfNum)%ZoneName))
CALL ShowContinueError(' Surface='//TRIM(Surface(Found)%Name)//', Zone='//TRIM(Surface(Found)%ZoneName))
Surface(SurfNum)%ExtSolar=.false.
Surface(Found)%ExtSolar=.false.
ENDIF
IF (Surface(SurfNum)%ExtWind .or. Surface(Found)%ExtWind) THEN
CALL ShowWarningError(RoutineName//'Interzone surfaces cannot be "WindExposed" -- removing WindExposed')
CALL ShowContinueError(' Surface='//TRIM(Surface(SurfNum)%Name)//', Zone='//TRIM(Surface(SurfNum)%ZoneName))
CALL ShowContinueError(' Surface='//TRIM(Surface(Found)%Name)//', Zone='//TRIM(Surface(Found)%ZoneName))
Surface(SurfNum)%ExtWind=.false.
Surface(Found)%ExtWind=.false.
ENDIF
END IF
! Set opposing surface back to this one (regardless of error)
Surface(Found)%ExtBoundCond=SurfNum
! Check subsurfaces... make sure base surface is also an interzone surface
IF (Surface(SurfNum)%BaseSurf /= SurfNum) THEN ! Subsurface
IF (Surface(SurfNum)%ExtBoundCond /= SurfNum .and. Surface(SurfNum)%ExtBoundCondName /= ' ') THEN
! if not internal subsurface
IF (Surface(Surface(SurfNum)%BaseSurf)%ExtBoundCond == Surface(SurfNum)%BaseSurf) THEN
! base surface is not interzone surface
CALL ShowSevereError(RoutineName//'SubSurface="'//TRIM(Surface(SurfNum)%Name)//'" is an interzone subsurface.')
CALL ShowContinueError('..but the Base Surface is not an interzone surface, Surface="'// &
TRIM(Surface(Surface(SurfNum)%BaseSurf)%Name)//'".')
SurfError=.true.
ENDIF
ENDIF
ENDIF
Else
! Seems unlikely that an internal surface would be missing itself, so this message
! only indicates for adjacent (interzone) surfaces.
CALL ShowSevereError(RoutineName//'Adjacent Surface not found: '//TRIM(Surface(SurfNum)%ExtBoundCondName)// &
' adjacent to surface '//TRIM(Surface(SurfNum)%Name) )
NonMatch=.true.
SurfError=.true.
End If
ELSEIF (Surface(SurfNum)%BaseSurf /= SurfNum) THEN ! Subsurface
IF (Surface(Surface(SurfNum)%BaseSurf)%ExtBoundCond > 0 .and. & ! If Interzone surface, subsurface must be also.
Surface(Surface(SurfNum)%BaseSurf)%ExtBoundCond /= Surface(SurfNum)%BaseSurf) THEN
CALL ShowSevereError(RoutineName//'SubSurface on Interzone Surface must be an Interzone SubSurface.')
CALL ShowContinueError('...OutsideFaceEnvironment is blank, in Surface='//TRIM(Surface(SurfNum)%Name))
SurfError=.true.
ELSE
ErrCount3=ErrCount3+1
IF (ErrCount3 == 1 .and. .not. DisplayExtraWarnings) THEN
CALL ShowWarningError(RoutineName//'Blank name for Outside Boundary Condition Objects.')
CALL ShowContinueError('...use Output:Diagnostics,DisplayExtraWarnings; to show more details on individual surfaces.')
ENDIF
IF (DisplayExtraWarnings) THEN
CALL ShowWarningError(RoutineName//'Blank name for Outside Boundary Condition Object, in surface='// &
TRIM(Surface(SurfNum)%Name))
CALL ShowContinueError('Resetting this surface to be an internal zone surface, zone='//TRIM(Surface(SurfNum)%ZoneName))
ENDIF
Surface(SurfNum)%ExtBoundCondName=Surface(SurfNum)%Name
Surface(SurfNum)%ExtBoundCond=SurfNum
ENDIF
ELSE
ErrCount3=ErrCount3+1
IF (ErrCount3 == 1 .and. .not. DisplayExtraWarnings) THEN
CALL ShowSevereError(RoutineName//'Blank name for Outside Boundary Condition Objects.')
CALL ShowContinueError('...use Output:Diagnostics,DisplayExtraWarnings; to show more details on individual surfaces.')
ENDIF
IF (DisplayExtraWarnings) THEN
CALL ShowWarningError(RoutineName//'Blank name for Outside Boundary Condition Object, in surface='// &
TRIM(Surface(SurfNum)%Name))
CALL ShowContinueError('Resetting this surface to be an internal zone (adiabatic) surface, zone='// &
TRIM(Surface(SurfNum)%ZoneName))
ENDIF
Surface(SurfNum)%ExtBoundCondName=Surface(SurfNum)%Name
Surface(SurfNum)%ExtBoundCond=SurfNum
SurfError=.true.
ENDIF
End If
END DO ! ...end of the Surface DO loop for finding BaseSurf
If (NonMatch) THEN
CALL ShowSevereError(RoutineName//'Non matching interzone surfaces found')
End If
!**********************************************************************************
! Warn about interzone surfaces that have adiabatic windows/vice versa
SubSurfaceSevereDisplayed=.false.
DO SurfNum=1,TotSurfaces
IF (.not. Surface(SurfNum)%HeatTransSurf) CYCLE
IF (Surface(SurfNum)%BaseSurf == SurfNum) CYCLE ! base surface
! not base surface. Check it.
IF (Surface(Surface(SurfNum)%BaseSurf)%ExtBoundCond <= 0) THEN ! exterior or other base surface
IF (Surface(SurfNum)%ExtBoundCond /= Surface(Surface(SurfNum)%BaseSurf)%ExtBoundCond) THEN ! should match base surface
IF (Surface(SurfNum)%ExtBoundCond == SurfNum) THEN
CALL ShowSevereError(RoutineName//'Subsurface="'//trim(Surface(SurfNum)%Name)// &
'" exterior condition [adiabatic surface] in a base surface="'// &
trim(Surface(Surface(SurfNum)%BaseSurf)%Name)// &
'" with exterior condition ['// &
trim(cExtBoundCondition(Surface(Surface(SurfNum)%BaseSurf)%ExtBoundCond))//']')
SurfError=.true.
ELSEIF (Surface(SurfNum)%ExtBoundCond > 0) THEN
CALL ShowSevereError(RoutineName//'Subsurface="'//trim(Surface(SurfNum)%Name)// &
'" exterior condition [interzone surface] in a base surface="'// &
trim(Surface(Surface(SurfNum)%BaseSurf)%Name)// &
'" with exterior condition ['// &
trim(cExtBoundCondition(Surface(Surface(SurfNum)%BaseSurf)%ExtBoundCond))//']')
SurfError=.true.
ELSEIF (Surface(Surface(SurfNum)%BaseSurf)%ExtBoundCond == OtherSideCondModeledExt) THEN
CALL ShowWarningError(RoutineName//'Subsurface="'//trim(Surface(SurfNum)%Name)// &
'" exterior condition ['// &
trim(cExtBoundCondition(Surface(SurfNum)%ExtBoundCond))// &
'] in a base surface="'//trim(Surface(Surface(SurfNum)%BaseSurf)%Name)// &
'" with exterior condition ['// &
trim(cExtBoundCondition(Surface(Surface(SurfNum)%BaseSurf)%ExtBoundCond))//']')
CALL ShowContinueError('...SubSurface will not use the exterior condition model of the base surface.')
ELSE
CALL ShowSevereError(RoutineName//'Subsurface="'//trim(Surface(SurfNum)%Name)// &
'" exterior condition ['// &
trim(cExtBoundCondition(Surface(SurfNum)%ExtBoundCond))// &
'] in a base surface="'//trim(Surface(Surface(SurfNum)%BaseSurf)%Name)// &
'" with exterior condition ['// &
trim(cExtBoundCondition(Surface(Surface(SurfNum)%BaseSurf)%ExtBoundCond))//']')
SurfError=.true.
ENDIF
IF (.not. SubSurfaceSevereDisplayed .and. SurfError) THEN
CALL ShowContinueError('...calculations for heat balance would be compromised.')
SubSurfaceSevereDisplayed=.true.
ENDIF
ENDIF
ELSEIF (Surface(Surface(SurfNum)%BaseSurf)%BaseSurf == Surface(Surface(SurfNum)%BaseSurf)%ExtBoundCond) THEN
! adiabatic surface. make sure subsurfaces match
IF (Surface(SurfNum)%ExtBoundCond /= SurfNum) THEN ! not adiabatic surface
IF (Surface(SurfNum)%ExtBoundCond > 0) THEN
CALL ShowSevereError(RoutineName//'Subsurface="'//trim(Surface(SurfNum)%Name)// &
'" exterior condition [interzone surface] in a base surface="'// &
trim(Surface(Surface(SurfNum)%BaseSurf)%Name)// &
'" with exterior condition [adiabatic surface]')
ELSE
CALL ShowSevereError(RoutineName//'Subsurface="'//trim(Surface(SurfNum)%Name)// &
'" exterior condition ['// &
trim(cExtBoundCondition(Surface(SurfNum)%ExtBoundCond))// &
'] in a base surface="'//trim(Surface(Surface(SurfNum)%BaseSurf)%Name)// &
'" with exterior condition [adiabatic surface]')
ENDIF
IF (.not. SubSurfaceSevereDisplayed) THEN
CALL ShowContinueError('...calculations for heat balance would be compromised.')
SubSurfaceSevereDisplayed=.true.
ENDIF
SurfError=.true.
ENDIF
ELSEIF (Surface(Surface(SurfNum)%BaseSurf)%ExtBoundCond > 0) THEN ! interzone surface
IF (Surface(SurfNum)%ExtBoundCond == SurfNum) THEN
CALL ShowSevereError(RoutineName//'Subsurface="'//trim(Surface(SurfNum)%Name)// &
'" is an adiabatic surface in an Interzone base surface="'//trim(Surface(Surface(SurfNum)%BaseSurf)%Name)//'"')
IF (.not. SubSurfaceSevereDisplayed) THEN
CALL ShowContinueError('...calculations for heat balance would be compromised.')
SubSurfaceSevereDisplayed=.true.
ENDIF
! SurfError=.true.
ENDIF
ENDIF
ENDDO
!**********************************************************************************
! Set up Zone Surface Pointers
DO ZoneNum=1,NumOfZones
DO SurfNum=1,MovedSurfs !TotSurfaces
IF (Surface(SurfNum)%Zone == ZoneNum) THEN
IF (Zone(ZoneNum)%SurfaceFirst == 0) THEN
Zone(ZoneNum)%SurfaceFirst=SurfNum
EXIT
ENDIF
ENDIF
END DO
END DO
! Surface First pointers are set, set last
IF (NumOfZones > 0) THEN
Zone(NumOfZones)%SurfaceLast=TotSurfaces
ENDIF
DO ZoneNum=1,NumOfZones-1
Zone(ZoneNum)%SurfaceLast=Zone(ZoneNum+1)%SurfaceFirst-1
END DO
DO ZoneNum=1,NumOfZones
IF (Zone(ZoneNum)%SurfaceFirst == 0) THEN
CALL ShowSevereError(RoutineName//'Zone has no surfaces, Zone='//TRIM(Zone(ZoneNum)%Name))
SurfError=.true.
ENDIF
ENDDO
! Set up Floor Areas for Zones
IF (.not. SurfError) THEN
DO ZoneNum=1,NumOfZones
DO SurfNum=Zone(ZoneNum)%SurfaceFirst,Zone(ZoneNum)%SurfaceLast
IF (Surface(SurfNum)%Class == SurfaceClass_Floor) THEN
Zone(ZoneNum)%FloorArea=Zone(ZoneNum)%FloorArea+Surface(SurfNum)%Area
Zone(ZoneNum)%HasFloor=.true.
ENDIF
IF (Surface(SurfNum)%Class == SurfaceClass_Roof) THEN
Zone(ZoneNum)%HasRoof=.true.
ENDIF
END DO
END DO
errCount=0
DO ZoneNum=1,NumOfZones
Zone(ZoneNum)%CalcFloorArea = Zone(ZoneNum)%FloorArea
IF (Zone(ZoneNum)%UserEnteredFloorArea /= AutoCalculate) THEN
! Check entered vs calculated
IF (Zone(ZoneNum)%UserEnteredFloorArea > 0.0d0) THEN ! User entered zone floor area,
! produce message if not near calculated
IF (Zone(ZoneNum)%CalcFloorArea > 0.0d0) THEN
diffp=ABS(Zone(ZoneNum)%CalcFloorArea-Zone(ZoneNum)%UserEnteredFloorArea)/Zone(ZoneNum)%UserEnteredFloorArea
IF (diffp > .05d0) THEN
ErrCount=ErrCount+1
IF (ErrCount == 1 .and. .not. DisplayExtraWarnings) THEN
CALL ShowWarningError(RoutineName//'Entered Zone Floor Areas differ from calculated Zone Floor Area(s).')
CALL ShowContinueError('...use Output:Diagnostics,DisplayExtraWarnings; to show more details on individual zones.')
ENDIF
IF (DisplayExtraWarnings) THEN
! Warn user of using specified Zone Floor Area
CALL ShowWarningError(RoutineName//'Entered Floor Area entered for Zone="'//TRIM(Zone(ZoneNum)%Name)// &
'" significantly different from calculated Floor Area')
CALL ShowContinueError('Entered Zone Floor Area value='// &
TRIM(RoundSigDigits(Zone(ZoneNum)%UserEnteredFloorArea,2))// &
', Calculated Zone Floor Area value='//TRIM(RoundSigDigits(Zone(ZoneNum)%CalcFloorArea,2))// &
', entered Floor Area will be used in calculations.')
ENDIF
ENDIF
ENDIF
Zone(ZoneNum)%FloorArea = Zone(ZoneNum)%UserEnteredFloorArea
Zone(ZoneNum)%HasFloor=.true.
ENDIF
ELSE
Zone(ZoneNum)%FloorArea = Zone(ZoneNum)%CalcFloorArea ! redundant, already done.
ENDIF
END DO
ENDIF
DO SurfNum=1,MovedSurfs !TotSurfaces
IF (Surface(SurfNum)%Area < 1.d-06) THEN
CALL ShowSevereError(RoutineName//'Zero or negative surface area['//trim(RoundSigDigits(Surface(SurfNum)%Area,5))// &
'], Surface='//Trim(Surface(SurfNum)%Name))
SurfError=.true.
ENDIF
IF (Surface(SurfNum)%Area >= 1.d-06 .and. Surface(SurfNum)%Area < .001d0) THEN
CALL ShowWarningError(RoutineName//'Very small surface area['//trim(RoundSigDigits(Surface(SurfNum)%Area,5))// &
'], Surface='//Trim(Surface(SurfNum)%Name))
ENDIF
END DO
DO SurfNum=1,MovedSurfs !TotSurfaces
! GLASSDOORs and TDD:DIFFUSERs will be treated as windows in the subsequent heat transfer and daylighting
! calculations. Reset class to 'Window' after saving the original designation in SurfaceWindow.
SurfaceWindow(SurfNum)%OriginalClass = Surface(SurfNum)%Class
IF (Surface(SurfNum)%Class == SurfaceClass_GlassDoor &
.OR. Surface(SurfNum)%Class == SurfaceClass_TDD_Diffuser) Surface(SurfNum)%Class = SurfaceClass_Window
IF (Surface(SurfNum)%Class.EQ.SurfaceClass_TDD_Dome) THEN
! Reset the TDD:DOME subsurface to act as a base surface that can shade and be shaded
! NOTE: This must be set early so that subsequent shading calculations are done correctly
Surface(SurfNum)%BaseSurf=SurfNum
END IF
END DO
errFlag=.false.
IF (.not. SurfError) THEN
DO SurfNum=1,MovedSurfs !TotSurfaces
! Set ShadedConstruction numbers for windows whose shaded constructions were created
! when shading device was specified in the WindowShadingControl for the window
IF(Surface(SurfNum)%ShadedConstruction /= 0) &
SurfaceWindow(SurfNum)%ShadedConstruction = Surface(SurfNum)%ShadedConstruction
! no need to set the below -- it is the default
! Set variable that indicates if shading device has movable slats
! SurfaceWindow(SurfNum)%MovableSlats = .FALSE.
! TH 2/9/2010. Fixed for CR 8010 for speed up purpose rather than fixing the problem
WinShadingControlPtr = Surface(SurfNum)%WindowShadingControlPtr
IF(WinShadingControlPtr /= 0) THEN
IF(WindowShadingControl(WinShadingControlPtr)%SlatAngleControlForBlinds /= WSC_SAC_FixedSlatAngle) &
SurfaceWindow(SurfNum)%MovableSlats = .TRUE.
! for a constant schedule of slat angle, it acts the same way as fixed angle
! TH 3/14/2011, CR 8347. Code was commented out due to the use of ExternalInterface (BCVTB)
!IF(WindowShadingControl(WinShadingControlPtr)%SlatAngleControlForBlinds == WSC_SAC_ScheduledSlatAngle) THEN
! get schedule index
! SchID = WindowShadingControl(WinShadingControlPtr)%SlatAngleSchedule
! IF (SchID /= 0 ) THEN
! SchSlatAngle = GetScheduleMinValue(SchID)
! IF (SchSlatAngle == GetScheduleMaxValue(SchID)) THEN
! SurfaceWindow(SurfNum)%MovableSlats = .FALSE.
! ENDIF
! ENDIF
!ENDIF
ENDIF
ConstrNumSh = SurfaceWindow(SurfNum)%ShadedConstruction
IF(ConstrNumSh <= 0) CYCLE
ShadingType = WindowShadingControl(WinShadingControlPtr)%ShadingType
! only for blinds
IF(ShadingType == WSC_ST_ExteriorBlind .OR. ShadingType == WSC_ST_InteriorBlind &
.OR. ShadingType == WSC_ST_BetweenGlassBlind ) THEN
! TH 1/7/2010. CR 7930
! The old code did not consider between-glass blind. Also there should not be two blinds - both interior and exterior
! Use the new generic code (assuming only one blind) as follows
DO iTmp1 = 1, Construct(ConstrNumSh)%TotLayers
iTmp2 = Construct(ConstrNumSh)%LayerPoint(iTmp1)
IF(Material(iTmp2)%Group == WindowBlind) THEN
BlNum = Material(iTmp2)%BlindDataPtr
SurfaceWindow(SurfNum)%BlindNumber = BlNum
! TH 2/18/2010. CR 8010
! if it is a blind with movable slats, create one new blind and set it to VariableSlat if not done so yet.
! the new blind is created only once, it can be shared by multiple windows though.
IF(SurfaceWindow(SurfNum)%MovableSlats .AND. Blind(BlNum)%SlatAngleType /= VariableSlats) THEN
errFlag=.false.
CALL AddVariableSlatBlind(BlNum,BlNumNew,errFlag)
! point to the new blind
Material(iTmp2)%BlindDataPtr = BlNumNew
! window surface points to new blind
SurfaceWindow(SurfNum)%BlindNumber = BlNumNew
ENDIF
EXIT
END IF
END DO
IF (errFlag) THEN
ErrorsFound=.true.
CALL ShowContinueError('WindowProperty:ShadingControl '// &
TRIM(WindowShadingControl(WinShadingControlPtr)%Name)// &
' has errors, program will terminate.')
ENDIF
! TH 5/17/2010. Fixed for CR 8121. Overwrite the blind slat angle with the constant scheduled value
! TH 3/14/2011. With fix for CR 8347, the following code is no longer needed.
!IF (SurfaceWindow(SurfNum)%BlindNumber >0 .AND. WinShadingControlPtr >0 ) THEN
! IF (.NOT. SurfaceWindow(SurfNum)%MovableSlats .AND. &
! WindowShadingControl(WinShadingControlPtr)%SlatAngleControlForBlinds == WSC_SAC_ScheduledSlatAngle) THEN
! Blind(SurfaceWindow(SurfNum)%BlindNumber)%SlatAngle = SchSlatAngle
! ENDIF
!ENDIF
ENDIF
END DO ! End of surface loop
! Warning if a WindowShadingControl is not referenced by any window; user may think
! window shading is occurring when it really isn't
DO ShadingCtrl = 1,TotWinShadingControl
WinShadingCtrlReferenced = .FALSE.
DO SurfNum = 1,TotSurfaces
IF(Surface(SurfNum)%WindowShadingControlPtr == ShadingCtrl) WinShadingCtrlReferenced = .TRUE.
END DO
IF(.NOT.WinShadingCtrlReferenced) THEN
CALL ShowWarningError(RoutineName//'WindowProperty:ShadingControl: "'//TRIM(WindowShadingControl(ShadingCtrl)%Name)// &
'" is not referenced by any window.')
END IF
END DO
ENDIF
! Check for zones with not enough surfaces
DO ZoneNum = 1,NumOfZones
OpaqueHTSurfs = 0
OpaqueHTSurfsWithWin = 0
InternalMassSurfs = 0
IF (Zone(ZoneNum)%SurfaceFirst == 0) CYCLE ! Zone with no surfaces
DO SurfNum = Zone(ZoneNum)%SurfaceFirst,Zone(ZoneNum)%SurfaceLast
IF(Surface(SurfNum)%Class == SurfaceClass_Floor .OR. Surface(SurfNum)%Class == SurfaceClass_Wall .OR. &
Surface(SurfNum)%Class == SurfaceClass_Roof) OpaqueHTSurfs = OpaqueHTSurfs + 1
IF(Surface(SurfNum)%Class == SurfaceClass_IntMass) InternalMassSurfs = InternalMassSurfs + 1
IF(Surface(SurfNum)%Class == SurfaceClass_Window) THEN
! Count base surface only once for multiple windows on a wall
IF(SurfNum > 1 .AND. Surface(SurfNum-1)%Class /= SurfaceClass_Window) &
OpaqueHTSurfsWithWin = OpaqueHTSurfsWithWin + 1
END IF
END DO
IF(OpaqueHTSurfsWithWin == 1 .AND. OpaqueHTSurfs == 1 .AND. InternalMassSurfs == 0) THEN
SurfError = .true.
CALL ShowSevereError(RoutineName//'Zone '//Trim(Zone(ZoneNum)%Name)// &
' has only one floor, wall or roof, and this surface has a window.')
CALL ShowContinueError('Add more floors, walls or roofs, or an internal mass surface.')
END IF
IF((OpaqueHTSurfs + InternalMassSurfs) < 6) THEN
CALL ShowWarningError(RoutineName//'The total number of floors, walls, roofs and internal mass surfaces in Zone '// &
Trim(Zone(ZoneNum)%Name))
CALL ShowContinueError('is < 6. This may cause an inaccurate zone heat balance calculation.')
END IF
END DO
! set up vertex of centroid for each surface.
CALL CalcSurfaceCentroid
CALL SetupShadeSurfacesForSolarCalcs ! if shading surfaces are solar collectors or PV, then we need full solar calc.
LayNumOutside=0
DO SurfNum=1,TotSurfaces
! Check for EcoRoof and only 1 allowed to be used.
IF (.not. Surface(SurfNum)%ExtEcoRoof) CYCLE
IF (LayNumOutSide == 0) THEN
LayNumOutSide=Construct(Surface(SurfNum)%Construction)%LayerPoint(1)
CYCLE
ENDIF
IF (LayNumOutSide /= Construct(Surface(SurfNum)%Construction)%LayerPoint(1)) THEN
CALL ShowSevereError(RoutineName//'Only one EcoRoof Material is currently allowed for all constructions.')
CALL ShowContinueError('... first material='//TRIM(Material(LayNumOutSide)%Name))
CALL ShowContinueError('... conflicting Construction='//TRIM(Construct(Surface(SurfNum)%Construction)%Name)// &
' uses material='//TRIM(Material(Construct(Surface(SurfNum)%Construction)%LayerPoint(1))%Name))
ErrorsFound=.true.
ENDIF
ENDDO
! Set flag that determines whether a surface can be an exterior obstruction
DO SurfNum = 1,TotSurfaces
Surface(SurfNum)%ShadowSurfPossibleObstruction = .FALSE.
! Exclude non-exterior heat transfer surfaces (but not OtherSideCondModeledExt = -4 CR7640)
IF(Surface(SurfNum)%HeatTransSurf .AND. Surface(SurfNum)%ExtBoundCond > 0 ) CYCLE
IF(Surface(SurfNum)%HeatTransSurf .AND. Surface(SurfNum)%ExtBoundCond == Ground) CYCLE
IF(Surface(SurfNum)%HeatTransSurf .AND. Surface(SurfNum)%ExtBoundCond == OtherSideCoefNoCalcExt) CYCLE
IF(Surface(SurfNum)%HeatTransSurf .AND. Surface(SurfNum)%ExtBoundCond == OtherSideCoefCalcExt) CYCLE
! Exclude windows and doors, i.e., consider only their base surfaces as possible obstructions
IF(Surface(SurfNum)%Class == SurfaceClass_Window .OR. Surface(SurfNum)%Class == SurfaceClass_Door) CYCLE
! Exclude duplicate shading surfaces
! TH 3/25/2010 CR 7872
! Shading surface names can start with Mir, a better way to use another flag
! to indicate whether a surface is a mirrored one.
!IF(Surface(SurfNum)%Name(1:3) == 'Mir') CYCLE
IF(Surface(SurfNum)%MirroredSurf) CYCLE
Surface(SurfNum)%ShadowSurfPossibleObstruction = .TRUE.
END DO
! Check for IRT surfaces in invalid places.
iTmp1=0
IF (ANY(Construct%TypeIsIRT)) THEN
DO SurfNum = 1,TotSurfaces
IF (.not. Surface(SurfNum)%HeatTransSurf) CYCLE ! ignore shading surfaces
IF (Surface(SurfNum)%ExtBoundCond > 0 .and. Surface(SurfNum)%ExtBoundCond /= SurfNum) CYCLE ! interzone, not adiabatic surface
IF (.not. Construct(Surface(SurfNum)%Construction)%TypeIsIRT) CYCLE
IF (.not. DisplayExtraWarnings) THEN
iTmp1=iTmp1+1
ELSE
CALL ShowWarningError(RoutineName//'Surface="'//trim(Surface(SurfNum)%Name)//'" uses InfraredTransparent'// &
' construction in a non-interzone surface. (illegal use)')
ENDIF
ENDDO
IF (iTmp1 > 0) THEN
CALL ShowWarningError(RoutineName//'Surfaces use InfraredTransparent constructions '//trim(TrimSigDigits(iTmp1))// &
' in non-interzone surfaces. (illegal use)')
CALL ShowContinueError('For explicit details on each use, use Output:Diagnostics,DisplayExtraWarnings;')
ENDIF
ENDIF
! Note, could do same for Window Area and detecting if Interzone Surface in Zone
IF (Warning1Count > 0) THEN
CALL ShowWarningMessage(RoutineName//'Window dimensions differ from Window 5/6 data file dimensions, '// &
trim(TrimSigDigits(Warning1Count))//' times.')
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.')
CALL ShowContinueError('For explicit details on each window, use Output:Diagnostics,DisplayExtraWarnings;')
ENDIF
IF (Warning2Count > 0) THEN
CALL ShowWarningMessage(RoutineName//'Exterior Windows have been replaced with Window 5/6 two glazing systems, '// &
trim(TrimSigDigits(Warning2Count))//' times.')
CALL ShowContinueError('Note that originally entered dimensions are overridden.')
CALL ShowContinueError('For explicit details on each window, use Output:Diagnostics,DisplayExtraWarnings;')
ENDIF
IF (Warning3Count > 0) THEN
CALL ShowWarningMessage(RoutineName//'Interior Windows have been replaced with Window 5/6 two glazing systems, '// &
trim(TrimSigDigits(Warning3Count))//' times.')
CALL ShowContinueError('Note that originally entered dimensions are overridden.')
CALL ShowContinueError('For explicit details on each window, use Output:Diagnostics,DisplayExtraWarnings;')
ENDIF
IF (TotalMultipliedWindows > 0) THEN
CALL ShowWarningMessage(RoutineName//'There are '//trim(TrimSigDigits(TotalMultipliedWindows))//' window/glass door(s) '// &
'that may cause inaccurate shadowing due to Solar Distribution.')
CALL ShowContinueError('For explicit details on each window, use Output:Diagnostics,DisplayExtraWarnings;')
TotalWarningErrors=TotalWarningErrors+TotalMultipliedWindows
ENDIF
IF (TotalCoincidentVertices > 0) THEN
CALL ShowWarningMessage(RoutineName//'There are '//trim(TrimSigDigits(TotalCoincidentVertices))// &
' coincident/collinear vertices; These have been deleted unless the deletion would bring the number of surface sides < 3.')
CALL ShowContinueError('For explicit details on each problem surface, use Output:Diagnostics,DisplayExtraWarnings;')
TotalWarningErrors=TotalWarningErrors+TotalCoincidentVertices
ENDIF
IF (TotalDegenerateSurfaces > 0) THEN
CALL ShowSevereMessage(RoutineName//'There are '//trim(TrimSigDigits(TotalDegenerateSurfaces))// &
' degenerate surfaces; Degenerate surfaces are those with number of sides < 3.')
CALL ShowContinueError('These surfaces should be deleted.')
CALL ShowContinueError('For explicit details on each problem surface, use Output:Diagnostics,DisplayExtraWarnings;')
TotalSevereErrors=TotalSevereErrors+TotalDegenerateSurfaces
ENDIF
CALL GetHTSurfExtVentedCavityData(ErrorsFound)
CALL GetSurfaceHeatTransferAlgorithmOverrides(ErrorsFound)
IF (SurfError .or. ErrorsFound) THEN
ErrorsFound=.true.
CALL ShowFatalError(RoutineName//'Errors discovered, program terminates.')
ENDIF
RETURN
END SUBROUTINE GetSurfaceData