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.
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 PreScanReportingVariables
          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Linda Lawrie
          !       DATE WRITTEN   July 2010
          !       MODIFIED       na
          !       RE-ENGINEERED  na
          ! PURPOSE OF THIS SUBROUTINE:
          ! This routine scans the input records and determines which output variables
          ! are actually being requested for the run so that the OutputProcessor will only
          ! consider those variables for output.  (At this time, all metered variables are
          ! allowed to pass through).
          ! METHODOLOGY EMPLOYED:
          ! Uses internal records and structures.
          ! Looks at:
          ! Output:Variable
          ! Meter:Custom
          ! Meter:CustomDecrement
          ! Meter:CustomDifference
          ! Output:Table:Monthly
          ! Output:Table:TimeBins
          ! Output:Table:SummaryReports
          ! EnergyManagementSystem:Sensor
          ! EnergyManagementSystem:OutputVariable
          ! REFERENCES:
          ! na
          ! USE STATEMENTS:
  USE DataOutputs
  IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
          ! SUBROUTINE ARGUMENT DEFINITIONS:
          ! na
          ! SUBROUTINE PARAMETER DEFINITIONS:
  CHARACTER(len=*), PARAMETER :: OutputVariable='OUTPUT:VARIABLE'
  CHARACTER(len=*), PARAMETER :: MeterCustom='METER:CUSTOM'
  CHARACTER(len=*), PARAMETER :: MeterCustomDecrement='METER:CUSTOMDECREMENT'
  CHARACTER(len=*), PARAMETER :: MeterCustomDifference='METER:CUSTOMDIFFERENCE'
  CHARACTER(len=*), PARAMETER :: OutputTableMonthly='OUTPUT:TABLE:MONTHLY'
  CHARACTER(len=*), PARAMETER :: OutputTableTimeBins='OUTPUT:TABLE:TIMEBINS'
  CHARACTER(len=*), PARAMETER :: OutputTableSummaries='OUTPUT:TABLE:SUMMARYREPORTS'
  CHARACTER(len=*), PARAMETER :: EMSSensor='ENERGYMANAGEMENTSYSTEM:SENSOR'
  CHARACTER(len=*), PARAMETER :: EMSOutputVariable='ENERGYMANAGEMENTSYSTEM:OUTPUTVARIABLE'
          ! INTERFACE BLOCK SPECIFICATIONS:
          ! na
          ! DERIVED TYPE DEFINITIONS:
          ! na
          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
  INTEGER :: CurrentRecord
  INTEGER :: Loop
  INTEGER :: Loop1
  ALLOCATE(OutputVariablesForSimulation(10000))
  MaxConsideredOutputVariables=10000
  ! Output Variable
  CurrentRecord=FindFirstRecord(OutputVariable)
  DO WHILE (CurrentRecord /= 0)
    IF (IDFRecords(CurrentRecord)%NumAlphas < 2) CYCLE  ! signals error condition for later on
    IF (.not. IDFRecords(CurrentRecord)%AlphBlank(1)) THEN
      CALL AddRecordToOutputVariableStructure(IDFRecords(CurrentRecord)%Alphas(1),IDFRecords(CurrentRecord)%Alphas(2))
    ELSE
      CALL AddRecordToOutputVariableStructure('*',IDFRecords(CurrentRecord)%Alphas(2))
    ENDIF
    CurrentRecord=FindNextRecord(OutputVariable,CurrentRecord)
  ENDDO
  CurrentRecord=FindFirstRecord(MeterCustom)
  DO WHILE (CurrentRecord /= 0)
    DO Loop=3,IDFRecords(CurrentRecord)%NumAlphas,2
      IF (Loop > IDFRecords(CurrentRecord)%NumAlphas .or. Loop+1 > IDFRecords(CurrentRecord)%NumAlphas) CYCLE  ! error condition
      IF (.not. IDFRecords(CurrentRecord)%AlphBlank(Loop)) THEN
        CALL AddRecordToOutputVariableStructure(IDFRecords(CurrentRecord)%Alphas(Loop),IDFRecords(CurrentRecord)%Alphas(Loop+1))
      ELSE
        CALL AddRecordToOutputVariableStructure('*',IDFRecords(CurrentRecord)%Alphas(Loop+1))
      ENDIF
    ENDDO
    CurrentRecord=FindNextRecord(MeterCustom,CurrentRecord)
  ENDDO
  CurrentRecord=FindFirstRecord(MeterCustomDecrement)
  DO WHILE (CurrentRecord /= 0)
    DO Loop=4,IDFRecords(CurrentRecord)%NumAlphas,2
      IF (Loop > IDFRecords(CurrentRecord)%NumAlphas .or. Loop+1 > IDFRecords(CurrentRecord)%NumAlphas) CYCLE  ! error condition
      IF (.not. IDFRecords(CurrentRecord)%AlphBlank(Loop)) THEN
        CALL AddRecordToOutputVariableStructure(IDFRecords(CurrentRecord)%Alphas(Loop),IDFRecords(CurrentRecord)%Alphas(Loop+1))
      ELSE
        CALL AddRecordToOutputVariableStructure('*',IDFRecords(CurrentRecord)%Alphas(Loop+1))
      ENDIF
    ENDDO
    CurrentRecord=FindNextRecord(MeterCustomDecrement,CurrentRecord)
  ENDDO
  CurrentRecord=FindFirstRecord(MeterCustomDifference)
  DO WHILE (CurrentRecord /= 0)
    DO Loop=4,IDFRecords(CurrentRecord)%NumAlphas,2
      IF (Loop > IDFRecords(CurrentRecord)%NumAlphas .or. Loop+1 > IDFRecords(CurrentRecord)%NumAlphas) CYCLE  ! error condition
      IF (.not. IDFRecords(CurrentRecord)%AlphBlank(Loop)) THEN
        CALL AddRecordToOutputVariableStructure(IDFRecords(CurrentRecord)%Alphas(Loop),IDFRecords(CurrentRecord)%Alphas(Loop+1))
      ELSE
        CALL AddRecordToOutputVariableStructure('*',IDFRecords(CurrentRecord)%Alphas(Loop+1))
      ENDIF
    ENDDO
    CurrentRecord=FindNextRecord(MeterCustomDifference,CurrentRecord)
  ENDDO
  CurrentRecord=FindFirstRecord(EMSSensor)
  DO WHILE (CurrentRecord /= 0)
    IF (IDFRecords(CurrentRecord)%NumAlphas < 2) CurrentRecord=FindNextRecord(EMSSensor,CurrentRecord)
    IF (IDFRecords(CurrentRecord)%Alphas(2) /= blank) THEN
      CALL AddRecordToOutputVariableStructure(IDFRecords(CurrentRecord)%Alphas(2),IDFRecords(CurrentRecord)%Alphas(3))
    ELSE
      CALL AddRecordToOutputVariableStructure('*',IDFRecords(CurrentRecord)%Alphas(3))
    ENDIF
    CurrentRecord=FindNextRecord(EMSSensor,CurrentRecord)
  ENDDO
  CurrentRecord=FindFirstRecord(EMSOutputVariable)
  DO WHILE (CurrentRecord /= 0)
    IF (IDFRecords(CurrentRecord)%NumAlphas < 2) CurrentRecord=FindNextRecord(EMSOutputVariable,CurrentRecord)
    CALL AddRecordToOutputVariableStructure('*',IDFRecords(CurrentRecord)%Alphas(1))
    CurrentRecord=FindNextRecord(EMSOutputVariable,CurrentRecord)
  ENDDO
  CurrentRecord=FindFirstRecord(OutputTableTimeBins)
  DO WHILE (CurrentRecord /= 0)
    IF (IDFRecords(CurrentRecord)%NumAlphas < 2) CurrentRecord=FindNextRecord(OutputTableTimeBins,CurrentRecord)
    IF (.not. IDFRecords(CurrentRecord)%AlphBlank(1)) THEN
      CALL AddRecordToOutputVariableStructure(IDFRecords(CurrentRecord)%Alphas(1),IDFRecords(CurrentRecord)%Alphas(2))
    ELSE
      CALL AddRecordToOutputVariableStructure('*',IDFRecords(CurrentRecord)%Alphas(2))
    ENDIF
    CurrentRecord=FindNextRecord(OutputTableTimeBins,CurrentRecord)
  ENDDO
  CurrentRecord=FindFirstRecord(OutputTableMonthly)
  DO WHILE (CurrentRecord /= 0)
    DO Loop=2,IDFRecords(CurrentRecord)%NumAlphas,2
      IF (IDFRecords(CurrentRecord)%NumAlphas < 2) CYCLE
      CALL AddRecordToOutputVariableStructure('*',IDFRecords(CurrentRecord)%Alphas(Loop))
    ENDDO
    CurrentRecord=FindNextRecord(OutputTableMonthly,CurrentRecord)
  ENDDO
  CurrentRecord=FindFirstRecord(OutputTableSummaries)  ! summary tables, not all add to variable structure
  DO WHILE (CurrentRecord /= 0)
    DO Loop=1,IDFRecords(CurrentRecord)%NumAlphas
      IF (IDFRecords(CurrentRecord)%Alphas(Loop) == 'ALLMONTHLY' .or.  &
          IDFRecords(CurrentRecord)%Alphas(Loop) == 'ALLSUMMARYANDMONTHLY') THEN
        DO Loop1=1,NumMonthlyReports
          CALL AddVariablesForMonthlyReport(MonthlyNamedReports(Loop1))
        ENDDO
      ELSE
        CALL AddVariablesForMonthlyReport(IDFRecords(CurrentRecord)%Alphas(Loop))
      ENDIF
    ENDDO
    CurrentRecord=FindNextRecord(OutputTableSummaries,CurrentRecord)
  ENDDO
  IF (NumConsideredOutputVariables > 0) THEN
    ALLOCATE(TempOutputVariablesForSimulation(NumConsideredOutputVariables))
    TempOutputVariablesForSimulation(1:NumConsideredOutputVariables)=OutputVariablesForSimulation(1:NumConsideredOutputVariables)
    DEALLOCATE(OutputVariablesForSimulation)
    ALLOCATE(OutputVariablesForSimulation(NumConsideredOutputVariables))
    OutputVariablesForSimulation(1:NumConsideredOutputVariables)=TempOutputVariablesForSimulation(1:NumConsideredOutputVariables)
    DEALLOCATE(TempOutputVariablesForSimulation)
    MaxConsideredOutputVariables=NumConsideredOutputVariables
  ENDIF
  RETURN
END SUBROUTINE PreScanReportingVariables