sw/rescue/lab8e_goettingen/disk2_11/rkb/paroff/haedec.ft

   1 C       -+-+-+-+-+ \ e  H A E D E C . F T  \ e -+-+-+-+-+
   2 C
   3 C       COMMAND INPUT AND DECODING
   4 C       * UP 11-MAY-83
   5 C       * UP 26-JAN-84
   6 C
   7         SUBROUTINE DECODE
   8         INCLUDE HAEPTI.FI
   9         INCLUDE HABRK.FI
  10         INCLUDE HAETTY.FI
  11 C
  12 \fC
  13         INTEGER CMD(30),MAXCMD          @ MAXCMD = DIM(CMD)
  14      *  ,SUBCMD(13),MAXSUB,             @ MAXSUB=DIM(SUBCMD)
  15      *  I,J,K,LINE(26),SUBLIN(26)
  16         DATA SUBCMD,MAXSUB
  17      *  /1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9,1H-,1H*,1H+, 13/
  18         DATA CMD,MAXCMD
  19      *  /2H  ,2HRD,2HAD,2HTV,2HPL,2HLP,
  20      *  2HCH,2HCO,2HEX,2HTO,2HSC,2HSP,2HSZ,2HPA,2HPR,2HFS,2HF3,2HF1,
  21      *  2HPF,2HCF,2HEO,2HID,2HCL,2HYS,2HNY,2HEI,2HFR,3*2H  ,30/
  22 C
  23 C
  24 10      IF BREAK(11) WRITE (TTO,5)      @ SWITCH 11 ABORTS ONE TASK ONLY
  25 11      IF BREAK(11) GOTO 11
  26         IF BREAK(10) WRITE (TTO,6)      @ SWITCH 10 ABORTS ALL COMMANDS
  27 12      IF BREAK(10) GOTO 12
  28         WRITE (TTO,4)                   @ $ DRUCKEN
  29         READ (TTI,1) (LINE(I),SUBLIN(I),I=1,26)
  30         DO 40 I=1,26                    @ TEST IF THERE IS AN EMPTY INPUT
  31         IF (LINE(27-I).NE.1H ) GOTO 41
  32 40      CONTINUE
  33         RETURN                          @ NO INPUT, EXECUTE LAST COMMANDS AGAIN
  34 41      CONTINUE
  35         ACTNUM=27-I                     @ DELETE TRAILING WORDS WITH SPACES
  36         DO 20 I=1,ACTNUM
  37         DO 15 J=1,MAXCMD,1              @ LOOK FOR A CMD
  38         IF (LINE(I).EQ.CMD(J)) GOTO 16  @ AHH, WE FOUND
  39 15      CONTINUE
  40         J=0                             @ INPUT DIDN'T MATCH ANY CMD, SET THE ERROR FLAG
  41 16      COMD(I)=J                       @ NUMMER DES BEFEHLS EINSETZEN
  42         IF (COMD(I).EQ.0) GOTO 35       @ IF THERE IS NO VALID CMD THEN ERROR OFF
  43         DO 30 J=1,MAXSUB,1
  44 30      IF (SUBLIN(I).EQ.SUBCMD(J)) COMD(I)=J*100+COMD(I)
  45         GOTO 20                         @ EXAMINE THE NEXT CMD'S
  46 C
  47 C
  48 35      CONTINUE                        @ HERE IS THE ERROR ROUTINE
  49         WRITE (TTO,2) LINE              @ IM FEHLERFALL EINGABEZEILE MIT STERNCHEN DARUNTER AUSDRUCKEN
  50         CALL MOVE (-13,1H ,LINE)
  51         K=I*3-2                         @ SPALTE AUSRECHNEN
  52         CALL CPUT (LINE,K,42)           @ FEHLERHAFTE * IN AUSGABEZEILE SETZEN
  53         K=K/6+1                         @ WORTE AUSRECHNEN UM KEINE
  54         WRITE (TTO,3) (LINE(J),J=1,K)   @  LEERZEICHEN ZUVIEL ZU DRUCKEN
  55         GOTO 10                         @ NEUE EINGABE ERWARTEN
  56 20      CONTINUE
  57         RETURN                          @ NACH ESUP UM DIE ZEILE AUSZUWERTEN
  58 1       FORMAT (26(A2,A1))
  59 2       FORMAT (2X,26A3)
  60 3       FORMAT (2X,13A6)
  61 4       FORMAT (2H $,$)
  62 5       FORMAT (' SCHALTER 11 AUSSCHALTEN.')
  63 6       FORMAT (' SCHALTER 10 AUSSCHALTEN.')
  64         END
  65 \1a