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 CreateDefaultComputation
! SUBROUTINE INFORMATION:
! AUTHOR Jason Glazer of GARD Analytics, Inc.
! DATE WRITTEN June 2004
! MODIFIED na
! RE-ENGINEERED na
!
! PURPOSE OF THIS SUBROUTINE:
! For most tariffs defined in EnergyPlus no specific
! ECONOMICS:COMPUTATION will be entered. In that case,
! a default sequence of computation steps needs to be
! created. This routine creates the default
! computation steps.
!
! Object Fields Depend On Fields
!
! Qualify namePt sourcePt
! thresholdPt
!
! Charge:Simple namePt sourcePt
! categoryPt costPerPt
!
! Charge:Block namePt sourcePt
! categoryPt blkSzMultPt
! remainingPt blkSzPt
! blkCostPt
!
! Ratchet namePt baselinePt
! adjustmentPt
! multiplierPt
! offsetPt
!
! These will be formed into expressions that look like
!
! namePt NOOP sourcePt thresholdPt
!
! The different Charges are combined using the SUM operation
! into categories.
!
! category SUM chg1Name chg2Name chg3Name
!
! Since the dependency array has one target and multiple
! parameters, remainingPt is shown as a seperate equation that
! depends on namePt for Charge:Block. The equation will not be
! displayed or processed except in the sort.
!
! remainingPt NOOP namePt
!
! Many lines of the computation will include just the name of
! a single variable which triggers the calculation for that
! charge, ratchet or qualify.
!
! chg1Name
!
! It is also possible that two variables referenced within one
! object could include a dependancy relationship also. For
! example, the blkSzPt could be calculated using the same sourePt
! in Charge:Block.
! METHODOLOGY EMPLOYED:
! Since some ECONOMCIS:* objects depend on other variables
! first must create the order of when to perform the
! computations. First a dependancy table is created that
! indicates what variables are dependant on other variables.
!
! A directed acyclic graph (DAG) describes the general
! problem which is usually solved using a topological
! sorting algorithm.
!
! Each line/step is generated and put into the depend
! array. Also in the array are counts of how many items it
! depends on and a list of entries that are dependant on that
! line.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataGlobals, ONLY : OutputFileInits
USE OutputReportTabular, ONLY: IntToStr
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:
INTEGER :: iTariff
INTEGER :: iVar
INTEGER :: jVar
INTEGER :: kObj
INTEGER :: mBlock
INTEGER :: kOperand
INTEGER :: curBasis
INTEGER :: curSubtotal
INTEGER :: curTotal
INTEGER :: curObject
INTEGER :: numNoDepend
INTEGER :: referVar
INTEGER :: loopCount
LOGICAL :: remainingVarFlag
INTEGER :: remainPt
! for each tariff that does not have a UtilityCost:Computation object go through the variables
DO iTariff = 1, numTariff
IF (.NOT. computation(iTariff)%isUserDef) THEN
! clear all variables so that they are not active
DO jVar = 1, numEconVar
econVar(jVar)%activeNow = .FALSE.
END DO
!make all native variables active
DO jVar = tariff(iTariff)%firstNative, tariff(iTariff)%lastNative
econVar(jVar)%activeNow = .TRUE.
END DO
!"clear" the dependOn array
numOperand = 0
!Define the preset equations (category sumation)
curTotal = tariff(iTariff)%ptTotal
curSubtotal = tariff(iTariff)%ptSubtotal
curBasis = tariff(iTariff)%ptBasis
! total SUM subtotal taxes
econVar(curTotal)%operator = opSUM
econVar(curTotal)%activeNow = .TRUE.
CALL addOperand(curTotal,curSubtotal)
CALL addOperand(curTotal,tariff(iTariff)%ptTaxes)
! subtotal SUM basis adjustments surcharges
econVar(curSubtotal)%operator = opSUM
econVar(curSubtotal)%activeNow = .TRUE.
CALL addOperand(curSubtotal,curBasis)
CALL addOperand(curSubtotal,tariff(iTariff)%ptAdjustment)
CALL addOperand(curSubtotal,tariff(iTariff)%ptSurcharge)
! basis SUM EnergyCharges DemandCharges ServiceCharges
econVar(curBasis)%operator = opSUM
econVar(curBasis)%activeNow = .TRUE.
CALL addOperand(curBasis,tariff(iTariff)%ptEnergyCharges)
CALL addOperand(curBasis,tariff(iTariff)%ptDemandCharges)
CALL addOperand(curBasis,tariff(iTariff)%ptServiceCharges)
!set up the equations for other objects
CALL addChargesToOperand(iTariff,tariff(iTariff)%ptEnergyCharges)
CALL addChargesToOperand(iTariff,tariff(iTariff)%ptDemandCharges)
CALL addChargesToOperand(iTariff,tariff(iTariff)%ptServiceCharges)
CALL addChargesToOperand(iTariff,tariff(iTariff)%ptAdjustment)
CALL addChargesToOperand(iTariff,tariff(iTariff)%ptSurcharge)
CALL addChargesToOperand(iTariff,tariff(iTariff)%ptTaxes)
!add the real time pricing to the energy charges
IF (tariff(iTariff)%chargeSchIndex .NE. 0) THEN
CALL addOperand(tariff(iTariff)%ptEnergyCharges, tariff(iTariff)%nativeRealTimePriceCosts)
END IF
!now add equations with NOOP to represent each object with its
!dependancies
! Qualify
DO kObj = 1, numQualify
IF (qualify(kObj)%tariffIndx .EQ. iTariff) THEN
curObject = qualify(kObj)%namePt
econVar(curObject)%operator = opNOOP
econVar(curObject)%activeNow = .TRUE.
CALL addOperand(curObject,qualify(kObj)%sourcePt)
CALL addOperand(curObject,qualify(kObj)%thresholdPt)
END IF
END DO
! Ratchet
DO kObj = 1, numRatchet
IF (ratchet(kObj)%tariffIndx .EQ. iTariff) THEN
curObject = ratchet(kObj)%namePt
econVar(curObject)%operator = opNOOP
econVar(curObject)%activeNow = .TRUE.
CALL addOperand(curObject,ratchet(kObj)%baselinePt)
CALL addOperand(curObject,ratchet(kObj)%adjustmentPt)
CALL addOperand(curObject,ratchet(kObj)%multiplierPt)
CALL addOperand(curObject,ratchet(kObj)%offsetPt)
END IF
END DO
! ChargeSimple
DO kObj = 1, numChargeSimple
IF (chargeSimple(kObj)%tariffIndx .EQ. iTariff) THEN
curObject = chargeSimple(kObj)%namePt
econVar(curObject)%operator = opNOOP
econVar(curObject)%activeNow = .TRUE.
CALL addOperand(curObject,chargeSimple(kObj)%sourcePt)
CALL addOperand(curObject,chargeSimple(kObj)%costPerPt)
END IF
END DO
! ChargeBlock
DO kObj = 1, numChargeBlock
IF (chargeBlock(kObj)%tariffIndx .EQ. iTariff) THEN
curObject = chargeBlock(kObj)%namePt
econVar(curObject)%operator = opNOOP
econVar(curObject)%activeNow = .TRUE.
CALL addOperand(curObject,chargeBlock(kObj)%sourcePt)
CALL addOperand(curObject,chargeBlock(kObj)%blkSzMultPt)
DO mBlock = 1, chargeBlock(kObj)%numBlk
CALL addOperand(curObject,chargeBlock(kObj)%blkSzPt(mBlock))
CALL addOperand(curObject,chargeBlock(kObj)%blkCostPt(mBlock))
END DO
! now add a new "equation" for dependency of remainingPt on namePt
remainPt = chargeBlock(kObj)%remainingPt
IF (remainPt .GT. 0) THEN
econVar(remainPt)%operator = opNOOP
econVar(remainPt)%activeNow = .TRUE.
CALL addOperand(remainPt,curObject)
END IF
END IF
END DO
! Economic:Variable
!make all of the user defined variables as active
DO iVar = 1, numEconVar
IF (econVar(iVar)%tariffIndx .EQ. iTariff) THEN
IF (econVar(iVar)%kindOfObj .EQ. kindVariable) THEN
econVar(iVar)%activeNow = .TRUE.
END IF
END IF
END DO
! make sure no compuation is already user defined
IF (computation(iTariff)%firstStep .NE. 0) THEN
CALL ShowWarningError('In UtilityCost:Tariff: Overwriting user defined tariff ' //TRIM(tariff(iTariff)%tariffName))
END IF
!initialize the computation
computation(iTariff)%computeName = 'Autogenerated - ' // TRIM(tariff(iTariff)%tariffName)
computation(iTariff)%firstStep = numSteps + 1
computation(iTariff)%lastStep = -1 !this will be incremented by addStep
computation(iTariff)%isUserDef = .FALSE.
! now all "equations" are defined, treat the variables with the list
! of dependancies as a directed acyclic graph and use "count down" algorithm
! to do a topological sort of the variables into the order for computation
!
! First, clear the counters
DO jVar = 1,numEconVar
econVar(jVar)%cntMeDependOn = 0
END DO
! Second, add up the number of dependancies on each variable
DO iVar = 1, numEconVar
IF (econVar(iVar)%activeNow) THEN
IF (econVar(iVar)%lastOperand .GE. econVar(iVar)%firstOperand) THEN
econVar(iVar)%cntMeDependOn = 1 + econVar(iVar)%lastOperand - econVar(iVar)%firstOperand
END IF
END IF
END DO
! Third, start removing items with zero connections and decrease each
! counter.
numNoDepend = -1
loopCount = 0
DO WHILE ((numNoDepend .NE. 0) .OR. (loopCount .GT. 100000))
numNoDepend = 0
DO iVar = 1,numEconVar
IF (econVar(iVar)%activeNow) THEN
!find a variable that has no more dangling dependancies
IF (econVar(iVar)%cntMeDependOn .EQ. 0) THEN
! If the variable is a native variable then
!IF (econVar(iVar)%kindOfObj .NE. kindNative) THEN
IF ((econVar(iVar)%kindOfObj .NE. kindNative) .AND. (econVar(iVar)%kindOfObj .NE. kindVariable)) THEN
IF (econVar(iVar)%lastOperand .GE. econVar(iVar)%firstOperand) THEN
!transfer variables and operator to the computation and list of steps
! go through the operands backwards (end of line is evaluated first)
DO kOperand = econVar(iVar)%lastOperand,econVar(iVar)%firstOperand,-1
CALL incrementSteps
steps(numSteps) = operand(kOperand)
END DO
! append the operator (either SUM or NOOP)
CALL incrementSteps
steps(numSteps) = econVar(iVar)%operator
! append the variable itself
CALL incrementSteps
steps(numSteps) = iVar
!at the end of the line show a zero to clear the stack
CALL incrementSteps
steps(numSteps) = 0
END IF
END IF
! go through each other variable looking for places where this variable is used
! and decrement their counters.
DO jVar = 1, numEconVar
IF (econVar(jVar)%activeNow) THEN
DO kOperand = econVar(jVar)%firstOperand, econVar(jVar)%lastOperand
referVar = operand(kOperand)
IF (iVar .EQ. referVar) THEN
econVar(jVar)%cntMeDependOn = econVar(jVar)%cntMeDependOn - 1
! for each variable that has been decremented to zero increment the counter
IF (econVar(jVar)%cntMeDependOn .LE. 0) THEN
numNoDepend = numNoDepend + 1
END IF
END IF
END DO
END IF
END DO
!make the variable inactive
econVar(iVar)%activeNow = .FALSE.
END IF
END IF
END DO
loopCount = loopCount + 1
END DO
IF (loopCount .GT. 100000) THEN
CALL ShowWarningError('UtilityCost:Tariff: Loop count exceeded when counting dependancies in tariff: '// &
TRIM(tariff(iTariff)%tariffName))
END IF
!make sure that all variables associated with the tariff are included
remainingVarFlag = .FALSE.
DO iVar = 1, numEconVar
IF (econVar(iVar)%activeNow) THEN
remainingVarFlag = .TRUE.
END IF
END DO
IF (remainingVarFlag) THEN
CALL ShowWarningError('CreateDefaultComputation: In UtilityCost:Computation: '// &
'Circular or invalid dependencies found in tariff: ' // &
TRIM(tariff(iTariff)%tariffName))
CALL ShowContinueError(' UtilityCost variables that may have invalid dependencies and the variables they are dependant on.')
DO iVar = 1, numEconVar
IF (econVar(iVar)%tariffIndx .EQ. iTariff) THEN
IF (econVar(iVar)%activeNow) THEN
CALL ShowContinueError(' ' // TRIM(econVar(iVar)%name))
DO kOperand = econVar(iVar)%firstOperand,econVar(iVar)%lastOperand
CALL ShowContinueError(' -> ' // TRIM(econVar(operand(kOperand))%name))
END DO
END IF
END IF
END DO
END IF
!set the end of the computations
computation(iTariff)%lastStep = numSteps
IF (computation(iTariff)%firstStep .GE. computation(iTariff)%lastStep) THEN
computation(iTariff)%firstStep = 0
computation(iTariff)%lastStep = -1
CALL ShowWarningError('CreateDefaultComputation: In UtilityCost:Computation: '// &
'No lines in the auto generated computation can be interpreted in tariff: ' // &
TRIM(tariff(iTariff)%tariffName))
END IF
END IF
END DO
END SUBROUTINE CreateDefaultComputation