Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | UnitNumber | |||
integer, | intent(inout) | :: | CurPos | |||
logical, | intent(inout) | :: | BlankLine | |||
integer, | intent(inout) | :: | InputLineLength | |||
logical, | intent(inout) | :: | EndofFile | |||
logical, | intent(inout), | optional | :: | MinMax | ||
integer, | intent(inout), | optional | :: | WhichMinMax | ||
character(len=*), | intent(inout), | optional | :: | MinMaxString | ||
real(kind=r64), | intent(inout), | optional | :: | Value | ||
logical, | intent(inout), | optional | :: | Default | ||
character(len=*), | intent(inout), | optional | :: | DefString | ||
logical, | intent(inout), | optional | :: | AutoSizable | ||
logical, | intent(inout), | optional | :: | AutoCalculatable | ||
logical, | intent(inout), | optional | :: | RetainCase | ||
logical, | intent(inout), | optional | :: | ErrorsFound |
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 ReadInputLine(UnitNumber,CurPos,BlankLine,InputLineLength,EndofFile, &
MinMax,WhichMinMax,MinMaxString,Value,Default,DefString,AutoSizable, &
AutoCalculatable,RetainCase,ErrorsFound)
! SUBROUTINE INFORMATION:
! AUTHOR Linda K. Lawrie
! DATE WRITTEN September 1997
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine reads a line in the specified file and checks for end of file
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: UnitNumber
INTEGER, INTENT(INOUT) :: CurPos
LOGICAL, INTENT(INOUT) :: EndofFile
LOGICAL, INTENT(INOUT) :: BlankLine
INTEGER, INTENT(INOUT) :: InputLineLength
LOGICAL, INTENT(INOUT), OPTIONAL :: MinMax
INTEGER, INTENT(INOUT), OPTIONAL :: WhichMinMax !=0 (none/invalid), =1 \min, =2 \min>, =3 \max, =4 \max< !Objexx:OPTIONAL Used without PRESENT check
CHARACTER(len=*), INTENT(INOUT), OPTIONAL :: MinMaxString !Objexx:OPTIONAL Used without PRESENT check
REAL(r64), INTENT(INOUT), OPTIONAL :: Value !Objexx:OPTIONAL Used without PRESENT check
LOGICAL, INTENT(INOUT), OPTIONAL :: Default
CHARACTER(len=*), INTENT(INOUT), OPTIONAL :: DefString !Objexx:OPTIONAL Used without PRESENT check
LOGICAL, INTENT(INOUT), OPTIONAL :: AutoSizable
LOGICAL, INTENT(INOUT), OPTIONAL :: AutoCalculatable
LOGICAL, INTENT(INOUT), OPTIONAL :: RetainCase !Objexx:OPTIONAL Used without PRESENT check
LOGICAL, INTENT(INOUT), OPTIONAL :: ErrorsFound !Objexx:OPTIONAL Used without PRESENT check
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=1), PARAMETER :: TabChar=CHAR(9)
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER ReadStat
INTEGER Pos
INTEGER Slash
INTEGER P1
CHARACTER(len=MaxInputLineLength) UCInputLine ! Each line can be up to MaxInputLineLength characters long
LOGICAL TabsInLine
INTEGER NSpace
LOGICAL ErrFlag
INTEGER, EXTERNAL :: FindNonSpace
INTEGER ErrLevel
INTEGER endcol
CHARACTER(len=52) cNumLines
LOGICAL LineTooLong
ErrFlag=.false.
LineTooLong=.false.
READ(UnitNumber,fmta,IOSTAT=ReadStat) InputLine
IF (ReadStat /= 0) InputLine=Blank
! Following section of code allows same software to read Win or Unix files without translating
IF (StripCR) THEN
endcol=LEN_TRIM(InputLine)
IF (ICHAR(InputLine(endcol:endcol)) == iASCII_CR) InputLine(endcol:endcol)=Blank
ENDIF
IF (InputLine(MaxInputLineLength+1:) /= Blank) THEN
LineTooLong=.true.
InputLine=InputLine(1:MaxInputLineLength)
ENDIF
P1=SCAN(InputLine,TabChar)
TabsInLine=.false.
DO WHILE (P1>0)
TabsInLine=.true.
InputLine(P1:P1)=Blank
P1=SCAN(InputLine,TabChar)
ENDDO
BlankLine=.false.
CurPos=1
IF (ReadStat < 0) THEN
EndofFile=.true.
ELSE
IF (EchoInputLine) THEN
NumLines=NumLines+1
IF (NumLines < 100000) THEN
WRITE(EchoInputFile,'(2X,I5,1X,A)') NumLines,TRIM(InputLine)
ELSE
cNumLines=IPTrimSigDigits(NumLines)
WRITE(EchoInputFile,'(1X,A,1X,A)') TRIM(cNumLines),TRIM(InputLine)
ENDIF
IF (TabsInLine) WRITE(EchoInputFile,"(6X,'***** Tabs eliminated from above line')")
IF (LineTooLong) THEN
CALL ShowSevereError('Input line longer than maximum length allowed='//TRIM(IPTrimSigDigits(MaxInputLineLength))// &
' characters. Other errors may follow.')
CALL ShowContinueError('.. at line='//TRIM(IPTrimSigDigits(NumLines))//', first 50 characters='// &
TRIM(InputLine(1:50)))
WRITE(EchoInputFile,"(6X,'***** Previous line is longer than allowed length for input line')")
ENDIF
ENDIF
EchoInputLine=.true.
InputLineLength=LEN_TRIM(InputLine)
IF (InputLineLength == 0) THEN
BlankLine=.true.
ENDIF
IF (ProcessingIDD) THEN
Pos=SCAN(InputLine,'!\') ! 4/30/09 remove ~
Slash=INDEX(InputLine,'\')
ELSE
Pos=SCAN(InputLine,'!') ! 4/30/09 remove ~
Slash=0
ENDIF
IF (Pos /= 0) THEN
InputLineLength=Pos
IF (Pos-1 > 0) THEN
IF (LEN_TRIM(InputLine(1:Pos-1)) == 0) THEN
BlankLine=.true.
ENDIF
ELSE
BlankLine=.true.
ENDIF
IF (Slash /= 0 .and. Pos == Slash) THEN
UCInputLine=MakeUPPERCase(InputLine)
IF (UCInputLine(Slash:Slash+5) == '\FIELD') THEN
! Capture Field Name
CurrentFieldName=InputLine(Slash+6:)
CurrentFieldName=ADJUSTL(CurrentFieldName)
P1=SCAN(CurrentFieldName,'!')
IF (P1 /= 0) CurrentFieldName(P1:)=Blank
FieldSet=.true.
ELSE
FieldSet=.false.
ENDIF
IF (UCInputLine(Slash:Slash+14) == '\REQUIRED-FIELD') THEN
RequiredField=.true.
ENDIF ! Required-field arg
IF (UCInputLine(Slash:Slash+15) == '\REQUIRED-OBJECT') THEN
RequiredObject=.true.
ENDIF ! Required-object arg
IF (UCInputLine(Slash:Slash+13) == '\UNIQUE-OBJECT') THEN
UniqueObject=.true.
ENDIF ! Unique-object arg
IF (UCInputLine(Slash:Slash+10) == '\EXTENSIBLE') THEN
ExtensibleObject=.true.
IF (UCInputLine(Slash+11:Slash+11) /= ':') THEN
CALL ShowFatalError('IP: IDD Line='//TRIM(IPTrimSigDigits(NumLines))// &
' Illegal definition for extensible object, should be "\extensible:<num>"',EchoInputFile)
ELSE
! process number
NSpace=SCAN(UCInputLine(Slash+12:),' !')
ExtensibleNumFields=INT(ProcessNumber(UCInputLine(Slash+12:Slash+12+NSpace-1),ErrFlag))
IF (ErrFlag) THEN
CALL ShowSevereError('IP: IDD Line='//TRIM(IPTrimSigDigits(NumLines))// &
' Illegal Number for \extensible:<num>',EchoInputFile)
ENDIF
ENDIF
ENDIF ! Extensible arg
IF (UCInputLine(Slash:Slash+10) == '\RETAINCASE') THEN
RetainCase=.true.
ENDIF ! Unique-object arg
IF (UCInputLine(Slash:Slash+10) == '\MIN-FIELDS') THEN
! RequiredField=.true.
NSpace=FindNonSpace(UCInputLine(Slash+11:))
IF (NSpace == 0) THEN
CALL ShowSevereError('IP: IDD Line='//TRIM(IPTrimSigDigits(NumLines))// &
' Need number for \Min-Fields',EchoInputFile)
ErrFlag=.true.
MinimumNumberOfFields=0
ELSE
Slash=Slash+11+NSpace-1
NSpace=SCAN(UCInputLine(Slash:),' !')
MinimumNumberOfFields=INT(ProcessNumber(UCInputLine(Slash:Slash+NSpace-1),ErrFlag))
IF (ErrFlag) THEN
CALL ShowSevereError('IP: IDD Line='//TRIM(IPTrimSigDigits(NumLines))// &
' Illegal Number for \Min-Fields',EchoInputFile)
ENDIF
ENDIF
ENDIF ! Min-Fields Arg
IF (UCInputLine(Slash:Slash+9) == '\OBSOLETE') THEN
NSpace=INDEX(UCInputLine(Slash+9:),'=>')
IF (NSpace == 0) THEN
CALL ShowSevereError('IP: IDD Line='//TRIM(IPTrimSigDigits(NumLines))// &
' Need replacement object for \Obsolete objects',EchoInputFile)
ErrFlag=.true.
ELSE
Slash=Slash+9+NSpace+1
NSpace=SCAN(UCInputLine(Slash:),'!')
IF (NSpace == 0) THEN
ReplacementName=InputLine(Slash:)
ELSE
ReplacementName=InputLine(Slash:Slash+NSpace-2)
ENDIF
ObsoleteObject=.true.
ENDIF
ENDIF ! Obsolete Arg
IF (PRESENT(MinMax)) THEN
IF (UCInputLine(Pos:Pos+7)=='\MINIMUM' .or. &
UCInputLine(Pos:Pos+7)=='\MAXIMUM') THEN
MinMax=.true.
CALL ProcessMinMaxDefLine(UCInputLine(Pos:),WhichMinMax,MinMaxString,Value,DefString,ErrLevel)
IF (ErrLevel > 0) THEN
CALL ShowSevereError('IP: IDD Line='//TRIM(IPTrimSigDigits(NumLines))// &
' Error in Minimum/Maximum designation -- invalid number='//TRIM(UCInputLine(Pos:)), &
EchoInputFile)
ErrFlag=.true.
ENDIF
ELSE
MinMax=.false.
ENDIF
ENDIF ! Min/Max Args
IF (PRESENT(Default)) THEN
IF (UCInputLine(Pos:Pos+7)=='\DEFAULT') THEN
! WhichMinMax, MinMaxString not filled here
Default=.true.
CALL ProcessMinMaxDefLine(InputLine(Pos:),WhichMinMax,MinMaxString,Value,DefString,ErrLevel)
IF (.not. RetainCase .and. DefString /= Blank) DefString=MakeUPPERCase(DefString)
IF (ErrLevel > 1) THEN
CALL ShowContinueError('Blank Default Field Encountered',EchoInputFile)
ErrFlag=.true.
ENDIF
ELSE
Default=.false.
ENDIF
ENDIF ! Default Arg
IF (PRESENT(AutoSizable)) THEN
IF (UCInputLine(Pos:Pos+5)=='\AUTOS') THEN
AutoSizable=.true.
CALL ProcessMinMaxDefLine(UCInputLine(Pos:),WhichMinMax,MinMaxString,Value,DefString,ErrLevel)
IF (ErrLevel > 0) THEN
CALL ShowSevereError('IP: IDD Line='//TRIM(IPTrimSigDigits(NumLines))// &
' Error in Autosize designation -- invalid number='//TRIM(UCInputLine(Pos:)),EchoInputFile)
ErrFlag=.true.
ENDIF
ELSE
AutoSizable=.false.
ENDIF
ENDIF ! AutoSizable Arg
IF (PRESENT(AutoCalculatable)) THEN
IF (UCInputLine(Pos:Pos+5)=='\AUTOC') THEN
AutoCalculatable=.true.
CALL ProcessMinMaxDefLine(UCInputLine(Pos:),WhichMinMax,MinMaxString,Value,DefString,ErrLevel)
IF (ErrLevel > 0) THEN
CALL ShowSevereError('IP: IDD Line='//TRIM(IPTrimSigDigits(NumLines))// &
' Error in Autocalculate designation -- invalid number='// &
TRIM(UCInputLine(Pos:)),EchoInputFile)
ErrFlag=.true.
ENDIF
ELSE
AutoCalculatable=.false.
ENDIF
ENDIF ! AutoCalculatable Arg
ENDIF
ENDIF
ENDIF
IF (ErrFlag) THEN
IF (PRESENT(ErrorsFound)) THEN
ErrorsFound=.true.
ENDIF
ENDIF
RETURN
END SUBROUTINE ReadInputLine