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 GetReportVariableInput
! SUBROUTINE INFORMATION:
! AUTHOR Linda K. Lawrie
! DATE WRITTEN December 1998
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine gets the requested report variables from
! the input file.
! Report Variable,
! \memo each Report Variable command picks variables to be put onto the standard output file (.eso)
! \memo some variables may not be reported for every simulation
! A1 , \field Key_Value
! \note use '*' (without quotes) to apply this variable to all keys
! A2 , \field Variable_Name
! A3 , \field Reporting_Frequency
! \type choice
! \key detailed
! \key timestep
! \key hourly
! \key daily
! \key monthly
! \key runperiod
! A4 ; \field Schedule_Name
! \type object-list
! \object-list ScheduleNames
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
! USE DataIPShortCuts
USE DataGlobals, ONLY: OutputFileInits
USE InputProcessor
USE ScheduleManager, ONLY: GetScheduleIndex
USE DataSystemVariables, ONLY:cMinReportFrequency,MinReportFrequency
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:
INTEGER Loop
INTEGER NumAlpha
INTEGER NumNumbers
INTEGER IOStat
INTEGER Item
LOGICAL :: ErrorsFound = .false. ! If errors detected in input
CHARACTER(len=MaxNameLength) :: cCurrentModuleObject
CHARACTER(len=MaxNameLength), DIMENSION(4) :: cAlphaArgs
CHARACTER(len=MaxNameLength), DIMENSION(4) :: cAlphaFieldNames
LOGICAL, DIMENSION(4) :: lAlphaFieldBlanks
REAL(r64), DIMENSION(1) :: rNumericArgs
CHARACTER(len=MaxNameLength), DIMENSION(1) :: cNumericFieldNames
LOGICAL, DIMENSION(1) :: lNumericFieldBlanks
! First check environment variable to see of possible override for minimum reporting frequency
IF (cMinReportFrequency /= ' ') THEN
CALL DetermineFrequency(cMinReportFrequency,Item) ! Use local variable Item so as not to possibly confuse things
MinReportFrequency=MAX(MinReportFrequency,Item)
WRITE(OutputFileInits,800)
WRITE(OutputFileInits,801) TRIM(FreqNotice(MinReportFrequency,1)),TRIM(cMinReportFrequency)
ENDIF
800 FORMAT('! <Minimum Reporting Frequency (overriding input value)>, Value, Input Value')
801 FORMAT(' Minimum Reporting Frequency, ',A,',',A)
cCurrentModuleObject='Output:Variable'
NumOfReqVariables=GetNumObjectsFound(cCurrentModuleObject)
ALLOCATE(ReqRepVars(NumOfReqVariables))
DO Loop=1,NumOfReqVariables
CALL GetObjectItem(cCurrentModuleObject,Loop,cAlphaArgs,NumAlpha,rNumericArgs,NumNumbers,IOStat, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
! Check for duplicates?
ReqRepVars(Loop)%Key=cAlphaArgs(1)
IF (ReqRepVars(Loop)%Key == '*') THEN
ReqRepVars(Loop)%Key=BlankString
ENDIF
Item=INDEX(cAlphaArgs(2),'[') ! Remove Units designation if user put it in
IF (Item /= 0) THEN
cAlphaArgs(2)=cAlphaArgs(2)(1:Item-1)
ENDIF
ReqRepVars(Loop)%VarName=cAlphaArgs(2)
CALL DetermineFrequency(cAlphaArgs(3),ReqRepVars(Loop)%ReportFreq)
! Schedule information
ReqRepVars(Loop)%SchedName=cAlphaArgs(4)
IF (ReqRepVars(Loop)%SchedName /= ' ') THEN
ReqRepVars(Loop)%SchedPtr=GetScheduleIndex(ReqRepVars(Loop)%SchedName)
IF (ReqRepVars(Loop)%SchedPtr == 0) THEN
CALL ShowSevereError('GetReportVariableInput: '//TRIM(cCurrentModuleObject)//'="'// &
TRIM(cAlphaArgs(1))//':'//TRIM(ReqRepVars(Loop)%VarName)//'" invalid '// &
TRIM(cAlphaFieldNames(4))//'="'//TRIM(ReqRepVars(Loop)%SchedName)// &
'" - not found.')
ErrorsFound=.true.
ENDIF
ELSE
ReqRepVars(Loop)%SchedPtr=0
ENDIF
ReqRepVars(Loop)%Used=.false.
ENDDO
IF (ErrorsFound) THEN
CALL ShowFatalError('GetReportVariableInput:'//TRIM(cCurrentModuleObject)//': errors in input.')
ENDIF
RETURN
END SUBROUTINE GetReportVariableInput