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 / comand.for < prev    next >
Encoding:
Text File  |  1991-04-13  |  6.6 KB  |  294 lines
  1.       SUBROUTINE COMAND (ID)
  2.       IMPLICIT NONE
  3. C
  4.       INTEGER ID(4)
  5. C
  6.       INCLUDE MATLAB$KOM:SIZEPARMS.INC
  7.       INCLUDE MATLAB$KOM:MATPLT.KOM
  8.       INCLUDE MATLAB$KOM:VSTK.KOM
  9.       INCLUDE MATLAB$KOM:ALFS.KOM
  10.       INCLUDE MATLAB$KOM:RECU.KOM
  11.       INCLUDE MATLAB$KOM:IOP.KOM
  12.       INCLUDE MATLAB$KOM:COM.KOM
  13. C
  14.       INTEGER CMD(4,17), CMDL, A, D, E, Z, LRECL, CH, H(4)
  15.       INTEGER BLANK, NAME, DOT, SEMI, COMMA, EOL, I, J, K, L
  16. C
  17.       DOUBLE PRECISION URAND
  18.       LOGICAL EQID
  19. C
  20. C       CLEAR             ELSE              END
  21. C       EXIT              FOR               HELP
  22. C       IF                LONG              RETUR
  23. C       SEMI              SHORT             WHAT
  24. C       WHILE             WHO               WHY
  25. C       LALA              FOO
  26.       DATA CMD /
  27.      .  12, 21, 14, 10,   14, 21, 28, 14,   14, 23, 13, 36,
  28.      .  14, 33, 18, 29,   15, 24, 27, 36,   17, 14, 21, 25,
  29.      .  18, 15, 36, 36,   21, 24, 23, 16,   27, 14, 29, 30,
  30.      .  28, 14, 22, 18,   28, 17, 24, 27,   32, 17, 10, 29,
  31.      .  32, 17, 18, 21,   32, 17, 24, 36,   32, 17, 34, 36,
  32.      .  21, 10, 21, 10,  15, 30, 12, 20 /
  33.       DATA CMDL / 17 /, A / 10 /, D / 13 /, E / 14 /, Z / 35 /
  34.       DATA LRECL / 80 /
  35.       DATA BLANK / 36 /, NAME / 1 /, DOT / 47 /
  36.       DATA SEMI / 39 /, COMMA / 48 /, EOL / 99 /
  37. C
  38. C
  39. C
  40.       IF (DDT.EQ.1) WRITE (WTE, 100)
  41. 100   FORMAT (' COMAND')
  42.       FUN = 0
  43.       DO 10 K = 1, CMDL
  44.         IF (EQID (ID, CMD(1,K))) GO TO 20
  45. 10    CONTINUE
  46.       FIN = 0
  47.       RETURN
  48. C
  49. 20    CONTINUE
  50.       IF (CHAR.EQ.COMMA .OR. CHAR.EQ.SEMI .OR. CHAR.EQ.EOL) GO TO 22
  51.       IF (CHAR.LE.Z .OR. K.EQ.6) GO TO 22
  52.       CALL ERROR (16)
  53.       RETURN
  54. C
  55. 22    CONTINUE
  56.       FIN = 1
  57.       GO TO (25, 36, 38, 40, 30, 80, 34, 52, 44, 55,
  58.      .       50, 65, 32, 60, 70, 46, 48), K
  59. C
  60. C ***      CLEAR
  61. 25    CONTINUE
  62.       IF (CHAR.GE.A .AND. CHAR.LE.Z) GO TO 26
  63.       BOT = LSIZE-3
  64.       GO TO 98
  65. C
  66. 26    CONTINUE
  67.       CALL GETSYM
  68.       TOP = TOP+1
  69.       MSTK(TOP) = 0
  70.       NSTK(TOP) = 0
  71.       RHS = 0
  72.       CALL STACKP (SYN)
  73.       IF (ERR.GT.0) RETURN
  74.       FIN = 1
  75.       GO TO 98
  76. C
  77. C ***      FOR, WHILE, IF, ELSE, END
  78. 30    CONTINUE
  79.       FIN = -11
  80.       GO TO 99
  81. C
  82. 32    CONTINUE
  83.       FIN = -12
  84.       GO TO 99
  85. C
  86. 34    CONTINUE
  87.       FIN = -13
  88.       GO TO 99
  89. C
  90. 36    CONTINUE
  91.       FIN = -14
  92.       GO TO 99
  93. C
  94. 38    CONTINUE
  95.       FIN = -15
  96.       GO TO 99
  97. C
  98. C ***      EXIT
  99. 40    CONTINUE
  100.       IF (PT.GT.PTZ) FIN = -16
  101.       IF (PT.GT.PTZ) GO TO 98
  102.       K = IDINT (STKR(VSIZE-2))
  103.       WRITE (WTE, 140) K
  104.       IF (WIO.NE.0) WRITE (WIO, 140) K
  105. 140   FORMAT (/, ' total flops ', I9, //, ' ADIOS', /)
  106.       IF (PLTST) THEN
  107.         CALL PLTFIN
  108.         CALL RLSDEV
  109.       ENDIF
  110.       FUN = 99
  111.       GO TO 98
  112. C
  113. C ***      RETURN
  114. 44    CONTINUE
  115.       K = LPT(1)-7
  116.       IF (K.LE.0) FUN = 99
  117.       IF (K.LE.0) GO TO 98
  118.       CALL FILES (-1*RIO, BUF)
  119.       LPT(1) = LIN(K+1)
  120.       LPT(4) = LIN(K+2)
  121.       LPT(6) = LIN(K+3)
  122.       PTZ = LIN(K+4)
  123.       RIO = LIN(K+5)
  124.       LCT(4) = LIN(K+6)
  125.       CHAR = BLANK
  126.       SYM = COMMA
  127.       GO TO 99
  128. C
  129. C ***      LALA
  130. 46    CONTINUE
  131.       WRITE (WTE, 900) 'QUIT SINGING AND GET BACK TO WORK.'
  132. 900   FORMAT (1X, A)
  133.       GO TO 98
  134. C
  135. C ***      FOO
  136. 48    CONTINUE
  137.       WRITE (WTE, 900) 'YOUR PLACE OR MINE'
  138.       GO TO 98
  139. C
  140. C ***      SHORT, LONG
  141. 50    CONTINUE
  142.       FMT = 1
  143.       GO TO 54
  144. C
  145. 52    CONTINUE
  146.       FMT = 2
  147. C
  148. 54    CONTINUE
  149.       IF (CHAR.EQ.E .OR. CHAR.EQ.D) FMT = FMT+2
  150.       IF (CHAR.EQ.Z) FMT = 5
  151.       IF (CHAR.EQ.E .OR. CHAR.EQ.D .OR. CHAR.EQ.Z) CALL GETSYM
  152.       GO TO 98
  153. C
  154. C ***      SEMI
  155. 55    CONTINUE
  156.       LCT(3) = 1-LCT(3)
  157.       GO TO 98
  158. C
  159. C ***      WHO
  160. 60    CONTINUE
  161.       WRITE (WTE, 160)
  162.       IF (WIO.NE.0) WRITE (WIO, 160)
  163. 160   FORMAT (' Your current variables are...')
  164.       CALL PRNTID (IDSTK(1,BOT), LSIZE-BOT+1)
  165.       L = VSIZE-LSTK(BOT)+1
  166.       WRITE (WTE, 161) L, VSIZE
  167.       IF (WIO.NE.0) WRITE (WIO, 161) L, VSIZE
  168. 161   FORMAT (' using ', I7, ' out of ', I7, ' elements.')
  169.       GO TO 98
  170. C
  171. C ***      WHAT
  172. 65    CONTINUE
  173.       WRITE (WTE, 900) 'The functions and commands are...'
  174.       H(1) = 0
  175.       CALL FUNS (H)
  176.       CALL PRNTID (CMD, CMDL-2)
  177.       GO TO 98
  178. C
  179. C ***      WHY
  180. 70    CONTINUE
  181.       K = IDINT (9.0D0*URAND (RAN(1))+1.0D0)
  182.       GO TO (71, 72, 73, 74, 75, 76, 77, 78, 79), K
  183. C
  184. 71    CONTINUE
  185.       WRITE (WTE, 900) 'WHAT?'
  186.       GO TO 98
  187. C
  188. 72    CONTINUE
  189.       WRITE (WTE, 900) 'R.T.F.M.'
  190.       GO TO 98
  191. C
  192. 73    CONTINUE
  193.       WRITE (WTE, 900) 'HOW THE HELL SHOULD I KNOW?'
  194.       GO TO 98
  195. C
  196. 74    CONTINUE
  197.       WRITE (WTE, 900) 'PETE MADE ME DO IT.'
  198.       GO TO 98
  199. C
  200. 75    CONTINUE
  201.       WRITE (WTE, 900) 'INSUFFICIENT DATA TO ANSWER.'
  202.       GO TO 98
  203. C
  204. 76    CONTINUE
  205.       WRITE (WTE, 900) 'IT FEELS GOOD.'
  206.       GO TO 98
  207. C
  208. 77    CONTINUE
  209.       WRITE (WTE, 900) 'WHY NOT?'
  210.       GO TO 98
  211. C
  212. 78    CONTINUE
  213.       WRITE (WTE, 900) '/--ERROR'
  214.       WRITE (WTE, 900) 'STUPID QUESTION.'
  215.       GO TO 98
  216. C
  217. 79    CONTINUE
  218.       WRITE (WTE, 900) 'SYSTEM ERROR, RETRY'
  219.       GO TO 98
  220. C
  221. C ***      HELP
  222. 80    CONTINUE
  223.       IF (CHAR.NE.EOL) GO TO 81
  224.       WRITE (WTE, 180)
  225.       IF (WIO.NE.0) WRITE (WIO, 180)
  226. 180   FORMAT (' Type HELP followed by ...', /,
  227.      .        ' INTRO   (To get started)', /,
  228.      .        ' NEWS    (recent revisions)')
  229.       H(1) = 0
  230.       CALL FUNS (H)
  231.       CALL PRNTID (CMD, CMDL-2)
  232.       J = BLANK+2
  233.       WRITE (WTE, 181)
  234.       IF (WIO.NE.0) WRITE (WIO, 181)
  235. 181   FORMAT (' ANS   EDIT  FILE  FUN   MACRO')
  236.       WRITE (WTE, 182) (ALFA(I), I = J, ALFL)
  237.       IF (WIO.NE.0) WRITE (WIO, 182) (ALFA(I), I = J, ALFL)
  238. 182   FORMAT (17(1X, A1), /)
  239.       GO TO 98
  240. C
  241. 81    CONTINUE
  242.       CALL GETSYM
  243.       IF (SYM.EQ.NAME) GO TO 82
  244.       IF (SYM.EQ.0) SYM = DOT
  245.       H(1) = ALFA(SYM+1)
  246.       H(2) = ALFA(BLANK+1)
  247.       H(3) = ALFA(BLANK+1)
  248.       H(4) = ALFA(BLANK+1)
  249.       GO TO 84
  250. C
  251. 82    CONTINUE
  252.       DO 83 I = 1, 4
  253.         CH = SYN(I)
  254.         H(I) = ALFA(CH+1)
  255. 83    CONTINUE
  256. C
  257. 84    CONTINUE
  258.       IF (HIO.NE.0) THEN
  259.       READ (HIO, 101, END = 89) (BUF(I), I = 1, LRECL)
  260. 101   FORMAT (80A1)
  261.       DO 85 I = 1, 4
  262.         IF (H(I).NE.BUF(I)) GO TO 84
  263. 85    CONTINUE
  264.       WRITE (WTE, 102)
  265.       IF (WIO.NE.0) WRITE (WIO, 102)
  266. 102   FORMAT (1X, 80A1)
  267. C
  268. 86    CONTINUE
  269.       K = LRECL+1
  270. C
  271. 87    CONTINUE
  272.       K = K-1
  273.       IF (BUF(K).EQ.ALFA(BLANK+1)) GO TO 87
  274.       WRITE (WTE, 102) (BUF(I), I = 1, K)
  275.       IF (WIO.NE.0) WRITE (WIO, 102) (BUF(I), I = 1, K)
  276.       READ (HIO, 101) (BUF(I), I = 1, LRECL)
  277.       IF (BUF(1).EQ.ALFA(BLANK+1)) GO TO 86
  278.       CALL FILES (-HIO, BUF)
  279.       GO TO 98
  280.       ENDIF
  281. C
  282. 89    CONTINUE
  283.       WRITE (WTE, 189) (H(I), I = 1, 4)
  284. 189   FORMAT (' SORRY, NO HELP ON ', 4A1)
  285.       CALL FILES (-HIO, BUF)
  286.       GO TO 98
  287. C
  288. 98    CONTINUE
  289.       CALL GETSYM
  290. C
  291. 99    CONTINUE
  292.       RETURN
  293.       END
  294.