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.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | ReportName | |||
logical, | intent(out) | :: | DoReport | |||
character(len=*), | intent(in), | optional | :: | ReportKey | ||
character(len=*), | intent(inout), | optional | :: | Option1 | ||
character(len=*), | intent(inout), | optional | :: | Option2 |
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 ScanForReports(ReportName,DoReport,ReportKey,Option1,Option2)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN March 2009
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This routine scans for the global "reports" settings, such as Variable Dictionary,
! Surfaces (and options), Constructions, etc.
! METHODOLOGY EMPLOYED:
! First time routine is called, all the viable combinations/settings for the reports are
! stored in SAVEd variables. Later callings will retrieve those.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataIPShortCuts
USE InputProcessor, ONLY: GetNumObjectsFound,GetObjectItem,MakeUPPERCase,FindItemInList,GetNumSectionsFound,SameString
USE DataInterfaces, ONLY: ShowWarningError, ShowContinueError
USE DataRuntimeLanguage, ONLY: OutputFullEMSTrace, OutputEMSErrors, OutputEMSActuatorAvailFull, &
OutputEMSActuatorAvailSmall, OutputEMSInternalVarsFull, OutputEMSInternalVarsSmall
USE DataGlobals, ONLY: ShowDecayCurvesInEIO
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*), INTENT(IN) :: ReportName
LOGICAL, INTENT(OUT) :: DoReport
CHARACTER(len=*), INTENT(IN), OPTIONAL :: ReportKey
CHARACTER(len=*), INTENT(INOUT), OPTIONAL :: Option1
CHARACTER(len=*), INTENT(INOUT), OPTIONAL :: Option2
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER NumReports
INTEGER RepNum
INTEGER NumNames
INTEGER NumNumbers
INTEGER IOStat
LOGICAL,SAVE :: SurfVert =.false.
LOGICAL,SAVE :: SurfDet =.false.
LOGICAL,SAVE :: SurfDetWVert=.false.
LOGICAL,SAVE :: DXFReport =.false.
CHARACTER(len=MaxNameLength),SAVE :: DXFOption1
CHARACTER(len=MaxNameLength),SAVE :: DXFOption2
LOGICAL,SAVE :: DXFWFReport =.false.
CHARACTER(len=MaxNameLength),SAVE :: DXFWFOption1
CHARACTER(len=MaxNameLength),SAVE :: DXFWFOption2
LOGICAL,SAVE :: VRMLReport =.false.
CHARACTER(len=MaxNameLength),SAVE :: VRMLOption1
CHARACTER(len=MaxNameLength),SAVE :: VRMLOption2
LOGICAL,SAVE :: CostInfo =.false.
LOGICAL,SAVE :: ViewFactorInfo =.false.
CHARACTER(len=MaxNameLength),SAVE :: ViewRptOption1=' '
LOGICAL,SAVE :: Constructions =.false.
LOGICAL,SAVE :: Materials =.false.
LOGICAL,SAVE :: LineRpt =.false.
CHARACTER(len=MaxNameLength),SAVE :: LineRptOption1=' '
LOGICAL,SAVE :: VarDict =.false.
LOGICAL, SAVE :: EMSoutput = .false.
CHARACTER(len=MaxNameLength),SAVE :: VarDictOption1=' '
CHARACTER(len=MaxNameLength),SAVE :: VarDictOption2=' '
! LOGICAL,SAVE :: SchRpt = .false.
! CHARACTER(len=MaxNameLength) :: SchRptOption
LOGICAL,SAVE :: GetReportInput=.true.
IF (GetReportInput) THEN
cCurrentModuleObject='Output:Surfaces:List'
NumReports=GetNumObjectsFound(cCurrentModuleObject)
DO RepNum=1,NumReports
CALL GetObjectItem(cCurrentModuleObject,RepNum,cAlphaArgs,NumNames,rNumericArgs,NumNumbers,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
SELECT CASE(cAlphaArgs(1))
CASE ('LINES')
LineRpt=.true.
LineRptOption1=cAlphaArgs(2)
CASE ('VERTICES')
SurfVert=.true.
CASE ('DETAILS','DETAILED','DETAIL')
SurfDet=.true.
CASE ('DETAILSWITHVERTICES','DETAILVERTICES')
SurfDetWVert=.true.
CASE ('COSTINFO')
! Custom case for reporting surface info for cost estimates (for first costs in opitimzing)
CostInfo=.true.
CASE ('VIEWFACTORINFO') ! actual reporting is in HeatBalanceIntRadExchange
ViewFactorInfo=.true.
ViewRptOption1=cAlphaArgs(2)
CASE ('DECAYCURVESFROMZONECOMPONENTLOADS') !Should the Radiant to Convective Decay Curves from the load component report appear in the EIO file
ShowDecayCurvesInEIO = .TRUE.
CASE (' ')
CALL ShowWarningError(trim(cCurrentModuleObject)//': No '//trim(cAlphaFieldNames(1))//' supplied.')
CALL ShowContinueError(' Legal values are: "Lines", "Vertices", "Details", "DetailsWithVertices", '// &
'"CostInfo", "ViewFactorIinfo".')
CASE DEFAULT
CALL ShowWarningError(trim(cCurrentModuleObject)//': Invalid '//trim(cAlphaFieldNames(1))//'="'// &
trim(cAlphaArgs(1))//'" supplied.')
CALL ShowContinueError(' Legal values are: "Lines", "Vertices", "Details", "DetailsWithVertices", '// &
'"CostInfo", "ViewFactorIinfo".')
END SELECT
ENDDO
cCurrentModuleObject='Output:Surfaces:Drawing'
NumReports=GetNumObjectsFound(cCurrentModuleObject)
DO RepNum=1,NumReports
CALL GetObjectItem(cCurrentModuleObject,RepNum,cAlphaArgs,NumNames,rNumericArgs,NumNumbers,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
SELECT CASE(cAlphaArgs(1))
CASE ('DXF')
DXFReport=.true.
DXFOption1=cAlphaArgs(2)
DXFOption2=cAlphaArgs(3)
CASE ('DXF:WIREFRAME')
DXFWFReport=.true.
DXFWFOption1=cAlphaArgs(2)
DXFWFOption2=cAlphaArgs(3)
CASE ('VRML')
VRMLReport=.true.
VRMLOption1=cAlphaArgs(2)
VRMLOption2=cAlphaArgs(3)
CASE (' ')
CALL ShowWarningError(trim(cCurrentModuleObject)//': No '//trim(cAlphaFieldNames(1))//' supplied.')
CALL ShowContinueError(' Legal values are: "DXF", "DXF:WireFrame", "VRML".')
CASE DEFAULT
CALL ShowWarningError(trim(cCurrentModuleObject)//': Invalid '//trim(cAlphaFieldNames(1))//'="'// &
trim(cAlphaArgs(1))//'" supplied.')
CALL ShowContinueError(' Legal values are: "DXF", "DXF:WireFrame", "VRML".')
END SELECT
ENDDO
RepNum=GetNumSectionsFound('Report Variable Dictionary')
IF (RepNum > 0) THEN
VarDict=.true.
VarDictOption1='REGULAR'
VarDictOption2=' '
ENDIF
cCurrentModuleObject='Output:VariableDictionary'
NumReports=GetNumObjectsFound(cCurrentModuleObject)
DO RepNum=1,NumReports
CALL GetObjectItem(cCurrentModuleObject,RepNum,cAlphaArgs,NumNames,rNumericArgs,NumNumbers,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
VarDict=.true.
VarDictOption1=cAlphaArgs(1)
VarDictOption2=cAlphaArgs(2)
ENDDO
cCurrentModuleObject='Output:Constructions'
NumReports=GetNumObjectsFound(cCurrentModuleObject)
DO RepNum=1,NumReports
CALL GetObjectItem(cCurrentModuleObject,RepNum,cAlphaArgs,NumNames,rNumericArgs,NumNumbers,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IF (cAlphaArgs(1)(1:9) == 'CONSTRUCT') THEN
Constructions=.true.
ELSEIF (cAlphaArgs(1)(1:3) == 'MAT') THEN
Materials=.true.
ENDIF
IF (NumNames > 1) THEN
IF (cAlphaArgs(2)(1:9) == 'CONSTRUCT') THEN
Constructions=.true.
ELSEIF (cAlphaArgs(2)(1:3) == 'MAT') THEN
Materials=.true.
ENDIF
ENDIF
ENDDO
cCurrentModuleObject = 'Output:EnergyManagementSystem'
NumReports=GetNumObjectsFound(cCurrentModuleObject)
DO RepNum=1,NumReports
CALL GetObjectItem(cCurrentModuleObject,RepNum,cAlphaArgs,NumNames,rNumericArgs,NumNumbers,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
EMSoutput = .TRUE.
SELECT CASE (TRIM(cAlphaArgs(1)))
CASE ('NONE')
OutputEMSActuatorAvailSmall = .FALSE.
OutputEMSActuatorAvailFull = .FALSE.
CASE ('NOTBYUNIQUEKEYNAMES')
OutputEMSActuatorAvailSmall = .TRUE.
OutputEMSActuatorAvailFull = .FALSE.
CASE ('VERBOSE')
OutputEMSActuatorAvailSmall = .FALSE.
OutputEMSActuatorAvailFull = .TRUE.
CASE (' ')
CALL ShowWarningError(trim(cCurrentModuleObject)//': Blank '//trim(cAlphaFieldNames(1))//' supplied.')
CALL ShowContinueError(' Legal values are: "None", "NotByUniqueKeyNames", "Verbose". "None" will be used.')
OutputEMSActuatorAvailSmall = .FALSE.
OutputEMSActuatorAvailFull = .FALSE.
CASE DEFAULT
CALL ShowWarningError(trim(cCurrentModuleObject)//': Invalid '//trim(cAlphaFieldNames(1))//'="'// &
trim(cAlphaArgs(1))//'" supplied.')
CALL ShowContinueError(' Legal values are: "None", "NotByUniqueKeyNames", "Verbose". "None" will be used.')
OutputEMSActuatorAvailSmall = .FALSE.
OutputEMSActuatorAvailFull = .FALSE.
END SELECT
SELECT CASE (cAlphaArgs(2))
CASE ('NONE')
OutputEMSInternalVarsFull = .FALSE.
OutputEMSInternalVarsSmall = .FALSE.
CASE ('NOTBYUNIQUEKEYNAMES')
OutputEMSInternalVarsFull = .FALSE.
OutputEMSInternalVarsSmall = .TRUE.
CASE ('VERBOSE')
OutputEMSInternalVarsFull = .TRUE.
OutputEMSInternalVarsSmall = .FALSE.
CASE (' ')
CALL ShowWarningError(trim(cCurrentModuleObject)//': Blank '//trim(cAlphaFieldNames(2))//' supplied.')
CALL ShowContinueError(' Legal values are: "None", "NotByUniqueKeyNames", "Verbose". "None" will be used.')
OutputEMSInternalVarsFull = .FALSE.
OutputEMSInternalVarsSmall = .FALSE.
CASE DEFAULT
CALL ShowWarningError(trim(cCurrentModuleObject)//': Invalid '//trim(cAlphaFieldNames(2))//'="'// &
trim(cAlphaArgs(1))//'" supplied.')
CALL ShowContinueError(' Legal values are: "None", "NotByUniqueKeyNames", "Verbose". "None" will be used.')
OutputEMSInternalVarsFull = .FALSE.
OutputEMSInternalVarsSmall = .FALSE.
END SELECT
SELECT CASE (cAlphaArgs(3))
CASE ('NONE')
OutputEMSErrors = .FALSE.
OutputFullEMSTrace = .FALSE.
CASE ('ERRORSONLY')
OutputEMSErrors = .TRUE.
OutputFullEMSTrace = .FALSE.
CASE ('VERBOSE')
OutputFullEMSTrace = .TRUE.
OutputEMSErrors = .TRUE.
CASE (' ')
CALL ShowWarningError(trim(cCurrentModuleObject)//': Blank '//trim(cAlphaFieldNames(3))//' supplied.')
CALL ShowContinueError(' Legal values are: "None", "ErrorsOnly", "Verbose". "None" will be used.')
OutputEMSErrors = .FALSE.
OutputFullEMSTrace = .FALSE.
CASE DEFAULT
CALL ShowWarningError(trim(cCurrentModuleObject)//': Invalid '//trim(cAlphaFieldNames(3))//'="'// &
trim(cAlphaArgs(1))//'" supplied.')
CALL ShowContinueError(' Legal values are: "None", "ErrorsOnly", "Verbose". "None" will be used.')
OutputEMSErrors = .FALSE.
OutputFullEMSTrace = .FALSE.
END SELECT
ENDDO
! cCurrentModuleObject='Output:Schedules'
! NumReports=GetNumObjectsFound(cCurrentModuleObject)
! DO RepNum=1,NumReports
! CALL GetObjectItem(cCurrentModuleObject,RepNum,cAlphaArgs,NumNames,rNumericArgs,NumNumbers,IOStat, &
! AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
! AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
! SchRpt=.true.
! SchRptOption=cAlphaArgs(1)
! ENDDO
GetReportInput=.false.
ENDIF
! Process the Scan Request
DoReport=.false.
SELECT CASE (MakeUPPERCase(ReportName))
CASE ('CONSTRUCTIONS')
IF (PRESENT(ReportKey)) THEN
IF (SameString(ReportKey,'Constructions')) DoReport=Constructions
IF (SameString(ReportKey,'Materials')) DoReport=Materials
ENDIF
CASE ('VIEWFACTORINFO')
DoReport=ViewFactorInfo
IF (PRESENT(Option1)) Option1=ViewRptOption1
CASE ('VARIABLEDICTIONARY')
DoReport=VarDict
IF (PRESENT(Option1)) Option1=VarDictOption1
IF (PRESENT(Option2)) Option2=VarDictOption2
! CASE ('SCHEDULES')
! DoReport=SchRpt
! IF (PRESENT(Option1)) Option1=SchRptOption
CASE ('SURFACES')
SELECT CASE (MakeUPPERCase(ReportKey)) !Objexx:OPTIONAL ReportKey used without PRESENT check
CASE ('COSTINFO')
DoReport=CostInfo
CASE ('DXF')
DoReport=DXFReport
IF (PRESENT(Option1)) Option1=DXFOption1
IF (PRESENT(Option2)) Option2=DXFOption2
CASE ('DXF:WIREFRAME')
DoReport=DXFWFReport
IF (PRESENT(Option1)) Option1=DXFWFOption1
IF (PRESENT(Option2)) Option2=DXFWFOption2
CASE ('VRML')
DoReport=VRMLReport
IF (PRESENT(Option1)) Option1=VRMLOption1
IF (PRESENT(Option2)) Option2=VRMLOption2
CASE ('VERTICES')
DoReport=SurfVert
CASE ('DETAILS')
DoReport=SurfDet
CASE ('DETAILSWITHVERTICES')
DoReport=SurfDetWVert
CASE ('LINES')
DoReport=LineRpt
IF (PRESENT(Option1)) Option1=LineRptOption1
CASE DEFAULT
END SELECT
CASE ('ENERGYMANAGEMENTSYSTEM')
DoReport = EMSoutput
CASE DEFAULT
END SELECT
RETURN
END SUBROUTINE ScanForReports