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