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

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