Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | UCInputLine | |||
integer, | intent(out) | :: | WhichMinMax | |||
character(len=*), | intent(out) | :: | MinMaxString | |||
real(kind=r64), | intent(out) | :: | Value | |||
character(len=*), | intent(out) | :: | DefaultString | |||
integer, | intent(out) | :: | ErrLevel |
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 ProcessMinMaxDefLine(UCInputLine,WhichMinMax,MinMaxString,Value,DefaultString,ErrLevel)
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN July 2000
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine processes the IDD lines that start with
! \minimum or \maximum and set up the parameters so that it can
! be automatically checked.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! IDD Statements.
! \minimum Minimum that includes the following value
! i.e. min >=
! \minimum> Minimum that must be > than the following value
!
! \maximum Maximum that includes the following value
! i.e. max <=
! \maximum< Maximum that must be < than the following value
!
! \default Default for field (when field is blank)
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*), INTENT(IN) :: UCInputLine ! part of input line starting \min or \max
INTEGER, INTENT(OUT) :: WhichMinMax !=0 (none/invalid), =1 \min, =2 \min>, =3 \max, =4 \max<
CHARACTER(len=*), INTENT(OUT) :: MinMaxString
REAL(r64), INTENT(OUT) :: Value
CHARACTER(len=*), INTENT(OUT) :: DefaultString
INTEGER, INTENT(OUT) :: ErrLevel
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER Pos
INTEGER NSpace
INTEGER, EXTERNAL :: FindNonSpace
LOGICAL ErrFlag
ErrLevel=0
Pos=SCAN(UCInputLine,' ')
SELECT CASE (MakeUPPERCase(UCInputLine(1:4)))
CASE('\MIN')
WhichMinMax=1
IF (SCAN(UCInputLine,'>') /= 0) THEN
Pos=SCAN(UCInputLine,'>')+1
WhichMinMax=2
ENDIF
IF (WhichMinMax == 1) THEN
MinMaxString='>='
ELSE
MinMaxString='>'
ENDIF
CASE('\MAX')
WhichMinMax=3
IF (SCAN(UCInputLine,'<') /= 0) THEN
POS=SCAN(UCInputLine,'<')+1
WhichMinMax=4
ENDIF
IF (WhichMinMax == 3) THEN
MinMaxString='<='
ELSE
MinMaxString='<'
ENDIF
CASE('\DEF')
WhichMinMax=5
MinMaxString=Blank
CASE('\AUT')
WhichMinMax=6
MinMaxString=Blank
CASE DEFAULT
WhichMinMax=0 ! invalid field
MinMaxString=Blank
Value=-999999.d0
END SELECT
IF (WhichMinMax /= 0) THEN
NSpace=FindNonSpace(UCInputLine(Pos:))
IF (NSpace == 0) THEN
IF (WhichMinMax /= 6) THEN ! Only autosize/autocalculate can't have argument
CALL ShowSevereError('IP: IDD Line='//TRIM(IPTrimSigDigits(NumLines))// &
'Min/Max/Default field cannot be blank -- must have value',EchoInputFile)
ErrLevel=2
ELSEIF (UCINPUTLINE(1:6) == '\AUTOS') THEN
Value=DefAutosizeValue
ELSEIF (UCINPUTLINE(1:6) == '\AUTOC') THEN
Value=DefAutocalculateValue
ENDIF
ELSE
Pos=Pos+NSpace-1
NSpace=SCAN(UCInputLine(Pos:),' !')
MinMaxString=TRIM(MinMaxString)//TRIM(UCInputLine(Pos:Pos+NSpace-1))
Value=ProcessNumber(UCInputLine(Pos:Pos+NSpace-1),ErrFlag)
IF (ErrFlag) ErrLevel=1
NSpace=Scan(UCInputLine(Pos:),'!')
IF (NSpace > 0) THEN
DefaultString=UCInputLine(Pos:Pos+NSpace-2)
ELSE
DefaultString=UCInputLine(Pos:)
ENDIF
DefaultString=ADJUSTL(DefaultString)
IF (DefaultString == Blank) THEN
IF (WhichMinMax == 6) THEN
IF (UCINPUTLINE(1:6) == '\AUTOS') THEN
Value=DefAutosizeValue
ELSE
Value=DefAutoCalculateValue
ENDIF
ELSE
CALL ShowSevereError('IP: IDD Line='//TRIM(IPTrimSigDigits(NumLines))// &
'Min/Max/Default field cannot be blank -- must have value',EchoInputFile)
ErrLevel=2
ENDIF
ENDIF
ENDIF
ENDIF
RETURN
END SUBROUTINE ProcessMinMaxDefLine