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 selectTariff
! SUBROUTINE INFORMATION:
! AUTHOR Jason Glazer of GARD Analytics, Inc.
! DATE WRITTEN July 2004
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! To select tariffs for each combination of meter and
! group. If multipler tariffs have the same meter and
! group, then select the one with the lowest cost.
! For electric tariffs, since they may have buy, sell, or
! netmetering, they need to be combined more carefully.
! Multiple meters are used but buy + sell might be more or
! less expensive than netmeter.
! METHODOLOGY EMPLOYED:
! REFERENCES:
! na
! USE STATEMENTS:
USE OutputProcessor, ONLY: EnergyMeters, NumEnergyMeters
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 :: totalVarPt
INTEGER :: totEneVarPt
REAL(r64) :: annualTotal
REAL(r64) :: annEneTotal
INTEGER :: iTariff
INTEGER :: jMonth
INTEGER :: kTariff
INTEGER :: lMin
INTEGER :: mGroup
INTEGER,DIMENSION(:),ALLOCATABLE :: groupIndex !index number (in tariff) for the group name
INTEGER,DIMENSION(:),ALLOCATABLE :: MinTariffIndex !tariff index for the Minimum value
INTEGER :: numMins
INTEGER :: curMinTariffIndex
LOGICAL :: isFound
INTEGER :: groupCount
INTEGER :: lowestSimpleTariff
INTEGER :: lowestPurchaseTariff
INTEGER :: lowestSurplusSoldTariff
INTEGER :: lowestNetMeterTariff
ALLOCATE(groupIndex(numTariff))
groupIndex = 0
groupCount = 0
numMins = 0
ALLOCATE(MinTariffIndex(numTariff))
MinTariffIndex = 0
DO iTariff = 1, numTariff
!determine if this is meter related to electricity
IF (Tariff(iTariff)%reportMeterIndx .NE. 0) THEN
SELECT CASE (TRIM(MakeUpperCase(EnergyMeters(Tariff(iTariff)%reportMeterIndx)%ResourceType)))
CASE('ELECTRICITY')
tariff(iTariff)%kindElectricMtr = kindMeterElecSimple
CASE ('ELECTRICITYPRODUCED')
tariff(iTariff)%kindElectricMtr = kindMeterElecProduced
CASE ('ELECTRICITYPURCHASED')
tariff(iTariff)%kindElectricMtr = kindMeterElecPurchased
CASE ('ELECTRICITYSURPLUSSOLD')
tariff(iTariff)%kindElectricMtr = kindMeterElecSurplusSold
CASE ('ELECTRICITYNET')
tariff(iTariff)%kindElectricMtr = kindMeterElecNet
CASE DEFAULT
tariff(iTariff)%kindElectricMtr = kindMeterNotElectric
END SELECT
ELSE
tariff(iTariff)%kindElectricMtr = kindMeterNotElectric
END IF
! compute the total annual cost of each tariff
totalVarPt = tariff(iTariff)%ptTotal
totEneVarPt = tariff(iTariff)%nativeTotalEnergy
annualTotal = 0.0d0
annEneTotal = 0.0d0
DO jMonth = 1,MaxNumMonths
annualTotal = annualTotal + econVar(totalVarPt)%values(jMonth)
annEneTotal = annEneTotal + econVar(totEneVarPt)%values(jMonth)
END DO
tariff(iTariff)%totalAnnualCost = annualTotal
tariff(iTariff)%totalAnnualEnergy = annEneTotal
! Set the groupIndex
IF (groupIndex(iTariff) .EQ. 0) THEN
!set the current item to the tariff index
groupCount = groupCount + 1
groupIndex(iTariff) = groupCount
!set all remaining matching items to the same index
DO kTariff = iTariff + 1,numTariff
IF (SameString(tariff(kTariff)%groupName,tariff(iTariff)%groupName)) THEN
groupIndex(kTariff) = groupCount
END IF
END DO
END IF
END DO
! First process the all tariff and identify the lowest cost for each type of meter and group.
DO iTariff = 1, numTariff
IF (tariff(iTariff)%isQualified) THEN
isFound = .FALSE.
DO lMin = 1,numMins
curMinTariffIndex = MinTariffIndex(lMin)
!find matching meter and group
IF (tariff(iTariff)%reportMeterIndx .EQ. tariff(curMinTariffIndex)%reportMeterIndx) THEN
IF (groupIndex(iTariff) .EQ. groupIndex(curMinTariffIndex)) THEN
isFound = .TRUE.
!found the matching mater and group now test if smaller Min is current tariff
IF (tariff(iTariff)%totalAnnualCost .LT. tariff(curMinTariffIndex)%totalAnnualCost) THEN
MinTariffIndex(lMin) = iTariff
!select the new Minimum tariff and deselect the one that was just exceeded
tariff(curMinTariffIndex)%isSelected = .FALSE.
tariff(iTariff)%isSelected = .TRUE.
END IF
END IF
END IF
END DO
IF (.NOT. isFound) THEN
numMins = numMins + 1
IF (numMins .GT. numTariff) THEN
CALL ShowWarningError('UtilityCost:Tariff Debugging error numMins greater than numTariff.')
END IF
MinTariffIndex(numMins) = iTariff
! tariff(numMins)%isSelected = .TRUE. !original
tariff(iTariff)%isSelected = .TRUE. !BTG changed 2/7/2005 CR6573
END IF
END IF
END DO
! Now select for the electric meters. If electric buying and selling and netmetering all are going
! on, need to determine which combination should be selected. Within each group select just one set
! of electric results. The electric results can be either the buy rate only, the buy rate plus the
! sell rate, or the netmetering rate, whichever of these three is the lowest combination.
DO mGroup = 1, groupCount
lowestSimpleTariff = 0
lowestPurchaseTariff = 0
lowestSurplusSoldTariff = 0
lowestNetMeterTariff = 0
DO iTariff = 1, numTariff
IF (tariff(iTariff)%isQualified) THEN
IF (tariff(iTariff)%isSelected) THEN
IF (groupIndex(iTariff) .EQ. mGroup) THEN
SELECT CASE (tariff(iTariff)%kindElectricMtr)
CASE (kindMeterElecSimple)
lowestSimpleTariff = iTariff
CASE (kindMeterElecProduced)
! don't show electric produced rates as ever selected since surplus sold is more relevant
tariff(iTariff)%isSelected = .FALSE.
CASE (kindMeterElecPurchased)
lowestPurchaseTariff = iTariff
CASE (kindMeterElecSurplusSold)
lowestSurplusSoldTariff = iTariff
CASE (kindMeterElecNet)
lowestNetMeterTariff = iTariff
END SELECT
END IF
END IF
END IF
END DO
! compare the simple and purchased metered tariffs
IF ((lowestSimpleTariff .GT. 0) .AND. (lowestPurchaseTariff .GT. 0)) THEN
IF (tariff(lowestSimpleTariff)%totalAnnualCost .LT. tariff(lowestPurchaseTariff)%totalAnnualCost) THEN
tariff(lowestPurchaseTariff)%isSelected = .FALSE.
lowestPurchaseTariff = 0
ELSE
tariff(lowestSimpleTariff)%isSelected = .FALSE.
lowestSimpleTariff = 0
END IF
END IF
! if surplus sold is negative use it otherwise don't
IF (lowestSurplusSoldTariff .GT. 0) THEN
IF (tariff(lowestSurplusSoldTariff)%totalAnnualCost .GT. 0) THEN
tariff(lowestSurplusSoldTariff)%isSelected = .FALSE.
lowestSurplusSoldTariff = 0
END IF
END IF
! if netmetering is used compare it to simple plus surplus
IF (((lowestNetMeterTariff .GT. 0) .AND. (lowestSurplusSoldTariff .GT. 0)) .AND. (lowestSimpleTariff .GT. 0)) THEN
IF (tariff(lowestNetMeterTariff)%totalAnnualCost .LT. &
(tariff(lowestSimpleTariff)%totalAnnualCost + tariff(lowestSurplusSoldTariff)%totalAnnualCost)) THEN
tariff(lowestSimpleTariff)%isSelected = .FALSE.
lowestSimpleTariff = 0
tariff(lowestSurplusSoldTariff)%isSelected = .FALSE.
lowestSurplusSoldTariff = 0
ELSE
tariff(lowestNetMeterTariff)%isSelected = .FALSE.
lowestNetMeterTariff = 0
END IF
END IF
! if netmetering is used compare it to purchased plus surplus
IF (((lowestNetMeterTariff .GT. 0) .AND. (lowestSurplusSoldTariff .GT. 0)) .AND. (lowestPurchaseTariff .GT. 0)) THEN
IF (tariff(lowestNetMeterTariff)%totalAnnualCost .LT. &
(tariff(lowestPurchaseTariff)%totalAnnualCost + tariff(lowestSurplusSoldTariff)%totalAnnualCost)) THEN
tariff(lowestPurchaseTariff)%isSelected = .FALSE.
lowestPurchaseTariff = 0
tariff(lowestSurplusSoldTariff)%isSelected = .FALSE.
lowestSurplusSoldTariff = 0
ELSE
tariff(lowestNetMeterTariff)%isSelected = .FALSE.
lowestNetMeterTariff = 0
END IF
END IF
! if netmetering is used compare it to simple only
IF ((lowestNetMeterTariff .GT. 0) .AND. (lowestSimpleTariff .GT. 0)) THEN
IF (tariff(lowestNetMeterTariff)%totalAnnualCost .LT. tariff(lowestSimpleTariff)%totalAnnualCost) THEN
tariff(lowestSimpleTariff)%isSelected = .FALSE.
lowestSimpleTariff = 0
ELSE
tariff(lowestNetMeterTariff)%isSelected = .FALSE.
lowestNetMeterTariff = 0
END IF
END IF
! if netmetering is used compare it to purchased only
IF ((lowestNetMeterTariff .GT. 0) .AND. (lowestPurchaseTariff .GT. 0)) THEN
IF (tariff(lowestNetMeterTariff)%totalAnnualCost .LT. tariff(lowestPurchaseTariff)%totalAnnualCost) THEN
tariff(lowestPurchaseTariff)%isSelected = .FALSE.
lowestPurchaseTariff = 0
ELSE
tariff(lowestNetMeterTariff)%isSelected = .FALSE.
lowestNetMeterTariff = 0
END IF
END IF
END DO
DEALLOCATE(groupIndex)
DEALLOCATE(MinTariffIndex)
END SUBROUTINE selectTariff