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

   1 C       -+-+-+-+-+ \ e  H A E C F L . F T  \ e -+-+-+-+-+
   2 C
   3 C       HERE WE PRINT THE SUMMED INTENSITY OF THE POWER SPECTRUM STORED ON UNIT 5
   4 C
   5         SUBROUTINE CFLACH
   6         INCLUDE HAEBUF.FI
   7         INCLUDE HAEGSA.FI
   8         INCLUDE HAEPTI.FI
   9         INCLUDE HABRK.FI
  10         INCLUDE HAEI85.FI
  11         INCLUDE HAECSZ.FI
  12         INCLUDE HAETTY.FI
  13 C
  14 \fC
  15         REAL COND
  16         INTEGER NCOND,TOASCI
  17         EXTERNAL COND,NCOND,TOASCI
  18 C
  19 \f       REAL FFTX(85),                  @ PART OF THE FFT BUFFER
  20      *   SUMM,                          @ SUMM OF ALL INTENSITIES
  21      *  PERCNT(10),CNTPER(10)           @ PERCENTAGE OF THE WHOLE POWER, FREQUENCY OF THIS VALUE (COMPUTED)
  22         INTEGER I,J,INCR2,PNT,
  23      *  RANGE                           @ POINTER TO THE PERCNT VECTOR
  24         LOGICAL F1                      @ SAMPLE BUFFER IS EMPTY FLAG
  25 C
  26         DATA PERCNT /10.,20.,40.,50.,60.,70.,80.,90.,95.,99./
  27 C
  28 C
  29 C       OPEN THE INPUT DATA FILE UNIT 5
  30 C        READ THE FILE HEADER FIRST BLOCK AND
  31 C        THE DATA HEADER, THE SECOND BLOCK OF UNIT 5
  32 C        INSERT THE COMMON CEGESA FROM THE DATA FILE
  33 C
  34         IF (REC5.LT.1) DEFINE FILE5(MAXBL5,85,U,REC5)
  35         REC5=1
  36         F1=SAMCNT.EQ.0 .OR. .NOT. COMP @ HEADER OF FILE 5 DOES NOT MATCH THE HEADER OF THE ACTUAL SAMPLE BUFFER
  37         READ (5'REC5) (RCRD0(I),I=1,85) @ READ THE FILE HEADER
  38         IF (F1) SAMCNT=0                @ CLEAR THE ACTUAL SAMPLE BUFFER
  39         IF (F1) COMP=.FALSE.            @ AND THE COMPUTATIONS FLAG TOO
  40         IF (REDVAL.NE.6H2DPWLD) GOTO 20 @ RECORD IS EMPTY
  41         REDVAL=0                        @ FOR SAVETY ONLY
  42         READ (5'REC5) LCEGSA(1),(LCEGSA(I),I=2,LCEGSA(1)) @ READ THE DATA HEADER BLOCK ( COMMON CEGESA)
  43         SETNUM=SETNU5
  44         CHANEL=CHANE5
  45 C
  46         INCR2=INCR/2                    @ NUMBER OF DATA POINTS IN POWER SPECTRUM
  47         PLTEND=NCOND(PLTEND,PLTEND,SAMRAT/2) @ DEFAULT END OF FREQUENCY SCALE IN HERTZ!
  48 C
  49         IF BREAK(11) RETURN             @ USER ABORTS PROGRAM
  50         WRITE (8,2) PERCNT              @ WRITE A HEADER
  51 C
  52 C
  53 C       COMPUTE THE WHOLE SUMM OF ALL INTENSITIES
  54 C
  55         XMAXI=0                         @ THIS HOLDS THE SUMM
  56         DO 40 I=1,INCR/2
  57         J=MOD(I-1,85)
  58         IF (J.EQ.0) READ (5'REC5) FFTX
  59 40      XMAXI=FFTX(J+1)+XMAXI
  60 C
  61         IF (OPTION.EQ.12) GOTO 30       @ PF* TAKES THE DEFAULT VALUES AND DOESNT ASK QUESTIONS
  62         IF BREAK(11) RETURN             @ USER SWITCHED OFF THE TASK
  63 30      CONTINUE
  64 C
  65 C
  66         L1=.FALSE.
  67         REC5=3                  @ POWER SPECTRUM IS STORED ON REC 3 TO 17
  68
  69         SUMM=0
  70         RANGE=1                         @ SET THE POINTER FOR THE INTENSITY RANGE SCAN
  71         CALL MOVE (-10,99.,CNTPER)
  72         DO 10 I=PLTBEG*SPAN,PLTEND*SPAN,1
  73         J=MOD(I,85)
  74         IF (J.EQ.0) READ (5'REC5) FFTX
  75         SUMM=FFTX(J+1)+SUMM
  76         IF (SUMM.LT.XMAXI*PERCNT(RANGE)*.01) GOTO 10
  77         CNTPER(RANGE)=FLOAT(I)/FLOAT(SPAN) @ THE UNITS ARE HERTZ (HZ!)
  78         RANGE=RANGE+1
  79 10      CONTINUE
  80         SS=TOASCI(MOD(PLTBEG,60))
  81         MM=PLTBEG/60                    @ COMPUTE THE TIME OF THE POWER SPECTRUM
  82         WRITE (8,3) SETNUM,CHANEL,(LABEL(I),I=1,9),
  83      *  MM,SS,SPAN,CNTPER,XMAXI
  84         RETURN
  85 \fC
  86 C
  87 20      CONTINUE                        @ FILE 5 IS EMPTY
  88         COMPUT=0
  89         SAMCNT=0
  90         WRITE (TTO,1)                   @ NO DATA TO PLOT
  91         RETURN
  92 C
  93 C
  94 1       FORMAT (' KEINE DATEN IN DER DATEI 5')
  95 2       FORMAT (1H1,T72,10F6.1)
  96 3       FORMAT (I4,I2,':'9A6,I4,1H:,A2,1H-,I2,10F6.1,1P,E11.2)
  97         END
  98 \1a