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) | :: | ComponentType | |||
character(len=*), | intent(in) | :: | ComponentName | |||
integer, | intent(out), | DIMENSION(:) | :: | VarIndexes | ||
integer, | intent(out), | DIMENSION(:) | :: | VarTypes | ||
integer, | intent(out), | DIMENSION(:) | :: | IndexTypes | ||
character(len=*), | intent(out), | DIMENSION(:) | :: | UnitsStrings | ||
integer, | intent(out), | DIMENSION(:) | :: | ResourceTypes | ||
character(len=*), | intent(out), | optional | DIMENSION(:) | :: | EndUses | |
character(len=*), | intent(out), | optional | DIMENSION(:) | :: | Groups | |
character(len=*), | intent(out), | optional | DIMENSION(:) | :: | Names | |
integer, | intent(out), | optional | :: | NumFound | ||
integer, | intent(out), | optional | DIMENSION(:) | :: | VarIDs |
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 GetMeteredVariables(ComponentType,ComponentName,VarIndexes,VarTypes,IndexTypes, &
UnitsStrings,ResourceTypes,EndUses,Groups,Names,NumFound,VarIDs)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN May 2005
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This routine gets the variable names and other associated information
! for metered variables associated with the given ComponentType/Name.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataPrecisionGlobals
USE InputProcessor, ONLY: MakeUPPERCase
USE DataGlobalConstants
USE OutputProcessor
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*), INTENT(IN) :: ComponentType ! Given Component Type
CHARACTER(len=*), INTENT(IN) :: ComponentName ! Given Component Name (user defined)
INTEGER, DIMENSION(:), INTENT(OUT) :: VarIndexes ! Variable Numbers
INTEGER, DIMENSION(:), INTENT(OUT) :: VarTypes ! Variable Types (1=integer, 2=real, 3=meter)
INTEGER, DIMENSION(:), INTENT(OUT) :: IndexTypes ! Variable Index Types (1=Zone,2=HVAC)
CHARACTER(len=*), DIMENSION(:), INTENT(OUT) :: UnitsStrings ! UnitsStrings for each variable
INTEGER, DIMENSION(:), INTENT(OUT) :: ResourceTypes ! ResourceTypes for each variable
CHARACTER(len=*), DIMENSION(:), &
OPTIONAL, INTENT(OUT) :: EndUses ! EndUses for each variable
CHARACTER(len=*), DIMENSION(:), &
OPTIONAL, INTENT(OUT) :: Groups ! Groups for each variable
CHARACTER(len=*), DIMENSION(:), &
OPTIONAL, INTENT(OUT) :: Names ! Variable Names for each variable
INTEGER, OPTIONAL, INTENT(OUT) :: NumFound ! Number Found
INTEGER, DIMENSION(:), OPTIONAL, INTENT(OUT) :: VarIDs ! Variable Report Numbers
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: Loop
INTEGER :: Pos
INTEGER :: NumVariables
INTEGER :: MeterPtr
INTEGER :: NumOnMeterPtr
INTEGER :: MeterNum
NumVariables=0
DO Loop=1,NumOfRVariable
! Pos=INDEX(RVariableTypes(Loop)%VarName,':')
! IF (ComponentName /= RVariableTypes(Loop)%VarNameUC(1:Pos-1)) CYCLE
IF (ComponentName /= RVariableTypes(Loop)%KeyNameOnlyUC) CYCLE
RVar=>RVariableTypes(Loop)%VarPtr
IF (RVar%MeterArrayPtr == 0) CYCLE
NumOnMeterPtr=VarMeterArrays(RVar%MeterArrayPtr)%NumOnMeters
MeterPtr=VarMeterArrays(RVar%MeterArrayPtr)%OnMeters(1)
NumVariables=NumVariables+1
VarIndexes(NumVariables)=Loop
VarTypes(NumVariables)=2
IndexTypes(NumVariables)=RVariableTypes(Loop)%IndexType
UnitsStrings(NumVariables)=RVariableTypes(Loop)%UnitsString
ResourceTypes(NumVariables)=AssignResourceTypeNum(MakeUPPERCase(EnergyMeters(MeterPtr)%ResourceType))
IF (PRESENT(Names)) THEN
Names(NumVariables)=RVariableTypes(Loop)%VarNameUC
ENDIF
IF (PRESENT(EndUses)) THEN
DO MeterNum=1,NumOnMeterPtr
MeterPtr=VarMeterArrays(RVar%MeterArrayPtr)%OnMeters(MeterNum)
IF (EnergyMeters(MeterPtr)%EndUse /= ' ') THEN
EndUses(NumVariables)=MakeUPPERCase(EnergyMeters(MeterPtr)%EndUse)
EXIT
ENDIF
ENDDO
ENDIF
IF (PRESENT(Groups)) THEN
DO MeterNum=1,NumOnMeterPtr
MeterPtr=VarMeterArrays(RVar%MeterArrayPtr)%OnMeters(MeterNum)
IF (EnergyMeters(MeterPtr)%Group /= ' ') THEN
Groups(NumVariables)=MakeUPPERCase(EnergyMeters(MeterPtr)%Group)
EXIT
ENDIF
ENDDO
ENDIF
IF (PRESENT(VarIDs)) THEN
VarIDs(NumVariables)=RVar%ReportID
ENDIF
ENDDO
IF (PRESENT(NumFound)) THEN
NumFound=NumVariables
ENDIF
RETURN
END SUBROUTINE GetMeteredVariables