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 | ||
---|---|---|---|---|---|---|
logical, | intent(inout) | :: | ErrorsFound |
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 GetInputEconomicsTariff(ErrorsFound)
! SUBROUTINE INFORMATION:
! AUTHOR Jason Glazer of GARD Analytics, Inc.
! DATE WRITTEN May 2004
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Read the input file for "Economics:Tariff" objects.
! METHODOLOGY EMPLOYED:
! REFERENCES:
! na
! USE STATEMENTS:
USE DataGlobals, ONLY: NumOfTimeStepInHour
USE OutputReportTabular, ONLY: AddTOCEntry
USE DataInterfaces, ONLY:GetVariableKeyCountandType, GetVariableKeys
USE OutputProcessor, ONLY: EnergyMeters, NumEnergyMeters
USE DataGlobalConstants, ONLY: AssignResourceTypeNum
USE DataIPShortCuts
USE General, ONLY: RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(INOUT) :: ErrorsFound ! true if errors found during getting input objects.
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName='GetInputEconomicsTariff: '
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: iInObj ! loop index variable for reading in objects
INTEGER :: jObj ! loop index for objects
INTEGER :: NumAlphas ! Number of elements in the alpha array
INTEGER :: NumNums ! Number of elements in the numeric array
!CHARACTER(len=MaxNameLength),DIMENSION(100) :: AlphaArray !character string data
!REAL(r64), DIMENSION(100) :: NumArray !numeric data
INTEGER :: IOStat ! IO Status when calling get input subroutine
INTEGER :: found
LOGICAL :: isNotNumeric
! variables for getting report variable/meter index
INTEGER :: KeyCount
INTEGER :: TypeVar
INTEGER :: AvgSumVar
INTEGER :: StepTypeVar
CHARACTER(len=MaxNameLength) :: UnitsVar ! Units sting, may be blank
CHARACTER(len=MaxNameLength), DIMENSION(:), ALLOCATABLE :: NamesOfKeys ! Specific key name
INTEGER, DIMENSION(:) , ALLOCATABLE :: IndexesForKeyVar ! Array index
INTEGER :: jFld
CHARACTER(len=MaxNameLength) :: CurrentModuleObject ! for ease in renaming.
CurrentModuleObject = 'UtilityCost:Tariff'
NumTariff = GetNumObjectsFound(CurrentModuleObject)
ALLOCATE(tariff(NumTariff))
DO iInObj = 1 , NumTariff
CALL GetObjectItem(CurrentModuleObject,iInObj,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
!check to make sure none of the values are another economic object
DO jFld = 1, NumAlphas
! args are always turned to upper case but this is okay...
IF (INDEX(MakeUpperCase(cAlphaArgs(jFld)),'UTILITYCOST:') .GT. 0) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)// '="' // TRIM(cAlphaArgs(1)) //'".')
CALL ShowContinueError('... a field was found containing UtilityCost: which may indicate a missing comma.')
END IF
END Do
!name of the tariff
tariff(iInObj)%tariffName = cAlphaArgs(1)
!check if tariff name is unique
found = 0
DO jObj = 1, iInObj - 1
IF (tariff(iInObj)%tariffName .EQ. tariff(jObj)%tariffName) THEN
found = jObj
EXIT
END IF
END DO
IF (found .GT. 0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid data')
CALL ShowContinueError('...Duplicate name. Name has already been used.')
ErrorsFound=.true.
END IF
!name of the report meter
tariff(iInObj)%reportMeter = cAlphaArgs(2)
! call the key count function but only need count during this pass
CALL GetVariableKeyCountandType(tariff(iInObj)%reportMeter,KeyCount,TypeVar,AvgSumVar,StepTypeVar,UnitsVar)
! if no meters found for that name
IF (KeyCount .EQ. 0) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" missing meter')
CALL ShowContinueError('Meter referenced is not present due to a lack of equipment that uses that energy source/meter:"'// &
trim(tariff(iInObj)%reportMeter)//'".')
tariff(iInObj)%reportMeterIndx = 0
ELSE
ALLOCATE(NamesOfKeys(KeyCount))
ALLOCATE(IndexesForKeyVar(KeyCount))
CALL GetVariableKeys(tariff(iInObj)%reportMeter,TypeVar,NamesOfKeys,IndexesForKeyVar)
!although this retrieves all keys for a variable, we only need one so the first one is chosen
IF (KeyCount .GT. 1) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" multiple keys')
CALL ShowContinueError('... Multiple keys for variable select. First key will be used.')
END IF
!assign the index
tariff(iInObj)%reportMeterIndx = IndexesForKeyVar(1)
!get rid of the arrays used to get the variable number
DEALLOCATE(NamesOfKeys)
DEALLOCATE(IndexesForKeyVar)
END IF
!conversion factor
IF (SameString(cAlphaArgs(3),'USERDEFINED')) THEN
tariff(iInObj)%convChoice = conversionUSERDEF
tariff(iInObj)%energyConv = rNumericArgs(1) !energy conversion factor
tariff(iInObj)%demandConv = rNumericArgs(2) !demand conversion factor
ELSE IF (SameString(cAlphaArgs(3),'KWH')) THEN
tariff(iInObj)%convChoice = conversionKWH
tariff(iInObj)%energyConv = 0.0000002778d0
tariff(iInObj)%demandConv = 0.001d0
ELSE IF (SameString(cAlphaArgs(3),'THERM')) THEN
tariff(iInObj)%convChoice = conversionTHERM
tariff(iInObj)%energyConv = 9.4781712d-9
tariff(iInObj)%demandConv = 0.00003412d0
ELSE IF (SameString(cAlphaArgs(3),'MMBTU')) THEN
tariff(iInObj)%convChoice = conversionMMBTU
tariff(iInObj)%energyConv = 9.4781712d-10
tariff(iInObj)%demandConv = 0.000003412d0
ELSE IF (SameString(cAlphaArgs(3),'MJ')) THEN
tariff(iInObj)%convChoice = conversionMJ
tariff(iInObj)%energyConv = 0.000001d0
tariff(iInObj)%demandConv = 0.0036d0
ELSE IF (SameString(cAlphaArgs(3),'KBTU')) THEN
tariff(iInObj)%convChoice = conversionKBTU
tariff(iInObj)%energyConv = 9.4781712d-7
tariff(iInObj)%demandConv = 0.003412d0
ELSE IF (SameString(cAlphaArgs(3),'MCF')) THEN
tariff(iInObj)%convChoice = conversionMCF
tariff(iInObj)%energyConv = 9.4781712d-10
tariff(iInObj)%demandConv = 0.000003412d0
ELSE IF (SameString(cAlphaArgs(3),'CCF')) THEN
tariff(iInObj)%convChoice = conversionCCF
tariff(iInObj)%energyConv = 9.4781712d-9
tariff(iInObj)%demandConv = 0.00003412d0
ELSE
tariff(iInObj)%convChoice = conversionKWH
tariff(iInObj)%energyConv = 0.0000002778d0
tariff(iInObj)%demandConv = 0.001d0
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid data')
CALL ShowContinueError(trim(cAlphaFieldNames(3))//'="'//trim(cAlphaArgs(3))//'", Defaulting to KWH.')
END IF
!schedules
! period schedule
IF (LEN_TRIM(cAlphaArgs(4)) .GT. 0) THEN
tariff(iInObj)%periodSchedule = cAlphaArgs(4) !name of the period schedule (time of day)
tariff(iInObj)%periodSchIndex = GetScheduleIndex(cAlphaArgs(4)) !index to the period schedule
IF (tariff(iInObj)%periodSchIndex .EQ. 0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid data')
CALL ShowContinueError(' not found '//trim(cAlphaFieldNames(4))//'="'//TRIM(cAlphaArgs(4)) //'".')
ErrorsFound=.true.
END IF
ELSE
tariff(iInObj)%periodSchIndex = 0 !flag value for no schedule used
END IF
! season schedule
IF (LEN_TRIM(cAlphaArgs(5)) .GT. 0) THEN
tariff(iInObj)%seasonSchedule = cAlphaArgs(5) !name of the season schedule (winter/summer)
tariff(iInObj)%seasonSchIndex = GetScheduleIndex(cAlphaArgs(5)) !index to the season schedule
IF (tariff(iInObj)%seasonSchIndex .EQ. 0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid data')
CALL ShowContinueError(' not found '//trim(cAlphaFieldNames(5))//'="'//TRIM(cAlphaArgs(5)) //'".')
ErrorsFound=.true.
END IF
ELSE
tariff(iInObj)%seasonSchIndex = 0 !flag value for no schedule used
END IF
! month schedule
IF (LEN_TRIM(cAlphaArgs(6)) .GT. 0) THEN
tariff(iInObj)%monthSchedule = cAlphaArgs(6) !name of month schedule (when months end)
tariff(iInObj)%monthSchIndex = GetScheduleIndex(cAlphaArgs(6)) !index to the month schedule
IF (tariff(iInObj)%monthSchIndex .EQ. 0) THEN
CALL ShowSevereError(RoutineName//TRIM(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid data')
CALL ShowContinueError(' not found '//trim(cAlphaFieldNames(6))//'="'//TRIM(cAlphaArgs(6)) //'".')
ErrorsFound=.true.
END IF
ELSE
tariff(iInObj)%monthSchIndex = 0 !flag value for no schedule used
END IF
!type of demand window
IF (SameString(cAlphaArgs(7),'QuarterHour')) THEN
! check to make sure that the demand window and the TIMESTEP IN HOUR are consistant.
SELECT CASE (NumOfTimeStepInHour)
CASE (1,3,5,15)
tariff(iInObj)%demandWindow = demandWindowHour
tariff(iInObj)%demWinTime = 1.00d0
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid data')
CALL ShowContinueError('Demand window of QuarterHour is not consistent with number of timesteps per hour ['// &
trim(RoundSigDigits(NumOfTimeStepInHour))//'].')
CALL ShowContinueError('Demand window will be set to FullHour, and the simulation continues.')
CASE (2,6,10,30)
tariff(iInObj)%demandWindow = demandWindowHalf
tariff(iInObj)%demWinTime = 0.50d0
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid data')
CALL ShowContinueError('Demand window of QuarterHour is not consistent with number of timesteps per hour ['// &
trim(RoundSigDigits(NumOfTimeStepInHour))//'].')
CALL ShowContinueError('Demand window will be set to HalfHour, and the simulation continues.')
CASE (4,12,20,60)
tariff(iInObj)%demandWindow = demandWindowQuarter
tariff(iInObj)%demWinTime = 0.25d0
END SELECT
ELSE IF (SameString(cAlphaArgs(7),'HalfHour')) THEN
SELECT CASE (NumOfTimeStepInHour)
CASE (1,3,5,15)
tariff(iInObj)%demandWindow = demandWindowHour
tariff(iInObj)%demWinTime = 1.00d0
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid data')
CALL ShowContinueError('Demand window of HalfHour is not consistent with number of timesteps per hour ['// &
trim(RoundSigDigits(NumOfTimeStepInHour))//'].')
CALL ShowContinueError('Demand window will be set to FullHour, and the simulation continues.')
CASE (2,4,6,10,12,20,30,60)
tariff(iInObj)%demandWindow = demandWindowHalf
tariff(iInObj)%demWinTime = 0.50d0
END SELECT
ELSE IF (SameString(cAlphaArgs(7),'FullHour')) THEN
tariff(iInObj)%demandWindow = demandWindowHour
tariff(iInObj)%demWinTime = 1.00d0
ELSE IF (SameString(cAlphaArgs(7),'Day')) THEN
tariff(iInObj)%demandWindow = demandWindowDay
tariff(iInObj)%demWinTime = 24.00d0
ELSE IF (SameString(cAlphaArgs(7),'Week')) THEN
tariff(iInObj)%demandWindow = demandWindowWeek
tariff(iInObj)%demWinTime = 24.d0 * 7.d0
ELSE
! if not entered default to the same logic as quarter of an hour
SELECT CASE (NumOfTimeStepInHour)
CASE (1,3,5,15)
tariff(iInObj)%demandWindow = demandWindowHour
tariff(iInObj)%demWinTime = 1.00d0
CASE (2,6,10,30)
tariff(iInObj)%demandWindow = demandWindowHalf
tariff(iInObj)%demWinTime = 0.50d0
CASE (4,12,20,60)
tariff(iInObj)%demandWindow = demandWindowQuarter
tariff(iInObj)%demWinTime = 0.25d0
END SELECT
END IF
!monthly charge
tariff(iInObj)%monthChgVal = ProcessNumber(cAlphaArgs(8),isNotNumeric)
tariff(iInObj)%monthChgPt = AssignVariablePt(cAlphaArgs(8),isNotNumeric,varIsArgument,varNotYetDefined,kindUnknown,0,iInObj)
!minimum monthly charge
IF (LEN_TRIM(cAlphaArgs(9)) .GT. 0) THEN
tariff(iInObj)%minMonthChgVal = ProcessNumber(cAlphaArgs(9),isNotNumeric)
ELSE
tariff(iInObj)%minMonthChgVal = -HUGE(-1.0d0) !set to a very negative value
END IF
tariff(iInObj)%minMonthChgPt = AssignVariablePt(cAlphaArgs(9),isNotNumeric,varIsArgument,varNotYetDefined,kindUnknown,0,iInObj)
!real time pricing
tariff(iInObj)%chargeSchedule = cAlphaArgs(10)
tariff(iInObj)%chargeSchIndex = GetScheduleIndex(cAlphaArgs(10))
tariff(iInObj)%baseUseSchedule = cAlphaArgs(11)
tariff(iInObj)%baseUseSchIndex = GetScheduleIndex(cAlphaArgs(11))
!group name for separate distribution and transmission rates
tariff(iInObj)%groupName = cAlphaArgs(12)
!buy or sell option
IF (SameString(cAlphaArgs(13),'BuyFromUtility')) THEN
tariff(iInObj)%buyOrSell = buyFromUtility
ELSE IF (SameString(cAlphaArgs(13),'SellToUtility')) THEN
tariff(iInObj)%buyOrSell = sellToUtility
ELSE IF (SameString(cAlphaArgs(13),'NetMetering')) THEN
tariff(iInObj)%buyOrSell = netMetering
ELSE
tariff(iInObj)%buyOrSell = buyFromUtility
END IF
! check if meter is consistent with buy or sell option
IF ((tariff(iInObj)%buyOrSell .EQ. sellToUtility) .AND. &
(.NOT. SameString(tariff(iInObj)%reportMeter,'ELECTRICITYSURPLUSSOLD:FACILITY'))) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" atypical meter')
CALL ShowContinueError('The meter chosen "' // TRIM(tariff(iInObj)%reportMeter) // &
'" is not typically used with the sellToUtility option.')
CALL ShowContinueError('Usually the ElectricitySurplusSold:Facility meter is selected when the sellToUtility option is used.')
END IF
IF ((tariff(iInObj)%buyOrSell .EQ. netMetering) .AND. &
(.NOT. SameString(tariff(iInObj)%reportMeter,'ELECTRICITYNET:FACILITY'))) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" atypical meter')
CALL ShowContinueError('The meter chosen "' // TRIM(tariff(iInObj)%reportMeter) // &
' is not typically used with the netMetering option.')
CALL ShowContinueError('Usually the ElectricityNet:Facility meter is selected when the netMetering option is used.')
END IF
!also test the buy option for electricity
IF (tariff(iInObj)%buyOrSell .EQ. buyFromUtility) THEN
IF (INDEX(MakeUPPERCase(tariff(iInObj)%reportMeter),'ELEC') .GT. 0) THEN !test if electric meter
IF (.NOT. (SameString(tariff(iInObj)%reportMeter,'Electricity:Facility') .OR. &
SameString(tariff(iInObj)%reportMeter,'ElectricityPurchased:Facility'))) THEN
CALL ShowWarningError(RoutineName//TRIM(CurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" atypical meter')
CALL ShowContinueError('The meter chosen "' // TRIM(tariff(iInObj)%reportMeter) // &
' is not typically used with the buyFromUtility option.')
CALL ShowContinueError('Usually the Electricity:Facility meter or the '// &
'ElectricityPurchased:Facility is selected when the buyFromUtility option is used.')
ENDIF
END IF
END IF
! initialize gathering arrays
tariff(iInObj)%seasonForMonth = 0
tariff(iInObj)%gatherEnergy = 0.0d0
tariff(iInObj)%gatherDemand = 0.0d0
!assume that the tariff is qualified
tariff(iInObj)%isQualified = .TRUE.
tariff(iInObj)%ptDisqualifier = 0
!assume that the tariff is not selected
tariff(iInObj)%isSelected = .FALSE.
tariff(iInObj)%totalAnnualCost = 0.0d0
!now create the Table Of Contents entries for an HTML file
CALL AddTOCEntry('Tariff Report',tariff(iInObj)%tariffName)
!associate the resource number with each tariff
IF (Tariff(iInObj)%reportMeterIndx .GE. 1) THEN
tariff(iInObj)%resourceNum = AssignResourceTypeNum(EnergyMeters(Tariff(iInObj)%reportMeterIndx)%ResourceType)
END IF
END DO
END SUBROUTINE GetInputEconomicsTariff