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=*) | :: | Message | ||||
integer, | intent(inout) | :: | MsgIndex | |||
real(kind=r64), | intent(in), | optional | :: | ReportMaxOf | ||
real(kind=r64), | intent(in), | optional | :: | ReportMinOf | ||
real(kind=r64), | intent(in), | optional | :: | ReportSumOf | ||
character(len=*), | intent(in), | optional | :: | ReportMaxUnits | ||
character(len=*), | intent(in), | optional | :: | ReportMinUnits | ||
character(len=*), | intent(in), | optional | :: | ReportSumUnits |
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 ShowRecurringContinueErrorAtEnd(Message,MsgIndex,ReportMaxOf,ReportMinOf,ReportSumOf, &
ReportMaxUnits,ReportMinUnits,ReportSumUnits)
! SUBROUTINE INFORMATION:
! AUTHOR Michael J. Witte
! DATE WRITTEN August 2004
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine stores a recurring ErrorMessage with a continue designation
! for output at the end of the simulation with automatic tracking of number
! of occurences and optional tracking of associated min, max, and sum values
! METHODOLOGY EMPLOYED:
! Calls StoreRecurringErrorMessage utility routine.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataPrecisionGlobals
USE DataStringGlobals
USE DataErrorTracking
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*) :: Message ! Message automatically written to "error file" at end of simulation
INTEGER, INTENT(INOUT) :: MsgIndex ! Recurring message index, if zero, next available index is assigned
REAL(r64), INTENT(IN), OPTIONAL :: ReportMaxOf ! Track and report the max of the values passed to this argument
REAL(r64), INTENT(IN), OPTIONAL :: ReportMinOf ! Track and report the min of the values passed to this argument
REAL(r64), INTENT(IN), OPTIONAL :: ReportSumOf ! Track and report the sum of the values passed to this argument
CHARACTER(len=*), INTENT(IN), OPTIONAL :: ReportMaxUnits ! optional char string (<=15 length) of units for max value
CHARACTER(len=*), INTENT(IN), OPTIONAL :: ReportMinUnits ! optional char string (<=15 length) of units for min value
CHARACTER(len=*), INTENT(IN), OPTIONAL :: ReportSumUnits ! optional char string (<=15 length) of units for sum value
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
INTERFACE
SUBROUTINE StoreRecurringErrorMessage(ErrorMessage,ErrorMsgIndex,ErrorReportMaxOf,ErrorReportMinOf,ErrorReportSumOf, &
ErrorReportMaxUnits,ErrorReportMinUnits,ErrorReportSumUnits)
USE DataPrecisionGlobals
! Use for recurring "warning" error messages shown once at end of simulation
! with count of occurences and optional max, min, sum
CHARACTER(len=*) ErrorMessage ! Message automatically written to "error file" at end of simulation
INTEGER, INTENT(INOUT) :: ErrorMsgIndex ! Recurring message index, if zero, next available index is assigned
REAL(r64), INTENT(IN), OPTIONAL :: ErrorReportMaxOf ! Track and report the max of the values passed to this argument
REAL(r64), INTENT(IN), OPTIONAL :: ErrorReportMinOf ! Track and report the min of the values passed to this argument
REAL(r64), INTENT(IN), OPTIONAL :: ErrorReportSumOf ! Track and report the sum of the values passed to this argument
CHARACTER(len=*), INTENT(IN), OPTIONAL :: ErrorReportMaxUnits ! Units for "max" reporting
CHARACTER(len=*), INTENT(IN), OPTIONAL :: ErrorReportMinUnits ! Units for "min" reporting
CHARACTER(len=*), INTENT(IN), OPTIONAL :: ErrorReportSumUnits ! Units for "sum" reporting
END SUBROUTINE
END INTERFACE
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER Loop
DO Loop=1,SearchCounts
IF (INDEX(Message,TRIM(MessageSearch(Loop))) > 0) MatchCounts(Loop)=MatchCounts(Loop)+1
ENDDO
CALL StoreRecurringErrorMessage(' ** ~~~ ** '//Message,MsgIndex,ReportMaxOf,ReportMinOf,ReportSumOf, &
ReportMaxUnits,ReportMinUnits,ReportSumUnits)
RETURN
END SUBROUTINE ShowRecurringContinueErrorAtEnd