home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_progs / libs / matlab.lzh / MATLAB / MATLAB.LZH / Source / MatLab / getsym.for < prev    next >
Encoding:
Text File  |  1991-04-13  |  2.5 KB  |  106 lines
  1.       SUBROUTINE GETSYM
  2.       IMPLICIT NONE
  3. C
  4. C GET A SYMBOL
  5. C
  6.       INCLUDE MATLAB$KOM:SIZEPARMS.INC
  7.       INCLUDE MATLAB$KOM:VSTK.KOM
  8.       INCLUDE MATLAB$KOM:ALFS.KOM
  9.       INCLUDE MATLAB$KOM:IOP.KOM
  10.       INCLUDE MATLAB$KOM:COM.KOM
  11. C
  12.       DOUBLE PRECISION SYV, S
  13.       INTEGER BLANK, Z, DOT, D, E, PLUS, MINUS, NAME, NUM, SIGN
  14.      .        CHCNT, EOL, STAR, SLASH, BSLASH, SS, CHCNT, I
  15. C
  16.       DOUBLE PRECISION FLOP
  17. C
  18.       DATA BLANK / 36 /, Z / 35 /, DOT / 47 /, D / 13 /, E / 14 /
  19.       DATA EOL / 99 /, PLUS / 41 /,  MINUS / 42 /, NAME / 1 /
  20.       DATA NUM / 0 /, STAR / 43 /, SLASH / 44 /, BSLASH / 45 /
  21. C
  22. C
  23. 10    CONTINUE
  24.       IF (CHAR.NE.BLANK) GO TO 20
  25.       CALL GETCH
  26.       GO TO 10
  27. C
  28. 20    CONTINUE
  29.       LPT(2) = LPT(3)
  30.       LPT(3) = LPT(4)
  31.       IF (CHAR.LE.9) GO TO 50
  32.       IF (CHAR.LE.Z) GO TO 30
  33. C
  34. C ***      SPECIAL CHARACTER
  35.       SS = SYM
  36.       SYM = CHAR
  37.       CALL GETCH
  38.       IF (SYM.NE.DOT) GO TO 90
  39. C
  40. C ***      IS DOT PART OF NUMBER OR OPERATOR
  41.       SYV = 0.0D0
  42.       IF (CHAR.LE.9) GO TO 55
  43.       IF (CHAR.EQ.STAR .OR. CHAR.EQ.SLASH .OR. CHAR.EQ.BSLASH) GO TO 90
  44.       IF (SS.EQ.STAR .OR. SS.EQ.SLASH .OR. SS.EQ.BSLASH) GO TO 90
  45.       GO TO 55
  46. C
  47. C ***      NAME
  48. 30    CONTINUE
  49.       SYM = NAME
  50.       SYN(1) = CHAR
  51.       CHCNT = 1
  52. 40    CONTINUE
  53.       CALL GETCH
  54.       CHCNT = CHCNT+1
  55.       IF (CHAR.GT.Z) GO TO 45
  56.       IF (CHCNT.LE.4) SYN(CHCNT) = CHAR
  57.       GO TO 40
  58. C
  59. 45    CONTINUE
  60.       IF (CHCNT.GT.4) GO TO 47
  61.       DO 46 I = CHCNT, 4
  62.         SYN(I) = BLANK
  63. 46    CONTINUE
  64. 47    CONTINUE
  65.       GO TO 90
  66. C
  67. C ***      NUMBER
  68. 50    CONTINUE
  69.       CALL GETVAL (SYV)
  70.       IF (CHAR.NE.DOT) GO TO 60
  71.       CALL GETCH
  72. 55    CONTINUE
  73.       CHCNT = LPT(4)
  74.       CALL GETVAL (S)
  75.       CHCNT = LPT(4)-CHCNT
  76.       IF (CHAR.EQ.EOL) CHCNT = CHCNT+1
  77.       SYV = SYV+S/10.0D0**CHCNT
  78. 60    CONTINUE
  79.       IF (CHAR.NE.D .AND. CHAR.NE.E) GO TO 70
  80.       CALL GETCH
  81.       SIGN = CHAR
  82.       IF (SIGN.EQ.MINUS .OR. SIGN.EQ.PLUS) CALL GETCH
  83.       CALL GETVAL (S)
  84.       IF (SIGN.NE.MINUS) SYV = SYV*10.0D0**S
  85.       IF (SIGN.EQ.MINUS) SYV = SYV/10.0D0**S
  86. 70    CONTINUE
  87.       STKI(VSIZE) = FLOP (SYV)
  88.       SYM = NUM
  89. C
  90. 90    CONTINUE
  91.       IF (CHAR.NE.BLANK) GO TO 99
  92.       CALL GETCH
  93.       GO TO 90
  94. C
  95. 99    CONTINUE
  96.       IF (DDT.NE.1) RETURN
  97.       IF (SYM.GT.NAME .AND. SYM.LT.ALFL) WRITE (WTE, 197) ALFA(SYM+1)
  98. 197   FORMAT (1X, A1)
  99.       IF (SYM.GE.ALFL) WRITE (WTE, 198)
  100. 198   FORMAT (' EOL')
  101.       IF (SYM.EQ.NAME) CALL PRNTID (SYN, 1)
  102.       IF (SYM.EQ.NUM) WRITE (WTE, 199) SYV
  103. 199   FORMAT (1X, G8.2)
  104.       RETURN
  105.       END
  106.