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 InitializeTabularMonthly
! SUBROUTINE INFORMATION:
! AUTHOR Jason Glazer
! DATE WRITTEN July 2008
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This routine initializes the data structures based
! on input from either the IDF file or from the predefined
! monthly reports. The data structures follow the IDD
! closely. The routine initializes many of the arrays
! for monthly tables.
! METHODOLOGY EMPLOYED:
! Process the data structures that define monthly tabular
! reports
! NOTE:
! The bulk of this routine used to be part of the the
! GetInputTabularMonthly routine but when predefined
! monthly reports were added this routine was seperated
! from input.
! REFERENCES:
! na
! USE STATEMENTS:
! na
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: TabNum ! index when cycling through each table
INTEGER :: NumColumns !number of columns specified in the input for an object
INTEGER :: FirstColumn !the first column of the monthly input
CHARACTER(len=MaxNameLength) :: curVariMeter ! current variable or meter
INTEGER :: colNum !loop index for columns
INTEGER :: KeyCount
INTEGER :: TypeVar
INTEGER :: AvgSumVar
INTEGER :: StepTypeVar
CHARACTER(len=MaxNameLength) :: UnitsVar ! Units sting, may be blank
!CHARACTER(len=MaxNameLength), DIMENSION(:), ALLOCATABLE :: NamesOfKeys ! Specific key name
!INTEGER, DIMENSION(:) , ALLOCATABLE :: IndexesForKeyVar ! Array index
CHARACTER(len=MaxNameLength), DIMENSION(:), ALLOCATABLE :: UniqueKeyNames
CHARACTER(len=MaxNameLength), DIMENSION(:), ALLOCATABLE :: tempUniqueKeyNames
INTEGER :: UniqueKeyCount
INTEGER :: iKey
INTEGER :: jUnique
INTEGER :: found
INTEGER :: kUniqueKey
INTEGER :: lTable
INTEGER :: mColumn
INTEGER :: ColumnsRecount
INTEGER :: TablesRecount
REAL(r64) :: bigNum=0.0d0
LOGICAL :: environmentKeyFound
LOGICAL, SAVE :: VarWarning=.true.
INTEGER, SAVE :: ErrCount1=0
INTEGER, SAVE :: ErrCount2=0
!INTEGER :: maxKeyCount
! if not a running a weather simulation do not create reports
IF (.NOT. DoWeathSim) RETURN
maxUniqueKeyCount=1500
ALLOCATE(UniqueKeyNames(maxUniqueKeyCount))
! First pass through the input objects is to put the name of the report
! into the array and count the number of unique keys found to allocate
! the monthlyTables and monthlyColumns
! This approach seems inefficient but I know of no other way to size
! the arrays prior to filling them and to size the arrays basically
! the same steps must be gone through as with filling the arrays.
!#ifdef ITM_KEYCACHE
! Noel comment: How about allocating these variables once for the whole routine?
! Again, if a max value for key count can be agreed upon, we could use it here --
! otherwise, will have to have re-allocate logic.
!maxKeyCount=1500 ! ?
!ALLOCATE(NamesOfKeys(maxKeyCount))
!ALLOCATE(IndexesForKeyVar(maxKeyCount))
!#endif
MonthlyColumnsCount = 0
MonthlyTablesCount = 0
DO TabNum = 1 , MonthlyInputCount
! the number of columns based on number of alpha fields
NumColumns = MonthlyInput(TabNum)%numFieldSet
FirstColumn = MonthlyInput(TabNum)%firstFieldSet
environmentKeyFound = .FALSE.
UniqueKeyCount = 0
DO ColNum = 1, NumColumns
!#ifdef ITM_KEYCACHE
! Noel comment: First time in this TabNum/ColNum loop, let's save the results
! of GetVariableKeyCountandType & GetVariableKeys.
curVariMeter = MakeUPPERCase(MonthlyFieldSetInput(FirstColumn + ColNum - 1)%variMeter)
! call the key count function but only need count during this pass
CALL GetVariableKeyCountandType(curVariMeter,KeyCount,TypeVar,AvgSumVar,StepTypeVar,UnitsVar)
! IF (KeyCount > maxKeyCount) THEN
! DEALLOCATE(NamesOfKeys)
! DEALLOCATE(IndexesForKeyVar)
! maxKeyCount=KeyCount
! ALLOCATE(NamesOfKeys(maxKeyCount))
! ALLOCATE(IndexesForKeyVar(maxKeyCount))
! ENDIF
ALLOCATE(MonthlyFieldSetInput(FirstColumn + ColNum - 1)%NamesOfKeys(KeyCount))
ALLOCATE(MonthlyFieldSetInput(FirstColumn + ColNum - 1)%IndexesForKeyVar(KeyCount))
! fill keys?
CALL GetVariableKeys(curVariMeter,TypeVar, &
MonthlyFieldSetInput(FirstColumn+ColNum-1)%NamesOfKeys,MonthlyFieldSetInput(FirstColumn+ColNum-1)%IndexesForKeyVar)
! save these values to use later -- noel
MonthlyFieldSetInput(FirstColumn + ColNum - 1)%variMeterUpper = curVariMeter
MonthlyFieldSetInput(FirstColumn + ColNum - 1)%typeOfVar = TypeVar
MonthlyFieldSetInput(FirstColumn + ColNum - 1)%keyCount = KeyCount
MonthlyFieldSetInput(FirstColumn + ColNum - 1)%varAvgSum = AvgSumVar
MonthlyFieldSetInput(FirstColumn + ColNum - 1)%varStepType = StepTypeVar
MonthlyFieldSetInput(FirstColumn + ColNum - 1)%varUnits = UnitsVar
! DO iKey = 1, KeyCount
! MonthlyFieldSetInput(FirstColumn + ColNum - 1)%NamesOfKeys(iKey) = NamesOfKeys(iKey) !noel
! MonthlyFieldSetInput(FirstColumn + ColNum - 1)%IndexesForKeyVar(iKey) = IndexesForKeyVar(iKey) !noel
! ENDDO
!#else
! curVariMeter = MakeUPPERCase(MonthlyFieldSetInput(FirstColumn + ColNum - 1)%variMeter)
! ! call the key count function but only need count during this pass
! CALL GetVariableKeyCountandType(curVariMeter,KeyCount,TypeVar,AvgSumVar,StepTypeVar,UnitsVar)
! ALLOCATE(NamesOfKeys(KeyCount))
! ALLOCATE(IndexesForKeyVar(KeyCount))
! CALL GetVariableKeys(curVariMeter,TypeVar,NamesOfKeys,IndexesForKeyVar)
!#endif
DO iKey = 1, KeyCount
found = 0
! set a flag if environment variables are found
IF (sameString(MonthlyFieldSetInput(FirstColumn+ColNum-1)%NamesOfKeys(iKey),"ENVIRONMENT")) THEN
environmentKeyFound = .TRUE.
found = -1 !so not counted in list of unique keys
END IF
DO jUnique = 1, UniqueKeyCount
IF (sameString(UniqueKeyNames(jUnique),MonthlyFieldSetInput(FirstColumn+ColNum-1)%NamesOfKeys(iKey))) THEN
found = jUnique
EXIT
END IF
END DO
IF (found .EQ. 0) THEN
UniqueKeyCount = UniqueKeyCount + 1
IF (UniqueKeyCount > maxUniqueKeyCount) THEN
ALLOCATE(tempUniqueKeyNames(maxUniqueKeyCount))
tempUniqueKeyNames=UniqueKeyNames
DEALLOCATE(UniqueKeyNames)
ALLOCATE(UniqueKeyNames(maxUniqueKeyCount+500))
UniqueKeyNames(1:maxUniqueKeyCount)=tempUniqueKeyNames
UniqueKeyNames(maxUniqueKeyCount+1:maxUniqueKeyCount+500)=' '
DEALLOCATE(tempUniqueKeyNames)
maxUniqueKeyCount=maxUniqueKeyCount+500
ENDIF
UniqueKeyNames(UniqueKeyCount) = MonthlyFieldSetInput(FirstColumn+ColNum-1)%NamesOfKeys(iKey)
END IF
END DO
!#ifdef ITM_KEYCACHE
! ! Don't deallocate here, only allocating/deallocating once for the whole routine
!#else
! DEALLOCATE(NamesOfKeys)
! DEALLOCATE(IndexesForKeyVar)
!#endif
END DO !colNum
! fix for CR8285 - when monthly report is only environmental variables
IF (environmentKeyFound .AND. UniqueKeyCount .EQ. 0) THEN
UniqueKeyCount = 1
END IF
! increment the number of tables based on the number of unique keys
MonthlyTablesCount = MonthlyTablesCount + UniqueKeyCount
MonthlyColumnsCount = MonthlyColumnsCount + UniqueKeyCount * NumColumns
END DO !TabNum the end of the loop through the inputs objects
! Now that we have the maximum size of the number of tables (each table is
! repeated for the number of keys found) and the number of total columns
! of all of the tables, allocate the arrays to store this information.
ALLOCATE (MonthlyTables(MonthlyTablesCount))
ALLOCATE (MonthlyColumns(MonthlyColumnsCount))
! Initialize tables and results
MonthlyTables%keyValue = ' '
MonthlyTables%firstColumn = 0
MonthlyTables%numColumns = 0
MonthlyColumns%varName = ' '
MonthlyColumns%varNum = 0
MonthlyColumns%typeOfVar = 0
MonthlyColumns%avgSum = 0
MonthlyColumns%stepType = 0
MonthlyColumns%units = ' '
MonthlyColumns%aggType = 0
DO ColNum = 1, MonthlyColumnsCount
MonthlyColumns(ColNum)%reslt = 0.0d0
MonthlyColumns(ColNum)%timeStamp = 0
MonthlyColumns(ColNum)%duration = 0.0d0
END DO
ColumnsRecount = 0
TablesRecount = 0
DO TabNum = 1 , MonthlyInputCount
! the number of columns based on number of alpha fields
NumColumns = MonthlyInput(TabNum)%numFieldSet
FirstColumn = MonthlyInput(TabNum)%firstFieldSet
UniqueKeyCount = 0
environmentKeyFound = .FALSE.
DO ColNum = 1, NumColumns
!#ifdef ITM_KEYCACHE
! Noel comment: Here is where we could use the saved values
curVariMeter = MonthlyFieldSetInput(FirstColumn + ColNum - 1)%variMeterUpper
KeyCount = MonthlyFieldSetInput(FirstColumn + ColNum - 1)%keyCount
TypeVar = MonthlyFieldSetInput(FirstColumn + ColNum - 1)%typeOfVar
AvgSumVar = MonthlyFieldSetInput(FirstColumn + ColNum - 1)%varAvgSum
StepTypeVar = MonthlyFieldSetInput(FirstColumn + ColNum - 1)%varStepType
UnitsVar = MonthlyFieldSetInput(FirstColumn + ColNum - 1)%varUnits
! DO iKey = 1, KeyCount !noel
! NamesOfKeys(iKey) = MonthlyFieldSetInput(FirstColumn + ColNum - 1)%NamesOfKeys(iKey) !noel
! IndexesForKeyVar(iKey) = MonthlyFieldSetInput(FirstColumn + ColNum - 1)%IndexesForKeyVar(iKey) !noel
! ENDDO
!#else
! curVariMeter = MakeUPPERCase(MonthlyFieldSetInput(FirstColumn + ColNum - 1)%variMeter)
! ! call the key count function but only need count during this pass
! CALL GetVariableKeyCountandType(curVariMeter,KeyCount,TypeVar,AvgSumVar,StepTypeVar,UnitsVar)
! ALLOCATE(NamesOfKeys(KeyCount))
! ALLOCATE(IndexesForKeyVar(KeyCount))
! CALL GetVariableKeys(curVariMeter,TypeVar,NamesOfKeys,IndexesForKeyVar)
!#endif
IF (KeyCount == 0) THEN
ErrCount1=ErrCount1+1
IF (ErrCount1 == 1 .and. .not. DisplayExtraWarnings .and. .not. VarWarning .and. KindOfSim == ksRunPeriodWeather) THEN
CALL ShowWarningError('Processing Monthly Tabular Reports: Variable names not valid for this simulation')
CALL ShowContinueError('...use Output:Diagnostics,DisplayExtraWarnings; to show more details on individual variables.')
ENDIF
!fixing CR5878 removed the showing of the warning once about a specific variable.
IF (DisplayExtraWarnings .and. KindOfSim == ksRunPeriodWeather) THEN
CALL ShowWarningError('Processing Monthly Tabular Reports: '//TRIM(MonthlyInput(TabNum)%name))
CALL ShowContinueError('..Variable name='//TRIM(curVariMeter)//' not valid for this simulation.')
IF (VarWarning) THEN
CALL ShowContinueError('..Variables not valid for this simulation will have "[Invalid/Undefined]"'// &
' in the Units Column of the Table Report.')
VarWarning=.false.
ENDIF
ENDIF
ENDIF
DO iKey = 1, KeyCount
found = 0
! set a flag if environment variables are found
IF (sameString(MonthlyFieldSetInput(FirstColumn+ColNum-1)%NamesOfKeys(iKey),"ENVIRONMENT")) THEN
environmentKeyFound = .TRUE.
found = -1 !so not counted in list of unique keys
END IF
DO jUnique = 1, UniqueKeyCount
IF (sameString(UniqueKeyNames(jUnique),MonthlyFieldSetInput(FirstColumn+ColNum-1)%NamesOfKeys(iKey))) THEN
found = jUnique
EXIT
END IF
END DO
IF (found .EQ. 0) THEN
UniqueKeyCount = UniqueKeyCount + 1
UniqueKeyNames(UniqueKeyCount) = MonthlyFieldSetInput(FirstColumn+ColNum-1)%NamesOfKeys(iKey)
END IF
END DO
!#ifdef ITM_KEYCACHE
! ! Don't deallocate here, only allocating/deallocating once for the whole routine
!#else
! DEALLOCATE(NamesOfKeys)
! DEALLOCATE(IndexesForKeyVar)
!#endif
END DO
! fix for CR8285 - when monthly report is only environmental variables
IF (environmentKeyFound .AND. UniqueKeyCount .EQ. 0) THEN
UniqueKeyCount = 1
END IF
! increment the number of tables based on the number of unique keys
MonthlyInput(TabNum)%firstTable = TablesRecount + 1
MonthlyInput(TabNum)%numTables = UniqueKeyCount
TablesRecount = TablesRecount + UniqueKeyCount
! loop through the different unique keys since each user defined table
! has that many instances - one for each unique key.
! It is unusual that this loop is about 'keys' and an inner loop is also
! about 'keys' but for this loop the keys are really instances of tables.
DO kUniqueKey = 1, UniqueKeyCount
lTable = kUniqueKey + MonthlyInput(TabNum)%firstTable - 1
!use the term 'environment' for identifying the report if
IF (environmentKeyFound .AND. UniqueKeyCount .EQ. 1) THEN
MonthlyTables(lTable)%keyValue = 'Environment'
ELSE !this is the most common case is to use the unique key for the report
MonthlyTables(lTable)%keyValue = UniqueKeyNames(kUniqueKey)
END IF
MonthlyTables(lTable)%firstColumn = ColumnsRecount + 1
MonthlyTables(lTable)%numColumns = NumColumns
ColumnsRecount = ColumnsRecount + NumColumns
FirstColumn = MonthlyInput(TabNum)%firstFieldSet
DO ColNum = 1, NumColumns
environmentKeyFound = .FALSE.
mColumn = ColNum + MonthlyTables(lTable)%firstColumn - 1
! when going through the columns this time, not all columns may have
! a EP variable that corresponds to it. In no variable is found
! then set it to 0 to be skipped during data gathering
!#ifdef ITM_KEYCACHE
! Noel comment: Here is where we could use the saved values
curVariMeter = MonthlyFieldSetInput(FirstColumn + ColNum - 1)%variMeterUpper
KeyCount = MonthlyFieldSetInput(FirstColumn + ColNum - 1)%keyCount
TypeVar = MonthlyFieldSetInput(FirstColumn + ColNum - 1)%typeOfVar
AvgSumVar = MonthlyFieldSetInput(FirstColumn + ColNum - 1)%varAvgSum
StepTypeVar = MonthlyFieldSetInput(FirstColumn + ColNum - 1)%varStepType
UnitsVar = MonthlyFieldSetInput(FirstColumn + ColNum - 1)%varUnits
! DO iKey = 1, KeyCount !noel
! NamesOfKeys(iKey) = MonthlyFieldSetInput(FirstColumn + ColNum - 1)%NamesOfKeys(iKey) !noel
! IndexesForKeyVar(iKey) = MonthlyFieldSetInput(FirstColumn + ColNum - 1)%IndexesForKeyVar(iKey) !noel
! ENDDO
!#else
! curVariMeter = MakeUPPERCase(MonthlyFieldSetInput(FirstColumn + ColNum - 1)%variMeter)
! ! call the key count function but only need count during this pass
! CALL GetVariableKeyCountandType(curVariMeter,KeyCount,TypeVar,AvgSumVar,StepTypeVar,UnitsVar)
! ALLOCATE(NamesOfKeys(KeyCount))
! ALLOCATE(IndexesForKeyVar(KeyCount))
! CALL GetVariableKeys(curVariMeter,TypeVar,NamesOfKeys,IndexesForKeyVar)
!#endif
IF (KeyCount .EQ. 1) THEN ! first test if KeyCount is one to avoid referencing a zero element array
IF (sameString(MonthlyFieldSetInput(FirstColumn+ColNum-1)%NamesOfKeys(1),"ENVIRONMENT")) THEN
environmentKeyFound = .TRUE.
END IF
END IF
! if this is an environment variable - don't bother searching
IF (environmentKeyFound) THEN
found = 1 !only one instance of environment variables so use it.
ELSE
! search through the keys for the currently active key "UniqueKeyNames(kUniqueKey)"
found = 0
DO iKey = 1, KeyCount
IF (sameString(MonthlyFieldSetInput(FirstColumn+ColNum-1)%NamesOfKeys(iKey), UniqueKeyNames(kUniqueKey))) THEN
found = iKey
EXIT
ENDIF
END DO
END IF
IF ((found .GT. 0) .AND. (KeyCount .GE. 1)) THEN
MonthlyColumns(mColumn)%varName = curVariMeter
MonthlyColumns(mColumn)%varNum = MonthlyFieldSetInput(FirstColumn+ColNum-1)%IndexesForKeyVar(found)
MonthlyColumns(mColumn)%typeOfVar = TypeVar
MonthlyColumns(mColumn)%avgSum = AvgSumVar
MonthlyColumns(mColumn)%stepType = StepTypeVar
MonthlyColumns(mColumn)%units = UnitsVar
MonthlyColumns(mColumn)%aggType = MonthlyFieldSetInput(FirstColumn + ColNum - 1)%aggregate
! set accumulator values to default as appropriate for aggregation type
SELECT CASE (MonthlyColumns(mColumn)%aggType)
CASE (aggTypeSumOrAvg)
MonthlyColumns(mColumn)%reslt = 0.0d0
MonthlyColumns(mColumn)%duration = 0.0d0
CASE (aggTypeMaximum)
MonthlyColumns(mColumn)%reslt = -HUGE(BigNum)
MonthlyColumns(mColumn)%timeStamp = 0
CASE (aggTypeMinimum)
MonthlyColumns(mColumn)%reslt = HUGE(BigNum)
MonthlyColumns(mColumn)%timeStamp = 0
CASE (aggTypeValueWhenMaxMin)
MonthlyColumns(mColumn)%reslt = 0.0d0
CASE (aggTypeHoursZero)
MonthlyColumns(mColumn)%reslt = 0.0d0
CASE (aggTypeHoursNonZero)
MonthlyColumns(mColumn)%reslt = 0.0d0
CASE (aggTypeHoursPositive)
MonthlyColumns(mColumn)%reslt = 0.0d0
CASE (aggTypeHoursNonPositive)
MonthlyColumns(mColumn)%reslt = 0.0d0
CASE (aggTypeHoursNegative)
MonthlyColumns(mColumn)%reslt = 0.0d0
CASE (aggTypeHoursNonNegative)
MonthlyColumns(mColumn)%reslt = 0.0d0
CASE (aggTypeSumOrAverageHoursShown)
MonthlyColumns(mColumn)%reslt = 0.0d0
MonthlyColumns(mColumn)%duration = 0.0d0
CASE (aggTypeMaximumDuringHoursShown)
MonthlyColumns(mColumn)%reslt = -HUGE(BigNum)
MonthlyColumns(mColumn)%timeStamp = 0
CASE (aggTypeMinimumDuringHoursShown)
MonthlyColumns(mColumn)%reslt = HUGE(BigNum)
MonthlyColumns(mColumn)%timeStamp = 0
END SELECT
ELSE !if no key corresponds to this instance of the report
ErrCount2=ErrCount2+1
IF (ErrCount2 == 1 .and. .not. DisplayExtraWarnings .and. .not. VarWarning .and. KindOfSim == ksRunPeriodWeather) THEN
CALL ShowWarningError('Processing Monthly Tabular Reports: Variable names not valid for this simulation')
CALL ShowContinueError('...use Output:Diagnostics,DisplayExtraWarnings; to show more details on individual variables.')
ENDIF
!fixing CR5878 removed the showing of the warning once about a specific variable.
IF (DisplayExtraWarnings .and. KindOfSim == ksRunPeriodWeather) THEN
CALL ShowWarningError('Processing Monthly Tabular Reports: '//TRIM(MonthlyInput(TabNum)%name))
CALL ShowContinueError('..Variable name='//TRIM(curVariMeter)//' not valid for this simulation.')
CALL ShowContinueError('..i.e., Variable name='//TRIM(UniqueKeyNames(kUniqueKey))//':'// &
TRIM(curVariMeter)//' not valid for this simulation.')
IF (VarWarning) THEN
CALL ShowContinueError('..Variables not valid for this simulation will have "[Invalid/Undefined]"'// &
' in the Units Column of the Table Report.')
VarWarning=.false.
ENDIF
ENDIF
MonthlyColumns(mColumn)%varName = curVariMeter
MonthlyColumns(mColumn)%varNum = 0
MonthlyColumns(mColumn)%typeOfVar = 0
MonthlyColumns(mColumn)%avgSum = 0
MonthlyColumns(mColumn)%stepType = 0
MonthlyColumns(mColumn)%units = 'Invalid/Undefined'
MonthlyColumns(mColumn)%aggType = aggTypeSumOrAvg
ENDIF
!#ifdef ITM_KEYCACHE
!#else
! DEALLOCATE(NamesOfKeys)
! DEALLOCATE(IndexesForKeyVar)
!#endif
END DO !ColNum
END DO !kUniqueKey
END DO !TabNum the end of the loop through the inputs objects
!#ifdef ITM_KEYCACHE
!DEALLOCATE(NamesOfKeys)
!DEALLOCATE(IndexesForKeyVar)
!#endif
IF (ALLOCATED(UniqueKeynames)) DEALLOCATE(UniqueKeyNames)
END SUBROUTINE InitializeTabularMonthly