      SUBROUTINE MAIN
      LOGICAL*1 ANAME(40)
      INTEGER GETARG, OVRIDE
      LOGICAL*1 COMAND(3)
      COMMON / CARCH / FSTAT(256), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCO
     *L, FILPTR(256), FNAME(2560), 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(40)
      INTEGER NEW
      LOGICAL*1 HDR
      LOGICAL*1 ASC
      LOGICAL*1 LOCAL
      LOGICAL*1 BIN
      LOGICAL*1 USER
      LOGICAL*1 USESTR(44)
      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)/93/,USESTR(40)/32/,USESTR(41)/46/,USESTR(42)/46/,USESTR(43)/4
     *6/,USESTR(44)/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(256), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCO
     *L, FILPTR(256), FNAME(2560), 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), INCS(2), TSIZE(2)
      LOGICAL*1 LIN(512)
      INTEGER GETLIN
      TSIZE(1) = SIZE(1)
      TSIZE(2) = SIZE(2)
      INCS(1) = 0
23022 IF (.NOT.(.NOT.(TSIZE(1) .LE. 0 .AND. TSIZE(2) .LE. 0)))GOTO 23023
      INCS(2) = GETLIN( LIN, FDI)
      IF (.NOT.( INCS(2) .EQ. -1 ))GOTO 23024
      GOTO 23023
23024 CONTINUE
      IF (.NOT.( FDO .NE. -3 ))GOTO 23026
      CALL PUTLIN( LIN, FDO)
23026 CONTINUE
      TSIZE(1) = TSIZE(1) - INCS(1)
      TSIZE(2) = TSIZE(2) - INCS(2)
      IF (.NOT.( TSIZE(2) .LT. 0))GOTO 23028
      TSIZE(1) = TSIZE(1) - 1
      TSIZE(2) = TSIZE(2) + 10000
23028 CONTINUE
      GOTO 23022
23023 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 23030
      SIZE(2) = -3
      GOTO 23031
23030 CONTINUE
      SIZE(1) = 0
      SIZE(2) = 0
23032 IF (.NOT.(GETCH(C, INT) .NE. -1))GOTO 23033
      SIZE(2) = SIZE(2) + 1
      IF (.NOT.(SIZE(2) .GE. 10000))GOTO 23034
      SIZE(1) = SIZE(1) + 1
      SIZE(2) = 0
23034 CONTINUE
      GOTO 23032
23033 CONTINUE
      CALL CLOSE(INT)
23031 CONTINUE
      RETURN
      END
      SUBROUTINE DELET (ANAME)
      LOGICAL*1 ANAME(40), IN(512), TFILE(40)
      INTEGER CREATE, OPEN, REMOVE
      INTEGER AFD, TFD, JUNK
      COMMON / CARCH / FSTAT(256), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCO
     *L, FILPTR(256), FNAME(2560), 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 23036
      CALL ERROR(22H? Delete by name only.)
23036 CONTINUE
      AFD = OPEN(ANAME, 1)
      IF (.NOT.( AFD .EQ. -3 ))GOTO 23038
      CALL CANT(ANAME)
23038 CONTINUE
      CALL SCRATF(TNAME, TFILE)
      TFD = CREATE(TFILE, 2)
      IF (.NOT.( TFD .EQ. -3 ))GOTO 23040
      CALL CANT(TFILE)
23040 CONTINUE
      CALL REPLAC(AFD, TFD, 100, ERRCNT)
      CALL NOTFND
      CALL CLOSE(AFD)
      CALL CLOSE(TFD)
      IF (.NOT.( ERRCNT .EQ. 0 ))GOTO 23042
      CALL FMOVE(TFILE, ANAME)
      GOTO 23043
23042 CONTINUE
      CALL REMARK(37H? Fatal errors - archive not altered.)
23043 CONTINUE
      JUNK = 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(256), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCO
     *L, FILPTR(256), FNAME(2560), 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(40)
      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 23044
      CALL CANT(ANAME)
23044 CONTINUE
      IF (.NOT.( CMD .EQ. 112 ))GOTO 23046
      EFD = 2
      GOTO 23047
23046 CONTINUE
      EFD = -3
23047 CONTINUE
23048 IF (.NOT.( GETHDR(AFD, IN, ENAME, SIZE, TYPE) .NE. -1 ))GOTO 23049
      IF (.NOT.( FILARG(ENAME) .EQ. 0 ))GOTO 23050
      CALL ARCOPY(AFD,-3, SIZE)
      GOTO 23051
23050 CONTINUE
      IF (.NOT.( EFD .NE. 2 ))GOTO 23052
      EFD = CREATE(ENAME, 2)
23052 CONTINUE
      IF (.NOT.(EFD .EQ. -3))GOTO 23054
      CALL PUTLIN(2H? , 3)
      CALL PUTLIN(ENAME, 3)
      CALL REMARK(15H: can't create.)
      ERRCNT = ERRCNT + 1
      CALL ARCOPY(AFD,-3, SIZE)
      GOTO 23055
23054 CONTINUE
      IF (.NOT.( VERBOS .EQ. 1 ))GOTO 23056
      CALL PUTLIN(ENAME, 2)
      CALL PUTCH(10, 2)
23056 CONTINUE
      CALL ARCOPY(AFD, EFD, SIZE)
      IF (.NOT.( EFD .NE. 2 ))GOTO 23058
      CALL CLOSE(EFD)
23058 CONTINUE
23055 CONTINUE
23051 CONTINUE
      GOTO 23048
23049 CONTINUE
      CALL NOTFND
      RETURN
      END
      INTEGER FUNCTION FILARG(NAME)
      LOGICAL*1 NAME(100), TEMP(40)
      INTEGER EQUAL
      INTEGER I, J
      COMMON / CARCH / FSTAT(256), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCO
     *L, FILPTR(256), FNAME(2560), 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 23060
      FILARG=(1)
      RETURN
23060 CONTINUE
      I = 1 
23062 IF (.NOT.(I .LE. FCOUNT ))GOTO 23064
      J = FILPTR(I)
      CALL SCOPY(FNAME, J, TEMP, 1)
      IF (.NOT.( EQUAL(NAME, TEMP ) .EQ. 1))GOTO 23065
      FSTAT(I) = 1
      FILARG=(1)
      RETURN
23065 CONTINUE
23063 I = I + 1 
      GOTO 23062
23064 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 23067
      CALL PUTLIN(STR1, 3)
      CALL PUTLIN(IN, 3)
      CALL PUTLIN(STR2, 3)
      CALL REMARK(OUT)
23067 CONTINUE
      RETURN
      END
      SUBROUTINE GETFNS
      LOGICAL*1 FILE(40)
      INTEGER EQUAL, GETARG, GETLIN, LENGTH
      INTEGER I, J, K, USEIN
      COMMON / CARCH / FSTAT(256), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCO
     *L, FILPTR(256), FNAME(2560), 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 
23069 IF (.NOT.(I .LE. 256 ))GOTO 23071
      IF (.NOT.( USEIN .EQ. 0 ))GOTO 23072
      IF (.NOT.( GETARG(I+2, TEMP, 40) .EQ. -1 ))GOTO 23074
      GOTO 23071
23074 CONTINUE
      IF (.NOT.( TEMP(1) .EQ. 45 .AND. TEMP(2) .EQ. 0 ))GOTO 23076
      USEIN = 1
23076 CONTINUE
23072 CONTINUE
      IF (.NOT.( USEIN .EQ. 1 ))GOTO 23078
      LEN = GETLIN(TEMP, 1)
      IF (.NOT.( LEN .EQ. -1 ))GOTO 23080
      GOTO 23071
23080 CONTINUE
      TEMP(LEN) = 0
23078 CONTINUE
      CALL FOLD(TEMP)
      LEN = LENGTH(TEMP) + 1
      IF (.NOT.((J + LEN) .GT. 2560))GOTO 23082
      GOTO 23071
23082 CONTINUE
      FILPTR(I) = J
      CALL STCOPY(TEMP, 1, FNAME, J)
      J = J + 1
23070 I = I + 1 
      GOTO 23069
23071 CONTINUE
      FCOUNT = I - 1
      IF (.NOT.( GETARG(I+2, FILE, 40) .NE. -1 ))GOTO 23084
      CALL ERROR(20Htoo many file names.)
23084 CONTINUE
      I = 1 
23086 IF (.NOT.(I .LE. FCOUNT ))GOTO 23088
      FSTAT(I) = 0
23087 I = I + 1 
      GOTO 23086
23088 CONTINUE
      I = 1 
23089 IF (.NOT.(I .LT. FCOUNT ))GOTO 23091
      K = FILPTR(I)
      CALL SCOPY(FNAME, K, FILE, 1)
      J = I + 1 
23092 IF (.NOT.(J .LE. FCOUNT ))GOTO 23094
      K = FILPTR(J)
      CALL SCOPY(FNAME, K, TEMP, 1)
      IF (.NOT.(EQUAL(FILE, TEMP) .EQ. 1))GOTO 23095
      CALL PUTLIN(2H? , 3)
      CALL PUTLIN(FILE, 3)
      CALL ERROR(22H: duplicate file name.)
23095 CONTINUE
23093 J = J + 1 
      GOTO 23092
23094 CONTINUE
23090 I = I + 1 
      GOTO 23089
23091 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(40)
      INTEGER NEW
      LOGICAL*1 HDR
      LOGICAL*1 ASC
      LOGICAL*1 LOCAL
      LOGICAL*1 BIN
      LOGICAL*1 USER
      IF (.NOT.( NEW ))GOTO 23097
      GETHDR = -1
      RETURN
23097 CONTINUE
      IF (.NOT.( GETLIN(BUF, FD) .EQ. -1 ))GOTO 23099
      GETHDR = -1
      RETURN
23099 CONTINUE
      CALL FOLD(BUF)
      IF (.NOT.(ISHDR(BUF, I) .EQ. 0))GOTO 23101
      CALL ERROR(31H? Archive not in proper format.)
23101 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 23103
      TYPE = 12
      GOTO 23104
23103 CONTINUE
      IF (.NOT.( EQUAL(TEMP, LOCAL) ))GOTO 23105
      TYPE = 6
      GOTO 23106
23105 CONTINUE
      IF (.NOT.( EQUAL(TEMP, BIN) ))GOTO 23107
      TYPE = 60
      GOTO 23108
23107 CONTINUE
      TYPE = 12
23108 CONTINUE
23106 CONTINUE
23104 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(40)
      INTEGER NEW
      LOGICAL*1 HDR
      LOGICAL*1 ASC
      LOGICAL*1 LOCAL
      LOGICAL*1 BIN
      LOGICAL*1 USER
      COMMON / CARCH / FSTAT(256), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCO
     *L, FILPTR(256), FNAME(2560), 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 23109
      PACKIT = ISATTY(2)
23109 CONTINUE
      IF (.NOT.(VERBOS .EQ. 1))GOTO 23111
      PACKIT = 0
23111 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(40)
      INTEGER NEW
      LOGICAL*1 HDR
      LOGICAL*1 ASC
      LOGICAL*1 LOCAL
      LOGICAL*1 BIN
      LOGICAL*1 USER
      ISHDR = 1
      I=1
23113 IF (.NOT.(HDR(I) .NE. 0))GOTO 23115
      IF (.NOT.(BUF(I) .NE. HDR(I)))GOTO 23116
      ISHDR = 0
      GOTO 23115
23116 CONTINUE
23114 I=I+1
      GOTO 23113
23115 CONTINUE
      IF (.NOT.(ISHDR .EQ. 1))GOTO 23118
      IF (.NOT.(BUF(I) .NE. 32))GOTO 23120
      ISHDR = 0
23120 CONTINUE
23118 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(40)
      INTEGER NEW
      LOGICAL*1 HDR
      LOGICAL*1 ASC
      LOGICAL*1 LOCAL
      LOGICAL*1 BIN
      LOGICAL*1 USER
      COMMON / CARCH / FSTAT(256), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCO
     *L, FILPTR(256), FNAME(2560), 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 23122
      FILSIZ(1) = 0
      ERRCNT = ERRCNT + 1
      GOTO 23123
23122 CONTINUE
      JUNK = DITOC(SIZE, FILSIZ, 20)
23123 CONTINUE
      N = 20 - LENGTH(FILSIZ) - LENGTH(NAME)
      J=1
23124 IF (.NOT.(J .LT. N))GOTO 23126
      CALL CHCOPY(32, HEAD, I)
23125 J=J+1
      GOTO 23124
23126 CONTINUE
      CALL CHCOPY(32, HEAD, I)
      CALL STCOPY(FILSIZ, 1, HEAD, I)
      CALL STCOPY(TWOBLK, 1, HEAD, I)
      IF (.NOT.( TYPE .EQ. 12 ))GOTO 23127
      CALL STCOPY(ASC, 1, HEAD, I)
      GOTO 23128
23127 CONTINUE
      IF (.NOT.( TYPE .EQ. 6 ))GOTO 23129
      CALL STCOPY(LOCAL, 1, HEAD, I)
      GOTO 23130
23129 CONTINUE
      IF (.NOT.( TYPE .EQ. 60 ))GOTO 23131
      CALL STCOPY(BIN, 1, HEAD, I)
23131 CONTINUE
23130 CONTINUE
23128 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(256), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCO
     *L, FILPTR(256), FNAME(2560), OBUF(512)
      INTEGER FSTAT
      INTEGER FCOUNT
      INTEGER ERRCNT
      INTEGER VERBOS
      INTEGER PACKIT
      INTEGER NXTCOL
      INTEGER FILPTR
      LOGICAL*1 FNAME
      LOGICAL*1 OBUF
      I = 1 
23133 IF (.NOT.(I .LE. FCOUNT ))GOTO 23135
      IF (.NOT.(FSTAT(I) .EQ. 0 ))GOTO 23136
      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
23136 CONTINUE
23134 I = I + 1 
      GOTO 23133
23135 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(40)
      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 23138
      IF (.NOT.( GETLIN(BUF, AFD) .EQ. -1 ))GOTO 23140
      NXTFL = -1
      RETURN
23140 CONTINUE
      IF (.NOT.(ISHDR(BUF, I) .EQ. 0))GOTO 23142
      CALL ERROR (31H? Archive not in proper format.)
23142 CONTINUE
      LEN = GETWRD(BUF, I, HOLDNM)
23138 CONTINUE
      CALL SCOPY(HOLDNM, 1, NAME, 1)
      HOLDNM(1) = 0
      INT = CREATE(NAME, 2)
      IF (.NOT.( INT .EQ. -3 ))GOTO 23144
      CALL CANT(NAME)
23144 CONTINUE
23146 IF (.NOT.( GETLIN(BUF, AFD) .NE. -1 ))GOTO 23147
      IF (.NOT.(ISHDR(BUF, I) .EQ. 1))GOTO 23148
      LEN = GETWRD(BUF, I, HOLDNM)
      GOTO 23147
23148 CONTINUE
      CALL PUTLIN(BUF, INT)
      GOTO 23146
23147 CONTINUE
      CALL CLOSE(INT)
      NXTFL = 0
      RETURN
      END
      SUBROUTINE RECOVR (ANAME)
      INTEGER CREATE, OPEN, NXTFL, REMOVE
      INTEGER AFD, TFD, JUNK
      LOGICAL*1 ANAME(100), TFILE(40), NAME(40)
      COMMON / CARCH / FSTAT(256), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCO
     *L, FILPTR(256), FNAME(2560), 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 23150
      CALL CANT(ANAME)
23150 CONTINUE
      CALL SCRATF (TNAME, TFILE)
      TFD = CREATE(TFILE, 2)
      IF (.NOT.( TFD .EQ. -3 ))GOTO 23152
      CALL CANT(TFILE)
23152 CONTINUE
23154 IF (.NOT.( NXTFL(NAME, AFD) .NE. -1 ))GOTO 23155
      CALL ADDFIL(NAME, TFD, ERRCNT)
      JUNK = REMOVE(NAME)
      GOTO 23154
23155 CONTINUE
      CALL CLOSE(AFD)
      CALL CLOSE(TFD)
      IF (.NOT.( ERRCNT .EQ. 0 ))GOTO 23156
      CALL FMOVE(TFILE, ANAME)
      GOTO 23157
23156 CONTINUE
      CALL REMARK(37H? Fatal errors - archive not altered.)
23157 CONTINUE
      JUNK = 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(256), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCO
     *L, FILPTR(256), FNAME(2560), OBUF(512)
      INTEGER FSTAT
      INTEGER FCOUNT
      INTEGER ERRCNT
      INTEGER VERBOS
      INTEGER PACKIT
      INTEGER NXTCOL
      INTEGER FILPTR
      LOGICAL*1 FNAME
      LOGICAL*1 OBUF
23158 IF (.NOT.( GETHDR(AFD, IN, UNAME, SIZE, TYPE) .NE. -1 ))GOTO 23159
      IF (.NOT.( FILARG(UNAME) .EQ. 1 ))GOTO 23160
      IF (.NOT.( CMD .EQ. 117 ))GOTO 23162
      CALL ADDFIL(UNAME, TFD, ERRCT)
23162 CONTINUE
      IF (.NOT.( VERBOS .EQ. 1 .AND. CMD .EQ. 100))GOTO 23164
      CALL PUTLIN (UNAME, 2)
      CALL PUTCH (10, 2)
23164 CONTINUE
      CALL ARCOPY(AFD,-3, SIZE)
      GOTO 23161
23160 CONTINUE
      CALL PUTLIN(IN, TFD)
      CALL ARCOPY(AFD, TFD, SIZE)
23161 CONTINUE
      GOTO 23158
23159 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(256), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCO
     *L, FILPTR(256), FNAME(2560), 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 23166
      CALL CANT(ANAME)
23166 CONTINUE
      IF (.NOT.(PACKIT .EQ. 1))GOTO 23168
      CALL INPACK(NXTCOL, 80, OBUF, 2)
23168 CONTINUE
23170 IF (.NOT.( GETHDR(AFD, IN, LNAME, SIZE, TYPE) .NE. -1 ))GOTO 23171
      IF (.NOT.( FILARG(LNAME) .EQ. 1 ))GOTO 23172
      CALL TPRINT(IN)
23172 CONTINUE
      CALL ARCOPY( AFD,-3, SIZE)
      GOTO 23170
23171 CONTINUE
      IF (.NOT.(PACKIT .EQ. 1))GOTO 23174
      CALL FLPACK(NXTCOL, 80, OBUF, 2)
23174 CONTINUE
      CALL NOTFND
      RETURN
      END
      SUBROUTINE TPRINT(BUF)
      INTEGER I, J
      LOGICAL*1 BUF(100), NAME(40)
      COMMON / CARCH / FSTAT(256), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCO
     *L, FILPTR(256), FNAME(2560), OBUF(512)
      INTEGER FSTAT
      INTEGER FCOUNT
      INTEGER ERRCNT
      INTEGER VERBOS
      INTEGER PACKIT
      INTEGER NXTCOL
      INTEGER FILPTR
      LOGICAL*1 FNAME
      LOGICAL*1 OBUF
      I=1 
23176 IF (.NOT.(BUF(I) .NE. 32 ))GOTO 23178
23177 I=I+1
      GOTO 23176
23178 CONTINUE
      J = 1
      I=I+1 
23179 IF (.NOT.(BUF(I) .NE. 32 ))GOTO 23181
      CALL CHCOPY(BUF(I), NAME, J)
23180 I=I+1 
      GOTO 23179
23181 CONTINUE
      NAME(J) = 0
      IF (.NOT.(PACKIT .EQ. 1))GOTO 23182
      CALL DOPACK(NAME, NXTCOL, 80, OBUF, 2)
      GOTO 23183
23182 CONTINUE
      CALL PUTLIN(NAME, 2)
      IF (.NOT.(VERBOS .EQ. 1))GOTO 23184
      CALL PUTLIN(BUF(I), 2)
      GOTO 23185
23184 CONTINUE
      CALL PUTCH(10, 2)
23185 CONTINUE
23183 CONTINUE
      RETURN
      END
      SUBROUTINE UPDATE(ANAME)
      LOGICAL*1 ANAME(40), TFILE(40)
      INTEGER CREATE, GETARG, OPEN, REMOVE
      INTEGER AFD, I, TFD, J, JUNK
      COMMON / CARCH / FSTAT(256), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCO
     *L, FILPTR(256), FNAME(2560), 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(40)
      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 23186
      AFD = CREATE(ANAME, 2)
      IF (.NOT.( AFD .EQ. -3 ))GOTO 23188
      CALL CANT(ANAME)
23188 CONTINUE
      NEW = 1
      GOTO 23187
23186 CONTINUE
      NEW = 0
23187 CONTINUE
      CALL CLOSE(1)
      CALL SCRATF(TNAME, TFILE)
      TFD = CREATE(TFILE, 2)
      IF (.NOT.( TFD .EQ. -3 ))GOTO 23190
      CALL CANT(TFILE)
23190 CONTINUE
      CALL REPLAC(AFD, TFD, 117, ERRCNT)
      I = 1 
23192 IF (.NOT.(I .LE. FCOUNT ))GOTO 23194
      IF (.NOT.( FSTAT(I) .EQ. 0 ))GOTO 23195
      J = FILPTR(I)
      CALL SCOPY(FNAME, J, TEMP, 1)
      CALL ADDFIL(TEMP, TFD, ERRCNT)
      FSTAT(I) = 1
23195 CONTINUE
23193 I = I + 1 
      GOTO 23192
23194 CONTINUE
      CALL CLOSE(AFD)
      CALL CLOSE(TFD)
      IF (.NOT.( ERRCNT .EQ. 0 ))GOTO 23197
      CALL FMOVE(TFILE, ANAME)
      GOTO 23198
23197 CONTINUE
      CALL REMARK(37H? Fatal errors - archive not altered.)
23198 CONTINUE
      JUNK = REMOVE(TFILE)
      RETURN
      END
