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 TAB
      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)
      COMMON / CTAB / TAB(11000)
      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
      J = 1
23017 IF (.NOT.(J.LT.  11001-J))GOTO 23019
      IF (.NOT.(GETLIN(REVBUF, FDREV) .EQ. -1))GOTO 23020
      GOTO 23019
23020 CONTINUE
      TAB(J) = J
      KEY = HASH(REVBUF)
      TAB( 11001-J) = KEY
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.(TAB( 11001-J) .NE. TAB( 11001-J-1)))GOTO 23027
      TAB(J) = -TAB(J)
23027 CONTINUE
23025 J = J + 1
      GOTO 23024
23026 CONTINUE
      TAB(NNN) = -TAB(NNN)
      I = NNN+3
23029 IF (.NOT.(I .LT.  11001-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 =  11001-MIDPT
      IF (.NOT.(TAB(KMID) .LT. KEY))GOTO 23036
      LOW = MIDPT
      GOTO 23037
23036 CONTINUE
      HIGH = MIDPT
      IF (.NOT.(TAB(KMID) .EQ. KEY))GOTO 23038
      J = MIDPT
23038 CONTINUE
23037 CONTINUE
      GOTO 23034
23035 CONTINUE
      TAB(I) = J
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
      TAB(CAND+ 1) = NNN+2
      TAB(CAND+ 2) = 0
      TAB(CAND+ 0) = NIL
      TAB(K) = CAND
      CAND = CAND+ 3
      TAB(CAND+ 1) = TOTSIZ+1
      TAB(CAND+ 2) = NNN+1
      TAB(CAND+ 0) = NIL
      TAB(K+1) = CAND
      CAND = CAND+ 3
      I = NNN+3
23042 IF (.NOT.(I .LE. TOTSIZ))GOTO 23044
      P = TAB(I)
      IF (.NOT.(P .NE. 0))GOTO 23045
      R = NNN+1
      C = TAB(R)
23047 CONTINUE
      J = IABS(TAB(P))
      LOW = R
      HIGH = K
23050 IF (.NOT.(LOW .LE. HIGH))GOTO 23051
      S = (LOW+HIGH) / 2
      KS = TAB(S)
      IF (.NOT.(TAB(KS+ 2) .GE. J))GOTO 23052
      HIGH = S - 1
      GOTO 23053
23052 CONTINUE
      KS1 = TAB(S+1)
      IF (.NOT.(TAB(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.(TAB(KS1+ 2) .GT. J))GOTO 23058
      TAB(R) = C
      R = S + 1
      IF (.NOT.(CAND .GT.  11001-3 ))GOTO 23060
      CALL ERROR(ST00AZ)
23060 CONTINUE
      TAB(CAND+ 1) = I
      TAB(CAND+ 2) = J
      TAB(CAND+ 0) = KS
      C = CAND
      CAND = CAND+ 3
23058 CONTINUE
      IF (.NOT.(S .EQ. K))GOTO 23062
      TAB(K+2) = TAB(K+1)
      K = K + 1
      GOTO 23049
23062 CONTINUE
23056 CONTINUE
      IF (.NOT.(TAB(P) .LT. 0))GOTO 23064
      GOTO 23049
23064 CONTINUE
      P = P + 1
23065 CONTINUE
23048 GOTO 23047
23049 CONTINUE
      TAB(R) = C
23045 CONTINUE
23043 I = I + 1
      GOTO 23042
23044 CONTINUE
      C = TAB(K)
      I = NNN+3
23066 IF (.NOT.(I .LE. TOTSIZ))GOTO 23068
      TAB(I) = 0
23067 I = I + 1
      GOTO 23066
23068 CONTINUE
      TAB(TOTSIZ+1) = NNN+1
23069 IF (.NOT.(C .NE. NIL))GOTO 23070
      I = TAB(C+ 1)
      J = TAB(C+ 2)
      TAB(I) = J
      C = TAB(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 = TAB(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)
      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
      SUBROUTINE DOSORT(NNN)
      INTEGER NNN
      INTEGER S, LEFT(20), RIGHT(20), L, R, I, J, P, ITEMP, KI, KJ
      INTEGER CMPINT
      INTEGER TAB
      COMMON / CTAB / TAB(11000)
      S = 1
      LEFT(1) = 1
      RIGHT(1) = NNN
23221 CONTINUE
      L = LEFT(S)
      R = RIGHT(S)
      S = S - 1
23224 CONTINUE
      I = L
      J = R
      P = R
23227 CONTINUE
23230 IF (.NOT.(CMPINT(I, P) .LT. 0))GOTO 23231
      I = I + 1
      GOTO 23230
23231 CONTINUE
23232 IF (.NOT.(CMPINT(P, J) .LT. 0))GOTO 23233
      J = J - 1
      GOTO 23232
23233 CONTINUE
      IF (.NOT.(I .LE. J))GOTO 23234
      ITEMP = TAB(I)
      TAB(I) = TAB(J)
      TAB(J) = ITEMP
      KI =  11001 - I
      KJ =  11001 - J
      ITEMP = TAB(KI)
      TAB(KI) = TAB(KJ)
      TAB(KJ) = ITEMP
      I = I + 1
      J = J - 1
23234 CONTINUE
23228 IF (.NOT.(I .GT. J))GOTO 23227
23229 CONTINUE
      IF (.NOT.(J - L .LT. R - I))GOTO 23236
      IF (.NOT.(I .LT. R))GOTO 23238
      S = S + 1
      LEFT(S) = I
      RIGHT(S) = R
23238 CONTINUE
      R = J
      GOTO 23237
23236 CONTINUE
      IF (.NOT.(L .LT. J))GOTO 23240
      S = S + 1
      LEFT(S) = L
      RIGHT(S) = J
23240 CONTINUE
      L = I
23237 CONTINUE
23225 IF (.NOT.(L .GE. R))GOTO 23224
23226 CONTINUE
23222 IF (.NOT.(S .EQ. 0))GOTO 23221
23223 CONTINUE
      RETURN
      END
      INTEGER FUNCTION CMPINT(I, J)
      INTEGER I, J
      INTEGER KI, KJ, VI, VJ, STATUS
      INTEGER TAB
      COMMON / CTAB / TAB(11000)
      KI =  11001 - I
      KJ =  11001 - J
      VI = TAB(KI)
      VJ = TAB(KJ)
      IF (.NOT.(VI .LT. VJ))GOTO 23242
      STATUS = -1
      GOTO 23243
23242 CONTINUE
      IF (.NOT.(VI .GT. VJ))GOTO 23244
      STATUS = 1
      GOTO 23245
23244 CONTINUE
      VI = TAB(I)
      VJ = TAB(J)
      IF (.NOT.(VI .LT. VJ))GOTO 23246
      STATUS = -1
      GOTO 23247
23246 CONTINUE
      IF (.NOT.(VI .GT. VJ))GOTO 23248
      STATUS = 1
      GOTO 23249
23248 CONTINUE
      STATUS = 0
23249 CONTINUE
23247 CONTINUE
23245 CONTINUE
23243 CONTINUE
      CMPINT=(STATUS)
      RETURN
      END