C     ALGORITHM 628 COLLECTED ALGORITHMS FROM ACM.
C     ALGORITHM APPEARED IN ACM-TRANS. MATH. SOFTWARE, VOL.11, NO. 1,
C     MAR., 1985, P. 66.
C*-*-*-*-*-*ADD3        *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-ADD   10
      SUBROUTINE ADD3(A, B, C)                                          ADD   20
      COMMON /TR3/ BETA, THETA
      INTEGER BETA, THETA, A, B, C, D
      D = A + B + C
      A = D/BETA
      B = MOD(D,BETA)
      RETURN
      END
C*-*-*-*-*-*ALTER       *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-ALT   10
      SUBROUTINE ALTER(A, L)                                            ALT   20
      COMMON /S/ SPACE(20000)
      INTEGER SPACE, A, L
      SPACE(L+1) = A
      RETURN
      END
C*-*-*-*-*-*AND         *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-AND   10
      INTEGER FUNCTION AND(XX, YY)                                      AND   20
      INTEGER B, X, XB, XX, X1, Y, YB, YY, Y1, Z
      X = XX
      Y = YY
      Z = 0
      B = 1
   10 IF (X.EQ.0 .OR. Y.EQ.0) GO TO 20
      X1 = X/2
      XB = X - 2*X1
      Y1 = Y/2
      YB = Y - 2*Y1
      IF (XB*YB.GT.0) Z = Z + B
      X = X1
      Y = Y1
      B = 2*B
      GO TO 10
   20 AND = Z
      RETURN
      END
C*-*-*-*-*-*BEGIN       *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-BEG   10
      SUBROUTINE BEGIN                                                  BEG   20
      COMMON /S/ SPACE(20000)
      COMMON /TR1/ AVAIL, STAK, RECORD(72)
      INTEGER SPACE, AVAIL, STAK, RECORD
      I = 19999
   10 SPACE(I) = I + 2
      SPACE(I+1) = 0
      I = I - 2
      IF (I.GT.0) GO TO 10
      SPACE(19999) = 0
      AVAIL = 1
      STAK = 0
      RETURN
      END
C*-*-*-*-*-*COUNT       *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-COU   10
      INTEGER FUNCTION COUNT(L)                                         COU   20
      COMMON /S/ SPACE(20000)
      INTEGER SPACE, L, W, W1
      W = SPACE(L)
      W1 = W/1048576
      COUNT = MOD(W1,1024)
      RETURN
      END
C*-*-*-*-*-*DLREAD      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-DLR   10
      INTEGER FUNCTION DLREAD(U)                                        DLR   20
      COMMON /TR1/ AVAIL, STAK, RECORD(72)
      INTEGER AVAIL, STAK, RECORD
      INTEGER A, C, P, S, T, U, PFA, PFL
      L = 0
      M = 0
      I = 1
      CALL READ(U, RECORD)
      C = RECORD(1)
      DLREAD = -1
      IF (C.EQ.-1) RETURN
      IF (C.NE.40) GO TO 130
   10 P = C
      I = I + 1
      IF (I.LE.72) GO TO 20
      I = 1
      CALL READ(U, RECORD)
   20 C = RECORD(I)
      IF (C.EQ.40) GO TO 30
      IF (C.EQ.41) GO TO 40
      IF (C.EQ.42) GO TO 50
      IF (C.EQ.36 .OR. C.EQ.37) GO TO 60
      IF (C.LE.9) GO TO 70
      GO TO 130
   30 IF (P.EQ.40 .OR. P.EQ.42) GO TO 80
      GO TO 130
   40 IF (P.EQ.40 .OR. P.EQ.41) GO TO 90
      IF (P.LE.9) GO TO 120
      GO TO 130
   50 IF (P.LE.9) GO TO 120
      IF (P.EQ.41) GO TO 10
      GO TO 130
   60 IF (P.EQ.40 .OR. P.EQ.42) GO TO 100
      GO TO 130
   70 IF (P.LE.9 .OR. P.EQ.36 .OR. P.EQ.37) GO TO 110
      IF (P.EQ.40 .OR. P.EQ.42) GO TO 100
      GO TO 130
   80 M = PFL(L,M)
      L = 0
      GO TO 10
   90 L = INV(L)
      DLREAD = L
      IF (M.EQ.0) RETURN
      CALL DECAP(T, M)
      L = PFL(L,T)
      GO TO 10
  100 S = 1
      IF (C.EQ.37) S = -1
      A = 0
      IF (C.LE.9) A = C
      GO TO 10
  110 A = 10*A + C
      GO TO 10
  120 A = S*A
      L = PFA(A,L)
      IF (C.EQ.41) GO TO 90
      GO TO 10
  130 CALL ERASE(L)
      CALL ERASE(M)
      DLREAD = -2
      RETURN
      END
C*-*-*-*-*-*DLWRIT      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-DLW   10
      SUBROUTINE DLWRIT(U, L)                                           DLW   20
      COMMON /TR1/ AVAIL, STAK, RECORD(72)
      INTEGER AVAIL, STAK, RECORD
      INTEGER C, E, T, U, PFA, PFL, TYPE
      K = L
      M = 0
      I = 1
      C = 40
      GO TO 80
   10 IF (K.NE.0) GO TO 20
      C = 41
      GO TO 80
   20 T = TYPE(K)
      CALL ADV(E, K)
      IF (T.EQ.0) GO TO 50
      M = PFL(K,M)
      K = E
      C = 40
      GO TO 80
   30 IF (M.EQ.0) GO TO 100
      CALL DECAP(K, M)
   40 IF (K.EQ.0) C = 41
      IF (K.NE.0) C = 42
      GO TO 80
   50 C = 36
      IF (E.LT.0) C = 37
      IF (E.LT.0) E = -E
      T = 0
      GO TO 80
   60 C = MOD(E,10)
      T = PFA(C,T)
      E = E/10
      IF (E.NE.0) GO TO 60
   70 IF (T.EQ.0) GO TO 40
      CALL DECAP(C, T)
   80 IF (I.LE.72) GO TO 90
      CALL WRITE(U, RECORD)
      I = 1
   90 RECORD(I) = C
      I = I + 1
      IF (C.LE.9) GO TO 70
      IF (C.EQ.36 .OR. C.EQ.37) GO TO 60
      IF (C.EQ.40) GO TO 10
      IF (C.EQ.41) GO TO 30
      GO TO 20
  100 IF (I.EQ.73) GO TO 110
      RECORD(I) = 44
      I = I + 1
      GO TO 100
  110 CALL WRITE(U, RECORD)
      RETURN
      END
C*-*-*-*-*-*FIRST       *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-FIR   10
      INTEGER FUNCTION FIRST(L)                                         FIR   20
      COMMON /S/ SPACE(20000)
      INTEGER SPACE, L
      FIRST = SPACE(L+1)
      RETURN
      END
C*-*-*-*-*-*INITIO      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-INI   10
      SUBROUTINE INITIO(U)                                              INI   20
      COMMON /PR1/ MCODE(47), SCODE(47), TABLE(47)
      INTEGER U, MCODE, SCODE, TABLE, PRINT, S, C
      DATA S /0/
      DATA PRINT /6/
99999 FORMAT (47A1)
99998 FORMAT (20H INCORRECT CODE CARD)
      IF (S.NE.0) RETURN
      S = 1
      READ (U,99999) MCODE
      DO 10 I=1,47
        SCODE(I) = I - 1
   10 CONTINUE
      J = 46
   20 DO 40 I=1,J
        IF (MCODE(I).LT.0 .AND. MCODE(I+1).GT.0) GO TO 40
        IF (MCODE(I).GT.0 .AND. MCODE(I+1).LT.0) GO TO 30
        IF (MCODE(I).LE.MCODE(I+1)) GO TO 40
   30   C = MCODE(I)
        MCODE(I) = MCODE(I+1)
        MCODE(I+1) = C
        C = SCODE(I)
        SCODE(I) = SCODE(I+1)
        SCODE(I+1) = C
   40 CONTINUE
      J = J - 1
      IF (J.GE.1) GO TO 20
      DO 50 I=1,46
        IF (MCODE(I).EQ.MCODE(I+1)) GO TO 70
   50 CONTINUE
      DO 60 I=1,47
        J = SCODE(I) + 1
        TABLE(J) = MCODE(I)
   60 CONTINUE
      RETURN
   70 WRITE (PRINT,99998)
      STOP
      END
C*-*-*-*-*-*MPY         *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-MPY   10
      SUBROUTINE MPY(A, B)                                              MPY   20
      COMMON /TR3/ BETA, THETA
      INTEGER BETA, THETA, A, B, C
      C = A*B
      A = C/BETA
      B = MOD(C,BETA)
      RETURN
      END
C*-*-*-*-*-*OR          *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-OR    10
      INTEGER FUNCTION OR(XX, YY)                                       OR    20
      INTEGER B, X, XB, XX, X1, Y, YB, YY, Y1, Z
      X = XX
      Y = YY
      Z = 0
      B = 1
   10 IF (X.EQ.0) GO TO 20
      IF (Y.EQ.0) GO TO 30
      X1 = X/2
      XB = X - 2*X1
      Y1 = Y/2
      YB = Y - 2*Y1
      IF (XB+YB.GT.0) Z = Z + B
      X = X1
      Y = Y1
      B = 2*B
      GO TO 10
   20 OR = Z + Y*B
      RETURN
   30 OR = Z + X*B
      RETURN
      END
C*-*-*-*-*-*QR          *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-QR    10
      SUBROUTINE QR(A, B, C)                                            QR    20
      COMMON /TR3/ BETA, THETA
      INTEGER BETA, THETA, A, B, C, D
      D = A*BETA + B
      A = D/C
      B = MOD(D,C)
      RETURN
      END
C*-*-*-*-*-*READ        *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-REA   10
      SUBROUTINE READ(U, A)                                             REA   20
      COMMON /PR1/ MCODE(47), SCODE(47), TABLE(47)
      DIMENSION A(72)
      INTEGER U, A, MCODE, SCODE, TABLE, PRINT, C
      DATA PRINT /6/
99999 FORMAT (72A1)
99998 FORMAT (24H INVALID INPUT CHARACTER)
      CALL INITIO(U)
      READ (U,99999) A
      DO 40 I=1,72
        C = A(I)
        J = 1
        K = 32
   10   L = J + K
        IF (L.GT.47) GO TO 30
        IF (C.LT.0 .AND. MCODE(L).GT.0) GO TO 30
        IF (C.GT.0 .AND. MCODE(L).LT.0) GO TO 20
        IF (C.LT.MCODE(L)) GO TO 30
   20   J = L
   30   K = K/2
        IF (K.NE.0) GO TO 10
        IF (C.NE.MCODE(J)) GO TO 50
        A(I) = SCODE(J)
   40 CONTINUE
      RETURN
   50 WRITE (PRINT,99998)
      STOP
      END
C*-*-*-*-*-*SCOUNT      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-SCO   10
      SUBROUTINE SCOUNT(C, L)                                           SCO   20
      COMMON /S/ SPACE(20000)
      INTEGER SPACE, C, L, W, S, T, W1
      W = SPACE(L)
      S = MOD(W,1048576)
      T = W/1073741824
      W1 = 1024*T + C
      W = 1048576*W1 + S
      SPACE(L) = W
      RETURN
      END
C*-*-*-*-*-*SSUCC       *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-SSU   10
      SUBROUTINE SSUCC(S, L)                                            SSU   20
      COMMON /S/ SPACE(20000)
      INTEGER SPACE, S, L, W, T
      W = SPACE(L)
      T = W/1048576
      W = 1048576*T + S
      SPACE(L) = W
      RETURN
      END
C*-*-*-*-*-*STYPE       *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-STY   10
      SUBROUTINE STYPE(T, L)                                            STY   20
      COMMON /S/ SPACE(20000)
      INTEGER SPACE, T, L, W, W1
      W = SPACE(L)
      W1 = MOD(W,1073741824)
      W = 1073741824*T + W1
      SPACE(L) = W
      RETURN
      END
C*-*-*-*-*-*TAIL        *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-TAI   10
      INTEGER FUNCTION TAIL(L)                                          TAI   20
      COMMON /S/ SPACE(20000)
      INTEGER SPACE, L, W
      W = SPACE(L)
      TAIL = MOD(W,1048576)
      RETURN
      END
C*-*-*-*-*-*TYPE        *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-TYP   10
      INTEGER FUNCTION TYPE(L)                                          TYP   20
      COMMON /S/ SPACE(20000)
      INTEGER SPACE, L, W
      W = SPACE(L)
      TYPE = W/1073741824
      RETURN
      END
C*-*-*-*-*-*WRITE       *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-WRI   10
      SUBROUTINE WRITE(U, A)                                            WRI   20
      COMMON /PR1/ MCODE(47), SCODE(47), TABLE(47)
      DIMENSION A(72)
      INTEGER U, A, MCODE, SCODE, TABLE, PRINT
      DATA PRINT /6/
99999 FORMAT (72A1)
99998 FORMAT (73A1)
99997 FORMAT (25H INVALID OUTPUT CHARACTER)
      CALL INITIO(U)
      DO 20 I=1,72
        J = A(I)
        IF (J.GE.0 .AND. J.LE.46) GO TO 10
        WRITE (PRINT,99997)
        STOP
   10   J = J + 1
        A(I) = TABLE(J)
   20 CONTINUE
      IF (U.EQ.PRINT) GO TO 30
      WRITE (U,99999) A
      RETURN
   30 WRITE (PRINT,99998) TABLE(45), A
      RETURN
      END
C*-*-*-*-*-*ADV         *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-ADV   10
      SUBROUTINE ADV(EL, LOC)                                           ADV   20
      INTEGER EL, LOC, L, TAIL, FIRST
      L = LOC
      EL = FIRST(L)
      LOC = TAIL(L)
      RETURN
      END
C*-*-*-*-*-*ADV2        *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-ADV   10
      SUBROUTINE ADV2(A, B, L)                                          ADV   20
      INTEGER A, B
      CALL ADV(A, L)
      CALL ADV(B, L)
      RETURN
      END
C*-*-*-*-*-*BORROW      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-BOR   10
      INTEGER FUNCTION BORROW(LIST)                                     BOR   20
      INTEGER COUNT
      BORROW = LIST
      IF (BORROW.EQ.0) RETURN
      CALL SCOUNT(COUNT(BORROW)+1, BORROW)
      RETURN
      END
C*-*-*-*-*-*CINV        *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-CIN   10
      INTEGER FUNCTION CINV(X)                                          CIN   20
      INTEGER TYPE, PFA, PFL, BORROW
      INTEGER X, Z, R, E, T
      Z = 0
      R = X
   10 IF (R.EQ.0) GO TO 30
      T = TYPE(R)
      CALL ADV(E, R)
      IF (T.EQ.1) GO TO 20
      Z = PFA(E,Z)
      GO TO 10
   20 Z = PFL(BORROW(E),Z)
      GO TO 10
   30 CINV = Z
      RETURN
      END
C*-*-*-*-*-*CONC        *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-CON   10
      INTEGER FUNCTION CONC(X, Y)                                       CON   20
      INTEGER X, Y, XAD, XNEXT, XSUC, TAIL
      CONC = Y
      XSUC = CONC
      XNEXT = X
      IF (XNEXT.EQ.0) RETURN
      CONC = XNEXT
      IF (XSUC.EQ.0) RETURN
   10 XAD = XNEXT
      XNEXT = TAIL(XNEXT)
      IF (XNEXT.NE.0) GO TO 10
      CALL SSUCC(XSUC, XAD)
      RETURN
      END
C*-*-*-*-*-*DECAP       *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-DEC   10
      SUBROUTINE DECAP(EL, LOC)                                         DEC   20
      COMMON /TR1/ AVAIL, STAK, RECORD(72)
      INTEGER AVAIL, STAK, RECORD
      INTEGER B, EL, TAIL, FIRST
      B = AVAIL
      AVAIL = LOC
      EL = FIRST(AVAIL)
      LOC = TAIL(AVAIL)
      CALL SSUCC(B, AVAIL)
      CALL SCOUNT(0, AVAIL)
      RETURN
      END
C*-*-*-*-*-*DECAP2      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-DEC   10
      SUBROUTINE DECAP2(A, B, L)                                        DEC   20
      INTEGER A, B
      CALL DECAP(A, L)
      CALL DECAP(B, L)
      RETURN
      END
C*-*-*-*-*-*ERASE       *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-ERA   10
      SUBROUTINE ERASE(XX)                                              ERA   20
      COMMON /TR1/ AVAIL, STAK, RECORD(72)
      INTEGER AVAIL, STAK, RECORD
      INTEGER COUNT, FIRST, TAIL, TYPE
      INTEGER X, XX, T, BIN
      X = XX
      BIN = 0
   10 IF (X.EQ.0) GO TO 20
      K = COUNT(X) - 1
      CALL SCOUNT(K, X)
      IF (K.GT.0) GO TO 20
      IF (TYPE(X).EQ.1) GO TO 30
      T = TAIL(X)
      CALL SSUCC(AVAIL, X)
      AVAIL = X
      X = T
      GO TO 10
   20 IF (BIN.EQ.0) RETURN
      X = FIRST(BIN)
      T = TAIL(BIN)
      CALL SSUCC(AVAIL, BIN)
      AVAIL = BIN
      BIN = T
      GO TO 10
   30 T = TAIL(X)
      CALL SSUCC(BIN, X)
      BIN = X
      X = T
      GO TO 10
      END
C*-*-*-*-*-*ERLA        *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-ERL   10
      SUBROUTINE ERLA(X)                                                ERL   20
      COMMON /TR1/ AVAIL, STAK, RECORD(72)
      INTEGER AVAIL, STAK, RECORD
      INTEGER X, U, V, TAIL, COUNT
      IF (X.EQ.0) GO TO 30
      U = 0
      V = X
   10 N = COUNT(V) - 1
      CALL SCOUNT(N, V)
      IF (N.NE.0) GO TO 20
      U = V
      V = TAIL(V)
      IF (V.NE.0) GO TO 10
   20 IF (U.EQ.0) GO TO 30
      CALL SSUCC(AVAIL, U)
      AVAIL = X
   30 RETURN
      END
C*-*-*-*-*-*FIRST2      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-FIR   10
      SUBROUTINE FIRST2(A, B, L)                                        FIR   20
C     FIRST 2 ELEMENTS OF L
C     L IS A LIST (A1, A2, ..., AN) OF LENGTH N .GE. 2.  A IS SET TO A1
C     AND B IS SET TO A2.
C
      INTEGER A, B, L, T
      INTEGER FIRST
C
      T = L
      CALL ADV(A, T)
      B = FIRST(T)
      RETURN
      END
C*-*-*-*-*-*INV         *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-INV   10
      FUNCTION INV(LIST)                                                INV   20
      INTEGER TAIL
      INV = 0
      NEXT = LIST
      IF (NEXT.EQ.0) RETURN
   10 ISTORE = NEXT
      NEXT = TAIL(ISTORE)
      CALL SSUCC(INV, ISTORE)
      INV = ISTORE
      IF (NEXT.NE.0) GO TO 10
      RETURN
      END
C*-*-*-*-*-*LENGTH      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-LEN   10
      FUNCTION LENGTH(LIST)                                             LEN   20
      INTEGER TAIL
      LENGTH = 0
      K = LIST
   10 IF (K.EQ.0) RETURN
      K = TAIL(K)
      LENGTH = LENGTH + 1
      GO TO 10
      END
C*-*-*-*-*-*NOAVLS      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-NOA   10
      SUBROUTINE NOAVLS                                                 NOA   20
      PRINT 99999
      STOP
99999 FORMAT (23H OUT OF AVAILABLE SPACE)
      END
C*-*-*-*-*-*PFA         *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-PFA   10
      INTEGER FUNCTION PFA(ATOM, LIST)                                  PFA   20
      INTEGER AVAIL, STAK, RECORD
      INTEGER ATOM, TAIL
      COMMON /TR1/ AVAIL, STAK, RECORD(72)
      PFA = AVAIL
      IF (PFA.EQ.0) CALL NOAVLS
      AVAIL = TAIL(AVAIL)
      CALL SSUCC(LIST, PFA)
      CALL STYPE(0, PFA)
      CALL SCOUNT(1, PFA)
      CALL ALTER(ATOM, PFA)
      RETURN
      END
C*-*-*-*-*-*PFL         *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-PFL   10
      INTEGER FUNCTION PFL(LIST1, LIST)                                 PFL   20
      INTEGER AVAIL, STAK, RECORD
      INTEGER TAIL
      COMMON /TR1/ AVAIL, STAK, RECORD(72)
      PFL = AVAIL
      IF (PFL.EQ.0) CALL NOAVLS
      AVAIL = TAIL(AVAIL)
      CALL SSUCC(LIST, PFL)
      CALL STYPE(1, PFL)
      CALL SCOUNT(1, PFL)
      CALL ALTER(LIST1, PFL)
      RETURN
      END
C*-*-*-*-*-*SECOND      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-SEC   10
      INTEGER FUNCTION SECOND(B)                                        SEC   20
      INTEGER FIRST, TAIL
      INTEGER ALC, B
      ALC = FIRST(TAIL(B))
      SECOND = ALC
      RETURN
      END
C*-*-*-*-*-*STACK2      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-STA   10
      SUBROUTINE STACK2(X, Y)                                           STA   20
      COMMON /TR1/ AVAIL, STAK, RECORD(72)
      INTEGER AVAIL, STAK, RECORD
      INTEGER X, Y, PFA
      STAK = PFA(Y,PFA(X,STAK))
      RETURN
      END
C*-*-*-*-*-*STACK3      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-STA   10
      SUBROUTINE STACK3(X, Y, Z)                                        STA   20
      COMMON /TR1/ AVAIL, STAK, RECORD(72)
      INTEGER AVAIL, STAK, RECORD
      INTEGER X, Y, Z, PFA
      STAK = PFA(Z,PFA(Y,PFA(X,STAK)))
      RETURN
      END
C*-*-*-*-*-*UNSTK2      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-UNS   10
      SUBROUTINE UNSTK2(X, Y)                                           UNS   20
      COMMON /TR1/ AVAIL, STAK, RECORD(72)
      INTEGER AVAIL, STAK, RECORD
      INTEGER X, Y
      CALL DECAP(Y, STAK)
      CALL DECAP(X, STAK)
      RETURN
      END
C*-*-*-*-*-*UNSTK3      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-UNS   10
      SUBROUTINE UNSTK3(X, Y, Z)                                        UNS   20
      COMMON /TR1/ AVAIL, STAK, RECORD(72)
      INTEGER AVAIL, STAK, RECORD
      INTEGER X, Y, Z
      CALL DECAP(Z, STAK)
      CALL DECAP(Y, STAK)
      CALL DECAP(X, STAK)
      RETURN
      END
      INTEGER FUNCTION LEQUAL(X, Y)                                     LEQ   10
      INTEGER X, Y
      INTEGER FIRST, PFA, TAIL, TYPE
      INTEGER STAK, XDP, XP, YDP, YP, Z
C     SAVE POINTERS AND SET UP BRANCH STACK.
      XP = X
      YP = Y
      STAK = 0
C     TEST FOR END.
   10 IF (XP.NE.YP) GO TO 30
      IF (STAK.NE.0) GO TO 20
      LEQUAL = 1
      RETURN
   20 CALL DECAP(XP, STAK)
      CALL DECAP(YP, STAK)
C     TEST NEXT NODE
   30 IF (XP.LE.0 .OR. YP.LE.0) GO TO 50
      Z = TYPE(XP)
      IF (Z.NE.TYPE(YP)) GO TO 50
      XDP = FIRST(XP)
      YDP = FIRST(YP)
      IF (XDP.EQ.YDP) GO TO 40
      IF (Z.EQ.0) GO TO 50
      STAK = PFA(XDP,PFA(YDP,STAK))
   40 YP = TAIL(YP)
      XP = TAIL(XP)
      GO TO 10
   50 LEQUAL = 0
      CALL ERLA(STAK)
      RETURN
      END
C*-*-*-*-*-*COMPAT      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-COM   10
      SUBROUTINE COMPAT(S, A, B)                                        COM   20
      COMMON /TR3/ BETA, THETA
      INTEGER S, A, B, BETA
      B = A + B
      IF (S.LT.0) GO TO 10
      IF (B.GE.0) GO TO 20
      B = B + BETA
      A = -1
      RETURN
   10 IF (B.LE.0) GO TO 20
      B = B - BETA
      A = 1
      RETURN
   20 A = 0
      RETURN
      END
C*-*-*-*-*-*ELPOF2      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-ELP   10
      SUBROUTINE ELPOF2(X, EFLR, ECEIL)                                 ELP   20
      INTEGER ECEIL, EFLR, Q, R, RP, V, X, Z
      INTEGER IABSL, IQRS
      V = X
      EFLR = 0
      ECEIL = 0
      IF (V.EQ.0) RETURN
      Q = IABSL(V)
      RP = 0
   10 Z = IQRS(Q,2)
      CALL ERLA(Q)
      CALL DECAP(Q, Z)
      CALL DECAP(R, Z)
      IF (R.EQ.0) GO TO 20
      RP = RP + 1
   20 IF (Q.EQ.0) GO TO 30
      EFLR = EFLR + 1
      GO TO 10
   30 IF (RP.GT.1) ECEIL = 1
      ECEIL = EFLR + ECEIL
      RETURN
      END
C*-*-*-*-*-*IABSL       *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-IAB   10
      INTEGER FUNCTION IABSL(A)                                         IAB   20
      INTEGER A, B, S, BORROW, INEG, ISIGNL
      S = ISIGNL(A)
      IF (S.LT.0) GO TO 10
      B = BORROW(A)
      GO TO 20
   10 B = INEG(A)
   20 IABSL = B
      RETURN
      END
C*-*-*-*-*-*IBTOD       *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-IBT   10
      INTEGER FUNCTION IBTOD(A)                                         IBT   20
      INTEGER A, C
      C = IBTOH(A)
      IBTOD = IHTOD(C)
      CALL ERLA(C)
      RETURN
      END
C*-*-*-*-*-*IBTOH       *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-IBT   10
      INTEGER FUNCTION IBTOH(A)                                         IBT   20
      COMMON /TR3/ BETA, THETA
      INTEGER A, B, BETA, BI, Q, THETA, BORROW, PFA
      B = 0
      Q = BORROW(A)
   10 IF (Q.EQ.0) GO TO 20
      L = IQRS(Q,THETA)
      CALL ERLA(Q)
      CALL DECAP(Q, L)
      CALL DECAP(BI, L)
      B = PFA(BI,B)
      GO TO 10
   20 IBTOH = B
      RETURN
      END
C*-*-*-*-*-*ICOMP       *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-ICO   10
      INTEGER FUNCTION ICOMP(A, B)                                      ICO   20
      INTEGER A, B, S, T, U, V, X, Y
      INTEGER FIRST, TAIL, ISIGNL
      U = ISIGNL(A)
      V = ISIGNL(B)
      S = U - V
      IF (U.EQ.0 .OR. V.EQ.0) GO TO 40
      IF (S.NE.0) GO TO 30
      X = A
      Y = B
   10 T = FIRST(X) - FIRST(Y)
      IF (T.NE.0) S = T
      X = TAIL(X)
      Y = TAIL(Y)
      IF (X.EQ.0) GO TO 20
      IF (Y.NE.0) GO TO 10
      S = U
      GO TO 40
   20 IF (Y.EQ.0) GO TO 30
      S = -U
      GO TO 40
   30 IF (S.GT.0) S = 1
      IF (S.LT.0) S = -1
   40 ICOMP = S
      RETURN
      END
C*-*-*-*-*-*IDIF        *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-IDI   10
      INTEGER FUNCTION IDIF(A, B)                                       IDI   20
      INTEGER A, B, C, F, G, AI, BI, DI, EI, S, T, U, V
      INTEGER BORROW, FIRST, INV, PFA, TAIL, ISIGNL, INEG
      IF (A.NE.0) GO TO 10
      C = INEG(B)
      GO TO 140
   10 IF (B.NE.0) GO TO 20
      C = BORROW(A)
      GO TO 140
   20 C = 0
      U = A
      V = B
      S = ISIGNL(A)
      T = ISIGNL(B)
      IF (S+T.NE.0) GO TO 70
      DI = 0
   30 CALL ADV(AI, U)
      CALL ADV(BI, V)
      BI = -BI
      CALL ADD3(DI, AI, BI)
      C = PFA(AI,C)
      IF (U.EQ.0) GO TO 50
      IF (V.NE.0) GO TO 30
   40 CALL ADV(AI, U)
      CALL ADD3(DI, AI, 0)
      C = PFA(AI,C)
      IF (U.NE.0) GO TO 40
      GO TO 60
   50 IF (V.EQ.0) GO TO 60
      CALL ADV(BI, V)
      BI = -BI
      CALL ADD3(DI, BI, 0)
      C = PFA(BI,C)
      GO TO 50
   60 IF (DI.NE.0) C = PFA(DI,C)
      C = INV(C)
      GO TO 140
   70 F = 0
   80 CALL ADV(AI, U)
      CALL ADV(BI, V)
      DI = AI - BI
      IF (DI.NE.0) F = DI
      C = PFA(DI,C)
      IF (U.EQ.0) GO TO 100
      IF (V.NE.0) GO TO 80
   90 CALL ADV(DI, U)
      IF (DI.NE.0) F = DI
      C = PFA(DI,C)
      IF (U.NE.0) GO TO 90
      GO TO 110
  100 IF (V.EQ.0) GO TO 110
      CALL ADV(DI, V)
      DI = -DI
      IF (DI.NE.0) F = DI
      C = PFA(DI,C)
      GO TO 100
  110 IF (F.NE.0) GO TO 120
      CALL ERLA(C)
      C = 0
      GO TO 140
  120 C = INV(C)
      S = 1
      IF (F.LT.0) S = -1
      F = 0
      EI = 0
      U = C
  130 DI = FIRST(U)
      CALL COMPAT(S, EI, DI)
      IF (DI.NE.0) F = U
      CALL ALTER(DI, U)
      U = TAIL(U)
      IF (U.NE.0) GO TO 130
      G = TAIL(F)
      CALL SSUCC(0, F)
      CALL ERLA(G)
  140 IDIF = C
      RETURN
      END
C*-*-*-*-*-*IDTOB       *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-IDT   10
      INTEGER FUNCTION IDTOB(A)                                         IDT   20
      INTEGER A, C
      C = IDTOH(A)
      IDTOB = IHTOB(C)
      CALL ERLA(C)
      RETURN
      END
C*-*-*-*-*-*IDTOH       *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-IDT   10
      INTEGER FUNCTION IDTOH(A)                                         IDT   20
      COMMON /TR3/ BETA, THETA
      INTEGER BETA, THETA, A
      INTEGER FIRST, PFA, INV
      INTEGER U, S, BI, M, AI, V
      U = A
      IDTOH = 0
      S = 1
      IF (FIRST(U).LT.10) GO TO 10
      CALL ADV(V, U)
      IF (V.EQ.37) S = -1
   10 IF (FIRST(U).EQ.0) RETURN
      V = INV(U)
      U = V
   20 BI = 0
      M = 1
   30 CALL ADV(AI, U)
      BI = AI*M + BI
      M = 10*M
      IF (M.NE.THETA .AND. U.NE.0) GO TO 30
      IDTOH = PFA(S*BI,IDTOH)
      IF (U.NE.0) GO TO 20
      U = INV(V)
      RETURN
      END
C*-*-*-*-*-*IGCD        *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-IGC   10
      INTEGER FUNCTION IGCD(I, J)                                       IGC   20
      COMMON /TR3/ BETA, THETA
      INTEGER BETA, THETA
      INTEGER FIRST, PFA, TAIL
      INTEGER A, A1, A2, ADPRIM, APRIME, B, BDPRIM, BPRIME
      INTEGER C, C1, C2, D, E, E1, E2, F, F1, F2, G, QDPRIM, QPRIME
      INTEGER S, T, T1, T2, U, U1, U2, V, X, Y
      IF (I.NE.0) GO TO 10
      IGCD = IABSL(J)
      RETURN
   10 IF (J.NE.0) GO TO 20
      IGCD = IABSL(I)
      RETURN
   20 A = 0
      T = I
   30 CALL ADV(D, T)
      A = PFA(IABS(D),A)
      IF (T.NE.0) GO TO 30
      A = INV(A)
      B = 0
      T = J
   40 CALL ADV(D, T)
      B = PFA(IABS(D),B)
      IF (T.NE.0) GO TO 40
      B = INV(B)
      S = ICOMP(A,B)
      IF (S.NE.0) GO TO 50
      CALL ERLA(A)
      IGCD = B
      RETURN
   50 IF (S.GE.0) GO TO 60
      T = A
      A = B
      B = T
   60 IF (B.NE.0) GO TO 70
      IGCD = A
      RETURN
   70 IF (TAIL(B).NE.0) GO TO 100
      C = IREM(A,B)
      CALL ERLA(A)
      IF (C.NE.0) GO TO 80
      IGCD = B
      RETURN
   80 CALL DECAP(A, B)
      CALL DECAP(B, C)
   90 C = A - A/B*B
      A = B
      B = C
      IF (B.NE.0) GO TO 90
      IGCD = PFA(A,0)
      RETURN
  100 T = A
  110 CALL ADV(F, T)
      IF (T.NE.0) GO TO 110
      D = 1
      E = 0
      F = F + 1
      IF (F.NE.BETA) CALL QR(D, E, F)
      T = A
      N = 0
      C = 0
      G = 0
  120 CALL ADV(E, T)
      F = D
      CALL MPY(E, F)
      CALL ADD3(C, F, G)
      G = E
      N = N + 1
      IF (T.NE.0) GO TO 120
      APRIME = F
      ADPRIM = APRIME + 1
      T = B
      M = 0
      C = 0
      G = 0
  130 CALL ADV(E, T)
      F = D
      CALL MPY(E, F)
      CALL ADD3(C, F, G)
      G = E
      M = M + 1
      IF (T.NE.0) GO TO 130
      BDPRIM = F
      IF (M.LT.N) BDPRIM = C + G
      IF (M.LT.N-1) BDPRIM = 0
      BPRIME = BDPRIM + 1
      IF (BDPRIM.EQ.0 .OR. APRIME.LT.BPRIME .OR. ADPRIM.EQ.BETA) GO TO
     * 160
      X = 1
      Y = 0
      U = 0
      V = 1
  140 IF (BPRIME.EQ.0 .OR. BDPRIM.EQ.0) GO TO 170
      IF (BPRIME.EQ.0 .OR. BDPRIM.EQ.0) GO TO 170
      QPRIME = APRIME/BPRIME
      QDPRIM = ADPRIM/BDPRIM
      IF (QPRIME.EQ.QDPRIM) GO TO 150
      IF (Y.EQ.0) GO TO 160
      GO TO 170
  150 T = APRIME - QPRIME*BPRIME
      APRIME = BPRIME
      BPRIME = T
      T = ADPRIM - QPRIME*BDPRIM
      ADPRIM = BDPRIM
      BDPRIM = T
      T = X - QPRIME*U
      X = U
      U = T
      T = Y - QPRIME*V
      Y = V
      V = T
      GO TO 140
  160 T = IREM(A,B)
      CALL ERLA(A)
      A = B
      B = T
      GO TO 60
  170 T1 = A
      T2 = B
      C1 = 0
      C2 = 0
      L1 = 0
      L2 = 0
  180 A1 = FIRST(T1)
      A2 = FIRST(T2)
      E1 = A1
      F1 = X
      CALL MPY(E1, F1)
      E2 = A2
      F2 = Y
      CALL MPY(E2, F2)
      CALL ADD3(C1, F1, F2)
      C1 = C1 + E1 + E2
      IF (F1.GE.0) GO TO 190
      F1 = F1 + BETA
      C1 = C1 - 1
  190 CALL ALTER(F1, T1)
      IF (F1.NE.0) L1 = T1
      E1 = A1
      F1 = U
      CALL MPY(E1, F1)
      E2 = A2
      F2 = V
      CALL MPY(E2, F2)
      CALL ADD3(C2, F1, F2)
      C2 = C2 + E1 + E2
      IF (F1.GE.0) GO TO 200
      F1 = F1 + BETA
      C2 = C2 - 1
  200 CALL ALTER(F1, T2)
      IF (F1.NE.0) L2 = T2
      U1 = TAIL(T1)
      U2 = TAIL(T2)
      IF (U1.EQ.0 .OR. U2.NE.0) GO TO 210
      U2 = PFA(0,0)
      CALL SSUCC(U2, T2)
  210 T1 = U1
      T2 = U2
      IF (T1.NE.0) GO TO 180
      U1 = TAIL(L1)
      CALL SSUCC(0, L1)
      CALL ERLA(U1)
      IF (L2.EQ.0) GO TO 60
      U2 = TAIL(L2)
      CALL SSUCC(0, L2)
      CALL ERLA(U2)
      GO TO 60
      END
C*-*-*-*-*-*IGCDCF      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-IGC   10
      SUBROUTINE IGCDCF(A, B, C, ABAR, BBAR)                            IGC   20
      INTEGER A, ABAR, B, BBAR, C, BORROW, FIRST, TAIL
      C = IGCD(A,B)
      IF (FIRST(C).NE.1 .OR. TAIL(C).NE.0) GO TO 10
      ABAR = BORROW(A)
      BBAR = BORROW(B)
      RETURN
   10 ABAR = IQ(A,C)
      BBAR = IQ(B,C)
      RETURN
      END
C*-*-*-*-*-*IHTOB       *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-IHT   10
      INTEGER FUNCTION IHTOB(A)                                         IHT   20
      COMMON /TR3/ BETA, THETA
      INTEGER A, AI, B, BETA, THETA, U, PFA
      U = A
      B = 0
      IF (U.EQ.0) GO TO 20
      CALL ADV(AI, U)
      B = PFA(AI,0)
   10 IF (U.EQ.0) GO TO 20
      CALL ADV(AI, U)
      B = IMADD(B,THETA,AI)
      GO TO 10
   20 IHTOB = B
      RETURN
      END
C*-*-*-*-*-*IHTOD       *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-IHT   10
      INTEGER FUNCTION IHTOD(A)                                         IHT   20
      COMMON /TR3/ BETA, THETA
      INTEGER BETA, THETA, A
      INTEGER PFA, FIRST, INV
      INTEGER U, S, AI, M, BI
      IF (A.NE.0) GO TO 10
      IHTOD = PFA(36,PFA(0,0))
      RETURN
   10 IHTOD = 0
      U = A
      S = FIRST(A)
   20 IF (U.EQ.0) GO TO 40
      CALL ADV(AI, U)
      M = THETA/10
   30 BI = AI/M
      AI = AI - BI*M
      IF (IHTOD.NE.0 .OR. BI.NE.0) IHTOD = PFA(IABS(BI),IHTOD)
      M = M/10
      IF (M) 30, 20, 30
   40 IF (S.GT.0) S = 36
      IF (S.LT.0) S = 37
      IHTOD = PFA(S,INV(IHTOD))
      RETURN
      END
C*-*-*-*-*-*ILCM        *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-ILC   10
      INTEGER FUNCTION ILCM(A, B)                                       ILC   20
      INTEGER A, B, D, E, F
      ILCM = 0
      IF (A.EQ.0) RETURN
      IF (B.EQ.0) RETURN
      D = IGCD(A,B)
      E = IQ(B,D)
      CALL ERLA(D)
      F = IPROD(A,E)
      CALL ERLA(E)
      ILCM = IABSL(F)
      CALL ERLA(F)
      RETURN
      END
C*-*-*-*-*-*IMADD       *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-IMA   10
      INTEGER FUNCTION IMADD(A, B, C)                                   IMA   20
      INTEGER A, B, C, D, E, F, G, H, T
      INTEGER FIRST, TAIL, PFA
      T = A
      G = C
      H = 0
   10 F = FIRST(T)
      E = B
      CALL MPY(E, F)
      CALL ADD3(G, F, H)
      CALL ALTER(F, T)
      H = E
      E = T
      T = TAIL(T)
      IF (T.NE.0) GO TO 10
      D = A
      G = G + H
      IF (G.EQ.0) GO TO 20
      F = PFA(G,0)
      CALL SSUCC(F, E)
   20 IMADD = D
      RETURN
      END
C*-*-*-*-*-*INEG        *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-INE   10
      INTEGER FUNCTION INEG(A)                                          INE   20
      INTEGER A, AI, B, U, INV, PFA
      B = 0
      IF (A.EQ.0) GO TO 20
      U = A
   10 CALL ADV(AI, U)
      B = PFA(-AI,B)
      IF (U.NE.0) GO TO 10
      B = INV(B)
   20 INEG = B
      RETURN
      END
C*-*-*-*-*-*IPOWER      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-IPO   10
      INTEGER FUNCTION IPOWER(A, N)                                     IPO   20
      INTEGER A, B, C, BORROW, PFA, IPROD
      IF (N.NE.0) GO TO 10
      B = PFA(1,0)
      GO TO 30
   10 B = BORROW(A)
      IF (A.EQ.0) GO TO 30
      J = 1
   20 IF (J.EQ.N) GO TO 30
      C = IPROD(B,A)
      CALL ERLA(B)
      B = C
      J = J + 1
      GO TO 20
   30 IPOWER = B
      RETURN
      END
C*-*-*-*-*-*IPROD       *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-IPR   10
      INTEGER FUNCTION IPROD(A, B)                                      IPR   20
      INTEGER A, B, C, E, F, G, S, T, U, V, W, X, Z, AI, BJ
      INTEGER FIRST, TAIL, PFA, LENGTH
      C = 0
      IF (A.EQ.0 .OR. B.EQ.0) GO TO 50
      S = PFA(0,0)
      T = PFA(0,S)
      M = LENGTH(A) + LENGTH(B) - 2
      C = T
      IF (M.EQ.0) GO TO 20
      DO 10 I=1,M
        C = PFA(0,C)
   10 CONTINUE
   20 V = B
      W = C
   30 X = A
      CALL ADV(BJ, V)
      Z = W
      G = 0
   40 CALL ADV(AI, X)
      F = BJ
      CALL MPY(AI, F)
      E = FIRST(Z)
      CALL ADD3(G, E, F)
      CALL ALTER(E, Z)
      G = AI + G
      Z = TAIL(Z)
      IF (X.NE.0) GO TO 40
      CALL ALTER(G, Z)
      W = TAIL(W)
      IF (V.NE.0) GO TO 30
      IF (G.NE.0) GO TO 50
      CALL SSUCC(0, T)
      CALL DECAP(G, S)
   50 IPROD = C
      RETURN
      END
C*-*-*-*-*-*IQ          *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-IQ    10
      INTEGER FUNCTION IQ(A, B)                                         IQ    20
      INTEGER A, B, L, Q, R, IQR
      L = IQR(A,B)
      CALL DECAP(Q, L)
      CALL DECAP(R, L)
      CALL ERLA(R)
      IQ = Q
      RETURN
      END
C*-*-*-*-*-*IQR         *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-IQR   10
      INTEGER FUNCTION IQR(A, B)                                        IQR   20
      COMMON /TR3/ BETA, THETA
      INTEGER BETA, THETA
      INTEGER BORROW, FIRST, IPROD, IQRS, ISIGNL, LENGTH, PFA, PFL, TAIL
      INTEGER A, A1, A2, A3, ABAR, B, B1, B2, BBAR, C, C1, C2, D, E, F,
     * I, J, K
      INTEGER L, L1, L2, M, N, Q, QBAR, R, R1, R2, S, T, U, V, W, X
      Q = 0
      IF (A.NE.0 .AND. B.NE.0) GO TO 10
      R = BORROW(A)
      GO TO 210
   10 IF (TAIL(B).NE.0) GO TO 20
      B1 = FIRST(B)
      L = IQRS(A,B1)
      CALL DECAP(Q, L)
      CALL DECAP(R, L)
      IF (R.NE.0) R = PFA(R,0)
      GO TO 210
   20 M = LENGTH(A)
      N = LENGTH(B)
      K = M - N
      IF (K.GE.0) GO TO 30
      R = BORROW(A)
      GO TO 210
   30 S = ISIGNL(A)
      U = B
      J = N - 1
      DO 40 I=1,J
        U = TAIL(U)
   40 CONTINUE
      C = FIRST(U)
      T = 1
      IF (C.GE.0) GO TO 50
      T = -1
      C = -C
   50 D = BETA/(C+1)
      W = S*T
      E = PFA(S*D,0)
      ABAR = IPROD(A,E)
      CALL ALTER(T*D, E)
      BBAR = IPROD(B,E)
      CALL ERLA(E)
      U = ABAR
      L1 = 0
      J = K + 1
      DO 60 I=1,J
        L1 = PFA(U,L1)
        U = TAIL(U)
   60 CONTINUE
      L2 = L1
      J = N - 2
      IF (J.EQ.0) GO TO 80
      DO 70 I=1,J
        L2 = PFA(U,L2)
        U = TAIL(U)
   70 CONTINUE
   80 IF (TAIL(U).NE.0) GO TO 90
      V = PFA(0,0)
      CALL SSUCC(V, U)
   90 U = BBAR
      J = N - 2
      IF (J.EQ.0) GO TO 110
      DO 100 I=1,J
        U = TAIL(U)
  100 CONTINUE
  110 CALL ADV(B2, U)
      CALL ADV(B1, U)
  120 U = FIRST(L2)
      CALL ADV(A3, U)
      CALL ADV(A2, U)
      CALL ADV(A1, U)
      IF (A1.LT.B1) GO TO 130
      QBAR = BETA - 1
      GO TO 140
  130 E = A1
      F = A2
      CALL QR(E, F, B1)
      QBAR = E
  140 C1 = QBAR
      C2 = B1
      CALL MPY(C1, C2)
      R1 = A1 - C1
      R2 = A2 - C2
      IF (R2.GE.0) GO TO 150
      R2 = R2 + BETA
      R1 = R1 - 1
  150 IF (R1.GT.0) GO TO 160
      C1 = QBAR
      C2 = B2
      CALL MPY(C1, C2)
      R1 = R2 - C1
      IF (R1.GT.0) GO TO 160
      R2 = A3 - C2
      IF (R1.GE.0 .AND. R2.GE.0) GO TO 160
      QBAR = QBAR - 1
      GO TO 140
  160 U = FIRST(L1)
      V = BBAR
      C1 = 0
  170 E = -QBAR
      CALL ADV(F, V)
      CALL MPY(E, F)
      A1 = FIRST(U)
      CALL ADD3(C1, A1, F)
      IF (A1.GE.0) GO TO 180
      A1 = A1 + BETA
      C1 = C1 - 1
  180 C1 = C1 + E
      CALL ALTER(A1, U)
      X = U
      U = TAIL(U)
      IF (V.NE.0) GO TO 170
      CALL DECAP(A1, U)
      CALL SSUCC(0, X)
      A1 = A1 + C1
      IF (A1.EQ.0) GO TO 200
      U = FIRST(L1)
      V = BBAR
      C1 = 0
      QBAR = QBAR - 1
  190 A1 = FIRST(U)
      CALL ADV(B1, V)
      CALL ADD3(C1, A1, B1)
      CALL ALTER(A1, U)
      U = TAIL(U)
      IF (V.NE.0) GO TO 190
  200 IF (QBAR.NE.0 .OR. Q.NE.0) Q = PFA(W*QBAR,Q)
      L1 = TAIL(L1)
      CALL DECAP(U, L2)
      IF (L1.NE.0) GO TO 120
      L = IQRS(ABAR,S*D)
      CALL DECAP(R, L)
      CALL DECAP(U, L)
      CALL ERLA(BBAR)
      CALL ERLA(L2)
      CALL ERLA(ABAR)
  210 IQR = PFL(Q,PFL(R,0))
      RETURN
      END
C*-*-*-*-*-*IQRS        *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-IQR   10
      INTEGER FUNCTION IQRS(A, B)                                       IQR   20
      INTEGER A, B, C, E, F, Q
      INTEGER CINV, PFA, PFL
      Q = 0
      E = 0
      IF (A.EQ.0) GO TO 20
      C = CINV(A)
   10 CALL DECAP(F, C)
      CALL QR(E, F, B)
      IF (Q.NE.0 .OR. E.NE.0) Q = PFA(E,Q)
      E = F
      IF (C.NE.0) GO TO 10
   20 IQRS = PFL(Q,PFA(E,0))
      RETURN
      END
C*-*-*-*-*-*IREAD       *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-IRE   10
      INTEGER FUNCTION IREAD(U)                                         IRE   20
      COMMON /TR1/ AVAIL, STAK, RECORD(72)
      INTEGER AVAIL, STAK, RECORD, U
      INTEGER PFA, IDTOB, INV
      INTEGER B, N
      B = 0
      CALL READ(U, RECORD)
      IF (RECORD(1).NE.-1) GO TO 10
      IREAD = -1
      RETURN
   10 DO 20 N=1,72
        IF (RECORD(N).EQ.44) GO TO 30
        B = PFA(RECORD(N),B)
   20 CONTINUE
      CALL READ(U, RECORD)
      IF (RECORD(1).GE.0) GO TO 10
   30 B = INV(B)
      IREAD = IDTOB(B)
      CALL ERLA(B)
      RETURN
      END
C*-*-*-*-*-*IREM        *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-IRE   10
      INTEGER FUNCTION IREM(A, B)                                       IRE   20
      INTEGER A, B, L, Q, R
      L = IQR(A,B)
      CALL DECAP(Q, L)
      CALL DECAP(R, L)
      CALL ERLA(Q)
      IREM = R
      RETURN
      END
C*-*-*-*-*-*ISIGNL      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-ISI   10
      INTEGER FUNCTION ISIGNL(A)                                        ISI   20
      INTEGER A, B, S, T
      S = 0
      IF (A.EQ.0) GO TO 20
      T = A
   10 CALL ADV(B, T)
      IF (B.EQ.0) GO TO 10
      S = 1
      IF (B.LT.0) S = -1
   20 ISIGNL = S
      RETURN
      END
C*-*-*-*-*-*ISUM        *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-ISU   10
      INTEGER FUNCTION ISUM(A, B)                                       ISU   20
      INTEGER A, B, C, F, G, AI, BI, DI, EI, S, T, U, V
      INTEGER BORROW, FIRST, INV, PFA, TAIL, ISIGNL
      IF (A.NE.0) GO TO 10
      C = BORROW(B)
      GO TO 140
   10 IF (B.NE.0) GO TO 20
      C = BORROW(A)
      GO TO 140
   20 C = 0
      U = A
      V = B
      S = ISIGNL(A)
      T = ISIGNL(B)
      IF (S+T.EQ.0) GO TO 70
      DI = 0
   30 CALL ADV(AI, U)
      CALL ADV(BI, V)
      CALL ADD3(DI, AI, BI)
      C = PFA(AI,C)
      IF (U.NE.0) GO TO 40
      U = V
      GO TO 60
   40 IF (V.NE.0) GO TO 30
   50 CALL ADV(AI, U)
      CALL ADD3(DI, AI, 0)
      C = PFA(AI,C)
   60 IF (U.NE.0) GO TO 50
      IF (DI.NE.0) C = PFA(DI,C)
      C = INV(C)
      GO TO 140
   70 F = 0
   80 CALL ADV(AI, U)
      CALL ADV(BI, V)
      DI = AI + BI
      IF (DI.NE.0) F = DI
      C = PFA(DI,C)
      IF (U.NE.0) GO TO 90
      U = V
      GO TO 110
   90 IF (V.NE.0) GO TO 80
  100 CALL ADV(F, U)
      C = PFA(F,C)
  110 IF (U.NE.0) GO TO 100
      IF (F.NE.0) GO TO 120
      CALL ERLA(C)
      C = 0
      GO TO 140
  120 C = INV(C)
      S = 1
      IF (F.LT.0) S = -1
      F = 0
      EI = 0
      U = C
  130 DI = FIRST(U)
      CALL COMPAT(S, EI, DI)
      IF (DI.NE.0) F = U
      CALL ALTER(DI, U)
      U = TAIL(U)
      IF (U.NE.0) GO TO 130
      G = TAIL(F)
      IF (G.EQ.0) GO TO 140
      CALL SSUCC(0, F)
      CALL ERLA(G)
  140 ISUM = C
      RETURN
      END
C*-*-*-*-*-*IWRITE      *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-IWR   10
      SUBROUTINE IWRITE(U, A)                                           IWR   20
      COMMON /TR1/ AVAIL, STAK, RECORD(72)
      INTEGER AVAIL, STAK, RECORD, U, A
      INTEGER IBTOD, N, B, C
      B = IBTOD(A)
   10 DO 20 N=1,72
        IF (B.EQ.0) GO TO 30
        CALL DECAP(C, B)
        RECORD(N) = C
   20 CONTINUE
      CALL WRITE(U, RECORD)
      GO TO 10
   30 DO 40 I=N,72
        RECORD(I) = 44
   40 CONTINUE
      CALL WRITE(U, RECORD)
      RETURN
      END
C     PROGRAM GROEB
C                                                                       MAN   10
C                                                                       MAN   20
C                                                                       MAN   30
C                             GROEB                                     MAN   40
C                                                                       MAN   50
C     A PROGRAM PACKAGE FOR COMPUTING GROEBNER-BASES OF POLYNOMIAL      MAN   60
C            IDEALS OVER THE FIELD OF RATIONAL INTEGERS                 MAN   70
C                                                                       MAN   80
C                                                                       MAN   90
C                          FRANZ WINKLER                                MAN  100
C                    INSTITUT FUER MATHEMATIK                           MAN  110
C                  JOHANNES KEPLER UNIVERSITAET                         MAN  120
C                       A-4040 LINZ, AUSTRIA                            MAN  130
C                                                                       MAN  140
C                                                                       MAN  150
C                                                                       MAN  160
C     THE PACKAGE IS BUILT ON TOP OF THE SAC-1 SYSTEM, WHICH HAS BEEN   MAN  170
C     DEVELOPED AT THE UNIVERSITY OF WISCONSIN, MADISON, FOR SYMBOLIC   MAN  180
C     AND ALGEBRAIC COMPUTATION. FROM THE SAC-1 SYSTEM ONLY THE SUB-    MAN  190
C     SYSTEMS CONCERNING LIST PROCESSING AND INTEGER ARITHMETIC ARE USEDMAN  200
C     (SEE                                                              MAN  210
C          G.E. COLLINS: THE SAC-1 LEST PROCESSING SYSTEM,              MAN  220
C               TECHN. REP. NR. 129, COMP. SCI. DEPT.,                  MAN  230
C               UNIV. OF WISCONSIN, MADISON (1971)                      MAN  240
C      AND                                                              MAN  250
C          G.E. COLLINS: THE SAC-1 INTEGER ARITHMETIC SYSTEM,           MAN  260
C               TECHN. REP. NR. 156, COMP. SCI. DEPT.,                  MAN  270
C               UNIV. OF WISCONSIN, MADISON (1971)                      MAN  280
C      FOR AN INTRODUCTION).                                            MAN  290
C     THUS, BEFORE STARTING TO CALL GBASIS WE HAVE TO INITIATE SOME OF  MAN  300
C     THE SYSTEM VARIABLES OF SAC-1.                                    MAN  310
C                                                                       MAN  320
C                                                                       MAN  330
C                                                                       MAN  340
C                                                                       MAN  350
C     THE MAIN PROGRAM KEEPS                                            MAN  360
C         - READING IN A SEQUENCE OF POLYNOMIALS                        MAN  370
C         - COMPUTING THE GROEBNER-BASIS                                MAN  380
C         - PRINTING THE GROEBNER-BASIS                                 MAN  390
C     UNTIL THE NUMBER OF VARIABLES IS SET TO 0.                        MAN  400
C                                                                       MAN  410
C                                                                       MAN  420
C                                                                       MAN  430
C                                                                       MAN  440
C     A SEQUENCE OF POLYNOMIALS HAS TO BE PRESENTED FOR INPUT IN THE    MAN  450
C     FOLLOWING FORMAT:                                                 MAN  460
C     NUMBER OF VARIABLES (FORMAT I2)                                   MAN  470
C     NUMBER OF POLYNOMIALS IN THE BASIS (FORMAT I2)                    MAN  480
C     FOR EACH POLYNOMIAL:                                              MAN  490
C     NUMBER OF TERMS (FORMAT I2)                                       MAN  500
C     FOR EACH TERM (ORDERED WITH RESPECT TO LINORD):                   MAN  510
C     NUMERATOR OF THE COEFFICIENT                                      MAN  520
C     DENOMINATOR OF THE COEFFICIENT                                    MAN  530
C     EXPONENTS (FORMAT NI3, IF N IS THE NUMBER OF VARIABLES).          MAN  540
C                                                                       MAN  550
C                                                                       MAN  560
C     EXAMPLE:                                                          MAN  570
C     THE SEQUENCE                                                      MAN  580
C                    2                                                  MAN  590
C           F1 =    X Y  -  XY                                          MAN  600
C                                                                       MAN  610
C                     2                                                 MAN  620
C           F2 =    XY   +  XY  +  Y                                    MAN  630
C                                                                       MAN  640
C     HAS TO BE PRESENTED AS                                            MAN  650
C      2                                                                MAN  660
C      2                                                                MAN  670
C      2                                                                MAN  680
C     +1                                                                MAN  690
C     +1                                                                MAN  700
C       2  1                                                            MAN  710
C     -1                                                                MAN  720
C     +1                                                                MAN  730
C       1  1                                                            MAN  740
C      3                                                                MAN  750
C     +1                                                                MAN  760
C     +1                                                                MAN  770
C       1  2                                                            MAN  780
C     +1                                                                MAN  790
C     +1                                                                MAN  800
C       1  1                                                            MAN  810
C     +1                                                                MAN  820
C     +1                                                                MAN  830
C       0  1                                                            MAN  840
C                                                                       MAN  850
C                                                                       MAN  860
C                                                                       MAN  870
C                                                                       MAN  880
C     THE FIRST CARD READ BY THE PROGRAM HAS TO BE THE CHARACTER        MAN  890
C     CONTROL CARD, CONSISTING OF THE SAC-1 CHARACTERS:                 MAN  900
C     0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ+-*/(),. =$                   MAN  910
C                                                                       MAN  920
C                                                                       MAN  930
C                                                                       MAN  940
C                                                                       MAN  950
      INTEGER AVAIL, STACK, RECORD, SYMLST, BETA, THETA, OUT            MAN  960
      INTEGER SPACE, F, G, READLP                                       MAN  970
      COMMON /TR1/ AVAIL, STAK, RECORD(72)                              MAN  980
      COMMON /TR2/ SYMLST                                               MAN  990
      COMMON /TR3/ BETA, THETA                                          MAN 1000
      COMMON /S/ SPACE(20000)                                           MAN 1010
      COMMON /VAR/ N                                                    MAN 1020
      COMMON /OUTPUT/ OUT                                               MAN 1030
      IN = 5                                                            MAN 1040
      OUT = 6                                                           MAN 1050
      CALL INITIO(IN)                                                   MAN 1060
      CALL BEGIN                                                        MAN 1070
      SYMLST = 0                                                        MAN 1080
      BETA = 2**14                                                      MAN 1090
      THETA = 10**5                                                     MAN 1100
   10 READ (IN,99999) N                                                 MAN 1110
99999 FORMAT (I2)                                                       MAN 1120
      IF (N.EQ.0) STOP                                                  MAN 1130
      F = READLP(IN)                                                    MAN 1140
      WRITE (OUT,99998)                                                 MAN 1150
99998 FORMAT (1H1, 1HG, 1HI, 1HV, 1HE, 1HN, 1H , 1HB, 1HA, 1HS, 1HI,    MAN 1160
     * 1HS, 1H , 1HF)                                                   MAN 1170
      CALL WRITLP(OUT, F)                                               MAN 1180
      CALL GBASIS(F, G, N)                                              MAN 1190
      WRITE (OUT,99997)                                                 MAN 1200
99997 FORMAT (1H1, 1HG, 1HR, 1HO, 1HE, 1HB, 1HN, 1HE, 1HR, 1HB, 1HA,    MAN 1210
     * 1HS, 1HI, 1HS, 1H , 1HG)                                         MAN 1220
      CALL WRITLP(OUT, G)                                               MAN 1230
      CALL ERASE(F)                                                     MAN 1240
      CALL ERASE(G)                                                     MAN 1250
      GO TO 10                                                          MAN 1260
      END                                                               MAN 1270
C                                                                       GBA   10
C                                                                       GBA   20
C                                                                       GBA   30
C                                                                       GBA   40
C                                                                       GBA   50
C                                                                       GBA   60
      SUBROUTINE GBASIS(F, G, N)                                        GBA   70
C     FOR THE INPUT
C          F ... A FINITE SEQUENCE OF MULTIVARIATE POLYNOMIALS
C          N ... NUMBER OF VARIABLES
C     GBASIS COMPUTES THE OUTPUT
C          G ... A FINITE SEQUENCE OF MULTIVARIATE POLYNOMIALS
C     SUCH THAT
C          THE IDEAL GENERATED BY F =
C               THE IDEAL GENERATED BY G, AND
C          G IS A (MINIMAL NORMED) GROEBNER-BASIS.
C
C     REFERENCE TO LITERATURE:
C     A COMPLETE REFERENCE TO THE THEORETICAL WORK ON WHICH THE
C     ALGORITHM IS BASED IS GIVEN IN THE ACCOMPANYING PAPER.
C
C     THE SUBROUTINE GROEB USES THE SUBROUTINES FROM THE
C     SAC-1 LIST PROCESSING SYSTEM AND THE SAC-1 INTEGER ARITHMETIC
C     SYSTEM, WHICH WE DO NOT INCLUDE IN THE FOLLOWING LISTING.
C     (CORRESPONDINGLY, A CALL OF THE SUBROUTINE  ERASE  WILL
C     APPEAR ON NUMEROUS PLACES IN THE PROGRAM FOR GARBAGE
C     COLLECTION PURPOSES.)
C
C     THE OVERALL LOGICAL STRUCTURE OF THE PROGRAM GROEB EXACTLY
C     CORRESPONDS TO THE DESCRIPTION IN SECTION 1. SOME STRAIGHT-
C     FORWARD MODIFICATIONS ARE DUE TO THE USE OF   FORTRAN
C     LANGUAGE FEATURES AND THE NEED FOR GENERATING THE AUXILIARY
C     ARRAY  AUX  (SEE THE INSTRUCTION  CALL CREAUX(G,AUX)  ).
C
C
      INTEGER F, G, B, AUX, OUT, H1, H2, H, GM
      INTEGER COPY, CRIT, SPOL, CONC, PFL, AVAIL
      COMMON /OUTPUT/ OUT
      COMMON /TR1/ AVAIL, STAK, RECORD(72)
      DIMENSION B(40,40), AUX(40)
      G = COPY(F)
      CALL CREAUX(G, AUX)
      CALL BINIT(G, B)
   10 CALL SELB(B, G, AUX, I, J)
      IF (I.EQ.0) GO TO 30
      B(I,J) = 0
      IF (CRIT(G,AUX,B,I,J).EQ.0) GO TO 10
      H1 = SPOL(AUX(I),AUX(J))
      H2 = NORMF(G,AUX,H1)
      H = NORM(H2)
      CALL ERASE(H1)
      CALL ERASE(H2)
      IF (H.EQ.0) GO TO 10
      G = CONC(G,PFL(H,0))
      L = LENGTH(G)
      IF (L.LE.40) GO TO 20
      WRITE (OUT,99999)
99999 FORMAT (1H1, 1HL, 1HE, 1HN, 1HG, 1HT, 1HH, 1H , 1HO, 1HF, 1H ,
     * 1HS, 1HE, 1HQ, 1HU, 1HE, 1HN, 1HC, 1HE, 1H , 1HO, 1HF, 1H , 1HP,
     * 1HO, 1HL, 1HI, 1HN, 1HO, 1HM, 1HI, 1HA, 1HL, 1HS, 1H , 1HE, 1HX,
     * 1HC, 1HE, 1HE, 1HD, 1HS, 1H , 1H4, 1H0)
      STOP
   20 AUX(L) = H
      CALL COMPL(B, L)
      GO TO 10
   30 CONTINUE
      GM = MINOR(G)
      CALL ERASE(G)
      G = GM
      RETURN
      END
C                                                                       COP   10
C                                                                       COP   20
C                                                                       COP   30
C                                                                       COP   40
C                                                                       COP   50
C                                                                       COP   60
      INTEGER FUNCTION COPY(X)                                          COP   70
C     FOR THE INPUT
C          X ... A SAC-1 LIST (IN PARTICULAR A SEQUENCE OF
C                POLYNOMIALS)
C     COPY(X) IS A COPY OF THE LIST X  (REFERENCE COUNTS IN
C          THE SENSE OF SAC-1 ARE SET TO 1).
C
C
      COMMON /TR1/ AVAIL, STAK, RECORD(72)
      INTEGER AVAIL, STAK, RECORD
      INTEGER FIRST, TAIL, TYPE, PFL, PFA
      INTEGER X, ARG, OLDSTK, RET, H1
      ARG = X
      OLDSTK = STAK
   10 IF (ARG.NE.0) GO TO 20
      RET = 0
      GO TO 60
   20 CALL STACK3(ARG, 0, 1)
      ARG = TAIL(ARG)
      GO TO 10
   30 H1 = RET
      IF (TYPE(ARG).EQ.1) GO TO 40
      RET = PFA(FIRST(ARG),H1)
      GO TO 60
   40 CALL STACK3(ARG, H1, 2)
      ARG = FIRST(ARG)
      GO TO 10
   50 RET = PFL(RET,H1)
      GO TO 60
   60 IF (STAK.EQ.OLDSTK) GO TO 70
      CALL UNSTK3(ARG, H1, I)
      GO TO (30, 50), I
   70 COPY = RET
      RETURN
      END
C                                                                       CRE   10
C                                                                       CRE   20
C                                                                       CRE   30
C                                                                       CRE   40
C                                                                       CRE   50
C                                                                       CRE   60
      SUBROUTINE CREAUX(PLIST, AUX)                                     CRE   70
C     FOR THE INPUT
C          PLIST ... A FINITE SEQUENCE OF POLYNOMIALS
C     CREAUX COMPUTES THE OUTPUT
C          AUX ..... A ONE-DIMENSIONAL INTEGER ARRAY
C     SUCH THAT
C          AUX(I) IS THE POINTER TO THE I-TH POLYNOMIAL IN  PLIST
C          FOR ALL  1 <= I <= LENGTH OF PLIST.
C
C
      INTEGER PLIST, AUX, OUT, PL, FIRST, TAIL
      COMMON /OUTPUT/ OUT
      DIMENSION AUX(40)
      L = LENGTH(PLIST)
      IF (L.EQ.0) RETURN
      IF (L.LE.40) GO TO 10
      WRITE (OUT,99999)
99999 FORMAT (1H1, 1HL, 1HE, 1HN, 1HG, 1HT, 1HH, 1H , 1HO, 1HF, 1H ,
     * 1HS, 1HE, 1HQ, 1HU, 1HE, 1HN, 1HC, 1HE, 1H , 1HO, 1HF, 1H , 1HP,
     * 1HO, 1HL, 1HI, 1HN, 1HO, 1HM, 1HI, 1HA, 1HL, 1HS, 1H , 1HE, 1HX,
     * 1HC, 1HE, 1HE, 1HD, 1HS, 1H , 1H4, 1HO)
      STOP
   10 PL = PLIST
      DO 20 I=1,L
        AUX(I) = FIRST(PL)
        PL = TAIL(PL)
   20 CONTINUE
      RETURN
      END
C                                                                       SEL   10
C                                                                       SEL   20
C                                                                       SEL   30
C                                                                       SEL   40
C                                                                       SEL   50
C                                                                       SEL   60
      SUBROUTINE SELB(B, PLIST, AUX, I, J)                              SEL   70
C     FOR THE INPUT
C          B ....... AN INTEGER ARRAY OF DIMENSION
C                    (LENGTH OF PLIST,LENGTH OF PLIST)
C          PLIST ... A FINITE SEQUENCE OF POLYNOMIALS
C          AUX ..... A ONE-DIMENSIONAL INTEGER ARRAY POINTING TO
C                    THE POLYNOMIALS IN PLIST
C     SELB IN THE NORMAL CASE COMPUTES THE OUTPUT
C          I ....... AN INTEGER (1<=I<=LENGTH OF PLIST)
C          J ....... AN INTEGER (1<=J<=LENGTH OF PLIST)
C     SUCH THAT
C          I < J,
C          B(I,J) = 1    (I.E. THE REDUCTION CORRESPONDING TO THE
C               INDICES I AND J HAS NOT YET BEEN CARRIED OUT),
C          LEAST COMMON MULTIPLE OF THE HEADTERMS OF THE I-TH AND
C               J-TH POLYNOMIAL IS MINIMAL (WITH RESPECT TO THE
C               TERM ORDERING) AMONG THE LEAST COMMON MULTIPLES
C               OF THE HEADTERMS OF THE I'-TH AND J'-TH POLYNOMIAL
C               FOR ALL REMAINING I',J' WITH B(I',J')=1.
C     (IF NO SUCH I,J EXIST, SELB RETURNS I=0).
C
C
      INTEGER B, PLIST, AUX, EXP, EXPK, EXP1
      INTEGER BORROW, FIRST
      DIMENSION B(40,40), AUX(40)
      L = LENGTH(PLIST)
      I = 0
      IF (L.LE.1) RETURN
      L1 = L - 1
      DO 40 K=1,L1
        K1 = K + 1
        EXPK = FIRST(FIRST(AUX(K)))
        DO 30 M=K1,L
          IF (B(K,M).EQ.0) GO TO 30
          IF (I.NE.0) GO TO 10
          I = K
          J = M
          EXP = LCM(EXPK,FIRST(FIRST(AUX(M))))
          GO TO 30
   10     EXP1 = LCM(EXPK,FIRST(FIRST(AUX(M))))
          IF (LINORD(EXP1,EXP).NE.2) GO TO 20
          I = K
          J = M
          CALL ERASE(EXP)
          EXP = EXP1
          GO TO 30
   20     CALL ERASE(EXP1)
   30   CONTINUE
   40 CONTINUE
      IF (I.NE.0) CALL ERASE(EXP)
      RETURN
      END
C                                                                       SPO   10
C                                                                       SPO   20
C                                                                       SPO   30
C                                                                       SPO   40
C                                                                       SPO   50
C                                                                       SPO   60
      INTEGER FUNCTION SPOL(P, Q)                                       SPO   70
C     FOR THE INPUT
C          P ... A POLYNOMIAL
C          Q ... A POLYNOMIAL
C     SPOL(P,Q) IS THE S-POLYNOMIAL OF P AND Q (SEE /4/).
C
C
      INTEGER P, Q, RP, RQ, HEXP, HEXQ, HEXPQ, MEXP, MEXQ, PE, QE, SP,
     * SQ
      INTEGER TAIL, FIRST, QUOTEE, PRODPE, PRODPR, DIFFPP
      RP = TAIL(FIRST(P))
      RQ = TAIL(FIRST(Q))
      HEXP = FIRST(FIRST(P))
      HEXQ = FIRST(FIRST(Q))
      HEXPQ = LCM(HEXP,HEXQ)
      MEXP = QUOTEE(HEXPQ,HEXP)
      MEXQ = QUOTEE(HEXPQ,HEXQ)
      PE = PRODPE(P,MEXP)
      QE = PRODPE(Q,MEXQ)
      SP = PRODPR(PE,RQ)
      SQ = PRODPR(QE,RP)
      SPOL = DIFFPP(SP,SQ)
      CALL ERASE(HEXPQ)
      CALL ERASE(MEXP)
      CALL ERASE(MEXQ)
      CALL ERASE(PE)
      CALL ERASE(QE)
      CALL ERASE(SP)
      CALL ERASE(SQ)
      RETURN
      END
C                                                                       NOR   10
C                                                                       NOR   20
C                                                                       NOR   30
C                                                                       NOR   40
C                                                                       NOR   50
C                                                                       NOR   60
      INTEGER FUNCTION NORMF(PLIST, AUX, P)                             NOR   70
C     FOR THE INPUT
C          PLIST ... A FINITE SEQUENCE OF POLYNOMIALS
C          AUX ..... A ONE-DIMENSIONAL INTEGER ARRAY POINTING TO
C                    THE POLYNOMIALS IN PLIST
C          P ....... A POLYNOMIAL
C     NORMF(PLIST,P) IS A POLYNOMIAL SUCH THAT
C          P IS REDUCIBLE TO NORMF(PLIST,P) MODULO PLIST AND
C          NORMF(PLIST,P) IS IN NORMALFORM WITH RESPECT TO PLIST.
C
C
      INTEGER PLIST, AUX, P, POINT, T, Q, S, HCQ, A, R, H1, H
      INTEGER BORROW, QUOTEE, FIRST, TAIL, QUOT, PRODPE, PRODPR, DIFFPP
      DIMENSION AUX(40)
      NORMF = BORROW(P)
      POINT = 0
   10 CALL SEL(PLIST, AUX, NORMF, POINT, T, Q)
      IF (T.EQ.0) RETURN
      S = QUOTEE(FIRST(T),FIRST(FIRST(Q)))
      HCQ = TAIL(FIRST(Q))
      A = QUOT(TAIL(T),HCQ)
      R = PRODPE(Q,S)
      H1 = PRODPR(R,A)
      H = DIFFPP(NORMF,H1)
      CALL ERASE(S)
      CALL ERASE(A)
      CALL ERASE(R)
      CALL ERASE(H1)
      CALL ERASE(NORMF)
      NORMF = H
      GO TO 10
      END
C                                                                       NOR   10
C                                                                       NOR   20
C                                                                       NOR   30
C                                                                       NOR   40
C                                                                       NOR   50
C                                                                       NOR   60
      INTEGER FUNCTION NORM(P)                                          NOR   70
C     FOR THE INPUT
C          P ... A POLYNOMIAL
C     NORM(P) IS THE POLYNOMIAL WHICH RESULTS FROM DIVIDING
C          P BY ITS HEADCOEFFICIENT.
C
C
      INTEGER P
      INTEGER CINV, FIRST, TAIL, PRODPR
      IF (P.NE.0) GO TO 10
      NORM = 0
      RETURN
   10 INVHC = CINV(TAIL(FIRST(P)))
      NORM = PRODPR(P,INVHC)
      CALL ERASE(INVHC)
      RETURN
      END
C                                                                       MIN   10
C                                                                       MIN   20
C                                                                       MIN   30
C                                                                       MIN   40
C                                                                       MIN   50
C                                                                       MIN   60
      INTEGER FUNCTION MINOR(PLIST)                                     MIN   70
C     FOR THE INPUT
C          PLIST ... A GROEBNER-BASIS
C     MINOR(PLIST) IS THE UNIQUE MINIMAL NORMED AND ORDERED
C          GROEBNER-BASIS EQUIVALENT TO PLIST (SEE /5/).
C
C
      INTEGER PLIST, AUX, DEL, AUXM, ORD, EP, EQ, P, P1, P1N, PN, Q
      INTEGER BORROW, FIRST, TAIL, PFL
      INTEGER AVAIL
      COMMON /TR1/ AVAIL, STAK, RECORD(72)
      DIMENSION AUX(40), DEL(40), AUXM(40), ORD(40)
      L = LENGTH(PLIST)
      IF (L.GT.1) GO TO 10
      MINOR = BORROW(PLIST)
      RETURN
   10 CALL CREAUX(PLIST, AUX)
      DO 20 I=1,L
        DEL(I) = 0
   20 CONTINUE
      DO 50 I=1,L
        P = AUX(I)
        IF (P.NE.0) GO TO 30
        DEL(I) = 1
        GO TO 50
   30   EP = FIRST(FIRST(P))
        DO 40 J=1,L
          IF (I.EQ.J .OR. DEL(J).EQ.1) GO TO 40
          Q = AUX(J)
          EQ = FIRST(FIRST(Q))
          M = MORD(EP,EQ)
          IF (M.NE.1) GO TO 40
          DEL(I) = 1
          GO TO 50
   40   CONTINUE
   50 CONTINUE
      MI = 0
      DO 60 I=1,L
        IF (DEL(I).EQ.0) MI = PFL(BORROW(AUX(I)),MI)
   60 CONTINUE
      MI = INV(MI)
      LMI = LENGTH(MI)
      IF (LMI.GT.1) GO TO 70
      MINOR = MI
      RETURN
   70 MIN = 0
      CALL CREAUX(MI, AUXM)
      DO 80 I=1,LMI
        P = AUXM(I)
        P1 = TAIL(P)
        P1N = NORMF(MI,AUXM,P1)
        PN = PFL(BORROW(FIRST(P)),P1N)
        MIN = PFL(PN,MIN)
   80 CONTINUE
      CALL ERASE(MI)
      MIN = INV(MIN)
      CALL CREAUX(MIN, AUXM)
      DO 90 I=1,LMI
        ORD(I) = I
   90 CONTINUE
      LMI1 = LMI - 1
      DO 110 J=1,LMI1
        DO 100 I=1,LMI1
          K = ORD(I)
          M = ORD(I+1)
          L = LINORD(FIRST(FIRST(AUXM(K))),FIRST(FIRST(AUXM(M))))
          IF (L.NE.1) GO TO 100
          ORD(I) = M
          ORD(I+1) = K
  100   CONTINUE
  110 CONTINUE
      MINOR = 0
      DO 120 I=1,LMI
        MINOR = PFL(BORROW(AUXM(ORD(I))),MINOR)
  120 CONTINUE
      MINOR = INV(MINOR)
      CALL ERASE(MIN)
      RETURN
      END
C                                                                       BIN   10
C                                                                       BIN   20
C                                                                       BIN   30
C                                                                       BIN   40
C                                                                       BIN   50
C                                                                       BIN   60
      SUBROUTINE BINIT(PLIST, B)                                        BIN   70
C     FOR THE INPUT
C          PLIST ... A FINITE SEQUENCE OF POLYNOMIALS
C     BINIT COMPUTES THE OUTPUT
C          B ....... AN INTEGER ARRAY OF DIMENSION
C                    (LENGTH OF PLIST,LENGTH OF PLIST)
C     SUCH THAT
C          B(I,J) = 1, IF 1<=I<J<=LENGTH OF PLIST
C          (B(I,J) FOR 1<=J<=I<=LENGTH OF PLIST REMAINS UNDEFINED).
C
C
      INTEGER PLIST, B, OUT
      COMMON /OUTPUT/ OUT
      DIMENSION B(40,40)
      L = LENGTH(PLIST)
      IF (L.EQ.0) RETURN
      IF (L.LE.40) GO TO 10
      WRITE (OUT,99999)
99999 FORMAT (1H1, 1HL, 1HE, 1HN, 1HG, 1HT, 1HH, 1H , 1HO, 1HF, 1H ,
     * 1HS, 1HE, 1HQ, 1HU, 1HE, 1HN, 1HC, 1HE, 1H , 1HO, 1HF, 1H , 1HP,
     * 1HO, 1HL, 1HI, 1HN, 1HO, 1HM, 1HI, 1HA, 1HL, 1HS, 1H , 1HE, 1HX,
     * 1HC, 1HE, 1HE, 1HD, 1HS, 1H , 1H4, 1HO)
      STOP
   10 L1 = L - 1
      DO 30 I=1,L1
        I1 = I + 1
        DO 20 J=I1,L
          B(I,J) = 1
   20   CONTINUE
   30 CONTINUE
      RETURN
      END
C                                                                       COM   10
C                                                                       COM   20
C                                                                       COM   30
C                                                                       COM   40
C                                                                       COM   50
C                                                                       COM   60
      SUBROUTINE COMPL(B, L)                                            COM   70
C     FOR THE INPUT
C          B ... A 2-DIMENSIONAL INTEGER ARRAY
C          L ... AN INTEGER GREATER THAN 0
C     COMPL MODIFIES B BY DEFINING
C          B(I,L) = 1   FOR 1<=I<L
C          (THE OTHER VALUES B(I,J) ARE LEFT UNCHANGED).
C
C
      INTEGER B, OUT
      COMMON /OUTPUT/ OUT
      DIMENSION B(40,40)
      IF (L.LE.1) RETURN
      L1 = L - 1
      DO 10 I=1,L1
        B(I,L) = 1
   10 CONTINUE
      RETURN
      END
C                                                                       CRI   10
C                                                                       CRI   20
C                                                                       CRI   30
C                                                                       CRI   40
C                                                                       CRI   50
C                                                                       CRI   60
      INTEGER FUNCTION CRIT(PLIST, AUX, B, I, J)                        CRI   70
C     FOR THE INPUT
C          PLIST ... A FINITE SEQUENCE OF POLYNOMIALS
C          AUX ..... A ONE-DIMENSIONAL INTEGER ARRAY POINTING TO
C                    THE POLYNOMIALS IN PLIST
C          B ....... AN INTEGER ARRAY OF DIMENSION
C                    (LENGTH OF PLIST, LENGTH OF PLIST)
C          I ....... AN INTEGER (1<=I<LENGTH OF PLIST)
C          J ....... AN INTEGER (I<J<=LENGTH OF PLIST)
C     CRIT(PLIST,AUX,B,I,J) = 0,
C          IF THE REDUCTION OF THE S-POLYNOMIAL OF THE I-TH AND
C          THE J-TH POLYNOMIAL IN PLIST MAY BE OMITTED
C          (IN THE CASE OF THE COMBINED CRITERION THIS MEANS,
C          THAT AT LEAST ONE SUBCRITERION  CRIT3  OR  CRIT4
C          YIELDS 0 FOR THE GIVEN PARAMETERS),
C          = 1  OTHERWISE.
C
C     IT IS THE GOAL OF VARIOUS THEORETICAL INVESTIGATIONS
C     /3/, /6/, /7/, /10/ TO PROVE THE CORRECTNESS OF THE
C     ALGORITHM FOR DIFFERENT CRITERIA. IN THIS VERSION OF THE
C     ALGORITHM WE PRESENT A SPECIAL COMBINATION OF TWO CRITERIA,
C     CRITERION 3 OF /6/ AND CRITERION S.2 OF /3/ (= CRITERION 4
C     OF /7/), WHICH PROVED TO BE THE MOST EFFICIENT ONE SO FAR.
C
C
      INTEGER PLIST, AUX, B, CRIT3, CRIT4
      DIMENSION B(40,40), AUX(40)
      CRIT = 1
      IF (CRIT3(PLIST,AUX,B,I,J).EQ.0 .OR. CRIT4(AUX,I,J).EQ.0) CRIT = 0
      RETURN
      END
C                                                                       CRI   10
C                                                                       CRI   20
C                                                                       CRI   30
C                                                                       CRI   40
C                                                                       CRI   50
C                                                                       CRI   60
      INTEGER FUNCTION CRIT3(PLIST, AUX, B, I, J)                       CRI   70
C     FOR THE INPUT
C          PLIST ... A FINITE SEQUENCE OF POLYNOMIALS
C          AUX ..... A ONE-DIMENSIONAL INTEGER ARRAY POINTING TO THE
C                    POLYNOMIALS IN PLIST
C          B ....... AN INTEGER ARRAY OF DIMENSION
C                    (LENGTH OF PLIST,LENGTH OF PLIST)
C          I ....... AN INTEGER (1<=I<LENGTH OF PLIST)
C          J ....... AN INTEGER (I<J<=LENGTH OF PLIST)
C     CRIT3(PLIST,AUX,B,I,J)=1,
C          IF CRITERION 3, DEFINED IN /6/, PAGE 14, IS
C          FULFILLED FOR THE GIVEN ARGUMENTS,
C          = 0  OTHERWISE.
C
C
      INTEGER PLIST, AUX, B, EGI, EGJ, HGIJ, HGK, C
      INTEGER FIRST
      DIMENSION B(40,40), AUX(40)
      EGI = FIRST(FIRST(AUX(I)))
      EGJ = FIRST(FIRST(AUX(J)))
      HGIJ = LCM(EGI,EGJ)
      L = LENGTH(PLIST)
      DO 40 K=1,L
        IF (I.EQ.K .OR. K.EQ.J) GO TO 40
        HGK = FIRST(FIRST(AUX(K)))
        M = MORD(HGIJ,HGK)
        IF (M.EQ.0) GO TO 40
        IF (K.GE.I) GO TO 10
        C = B(K,I) + B(K,J)
        GO TO 30
   10   IF (K.GE.J) GO TO 20
        C = B(I,K) + B(K,J)
        GO TO 30
   20   C = B(I,K) + B(J,K)
   30   IF (C.NE.0) GO TO 40
        CRIT3 = 0
        CALL ERASE(HGIJ)
        RETURN
   40 CONTINUE
      CRIT3 = 1
      CALL ERASE(HGIJ)
      RETURN
      END
C                                                                       CRI   10
C                                                                       CRI   20
C                                                                       CRI   30
C                                                                       CRI   40
C                                                                       CRI   50
C                                                                       CRI   60
      INTEGER FUNCTION CRIT4(AUX, I, J)                                 CRI   70
C     FOR THE INPUT
C          AUX ... A ONE-DIMENSIONAL INTEGER ARRAY POINTING TO THE
C                  POLYNOMIALS OF THE ACTUAL POLYNOMIAL LIST
C          I ....... AN INTEGER (1<=I<LENGTH OF AUX)
C          J ....... AN INTEGER (I<J<=LENGTH OF AUX)
C     CRIT4(AUX,I,J) = 1,
C          IF CRITERION 4, DEFINED IN /7/, PAGE 46, IS
C          FULFILLED FOR THE GIVEN ARGUMENTS,
C          = 0  OTHERWISE.
C
C
      INTEGER AUX, EI, EJ, EPROD, ELCM, FIRST, PRODEE
      DIMENSION AUX(40)
      EI = FIRST(FIRST(AUX(I)))
      EJ = FIRST(FIRST(AUX(J)))
      EPROD = PRODEE(EI,EJ)
      ELCM = LCM(EI,EJ)
      CRIT4 = (LEQUAL(EPROD,ELCM)-1)**2
      CALL ERASE(EPROD)
      CALL ERASE(ELCM)
      RETURN
      END
C                                                                       SEL   10
C                                                                       SEL   20
C                                                                       SEL   30
C                                                                       SEL   40
C                                                                       SEL   50
C                                                                       SEL   60
      SUBROUTINE SEL(PLIST, AUX, P, POINT, T, Q)                        SEL   70
C     FOR THE INPUT
C          PLIST ... A FINITE SEQUENCE OF POLYNOMIALS
C          AUX ..... A ONE-DIMENSIONAL INTEGER ARRAY POINTING
C                    TO THE POLYNOMIALS IN PLIST
C          P ....... A POLYNOMIAL
C          POINT ... A NONNEGATIVE INTEGER
C     SEL IN THE NORMAL CASE COMPUTES THE OUTPUT
C          T ....... ONE OF THE LAST (LENGTH(P)-POINT) TERMS
C                    (EXPONENT LIST + COEFFICIENT) IN P
C          Q ....... A POLYNOMIAL IN PLIST
C     SUCH THAT
C          THE EXPONENT OF T IS A MULTIPLE OF THE EXPONENT
C          OF THE FIRST TERM IN Q
C     AND SETS  POINT TO THE NUMBER OF T IN P.
C     (IF NO SUCH T AND Q EXIST, SEL RETURNS T=0).
C     NO BORROW IS MADE FOR T AND Q.
C
C
      INTEGER PLIST, AUX, P, POINT, T, Q, H
      INTEGER FIRST, TAIL
      DIMENSION AUX(40)
      H = P
      LH = LENGTH(H)
      IF (LH-POINT) 60, 60, 10
   10 IF (POINT.EQ.0) GO TO 30
      DO 20 I=1,POINT
        H = TAIL(H)
   20 CONTINUE
   30 LH = LH - POINT
      L = LENGTH(PLIST)
      DO 50 I=1,LH
        T = FIRST(H)
        H = TAIL(H)
        DO 40 J=1,L
          Q = AUX(J)
          IF (Q.EQ.0) GO TO 40
          M = MORD(FIRST(T),FIRST(FIRST(Q)))
          IF (M.EQ.1) RETURN
   40   CONTINUE
        POINT = POINT + 1
   50 CONTINUE
   60 T = 0
      RETURN
      END
C                                                                       DIF   10
C                                                                       DIF   20
C                                                                       DIF   30
C                                                                       DIF   40
C                                                                       DIF   50
C                                                                       DIF   60
      INTEGER FUNCTION DIFFPP(P, Q)                                     DIF   70
C     FOR THE INPUT P
C          P ... A POLYNOMIAL
C          Q ... A POLYNOMIAL
C     DIFFPP(P,Q) IS THE DIFFERENCE P-Q.
C
C
      INTEGER P, Q, P1, Q1, TDIF, EXP, COEF, COEFP, COEFQ
      INTEGER FIRST, TAIL, BORROW, PFL, DIFF
      P1 = P
      Q1 = Q
      DIFFPP = 0
   10 IF (P1.EQ.0) GO TO 60
      IF (Q1.EQ.0) GO TO 20
      LO = LINORD(FIRST(FIRST(P1)),FIRST(FIRST(Q1)))
      IF (LO-1) 40, 20, 30
   20 TDIF = BORROW(FIRST(P1))
      P1 = TAIL(P1)
      GO TO 50
   30 EXP = FIRST(FIRST(Q1))
      COEF = TAIL(FIRST(Q1))
      NCOEF = DIFF(0,COEF)
      TDIF = PFL(BORROW(EXP),NCOEF)
      Q1 = TAIL(Q1)
      GO TO 50
   40 EXP = FIRST(FIRST(P1))
      COEFP = TAIL(FIRST(P1))
      COEFQ = TAIL(FIRST(Q1))
      COEF = DIFF(COEFP,COEFQ)
      P1 = TAIL(P1)
      Q1 = TAIL(Q1)
      IF (COEF.EQ.0) GO TO 10
      TDIF = PFL(BORROW(EXP),COEF)
   50 DIFFPP = PFL(TDIF,DIFFPP)
      GO TO 10
   60 IF (Q1.NE.0) GO TO 30
      DIFFPP = INV(DIFFPP)
      RETURN
      END
C                                                                       PRO   10
C                                                                       PRO   20
C                                                                       PRO   30
C                                                                       PRO   40
C                                                                       PRO   50
C                                                                       PRO   60
      INTEGER FUNCTION PRODPE(P, EXP)                                   PRO   70
C     FOR THE INPUT
C          P ..... A POLYNOMIAL
C          EXP ... A (PACKED) LIST OF EXPONENTS
C     PRODPE(P,EXP) IS THE POLYNOMIAL RESULTING FROM MULTIPLYING EACH
C          TERM IN P BY THE "TERM" EXP.
C
C
      INTEGER P, EXP, Q, QT, ENEW, TNEW
      INTEGER FIRST, TAIL, PRODEE, PFL, BORROW
      PRODPE = 0
      Q = P
   10 IF (Q.EQ.0) GO TO 20
      QT = FIRST(Q)
      Q = TAIL(Q)
      ENEW = PRODEE(FIRST(QT),EXP)
      TNEW = PFL(ENEW,BORROW(TAIL(QT)))
      PRODPE = PFL(TNEW,PRODPE)
      GO TO 10
   20 PRODPE = INV(PRODPE)
      RETURN
      END
C                                                                       PRO   10
C                                                                       PRO   20
C                                                                       PRO   30
C                                                                       PRO   40
C                                                                       PRO   50
C                                                                       PRO   60
      INTEGER FUNCTION PRODPR(P, R)                                     PRO   70
C     FOR THE INPUT
C          P ... A POLYNOMIAL
C          R ... AN ELEMENT OF THE UNDERLYING FIELD
C     PRODPR(P,R) IS THE POLYNOMIAL RESULTING FROM MULTILYING THE
C          COEFFICIENT OF EACH TERM IN P BY R.
C
C
      INTEGER P, R, Q, QT, RNEW, TNEW
      INTEGER FIRST, TAIL, PROD, PFL, BORROW
      PRODPR = 0
      Q = P
   10 IF (Q.EQ.0) GO TO 20
      QT = FIRST(Q)
      Q = TAIL(Q)
      RNEW = PROD(R,TAIL(QT))
      TNEW = PFL(BORROW(FIRST(QT)),RNEW)
      PRODPR = PFL(TNEW,PRODPR)
      GO TO 10
   20 PRODPR = INV(PRODPR)
      RETURN
      END
C                                                                       PRO   10
C                                                                       PRO   20
C                                                                       PRO   30
C                                                                       PRO   40
C                                                                       PRO   50
C                                                                       PRO   60
      INTEGER FUNCTION PRODEE(EXP1, EXP2)                               PRO   70
C     FOR THE INPUT
C          EXP1 ... A (PACKED) LIST OF EXPONENTS
C          EXP2 ... A (PACKED) LIST OF EXPONENTS
C     PRODEE(EXP1,EXP2) IS THE PRODUCT EXP1 X EXP2 (IN PACKED FORM).
C
C
      INTEGER EXP1, EXP2, EI1, EI2, S, OUT
      INTEGER FIRST, TAIL, PFA, DECODE, ENCODE
      COMMON /VAR/ N
      COMMON /OUTPUT/ OUT
      LP = 0
      L1 = DECODE(EXP1)
      L2 = DECODE(EXP2)
      LE1 = L1
      LE2 = L2
      DO 20 I=1,N
        EI1 = FIRST(LE1)
        LE1 = TAIL(LE1)
        EI2 = FIRST(LE2)
        LE2 = TAIL(LE2)
        S = EI1 + EI2
        IF (S.LE.255) GO TO 10
        WRITE (OUT,99999)
99999   FORMAT (1H1, 1HE, 1HX, 1HP, 1HO, 1HN, 1HE, 1HN, 1HT, 1H , 1HG,
     *   1HR, 1HE, 1HA, 1HT, 1HE, 1HR, 1H , 1HT, 1HH, 1HA, 1HN, 1H ,
     *   1H2, 1H5, 1H5)
        STOP
   10   LP = PFA(S,LP)
   20 CONTINUE
      LP = INV(LP)
      PRODEE = ENCODE(LP)
      CALL ERASE(L1)
      CALL ERASE(L2)
      CALL ERASE(LP)
      RETURN
      END
C                                                                       QUO   10
C                                                                       QUO   20
C                                                                       QUO   30
C                                                                       QUO   40
C                                                                       QUO   50
C                                                                       QUO   60
      INTEGER FUNCTION QUOTEE(EXP1, EXP2)                               QUO   70
C     FOR THE INPUT
C          EXP1 ... A (PACKED) LIST OF EXPONENTS
C          EXP2 ... A (PACKED) LIST OF EXPONENTS
C     QUOTEE(EXP1,EXP2) IS THE QUOTIENT EXP1/EXP2 (IN PACKED FORM).
C
C
      INTEGER EXP1, EXP2, EI1, EI2, V, OUT
      INTEGER FIRST, TAIL, PFA, DECODE, ENCODE
      COMMON /VAR/ N
      COMMON /OUTPUT/ OUT
      LQ = 0
      L1 = DECODE(EXP1)
      L2 = DECODE(EXP2)
      LE1 = L1
      LE2 = L2
      DO 30 I=1,N
        EI1 = FIRST(LE1)
        LE1 = TAIL(LE1)
        EI2 = FIRST(LE2)
        LE2 = TAIL(LE2)
        V = EI1 - EI2
        IF (V) 10, 20, 20
   10   WRITE (OUT,99999)
99999   FORMAT (1H1, 1HD, 1HI, 1HV, 1HI, 1HS, 1HI, 1HO, 1HN, 1H , 1HE,
     *   1HR, 1HR, 1HO, 1HR, 1H , 1HI, 1HN, 1H , 1HQ, 1HU, 1HO, 1HT,
     *   1HE, 1HE)
        STOP
   20   LQ = PFA(V,LQ)
   30 CONTINUE
      LQ = INV(LQ)
      QUOTEE = ENCODE(LQ)
      CALL ERASE(L1)
      CALL ERASE(L2)
      CALL ERASE(LQ)
      RETURN
      END
C                                                                       LCM   10
C                                                                       LCM   20
C                                                                       LCM   30
C                                                                       LCM   40
C                                                                       LCM   50
C                                                                       LCM   60
      INTEGER FUNCTION LCM(EXP1, EXP2)                                  LCM   70
C     FOR THE INPUT
C          EXP1 ... A (PACKED) LIST OF EXPONENTS
C          EXP2 ... A (PACKED) LIST OF EXPONENTS
C     LCM(EXP1,EXP2) IS THE LEAST COMMON MULTIPLE OF EXP1 AND EXP2
C          (IN PACKED FORM).
C
C
      INTEGER EXP1, EXP2, EI1, EI2
      INTEGER FIRST, TAIL, PFA, DECODE, ENCODE
      COMMON /VAR/ N
      LEC = 0
      L1 = DECODE(EXP1)
      L2 = DECODE(EXP2)
      LE1 = L1
      LE2 = L2
      DO 30 I=1,N
        EI1 = FIRST(LE1)
        LE1 = TAIL(LE1)
        EI2 = FIRST(LE2)
        LE2 = TAIL(LE2)
        IF (EI1-EI2) 20, 10, 10
   10   LEC = PFA(EI1,LEC)
        GO TO 30
   20   LEC = PFA(EI2,LEC)
   30 CONTINUE
      LEC = INV(LEC)
      LCM = ENCODE(LEC)
      CALL ERASE(L1)
      CALL ERASE(L2)
      CALL ERASE(LEC)
      RETURN
      END
C                                                                       MOR   10
C                                                                       MOR   20
C                                                                       MOR   30
C                                                                       MOR   40
C                                                                       MOR   50
C                                                                       MOR   60
      INTEGER FUNCTION MORD(EXP1, EXP2)                                 MOR   70
C     FOR THE INPUT
C          EXP1 ... A (PACKED) LIST OF EXPONENTS
C          EXP2 ... A (PACKED) LIST OF EXPONENTS
C     MORD(EXP1,EXP2)=1, IF EXP1 IS A MULTIPLE OF EXP2,
C                     0  OTHERWISE.
C
C
      INTEGER EXP1, EXP2, EI1, EI2
      INTEGER DECODE, FIRST, TAIL
      COMMON /VAR/ N
      L1 = DECODE(EXP1)
      L2 = DECODE(EXP2)
      LE1 = L1
      LE2 = L2
      DO 10 I=1,N
        EI1 = FIRST(LE1)
        EI2 = FIRST(LE2)
        IF (EI2.GT.EI1) GO TO 20
        LE1 = TAIL(LE1)
        LE2 = TAIL(LE2)
   10 CONTINUE
      MORD = 1
      GO TO 30
   20 MORD = 0
   30 CALL ERASE(L1)
      CALL ERASE(L2)
      RETURN
      END
C                                                                       DIF   10
C                                                                       DIF   20
C                                                                       DIF   30
C                                                                       DIF   40
C                                                                       DIF   50
C                                                                       DIF   60
      INTEGER FUNCTION DIFF(R1, R2)                                     DIF   70
C     FOR THE INPUT
C          R1 ... AN ELEMENT OF THE RATIONAL NUMBER FIELD
C          R2 ... AN ELEMENT OF THE RATIONAL NUMBER FIELD
C     DIFF(R1,R2) IS THE DIFFERENCE R1-R2.
C
C
      INTEGER R1, R2, DEN1, DEN2, DE, DEN, A, B, GCDDN
      INTEGER FIRST, TAIL, BORROW, PFL
      DIFF = 0
      IF (R1.EQ.0 .AND. R2.EQ.0) RETURN
      IF (R1.NE.0) GO TO 10
      DIFF = PFL(INEG(FIRST(R2)),BORROW(TAIL(R2)))
      RETURN
   10 IF (R2.NE.0) GO TO 20
      DIFF = BORROW(R1)
      RETURN
   20 DEN1 = FIRST(R1)
      NOM1 = FIRST(TAIL(R1))
      DEN2 = FIRST(R2)
      NOM2 = FIRST(TAIL(R2))
      A = IPROD(DEN1,NOM2)
      B = IPROD(DEN2,NOM1)
      DE = IDIF(A,B)
      CALL ERASE(A)
      CALL ERASE(B)
      IF (DE.EQ.0) RETURN
      NO = IPROD(NOM1,NOM2)
      GCDDN = IGCD(DE,NO)
      DEN = IQ(DE,GCDDN)
      NOM = IQ(NO,GCDDN)
      DIFF = PFL(DEN,PFL(NOM,0))
      CALL ERASE(DE)
      CALL ERASE(NO)
      CALL ERASE(GCDDN)
      RETURN
      END
C                                                                       PRO   10
C                                                                       PRO   20
C                                                                       PRO   30
C                                                                       PRO   40
C                                                                       PRO   50
C                                                                       PRO   60
      INTEGER FUNCTION PROD(R1, R2)                                     PRO   70
C     FOR THE INPUT
C          R1 ... AN ELEMENT OF THE RATIONAL NUMBER FIELD
C          R2 ... AN ELEMENT OF THE RATIONAL NUMBER FIELD
C     PROD(R1,R2) IS THE PRODUCT R1 X R2.
C
C
      INTEGER R1, R2, DEN1, DEN2, A, B, GCDAB, DEN
      INTEGER FIRST, TAIL, PFL
      PROD = 0
      IF (R1.EQ.0 .OR. R2.EQ.0) RETURN
      DEN1 = FIRST(R1)
      NOM1 = FIRST(TAIL(R1))
      DEN2 = FIRST(R2)
      NOM2 = FIRST(TAIL(R2))
      A = IPROD(DEN1,DEN2)
      B = IPROD(NOM1,NOM2)
      GCDAB = IGCD(A,B)
      DEN = IQ(A,GCDAB)
      NOM = IQ(B,GCDAB)
      PROD = PFL(DEN,PFL(NOM,0))
      CALL ERASE(A)
      CALL ERASE(B)
      CALL ERASE(GCDAB)
      RETURN
      END
C                                                                       QUO   10
C                                                                       QUO   20
C                                                                       QUO   30
C                                                                       QUO   40
C                                                                       QUO   50
C                                                                       QUO   60
      INTEGER FUNCTION QUOT(R1, R2)                                     QUO   70
C     FOR THE INPUT
C          R1 ... AN ELEMENT OF THE RATIONAL NUMBER FIELD
C          R2 ... AN ELEMENT OF THE RATIONAL NUMBER FIELD
C     QUOT(R1,R2) IS THE QUOTIENT R1/R2.
C
C
      INTEGER R1, R2, OUT, DEN1, DEN2, A, B, GCDAB, DEN
      INTEGER FIRST, TAIL, PFL
      COMMON /OUTOUT/ OUT
      QUOT = 0
      IF (R2.EQ.0) GO TO 10
      IF (R1.EQ.0) RETURN
      DEN1 = FIRST(R1)
      NOM1 = FIRST(TAIL(R1))
      DEN2 = FIRST(R2)
      NOM2 = FIRST(TAIL(R2))
      IF (DEN2.EQ.0) GO TO 10
      IF (DEN1.EQ.0) RETURN
      A = IPROD(DEN1,NOM2)
      B = IPROD(DEN2,NOM1)
      GCDAB = IGCD(A,B)
      DEN = IQ(A,GCDAB)
      NOM = IQ(B,GCDAB)
      CALL ERASE(A)
      CALL ERASE(B)
      CALL ERASE(GCDAB)
      QUOT = PFL(DEN,PFL(NOM,0))
      RETURN
   10 WRITE (OUT,99999)
99999 FORMAT (1H1, 1HD, 1HI, 1HV, 1HI, 1HS, 1HI, 1HO, 1HN, 1H , 1HB,
     * 1HY, 1H , 1HO)
      STOP
      END
C                                                                       ENC   10
C                                                                       ENC   20
C                                                                       ENC   30
C                                                                       ENC   40
C                                                                       ENC   50
C                                                                       ENC   60
      INTEGER FUNCTION ENCODE(UNPKD)                                    ENC   70
C     FOR THE INPUT
C          UNPKD ... AN UNPACKED LIST OF EXPONENTS
C     ENCODE(UNPKD) IS THE CORRESPONDING PACKED LIST OF EXPONENTS
C          (WHERE IN THIS IMPLEMENTATION EACH ATOM CONTAINS
C          4 EXPONENTS).
C
C
      INTEGER UNPKD, OUT, FA, UNP, BOUND, PK, E
      INTEGER FIRST, TAIL, PFA
      COMMON /VAR/ N
      COMMON /OUTPUT/ OUT
      DIMENSION FA(4)
      ENCODE = 0
      FA(1) = 16777216
      FA(2) = 65536
      FA(3) = 256
      FA(4) = 1
      UNP = UNPKD
      LU = N
   10 BOUND = 4
      IF (LU.LT.4) BOUND = LU
      PK = 0
      DO 20 I=1,BOUND
        E = FIRST(UNP)
        IF (E.GT.255) WRITE (OUT,99999)
99999   FORMAT (1H1, 1HE, 1HX, 1HP, 1HO, 1HN, 1HE, 1HN, 1HT, 1H , 1HG,
     *   1HR, 1HE, 1HA, 1HT, 1HE, 1HR, 1H , 1HT, 1HH, 1HA, 1HN, 1H ,
     *   1H2, 1H5, 1H5)
        UNP = TAIL(UNP)
        PK = PK + E*FA(I)
   20 CONTINUE
      ENCODE = PFA(PK,ENCODE)
      LU = LU - BOUND
      IF (LU.NE.0) GO TO 10
      ENCODE = INV(ENCODE)
      RETURN
      END
C                                                                       DEC   10
C                                                                       DEC   20
C                                                                       DEC   30
C                                                                       DEC   40
C                                                                       DEC   50
C                                                                       DEC   60
      INTEGER FUNCTION DECODE(PACKED)                                   DEC   70
C     FOR THE INPUT
C          PACKED ... A PACKED LIST OF EXPONENTS
C     DECODE(PACKED) IS THE CORRESPONDING UNPACKED LIST OF EXPONENTS.
C
C
      INTEGER PACKED, E, PAC, EX, BOUND
      INTEGER FIRST, TAIL, PFA
      COMMON /VAR/ N
      DIMENSION E(4)
      DECODE = 0
      PAC = PACKED
      LP = LENGTH(PACKED)
      DO 30 I=1,LP
        EX = FIRST(PAC)
        PAC = TAIL(PAC)
        DO 10 J=1,4
          K = 5 - J
          E(K) = MOD(EX,256)
          EX = EX/256
   10   CONTINUE
        BOUND = 4
        IF (I.EQ.LP) BOUND = N - (LP-1)*4
        DO 20 J=1,BOUND
          DECODE = PFA(E(J),DECODE)
   20   CONTINUE
   30 CONTINUE
      DECODE = INV(DECODE)
      RETURN
      END
C                                                                       REA   10
C                                                                       REA   20
C                                                                       REA   30
C                                                                       REA   40
C                                                                       REA   50
C                                                                       REA   60
      INTEGER FUNCTION READLP(IN)                                       REA   70
C     FOR THE INPUT
C          IN ... AN INTEGER
C     READLP(IN) IS A LIST OF POLYNOMIALS READ FROM THE
C          INPUT FILE WITH THE NUMBER IN.
C
C
      INTEGER P, READP, PFL
      READLP = 0
      READ (IN,99999) NUMP
99999 FORMAT (I2)
      IF (NUMP.LE.0) RETURN
      DO 10 I=1,NUMP
        P = READP(IN)
        READLP = PFL(P,READLP)
   10 CONTINUE
      READLP = INV(READLP)
      RETURN
      END
C                                                                       REA   10
C                                                                       REA   20
C                                                                       REA   30
C                                                                       REA   40
C                                                                       REA   50
C                                                                       REA   60
      INTEGER FUNCTION READP(IN)                                        REA   70
C     FOR THE INPUT
C          IN ... AN INTEGER
C     READP(IN) IS A POLYNOMIAL READ FROM THE INPUT FILE WITH
C          THE NUMBER IN.
C
C
      INTEGER EX, TERM, DEN, PLEX, T, OUT
      INTEGER PFA, PFL, ENCODE
      COMMON /VAR/ N
      COMMON /OUTPUT/ OUT
      DIMENSION EX(26)
      IF (N.LE.26) GO TO 10
      WRITE (OUT,99999)
99999 FORMAT (1H1, 1HM, 1HO, 1HR, 1HE, 1H , 1HT, 1HH, 1HA, 1HN, 1H ,
     * 1H2, 1H6, 1H , 1HV, 1HA, 1HR, 1HI, 1HA, 1HB, 1HL, 1HE, 1HS, 1H ,
     * 1HI, 1HN, 1H , 1HP, 1HO, 1HL, 1HY, 1HN, 1HO, 1HM, 1HI, 1HA, 1HL)
      STOP
   10 READP = 0
      READ (IN,99998) NUMT
99998 FORMAT (I2)
      IF (NUMT.LE.0) RETURN
      DO 30 TERM=1,NUMT
        DEN = IREAD(IN)
        NOM = IREAD(IN)
        READ (IN,99997) (EX(J),J=1,N)
99997   FORMAT (26I3)
        LEX = 0
        DO 20 J=1,N
          LEX = PFA(EX(J),LEX)
   20   CONTINUE
        LEX = INV(LEX)
        PLEX = ENCODE(LEX)
        CALL ERASE(LEX)
        T = PFL(PLEX,PFL(DEN,PFL(NOM,0)))
        READP = PFL(T,READP)
   30 CONTINUE
      READP = INV(READP)
      RETURN
      END
C                                                                       WRI   10
C                                                                       WRI   20
C                                                                       WRI   30
C                                                                       WRI   40
C                                                                       WRI   50
C                                                                       WRI   60
      SUBROUTINE WRITLP(OUT, PLIST)                                     WRI   70
C     FOR THE INPUT
C          OUT ..... AN INTEGER
C          PLIST ... A LIST OF POLYNOMIALS
C     WRITLP WRITES PLIST ON THE OUTPUT FILE WITH THE NUMBER OUT.
C
C
      INTEGER OUT, PLIST, PL, P, FIRST, TAIL
      IF (PLIST.NE.0) GO TO 10
      WRITE (OUT,99999)
99999 FORMAT (//1H , 1H0)
      RETURN
   10 L = LENGTH(PLIST)
      PL = PLIST
      DO 20 I=1,L
        P = FIRST(PL)
        PL = TAIL(PL)
        CALL WRITP(OUT, P)
   20 CONTINUE
      RETURN
      END
C                                                                       WRI   10
C                                                                       WRI   20
C                                                                       WRI   30
C                                                                       WRI   40
C                                                                       WRI   50
C                                                                       WRI   60
      SUBROUTINE WRITP(OUT, P)                                          WRI   70
C     FOR THE INPUT
C          OUT ... AN INTEGER
C          P ..... A POLYNOMIAL
C     WRITP WRITES P ON THE OUTPUT FILE WITH THE NUMBER OUT.
C
C
      INTEGER OUT, P, Q, EX, T, R, DEN
      INTEGER FIRST, TAIL, DECODE
      COMMON /VAR/ N
      DIMENSION EX(26)
      IF (N.LE.26) GO TO 10
      WRITE (OUT,99999)
99999 FORMAT (1H1, 1HM, 1HO, 1HR, 1HE, 1H , 1HT, 1HH, 1HA, 1HN, 1H ,
     * 1H2, 1H6, 1H , 1HV, 1HA, 1HR, 1HI, 1HA, 1HB, 1HL, 1HE, 1HS, 1H ,
     * 1HI, 1HN, 1H , 1HP, 1HO, 1HL, 1HY, 1HN, 1HO, 1HM, 1HI, 1HA, 1HL)
      STOP
   10 WRITE (OUT,99998)
99998 FORMAT (//)
      IF (P.NE.0) GO TO 20
      WRITE (OUT,99997)
99997 FORMAT (1H , 1H0)
      RETURN
   20 L = LENGTH(P)
      Q = P
      DO 40 I=1,L
        T = FIRST(Q)
        Q = TAIL(Q)
        LEX = DECODE(FIRST(T))
        LEX1 = LEX
        DO 30 J=1,N
          EX(J) = FIRST(LEX1)
          LEX1 = TAIL(LEX1)
   30   CONTINUE
        CALL ERASE(LEX)
        R = TAIL(T)
        DEN = FIRST(R)
        NOM = FIRST(TAIL(R))
        CALL IWRITE(OUT, DEN)
        CALL IWRITE(OUT, NOM)
        WRITE (OUT,99996) (EX(J),J=1,N)
99996   FORMAT (1X, 26I3)
   40 CONTINUE
      RETURN
      END
C                                                                       LIN   10
C                                                                       LIN   20
C                                                                       LIN   30
C                                                                       LIN   40
C                                                                       LIN   50
C                                                                       LIN   60
      INTEGER FUNCTION LINORD(EXP1, EXP2)                               LIN   70
C     FOR THE INPUT
C          EXP1 ... A (PACKED) LIST OF EXPONENTS
C          EXP2 ... A (PACKED) LIST OF EXPONENTS
C     LINORD(EXP1,EXP2)=0, IF EXP1=EXP2
C                       1, IF EXP2<EXP1
C                       2, IF EXP1<EXP2
C          WITH RESPECT TO THE GRADUATED LEXICOGRAPHICAL TERM ORDERING.
C
C
      INTEGER EXP1, EXP2, DEG1, DEG2, EI1, EI2
      INTEGER DECODE, FIRST, TAIL
      COMMON /VAR/ N
      L1 = DECODE(EXP1)
      L2 = DECODE(EXP2)
      LE1 = L1
      LE2 = L2
      DEG1 = 0
      DEG2 = 0
      DO 10 I=1,N
        DEG1 = DEG1 + FIRST(LE1)
        DEG2 = DEG2 + FIRST(LE2)
        LE1 = TAIL(LE1)
        LE2 = TAIL(LE2)
   10 CONTINUE
      IF (DEG1-DEG2) 20, 40, 30
   20 LINORD = 2
      GO TO 60
   30 LINORD = 1
      GO TO 60
   40 LE1 = L1
      LE2 = L2
      DO 50 I=1,N
        EI1 = FIRST(LE1)
        EI2 = FIRST(LE2)
        LE1 = TAIL(LE1)
        LE2 = TAIL(LE2)
        IF (EI1-EI2) 30, 50, 20
   50 CONTINUE
      LINORD = 0
   60 CALL ERASE(L1)
      CALL ERASE(L2)
      RETURN
      END
C                                                                       LIN   10
C                                                                       LIN   20
C                                                                       LIN   30
C                                                                       LIN   40
C                                                                       LIN   50
C                                                                       LIN   60
      INTEGER FUNCTION LINORD(EXP1, EXP2)                               LIN   70
C     FOR THE INPUT
C          EXP1 ... A (PACKED) LIST OF EXPONENTS
C          EXP2 ... A (PACKED) LIST OF EXPONENTS
C     LINORD(EXP1,EXP2)=0, IF EXP1=EXP2
C                       1, IF EXP2<EXP1
C                       2, IF EXP1<EXP2
C          WITH RESPECT TO THE LEXICOGRAPHICAL TERM ORDERING.
C
C
      INTEGER EXP1, EXP2, EI1, EI2
      INTEGER DECODE, FIRST, TAIL
      COMMON /VAR/ N
      L1 = DECODE(EXP1)
      L2 = DECODE(EXP2)
      LE1 = L1
      LE2 = L2
      DO 20 I=1,N
        EI1 = FIRST(LE1)
        EI2 = FIRST(LE2)
        IF (EI1-EI2) 30, 10, 40
   10   LE1 = TAIL(LE1)
        LE2 = TAIL(LE2)
   20 CONTINUE
      LINORD = 0
      GO TO 50
   30 LINORD = 2
      GO TO 50
   40 LINORD = 1
   50 CALL ERASE(L1)
      CALL ERASE(L2)
      RETURN
      END
0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ+-*/(),. =$
 2
 2
 2
+1
+1
  2  1
-1
+1
  1  0
 2
+1
+1
  0  3
-2
+1
  1  1
 0
0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ+-*/(),. =$
 2
 2
 2
+1
+1
  2  1
-1
+1
  1  0
 2
-2
+1
  1  1
+1
+1
  0  3
 0
0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ+-*/(),. =$
 3
 2
 8
+1
+1
  4  0  0
-2
+1
  2  1  0
+1
+1
  2  0  2
+1
+1
  2  0  1
+1
+1
  0  2  0
-1
+1
  0  1  2
-1
+1
  0  1  1
+1
+1
  0  0  3
 6
-2
+1
  3  0  1
+1
+1
  2  1  0
+2
+1
  1  1  1
-2
+1
  1  0  2
-1
+1
  0  2  0
+1
+1
  0  1  1
 0
0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ+-*/(),. =$
 3
 3
 4
+4
+1
  2  0  0
+1
+1
  1  2  0
-1
+1
  0  0  1
+1
+4
  0  0  0
 3
+2
+1
  1  0  0
+1
+1
  0  2  1
+1
+2
  0  0  0
 3
-1
+1
  2  0  1
+1
+2
  1  0  0
+1
+1
  0  2  0
 0
