Nodes of different colours represent the following:
Solid arrows point from a parent (sub)module to the submodule which is descended from it. Dashed arrows point from a module being used to the module or program unit using it. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
SUBROUTINE WriteSourceEnergyEndUseSummary
! SUBROUTINE INFORMATION:
! AUTHOR Mangesh Basarkar
! DATE WRITTEN September 2011
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Take the gathered total and end use source energy 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.
! REFERENCES:
! na
! USE STATEMENTS:
USE OutputProcessor, ONLY: MaxNumSubcategories, EndUseCategory
USE SQLiteProcedures, ONLY: CreateSQLiteTabularDataRecords
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! 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(6) :: collapsedTotal
REAL(r64),DIMENSION(numEndUses,6) :: collapsedEndUse
REAL(r64),DIMENSION(6,numEndUses,MaxNumSubcategories) :: collapsedEndUseSub
REAL(r64) :: totalSourceEnergyUse
INTEGER :: iResource
INTEGER :: jEndUse
INTEGER :: kEndUseSub
INTEGER :: i
REAL(r64) :: largeConversionFactor
INTEGER :: numRows
CHARACTER(len=100) :: footnote = ' '
REAL(r64) :: areaConversionFactor
REAL(r64) :: convBldgGrossFloorArea
REAL(r64) :: convBldgCondFloorArea
CHARACTER(len=MaxNameLength) :: curNameWithSIUnits
CHARACTER(len=MaxNameLength) :: curNameAndUnits
INTEGER :: indexUnitConv
IF (displaySourceEnergyEndUseSummary) THEN
! show the headers of the report
CALL WriteReportHeaders('Source Energy End Use Components 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.)
! determine building floor areas
CALL DetermineBuildingFloorArea
! collapse the gatherEndUseBEPS array to the resource groups displayed
DO jEndUse=1,numEndUses
collapsedEndUse(jEndUse,1) = gatherEndUseBySourceBEPS(jEndUse,1) !electricity
collapsedEndUse(jEndUse,2) = gatherEndUseBySourceBEPS(jEndUse,2) !natural gas
collapsedEndUse(jEndUse,3) = gatherEndUseBySourceBEPS(jEndUse,6) & !Additional fuel <- gasoline
+ gatherEndUseBySourceBEPS(jEndUse,8) & ! <- diesel
+ gatherEndUseBySourceBEPS(jEndUse,9) & ! <- coal
+ gatherEndUseBySourceBEPS(jEndUse,10) & ! <- fuel oil #1
+ gatherEndUseBySourceBEPS(jEndUse,11) & ! <- fuel oil #2
+ gatherEndUseBySourceBEPS(jEndUse,12) & ! <- propane
+ gatherEndUseBySourceBEPS(jEndUse,13) & ! <- otherfuel1
+ gatherEndUseBySourceBEPS(jEndUse,14) ! <- otherfuel2
collapsedEndUse(jEndUse,4) = gatherEndUseBySourceBEPS(jEndUse,3) !district cooling <- purchased cooling
collapsedEndUse(jEndUse,5) = gatherEndUseBySourceBEPS(jEndUse,4) & !district heating <- purchased heating
+ gatherEndUseBySourceBEPS(jEndUse,5) ! <- steam
collapsedEndUse(jEndUse,6) = gatherEndUseBySourceBEPS(jEndUse,7) !water
END DO
! repeat with totals
collapsedTotal(1) = gatherTotalsBySourceBEPS(1) !electricity
collapsedTotal(2) = gatherTotalsBySourceBEPS(2) !natural gas
collapsedTotal(3) = gatherTotalsBySourceBEPS(6) & !Additional fuel <- gasoline
+ gatherTotalsBySourceBEPS(8) & ! <- diesel
+ gatherTotalsBySourceBEPS(9) & ! <- coal
+ gatherTotalsBySourceBEPS(10) & ! <- fuel oil #1
+ gatherTotalsBySourceBEPS(11) & ! <- fuel oil #2
+ gatherTotalsBySourceBEPS(12) & ! <- propane
+ gatherTotalsBySourceBEPS(13) & ! <- otherfuel1
+ gatherTotalsBySourceBEPS(14) ! <- otherfuel2
collapsedTotal(4) = gatherTotalsBySourceBEPS(3) !district cooling <- purchased cooling
collapsedTotal(5) = gatherTotalsBySourceBEPS(4) & !district heating <- purchased heating
+ gatherTotalsBySourceBEPS(5) ! <- steam
collapsedTotal(6) = gatherTotalsBySourceBEPS(7) !water
! unit conversion - all values are used as divisors
SELECT CASE (unitsStyle)
CASE (unitsStyleJtoKWH)
largeConversionFactor = 3600000.d0
areaConversionFactor = 1.0d0
CASE (unitsStyleInchPound)
largeConversionFactor = getSpecificUnitDivider('J','kBtu') !1054351.84 J to kBtu
areaConversionFactor = getSpecificUnitDivider('m2','ft2') !0.092893973 m2 to ft2
CASE DEFAULT
largeConversionFactor = 1000000.d0 ! to MJ
areaConversionFactor = 1.0d0
END SELECT
! convert floor areas
convBldgCondFloorArea = buildingConditionedFloorArea / areaConversionFactor
!convert units into MJ (divide by 1,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
END DO
collapsedTotal(iResource) = collapsedTotal(iResource) / largeConversionFactor
END DO
ALLOCATE(rowHead(16))
ALLOCATE(columnHead(5))
ALLOCATE(columnWidth(5))
columnWidth = 14 !array assignment - same for all columns
ALLOCATE(tableBody(16,5))
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 Source Energy End Use Components'
largeConversionFactor = 1.0d0
SELECT CASE (unitsStyle)
CASE (unitsStyleJtoKWH)
columnHead(1) = 'Source Electricity [kWh]'
columnHead(2) = 'Source Natural Gas [kWh]'
columnHead(3) = 'Source Additional Fuel [kWh]'
columnHead(4) = 'Source District Cooling [kWh]'
columnHead(5) = 'Source District Heating [kWh]'
CASE (unitsStyleInchPound)
columnHead(1) = 'Source Electricity [kBtu]'
columnHead(2) = 'Source Natural Gas [kBtu]'
columnHead(3) = 'Source Additional Fuel [kBtu]'
columnHead(4) = 'Source District Cooling [kBtu]'
columnHead(5) = 'Source District Heating [kBtu]'
CASE DEFAULT
columnHead(1) = 'Source Electricity [GJ]'
columnHead(2) = 'Source Natural Gas [GJ]'
columnHead(3) = 'Source Additional Fuel [GJ]'
columnHead(4) = 'Source District Cooling [GJ]'
columnHead(5) = 'Source District Heating [GJ]'
largeConversionFactor = 1000.d0 ! for converting MJ to GJ
END SELECT
!
!---- End Uses by Source Energy Sub-Table
!
tableBody = ''
DO iResource= 1,5
DO jEndUse=1,14
tableBody(jEndUse,iResource) = TRIM(RealToStr(useVal(jEndUse,iResource) / largeConversionFactor,2))
END DO
tableBody(16,iResource) = TRIM(RealToStr(useVal(15,iResource) / largeConversionFactor,2))
END DO
! heading for the entire sub-table
CALL writeSubtitle('Source Energy End Use Components Summary')
CALL writeTable(tableBody,rowHead,columnHead,columnWidth)
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
'SourceEnergyEndUseComponentsSummary',&
'Entire Facility',&
'Source Energy End Use Components Summary')
!
!---- Normalized by Conditioned Area Sub-Table
!
SELECT CASE (unitsStyle)
CASE (unitsStyleJtoKWH)
columnHead(1) = 'Source Electricity [kWh/m2]'
columnHead(2) = 'Source Natural Gas [kWh/m2]'
columnHead(3) = 'Source Additional Fuel [kWh/m2]'
columnHead(4) = 'Source District Cooling [kWh/m2]'
columnHead(5) = 'Source District Heating [kWh/m2]'
CASE (unitsStyleInchPound)
columnHead(1) = 'Source Electricity [kBtu/ft2]'
columnHead(2) = 'Source Natural Gas [kBtu/ft2]'
columnHead(3) = 'Source Additional Fuel [kBtu/ft2]'
columnHead(4) = 'Source District Cooling [kBtu/ft2]'
columnHead(5) = 'Source District Heating [kBtu/ft2]'
CASE DEFAULT
columnHead(1) = 'Source Electricity [MJ/m2]'
columnHead(2) = 'Source Natural Gas [MJ/m2]'
columnHead(3) = 'Source Additional Fuel [MJ/m2]'
columnHead(4) = 'Source District Cooling [MJ/m2]'
columnHead(5) = 'Source District Heating [MJ/m2]'
END SELECT
tableBody = ''
IF (convBldgCondFloorArea .GT. 0) THEN
DO iResource= 1,5
DO jEndUse=1,14
tableBody(jEndUse,iResource) = TRIM(RealToStr(useVal(jEndUse,iResource) / convBldgCondFloorArea,2))
END DO
tableBody(16,iResource) = TRIM(RealToStr(useVal(15,iResource) / convBldgCondFloorArea,2))
END DO
END IF
CALL writeTextLine('Normalized Metrics',.TRUE.)
! heading for the entire sub-table
CALL writeSubtitle('Source Energy End Use Components Per Conditioned Floor Area')
CALL writeTable(tableBody,rowHead,columnHead,columnWidth)
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
'SourceEnergyEndUseComponentsSummary',&
'Entire Facility',&
'Source Energy End Use Component Per Conditioned Floor Area')
!
!---- Normalized by Total Area Sub-Table
!
tableBody = ''
IF (convBldgCondFloorArea .GT. 0) THEN
DO iResource= 1,5
DO jEndUse=1,14
tableBody(jEndUse,iResource) = TRIM(RealToStr(useVal(jEndUse,iResource) / convBldgCondFloorArea,2))
END DO
tableBody(16,iResource) = TRIM(RealToStr(useVal(15,iResource) / convBldgCondFloorArea,2))
END DO
END IF
! heading for the entire sub-table
CALL writeSubtitle('Source Energy End Use Components Per Total Floor Area')
CALL writeTable(tableBody,rowHead,columnHead,columnWidth)
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
'SourceEnergyEndUseComponentsSummary',&
'Entire Facility',&
'Source Energy End Use Components Per Total Floor Area')
DEALLOCATE(columnHead)
DEALLOCATE(rowHead)
DEALLOCATE(columnWidth)
DEALLOCATE(tableBody)
END IF
END SUBROUTINE WriteSourceEnergyEndUseSummary