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 WriteTimeBinTables
! SUBROUTINE INFORMATION:
! AUTHOR Jason Glazer
! DATE WRITTEN August 2003
! MODIFIED January 2010, Kyle Benne
! Added SQLite output
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Set up the time bin tabular report results
! METHODOLOGY EMPLOYED:
! Creates several arrays that are passed to the writeTable
! routine. All arrays are strings so numbers need to be
! converted prior to calling writeTable.
USE SQLiteProcedures, ONLY: CreateSQLiteTabularDataRecords
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: fmta="(A)"
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: iInObj
INTEGER :: iTable
INTEGER :: kHour
INTEGER :: kMonth
INTEGER :: nCol
!main table
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: columnHead
INTEGER,ALLOCATABLE,DIMENSION(:) :: columnWidth
CHARACTER(len=MaxNameLength), DIMENSION(39) :: rowHead
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:,:) :: tableBody
!stat table
CHARACTER(len=MaxNameLength), DIMENSION(1) :: columnHeadStat
INTEGER,DIMENSION(1) :: columnWidthStat
CHARACTER(len=MaxNameLength), DIMENSION(6) :: rowHeadStat
CHARACTER(len=MaxNameLength), DIMENSION(6,1) :: tableBodyStat
REAL(r64) :: curIntervalStart
REAL(r64) :: curIntervalSize
INTEGER :: curIntervalCount
INTEGER :: curResIndex
INTEGER :: curNumTables
INTEGER :: numIntervalDigits
INTEGER :: firstReport
REAL(r64) :: topValue
INTEGER :: repIndex
REAL(r64) :: rowTotal
REAL(r64) :: colTotal
REAL(r64) :: aboveTotal
REAL(r64) :: belowTotal
REAL(r64) :: tableTotal
!CHARACTER(len=MaxNameLength):: repNameWithUnits ! For time bin reports, varible name with units
CHARACTER(len=MaxNameLength*2+15) :: repNameWithUnitsandscheduleName
REAL(r64) :: repStDev ! standard deviation
REAL(r64) :: repMean
CHARACTER(len=MaxNameLength) :: curNameWithSIUnits
CHARACTER(len=MaxNameLength) :: curNameAndUnits
INTEGER :: indexUnitConv
rowHead(1) = 'Interval Start'
rowHead(2) = 'Interval End'
rowHead(3) = 'January'
rowHead(4) = 'February'
rowHead(5) = 'March'
rowHead(6) = 'April'
rowHead(7) = 'May'
rowHead(8) = 'June'
rowHead(9) = 'July'
rowHead(10) = 'August'
rowHead(11) = 'September'
rowHead(12) = 'October'
rowHead(13) = 'November'
rowHead(14) = 'December'
rowHead(15) = '12:01 to 1:00 am'
rowHead(16) = ' 1:01 to 2:00 am'
rowHead(17) = ' 2:01 to 3:00 am'
rowHead(18) = ' 3:01 to 4:00 am'
rowHead(19) = ' 4:01 to 5:00 am'
rowHead(20) = ' 5:01 to 6:00 am'
rowHead(21) = ' 6:01 to 7:00 am'
rowHead(22) = ' 7:01 to 8:00 am'
rowHead(23) = ' 8:01 to 9:00 am'
rowHead(24) = ' 9:01 to 10:00 am'
rowHead(25) = '10:01 to 11:00 am'
rowHead(26) = '11:01 to 12:00 pm'
rowHead(27) = '12:01 to 1:00 pm'
rowHead(28) = ' 1:01 to 2:00 pm'
rowHead(29) = ' 2:01 to 3:00 pm'
rowHead(30) = ' 3:01 to 4:00 pm'
rowHead(31) = ' 4:01 to 5:00 pm'
rowHead(32) = ' 5:01 to 6:00 pm'
rowHead(33) = ' 6:01 to 7:00 pm'
rowHead(34) = ' 7:01 to 8:00 pm'
rowHead(35) = ' 8:01 to 9:00 pm'
rowHead(36) = ' 9:01 to 10:00 pm'
rowHead(37) = '10:01 to 11:00 pm'
rowHead(38) = '11:01 to 12:00 am'
rowHead(39) = 'Total'
DO iInObj = 1 , OutputTableBinnedCount
firstReport = OutputTableBinned(iInObj)%resIndex
curNameWithSIUnits = TRIM(OutputTableBinned(iInObj)%varOrMeter)//' ['//TRIM(OutputTableBinned(iInObj)%units) //']'
IF (unitsStyle .EQ. unitsStyleInchPound) THEN
CALL LookupSItoIP(curNameWithSIUnits, indexUnitConv, curNameAndUnits)
curIntervalStart = ConvertIP(indexUnitConv,OutputTableBinned(iInObj)%intervalStart)
curIntervalSize = ConvertIPdelta(indexUnitConv,OutputTableBinned(iInObj)%intervalSize)
ELSE
curNameAndUnits = curNameWithSIUnits
curIntervalStart = OutputTableBinned(iInObj)%intervalStart
curIntervalSize = OutputTableBinned(iInObj)%intervalSize
END IF
curIntervalCount = OutputTableBinned(iInObj)%intervalCount
curResIndex = OutputTableBinned(iInObj)%resIndex
curNumTables = OutputTableBinned(iInObj)%numTables
topValue = curIntervalStart + curIntervalSize * curIntervalCount
IF (curIntervalSize .LT. 1) THEN
numIntervalDigits = 4
ELSEIF (curIntervalSize .GE. 10) THEN
numIntervalDigits = 0
ELSE
numIntervalDigits = 2
END IF
! make arrays two columns wider for below and above bin range
ALLOCATE(columnHead(curIntervalCount + 3))
ALLOCATE(columnWidth(curIntervalCount + 3))
columnWidth = 14 !array assignment - same for all columns
ALLOCATE(tableBody(39,curIntervalCount + 3))
tableBody = ' '
columnHead = '-'
tableBody(1,1) = 'less than'
TableBody(2,1) = RealToStr(curIntervalStart,numIntervalDigits)
DO nCol = 1, curIntervalCount
columnHead(nCol + 1) = IntToStr(nCol)
!beginning of interval
tableBody(1,nCol + 1) = TRIM(RealToStr(curIntervalStart + (nCol-1)*curIntervalSize ,numIntervalDigits)) // '<='
!end of interval
tableBody(2,nCol + 1) = TRIM(RealToStr(curIntervalStart + nCol*curIntervalSize ,numIntervalDigits)) // '>'
END DO
TableBody(1, curIntervalCount + 2) = 'equal to or more than'
TableBody(2, curIntervalCount + 2) = RealToStr(topValue,numIntervalDigits)
TableBody(1, curIntervalCount + 3) = 'Row'
TableBody(2, curIntervalCount + 3) = 'Total'
DO iTable = 1, curNumTables
repIndex = firstReport + (iTable - 1)
IF (OutputTableBinned(iInObj)%scheduleIndex == 0) THEN
repNameWithUnitsandscheduleName = curNameAndUnits
ELSE
repNameWithUnitsandscheduleName = TRIM(curNameAndUnits) // &
' [' // TRIM(OutputTableBinned(iInObj)%ScheduleName) // ']'
ENDIF
CALL WriteReportHeaders(repNameWithUnitsandscheduleName, BinObjVarID(repIndex)%namesOfObj, OutputTableBinned(iInObj)%avgSum)
DO kHour = 1, 24
tableBody(14+kHour,1) = TRIM(RealToStr(BinResultsBelow(repIndex)%hrly(kHour),2))
tableBody(14+kHour,curIntervalCount+2) = RealToStr(BinResultsAbove(repIndex)%hrly(kHour),2)
rowTotal = BinResultsBelow(repIndex)%hrly(kHour) + BinResultsAbove(repIndex)%hrly(kHour)
DO nCol = 1, curIntervalCount
tableBody(14+kHour,nCol+1) = TRIM(RealToStr(BinResults(repIndex,nCol)%hrly(kHour),2))
! sum the total for all columns
rowTotal = rowTotal + BinResults(repIndex,nCol)%hrly(kHour)
END DO
tableBody(14+kHour, nCol+2) = TRIM(RealToStr(rowTotal,2))
END DO
tableTotal = 0.0d0
DO kMonth = 1, 12
tableBody(2+kMonth,1) = RealToStr(BinResultsBelow(repIndex)%mnth(kMonth),2)
tableBody(2+kMonth,curIntervalCount+2) = RealToStr(BinResultsAbove(repIndex)%mnth(kMonth),2)
rowTotal = BinResultsBelow(repIndex)%mnth(kMonth) + BinResultsAbove(repIndex)%mnth(kMonth)
DO nCol = 1, curIntervalCount
tableBody(2+kMonth,nCol+1) = TRIM(RealToStr(BinResults(repIndex,nCol)%mnth(kMonth),2))
! sum the total for all columns
rowTotal = rowTotal + BinResults(repIndex,nCol)%mnth(kMonth)
END DO
tableBody(2+kMonth, nCol+2) = TRIM(RealToStr(rowTotal,2))
tableTotal = tableTotal + rowTotal
END DO
! compute total row
DO nCol = 1, curIntervalCount
colTotal=0.0d0
DO kMonth = 1, 12
colTotal = colTotal + BinResults(repIndex,nCol)%mnth(kMonth)
END DO
tableBody(39,nCol+1) = TRIM(RealToStr(colTotal,2))
END DO
aboveTotal = 0.0d0
belowTotal = 0.0d0
DO kMonth = 1, 12
aboveTotal = aboveTotal + BinResultsAbove(repIndex)%mnth(kMonth)
belowTotal = belowTotal + BinResultsBelow(repIndex)%mnth(kMonth)
END DO
tableBody(39,1) = TRIM(RealToStr(belowTotal,2))
tableBody(39,curIntervalCount+2) = TRIM(RealToStr(aboveTotal,2))
tableBody(39,curIntervalCount+3) = TRIM(RealToStr(tableTotal,2))
CALL writeTextLine('Values in table are in hours.')
CALL writeTextLine(' ')
CALL WriteSubtitle("Time Bin Results")
CALL writeTable(tableBody,rowHead,columnHead,columnWidth,.TRUE.) !transpose XML tables
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
repNameWithUnitsandscheduleName,&
BinObjVarID(repIndex)%namesOfObj,&
'Time Bin Results')
!create statistics table
rowHeadStat(1) = 'Minimum'
rowHeadStat(2) = 'Mean minus two standard deviations'
rowHeadStat(3) = 'Mean'
rowHeadStat(4) = 'Mean plus two standard deviations'
rowHeadStat(5) = 'Maximum'
rowHeadStat(6) = 'Standard deviation'
columnHeadStat(1) = 'Statistic'
columnWidthStat(1) = 14
!per Applied Regression Analysis and Other Multivariate Methods, Kleinburger/Kupper, 1978
!first check if very large constant number has caused the second part to be larger than the first
IF (BinStatistics(repIndex)%n .GT. 1) THEN
IF (BinStatistics(repIndex)%sum2 .GT. ((BinStatistics(repIndex)%sum ** 2)/BinStatistics(repIndex)%n)) THEN
repStDev = SQRT((BinStatistics(repIndex)%sum2 - ((BinStatistics(repIndex)%sum ** 2)/BinStatistics(repIndex)%n)) &
/ (BinStatistics(repIndex)%n - 1))
ELSE
repStDev = 0.0d0
END IF
repMean = BinStatistics(repIndex)%sum / BinStatistics(repIndex)%n
ELSE
repStDev = 0.0d0
repMean = 0.0d0
END IF
IF (unitsStyle .EQ. unitsStyleInchPound) THEN
tableBodyStat(1,1) = RealToStr(ConvertIP(indexUnitConv,BinStatistics(repIndex)%minimum),2)
tableBodyStat(2,1) = RealToStr(ConvertIP(indexUnitConv,repMean - 2 * repStDev),2)
tableBodyStat(3,1) = RealToStr(ConvertIP(indexUnitConv,repMean),2)
tableBodyStat(4,1) = RealToStr(ConvertIP(indexUnitConv,repMean + 2 * repStDev),2)
tableBodyStat(5,1) = RealToStr(ConvertIP(indexUnitConv,BinStatistics(repIndex)%Maximum),2)
tableBodyStat(6,1) = RealToStr(ConvertIPdelta(indexUnitConv,repStDev),2)
ELSE
tableBodyStat(1,1) = RealToStr(BinStatistics(repIndex)%minimum,2)
tableBodyStat(2,1) = RealToStr(repMean - 2 * repStDev,2)
tableBodyStat(3,1) = RealToStr(repMean,2)
tableBodyStat(4,1) = RealToStr(repMean + 2 * repStDev,2)
tableBodyStat(5,1) = RealToStr(BinStatistics(repIndex)%Maximum,2)
tableBodyStat(6,1) = RealToStr(repStDev,2)
END IF
CALL writeSubtitle('Statistics')
CALL writeTable(tableBodyStat,rowHeadStat,columnHeadStat,columnWidthStat,.TRUE.) !transpose XML table
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
repNameWithUnitsandscheduleName,&
BinObjVarID(repIndex)%namesOfObj,&
'Statistics')
END DO
DEALLOCATE(columnHead)
DEALLOCATE(columnWidth)
DEALLOCATE(tableBody)
END DO
END SUBROUTINE WriteTimeBinTables