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 GetCustomMeterInput(ErrorsFound)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN January 2006
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This routine will help implement "custom"/user defined meters. However, it must be called after all
! the other meters are set up and all report variables are established.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! Processes the objects:
! Meter:Custom,
! \extensible:2 - repeat last two fields, remembering to remove ; from "inner" fields.
! \memo Used to allow users to combine specific variables and/or meters into
! \memo "custom" meter configurations.
! A1, \field Name
! \required-field
! \reference CustomMeterNames
! A2, \field Fuel Type
! \type choice
! \key Electricity
! \key NaturalGas
! \key PropaneGas
! \key FuelOil#1
! \key FuelOil#2
! \key Coal
! \key Diesel
! \key Gasoline
! \key Water
! \key Generic
! \key OtherFuel1
! \key OtherFuel2
! A3, \field Key Name 1
! \required-field
! \begin-extensible
! A4, \field Report Variable or Meter Name 1
! \required-field
! <etc>
! AND
! Meter:CustomDecrement,
! \extensible:2 - repeat last two fields, remembering to remove ; from "inner" fields.
! \memo Used to allow users to combine specific variables and/or meters into
! \memo "custom" meter configurations.
! A1, \field Name
! \required-field
! \reference CustomMeterNames
! A2, \field Fuel Type
! \type choice
! \key Electricity
! \key NaturalGas
! \key PropaneGas
! \key FuelOil#1
! \key FuelOil#2
! \key Coal
! \key Diesel
! \key Gasoline
! \key Water
! \key Generic
! \key OtherFuel1
! \key OtherFuel2
! A3, \field Source Meter Name
! \required-field
! A4, \field Key Name 1
! \required-field
! \begin-extensible
! A5, \field Report Variable or Meter Name 1
! \required-field
! <etc>
! USE STATEMENTS:
USE DataIPShortCuts
USE InputProcessor
USE DataInterfaces, ONLY:GetVariableKeyCountandType, GetVariableKeys
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(INOUT) :: ErrorsFound
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER NumAlpha
INTEGER NumNumbers
INTEGER Loop
INTEGER IOStat
INTEGER NumCustomMeters
INTEGER NumCustomDecMeters
LOGICAL IsNotOK
LOGICAL IsBlank
INTEGER fldIndex
LOGICAL KeyIsStar
CHARACTER(len=MaxNameLength), DIMENSION(:), ALLOCATABLE :: NamesOfKeys ! Specific key name
INTEGER, DIMENSION(:) , ALLOCATABLE :: IndexesForKeyVar ! Array index
CHARACTER(len=MaxNameLength) :: UnitsVar ! Units sting, may be blank
CHARACTER(len=MaxNameLength) :: MeterUnits ! Units sting, may be blank
INTEGER :: KeyCount
INTEGER :: TypeVar
INTEGER :: AvgSumVar
INTEGER :: StepTypeVar
INTEGER :: iKey
INTEGER :: iKey1
LOGICAL :: MeterCreated
INTEGER, DIMENSION(:), ALLOCATABLE :: VarsOnCustomMeter
INTEGER, DIMENSION(:), ALLOCATABLE :: TempVarsOnCustomMeter
INTEGER :: MaxVarsOnCustomMeter
INTEGER :: NumVarsOnCustomMeter
INTEGER, DIMENSION(:), ALLOCATABLE :: VarsOnSourceMeter
INTEGER, DIMENSION(:), ALLOCATABLE :: TempVarsOnSourceMeter
INTEGER :: MaxVarsOnSourceMeter
INTEGER :: NumVarsOnSourceMeter
INTEGER :: iOnMeter
INTEGER :: WhichMeter
LOGICAL :: ErrFlag
LOGICAL :: BigErrorsFound
LOGICAL :: testa
LOGICAL :: testb
LOGICAL :: Tagged ! variable is appropriate to put on meter
INTEGER :: lbrackPos
BigErrorsFound=.false.
cCurrentModuleObject='Meter:Custom'
NumCustomMeters=GetNumObjectsFound(cCurrentModuleObject)
DO Loop=1,NumCustomMeters
CALL GetObjectItem(cCurrentModuleObject,Loop,cAlphaArgs,NumAlpha,rNumericArgs,NumNumbers,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
lbrackPos=INDEX(cAlphaArgs(1),'[')
IF (lbrackPos /= 0) cAlphaArgs(1)=cAlphaArgs(1)(1:lbrackPos-1)
MeterCreated=.false.
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),EnergyMeters%Name,NumEnergyMeters,IsNotOK,IsBlank,'Meter Names')
IF (IsNotOK) THEN
ErrorsFound=.true.
CYCLE
ENDIF
IF (ALLOCATED(VarsOnCustomMeter)) DEALLOCATE(VarsOnCustomMeter)
ALLOCATE(VarsOnCustomMeter(1000))
VarsOnCustomMeter=0
MaxVarsOnCustomMeter=1000
NumVarsOnCustomMeter=0
DO fldIndex=3,NumAlpha,2
IF (cAlphaArgs(fldIndex) == '*' .or. lAlphaFieldBlanks(fldIndex)) THEN
KeyIsStar=.true.
cAlphaArgs(fldIndex)='*'
ELSE
KeyIsStar=.false.
ENDIF
IF (lAlphaFieldBlanks(fldIndex+1)) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", blank '// &
TRIM(cAlphaFieldNames(fldIndex+1))//'.')
CALL ShowContinueError('...cannot create custom meter.')
BigErrorsFound=.true.
CYCLE
ENDIF
IF (BigErrorsFound) CYCLE
! Don't build/check things out if there were errors anywhere. Use "GetVariableKeys" to map to actual variables...
lbrackPos=INDEX(cAlphaArgs(fldIndex+1),'[')
IF (lbrackPos /= 0) cAlphaArgs(fldIndex+1)=cAlphaArgs(fldIndex+1)(1:lbrackPos-1)
Tagged=.false.
CALL GetVariableKeyCountandType(cAlphaArgs(fldIndex+1),KeyCount,TypeVar,AvgSumVar,StepTypeVar,UnitsVar)
IF (TypeVar == VarType_NotFound) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid '// &
TRIM(cAlphaFieldNames(fldIndex+1))//'="'//TRIM(cAlphaArgs(fldIndex+1))//'".')
CALL ShowContinueError('...will not be shown with the Meter results.')
CYCLE
ENDIF
IF (.not. MeterCreated) THEN
MeterUnits=UnitsVar ! meter units are same as first variable on custom meter
CALL AddMeter(cAlphaArgs(1),UnitsVar,BlankString,BlankString,BlankString,BlankString)
EnergyMeters(NumEnergyMeters)%TypeOfMeter=MeterType_Custom
! Can't use resource type in AddMeter cause it will confuse it with other meters. So, now:
CALL GetStandardMeterResourceType(EnergyMeters(NumEnergyMeters)%ResourceType,MakeUPPERCase(cAlphaArgs(2)),ErrFlag)
IF (ErrFlag) THEN
CALL ShowContinueError('..on '//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'".')
BigErrorsFound=.true.
ENDIF
CALL DetermineMeterIPUnits(EnergyMeters(NumEnergyMeters)%RT_forIPUnits,EnergyMeters(NumEnergyMeters)%ResourceType, &
UnitsVar,ErrFlag)
IF (ErrFlag) THEN
CALL ShowContinueError('..on '//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'".')
CALL ShowContinueError('..requests for IP units from this meter will be ignored.')
ENDIF
! EnergyMeters(NumEnergyMeters)%RT_forIPUnits=DetermineMeterIPUnits(EnergyMeters(NumEnergyMeters)%ResourceType,UnitsVar)
MeterCreated=.true.
ENDIF
IF (UnitsVar /= MeterUnits) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", differing units in '// &
TRIM(cAlphaFieldNames(fldIndex+1))//'="'//TRIM(cAlphaArgs(fldIndex+1))//'".')
CALL ShowContinueError('...will not be shown with the Meter results; units for meter='//TRIM(MeterUnits)// &
', units for this variable='//TRIM(UnitsVar)//'.')
CYCLE
ENDIF
IF ((TypeVar == VarType_Real .or. TypeVar == VarType_Integer) .and. AvgSumVar == SummedVar) THEN
Tagged=.true.
ALLOCATE(NamesOfKeys(KeyCount))
ALLOCATE(IndexesForKeyVar(KeyCount))
CALL GetVariableKeys(cAlphaArgs(fldIndex+1),TypeVar,NamesOfKeys,IndexesForKeyVar)
iOnMeter=0
IF (KeyIsStar) THEN
DO iKey = 1, KeyCount
NumVarsOnCustomMeter=NumVarsOnCustomMeter+1
IF (NumVarsOnCustomMeter > MaxVarsOnCustomMeter) THEN
MaxVarsOnCustomMeter=MaxVarsOnCustomMeter+100
ALLOCATE(TempVarsOnCustomMeter(MaxVarsOnCustomMeter))
TempVarsOnCustomMeter(1:MaxVarsOnCustomMeter-100)=VarsOnCustomMeter
TempVarsOnCustomMeter(MaxVarsOnCustomMeter-100+1:MaxVarsOnCustomMeter)=0
DEALLOCATE(VarsOnCustomMeter)
ALLOCATE(VarsOnCustomMeter(MaxVarsOnCustomMeter))
VarsOnCustomMeter=TempVarsOnCustomMeter
DEALLOCATE(TempVarsOnCustomMeter)
ENDIF
VarsOnCustomMeter(NumVarsOnCustomMeter)=IndexesForKeyVar(iKey)
iOnMeter=1
ENDDO
IF (iOnMeter == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid (all keys) '// &
TRIM(cAlphaFieldNames(fldIndex+1))//'="'//TRIM(cAlphaArgs(fldIndex+1))//'".')
ErrorsFound=.true.
ENDIF
ELSE ! Key is not "*"
DO iKey = 1, KeyCount
IF (NamesOfKeys(iKey) /= cAlphaArgs(fldIndex)) CYCLE
NumVarsOnCustomMeter=NumVarsOnCustomMeter+1
IF (NumVarsOnCustomMeter > MaxVarsOnCustomMeter) THEN
MaxVarsOnCustomMeter=MaxVarsOnCustomMeter+100
ALLOCATE(TempVarsOnCustomMeter(MaxVarsOnCustomMeter))
TempVarsOnCustomMeter(1:MaxVarsOnCustomMeter-100)=VarsOnCustomMeter
TempVarsOnCustomMeter(MaxVarsOnCustomMeter-100+1:MaxVarsOnCustomMeter)=0
DEALLOCATE(VarsOnCustomMeter)
ALLOCATE(VarsOnCustomMeter(MaxVarsOnCustomMeter))
VarsOnCustomMeter=TempVarsOnCustomMeter
DEALLOCATE(TempVarsOnCustomMeter)
ENDIF
VarsOnCustomMeter(NumVarsOnCustomMeter)=IndexesForKeyVar(iKey)
iOnMeter=1
ENDDO
IF (iOnMeter == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid '// &
TRIM(cAlphaArgs(fldIndex))//':'//TRIM(cAlphaArgs(fldIndex+1)))
ErrorsFound=.true.
ENDIF
ENDIF
DEALLOCATE(NamesOfKeys)
DEALLOCATE(IndexesForKeyVar)
ENDIF
IF (TypeVar == VarType_Meter .and. AvgSumVar == SummedVar) THEN
Tagged=.true.
ALLOCATE(NamesOfKeys(KeyCount))
ALLOCATE(IndexesForKeyVar(KeyCount))
CALL GetVariableKeys(cAlphaArgs(fldIndex+1),TypeVar,NamesOfKeys,IndexesForKeyVar)
WhichMeter=IndexesForKeyVar(1)
DEALLOCATE(NamesOfKeys)
DEALLOCATE(IndexesForKeyVar)
! for meters there will only be one key... but it has variables associated...
DO iOnMeter=1,NumVarMeterArrays
IF (.not. ANY(VarMeterArrays(iOnMeter)%OnMeters == WhichMeter) ) CYCLE
NumVarsOnCustomMeter=NumVarsOnCustomMeter+1
IF (NumVarsOnCustomMeter > MaxVarsOnCustomMeter) THEN
MaxVarsOnCustomMeter=MaxVarsOnCustomMeter+100
ALLOCATE(TempVarsOnCustomMeter(MaxVarsOnCustomMeter))
TempVarsOnCustomMeter(1:MaxVarsOnCustomMeter-100)=VarsOnCustomMeter
TempVarsOnCustomMeter(MaxVarsOnCustomMeter-100+1:MaxVarsOnCustomMeter)=0
DEALLOCATE(VarsOnCustomMeter)
ALLOCATE(VarsOnCustomMeter(MaxVarsOnCustomMeter))
VarsOnCustomMeter=TempVarsOnCustomMeter
DEALLOCATE(TempVarsOnCustomMeter)
ENDIF
VarsOnCustomMeter(NumVarsOnCustomMeter)=VarMeterArrays(iOnMeter)%RepVariable
ENDDO
ENDIF
IF (.not. Tagged) THEN ! couldn't find place for this item on a meter
IF (AvgSumVar /= SummedVar) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", variable not summed variable '// &
TRIM(cAlphaFieldNames(fldIndex+1))//'="'//TRIM(cAlphaArgs(fldIndex+1))//'".')
CALL ShowContinueError('...will not be shown with the Meter results; units for meter='//TRIM(MeterUnits)// &
', units for this variable='//TRIM(UnitsVar)//'.')
ENDIF
ENDIF
ENDDO
! Check for duplicates
DO iKey=1,NumVarsOnCustomMeter
IF (VarsOnCustomMeter(iKey) == 0) CYCLE
DO iKey1=iKey+1,NumVarsOnCustomMeter
IF (iKey == iKey1) CYCLE
IF (VarsOnCustomMeter(iKey) /= VarsOnCustomMeter(iKey1)) CYCLE
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", duplicate name="'// &
TRIM(RVariableTypes(VarsOnCustomMeter(iKey1))%VarName)//'".')
CALL ShowContinueError('...only one value with this name will be shown with the Meter results.')
VarsOnCustomMeter(iKey1)=0
ENDDO
ENDDO
DO iKey=1,NumVarsOnCustomMeter
IF (VarsOnCustomMeter(iKey) == 0) CYCLE
RVariable=>RVariableTypes(VarsOnCustomMeter(iKey))%Varptr
CALL AttachCustomMeters(MeterUnits,VarsOnCustomMeter(iKey),RVariable%MeterArrayPtr, &
NumEnergyMeters,ErrorsFound)
ENDDO
IF (NumVarsOnCustomMeter == 0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", no items assigned ')
CALL ShowContinueError('...will not be shown with the Meter results')
ENDIF
ENDDO
cCurrentModuleObject='Meter:CustomDecrement'
NumCustomDecMeters=GetNumObjectsFound(cCurrentModuleObject)
DO Loop=1,NumCustomDecMeters
CALL GetObjectItem(cCurrentModuleObject,Loop,cAlphaArgs,NumAlpha,rNumericArgs,NumNumbers,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
lbrackPos=INDEX(cAlphaArgs(1),'[')
IF (lbrackPos /= 0) cAlphaArgs(1)=cAlphaArgs(1)(1:lbrackPos-1)
MeterCreated=.false.
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),EnergyMeters%Name,NumEnergyMeters,IsNotOK,IsBlank,'Meter Names')
IF (IsNotOK) THEN
ErrorsFound=.true.
CYCLE
ENDIF
IF (ALLOCATED(VarsOnCustomMeter)) DEALLOCATE(VarsOnCustomMeter)
ALLOCATE(VarsOnCustomMeter(1000))
VarsOnCustomMeter=0
MaxVarsOnCustomMeter=1000
NumVarsOnCustomMeter=0
lbrackPos=INDEX(cAlphaArgs(3),'[')
IF (lbrackPos /= 0) cAlphaArgs(1)=cAlphaArgs(3)(1:lbrackPos-1)
WhichMeter=FindItem(cAlphaArgs(3),EnergyMeters%Name,NumEnergyMeters)
IF (WhichMeter == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid '// &
TRIM(cAlphaFieldNames(3))//'="'//TRIM(cAlphaArgs(3))//'".')
ErrorsFound=.true.
CYCLE
ENDIF
! Set up array of Vars that are on the source meter (for later validation).
IF (ALLOCATED(VarsOnSourceMeter)) DEALLOCATE(VarsOnSourceMeter)
ALLOCATE(VarsOnSourceMeter(1000))
VarsOnSourceMeter=0
MaxVarsOnSourceMeter=1000
NumVarsOnSourceMeter=0
DO iKey=1,NumVarMeterArrays
IF (VarMeterArrays(iKey)%NumOnMeters == 0 .and. VarMeterArrays(iKey)%NumOnCustomMeters == 0) CYCLE
! On a meter
IF (ANY(VarMeterArrays(iKey)%OnMeters==WhichMeter)) THEN
NumVarsOnSourceMeter=NumVarsOnSourceMeter+1
IF (NumVarsOnSourceMeter > MaxVarsOnSourceMeter) THEN
MaxVarsOnSourceMeter=MaxVarsOnSourceMeter+100
ALLOCATE(TempVarsOnSourceMeter(MaxVarsOnSourceMeter))
TempVarsOnSourceMeter(1:MaxVarsOnSourceMeter-100)=VarsOnSourceMeter
TempVarsOnSourceMeter(MaxVarsOnSourceMeter-100+1:MaxVarsOnSourceMeter)=0
DEALLOCATE(VarsOnSourceMeter)
ALLOCATE(VarsOnSourceMeter(MaxVarsOnSourceMeter))
VarsOnSourceMeter=TempVarsOnSourceMeter
DEALLOCATE(TempVarsOnSourceMeter)
ENDIF
VarsOnSourceMeter(NumVarsOnSourceMeter)=VarMeterArrays(iKey)%RepVariable
CYCLE
ENDIF
IF (VarMeterArrays(iKey)%NumOnCustomMeters == 0) CYCLE
IF (ANY(VarMeterArrays(iKey)%OnCustomMeters==WhichMeter)) THEN
NumVarsOnSourceMeter=NumVarsOnSourceMeter+1
IF (NumVarsOnSourceMeter > MaxVarsOnSourceMeter) THEN
MaxVarsOnSourceMeter=MaxVarsOnSourceMeter+100
ALLOCATE(TempVarsOnSourceMeter(MaxVarsOnSourceMeter))
TempVarsOnSourceMeter(1:MaxVarsOnSourceMeter-100)=VarsOnSourceMeter
TempVarsOnSourceMeter(MaxVarsOnSourceMeter-100+1:MaxVarsOnSourceMeter)=0
DEALLOCATE(VarsOnSourceMeter)
ALLOCATE(VarsOnSourceMeter(MaxVarsOnSourceMeter))
VarsOnSourceMeter=TempVarsOnSourceMeter
DEALLOCATE(TempVarsOnSourceMeter)
ENDIF
VarsOnSourceMeter(NumVarsOnSourceMeter)=VarMeterArrays(iKey)%RepVariable
CYCLE
ENDIF
ENDDO
DO fldIndex=4,NumAlpha,2
IF (cAlphaArgs(fldIndex) == '*' .or. lAlphaFieldBlanks(fldIndex)) THEN
KeyIsStar=.true.
cAlphaArgs(fldIndex)='*'
ELSE
KeyIsStar=.false.
ENDIF
IF (lAlphaFieldBlanks(fldIndex+1)) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", blank '// &
TRIM(cAlphaFieldNames(fldIndex+1))//'.')
CALL ShowContinueError('...cannot create custom meter.')
BigErrorsFound=.true.
CYCLE
ENDIF
IF (BigErrorsFound) CYCLE
Tagged=.false.
lbrackPos=INDEX(cAlphaArgs(fldIndex+1),'[')
IF (lbrackPos /= 0) cAlphaArgs(fldIndex+1)=cAlphaArgs(fldIndex+1)(1:lbrackPos-1)
! Don't build/check things out if there were errors anywhere. Use "GetVariableKeys" to map to actual variables...
CALL GetVariableKeyCountandType(cAlphaArgs(fldIndex+1),KeyCount,TypeVar,AvgSumVar,StepTypeVar,UnitsVar)
IF (TypeVar == VarType_NotFound) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid '// &
TRIM(cAlphaFieldNames(fldIndex+1))//'="'//TRIM(cAlphaArgs(fldIndex+1))//'".')
CALL ShowContinueError('...will not be shown with the Meter results.')
CYCLE
ENDIF
IF (.not. MeterCreated) THEN
MeterUnits=UnitsVar
CALL AddMeter(cAlphaArgs(1),UnitsVar,BlankString,BlankString,BlankString,BlankString)
EnergyMeters(NumEnergyMeters)%TypeOfMeter=MeterType_CustomDec
EnergyMeters(NumEnergyMeters)%SourceMeter=WhichMeter
! Can't use resource type in AddMeter cause it will confuse it with other meters. So, now:
CALL GetStandardMeterResourceType(EnergyMeters(NumEnergyMeters)%ResourceType,MakeUPPERCase(cAlphaArgs(2)),ErrFlag)
IF (ErrFlag) THEN
CALL ShowContinueError('..on '//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'".')
BigErrorsFound=.true.
ENDIF
CALL DetermineMeterIPUnits(EnergyMeters(NumEnergyMeters)%RT_forIPUnits,EnergyMeters(NumEnergyMeters)%ResourceType, &
UnitsVar,ErrFlag)
IF (ErrFlag) THEN
CALL ShowContinueError('..on '//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'".')
CALL ShowContinueError('..requests for IP units from this meter will be ignored.')
ENDIF
! EnergyMeters(NumEnergyMeters)%RT_forIPUnits=DetermineMeterIPUnits(EnergyMeters(NumEnergyMeters)%ResourceType,UnitsVar)
MeterCreated=.true.
ENDIF
IF (UnitsVar /= MeterUnits) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", differing units in '// &
TRIM(cAlphaFieldNames(fldIndex+1))//'="'//TRIM(cAlphaArgs(fldIndex+1))//'".')
CALL ShowContinueError('...will not be shown with the Meter results; units for meter='//TRIM(MeterUnits)// &
', units for this variable='//TRIM(UnitsVar)//'.')
CYCLE
ENDIF
IF ((TypeVar == VarType_Real .or. TypeVar == VarType_Integer) .and. AvgSumVar == SummedVar) THEN
Tagged=.true.
ALLOCATE(NamesOfKeys(KeyCount))
ALLOCATE(IndexesForKeyVar(KeyCount))
CALL GetVariableKeys(cAlphaArgs(fldIndex+1),TypeVar,NamesOfKeys,IndexesForKeyVar)
iOnMeter=0
IF (KeyIsStar) THEN
DO iKey = 1, KeyCount
NumVarsOnCustomMeter=NumVarsOnCustomMeter+1
IF (NumVarsOnCustomMeter > MaxVarsOnCustomMeter) THEN
MaxVarsOnCustomMeter=MaxVarsOnCustomMeter+100
ALLOCATE(TempVarsOnCustomMeter(MaxVarsOnCustomMeter))
TempVarsOnCustomMeter(1:MaxVarsOnCustomMeter-100)=VarsOnCustomMeter
TempVarsOnCustomMeter(MaxVarsOnCustomMeter-100+1:MaxVarsOnCustomMeter)=0
DEALLOCATE(VarsOnCustomMeter)
ALLOCATE(VarsOnCustomMeter(MaxVarsOnCustomMeter))
VarsOnCustomMeter=TempVarsOnCustomMeter
DEALLOCATE(TempVarsOnCustomMeter)
ENDIF
VarsOnCustomMeter(NumVarsOnCustomMeter)=IndexesForKeyVar(iKey)
iOnMeter=1
ENDDO
IF (iOnMeter == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid (all keys) '// &
TRIM(cAlphaFieldNames(fldIndex+1))//'="'//TRIM(cAlphaArgs(fldIndex+1))//'".')
ErrorsFound=.true.
ENDIF
ELSE
DO iKey = 1, KeyCount
IF (NamesOfKeys(iKey) /= cAlphaArgs(fldIndex)) CYCLE
NumVarsOnCustomMeter=NumVarsOnCustomMeter+1
IF (NumVarsOnCustomMeter > MaxVarsOnCustomMeter) THEN
MaxVarsOnCustomMeter=MaxVarsOnCustomMeter+100
ALLOCATE(TempVarsOnCustomMeter(MaxVarsOnCustomMeter))
TempVarsOnCustomMeter(1:MaxVarsOnCustomMeter-100)=VarsOnCustomMeter
TempVarsOnCustomMeter(MaxVarsOnCustomMeter-100+1:MaxVarsOnCustomMeter)=0
DEALLOCATE(VarsOnCustomMeter)
ALLOCATE(VarsOnCustomMeter(MaxVarsOnCustomMeter))
VarsOnCustomMeter=TempVarsOnCustomMeter
DEALLOCATE(TempVarsOnCustomMeter)
ENDIF
VarsOnCustomMeter(NumVarsOnCustomMeter)=IndexesForKeyVar(iKey)
iOnMeter=1
ENDDO
IF (iOnMeter == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid '// &
TRIM(cAlphaArgs(fldIndex))//':'//TRIM(cAlphaArgs(fldIndex+1)))
ErrorsFound=.true.
ENDIF
ENDIF
DEALLOCATE(NamesOfKeys)
DEALLOCATE(IndexesForKeyVar)
ENDIF
IF (TypeVar == VarType_Meter .and. AvgSumVar == SummedVar) THEN
Tagged=.true.
ALLOCATE(NamesOfKeys(KeyCount))
ALLOCATE(IndexesForKeyVar(KeyCount))
CALL GetVariableKeys(cAlphaArgs(fldIndex+1),TypeVar,NamesOfKeys,IndexesForKeyVar)
WhichMeter=IndexesForKeyVar(1)
DEALLOCATE(NamesOfKeys)
DEALLOCATE(IndexesForKeyVar)
! for meters there will only be one key... but it has variables associated...
DO iOnMeter=1,NumVarMeterArrays
testa = ANY(VarMeterArrays(iOnMeter)%OnMeters == WhichMeter)
testb = .false.
IF (VarMeterArrays(iOnMeter)%NumOnCustomMeters > 0) THEN
testb = ANY(VarMeterArrays(iOnMeter)%OnCustomMeters == WhichMeter)
ENDIF
IF (.not. (testa .or. testb) ) CYCLE
NumVarsOnCustomMeter=NumVarsOnCustomMeter+1
IF (NumVarsOnCustomMeter > MaxVarsOnCustomMeter) THEN
MaxVarsOnCustomMeter=MaxVarsOnCustomMeter+100
ALLOCATE(TempVarsOnCustomMeter(MaxVarsOnCustomMeter))
TempVarsOnCustomMeter(1:MaxVarsOnCustomMeter-100)=VarsOnCustomMeter
TempVarsOnCustomMeter(MaxVarsOnCustomMeter-100+1:MaxVarsOnCustomMeter)=0
DEALLOCATE(VarsOnCustomMeter)
ALLOCATE(VarsOnCustomMeter(MaxVarsOnCustomMeter))
VarsOnCustomMeter=TempVarsOnCustomMeter
DEALLOCATE(TempVarsOnCustomMeter)
ENDIF
VarsOnCustomMeter(NumVarsOnCustomMeter)=VarMeterArrays(iOnMeter)%RepVariable
ENDDO
ENDIF
IF (.not. Tagged) THEN ! couldn't find place for this item on a meter
IF (AvgSumVar /= SummedVar) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", variable not summed variable '// &
TRIM(cAlphaFieldNames(fldIndex+1))//'="'//TRIM(cAlphaArgs(fldIndex+1))//'".')
CALL ShowContinueError('...will not be shown with the Meter results; units for meter='//TRIM(MeterUnits)// &
', units for this variable='//TRIM(UnitsVar)//'.')
ENDIF
ENDIF
ENDDO
! Check for duplicates
DO iKey=1,NumVarsOnCustomMeter
IF (VarsOnCustomMeter(iKey) == 0) CYCLE
DO iKey1=iKey+1,NumVarsOnCustomMeter
IF (iKey == iKey1) CYCLE
IF (VarsOnCustomMeter(iKey) /= VarsOnCustomMeter(iKey1)) CYCLE
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", duplicate name="'// &
TRIM(RVariableTypes(VarsOnCustomMeter(iKey1))%VarName)//'".')
CALL ShowContinueError('...only one value with this name will be shown with the Meter results.')
VarsOnCustomMeter(iKey1)=0
ENDDO
ENDDO
DO iKey=1,NumVarsOnCustomMeter
IF (VarsOnCustomMeter(iKey) == 0) CYCLE
RVariable=>RVariableTypes(VarsOnCustomMeter(iKey))%Varptr
CALL AttachCustomMeters(MeterUnits,VarsOnCustomMeter(iKey),RVariable%MeterArrayPtr, &
NumEnergyMeters,ErrorsFound)
ENDDO
ErrFlag=.false.
DO iKey=1,NumVarsOnCustomMeter
DO iKey1=1,NumVarsOnSourceMeter
IF (ANY(VarsOnSourceMeter==VarsOnCustomMeter(iKey))) EXIT
IF (.not. ErrFlag) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid specification to '// &
TRIM(cAlphaFieldNames(3))//'="'//TRIM(cAlphaArgs(3))//'".')
ErrFlag=.true.
ENDIF
CALL ShowContinueError('..Variable='//TRIM(RVariableTypes(VarsOnCustomMeter(iKey))%VarName))
ErrorsFound=.true.
EXIT
ENDDO
ENDDO
IF (NumVarsOnCustomMeter == 0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", no items assigned ')
CALL ShowContinueError('...will not be shown with the Meter results')
ENDIF
DEALLOCATE(VarsOnCustomMeter)
DEALLOCATE(VarsOnSourceMeter)
ENDDO
IF (BigErrorsFound) ErrorsFound=.true.
RETURN
END SUBROUTINE GetCustomMeterInput