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 WriteComponentSizing
! SUBROUTINE INFORMATION:
! AUTHOR Jason Glazer
! DATE WRITTEN July 2007
! MODIFIED January 2010, Kyle Benne
! Added SQLite output
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Write out tables based on component sizing data originally
! found in the EIO report.
! METHODOLOGY EMPLOYED:
! Create arrays for the call to writeTable and then call it.
! The tables created do not have known headers for rows or
! columns so those are determined based on what calls have
! been made to the ReportSizingOutput routine. A table
! is created for each type of component. Columns are created
! for each description within that table. Rows are created
! for each named object.
! REFERENCES:
! na
! USE STATEMENTS:
USE SQLiteProcedures, ONLY: CreateSQLiteTabularDataRecords
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
! all arrays are in the format: (row, column)
CHARACTER(len=MaxNameLength),ALLOCATABLE, DIMENSION(:) :: columnHead
INTEGER,ALLOCATABLE,DIMENSION(:) :: columnWidth
INTEGER,ALLOCATABLE,DIMENSION(:) :: colUnitConv
CHARACTER(len=MaxNameLength),ALLOCATABLE, DIMENSION(:) :: rowHead
CHARACTER(len=MaxNameLength),ALLOCATABLE, DIMENSION(:,:) :: tableBody
CHARACTER(len=MaxNameLength),ALLOCATABLE, DIMENSION(:) :: uniqueDesc
INTEGER :: numUniqueDesc
CHARACTER(len=MaxNameLength),ALLOCATABLE, DIMENSION(:) :: uniqueObj
INTEGER :: numUniqueObj
CHARACTER(len=MaxNameLength) :: curDesc
CHARACTER(len=MaxNameLength) :: curObj
INTEGER :: foundEntry
INTEGER :: foundDesc
INTEGER :: foundObj
INTEGER :: loopLimit
INTEGER :: iTableEntry
INTEGER :: jUnique
CHARACTER(len=MaxNameLength) :: curColHeadWithSI = ''
CHARACTER(len=MaxNameLength) :: curColHead = ''
INTEGER :: indexUnitConv = 0
REAL(r64) :: curValueSI = 0.0d0
REAL(r64) :: curValue = 0.0d0
IF (displayComponentSizing) THEN
CALL WriteReportHeaders('Component Sizing Summary','Entire Facility',isAverage)
!The arrays that look for unique headers are dimensioned in the
!running program since the size of the number of entries is
!not previouslly known. Use the size of all entries since that
!is the maximum possible.
ALLOCATE(uniqueDesc(numCompSizeTableEntry))
ALLOCATE(uniqueObj(numCompSizeTableEntry))
!initially clear the written flags for entire array
! The following line is not really necessary and it is possible that the array has
! not been allocated when this is first called.
! CompSizeTableEntry%written = .false.
! repeat the following loop until everything in array has been
! written into a table
loopLimit = 0
DO WHILE (loopLimit .LE. 100) !put a maximum count since complex loop that could run indefinitely if error
foundEntry = 0
loopLimit = loopLimit + 1
DO iTableEntry = 1, numCompSizeTableEntry
IF (.NOT. CompSizeTableEntry(iTableEntry)%written) THEN
foundEntry = iTableEntry
EXIT
END IF
END DO
IF (foundEntry .EQ. 0) EXIT !leave main loop - all items put into tables
!clear active items
CompSizeTableEntry%active = .false.
!make an unwritten item that is of the same type active - these will be the
!entries for the particular subtable.
DO iTableEntry = 1, numCompSizeTableEntry
IF (.NOT. CompSizeTableEntry(iTableEntry)%written) THEN
IF (SameString(CompSizeTableEntry(iTableEntry)%typeField,CompSizeTableEntry(foundEntry)%typeField)) THEN
CompSizeTableEntry(iTableEntry)%active = .true.
END IF
END IF
END DO
!identify unique descriptions and objects (columns and rows) in order
!to size the table arrays properly.
!reset the counters for the arrays looking for unique rows and columns
numUniqueDesc = 0
numUniqueObj = 0
DO iTableEntry = 1, numCompSizeTableEntry
!search for descriptions
foundDesc = 0
IF (CompSizeTableEntry(iTableEntry)%active) THEN
curDesc = CompSizeTableEntry(iTableEntry)%description
!look through the list of unique items to see if it matches
DO jUnique = 1, numUniqueDesc
IF (SameString(curDesc,uniqueDesc(jUnique))) THEN
foundDesc = jUnique
EXIT
ENDIF
END DO
!if not found add to the list
IF (foundDesc .EQ. 0) THEN
numUniqueDesc = numUniqueDesc + 1
uniqueDesc(numUniqueDesc) = curDesc
END IF
!search for objects
foundObj = 0
curObj = CompSizeTableEntry(iTableEntry)%nameField
DO jUnique = 1, numUniqueObj
IF (SameString(curObj,uniqueObj(jUnique))) THEN
foundObj = jUnique
EXIT
ENDIF
END DO
!if not found add to the list
IF (foundObj .EQ. 0) THEN
numUniqueObj = numUniqueObj + 1
uniqueObj(numUniqueObj) = curObj
END IF
END IF
END DO
!make sure the table has at least one row and columns
IF (numUniqueDesc .EQ. 0) numUniqueDesc = 1
IF (numUniqueObj .EQ. 0) numUniqueObj = 1
!now that the unique row and column headers are known the array
!sizes can be set for the table arrays
ALLOCATE(rowHead(numUniqueObj))
ALLOCATE(columnHead(numUniqueDesc))
ALLOCATE(columnWidth(numUniqueDesc))
columnWidth = 14 !array assignment - same for all columns
ALLOCATE(colUnitConv(numUniqueDesc))
ALLOCATE(tableBody(numUniqueObj,numUniqueDesc))
! initialize table body to blanks (in case entries are incomplete)
tableBody = ' '
!transfer the row and column headings first
DO jUnique = 1, numUniqueDesc
!do the unit conversions
curColHeadWithSI = uniqueDesc(jUnique)
IF (unitsStyle .EQ. unitsStyleInchPound) THEN
CALL LookupSItoIP(curColHeadWithSI, indexUnitConv, curColHead)
colUnitConv(jUnique) = indexUnitConv
ELSE
curColHead = curColHeadWithSI
colUnitConv(jUnique) = 0
END IF
columnHead(jUnique) = curColHead
END DO
DO jUnique = 1, numUniqueObj
rowHead(jUnique) = uniqueObj(jUnique)
END DO
!fill the table
DO iTableEntry = 1, numCompSizeTableEntry
!find the row and column for the specific entry
IF (CompSizeTableEntry(iTableEntry)%active) THEN
curDesc = CompSizeTableEntry(iTableEntry)%description
foundDesc = 0
DO jUnique = 1, numUniqueDesc
IF (SameString(uniqueDesc(jUnique),curDesc)) THEN
foundDesc = jUnique
EXIT
END IF
END DO
curObj = CompSizeTableEntry(iTableEntry)%nameField
foundObj = 0
DO jUnique = 1, numUniqueObj
IF (SameString(rowHead(jUnique),curObj)) THEN
foundObj = jUnique
EXIT
END IF
END DO
IF ((foundDesc .GE. 1) .AND. (foundObj .GE. 1)) THEN
curValueSI = CompSizeTableEntry(iTableEntry)%valField
IF (unitsStyle .EQ. unitsStyleInchPound) THEN
IF (colUnitConv(foundDesc) .NE. 0) THEN
curValue = convertIP(colUnitConv(foundDesc),curValueSI)
ELSE
curValue = curValueSI
END IF
ELSE
curValue = curValueSI
END IF
IF (ABS(curValue) .GE. 1.0d0) THEN
tableBody(foundObj,foundDesc) = TRIM(RealToStr(curValue,2))
ELSE
tableBody(foundObj,foundDesc) = TRIM(RealToStr(curValue,6))
END IF
CompSizeTableEntry(iTableEntry)%written = .true.
END IF
END IF
END DO
!write the table
CALL writeSubtitle(CompSizeTableEntry(foundEntry)%typeField)
CALL writeTable(tableBody,rowHead,columnHead,columnWidth,.FALSE.,'User-Specified values were used. '// &
'Design Size values were used if no User-Specified values were provided.')
CALL CreateSQLiteTabularDataRecords(tableBody,rowHead,columnHead,&
'ComponentSizingSummary',&
'Entire Facility',&
CompSizeTableEntry(foundEntry)%typeField)
!deallocate these arrays since they are used to create the next
!table
DEALLOCATE(rowHead)
DEALLOCATE(columnHead)
DEALLOCATE(columnWidth)
DEALLOCATE(colUnitConv)
DEALLOCATE(tableBody)
END DO
!free the memory of these arrays that are only needed in this routine
DEALLOCATE(uniqueDesc)
DEALLOCATE(uniqueObj)
END IF
END SUBROUTINE WriteComponentSizing