SUBROUTINE WriteBEPSTable
! SUBROUTINE INFORMATION:
! AUTHOR Jason Glazer
! DATE WRITTEN November 2003
! MODIFIED January 2010, Kyle Benne
! Added SQLite output
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Take the gathered total and enduse meter data and structure
! the results 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. Anytime that column headings are
! desired they are done in a new table because the only place
! that will split up very long header lines for the fixed width
! table is the header rows.
! REFERENCES:
! na
! USE STATEMENTS:
USE OutputProcessor, ONLY: MaxNumSubcategories, EndUseCategory
USE DataWater, ONlY: WaterStorage
USE ManageElectricPower , ONLY: ElecStorage, NumElecStorageDevices
USE SQLiteProcedures, ONLY: CreateSQLiteTabularDataRecords
USE DataHVACGlobals, ONLY: deviationFromSetPtThresholdHtg,deviationFromSetPtThresholdClg
USE ScheduleManager, ONLY: GetScheduleName
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
INTEGER, parameter :: enduseLine = 1
INTEGER, parameter :: detailLine = 16
INTEGER, parameter :: normalizedLine = 23
INTEGER, parameter :: elecSatisLine = 36
INTEGER, parameter :: thermSatisLine = 50
INTEGER, parameter :: waterSatisLine = 59
INTEGER, parameter :: sourceSiteLine = 69
INTEGER, parameter :: areaLine = 73
INTEGER, parameter :: controlLine = 77
INTEGER, parameter :: notesLine = 83
INTEGER, parameter :: colElectricity = 1
INTEGER, parameter :: colGas = 2
INTEGER, parameter :: colAdditionalFuel = 3
INTEGER, parameter :: colPurchCool = 4
INTEGER, parameter :: colPurchHeat = 5
INTEGER, parameter :: colWater = 6
REAL(r64), parameter :: SmallValue = 1.d-14
! 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
! all arrays are in the format: (row, columnm)
REAL(r64),DIMENSION(15,6) :: useVal
REAL(r64),DIMENSION(4,6) :: normalVal
REAL(r64),DIMENSION(6) :: collapsedTotal
REAL(r64),DIMENSION(numEndUses,6) :: collapsedEndUse
REAL(r64),DIMENSION(6,numEndUses,MaxNumSubcategories) :: collapsedEndUseSub
REAL(r64),DIMENSION(numEndUses,6) :: endUseSubOther
LOGICAL,DIMENSION(numEndUses) :: needOtherRow
REAL(r64) :: totalOnsiteHeat
REAL(r64) :: totalOnsiteWater
REAL(r64) :: totalWater
REAL(r64) :: netElecPurchasedSold
REAL(r64) :: totalSiteEnergyUse
REAL(r64) :: netSiteEnergyUse
REAL(r64) :: totalSourceEnergyUse
REAL(r64) :: netSourceEnergyUse
REAL(r64) :: netSourceElecPurchasedSold
INTEGER :: iResource
INTEGER :: jEndUse
INTEGER :: kEndUseSub
INTEGER :: i
REAL(r64) :: largeConversionFactor
REAL(r64) :: kConversionFactor
INTEGER :: numRows
REAL(r64) :: initialStorage
REAL(r64) :: finalStorage
REAL(r64) :: StorageChange
INTEGER :: resourcePrimaryHeating
REAL(r64) :: heatingMaximum
CHARACTER(len=100) :: footnote
REAL(r64) :: waterConversionFactor
REAL(r64) :: areaConversionFactor
REAL(r64) :: convBldgGrossFloorArea
REAL(r64) :: convBldgCondFloorArea
CHARACTER(len=MaxNameLength) :: curNameWithSIUnits
CHARACTER(len=MaxNameLength) :: curNameAndUnits
INTEGER :: indexUnitConv
CHARACTER(len=52) :: tableString
REAL(r64) :: processFraction
REAL(r64) :: processElecCost
REAL(r64) :: processGasCost
REAL(r64) :: processOthrCost
REAL(r64),DIMENSION(6) :: leedFansParkFromFan
REAL(r64),DIMENSION(6) :: leedFansParkFromExtFuelEquip
REAL(r64),DIMENSION(6) :: leedIntLightProc
REAL(r64),DIMENSION(6) :: leedCook
REAL(r64),DIMENSION(6) :: leedIndProc
REAL(r64),DIMENSION(6) :: leedElevEsc
CHARACTER(len=MaxNameLength) :: subCatName
REAL(r64) :: nonMisc
REAL(r64) :: leedSiteIntLite = 0.0d0
REAL(r64) :: leedSiteSpHeat = 0.0d0
REAL(r64) :: leedSiteSpCool = 0.0d0
REAL(r64) :: leedSiteFanInt = 0.0d0
REAL(r64) :: leedSiteSrvWatr = 0.0d0
REAL(r64) :: leedSiteRecept = 0.0d0
REAL(r64) :: leedSiteMisc = 0.0d0
REAL(r64) :: leedSiteTotal = 0.0d0
REAL(r64) :: unconvert
IF (displayTabularBEPS .or. displayLEEDSummary) THEN
! show the headers of the report
IF (displayTabularBEPS) THEN
CALL WriteReportHeaders('Annual Building Utility Performance Summary','Entire Facility',isAverage)
! show the number of hours that the table applies to
CALL writeTextLine('Values gathered over ' // RealToStr(gatherElapsedTimeBEPS,2) // ' hours',.TRUE.)
IF (gatherElapsedTimeBEPS .LT. 8759.0d0) THEN ! might not add up to 8760 exactly but can't be more than 1 hour diff.
CALL writeTextLine('WARNING: THE REPORT DOES NOT REPRESENT A FULL ANNUAL SIMULATION.',.TRUE.)
END IF
CALL writeTextLine('',.TRUE.)
ENDIF
! determine building floor areas
CALL DetermineBuildingFloorArea
! collapse the gatherEndUseBEPS array to the resource groups displayed
DO jEndUse=1,numEndUses
collapsedEndUse(jEndUse,1) = gatherEndUseBEPS(jEndUse,1) !electricity
collapsedEndUse(jEndUse,2) = gatherEndUseBEPS(jEndUse,2) !natural gas
collapsedEndUse(jEndUse,3) = gatherEndUseBEPS(jEndUse,6) & !additional fuel <- gasoline
+ gatherEndUseBEPS(jEndUse,8) & ! <- diesel
+ gatherEndUseBEPS(jEndUse,9) & ! <- coal
+ gatherEndUseBEPS(jEndUse,10) & ! <- fuel oil #1
+ gatherEndUseBEPS(jEndUse,11) & ! <- fuel oil #2
+ gatherEndUseBEPS(jEndUse,12) & ! <- propane
+ gatherEndUseBEPS(jEndUse,13) & ! <- otherfuel1
+ gatherEndUseBEPS(jEndUse,14) ! <- otherfuel2
collapsedEndUse(jEndUse,4) = gatherEndUseBEPS(jEndUse,3) !district cooling <- purchased cooling
collapsedEndUse(jEndUse,5) = gatherEndUseBEPS(jEndUse,4) & !district heating <- purchased heating
+ gatherEndUseBEPS(jEndUse,5) ! <- steam
collapsedEndUse(jEndUse,6) = gatherEndUseBEPS(jEndUse,7) !water
END DO
! repeat with totals
collapsedTotal(1) = gatherTotalsBEPS(1) !electricity
collapsedTotal(2) = gatherTotalsBEPS(2) !natural gas
collapsedTotal(3) = gatherTotalsBEPS(6) & !additional fuel <- gasoline
+ gatherTotalsBEPS(8) & ! <- diesel
+ gatherTotalsBEPS(9) & ! <- coal
+ gatherTotalsBEPS(10) & ! <- fuel oil #1
+ gatherTotalsBEPS(11) & ! <- fuel oil #2
+ gatherTotalsBEPS(12) & ! <- propane
+ gatherTotalsBEPS(13) & ! <- otherfuel1
+ gatherTotalsBEPS(14) ! <- otherfuel2
collapsedTotal(4) = gatherTotalsBEPS(3) !district cooling <- purchased cooling
collapsedTotal(5) = gatherTotalsBEPS(4) & !district heating <- purchased heating
+ gatherTotalsBEPS(5) ! <- steam
collapsedTotal(6) = gatherTotalsBEPS(7) !water
DO jEndUse=1,numEndUses
DO kEndUseSub = 1, EndUseCategory(jEndUse)%NumSubcategories
collapsedEndUseSub(1,jEndUse,kEndUseSub) = gatherEndUseSubBEPS(1,jEndUse,kEndUseSub) !electricity
collapsedEndUseSub(2,jEndUse,kEndUseSub) = gatherEndUseSubBEPS(2,jEndUse,kEndUseSub) !natural gas
collapsedEndUseSub(3,jEndUse,kEndUseSub) = gatherEndUseSubBEPS(6,jEndUse,kEndUseSub) & !additional fuel <- gasoline
+ gatherEndUseSubBEPS(8,jEndUse,kEndUseSub) & ! <- diesel
+ gatherEndUseSubBEPS(9,jEndUse,kEndUseSub) & ! <- coal
+ gatherEndUseSubBEPS(10,jEndUse,kEndUseSub) & ! <- fuel oil #1
+ gatherEndUseSubBEPS(11,jEndUse,kEndUseSub) & ! <- fuel oil #2
+ gatherEndUseSubBEPS(12,jEndUse,kEndUseSub) & ! <- propane
+ gatherEndUseSubBEPS(13,jEndUse,kEndUseSub) & ! <- otherfuel1
+ gatherEndUseSubBEPS(14,jEndUse,kEndUseSub) ! <- otherfuel2
collapsedEndUseSub(4,jEndUse,kEndUseSub) = gatherEndUseSubBEPS(3,jEndUse,kEndUseSub) !district cooling <- purch cooling
collapsedEndUseSub(5,jEndUse,kEndUseSub) = gatherEndUseSubBEPS(4,jEndUse,kEndUseSub) & !district heating <- purch heating
+ gatherEndUseSubBEPS(5,jEndUse,kEndUseSub) ! <- steam
collapsedEndUseSub(6,jEndUse,kEndUseSub) = gatherEndUseSubBEPS(7,jEndUse,kEndUseSub) !water
END DO
END DO
! unit conversion - all values are used as divisors
SELECT CASE (unitsStyle)
CASE (unitsStyleJtoKWH)
largeConversionFactor = 3600000.d0
kConversionFactor = 1.0d0
waterConversionFactor = 1.0d0
areaConversionFactor = 1.0d0
CASE (unitsStyleInchPound)
largeConversionFactor = getSpecificUnitDivider('J','kBtu') !1054351.84 J to kBtu
kConversionFactor = 1.0d0
waterConversionFactor = getSpecificUnitDivider('m3','gal') !0.003785413 m3 to gal
areaConversionFactor = getSpecificUnitDivider('m2','ft2') !0.092893973 m2 to ft2
CASE DEFAULT
largeConversionFactor = 1000000000.d0
kConversionFactor = 1000.0d0
waterConversionFactor = 1.0d0
areaConversionFactor = 1.0d0
END SELECT
! convert floor areas
convBldgGrossFloorArea = buildingGrossFloorArea / areaConversionFactor
convBldgCondFloorArea = buildingConditionedFloorArea / areaConversionFactor
!convert units into GJ (divide by 1,000,000,000) if J otherwise kWh
DO iResource= 1,5 !don't do water
DO jEndUse=1,numEndUses
collapsedEndUse(jEndUse,iResource) = collapsedEndUse(jEndUse,iResource) / largeConversionFactor
DO kEndUseSub = 1, EndUseCategory(jEndUse)%NumSubcategories
collapsedEndUseSub(iResource,jEndUse,kEndUseSub) = collapsedEndUseSub(iResource,jEndUse,kEndUseSub) &
/ largeConversionFactor
END DO
END DO
collapsedTotal(iResource) = collapsedTotal(iResource) / largeConversionFactor
END DO
!do water
DO jEndUse=1,numEndUses
collapsedEndUse(jEndUse,6) = collapsedEndUse(jEndUse,6) / waterConversionFactor
DO kEndUseSub = 1, EndUseCategory(jEndUse)%NumSubcategories
collapsedEndUseSub(6,jEndUse,kEndUseSub) = collapsedEndUseSub(6,jEndUse,kEndUseSub) &
/ waterConversionFactor
END DO
END DO
! convert to GJ
gatherPowerFuelFireGen = gatherPowerFuelFireGen / largeConversionFactor
gatherPowerPV = gatherPowerPV / largeConversionFactor
gatherPowerWind = gatherPowerWind / largeConversionFactor
gatherPowerHTGeothermal = gatherPowerHTGeothermal / largeConversionFactor
gatherElecProduced = gatherElecProduced / largeConversionFactor
gatherElecPurchased = gatherElecPurchased / largeConversionFactor
gatherElecSurplusSold = gatherElecSurplusSold / largeConversionFactor
! get change in overall state of charge for electrical storage devices.
IF (NumElecStorageDevices >0) THEN
OverallNetEnergyFromStorage = (Sum(ElecStorage%StartingEnergyStored) - Sum(ElecStorage%ThisTimeStepStateOfCharge))
OverallNetEnergyFromStorage = OverallNetEnergyFromStorage / largeConversionFactor
ELSE
OverallNetEnergyFromStorage = 0.0D0
ENDIF
! determine which resource is the primary heating resourse
resourcePrimaryHeating = 0
heatingMaximum = 0.0d0
DO iResource = 1, 5 !don't do water
IF (collapsedEndUse(endUseHeating, iResource) .GT. heatingMaximum) THEN
heatingMaximum = collapsedEndUse(endUseHeating, iResource)
resourcePrimaryHeating = iResource
END IF
END DO
!
!---- Source and Site Energy Sub-Table
!
ALLOCATE(rowHead(4))
ALLOCATE(columnHead(3))
ALLOCATE(columnWidth(3))
columnWidth = 14 !array assignment - same for all columns
ALLOCATE(tableBody(4,3))
SELECT CASE (unitsStyle)
CASE (unitsStyleJtoKWH)
columnHead(1) = 'Total Energy [kWh]'
columnHead(2) = 'Energy Per Total Building Area [kWh/m2]'
columnHead(3) = 'Energy Per Conditioned Building Area [kWh/m2]'
CASE (unitsStyleInchPound)
columnHead(1) = 'Total Energy [kBtu]'
columnHead(2) = 'Energy Per Total Building Area [kBtu/ft2]'
columnHead(3) = 'Energy Per Conditioned Building Area [kBtu/ft2]'
CASE DEFAULT
columnHead(1) = 'Total Energy [GJ]'
columnHead(2) = 'Energy Per Total Building Area [MJ/m2]'
columnHead(3) = 'Energy Per Conditioned Building Area [MJ/m2]'
END SELECT
rowHead(1) = 'Total Site Energy'
rowHead(2) = 'Net Site Energy'
rowHead(3) = 'Total Source Energy'
rowHead(4) = 'Net Source Energy'
tableBody = ''
! compute the net amount of electricity received from the utility which
! is the amount purchased less the amount sold to the utility. Note that
! previously these variables were converted into GJ so now we don't need
! to do any conversion
totalSiteEnergyUse = (gatherTotalsBEPS(1) & !electricity
+ gatherTotalsBEPS(2) & !natural gas
+ gatherTotalsBEPS(3) & !district cooling
+ gatherTotalsBEPS(4) & !district heating
+ gatherTotalsBEPS(5) & !steam
+ gatherTotalsBEPS(6) & !gasoline
! water is not included gatherTotalsBEPS(7) !water
+ gatherTotalsBEPS(8) & !diesel
+ gatherTotalsBEPS(9) & !coal
+ gatherTotalsBEPS(10) & !fuel oil #1
+ gatherTotalsBEPS(11) & !fuel oil #2
+ gatherTotalsBEPS(12) & !propane
+ gatherTotalsBEPS(13) & !otherfuel1
+ gatherTotalsBEPS(14) & !otherfuel2
) / largeConversionFactor
netElecPurchasedSold = gatherElecPurchased - gatherElecSurplusSold
netSiteEnergyUse = netElecPurchasedSold & !electricity (already in GJ)
+ ( gatherTotalsBEPS(2) & !natural gas
+ gatherTotalsBEPS(3) & !district cooling
+ gatherTotalsBEPS(4) & !district heating
+ gatherTotalsBEPS(5) & !steam
+ gatherTotalsBEPS(6) & !gasoline
! water is not included gatherTotalsBEPS(7) !water
+ gatherTotalsBEPS(8) & !diesel
+ gatherTotalsBEPS(9) & !coal
+ gatherTotalsBEPS(10) & !fuel oil #1
+ gatherTotalsBEPS(11) & !fuel oil #2
+ gatherTotalsBEPS(12) & !propane
+ gatherTotalsBEPS(13) & !otherfuel1
+ gatherTotalsBEPS(14) & !otherfuel2
) / largeConversionFactor
IF (efficiencyDistrictCooling .EQ. 0) efficiencyDistrictCooling = 1.0d0
IF (efficiencyDistrictHeating .EQ. 0) efficiencyDistrictHeating = 1.0d0
! source emissions already have the source factors included in the calcs.
TotalSourceEnergyUse=0.0d0
! electricity
if (fuelfactorsused(1)) then
TotalSourceEnergyUse=TotalSourceEnergyUse+gatherTotalsSource(1)
else
TotalSourceEnergyUse=TotalSourceEnergyUse+gatherTotalsBEPS(1)*sourceFactorElectric
endif
! natural gas
if (fuelfactorsused(2)) then
TotalSourceEnergyUse=TotalSourceEnergyUse+gatherTotalsSource(2)
else
TotalSourceEnergyUse=TotalSourceEnergyUse+gatherTotalsBEPS(2)*sourceFactorNaturalGas
endif
! gasoline
if (fuelfactorsused(3)) then
TotalSourceEnergyUse=TotalSourceEnergyUse+gatherTotalsSource(3)
else
TotalSourceEnergyUse=TotalSourceEnergyUse+gatherTotalsBEPS(6)*sourceFactorGasoline
endif
! diesel
if (fuelfactorsused(4)) then
TotalSourceEnergyUse=TotalSourceEnergyUse+gatherTotalsSource(4)
else
TotalSourceEnergyUse=TotalSourceEnergyUse+gatherTotalsBEPS(8)*sourceFactorDiesel
endif
! coal
if (fuelfactorsused(5)) then
TotalSourceEnergyUse=TotalSourceEnergyUse+gatherTotalsSource(5)
else
TotalSourceEnergyUse=TotalSourceEnergyUse+gatherTotalsBEPS(9)*sourceFactorCoal
endif
! fuel oil #1
if (fuelfactorsused(6)) then
TotalSourceEnergyUse=TotalSourceEnergyUse+gatherTotalsSource(6)
else
TotalSourceEnergyUse=TotalSourceEnergyUse+gatherTotalsBEPS(10)*sourceFactorFuelOil1
endif
! fuel oil #2
if (fuelfactorsused(7)) then
TotalSourceEnergyUse=TotalSourceEnergyUse+gatherTotalsSource(7)
else
TotalSourceEnergyUse=TotalSourceEnergyUse+gatherTotalsBEPS(11)*sourceFactorFuelOil2
endif
! propane
if (fuelfactorsused(8)) then
TotalSourceEnergyUse=TotalSourceEnergyUse+gatherTotalsSource(8)
else
TotalSourceEnergyUse=TotalSourceEnergyUse+gatherTotalsBEPS(12)*sourceFactorPropane
endif
!otherfuel1
if (fuelfactorsused(11)) then
TotalSourceEnergyUse=TotalSourceEnergyUse+gatherTotalsSource(11)
else
TotalSourceEnergyUse=TotalSourceEnergyUse+gatherTotalsBEPS(13)*sourceFactorOtherFuel1
endif
!otherfuel2
if (fuelfactorsused(12)) then
TotalSourceEnergyUse=TotalSourceEnergyUse+gatherTotalsSource(12)
else
TotalSourceEnergyUse=TotalSourceEnergyUse+gatherTotalsBEPS(14)*sourceFactorOtherFuel2
endif
TotalSourceEnergyUse = (TotalSourceEnergyuse &
+ gatherTotalsBEPS(3)*sourceFactorElectric/efficiencyDistrictCooling & !district cooling
+ gatherTotalsBEPS(4)*sourceFactorNaturalGas/efficiencyDistrictHeating & !district heating
+ gatherTotalsBEPS(5)*sourceFactorSteam & !steam
) / largeConversionFactor
! now determine "net" source from purchased and surplus sold (still in J)
if (fuelfactorsused(1)) then
netSourceElecPurchasedSold = gatherTotalsSource(9) - gatherTotalsSource(10)
else
netSourceElecPurchasedSold = netElecPurchasedSold*sourceFactorElectric*largeConversionFactor ! back to J
endif
netSourceEnergyUse=0.0d0
! natural gas
if (fuelfactorsused(2)) then
netSourceEnergyUse=netSourceEnergyUse+gatherTotalsSource(2)
else
netSourceEnergyUse=netSourceEnergyUse+gatherTotalsBEPS(2)*sourceFactorNaturalGas
endif
! gasoline
if (fuelfactorsused(3)) then
netSourceEnergyUse=netSourceEnergyUse+gatherTotalsSource(3)
else
netSourceEnergyUse=netSourceEnergyUse+gatherTotalsBEPS(6)*sourceFactorGasoline
endif
! diesel
if (fuelfactorsused(4)) then
netSourceEnergyUse=netSourceEnergyUse+gatherTotalsSource(4)
else
netSourceEnergyUse=netSourceEnergyUse+gatherTotalsBEPS(8)*sourceFactorDiesel
endif
! coal
if (fuelfactorsused(5)) then
netSourceEnergyUse=netSourceEnergyUse+gatherTotalsSource(5)
else
netSourceEnergyUse=netSourceEnergyUse+gatherTotalsBEPS(9)*sourceFactorCoal
endif
! fuel oil #1
if (fuelfactorsused(6)) then
netSourceEnergyUse=netSourceEnergyUse+gatherTotalsSource(6)
else
netSourceEnergyUse=netSourceEnergyUse+gatherTotalsBEPS(10)*sourceFactorFuelOil1
endif
! fuel oil #2
if (fuelfactorsused(7)) then
netSourceEnergyUse=netSourceEnergyUse+gatherTotalsSource(7)
else
netSourceEnergyUse=netSourceEnergyUse+gatherTotalsBEPS(11)*sourceFactorFuelOil2
endif
! propane
if (fuelfactorsused(8)) then
netSourceEnergyUse=netSourceEnergyUse+gatherTotalsSource(8)
else
netSourceEnergyUse=netSourceEnergyUse+gatherTotalsBEPS(12)*sourceFactorPropane
endif
! otherfuel1
if (fuelfactorsused(11)) then
netSourceEnergyUse=netSourceEnergyUse+gatherTotalsSource(11)
else
netSourceEnergyUse=netSourceEnergyUse+gatherTotalsBEPS(13)*sourceFactorOtherFuel1
endif
! otherfuel2
if (fuelfactorsused(12)) then
netSourceEnergyUse=netSourceEnergyUse+gatherTotalsSource(12)
else
netSourceEnergyUse=netSourceEnergyUse+gatherTotalsBEPS(14)*sourceFactorOtherFuel2
endif
netSourceEnergyUse = (netSourceEnergyUse & ! from other fuels
+ netSourceElecPurchasedSold & !net source from electricity
+ gatherTotalsBEPS(3)*sourceFactorElectric/efficiencyDistrictCooling & !district cooling
+ gatherTotalsBEPS(4)*sourceFactorNaturalGas/efficiencyDistrictHeating & !district heating
+ gatherTotalsBEPS(5)*sourceFactorSteam & !steam
) / largeConversionFactor
! show annual values
tableBody(1,1) = TRIM(RealToStr(totalSiteEnergyUse,2))
tableBody(2,1) = TRIM(RealToStr(netSiteEnergyUse, 2))
tableBody(3,1) = TRIM(RealToStr(totalSourceEnergyUse,2))
tableBody(4,1) = TRIM(RealToStr(netSourceEnergyUse,2))
! show per building area
IF (convBldgGrossFloorArea .GT. 0) THEN
tableBody(1,2) = TRIM(RealToStr(totalSiteEnergyUse * kConversionFactor &
/ convBldgGrossFloorArea,2))
tableBody(2,2) = TRIM(RealToStr(netSiteEnergyUse * kConversionFactor &
/ convBldgGrossFloorArea,2))
tableBody(3,2) = TRIM(RealToStr(totalSourceEnergyUse * kConversionFactor &
/ convBldgGrossFloorArea, 2))
tableBody(4,2) = TRIM(RealToStr(netSourceEnergyUse * kConversionFactor &
/ convBldgGrossFloorArea, 2))
END IF
! show per conditioned building area
IF (convBldgCondFloorArea .GT. 0) THEN
tableBody(1,3) = TRIM(RealToStr(TotalSiteEnergyUse * kConversionFactor &
/ convBldgCondFloorArea,2))
tableBody(2,3) = TRIM(RealToStr(NetSiteEnergyUse * kConversionFactor &
/ convBldgCondFloorArea,2))
tableBody(3,3) = TRIM(RealToStr(TotalSourceEnergyUse * kConversionFactor &
/ convBldgCondFloorArea, 2))
tableBody(4,3) = TRIM(RealToStr(NetSourceEnergyUse * kConversionFactor &
/ convBldgCondFloorArea, 2))
END IF
! heading for the entire sub-table
IF (displayTabularBEPS) THEN
CALL writeSubtitle('Site and Source Energy')
CALL writeTable(tableBody,rowHead,columnHead,columnWidth)
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
'AnnualBuildingUtilityPerformanceSummary',&
'Entire Facility',&
'Site and Source Energy')
ENDIF
DEALLOCATE(columnHead)
DEALLOCATE(rowHead)
DEALLOCATE(columnWidth)
DEALLOCATE(tableBody)
!
!---- Source and Site Energy Sub-Table
!
ALLOCATE(rowHead(13))
ALLOCATE(columnHead(1))
ALLOCATE(columnWidth(1))
columnWidth = 50 !array assignment
ALLOCATE(tableBody(13,1))
columnHead(1) = 'Site=>Source Conversion Factor'
rowHead(1) = 'Electricity'
rowHead(2) = 'Natural Gas'
rowHead(3) = 'District Cooling'
rowHead(4) = 'District Heating'
rowHead(5) = 'Steam'
rowHead(6) = 'Gasoline'
rowHead(7) = 'Diesel'
rowHead(8) = 'Coal'
rowHead(9) = 'Fuel Oil #1'
rowHead(10) = 'Fuel Oil #2'
rowHead(11) = 'Propane'
rowHead(12) = 'Other Fuel 1'
rowHead(13) = 'Other Fuel 2'
tableBody = ''
! set columns to conversion factors
! show values
! tableBody(1,1) = TRIM(RealToStr(sourceFactorElectric,3))
! tableBody(2,1) = TRIM(RealToStr(sourceFactorNaturalGas, 3))
! tableBody(3,1) = TRIM(RealToStr(sourceFactorElectric/ efficiencyDistrictCooling,3))
! tableBody(4,1) = TRIM(RealToStr(sourceFactorNaturalGas/ efficiencyDistrictHeating ,3))
! tableBody(5,1) = TRIM(RealToStr(sourceFactorSteam ,3))
! tableBody(6,1) = TRIM(RealToStr(sourceFactorGasoline ,3))
! tableBody(7,1) = TRIM(RealToStr(sourceFactorDiesel ,3))
! tableBody(8,1) = TRIM(RealToStr(sourceFactorCoal ,3))
! tableBody(9,1) = TRIM(RealToStr(sourceFactorFuelOil1 ,3))
! tableBody(10,1) = TRIM(RealToStr(sourceFactorFuelOil2 ,3))
! tableBody(11,1) = TRIM(RealToStr(sourceFactorPropane ,3))
IF (.not. ffSchedUsed(1)) THEN
tableBody(1,1) = TRIM(RealToStr(sourceFactorElectric,3))
ELSEIF (gatherTotalsBEPS(1) > SmallValue) THEN
tableBody(1,1) = 'Effective Factor = ' // TRIM(RealToStr(gatherTotalsBySourceBEPS(1)/gatherTotalsBEPS(1),3)) // &
' (calculated using schedule "' // TRIM(GetScheduleName(ffSchedIndex(1))) // '")'
ELSE
tableBody(1,1) = 'N/A'
END IF
IF (.not. ffSchedUsed(2)) THEN
tableBody(2,1) = TRIM(RealToStr(sourceFactorNaturalGas, 3))
ELSEIF (gatherTotalsBEPS(2) > SmallValue) THEN
tableBody(2,1) = 'Effective Factor = ' // TRIM(RealToStr(gatherTotalsBySourceBEPS(2)/gatherTotalsBEPS(2),3)) // &
' (calculated using schedule "' // TRIM(GetScheduleName(ffSchedIndex(2))) // '")'
ELSE
tableBody(2,1) = 'N/A'
END IF
tableBody(3,1) = TRIM(RealToStr(sourceFactorElectric/ efficiencyDistrictCooling,3)) ! District Cooling
tableBody(4,1) = TRIM(RealToStr(sourceFactorNaturalGas/ efficiencyDistrictHeating ,3)) ! Disctrict Heating
tableBody(5,1) = TRIM(RealToStr(sourceFactorSteam ,3)) ! Steam
IF (.not. ffSchedUsed(6)) THEN
tableBody(6,1) = TRIM(RealToStr(sourceFactorGasoline ,3))
ELSEIF (gatherTotalsBEPS(6) > SmallValue) THEN
tableBody(6,1) = 'Effective Factor = ' // TRIM(RealToStr(gatherTotalsBySourceBEPS(6)/gatherTotalsBEPS(6),3)) // &
' (calculated using schedule "' // TRIM(GetScheduleName(ffSchedIndex(6))) // '")'
ELSE
tableBody(6,1) = 'N/A'
END IF
IF (.not. ffSchedUsed(8)) THEN
tableBody(7,1) = TRIM(RealToStr(sourceFactorDiesel ,3))
ELSEIF (gatherTotalsBEPS(8) > SmallValue) THEN
tableBody(7,1) = 'Effective Factor = ' // TRIM(RealToStr(gatherTotalsBySourceBEPS(8)/gatherTotalsBEPS(8),3)) // &
' (calculated using schedule "' // TRIM(GetScheduleName(ffSchedIndex(8))) // '")'
ELSE
tableBody(7,1) = 'N/A'
END IF
IF (.not. ffSchedUsed(9)) THEN
tableBody(8,1) = TRIM(RealToStr(sourceFactorCoal ,3))
ELSEIF (gatherTotalsBEPS(9) > SmallValue) THEN
tableBody(8,1) = 'Effective Factor = ' // TRIM(RealToStr(gatherTotalsBySourceBEPS(9)/gatherTotalsBEPS(9),3)) // &
' (calculated using schedule "' // TRIM(GetScheduleName(ffSchedIndex(9))) //'")'
ELSE
tableBody(8,1) = 'N/A'
END IF
IF (.not. ffSchedUsed(10)) THEN
tableBody(9,1) = TRIM(RealToStr(sourceFactorFuelOil1 ,3))
ELSEIF (gatherTotalsBEPS(10) > SmallValue) THEN
tableBody(9,1) = 'Effective Factor = ' // TRIM(RealToStr(gatherTotalsBySourceBEPS(10)/gatherTotalsBEPS(10),3)) // &
' (calculated using schedule "' // TRIM(GetScheduleName(ffSchedIndex(10))) //'")'
ELSE
tableBody(9,1) = 'N/A'
END IF
IF (.not. ffSchedUsed(11)) THEN
tableBody(10,1) = TRIM(RealToStr(sourceFactorFuelOil2 ,3))
ELSEIF (gatherTotalsBEPS(11) > SmallValue) THEN
tableBody(10,1) = 'Effective Factor = ' // TRIM(RealToStr(gatherTotalsBySourceBEPS(11)/gatherTotalsBEPS(11),3)) // &
' (calculated using schedule "' // TRIM(GetScheduleName(ffSchedIndex(11))) //'")'
ELSE
tableBody(10,1) = 'N/A'
END IF
IF (.not. ffSchedUsed(12)) THEN
tableBody(11,1) = TRIM(RealToStr(sourceFactorPropane ,3))
ELSEIF (gatherTotalsBEPS(12) > SmallValue) THEN
tableBody(11,1) = 'Effective Factor = ' // TRIM(RealToStr(gatherTotalsBySourceBEPS(12)/gatherTotalsBEPS(12),3)) // &
' (calculated using schedule "' // TRIM(GetScheduleName(ffSchedIndex(12))) //'")'
ELSE
tableBody(11,1) = 'N/A'
END IF
IF (.not. ffSchedUsed(13)) THEN
tableBody(12,1) = TRIM(RealToStr(sourceFactorOtherFuel1 ,3))
ELSEIF (gatherTotalsBEPS(13) > SmallValue) THEN
tableBody(12,1) = 'Effective Factor = ' // TRIM(RealToStr(gatherTotalsBySourceBEPS(13)/gatherTotalsBEPS(13),3)) // &
' (calculated using schedule "' // TRIM(GetScheduleName(ffSchedIndex(13))) //'")'
ELSE
tableBody(12,1) = 'N/A'
END IF
IF (.not. ffSchedUsed(14)) THEN
tableBody(13,1) = TRIM(RealToStr(sourceFactorOtherFuel2 ,3))
ELSEIF (gatherTotalsBEPS(14) > SmallValue) THEN
tableBody(13,1) = 'Effective Factor = ' // TRIM(RealToStr(gatherTotalsBySourceBEPS(14)/gatherTotalsBEPS(14),3)) // &
' (calculated using schedule "' // TRIM(GetScheduleName(ffSchedIndex(14))) //'")'
ELSE
tableBody(13,1) = 'N/A'
END IF
! heading for the entire sub-table
IF (displayTabularBEPS) THEN
CALL writeSubtitle('Site to Source Energy Conversion Factors')
CALL writeTable(tableBody,rowHead,columnHead,columnWidth)
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
'AnnualBuildingUtilityPerformanceSummary',&
'Entire Facility',&
'Site to Source Energy Conversion Factors')
ENDIF
DEALLOCATE(columnHead)
DEALLOCATE(rowHead)
DEALLOCATE(columnWidth)
DEALLOCATE(tableBody)
!
!---- Building Area Sub-Table
!
ALLOCATE(rowHead(3))
ALLOCATE(columnHead(1))
ALLOCATE(columnWidth(1))
columnWidth = 14 !array assignment - same for all columns
ALLOCATE(tableBody(3,1))
SELECT CASE (unitsStyle)
CASE (unitsStyleJtoKWH)
columnHead(1) = 'Area [m2]'
CASE (unitsStyleInchPound)
columnHead(1) = 'Area [ft2]'
CASE DEFAULT
columnHead(1) = 'Area [m2]'
END SELECT
rowHead(1) = 'Total Building Area'
rowHead(2) = 'Net Conditioned Building Area'
rowHead(3) = 'Unconditioned Building Area'
tableBody = ''
tableBody(1,1) = TRIM(RealToStr(convBldgGrossFloorArea,2))
CALL PreDefTableEntry(pdchLeedGenData,'Total gross floor area [m2]',TRIM(RealToStr(convBldgGrossFloorArea,2)))
tableBody(2,1) = TRIM(RealToStr(convBldgCondFloorArea,2))
tableBody(3,1) = TRIM(RealToStr(convBldgGrossFloorArea - convBldgCondFloorArea,2))
! heading for the entire sub-table
IF (displayTabularBEPS) THEN
CALL writeSubtitle('Building Area')
CALL writeTable(tableBody,rowHead,columnHead,columnWidth)
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
'AnnualBuildingUtilityPerformanceSummary',&
'Entire Facility',&
'Building Area')
ENDIF
DEALLOCATE(columnHead)
DEALLOCATE(rowHead)
DEALLOCATE(columnWidth)
DEALLOCATE(tableBody)
!
!---- End Use Sub-Table
!
ALLOCATE(rowHead(16))
ALLOCATE(columnHead(6))
ALLOCATE(columnWidth(6))
columnWidth = 14 !array assignment - same for all columns
ALLOCATE(tableBody(16,6))
DO iResource= 1,6
useVal(1,iResource) = collapsedEndUse(endUseHeating,iResource)
useVal(2,iResource) = collapsedEndUse(endUseCooling,iResource)
useVal(3,iResource) = collapsedEndUse(endUseInteriorLights,iResource)
useVal(4,iResource) = collapsedEndUse(endUseExteriorLights,iResource)
useVal(5,iResource) = collapsedEndUse(endUseInteriorEquipment,iResource)
useVal(6,iResource) = collapsedEndUse(endUseExteriorEquipment,iResource)
useVal(7,iResource) = collapsedEndUse(endUseFans,iResource)
useVal(8,iResource) = collapsedEndUse(endUsePumps,iResource)
useVal(9,iResource) = collapsedEndUse(endUseHeatRejection,iResource)
useVal(10,iResource) = collapsedEndUse(endUseHumidification,iResource)
useVal(11,iResource) = collapsedEndUse(endUseHeatRecovery,iResource)
useVal(12,iResource) = collapsedEndUse(endUseWaterSystem,iResource)
useVal(13,iResource) = collapsedEndUse(endUseRefrigeration,iResource)
useVal(14,iResource) = collapsedEndUse(endUseCogeneration,iResource)
useVal(15,iResource) = collapsedTotal(iResource) ! totals
END DO
rowHead(1) = 'Heating'
rowHead(2) = 'Cooling'
rowHead(3) = 'Interior Lighting'
rowHead(4) = 'Exterior Lighting'
rowHead(5) = 'Interior Equipment'
rowHead(6) = 'Exterior Equipment'
rowHead(7) = 'Fans'
rowHead(8) = 'Pumps'
rowHead(9) = 'Heat Rejection'
rowHead(10) = 'Humidification'
rowHead(11) = 'Heat Recovery'
rowHead(12) = 'Water Systems'
rowHead(13) = 'Refrigeration'
rowHead(14) = 'Generators'
rowHead(15) = ''
rowHead(16) = 'Total End Uses'
SELECT CASE (unitsStyle)
CASE (unitsStyleJtoKWH)
columnHead(1) = 'Electricity [kWh]'
columnHead(2) = 'Natural Gas [kWh]'
columnHead(3) = 'Additional Fuel [kWh]'
columnHead(4) = 'District Cooling [kWh]'
columnHead(5) = 'District Heating [kWh]'
columnHead(6) = 'Water [m3]'
CASE (unitsStyleInchPound)
columnHead(1) = 'Electricity [kBtu]'
columnHead(2) = 'Natural Gas [kBtu]'
columnHead(3) = 'Additional Fuel [kBtu]'
columnHead(4) = 'District Cooling [kBtu]'
columnHead(5) = 'District Heating [kBtu]'
columnHead(6) = 'Water [gal]'
CASE DEFAULT
columnHead(1) = 'Electricity [GJ]'
columnHead(2) = 'Natural Gas [GJ]'
columnHead(3) = 'Additional Fuel [GJ]'
columnHead(4) = 'District Cooling [GJ]'
columnHead(5) = 'District Heating [GJ]'
columnHead(6) = 'Water [m3]'
END SELECT
tableBody = ''
DO iResource= 1,6
DO jEndUse=1,14
tableBody(jEndUse,iResource) = TRIM(RealToStr(useVal(jEndUse,iResource),2))
END DO
tableBody(16,iResource) = TRIM(RealToStr(useVal(15,iResource),2))
END DO
!complete the LEED end use table using the same values
! for certain rows in the LEED table the subcategories are necessary so first compute those values
leedFansParkFromFan = 0.0d0
leedFansParkFromExtFuelEquip = 0.0d0
leedIntLightProc = 0.0d0
leedCook = 0.0d0
leedIndProc = 0.0d0
leedElevEsc = 0.0d0
DO iResource = 1, 5 ! don't bother with water
DO jEndUse = 1, NumEndUses
IF (EndUseCategory(jEndUse)%NumSubcategories > 0) THEN
DO kEndUseSub = 1, EndUseCategory(jEndUse)%NumSubcategories
subCatName = EndUseCategory(jEndUse)%SubcategoryName(kEndUseSub)
IF (SameString(subCatName,'Fans - Parking Garage')) THEN
IF (jEndUse .EQ. 7) THEN !fans
leedFansParkFromFan(iResource) = leedFansParkFromFan(iResource) + collapsedEndUseSub(iResource,jEndUse,kEndUseSub)
ELSE
leedFansParkFromExtFuelEquip(iResource) = leedFansParkFromExtFuelEquip(iResource) &
+ collapsedEndUseSub(iResource,jEndUse,kEndUseSub)
END IF
ELSEIF (SameString(subCatName,'Interior Lighting - Process')) THEN
leedIntLightProc(iResource) = leedIntLightProc(iResource) + collapsedEndUseSub(iResource,jEndUse,kEndUseSub)
ELSEIF (SameString(subCatName,'Cooking')) THEN
leedCook(iResource) = leedCook(iResource) + collapsedEndUseSub(iResource,jEndUse,kEndUseSub)
ELSEIF (SameString(subCatName,'Industrial Process')) THEN
leedIndProc(iResource) = leedIndProc(iResource) + collapsedEndUseSub(iResource,jEndUse,kEndUseSub)
ELSEIF (SameString(subCatName,'Elevators and Escalators')) THEN
leedElevEsc(iResource) = leedElevEsc(iResource) + collapsedEndUseSub(iResource,jEndUse,kEndUseSub)
END IF
END DO
END IF
END DO
END DO
unconvert = largeConversionFactor / 1000000000.d0 !to avoid double converting, the values for the LEED report should be in GJ
CALL PreDefTableEntry(pdchLeedPerfElEneUse,'Interior Lighting',unconvert * (useVal(3,colElectricity) &
- leedIntLightProc(colElectricity)),2)
CALL PreDefTableEntry(pdchLeedPerfElEneUse,'Exterior Lighting',unconvert * useVal(4,colElectricity),2)
CALL PreDefTableEntry(pdchLeedPerfElEneUse,'Space Heating',unconvert * useVal(1,colElectricity),2)
CALL PreDefTableEntry(pdchLeedPerfElEneUse,'Space Cooling',unconvert * useVal(2,colElectricity),2)
CALL PreDefTableEntry(pdchLeedPerfElEneUse,'Pumps',unconvert * useVal(8,colElectricity),2)
CALL PreDefTableEntry(pdchLeedPerfElEneUse,'Heat Rejection',unconvert * useVal(9,colElectricity),2)
CALL PreDefTableEntry(pdchLeedPerfElEneUse,'Fans-Interior',unconvert * (useVal(7,colElectricity) &
- leedFansParkFromFan(colElectricity)),2)
CALL PreDefTableEntry(pdchLeedPerfElEneUse,'Fans-Parking Garage',unconvert * (leedFansParkFromFan(colElectricity) &
+ leedFansParkFromExtFuelEquip(colElectricity)),2)
CALL PreDefTableEntry(pdchLeedPerfElEneUse,'Service Water Heating',unconvert * useVal(12,colElectricity),2)
CALL PreDefTableEntry(pdchLeedPerfElEneUse,'Receptacle Equipment',unconvert * useVal(5,colElectricity),2)
CALL PreDefTableEntry(pdchLeedPerfElEneUse,'Interior Lighting (process)',unconvert * leedIntLightProc(colElectricity),2)
CALL PreDefTableEntry(pdchLeedPerfElEneUse,'Refrigeration Equipment',unconvert * useVal(13,colElectricity),2)
CALL PreDefTableEntry(pdchLeedPerfElEneUse,'Cooking',unconvert * leedCook(colElectricity),2)
CALL PreDefTableEntry(pdchLeedPerfElEneUse,'Industrial Process',unconvert * leedIndProc(colElectricity),2)
CALL PreDefTableEntry(pdchLeedPerfElEneUse,'Elevators and Escalators',unconvert * leedElevEsc(colElectricity),2)
CALL PreDefTableEntry(pdchLeedPerfElEneUse,'Total Line',unconvert * useVal(15,colElectricity),2)
! Energy Use Intensities
IF (buildingGrossFloorArea .GT. 0) THEN
CALL PreDefTableEntry(pdchLeedEuiElec,'Interior Lighting',unconvert * 1000 * (useVal(3,colElectricity) &
- leedIntLightProc(colElectricity))/buildingGrossFloorArea,2)
CALL PreDefTableEntry(pdchLeedEuiElec,'Space Heating',unconvert * 1000 * useVal(1,colElectricity)/buildingGrossFloorArea,2)
CALL PreDefTableEntry(pdchLeedEuiElec,'Space Cooling',unconvert * 1000 * useVal(2,colElectricity)/buildingGrossFloorArea,2)
CALL PreDefTableEntry(pdchLeedEuiElec,'Fans-Interior',unconvert * 1000 * (useVal(7,colElectricity) &
- leedFansParkFromFan(colElectricity))/buildingGrossFloorArea,2)
CALL PreDefTableEntry(pdchLeedEuiElec,'Service Water Heating',unconvert * 1000 &
* useVal(12,colElectricity)/buildingGrossFloorArea,2)
CALL PreDefTableEntry(pdchLeedEuiElec,'Receptacle Equipment',unconvert * 1000 &
* useVal(5,colElectricity)/buildingGrossFloorArea,2)
nonMisc = useVal(3,colElectricity) - leedIntLightProc(colElectricity) &
+ useVal(1,colElectricity) + useVal(2,colElectricity) &
+ useVal(7,colElectricity) - leedFansParkFromFan(colElectricity) &
+ useVal(12,colElectricity) + useVal(5,colElectricity)
CALL PreDefTableEntry(pdchLeedEuiElec,'Miscellaneous',unconvert * 1000 * (useVal(15,colElectricity) - nonMisc) &
/ buildingGrossFloorArea,2)
CALL PreDefTableEntry(pdchLeedEuiElec,'Subtotal',unconvert * 1000 * useVal(15,colElectricity)/buildingGrossFloorArea,2)
END IF
CALL PreDefTableEntry(pdchLeedEusTotal,'Electricity',unconvert * useVal(15,colElectricity),2)
CALL PreDefTableEntry(pdchLeedEusProc,'Electricity',unconvert * (useVal(5,colElectricity) + useVal(13,colElectricity)),2)
IF (useVal(15,colElectricity) .NE. 0) THEN
processFraction = (useVal(5,colElectricity) + useVal(13,colElectricity))/useVal(15,colElectricity)
processElecCost = LEEDelecCostTotal * processFraction
ELSE
processElecCost = 0.0d0
END IF
CALL PreDefTableEntry(pdchLeedEcsProc,'Electricity',processElecCost,2)
CALL addFootNoteSubTable(pdstLeedEneCostSum,'Process energy cost based on ratio of process to total energy.')
CALL PreDefTableEntry(pdchLeedPerfGasEneUse,'Interior Lighting',unconvert * (useVal(3,colGas) - leedIntLightProc(colGas)),2)
CALL PreDefTableEntry(pdchLeedPerfGasEneUse,'Exterior Lighting',unconvert * useVal(4,colGas),2)
CALL PreDefTableEntry(pdchLeedPerfGasEneUse,'Space Heating',unconvert * useVal(1,colGas),2)
CALL PreDefTableEntry(pdchLeedPerfGasEneUse,'Space Cooling',unconvert * useVal(2,colGas),2)
CALL PreDefTableEntry(pdchLeedPerfGasEneUse,'Pumps',unconvert * useVal(8,colGas),2)
CALL PreDefTableEntry(pdchLeedPerfGasEneUse,'Heat Rejection',unconvert * useVal(9,colGas),2)
CALL PreDefTableEntry(pdchLeedPerfGasEneUse,'Fans-Interior',unconvert * (useVal(7,colGas)- leedFansParkFromFan(colGas)),2)
CALL PreDefTableEntry(pdchLeedPerfGasEneUse,'Fans-Parking Garage',unconvert * (leedFansParkFromFan(colGas) &
+ leedFansParkFromExtFuelEquip(colGas)),2)
CALL PreDefTableEntry(pdchLeedPerfGasEneUse,'Service Water Heating',unconvert * useVal(12,colGas),2)
CALL PreDefTableEntry(pdchLeedPerfGasEneUse,'Receptacle Equipment',unconvert * useVal(5,colGas),2)
CALL PreDefTableEntry(pdchLeedPerfGasEneUse,'Interior Lighting (process)',unconvert * leedIntLightProc(colGas),2)
CALL PreDefTableEntry(pdchLeedPerfGasEneUse,'Refrigeration Equipment',unconvert * useVal(13,colGas),2)
CALL PreDefTableEntry(pdchLeedPerfGasEneUse,'Cooking',unconvert * leedCook(colGas),2)
CALL PreDefTableEntry(pdchLeedPerfGasEneUse,'Industrial Process',unconvert * leedIndProc(colGas),2)
CALL PreDefTableEntry(pdchLeedPerfGasEneUse,'Elevators and Escalators',unconvert * leedElevEsc(colGas),2)
CALL PreDefTableEntry(pdchLeedPerfGasEneUse,'Total Line',unconvert * useVal(15,colGas),2)
! Energy Use Intensities
IF (buildingGrossFloorArea .GT. 0) THEN
CALL PreDefTableEntry(pdchLeedEuiNatG,'Space Heating',unconvert * 1000 * useVal(1,colGas)/buildingGrossFloorArea,2)
CALL PreDefTableEntry(pdchLeedEuiNatG,'Service Water Heating',unconvert * 1000 * useVal(12,colGas)/buildingGrossFloorArea,2)
nonMisc = useVal(1,colGas) + useVal(12,colGas)
CALL PreDefTableEntry(pdchLeedEuiNatG,'Miscellaneous',unconvert * 1000 * (useVal(15,colGas) - nonMisc) &
/ buildingGrossFloorArea,2)
CALL PreDefTableEntry(pdchLeedEuiNatG,'Subtotal',unconvert * 1000 * useVal(15,colGas)/buildingGrossFloorArea,2)
END IF
CALL PreDefTableEntry(pdchLeedEusTotal,'Natural Gas',unconvert * useVal(15,colGas),2)
CALL PreDefTableEntry(pdchLeedEusProc,'Natural Gas',unconvert * (useVal(5,colGas) + useVal(13,colGas)),2)
IF (useVal(15,colGas) .NE. 0) THEN
processFraction = (useVal(5,colGas) + useVal(13,colGas))/useVal(15,colGas)
processGasCost = LEEDgasCostTotal * processFraction
ELSE
processGasCost = 0.0d0
END IF
CALL PreDefTableEntry(pdchLeedEcsProc,'Natural Gas',processGasCost,2)
CALL PreDefTableEntry(pdchLeedPerfOthEneUse,'Interior Lighting',unconvert * &
(useVal(3,colAdditionalFuel) + useVal(3,colPurchCool) &
+ useVal(3,colPurchHeat) - (leedIntLightProc(colAdditionalFuel) &
+ leedIntLightProc(colPurchCool) + leedIntLightProc(colPurchHeat))) ,2)
CALL PreDefTableEntry(pdchLeedPerfOthEneUse,'Exterior Lighting',unconvert * &
(useVal(4,colAdditionalFuel) + useVal(4,colPurchCool) &
+ useVal(4,colPurchHeat)),2)
CALL PreDefTableEntry(pdchLeedPerfOthEneUse,'Space Heating',unconvert * (useVal(1,colAdditionalFuel) + useVal(1,colPurchCool) &
+ useVal(1,colPurchHeat)),2)
CALL PreDefTableEntry(pdchLeedPerfOthEneUse,'Space Cooling',unconvert * (useVal(2,colAdditionalFuel) + useVal(2,colPurchCool) &
+ useVal(2,colPurchHeat)),2)
CALL PreDefTableEntry(pdchLeedPerfOthEneUse,'Pumps',unconvert * (useVal(8,colAdditionalFuel) + useVal(8,colPurchCool) &
+ useVal(8,colPurchHeat)),2)
CALL PreDefTableEntry(pdchLeedPerfOthEneUse,'Heat Rejection',unconvert * (useVal(9,colAdditionalFuel) + useVal(9,colPurchCool) &
+ useVal(9,colPurchHeat)),2)
CALL PreDefTableEntry(pdchLeedPerfOthEneUse,'Fans-Interior',unconvert * (useVal(7,colAdditionalFuel) + useVal(7,colPurchCool) &
+ useVal(7,colPurchHeat) - (leedFansParkFromFan(colAdditionalFuel) &
+ leedFansParkFromFan(colPurchCool) + leedFansParkFromFan(colPurchHeat))),2)
CALL PreDefTableEntry(pdchLeedPerfOthEneUse,'Fans-Parking Garage',unconvert * (leedFansParkFromFan(colAdditionalFuel) &
+ leedFansParkFromFan(colPurchCool) + leedFansParkFromFan(colPurchHeat) &
+ leedFansParkFromExtFuelEquip(colAdditionalFuel) &
+ leedFansParkFromExtFuelEquip(colPurchCool) &
+ leedFansParkFromExtFuelEquip(colPurchHeat)),2)
CALL PreDefTableEntry(pdchLeedPerfOthEneUse,'Service Water Heating',unconvert * (useVal(12,colAdditionalFuel) &
+ useVal(12,colPurchCool) + useVal(12,colPurchHeat)),2)
CALL PreDefTableEntry(pdchLeedPerfOthEneUse,'Receptacle Equipment',unconvert * (useVal(5,colAdditionalFuel) &
+ useVal(5,colPurchCool) + useVal(5,colPurchHeat)),2)
CALL PreDefTableEntry(pdchLeedPerfOthEneUse,'Interior Lighting (process)',unconvert * (leedIntLightProc(colAdditionalFuel) &
+ leedIntLightProc(colPurchCool) + leedIntLightProc(colPurchHeat)),2)
CALL PreDefTableEntry(pdchLeedPerfOthEneUse,'Refrigeration Equipment',unconvert * (useVal(13,colAdditionalFuel) &
+ useVal(13,colPurchCool) + useVal(13,colPurchHeat)),2)
CALL PreDefTableEntry(pdchLeedPerfOthEneUse,'Cooking',unconvert * (leedCook(colAdditionalFuel) + leedCook(colPurchCool) &
+ leedCook(colPurchHeat)),2)
CALL PreDefTableEntry(pdchLeedPerfOthEneUse,'Industrial Process',unconvert * (leedIndProc(colAdditionalFuel) &
+ leedIndProc(colPurchCool) + leedIndProc(colPurchHeat)),2)
CALL PreDefTableEntry(pdchLeedPerfOthEneUse,'Elevators and Escalators',unconvert * (leedElevEsc(colAdditionalFuel) &
+ leedElevEsc(colPurchCool) + leedElevEsc(colPurchHeat)),2)
CALL PreDefTableEntry(pdchLeedPerfOthEneUse,'Total Line',unconvert * (useVal(15,colAdditionalFuel) + useVal(15,colPurchCool) &
+ useVal(15,colPurchHeat)),2)
! Energy Use Intensities
IF (buildingGrossFloorArea .GT. 0) THEN
CALL PreDefTableEntry(pdchLeedEuiOthr,'Miscellaneous',unconvert * 1000 * useVal(15,colAdditionalFuel)/buildingGrossFloorArea,2)
CALL PreDefTableEntry(pdchLeedEuiOthr,'Subtotal',unconvert * 1000 * useVal(15,colAdditionalFuel)/buildingGrossFloorArea,2)
END IF
CALL PreDefTableEntry(pdchLeedEusTotal,'Additional',unconvert * (useVal(15,colAdditionalFuel) + useVal(15,colPurchCool) &
+ useVal(15,colPurchHeat)),2)
CALL PreDefTableEntry(pdchLeedEusProc,'Additional',unconvert * (useVal(5,colAdditionalFuel) + useVal(13,colAdditionalFuel) &
+ useVal(5,colPurchCool) + useVal(13,colPurchCool) &
+ useVal(5,colPurchHeat) + useVal(13,colPurchHeat)) ,2)
IF ((useVal(15,colAdditionalFuel) + useVal(15,colPurchCool) + useVal(15,colPurchHeat)) .GT. 0.001d0) THEN
processFraction = (useVal(5,colAdditionalFuel) + useVal(13,colAdditionalFuel) &
+ useVal(5,colPurchCool) + useVal(13,colPurchCool) &
+ useVal(5,colPurchHeat) + useVal(13,colPurchHeat))&
/(useVal(15,colAdditionalFuel) + useVal(15,colPurchCool) + useVal(15,colPurchHeat))
ELSE
processFraction = 0.0d0
END IF
processOthrCost = LEEDothrCostTotal * processFraction
CALL PreDefTableEntry(pdchLeedEcsProc,'Additional',processOthrCost,2)
CALL PreDefTableEntry(pdchLeedEcsProc,'Total',processElecCost + processGasCost + processOthrCost,2)
! accumulate for percentage table
leedSiteIntLite = 0.0d0
leedSiteSpHeat = 0.0d0
leedSiteSpCool = 0.0d0
leedSiteFanInt = 0.0d0
leedSiteSrvWatr = 0.0d0
leedSiteRecept = 0.0d0
leedSiteTotal = 0.0d0
DO iResource = 1, 5 ! don't bother with water
leedSiteIntLite = leedSiteIntLite + useVal(3,iResource) - leedIntLightProc(iResource)
leedSiteSpHeat = leedSiteSpHeat + useVal(1,iResource)
leedSiteSpCool = leedSiteSpCool + useVal(2,iResource)
leedSiteFanInt = leedSiteFanInt + useVal(7,iResource) - leedFansParkFromFan(iResource)
leedSiteSrvWatr = leedSiteSrvWatr + useVal(12,iResource)
leedSiteRecept = leedSiteRecept + useVal(5,iResource)
leedSiteTotal = leedSiteTotal + useVal(15,iResource)
END DO
IF (leedSiteTotal .NE. 0) THEN
CALL PreDefTableEntry(pdchLeedEupPerc,'Interior Lighting',100 * leedSiteIntLite / leedSiteTotal,2)
CALL PreDefTableEntry(pdchLeedEupPerc,'Space Heating',100 * leedSiteSpHeat / leedSiteTotal,2)
CALL PreDefTableEntry(pdchLeedEupPerc,'Space Cooling',100 * leedSiteSpCool / leedSiteTotal,2)
CALL PreDefTableEntry(pdchLeedEupPerc,'Fans-Interior',100 * leedSiteFanInt / leedSiteTotal,2)
CALL PreDefTableEntry(pdchLeedEupPerc,'Service Water Heating',100 * leedSiteSrvWatr / leedSiteTotal,2)
CALL PreDefTableEntry(pdchLeedEupPerc,'Receptacle Equipment',100 * leedSiteRecept / leedSiteTotal,2)
CALL PreDefTableEntry(pdchLeedEupPerc,'Miscellaneous',100 * (leedSiteTotal &
- (leedSiteIntLite + leedSiteSpHeat + leedSiteSpCool + leedSiteFanInt + leedSiteSrvWatr + leedSiteRecept)) / leedSiteTotal,2)
END IF
!totals across energy source
CALL PreDefTableEntry(pdchLeedEusTotal,'Total',unconvert * (useVal(15,colAdditionalFuel) + useVal(15,colPurchCool) &
+ useVal(15,colPurchHeat) + useVal(15,colElectricity) + useVal(15,colGas)),2)
CALL PreDefTableEntry(pdchLeedEusProc,'Total',unconvert * (useVal(5,colAdditionalFuel) + useVal(13,colAdditionalFuel) &
+ useVal(5,colPurchCool) + useVal(13,colPurchCool) &
+ useVal(5,colPurchHeat) + useVal(13,colPurchHeat) &
+ useVal(5,colElectricity) + useVal(13,colElectricity) &
+ useVal(5,colGas) + useVal(13,colGas)),2)
footnote = ''
SELECT CASE (resourcePrimaryHeating)
CASE (colElectricity)
footnote = 'Note: Electricity appears to be the principal heating source based on energy usage. '
CALL PreDefTableEntry(pdchLeedGenData,'Principal Heating Source','Electricity')
CASE (colGas)
footnote = 'Note: Natural gas appears to be the principal heating source based on energy usage. '
CALL PreDefTableEntry(pdchLeedGenData,'Principal Heating Source','Natural Gas')
CASE (colAdditionalFuel)
footnote = 'Note: Additional fuel appears to be the principal heating source based on energy usage. '
CALL PreDefTableEntry(pdchLeedGenData,'Principal Heating Source','Additional Fuel')
CASE (colPurchHeat)
footnote = 'Note: District heat appears to be the principal heating source based on energy usage. '
CALL PreDefTableEntry(pdchLeedGenData,'Principal Heating Source','District Heat')
END SELECT
! heading for the entire sub-table
IF (displayTabularBEPS) THEN
CALL writeSubtitle('End Uses')
CALL writeTable(tableBody,rowHead,columnHead,columnWidth,.FALSE., footnote)
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
'AnnualBuildingUtilityPerformanceSummary',&
'Entire Facility',&
'End Uses')
ENDIF
DEALLOCATE(columnHead)
DEALLOCATE(rowHead)
DEALLOCATE(columnWidth)
DEALLOCATE(tableBody)
!
!---- End Uses By Subcategory Sub-Table
!
!determine if subcategories add up to the total and
!if not, determine the difference for the 'other' row
needOtherRow = .FALSE. !set array to all false assuming no other rows are needed
DO iResource = 1, 6
DO jEndUse = 1, NumEndUses
IF (EndUseCategory(jEndUse)%NumSubcategories > 0) THEN
!set the value to the total for the end use
endUseSubOther(jEndUse,iResource) = collapsedEndUse(jEndUse,iResource)
! subtract off each sub end use category value
DO kEndUseSub = 1, EndUseCategory(jEndUse)%NumSubcategories
endUseSubOther(jEndUse,iResource) = endUseSubOther(jEndUse,iResource) &
- collapsedEndUseSub(iResource,jEndUse,kEndUseSub)
END DO
!if just a small value remains set it to zero
IF (ABS(endUseSubOther(jEndUse,iResource)) .GT. 0.01d0) THEN
needOtherRow(jEndUse) = .TRUE.
ELSE
endUseSubOther(jEndUse,iResource) = 0.0d0
END IF
ELSE
endUseSubOther(jEndUse,iResource) = 0.0d0
END IF
END DO
END DO
!determine the number of rows needed for sub-table
numRows = 0
DO jEndUse = 1, NumEndUses
IF (EndUseCategory(jEndUse)%NumSubcategories > 0) THEN
DO kEndUseSub = 1, EndUseCategory(jEndUse)%NumSubcategories
numRows = numRows + 1
END DO
! check if an 'other' row is needed
IF (needOtherRow(jEndUse)) THEN
numRows = numRows + 1
END IF
ELSE
numRows = numRows + 1
END IF
END DO
ALLOCATE(rowHead(numRows))
ALLOCATE(columnHead(7))
ALLOCATE(columnWidth(7))
columnWidth = 14 !array assignment - same for all columns
ALLOCATE(tableBody(numRows,7))
rowHead = ''
tableBody = ''
! Build row head and subcategories columns
i = 1
DO jEndUse = 1, NumEndUses
rowHead(i) = EndUseCategory(jEndUse)%DisplayName
IF (EndUseCategory(jEndUse)%NumSubcategories > 0) THEN
DO kEndUseSub = 1, EndUseCategory(jEndUse)%NumSubcategories
tableBody(i,1) = EndUseCategory(jEndUse)%SubcategoryName(kEndUseSub)
i = i + 1
END DO
! check if an 'other' row is needed
IF (needOtherRow(jEndUse)) THEN
tableBody(i,1) = 'Other'
i = i + 1
END IF
ELSE
tableBody(i,1) = 'General'
i = i + 1
END IF
END DO
columnHead(1) = 'Subcategory'
SELECT CASE (unitsStyle)
CASE (unitsStyleJtoKWH)
columnHead(2) = 'Electricity [kWh]'
columnHead(3) = 'Natural Gas [kWh]'
columnHead(4) = 'Additional Fuel [kWh]'
columnHead(5) = 'District Cooling [kWh]'
columnHead(6) = 'District Heating [kWh]'
columnHead(7) = 'Water [m3]'
CASE (unitsStyleInchPound)
columnHead(2) = 'Electricity [kBtu]'
columnHead(3) = 'Natural Gas [kBtu]'
columnHead(4) = 'Additional Fuel [kBtu]'
columnHead(5) = 'District Cooling [kBtu]'
columnHead(6) = 'District Heating [kBtu]'
columnHead(7) = 'Water [gal]'
CASE DEFAULT
columnHead(2) = 'Electricity [GJ]'
columnHead(3) = 'Natural Gas [GJ]'
columnHead(4) = 'Additional Fuel [GJ]'
columnHead(5) = 'District Cooling [GJ]'
columnHead(6) = 'District Heating [GJ]'
columnHead(7) = 'Water [m3]'
END SELECT
DO iResource = 1, 6
i = 1
DO jEndUse = 1, NumEndUses
IF (EndUseCategory(jEndUse)%NumSubcategories > 0) THEN
DO kEndUseSub = 1, EndUseCategory(jEndUse)%NumSubcategories
tableBody(i,iResource+1) = TRIM(RealToStr(collapsedEndUseSub(iResource,jEndUse,kEndUseSub),2))
i = i + 1
END DO
!put other
IF (needOtherRow(jEndUse)) THEN
tableBody(i,iResource+1) = TRIM(RealToStr(endUseSubOther(jEndUse,iResource),2))
i = i + 1
END IF
ELSE
tableBody(i,iResource+1) = TRIM(RealToStr(collapsedEndUse(jEndUse,iResource),2))
i = i + 1
END IF
END DO
END DO
! heading for the entire sub-table
IF (displayTabularBEPS) THEN
CALL writeSubtitle('End Uses By Subcategory')
CALL writeTable(tableBody,rowHead,columnHead,columnWidth)
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
'AnnualBuildingUtilityPerformanceSummary',&
'Entire Facility',&
'End Uses By Subcategory')
ENDIF
DEALLOCATE(columnHead)
DEALLOCATE(rowHead)
DEALLOCATE(columnWidth)
DEALLOCATE(tableBody)
!
!---- Normalized by Conditioned Area Sub-Table
!
! Calculations for both normalized tables are first
ALLOCATE(rowHead(4))
ALLOCATE(columnHead(6))
ALLOCATE(columnWidth(6))
columnWidth = 14 !array assignment - same for all columns
ALLOCATE(tableBody(4,6))
DO iResource= 1,6
normalVal(1,iResource) = collapsedEndUse(endUseInteriorLights,iResource) & !Lights <- InteriorLights
+ collapsedEndUse(endUseExteriorLights,iResource) ! <- ExteriorLights
normalVal(2,iResource) = collapsedEndUse(endUseFans,iResource) & !HVAC <- fans
+ collapsedEndUse(endUsePumps,iResource) & ! <- pumps
+ collapsedEndUse(endUseHeating,iResource) & ! <- heating
+ collapsedEndUse(endUseCooling,iResource) & ! <- cooling
+ collapsedEndUse(endUseHeatRejection,iResource) & ! <- heat rejection
+ collapsedEndUse(endUseHumidification,iResource) & ! <- humidification
+ collapsedEndUse(endUseWaterSystem,iResource) ! <- water system domestic hot water
normalVal(3,iResource) = collapsedEndUse(endUseInteriorEquipment,iResource) & !Other <- InteriorEquipment
+ collapsedEndUse(endUseExteriorEquipment,iResource) & ! <- ExteriorEquipment
+ collapsedEndUse(endUseCogeneration,iResource) & ! <- generator fuel
+ collapsedEndUse(endUseHeatRecovery,iResource) & ! <- Heat Recovery (parasitics)
+ collapsedEndUse(endUseRefrigeration,iResource) ! <- Refrigeration
normalVal(4,iResource) = collapsedTotal(iResource) ! totals
END DO
! convert the normalized end use values to MJ from GJ if using J
DO iResource= 1,5 !not including resource=6 water
DO jEndUse=1,4
normalVal(jEndUse,iResource) = normalVal(jEndUse,iResource) * kConversionFactor
END DO
END DO
rowHead(1) = 'Lighting' !typo fixed 5-17-04 BTG
rowHead(2) = 'HVAC'
rowHead(3) = 'Other'
rowHead(4) = 'Total'
SELECT CASE (unitsStyle)
CASE (unitsStyleJtoKWH)
columnHead(1) = 'Electricity Intensity [kWh/m2]'
columnHead(2) = 'Natural Gas Intensity [kWh/m2]'
columnHead(3) = 'Additional Fuel Intensity [kWh/m2]'
columnHead(4) = 'District Cooling Intensity [kWh/m2]'
columnHead(5) = 'District Heating Intensity [kWh/m2]'
columnHead(6) = 'Water Intensity [m3/m2]'
CASE (unitsStyleInchPound)
columnHead(1) = 'Electricity Intensity [kBtu/ft2]'
columnHead(2) = 'Natural Gas Intensity [kBtu/ft2]'
columnHead(3) = 'Additional Fuel Intensity [kBtu/ft2]'
columnHead(4) = 'District Cooling Intensity [kBtu/ft2]'
columnHead(5) = 'District Heating Intensity [kBtu/ft2]'
columnHead(6) = 'Water Intensity [gal/ft2]'
CASE DEFAULT
columnHead(1) = 'Electricity Intensity [MJ/m2]'
columnHead(2) = 'Natural Gas Intensity [MJ/m2]'
columnHead(3) = 'Additional Fuel Intensity [MJ/m2]'
columnHead(4) = 'District Cooling Intensity [MJ/m2]'
columnHead(5) = 'District Heating Intensity [MJ/m2]'
columnHead(6) = 'Water Intensity [m3/m2]'
END SELECT
CALL writeTextLine('Normalized Metrics',.TRUE.)
! write the conditioned area based table
tableBody = ''
IF (convBldgCondFloorArea .GT. 0) THEN
DO iResource= 1,6
DO jEndUse=1,4
tableBody(jEndUse,iResource) = TRIM(RealToStr(normalVal(jEndUse,iResource) / convBldgCondFloorArea,2))
END DO
END DO
END IF
! heading for the entire sub-table
IF (displayTabularBEPS) THEN
CALL writeSubtitle('Utility Use Per Conditioned Floor Area')
CALL writeTable(tableBody,rowHead,columnHead,columnWidth)
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
'AnnualBuildingUtilityPerformanceSummary',&
'Entire Facility',&
'Utility Use Per Conditioned Floor Area')
ENDIF
!
!---- Normalized by Total Area Sub-Table
!
tableBody = ''
IF (convBldgGrossFloorArea .GT. 0) THEN
DO iResource= 1,6
DO jEndUse=1,4
tableBody(jEndUse,iResource) = TRIM(RealToStr(normalVal(jEndUse,iResource) / convBldgGrossFloorArea,2))
END DO
END DO
END IF
! heading for the entire sub-table
IF (displayTabularBEPS) THEN
CALL writeSubtitle('Utility Use Per Total Floor Area')
CALL writeTable(tableBody,rowHead,columnHead,columnWidth)
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
'AnnualBuildingUtilityPerformanceSummary',&
'Entire Facility',&
'Utility Use Per Total Floor Area')
ENDIF
DEALLOCATE(columnHead)
DEALLOCATE(rowHead)
DEALLOCATE(columnWidth)
DEALLOCATE(tableBody)
!
!---- Electric Loads Satisfied Sub-Table
!
ALLOCATE(rowHead(13))
ALLOCATE(columnHead(2))
ALLOCATE(columnWidth(2))
columnWidth = 14 !array assignment - same for all columns
ALLOCATE(tableBody(13,2))
SELECT CASE (unitsStyle)
CASE (unitsStyleJtoKWH)
columnHead(1) = 'Electricity [kWh]'
CASE (unitsStyleInchPound)
columnHead(1) = 'Electricity [kBtu]'
CASE DEFAULT
columnHead(1) = 'Electricity [GJ]'
END SELECT
columnHead(2) = 'Percent Electricity [%]'
rowHead(1) = 'Fuel-Fired Power Generation'
rowHead(2) = 'High Temperature Geothermal*'
rowHead(3) = 'Photovoltaic Power'
rowHead(4) = 'Wind Power'
rowHead(5) = 'Net Decrease in On-Site Storage'
rowHead(6) = 'Total On-Site Electric Sources'
rowHead(7) = ''
rowHead(8) = 'Electricity Coming From Utility'
rowHead(9) = 'Surplus Electricity Going To Utility'
rowHead(10) = 'Net Electricity From Utility'
rowHead(11) = ''
rowHead(12) = 'Total On-Site and Utility Electric Sources'
rowHead(13) = 'Total Electricity End Uses'
tableBody = ''
! show annual values
unconvert = largeConversionFactor / 1000000000.d0 !to avoid double converting, the values for the LEED report should be in GJ
tableBody(1,1) = TRIM(RealToStr(gatherPowerFuelFireGen,2))
tableBody(2,1) = TRIM(RealToStr(gatherPowerHTGeothermal,2))
tableBody(3,1) = TRIM(RealToStr(gatherPowerPV,2))
CALL PreDefTableEntry(pdchLeedRenAnGen,'Photovoltaic',unconvert * gatherPowerPV,2)
tableBody(4,1) = TRIM(RealToStr(gatherPowerWind,2))
CALL PreDefTableEntry(pdchLeedRenAnGen,'Wind',unconvert * gatherPowerWind,2)
tableBody(5,1) = TRIM(RealToStr(OverallNetEnergyFromStorage, 2 ))
tableBody(6,1) = TRIM(RealToStr(gatherElecProduced,2))
tableBody(8,1) = TRIM(RealToStr(gatherElecPurchased,2))
tableBody(9,1) = TRIM(RealToStr(gatherElecSurplusSold,2))
tableBody(10,1) = TRIM(RealToStr(gatherElecPurchased - gatherElecSurplusSold,2))
tableBody(12,1) = TRIM(RealToStr(gatherElecProduced + (gatherElecPurchased - gatherElecSurplusSold),2))
tableBody(13,1) = TRIM(RealToStr(collapsedTotal(1),2))
! show annual percentages
IF (collapsedTotal(1) .GT. 0) THEN
tableBody(1,2) = TRIM(RealToStr(100.0d0 * gatherPowerFuelFireGen / collapsedTotal(1),2))
tableBody(2,2) = TRIM(RealToStr(100.0d0 * gatherPowerHTGeothermal / collapsedTotal(1),2))
tableBody(3,2) = TRIM(RealToStr(100.0d0 * gatherPowerPV / collapsedTotal(1),2))
tableBody(4,2) = TRIM(RealToStr(100.0d0 * gatherPowerWind / collapsedTotal(1),2))
tableBody(5,2) = TRIM(RealToStr(100.0d0 * OverallNetEnergyFromStorage / collapsedTotal(1),2))
tableBody(6,2) = TRIM(RealToStr(100.0d0 * gatherElecProduced / collapsedTotal(1),2))
tableBody(8,2) = TRIM(RealToStr(100.0d0 * gatherElecPurchased / collapsedTotal(1),2))
tableBody(9,2) = TRIM(RealToStr(100.0d0 * gatherElecSurplusSold / collapsedTotal(1),2))
tableBody(10,2) = TRIM(RealToStr(100.0d0 * (gatherElecPurchased - gatherElecSurplusSold) / collapsedTotal(1),2))
tableBody(12,2) = TRIM(RealToStr(100.0d0 * (gatherElecProduced + (gatherElecPurchased - gatherElecSurplusSold)) / &
collapsedTotal(1),2))
tableBody(13,2) = TRIM(RealToStr(100.0d0,2))
END IF
! heading for the entire sub-table
IF (displayTabularBEPS) THEN
CALL writeSubtitle('Electric Loads Satisfied')
CALL writeTable(tableBody,rowHead,columnHead,columnWidth)
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
'AnnualBuildingUtilityPerformanceSummary',&
'Entire Facility',&
'Electric Loads Satisfied')
ENDIF
DEALLOCATE(columnHead)
DEALLOCATE(rowHead)
DEALLOCATE(columnWidth)
DEALLOCATE(tableBody)
!
!---- On-Site Thermal Sources Sub-Table
!
ALLOCATE(rowHead(7))
ALLOCATE(columnHead(2))
ALLOCATE(columnWidth(2))
columnWidth = 14 !array assignment - same for all columns
ALLOCATE(tableBody(7,2))
SELECT CASE (unitsStyle)
CASE (unitsStyleJtoKWH)
columnHead(1) = 'Heat [kWh]'
CASE (unitsStyleInchPound)
columnHead(1) = 'Heat [kBtu]'
CASE DEFAULT
columnHead(1) = 'Heat [GJ]'
END SELECT
columnHead(2) = 'Percent Heat [%]'
rowHead(1) = 'Water-Side Heat Recovery'
rowHead(2) = 'Air to Air Heat Recovery for Cooling'
rowHead(3) = 'Air to Air Heat Recovery for Heating'
rowHead(4) = 'High-Temperature Geothermal*'
rowHead(5) = 'Solar Water Thermal'
rowHead(6) = 'Solar Air Thermal'
rowHead(7) = 'Total On-Site Thermal Sources'
tableBody = ''
! convert to GJ
gatherWaterHeatRecovery = gatherWaterHeatRecovery / largeConversionFactor
gatherAirHeatRecoveryCool = gatherAirHeatRecoveryCool / largeConversionFactor
gatherAirHeatRecoveryHeat = gatherAirHeatRecoveryHeat / largeConversionFactor
gatherHeatHTGeothermal = gatherHeatHTGeothermal / largeConversionFactor
gatherHeatSolarWater = gatherHeatSolarWater / largeConversionFactor
gatherHeatSolarAir = gatherHeatSolarAir / largeConversionFactor
! determine total on site heat
totalOnsiteHeat = gatherWaterHeatRecovery &
+ gatherAirHeatRecoveryCool &
+ gatherAirHeatRecoveryHeat &
+ gatherHeatHTGeothermal &
+ gatherHeatSolarWater &
+ gatherHeatSolarAir
! show annual values
tableBody(1,1) = TRIM(RealToStr(gatherWaterHeatRecovery,2))
tableBody(2,1) = TRIM(RealToStr(gatherAirHeatRecoveryCool,2))
tableBody(3,1) = TRIM(RealToStr(gatherAirHeatRecoveryHeat,2))
tableBody(4,1) = TRIM(RealToStr(gatherHeatHTGeothermal,2))
tableBody(5,1) = TRIM(RealToStr(gatherHeatSolarWater,2))
tableBody(6,1) = TRIM(RealToStr(gatherHeatSolarAir,2))
tableBody(7,1) = TRIM(RealToStr(totalOnsiteHeat,2))
IF (totalOnsiteHeat .GT. 0) THEN
tableBody(1,2) = TRIM(RealToStr(100.0d0 * gatherWaterHeatRecovery / totalOnsiteHeat,2))
tableBody(2,2) = TRIM(RealToStr(100.0d0 * gatherAirHeatRecoveryCool / totalOnsiteHeat,2))
tableBody(3,2) = TRIM(RealToStr(100.0d0 * gatherAirHeatRecoveryHeat / totalOnsiteHeat,2))
tableBody(4,2) = TRIM(RealToStr(100.0d0 * gatherHeatHTGeothermal / totalOnsiteHeat,2))
tableBody(5,2) = TRIM(RealToStr(100.0d0 * gatherHeatSolarWater / totalOnsiteHeat,2))
tableBody(6,2) = TRIM(RealToStr(100.0d0 * gatherHeatSolarAir / totalOnsiteHeat,2))
tableBody(7,2) = TRIM(RealToStr(100.0d0,2))
END IF
! heading for the entire sub-table
IF (displayTabularBEPS) THEN
CALL writeSubtitle('On-Site Thermal Sources')
CALL writeTable(tableBody,rowHead,columnHead,columnWidth)
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
'AnnualBuildingUtilityPerformanceSummary',&
'Entire Facility',&
'On-Site Thermal Sources')
ENDIF
DEALLOCATE(columnHead)
DEALLOCATE(rowHead)
DEALLOCATE(columnWidth)
DEALLOCATE(tableBody)
!
!---- Water Loads Sub-Table
! As of 12/8/2003 decided to not include this sub-table to wait
! until water use is implemented in EnergyPlus before displaying
! the table. Implementing water end-uses makes sense for EnergyPlus
! but since they are not really implemented as of December 2003 the
! table would be all zeros. Recommendation to exclude this table
! for now made by Glazer and Crawley.
!
!Aug 2006, adding table in with implementation of water system, BGriffith
!
!
ALLOCATE(rowHead(13))
ALLOCATE(columnHead(2))
ALLOCATE(columnWidth(2))
columnWidth = 14 !array assignment - same for all columns
ALLOCATE(tableBody(13,2))
!
SELECT CASE (unitsStyle)
CASE (unitsStyleJtoKWH)
columnHead(1) = 'Water [m3]'
CASE (unitsStyleInchPound)
columnHead(1) = 'Water [gal]'
CASE DEFAULT
columnHead(1) = 'Water [m3]'
END SELECT
columnHead(2) = 'Percent Water [%]'
!
rowHead(1) = 'Rainwater Collection'
rowHead(2) = 'Condensate Collection'
rowHead(3) = 'Groundwater Well'
rowHead(4) = 'Total On Site Water Sources'
rowHead(5) = '-'
rowHead(6) = 'Initial Storage'
rowHead(7) = 'Final Storage'
rowHead(8) = 'Change in Storage'
rowHead(9) = '-'
rowHead(10) = 'Water Supplied by Utility'
rowHead(11) = '-'
rowHead(12) = 'Total On Site, Change in Storage, and Utility Water Sources'
rowHead(13) = 'Total Water End Uses'
!
tableBody = '-'
!
totalOnsiteWater = gatherRainWater + gatherCondensate + gatherWellwater
! ! show annual values
tableBody(1,1) = TRIM(RealToStr(gatherRainWater / waterConversionFactor ,2))
tableBody(2,1) = TRIM(RealToStr(gatherCondensate / waterConversionFactor,2))
tableBody(3,1) = TRIM(RealToStr(gatherWellwater / waterConversionFactor,2))
tableBody(4,1) = TRIM(RealToStr(totalOnsiteWater / waterConversionFactor,2))
IF (allocated(WaterStorage)) Then
initialStorage = sum(waterStorage%InitialVolume)
finalStorage = SUM(WaterSTorage%ThisTimeStepVolume)
StorageChange = initialStorage-finalStorage
else
initialStorage = 0.0d0
finalStorage = 0.0d0
StorageChange = 0.0d0
endif
tableBody(6,1) = TRIM(RealToStr(initialStorage / waterConversionFactor,2))
tableBody(7,1) = TRIM(RealToStr(finalStorage / waterConversionFactor,2))
tableBody(8,1) = TRIM(RealToStr(StorageChange / waterConversionFactor,2))
totalWater = totalOnsiteWater + gatherMains + StorageChange
tableBody(10,1) = TRIM(RealToStr(gatherMains / waterConversionFactor,2))
tableBody(12,1) = TRIM(RealToStr(totalWater / waterConversionFactor,2))
tableBody(13,1) = TRIM(RealToStr(gatherWaterEndUseTotal / waterConversionFactor,2))
!
IF (gatherWaterEndUseTotal .GT. 0) THEN
tableBody(1,2) = TRIM(RealToStr(100.0d0 * gatherRainWater / gatherWaterEndUseTotal,2))
tableBody(2,2) = TRIM(RealToStr(100.0d0 * gatherCondensate / gatherWaterEndUseTotal,2))
tableBody(3,2) = TRIM(RealToStr(100.0d0 * gatherWellwater / gatherWaterEndUseTotal,2))
tableBody(4,2) = TRIM(RealToStr(100.0d0 * totalOnsiteWater / gatherWaterEndUseTotal,2))
tableBody(6,2) = TRIM(RealToStr(100.0d0 * initialStorage/ gatherWaterEndUseTotal,2))
tableBody(7,2) = TRIM(RealToStr(100.0d0 * finalStorage / gatherWaterEndUseTotal,2))
tableBody(8,2) = TRIM(RealToStr(100.0d0 * StorageChange/ gatherWaterEndUseTotal,2))
tableBody(10,2) = TRIM(RealToStr(100.0d0 * gatherMains / gatherWaterEndUseTotal,2))
tableBody(12,2) = TRIM(RealToStr(100.0d0 * totalWater / gatherWaterEndUseTotal,2))
tableBody(13,2) = TRIM(RealToStr(100.0d0,2))
END IF
!
! ! heading for the entire sub-table
IF (displayTabularBEPS) THEN
CALL writeSubtitle('Water Source Summary')
CALL writeTable(tableBody,rowHead,columnHead,columnWidth)
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
'AnnualBuildingUtilityPerformanceSummary',&
'Entire Facility',&
'Water Source Summary')
ENDIF
!
DEALLOCATE(columnHead)
DEALLOCATE(rowHead)
DEALLOCATE(columnWidth)
DEALLOCATE(tableBody)
!
!---- Comfort and Setpoint Not Met Sub-Table
!
IF (displayTabularBEPS) THEN
ALLOCATE(rowHead(2))
ALLOCATE(columnHead(1))
ALLOCATE(columnWidth(1))
columnWidth = 14 !array assignment - same for all columns
ALLOCATE(tableBody(2,1))
CALL writeSubtitle('Setpoint Not Met Criteria')
curNameWithSIUnits = 'Degrees [deltaC]'
curNameAndUnits = curNameWithSIUnits
IF (unitsStyle .EQ. unitsStyleInchPound) THEN
CALL LookupSItoIP(curNameWithSIUnits, indexUnitConv, curNameAndUnits)
ENDIF
columnHead(1)=curNameAndUnits
rowHead(1) = 'Tolerance for Zone Heating Setpoint Not Met Time'
rowHead(2) = 'Tolerance for Zone Cooling Setpoint Not Met Time'
IF (unitsStyle .NE. unitsStyleInchPound) THEN
tableBody(1,1) = TRIM(RealToStr(abs(deviationFromSetPtThresholdHtg),2))
tableBody(2,1) = TRIM(RealToStr(deviationFromSetPtThresholdClg,2))
ELSE
tableBody(1,1) = TRIM(RealToStr(ConvertIPDelta(indexUnitConv,abs(deviationFromSetPtThresholdHtg)),2))
tableBody(2,1) = TRIM(RealToStr(ConvertIPDelta(indexUnitConv,deviationFromSetPtThresholdClg),2))
ENDIF
CALL writeTable(tableBody,rowHead,columnHead,columnWidth)
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
'AnnualBuildingUtilityPerformanceSummary',&
'Entire Facility',&
'Setpoint Not Met Criteria')
DEALLOCATE(columnHead)
DEALLOCATE(rowHead)
DEALLOCATE(columnWidth)
DEALLOCATE(tableBody)
ENDIF
ALLOCATE(rowHead(3))
ALLOCATE(columnHead(1))
ALLOCATE(columnWidth(1))
columnWidth = 14 !array assignment - same for all columns
ALLOCATE(tableBody(3,1))
IF (displayTabularBEPS) THEN
CALL writeSubtitle('Comfort and Setpoint Not Met Summary')
ENDIF
columnHead(1) = 'Facility [Hours]'
rowHead(1) = 'Time Setpoint Not Met During Occupied Heating'
rowHead(2) = 'Time Setpoint Not Met During Occupied Cooling'
rowHead(3) = 'Time Not Comfortable Based on Simple ASHRAE 55-2004'
tableBody(1,1) = TRIM(RealToStr(TotalNotMetHeatingOccupiedForABUPS,2))
tableBody(2,1) = TRIM(RealToStr(TotalNotMetCoolingOccupiedForABUPS,2))
CALL PreDefTableEntry(pdchLeedAmData,'Number of hours heating loads not met', &
TRIM(RealToStr(TotalNotMetHeatingOccupiedForABUPS,2)))
CALL PreDefTableEntry(pdchLeedAmData,'Number of hours cooling loads not met', &
TRIM(RealToStr(TotalNotMetCoolingOccupiedForABUPS,2)))
CALL PreDefTableEntry(pdchLeedAmData,'Number of hours not met',TRIM(RealToStr(TotalNotMetOccupiedForABUPS,2)))
tableBody(3,1) = TRIM(RealToStr(TotalTimeNotSimpleASH55EitherForABUPS,2))
IF (displayTabularBEPS) THEN
CALL writeTable(tableBody,rowHead,columnHead,columnWidth)
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
'AnnualBuildingUtilityPerformanceSummary',&
'Entire Facility',&
'Comfort and Setpoint Not Met Summary')
ENDIF
DEALLOCATE(columnHead)
DEALLOCATE(rowHead)
DEALLOCATE(columnWidth)
DEALLOCATE(tableBody)
!
!---- Control Summary Sub-Table
!
!
!---- End Notes
!
IF (displayTabularBEPS) THEN
CALL writeTextLine('Note 1: An asterisk (*) indicates that the feature is not yet implemented.')
ENDIF
!CALL writeTextLine('Note 2: The source energy conversion factors used are: ')
!CALL writeTextLine(' 1.05 for all fuels, 1 for district, and 3 for electricity.')
END IF
END SUBROUTINE WriteBEPSTable