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

   1 C       -+-+-+-+-+ \ e  H A E C F R . F I  \ e -+-+-+-+-+
   2 C
   3 C       CHANGE THE FREQUENCY LIMITS OF THE FIVE BANDS
   4 C
   5         SUBROUTINE CFREQU
   6         INCLUDE HAETTY.FI
   7         INCLUDE HAEGSA.FI
   8         INCLUDE HAEPTI.FI
   9 C\f      INTEGER NCOND
  10         REAL COND
  11         LOGICAL BETW
  12         EXTERNAL COND,NCOND,BETW
  13 C
  14         INTEGER BAND,                   @ DO LOOP INDEX
  15      *  TEXT(2),                        @ MESSAGE LOWER LIMIT OR UPPER LIMIT
  16      *  BLOW,BUP,                       @ LOWER AND UPPER BAND LIMITS TO CHANGE
  17      *  TEMP2                           @ HOLDS BAND INDEX ( GREEK LETTER )
  18         LOGICAL L                       @ A SPECIAL BAND LIMIT IS CHANGED
  19         REAL TEMP                       @ USER INPUT
  20         DATA TEXT /'UNTERE','OBERE'/
  21 C
  22         L=BETW(1,OPTION-1,6)
  23         BLOW=NCOND(L,OPTION-1,1)        @ COMPUTE LOWER BAND TO CHANGE
  24         BUP =NCOND(L,BLOW    ,5)        @ COMPUTE UPPER BAND TO CHANGE
  25 C
  26         DO 20 BAND=BLOW,BUP
  27 15      DO 10 LIMIT=1,2                 @ LOWER LIMIT, UPPER LIMIT TO READ
  28         WRITE (TTO,1) TEXT(LIMIT),BAND,FREQU(BAND,LIMIT)
  29         READ  (TTI,2) TEMP,TEMP2        @ WRITE THE OLD VALUE AND ASK FOR THE NEW ONE
  30         GENAM(BAND)=NCOND(TEMP2.NE.1H ,TEMP2,
  31      *  TEMP1.NE.FREQU(BAND,LIMIT),1H ,GENAM(BAND)) @ INSERT THE NEW BAND INDEX (GREEK LETTER) IF DESIERED, OR  IF LIMITS CHANGED DELETE IT
  32 10      FREQU(BAND,LIMIT)=COND(TEMP,TEMP,FREQU(BAND,LIMIT)) @ INSERT THE NEW VALUE
  33         IF (FREQU(BAND,1).LT.FREQU(BAND,2)) GOTO 20 @ IF THE LIMITS ARE MIXED THEN
  34         WRITE (TTO,3) BAND,(FREQU(BAND,LIMIT),LIMIT=1,2) @  WRITE AN ERROR MSG AND ASK AGAIN
  35         GOTO 15
  36 20      CONTINUE
  37         RETURN
  38 1       FORMAT (1X,A6,' GRENZE VON BAND',I2,' (',F4.1,' HZ) ? ',$)
  39 2       FORMAT (F4.0,A2)
  40 3       FORMAT (' GRENZEN VON BAND',I2,' DURCHEINANDER:',2F7.1)
  41         END
  42 \1a