Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
logical, | intent(inout) | :: | ErrorsFound | |||
character(len=*), | intent(in) | :: | WhatFieldString | |||
character(len=*), | intent(in) | :: | WhatObjectString | |||
character(len=*), | intent(in) | :: | ErrorLevel | |||
character(len=*), | intent(in), | optional | :: | LowerBoundString | ||
logical, | intent(in), | optional | :: | LowerBoundCondition | ||
character(len=*), | intent(in), | optional | :: | UpperBoundString | ||
logical, | intent(in), | optional | :: | UpperBoundCondition | ||
character(len=*), | intent(in), | optional | :: | ValueString | ||
character(len=*), | intent(in), | optional | :: | WhatObjectName |
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 RangeCheck(ErrorsFound,WhatFieldString,WhatObjectString,ErrorLevel, &
LowerBoundString,LowerBoundCondition,UpperBoundString,UpperBoundCondition, &
ValueString,WhatObjectName)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN July 2000
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is a general purpose "range check" routine for GetInput routines.
! Using the standard "ErrorsFound" logical, this routine can produce a reasonable
! error message to describe the situation in addition to setting the ErrorsFound variable
! to true.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(INOUT) :: ErrorsFound ! Set to true if error detected
CHARACTER(len=*), INTENT(IN) :: WhatFieldString ! Descriptive field for string
CHARACTER(len=*), INTENT(IN) :: WhatObjectString ! Descriptive field for object, Zone Name, etc.
CHARACTER(len=*), INTENT(IN) :: ErrorLevel ! 'Warning','Severe','Fatal')
CHARACTER(len=*), INTENT(IN), OPTIONAL :: LowerBoundString ! String for error message, if applicable
LOGICAL, INTENT(IN), OPTIONAL :: LowerBoundCondition ! Condition for error condition, if applicable
CHARACTER(len=*), INTENT(IN), OPTIONAL :: UpperBoundString ! String for error message, if applicable
LOGICAL, INTENT(IN), OPTIONAL :: UpperBoundCondition ! Condition for error condition, if applicable
CHARACTER(len=*), INTENT(IN), OPTIONAL :: ValueString ! Value with digits if to be displayed with error
CHARACTER(len=*), INTENT(IN), OPTIONAL :: WhatObjectName ! ObjectName -- used for error messages
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
CHARACTER(len=7) ErrorString ! Uppercase representation of ErrorLevel
LOGICAL Error
CHARACTER(len=300) Message1
CHARACTER(len=300) Message2
Error=.false.
IF (PRESENT(UpperBoundCondition)) THEN
IF (.not. UpperBoundCondition) Error=.true.
ENDIF
IF (PRESENT(LowerBoundCondition)) THEN
IF (.not. LowerBoundCondition) Error=.true.
ENDIF
IF (Error) THEN
CALL ConvertCasetoUPPER(ErrorLevel,ErrorString)
Message1=trim(WhatObjectString)
IF (PRESENT(WhatObjectName)) Message1=trim(Message1)//'="'//trim(WhatObjectName)//'", out of range data'
Message2='Out of range value field='//TRIM(WhatFieldString)
IF (PRESENT(ValueString)) Message2=trim(Message2)//', Value=['//trim(ValueString)//']'
Message2=trim(Message2)//', range={'
IF (PRESENT(LowerBoundString)) Message2=TRIM(Message2)//TRIM(LowerBoundString)
IF (PRESENT(LowerBoundString) .and. PRESENT(UpperBoundString)) THEN
Message2=TRIM(Message2)//' and '//TRIM(UpperBoundString)
ELSEIF (PRESENT(UpperBoundString)) THEN
Message2=TRIM(Message2)//TRIM(UpperBoundString)
ENDIF
Message2=TRIM(Message2)//'}'
SELECT CASE(ErrorString(1:1))
CASE('W','w')
CALL ShowWarningError(Message1)
CALL ShowContinueError(Message2)
CASE('S','s')
CALL ShowSevereError(Message1)
CALL ShowContinueError(Message2)
ErrorsFound=.true.
CASE('F','f')
CALL ShowSevereError(Message1)
CALL ShowContinueError(Message2)
CALL ShowFatalError('Program terminates due to preceding condition(s).')
CASE DEFAULT
CALL ShowSevereError(TRIM(Message1))
CALL ShowContinueError(Message2)
ErrorsFound=.true.
END SELECT
ENDIF
RETURN
END SUBROUTINE RangeCheck