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

   1 C       -+-+-+-+-+ \ e  H A E F I 1 . F T  \ e -+-+-+-+-+
   2 C
   3 C       11 POINT FILTER
   4 C
   5         SUBROUTINE FI1LTR
   6         INCLUDE HAEBUF.FI
   7         INCLUDE HAEGSA.FI
   8         INCLUDE HAEPTI.FI
   9         INCLUDE HABRK.FI
  10         INCLUDE HAEI85.FI
  11         INCLUDE HAETTY.FI
  12 C
  13 \fC
  14         REAL COND
  15         INTEGER NCOND
  16         EXTERNAL COND,NCOND
  17 C
  18         REAL FFTX(85),                  @ PART OF THE FFT BUFFER
  19      *  ORD,ABZ,TEMSET,
  20      *  FFTMIN,FFTMAX,                  @ HERE WE SAVE THE NEW MINIMUM AND MAXIMUM
  21      *  X(11),Y(11),                    @ TEMPORARY STORAGE
  22      *  A(6)                            @ SCALING
  23         INTEGER I,J,K,INCR2,PNT,BAND
  24         LOGICAL F1,                     @ SAMPLE BUFFER IS EMPTY FLAG
  25      *  W                               @ BUFFER CHANGED FLAG
  26         DATA A /.1038,.1956,.1608,.0488,.021,-.03/
  27 C
  28 C
  29 C
  30 C       OPEN THE INPUT DATA FILE UNIT 5
  31 C        READ THE FILE HEADER FIRST BLOCK AND
  32 C        THE DATA HEADER, THE SECOND BLOCK OF UNIT 5
  33 C        INSERT THE COMMON CEGESA FROM THE DATA FILE
  34 C
  35         IF (REC5.LT.1) DEFINE FILE5(MAXBL5,85,U,REC5)
  36         REC5=1
  37         F1=SAMCNT.EQ.0 .OR. .NOT. COMP @ HEADER OF FILE 5 DOES NOT MATCH THE HEADER OF THE ACTUAL SAMPLE BUFFER
  38         READ (5'REC5) (RCRD0(I),I=1,85) @ READ THE FILE HEADER
  39         IF (F1) SAMCNT=0                @ CLEAR THE ACTUAL SAMPLE BUFFER
  40         IF (F1) COMP=.FALSE.            @ AND THE COMPUTATIONS FLAG TOO
  41         IF (REDVAL.NE.6H2DPWLD) GOTO 20 @ RECORD IS EMPTY
  42         REDVAL=0                        @ FOR SAVETY ONLY
  43         READ (5'REC5) LCEGSA(1),(LCEGSA(I),I=2,LCEGSA(1)) @ READ THE DATA HEADER BLOCK ( COMMON CEGESA)
  44         IF (FILTER.EQ.0) GOTO 40        @ ONLY ONE FILTER SCAN ALLOWED
  45         WRITE (TTY,2) FILTER            @ ' DATA SET ALREADY WITH N POINT FILTER SMOOTHED'
  46         RETURN
  47 40      CONTINUE
  48         INCR2=INCR/2                    @ NUMBER OF DATA POINTS IN POWER SPECTRUM
  49 C
  50 C       HERE WE SCAN WITH A 11 POINT FILTER THE POWER SPECTRUM
  51 C
  52 C
  53         CALL MOVE (-11,0,Y)
  54         W=.FALSE.
  55         FFTMAX=0
  56         FFTMIN=5E55
  57         DO 10 I=1,INCR2
  58         J=MOD(I-1,85)
  59         IF (J.NE.0) GOTO 15
  60         IF (W) WRITE (5'REC5) FFTX
  61         W=.FALSE.
  62         READ (5'REC5) FFTX
  63         REC5=REC5-1
  64 15      CONTINUE
  65         CALL MOVE (10,Y(2),Y)
  66         Y(11)=FFTX(J+1)
  67         FFTX(J+1)=0
  68         DO 16 K=1,6
  69         FFTX(J+1)=FFTX(J+1)+A(K)*(Y(7-K)+Y(5+K))
  70         FFTMIN=AMIN1(FFTMIN,FFTX(J+1))
  71         FFTMAX=AMAX1(FFTMAX,FFTX(J+1))
  72 16      CONTINUE
  73         W=.TRUE.
  74 10      CONTINUE
  75         IF (W) WRITE (5'REC5) FFTX
  76 C
  77 C       HERE WE SCAN THE BAND INTENSITY
  78 C
  79         W=.FALSE.
  80         DO 30 BAND=1,5
  81         CALL MOVE (-11,0,Y)
  82         CALL MOVE (-11,0,X)
  83         DO 30 I=0,DATCNT-1
  84         PNT=MOD(I,4)+1
  85         IF (PNT.NE.1) GOTO 35
  86         IF (W) WRITE (5'REC5) INTE85
  87         W=.FALSE.
  88         REC5=STSCAN+I/4
  89         READ (5'REC5) INTE85
  90         REC5=REC5-1
  91 35      CONTINUE
  92         CALL MOVE (10,Y(2),Y)
  93         CALL MOVE (10,X(2),X)
  94         Y(11)=INTE(1,BAND,PNT)
  95         X(11)=INTE(4,BAND,PNT)
  96         INTE(1,BAND,PNT)=0
  97         INTE(4,BAND,PNT)=0
  98         DO 36 K=1,6
  99         INTE(1,BAND,PNT)=INTE(1,BAND,PNT)+A(K)*(Y(7-K)+Y(5+K))
 100 36      INTE(4,BAND,PNT)=INTE(4,BAND,PNT)+A(K)*(X(7-K)+X(5+K))
 101         W=.TRUE.
 102 30      CONTINUE
 103         IF (W) WRITE (5'REC5) INTE85
 104 C       INSERT THE NEW MIN/MAX INTO THE SECOND DATA HEADER BLOCK
 105         REC5=2                          @ READ THE HEADER AGAIN
 106         XMINI=FFTMIN
 107         XMAXI=FFTMAX                    @ INSERT THE NEW MIN/MAX
 108         FILTER=11                       @ 11 POINT FILTER
 109         WRITE (5'REC5) LCEGSA(1),(LCEGSA(I),I=2,LCEGSA(1)) @ WRITE THE DATA HEADER BLOCK ( COMMON CEGESA)
 110         RETURN
 111 C
 112 20      CONTINUE                        @ FILE 5 IS EMPTY
 113         COMPUT=0
 114         SAMCNT=0
 115         WRITE (TTO,1)                   @ NO DATA FOUND
 116         RETURN
 117 C
 118 1       FORMAT (' KEINE DATEN IN DER DATEI 5')
 119 2       FORMAT (' LEISTUNGS SPECTRUM BEREITS MIT ',I3,' PUNKT FILTER',
 120      *   'GEGELAETET.')
 121         END
 122 \f\1a