Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real(kind=r64), | intent(in) | :: | Value | |||
integer, | intent(in) | :: | FieldNumber | |||
integer, | intent(in) | :: | WhichObject | |||
character(len=*), | intent(in) | :: | PossibleAlpha | |||
logical, | intent(in) | :: | AutoSizable | |||
logical, | intent(in) | :: | AutoCalculatable |
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 InternalRangeCheck(Value,FieldNumber,WhichObject,PossibleAlpha,AutoSizable,AutoCalculatable)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN July 2000
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is an internal range check that checks fields which have
! the \min and/or \max values set for appropriate values.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
REAL(r64), INTENT(IN) :: Value
INTEGER, INTENT(IN) :: FieldNumber
INTEGER, INTENT(IN) :: WhichObject
CHARACTER(len=*), INTENT(IN) :: PossibleAlpha
LOGICAL, INTENT(IN) :: AutoSizable
LOGICAL, INTENT(IN) :: AutoCalculatable
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL Error
CHARACTER(len=32) FieldString
CHARACTER(len=MaxFieldNameLength) FieldNameString
CHARACTER(len=25) ValueString
CHARACTER(len=300) Message
Error=.false.
IF (ObjectDef(WhichObject)%NumRangeChks(FieldNumber)%WhichMinMax(1) == 1) THEN
IF (Value < ObjectDef(WhichObject)%NumRangeChks(FieldNumber)%MinMaxValue(1)) Error=.true.
ELSEIF (ObjectDef(WhichObject)%NumRangeChks(FieldNumber)%WhichMinMax(1) == 2) THEN
IF (Value <= ObjectDef(WhichObject)%NumRangeChks(FieldNumber)%MinMaxValue(1)) Error=.true.
ENDIF
IF (ObjectDef(WhichObject)%NumRangeChks(FieldNumber)%WhichMinMax(2) == 3) THEN
IF (Value > ObjectDef(WhichObject)%NumRangeChks(FieldNumber)%MinMaxValue(2)) Error=.true.
ELSEIF (ObjectDef(WhichObject)%NumRangeChks(FieldNumber)%WhichMinMax(2) == 4) THEN
IF (Value >= ObjectDef(WhichObject)%NumRangeChks(FieldNumber)%MinMaxValue(2)) Error=.true.
ENDIF
IF (Error) THEN
IF (.not. (AutoSizable .and. Value == ObjectDef(WhichObject)%NumRangeChks(FieldNumber)%AutoSizeValue) .and. &
.not. (AutoCalculatable .and. Value == ObjectDef(WhichObject)%NumRangeChks(FieldNumber)%AutoCalculateValue)) THEN
NumOutOfRangeErrorsFound=NumOutOfRangeErrorsFound+1
IF (ReportRangeCheckErrors) THEN
FieldString=IPTrimSigDigits(FieldNumber)
FieldNameString=ObjectDef(WhichObject)%NumRangeChks(FieldNumber)%FieldName
WRITE(ValueString,'(F20.5)') Value
ValueString=ADJUSTL(ValueString)
IF (FieldNameString /= Blank) THEN
Message='Out of range value Numeric Field#'//TRIM(FieldString)//' ('//TRIM(FieldNameString)// &
'), value='//TRIM(ValueString)//', range={'
ELSE ! Field Name not recorded
Message='Out of range value Numeric Field#'//TRIM(FieldString)//', value='//TRIM(ValueString)//', range={'
ENDIF
IF (ObjectDef(WhichObject)%NumRangeChks(FieldNumber)%WhichMinMax(1) /= 0) &
Message=TRIM(Message)//ObjectDef(WhichObject)%NumRangeChks(FieldNumber)%MinMaxString(1)
IF (ObjectDef(WhichObject)%NumRangeChks(FieldNumber)%WhichMinMax(1) /= 0 .and. &
ObjectDef(WhichObject)%NumRangeChks(FieldNumber)%WhichMinMax(2) /= 0) THEN
Message=TRIM(Message)//' and '//ObjectDef(WhichObject)%NumRangeChks(FieldNumber)%MinMaxString(2)
ELSEIF (ObjectDef(WhichObject)%NumRangeChks(FieldNumber)%WhichMinMax(2) /= 0) THEN
Message=TRIM(Message)//ObjectDef(WhichObject)%NumRangeChks(FieldNumber)%MinMaxString(2)
ENDIF
Message=TRIM(Message)//'}, in '//TRIM(ObjectDef(WhichObject)%Name)
IF (ObjectDef(WhichObject)%NameAlpha1) THEN
Message=TRIM(Message)//'='//PossibleAlpha
ENDIF
CALL ShowSevereError(TRIM(Message),EchoInputFile)
ENDIF
ENDIF
ENDIF
RETURN
END SUBROUTINE InternalRangeCheck