SUBROUTINE COMAND (ID) IMPLICIT NONE C INTEGER ID(4) C INCLUDE MATLAB$KOM:SIZEPARMS.INC INCLUDE MATLAB$KOM:MATPLT.KOM INCLUDE MATLAB$KOM:VSTK.KOM INCLUDE MATLAB$KOM:ALFS.KOM INCLUDE MATLAB$KOM:RECU.KOM INCLUDE MATLAB$KOM:IOP.KOM INCLUDE MATLAB$KOM:COM.KOM C INTEGER CMD(4,17), CMDL, A, D, E, Z, LRECL, CH, H(4) INTEGER BLANK, NAME, DOT, SEMI, COMMA, EOL, I, J, K, L C DOUBLE PRECISION URAND LOGICAL EQID C C CLEAR ELSE END C EXIT FOR HELP C IF LONG RETUR C SEMI SHORT WHAT C WHILE WHO WHY C LALA FOO DATA CMD / . 12, 21, 14, 10, 14, 21, 28, 14, 14, 23, 13, 36, . 14, 33, 18, 29, 15, 24, 27, 36, 17, 14, 21, 25, . 18, 15, 36, 36, 21, 24, 23, 16, 27, 14, 29, 30, . 28, 14, 22, 18, 28, 17, 24, 27, 32, 17, 10, 29, . 32, 17, 18, 21, 32, 17, 24, 36, 32, 17, 34, 36, . 21, 10, 21, 10, 15, 30, 12, 20 / DATA CMDL / 17 /, A / 10 /, D / 13 /, E / 14 /, Z / 35 / DATA LRECL / 80 / DATA BLANK / 36 /, NAME / 1 /, DOT / 47 / DATA SEMI / 39 /, COMMA / 48 /, EOL / 99 / C C C IF (DDT.EQ.1) WRITE (WTE, 100) 100 FORMAT (' COMAND') FUN = 0 DO 10 K = 1, CMDL IF (EQID (ID, CMD(1,K))) GO TO 20 10 CONTINUE FIN = 0 RETURN C 20 CONTINUE IF (CHAR.EQ.COMMA .OR. CHAR.EQ.SEMI .OR. CHAR.EQ.EOL) GO TO 22 IF (CHAR.LE.Z .OR. K.EQ.6) GO TO 22 CALL ERROR (16) RETURN C 22 CONTINUE FIN = 1 GO TO (25, 36, 38, 40, 30, 80, 34, 52, 44, 55, . 50, 65, 32, 60, 70, 46, 48), K C C *** CLEAR 25 CONTINUE IF (CHAR.GE.A .AND. CHAR.LE.Z) GO TO 26 BOT = LSIZE-3 GO TO 98 C 26 CONTINUE CALL GETSYM TOP = TOP+1 MSTK(TOP) = 0 NSTK(TOP) = 0 RHS = 0 CALL STACKP (SYN) IF (ERR.GT.0) RETURN FIN = 1 GO TO 98 C C *** FOR, WHILE, IF, ELSE, END 30 CONTINUE FIN = -11 GO TO 99 C 32 CONTINUE FIN = -12 GO TO 99 C 34 CONTINUE FIN = -13 GO TO 99 C 36 CONTINUE FIN = -14 GO TO 99 C 38 CONTINUE FIN = -15 GO TO 99 C C *** EXIT 40 CONTINUE IF (PT.GT.PTZ) FIN = -16 IF (PT.GT.PTZ) GO TO 98 K = IDINT (STKR(VSIZE-2)) WRITE (WTE, 140) K IF (WIO.NE.0) WRITE (WIO, 140) K 140 FORMAT (/, ' total flops ', I9, //, ' ADIOS', /) IF (PLTST) THEN CALL PLTFIN CALL RLSDEV ENDIF FUN = 99 GO TO 98 C C *** RETURN 44 CONTINUE K = LPT(1)-7 IF (K.LE.0) FUN = 99 IF (K.LE.0) GO TO 98 CALL FILES (-1*RIO, BUF) LPT(1) = LIN(K+1) LPT(4) = LIN(K+2) LPT(6) = LIN(K+3) PTZ = LIN(K+4) RIO = LIN(K+5) LCT(4) = LIN(K+6) CHAR = BLANK SYM = COMMA GO TO 99 C C *** LALA 46 CONTINUE WRITE (WTE, 900) 'QUIT SINGING AND GET BACK TO WORK.' 900 FORMAT (1X, A) GO TO 98 C C *** FOO 48 CONTINUE WRITE (WTE, 900) 'YOUR PLACE OR MINE' GO TO 98 C C *** SHORT, LONG 50 CONTINUE FMT = 1 GO TO 54 C 52 CONTINUE FMT = 2 C 54 CONTINUE IF (CHAR.EQ.E .OR. CHAR.EQ.D) FMT = FMT+2 IF (CHAR.EQ.Z) FMT = 5 IF (CHAR.EQ.E .OR. CHAR.EQ.D .OR. CHAR.EQ.Z) CALL GETSYM GO TO 98 C C *** SEMI 55 CONTINUE LCT(3) = 1-LCT(3) GO TO 98 C C *** WHO 60 CONTINUE WRITE (WTE, 160) IF (WIO.NE.0) WRITE (WIO, 160) 160 FORMAT (' Your current variables are...') CALL PRNTID (IDSTK(1,BOT), LSIZE-BOT+1) L = VSIZE-LSTK(BOT)+1 WRITE (WTE, 161) L, VSIZE IF (WIO.NE.0) WRITE (WIO, 161) L, VSIZE 161 FORMAT (' using ', I7, ' out of ', I7, ' elements.') GO TO 98 C C *** WHAT 65 CONTINUE WRITE (WTE, 900) 'The functions and commands are...' H(1) = 0 CALL FUNS (H) CALL PRNTID (CMD, CMDL-2) GO TO 98 C C *** WHY 70 CONTINUE K = IDINT (9.0D0*URAND (RAN(1))+1.0D0) GO TO (71, 72, 73, 74, 75, 76, 77, 78, 79), K C 71 CONTINUE WRITE (WTE, 900) 'WHAT?' GO TO 98 C 72 CONTINUE WRITE (WTE, 900) 'R.T.F.M.' GO TO 98 C 73 CONTINUE WRITE (WTE, 900) 'HOW THE HELL SHOULD I KNOW?' GO TO 98 C 74 CONTINUE WRITE (WTE, 900) 'PETE MADE ME DO IT.' GO TO 98 C 75 CONTINUE WRITE (WTE, 900) 'INSUFFICIENT DATA TO ANSWER.' GO TO 98 C 76 CONTINUE WRITE (WTE, 900) 'IT FEELS GOOD.' GO TO 98 C 77 CONTINUE WRITE (WTE, 900) 'WHY NOT?' GO TO 98 C 78 CONTINUE WRITE (WTE, 900) '/--ERROR' WRITE (WTE, 900) 'STUPID QUESTION.' GO TO 98 C 79 CONTINUE WRITE (WTE, 900) 'SYSTEM ERROR, RETRY' GO TO 98 C C *** HELP 80 CONTINUE IF (CHAR.NE.EOL) GO TO 81 WRITE (WTE, 180) IF (WIO.NE.0) WRITE (WIO, 180) 180 FORMAT (' Type HELP followed by ...', /, . ' INTRO (To get started)', /, . ' NEWS (recent revisions)') H(1) = 0 CALL FUNS (H) CALL PRNTID (CMD, CMDL-2) J = BLANK+2 WRITE (WTE, 181) IF (WIO.NE.0) WRITE (WIO, 181) 181 FORMAT (' ANS EDIT FILE FUN MACRO') WRITE (WTE, 182) (ALFA(I), I = J, ALFL) IF (WIO.NE.0) WRITE (WIO, 182) (ALFA(I), I = J, ALFL) 182 FORMAT (17(1X, A1), /) GO TO 98 C 81 CONTINUE CALL GETSYM IF (SYM.EQ.NAME) GO TO 82 IF (SYM.EQ.0) SYM = DOT H(1) = ALFA(SYM+1) H(2) = ALFA(BLANK+1) H(3) = ALFA(BLANK+1) H(4) = ALFA(BLANK+1) GO TO 84 C 82 CONTINUE DO 83 I = 1, 4 CH = SYN(I) H(I) = ALFA(CH+1) 83 CONTINUE C 84 CONTINUE IF (HIO.NE.0) THEN READ (HIO, 101, END = 89) (BUF(I), I = 1, LRECL) 101 FORMAT (80A1) DO 85 I = 1, 4 IF (H(I).NE.BUF(I)) GO TO 84 85 CONTINUE WRITE (WTE, 102) IF (WIO.NE.0) WRITE (WIO, 102) 102 FORMAT (1X, 80A1) C 86 CONTINUE K = LRECL+1 C 87 CONTINUE K = K-1 IF (BUF(K).EQ.ALFA(BLANK+1)) GO TO 87 WRITE (WTE, 102) (BUF(I), I = 1, K) IF (WIO.NE.0) WRITE (WIO, 102) (BUF(I), I = 1, K) READ (HIO, 101) (BUF(I), I = 1, LRECL) IF (BUF(1).EQ.ALFA(BLANK+1)) GO TO 86 CALL FILES (-HIO, BUF) GO TO 98 ENDIF C 89 CONTINUE WRITE (WTE, 189) (H(I), I = 1, 4) 189 FORMAT (' SORRY, NO HELP ON ', 4A1) CALL FILES (-HIO, BUF) GO TO 98 C 98 CONTINUE CALL GETSYM C 99 CONTINUE RETURN END