Cloned SEACAS for EXODUS library with extra build files for internal package management.
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.
 
 
 
 
 
 

159 lines
4.6 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
C=======================================================================
SUBROUTINE APARSE (LINE, MAXFLD,NUMFLD, ITYPE, CFIELD, RFIELD)
C=======================================================================
C --*** APARSE *** (ALGEBRA) Parse line into fields
C -- Written by Amy Gilkey - revised 02/23/88
C --
C --APARSE converts a line to uppercase and parses the line into individual
C --fields. A field is one of the following:
C -- a number (starts with 0-9 or ., rest = 0-9 or . or E or E+ or E-)
C -- a name (starts with A-Z, rest = A-Z or $ or :)
C -- a non-number or non-name character; ** is converted to ^
C --
C --Parameters:
C -- LINE - IN - the input line to be parsed, all uppercase
C -- MAXFLD - IN - the maximum number of parsed fields
C -- NUMFLD - OUT - the number of parsed fields
C -- ITYPE - OUT - the field types:
C -- -1= no value
C -- 0 = CFIELD only valid, name or invalid number string
C -- 1 = CFIELD and RFIELD only valid
C -- 3 = CFIELD only valid, character string
C -- CFIELD - OUT - the alphanumeric fields
C -- RFIELD - OUT - the numeric fields
CHARACTER*(*) LINE
INTEGER ITYPE(*)
CHARACTER*(*) CFIELD(*)
REAL RFIELD(*)
CHARACTER*32 CONVERT
CHARACTER CH
C --Initialize fields
CALL INIINT (MAXFLD, -1, ITYPE)
CALL INISTR (MAXFLD, ' ', CFIELD)
CALL INIREA (MAXFLD, 0.0, RFIELD)
NUMFLD = 0
C --Change line to upper case
CALL EXUPCS (LINE)
C --Repeat until done with input characters
IEND = LENSTR (LINE)
NCOL = 1
100 CONTINUE
IF (NCOL .LE. IEND) THEN
C --Skip blank characters
110 CONTINUE
IF (LINE(NCOL:NCOL) .EQ. ' ') THEN
NCOL = NCOL + 1
GOTO 110
END IF
CH = LINE(NCOL:NCOL)
NUMFLD = NUMFLD + 1
IF (((CH .GE. '0') .AND. (CH .LE. '9'))
& .OR. (CH .EQ. '.')) THEN
C --Get number string
ILEFT = NCOL
IRIGHT = 0
120 CONTINUE
IF (IRIGHT .EQ. 0) THEN
NCOL = NCOL + 1
CH = LINE(NCOL:NCOL)
IF (CH .EQ. 'E') THEN
CH = LINE(NCOL+1:NCOL+1)
IF ((CH .EQ. '+') .OR. (CH .EQ. '-')) NCOL = NCOL + 1
ELSE IF (CH .EQ. '.') THEN
CONTINUE
ELSE IF ((CH .GE. '0') .AND. (CH .LE. '9')) THEN
CONTINUE
ELSE
IRIGHT = NCOL - 1
END IF
GOTO 120
END IF
C --Convert number string and store
IF (NUMFLD .LE. MAXFLD) THEN
CFIELD(NUMFLD) = LINE(ILEFT:IRIGHT)
ITYPE(NUMFLD) = 0
CONVERT = ' '
IJUST = 32 - (IRIGHT - ILEFT + 1) + 1
CONVERT(IJUST:32) = LINE(ILEFT:IRIGHT)
READ (CONVERT, '(F32.0)', IOSTAT=ITRANS) RNUM
IF (ITRANS .EQ. 0) THEN
RFIELD(NUMFLD) = RNUM
ITYPE(NUMFLD) = 1
END IF
END IF
ELSE IF ((CH .GE. 'A') .AND. (CH .LE. 'Z')) THEN
C --Get word string and store
ILEFT = NCOL
IRIGHT = 0
130 CONTINUE
IF (IRIGHT .EQ. 0) THEN
NCOL = NCOL + 1
CH = LINE(NCOL:NCOL)
IF (((CH .GE. 'A') .AND. (CH .LE. 'Z'))
& .OR. ((CH .GE. '0') .AND. (CH .LE. '9'))
& .OR. (CH .EQ. '$') .OR. (CH .EQ. ':')
& .OR. (CH .EQ. '_') .OR. (CH .EQ. '.')) THEN
CONTINUE
ELSE
IRIGHT = NCOL - 1
END IF
GOTO 130
END IF
IF (NUMFLD .LE. MAXFLD) THEN
CFIELD(NUMFLD) = LINE(ILEFT:IRIGHT)
ITYPE(NUMFLD) = 0
END IF
ELSE
C --Get single character (or **) and store
C --Includes { , ( ) = }
NCOL = NCOL + 1
IF ((CH .EQ. '*') .AND. (LINE(NCOL:NCOL) .EQ. '*')) THEN
CH = '^'
NCOL = NCOL + 1
END IF
IF (NUMFLD .LE. MAXFLD) THEN
CFIELD(NUMFLD) = CH
ITYPE(NUMFLD) = 3
END IF
END IF
GOTO 100
END IF
RETURN
END