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.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real(kind=r64), | intent(in), | DIMENSION(MaxNumMonths) | :: | monthlyArray | ||
integer, | intent(in) | :: | variablePointer |
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 pushStack(monthlyArray,variablePointer)
! SUBROUTINE INFORMATION:
! AUTHOR Jason Glazer of GARD Analytics, Inc.
! DATE WRITTEN July 2004
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! A stack is used in the evaluation of the tariff since
! the variables and operators are in a reverse polish
! notation order. The stack operates on a last-in
! first out basis. The stack consists of both a pointer
! to the variable and the twelve monthly values.
! This routine puts an item on the top of the stack.
! METHODOLOGY EMPLOYED:
! REFERENCES:
! na
! USE STATEMENTS:
USE OutputReportTabular, ONLY: IntToStr
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
REAL(r64), DIMENSION(MaxNumMonths),INTENT(IN) :: monthlyArray
INTEGER,INTENT(IN) :: variablePointer
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64), DIMENSION(MaxNumMonths) :: curMonthlyArray
INTEGER :: sizeIncrement = 50
curMonthlyArray = monthlyArray
IF (.NOT. ALLOCATED(stack)) THEN
ALLOCATE(stack(sizeIncrement))
sizeStack = sizeIncrement
topOfStack = 1
ELSE
topOfStack = topOfStack + 1
! if larger then current size then make a temporary array of the same
! type and put stuff into it while reallocating the main array
IF (topOfStack .GT. sizeStack) THEN
ALLOCATE(stackCopy(sizeStack))
stackCopy = stack
DEALLOCATE(stack)
ALLOCATE(stack(sizeStack + sizeIncrement))
stack(1:sizeStack) = stackCopy
DEALLOCATE(stackCopy)
sizeStack = sizeStack + sizeIncrement
END IF
END IF
!now push the values on to the stack
stack(topOfStack)%varPt = variablePointer
!check if variable has been evaluated if it is CHARGE:SIMPLE, CHARGE:BLOCK, RATCHET, or QUALIFY
!if it has not overwrite the values for monthlyArray with the evaluated values
IF (variablePointer .NE. 0) THEN
IF (.NOT. econVar(variablePointer)%isEvaluated) THEN
SELECT CASE (econVar(variablePointer)%kindOfObj)
CASE (kindChargeSimple)
CALL evaluateChargeSimple(variablePointer)
CASE (kindChargeBlock)
CALL evaluateChargeBlock(variablePointer)
CASE (kindRatchet)
CALL evaluateRatchet(variablePointer)
CASE (kindQualify)
CALL evaluateQualify(variablePointer)
CASE (kindUnknown)
CALL ShowWarningError('UtilityCost variable not defined: ' // TRIM(econVar(variablePointer)%name))
CALL ShowContinueError(' In tariff: ' // TRIM(Tariff(econVar(variablePointer)%tariffIndx)%tariffName))
CALL ShowContinueError(' This may be the result of a mispelled variable name in the UtilityCost:Computation object.')
CALL ShowContinueError(' All zero values will be assumed for this variable.')
CASE (kindVariable,kindCategory,kindNative,kindAssignCompute,kindTariff,kindComputation)
! do nothing
CASE DEFAULT
CALL ShowWarningError('UtilityCost Debugging issue. Invalid kind of variable used (pushStack). ' &
// TRIM(IntToStr(econVar(variablePointer)%kindOfObj)) &
// ' in tariff: ' // TRIM(Tariff(econVar(variablePointer)%tariffIndx)%tariffName))
END SELECT
! if the serviceCharges are being evaluated add in the monthly charges
IF (econVar(variablePointer)%specific .EQ. catServiceCharges) CALL addMonthlyCharge(variablePointer)
!get the results of performing the evaulation - should have been
!put into the econVar values
curMonthlyArray = econVar(variablePointer)%values
END IF
END IF
!now assign
stack(topOfStack)%values = curMonthlyArray
END SUBROUTINE pushStack