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 WriteTableOfContents
! SUBROUTINE INFORMATION:
! AUTHOR Jason Glazer
! DATE WRITTEN June 2005
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Creates hyperlinks for table of contents
! METHODOLOGY EMPLOYED:
! Go through the reports and create links
! REFERENCES:
! na
! USE STATEMENTS:
USE OutputReportPredefined, ONLY: reportName, numReportName
USE DataCostEstimate, ONLY: DoCostEstimate
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! 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 :: iInput
INTEGER :: jTable
INTEGER :: curTable
INTEGER :: iEntry
INTEGER :: jEntry
INTEGER :: kReport
CHARACTER(len=MaxNameLength) :: curSection
INTEGER :: iStyle
INTEGER :: curFH
CHARACTER(len=MaxNameLength) :: origName
CHARACTER(len=MaxNameLength) :: curName
INTEGER :: indexUnitConv
DO iStyle = 1, numStyles
IF (tableStyle(iStyle) .eq. tableStyleHTML) THEN
curFH = TabularOutputFile(iStyle)
WRITE(curFH,fmta) '<hr>'
WRITE(curFH,fmta) '<a name=toc></a>'
WRITE(curFH,fmta) '<p><b>Table of Contents</b></p>'
WRITE(curFH,fmta) '<a href="#top">Top</a>'
IF (displayTabularBEPS) THEN
WRITE(curFH,fmta) '<br><a href="#' // TRIM(MakeAnchorName('Annual Building Utility Performance Summary', &
'Entire Facility')) // '">Annual Building Utility Performance Summary</a>'
ENDIF
IF (displayTabularVeriSum) THEN
WRITE(curFH,fmta) '<br><a href="#' // TRIM(MakeAnchorName('Input Verification and Results Summary', &
'Entire Facility')) // '">Input Verification and Results Summary</a>'
ENDIF
IF (displayDemandEndUse) THEN
WRITE(curFH,fmta) '<br><a href="#' // TRIM(MakeAnchorName('Demand End Use Components Summary', &
'Entire Facility')) // '">Demand End Use Components Summary</a>'
ENDIF
IF (displaySourceEnergyEndUseSummary) THEN
WRITE(curFH,fmta) '<br><a href="#' // TRIM(MakeAnchorName('Source Energy End Use Components Summary', &
'Entire Facility')) // '">Source Energy End Use Components Summary</a>'
ENDIF
IF (DoCostEstimate) THEN
WRITE(curFH,fmta) '<br><a href="#' // TRIM(MakeAnchorName('Component Cost Economics Summary', &
'Entire Facility')) // '">Component Cost Economics Summary</a>'
ENDIF
IF (displayComponentSizing) THEN
WRITE(curFH,fmta) '<br><a href="#' // TRIM(MakeAnchorName('Component Sizing Summary', &
'Entire Facility')) // '">Component Sizing Summary</a>'
END IF
IF (displaySurfaceShadowing) THEN
WRITE(curFH,fmta) '<br><a href="#' // TRIM(MakeAnchorName('Surface Shadowing Summary', &
'Entire Facility')) // '">Surface Shadowing Summary</a>'
END IF
DO kReport = 1, numReportName
IF (reportName(kReport)%show) THEN
WRITE(curFH,fmta) '<br><a href="#' // TRIM(MakeAnchorName(TRIM(reportName(kReport)%namewithSpaces), &
'Entire Facility')) // '">'//TRIM(reportName(kReport)%namewithSpaces)//'</a>'
END IF
END DO
IF (DoWeathSim) THEN
DO iInput = 1, MonthlyInputCount
IF (MonthlyInput(iInput)%numTables .GT. 0) THEN
WRITE(curFH,fmta) '<p><b>' // TRIM(MonthlyInput(iInput)%name) // '</b></p> |'
DO jTable = 1 , MonthlyInput(iInput)%numTables
curTable =jTable + MonthlyInput(iInput)%firstTable - 1
WRITE(curFH,fmta) '<a href="#' // TRIM(MakeAnchorName(MonthlyInput(iInput)%name, &
MonthlyTables(curTable)%keyValue)) // '">' // TRIM(MonthlyTables(curTable)%keyValue) // '</a> | '
END DO
END IF
END DO
DO iInput = 1 , OutputTableBinnedCount
IF (OutputTableBinned(iInput)%numTables .GT. 0) THEN
IF (OutputTableBinned(iInput)%scheduleIndex == 0) THEN
WRITE(curFH,fmta) '<p><b>' // TRIM(OutputTableBinned(iInput)%varOrMeter) // '</b></p> |'
ELSE
WRITE(curFH,fmta) '<p><b>' // TRIM(OutputTableBinned(iInput)%varOrMeter) // &
' [' // TRIM(OutputTableBinned(iInput)%ScheduleName) // ']' // '</b></p> |'
ENDIF
DO jTable = 1, OutputTableBinned(iInput)%numTables
curTable = OutputTableBinned(iInput)%resIndex + (jTable - 1)
curName = ''
IF (unitsStyle .EQ. unitsStyleInchPound) THEN
origName = TRIM(OutputTableBinned(iInput)%varOrMeter)//' ['//TRIM(OutputTableBinned(iInput)%units) //']'
CALL LookupSItoIP(origName, indexUnitConv, curName)
ELSE
curName = TRIM(OutputTableBinned(iInput)%varOrMeter)//' ['//TRIM(OutputTableBinned(iInput)%units) //']'
END IF
IF (OutputTableBinned(iInput)%scheduleIndex == 0) THEN
WRITE(curFH,fmta) '<a href="#' // TRIM(MakeAnchorName(TRIM(curName), BinObjVarID(curTable)%namesOfObj)) // '">' // &
TRIM(BinObjVarID(curTable)%namesOfObj) // '</a> | '
ELSE
WRITE(curFH,fmta) '<a href="#' // TRIM(MakeAnchorName(TRIM(curName) // &
TRIM(OutputTableBinned(iInput)%ScheduleName), &
BinObjVarID(curTable)%namesOfObj)) // '">' // &
TRIM(BinObjVarID(curTable)%namesOfObj) // '</a> | '
ENDIF
END DO
END IF
END DO
END IF
!add entries specifically added using AddTOCEntry
DO iEntry = 1, TOCEntriesCount
IF (.NOT. TOCEntries(iEntry)%isWritten) THEN
curSection = TOCEntries(iEntry)%sectionName
WRITE(curFH,fmta) '<p><b>' // TRIM(curSection) // '</b></p> |'
DO jEntry = iEntry, TOCEntriesCount
IF (.NOT. TOCEntries(jEntry)%isWritten) THEN
IF (TOCEntries(jEntry)%sectionName .EQ. curSection) THEN
WRITE(curFH,fmta) '<a href="#' // TRIM(MakeAnchorName(TOCEntries(jEntry)%sectionName, &
TOCEntries(jEntry)%reportName)) // '">' // &
TRIM(TOCEntries(jEntry)%reportName) // '</a> | '
TOCEntries(jEntry)%isWritten = .TRUE.
END IF
END IF
END DO
END IF
END DO
END IF
END DO
END SUBROUTINE WriteTableOfContents