You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
257 lines
9.3 KiB
257 lines
9.3 KiB
C Copyright(C) 1999-2020 National Technology & Engineering Solutions
|
|
C of Sandia, LLC (NTESS). Under the terms of Contract DE-NA0003525 with
|
|
C NTESS, the U.S. Government retains certain rights in this software.
|
|
C
|
|
C See packages/seacas/LICENSE for details
|
|
SUBROUTINE FFISTR( LINE,MFIELD,IDCONT,NFIELD,KVALUE,CVALUE,IVALUE,
|
|
* RVALUE )
|
|
CHARACTER*(*) LINE,CVALUE(MFIELD)
|
|
CHARACTER*32 CFIELD
|
|
INTEGER KVALUE(MFIELD),IVALUE(MFIELD)
|
|
REAL RVALUE(MFIELD)
|
|
|
|
INTEGER TABC
|
|
TABC = 9
|
|
|
|
************************************************************************
|
|
|
|
C FREFLD INPUT SYSTEM - ANSI FORTRAN - USER INTERFACE ROUTINE
|
|
|
|
C DESCRIPTION:
|
|
C This routine is the main parsing routine of the SUPES Free Field
|
|
C Input system. It parses a CHARACTER string into data fields, and
|
|
C returns the CHARACTER, REAL, and INTEGER value for each field. A
|
|
C value which indicates whether the character and numeric values
|
|
C were explicitly defined by a valid string or simply set to a
|
|
C default blank or zero is also returned.
|
|
|
|
C FORMAL PARAMETERS:
|
|
C LINE CHARACTER Input string.
|
|
C MFIELD INTEGER Maximum number of data fields to be returned.
|
|
C IDCONT INTEGER Continuation flag ( 0 = NO continuation )
|
|
C NFIELD INTEGER Number of data fields found.
|
|
C KVALUE INTEGER Translation states of the data fields:
|
|
C -1 = This is a null field.
|
|
C 0 = This is a non-numeric field.
|
|
C 1 = This is a REAL numeric field.
|
|
C 2 = This is an INTEGER numeric field.
|
|
C CVALUE CHARACTER Character values of the data fields.
|
|
C RVALUE REAL Floating-point values of the data fields.
|
|
C IVALUE INTEGER Integer values of the data fields.
|
|
|
|
C ROUTINES CALLED:
|
|
C STRIPB Strip leading/trailing blanks from a string.
|
|
C EXUPCS Convert a string to ANSI FORTRAN character set.
|
|
C QUOTED Process a quoted string.
|
|
|
|
************************************************************************
|
|
|
|
C Initialize output arrays to their default values and zero field
|
|
C counter, unless IDCONT indicates that this is a continuation record.
|
|
|
|
IF ( IDCONT .EQ. 0 ) THEN
|
|
DO 300 I = 1 , MFIELD
|
|
KVALUE(I) = -1
|
|
CVALUE(I) = ' '
|
|
RVALUE(I) = 0.
|
|
IVALUE(I) = 0
|
|
300 CONTINUE
|
|
NFIELD = 0
|
|
END IF
|
|
IDCONT = 0
|
|
|
|
************************************************************************
|
|
|
|
C Isolate the effective portion of the input line. At the end
|
|
C of this phase LINE(ILEFT:ISTOP) will represent this portion.
|
|
C The continuation flag IDCONT will indicate whether or not a
|
|
C continuation line is to follow this record. Exit at any
|
|
C point where the effective portion of the line becomes null.
|
|
|
|
ILEFT = 1
|
|
ISTOP = LEN ( LINE )
|
|
|
|
C Now start processing fields.
|
|
C Upper range of loop is a dummy maximum.
|
|
|
|
c Had to fix more VAX FORTRAN specific stuff. We'll try this only
|
|
c for a short while. JRR.
|
|
|
|
DO 1 IFLD = 1, ISTOP
|
|
|
|
CALL STRIPB( LINE(ILEFT:ISTOP), IL, ISTOP )
|
|
ISTOP = ISTOP + ILEFT - 1
|
|
ILEFT = IL + ILEFT - 1
|
|
IF ( ILEFT .GT. ISTOP ) THEN
|
|
|
|
C Remainder of line is null.
|
|
|
|
RETURN
|
|
ELSE IF ( LINE(ILEFT:ILEFT) .EQ. '$' ) THEN
|
|
|
|
C Rest is comment.
|
|
|
|
RETURN
|
|
ELSE IF ( LINE(ILEFT:ILEFT) .EQ. '*' ) THEN
|
|
|
|
C Continuation.
|
|
|
|
IDCONT = 1
|
|
RETURN
|
|
ELSE IF ( LINE(ILEFT:ILEFT) .EQ. '''' ) THEN
|
|
|
|
C This is the beginning of a quoted string. Call a special handler.
|
|
|
|
CALL QUOTED ( LINE(ILEFT:ISTOP), IL, IRIGHT )
|
|
IF ( IRIGHT .NE. 0 ) IRIGHT = IRIGHT + ILEFT - 1
|
|
ILEFT = IL+ ILEFT - 1
|
|
ELSE IF ( INDEX ( ',=', LINE(ILEFT:ILEFT) ) .NE. 0 ) THEN
|
|
|
|
C This is a null field.
|
|
|
|
IRIGHT = 0
|
|
ELSE
|
|
|
|
C Find the end of this token.
|
|
C Valid delimiters, are ' ', '*', ',', '=', '$'.
|
|
|
|
IBLNK = INDEX ( LINE(ILEFT:ISTOP), ' ' ) + ILEFT - 2
|
|
IAST = INDEX ( LINE(ILEFT:ISTOP), '*' ) + ILEFT - 2
|
|
ICOMA = INDEX ( LINE(ILEFT:ISTOP), ',' ) + ILEFT - 2
|
|
IEQLS = INDEX ( LINE(ILEFT:ISTOP), '=' ) + ILEFT - 2
|
|
IDOLR = INDEX ( LINE(ILEFT:ISTOP), '$' ) + ILEFT - 2
|
|
|
|
ITAB = INDEX ( LINE(ILEFT:ISTOP), CHAR(TABC)) + ILEFT - 2
|
|
IF ( IBLNK .LT. ILEFT ) IBLNK = ISTOP + 1
|
|
IF ( IAST .LT. ILEFT ) IAST = ISTOP + 1
|
|
IF ( ICOMA .LT. ILEFT ) ICOMA = ISTOP + 1
|
|
IF ( IEQLS .LT. ILEFT ) IEQLS = ISTOP + 1
|
|
IF ( IDOLR .LT. ILEFT ) IDOLR = ISTOP + 1
|
|
IF ( ITAB .LT. ILEFT ) ITAB = ISTOP + 1
|
|
IRIGHT = MIN ( IBLNK, IAST, ICOMA, IEQLS, IDOLR,
|
|
$ ITAB, ISTOP )
|
|
|
|
C Convert data to standard character set -
|
|
|
|
CALL EXUPCS( LINE(ILEFT:IRIGHT) )
|
|
END IF
|
|
|
|
C Process this field.
|
|
C Don't process this field unless there is room in the data arrays -
|
|
|
|
NFIELD = NFIELD + 1
|
|
IF ( NFIELD .LE. MFIELD ) THEN
|
|
|
|
C Calculate the effective length of this field -
|
|
|
|
LFIELD = IRIGHT - ILEFT + 1
|
|
IF ( LFIELD .LE. 0 ) THEN
|
|
|
|
C This is a null field; skip it -
|
|
|
|
ELSE IF ( LFIELD .GT. 32 ) THEN
|
|
|
|
C This field exceeds the maximum allowable numeric
|
|
C field size; define only the character value -
|
|
|
|
CVALUE(NFIELD) = LINE(ILEFT:IRIGHT)
|
|
KVALUE(NFIELD) = 0
|
|
ELSE
|
|
|
|
C Define the character value for this field,
|
|
C then right-justify and attempt numeric translations -
|
|
|
|
CVALUE(NFIELD) = LINE(ILEFT:IRIGHT)
|
|
KVALUE(NFIELD) = 0
|
|
CFIELD = ' '
|
|
IJUST = 32 - LFIELD + 1
|
|
CFIELD(IJUST:32) = LINE(ILEFT:IRIGHT)
|
|
|
|
C See if a digit is present in this field.
|
|
C If there is no digit present, then do not accept
|
|
C this token as a valid real or integer value.
|
|
C This is needed, since some systems accept a token like
|
|
C "E", "Q", "INF", ... as a valid real number even though
|
|
C no digit appears in the token.
|
|
IF ( INDEX(CFIELD(IJUST:32),'0').NE.0 .OR.
|
|
1 INDEX(CFIELD(IJUST:32),'1').NE.0 .OR.
|
|
2 INDEX(CFIELD(IJUST:32),'2').NE.0 .OR.
|
|
3 INDEX(CFIELD(IJUST:32),'3').NE.0 .OR.
|
|
4 INDEX(CFIELD(IJUST:32),'4').NE.0 .OR.
|
|
5 INDEX(CFIELD(IJUST:32),'5').NE.0 .OR.
|
|
6 INDEX(CFIELD(IJUST:32),'6').NE.0 .OR.
|
|
7 INDEX(CFIELD(IJUST:32),'7').NE.0 .OR.
|
|
8 INDEX(CFIELD(IJUST:32),'8').NE.0 .OR.
|
|
9 INDEX(CFIELD(IJUST:32),'9').NE.0 ) THEN
|
|
C ... One more check. If the field contains a digit, but starts with
|
|
C 'D' or 'E', several systems will interpret this as a valid
|
|
C Integer and/or real number. This is not the desired behavior
|
|
IF (CFIELD(IJUST:IJUST) .NE. 'D' .AND.
|
|
& CFIELD(IJUST:IJUST) .NE. 'E') THEN
|
|
IDIG = 1
|
|
ELSE
|
|
IDIG = 0
|
|
END IF
|
|
ELSE
|
|
IDIG = 0
|
|
END IF
|
|
|
|
C ... It should not be necessary to initialize ITRANS, but the gcc-4.0.0 gfortran
|
|
C Does not correctly set ITRANS after the first execution if it is non-zero.
|
|
C It seems to work correctly if initialized to zero.
|
|
ITRANS = 0
|
|
READ( CFIELD,3000,IOSTAT=ITRANS ) RFIELD
|
|
IF ( IDIG .EQ. 1 .AND. ITRANS .EQ. 0 ) THEN
|
|
|
|
C This field has a valid floating-point value -
|
|
|
|
RVALUE(NFIELD) = RFIELD
|
|
KVALUE(NFIELD) = 1
|
|
END IF
|
|
READ( CFIELD,4000,IOSTAT=ITRANS ) IFIELD
|
|
IF ( IDIG .EQ. 1 .AND. ITRANS .EQ. 0 ) THEN
|
|
|
|
C This field has a valid integer value -
|
|
|
|
IVALUE(NFIELD) = IFIELD
|
|
KVALUE(NFIELD) = 2
|
|
ELSE IF ( KVALUE(NFIELD) .EQ. 1 .AND.
|
|
* ABS ( RVALUE(NFIELD) ) .LE. 1.E9 ) THEN
|
|
|
|
C This field has a valid real that did not automatically
|
|
C Translate to an integer. Try to convert the real to an
|
|
C integer.
|
|
|
|
IFIELD = RVALUE(NFIELD)
|
|
RFIELD = IFIELD
|
|
IF ( RFIELD .EQ. RVALUE(NFIELD) ) THEN
|
|
|
|
C Successful conversion of real to integer.
|
|
|
|
IVALUE(NFIELD) = IFIELD
|
|
KVALUE(NFIELD) = 2
|
|
END IF
|
|
END IF
|
|
END IF
|
|
END IF
|
|
|
|
C Remove any trailing delimiters before looping.
|
|
|
|
IF ( IRIGHT .GT. 0 ) ILEFT = MAX ( ILEFT, IRIGHT ) + 1
|
|
IF ( ILEFT .GT. ISTOP ) RETURN
|
|
CALL STRIPB( LINE(ILEFT:ISTOP), IL, ISTOP )
|
|
ISTOP = ISTOP + ILEFT - 1
|
|
ILEFT = IL + ILEFT - 1
|
|
IF ( ILEFT .GT. ISTOP ) RETURN
|
|
IF ( INDEX ( ',=', LINE(ILEFT:ILEFT) ) .NE. 0 )
|
|
* ILEFT = ILEFT + 1
|
|
IF ( ILEFT .GT. ISTOP ) RETURN
|
|
1 continue
|
|
|
|
c The end of the VAX FORTRAN DO Loop that I commented out. jrr.
|
|
|
|
c END DO
|
|
3000 FORMAT( F32.0 )
|
|
4000 FORMAT( I32 )
|
|
|
|
END
|
|
|