Tested routine for simulting external read of ascii data (for omission detection) 
Author Message
 Tested routine for simulting external read of ascii data (for omission detection)

I followed my own advice and re-wrote the posted routine after finding
a better way with less limits on use. Here is the code which I tested
on a few formats and data files.
Some extra limit checking can be added, error branching to label 15

      SUBROUTINE FMT(CF,CF1,CF2,LIM,NPOS,NWID,NV,NCRD)
      CHARACTER     CF(LIM),CF1(LIM),CF2(80),CX
      INTEGER       NPOS(NV),NWID(NV),NCRD
C SUBROUTINE TO SIMULATE DIRECT READING OF ASCII RECORDS, BY FIRST
C READING THE SAME NUMBER OF SYMBOLS AS ONE STRING THEN READING THE
C REQUIRED DATA FROM THE STRING. THE STRING CAN BE CHECKED FOR
BLANKS.
C METHOD. USE GIVEN FORMAT TO CREATE TWO OTHERS;
C         ONE TO READ THE ASCII DATA AS CHARACTERS AND INTERNAL
BLANKS,
C         THE OTHER TO READ INTEGER OR REAL VALUES FROM THE STRING.
C         A LIST OF NV VALUE FIELDS AND WIDTHS IS RETURNED.
C         NCRD COUNTS HOW MANY EXTERNAL RECORDS ENTER PER OPERATION.
C         NV IS NUMBER OF VARIABLES EXPECTED TO BE READ PER OPERATION
C         LIM IS CHARACTER LENGTH OF ORIGINAL FORMAT STATEMENT,
C           THE GERERATED ONES ARE SMALLER.
C LIMITS:
C 10 EXTERNAL ASCII RECORDS PER SINGLE READ OPERATION
C  9 LEVELS OF FORMAT BRACKET NESTING
C
C  GIVEN USER FORMAT ARRAY CF,
C  READ  DATA  WITH CF1 TO CHARACTER ARRAY AS CHARACTERS,
C  TREAT CHARACTER ARRAY AS STRING AND READ WITH CF2 GET VALUES.
C  USER MUST CHECK VALUE(IX) OF 0.0 AGAINST NPOS(IX), WIDTH NWID(IX)
C CAVEAT. EXCEEDING LIMITS IS NOT CHECKED OR REPORTED. (EASY TO ADD)
C
C NINE LEVELS OF NESTING (..) CLAUSES
      INTEGER*2     NRPC(9),NRPP(9),NLEV
      INTEGER*2     ICX,NC,ISW,J1,IP,NB
      EQUIVALENCE  (CX,ICX)
C FORMAT GENERATION TO READ DATA BLOCKS
      CHARACTER*8   CN8
      CHARACTER*3   CN3
      CHARACTER     CN(8)
      EQUIVALENCE  (CN3,CN8,CN)
      DATA    CN8/ 'nnnA1,/,' /
C
      ICX=0
      ISW=0
      NLEV=0
      NC=1
      J1=1
C FORMAT STARTS ITH OPENING BRACKET
      CF2(J1)='('
C COPY CF TO CF1 AND REMOVE ANY '/'
      DO 1 J=1,LIM
        CX=CF(J)
        CF1(J)=CX
        IF (CX.EQ.'(') NLEV=NLEV+1
C ELIMINATE '/' IN CF1. USED TO READ DATA VALUES FROM STRING
        IF (ISW.NE.0) THEN
          ISW=0
C REMOVE '/'
          CF1(J-1)=' '
C WAS (/, OR ,/, ?
          IF (CX.EQ.',') CF1(J)=' '
C WAS ,/) ?
          IF (CX.EQ.')') THEN
            IF (CF(J-2).EQ.',') CF1(J-2)=' '
          ENDIF
        ENDIF
C NOW NOTE IF FOUND '/'
        IF (CX.EQ.'/') ISW=1
        IF (CX.EQ.')') NLEV=NLEV-1
        IF (NLEV.EQ.0) GO TO 2
    1 CONTINUE
      IF (NLEV.NE.0) GO TO 15
C NOW HAVE FORMAT CF1
C
C PARSE CF TO FIND CHARACTERS/RECORD AND GENERATE READ FORMAT CF2
    2 J=0
      NB=0
      IP=1
C RESET THE REPEAT COUNT
    3 NR=0
C 'nn' REPEAT
    4 J=J+1
      CX=CF(J)
      IF (ICX.LE.#20) GO TO 15
      IF (ICX.LT.#30) GO TO 5
      IF (ICX.GT.#39) GO TO 6
      NR=10*NR+ICX-#30
      GO TO 4
C #21-#30   !#$%&'()*+,-./
    5 IF (NR.EQ.0) THEN
        IF (CX.EQ.',') GO TO 3
C SLASH OR RIGHT BRACKET?
        IF (CX.EQ.')') GO TO 12
        IF (CX.EQ.'/') GO TO 12
      ENDIF
C OPEN BRACKET ?
      IF (CX.EQ.'(') THEN
        IF (NR.EQ.0) NR=1
        NLEV=NLEV+1
        NRPC(NLEV)=NR
        NRPP(NLEV)=J
        GO TO 3
      ENDIF
C ANYTHING ELSE IS INVALID CODE AT J
      GO TO 15
C ACCEPT 'Bn','Bz','I','D','E','F','G','P','X' FIELD TYPES.
    6 IF (ICX.GT.#5A) ICX=ICX-#20
C X SKIPS
      IF (CX.EQ.'X') THEN
        IP=IP+NR
        NB=NB+NR
        GO TO 3
      ENDIF
C BLANK CONTROL?
      IF (CX.EQ.'B') THEN
        IF (NR.NE.0) GO TO 15
        J=J+1
        CX=CF(J)
        IF (ICX.GT.#5A) ICX=ICX-#20
        IF (CX.EQ.'N') GO TO 3
        IF (CX.EQ.'Z') GO TO 3
        GO TO 15
      ENDIF
C SCALE? kPa
      IF (CX.EQ.'P') THEN
        IF (NR.EQ.0) NR=1
        GO TO 3
      ENDIF
C STILL HAVE NR AS REPEAT
      NW=0
C I=INTEGER ?
      IF (CX.EQ.'I') GO TO 8
C D,E,F,G =REAL?
      IF (ICX.LT.#44) GO TO 15
      IF (ICX.GT.#47) GO TO 15
C 'w'
    8 J=J+1
      CX=CF(J)
      IF (CX.EQ.' ')  GO TO 8
      IF (ICX.LT.#30) GO TO 9
      IF (ICX.GT.#39) GO TO 9
      NW=10*NW+ICX-#30
      GO TO 8
C HAVE nn?w , WHERE ?=I,D,E,F,G
    9 DO 10 I=1,NR
        IX=IX+1
        NWID(IX)=NW
        NPOS(IX)=IP
        IP=IP+NW
        NB=NB+NW
   10 CONTINUE
C HAVE ALREADY USED NR
      NR=0
C PASS ANYTHING TILL COMMA OR RIGHT BRACKET
   11 IF (CX.EQ.')') GO TO 12
      IF (CX.EQ.',') GO TO 3
      J=J+1
      CX=CF(J)
      GO TO 11
C HAVE '/'
   12 WRITE(CN3,900) NB
  900 FORMAT(I3.3)
      DO 13 I=1,8
        J1=J1+1
        CF2(J1)=CN(I)
   13 CONTINUE
      NB=0
      NC=NC+1
C NOT CLOSING BRACKET?
      IF (CX.NE.')') GO TO 3
C CLOSE BRACKET
C ")"
      IF (NR.NE.0) GO TO 15
      NR=NRPC(NLEV)-1
      NRPC(NLEV)=NR
      IF (NR.GT.0) THEN
        J=NRPP(NLEV)
        GO TO 3
      ENDIF
      NLEV=NLEV-1
      IF (NLEV.GT.0) GO TO 3
C HAVE FINAL ",/," BUT NEED ')'
      J1=J1-1
      CF2(J1-1)=')'
      DO 14 J=J1,80
        CF2(J)=' '
   14 CONTINUE
      NCRD=NC
      RETURN
C FORMAT ERROR POSITION AND FLAG
   15 NCRD=-J
      RETURN
      END



Wed, 07 Sep 2011 06:28:21 GMT  
 
 [ 1 post ] 

 Relevant Pages 

1. help reading negative values in data file - test code and test data

2. Need routine to parse ASCII data

3. Read Access Data and convert it to ascii

4. How to read data from the ascii file?

5. Reading binary data -> ascii

6. Reading ASCII data file with DVF NAMELIST

7. Reading data from ASCII file like .INI

8. reading ASCII data from a COM Port

9. Challenge: reading ascii data

10. A PLI routine to read test stimulus

11. ada routine reading c data problem

12. Routine to read a generic table of data

 

 
Powered by phpBB® Forum Software