SUBROUTINE WriteVeriSumTable
! SUBROUTINE INFORMATION:
! AUTHOR Jason Glazer
! DATE WRITTEN June 2006
! MODIFIED January 2010, Kyle Benne
! Added SQLite output
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Summarize inputs and results for use with code and beyond-code
! compliance into a tabular report for output.
! METHODOLOGY EMPLOYED:
! Create arrays for the call to writeTable and then call it.
! This report actually consists of many sub-tables each with
! its own call to writeTable.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataStringGlobals, ONLY: VerString
USE DataEnvironment, ONLY: EnvironmentName,Latitude,Longitude,Elevation,TimeZoneNumber, &
RunPeriodStartDayOfWeek,WeatherFileLocationTitle
USE DataHeatBalance, ONLY: Zone, BuildingAzimuth, Construct, TotLights, Lights, ZoneIntGain, &
People, TotPeople, ZoneElectric, TotElecEquip, ZoneGas, TotGasEquip, &
ZoneOtherEq, TotOthEquip, ZoneHWEq, TotHWEquip, BuildingRotationAppendixG
USE DataSurfaces, ONLY: Surface, TotSurfaces,SurfaceClass_Wall,SurfaceClass_Floor,SurfaceClass_Roof, &
SurfaceClass_Window,SurfaceClass_TDD_Dome,FrameDivider,ExternalEnvironment,Ground, &
OtherSideCondModeledExt,GroundFCfactorMethod
USE ScheduleManager, ONLY: ScheduleAverageHoursPerWeek, GetScheduleName
USE ExteriorEnergyUse, ONLY: ExteriorLights, NumExteriorLights, ScheduleOnly, AstroClockOverride
USE General, ONLY: SafeDivide,RoundSigDigits
USE SQLiteProcedures, ONLY: CreateSQLiteTabularDataRecords
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
INTEGER, parameter :: wwrcTotal = 1
INTEGER, parameter :: wwrcNorth = 2
INTEGER, parameter :: wwrcEast = 3
INTEGER, parameter :: wwrcSouth = 4
INTEGER, parameter :: wwrcWest = 5
INTEGER, parameter :: wwrrWall = 1
INTEGER, parameter :: wwrrAbvGndWall = 2
INTEGER, parameter :: wwrrWindow = 3
INTEGER, parameter :: wwrrWWR = 4
INTEGER, parameter :: wwrrAbvGndWWR = 5
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
! all arrays are in the format: (row, column)
CHARACTER(len=MaxNameLength),ALLOCATABLE, DIMENSION(:) :: columnHead
INTEGER,ALLOCATABLE,DIMENSION(:) :: columnWidth
CHARACTER(len=MaxNameLength),ALLOCATABLE, DIMENSION(:) :: rowHead
CHARACTER(len=MaxNameLength),ALLOCATABLE, DIMENSION(:,:) :: tableBody
INTEGER :: iSurf
INTEGER :: kOpaque
INTEGER :: zonePt
INTEGER :: iLight
INTEGER :: iZone
INTEGER :: iPeople
INTEGER :: iPlugProc
REAL(r64) :: mult
REAL(r64) :: curAzimuth
REAL(r64) :: curArea
REAL(r64) :: wallAreaN
REAL(r64) :: wallAreaS
REAL(r64) :: wallAreaE
REAL(r64) :: wallAreaW
REAL(r64) :: aboveGroundWallAreaN
REAL(r64) :: aboveGroundWallAreaS
REAL(r64) :: aboveGroundWallAreaE
REAL(r64) :: aboveGroundWallAreaW
REAL(r64) :: windowAreaN
REAL(r64) :: windowAreaS
REAL(r64) :: windowAreaE
REAL(r64) :: windowAreaW
!wall and window areas attached to conditioned zones
REAL(r64) :: wallAreaNcond
REAL(r64) :: wallAreaScond
REAL(r64) :: wallAreaEcond
REAL(r64) :: wallAreaWcond
REAL(r64) :: aboveGroundWallAreaNcond
REAL(r64) :: aboveGroundWallAreaScond
REAL(r64) :: aboveGroundWallAreaEcond
REAL(r64) :: aboveGroundWallAreaWcond
REAL(r64) :: windowAreaNcond
REAL(r64) :: windowAreaScond
REAL(r64) :: windowAreaEcond
REAL(r64) :: windowAreaWcond
LOGICAL :: isConditioned
LOGICAL :: isAboveGround
REAL(r64) :: roofArea
REAL(r64) :: skylightArea
REAL(r64) :: totLightPower
REAL(r64) :: totNumPeople
REAL(r64) :: totPlugProcess
REAL(r64) :: frameWidth
REAL(r64) :: frameArea
LOGICAL :: zoneIsCond
LOGICAL :: usezoneFloorArea
INTEGER :: grandTotal = 1
INTEGER :: condTotal = 2
INTEGER :: uncondTotal = 3
INTEGER :: notpartTotal = 4
INTEGER :: iTotal
CHARACTER(len=MaxNameLength) :: SIunit = ''
INTEGER :: unitConvIndex = 0
REAL(r64) :: m_unitConv = 0.0d0
REAL(r64) :: m2_unitConv = 0.0d0
REAL(r64) :: m3_unitConv = 0.0d0
REAL(r64) :: Wm2_unitConv = 0.0d0
CHARACTER(len=MaxNameLength) :: m_unitName = ''
CHARACTER(len=MaxNameLength) :: m2_unitName = ''
CHARACTER(len=MaxNameLength) :: m3_unitName = ''
CHARACTER(len=MaxNameLength) :: Wm2_unitName = ''
!zone summary total
REAL(r64), DIMENSION(4) :: zstArea = 0.0d0
REAL(r64), DIMENSION(4) :: zstVolume = 0.0d0
REAL(r64), DIMENSION(4) :: zstWallArea = 0.0d0
REAL(r64), DIMENSION(4) :: zstWindowArea = 0.0d0
REAL(r64), DIMENSION(4) :: zstLight = 0.0d0
REAL(r64), DIMENSION(4) :: zstPeople = 0.0d0
REAL(r64), DIMENSION(4) :: zstPlug = 0.0d0
! misc
REAL(r64) :: pdiff
LOGICAL :: DetailedWWR
REAL(r64) :: TotalWallArea
REAL(r64) :: TotalWindowArea
REAL(r64) :: TotalAboveGroundWallArea
! all arrays are in the format: (row, columnm)
IF (displayTabularVeriSum) THEN
! show the headers of the report
CALL WriteReportHeaders('Input Verification and Results Summary','Entire Facility',isAverage)
! do unit conversions if necessary
IF (unitsStyle .EQ. unitsStyleInchPound) THEN
SIunit = '[m]'
CALL LookupSItoIP(SIunit, unitConvIndex, m_unitName)
m_unitConv = convertIP(unitConvIndex,1.0d0)
SIunit = '[m2]'
CALL LookupSItoIP(SIunit, unitConvIndex, m2_unitName)
m2_unitConv = convertIP(unitConvIndex,1.0d0)
SIunit = '[m3]'
CALL LookupSItoIP(SIunit, unitConvIndex, m3_unitName)
m3_unitConv = convertIP(unitConvIndex,1.0d0)
SIunit = '[W/m2]'
CALL LookupSItoIP(SIunit, unitConvIndex, Wm2_unitName)
Wm2_unitConv = convertIP(unitConvIndex,1.0d0)
ELSE
m_unitName = '[m]'
m_unitConv = 1.0d0
m2_unitName = '[m2]'
m2_unitConv = 1.0d0
m3_unitName = '[m3]'
m3_unitConv = 1.0d0
Wm2_unitName = '[W/m2]'
Wm2_unitConv = 1.0d0
END IF
!
!---- General Sub-Table
!
! since a variable number of design days is possible, first read them before sizing the arrays
ALLOCATE(rowHead(10))
ALLOCATE(columnHead(1))
ALLOCATE(columnWidth(1))
columnWidth = 14 !array assignment - same for all columns
ALLOCATE(tableBody(10,1))
columnHead(1) = 'Value'
rowHead(1) = 'Program Version and Build'
rowHead(2) = 'RunPeriod'
rowHead(3) = 'Weather File'
rowHead(4) = 'Latitude [deg]'
rowHead(5) = 'Longitude [deg]'
rowHead(6) = 'Elevation ' // TRIM(m_unitName)
rowHead(7) = 'Time Zone'
rowHead(8) = 'North Axis Angle [deg]'
rowHead(9) = 'Rotation for Appendix G [deg]'
rowHead(10) = 'Hours Simulated [hrs]'
! rowHead(9) = 'Num Table Entries' !used for debugging
tableBody = ''
tableBody(1,1) = TRIM(VerString) !program
tableBody(2,1) = TRIM(EnvironmentName) !runperiod name
tableBody(3,1) = TRIM(WeatherFileLocationTitle) !weather
tableBody(4,1) = TRIM(RealToStr(Latitude,2)) !latitude
tableBody(5,1) = TRIM(RealToStr(Longitude,2)) !longitude
tableBody(6,1) = TRIM(RealToStr(Elevation * m_unitConv,2)) !Elevation
tableBody(7,1) = TRIM(RealToStr(TimeZoneNumber,2)) !Time Zone
tableBody(8,1) = TRIM(RealToStr(BuildingAzimuth,2)) !north axis angle
tableBody(9,1) = TRIM(RealToStr(BuildingRotationAppendixG,2)) !Rotation for Appendix G
tableBody(10,1) = TRIM(RealToStr(gatherElapsedTimeBEPS,2)) !hours simulated
! tableBody(9,1) = TRIM(IntToStr(numTableEntry)) !number of table entries for predefined tables
CALL writeSubtitle('General')
CALL writeTable(tableBody,rowHead,columnHead,columnWidth)
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
'InputVerificationandResultsSummary',&
'Entire Facility',&
'General')
DEALLOCATE(columnHead)
DEALLOCATE(rowHead)
DEALLOCATE(columnWidth)
DEALLOCATE(tableBody)
!
!---- Window Wall Ratio Sub-Table
!
CALL writeTextLine('ENVELOPE',.TRUE.)
ALLOCATE(rowHead(5))
ALLOCATE(columnHead(5))
ALLOCATE(columnWidth(5))
columnWidth = 14 !array assignment - same for all columns
ALLOCATE(tableBody(5,5))
columnHead(wwrcTotal) = 'Total'
columnHead(wwrcNorth) = 'North (315 to 45 deg)'
columnHead(wwrcEast) = 'East (45 to 135 deg)'
columnHead(wwrcSouth) = 'South (135 to 225 deg)'
columnHead(wwrcWest) = 'West (225 to 315 deg)'
rowHead(wwrrWall) = 'Gross Wall Area ' // TRIM(m2_unitName)
rowHead(wwrrAbvGndWall) = 'Above Ground Wall Area ' // TRIM(m2_unitName)
rowHead(wwrrWindow) = 'Window Opening Area ' // TRIM(m2_unitName)
rowHead(wwrrWWR) = 'Gross Window-Wall Ratio [%]'
rowHead(wwrrAbvGndWWR) = 'Above Ground Window-Wall Ratio [%]'
wallAreaN = 0.0d0
wallAreaS = 0.0d0
wallAreaE = 0.0d0
wallAreaW = 0.0d0
aboveGroundWallAreaN = 0.0d0
aboveGroundWallAreaS = 0.0d0
aboveGroundWallAreaE = 0.0d0
aboveGroundWallAreaW = 0.0d0
windowAreaN = 0.0d0
windowAreaS = 0.0d0
windowAreaE = 0.0d0
windowAreaW = 0.0d0
wallAreaNcond = 0.0d0
wallAreaScond = 0.0d0
wallAreaEcond = 0.0d0
wallAreaWcond = 0.0d0
aboveGroundWallAreaNcond = 0.0d0
aboveGroundWallAreaScond = 0.0d0
aboveGroundWallAreaEcond = 0.0d0
aboveGroundWallAreaWcond = 0.0d0
windowAreaNcond = 0.0d0
windowAreaScond = 0.0d0
windowAreaEcond = 0.0d0
windowAreaWcond = 0.0d0
roofArea = 0.0d0
skylightArea = 0.0d0
totLightPower = 0.0d0
totNumPeople = 0.0d0
totPlugProcess = 0.0d0
kOpaque = 0
DetailedWWR=(GetNumSectionsFound('DETAILEDWWR_DEBUG') > 0)
IF (DetailedWWR) THEN
WRITE(OutputFileDebug,'(A)') '======90.1 Classification [>=60 & <=120] tilt = wall=================='
WRITE(OutputFileDebug,'(A)') 'SurfName,Class,Area,Tilt'
ENDIF
DO iSurf = 1, TotSurfaces
!only exterior surfaces including underground
IF (.not. Surface(iSurf)%HeatTransSurf) CYCLE
isAboveGround = (Surface(iSurf)%ExtBoundCond == ExternalEnvironment) .or. &
(Surface(iSurf)%ExtBoundCond == OtherSideCondModeledExt)
IF (isAboveGround .or. (Surface(iSurf)%ExtBoundCond == Ground) .or. &
(Surface(iSurf)%ExtBoundCond == GroundFCfactorMethod)) THEN
curAzimuth = Surface(iSurf)%Azimuth
curArea = Surface(iSurf)%GrossArea
IF (Surface(iSurf)%FrameDivider .NE. 0) THEN
frameWidth = FrameDivider(Surface(iSurf)%FrameDivider)%FrameWidth
frameArea = (Surface(iSurf)%Height + 2.0d0*frameWidth)*(Surface(iSurf)%Width + 2.0d0*frameWidth) &
- (Surface(iSurf)%Height * Surface(iSurf)%Width)
curArea = curArea + frameArea
END IF
zonePt = Surface(iSurf)%Zone
isConditioned = .FALSE.
IF (zonePt .GT. 0) THEN
IF (Zone(zonePt)%SystemZoneNodeNumber .GT. 0) THEN
isConditioned = .TRUE.
ENDIF
END IF
IF ((Surface(iSurf)%Tilt >= 60.d0) .AND. (Surface(iSurf)%Tilt <= 120.d0)) THEN
!vertical walls and windows
SELECT CASE (Surface(iSurf)%Class)
CASE (SurfaceClass_Wall,SurfaceClass_Floor,SurfaceClass_Roof)
mult = Zone(zonePt)%Multiplier * Zone(zonePt)%ListMultiplier
IF ((curAzimuth .GE. 315.d0) .OR. (curAzimuth .LT. 45.d0)) THEN
wallAreaN = wallAreaN + curArea * mult
IF (isConditioned) wallAreaNcond = wallAreaNcond + curArea * mult
IF (isAboveGround) THEN
aboveGroundWallAreaN = aboveGroundWallAreaN + curArea * mult
IF (isConditioned) aboveGroundWallAreaNcond = aboveGroundWallAreaNcond + curArea * mult
ENDIF
ELSE IF ((curAzimuth .GE. 45.d0) .AND. (curAzimuth .LT. 135.d0)) THEN
wallAreaE = wallAreaE + curArea * mult
IF (isConditioned) wallAreaEcond = wallAreaEcond + curArea * mult
IF (isAboveGround) THEN
aboveGroundWallAreaE = aboveGroundWallAreaE + curArea * mult
IF (isConditioned) aboveGroundWallAreaEcond = aboveGroundWallAreaEcond + curArea * mult
ENDIF
ELSE IF ((curAzimuth .GE. 135.d0) .AND. (curAzimuth .LT. 225.d0)) THEN
wallAreaS = wallAreaS + curArea * mult
IF (isConditioned) wallAreaScond = wallAreaScond + curArea * mult
IF (isAboveGround) THEN
aboveGroundWallAreaS = aboveGroundWallAreaS + curArea * mult
IF (isConditioned) aboveGroundWallAreaScond = aboveGroundWallAreaScond + curArea * mult
ENDIF
ELSE IF ((curAzimuth .GE. 225.d0) .AND. (curAzimuth .LT. 315.d0)) THEN
wallAreaW = wallAreaW + curArea * mult
IF (isConditioned) wallAreaWcond = wallAreaWcond + curArea * mult
IF (isAboveGround) THEN
aboveGroundWallAreaW = aboveGroundWallAreaW + curArea * mult
IF (isConditioned) aboveGroundWallAreaWcond = aboveGroundWallAreaWcond + curArea * mult
ENDIF
ENDIF
IF (DetailedWWR) THEN
WRITE(OutputFileDebug,'(A)') trim(Surface(iSurf)%Name)//',Wall,'//trim(RoundSigDigits(curArea*mult,1))// &
','//trim(RoundSigDigits(Surface(iSurf)%Tilt,1))
ENDIF
CASE (SurfaceClass_Window,SurfaceClass_TDD_Dome)
mult = Zone(zonePt)%Multiplier * Zone(zonePt)%ListMultiplier * Surface(iSurf)%Multiplier
IF ((curAzimuth .GE. 315.d0) .OR. (curAzimuth .LT. 45.d0)) THEN
windowAreaN = windowAreaN + curArea * mult
IF (isConditioned) windowAreaNcond = windowAreaNcond + curArea * mult
ELSE IF ((curAzimuth .GE. 45.d0) .AND. (curAzimuth .LT. 135.d0)) THEN
windowAreaE = windowAreaE + curArea * mult
IF (isConditioned) windowAreaEcond = windowAreaEcond + curArea * mult
ELSE IF ((curAzimuth .GE. 135.d0) .AND. (curAzimuth .LT. 225.d0)) THEN
windowAreaS = windowAreaS + curArea * mult
IF (isConditioned) windowAreaScond = windowAreaScond + curArea * mult
ELSE IF ((curAzimuth .GE. 225.d0) .AND. (curAzimuth .LT. 315.d0)) THEN
windowAreaW = windowAreaW + curArea * mult
IF (isConditioned) windowAreaWcond = windowAreaWcond + curArea * mult
ENDIF
IF (DetailedWWR) THEN
WRITE(OutputFileDebug,'(A)') trim(Surface(iSurf)%Name)//',Window,'//trim(RoundSigDigits(curArea*mult,1))// &
','//trim(RoundSigDigits(Surface(iSurf)%Tilt,1))
ENDIF
END SELECT
ELSE IF (Surface(iSurf)%Tilt < 60.d0) THEN !roof and skylights
SELECT CASE (Surface(iSurf)%Class)
CASE (SurfaceClass_Wall,SurfaceClass_Floor,SurfaceClass_Roof)
mult = Zone(zonePt)%Multiplier * Zone(zonePt)%ListMultiplier
roofArea = roofArea + curArea * mult
IF (DetailedWWR) THEN
WRITE(OutputFileDebug,'(A)') trim(Surface(iSurf)%Name)//',Roof,'//trim(RoundSigDigits(curArea*mult,1))// &
','//trim(RoundSigDigits(Surface(iSurf)%Tilt,1))
ENDIF
CASE (SurfaceClass_Window,SurfaceClass_TDD_Dome)
mult = Zone(zonePt)%Multiplier * Zone(zonePt)%ListMultiplier * Surface(iSurf)%Multiplier
skylightArea = skylightArea + curArea * mult
IF (DetailedWWR) THEN
WRITE(OutputFileDebug,'(A)') trim(Surface(iSurf)%Name)//',Skylight,'//trim(RoundSigDigits(curArea*mult,1))// &
','//trim(RoundSigDigits(Surface(iSurf)%Tilt,1))
ENDIF
END SELECT
ELSE !floors
!ignored
END IF
END IF
END DO
TotalWallArea=wallAreaN + wallAreaS + wallAreaE + wallAreaW
TotalAboveGroundWallArea=aboveGroundWallAreaN+aboveGroundWallAreaS+aboveGroundWallAreaE+aboveGroundWallAreaW
TotalWindowArea=windowAreaN + windowAreaS + windowAreaE + windowAreaW
IF (DetailedWWR) THEN
WRITE(OutputFileDebug,'(A)') '========================'
WRITE(OutputFileDebug,'(A)') 'TotalWallArea,WallAreaN,WallAreaS,WallAreaE,WallAreaW'
WRITE(OutputFileDebug,'(A)') 'TotalWindowArea,WindowAreaN,WindowAreaS,WindowAreaE,WindowAreaW'
WRITE(OutputFileDebug,'(A)') trim(RoundSigDigits(TotalWallArea,2))//','// &
trim(RoundSigDigits(WallAreaN,2))//','//trim(RoundSigDigits(WallAreaS,2))//','// &
trim(RoundSigDigits(WallAreaE,2))//','//trim(RoundSigDigits(WallAreaW,2))
WRITE(OutputFileDebug,'(A)') trim(RoundSigDigits(TotalWindowArea,2))//','// &
trim(RoundSigDigits(WindowAreaN,2))//','//trim(RoundSigDigits(WindowAreaS,2))//','// &
trim(RoundSigDigits(WindowAreaE,2))//','//trim(RoundSigDigits(WindowAreaW,2))
ENDIF
tableBody = ''
tableBody(wwrrWall,wwrcNorth) = TRIM(RealToStr(wallAreaN * m2_unitConv,2))
tableBody(wwrrWall,wwrcSouth) = TRIM(RealToStr(wallAreaS * m2_unitConv,2))
tableBody(wwrrWall,wwrcEast) = TRIM(RealToStr(wallAreaE * m2_unitConv,2))
tableBody(wwrrWall,wwrcWest) = TRIM(RealToStr(wallAreaW * m2_unitConv,2))
tableBody(wwrrWall,wwrcTotal) = TRIM(RealToStr(TotalWallArea * m2_unitConv,2))
tableBody(wwrrAbvGndWall,wwrcNorth) = TRIM(RealToStr(aboveGroundWallAreaN * m2_unitConv,2))
tableBody(wwrrAbvGndWall,wwrcSouth) = TRIM(RealToStr(aboveGroundWallAreaS * m2_unitConv,2))
tableBody(wwrrAbvGndWall,wwrcEast) = TRIM(RealToStr(aboveGroundWallAreaE * m2_unitConv,2))
tableBody(wwrrAbvGndWall,wwrcWest) = TRIM(RealToStr(aboveGroundWallAreaW * m2_unitConv,2))
tableBody(wwrrAbvGndWall,wwrcTotal) = TRIM(RealToStr(TotalAboveGroundWallArea * m2_unitConv,2))
tableBody(wwrrWindow,wwrcNorth) = TRIM(RealToStr(windowAreaN * m2_unitConv,2))
tableBody(wwrrWindow,wwrcSouth) = TRIM(RealToStr(windowAreaS * m2_unitConv,2))
tableBody(wwrrWindow,wwrcEast) = TRIM(RealToStr(windowAreaE * m2_unitConv,2))
tableBody(wwrrWindow,wwrcWest) = TRIM(RealToStr(windowAreaW * m2_unitConv,2))
tableBody(wwrrWindow,wwrcTotal) = TRIM(RealToStr(TotalWindowArea * m2_unitConv,2))
tableBody(wwrrWWR,wwrcNorth) = TRIM(RealToStr(100.d0 * SafeDivide(windowAreaN , wallAreaN),2))
tableBody(wwrrWWR,wwrcSouth) = TRIM(RealToStr(100.d0 * SafeDivide(windowAreaS , wallAreaS),2))
tableBody(wwrrWWR,wwrcEast) = TRIM(RealToStr(100.d0 * SafeDivide(windowAreaE , wallAreaE),2))
tableBody(wwrrWWR,wwrcWest) = TRIM(RealToStr(100.d0 * SafeDivide(windowAreaW , wallAreaW),2))
tableBody(wwrrWWR,wwrcTotal) = TRIM(RealToStr(100.d0 * SafeDivide(TotalWindowArea , TotalWallArea),2))
tableBody(wwrrAbvGndWWR,wwrcNorth) = TRIM(RealToStr(100.d0 * SafeDivide(windowAreaN , aboveGroundWallAreaN),2))
tableBody(wwrrAbvGndWWR,wwrcSouth) = TRIM(RealToStr(100.d0 * SafeDivide(windowAreaS , aboveGroundWallAreaS),2))
tableBody(wwrrAbvGndWWR,wwrcEast) = TRIM(RealToStr(100.d0 * SafeDivide(windowAreaE , aboveGroundWallAreaE),2))
tableBody(wwrrAbvGndWWR,wwrcWest) = TRIM(RealToStr(100.d0 * SafeDivide(windowAreaW , aboveGroundWallAreaW),2))
tableBody(wwrrAbvGndWWR,wwrcTotal)=TRIM(RealToStr(100.d0*SafeDivide(TotalWindowArea,TotalAboveGroundWallArea),2))
CALL writeSubtitle('Window-Wall Ratio')
CALL writeTable(tableBody,rowHead,columnHead,columnWidth)
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
'InputVerificationandResultsSummary',&
'Entire Facility',&
'Window-Wall Ratio')
DEALLOCATE(columnHead)
DEALLOCATE(rowHead)
DEALLOCATE(columnWidth)
DEALLOCATE(tableBody)
!
!---- Conditioned Window Wall Ratio Sub-Table
!
ALLOCATE(rowHead(5))
ALLOCATE(columnHead(5))
ALLOCATE(columnWidth(5))
columnWidth = 14 !array assignment - same for all columns
ALLOCATE(tableBody(5,5))
columnHead(wwrcTotal) = 'Total'
columnHead(wwrcNorth) = 'North (315 to 45 deg)'
columnHead(wwrcEast) = 'East (45 to 135 deg)'
columnHead(wwrcSouth) = 'South (135 to 225 deg)'
columnHead(wwrcWest) = 'West (225 to 315 deg)'
rowHead(wwrrWall) = 'Gross Wall Area ' // TRIM(m2_unitName)
rowHead(wwrrAbvGndWall) = 'Above Ground Wall Area ' // TRIM(m2_unitName)
rowHead(wwrrWindow) = 'Window Opening Area ' // TRIM(m2_unitName)
rowHead(wwrrWWR) = 'Gross Window-Wall Ratio [%]'
rowHead(wwrrAbvGndWWR) = 'Above Ground Window-Wall Ratio [%]'
!calculations appear in last block with normal window-wall ratio table
TotalWallArea=wallAreaNcond + wallAreaScond + wallAreaEcond + wallAreaWcond
TotalAboveGroundWallArea=aboveGroundWallAreaNcond+aboveGroundWallAreaScond+aboveGroundWallAreaEcond+aboveGroundWallAreaWcond
TotalWindowArea=windowAreaNcond + windowAreaScond + windowAreaEcond + windowAreaWcond
tableBody = ''
tableBody(wwrrWall,wwrcNorth) = TRIM(RealToStr(wallAreaNcond * m2_unitConv,2))
tableBody(wwrrWall,wwrcSouth) = TRIM(RealToStr(wallAreaScond * m2_unitConv,2))
tableBody(wwrrWall,wwrcEast) = TRIM(RealToStr(wallAreaEcond * m2_unitConv,2))
tableBody(wwrrWall,wwrcWest) = TRIM(RealToStr(wallAreaWcond * m2_unitConv,2))
tableBody(wwrrWall,wwrcTotal) = TRIM(RealToStr(TotalWallArea * m2_unitConv,2))
tableBody(wwrrAbvGndWall,wwrcNorth) = TRIM(RealToStr(aboveGroundWallAreaNcond * m2_unitConv,2))
tableBody(wwrrAbvGndWall,wwrcSouth) = TRIM(RealToStr(aboveGroundWallAreaScond * m2_unitConv,2))
tableBody(wwrrAbvGndWall,wwrcEast) = TRIM(RealToStr(aboveGroundWallAreaEcond * m2_unitConv,2))
tableBody(wwrrAbvGndWall,wwrcWest) = TRIM(RealToStr(aboveGroundWallAreaWcond * m2_unitConv,2))
tableBody(wwrrAbvGndWall,wwrcTotal) = TRIM(RealToStr(TotalAboveGroundWallArea * m2_unitConv,2))
tableBody(wwrrWindow,wwrcNorth) = TRIM(RealToStr(windowAreaNcond * m2_unitConv,2))
tableBody(wwrrWindow,wwrcSouth) = TRIM(RealToStr(windowAreaScond * m2_unitConv,2))
tableBody(wwrrWindow,wwrcEast) = TRIM(RealToStr(windowAreaEcond * m2_unitConv,2))
tableBody(wwrrWindow,wwrcWest) = TRIM(RealToStr(windowAreaWcond * m2_unitConv,2))
tableBody(wwrrWindow,wwrcTotal) = TRIM(RealToStr(TotalWindowArea * m2_unitConv,2))
tableBody(wwrrWWR,wwrcNorth) = TRIM(RealToStr(100.d0 * SafeDivide(windowAreaNcond , wallAreaNcond),2))
tableBody(wwrrWWR,wwrcSouth) = TRIM(RealToStr(100.d0 * SafeDivide(windowAreaScond , wallAreaScond),2))
tableBody(wwrrWWR,wwrcEast) = TRIM(RealToStr(100.d0 * SafeDivide(windowAreaEcond , wallAreaEcond),2))
tableBody(wwrrWWR,wwrcWest) = TRIM(RealToStr(100.d0 * SafeDivide(windowAreaWcond , wallAreaWcond),2))
tableBody(wwrrWWR,wwrcTotal) = TRIM(RealToStr(100.d0 * SafeDivide(TotalWindowArea,TotalWallArea),2))
tableBody(wwrrAbvGndWWR,wwrcNorth) = TRIM(RealToStr(100.d0 * SafeDivide(windowAreaNcond , aboveGroundWallAreaNcond),2))
tableBody(wwrrAbvGndWWR,wwrcSouth) = TRIM(RealToStr(100.d0 * SafeDivide(windowAreaScond , aboveGroundWallAreaScond),2))
tableBody(wwrrAbvGndWWR,wwrcEast) = TRIM(RealToStr(100.d0 * SafeDivide(windowAreaEcond , aboveGroundWallAreaEcond),2))
tableBody(wwrrAbvGndWWR,wwrcWest) = TRIM(RealToStr(100.d0 * SafeDivide(windowAreaWcond , aboveGroundWallAreaWcond),2))
tableBody(wwrrAbvGndWWR,wwrcTotal)=TRIM(RealToStr(100.d0*SafeDivide(TotalWindowArea,TotalAboveGroundWallArea),2))
CALL writeSubtitle('Conditioned Window-Wall Ratio')
CALL writeTable(tableBody,rowHead,columnHead,columnWidth)
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
'InputVerificationandResultsSummary',&
'Entire Facility',&
'Conditioned Window-Wall Ratio')
DEALLOCATE(columnHead)
DEALLOCATE(rowHead)
DEALLOCATE(columnWidth)
DEALLOCATE(tableBody)
!
!---- Skylight Roof Ratio Sub-Table
!
ALLOCATE(rowHead(3))
ALLOCATE(columnHead(1))
ALLOCATE(columnWidth(1))
columnWidth = 14 !array assignment - same for all columns
ALLOCATE(tableBody(3,1))
columnHead(1) = 'Total'
rowHead(1) = 'Gross Roof Area ' // TRIM(m2_unitName)
rowHead(2) = 'Skylight Area ' // TRIM(m2_unitName)
rowHead(3) = 'Skylight-Roof Ratio [%]'
IF (DetailedWWR) THEN
WRITE(OutputFileDebug,'(A)') '========================'
WRITE(OutputFileDebug,'(A)') 'TotalRoofArea,SkylightArea'
WRITE(OutputFileDebug,'(A)') trim(RoundSigDigits(roofArea,2))//','// &
trim(RoundSigDigits(skylightArea,2))
ENDIF
tableBody(1,1) = TRIM(RealToStr(roofArea * m2_unitConv,2))
tableBody(2,1) = TRIM(RealToStr(skylightArea * m2_unitConv,2))
tableBody(3,1) = TRIM(RealToStr(100.d0 * SafeDivide(skylightArea , roofArea),2))
CALL writeSubtitle('Skylight-Roof Ratio')
CALL writeTable(tableBody,rowHead,columnHead,columnWidth)
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
'InputVerificationandResultsSummary',&
'Entire Facility',&
'Skylight-Roof Ratio')
DEALLOCATE(columnHead)
DEALLOCATE(rowHead)
DEALLOCATE(columnWidth)
DEALLOCATE(tableBody)
IF (SUM(Zone(1:NumOfZones)%ExtGrossWallArea_Multiplied) > 0.0d0 .or. &
SUM(Zone(1:NumOfZones)%ExtGrossGroundWallArea_Multiplied) > 0.0d0) THEN
pdiff=ABS((wallAreaN + wallAreaS + wallAreaE + wallAreaW)- &
(SUM(Zone(1:NumOfZones)%ExtGrossWallArea_Multiplied)+SUM(Zone(1:NumOfZones)%ExtGrossGroundWallArea_Multiplied)))/ &
(SUM(Zone(1:NumOfZones)%ExtGrossWallArea_Multiplied)+SUM(Zone(1:NumOfZones)%ExtGrossGroundWallArea_Multiplied))
IF (pdiff > .019d0) THEN
CALL ShowWarningError('WriteVeriSumTable: InputVerificationsAndResultsSummary: '// &
'Wall area based on [>=60,<=120] degrees (tilt) as walls ')
CALL ShowContinueError('differs ~'//trim(RoundSigDigits(pdiff*100.d0,1))// &
'% from user entered Wall class surfaces. '// &
'Degree calculation based on ASHRAE 90.1 wall definitions.')
! CALL ShowContinueError('Calculated based on degrees=['// &
! trim(adjustl(RealToStr((wallAreaN + wallAreaS + wallAreaE + wallAreaW),3)))// &
! '] m2, Calculated from user entered Wall class surfaces=['// &
! trim(adjustl(RealToStr(SUM(Zone(1:NumOfZones)%ExtGrossWallArea_Multiplied),3)))//' m2.')
CALL ShowContinueError('Check classes of surfaces and tilts for discrepancies.')
CALL ShowContinueError('Total wall area by ASHRAE 90.1 definition='// &
trim(adjustl(RealToStr((wallAreaN + wallAreaS + wallAreaE + wallAreaW),3)))// &
' m2.')
CALL ShowContinueError('Total exterior wall area from user entered classes='// &
trim(adjustl(RealToStr(SUM(Zone(1:NumOfZones)%ExtGrossWallArea_Multiplied),3)))//' m2.')
CALL ShowContinueError('Total ground contact wall area from user entered classes='// &
trim(adjustl(RealToStr(SUM(Zone(1:NumOfZones)%ExtGrossGroundWallArea_Multiplied),3)))//' m2.')
ENDIF
ENDIF
!
!---- Space Summary Sub-Table
!
CALL writeTextLine('PERFORMANCE',.TRUE.)
ALLOCATE(rowHead(NumOfZones + 4))
ALLOCATE(columnHead(10))
ALLOCATE(columnWidth(10))
columnWidth = 14 !array assignment - same for all columns
ALLOCATE(tableBody(NumOfZones + 4,10))
columnHead(1) = 'Area ' // TRIM(m2_unitName)
columnHead(2) = 'Conditioned (Y/N)'
columnHead(3) = 'Part of Total Floor Area (Y/N)'
columnHead(4) = 'Volume ' // TRIM(m3_unitName)
columnHead(5) = 'Multipliers'
columnHead(6) = 'Gross Wall Area ' // TRIM(m2_unitName)
columnHead(7) = 'Window Glass Area ' // TRIM(m2_unitName)
columnHead(8) = 'Lighting ' // TRIM(Wm2_unitName)
columnHead(9) = 'People ' // TRIM(m2_unitName(1:Len_Trim(m2_unitName)-1)) // &
' per person'//m2_unitName(Len_Trim(m2_unitName):Len_Trim(m2_unitName))
columnHead(10) = 'Plug and Process ' // TRIM(Wm2_unitName)
rowHead = ''
rowHead(NumOfZones + grandTotal) = 'Total'
rowHead(NumOfZones + condTotal) = 'Conditioned Total'
rowHead(NumOfZones + uncondTotal) = 'Unconditioned Total'
rowHead(NumOfZones + notpartTotal) = 'Not Part of Total'
tableBody = ''
DO iZone = 1, NumOfZones
mult = Zone(iZone)%Multiplier * Zone(iZone)%ListMultiplier
rowHead(iZone) = TRIM(Zone(iZone)%Name)
IF (Zone(iZone)%SystemZoneNodeNumber .GT. 0) THEN
tableBody(iZone,2) = 'Yes'
zoneIsCond = .TRUE.
ELSE
tableBody(iZone,2) = 'No'
zoneIsCond = .FALSE.
END IF
IF (Zone(iZone)%isPartOfTotalArea) THEN
tableBody(iZone,3) = 'Yes'
usezoneFloorArea = .TRUE.
ELSE
tableBody(iZone,3) = 'No'
usezoneFloorArea = .FALSE.
END IF
tableBody(iZone,1) = TRIM(RealToStr(Zone(iZone)%FloorArea * m2_unitConv,2))
tableBody(iZone,4) = TRIM(RealToStr(Zone(iZone)%Volume * m3_unitConv,2))
!no unit conversion necessary since done automatically
CALL PreDefTableEntry(pdchLeedSutSpArea,Zone(iZone)%Name,Zone(iZone)%FloorArea,2)
IF (zoneIsCOnd) THEN
CALL PreDefTableEntry(pdchLeedSutOcArea,Zone(iZone)%Name,Zone(iZone)%FloorArea,2)
CALL PreDefTableEntry(pdchLeedSutUnArea,Zone(iZone)%Name,'0.00')
ELSE
CALL PreDefTableEntry(pdchLeedSutOcArea,Zone(iZone)%Name,'0.00')
CALL PreDefTableEntry(pdchLeedSutUnArea,Zone(iZone)%Name,Zone(iZone)%FloorArea,2)
ENDIF
tableBody(iZone,5) = TRIM(RealToStr(mult,2))
tableBody(iZone,6) = TRIM(RealToStr(Zone(iZone)%ExtGrossWallArea * m2_unitConv,2))
tableBody(iZone,7) = TRIM(RealToStr(Zone(iZone)%ExtWindowArea * m2_unitConv,2))
! lighting density
totLightPower = 0.0d0
DO iLight = 1, TotLights
IF (iZone .EQ. Lights(iLight)%ZonePtr) THEN
totLightPower = totLightPower + Lights(iLight)%DesignLevel
END IF
END DO
IF (Zone(iZone)%FloorArea .GT. 0 .and. usezoneFloorArea) THEN
tableBody(iZone,8) = TRIM(RealToStr(Wm2_unitConv * totLightPower / Zone(iZone)%FloorArea,4))
END IF
! people density
totNumPeople = 0.0d0
DO iPeople = 1, TotPeople
IF (iZone .EQ. People(iPeople)%ZonePtr) THEN
totNumPeople = totNumPeople + People(iPeople)%NumberOfPeople
END IF
END DO
IF (totNumPeople .GT. 0) THEN
tableBody(iZone,9) = TRIM(RealToStr(Zone(iZone)%FloorArea * m2_unitConv / totNumPeople,2))
END IF
! plug and process density
totPlugProcess = 0.0d0
DO iPlugProc = 1, TotElecEquip
IF (iZone .EQ. ZoneElectric(iPlugProc)%ZonePtr) THEN
totPlugProcess = totPlugProcess + ZoneElectric(iPlugProc)%DesignLevel
END IF
END DO
DO iPlugProc = 1, TotGasEquip
IF (iZone .EQ. ZoneGas(iPlugProc)%ZonePtr) THEN
totPlugProcess = totPlugProcess + ZoneGas(iPlugProc)%DesignLevel
END IF
END DO
DO iPlugProc = 1, TotOthEquip
IF (iZone .EQ. ZoneOtherEq(iPlugProc)%ZonePtr) THEN
totPlugProcess = totPlugProcess + ZoneOtherEq(iPlugProc)%DesignLevel
END IF
END DO
DO iPlugProc = 1, TotHWEquip
IF (iZone .EQ. ZoneHWEq(iPlugProc)%ZonePtr) THEN
totPlugProcess = totPlugProcess + ZoneHWEq(iPlugProc)%DesignLevel
END IF
END DO
IF (Zone(iZone)%FloorArea .GT. 0 .and. useZoneFloorArea) THEN
tableBody(iZone,10) = TRIM(RealToStr(totPlugProcess * Wm2_unitConv / Zone(iZone)%FloorArea,4))
END IF
!total rows for conditioned, unconditioned, and total
IF (usezoneFloorArea) THEN
zstArea(grandTotal) = zstArea(grandTotal) + mult * Zone(iZone)%FloorArea
zstVolume(grandTotal) = zstVolume(grandTotal) + mult * Zone(iZone)%Volume
zstWallArea(grandTotal) = zstWallArea(grandTotal) + mult * Zone(iZone)%ExtGrossWallArea
zstWindowArea(grandTotal) = zstWindowArea(grandTotal) + mult * Zone(iZone)%ExtWindowArea
zstLight(grandTotal) = zstLight(grandTotal) + mult * totLightPower
zstPeople(grandTotal) = zstPeople(grandTotal) + mult * totNumPeople
zstPlug(grandTotal) = zstPlug(grandTotal) + mult * totPlugProcess
ELSE
zstArea(notpartTotal) = zstArea(notpartTotal) + mult * Zone(iZone)%FloorArea
zstVolume(notpartTotal) = zstVolume(notpartTotal) + mult * Zone(iZone)%Volume
zstWallArea(notpartTotal) = zstWallArea(notpartTotal) + mult * Zone(iZone)%ExtGrossWallArea
zstWindowArea(notpartTotal) = zstWindowArea(notpartTotal) + mult * Zone(iZone)%ExtWindowArea
zstLight(notpartTotal) = zstLight(notpartTotal) + mult * totLightPower
zstPeople(notpartTotal) = zstPeople(notpartTotal) + mult * totNumPeople
zstPlug(notpartTotal) = zstPlug(notpartTotal) + mult * totPlugProcess
ENDIF
IF (zoneIsCond .and. usezoneFloorArea) THEN
zstArea(condTotal) = zstArea(condTotal) + mult * Zone(iZone)%FloorArea
zstVolume(condTotal) = zstVolume(condTotal) + mult * Zone(iZone)%Volume
zstWallArea(condTotal) = zstWallArea(condTotal) + mult * Zone(iZone)%ExtGrossWallArea
zstWindowArea(condTotal) = zstWindowArea(condTotal) + mult * Zone(iZone)%ExtWindowArea
zstLight(condTotal) = zstLight(condTotal) + mult * totLightPower
zstPeople(condTotal) = zstPeople(condTotal) + mult * totNumPeople
zstPlug(condTotal) = zstPlug(condTotal) + mult * totPlugProcess
ELSEIF (.not. zoneIsCond) THEN
zstArea(uncondTotal) = zstArea(uncondTotal) + mult * Zone(iZone)%FloorArea
zstVolume(uncondTotal) = zstVolume(uncondTotal) + mult * Zone(iZone)%Volume
zstWallArea(uncondTotal) = zstWallArea(uncondTotal) + mult * Zone(iZone)%ExtGrossWallArea
zstWindowArea(uncondTotal) = zstWindowArea(uncondTotal) + mult * Zone(iZone)%ExtWindowArea
zstLight(uncondTotal) = zstLight(uncondTotal) + mult * totLightPower
zstPeople(uncondTotal) = zstPeople(uncondTotal) + mult * totNumPeople
zstPlug(uncondTotal) = zstPlug(uncondTotal) + mult * totPlugProcess
ELSE
zstArea(notpartTotal) = zstArea(notpartTotal) + mult * Zone(iZone)%FloorArea
zstVolume(notpartTotal) = zstVolume(notpartTotal) + mult * Zone(iZone)%Volume
zstWallArea(notpartTotal) = zstWallArea(notpartTotal) + mult * Zone(iZone)%ExtGrossWallArea
zstWindowArea(notpartTotal) = zstWindowArea(notpartTotal) + mult * Zone(iZone)%ExtWindowArea
zstLight(notpartTotal) = zstLight(notpartTotal) + mult * totLightPower
zstPeople(notpartTotal) = zstPeople(notpartTotal) + mult * totNumPeople
zstPlug(notpartTotal) = zstPlug(notpartTotal) + mult * totPlugProcess
END IF
END DO
DO iTotal = 1, 4
tableBody(NumOfZones + iTotal,1) = TRIM(RealToStr(zstArea(iTotal) * m2_unitConv,2))
tableBody(NumOfZones + iTotal,4) = TRIM(RealToStr(zstVolume(iTotal) * m3_unitConv,2))
tableBody(NumOfZones + iTotal,6) = TRIM(RealToStr(zstWallArea(iTotal) * m2_unitConv,2))
tableBody(NumOfZones + iTotal,7) = TRIM(RealToStr(zstWindowArea(iTotal) * m2_unitConv,2))
IF (zstArea(iTotal) .NE. 0) THEN
tableBody(NumOfZones + iTotal,8) = TRIM(RealToStr(zstLight(iTotal) * Wm2_unitConv / zstArea(iTotal),4))
tableBody(NumOfZones + iTotal,10) = TRIM(RealToStr(zstPlug(iTotal) * Wm2_unitConv / zstArea(iTotal),4))
END IF
IF (zstPeople(iTotal) .NE. 0) THEN
tableBody(NumOfZones + iTotal,9) = TRIM(RealToStr(zstArea(iTotal) * m2_unitConv / zstPeople(iTotal),2))
END IF
END DO
CALL PreDefTableEntry(pdchLeedSutSpArea,'Totals',zstArea(grandTotal),2)
CALL PreDefTableEntry(pdchLeedSutOcArea,'Totals',zstArea(condTotal),2)
CALL PreDefTableEntry(pdchLeedSutUnArea,'Totals',zstArea(uncondTotal),2)
CALL writeSubtitle('Zone Summary')
CALL writeTable(tableBody,rowHead,columnHead,columnWidth)
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
'InputVerificationandResultsSummary',&
'Entire Facility',&
'Zone Summary')
DEALLOCATE(columnHead)
DEALLOCATE(rowHead)
DEALLOCATE(columnWidth)
DEALLOCATE(tableBody)
END IF
END SUBROUTINE WriteVeriSumTable