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 | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | IndexTypeKey |
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 GatherBinResultsForTimestep(IndexTypeKey)
! SUBROUTINE INFORMATION:
! AUTHOR Jason Glazer
! DATE WRITTEN August 2003
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Gathers the data each timesetp and adds the length of the
! timestep to the appropriate bin.
! USE STATEMENTS:
USE DataHVACGlobals, ONLY: TimeStepSys
USE DataEnvironment, ONLY: Month
USE ScheduleManager, ONLY: GetCurrentScheduleValue
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: IndexTypeKey ! What kind of data to update (Zone, HVAC)
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: iInObj
INTEGER :: jTable
REAL(r64) :: curValue
! values of OutputTableBinned array for current index
REAL(r64) :: curIntervalStart
REAL(r64) :: curIntervalSize
INTEGER :: curIntervalCount
INTEGER :: curResIndex
INTEGER :: curNumTables
INTEGER :: curTypeOfVar
INTEGER :: curScheduleIndex
REAL(r64) :: elapsedTime
LOGICAL :: gatherThisTime
!
REAL(r64) :: topValue
INTEGER :: binNum
INTEGER :: repIndex
INTEGER :: curStepType
!REAL(r64), external :: GetInternalVariableValue
IF (.NOT. DoWeathSim) RETURN
elapsedTime = TimeStepSys
timeInYear = timeInYear + elapsedTime
DO iInObj = 1, OutputTableBinnedCount
! get values of array for current object being referenced
curIntervalStart = OutputTableBinned(iInObj)%intervalStart
curIntervalSize = OutputTableBinned(iInObj)%intervalSize
curIntervalCount = OutputTableBinned(iInObj)%intervalCount
curResIndex = OutputTableBinned(iInObj)%resIndex
curNumTables = OutputTableBinned(iInObj)%numTables
topValue = curIntervalStart + curIntervalSize * curIntervalCount
curTypeOfVar = OutputTableBinned(iInObj)%typeOfVar
curStepType = OutputTableBinned(iInObj)%stepType
curScheduleIndex = OutputTableBinned(iInObj)%scheduleIndex
!if a schedule was used, check if it was non-zero value
IF (curScheduleIndex .NE. 0) THEN
IF (GetCurrentScheduleValue(curScheduleIndex) .NE. 0.0d0) THEN
gatherThisTime = .TRUE.
ELSE
gatherThisTime = .FALSE.
END IF
ELSE
gatherThisTime = .TRUE.
END IF
IF (gatherThisTime) THEN
DO jTable = 1, curNumTables
repIndex = curResIndex + (jTable - 1)
IF (((curStepType .EQ. stepTypeZone) .AND. (IndexTypeKey .EQ. ZoneTSReporting)) .OR. &
((curStepType .EQ. stepTypeHVAC) .AND. (IndexTypeKey .EQ. HVACTSReporting))) THEN
! put actual value from OutputProcesser arrays
curValue = GetInternalVariableValue(curTypeOfVar,BinObjVarID(repIndex)%varMeterNum)
! per MJW when a summed variable is used divide it by the length of the time step
IF (IndexTypeKey .EQ. HVACTSReporting) THEN
elapsedTime = TimeStepSys
ELSE
elapsedTime = TimeStepZone
ENDIF
IF (OutputTableBinned(iInObj)%avgSum .EQ. isSum) THEN ! if it is a summed variable
curValue = curValue / (elapsedTime * SecInHour)
END IF
! check if the value is above the maximum or below the minimum value
! first before binning the value within the range.
IF (curValue .LT. curIntervalStart) THEN
BinResultsBelow(repIndex)%mnth(month) = BinResultsBelow(repIndex)%mnth(month) + elapsedTime
BinResultsBelow(repIndex)%hrly(HourOfDay) = BinResultsBelow(repIndex)%hrly(HourOfDay) + elapsedTime
ELSE IF (curValue .GE. topValue) THEN
BinResultsAbove(repIndex)%mnth(month) = BinResultsAbove(repIndex)%mnth(month) + elapsedTime
BinResultsAbove(repIndex)%hrly(HourOfDay) = BinResultsAbove(repIndex)%hrly(HourOfDay) + elapsedTime
ELSE
! determine which bin the results are in
binNum = INT((curValue - curIntervalStart) / curIntervalSize) + 1
BinResults(repIndex,binNum)%mnth(month) = BinResults(repIndex,binNum)%mnth(month) + elapsedTime
BinResults(repIndex,binNum)%hrly(HourOfDay) = BinResults(repIndex,binNum)%hrly(HourOfDay) + elapsedTime
END IF
! add to statistics array
BinStatistics(repIndex)%n = BinStatistics(repIndex)%n + 1
BinStatistics(repIndex)%sum = BinStatistics(repIndex)%sum + curValue
BinStatistics(repIndex)%sum2 = BinStatistics(repIndex)%sum2 + curValue * curValue
IF (curValue .LT. BinStatistics(repIndex)%minimum) THEN
BinStatistics(repIndex)%minimum = curValue
ENDIF
IF (curValue .GT. BinStatistics(repIndex)%maximum) THEN
BinStatistics(repIndex)%maximum = curValue
ENDIF
END IF
END DO
END IF
END DO
END SUBROUTINE GatherBinResultsForTimestep