      SUBROUTINE MAIN
      COMMON /FBCOM/ ANDPAT, COUNT, EXCEPT, ELEVEL, CASIND, PAT(132, 10)
     *, ATEND, ATBEG, SEPS(132,2), NBRSEP, SKPING, PRTING, MCOUNT, SEPLO
     *C, BKLTH, LCOUNT, LOCATD(10)
      INTEGER ANDPAT
      INTEGER COUNT
      INTEGER EXCEPT
      INTEGER ELEVEL
      INTEGER CASIND
      INTEGER PAT
      INTEGER ATEND
      INTEGER ATBEG
      INTEGER SEPS
      INTEGER NBRSEP
      INTEGER SEPLOC
      INTEGER MCOUNT
      INTEGER SKPING
      LOGICAL*1 LOCATD
      INTEGER BKLTH
      INTEGER LCOUNT
      CALL QUERY(58Husage:  fb [-acix] [-ln] [-sexpr [-sexpr]] expr [exp
     *r] ...)
      CALL FBARGS
      CALL DOBK (1)
      IF (.NOT.(COUNT .EQ. 1))GOTO 23000
      CALL PUTINT(MCOUNT, 1,2)
      CALL PUTCH(10,2)
23000 CONTINUE
      RETURN
      END
      SUBROUTINE BMATCH (LINE)
      LOGICAL*1 LINE(100)
      INTEGER MATCH
      COMMON /FBCOM/ ANDPAT, COUNT, EXCEPT, ELEVEL, CASIND, PAT(132, 10)
     *, ATEND, ATBEG, SEPS(132,2), NBRSEP, SKPING, PRTING, MCOUNT, SEPLO
     *C, BKLTH, LCOUNT, LOCATD(10)
      INTEGER ANDPAT
      INTEGER COUNT
      INTEGER EXCEPT
      INTEGER ELEVEL
      INTEGER CASIND
      INTEGER PAT
      INTEGER ATEND
      INTEGER ATBEG
      INTEGER SEPS
      INTEGER NBRSEP
      INTEGER SEPLOC
      INTEGER MCOUNT
      INTEGER SKPING
      LOGICAL*1 LOCATD
      INTEGER BKLTH
      INTEGER LCOUNT
      COMMON / FBTEMP / TMPBUF(512)
      LOGICAL*1 TMPBUF
      CALL STRCPY(LINE, TMPBUF)
      IF (.NOT.(CASIND .EQ. 1))GOTO 23002
      CALL FOLD(TMPBUF)
23002 CONTINUE
      I=1
23004 IF (.NOT.(I.LE.ELEVEL))GOTO 23006
      IF (.NOT.(MATCH(TMPBUF, PAT(1,I)) .EQ. 1))GOTO 23007
      LOCATD(I) = 1
23007 CONTINUE
23005 I=I+1
      GOTO 23004
23006 CONTINUE
      RETURN
      END
      SUBROUTINE CHECKL (LINE)
      LOGICAL*1 LINE(100)
      INTEGER MATCH
      COMMON /FBCOM/ ANDPAT, COUNT, EXCEPT, ELEVEL, CASIND, PAT(132, 10)
     *, ATEND, ATBEG, SEPS(132,2), NBRSEP, SKPING, PRTING, MCOUNT, SEPLO
     *C, BKLTH, LCOUNT, LOCATD(10)
      INTEGER ANDPAT
      INTEGER COUNT
      INTEGER EXCEPT
      INTEGER ELEVEL
      INTEGER CASIND
      INTEGER PAT
      INTEGER ATEND
      INTEGER ATBEG
      INTEGER SEPS
      INTEGER NBRSEP
      INTEGER SEPLOC
      INTEGER MCOUNT
      INTEGER SKPING
      LOGICAL*1 LOCATD
      INTEGER BKLTH
      INTEGER LCOUNT
      COMMON / FBTEMP / TMPBUF(512)
      LOGICAL*1 TMPBUF
      CALL STRCPY(LINE, TMPBUF)
      IF (.NOT.(CASIND .EQ. 1))GOTO 23009
      CALL FOLD(TMPBUF)
23009 CONTINUE
      ATBEG = MATCH(TMPBUF, SEPS(1,1))
      IF (.NOT.(NBRSEP .EQ. 1))GOTO 23011
      ATEND = ATBEG
      GOTO 23012
23011 CONTINUE
      ATEND = MATCH(TMPBUF, SEPS(1,2))
23012 CONTINUE
      RETURN
      END
      SUBROUTINE DOBEG (LINE)
      LOGICAL*1 LINE(100)
      INTEGER STACKL
      COMMON /FBCOM/ ANDPAT, COUNT, EXCEPT, ELEVEL, CASIND, PAT(132, 10)
     *, ATEND, ATBEG, SEPS(132,2), NBRSEP, SKPING, PRTING, MCOUNT, SEPLO
     *C, BKLTH, LCOUNT, LOCATD(10)
      INTEGER ANDPAT
      INTEGER COUNT
      INTEGER EXCEPT
      INTEGER ELEVEL
      INTEGER CASIND
      INTEGER PAT
      INTEGER ATEND
      INTEGER ATBEG
      INTEGER SEPS
      INTEGER NBRSEP
      INTEGER SEPLOC
      INTEGER MCOUNT
      INTEGER SKPING
      LOGICAL*1 LOCATD
      INTEGER BKLTH
      INTEGER LCOUNT
      CALL INITBK
      LCOUNT = 0
      IF (.NOT.(NBRSEP .GT. 1 .OR. SEPLOC .EQ. 1))GOTO 23013
      CALL BMATCH(LINE)
      IF (.NOT.(STACKL(LINE) .EQ. -3))GOTO 23015
      CALL ERROR (21HBlock buffer overflow)
23015 CONTINUE
23013 CONTINUE
      SKPING = 0
      PRTING = 0
      RETURN
      END
      SUBROUTINE DOBK (FD)
      INTEGER GETLIN, REMOVE
      INTEGER FD, PRT, FIRST, JUNK
      LOGICAL*1 LINE(512)
      COMMON /FBCOM/ ANDPAT, COUNT, EXCEPT, ELEVEL, CASIND, PAT(132, 10)
     *, ATEND, ATBEG, SEPS(132,2), NBRSEP, SKPING, PRTING, MCOUNT, SEPLO
     *C, BKLTH, LCOUNT, LOCATD(10)
      INTEGER ANDPAT
      INTEGER COUNT
      INTEGER EXCEPT
      INTEGER ELEVEL
      INTEGER CASIND
      INTEGER PAT
      INTEGER ATEND
      INTEGER ATBEG
      INTEGER SEPS
      INTEGER NBRSEP
      INTEGER SEPLOC
      INTEGER MCOUNT
      INTEGER SKPING
      LOGICAL*1 LOCATD
      INTEGER BKLTH
      INTEGER LCOUNT
      COMMON /FBBUF/ FBBUF(5000), ENDSTK, FNAME(40), FB
      LOGICAL*1 FBBUF
      INTEGER ENDSTK
      LOGICAL*1 FNAME
      INTEGER FB
      CALL INITBK
      FIRST = 1
23017 IF (.NOT.(GETLIN(LINE, FD) .NE. -1))GOTO 23018
      CALL CHECKL (LINE)
      IF (.NOT.(FIRST .EQ. 1 .AND. ATEND .EQ. 1 .AND. NBRSEP .EQ. 1))GOT
     *O 23019
      SEPLOC = 1
23019 CONTINUE
      FIRST = 0
      IF (.NOT.(ATEND .EQ. 1))GOTO 23021
      CALL DOEND(LINE)
23021 CONTINUE
      IF (.NOT.(ATBEG .EQ. 1))GOTO 23023
      CALL DOBEG(LINE)
      GOTO 23017
23023 CONTINUE
      IF (.NOT.(SKPING .EQ. 1))GOTO 23025
      GOTO 23017
23025 CONTINUE
      CALL DOLIN (LINE)
23026 CONTINUE
      GOTO 23017
23018 CONTINUE
      IF (.NOT.(SKPING .EQ. 0))GOTO 23027
      CALL DOEND(LINE)
23027 CONTINUE
      IF (.NOT.(FB .NE. -3))GOTO 23029
      CALL CLOSE(FB)
      JUNK = REMOVE(FNAME)
      FB = -3
23029 CONTINUE
      RETURN
      END
      SUBROUTINE DOEND (LINE)
      LOGICAL*1 LINE(100)
      INTEGER STACKL
      INTEGER PRT
      COMMON /FBCOM/ ANDPAT, COUNT, EXCEPT, ELEVEL, CASIND, PAT(132, 10)
     *, ATEND, ATBEG, SEPS(132,2), NBRSEP, SKPING, PRTING, MCOUNT, SEPLO
     *C, BKLTH, LCOUNT, LOCATD(10)
      INTEGER ANDPAT
      INTEGER COUNT
      INTEGER EXCEPT
      INTEGER ELEVEL
      INTEGER CASIND
      INTEGER PAT
      INTEGER ATEND
      INTEGER ATBEG
      INTEGER SEPS
      INTEGER NBRSEP
      INTEGER SEPLOC
      INTEGER MCOUNT
      INTEGER SKPING
      LOGICAL*1 LOCATD
      INTEGER BKLTH
      INTEGER LCOUNT
      IF (.NOT.(PRTING .EQ. 1))GOTO 23031
      IF (.NOT.( (NBRSEP .GT. 1 .OR. SEPLOC .EQ. 0) .AND. COUNT .EQ. 0))
     *GOTO 23033
      CALL OUTLIN(LINE)
23033 CONTINUE
      IF (.NOT.(BKLTH .NE. 30000))GOTO 23035
      LCOUNT=LCOUNT+1
23037 IF (.NOT.(LCOUNT.LE.BKLTH))GOTO 23039
      CALL PUTCH(10, 2)
23038 LCOUNT=LCOUNT+1
      GOTO 23037
23039 CONTINUE
23035 CONTINUE
      GOTO 23032
23031 CONTINUE
      IF (.NOT.(SKPING .EQ. 0))GOTO 23040
      IF (.NOT.(NBRSEP .GT. 1 .OR. SEPLOC .EQ. 0))GOTO 23042
      CALL BMATCH (LINE)
      IF (.NOT.(STACKL(LINE) .EQ.-3))GOTO 23044
      CALL ERROR (21HBlock buffer overflow)
23044 CONTINUE
23042 CONTINUE
      CALL TALLY (PRT)
      IF (.NOT.(PRT .EQ. 1))GOTO 23046
      CALL PRINTB
      IF (.NOT.(BKLTH .NE. 30000))GOTO 23048
      LCOUNT=LCOUNT+1
23050 IF (.NOT.(LCOUNT.LE.BKLTH))GOTO 23052
      CALL PUTCH(10,2)
23051 LCOUNT=LCOUNT+1
      GOTO 23050
23052 CONTINUE
23048 CONTINUE
23046 CONTINUE
23040 CONTINUE
23032 CONTINUE
      SKPING = 1
      PRTING = 0
      RETURN
      END
      SUBROUTINE DOLIN (LINE)
      LOGICAL*1 LINE(100)
      INTEGER PRT
      INTEGER STACKL
      COMMON /FBCOM/ ANDPAT, COUNT, EXCEPT, ELEVEL, CASIND, PAT(132, 10)
     *, ATEND, ATBEG, SEPS(132,2), NBRSEP, SKPING, PRTING, MCOUNT, SEPLO
     *C, BKLTH, LCOUNT, LOCATD(10)
      INTEGER ANDPAT
      INTEGER COUNT
      INTEGER EXCEPT
      INTEGER ELEVEL
      INTEGER CASIND
      INTEGER PAT
      INTEGER ATEND
      INTEGER ATBEG
      INTEGER SEPS
      INTEGER NBRSEP
      INTEGER SEPLOC
      INTEGER MCOUNT
      INTEGER SKPING
      LOGICAL*1 LOCATD
      INTEGER BKLTH
      INTEGER LCOUNT
      IF (.NOT.(SKPING .EQ. 1))GOTO 23053
      RETURN
23053 CONTINUE
      IF (.NOT.(PRTING .EQ. 1))GOTO 23055
      IF (.NOT.(COUNT .EQ. 0))GOTO 23057
      CALL OUTLIN(LINE)
23057 CONTINUE
      GOTO 23056
23055 CONTINUE
      CALL BMATCH (LINE)
      IF (.NOT.(STACKL(LINE) .EQ. -3))GOTO 23059
      CALL ERROR (21HBlock buffer overflow)
23059 CONTINUE
      CALL TALLY(PRT)
      IF (.NOT.(PRT .EQ. 1 .AND. EXCEPT .EQ. 0))GOTO 23061
      CALL PRINTB
      PRTING = 1
      GOTO 23062
23061 CONTINUE
      IF (.NOT.(PRT .EQ. 0 .AND. EXCEPT .EQ. 1))GOTO 23063
      SKPING = 1
23063 CONTINUE
23062 CONTINUE
23056 CONTINUE
      RETURN
      END
      SUBROUTINE FBARGS
      LOGICAL*1 ARG(512)
      INTEGER GETARG, ITOC, GETPAT, STATUS, INDEXC, CTOI
      INTEGER I, J
      COMMON /FBBUF/ FBBUF(5000), ENDSTK, FNAME(40), FB
      LOGICAL*1 FBBUF
      INTEGER ENDSTK
      LOGICAL*1 FNAME
      INTEGER FB
      COMMON /FBCOM/ ANDPAT, COUNT, EXCEPT, ELEVEL, CASIND, PAT(132, 10)
     *, ATEND, ATBEG, SEPS(132,2), NBRSEP, SKPING, PRTING, MCOUNT, SEPLO
     *C, BKLTH, LCOUNT, LOCATD(10)
      INTEGER ANDPAT
      INTEGER COUNT
      INTEGER EXCEPT
      INTEGER ELEVEL
      INTEGER CASIND
      INTEGER PAT
      INTEGER ATEND
      INTEGER ATBEG
      INTEGER SEPS
      INTEGER NBRSEP
      INTEGER SEPLOC
      INTEGER MCOUNT
      INTEGER SKPING
      LOGICAL*1 LOCATD
      INTEGER BKLTH
      INTEGER LCOUNT
      LOGICAL*1 ILPAT(18)
      LOGICAL*1 MAXEXP(30)
      LOGICAL*1 DSEP(5)
      DATA ILPAT(1)/105/,ILPAT(2)/108/,ILPAT(3)/108/,ILPAT(4)/101/,ILPAT
     *(5)/103/,ILPAT(6)/97/,ILPAT(7)/108/,ILPAT(8)/32/,ILPAT(9)/112/,ILP
     *AT(10)/97/,ILPAT(11)/116/,ILPAT(12)/116/,ILPAT(13)/101/,ILPAT(14)/
     *114/,ILPAT(15)/110/,ILPAT(16)/58/,ILPAT(17)/32/,ILPAT(18)/0/
      DATA MAXEXP(1)/109/,MAXEXP(2)/97/,MAXEXP(3)/120/,MAXEXP(4)/32/,MAX
     *EXP(5)/110/,MAXEXP(6)/98/,MAXEXP(7)/114/,MAXEXP(8)/32/,MAXEXP(9)/1
     *01/,MAXEXP(10)/120/,MAXEXP(11)/112/,MAXEXP(12)/114/,MAXEXP(13)/101
     */,MAXEXP(14)/115/,MAXEXP(15)/115/,MAXEXP(16)/105/,MAXEXP(17)/111/,
     *MAXEXP(18)/110/,MAXEXP(19)/115/,MAXEXP(20)/32/,MAXEXP(21)/97/,MAXE
     *XP(22)/108/,MAXEXP(23)/108/,MAXEXP(24)/111/,MAXEXP(25)/119/,MAXEXP
     *(26)/101/,MAXEXP(27)/100/,MAXEXP(28)/58/,MAXEXP(29)/32/,MAXEXP(30)
     */0/
      DATA DSEP(1)/37/,DSEP(2)/32/,DSEP(3)/42/,DSEP(4)/36/,DSEP(5)/0/
      DATA EXCEPT/0/
      DATA ANDPAT/0/
      DATA COUNT /0/
      DATA MCOUNT /0/
      DATA ELEVEL/0/
      DATA CASIND/0/
      DATA SKPING /0/
      DATA NBRSEP /0/
      DATA SEPLOC /0/
      DATA ENDSTK /0/
      DATA FB /-3/
      DATA BKLTH /30000/
      DATA LCOUNT /0/
      I=1
23065 IF (.NOT.(GETARG(I, ARG, 128) .NE. -1))GOTO 23067
      IF (.NOT.(ARG(1) .EQ. 45 .AND. (ARG(2) .EQ. 115 .OR. ARG(2) .EQ. 8
     *3)))GOTO 23068
      NBRSEP = NBRSEP + 1
      IF (.NOT.(NBRSEP .GT. 2))GOTO 23070
      CALL ERROR (40Honly start and ending separators allowed)
23070 CONTINUE
      IF (.NOT.(CASIND .EQ. 1))GOTO 23072
      CALL FOLD(ARG)
23072 CONTINUE
      IF (.NOT.(GETPAT(ARG(3), SEPS(1, NBRSEP)) .EQ. -3))GOTO 23074
      CALL PUTLIN(ILPAT, 3)
      CALL ERROR (ARG(3))
23074 CONTINUE
      GOTO 23069
23068 CONTINUE
      IF (.NOT.(ARG(1) .EQ. 45))GOTO 23076
      CALL FOLD(ARG)
      IF (.NOT.(INDEXC(ARG, 97) .GT. 0))GOTO 23078
      ANDPAT = 1
23078 CONTINUE
      IF (.NOT.(INDEXC(ARG, 99) .GT. 0))GOTO 23080
      COUNT = 1
23080 CONTINUE
      IF (.NOT.(INDEXC(ARG, 105) .GT. 0))GOTO 23082
      CASIND = 1
23082 CONTINUE
      IF (.NOT.(INDEXC(ARG, 120) .GT. 0))GOTO 23084
      EXCEPT = 1
23084 CONTINUE
      J = INDEXC(ARG, 108)
      IF (.NOT.(J .GT. 0))GOTO 23086
      J = J + 1
      BKLTH = CTOI(ARG, J)
      IF (.NOT.(BKLTH .LE. 0))GOTO 23088
      CALL ERROR(58Husage:  fb [-acix] [-ln] [-sexpr [-sexpr]] expr [exp
     *r] ...)
23088 CONTINUE
23086 CONTINUE
      GOTO 23077
23076 CONTINUE
      IF (.NOT.(ELEVEL .LT. 10))GOTO 23090
      ELEVEL = ELEVEL + 1
      IF (.NOT.(CASIND .EQ. 1))GOTO 23092
      CALL FOLD(ARG)
23092 CONTINUE
      IF (.NOT.(GETPAT(ARG(1), PAT(1,ELEVEL)) .EQ. -3))GOTO 23094
      CALL PUTLIN(ILPAT, 3)
      CALL ERROR (ARG)
23094 CONTINUE
      GOTO 23091
23090 CONTINUE
      CALL PUTLIN(MAXEXP, 3)
      STATUS = ITOC(10, ARG, 128)
      CALL ERROR(ARG)
23091 CONTINUE
23077 CONTINUE
23069 CONTINUE
23066 I=I+1
      GOTO 23065
23067 CONTINUE
      IF (.NOT.(ELEVEL .EQ. 0))GOTO 23096
      CALL ERROR(58Husage:  fb [-acix] [-ln] [-sexpr [-sexpr]] expr [exp
     *r] ...)
23096 CONTINUE
      IF (.NOT.(NBRSEP .EQ. 0))GOTO 23098
      IF (.NOT.(GETPAT(DSEP, SEPS(1,1)) .EQ. -3))GOTO 23100
      CALL ERROR (25Hillegal default separator)
23100 CONTINUE
      NBRSEP = 1
23098 CONTINUE
      IF (.NOT.(NBRSEP .GT. 1))GOTO 23102
      SKPING = 1
23102 CONTINUE
      RETURN
      END
      SUBROUTINE INITBK
      INTEGER JUNK
      INTEGER REMOVE
      COMMON /FBCOM/ ANDPAT, COUNT, EXCEPT, ELEVEL, CASIND, PAT(132, 10)
     *, ATEND, ATBEG, SEPS(132,2), NBRSEP, SKPING, PRTING, MCOUNT, SEPLO
     *C, BKLTH, LCOUNT, LOCATD(10)
      INTEGER ANDPAT
      INTEGER COUNT
      INTEGER EXCEPT
      INTEGER ELEVEL
      INTEGER CASIND
      INTEGER PAT
      INTEGER ATEND
      INTEGER ATBEG
      INTEGER SEPS
      INTEGER NBRSEP
      INTEGER SEPLOC
      INTEGER MCOUNT
      INTEGER SKPING
      LOGICAL*1 LOCATD
      INTEGER BKLTH
      INTEGER LCOUNT
      COMMON /FBBUF/ FBBUF(5000), ENDSTK, FNAME(40), FB
      LOGICAL*1 FBBUF
      INTEGER ENDSTK
      LOGICAL*1 FNAME
      INTEGER FB
      I=1
23104 IF (.NOT.(I.LE.ELEVEL))GOTO 23106
      LOCATD(I) = 0
23105 I=I+1
      GOTO 23104
23106 CONTINUE
      ENDSTK = 0
      IF (.NOT.(FB .NE. -3))GOTO 23107
      CALL CLOSE(FB)
      JUNK = REMOVE(FNAME)
      FB = -3
23107 CONTINUE
      RETURN
      END
      SUBROUTINE OUTLIN(LINE)
      LOGICAL*1 LINE(100)
      COMMON /FBCOM/ ANDPAT, COUNT, EXCEPT, ELEVEL, CASIND, PAT(132, 10)
     *, ATEND, ATBEG, SEPS(132,2), NBRSEP, SKPING, PRTING, MCOUNT, SEPLO
     *C, BKLTH, LCOUNT, LOCATD(10)
      INTEGER ANDPAT
      INTEGER COUNT
      INTEGER EXCEPT
      INTEGER ELEVEL
      INTEGER CASIND
      INTEGER PAT
      INTEGER ATEND
      INTEGER ATBEG
      INTEGER SEPS
      INTEGER NBRSEP
      INTEGER SEPLOC
      INTEGER MCOUNT
      INTEGER SKPING
      LOGICAL*1 LOCATD
      INTEGER BKLTH
      INTEGER LCOUNT
      LCOUNT = LCOUNT + 1
      IF (.NOT.(LCOUNT .LE. BKLTH))GOTO 23109
      CALL PUTLIN(LINE, 2)
23109 CONTINUE
      RETURN
      END
      SUBROUTINE PRINTB
      INTEGER I, JUNK
      LOGICAL*1 C
      LOGICAL*1 GETCH
      INTEGER OPEN, REMOVE
      COMMON /FBBUF/ FBBUF(5000), ENDSTK, FNAME(40), FB
      LOGICAL*1 FBBUF
      INTEGER ENDSTK
      LOGICAL*1 FNAME
      INTEGER FB
      COMMON /FBCOM/ ANDPAT, COUNT, EXCEPT, ELEVEL, CASIND, PAT(132, 10)
     *, ATEND, ATBEG, SEPS(132,2), NBRSEP, SKPING, PRTING, MCOUNT, SEPLO
     *C, BKLTH, LCOUNT, LOCATD(10)
      INTEGER ANDPAT
      INTEGER COUNT
      INTEGER EXCEPT
      INTEGER ELEVEL
      INTEGER CASIND
      INTEGER PAT
      INTEGER ATEND
      INTEGER ATBEG
      INTEGER SEPS
      INTEGER NBRSEP
      INTEGER SEPLOC
      INTEGER MCOUNT
      INTEGER SKPING
      LOGICAL*1 LOCATD
      INTEGER BKLTH
      INTEGER LCOUNT
      IF (.NOT.(ENDSTK .EQ. 0 .AND. FB .EQ. -3))GOTO 23111
      RETURN
23111 CONTINUE
      IF (.NOT.(COUNT .EQ. 1))GOTO 23113
      MCOUNT = MCOUNT + 1
      RETURN
23113 CONTINUE
      IF (.NOT.(FB .NE. -3))GOTO 23115
      CALL CLOSE(FB)
      FB = OPEN(FNAME, 1)
      IF (.NOT.(FB .EQ. -3))GOTO 23117
      CALL ERROR (31Hproblems reopening scratch file)
23117 CONTINUE
23119 IF (.NOT.(GETCH(C, FB) .NE. -1))GOTO 23120
      CALL PUTCH(C, 2)
      GOTO 23119
23120 CONTINUE
      CALL CLOSE(FB)
      JUNK = REMOVE (FNAME)
      FB = -3
23115 CONTINUE
      I=1
23121 IF (.NOT.(I.LE.ENDSTK))GOTO 23123
      CALL PUTCH(FBBUF(I), 2)
23122 I=I+1
      GOTO 23121
23123 CONTINUE
      RETURN
      END
      INTEGER FUNCTION STACKL (LINE)
      LOGICAL*1 LINE(512)
      INTEGER LENGTH, CREATE
      INTEGER LEN
      COMMON /FBBUF/ FBBUF(5000), ENDSTK, FNAME(40), FB
      LOGICAL*1 FBBUF
      INTEGER ENDSTK
      LOGICAL*1 FNAME
      INTEGER FB
      COMMON /FBCOM/ ANDPAT, COUNT, EXCEPT, ELEVEL, CASIND, PAT(132, 10)
     *, ATEND, ATBEG, SEPS(132,2), NBRSEP, SKPING, PRTING, MCOUNT, SEPLO
     *C, BKLTH, LCOUNT, LOCATD(10)
      INTEGER ANDPAT
      INTEGER COUNT
      INTEGER EXCEPT
      INTEGER ELEVEL
      INTEGER CASIND
      INTEGER PAT
      INTEGER ATEND
      INTEGER ATBEG
      INTEGER SEPS
      INTEGER NBRSEP
      INTEGER SEPLOC
      INTEGER MCOUNT
      INTEGER SKPING
      LOGICAL*1 LOCATD
      INTEGER BKLTH
      INTEGER LCOUNT
      LOGICAL*1 FBTEMP(4)
      DATA FBTEMP(1)/102/,FBTEMP(2)/98/,FBTEMP(3)/116/,FBTEMP(4)/0/
      STACKL = 0
      IF (.NOT.(COUNT .EQ. 1))GOTO 23124
      RETURN
23124 CONTINUE
      LCOUNT = LCOUNT + 1
      IF (.NOT.(LCOUNT .GT. BKLTH))GOTO 23126
      RETURN
23126 CONTINUE
      LEN = LENGTH(LINE)
      IF (.NOT.( (LEN+ENDSTK+1) .GT. 5000))GOTO 23128
      IF (.NOT.(FB .EQ. -3))GOTO 23130
      CALL SCRATF(FBTEMP, FNAME)
      FB = CREATE(FNAME, 2)
      IF (.NOT.(FB .EQ. -3))GOTO 23132
      CALL REMARK (29Hproblems opening scratch file)
      CALL CANT (FNAME)
23132 CONTINUE
23130 CONTINUE
      I=1
23134 IF (.NOT.(I.LE.ENDSTK))GOTO 23136
      CALL PUTCH(FBBUF(I), FB)
23135 I=I+1
      GOTO 23134
23136 CONTINUE
      CALL PUTLIN(LINE, FB)
      ENDSTK = 0
      RETURN
23128 CONTINUE
      CALL SCOPY(LINE, 1, FBBUF, ENDSTK+1)
      ENDSTK = ENDSTK + LEN
      RETURN
      END
      SUBROUTINE TALLY (PRT)
      INTEGER PRT
      COMMON /FBCOM/ ANDPAT, COUNT, EXCEPT, ELEVEL, CASIND, PAT(132, 10)
     *, ATEND, ATBEG, SEPS(132,2), NBRSEP, SKPING, PRTING, MCOUNT, SEPLO
     *C, BKLTH, LCOUNT, LOCATD(10)
      INTEGER ANDPAT
      INTEGER COUNT
      INTEGER EXCEPT
      INTEGER ELEVEL
      INTEGER CASIND
      INTEGER PAT
      INTEGER ATEND
      INTEGER ATBEG
      INTEGER SEPS
      INTEGER NBRSEP
      INTEGER SEPLOC
      INTEGER MCOUNT
      INTEGER SKPING
      LOGICAL*1 LOCATD
      INTEGER BKLTH
      INTEGER LCOUNT
      PRT = ANDPAT
      I=1
23137 IF (.NOT.(I.LE.ELEVEL))GOTO 23139
      IF (.NOT.(ANDPAT .EQ. 0 .AND. LOCATD(I) .EQ. 1))GOTO 23140
      PRT = 1
      GOTO 23139
23140 CONTINUE
      IF (.NOT.(ANDPAT .EQ. 1 .AND. LOCATD(I) .EQ. 0))GOTO 23142
      PRT = 0
      GOTO 23139
23142 CONTINUE
23141 CONTINUE
23138 I=I+1
      GOTO 23137
23139 CONTINUE
      IF (.NOT.(EXCEPT .EQ. 1))GOTO 23144
      IF (.NOT.(PRT .EQ. 0))GOTO 23146
      PRT = 1
      GOTO 23147
23146 CONTINUE
      PRT = 0
23147 CONTINUE
23144 CONTINUE
      RETURN
      END
