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 ComputeTariff
! SUBROUTINE INFORMATION:
! AUTHOR Jason Glazer of GARD Analytics, Inc.
! DATE WRITTEN July 2004
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Perform the calculation steps to compute the monthly
! utility bills for the user entered tariffs.
!
! The list of steps for the tariff computation are in order
! for stack based computation (reverse polish notation)
! METHODOLOGY EMPLOYED:
! REFERENCES:
! na
! USE STATEMENTS:
USE OutputReportTabular, ONLY: WriteTabularFiles
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
! values used in specific operations
REAL(r64), DIMENSION(MaxNumMonths) :: a
INTEGER :: aPt
REAL(r64), DIMENSION(MaxNumMonths) :: b
INTEGER :: bPt
REAL(r64), DIMENSION(MaxNumMonths) :: c
INTEGER :: cPt
REAL(r64), DIMENSION(MaxNumMonths) :: d
INTEGER :: iTariff
INTEGER :: jStep
INTEGER :: kStack
INTEGER :: lMonth
INTEGER :: nVar
INTEGER :: curStep
INTEGER, parameter :: noVar = 0
REAL(r64) :: hugeValue
REAL(r64) :: annualAggregate
INTEGER :: annualCnt
hugeValue = HUGE(hugeValue)
! Clear the isEvaluated flags for all economics variables.
DO nVar = 1, numEconVar
econVar(nVar)%isEvaluated = .FALSE.
END DO
IF (numTariff .GE. 1) THEN
WriteTabularFiles = .TRUE.
CALL setNativeVariables
DO iTariff = 1, numTariff
DO jStep = computation(iTariff)%firstStep,computation(iTariff)%lastStep
curStep = steps(jStep)
SELECT CASE (curStep)
CASE (0) !end of line - assign variable and clear stack
! if the stack still has two items on it then assign the values to the
! pointer otherwise if it follows a NOOP line it will only have one item
! that has already been assigned and no further action is required.
IF (topOfStack .GE. 2) THEN
CALL popStack(b,bPt) !pop the variable pointer
CALL popStack(a,aPt) !pop the values
IF (isWithinRange(bPt,1,numEconVar)) THEN
econVar(bPt)%values = a
END IF
END IF
topOfStack = 0
CASE (1:) !all positive values are a reference to an econVar
CALL pushStack(econVar(curStep)%values,curStep)
CASE (opSUM)
a = 0.0d0
DO kStack = 1,topOfStack
CALL popStack(b,bPt)
a = a + b
END DO
CALL pushStack(a,noVar)
CASE (opMULTIPLY)
CALL popStack(b,bPt)
CALL popStack(a,aPt)
CALL pushStack(a * b,noVar)
CASE (opSUBTRACT)
CALL popStack(b,bPt)
CALL popStack(a,aPt)
CALL pushStack(b - a,noVar)
CASE (opDIVIDE)
CALL popStack(a,aPt)
CALL popStack(b,bPt)
DO lMonth = 1,MaxNumMonths
IF (b(lMonth) .NE. 0) THEN
c(lMonth) = a(lMonth) / b(lMonth)
ELSE
c(lMonth) = 0.0d0
END IF
END DO
CALL pushStack(c,noVar)
CASE (opABSOLUTE)
CALL popStack(a,aPt)
CALL pushStack(ABS(a),noVar)
CASE (opINTEGER)
CALL popStack(a,aPt)
CALL pushStack(REAL(INT(a),r64),noVar)
CASE (opSIGN)
CALL popStack(a,aPt)
CALL pushStack(SIGN(1.d0,a),noVar)
! CASE (opROUND)
! CALL popStack(b,bPt)
! CALL popStack(a,aPt)
! DO lMonth = 1,MaxNumMonths
! IF ((b(lMonth) .LE. 5) .AND. (b(lMonth) .GE. -5)) THEN
! c(lMonth) = FLOAT(INT(a(lMonth) / (10 ** b(lMonth))) * (10 ** b(lMonth)))
! END IF
! END DO
! CALL pushStack(c,noVar)
CASE (opMAXIMUM)
a = -hugeValue
DO kStack = 1,topOfStack
CALL popStack(b,bPt)
DO lMonth = 1,MaxNumMonths
IF (b(lMonth) .GT. a(lMonth)) THEN
a(lMonth) = b(lMonth)
END IF
END DO
END DO
CALL pushStack(a,noVar)
CASE (opMINIMUM)
a = hugeValue
DO kStack = 1,topOfStack
CALL popStack(b,bPt)
DO lMonth = 1,MaxNumMonths
IF (b(lMonth) .LT. a(lMonth)) THEN
a(lMonth) = b(lMonth)
END IF
END DO
END DO
CALL pushStack(a,noVar)
CASE (opEXCEEDS)
CALL popStack(b,bPt)
CALL popStack(a,aPt)
DO lMonth = 1,MaxNumMonths
IF (a(lMonth) .GT. b(lMonth)) THEN
c(lMonth) = a(lMonth) - b(lMonth)
ELSE
c(lMonth) = 0.0d0
END IF
END DO
CALL pushStack(c,noVar)
CASE (opANNUALMINIMUM)
!takes the minimum but ignores zeros
annualAggregate = hugeValue
CALL popStack(a,aPt)
DO lMonth = 1,MaxNumMonths
IF (a(lMonth) .NE. 0) THEN
IF (a(lMonth) .LT. annualAggregate) THEN
annualAggregate = a(lMonth)
END IF
END IF
END DO
! if all months are zero then hugeValue still in annual but should be zero
IF (annualAggregate .EQ. hugeValue) THEN
annualAggregate = 0.0d0
END IF
c = annualAggregate
CALL pushStack(c,noVar)
CASE (opANNUALMAXIMUM)
!takes the maximum but ignores zeros
annualAggregate = -hugeValue
CALL popStack(a,aPt)
DO lMonth = 1,MaxNumMonths
IF (a(lMonth) .NE. 0) THEN
IF (a(lMonth) .GT. annualAggregate) THEN
annualAggregate = a(lMonth)
END IF
END IF
END DO
! if all months are zero then hugeValue still in annual but should be zero
IF (annualAggregate .EQ. -hugeValue) THEN
annualAggregate = 0.0d0
END IF
c = annualAggregate
CALL pushStack(c,noVar)
CASE (opANNUALSUM)
!takes the maximum but ignores zeros
annualAggregate = 0.0d0
CALL popStack(a,aPt)
DO lMonth = 1,MaxNumMonths
annualAggregate = annualAggregate + a(lMonth)
END DO
c = annualAggregate
CALL pushStack(c,noVar)
CASE (opANNUALAVERAGE)
!takes the annual sum but ignores zeros
annualAggregate = 0.0d0
annualCnt = 0
CALL popStack(a,aPt)
DO lMonth = 1,MaxNumMonths
IF (a(lMonth) .NE. 0) THEN
annualAggregate = annualAggregate + a(lMonth)
annualCnt = annualCnt + 1
END IF
END DO
! if all months are zero then return zero
IF (annualCnt .NE. 0) THEN
c = annualAggregate / annualCnt
ELSE
c = 0.0d0
END IF
CALL pushStack(c,noVar)
CASE (opANNUALOR)
annualCnt = 0
CALL popStack(a,aPt)
DO lMonth = 1,MaxNumMonths
IF (a(lMonth) .NE. 0) THEN
annualCnt = annualCnt + 1
END IF
END DO
! if any months is not zero then "true"
IF (annualCnt .GE. 1) THEN
c = 1.0d0
ELSE
c = 0.0d0
END IF
CALL pushStack(c,noVar)
CASE (opANNUALAND)
annualCnt = 0
CALL popStack(a,aPt)
DO lMonth = 1,MaxNumMonths
IF (a(lMonth) .NE. 0) THEN
annualCnt = annualCnt + 1
END IF
END DO
! if all months are not zero then "true"
IF (annualCnt .EQ. MaxNumMonths) THEN
c = 1.0d0
ELSE
c = 0.0d0
END IF
CALL pushStack(c,noVar)
CASE (opANNUALMAXIMUMZERO)
!takes the maximum including zeros
annualAggregate = -hugeValue
CALL popStack(a,aPt)
DO lMonth = 1,MaxNumMonths
IF (a(lMonth) .GT. annualAggregate) THEN
annualAggregate = a(lMonth)
END IF
END DO
c = annualAggregate
CALL pushStack(c,noVar)
CASE (opANNUALMINIMUMZERO)
!takes the maximum including zeros
annualAggregate = hugeValue
CALL popStack(a,aPt)
DO lMonth = 1,MaxNumMonths
IF (a(lMonth) .LT. annualAggregate) THEN
annualAggregate = a(lMonth)
END IF
END DO
c = annualAggregate
CALL pushStack(c,noVar)
CASE (opIF)
CALL popStack(c,cPt)
CALL popStack(b,bPt)
CALL popStack(a,aPt)
DO lMonth = 1,MaxNumMonths
IF (a(lMonth) .NE. 0) THEN
d(lMonth) = b(lMonth)
ELSE
d(lMonth) = c(lMonth)
END IF
END DO
CALL pushStack(d,noVar)
CASE (opGREATERTHAN)
CALL popStack(b,bPt)
CALL popStack(a,aPt)
DO lMonth = 1,MaxNumMonths
IF (a(lMonth) .GT. b(lMonth)) THEN
c(lMonth) = 1.0d0
ELSE
c(lMonth) = 0.0d0
END IF
END DO
CALL pushStack(c,noVar)
CASE (opGREATEREQUAL)
CALL popStack(b,bPt)
CALL popStack(a,aPt)
DO lMonth = 1,MaxNumMonths
IF (a(lMonth) .GE. b(lMonth)) THEN
c(lMonth) = 1.0d0
ELSE
c(lMonth) = 0.0d0
END IF
END DO
CALL pushStack(c,noVar)
CASE (opLESSTHAN)
CALL popStack(b,bPt)
CALL popStack(a,aPt)
DO lMonth = 1,MaxNumMonths
IF (a(lMonth) .LT. b(lMonth)) THEN
c(lMonth) = 1.0d0
ELSE
c(lMonth) = 0.0d0
END IF
END DO
CALL pushStack(c,noVar)
CASE (opLESSEQUAL)
CALL popStack(b,bPt)
CALL popStack(a,aPt)
DO lMonth = 1,MaxNumMonths
IF (a(lMonth) .LE. b(lMonth)) THEN
c(lMonth) = 1.0d0
ELSE
c(lMonth) = 0.0d0
END IF
END DO
CALL pushStack(c,noVar)
CASE (opEQUAL)
CALL popStack(b,bPt)
CALL popStack(a,aPt)
DO lMonth = 1,MaxNumMonths
IF (a(lMonth) .EQ. b(lMonth)) THEN
c(lMonth) = 1.0d0
ELSE
c(lMonth) = 0.0d0
END IF
END DO
CALL pushStack(c,noVar)
CASE (opNOTEQUAL)
CALL popStack(b,bPt)
CALL popStack(a,aPt)
DO lMonth = 1,MaxNumMonths
IF (a(lMonth) .NE. b(lMonth)) THEN
c(lMonth) = 1.0d0
ELSE
c(lMonth) = 0.0d0
END IF
END DO
CALL pushStack(c,noVar)
CASE (opAND)
CALL popStack(b,bPt)
CALL popStack(a,aPt)
DO lMonth = 1,MaxNumMonths
IF ((a(lMonth) .NE. 0) .AND. (b(lMonth) .NE. 0)) THEN
c(lMonth) = 1.0d0
ELSE
c(lMonth) = 0.0d0
END IF
END DO
CALL pushStack(c,noVar)
CASE (opOR)
CALL popStack(b,bPt)
CALL popStack(a,aPt)
DO lMonth = 1,MaxNumMonths
IF ((a(lMonth) .NE. 0) .OR. (b(lMonth) .NE. 0)) THEN
c(lMonth) = 1.0d0
ELSE
c(lMonth) = 0.0d0
END IF
END DO
CALL pushStack(c,noVar)
CASE (opNOT)
CALL popStack(a,aPt)
DO lMonth = 1,MaxNumMonths
IF (a(lMonth) .EQ. 0) THEN
c(lMonth) = 1.0d0
ELSE
c(lMonth) = 0.0d0
END IF
END DO
CALL pushStack(c,noVar)
CASE (opADD)
CALL popStack(b,bPt)
CALL popStack(a,aPt)
CALL pushStack(a + b,noVar)
CASE (opNOOP)
!do nothing but clear the stack
topOfStack = 0
! No longer pushing a zero to fix bug
!and push zero
!a = 0
!CALL pushStack(a,noVar)
END SELECT
END DO
CALL checkMinimumMonthlyCharge(iTariff)
END DO
CALL selectTariff
CALL LEEDtariffReporting
END IF
END SUBROUTINE ComputeTariff