SUBROUTINE MAIN
      INTEGER ANSTRY, FDHIS, FDREV, FDSCR, FLAG, INSERT, MYANCS, MAXVER,
     * SEEKPT
      INTEGER GETARG, GETLIN
      LOGICAL*1 HISTRY(36)
      LOGICAL*1 RVISN(36)
      LOGICAL*1 NWHSTY(36)
      LOGICAL*1 REASON(402)
      LOGICAL*1 WANTED(40)
      INTEGER PROMPT
      INTEGER I
      LOGICAL*1 ST001Z(44)
      LOGICAL*1 ST002Z(46)
      COMMON /TCS/ ANSTRY(100), FDHIS, FDREV, FDSCR, FLAG, INSERT, MYANC
     *S, MAXVER, SEEKPT(2)
      DATA ST001Z(1)/117/,ST001Z(2)/115/,ST001Z(3)/97/,ST001Z(4)/103/,ST
     *001Z(5)/101/,ST001Z(6)/58/,ST001Z(7)/32/,ST001Z(8)/32/,ST001Z(9)/1
     *00/,ST001Z(10)/101/,ST001Z(11)/108/,ST001Z(12)/116/,ST001Z(13)/97/
     *,ST001Z(14)/32/,ST001Z(15)/114/,ST001Z(16)/101/,ST001Z(17)/118/,ST
     *001Z(18)/105/,ST001Z(19)/115/,ST001Z(20)/105/,ST001Z(21)/111/,ST00
     *1Z(22)/110/,ST001Z(23)/32/,ST001Z(24)/104/,ST001Z(25)/105/,ST001Z(
     *26)/115/,ST001Z(27)/116/,ST001Z(28)/111/,ST001Z(29)/114/,ST001Z(30
     *)/121/,ST001Z(31)/32/,ST001Z(32)/91/,ST001Z(33)/110/,ST001Z(34)/10
     *1/,ST001Z(35)/119/,ST001Z(36)/104/,ST001Z(37)/105/,ST001Z(38)/115/
     *,ST001Z(39)/116/,ST001Z(40)/111/,ST001Z(41)/114/,ST001Z(42)/121/,S
     *T001Z(43)/93/,ST001Z(44)/0/
      DATA ST002Z(1)/63/,ST002Z(2)/32/,ST002Z(3)/117/,ST002Z(4)/115/,ST0
     *02Z(5)/97/,ST002Z(6)/103/,ST002Z(7)/101/,ST002Z(8)/58/,ST002Z(9)/3
     *2/,ST002Z(10)/32/,ST002Z(11)/100/,ST002Z(12)/101/,ST002Z(13)/108/,
     *ST002Z(14)/116/,ST002Z(15)/97/,ST002Z(16)/32/,ST002Z(17)/114/,ST00
     *2Z(18)/101/,ST002Z(19)/118/,ST002Z(20)/105/,ST002Z(21)/115/,ST002Z
     *(22)/105/,ST002Z(23)/111/,ST002Z(24)/110/,ST002Z(25)/32/,ST002Z(26
     *)/104/,ST002Z(27)/105/,ST002Z(28)/115/,ST002Z(29)/116/,ST002Z(30)/
     *111/,ST002Z(31)/114/,ST002Z(32)/121/,ST002Z(33)/32/,ST002Z(34)/91/
     *,ST002Z(35)/110/,ST002Z(36)/101/,ST002Z(37)/119/,ST002Z(38)/104/,S
     *T002Z(39)/105/,ST002Z(40)/115/,ST002Z(41)/116/,ST002Z(42)/111/,ST0
     *02Z(43)/114/,ST002Z(44)/121/,ST002Z(45)/93/,ST002Z(46)/0/
      CALL QUERY(ST001Z)
      IF (.NOT.(GETARG(1, RVISN, 36) .EQ. -1 .OR. GETARG(2, HISTRY, 36) 
     *.EQ. -1))GOTO 23000
      CALL ERROR(ST002Z)
23000 CONTINUE
      IF (.NOT.(GETARG(3, NWHSTY, 36) .EQ. -1))GOTO 23002
      CALL SCOPY(HISTRY, 1, NWHSTY, 1)
23002 CONTINUE
      WANTED(1) = 0
      CALL MAKDEL(HISTRY, RVISN, NWHSTY, WANTED)
      END
      SUBROUTINE MAKDEL(HISFIL, REVFIL, NEWFIL, WANTED)
      INTEGER ANSTRY, FDHIS, FDREV, FDSCR, FLAG, INSERT, MYANCS, MAXVER,
     * SEEKPT
      INTEGER GETTAB
      INTEGER ISTAB1, ISTAB2
      LOGICAL*1 HISFIL(36)
      LOGICAL*1 REVFIL(36)
      LOGICAL*1 NEWFIL(36)
      LOGICAL*1 SCRFIL(36)
      LOGICAL*1 WANTED(40)
      LOGICAL*1 HISBUF(402)
      LOGICAL*1 REVBUF(402)
      INTEGER BMATCH, CREATE, REMOVE, INDEXC
      INTEGER EQUAL, GETLIN, IABS, HASH, LINGET, OPEN, PROMPT
      INTEGER C, CAND, COUNT, JUNK
      LOGICAL*1 DATE( 10), TIME( 9)
      INTEGER FROM, TO
      INTEGER HIGH, NOW( 7)
      INTEGER IREC1, IREC2
      INTEGER I, J, K
      INTEGER KMID, KS, KS1
      INTEGER LEN1, LEN2, LOW, MIDPT
      INTEGER KEY
      INTEGER NIL
      INTEGER P, R, S
      INTEGER MMM, NNN
      LOGICAL*1 SCT(4)
      LOGICAL*1 ST003Z(30)
      LOGICAL*1 ST004Z(9)
      LOGICAL*1 ST005Z(3)
      LOGICAL*1 ST006Z(5)
      LOGICAL*1 ST007Z(18)
      LOGICAL*1 ST008Z(23)
      LOGICAL*1 ST009Z(22)
      LOGICAL*1 ST00AZ(28)
      LOGICAL*1 ST00BZ(5)
      LOGICAL*1 ST00CZ(5)
      LOGICAL*1 ST00DZ(5)
      LOGICAL*1 ST00EZ(5)
      LOGICAL*1 ST00FZ(5)
      LOGICAL*1 ST00GZ(5)
      LOGICAL*1 ST00HZ(5)
      LOGICAL*1 ST00IZ(5)
      LOGICAL*1 ST00JZ(5)
      LOGICAL*1 ST00KZ(5)
      LOGICAL*1 ST00LZ(12)
      LOGICAL*1 ST00MZ(11)
      LOGICAL*1 ST00NZ(11)
      LOGICAL*1 ST00OZ(18)
      LOGICAL*1 ST00PZ(5)
      LOGICAL*1 ST00QZ(5)
      LOGICAL*1 ST00RZ(3)
      COMMON /TCS/ ANSTRY(100), FDHIS, FDREV, FDSCR, FLAG, INSERT, MYANC
     *S, MAXVER, SEEKPT(2)
      DATA SCT(1)/83/,SCT(2)/67/,SCT(3)/84/,SCT(4)/0/
      DATA ST003Z(1)/63/,ST003Z(2)/32/,ST003Z(3)/67/,ST003Z(4)/97/,ST003
     *Z(5)/110/,ST003Z(6)/39/,ST003Z(7)/116/,ST003Z(8)/32/,ST003Z(9)/102
     */,ST003Z(10)/105/,ST003Z(11)/110/,ST003Z(12)/100/,ST003Z(13)/32/,S
     *T003Z(14)/84/,ST003Z(15)/67/,ST003Z(16)/83/,ST003Z(17)/32/,ST003Z(
     *18)/104/,ST003Z(19)/105/,ST003Z(20)/115/,ST003Z(21)/116/,ST003Z(22
     *)/111/,ST003Z(23)/114/,ST003Z(24)/121/,ST003Z(25)/32/,ST003Z(26)/1
     *02/,ST003Z(27)/105/,ST003Z(28)/108/,ST003Z(29)/101/,ST003Z(30)/0/
      DATA ST004Z(1)/72/,ST004Z(2)/105/,ST004Z(3)/115/,ST004Z(4)/116/,ST
     *004Z(5)/111/,ST004Z(6)/114/,ST004Z(7)/121/,ST004Z(8)/63/,ST004Z(9)
     */0/
      DATA ST005Z(1)/62/,ST005Z(2)/32/,ST005Z(3)/0/
      DATA ST006Z(1)/37/,ST006Z(2)/37/,ST006Z(3)/99/,ST006Z(4)/32/,ST006
     *Z(5)/0/
      DATA ST007Z(1)/78/,ST007Z(2)/101/,ST007Z(3)/119/,ST007Z(4)/32/,ST0
     *07Z(5)/86/,ST007Z(6)/101/,ST007Z(7)/114/,ST007Z(8)/115/,ST007Z(9)/
     *105/,ST007Z(10)/111/,ST007Z(11)/110/,ST007Z(12)/32/,ST007Z(13)/105
     */,ST007Z(14)/115/,ST007Z(15)/32/,ST007Z(16)/35/,ST007Z(17)/32/,ST0
     *07Z(18)/0/
      DATA ST008Z(1)/82/,ST008Z(2)/101/,ST008Z(3)/118/,ST008Z(4)/105/,ST
     *008Z(5)/115/,ST008Z(6)/105/,ST008Z(7)/111/,ST008Z(8)/110/,ST008Z(9
     *)/32/,ST008Z(10)/102/,ST008Z(11)/105/,ST008Z(12)/108/,ST008Z(13)/1
     *01/,ST008Z(14)/32/,ST008Z(15)/105/,ST008Z(16)/115/,ST008Z(17)/32/,
     *ST008Z(18)/101/,ST008Z(19)/109/,ST008Z(20)/112/,ST008Z(21)/116/,ST
     *008Z(22)/121/,ST008Z(23)/0/
      DATA ST009Z(1)/72/,ST009Z(2)/105/,ST009Z(3)/115/,ST009Z(4)/116/,ST
     *009Z(5)/111/,ST009Z(6)/114/,ST009Z(7)/121/,ST009Z(8)/32/,ST009Z(9)
     */102/,ST009Z(10)/105/,ST009Z(11)/108/,ST009Z(12)/101/,ST009Z(13)/3
     *2/,ST009Z(14)/105/,ST009Z(15)/115/,ST009Z(16)/32/,ST009Z(17)/101/,
     *ST009Z(18)/109/,ST009Z(19)/112/,ST009Z(20)/116/,ST009Z(21)/121/,ST
     *009Z(22)/0/
      DATA ST00AZ(1)/70/,ST00AZ(2)/105/,ST00AZ(3)/108/,ST00AZ(4)/101/,ST
     *00AZ(5)/115/,ST00AZ(6)/32/,ST00AZ(7)/97/,ST00AZ(8)/114/,ST00AZ(9)/
     *101/,ST00AZ(10)/32/,ST00AZ(11)/116/,ST00AZ(12)/111/,ST00AZ(13)/111
     */,ST00AZ(14)/32/,ST00AZ(15)/98/,ST00AZ(16)/105/,ST00AZ(17)/103/,ST
     *00AZ(18)/32/,ST00AZ(19)/116/,ST00AZ(20)/111/,ST00AZ(21)/32/,ST00AZ
     *(22)/104/,ST00AZ(23)/97/,ST00AZ(24)/110/,ST00AZ(25)/100/,ST00AZ(26
     *)/108/,ST00AZ(27)/101/,ST00AZ(28)/0/
      DATA ST00BZ(1)/37/,ST00BZ(2)/37/,ST00BZ(3)/69/,ST00BZ(4)/32/,ST00B
     *Z(5)/0/
      DATA ST00CZ(1)/37/,ST00CZ(2)/37/,ST00CZ(3)/68/,ST00CZ(4)/32/,ST00C
     *Z(5)/0/
      DATA ST00DZ(1)/37/,ST00DZ(2)/37/,ST00DZ(3)/69/,ST00DZ(4)/32/,ST00D
     *Z(5)/0/
      DATA ST00EZ(1)/37/,ST00EZ(2)/37/,ST00EZ(3)/73/,ST00EZ(4)/32/,ST00E
     *Z(5)/0/
      DATA ST00FZ(1)/37/,ST00FZ(2)/37/,ST00FZ(3)/69/,ST00FZ(4)/32/,ST00F
     *Z(5)/0/
      DATA ST00GZ(1)/37/,ST00GZ(2)/37/,ST00GZ(3)/69/,ST00GZ(4)/32/,ST00G
     *Z(5)/0/
      DATA ST00HZ(1)/37/,ST00HZ(2)/37/,ST00HZ(3)/68/,ST00HZ(4)/32/,ST00H
     *Z(5)/0/
      DATA ST00IZ(1)/37/,ST00IZ(2)/37/,ST00IZ(3)/69/,ST00IZ(4)/32/,ST00I
     *Z(5)/0/
      DATA ST00JZ(1)/37/,ST00JZ(2)/37/,ST00JZ(3)/73/,ST00JZ(4)/32/,ST00J
     *Z(5)/0/
      DATA ST00KZ(1)/37/,ST00KZ(2)/37/,ST00KZ(3)/69/,ST00KZ(4)/32/,ST00K
     *Z(5)/0/
      DATA ST00LZ(1)/32/,ST00LZ(2)/105/,ST00LZ(3)/110/,ST00LZ(4)/115/,ST
     *00LZ(5)/101/,ST00LZ(6)/114/,ST00LZ(7)/116/,ST00LZ(8)/105/,ST00LZ(9
     *)/111/,ST00LZ(10)/110/,ST00LZ(11)/115/,ST00LZ(12)/0/
      DATA ST00MZ(1)/32/,ST00MZ(2)/100/,ST00MZ(3)/101/,ST00MZ(4)/108/,ST
     *00MZ(5)/101/,ST00MZ(6)/116/,ST00MZ(7)/105/,ST00MZ(8)/111/,ST00MZ(9
     *)/110/,ST00MZ(10)/115/,ST00MZ(11)/0/
      DATA ST00NZ(1)/32/,ST00NZ(2)/117/,ST00NZ(3)/110/,ST00NZ(4)/99/,ST0
     *0NZ(5)/104/,ST00NZ(6)/97/,ST00NZ(7)/110/,ST00NZ(8)/103/,ST00NZ(9)/
     *101/,ST00NZ(10)/100/,ST00NZ(11)/0/
      DATA ST00OZ(1)/84/,ST00OZ(2)/101/,ST00OZ(3)/109/,ST00OZ(4)/112/,ST
     *00OZ(5)/32/,ST00OZ(6)/102/,ST00OZ(7)/105/,ST00OZ(8)/108/,ST00OZ(9)
     */101/,ST00OZ(10)/32/,ST00OZ(11)/101/,ST00OZ(12)/114/,ST00OZ(13)/11
     *4/,ST00OZ(14)/111/,ST00OZ(15)/114/,ST00OZ(16)/58/,ST00OZ(17)/32/,S
     *T00OZ(18)/0/
      DATA ST00PZ(1)/37/,ST00PZ(2)/37/,ST00PZ(3)/115/,ST00PZ(4)/32/,ST00
     *PZ(5)/0/
      DATA ST00QZ(1)/37/,ST00QZ(2)/37/,ST00QZ(3)/100/,ST00QZ(4)/32/,ST00
     *QZ(5)/0/
      DATA ST00RZ(1)/68/,ST00RZ(2)/32/,ST00RZ(3)/0/
      FDREV = OPEN(REVFIL, 1)
      IF (.NOT.(FDREV .EQ. -3))GOTO 23004
      CALL CANT(REVFIL)
23004 CONTINUE
      FDSCR = OPEN( HISFIL, 1)
      IF (.NOT.( FDSCR .EQ. -3 ))GOTO 23006
      CALL ERROR(ST003Z)
23006 CONTINUE
      CALL CLOSE(FDSCR)
      CALL SCRATF(SCT, SCRFIL)
      FDSCR = CREATE(SCRFIL, 2)
      IF (.NOT.(FDSCR .EQ. -3))GOTO 23008
      CALL CANT(SCRFIL)
23008 CONTINUE
      CALL PUTLIN(ST004Z, 3)
      CALL PUTCH(10, 3)
23010 CONTINUE
      I = PROMPT(ST005Z, HISBUF, 1)
      IF (.NOT.(I .EQ. -1))GOTO 23013
      GOTO 23012
23013 CONTINUE
      IF (.NOT.((I .EQ. 2) .AND. (HISBUF(1) .EQ. 46)))GOTO 23015
      GOTO 23012
23015 CONTINUE
      CALL PUTLIN(ST006Z, FDSCR)
      CALL PUTLIN(HISBUF, FDSCR)
23011 GOTO 23010
23012 CONTINUE
      CALL SETGET(HISFIL, WANTED)
      CALL INCVNO(WANTED)
      CALL PUTLIN(ST007Z, 3)
      CALL PUTLIN(WANTED, 3)
      CALL PUTCH(10, 3)
      MAXVER = MAXVER + 1
      CALL VIRINT
      J = 1
23017 IF (.NOT.(J.LT.  32513-J))GOTO 23019
      IF (.NOT.(GETLIN(REVBUF, FDREV) .EQ. -1))GOTO 23020
      GOTO 23019
23020 CONTINUE
      ISTAB1=J
      ISTAB2= J
      CALL SETTAB(ISTAB1, ISTAB2)
      KEY = HASH(REVBUF)
      ISTAB1= 32513-J
      ISTAB2= KEY
      CALL SETTAB(ISTAB1, ISTAB2)
23018 J = J+1
      GOTO 23017
23019 CONTINUE
      CALL CLOSE(FDREV)
      NNN = J - 1
      IF (.NOT.(NNN .EQ. 0))GOTO 23022
      CALL ERROR(ST008Z)
23022 CONTINUE
      CALL DOSORT(NNN)
      J = 1
23024 IF (.NOT.(J .LT. NNN))GOTO 23026
      IF (.NOT.(GETTAB( 32513-J) .NE. GETTAB( 32513-J-1)))GOTO 23027
      ISTAB1=J
      ISTAB2= -GETTAB(J)
      CALL SETTAB(ISTAB1, ISTAB2)
23027 CONTINUE
23025 J = J + 1
      GOTO 23024
23026 CONTINUE
      ISTAB1=NNN
      ISTAB2= -GETTAB(NNN)
      CALL SETTAB(ISTAB1, ISTAB2)
      I = NNN+3
23029 IF (.NOT.(I .LT.  32513-NNN))GOTO 23031
      IF (.NOT.(LINGET(HISBUF, 0) .EQ. -1))GOTO 23032
      GOTO 23031
23032 CONTINUE
      KEY = HASH(HISBUF)
      J = 0
      LOW = 0
      HIGH = NNN+1
23034 IF (.NOT.(LOW+1 .LT. HIGH))GOTO 23035
      MIDPT = (LOW+HIGH) / 2
      KMID =  32513-MIDPT
      IF (.NOT.(GETTAB(KMID) .LT. KEY))GOTO 23036
      LOW = MIDPT
      GOTO 23037
23036 CONTINUE
      HIGH = MIDPT
      IF (.NOT.(GETTAB(KMID) .EQ. KEY))GOTO 23038
      J = MIDPT
23038 CONTINUE
23037 CONTINUE
      GOTO 23034
23035 CONTINUE
      ISTAB1=I
      ISTAB2= J
      CALL SETTAB(ISTAB1, ISTAB2)
23030 I = I + 1
      GOTO 23029
23031 CONTINUE
      TOTSIZ = I-1
      MMM = TOTSIZ - NNN - 2
      IF (.NOT.(MMM .EQ. 0))GOTO 23040
      CALL ERROR(ST009Z)
23040 CONTINUE
      CAND = TOTSIZ+1
      NIL = TOTSIZ+1
      K = NNN+1
      ISTAB1=CAND+ 1
      ISTAB2= NNN+2
      CALL SETTAB(ISTAB1, ISTAB2)
      ISTAB1=CAND+ 2
      ISTAB2= 0
      CALL SETTAB(ISTAB1, ISTAB2)
      ISTAB1=CAND+ 0
      ISTAB2= NIL
      CALL SETTAB(ISTAB1, ISTAB2)
      ISTAB1=K
      ISTAB2= CAND
      CALL SETTAB(ISTAB1, ISTAB2)
      CAND = CAND+ 3
      ISTAB1=CAND+ 1
      ISTAB2= TOTSIZ+1
      CALL SETTAB(ISTAB1, ISTAB2)
      ISTAB1=CAND+ 2
      ISTAB2= NNN+1
      CALL SETTAB(ISTAB1, ISTAB2)
      ISTAB1=CAND+ 0
      ISTAB2= NIL
      CALL SETTAB(ISTAB1, ISTAB2)
      ISTAB1=K+1
      ISTAB2= CAND
      CALL SETTAB(ISTAB1, ISTAB2)
      CAND = CAND+ 3
      I = NNN+3
23042 IF (.NOT.(I .LE. TOTSIZ))GOTO 23044
      P = GETTAB(I)
      IF (.NOT.(P .NE. 0))GOTO 23045
      R = NNN+1
      C = GETTAB(R)
23047 CONTINUE
      J = IABS(GETTAB(P))
      LOW = R
      HIGH = K
23050 IF (.NOT.(LOW .LE. HIGH))GOTO 23051
      S = (LOW+HIGH) / 2
      KS = GETTAB(S)
      IF (.NOT.(GETTAB(KS+ 2) .GE. J))GOTO 23052
      HIGH = S - 1
      GOTO 23053
23052 CONTINUE
      KS1 = GETTAB(S+1)
      IF (.NOT.(GETTAB(KS1+ 2) .GE. J))GOTO 23054
      GOTO 23051
23054 CONTINUE
      LOW = S+1
23053 CONTINUE
      GOTO 23050
23051 CONTINUE
      IF (.NOT.(LOW .LE. HIGH))GOTO 23056
      IF (.NOT.(GETTAB(KS1+ 2) .GT. J))GOTO 23058
      ISTAB1=R
      ISTAB2= C
      CALL SETTAB(ISTAB1, ISTAB2)
      R = S + 1
      IF (.NOT.(CAND .GT.  32513-3 ))GOTO 23060
      CALL ERROR(ST00AZ)
23060 CONTINUE
      ISTAB1=CAND+ 1
      ISTAB2= I
      CALL SETTAB(ISTAB1, ISTAB2)
      ISTAB1=CAND+ 2
      ISTAB2= J
      CALL SETTAB(ISTAB1, ISTAB2)
      ISTAB1=CAND+ 0
      ISTAB2= KS
      CALL SETTAB(ISTAB1, ISTAB2)
      C = CAND
      CAND = CAND+ 3
23058 CONTINUE
      IF (.NOT.(S .EQ. K))GOTO 23062
      ISTAB1=K+2
      ISTAB2= GETTAB(K+1)
      CALL SETTAB(ISTAB1, ISTAB2)
      K = K + 1
      GOTO 23049
23062 CONTINUE
23056 CONTINUE
      IF (.NOT.(GETTAB(P) .LT. 0))GOTO 23064
      GOTO 23049
23064 CONTINUE
      P = P + 1
23065 CONTINUE
23048 GOTO 23047
23049 CONTINUE
      ISTAB1=R
      ISTAB2= C
      CALL SETTAB(ISTAB1, ISTAB2)
23045 CONTINUE
23043 I = I + 1
      GOTO 23042
23044 CONTINUE
      C = GETTAB(K)
      I = NNN+3
23066 IF (.NOT.(I .LE. TOTSIZ))GOTO 23068
      ISTAB1=I
      ISTAB2= 0
      CALL SETTAB(ISTAB1, ISTAB2)
23067 I = I + 1
      GOTO 23066
23068 CONTINUE
      ISTAB1=TOTSIZ+1
      ISTAB2= NNN+1
      CALL SETTAB(ISTAB1, ISTAB2)
23069 IF (.NOT.(C .NE. NIL))GOTO 23070
      I = GETTAB(C+ 1)
      J = GETTAB(C+ 2)
      ISTAB1=I
      ISTAB2= J
      CALL SETTAB(ISTAB1, ISTAB2)
      C = GETTAB(C+ 0)
      GOTO 23069
23070 CONTINUE
      CALL RSTGET()
      FDREV = OPEN(REVFIL, 1)
      IF (.NOT.(FDREV .EQ. -3))GOTO 23071
      CALL CANT(REVFIL)
23071 CONTINUE
      IREC1 = 0
      IREC2 = 0
      COUNT = 0
      I = NNN+2
      FLAG =  3
23073 CONTINUE
      IREC1 = IREC1 + 1
      IF (.NOT.(IREC1 .LE. MMM))GOTO 23076
      LEN1 = LINGET(HISBUF, 1)
23076 CONTINUE
      I = I + 1
      J = GETTAB(I)
      IF (.NOT.(J .EQ. 0))GOTO 23078
      IF (.NOT.(FLAG .NE.  1))GOTO 23080
      IF (.NOT.(FLAG .EQ.  2))GOTO 23082
      CALL PUTTAG(ST00BZ)
23082 CONTINUE
      CALL PUTTAG(ST00CZ)
      FLAG =  1
23080 CONTINUE
      CALL PUTLIN(HISBUF, FDSCR)
      GOTO 23079
23078 CONTINUE
23084 CONTINUE
      IREC2 = IREC2 + 1
      IF (.NOT.(IREC2 .LE. NNN))GOTO 23087
      LEN2 = GETLIN(REVBUF, FDREV)
23087 CONTINUE
      IF (.NOT.(IREC2 .GE. J))GOTO 23089
      GOTO 23086
23089 CONTINUE
      IF (.NOT.(FLAG .NE.  2))GOTO 23091
      IF (.NOT.(FLAG .EQ.  1))GOTO 23093
      CALL PUTTAG(ST00DZ)
23093 CONTINUE
      CALL PUTTAG(ST00EZ)
      FLAG =  2
23091 CONTINUE
      CALL PUTLIN(REVBUF, FDSCR)
23085 GOTO 23084
23086 CONTINUE
      IF (.NOT.(IREC2 .GT. NNN))GOTO 23095
      GOTO 23075
23095 CONTINUE
      IF (.NOT.(EQUAL(HISBUF, REVBUF) .EQ. 1))GOTO 23097
      IF (.NOT.(FLAG .NE.  3))GOTO 23099
      CALL PUTTAG(ST00FZ)
      FLAG =  3
23099 CONTINUE
      COUNT = COUNT + 1
      CALL PUTLIN(HISBUF, FDSCR)
      GOTO 23098
23097 CONTINUE
      IF (.NOT.(FLAG .NE.  1))GOTO 23101
      IF (.NOT.(FLAG .EQ.  2))GOTO 23103
      CALL PUTTAG(ST00GZ)
23103 CONTINUE
      CALL PUTTAG(ST00HZ)
23101 CONTINUE
      CALL PUTLIN(HISBUF, FDSCR)
      CALL PUTTAG(ST00IZ)
      CALL PUTTAG(ST00JZ)
      CALL PUTLIN(REVBUF, FDSCR)
      FLAG =  2
23098 CONTINUE
23079 CONTINUE
23074 GOTO 23073
23075 CONTINUE
      IF (.NOT.(FLAG .NE.  3))GOTO 23105
      CALL PUTTAG(ST00KZ)
23105 CONTINUE
23107 IF (.NOT.(LINGET(HISBUF, 1) .NE. -1))GOTO 23108
      CALL PUTLIN(HISBUF, FDSCR)
      GOTO 23107
23108 CONTINUE
      CALL CLOSE(FDHIS)
      CALL CLOSE(FDREV)
      CALL CLOSE(FDSCR)
      CALL PUTNUM(NNN - COUNT, 1, 3)
      CALL REMARK(ST00LZ)
      CALL PUTNUM(MMM - COUNT, 1, 3)
      CALL REMARK(ST00MZ)
      CALL PUTNUM(COUNT, 1, 3)
      CALL REMARK(ST00NZ)
      FDHIS = CREATE(NEWFIL, 2)
      IF (.NOT.(FDHIS .EQ. -3))GOTO 23109
      CALL CANT(NEWFIL)
23109 CONTINUE
      FDSCR = OPEN(SCRFIL, 1)
      IF (.NOT.(FDSCR .EQ. -3))GOTO 23111
      CALL PUTLIN(ST00OZ, 3)
      CALL CANT(SCRFIL)
23111 CONTINUE
      CALL PUTLIN(ST00PZ, FDHIS)
      CALL PUTNUM(NNN - COUNT, 1, FDHIS)
      CALL PUTCH(47, FDHIS)
      CALL PUTNUM(MMM - COUNT, 1, FDHIS)
      CALL PUTCH(47, FDHIS)
      CALL PUTNUM(COUNT, 1, FDHIS)
      CALL PUTCH(10, FDHIS)
      CALL PUTLIN(ST00QZ, FDHIS)
      CALL PUTLIN(ST00RZ, FDHIS)
      CALL PUTLIN(WANTED, FDHIS)
      CALL PUTCH(32, FDHIS)
      CALL GETNOW(NOW)
      CALL FMTDAT( DATE, TIME, NOW, 1)
      CALL PUTLIN( DATE, FDHIS)
      CALL PUTCH(32, FDHIS)
      CALL PUTLIN( TIME, FDHIS)
      CALL PUTCH(32, FDHIS)
      CALL MAILID(REVBUF)
      I = INDEXC(REVBUF, 32)
      IF (.NOT.(I .GT. 0))GOTO 23113
      REVBUF(I) = 0
23113 CONTINUE
      CALL PUTLIN(REVBUF, FDHIS)
      CALL PUTCH(32, FDHIS)
      CALL PUTNUM(MAXVER, 1, FDHIS)
      CALL PUTCH(32, FDHIS)
      CALL PUTNUM(MYANCS, 1, FDHIS)
      CALL PUTCH(10, FDHIS)
23115 IF (.NOT.(GETLIN(HISBUF, FDSCR) .NE. -1))GOTO 23116
      CALL PUTLIN(HISBUF, FDHIS)
      GOTO 23115
23116 CONTINUE
      CALL CLOSE(FDSCR)
      CALL CLOSE(FDHIS)
      JUNK = REMOVE(SCRFIL)
      CALL VIRFIN
      RETURN
      END
      SUBROUTINE PARSE(INBUF, FROM, OUTARA, DELIM)
      LOGICAL*1 INBUF(402)
      INTEGER FROM
      INTEGER OUTARA(16)
      LOGICAL*1 DELIM
      INTEGER PTR
      PTR = FROM
23117 IF (.NOT.(INBUF(PTR) .EQ. DELIM))GOTO 23118
      PTR = PTR+1
      GOTO 23117
23118 CONTINUE
      I=1
23119 IF (.NOT.(INBUF(PTR) .NE. 10))GOTO 23121
      OUTARA(I) = PTR
23122 IF (.NOT.((INBUF(PTR) .NE. DELIM) .AND. (INBUF(PTR) .NE. 10)))GOTO
     * 23123
      PTR = PTR+1
      GOTO 23122
23123 CONTINUE
23124 IF (.NOT.((INBUF(PTR) .EQ. DELIM) .AND. (INBUF(PTR) .NE. 10)))GOTO
     * 23125
      INBUF(PTR) = 0
      PTR = PTR+1
      GOTO 23124
23125 CONTINUE
23120 I=I+1
      GOTO 23119
23121 CONTINUE
      INBUF(PTR) = 0
      OUTARA(I) = 0
      RETURN
      END
      INTEGER FUNCTION BMATCH(LIN, FROM, PAT)
      LOGICAL*1 LIN (402), PAT(402)
      INTEGER FROM, I, J
      I = FROM
      J=1
23126 IF (.NOT.(PAT(J) .NE. 0))GOTO 23128
      IF (.NOT.(LIN(I).NE.PAT(J)))GOTO 23129
      BMATCH = 0
      RETURN
23129 CONTINUE
      I = I + 1
23127 J = J + 1
      GOTO 23126
23128 CONTINUE
      BMATCH = I
      RETURN
      END
      INTEGER FUNCTION BMCH2(LIN, FROM, PAT)
      LOGICAL*1 LIN (402), PAT(402)
      INTEGER FROM
      INTEGER EQUAL
      LOGICAL*1 TEMP(402)
      CALL SCOPY(LIN, FROM, TEMP, 1)
      BMCH2=(EQUAL(TEMP, PAT))
      RETURN
      END
      INTEGER FUNCTION CTOI2(BUF, FIXED)
      LOGICAL*1 BUF
      INTEGER FIXED
      INTEGER CTOI
      INTEGER PTR
      PTR = FIXED
      CTOI2=(CTOI(BUF, PTR))
      RETURN
      END
      SUBROUTINE SETGET (FILNAM, WANTED)
      LOGICAL*1 FILNAM(36)
      LOGICAL*1 WANTED(36)
      INTEGER ANSTRY, FDHIS, FDREV, FDSCR, FLAG, INSERT, MYANCS, MAXVER,
     * SEEKPT
      INTEGER BMATCH, BMCH2, CLOSE, CTOI2, GETLIN, OPEN, NOTE
      INTEGER JUNK
      LOGICAL*1 INBUF(402)
      INTEGER ARRAY(16)
      INTEGER I
      INTEGER THREAD, IPREV, ITHIS
      LOGICAL*1 ST00SZ(31)
      LOGICAL*1 ST00TZ(36)
      LOGICAL*1 ST010Z(4)
      LOGICAL*1 ST011Z(37)
      LOGICAL*1 ST012Z(5)
      LOGICAL*1 ST013Z(11)
      COMMON /TCS/ ANSTRY(100), FDHIS, FDREV, FDSCR, FLAG, INSERT, MYANC
     *S, MAXVER, SEEKPT(2)
      DATA ST00SZ(1)/67/,ST00SZ(2)/97/,ST00SZ(3)/110/,ST00SZ(4)/110/,ST0
     *0SZ(5)/111/,ST00SZ(6)/116/,ST00SZ(7)/32/,ST00SZ(8)/108/,ST00SZ(9)/
     *111/,ST00SZ(10)/99/,ST00SZ(11)/97/,ST00SZ(12)/116/,ST00SZ(13)/101/
     *,ST00SZ(14)/32/,ST00SZ(15)/84/,ST00SZ(16)/67/,ST00SZ(17)/83/,ST00S
     *Z(18)/32/,ST00SZ(19)/104/,ST00SZ(20)/105/,ST00SZ(21)/115/,ST00SZ(2
     *2)/116/,ST00SZ(23)/111/,ST00SZ(24)/114/,ST00SZ(25)/121/,ST00SZ(26)
     */32/,ST00SZ(27)/102/,ST00SZ(28)/105/,ST00SZ(29)/108/,ST00SZ(30)/10
     *1/,ST00SZ(31)/0/
      DATA ST00TZ(1)/85/,ST00TZ(2)/110/,ST00TZ(3)/101/,ST00TZ(4)/120/,ST
     *00TZ(5)/112/,ST00TZ(6)/101/,ST00TZ(7)/99/,ST00TZ(8)/116/,ST00TZ(9)
     */101/,ST00TZ(10)/100/,ST00TZ(11)/32/,ST00TZ(12)/69/,ST00TZ(13)/79/
     *,ST00TZ(14)/70/,ST00TZ(15)/32/,ST00TZ(16)/111/,ST00TZ(17)/110/,ST0
     *0TZ(18)/32/,ST00TZ(19)/104/,ST00TZ(20)/105/,ST00TZ(21)/115/,ST00TZ
     *(22)/116/,ST00TZ(23)/111/,ST00TZ(24)/114/,ST00TZ(25)/121/,ST00TZ(2
     *6)/45/,ST00TZ(27)/105/,ST00TZ(28)/110/,ST00TZ(29)/102/,ST00TZ(30)/
     *111/,ST00TZ(31)/32/,ST00TZ(32)/115/,ST00TZ(33)/99/,ST00TZ(34)/97/,
     *ST00TZ(35)/110/,ST00TZ(36)/0/
      DATA ST010Z(1)/37/,ST010Z(2)/37/,ST010Z(3)/84/,ST010Z(4)/0/
      DATA ST011Z(1)/78/,ST011Z(2)/111/,ST011Z(3)/110/,ST011Z(4)/101/,ST
     *011Z(5)/120/,ST011Z(6)/105/,ST011Z(7)/115/,ST011Z(8)/116/,ST011Z(9
     *)/97/,ST011Z(10)/110/,ST011Z(11)/116/,ST011Z(12)/32/,ST011Z(13)/11
     *4/,ST011Z(14)/101/,ST011Z(15)/118/,ST011Z(16)/105/,ST011Z(17)/115/
     *,ST011Z(18)/105/,ST011Z(19)/111/,ST011Z(20)/110/,ST011Z(21)/32/,ST
     *011Z(22)/108/,ST011Z(23)/101/,ST011Z(24)/118/,ST011Z(25)/101/,ST01
     *1Z(26)/108/,ST011Z(27)/32/,ST011Z(28)/114/,ST011Z(29)/101/,ST011Z(
     *30)/113/,ST011Z(31)/117/,ST011Z(32)/101/,ST011Z(33)/115/,ST011Z(34
     *)/116/,ST011Z(35)/101/,ST011Z(36)/100/,ST011Z(37)/0/
      DATA ST012Z(1)/37/,ST012Z(2)/37/,ST012Z(3)/100/,ST012Z(4)/32/,ST01
     *2Z(5)/0/
      DATA ST013Z(1)/86/,ST013Z(2)/101/,ST013Z(3)/114/,ST013Z(4)/115/,ST
     *013Z(5)/105/,ST013Z(6)/111/,ST013Z(7)/110/,ST013Z(8)/32/,ST013Z(9)
     */35/,ST013Z(10)/32/,ST013Z(11)/0/
      FDHIS = OPEN(FILNAM, 1)
      IF (.NOT.(FDHIS .EQ. -3))GOTO 23131
      CALL ERROR(ST00SZ)
23131 CONTINUE
      I=1
23133 IF (.NOT.(I.LE.100))GOTO 23135
      ANSTRY(I) = 0
23134 I=I+1
      GOTO 23133
23135 CONTINUE
      THREAD = -1
23136 CONTINUE
      I = GETLIN(INBUF, FDHIS)
      IF (.NOT.(I .EQ. -1))GOTO 23139
      CALL ERROR(ST00TZ)
23139 CONTINUE
      CALL PUTLIN(INBUF, FDSCR)
      IF (.NOT.(BMATCH(INBUF, 1, ST010Z) .NE. 0))GOTO 23141
      CALL ERROR(ST011Z)
23141 CONTINUE
      IF (.NOT.(BMATCH(INBUF, 1, ST012Z) .NE. 0))GOTO 23143
      CALL PARSE(INBUF, 5, ARRAY, 32)
      ITHIS = CTOI2(INBUF, ARRAY(6))
      IPREV = CTOI2(INBUF, ARRAY(7))
      IF (.NOT.(THREAD .LT. 0))GOTO 23145
      MAXVER = ITHIS
      THREAD = 0
23145 CONTINUE
      IF (.NOT.(THREAD .EQ. 0))GOTO 23147
      IF (.NOT.((WANTED(1) .EQ. 0) .OR. (BMCH2(INBUF, ARRAY(2), WANTED) 
     *.EQ. 1)))GOTO 23149
      IF (.NOT.(WANTED(1) .EQ. 0))GOTO 23151
      CALL SCOPY(INBUF, ARRAY(2), WANTED, 1)
      CALL PUTLIN(ST013Z, 3)
      CALL PUTLIN(WANTED, 3)
      CALL PUTCH(10, 3)
23151 CONTINUE
      ANSTRY(ITHIS) = 1
      MYANCS = ITHIS
      THREAD = IPREV
      IF (.NOT.(THREAD .EQ. 0))GOTO 23153
      GOTO 23138
23153 CONTINUE
      GOTO 23150
23149 CONTINUE
      GOTO 23137
23150 CONTINUE
      GOTO 23148
23147 CONTINUE
      IF (.NOT.(ITHIS .EQ. THREAD))GOTO 23155
      ANSTRY(ITHIS) = 1
      THREAD = IPREV
      IF (.NOT.(THREAD .EQ. 0))GOTO 23157
      GOTO 23138
23157 CONTINUE
23155 CONTINUE
23148 CONTINUE
23143 CONTINUE
23137 GOTO 23136
23138 CONTINUE
      JUNK = NOTE(SEEKPT, FDHIS)
      RETURN
      END
      SUBROUTINE RSTGET()
      INTEGER ANSTRY, FDHIS, FDREV, FDSCR, FLAG, INSERT, MYANCS, MAXVER,
     * SEEKPT
      COMMON /TCS/ ANSTRY(100), FDHIS, FDREV, FDSCR, FLAG, INSERT, MYANC
     *S, MAXVER, SEEKPT(2)
      CALL SEEK(SEEKPT, FDHIS)
      INSERT = 0
      RETURN
      END
      INTEGER FUNCTION LINGET(INBUF, PSTHRU)
      LOGICAL*1 INBUF(402)
      INTEGER PSTHRU
      INTEGER ANSTRY, FDHIS, FDREV, FDSCR, FLAG, INSERT, MYANCS, MAXVER,
     * SEEKPT
      INTEGER BMATCH, CTOI2, GETLIN
      INTEGER CURNST, I
      LOGICAL*1 ST014Z(36)
      LOGICAL*1 ST015Z(5)
      LOGICAL*1 ST016Z(5)
      LOGICAL*1 ST017Z(5)
      LOGICAL*1 ST018Z(5)
      COMMON /TCS/ ANSTRY(100), FDHIS, FDREV, FDSCR, FLAG, INSERT, MYANC
     *S, MAXVER, SEEKPT(2)
      DATA ST014Z(1)/85/,ST014Z(2)/110/,ST014Z(3)/101/,ST014Z(4)/120/,ST
     *014Z(5)/112/,ST014Z(6)/101/,ST014Z(7)/99/,ST014Z(8)/116/,ST014Z(9)
     */101/,ST014Z(10)/100/,ST014Z(11)/32/,ST014Z(12)/69/,ST014Z(13)/79/
     *,ST014Z(14)/70/,ST014Z(15)/32/,ST014Z(16)/111/,ST014Z(17)/110/,ST0
     *14Z(18)/32/,ST014Z(19)/104/,ST014Z(20)/105/,ST014Z(21)/115/,ST014Z
     *(22)/116/,ST014Z(23)/111/,ST014Z(24)/114/,ST014Z(25)/121/,ST014Z(2
     *6)/45/,ST014Z(27)/100/,ST014Z(28)/97/,ST014Z(29)/116/,ST014Z(30)/9
     *7/,ST014Z(31)/32/,ST014Z(32)/115/,ST014Z(33)/99/,ST014Z(34)/97/,ST
     *014Z(35)/110/,ST014Z(36)/0/
      DATA ST015Z(1)/37/,ST015Z(2)/37/,ST015Z(3)/69/,ST015Z(4)/32/,ST015
     *Z(5)/0/
      DATA ST016Z(1)/37/,ST016Z(2)/37/,ST016Z(3)/73/,ST016Z(4)/32/,ST016
     *Z(5)/0/
      DATA ST017Z(1)/37/,ST017Z(2)/37/,ST017Z(3)/68/,ST017Z(4)/32/,ST017
     *Z(5)/0/
      DATA ST018Z(1)/37/,ST018Z(2)/37/,ST018Z(3)/69/,ST018Z(4)/32/,ST018
     *Z(5)/0/
23159 CONTINUE
      I = GETLIN(INBUF, FDHIS)
      IF (.NOT.(I .EQ. -1))GOTO 23162
      CALL ERROR(ST014Z)
23162 CONTINUE
      IF (.NOT.(BMATCH(INBUF, 1, ST015Z) .NE. 0))GOTO 23164
      IF (.NOT.(CTOI2(INBUF, 5) .EQ. 1))GOTO 23166
      IF (.NOT.(PSTHRU .EQ. 1))GOTO 23168
      CALL PUTLIN(INBUF, FDSCR)
23168 CONTINUE
      GOTO 23161
23166 CONTINUE
      IF (.NOT.(INSERT .EQ. 0))GOTO 23170
      IF (.NOT.(CTOI2(INBUF, 5) .EQ. CURNST))GOTO 23172
      INSERT = 1
23172 CONTINUE
23170 CONTINUE
      GOTO 23165
23164 CONTINUE
      IF (.NOT.(BMATCH(INBUF, 1, ST016Z) .NE. 0))GOTO 23174
      IF (.NOT.(ANSTRY(CTOI2(INBUF, 5)) .EQ. 1))GOTO 23176
      INSERT = 1
      GOTO 23177
23176 CONTINUE
      IF (.NOT.(INSERT .EQ. 1))GOTO 23178
      CURNST = CTOI2(INBUF, 5)
      INSERT = 0
23178 CONTINUE
23177 CONTINUE
      GOTO 23175
23174 CONTINUE
      IF (.NOT.(BMATCH(INBUF, 1, ST017Z) .NE. 0))GOTO 23180
      IF (.NOT.(ANSTRY(CTOI2(INBUF, 5)) .EQ. 1))GOTO 23182
      IF (.NOT.(INSERT .EQ. 1))GOTO 23184
      CURNST = CTOI2(INBUF, 5)
      INSERT = 0
23184 CONTINUE
23182 CONTINUE
      GOTO 23181
23180 CONTINUE
      IF (.NOT.(INSERT .EQ. 1))GOTO 23186
      LINGET=(I)
      RETURN
23186 CONTINUE
23181 CONTINUE
23175 CONTINUE
23165 CONTINUE
      IF (.NOT.(PSTHRU .EQ. 1))GOTO 23188
      IF (.NOT.(FLAG .EQ.  1))GOTO 23190
      CALL PUTTAG(ST018Z)
      FLAG =  3
23190 CONTINUE
      CALL PUTLIN(INBUF, FDSCR)
23188 CONTINUE
23160 GOTO 23159
23161 CONTINUE
      LINGET=(-1)
      RETURN
      END
      INTEGER FUNCTION HASH (MCARD)
      LOGICAL*1 MCARD(402)
      INTEGER I, N
      HASH = 0
      I=1
23192 IF (.NOT.(MCARD(I) .NE. 0))GOTO 23194
      N = MCARD(I)
      IF (.NOT.(N .LT. 0))GOTO 23195
      N = (N+ 32687) +  1
23195 CONTINUE
      IF (.NOT.(HASH .LT.  32687/2 ))GOTO 23197
      HASH = HASH + HASH + 1
      GOTO 23198
23197 CONTINUE
      HASH = (HASH- 32687) + HASH-1
23198 CONTINUE
      HASH = N - HASH
      IF (.NOT.(HASH .LT. 0))GOTO 23199
      HASH = (HASH+ 32687) +  1
23199 CONTINUE
23193 I= I + 1
      GOTO 23192
23194 CONTINUE
      RETURN
      END
      SUBROUTINE INCVNO( IN )
      LOGICAL*1 IN(402)
      INTEGER CTOI, ITOC
      INTEGER EFLAG
      INTEGER I, KI, N
      LOGICAL*1 TMP(10)
      LOGICAL*1 ST019Z(30)
      LOGICAL*1 ST01AZ(30)
      DATA ST019Z(1)/84/,ST019Z(2)/67/,ST019Z(3)/83/,ST019Z(4)/32/,ST019
     *Z(5)/86/,ST019Z(6)/101/,ST019Z(7)/114/,ST019Z(8)/115/,ST019Z(9)/10
     *5/,ST019Z(10)/111/,ST019Z(11)/110/,ST019Z(12)/32/,ST019Z(13)/110/,
     *ST019Z(14)/117/,ST019Z(15)/109/,ST019Z(16)/98/,ST019Z(17)/101/,ST0
     *19Z(18)/114/,ST019Z(19)/32/,ST019Z(20)/99/,ST019Z(21)/111/,ST019Z(
     *22)/114/,ST019Z(23)/114/,ST019Z(24)/117/,ST019Z(25)/112/,ST019Z(26
     *)/116/,ST019Z(27)/101/,ST019Z(28)/100/,ST019Z(29)/33/,ST019Z(30)/0
     */
      DATA ST01AZ(1)/84/,ST01AZ(2)/67/,ST01AZ(3)/83/,ST01AZ(4)/32/,ST01A
     *Z(5)/86/,ST01AZ(6)/101/,ST01AZ(7)/114/,ST01AZ(8)/115/,ST01AZ(9)/10
     *5/,ST01AZ(10)/111/,ST01AZ(11)/110/,ST01AZ(12)/32/,ST01AZ(13)/78/,S
     *T01AZ(14)/117/,ST01AZ(15)/109/,ST01AZ(16)/98/,ST01AZ(17)/101/,ST01
     *AZ(18)/114/,ST01AZ(19)/32/,ST01AZ(20)/99/,ST01AZ(21)/111/,ST01AZ(2
     *2)/114/,ST01AZ(23)/114/,ST01AZ(24)/117/,ST01AZ(25)/112/,ST01AZ(26)
     */116/,ST01AZ(27)/101/,ST01AZ(28)/100/,ST01AZ(29)/33/,ST01AZ(30)/0/
      I = 1
      EFLAG =  0
23201 CONTINUE
      KI = I
      N = CTOI(IN, I)
      IF (.NOT.(N .GT. 0))GOTO 23204
      EFLAG =  0
23204 CONTINUE
      IF (.NOT.(IN(I) .NE. 46))GOTO 23206
      GOTO 23203
23206 CONTINUE
      I = I+1
      IF (.NOT.(EFLAG .EQ.  1))GOTO 23208
      CALL ERROR(ST019Z)
23208 CONTINUE
      EFLAG =  1
23207 CONTINUE
23202 GOTO 23201
23203 CONTINUE
      IF (.NOT.(N .EQ. 0))GOTO 23210
      CALL ERROR(ST01AZ)
23210 CONTINUE
      N = N+1
      I = ITOC(N, TMP, 10)
      CALL SCOPY(TMP, 1, IN, KI)
      IN(KI+I) = 0
      RETURN
      END
      SUBROUTINE PUTNUM(N, W, FILE)
      LOGICAL*1 CHARS( 20)
      INTEGER ITOC
      INTEGER I, N, ND, W
      ND = ITOC(N, CHARS,  20)
      I=ND+1
23212 IF (.NOT.(I.LE.W))GOTO 23214
      CALL PUTCH(32, FILE)
23213 I=I+1
      GOTO 23212
23214 CONTINUE
      I=1
23215 IF (.NOT.(I.LE.ND))GOTO 23217
      CALL PUTCH(CHARS(I), FILE)
23216 I=I+1
      GOTO 23215
23217 CONTINUE
      RETURN
      END
      SUBROUTINE APUTLN(STR, OFF, OUTFD)
      LOGICAL*1 STR(402)
      INTEGER OFF, OUTFD
      LOGICAL*1 TMPLIN(402)
      INTEGER I, J
      I = OFF-1
      J = 1
23218 CONTINUE
      I = I+1
      TMPLIN(J) = STR(I)
      J = J+1
23219 IF (.NOT.((STR(I) .EQ. 0) .OR. (STR(I) .EQ. 10)))GOTO 23218
23220 CONTINUE
      TMPLIN(J) = 0
      CALL PUTLIN(TMPLIN, OUTFD)
      RETURN
      END
      SUBROUTINE PUTTAG( TAG )
      LOGICAL*1 TAG(20)
      INTEGER ANSTRY, FDHIS, FDREV, FDSCR, FLAG, INSERT, MYANCS, MAXVER,
     * SEEKPT
      COMMON /TCS/ ANSTRY(100), FDHIS, FDREV, FDSCR, FLAG, INSERT, MYANC
     *S, MAXVER, SEEKPT(2)
      CALL PUTLIN(TAG, FDSCR)
      CALL PUTNUM(MAXVER, 1, FDSCR)
      CALL PUTCH(10, FDSCR)
      RETURN
      END
      INTEGER FUNCTION GETTAB(VIRNDX)
      INTEGER VIRNDX, PHYNDX, PAGE
      INTEGER VIRPHY
      INTEGER TAB
      COMMON / CTAB / TAB(8192)
      PAGE = VIRPHY(VIRNDX, PHYNDX)
      GETTAB=(TAB(PHYNDX))
      RETURN
      END
      SUBROUTINE SETTAB(VIRNDX, VALUE)
      INTEGER VIRNDX, VALUE, PAGE, PHYNDX
      INTEGER VIRPHY
      INTEGER TAB
      COMMON / CTAB / TAB(8192)
      PAGE = VIRPHY(VIRNDX, PHYNDX)
      TAB(PHYNDX) = VALUE
      CALL PDIRTY(PAGE)
      RETURN
      END
      SUBROUTINE MAPPHY(I)
      INTEGER I, N, J, PND, JUNK
      INTEGER NOTE
      INTEGER CREATE
      INTEGER VIRIND
      INTEGER PHYIND
      INTEGER*4 DSKADR
      INTEGER VIRUNT
      INTEGER*4 VIREND
      LOGICAL*1 VPFILE
      INTEGER LRUP
      INTEGER MRUP
      INTEGER PFNP
      LOGICAL*1 VPF(4)
      LOGICAL*1 ST01BZ(24)
      COMMON / CVIRT / VIRIND(128), PHYIND(128), DSKADR(128)
      COMMON / CVFILE / VIRUNT, VIREND, VPFILE(36)
      COMMON / CLRU / LRUP(32), MRUP(32), PFNP(32)
      DATA VPF(1)/118/,VPF(2)/112/,VPF(3)/102/,VPF(4)/0/
      DATA ST01BZ(1)/67/,ST01BZ(2)/97/,ST01BZ(3)/110/,ST01BZ(4)/110/,ST0
     *1BZ(5)/111/,ST01BZ(6)/116/,ST01BZ(7)/32/,ST01BZ(8)/111/,ST01BZ(9)/
     *112/,ST01BZ(10)/101/,ST01BZ(11)/110/,ST01BZ(12)/32/,ST01BZ(13)/112
     */,ST01BZ(14)/97/,ST01BZ(15)/103/,ST01BZ(16)/105/,ST01BZ(17)/110/,S
     *T01BZ(18)/103/,ST01BZ(19)/32/,ST01BZ(20)/102/,ST01BZ(21)/105/,ST01
     *BZ(22)/108/,ST01BZ(23)/101/,ST01BZ(24)/0/
      IF (.NOT.(VIRUNT .EQ. -3))GOTO 23221
      CALL SCRATF(VPF, VPFILE)
      VIRUNT = CREATE(VPFILE, -3)
      IF (.NOT.(VIRUNT .EQ. -3))GOTO 23223
      CALL ERROR(ST01BZ)
23223 CONTINUE
      JUNK = NOTE(VIREND, VIRUNT)
23221 CONTINUE
      N = LRUP(1)
      J = PFNP(N)
      PND = IABS(PHYIND(J))
      CALL PAGOUT(J)
      PHYIND(I) = PND
      CALL PAGIN(I)
      PFNP(N) = I
      CALL MRUSET(N)
      RETURN
      END
      SUBROUTINE MRUSET(N)
      INTEGER N, I, J
      INTEGER LRUP
      INTEGER MRUP
      INTEGER PFNP
      COMMON / CLRU / LRUP(32), MRUP(32), PFNP(32)
      IF (.NOT.(N .NE. 1))GOTO 23225
      J = LRUP(N)
      I = MRUP(N)
      MRUP(J) = I
      LRUP(I) = J
      I = MRUP(1)
      MRUP(1) = N
      LRUP(I) = N
      LRUP(N) = 1
      MRUP(N) = I
23225 CONTINUE
      RETURN
      END
      SUBROUTINE PAGIN(I)
      INTEGER I, N, JUNK
      INTEGER READF, PTREQ
      INTEGER VIRIND
      INTEGER PHYIND
      INTEGER*4 DSKADR
      INTEGER VIRUNT
      INTEGER*4 VIREND
      LOGICAL*1 VPFILE
      INTEGER TAB
      COMMON / CVIRT / VIRIND(128), PHYIND(128), DSKADR(128)
      COMMON / CVFILE / VIRUNT, VIREND, VPFILE(36)
      COMMON / CTAB / TAB(8192)
      N = PHYIND(I)
      IF (.NOT.(PTREQ(DSKADR(I), 0) .EQ. 1))GOTO 23227
      JUNK = N + 256
23229 IF (.NOT.(N .LT. JUNK))GOTO 23231
      TAB(N) = 0
23230 N=N+1
      GOTO 23229
23231 CONTINUE
      GOTO 23228
23227 CONTINUE
      CALL SEEK(DSKADR(I), VIRUNT)
      JUNK = READF(TAB(N), 512, VIRUNT)
23228 CONTINUE
      RETURN
      END
      SUBROUTINE PAGOUT(J)
      INTEGER J, N, JUNK, RESET
      INTEGER WRITEF, PTREQ, NOTE
      INTEGER VIRIND
      INTEGER PHYIND
      INTEGER*4 DSKADR
      INTEGER VIRUNT
      INTEGER*4 VIREND
      LOGICAL*1 VPFILE
      INTEGER TAB
      COMMON / CVIRT / VIRIND(128), PHYIND(128), DSKADR(128)
      COMMON / CVFILE / VIRUNT, VIREND, VPFILE(36)
      COMMON / CTAB / TAB(8192)
      IF (.NOT.(PHYIND(J) .LT. 0))GOTO 23232
      N = IABS(PHYIND(J))
      IF (.NOT.(PTREQ(DSKADR(J), 0) .EQ. 1))GOTO 23234
      CALL PTRCPY(VIREND, DSKADR(J))
      RESET = 1
      GOTO 23235
23234 CONTINUE
      RESET = 0
23235 CONTINUE
      CALL SEEK(DSKADR(J), VIRUNT)
      JUNK = WRITEF(TAB(N), 512, VIRUNT)
      IF (.NOT.(RESET .EQ. 1))GOTO 23236
      JUNK = NOTE(VIREND, VIRUNT)
23236 CONTINUE
23232 CONTINUE
      PHYIND(J) = 0
      RETURN
      END
      SUBROUTINE PDIRTY(I)
      INTEGER I, N
      INTEGER VIRIND
      INTEGER PHYIND
      INTEGER*4 DSKADR
      INTEGER LRUP
      INTEGER MRUP
      INTEGER PFNP
      COMMON / CVIRT / VIRIND(128), PHYIND(128), DSKADR(128)
      COMMON / CLRU / LRUP(32), MRUP(32), PFNP(32)
      PHYIND(I) = -IABS(PHYIND(I))
      N=1
23238 IF (.NOT.(N .LE. 32))GOTO 23240
      IF (.NOT.(PFNP(N) .EQ. I))GOTO 23241
      GOTO 23240
23241 CONTINUE
23239 N=N+1
      GOTO 23238
23240 CONTINUE
      CALL MRUSET(N)
      RETURN
      END
      SUBROUTINE VIRINT
      INTEGER I, J
      INTEGER VIRIND
      INTEGER PHYIND
      INTEGER*4 DSKADR
      INTEGER VIRUNT
      INTEGER*4 VIREND
      LOGICAL*1 VPFILE
      INTEGER LRUP
      INTEGER MRUP
      INTEGER PFNP
      COMMON / CVIRT / VIRIND(128), PHYIND(128), DSKADR(128)
      COMMON / CVFILE / VIRUNT, VIREND, VPFILE(36)
      COMMON / CLRU / LRUP(32), MRUP(32), PFNP(32)
      I=1
      J=1
23243 IF (.NOT.(I .LE. 128))GOTO 23245
      VIRIND(I) = J
      CALL PTRCPY(0,DSKADR(I))
      IF (.NOT.(I .LE. 32))GOTO 23246
      PHYIND(I) = J
      GOTO 23247
23246 CONTINUE
      PHYIND(I) = 0
23247 CONTINUE
23244 I=I+1
      J=J+256
      GOTO 23243
23245 CONTINUE
      VIRUNT = -3
      I=1
23248 IF (.NOT.(I .LE. 32))GOTO 23250
      LRUP(I) = I - 1
      MRUP(I) = I + 1
      PFNP(I) = I
23249 I=I+1
      GOTO 23248
23250 CONTINUE
      LRUP(1) = 32
      MRUP(32) = 1
      RETURN
      END
      INTEGER FUNCTION VIRPHY(VIRTND, PHYSND)
      INTEGER VIRTND, PHYSND, I
      INTEGER VIRIND
      INTEGER PHYIND
      INTEGER*4 DSKADR
      COMMON / CVIRT / VIRIND(128), PHYIND(128), DSKADR(128)
      I = ((VIRTND - 1) / 256) + 1
      IF (.NOT.(PHYIND(I) .EQ. 0))GOTO 23251
      CALL MAPPHY(I)
23251 CONTINUE
      PHYSND = IABS(PHYIND(I)) + (VIRTND - VIRIND(I))
      VIRPHY=(I)
      RETURN
      END
      SUBROUTINE VIRFIN
      INTEGER VIRUNT
      INTEGER*4 VIREND
      LOGICAL*1 VPFILE
      INTEGER JUNK
      INTEGER REMOVE
      COMMON / CVFILE / VIRUNT, VIREND, VPFILE(36)
      IF (.NOT.(VIRUNT .NE. -3))GOTO 23253
      CALL CLOSE(VIRUNT)
      JUNK = REMOVE(VPFILE)
23253 CONTINUE
      RETURN
      END
      SUBROUTINE DOSORT(NNN)
      INTEGER NNN
      INTEGER S, LEFT(20), RIGHT(20), L, R, I, J, P, ITEMP, KI, KJ
      INTEGER CMPINT
      INTEGER GETTAB
      INTEGER ISTAB1, ISTAB2
      S = 1
      LEFT(1) = 1
      RIGHT(1) = NNN
23255 CONTINUE
      L = LEFT(S)
      R = RIGHT(S)
      S = S - 1
23258 CONTINUE
      I = L
      J = R
      P = R
23261 CONTINUE
23264 IF (.NOT.(CMPINT(I, P) .LT. 0))GOTO 23265
      I = I + 1
      GOTO 23264
23265 CONTINUE
23266 IF (.NOT.(CMPINT(P, J) .LT. 0))GOTO 23267
      J = J - 1
      GOTO 23266
23267 CONTINUE
      IF (.NOT.(I .LE. J))GOTO 23268
      ITEMP = GETTAB(I)
      ISTAB1=I
      ISTAB2= GETTAB(J)
      CALL SETTAB(ISTAB1, ISTAB2)
      ISTAB1=J
      ISTAB2= ITEMP
      CALL SETTAB(ISTAB1, ISTAB2)
      KI =  32513 - I
      KJ =  32513 - J
      ITEMP = GETTAB(KI)
      ISTAB1=KI
      ISTAB2= GETTAB(KJ)
      CALL SETTAB(ISTAB1, ISTAB2)
      ISTAB1=KJ
      ISTAB2= ITEMP
      CALL SETTAB(ISTAB1, ISTAB2)
      I = I + 1
      J = J - 1
23268 CONTINUE
23262 IF (.NOT.(I .GT. J))GOTO 23261
23263 CONTINUE
      IF (.NOT.(J - L .LT. R - I))GOTO 23270
      IF (.NOT.(I .LT. R))GOTO 23272
      S = S + 1
      LEFT(S) = I
      RIGHT(S) = R
23272 CONTINUE
      R = J
      GOTO 23271
23270 CONTINUE
      IF (.NOT.(L .LT. J))GOTO 23274
      S = S + 1
      LEFT(S) = L
      RIGHT(S) = J
23274 CONTINUE
      L = I
23271 CONTINUE
23259 IF (.NOT.(L .GE. R))GOTO 23258
23260 CONTINUE
23256 IF (.NOT.(S .EQ. 0))GOTO 23255
23257 CONTINUE
      RETURN
      END
      INTEGER FUNCTION CMPINT(I, J)
      INTEGER I, J
      INTEGER KI, KJ, VI, VJ, STATUS
      INTEGER GETTAB
      INTEGER ISTAB1, ISTAB2
      KI =  32513 - I
      KJ =  32513 - J
      VI = GETTAB(KI)
      VJ = GETTAB(KJ)
      IF (.NOT.(VI .LT. VJ))GOTO 23276
      STATUS = -1
      GOTO 23277
23276 CONTINUE
      IF (.NOT.(VI .GT. VJ))GOTO 23278
      STATUS = 1
      GOTO 23279
23278 CONTINUE
      VI = GETTAB(I)
      VJ = GETTAB(J)
      IF (.NOT.(VI .LT. VJ))GOTO 23280
      STATUS = -1
      GOTO 23281
23280 CONTINUE
      IF (.NOT.(VI .GT. VJ))GOTO 23282
      STATUS = 1
      GOTO 23283
23282 CONTINUE
      STATUS = 0
23283 CONTINUE
23281 CONTINUE
23279 CONTINUE
23277 CONTINUE
      CMPINT=(STATUS)
      RETURN
      END