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.
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 GetInputTabularTimeBins
          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Jason Glazer
          !       DATE WRITTEN   July 2003
          !       MODIFIED       na
          !       RE-ENGINEERED  na
          ! PURPOSE OF THIS SUBROUTINE:
          !   This routine initializes the data structures based
          !   on input from in the IDF file.  The data structures
          !   follow the IDD closely.
          ! METHODOLOGY EMPLOYED:
          !   Uses get input structure similar to other objects
          ! REFERENCES:
          ! na
          ! USE STATEMENTS:
USE DataIPShortCuts
USE ScheduleManager, ONLY: GetScheduleIndex
IMPLICIT NONE
          ! SUBROUTINE ARGUMENT DEFINITIONS:
          ! na
          ! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: CurrentModuleObject='Output:Table:TimeBins'
          ! INTERFACE BLOCK SPECIFICATIONS:
          ! na
          ! DERIVED TYPE DEFINITIONS:
          ! na
          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER                     :: iInObj     ! index when cycling through each idf input object
INTEGER                     :: NumParams  ! Number of elements combined
INTEGER                     :: NumAlphas  ! Number of elements in the alpha array
INTEGER                     :: NumNums    ! Number of elements in the numeric array
CHARACTER(len=MaxNameLength),DIMENSION(:),ALLOCATABLE  :: AlphArray !character string data
REAL(r64), DIMENSION(:), ALLOCATABLE  :: NumArray  !numeric data
INTEGER                     :: IOStat     ! IO Status when calling get input subroutine
INTEGER                     :: iTable
INTEGER                     :: firstReport
INTEGER                     :: repIndex
INTEGER                     :: indx
INTEGER                     :: found
REAL(r64)                   :: bigVal !used with HUGE
CHARACTER(len=MaxNameLength),ALLOCATABLE,DIMENSION(:)  :: objNames
INTEGER,ALLOCATABLE,DIMENSION(:)                       :: objVarIDs
CALL GetObjectDefMaxArgs(CurrentModuleObject,NumParams,NumAlphas,NumNums)
ALLOCATE(AlphArray(NumAlphas))
AlphArray=' '
ALLOCATE(NumArray(NumNums))
NumArray=0.0d0
timeInYear=0.0d0 !intialize the time in year counter
! determine size of array that holds the IDF description
OutputTableBinnedCount = GetNumObjectsFound(CurrentModuleObject)
ALLOCATE(OutputTableBinned(OutputTableBinnedCount))
IF (OutputTableBinnedCount > 0) THEN
  WriteTabularFiles=.true.
  ! if not a run period using weather do not create reports
  IF (.NOT. DoWeathSim) THEN
    CALL ShowWarningError(CurrentModuleObject // &
       ' requested with SimulationControl Run Simulation for Weather File Run Periods set to No so ' &
        // CurrentModuleObject // ' will not be generated')
    RETURN
  END IF
END IF
! looking for maximum number of intervals for sizing
BinResultsIntervalCount = 0
BinResultsTableCount = 0
DO iInObj = 1 , OutputTableBinnedCount
  CALL GetObjectItem(CurrentModuleObject,iInObj,AlphArray,NumAlphas,NumArray,NumNums,IOSTAT,  &
                   AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks,  &
                   AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
  OutputTableBinned(iInObj)%keyValue      = AlphArray(1)
  OutputTableBinned(iInObj)%varOrMeter    = AlphArray(2)
  !if a schedule has been specified assign
  IF (LEN_TRIM(AlphArray(3)) .GT. 0) THEN
    OutputTableBinned(iInObj)%scheduleName  = AlphArray(3)
    OutputTableBinned(iInObj)%scheduleIndex = GetScheduleIndex(AlphArray(3))
    IF (OutputTableBinned(iInObj)%scheduleIndex .EQ. 0) THEN
      CALL ShowWarningError(CurrentModuleObject//': invalid '//TRIM(cAlphaFieldNames(3))//'="' //   &
         TRIM(AlphArray(3))//'" - not found.')
    END IF
  ELSE
    OutputTableBinned(iInObj)%scheduleIndex = 0 !flag value for no schedule used
  END IF
  !validate the kind of variable - not used internally except for validation
  IF (LEN_TRIM(AlphArray(4)) .GT. 0) THEN
    IF (.NOT. (SameString(AlphArray(4),'ENERGY') .OR. SameString(AlphArray(4),'DEMAND') .OR. &
      SameString(AlphArray(4),'TEMPERATURE') .OR. SameString(AlphArray(4),'FLOWRATE'))) THEN
      CALL ShowWarningError('In '//TRIM(CurrentModuleObject)//' named ' // TRIM(AlphArray(1)) //   &
                            ' the Variable Type was not energy, demand, temperature, or flowrate.')
    END IF
  END IF
  OutputTableBinned(iInObj)%intervalStart = NumArray(1)
  OutputTableBinned(iInObj)%intervalSize  = NumArray(2)
  OutputTableBinned(iInObj)%intervalCount = INT(NumArray(3))
  ! valid range checking on inputs
  IF (OutputTableBinned(iInObj)%intervalCount .LT. 1) THEN
    OutputTableBinned(iInObj)%intervalCount = 1
  END IF
  IF (OutputTableBinned(iInObj)%intervalCount .GT. 20) THEN
    OutputTableBinned(iInObj)%intervalCount = 20
  END IF
  IF (OutputTableBinned(iInObj)%intervalSize .LT. 0) THEN
    OutputTableBinned(iInObj)%intervalSize = 1000.0d0
  END IF
  OutputTableBinned(iInObj)%resIndex = BinResultsTableCount + 1  !the next results report
  ! find maximum number of intervals
  IF (OutputTableBinned(iInObj)%intervalCount .GT. BinResultsIntervalCount) THEN
    BinResultsIntervalCount = OutputTableBinned(iInObj)%intervalCount
  END IF
  CALL GetVariableKeyCountandType(OutputTableBinned(iInObj)%varOrMeter, OutputTableBinned(iInObj)%numTables, &
                                  OutputTableBinned(iInObj)%typeOfVar, OutputTableBinned(iInObj)%avgSum, &
                                  OutputTableBinned(iInObj)%stepType, OutputTableBinned(iInObj)%units)
  IF (OutputTableBinned(iInObj)%typeOfVar .EQ. 0) THEN
    CALL ShowWarningError(CurrentModuleObject//': User specified meter or variable not found: ' //   &
                            TRIM(OutputTableBinned(iInObj)%varOrMeter))
  END IF
  ! If only a single table key is requested than only one should be counted
  ! later will reset the numTables array pointer but for now use it to know
  ! how many items to scan through
  IF (OutputTableBinned(iInObj)%keyValue .EQ. '*') THEN
    BinResultsTableCount = BinResultsTableCount + OutputTableBinned(iInObj)%numTables
  ELSE
    BinResultsTableCount = BinResultsTableCount + 1  !if a particular key is requested then only one more report
  ENDIF
END DO
! size the arrays that holds the bin results
ALLOCATE(BinResults(BinResultsTableCount,BinResultsIntervalCount))
ALLOCATE(BinResultsBelow(BinResultsTableCount))
ALLOCATE(BinResultsAbove(BinResultsTableCount))
ALLOCATE(BinStatistics(BinResultsTableCount))
ALLOCATE(BinObjVarID(BinResultsTableCount))
! now that the arrays are sized go back and fill in
! what ID numbers are used for each table
DO iInObj = 1 , OutputTableBinnedCount
  firstReport = OutputTableBinned(iInObj)%resIndex
  ! allocate the arrays to the number of objects
  ALLOCATE(objNames(OutputTableBinned(iInObj)%numTables))
  ALLOCATE(objVarIDs(OutputTableBinned(iInObj)%numTables))
  CALL GetVariableKeys(OutputTableBinned(iInObj)%varOrMeter, OutputTableBinned(iInObj)%typeOfVar, objNames, objVarIDs)
  IF (OutputTableBinned(iInObj)%keyValue .EQ. '*') THEN
    DO iTable = 1, OutputTableBinned(iInObj)%numTables
      repIndex = firstReport + (iTable - 1)
      BinObjVarID(repIndex)%namesOfObj  = objNames(iTable)
      BinObjVarID(repIndex)%varMeterNum = objVarIDs(iTable)
      ! check if valid meter or number
      IF (objVarIDs(iTable) .EQ. 0) THEN
        CALL ShowWarningError(CurrentModuleObject//': Specified variable or meter not found: ' //   &
                            TRIM(objNames(iTable)))
      END IF
    END DO
  ELSE
    ! scan through the keys and look for the user specified key
    found = 0
    DO iTable = 1, OutputTableBinned(iInObj)%numTables
      IF (sameString(objNames(iTable),OutputTableBinned(iInObj)%keyValue)) THEN
        found = iTable
        EXIT
      END IF
    END DO
    ! the first and only report is assigned to the found object name
    IF (found .NE. 0) THEN
      BinObjVarID(firstReport)%namesOfObj  = objNames(found)
      BinObjVarID(firstReport)%varMeterNum = objVarIDs(found)
    ELSE
      CALL ShowWarningError(CurrentModuleObject//': Specified key not found, the first key will be used: ' //   &
                            TRIM(OutputTableBinned(iInObj)%keyValue))
      BinObjVarID(firstReport)%namesOfObj  = objNames(1)
      BinObjVarID(firstReport)%varMeterNum = objVarIDs(1)
      IF (objVarIDs(1) .EQ. 0) THEN
        CALL ShowWarningError(CurrentModuleObject//': Specified meter or variable not found: ' //   &
                            TRIM(objNames(1)))
      END IF
    END IF
    ! reset the number of tables to one
    OutputTableBinned(iInObj)%numTables = 1
  END IF
  ! release the arrays if they are already allocated
  DEALLOCATE(objNames)
  DEALLOCATE(objVarIDs)
END DO
! clear the binning arrays to zeros
! - not completely sure this approach will work
DO indx = 1, 12
  BinResults(1:BinResultsTableCount,1:BinResultsIntervalCount)%mnth(indx) = 0.0d0
  BinResultsBelow(1:BinResultsTableCount)%mnth(indx) = 0.0d0
  BinResultsAbove(1:BinResultsTableCount)%mnth(indx) = 0.0d0
END DO
DO indx = 1, 24
  BinResults(1:BinResultsTableCount,1:BinResultsIntervalCount)%hrly(indx) = 0.0d0
  BinResultsBelow(1:BinResultsTableCount)%hrly(indx) = 0.0d0
  BinResultsAbove(1:BinResultsTableCount)%hrly(indx) = 0.0d0
END DO
! initialize statistics counters
BinStatistics%minimum = HUGE(bigVal)
BinStatistics%maximum = -HUGE(bigVal)
BinStatistics%n       = 0
BinStatistics%sum     = 0.0d0
BinStatistics%sum2    = 0.0d0
DEALLOCATE(AlphArray)
DEALLOCATE(NumArray)
END SUBROUTINE GetInputTabularTimeBins