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(in) | :: | varType | |||
| character(len=*), | intent(out), | DIMENSION(:) | :: | keyNames | ||
| integer, | intent(out), | DIMENSION(:) | :: | keyVarIndexes | 
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 GetVariableKeys(varName,varType,keyNames,keyVarIndexes)
          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Michael J. Witte
          !       DATE WRITTEN   August 2003
          !       MODIFIED       na
          !       RE-ENGINEERED  na
          ! PURPOSE OF THIS SUBROUTINE:
          ! This subroutine returns a list of keynames and indexes associated
          ! with a particular report variable or report meter name (varName).
          ! This routine assumes that the variable TYPE (Real, integer, meter, etc.)
          ! may be determined by calling GetVariableKeyCountandType.  The variable type
          ! and index can then be used with function GetInternalVariableValue to
          ! to retrieve the current value of a particular variable/keyname combination.
          ! METHODOLOGY EMPLOYED:
          ! Uses Internal OutputProcessor data structure to search for varName
          ! and build list of keynames and indexes.  The indexes are the array index
          ! in the data array for the
          ! REFERENCES:
          ! na
          ! USE STATEMENTS:
  USE DataPrecisionGlobals
  USE InputProcessor, ONLY: MakeUPPERCase
  USE OutputProcessor
  USE ScheduleManager, ONLY: GetScheduleIndex
  IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
          ! SUBROUTINE ARGUMENT DEFINITIONS:
  CHARACTER(len=*), INTENT(IN)                  :: varName       ! Standard variable name
  INTEGER, INTENT(IN)                           :: varType       ! 1=integer, 2=real, 3=meter
  CHARACTER(len=*), INTENT(OUT), DIMENSION(:)   :: keyNames      ! Specific key name
  INTEGER, INTENT(OUT), DIMENSION(:)            :: keyVarIndexes ! Array index for
          ! SUBROUTINE PARAMETER DEFINITIONS:
          ! na
          ! INTERFACE BLOCK SPECIFICATIONS:
          ! na
          ! DERIVED TYPE DEFINITIONS:
          ! na
          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
  INTEGER, EXTERNAL                      :: GetMeterIndex
  INTEGER                                :: Loop, Loop2      ! Loop counters
  INTEGER                                :: Position         ! Starting point of search string
  LOGICAL                                :: Duplicate        ! True if keyname is a duplicate
  INTEGER                                :: maxKeyNames      ! Max allowable # of key names=size of keyNames array
  INTEGER                                :: maxkeyVarIndexes ! Max allowable # of key indexes=size of keyVarIndexes array
  INTEGER                                :: numKeys          ! Number of keys found
  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
          ! INITIALIZATIONS
  keyNames         = ' '
  keyVarIndexes    = 0
  numKeys          = 0
  Duplicate        = .FALSE.
  maxKeyNames      = SIZE(keyNames)
  maxkeyVarIndexes = SIZE(keyVarIndexes)
  varNameUpper     = MakeUPPERCase(varName)
          ! Select based on variable type:  integer, real, or meter
  SELECT CASE (varType)
    CASE (VarType_Integer)  ! Integer
      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
            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 > maxKeyNames) .OR. (numKeys > maxkeyVarIndexes)) THEN
                CALL ShowFatalError('Invalid array size in GetVariableKeys')
              ENDIF
              keyNames(numKeys) = IVariableTypes(Loop)%VarNameUC(1:Position-1)
              keyVarIndexes(numKeys) = Loop
            ENDIF
          ENDIF
        ENDIF
      ENDDO
    CASE (VarType_Real)  ! Real
      DO Loop = 1, NumOfRVariable
          IF (RVariableTypes(Loop)%VarNameOnlyUC == varNameUpper) THEN
            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 > maxKeyNames) .OR. (numKeys > maxkeyVarIndexes)) THEN
                CALL ShowFatalError('Invalid array size in GetVariableKeys')
              ENDIF
              keyNames(numKeys) = RVariableTypes(Loop)%KeyNameOnlyUC
              keyVarIndexes(numKeys) = Loop
            ENDIF
          ENDIF
      ENDDO
    CASE (VarType_Meter)  ! Meter
      numKeys = 1
      IF ((numKeys > maxKeyNames) .OR. (numKeys > maxkeyVarIndexes)) THEN
        CALL ShowFatalError('Invalid array size in GetVariableKeys')
      ENDIF
      keyNames(1) = 'Meter'
      keyVarIndexes(1) = GetMeterIndex(varName)
    CASE (VarType_Schedule)  ! Schedule
      numKeys = 1
      IF ((numKeys > maxKeyNames) .OR. (numKeys > maxkeyVarIndexes)) THEN
        CALL ShowFatalError('Invalid array size in GetVariableKeys')
      ENDIF
      keyNames(1) = 'Environment'
      keyVarIndexes(1) = GetScheduleIndex(varName)
    CASE DEFAULT
      ! do nothing
  END SELECT
END SUBROUTINE GetVariableKeys