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 GatherMonthlyResultsForTimestep(IndexTypeKey)
! SUBROUTINE INFORMATION:
! AUTHOR Jason Glazer
! DATE WRITTEN September 2003
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Gathers the data each timestep and updates the arrays
! holding the data that will be reported later.
! USE STATEMENTS:
USE DataHVACGlobals, ONLY: TimeStepSys,SysTimeElapsed
USE DataEnvironment, ONLY: Month, DayOfMonth
USE General, ONLY: EncodeMonDayHrMin,DetermineMinuteForReporting
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 :: iTable ! loop variable for monthlyTables
INTEGER :: jColumn ! loop variable for monthlyColumns
INTEGER :: curCol
REAL(r64) :: curValue
INTEGER :: curTypeOfVar
INTEGER :: curVarNum
REAL(r64) :: elapsedTime
REAL(r64) :: oldResultValue
INTEGER :: oldTimeStamp
REAL(r64) :: oldDuration
REAL(r64) :: newResultValue
INTEGER :: newTimeStamp
REAL(r64) :: newDuration
INTEGER :: timestepTimeStamp
LOGICAL :: activeMinMax
!LOGICAL,SAVE :: activeHoursShown=.false. !fix by LKL addressing CR6482
LOGICAL :: activeHoursShown
LOGICAL :: activeNewValue
INTEGER :: curStepType
INTEGER :: minuteCalculated
INTEGER :: kOtherColumn ! variable used in loop to scan through additional columns
INTEGER :: scanColumn
REAL(r64) :: scanValue
INTEGER :: scanTypeOfVar
INTEGER :: scanVarNum
REAL(r64) :: oldScanValue
! local copies of some of the MonthlyColumns array references since
! profiling showed that they were slow.
LOGICAL, SAVE :: RunOnce = .TRUE.
INTEGER,ALLOCATABLE,DIMENSION(:), SAVE :: MonthlyColumnsTypeOfVar
INTEGER,ALLOCATABLE,DIMENSION(:), SAVE :: MonthlyColumnsStepType
INTEGER,ALLOCATABLE,DIMENSION(:), SAVE :: MonthlyColumnsAggType
INTEGER,ALLOCATABLE,DIMENSION(:), SAVE :: MonthlyColumnsVarNum
INTEGER,ALLOCATABLE,DIMENSION(:), SAVE :: MonthlyTablesNumColumns
INTEGER :: curFirstColumn = 0
IF (.NOT. DoWeathSim) RETURN
!create temporary arrays to speed processing of these arrays
IF (RunOnce) THEN
!MonthlyColumns
ALLOCATE (MonthlyColumnsTypeOfVar(MonthlyColumnsCount))
MonthlyColumnsTypeOfVar = MonthlyColumns%typeOfVar
ALLOCATE (MonthlyColumnsStepType(MonthlyColumnsCount))
MonthlyColumnsStepType = MonthlyColumns%stepType
ALLOCATE (MonthlyColumnsAggType(MonthlyColumnsCount))
MonthlyColumnsAggType = MonthlyColumns%aggType
ALLOCATE (MonthlyColumnsVarNum(MonthlyColumnsCount))
MonthlyColumnsVarNum = MonthlyColumns%varNum
!MonthlyTables
ALLOCATE (MonthlyTablesNumColumns(MonthlyTablesCount))
MonthlyTablesNumColumns = MonthlyTables%numColumns
!set flag so this block is only executed once
RunOnce = .FALSE.
END IF
elapsedTime = TimeStepSys
IF (IndexTypeKey .EQ. HVACTSReporting) THEN
elapsedTime = TimeStepSys
ELSE
elapsedTime = TimeStepZone
ENDIF
IsMonthGathered(Month) = .TRUE.
DO iTable = 1, MonthlyTablesCount
activeMinMax = .FALSE. !at the beginning of the new timestep
activeHoursShown = .FALSE. !fix by JG addressing CR6482
curFirstColumn = MonthlyTables(iTable)%firstColumn
DO jColumn = 1, MonthlyTablesNumColumns(iTable)
curCol = jColumn + curFirstColumn - 1
curTypeOfVar = MonthlyColumnsTypeOfVar(curCol)
curStepType = MonthlyColumnsStepType(curCol)
IF (((curStepType .EQ. stepTypeZone) .AND. (IndexTypeKey .EQ. ZoneTSReporting)) .OR. &
((curStepType .EQ. stepTypeHVAC) .AND. (IndexTypeKey .EQ. HVACTSReporting))) THEN
! the above condition used to include the following prior to new scan method
! (MonthlyColumns(curCol)%aggType .EQ. aggTypeValueWhenMaxMin)
curVarNum = MonthlyColumnsVarNum(curCol)
curValue = GetInternalVariableValue(curTypeOfVar,curVarNum)
! Get the value from the result array
oldResultValue = MonthlyColumns(curCol)%reslt(Month)
oldTimeStamp = MonthlyColumns(curCol)%timeStamp(Month)
oldDuration = MonthlyColumns(curCol)%duration(Month)
! Zero the revised values (as default if not set later in SELECT)
newResultValue = 0.0d0
newTimeStamp = 0
newDuration = 0.0d0
activeNewValue = .FALSE.
! the current timestamp
minuteCalculated = DetermineMinuteForReporting(IndexTypeKey)
! minuteCalculated = (CurrentTime - INT(CurrentTime))*60
! IF (IndexTypeKey .EQ. stepTypeHVAC) minuteCalculated = minuteCalculated + SysTimeElapsed * 60
! minuteCalculated = INT((TimeStep-1) * TimeStepZone * 60) + INT((SysTimeElapsed + TimeStepSys) * 60)
CALL EncodeMonDayHrMin(timestepTimeStamp,Month,DayOfMonth,HourOfDay,minuteCalculated)
! perform the selected aggregation type
! use next lines since it is faster was: SELECT CASE (MonthlyColumns(curCol)%aggType)
SELECT CASE (MonthlyColumnsAggType(curCol))
CASE (aggTypeSumOrAvg)
IF (MonthlyColumns(curCol)%avgSum .EQ. isSum) THEN ! if it is a summed variable
newResultValue = oldResultValue + curValue
ELSE
newResultValue = oldResultValue + curValue * elapsedTime !for averaging - weight by elapsed time
END IF
newDuration = oldDuration + elapsedTime
activeNewValue = .TRUE.
CASE (aggTypeMaximum)
! per MJW when a summed variable is used divide it by the length of the time step
IF (MonthlyColumns(curCol)%avgSum .EQ. isSum) THEN ! if it is a summed variable
IF (IndexTypeKey .EQ. HVACTSReporting) THEN
curValue = curValue / (TimeStepSys * SecInHour)
ELSE
curValue = curValue / (TimeStepZone * SecInHour)
ENDIF
END IF
IF (curValue .GT. oldResultValue) THEN
newResultValue = curValue
newTimeStamp = timestepTimeStamp
activeMinMax = .TRUE.
activeNewValue = .TRUE.
ELSE
activeMinMax = .FALSE. !reset this
END IF
CASE (aggTypeMinimum)
! per MJW when a summed variable is used divide it by the length of the time step
IF (MonthlyColumns(curCol)%avgSum .EQ. isSum) THEN ! if it is a summed variable
IF (IndexTypeKey .EQ. HVACTSReporting) THEN
curValue = curValue / (TimeStepSys * SecInHour)
ELSE
curValue = curValue / (TimeStepZone * SecInHour)
ENDIF
END IF
IF (curValue .LT. oldResultValue) THEN
newResultValue = curValue
newTimeStamp = timestepTimeStamp
activeMinMax = .TRUE.
activeNewValue = .TRUE.
ELSE
activeMinMax = .FALSE. !reset this
END IF
CASE (aggTypeHoursZero)
IF (curValue .EQ. 0) THEN
newResultValue = oldResultValue + elapsedTime
activeHoursShown = .TRUE.
activeNewValue = .TRUE.
ELSE
activeHoursShown = .FALSE.
END IF
CASE (aggTypeHoursNonZero)
IF (curValue .NE. 0) THEN
newResultValue = oldResultValue + elapsedTime
activeHoursShown = .TRUE.
activeNewValue = .TRUE.
ELSE
activeHoursShown = .FALSE.
END IF
CASE (aggTypeHoursPositive)
IF (curValue .GT. 0) THEN
newResultValue = oldResultValue + elapsedTime
activeHoursShown = .TRUE.
activeNewValue = .TRUE.
ELSE
activeHoursShown = .FALSE.
END IF
CASE (aggTypeHoursNonPositive)
IF (curValue .LE. 0) THEN
newResultValue = oldResultValue + elapsedTime
activeHoursShown = .TRUE.
activeNewValue = .TRUE.
ELSE
activeHoursShown = .FALSE.
END IF
CASE (aggTypeHoursNegative)
IF (curValue .LT. 0) THEN
newResultValue = oldResultValue + elapsedTime
activeHoursShown = .TRUE.
activeNewValue = .TRUE.
ELSE
activeHoursShown = .FALSE.
END IF
CASE (aggTypeHoursNonNegative)
IF (curValue .GE. 0) THEN
newResultValue = oldResultValue + elapsedTime
activeHoursShown = .TRUE.
activeNewValue = .TRUE.
ELSE
activeHoursShown = .FALSE.
END IF
! The valueWhenMaxMin is picked up now during the activeMinMax if block below.
!CASE (aggTypeValueWhenMaxMin)
!CASE (aggTypeSumOrAverageHoursShown)
!CASE (aggTypeMaximumDuringHoursShown)
!CASE (aggTypeMinimumDuringHoursShown)
END SELECT
! if the new value has been set then set the monthly values to the
! new columns. This skips the aggregation types that don't even get
! triggered now such as valueWhenMinMax and all the agg*HoursShown
IF (activeNewValue) THEN
MonthlyColumns(curCol)%reslt(Month) = newResultValue
MonthlyColumns(curCol)%timeStamp(Month) = newTimeStamp
MonthlyColumns(curCol)%duration(Month) = newDuration
END IF
! if a minimum or maximum value was set this timeStep then
! scan the remaining columns of the table looking for values
! that are aggregation type "ValueWhenMaxMin" and set their values
! if another minimum or maximum column is found then end
! the scan (it will be taken care of when that column is done)
IF (activeMinMax) THEN
DO kOtherColumn = jColumn + 1, MonthlyTables(iTable)%numColumns
scanColumn = kOtherColumn + MonthlyTables(iTable)%firstColumn - 1
SELECT CASE (MonthlyColumns(scanColumn)%aggType)
CASE (aggTypeMaximum,aggTypeMinimum)
! end scanning since these might reset
EXIT !do
CASE (aggTypeValueWhenMaxMin)
! this case is when the value should be set
scanTypeOfVar = MonthlyColumns(scanColumn)%typeOfVar
scanVarNum = MonthlyColumns(scanColumn)%varNum
scanValue = GetInternalVariableValue(scanTypeOfVar,scanVarNum)
! When a summed variable is used divide it by the length of the time step
IF (MonthlyColumns(scanColumn)%avgSum .EQ. isSum) THEN ! if it is a summed variable
IF (IndexTypeKey .EQ. HVACTSReporting) THEN
scanValue = scanValue / (TimeStepSys * SecInHour)
ELSE
scanValue = scanValue / (TimeStepZone * SecInHour)
ENDIF
END IF
MonthlyColumns(scanColumn)%reslt(Month) = scanValue
CASE DEFAULT
! do nothing
END SELECT
END DO
END IF
! If the hours variable is active then scan through the rest of the variables
! and accumulate
IF (activeHoursShown) THEN
DO kOtherColumn = jColumn + 1, MonthlyTables(iTable)%numColumns
scanColumn = kOtherColumn + MonthlyTables(iTable)%firstColumn - 1
scanTypeOfVar = MonthlyColumns(scanColumn)%typeOfVar
scanVarNum = MonthlyColumns(scanColumn)%varNum
scanValue = GetInternalVariableValue(scanTypeOfVar,scanVarNum)
oldScanValue = MonthlyColumns(scanColumn)%reslt(Month)
SELECT CASE (MonthlyColumns(scanColumn)%aggType)
CASE (aggTypeHoursZero,aggTypeHoursNonZero)
! end scanning since these might reset
EXIT !do
CASE (aggTypeHoursPositive,aggTypeHoursNonPositive)
! end scanning since these might reset
EXIT !do
CASE (aggTypeHoursNegative,aggTypeHoursNonNegative)
! end scanning since these might reset
EXIT !do
CASE (aggTypeSumOrAverageHoursShown)
! this case is when the value should be set
IF (MonthlyColumns(scanColumn)%avgSum .EQ. isSum) THEN ! if it is a summed variable
MonthlyColumns(scanColumn)%reslt(Month) = oldScanValue + scanValue
ELSE
!for averaging - weight by elapsed time
MonthlyColumns(scanColumn)%reslt(Month) = oldScanValue + scanValue * elapsedTime
END IF
MonthlyColumns(scanColumn)%duration(Month) = MonthlyColumns(scanColumn)%duration(Month) + elapsedTime
CASE (aggTypeMaximumDuringHoursShown)
IF (MonthlyColumns(scanColumn)%avgSum .EQ. isSum) THEN ! if it is a summed variable
IF (IndexTypeKey .EQ. HVACTSReporting) THEN
scanValue = scanValue / (TimeStepSys * SecInHour)
ELSE
scanValue = scanValue / (TimeStepZone * SecInHour)
ENDIF
END IF
IF (scanValue .GT. oldScanValue) THEN
MonthlyColumns(scanColumn)%reslt(Month) = scanValue
MonthlyColumns(scanColumn)%timeStamp(Month) = timestepTimeStamp
END IF
CASE (aggTypeMinimumDuringHoursShown)
IF (MonthlyColumns(scanColumn)%avgSum .EQ. isSum) THEN ! if it is a summed variable
IF (IndexTypeKey .EQ. HVACTSReporting) THEN
scanValue = scanValue / (TimeStepSys * SecInHour)
ELSE
scanValue = scanValue / (TimeStepZone * SecInHour)
ENDIF
END IF
IF (scanValue .LT. oldScanValue) THEN
MonthlyColumns(scanColumn)%reslt(Month) = scanValue
MonthlyColumns(scanColumn)%timeStamp(Month) = timestepTimeStamp
END IF
CASE DEFAULT
! do nothing
END SELECT
activeHoursShown = .FALSE. !fixed CR8317
END DO
END IF
END IF
END DO
END DO
END SUBROUTINE GatherMonthlyResultsForTimestep