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) | :: | KeyedValue | |||
character(len=*), | intent(in) | :: | VarName |
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 CheckReportVariable(KeyedValue,VarName)
! SUBROUTINE INFORMATION:
! AUTHOR Linda K. Lawrie
! DATE WRITTEN December 1998
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine will get the report variable information from input and
! determine if this variable (KeyedValue and VariableName) should be reported
! and, if so, what frequency to report.
! This routine is called when SetupOutputVariable is called with no "optional"
! Reporting Frequency. It is expected that SetupOutputVariable would only be
! called once for each keyed variable to be triggered for output (from the input
! requests). The optional report frequency would only be used for debugging
! purposes. Therefore, this routine will collect all occasions where this
! passed variablename would be reported from the requested input. It builds
! a list of these requests (ReportList) so that the calling routine can propagate
! the requests into the correct data structure.
! METHODOLOGY EMPLOYED:
! This instance being requested will always have a key associated with it. Matching
! instances (from input) may or may not have keys, but only one instance of a reporting
! frequency per variable is allowed. ReportList will be populated with ReqRepVars indices
! of those extra things from input that satisfy this condition.
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: FindItem
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*), INTENT(IN) :: VarName ! String Name of variable (without units)
CHARACTER(len=*), INTENT(IN) :: KeyedValue ! Associated Key for this variable
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL, SAVE :: GetInputFlag = .true.
INTEGER Item
INTEGER Loop
INTEGER Pos
INTEGER MinLook
INTEGER MaxLook
IF (GetInputFlag) THEN
CALL GetReportVariableInput
GetInputFlag=.false.
ENDIF
IF (NumOfReqVariables > 0) THEN
! Do a quick check
Item=FindItem(VarName,ReqRepVars(1:NumOfReqVariables)%VarName,NumOfReqVariables)
NumExtraVars=0
ReportList=0
MinLook= 999999999
MaxLook=-999999999
IF (Item /= 0) THEN
Loop=Item
Pos=Item
MinLook=MIN(MinLook,Pos)
MaxLook=MAX(MaxLook,Pos)
DO WHILE (Loop <= NumOfReqVariables .and. Pos /= 0)
! Mark all with blank keys as used
IF (ReqRepVars(Loop)%Key == BlankString) THEN
ReqRepVars(Loop)%Used=.true.
ENDIF
IF (Loop < NumOfReqVariables) THEN
Pos=FindItem(VarName,ReqRepVars(Loop+1:NumOfReqVariables)%VarName,NumOfReqVariables-Loop)
IF (Pos /= 0) THEN
MinLook=MIN(MinLook,Loop+Pos)
MaxLook=MAX(MaxLook,Loop+Pos)
ENDIF
ELSE
Pos=1
ENDIF
Loop=Loop+Pos
ENDDO
CALL BuildKeyVarList(KeyedValue,VarName,MinLook,MaxLook)
CALL AddBlankKeys(VarName,MinLook,MaxLook)
ENDIF
ENDIF
RETURN
END SUBROUTINE CheckReportVariable