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 GetInputTabularMonthly
! SUBROUTINE INFORMATION:
! AUTHOR Jason Glazer
! DATE WRITTEN July 2003
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! The routine assigns the input information for
! REPORT:TABLE:MONTHLY also known as tabular monthly
! reports that are defined by the user. The input
! information is assigned to a data structure that
! is used for both user defined monthly reports and
! predefined monthly reports.
! METHODOLOGY EMPLOYED:
! Uses get input structure and call to build up
! data on monthly reports.
! REFERENCES:
! na
! USE STATEMENTS:
! na
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: CurrentModuleObject='Output:Table:Monthly'
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: TabNum ! index when cycling through each table
INTEGER :: curTable ! index of the current table being processed in MonthlyInput
INTEGER :: curAggType ! kind of aggregation identified (see AggType parameters)
CHARACTER(len=MaxNameLength) :: curAggString ! Current aggregation sting
INTEGER :: jField
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
LOGICAL, SAVE :: ErrorsFound=.false.
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
MonthlyInputCount = GetNumObjectsFound(CurrentModuleObject)
IF (MonthlyInputCount > 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
CALL GetObjectDefMaxArgs(CurrentModuleObject,NumParams,NumAlphas,NumNums)
ALLOCATE(AlphArray(NumAlphas))
AlphArray = ''
ALLOCATE(NumArray(NumNums))
NumArray=0.0d0
DO TabNum = 1 , MonthlyInputCount
CALL GetObjectItem(CurrentModuleObject,TabNum,AlphArray,NumAlphas, &
NumArray,NumNums,IOSTAT)
IsNotOK=.false.
IsBlank=.false.
IF (TabNum-1 > 0) THEN
CALL VerifyName(AlphArray(1),MonthlyInput%name,TabNum-1,IsNotOK,IsBlank,CurrentModuleObject//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) AlphArray(1)='RTMBLANK'
ENDIF
ENDIF
IF (NumAlphas .LT. 2) THEN
CALL ShowSevereError(CurrentModuleObject//': No fields specified.')
END IF
! add to the data structure
curTable = AddMonthlyReport(AlphArray(1),INT(NumArray(1)))
DO jField = 2,numAlphas,2
curAggString = AlphArray(jField + 1)
! set accumulator values to default as appropriate for aggregation type
IF (SameString(curAggString,'SumOrAverage')) THEN
curAggType = aggTypeSumOrAvg
ELSE IF (SameString(curAggString,'Maximum')) THEN
curAggType = aggTypeMaximum
ELSE IF (SameString(curAggString,'Minimum')) THEN
curAggType = aggTypeMinimum
ELSE IF (SameString(curAggString,'ValueWhenMaximumOrMinimum')) THEN
curAggType = aggTypeValueWhenMaxMin
ELSE IF (SameString(curAggString,'HoursZero')) THEN
curAggType = aggTypeHoursZero
ELSE IF (SameString(curAggString,'HoursNonzero')) THEN
curAggType = aggTypeHoursNonZero
ELSE IF (SameString(curAggString,'HoursPositive')) THEN
curAggType = aggTypeHoursPositive
ELSE IF (SameString(curAggString,'HoursNonpositive')) THEN
curAggType = aggTypeHoursNonPositive
ELSE IF (SameString(curAggString,'HoursNegative')) THEN
curAggType = aggTypeHoursNegative
ELSE IF (SameString(curAggString,'HoursNonnegative')) THEN
curAggType = aggTypeHoursNonNegative
ELSE IF (SameString(curAggString,'SumOrAverageDuringHoursShown')) THEN
curAggType = aggTypeSumOrAverageHoursShown
ELSE IF (SameString(curAggString,'MaximumDuringHoursShown')) THEN
curAggType = aggTypeMaximumDuringHoursShown
ELSE IF (SameString(curAggString,'MinimumDuringHoursShown')) THEN
curAggType = aggTypeMinimumDuringHoursShown
ELSE
curAggType = aggTypeSumOrAvg
CALL ShowWarningError(CurrentModuleObject//'='//TRIM(MonthlyInput(TabNum)%name)// &
', Variable name='//TRIM(AlphArray(jField)))
CALL ShowContinueError('Invalid aggregation type="'//TRIM(curAggString)//'" Defaulting to SumOrAverage.')
END IF
CALL AddMonthlyFieldSetInput(curTable,AlphArray(jField),'',curAggType)
END DO
END DO
DEALLOCATE(AlphArray)
DEALLOCATE(NumArray)
END SUBROUTINE GetInputTabularMonthly