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 GetInputTabularStyle
! SUBROUTINE INFORMATION:
! AUTHOR Jason Glazer
! DATE WRITTEN July 2003
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This routine set a flag for the output format for
! all tabular reports. This is a "unique" object.
! METHODOLOGY EMPLOYED:
! Uses get input structure similar to other objects
! REFERENCES:
! na
! USE STATEMENTS:
USE DataIPShortCuts
USE DataStringGlobals, ONLY: CharComma, CharTab, CharSpace
USE SQLiteProcedures, ONLY: WriteTabularDataToSQLite, WriteOutputToSQLite
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: fmta="(A)"
CHARACTER(len=*), PARAMETER :: CurrentModuleObject='OutputControl:Table:Style'
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: NumTabularStyle
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
CALL GetObjectDefMaxArgs(CurrentModuleObject,NumParams,NumAlphas,NumNums)
ALLOCATE(AlphArray(NumAlphas))
AlphArray=' '
ALLOCATE(NumArray(NumNums))
NumArray=0.0d0
NumTabularStyle = GetNumObjectsFound(CurrentModuleObject)
IF (NumTabularStyle .EQ. 0) THEN
AlphArray(1)='COMMA'
numStyles = 1
TableStyle(1) = tableStyleComma
del(1) = CharComma !comma
unitsStyle = unitsStyleNone
ELSEIF (NumTabularStyle .EQ. 1) THEN
CALL GetObjectItem(CurrentModuleObject,1,AlphArray,NumAlphas,NumArray,NumNums,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
! ColumnSeparator
IF (SameString(AlphArray(1),'Comma')) THEN
numStyles = 1
TableStyle(1) = tableStyleComma
del(1) = CharComma !comma
ELSEIF (SameString(AlphArray(1),'Tab')) THEN
numStyles = 1
TableStyle(1) = tableStyleTab
del(1) = CharTab !tab
ELSEIF (SameString(AlphArray(1),'Fixed')) THEN
numStyles = 1
TableStyle(1) = tableStyleFixed
del(1) = CharSpace ! space
ELSEIF (SameString(AlphArray(1),'HTML')) THEN
numStyles = 1
TableStyle(1) = tableStyleHTML
del(1) = CharSpace !space - this is not used much for HTML output
ELSEIF (SameString(AlphArray(1),'XML')) THEN
numStyles = 1
TableStyle(1) = tableStyleXML
del(1) = CharSpace !space - this is not used much for XML output
ELSEIF (SameString(AlphArray(1),'CommaAndHTML')) THEN
numStyles = 2
TableStyle(1) = tableStyleComma
del(1) = CharComma !comma
TableStyle(2) = tableStyleHTML
del(2) = CharSpace !space - this is not used much for HTML output
ELSEIF (SameString(AlphArray(1),'CommaAndXML')) THEN
numStyles = 2
TableStyle(1) = tableStyleComma
del(1) = CharComma !comma
TableStyle(2) = tableStyleXML
del(2) = CharSpace !space - this is not used much for XML output
ELSEIF (SameString(AlphArray(1),'TabAndHTML')) THEN
numStyles = 2
TableStyle(1) = tableStyleTab
del(1) = CharTab !tab
TableStyle(2) = tableStyleHTML
del(2) = CharSpace !space - this is not used much for HTML output
ELSEIF (SameString(AlphArray(1),'XMLandHTML')) THEN
numStyles = 2
TableStyle(1) = tableStyleXML
del(1) = CharSpace !space - this is not used much for XML output
TableStyle(2) = tableStyleHTML
del(2) = CharSpace !space - this is not used much for HTML output
ELSEIF (SameString(AlphArray(1),'All')) THEN
numStyles = 5
TableStyle(1) = tableStyleComma
del(1) = CharComma !comma
TableStyle(2) = tableStyleTab
del(2) = CharTab !tab
TableStyle(3) = tableStyleFixed
del(3) = CharSpace ! space
TableStyle(4) = tableStyleHTML
del(4) = CharSpace !space - this is not used much for HTML output
TableStyle(5) = tableStyleXML
del(5) = CharSpace !space - this is not used much for XML output
ELSE
CALL ShowWarningError(CurrentModuleObject//': Invalid '//TRIM(cAlphaFieldNames(1))//'="'// &
TRIM(AlphArray(1))//'". Commas will be used.')
numStyles = 1
TableStyle(1) = tableStyleComma
del(1) = CharComma !comma
AlphArray(1)='COMMA'
ENDIF
!MonthlyUnitConversion
IF (NumAlphas .GE. 2) THEN
IF (SameString(AlphArray(2),'None')) THEN
unitsStyle = unitsStyleNone
ELSEIF (SameString(AlphArray(2),'JTOKWH')) THEN
unitsStyle = unitsStyleJtoKWH
ELSEIF (SameString(AlphArray(2),'JTOMJ')) THEN
unitsStyle = unitsStyleJtoMJ
ELSEIF (SameString(AlphArray(2),'JTOGJ')) THEN
unitsStyle = unitsStyleJtoGJ
ELSEIF (SameString(AlphArray(2),'INCHPOUND')) THEN
unitsStyle = unitsStyleInchPound
ELSE
unitsStyle = unitsStyleNone
CALL ShowWarningError(CurrentModuleObject//': Invalid '//TRIM(cAlphaFieldNames(2))//'="'// &
TRIM(AlphArray(2))//'". No unit conversion will be performed. Normal SI units will be shown.')
ENDIF
ELSE
unitsStyle = unitsStyleNone
AlphArray(2)='None'
END IF
ELSEIF (NumTabularStyle .GT. 1) THEN
CALL ShowWarningError(CurrentModuleObject//': Only one instance of this object is allowed. Commas will be used.')
TableStyle = tableStyleComma
del = CharComma !comma
AlphArray(1)='COMMA'
unitsStyle = unitsStyleNone
AlphArray(2)='None'
ENDIF
IF (WriteTabularFiles) THEN
Write(OutputFileInits,fmta) '! <Tabular Report>,Style,Unit Conversion'
IF (AlphArray(1) /= 'HTML') THEN
CALL ConvertCaseToLower(AlphArray(1),AlphArray(2))
AlphArray(1)(2:)=AlphArray(2)(2:)
ENDIF
WRITE(OutputFileInits,"('Tabular Report,',A,',',A)") TRIM(AlphArray(1)),TRIM(AlphArray(2))
ENDIF
DEALLOCATE(AlphArray)
DEALLOCATE(NumArray)
END SUBROUTINE GetInputTabularStyle