SUBROUTINE ACOPY (FDI, FDO, SIZE)
      LOGICAL*1 GETCH
      LOGICAL*1 C
      INTEGER FDI, FDO, I, SIZE
      I=1
23000 IF(.NOT.(I.LE.SIZE))GOTO 23002
      IF(.NOT.(GETCH(C,FDI) .NE. -1))GOTO 23003
      CALL PUTCH (C, FDO)
23003 CONTINUE
23001 I=I+1
      GOTO 23000
23002 CONTINUE
      RETURN
      END
      INTEGER FUNCTION ADDSET (C, STR, J, MAXSIZ)
      INTEGER J, MAXSIZ
      LOGICAL*1 C, STR(MAXSIZ)
      IF(.NOT.(J .GT. MAXSIZ))GOTO 23005
      ADDSET = 0
      GOTO 23006
23005 CONTINUE
      STR(J) = C
      J = J + 1
      ADDSET = 1
23006 CONTINUE
      RETURN
      END
      SUBROUTINE ADRFIL(FILE)
      LOGICAL*1 FILE(40)
      LOGICAL*1 ADDR(8)
      DATA ADDR(1)/97/,ADDR(2)/100/,ADDR(3)/100/,ADDR(4)/114/,ADDR(5)/10
     *1/,ADDR(6)/115/,ADDR(7)/115/,ADDR(8)/0/
      CALL GETDIR(5, 6, FILE)
      CALL CONCAT(FILE, ADDR, FILE)
      RETURN
      END
      INTEGER FUNCTION ALLDIG (STR)
      INTEGER TYPE, I
      LOGICAL*1 STR(100)
      ALLDIG = 0
      IF(.NOT.(STR(1) .EQ. 0))GOTO 23007
      RETURN
23007 CONTINUE
      I=1
23009 IF(.NOT.(STR(I) .NE. 0))GOTO 23011
      IF(.NOT.(TYPE(STR(I)) .NE. 2))GOTO 23012
      RETURN
23012 CONTINUE
23010 I=I+1
      GOTO 23009
23011 CONTINUE
      ALLDIG = 1
      RETURN
      END
      SUBROUTINE BUBBLE(V, N)
      INTEGER I, J, K, N, V(100)
      I=N
23014 IF(.NOT.(I.GT.1))GOTO 23016
      J = 1
23017 IF(.NOT.(J.LT.I))GOTO 23019
      IF(.NOT.(V(J) .GT. V(J+1)))GOTO 23020
      K = V(J)
      V(J) = V(J+1)
      V(J+1) = K
23020 CONTINUE
23018 J=J+1
      GOTO 23017
23019 CONTINUE
23015 I=I-1
      GOTO 23014
23016 CONTINUE
      RETURN
      END
      SUBROUTINE CANT (FILE)
      LOGICAL*1 FILE (100)
      LOGICAL*1 BUF(15)
      DATA BUF(1), BUF(2), BUF(3), BUF(4), BUF(5), BUF(6), BUF(7), BUF(8
     *), BUF(9), BUF(10), BUF(11), BUF(12), BUF(13), BUF(14), BUF(15) /5
     *8, 32, 32, 99, 97, 110, 39, 116, 32, 111, 112, 101, 110, 10, 0/
      CALL PUTLIN (FILE, 3)
      CALL PUTLIN (BUF, 3)
      CALL R4EXIT(0)
      END
      INTEGER FUNCTION CTOI(IN, I)
      LOGICAL*1 IN(100)
      INTEGER INDEX
      INTEGER D, I
      LOGICAL*1 DIGITS(11)
      DATA DIGITS(1) /48/
      DATA DIGITS(2) /49/
      DATA DIGITS(3) /50/
      DATA DIGITS(4) /51/
      DATA DIGITS(5) /52/
      DATA DIGITS(6) /53/
      DATA DIGITS(7) /54/
      DATA DIGITS(8) /55/
      DATA DIGITS(9) /56/
      DATA DIGITS(10) /57/
      DATA DIGITS(11) /0/
23022 IF(.NOT.(IN(I) .EQ. 32 .OR. IN(I) .EQ. 9))GOTO 23023
      I = I + 1
      GOTO 23022
23023 CONTINUE
      CTOI = 0
23024 IF(.NOT.(IN(I) .NE. 0))GOTO 23026
      D = INDEX(DIGITS, IN(I))
      IF(.NOT.(D .EQ. 0))GOTO 23027
      GOTO 23026
23027 CONTINUE
      CTOI = 10 * CTOI + D - 1
23025 I = I + 1
      GOTO 23024
23026 CONTINUE
      RETURN
      END
      INTEGER FUNCTION EQUAL (STR1, STR2)
      LOGICAL*1 STR1(100), STR2(100)
      INTEGER I
      I=1
23029 IF(.NOT.(STR1(I) .EQ. STR2(I)))GOTO 23031
      IF(.NOT.(STR1(I) .EQ. 0))GOTO 23032
      EQUAL = 1
      RETURN
23032 CONTINUE
23030 I=I+1
      GOTO 23029
23031 CONTINUE
      EQUAL = 0
      RETURN
      END
      SUBROUTINE ERROR (LINE)
      LOGICAL*1 LINE(100)
      CALL REMARK (LINE)
      CALL R4EXIT(0)
      END
      SUBROUTINE FCOPY (IN, OUT)
      LOGICAL*1 C
      LOGICAL*1 GETCH
      INTEGER IN, OUT
23034 IF(.NOT.(GETCH(C,IN) .NE. -1))GOTO 23035
      CALL PUTCH(C, OUT)
      GOTO 23034
23035 CONTINUE
      RETURN
      END
      INTEGER FUNCTION FSIZE (NAME)
      LOGICAL*1 GETCH
      LOGICAL*1 C, NAME(100)
      INTEGER OPEN
      INTEGER FD
      FD = OPEN (NAME, 1)
      IF(.NOT.(FD .EQ. -3))GOTO 23036
      FSIZE = -3
      GOTO 23037
23036 CONTINUE
      FSIZE=0
23038 IF(.NOT.(GETCH(C,FD) .NE. -1))GOTO 23040
23039 FSIZE=FSIZE+1
      GOTO 23038
23040 CONTINUE
      CALL CLOSE (FD)
23037 CONTINUE
      RETURN
      END
      SUBROUTINE FSKIP (FD, N)
      LOGICAL*1 GETCH
      LOGICAL*1 C
      INTEGER FD, I, N
      I=1
23041 IF(.NOT.(I.LE.N))GOTO 23043
      IF(.NOT.(GETCH(C,FD) .EQ. -1))GOTO 23044
      GOTO 23043
23044 CONTINUE
23042 I=I+1
      GOTO 23041
23043 CONTINUE
      RETURN
      END
      LOGICAL*1 FUNCTION GETC(C)
      LOGICAL*1 C
      LOGICAL*1 GETCH
      GETC = GETCH(C, 1)
      RETURN
      END
      INTEGER FUNCTION GETWRD (IN, I, OUT)
      LOGICAL*1 IN(100), OUT(100)
      INTEGER I, J
23046 IF(.NOT.(IN(I) .EQ. 32 .OR. IN(I) .EQ. 9))GOTO 23047
      I = I + 1
      GOTO 23046
23047 CONTINUE
      J = 1
23048 IF(.NOT.(IN(I) .NE. 0 .AND. IN(I) .NE. 32 .AND. IN(I) .NE. 9 .AND.
     * IN(I) .NE. 10))GOTO 23049
      OUT(J) = IN(I)
      I = I + 1
      J = J + 1
      GOTO 23048
23049 CONTINUE
      OUT(J) = 0
      GETWRD = J - 1
      RETURN
      END
      SUBROUTINE IMPATH(PATH)
      LOGICAL*1 PATH(100)
      INTEGER I
      INTEGER LENGTH
      I = 1
      CALL GETDIR(2, 6, PATH(I))
      I = I + LENGTH(PATH(I)) + 1
      CALL GETDIR(1, 6, PATH(I))
      I = I + LENGTH(PATH(I)) + 1
      PATH(I) = 10
      PATH(I+1) = 0
      RETURN
      END
      INTEGER FUNCTION ITOC(INT, STR, SIZE)
      INTEGER MOD
      INTEGER D, I, INT, INTVAL, J, K, SIZE
      LOGICAL*1 STR(SIZE)
      LOGICAL*1 DIGITS(11)
      DATA DIGITS(1) /48/
      DATA DIGITS(2) /49/
      DATA DIGITS(3) /50/
      DATA DIGITS(4) /51/
      DATA DIGITS(5) /52/
      DATA DIGITS(6) /53/
      DATA DIGITS(7) /54/
      DATA DIGITS(8) /55/
      DATA DIGITS(9) /56/
      DATA DIGITS(10) /57/
      DATA DIGITS(11) /0/
      INTVAL = IABS(INT)
      STR(1) = 0
      I = 1
23050 CONTINUE
      I = I + 1
      D = MOD(INTVAL, 10)
      STR(I) = DIGITS(D+1)
      INTVAL = INTVAL / 10
23051 IF(.NOT.(INTVAL .EQ. 0 .OR. I .GE. SIZE))GOTO 23050
23052 CONTINUE
      IF(.NOT.(INT .LT. 0 .AND. I .LT. SIZE))GOTO 23053
      I = I + 1
      STR(I) = 45
23053 CONTINUE
      ITOC = I - 1
      J = 1
23055 IF(.NOT.(J .LT. I))GOTO 23057
      K = STR(I)
      STR(I) = STR(J)
      STR(J) = K
      I = I - 1
23056 J = J + 1
      GOTO 23055
23057 CONTINUE
      RETURN
      END
      SUBROUTINE PUTC (C)
      LOGICAL*1 C
      CALL PUTCH (C, 2)
      RETURN
      END
      SUBROUTINE PUTDEC(N,W)
      LOGICAL*1 CHARS(400)
      INTEGER ITOC
      INTEGER I,N,ND,W
      ND = ITOC(N,CHARS,400)
      I = ND+1
23058 IF(.NOT.(I .LE. W))GOTO 23060
      CALL PUTC(32)
23059 I = I+1
      GOTO 23058
23060 CONTINUE
      I = 1
23061 IF(.NOT.(I .LE. ND))GOTO 23063
      CALL PUTC(CHARS(I))
23062 I = I+1
      GOTO 23061
23063 CONTINUE
      RETURN
      END
      SUBROUTINE SHELL (V, N)
      INTEGER GAP, I, J, JG, K, N, V(100)
      GAP=N/2
23064 IF(.NOT.(GAP.GT.0))GOTO 23066
      I=GAP+1
23067 IF(.NOT.(I.LE.N))GOTO 23069
      J=I-GAP
23070 IF(.NOT.(J.GT.0))GOTO 23072
      JG = J + GAP
      IF(.NOT.(V(J) .LE. V(JG)))GOTO 23073
      GOTO 23072
23073 CONTINUE
      K = V(J)
      V(J) = V(JG)
      V(JG) = K
23071 J=J-GAP
      GOTO 23070
23072 CONTINUE
23068 I=I+1
      GOTO 23067
23069 CONTINUE
23065 GAP=GAP/2
      GOTO 23064
23066 CONTINUE
      RETURN
      END
      SUBROUTINE SKIPBL(LIN, I)
      LOGICAL*1 LIN(100)
      INTEGER I
23075 IF(.NOT.(LIN(I) .EQ. 32 .OR. LIN(I) .EQ. 9))GOTO 23076
      I = I + 1
      GOTO 23075
23076 CONTINUE
      RETURN
      END
      INTEGER FUNCTION TYPE (C)
      LOGICAL*1 C
      IF(.NOT.((C .GE. 97 .AND. C .LE. 122) .OR. (C .GE. 65 .AND. C .LE.
     * 90)))GOTO 23077
      TYPE = 1
      GOTO 23078
23077 CONTINUE
      IF(.NOT.(C .GE. 48 .AND. C .LE. 57))GOTO 23079
      TYPE = 2
      GOTO 23080
23079 CONTINUE
      TYPE = C
23080 CONTINUE
23078 CONTINUE
      RETURN
      END
      INTEGER FUNCTION GTFTOK(BUF, I, TOKEN)
      LOGICAL*1 BUF(100), TOKEN(100)
      INTEGER I, J
      IF(.NOT.(BUF(I) .EQ. 47))GOTO 23081
      I = I + 1
23081 CONTINUE
      J = 1
23083 IF(.NOT.(BUF(I) .NE. 47 .AND. BUF(I) .NE. 0))GOTO 23084
      TOKEN(J) = BUF(I)
      I = I + 1
      J = J + 1
      IF(.NOT.(BUF(I-1) .EQ. 92))GOTO 23085
      GOTO 23084
23085 CONTINUE
      GOTO 23083
23084 CONTINUE
      TOKEN(J) = 0
      GTFTOK = J - 1
      RETURN
      END
      SUBROUTINE EXPPTH(PATH, DEPTH, PTR, BUF)
      LOGICAL*1 PATH(100), BUF(100)
      INTEGER DEPTH, PTR(5), I, GTFTOK
      DEPTH = 0
      I = 1
23087 CONTINUE
      DEPTH = DEPTH + 1
      PTR(DEPTH) = I
23088 IF(.NOT.(GTFTOK(PATH, I, BUF) .EQ. 0))GOTO 23087
23089 CONTINUE
      DEPTH = DEPTH - 1
      RETURN
      END
      SUBROUTINE PUTINT(N, W, FD)
      LOGICAL*1 CHARS(20)
      INTEGER ITOC
      INTEGER N, W, FD, JUNK
      JUNK = ITOC(N,CHARS,20)
      CALL PUTSTR(CHARS, W, FD)
      RETURN
      END
      SUBROUTINE PUTSTR(STR, W, FD)
      LOGICAL*1 STR(100)
      LOGICAL*1 LENGTH
      INTEGER W, FD
      LEN = LENGTH(STR)
      I = LEN+1
23090 IF(.NOT.(I .LE. W))GOTO 23092
      CALL PUTCH(32, FD)
23091 I=I+1
      GOTO 23090
23092 CONTINUE
      I = 1
23093 IF(.NOT.(I .LE. LEN))GOTO 23095
      CALL PUTCH(STR(I), FD)
23094 I=I+1
      GOTO 23093
23095 CONTINUE
      I = (-W) - LEN
23096 IF(.NOT.(I .GT. 0))GOTO 23098
      CALL PUTCH(32, FD)
23097 I = I - 1
      GOTO 23096
23098 CONTINUE
      RETURN
      END
      INTEGER FUNCTION STRCMP (STR1, STR2)
      LOGICAL*1 STR1(100), STR2(100)
      INTEGER I
      I=1
23099 IF(.NOT.(STR1(I) .EQ. STR2(I)))GOTO 23101
      IF(.NOT.(STR1(I) .EQ. 0))GOTO 23102
      STRCMP = 0
      RETURN
23102 CONTINUE
23100 I=I+1
      GOTO 23099
23101 CONTINUE
      IF(.NOT.(STR1(I) .EQ. 0))GOTO 23104
      STRCMP = -1
      GOTO 23105
23104 CONTINUE
      IF(.NOT.(STR2(I) .EQ. 0))GOTO 23106
      STRCMP = + 1
      GOTO 23107
23106 CONTINUE
      IF(.NOT.(STR1(I) .LT. STR2(I)))GOTO 23108
      STRCMP = -1
      GOTO 23109
23108 CONTINUE
      STRCMP = +1
23109 CONTINUE
23107 CONTINUE
23105 CONTINUE
      RETURN
      END
      SUBROUTINE BADARG(ARG)
      LOGICAL*1 ARG(100)
      CALL PUTLIN(ARG, 3)
      CALL REMARK(28H: ignoring invalid argument.)
      RETURN
      END
      SUBROUTINE INPACK(NXTCOL, RIGHTM, BUF, UNIT)
      INTEGER NXTCOL, RIGHTM, UNIT
      LOGICAL*1 BUF(100)
      NXTCOL = 1
      RETURN
      END
      SUBROUTINE DOPACK(WORD, NXTCOL, RIGHTM, BUF, UNIT)
      INTEGER NXTCOL, RIGHTM, UNIT, I, J, NXTTAB
      INTEGER LENGTH
      LOGICAL*1 WORD(100), BUF(100)
      IF(.NOT.(NXTCOL .EQ. 1))GOTO 23110
      CALL STCOPY(WORD, 1, BUF, NXTCOL)
      GOTO 23111
23110 CONTINUE
      I = LENGTH(BUF) + 1
      NXTTAB = (((NXTCOL - 1) / 16 + 1) * 16) + 1
      J = NXTTAB + LENGTH(WORD) - 1
      IF(.NOT.(J .GT. RIGHTM))GOTO 23112
      CALL FLPACK(NXTCOL, RIGHTM, BUF, UNIT)
      I = 1
      NXTTAB = NXTCOL
      J = LENGTH(WORD)
23112 CONTINUE
      IF(.NOT.((NXTTAB - NXTCOL) .GT. 8))GOTO 23114
      CALL CHCOPY(9, BUF, I)
23114 CONTINUE
      IF(.NOT.((NXTTAB - NXTCOL) .GT. 0))GOTO 23116
      CALL CHCOPY(9, BUF, I)
23116 CONTINUE
      CALL SCOPY(WORD, 1, BUF, I)
      NXTCOL = J + 1
23111 CONTINUE
      RETURN
      END
      SUBROUTINE FLPACK(NXTCOL, RIGHTM, BUF, UNIT)
      INTEGER NXTCOL, RIGHTM, UNIT
      LOGICAL*1 BUF(100)
      IF(.NOT.(NXTCOL .GT. 1))GOTO 23118
      CALL PUTLIN(BUF, UNIT)
      CALL PUTCH(10, UNIT)
      NXTCOL = 1
23118 CONTINUE
      RETURN
      END
      SUBROUTINE USAGE(BUF)
      LOGICAL*1 BUF(100)
      LOGICAL*1 USE(9)
      DATA USE(1)/117/,USE(2)/115/,USE(3)/97/,USE(4)/103/,USE(5)/101/,US
     *E(6)/58/,USE(7)/32/,USE(8)/32/,USE(9)/0/
      CALL PUTLIN(USE, 3)
      CALL REMARK(BUF)
      CALL R4EXIT(0)
      END