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.
SUBROUTINE WriteTabularTariffReports
! SUBROUTINE INFORMATION:
! AUTHOR Jason Glazer of GARD Analytics, Inc.
! DATE WRITTEN July 2004
! MODIFIED January 2010, Kyle Benne
! Added SQLite output
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! METHODOLOGY EMPLOYED:
! REFERENCES:
! na
! USE STATEMENTS:
USE OutputReportTabular, ONLY: WriteReportHeaders, WriteSubtitle, WriteTable, RealToStr, writeTextLine, &
buildingGrossFloorArea, buildingConditionedFloorArea, DetermineBuildingFloorArea, &
LookupSItoIP, convertIP, unitsStyle, unitsStyleInchPound
USE SQLiteProcedures, ONLY: CreateSQLiteTabularDataRecords
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
INTEGER, EXTERNAL :: GetMeterIndex !an exteral subroutine
! 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
!other local variables
INTEGER :: elecFacilMeter
INTEGER :: gasFacilMeter
REAL(r64) :: elecTotalCost
REAL(r64) :: gasTotalCost
REAL(r64) :: otherTotalCost
REAL(r64) :: allTotalCost
CHARACTER(len=2000) :: outString !an arbitarilty long string
INTEGER :: curStep
INTEGER :: indexInChg
INTEGER :: iTariff
INTEGER :: kVar
INTEGER :: lStep
CHARACTER(len=MaxNameLength) :: SIunit = ''
INTEGER :: unitConvIndex = 0
REAL(r64) :: perAreaUnitConv = 0.0d0
CHARACTER(len=MaxNameLength) :: perAreaUnitName = ''
! compute floor area if no ABUPS
IF (buildingConditionedFloorArea == 0.0d0) THEN
CALL DetermineBuildingFloorArea
ENDIF
! do unit conversions if necessary
IF (unitsStyle .EQ. unitsStyleInchPound) THEN
SIunit = '[~~$~~/m2]'
CALL LookupSItoIP(SIunit, unitConvIndex, perAreaUnitName)
perAreaUnitConv = convertIP(unitConvIndex,1.0d0)
ELSE
perAreaUnitName = '[~~$~~/m2]'
perAreaUnitConv = 1.0d0
END IF
IF (numTariff .GT. 0) THEN
CALL DisplayString('Writing Tariff Reports')
econVar%isReported = .FALSE.
!CALL selectTariff moved to the end of computeTariff.
CALL showWarningsBasedOnTotal
!---------------------------------
! Economics Results Summary Report
!---------------------------------
CALL WriteReportHeaders('Economics Results Summary Report','Entire Facility',1)
elecFacilMeter = GetMeterIndex('ELECTRICITY:FACILITY')
gasFacilMeter = GetMeterIndex('GAS:FACILITY')
!
!---- Annual Summary
!
ALLOCATE(rowHead(3))
ALLOCATE(columnHead(4))
ALLOCATE(columnWidth(4))
ALLOCATE(tableBody(3,4))
tableBody = ''
columnHead(1) = 'Electric'
columnHead(2) = 'Gas'
columnHead(3) = 'Other'
columnHead(4) = 'Total'
rowHead(1) = 'Cost [~~$~~]'
rowHead(2) = 'Cost per Total Building Area ' // TRIM(perAreaUnitName)
rowHead(3) = 'Cost per Net Conditioned Building Area ' // TRIM(perAreaUnitName)
elecTotalCost = 0.0d0
gasTotalCost = 0.0d0
otherTotalCost = 0.0d0
allTotalCost = 0.0d0
DO iTariff = 1, numTariff
IF (tariff(iTariff)%isSelected) THEN
allTotalCost = allTotalCost + tariff(iTariff)%totalAnnualCost
IF (tariff(iTariff)%kindElectricMtr .GE. kindMeterElecSimple) THEN
elecTotalCost = elecTotalCost + tariff(iTariff)%totalAnnualCost
ELSE IF (tariff(iTariff)%reportMeterIndx .EQ. gasFacilMeter) THEN
gasTotalCost = gasTotalCost + tariff(iTariff)%totalAnnualCost
ELSE
otherTotalCost = otherTotalCost + tariff(iTariff)%totalAnnualCost
! removed because this was confusing columnHead(3) = tariff(iTariff)%reportMeter
END IF
END IF
END DO
tableBody(1,1) = TRIM(RealToStr(elecTotalCost,2))
tableBody(1,2) = TRIM(RealToStr(gasTotalCost,2))
tableBody(1,3) = TRIM(RealToStr(otherTotalCost,2))
tableBody(1,4) = TRIM(RealToStr(allTotalCost,2))
If (buildingGrossFloorArea > 0.0d0) then
tableBody(2,1) = TRIM(RealToStr((elecTotalCost/buildingGrossFloorArea) * perAreaUnitConv, 2))
tableBody(2,2) = TRIM(RealToStr((gasTotalCost/buildingGrossFloorArea) * perAreaUnitConv,2))
tableBody(2,3) = TRIM(RealToStr((otherTotalCost/buildingGrossFloorArea) * perAreaUnitConv,2))
tableBody(2,4) = TRIM(RealToStr((allTotalCost/buildingGrossFloorArea) * perAreaUnitConv,2))
endif
IF (buildingConditionedFloorArea > 0.0d0) THEN
tableBody(3,1) = TRIM(RealToStr((elecTotalCost/buildingConditionedFloorArea) * perAreaUnitConv, 2))
tableBody(3,2) = TRIM(RealToStr((gasTotalCost/buildingConditionedFloorArea) * perAreaUnitConv,2))
tableBody(3,3) = TRIM(RealToStr((otherTotalCost/buildingConditionedFloorArea) * perAreaUnitConv,2))
tableBody(3,4) = TRIM(RealToStr((allTotalCost/buildingConditionedFloorArea) * perAreaUnitConv,2))
ENDIF
columnWidth = 14 !array assignment - same for all columns
CALL WriteSubtitle('Annual Cost')
CALL writeTable(tableBody,rowHead,columnHead,columnWidth)
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
'Economics Results Summary Report',&
'Entire Facility',&
'Annual Cost')
DEALLOCATE(columnHead)
DEALLOCATE(rowHead)
DEALLOCATE(columnWidth)
DEALLOCATE(tableBody)
!
!---- Tariff Summary
!
ALLOCATE(rowHead(numTariff))
ALLOCATE(columnHead(6))
ALLOCATE(columnWidth(6))
ALLOCATE(tableBody(numTariff,6))
tableBody = ''
columnHead(1) = 'Selected'
columnHead(2) = 'Qualified'
columnHead(3) = 'Meter'
columnHead(4) = 'Buy or Sell'
columnHead(5) = 'Group'
columnHead(6) = 'Annual Cost (~~$~~)'
DO iTariff = 1, numTariff
rowHead(iTariff) = tariff(iTariff)%tariffName
IF (tariff(iTariff)%isSelected) THEN
tableBody(iTariff,1) = 'Yes'
ELSE
tableBody(iTariff,1) = 'No'
END IF
IF (tariff(iTariff)%isQualified) THEN
tableBody(iTariff,2) = 'Yes'
ELSE
tableBody(iTariff,2) = 'No'
END IF
tableBody(iTariff,3) = tariff(iTariff)%reportMeter
SELECT CASE (tariff(iTariff)%buyOrSell)
CASE (buyFromUtility)
tableBody(iTariff,4) = 'Buy'
CASE (sellToUtility)
tableBody(iTariff,4) = 'Sell'
CASE (netMetering)
tableBody(iTariff,4) = 'Net'
END SELECT
IF (tariff(iTariff)%groupName .EQ. '') THEN
tableBody(iTariff,5) = '(none)'
ELSE
tableBody(iTariff,5) = tariff(iTariff)%groupName
END IF
tableBody(iTariff,6) = TRIM(RealToStr(tariff(iTariff)%totalAnnualCost,2))
END DO
columnWidth = 14 !array assignment - same for all columns
CALL WriteSubtitle('Tariff Summary')
CALL writeTable(tableBody,rowHead,columnHead,columnWidth)
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
'Economics Results Summary Report',&
'Entire Facility',&
'Tariff Summary')
DEALLOCATE(columnHead)
DEALLOCATE(rowHead)
DEALLOCATE(columnWidth)
DEALLOCATE(tableBody)
!---------------------------------
! Tariff Report
!---------------------------------
DO iTariff = 1, numTariff
CALL WriteReportHeaders('Tariff Report',tariff(iTariff)%tariffName,1)
ALLOCATE(rowHead(7))
ALLOCATE(columnHead(1))
ALLOCATE(columnWidth(1))
ALLOCATE(tableBody(7,1))
tableBody = ''
columnHead(1) = 'Parameter'
rowHead(1) = 'Meter'
rowHead(2) = 'Selected'
rowHead(3) = 'Group'
rowHead(4) = 'Qualified'
rowHead(5) = 'Disqualifier'
rowHead(6) = 'Computation'
rowHead(7) = 'Units'
tableBody(1,1) = tariff(iTariff)%reportMeter
IF (tariff(iTariff)%isSelected) THEN
tableBody(2,1) = 'Yes'
ELSE
tableBody(2,1) = 'No'
END IF
IF (tariff(iTariff)%groupName .EQ. '') THEN
tableBody(3,1) = '(none)'
ELSE
tableBody(3,1) = tariff(iTariff)%groupName
END IF
IF (tariff(iTariff)%isQualified) THEN
tableBody(4,1) = 'Yes'
ELSE
tableBody(4,1) = 'No'
END IF
IF (tariff(iTariff)%isQualified) THEN
tableBody(5,1) = 'n/a'
ELSE
tableBody(5,1) = econVar(tariff(iTariff)%ptDisqualifier)%name
END IF
IF (computation(iTariff)%isUserDef) THEN
tableBody(6,1) = computation(iTariff)%computeName
ELSE
tableBody(6,1) = 'automatic'
END IF
SELECT CASE (tariff(iTariff)%convChoice)
CASE (conversionUSERDEF)
tableBody(7,1) = 'User Defined'
CASE (conversionKWH)
tableBody(7,1) = 'kWh'
CASE (conversionTHERM)
tableBody(7,1) = 'Therm'
CASE (conversionMMBTU)
tableBody(7,1) = 'MMBtu'
CASE (conversionMJ)
tableBody(7,1) = 'MJ'
CASE (conversionKBTU)
tableBody(7,1) = 'kBtu'
CASE (conversionMCF)
tableBody(7,1) = 'MCF'
CASE (conversionCCF)
tableBody(7,1) = 'CCF'
END SELECT
columnWidth = 14 !array assignment - same for all columns
CALL WriteSubtitle('General')
CALL writeTable(tableBody,rowHead,columnHead,columnWidth)
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
'Tariff Report',&
tariff(iTariff)%tariffName,&
'General')
DEALLOCATE(columnHead)
DEALLOCATE(rowHead)
DEALLOCATE(columnWidth)
DEALLOCATE(tableBody)
!
!---- Categories
!
econVar%activeNow = .FALSE.
econVar(tariff(iTariff)%ptEnergyCharges)%activeNow = .TRUE.
econVar(tariff(iTariff)%ptDemandCharges)%activeNow = .TRUE.
econVar(tariff(iTariff)%ptServiceCharges)%activeNow = .TRUE.
econVar(tariff(iTariff)%ptBasis)%activeNow = .TRUE.
econVar(tariff(iTariff)%ptAdjustment)%activeNow = .TRUE.
econVar(tariff(iTariff)%ptSurcharge)%activeNow = .TRUE.
econVar(tariff(iTariff)%ptSubtotal)%activeNow = .TRUE.
econVar(tariff(iTariff)%ptTaxes)%activeNow = .TRUE.
econVar(tariff(iTariff)%ptTotal)%activeNow = .TRUE.
CALL ReportEconomicVariable('Categories',.FALSE.,.TRUE.,tariff(iTariff)%tariffName)
!
!---- Charges
!
econVar%activeNow = .FALSE.
DO kVar = 1,numEconVar
IF (econVar(kVar)%tariffIndx .EQ. iTariff) THEN
IF ((econVar(kVar)%kindOfObj .EQ. kindChargeSimple) .OR. (econVar(kVar)%kindOfObj .EQ. kindChargeBlock)) THEN
econVar(kVar)%activeNow = .TRUE.
END IF
END IF
END DO
CALL ReportEconomicVariable('Charges',.TRUE.,.TRUE.,tariff(iTariff)%tariffName)
!
!---- Sources for Charges
!
econVar%activeNow = .FALSE.
DO kVar = 1,numEconVar
IF (econVar(kVar)%tariffIndx .EQ. iTariff) THEN
indexInChg = econVar(kVar)%index
IF (econVar(kVar)%kindOfObj .EQ. kindChargeSimple) THEN
IF (chargeSimple(indexInChg)%sourcePt .GT. 0) THEN
econVar(chargeSimple(indexInChg)%sourcePt)%activeNow = .TRUE.
END IF
ELSE IF (econVar(kVar)%kindOfObj .EQ. kindChargeBlock) THEN
IF (chargeBlock(indexInChg)%sourcePt .GT. 0) THEN
econVar(chargeBlock(indexInChg)%sourcePt)%activeNow = .TRUE.
END IF
END IF
END IF
END DO
CALL ReportEconomicVariable('Corresponding Sources for Charges',.FALSE.,.FALSE.,tariff(iTariff)%tariffName)
!
!---- Rachets
!
econVar%activeNow = .FALSE.
DO kVar = 1,numEconVar
IF (econVar(kVar)%tariffIndx .EQ. iTariff) THEN
IF (econVar(kVar)%kindOfObj .EQ. kindRatchet) THEN
econVar(kVar)%activeNow = .TRUE.
END IF
END IF
END DO
CALL ReportEconomicVariable('Ratchets',.FALSE.,.FALSE.,tariff(iTariff)%tariffName)
!
!---- Qualifies
!
econVar%activeNow = .FALSE.
DO kVar = 1,numEconVar
IF (econVar(kVar)%tariffIndx .EQ. iTariff) THEN
IF (econVar(kVar)%kindOfObj .EQ. kindQualify) THEN
econVar(kVar)%activeNow = .TRUE.
END IF
END IF
END DO
CALL ReportEconomicVariable('Qualifies',.FALSE.,.FALSE.,tariff(iTariff)%tariffName)
!
!---- Native Variables
!
econVar%activeNow = .FALSE.
DO kVar = tariff(iTariff)%firstNative,tariff(iTariff)%lastNative
econVar(kVar)%activeNow = .TRUE.
END DO
CALL ReportEconomicVariable('Native Variables',.FALSE.,.FALSE.,tariff(iTariff)%tariffName)
!
!---- Other Variables
!
econVar%activeNow = .FALSE.
DO kVar = 1,numEconVar
IF (econVar(kVar)%tariffIndx .EQ. iTariff) THEN
IF (.NOT. econVar(kVar)%isReported) THEN
econVar(kVar)%activeNow = .TRUE.
END IF
END IF
END DO
CALL ReportEconomicVariable('Other Variables',.FALSE.,.FALSE.,tariff(iTariff)%tariffName)
!
!---- Computation
!
IF (computation(iTariff)%isUserDef) THEN
CALL writeTextLine('Computation - User Defined',.TRUE.)
ELSE
CALL writeTextLine('Computation - Automatic',.TRUE.)
END IF
outString = ''
DO lStep = computation(iTariff)%firstStep,computation(iTariff)%lastStep
curStep = steps(lStep)
SELECT CASE (curStep)
CASE (0) !end of line
CALL writeTextLine(outString)
outString = ''
CASE (1:) !all positive values are a reference to an econVar
outString = TRIM(econVar(curStep)%name) // ' ' // TRIM(outString)
CASE (opSUM)
outString = 'SUM ' // TRIM(outString)
CASE (opMULTIPLY)
outString = 'MULTIPLY ' // TRIM(outString)
CASE (opSUBTRACT)
outString = 'SUBTRACT ' // TRIM(outString)
CASE (opDIVIDE)
outString = 'DIVIDE ' // TRIM(outString)
CASE (opABSOLUTE)
outString = 'ABSOLUTE ' // TRIM(outString)
CASE (opINTEGER)
outString = 'INTEGER ' // TRIM(outString)
CASE (opSIGN)
outString = 'SIGN ' // TRIM(outString)
CASE (opROUND)
outString = 'ROUND ' // TRIM(outString)
CASE (opMAXIMUM)
outString = 'MAXIMUM ' // TRIM(outString)
CASE (opMINIMUM)
outString = 'MINIMUM ' // TRIM(outString)
CASE (opEXCEEDS)
outString = 'EXCEEDS ' // TRIM(outString)
CASE (opANNUALMINIMUM)
outString = 'ANNUALMINIMUM ' // TRIM(outString)
CASE (opANNUALMAXIMUM)
outString = 'ANNUALMAXIMUM ' // TRIM(outString)
CASE (opANNUALSUM)
outString = 'ANNUALSUM ' // TRIM(outString)
CASE (opANNUALAVERAGE)
outString = 'ANNUALAVERAGE ' // TRIM(outString)
CASE (opANNUALOR)
outString = 'ANNUALOR ' // TRIM(outString)
CASE (opANNUALAND)
outString = 'ANNUALAND ' // TRIM(outString)
CASE (opANNUALMAXIMUMZERO)
outString = 'ANNUALMAXIMUMZERO ' // TRIM(outString)
CASE (opANNUALMINIMUMZERO)
outString = 'ANNUALMINIMUMZERO ' // TRIM(outString)
CASE (opIF)
outString = 'IF ' // TRIM(outString)
CASE (opGREATERTHAN)
outString = 'GREATERTHAN ' // TRIM(outString)
CASE (opGREATEREQUAL)
outString = 'GREATEREQUAL ' // TRIM(outString)
CASE (opLESSTHAN)
outString = 'LESSTHAN ' // TRIM(outString)
CASE (opLESSEQUAL)
outString = 'LESSEQUAL ' // TRIM(outString)
CASE (opEQUAL)
outString = 'EQUAL ' // TRIM(outString)
CASE (opNOTEQUAL)
outString = 'NOTEQUAL ' // TRIM(outString)
CASE (opAND)
outString = 'AND ' // TRIM(outString)
CASE (opOR)
outString = 'OR ' // TRIM(outString)
CASE (opNOT)
outString = 'NOT ' // TRIM(outString)
CASE (opADD)
outString = 'ADD ' // TRIM(outString)
CASE (opNOOP) !should clear the outString when done debugging
!outString = ''
outString = 'FROM ' // TRIM(outString)
END SELECT
END DO
END DO
END IF
END SUBROUTINE WriteTabularTariffReports