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 | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | varName | |||
integer, | intent(out) | :: | numKeys | |||
integer, | intent(out) | :: | varType | |||
integer, | intent(out) | :: | varAvgSum | |||
integer, | intent(out) | :: | varStepType | |||
character(len=*), | intent(out) | :: | varUnits |
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 GetVariableKeyCountandType(varName,numKeys,varType,varAvgSum,varStepType,varUnits)
! SUBROUTINE INFORMATION:
! AUTHOR Michael J. Witte
! DATE WRITTEN August 2003
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine returns the variable TYPE (Real, integer, meter, schedule, etc.)
! (varType) whether it is an averaged or summed variable (varAvgSum),
! whether it is a zone or HVAC time step (varStepType),
! and the number of keynames for a given report variable or report meter name
! (varName). The variable type (varType) and number of keys (numKeys) are
! used when calling subroutine GetVariableKeys to obtain a list of the
! keynames for a particular variable and a corresponding list of indexes.
! METHODOLOGY EMPLOYED:
! Uses Internal OutputProcessor data structure to search for varName
! in each of the three output data arrays:
! RVariableTypes - real report variables
! IVariableTypes - integer report variables
! EnergyMeters - report meters (via GetMeterIndex function)
! Schedules - specific schedule values
!
! When the variable is found, the variable type (varType) is set and the
! number of associated keys is counted.
!
! varType is assigned as follows:
! 0 = not found
! 1 = integer
! 2 = real
! 3 = meter
! 4 = schedule
!
! varAvgSum is assigned as follows:
! 1 = averaged
! 2 = summed
!
! varStepType is assigned as follows:
! 1 = zone time step
! 2 = HVAC time step
! REFERENCES:
! na
! USE STATEMENTS:
USE DataPrecisionGlobals
USE InputProcessor, ONLY: MakeUPPERCase, FindItemInSortedList
USE DataGlobals, ONLY: MaxNameLength
USE OutputProcessor
USE ScheduleManager, ONLY: GetScheduleIndex, GetScheduleType
USE SortAndStringUtilities, ONLY: SetupAndSort
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*), INTENT(IN) :: varName ! Standard variable name
INTEGER, INTENT(OUT) :: varType ! 0=not found, 1=integer, 2=real, 3=meter
INTEGER, INTENT(OUT) :: numKeys ! Number of keys found
INTEGER, INTENT(OUT) :: varAvgSum ! Variable is Averaged=1 or Summed=2
INTEGER, INTENT(OUT) :: varStepType ! Variable time step is Zone=1 or HVAC=2
CHARACTER(len=*), INTENT(OUT) :: varUnits ! Units sting, may be blank
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER, DIMENSION(:),ALLOCATABLE, SAVE :: keyVarIndexes ! Array index for specific key name
INTEGER, SAVE :: curkeyVarIndexLimit ! current limit for keyVarIndexes
LOGICAL, SAVE :: InitFlag=.true. ! for initting the keyVarIndexes array
INTEGER, EXTERNAL :: GetMeterIndex
INTEGER :: Loop, Loop2 ! Loop counters
INTEGER :: Position ! Starting point of search string
INTEGER :: VFound ! Found integer/real variable attributes
LOGICAL :: Found ! True if varName is found
LOGICAL :: Duplicate ! True if keyname is a duplicate
CHARACTER (len=MaxNameLength*2+1) :: VarKeyPlusName ! Full variable name including keyname and units
CHARACTER (len=MaxNameLength*2+1) :: varNameUpper ! varName pushed to all upper case
CHARACTER (len=MaxNameLength), &
DIMENSION(:), ALLOCATABLE, SAVE :: varNames ! stored variable names
INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: ivarNames ! pointers for sorted information
INTEGER, SAVE :: numvarNames ! number of variable names
! INITIALIZATIONS
IF (InitFlag) THEN
curKeyVarIndexLimit=1000
ALLOCATE(keyVarIndexes(curKeyVarIndexLimit))
numvarNames=NumVariablesForOutput
allocate(varNames(numvarNames))
allocate(ivarNames(numvarNames))
ivarNames=0
DO Loop = 1, NumVariablesForOutput
varNames(Loop) = MakeUPPERCase(DDVariableTypes(Loop)%VarNameOnly)
ENDDO
CALL SetupAndSort(varNames,ivarNames)
InitFlag=.false.
ENDIF
IF (numVarNames /= NumVariablesForOutput) THEN
deallocate(varnames)
deallocate(ivarnames)
numvarNames=NumVariablesForOutput
allocate(varNames(numvarNames))
allocate(ivarNames(numvarNames))
ivarNames=0
DO Loop = 1, NumVariablesForOutput
varNames(Loop) = MakeUPPERCase(DDVariableTypes(Loop)%VarNameOnly)
ENDDO
CALL SetupAndSort(varNames,ivarNames)
ENDIF
keyVarIndexes = 0
varType = VarType_NotFound
numKeys = 0
varAvgSum = 0
varStepType = 0
varUnits = ' '
Found = .FALSE.
Duplicate = .FALSE.
varNameUpper = varName
! Search Variable List First
VFound=FindItemInSortedList(varNameUpper,varNames,numvarNames)
IF (VFound /= 0) THEN
varType=DDVariableTypes(ivarNames(VFound))%VariableType
ENDIF
IF (varType == VarType_Integer) THEN
! Search Integer Variables
DO Loop = 1, NumOfIVariable
VarKeyPlusName = IVariableTypes(Loop)%VarNameUC
Position = INDEX(TRIM(VarKeyPlusName), &
':'//TRIM(varNameUpper), .TRUE.)
IF (Position > 0) THEN
IF (VarKeyPlusName(Position+1:) == varNameUpper) THEN
Found = .TRUE.
varType = VarType_Integer
Duplicate = .FALSE.
! Check if duplicate - duplicates happen if the same report variable/key name
! combination is requested more than once in the idf at different reporting
! frequencies
DO Loop2 = 1, numKeys
IF (VarKeyPlusName == IVariableTypes(keyVarIndexes(Loop2))%VarNameUC) Duplicate = .TRUE.
ENDDO
IF (.NOT. Duplicate) THEN
numKeys = numKeys + 1
IF (numKeys > curkeyVarIndexLimit) THEN
CALL ReallocateIntegerArray(keyVarIndexes,curkeyVarIndexLimit,500)
ENDIF
keyVarIndexes(numKeys) = Loop
varAvgSum = DDVariableTypes(ivarNames(VFound))%StoreType
varStepType = DDVariableTypes(ivarNames(VFound))%IndexType
varUnits = DDVariableTypes(ivarNames(VFound))%UnitsString
ENDIF
ENDIF
ENDIF
ENDDO
ELSEIF (varType == VarType_Real) THEN
! Search real Variables Next
DO Loop = 1, NumOfRVariable
IF (RVariableTypes(Loop)%VarNameOnlyUC == varNameUpper) THEN
Found = .TRUE.
varType = VarType_Real
Duplicate = .FALSE.
! Check if duplicate - duplicates happen if the same report variable/key name
! combination is requested more than once in the idf at different reporting
! frequencies
VarKeyPlusName = RVariableTypes(Loop)%VarNameUC
DO Loop2 = 1, numKeys
IF (VarKeyPlusName == RVariableTypes(keyVarIndexes(Loop2))%VarNameUC) Duplicate = .TRUE.
ENDDO
IF (.NOT. Duplicate) THEN
numKeys = numKeys + 1
IF (numKeys > curkeyVarIndexLimit) THEN
CALL ReallocateIntegerArray(keyVarIndexes,curkeyVarIndexLimit,500)
ENDIF
keyVarIndexes(numKeys) = Loop
varAvgSum = DDVariableTypes(ivarNames(VFound))%StoreType
varStepType = DDVariableTypes(ivarNames(VFound))%IndexType
varUnits = DDVariableTypes(ivarNames(VFound))%UnitsString
ENDIF
ENDIF
ENDDO
ENDIF
! Search Meters if not found in integers or reals
! Use the GetMeterIndex function
! Meters do not have keys, so only one will be found
IF (.NOT. Found) THEN
keyVarIndexes(1) = GetMeterIndex(varName)
IF (keyVarIndexes(1) > 0) THEN
Found = .TRUE.
numKeys = 1
varType = VarType_Meter
varUnits = EnergyMeters(keyVarIndexes(1))%Units
varAvgSum = SummedVar
varStepType = ZoneVar
ENDIF
ENDIF
! Search schedules if not found in integers, reals, or meters
! Use the GetScheduleIndex function
! Schedules do not have keys, so only one will be found
IF (.NOT. Found) THEN
keyVarIndexes(1) = GetScheduleIndex(varName)
IF (keyVarIndexes(1) > 0) THEN
Found = .TRUE.
numKeys = 1
varType = VarType_Schedule
varUnits = GetScheduleType(keyVarIndexes(1))
varAvgSum = AveragedVar
varStepType = ZoneVar
ENDIF
ENDIF
END SUBROUTINE GetVariableKeyCountandType