      SUBROUTINE FACTOR
      IMPLICIT NONE
C
      INCLUDE MATLAB$KOM:SIZEPARMS.INC
      INCLUDE MATLAB$KOM:VSTK.KOM
      INCLUDE MATLAB$KOM:RECU.KOM
      INCLUDE MATLAB$KOM:IOP.KOM
      INCLUDE MATLAB$KOM:COM.KOM
C
      INTEGER SEMI, EOL, BLANK, R, ID(4), EXCNT, LPAREN, RPAREN
      INTEGER STAR, DSTAR, COMMA, LESS, GREAT, QUOTE, NUM, NAME, ALFL
      INTEGER L, N, LN, K, J, LS, I
C
      DOUBLE PRECISION DFLOAT
C
      DATA DSTAR / 54 /, SEMI / 39 /, EOL / 99 /, BLANK / 36 /
      DATA STAR / 43 /, COMMA / 48 /, LPAREN / 37 /, RPAREN / 38 /
      DATA LESS / 50 /, GREAT / 51 /, QUOTE / 49 /, NUM / 0 /
      DATA NAME / 1 /, ALFL / 52 /
C
C
      IF (DDT.EQ.1) WRITE (WTE, 100) PT, RSTK(PT), SYM
100   FORMAT (' FACTOR', 3I4)
      R = RSTK(PT)
      GO TO (99, 99, 99, 99, 99, 99, 99, 01, 01, 25,
     .       45, 65, 99, 99, 99, 55, 75, 32, 37), R
C
01    CONTINUE
      IF (SYM.EQ.NUM .OR. SYM.EQ.QUOTE .OR. SYM.EQ.LESS) GO TO 10
      IF (SYM.EQ.GREAT) GO TO 30
      EXCNT = 0
      IF (SYM.EQ.NAME) GO TO 40
      ID(1) = BLANK
      IF (SYM.EQ.LPAREN) GO TO 42
      CALL ERROR (2)
      IF (ERR.GT.0) RETURN
C
C ***      PUT SOMETHING ON THE STACK
10    CONTINUE
      L = 1
      IF (TOP.GT.0) L = LSTK(TOP)+MSTK(TOP)*NSTK(TOP)
      IF (TOP+1.GE.BOT) CALL ERROR (18)
      IF (ERR.GT.0) RETURN
      TOP = TOP+1
      LSTK(TOP) = L
      IF (SYM.EQ.QUOTE) GO TO 15
      IF (SYM.EQ.LESS) GO TO 20
C
C ***      SINGLE NUMBER, GETSYM STORED IT IN STKI
      MSTK(TOP) = 1
      NSTK(TOP) = 1
      STKR(L) = STKI(VSIZE)
      STKI(L) = 0.0D0
      CALL GETSYM
      GO TO 60
C
C ***      STRING
15    CONTINUE
      N = 0
      LPT(4) = LPT(3)
      CALL GETCH
C
16    CONTINUE
      IF (CHAR.EQ.QUOTE) GO TO 18
C
17    CONTINUE
      LN = L+N
      IF (CHAR.EQ.EOL) CALL ERROR (31)
      IF (ERR.GT.0) RETURN
      STKR(LN) = DFLOAT (CHAR)
      STKI(LN) = 0.0D0
      N = N+1
      CALL GETCH
      GO TO 16
C
18    CONTINUE
      CALL GETCH
      IF (CHAR.EQ.QUOTE) GO TO 17
      IF (N.LE.0) CALL ERROR (31)
      IF (ERR.GT.0) RETURN
      MSTK(TOP) = 1
      NSTK(TOP) = N
      CALL GETSYM
      GO TO 60
C
C ***      EXPLICIT MATRIX
20    CONTINUE
      MSTK(TOP) = 0
      NSTK(TOP) = 0
C
21    CONTINUE
      TOP = TOP+1
      LSTK(TOP) = LSTK(TOP-1)+MSTK(TOP-1)*NSTK(TOP-1)
      MSTK(TOP) = 0
      NSTK(TOP) = 0
      CALL GETSYM
C
22    CONTINUE
      IF (SYM.EQ.SEMI .OR. SYM.EQ.GREAT .OR. SYM.EQ.EOL) GO TO 27
      IF (SYM.EQ.COMMA) CALL GETSYM
      PT = PT+1
      RSTK(PT) = 10
C *CALL* EXPR
      RETURN
C
25    CONTINUE
      PT = PT-1
      TOP = TOP-1
      IF (MSTK(TOP).EQ.0) MSTK(TOP) = MSTK(TOP+1)
      IF (MSTK(TOP).NE.MSTK(TOP+1)) CALL ERROR (5)
      IF (ERR.GT.0) RETURN
      NSTK(TOP) = NSTK(TOP)+NSTK(TOP+1)
      GO TO 22
C
27    CONTINUE
      IF (SYM.EQ.SEMI .AND. CHAR.EQ.EOL) CALL GETSYM
      CALL STACK1 (QUOTE)
      IF (ERR.GT.0) RETURN
      TOP = TOP-1
      IF (MSTK(TOP).EQ.0) MSTK(TOP) = MSTK(TOP+1)
      IF (MSTK(TOP).NE.MSTK(TOP+1) .AND. MSTK(TOP+1).GT.0)
     .      CALL ERROR (6)
      IF (ERR.GT.0) RETURN
      NSTK(TOP) = NSTK(TOP)+NSTK(TOP+1)
      IF (SYM.EQ.EOL) CALL GETLIN
      IF (SYM.NE.GREAT) GO TO 21
      CALL STACK1 (QUOTE)
      IF (ERR.GT.0) RETURN
      CALL GETSYM
      GO TO 60
C
C ***      MACRO STRING
30    CONTINUE
      CALL GETSYM
      IF (SYM.EQ.LESS .AND. CHAR.EQ.EOL) CALL ERROR (28)
      IF (ERR.GT.0) RETURN
      PT = PT+1
      RSTK(PT) = 18
C *CALL* EXPR
      RETURN
C
32    CONTINUE
      PT = PT-1
      IF (SYM.NE.LESS .AND. SYM.NE.EOL) CALL ERROR (37)
      IF (ERR.GT.0) RETURN
      IF (SYM.EQ.LESS) CALL GETSYM
      K = LPT(6)
      LIN(K+1) = LPT(1)
      LIN(K+2) = LPT(2)
      LIN(K+3) = LPT(6)
      LPT(1) = K+4
C
C ***      TRANSFER STACK TO INPUT LINE
      K = LPT(1)
      L = LSTK(TOP)
      N = MSTK(TOP)*NSTK(TOP)
      DO 34 J = 1, N
        LS = L+J-1
        LIN(K) = IDINT (STKR(LS))
        IF (LIN(K).LT.0 .OR. LIN(K).GE.ALFL) CALL ERROR (37)
        IF (ERR.GT.0) RETURN
        IF (K.LT.1024) K = K+1
        IF (K.EQ.1024) WRITE (WTE, 33) K
33      FORMAT (' INPUT BUFFER LIMIT IS ', I4, ' CHARACTERS.')
34    CONTINUE
      TOP = TOP-1
      LIN(K) = EOL
      LPT(6) = K
      LPT(4) = LPT(1)
      LPT(3) = 0
      LPT(2) = 0
      LCT(1) = 0
      CHAR = BLANK
      CALL GETSYM
      PT = PT+1
      RSTK(PT) = 19
C *CALL* EXPR
      RETURN
C
37    CONTINUE
      PT = PT-1
      K = LPT(1)-4
      LPT(1) = LIN(K+1)
      LPT(4) = LIN(K+2)
      LPT(6) = LIN(K+3)
      CHAR = BLANK
      CALL GETSYM
      GO TO 60
C
C ***      FUNCTION OR MATRIX ELEMENT
40    CONTINUE
      CALL PUTID (ID, SYN)
      CALL GETSYM
      IF (SYM.EQ.LPAREN) GO TO 42
      RHS = 0
      CALL FUNS (ID)
      IF (FIN.NE.0) CALL ERROR (25)
      IF (ERR.GT.0) RETURN
      CALL STACKG (ID)
      IF (ERR.GT.0) RETURN
      IF (FIN.EQ.7) GO TO 50
      IF (FIN.EQ.0) CALL PUTID (IDS(1,PT+1), ID)
      IF (FIN.EQ.0) CALL ERROR (4)
      IF (ERR.GT.0) RETURN
      GO TO 60
C
42    CONTINUE
      CALL GETSYM
      EXCNT = EXCNT+1
      PT = PT+1
      PSTK(PT) = EXCNT
      CALL PUTID (IDS(1,PT), ID)
      RSTK(PT) = 11
C *CALL* EXPR
      RETURN
C
45    CONTINUE
      CALL PUTID (ID, IDS(1,PT))
      EXCNT = PSTK(PT)
      PT = PT-1
      IF (SYM.EQ.COMMA) GO TO 42
      IF (SYM.NE.RPAREN) CALL ERROR (3)
      IF (ERR.GT.0) RETURN
      IF (SYM.EQ.RPAREN) CALL GETSYM
      IF (ID(1).EQ.BLANK) GO TO 60
      RHS = EXCNT
      CALL STACKG (ID)
      IF (ERR.GT.0) RETURN
      IF (FIN.EQ.0) CALL FUNS (ID)
      IF (FIN.EQ.0) CALL ERROR (4)
      IF (ERR.GT.0) RETURN
C
C ***      EVALUATE MATRIX FUNCTION
50    CONTINUE
      PT = PT+1
      RSTK(PT) = 16
C     *CALL* MATFN
      RETURN
C
55    CONTINUE
      PT = PT-1
      GO TO 60
C
C ***      CHECK FOR QUOTE (TRANSPOSE) AND ** (POWER)
60    CONTINUE
      IF (SYM.NE.QUOTE) GO TO 62
      I = LPT(3)-2
      IF (LIN(I).EQ.BLANK) GO TO 90
      CALL STACK1 (QUOTE)
      IF (ERR.GT.0) RETURN
      CALL GETSYM
62    CONTINUE
      IF (SYM.NE.STAR .OR. CHAR.NE.STAR) GO TO 90
      CALL GETSYM
      CALL GETSYM
      PT = PT+1
      RSTK(PT) = 12
C *CALL* FACTOR
      GO TO 01
C
65    CONTINUE
      PT = PT-1
      CALL STACK2 (DSTAR)
      IF (ERR.GT.0) RETURN
      IF (FUN.NE.2) GO TO 90
C
C ***      MATRIX POWER, USE EIGENVECTORS
      PT = PT+1
      RSTK(PT) = 17
C *CALL* MATFN
      RETURN
C
75    CONTINUE
      PT = PT-1
C
90    CONTINUE
      RETURN
C
99    CONTINUE
      CALL ERROR (22)
      IF (ERR.GT.0) RETURN
C
      RETURN
      END
