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 | |||
logical, | intent(in), | DIMENSION(:) | :: | CeilingHeightEntered |
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 CalculateZoneVolume(ErrorsFound,CeilingHeightEntered)
! SUBROUTINE INFORMATION:
! AUTHOR Legacy Code
! DATE WRITTEN 1992-1994
! MODIFIED Sep 2007
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine calculates the volume (m3) of a zone using the
! surfaces as possible.
! METHODOLOGY EMPLOYED:
! Uses surface area information for calculations. Modified to use the
! user-entered ceiling height (x floor area, if applicable) instead of using
! the calculated volume when the user enters the ceiling height.
! REFERENCES:
! Legacy Code (IBLAST)
! USE STATEMENTS:
USE InputProcessor, ONLY: FindItemInList,GetNumSectionsFound
USE Vectors
USE General, ONLY: RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(INOUT) :: ErrorsFound ! If errors found in input
LOGICAL, DIMENSION(:), INTENT(IN) :: CeilingHeightEntered
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: VolFmt="(F20.2)"
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) MinimumVolume ! The minimum allowable Zone volume (equivalent to a ceiling height of 2.5 meters)
REAL(r64) SumAreas ! Sum of the Zone surface areas that are not "internal mass"
REAL(r64) SurfCount ! Surface Count
INTEGER SurfNum ! Loop counter for surfaces
INTEGER ZoneNum ! Loop counter for Zones
LOGICAL ErrorFlag
REAL(r64) TempVolume ! Temporary for calculating volume
type(polyhedron) :: ZoneStruct
integer, allocatable, dimension(:) :: surfacenotused
integer :: notused
INTEGER NFaces
INTEGER NActFaces
REAL(r64) CalcVolume
LOGICAL initmsg
integer iside
LOGICAL :: ShowZoneSurfaces=.false.
LOGICAL :: ShowZoneSurfaceHeaders=.true.
INTEGER, SAVE :: ErrCount=0
initmsg=.true.
ShowZoneSurfaces=(GetNumSectionsFound('SHOWZONESURFACES_DEBUG') > 0)
DO ZoneNum = 1, NumOfZones
IF (.not. Zone(ZoneNum)%HasFloor) THEN
CALL ShowWarningError('No floor exists in Zone="'//TRIM(Zone(ZoneNum)%Name)// &
'", zone floor area is zero. All values for this zone that are entered per floor area will be zero.')
ENDIF
SumAreas=0.0d0
SurfCount=0.0d0
NFaces=Zone(ZoneNum)%SurfaceLast-Zone(ZoneNum)%SurfaceFirst+1
notused=0
ZoneStruct%NumSurfaceFaces=NFaces
ALLOCATE(ZoneStruct%SurfaceFace(NFaces))
NActFaces=0
ALLOCATE(surfacenotused(NFaces))
surfacenotused=0
DO SurfNum=Zone(ZoneNum)%SurfaceFirst,Zone(ZoneNum)%SurfaceLast
! Only include Base Surfaces in Calc.
IF (Surface(SurfNum)%Class /= SurfaceClass_Wall .and. Surface(SurfNum)%Class /= SurfaceClass_Floor .and. &
Surface(SurfNum)%Class /= SurfaceClass_Roof) THEN
notused=notused+1
surfacenotused(notused)=SurfNum
CYCLE
ENDIF
NActFaces=NActFaces+1
ALLOCATE(ZoneStruct%SurfaceFace(NActFaces)%FacePoints(Surface(SurfNum)%Sides))
ZoneStruct%SurfaceFace(NActFaces)%NSides=Surface(SurfNum)%Sides
ZoneStruct%SurfaceFace(NActFaces)%SurfNum=SurfNum
ZoneStruct%SurfaceFace(NActFaces)%FacePoints(1:Surface(SurfNum)%Sides)=Surface(SurfNum)%Vertex(1:Surface(SurfNum)%Sides)
CALL CreateNewellAreaVector(ZoneStruct%SurfaceFace(NActFaces)%FacePoints,ZoneStruct%SurfaceFace(NActFaces)%NSides, &
ZoneStruct%SurfaceFace(NActFaces)%NewellAreaVector)
SumAreas=SumAreas+VecLength(ZoneStruct%SurfaceFace(NActFaces)%NewellAreaVector)
ENDDO
ZoneStruct%NumSurfaceFaces=NActFaces
SurfCount=REAL(NActFaces,r64)
CALL CalcPolyhedronVolume(ZoneStruct,CalcVolume)
IF(Zone(ZoneNum)%FloorArea > 0.0d0) THEN
MinimumVolume=Zone(ZoneNum)%FloorArea * 2.5d0
IF (Zone(ZoneNum)%CeilingHeight > 0.0d0) THEN
MinimumVolume=Zone(ZoneNum)%FloorArea*Zone(ZoneNum)%CeilingHeight
ENDIF
ELSE
IF (SurfCount > 0) THEN
MinimumVolume=SQRT(SumAreas/SurfCount)**3
ELSE
MinimumVolume=0.0d0
ENDIF
ENDIF
IF (CalcVolume > 0.0d0) THEN
TempVolume=CalcVolume
ELSE
TempVolume=MinimumVolume
ENDIF
IF (Zone(ZoneNum)%Volume > 0.0d0) THEN ! User entered zone volume, produce message if not near calculated
IF (TempVolume > 0.0d0) THEN
IF (ABS(TempVolume-Zone(ZoneNum)%Volume)/Zone(ZoneNum)%Volume > .05d0) THEN
ErrCount=ErrCount+1
IF (ErrCount == 1 .and. .not. DisplayExtraWarnings) THEN
IF (initmsg) THEN
CALL ShowMessage('Note that the following warning(s) may/will occur if you have not enclosed your zone completely.')
initmsg=.false.
ENDIF
CALL ShowWarningError('Entered Zone Volumes differ from calculated zone volume(s).')
CALL ShowContinueError('...use Output:Diagnostics,DisplayExtraWarnings; to show more details on individual zones.')
ENDIF
IF (DisplayExtraWarnings) THEN
IF (initmsg) THEN
CALL ShowMessage('Note that the following warning(s) may/will occur if you have not enclosed your zone completely.')
initmsg=.false.
ENDIF
! Warn user of using specified Zone Volume
CALL ShowWarningError('Entered Volume entered for Zone="'//TRIM(Zone(ZoneNum)%Name)// &
'" significantly different from calculated Volume')
CALL ShowContinueError('Entered Zone Volume value='//TRIM(RoundSigDigits(Zone(ZoneNum)%Volume,2))// &
', Calculated Zone Volume value='//TRIM(RoundSigDigits(TempVolume,2))// &
', entered volume will be used in calculations.')
ENDIF
ENDIF
ENDIF
ELSEIF (CeilingHeightEntered(ZoneNum)) THEN ! User did not enter zone volume, but entered ceiling height
IF (Zone(ZoneNum)%FloorArea > 0.0d0) THEN
Zone(ZoneNum)%Volume=Zone(ZoneNum)%FloorArea*Zone(ZoneNum)%CeilingHeight
ELSE ! ceiling height entered but floor area zero
Zone(ZoneNum)%Volume=TempVolume
ENDIF
ELSE ! Neither ceiling height nor volume entered
Zone(ZoneNum)%Volume=TempVolume
ENDIF
IF (Zone(ZoneNum)%Volume <= 0.0d0) THEN
CALL ShowSevereError('Indicated Zone Volume <= 0.0 for Zone='//TRIM(Zone(ZoneNum)%Name))
CALL ShowContinueError('Zone Volume calculated was='//TRIM(RoundSigDigits(Zone(ZoneNum)%Volume,2)))
ENDIF
IF (ShowZoneSurfaces) THEN
IF (ShowZoneSurfaceHeaders) THEN
write(outputfiledebug,*) '==================================='
write(outputfiledebug,*) 'showing zone surfaces used and not used in volume calculation'
write(outputfiledebug,*) 'for volume calculation, only floors, walls and roofs/ceilings are used'
write(outputfiledebug,*) 'surface class, 1=wall, 2=floor, 3=roof/ceiling'
write(outputfiledebug,*) 'unused surface class(es), 5=internal mass, 11=window, 12=glass door'
write(outputfiledebug,*) ' 13=door, 14=shading, 15=overhang, 16=fin'
write(outputfiledebug,*) ' 17=TDD Dome, 18=TDD Diffuser'
ShowZoneSurfaceHeaders=.false.
ENDIF
write(outputfiledebug,*) '==================================='
write(outputfiledebug,*) 'zone=',trim(zone(zonenum)%name),' calc volume=',calcvolume
write(outputfiledebug,*) ' nsurfaces=',nfaces,' nactual=',nactfaces
ENDIF
do SurfNum=1,ZoneStruct%NumSurfaceFaces
IF (ShowZoneSurfaces) THEN
if (surfnum <= nactfaces) then
write(outputfiledebug,*) 'surface=',zonestruct%surfaceface(surfnum)%surfnum, &
' nsides=',zonestruct%surfaceface(surfnum)%Nsides
write(outputfiledebug,*) 'surface name=',trim(surface(zonestruct%surfaceface(surfnum)%surfnum)%name), &
' class=',surface(zonestruct%surfaceface(surfnum)%surfnum)%class
write(outputfiledebug,*) 'area=',surface(zonestruct%surfaceface(surfnum)%surfnum)%grossarea
do iside=1, zonestruct%surfaceface(surfnum)%Nsides
write(outputfiledebug,*) zonestruct%surfaceface(surfnum)%facepoints(iside)
enddo
endif
ENDIF
deallocate(ZoneStruct%SurfaceFace(SurfNum)%FacePoints)
enddo
IF (ShowZoneSurfaces) THEN
do surfnum=1,notused
write(outputfiledebug,*) 'notused:surface=',surfacenotused(surfnum),' name=', &
trim(surface(surfacenotused(surfnum))%name), &
' class=',surface(surfacenotused(surfnum))%class
enddo
ENDIF
deallocate(ZoneStruct%SurfaceFace)
deallocate(surfacenotused)
END DO
ErrorFlag=.false.
DO ZoneNum=1,NumOfZones
IF (Zone(ZoneNum)%Volume <= 0.0d0) ErrorFlag=.true.
END DO
IF (ErrorFlag) THEN
CALL ShowSevereError('All ZONE Volumes must be > 0.0')
ErrorsFound=.true.
ENDIF
RETURN
END SUBROUTINE CalculateZoneVolume