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=*) | :: | ErrorMessage | ||||
integer, | intent(inout) | :: | ErrorMsgIndex | |||
real(kind=r64), | intent(in), | optional | :: | ErrorReportMaxOf | ||
real(kind=r64), | intent(in), | optional | :: | ErrorReportMinOf | ||
real(kind=r64), | intent(in), | optional | :: | ErrorReportSumOf | ||
character(len=*), | intent(in), | optional | :: | ErrorReportMaxUnits | ||
character(len=*), | intent(in), | optional | :: | ErrorReportMinUnits | ||
character(len=*), | intent(in), | optional | :: | ErrorReportSumUnits |
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 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
TotalSevereErrors=TotalSevereErrors+1
CALL StoreRecurringErrorMessage(' ** Severe ** '//Message,MsgIndex,ReportMaxOf,ReportMinOf,ReportSumOf, &
ReportMaxUnits,ReportMinUnits,ReportSumUnits)
RETURN
END SUBROUTINE ShowRecurringSevereErrorAtEnd
SUBROUTINE ShowRecurringWarningErrorAtEnd(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 Warning 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
TotalWarningErrors=TotalWarningErrors+1
CALL StoreRecurringErrorMessage(' ** Warning ** '//Message,MsgIndex,ReportMaxOf,ReportMinOf,ReportSumOf, &
ReportMaxUnits,ReportMinUnits,ReportSumUnits)
RETURN
END SUBROUTINE ShowRecurringWarningErrorAtEnd
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
SUBROUTINE StoreRecurringErrorMessage(ErrorMessage,ErrorMsgIndex,ErrorReportMaxOf,ErrorReportMinOf,ErrorReportSumOf, &
ErrorReportMaxUnits,ErrorReportMinUnits,ErrorReportSumUnits)
! SUBROUTINE INFORMATION:
! AUTHOR Michael J. Witte
! DATE WRITTEN August 2004
! MODIFIED September 2005;LKL;Added Units
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine stores a recurring ErrorMessage with
! 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:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataPrecisionGlobals
USE DataStringGlobals
USE DataErrorTracking
USE DataGlobals, ONLY : WarmupFlag,DoingSizing
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
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
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
TYPE (RecurringErrorData), ALLOCATABLE, DIMENSION(:) :: TempRecurringErrors
! If Index is zero, then assign next available index and reallocate array
IF (ErrorMsgIndex == 0) THEN
NumRecurringErrors = NumRecurringErrors + 1
ErrorMsgIndex = NumRecurringErrors
IF (NumRecurringErrors == 1) THEN
ALLOCATE(RecurringErrors(NumRecurringErrors))
ELSEIF (NumRecurringErrors > 1) THEN
ALLOCATE(TempRecurringErrors(NumRecurringErrors))
TempRecurringErrors(1:NumRecurringErrors-1)=RecurringErrors(1:NumRecurringErrors-1)
DEALLOCATE(RecurringErrors)
ALLOCATE(RecurringErrors(NumRecurringErrors))
RecurringErrors = TempRecurringErrors
DEALLOCATE(TempRecurringErrors)
ENDIF
! The message string only needs to be stored once when a new recurring message is created
RecurringErrors(ErrorMsgIndex)%Message = TRIM(ErrorMessage)
RecurringErrors(ErrorMsgIndex)%Count = 1
IF (WarmupFlag) RecurringErrors(ErrorMsgIndex)%WarmupCount = 1
IF (DoingSizing) RecurringErrors(ErrorMsgIndex)%SizingCount = 1
! For max, min, and sum values, store the current value when a new recurring message is created
IF (PRESENT(ErrorReportMaxOf)) THEN
RecurringErrors(ErrorMsgIndex)%MaxValue = ErrorReportMaxOf
RecurringErrors(ErrorMsgIndex)%ReportMax = .TRUE.
IF (PRESENT(ErrorReportMaxUnits)) THEN
RecurringErrors(ErrorMsgIndex)%MaxUnits=ErrorReportMaxUnits
ENDIF
ENDIF
IF (PRESENT(ErrorReportMinOf)) THEN
RecurringErrors(ErrorMsgIndex)%MinValue = ErrorReportMinOf
RecurringErrors(ErrorMsgIndex)%ReportMin = .TRUE.
IF (PRESENT(ErrorReportMinUnits)) THEN
RecurringErrors(ErrorMsgIndex)%MinUnits=ErrorReportMinUnits
ENDIF
ENDIF
IF (PRESENT(ErrorReportSumOf)) THEN
RecurringErrors(ErrorMsgIndex)%SumValue = ErrorReportSumOf
RecurringErrors(ErrorMsgIndex)%ReportSum = .TRUE.
IF (PRESENT(ErrorReportSumUnits)) THEN
RecurringErrors(ErrorMsgIndex)%SumUnits=ErrorReportSumUnits
ENDIF
ENDIF
ELSEIF (ErrorMsgIndex > 0) THEN
! Do stats and store
RecurringErrors(ErrorMsgIndex)%Count = RecurringErrors(ErrorMsgIndex)%Count + 1
IF (WarmupFlag) RecurringErrors(ErrorMsgIndex)%WarmupCount = RecurringErrors(ErrorMsgIndex)%WarmupCount + 1
IF (DoingSizing) RecurringErrors(ErrorMsgIndex)%SizingCount = RecurringErrors(ErrorMsgIndex)%SizingCount + 1
IF (PRESENT(ErrorReportMaxOf)) THEN
RecurringErrors(ErrorMsgIndex)%MaxValue = MAX(ErrorReportMaxOf,RecurringErrors(ErrorMsgIndex)%MaxValue)
RecurringErrors(ErrorMsgIndex)%ReportMax = .TRUE.
ENDIF
IF (PRESENT(ErrorReportMinOf)) THEN
RecurringErrors(ErrorMsgIndex)%MinValue = MIN(ErrorReportMinOf,RecurringErrors(ErrorMsgIndex)%MinValue)
RecurringErrors(ErrorMsgIndex)%ReportMin = .TRUE.
ENDIF
IF (PRESENT(ErrorReportSumOf)) THEN
RecurringErrors(ErrorMsgIndex)%SumValue = ErrorReportSumOf + RecurringErrors(ErrorMsgIndex)%SumValue
RecurringErrors(ErrorMsgIndex)%ReportSum = .TRUE.
ENDIF
ELSE
! If ErrorMsgIndex < 0, then do nothing
ENDIF
RETURN
END SUBROUTINE StoreRecurringErrorMessage