SUBROUTINE MAIN
      LOGICAL*1 ANAME(40)
      INTEGER GETARG, OVRIDE
      LOGICAL*1 COMAND(3)
      COMMON / CARCH / FSTAT(100), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCO
     *L, FILPTR(100), FNAME(1000), OBUF(512)
      INTEGER FSTAT
      INTEGER FCOUNT
      INTEGER ERRCNT
      INTEGER VERBOS
      INTEGER PACKIT
      INTEGER NXTCOL
      INTEGER FILPTR
      LOGICAL*1 FNAME
      LOGICAL*1 OBUF
      COMMON /HDR/ NEW, HDR(5), ASC(4), LOCAL(6), BIN(4), USER(20)
      INTEGER NEW
      LOGICAL*1 HDR
      LOGICAL*1 ASC
      LOGICAL*1 LOCAL
      LOGICAL*1 BIN
      LOGICAL*1 USER
      LOGICAL*1 USESTR(42)
      DATA USESTR(1)/117/,USESTR(2)/115/,USESTR(3)/97/,USESTR(4)/103/,US
     *ESTR(5)/101/,USESTR(6)/58/,USESTR(7)/32/,USESTR(8)/32/,USESTR(9)/9
     *7/,USESTR(10)/114/,USESTR(11)/32/,USESTR(12)/123/,USESTR(13)/100/,
     *USESTR(14)/112/,USESTR(15)/115/,USESTR(16)/116/,USESTR(17)/117/,US
     *ESTR(18)/120/,USESTR(19)/125/,USESTR(20)/91/,USESTR(21)/118/,USEST
     *R(22)/47/,USESTR(23)/49/,USESTR(24)/93/,USESTR(25)/32/,USESTR(26)/
     *97/,USESTR(27)/114/,USESTR(28)/99/,USESTR(29)/110/,USESTR(30)/97/,
     *USESTR(31)/109/,USESTR(32)/101/,USESTR(33)/32/,USESTR(34)/91/,USES
     *TR(35)/102/,USESTR(36)/105/,USESTR(37)/108/,USESTR(38)/101/,USESTR
     *(39)/115/,USESTR(40)/93/,USESTR(41)/46/,USESTR(42)/0/
      DATA ERRCNT /0/
      DATA VERBOS /0/
      DATA HDR /35, 45, 104, 45, 0/
      DATA ASC /97, 115, 99, 0/
      DATA LOCAL /108, 111, 99, 97, 108, 0/
      DATA BIN /98, 105, 110, 0/
      CALL QUERY(USESTR)
      IF (.NOT.( GETARG(1, COMAND, 3) .EQ. -1 .OR. GETARG(2, ANAME, 40) 
     *.EQ. -1))GOTO 23000
      CALL HELP(USESTR)
23000 CONTINUE
      CALL FOLD(COMAND)
      PACKIT = 1
      IF (.NOT.( COMAND(2) .EQ. 118 ))GOTO 23002
      VERBOS = 1
      GOTO 23003
23002 CONTINUE
      IF (.NOT.(COMAND(2) .EQ. 49))GOTO 23004
      PACKIT = 0
23004 CONTINUE
23003 CONTINUE
      CALL INITAR
      CALL GETFNS
      IF (.NOT.( COMAND(1) .EQ. 117 ))GOTO 23006
      CALL UPDATE(ANAME)
      GOTO 23007
23006 CONTINUE
      IF (.NOT.( COMAND(1) .EQ. 116 ))GOTO 23008
      CALL TABLE(ANAME)
      GOTO 23009
23008 CONTINUE
      IF (.NOT.( COMAND(1) .EQ. 120 .OR. COMAND(1) .EQ. 112 ))GOTO 23010
      CALL EXTRAC(ANAME, COMAND(1))
      GOTO 23011
23010 CONTINUE
      IF (.NOT.( COMAND(1) .EQ. 100 ))GOTO 23012
      CALL DELET(ANAME)
      GOTO 23013
23012 CONTINUE
      IF (.NOT.( COMAND(1) .EQ. 115 ))GOTO 23014
      CALL RECOVR(ANAME)
      GOTO 23015
23014 CONTINUE
      CALL HELP(USESTR)
23015 CONTINUE
23013 CONTINUE
23011 CONTINUE
23009 CONTINUE
23007 CONTINUE
      RETURN
      END
      SUBROUTINE ADDFIL(NAME, FD, ERRCT)
      LOGICAL*1 HEAD(512), NAME(100)
      INTEGER OPEN
      INTEGER ERRCT, FD, NFD, SIZE(2), TYPE
      COMMON / CARCH / FSTAT(100), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCO
     *L, FILPTR(100), FNAME(1000), OBUF(512)
      INTEGER FSTAT
      INTEGER FCOUNT
      INTEGER ERRCNT
      INTEGER VERBOS
      INTEGER PACKIT
      INTEGER NXTCOL
      INTEGER FILPTR
      LOGICAL*1 FNAME
      LOGICAL*1 OBUF
      NFD = OPEN(NAME, 1)
      IF (.NOT.( NFD .EQ. -3 ))GOTO 23016
      CALL PUTLIN(2H? , 3)
      CALL PUTLIN(NAME, 3)
      CALL REMARK(12H: can't add.)
      ERRCT = ERRCT + 1
      RETURN
23016 CONTINUE
      CALL GETTYP(NFD, TYPE)
      CALL CLOSE(NFD)
      IF (.NOT.( ERRCT .EQ. 0 ))GOTO 23018
      CALL ARSIZE(NAME, SIZE)
      CALL MAKHDR (NAME, HEAD, SIZE, TYPE)
      IF (.NOT.( VERBOS .EQ. 1 ))GOTO 23020
      CALL PUTLIN (NAME, 2)
      CALL PUTCH (10, 2)
23020 CONTINUE
      NFD = OPEN(NAME,1)
      CALL PUTLIN(HEAD, FD)
      CALL ARCOPY (NFD, FD, SIZE)
      CALL CLOSE(NFD)
23018 CONTINUE
      RETURN
      END
      SUBROUTINE ARCOPY(FDI, FDO, SIZE)
      INTEGER FDI, FDO
      INTEGER SIZE(2), HI, LO
      LOGICAL*1 C
      LOGICAL*1 GETCH
      HI = SIZE(1)
      LO = SIZE(2)
      IF (.NOT.(LO .EQ. 0 .AND. HI .GT. 0))GOTO 23022
      LO = 10000
      HI = HI - 1
23022 CONTINUE
23024 IF (.NOT.(LO .GT. 0))GOTO 23025
      IF (.NOT.(GETCH(C, FDI) .EQ. -1))GOTO 23026
      GOTO 23025
23026 CONTINUE
      IF (.NOT.(FDO .NE. -3))GOTO 23028
      CALL PUTCH(C, FDO)
23028 CONTINUE
      LO = LO - 1
      IF (.NOT.(LO .EQ. 0 .AND. HI .GT. 0))GOTO 23030
      LO = 10000
      HI = HI - 1
23030 CONTINUE
      GOTO 23024
23025 CONTINUE
      RETURN
      END
      SUBROUTINE ARSIZE(FILE, SIZE)
      LOGICAL*1 FILE(40), C
      LOGICAL*1 GETCH
      INTEGER SIZE(2)
      INTEGER INT
      INTEGER OPEN
      INT = OPEN(FILE, 1)
      IF (.NOT.(INT .EQ. -3))GOTO 23032
      SIZE(2) = -3
      GOTO 23033
23032 CONTINUE
      SIZE(1) = 0
      SIZE(2) = 0
23034 IF (.NOT.(GETCH(C, INT) .NE. -1))GOTO 23035
      SIZE(2) = SIZE(2) + 1
      IF (.NOT.(SIZE(2) .GE. 10000))GOTO 23036
      SIZE(1) = SIZE(1) + 1
      SIZE(2) = 0
23036 CONTINUE
      GOTO 23034
23035 CONTINUE
      CALL CLOSE(INT)
23033 CONTINUE
      RETURN
      END
      SUBROUTINE DELET (ANAME)
      LOGICAL*1 ANAME(40), IN(512), TFILE(40)
      INTEGER CREATE, OPEN
      INTEGER AFD, TFD
      COMMON / CARCH / FSTAT(100), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCO
     *L, FILPTR(100), FNAME(1000), OBUF(512)
      INTEGER FSTAT
      INTEGER FCOUNT
      INTEGER ERRCNT
      INTEGER VERBOS
      INTEGER PACKIT
      INTEGER NXTCOL
      INTEGER FILPTR
      LOGICAL*1 FNAME
      LOGICAL*1 OBUF
      LOGICAL*1 TNAME(8)
      DATA TNAME(1)/97/,TNAME(2)/114/,TNAME(3)/99/,TNAME(4)/116/,TNAME(5
     *)/101/,TNAME(6)/109/,TNAME(7)/112/,TNAME(8)/0/
      IF (.NOT.( FCOUNT .LE. 0 ))GOTO 23038
      CALL ERROR(22H? Delete by name only.)
23038 CONTINUE
      AFD = OPEN(ANAME, 1)
      IF (.NOT.( AFD .EQ. -3 ))GOTO 23040
      CALL CANT(ANAME)
23040 CONTINUE
      CALL SCRATF(TNAME, TFILE)
      TFD = CREATE(TFILE, 2)
      IF (.NOT.( TFD .EQ. -3 ))GOTO 23042
      CALL CANT(TFILE)
23042 CONTINUE
      CALL REPLAC(AFD, TFD, 100, ERRCNT)
      CALL NOTFND
      CALL CLOSE(AFD)
      CALL CLOSE(TFD)
      IF (.NOT.( ERRCNT .EQ. 0 ))GOTO 23044
      CALL FMOVE(TFILE, ANAME)
      GOTO 23045
23044 CONTINUE
      CALL REMARK(37H? Fatal errors - archive not altered.)
23045 CONTINUE
      CALL REMOVE(TFILE)
      RETURN
      END
      SUBROUTINE EXTRAC(ANAME, CMD)
      LOGICAL*1 ANAME(40), ENAME(40), IN(512), CMD
      INTEGER CREATE, FILARG, GETHDR, OPEN, EQUAL
      INTEGER AFD, EFD, SIZE(2), TYPE
      COMMON / CARCH / FSTAT(100), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCO
     *L, FILPTR(100), FNAME(1000), OBUF(512)
      INTEGER FSTAT
      INTEGER FCOUNT
      INTEGER ERRCNT
      INTEGER VERBOS
      INTEGER PACKIT
      INTEGER NXTCOL
      INTEGER FILPTR
      LOGICAL*1 FNAME
      LOGICAL*1 OBUF
      COMMON /HDR/ NEW, HDR(5), ASC(4), LOCAL(6), BIN(4), USER(20)
      INTEGER NEW
      LOGICAL*1 HDR
      LOGICAL*1 ASC
      LOGICAL*1 LOCAL
      LOGICAL*1 BIN
      LOGICAL*1 USER
      AFD = OPEN(ANAME, 1)
      IF (.NOT.( AFD .EQ. -3 ))GOTO 23046
      CALL CANT(ANAME)
23046 CONTINUE
      IF (.NOT.( CMD .EQ. 112 ))GOTO 23048
      EFD = 2
      GOTO 23049
23048 CONTINUE
      EFD = -3
23049 CONTINUE
23050 IF (.NOT.( GETHDR(AFD, IN, ENAME, SIZE, TYPE) .NE. -1 ))GOTO 23051
      IF (.NOT.( FILARG(ENAME) .EQ. 0 ))GOTO 23052
      CALL ARCOPY(AFD,-3, SIZE,)
      GOTO 23053
23052 CONTINUE
      IF (.NOT.( EFD .NE. 2 ))GOTO 23054
      EFD = CREATE(ENAME, 2)
23054 CONTINUE
      IF (.NOT.(EFD .EQ. -3))GOTO 23056
      CALL PUTLIN(2H? , 3)
      CALL PUTLIN(ENAME, 3)
      CALL REMARK(15H: can't create.)
      ERRCNT = ERRCNT + 1
      CALL ARCOPY(AFD,-3, SIZE,)
      GOTO 23057
23056 CONTINUE
      IF (.NOT.( VERBOS .EQ. 1 ))GOTO 23058
      CALL PUTLIN(ENAME, 2)
      CALL PUTCH(10, 2)
23058 CONTINUE
      CALL ARCOPY(AFD, EFD, SIZE)
      IF (.NOT.( EFD .NE. 2 ))GOTO 23060
      CALL CLOSE(EFD)
23060 CONTINUE
23057 CONTINUE
23053 CONTINUE
      GOTO 23050
23051 CONTINUE
      CALL NOTFND
      RETURN
      END
      INTEGER FUNCTION FILARG(NAME)
      LOGICAL*1 NAME(100), TEMP(40)
      INTEGER EQUAL
      INTEGER I, J
      COMMON / CARCH / FSTAT(100), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCO
     *L, FILPTR(100), FNAME(1000), OBUF(512)
      INTEGER FSTAT
      INTEGER FCOUNT
      INTEGER ERRCNT
      INTEGER VERBOS
      INTEGER PACKIT
      INTEGER NXTCOL
      INTEGER FILPTR
      LOGICAL*1 FNAME
      LOGICAL*1 OBUF
      IF (.NOT.( FCOUNT .LE. 0 ))GOTO 23062
      FILARG=(1)
      RETURN
23062 CONTINUE
      I = 1 
23064 IF (.NOT.(I .LE. FCOUNT ))GOTO 23066
      J = FILPTR(I)
      CALL SCOPY(FNAME, J, TEMP, 1)
      IF (.NOT.( EQUAL(NAME, TEMP ) .EQ. 1))GOTO 23067
      FSTAT(I) = 1
      FILARG=(1)
      RETURN
23067 CONTINUE
23065 I = I + 1 
      GOTO 23064
23066 CONTINUE
      FILARG=(0)
      RETURN
      END
      SUBROUTINE FMOVE(IN, OUT)
      LOGICAL*1 IN(100), OUT(100)
      INTEGER AMOVE
      LOGICAL*1 STR1(18)
      LOGICAL*1 STR2(5)
      DATA STR1(1)/63/,STR1(2)/32/,STR1(3)/69/,STR1(4)/114/,STR1(5)/114/
     *,STR1(6)/111/,STR1(7)/114/,STR1(8)/32/,STR1(9)/114/,STR1(10)/101/,
     *STR1(11)/110/,STR1(12)/97/,STR1(13)/109/,STR1(14)/105/,STR1(15)/11
     *0/,STR1(16)/103/,STR1(17)/32/,STR1(18)/0/
      DATA STR2(1)/32/,STR2(2)/116/,STR2(3)/111/,STR2(4)/32/,STR2(5)/0/
      IF (.NOT.(AMOVE(IN, OUT) .EQ. -3))GOTO 23069
      CALL PUTLIN(STR1, 3)
      CALL PUTLIN(IN, 3)
      CALL PUTLIN(STR2, 3)
      CALL REMARK(OUT)
23069 CONTINUE
      RETURN
      END
      SUBROUTINE GETFNS
      LOGICAL*1 FILE(40)
      INTEGER EQUAL, GETARG, GETLIN, LENGTH
      INTEGER I, J, K, USEIN
      COMMON / CARCH / FSTAT(100), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCO
     *L, FILPTR(100), FNAME(1000), OBUF(512)
      INTEGER FSTAT
      INTEGER FCOUNT
      INTEGER ERRCNT
      INTEGER VERBOS
      INTEGER PACKIT
      INTEGER NXTCOL
      INTEGER FILPTR
      LOGICAL*1 FNAME
      LOGICAL*1 OBUF
      COMMON / CARTMP / TEMP(512)
      LOGICAL*1 TEMP
      DATA USEIN /0/
      ERRCNT = 0
      J = 1
      I = 1 
23071 IF (.NOT.(I .LE. 100 ))GOTO 23073
      IF (.NOT.( USEIN .EQ. 0 ))GOTO 23074
      IF (.NOT.( GETARG(I+2, TEMP, 40) .EQ. -1 ))GOTO 23076
      GOTO 23073
23076 CONTINUE
      IF (.NOT.( TEMP(1) .EQ. 45 .AND. TEMP(2) .EQ. 0 ))GOTO 23078
      USEIN = 1
23078 CONTINUE
23074 CONTINUE
      IF (.NOT.( USEIN .EQ. 1 ))GOTO 23080
      LEN = GETLIN(TEMP, 1)
      IF (.NOT.( LEN .EQ. -1 ))GOTO 23082
      GOTO 23073
23082 CONTINUE
      TEMP(LEN) = 0
23080 CONTINUE
      CALL FOLD(TEMP)
      LEN = LENGTH(TEMP) + 1
      IF (.NOT.((J + LEN) .GT. 1000))GOTO 23084
      GOTO 23073
23084 CONTINUE
      FILPTR(I) = J
      CALL STCOPY(TEMP, 1, FNAME, J)
      J = J + 1
23072 I = I + 1 
      GOTO 23071
23073 CONTINUE
      FCOUNT = I - 1
      IF (.NOT.( GETARG(I+2, FILE, 40) .NE. -1 ))GOTO 23086
      CALL ERROR(20Htoo many file names.)
23086 CONTINUE
      I = 1 
23088 IF (.NOT.(I .LE. FCOUNT ))GOTO 23090
      FSTAT(I) = 0
23089 I = I + 1 
      GOTO 23088
23090 CONTINUE
      I = 1 
23091 IF (.NOT.(I .LT. FCOUNT ))GOTO 23093
      K = FILPTR(I)
      CALL SCOPY(FNAME, K, FILE, 1)
      J = I + 1 
23094 IF (.NOT.(J .LE. FCOUNT ))GOTO 23096
      K = FILPTR(J)
      CALL SCOPY(FNAME, K, TEMP, 1)
      IF (.NOT.(EQUAL(FILE, TEMP) .EQ. 1))GOTO 23097
      CALL PUTLIN(2H? , 3)
      CALL PUTLIN(FILE, 3)
      CALL ERROR(22H: duplicate file name.)
23097 CONTINUE
23095 J = J + 1 
      GOTO 23094
23096 CONTINUE
23092 I = I + 1 
      GOTO 23091
23093 CONTINUE
      RETURN
      END
      INTEGER FUNCTION GETHDR(FD, BUF, NAME, SIZE, TYPE)
      LOGICAL*1 BUF(512), C, NAME(40), TEMP(40)
      INTEGER CTOI, EQUAL, GETLIN, GETWRD, ISHDR
      INTEGER FD, I, LEN, SIZE(2), TYPE, J
      COMMON /HDR/ NEW, HDR(5), ASC(4), LOCAL(6), BIN(4), USER(20)
      INTEGER NEW
      LOGICAL*1 HDR
      LOGICAL*1 ASC
      LOGICAL*1 LOCAL
      LOGICAL*1 BIN
      LOGICAL*1 USER
      IF (.NOT.( NEW ))GOTO 23099
      GETHDR = -1
      RETURN
23099 CONTINUE
      IF (.NOT.( GETLIN(BUF, FD) .EQ. -1 ))GOTO 23101
      GETHDR = -1
      RETURN
23101 CONTINUE
      CALL FOLD(BUF)
      IF (.NOT.(ISHDR(BUF, I) .EQ. 0))GOTO 23103
      CALL ERROR(31H? Archive not in proper format.)
23103 CONTINUE
      GETHDR = 1
      LEN = GETWRD(BUF, I, NAME)
      CALL CTODI(BUF, I, SIZE)
      LEN = GETWRD (BUF, I, TEMP)
      CALL FOLD(TEMP)
      IF (.NOT.( LEN .LE. 0 .OR. EQUAL(TEMP,ASC) ))GOTO 23105
      TYPE = 12
      GOTO 23106
23105 CONTINUE
      IF (.NOT.( EQUAL(TEMP, LOCAL) ))GOTO 23107
      TYPE = 6
      GOTO 23108
23107 CONTINUE
      IF (.NOT.( EQUAL(TEMP, BIN) ))GOTO 23109
      TYPE = 60
      GOTO 23110
23109 CONTINUE
      TYPE = 12
23110 CONTINUE
23108 CONTINUE
23106 CONTINUE
      RETURN
      END
      SUBROUTINE HELP(MSG)
      LOGICAL*1 MSG(100)
      LOGICAL*1 QSTR(3)
      DATA QSTR(1)/63/,QSTR(2)/32/,QSTR(3)/0/
      CALL PUTLIN(QSTR, 3)
      CALL ERROR(MSG)
      RETURN
      END
      SUBROUTINE INITAR
      INTEGER ISATTY
      COMMON /HDR/ NEW, HDR(5), ASC(4), LOCAL(6), BIN(4), USER(20)
      INTEGER NEW
      LOGICAL*1 HDR
      LOGICAL*1 ASC
      LOGICAL*1 LOCAL
      LOGICAL*1 BIN
      LOGICAL*1 USER
      COMMON / CARCH / FSTAT(100), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCO
     *L, FILPTR(100), FNAME(1000), OBUF(512)
      INTEGER FSTAT
      INTEGER FCOUNT
      INTEGER ERRCNT
      INTEGER VERBOS
      INTEGER PACKIT
      INTEGER NXTCOL
      INTEGER FILPTR
      LOGICAL*1 FNAME
      LOGICAL*1 OBUF
      CALL MAILID(USER)
      IF (.NOT.(PACKIT .EQ. 1))GOTO 23111
      PACKIT = ISATTY(2)
23111 CONTINUE
      IF (.NOT.(VERBOS .EQ. 1))GOTO 23113
      PACKIT = 0
23113 CONTINUE
      RETURN
      END
      INTEGER FUNCTION ISHDR(BUF, I)
      LOGICAL*1 BUF(100)
      INTEGER I
      COMMON /HDR/ NEW, HDR(5), ASC(4), LOCAL(6), BIN(4), USER(20)
      INTEGER NEW
      LOGICAL*1 HDR
      LOGICAL*1 ASC
      LOGICAL*1 LOCAL
      LOGICAL*1 BIN
      LOGICAL*1 USER
      ISHDR = 1
      I=1
23115 IF (.NOT.(HDR(I) .NE. 0))GOTO 23117
      IF (.NOT.(BUF(I) .NE. HDR(I)))GOTO 23118
      ISHDR = 0
      GOTO 23117
23118 CONTINUE
23116 I=I+1
      GOTO 23115
23117 CONTINUE
      IF (.NOT.(ISHDR .EQ. 1))GOTO 23120
      IF (.NOT.(BUF(I) .NE. 32))GOTO 23122
      ISHDR = 0
23122 CONTINUE
23120 CONTINUE
      RETURN
      END
      SUBROUTINE MAKHDR(NAME, HEAD, SIZE, TYPE)
      LOGICAL*1 HEAD(512), NAME(40), FILSIZ(20), DATE(10), TIME(10)
      INTEGER DITOC, LENGTH
      INTEGER SIZE(2), I, TYPE, NOW(7)
      COMMON /HDR/ NEW, HDR(5), ASC(4), LOCAL(6), BIN(4), USER(20)
      INTEGER NEW
      LOGICAL*1 HDR
      LOGICAL*1 ASC
      LOGICAL*1 LOCAL
      LOGICAL*1 BIN
      LOGICAL*1 USER
      COMMON / CARCH / FSTAT(100), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCO
     *L, FILPTR(100), FNAME(1000), OBUF(512)
      INTEGER FSTAT
      INTEGER FCOUNT
      INTEGER ERRCNT
      INTEGER VERBOS
      INTEGER PACKIT
      INTEGER NXTCOL
      INTEGER FILPTR
      LOGICAL*1 FNAME
      LOGICAL*1 OBUF
      LOGICAL*1 TWOBLK(3)
      DATA TWOBLK(1)/32/,TWOBLK(2)/32/,TWOBLK(3)/0/
      I = 1
      CALL STCOPY(HDR, 1, HEAD, I)
      CALL CHCOPY(32, HEAD, I)
      CALL STCOPY(NAME, 1, HEAD, I)
      IF (.NOT.( SIZE(2) .EQ. -3 ))GOTO 23124
      FILSIZ(1) = 0
      ERRCNT = ERRCNT + 1
      GOTO 23125
23124 CONTINUE
      JUNK = DITOC(SIZE, FILSIZ, 20)
23125 CONTINUE
      N = 20 - LENGTH(FILSIZ) - LENGTH(NAME)
      J=1
23126 IF (.NOT.(J .LT. N))GOTO 23128
      CALL CHCOPY(32, HEAD, I)
23127 J=J+1
      GOTO 23126
23128 CONTINUE
      CALL CHCOPY(32, HEAD, I)
      CALL STCOPY(FILSIZ, 1, HEAD, I)
      CALL STCOPY(TWOBLK, 1, HEAD, I)
      IF (.NOT.( TYPE .EQ. 12 ))GOTO 23129
      CALL STCOPY(ASC, 1, HEAD, I)
      GOTO 23130
23129 CONTINUE
      IF (.NOT.( TYPE .EQ. 6 ))GOTO 23131
      CALL STCOPY(LOCAL, 1, HEAD, I)
      GOTO 23132
23131 CONTINUE
      IF (.NOT.( TYPE .EQ. 60 ))GOTO 23133
      CALL STCOPY(BIN, 1, HEAD, I)
23133 CONTINUE
23132 CONTINUE
23130 CONTINUE
      CALL STCOPY(TWOBLK, 1, HEAD, I)
      CALL GETNOW(NOW)
      CALL FMTDAT(DATE, TIME, NOW, 1)
      CALL STCOPY(DATE, 1, HEAD, I)
      CALL CHCOPY(32, HEAD, I)
      CALL STCOPY(TIME, 1, HEAD, I)
      CALL STCOPY(TWOBLK, 1, HEAD, I)
      CALL STCOPY(USER, 1, HEAD, I)
      CALL CHCOPY(10, HEAD, I)
      CALL FOLD(HEAD)
      RETURN
      END
      SUBROUTINE NOTFND
      INTEGER I, J
      LOGICAL*1 TEMP(40)
      COMMON / CARCH / FSTAT(100), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCO
     *L, FILPTR(100), FNAME(1000), OBUF(512)
      INTEGER FSTAT
      INTEGER FCOUNT
      INTEGER ERRCNT
      INTEGER VERBOS
      INTEGER PACKIT
      INTEGER NXTCOL
      INTEGER FILPTR
      LOGICAL*1 FNAME
      LOGICAL*1 OBUF
      I = 1 
23135 IF (.NOT.(I .LE. FCOUNT ))GOTO 23137
      IF (.NOT.(FSTAT(I) .EQ. 0 ))GOTO 23138
      J = FILPTR(I)
      CALL SCOPY(FNAME, J, TEMP, 1)
      CALL PUTLIN(2H? , 3)
      CALL PUTLIN(TEMP, 3)
      CALL REMARK(17H: not in archive.)
      ERRCNT = ERRCNT + 1
23138 CONTINUE
23136 I = I + 1 
      GOTO 23135
23137 CONTINUE
      RETURN
      END
      INTEGER FUNCTION NXTFL(NAME, AFD)
      LOGICAL*1 NAME(100), HOLDNM(40), BUF(512)
      INTEGER CREATE, GETLIN, EQUAL, ISHDR
      INTEGER AFD, I
      COMMON /HDR/ NEW, HDR(5), ASC(4), LOCAL(6), BIN(4), USER(20)
      INTEGER NEW
      LOGICAL*1 HDR
      LOGICAL*1 ASC
      LOGICAL*1 LOCAL
      LOGICAL*1 BIN
      LOGICAL*1 USER
      DATA HOLDNM(1) /0/
      I = AFD
      IF (.NOT.( HOLDNM(1) .EQ. 0 ))GOTO 23140
      IF (.NOT.( GETLIN(BUF, AFD) .EQ. -1 ))GOTO 23142
      NXTFL = -1
      RETURN
23142 CONTINUE
      IF (.NOT.(ISHDR(BUF, I) .EQ. 0))GOTO 23144
      CALL ERROR (31H? Archive not in proper format.)
23144 CONTINUE
      LEN = GETWRD(BUF, I, HOLDNM)
23140 CONTINUE
      CALL SCOPY(HOLDNM, 1, NAME, 1)
      HOLDNM(1) = 0
      INT = CREATE(NAME, 2)
      IF (.NOT.( INT .EQ. -3 ))GOTO 23146
      CALL CANT(NAME)
23146 CONTINUE
23148 IF (.NOT.( GETLIN(BUF, AFD) .NE. -1 ))GOTO 23149
      IF (.NOT.(ISHDR(BUF, I) .EQ. 1))GOTO 23150
      LEN = GETWRD(BUF, I, HOLDNM)
      GOTO 23149
23150 CONTINUE
      CALL PUTLIN(BUF, INT)
      GOTO 23148
23149 CONTINUE
      CALL CLOSE(INT)
      NXTFL = 0
      RETURN
      END
      SUBROUTINE RECOVR (ANAME)
      INTEGER CREATE, OPEN, NXTFL
      INTEGER AFD, TFD
      LOGICAL*1 ANAME(100), TFILE(40), NAME(40)
      COMMON / CARCH / FSTAT(100), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCO
     *L, FILPTR(100), FNAME(1000), OBUF(512)
      INTEGER FSTAT
      INTEGER FCOUNT
      INTEGER ERRCNT
      INTEGER VERBOS
      INTEGER PACKIT
      INTEGER NXTCOL
      INTEGER FILPTR
      LOGICAL*1 FNAME
      LOGICAL*1 OBUF
      LOGICAL*1 TNAME(8)
      DATA TNAME(1)/97/,TNAME(2)/114/,TNAME(3)/99/,TNAME(4)/116/,TNAME(5
     *)/101/,TNAME(6)/109/,TNAME(7)/112/,TNAME(8)/0/
      AFD = OPEN(ANAME, 1)
      IF (.NOT.( AFD .EQ. -3 ))GOTO 23152
      CALL CANT(ANAME)
23152 CONTINUE
      CALL SCRATF (TNAME, TFILE)
      TFD = CREATE(TFILE, 2)
      IF (.NOT.( TFD .EQ. -3 ))GOTO 23154
      CALL CANT(TFILE)
23154 CONTINUE
23156 IF (.NOT.( NXTFL(NAME, AFD) .NE. -1 ))GOTO 23157
      CALL ADDFIL(NAME, TFD, ERRCNT)
      CALL REMOVE(NAME)
      GOTO 23156
23157 CONTINUE
      CALL CLOSE(AFD)
      CALL CLOSE(TFD)
      IF (.NOT.( ERRCNT .EQ. 0 ))GOTO 23158
      CALL FMOVE(TFILE, ANAME)
      GOTO 23159
23158 CONTINUE
      CALL REMARK(37H? Fatal errors - archive not altered.)
23159 CONTINUE
      CALL REMOVE (TFILE)
      RETURN
      END
      SUBROUTINE REPLAC(AFD, TFD, CMD, ERRCT)
      LOGICAL*1 IN(512), UNAME(40)
      INTEGER FILARG, GETHDR
      INTEGER AFD, CMD, ERRCT, SIZE(2), TFD, TYPE
      COMMON / CARCH / FSTAT(100), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCO
     *L, FILPTR(100), FNAME(1000), OBUF(512)
      INTEGER FSTAT
      INTEGER FCOUNT
      INTEGER ERRCNT
      INTEGER VERBOS
      INTEGER PACKIT
      INTEGER NXTCOL
      INTEGER FILPTR
      LOGICAL*1 FNAME
      LOGICAL*1 OBUF
23160 IF (.NOT.( GETHDR(AFD, IN, UNAME, SIZE, TYPE) .NE. -1 ))GOTO 23161
      IF (.NOT.( FILARG(UNAME) .EQ. 1 ))GOTO 23162
      IF (.NOT.( CMD .EQ. 117 ))GOTO 23164
      CALL ADDFIL(UNAME, TFD, ERRCT)
23164 CONTINUE
      IF (.NOT.( VERBOS .EQ. 1 .AND. CMD .EQ. 100))GOTO 23166
      CALL PUTLIN (UNAME, 2)
      CALL PUTCH (10, 2)
23166 CONTINUE
      CALL ARCOPY(AFD,-3, SIZE,)
      GOTO 23163
23162 CONTINUE
      CALL PUTLIN(IN, TFD)
      CALL ARCOPY(AFD, TFD, SIZE)
23163 CONTINUE
      GOTO 23160
23161 CONTINUE
      RETURN
      END
      SUBROUTINE TABLE(ANAME)
      LOGICAL*1 ANAME(40), IN(512), LNAME(40)
      INTEGER FILARG, GETHDR, OPEN
      INTEGER AFD, SIZE(2), TYPE
      COMMON / CARCH / FSTAT(100), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCO
     *L, FILPTR(100), FNAME(1000), OBUF(512)
      INTEGER FSTAT
      INTEGER FCOUNT
      INTEGER ERRCNT
      INTEGER VERBOS
      INTEGER PACKIT
      INTEGER NXTCOL
      INTEGER FILPTR
      LOGICAL*1 FNAME
      LOGICAL*1 OBUF
      AFD = OPEN(ANAME, 1)
      IF (.NOT.( AFD .EQ. -3 ))GOTO 23168
      CALL CANT(ANAME)
23168 CONTINUE
      IF (.NOT.(PACKIT .EQ. 1))GOTO 23170
      CALL INPACK(NXTCOL, 80, OBUF, 2)
23170 CONTINUE
23172 IF (.NOT.( GETHDR(AFD, IN, LNAME, SIZE, TYPE) .NE. -1 ))GOTO 23173
      IF (.NOT.( FILARG(LNAME) .EQ. 1 ))GOTO 23174
      CALL TPRINT(IN)
23174 CONTINUE
      CALL ARCOPY( AFD,-3, SIZE,)
      GOTO 23172
23173 CONTINUE
      IF (.NOT.(PACKIT .EQ. 1))GOTO 23176
      CALL FLPACK(NXTCOL, 80, OBUF, 2)
23176 CONTINUE
      CALL NOTFND
      RETURN
      END
      SUBROUTINE TPRINT(BUF)
      INTEGER I, J
      LOGICAL*1 BUF(100), NAME(40)
      COMMON / CARCH / FSTAT(100), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCO
     *L, FILPTR(100), FNAME(1000), OBUF(512)
      INTEGER FSTAT
      INTEGER FCOUNT
      INTEGER ERRCNT
      INTEGER VERBOS
      INTEGER PACKIT
      INTEGER NXTCOL
      INTEGER FILPTR
      LOGICAL*1 FNAME
      LOGICAL*1 OBUF
      I=1 
23178 IF (.NOT.(BUF(I) .NE. 32 ))GOTO 23180
23179 I=I+1
      GOTO 23178
23180 CONTINUE
      J = 1
      I=I+1 
23181 IF (.NOT.(BUF(I) .NE. 32 ))GOTO 23183
      CALL CHCOPY(BUF(I), NAME, J)
23182 I=I+1 
      GOTO 23181
23183 CONTINUE
      NAME(J) = 0
      IF (.NOT.(PACKIT .EQ. 1))GOTO 23184
      CALL DOPACK(NAME, NXTCOL, 80, OBUF, 2)
      GOTO 23185
23184 CONTINUE
      CALL PUTLIN(NAME, 2)
      IF (.NOT.(VERBOS .EQ. 1))GOTO 23186
      CALL PUTLIN(BUF(I), 2)
      GOTO 23187
23186 CONTINUE
      CALL PUTCH(10, 2)
23187 CONTINUE
23185 CONTINUE
      RETURN
      END
      SUBROUTINE UPDATE(ANAME)
      LOGICAL*1 ANAME(40), TFILE(40)
      INTEGER CREATE, GETARG, OPEN
      INTEGER AFD, I, TFD, J
      COMMON / CARCH / FSTAT(100), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCO
     *L, FILPTR(100), FNAME(1000), OBUF(512)
      INTEGER FSTAT
      INTEGER FCOUNT
      INTEGER ERRCNT
      INTEGER VERBOS
      INTEGER PACKIT
      INTEGER NXTCOL
      INTEGER FILPTR
      LOGICAL*1 FNAME
      LOGICAL*1 OBUF
      COMMON /HDR/ NEW, HDR(5), ASC(4), LOCAL(6), BIN(4), USER(20)
      INTEGER NEW
      LOGICAL*1 HDR
      LOGICAL*1 ASC
      LOGICAL*1 LOCAL
      LOGICAL*1 BIN
      LOGICAL*1 USER
      COMMON / CARTMP / TEMP(512)
      LOGICAL*1 TEMP
      LOGICAL*1 TNAME(8)
      DATA TNAME(1)/97/,TNAME(2)/114/,TNAME(3)/99/,TNAME(4)/116/,TNAME(5
     *)/101/,TNAME(6)/109/,TNAME(7)/112/,TNAME(8)/0/
      AFD = OPEN(ANAME, 1)
      IF (.NOT.( AFD .EQ. -3 ))GOTO 23188
      AFD = CREATE(ANAME, 2)
      IF (.NOT.( AFD .EQ. -3 ))GOTO 23190
      CALL CANT(ANAME)
23190 CONTINUE
      NEW = 1
      GOTO 23189
23188 CONTINUE
      NEW = 0
23189 CONTINUE
      CALL CLOSE(1)
      CALL SCRATF(TNAME, TFILE)
      TFD = CREATE(TFILE, 2)
      IF (.NOT.( TFD .EQ. -3 ))GOTO 23192
      CALL CANT(TFILE)
23192 CONTINUE
      CALL REPLAC(AFD, TFD, 117, ERRCNT)
      I = 1 
23194 IF (.NOT.(I .LE. FCOUNT ))GOTO 23196
      IF (.NOT.( FSTAT(I) .EQ. 0 ))GOTO 23197
      J = FILPTR(I)
      CALL SCOPY(FNAME, J, TEMP, 1)
      CALL ADDFIL(TEMP, TFD, ERRCNT)
      FSTAT(I) = 1
23197 CONTINUE
23195 I = I + 1 
      GOTO 23194
23196 CONTINUE
      CALL CLOSE(AFD)
      CALL CLOSE(TFD)
      IF (.NOT.( ERRCNT .EQ. 0 ))GOTO 23199
      CALL FMOVE(TFILE, ANAME)
      GOTO 23200
23199 CONTINUE
      CALL REMARK(37H? Fatal errors - archive not altered.)
23200 CONTINUE
      CALL REMOVE(TFILE)
      RETURN
      END