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

   1 C       -+-+-+-+-+ \ e  H A E Y S C . F T  \ e -+-+-+-+-+
   2 C
   3 C       FFT OF THE SCAN DATA STORED ON UNIT 5 (INTENSITIES OF POWER SPECTRUM)
   4 C
   5         SUBROUTINE YSCAN
   6 C
   7         INCLUDE HAEBUF.FI
   8         INCLUDE HAEGSA.FI
   9         INCLUDE HAEPTI.FI
  10         INCLUDE HAEDEF.FI
  11         INCLUDE HAEI85.FI
  12         INCLUDE HAETTY.FI
  13         INCLUDE HABRK.FI
  14 C
  15         INTEGER TOASCI,NCOND,LOG2
  16         REAL INTENS,IMAXNT,COND
  17         EXTERNAL TOASCI,INTENS,IMAXNT,NCOND,LOG2,COND
  18 \fC
  19         INTEGER I,J,K,PNT,BAND,         @ DO LOOP COUNTERS & LIMITS
  20      *  POSIT,POS1,                     @  START OF THE ACTUAL WINDOW (SAMRAT*SPAN)*N
  21      *  I1,I2,                          @ INDEX TO COMPLEX SPECTRUM
  22      *  LASTIM
  23         INTEGER HH,MM,SS,HHH,MMM,SSS            @ START OF FFT, END OF FFT IN MINUTES AND SECONDS
  24         REAL X(2050)                    @ BUFFER FOR THE FFT
  25         LOGICAL L1,                     @ TEMPORARY STORAGE
  26      *  F1                              @ SAMPLE BUFFER EMPTY FLAG
  27 C
  28 C       STATEMENT FUNCTIONS ARE:
  29 C
  30         INTEGER DATTIM                  @ STARTING TIME OF THIS POWER SPECTRUM DATA RECORD WITHIN THE SAMPLE
  31         DATTIM(IP1)=INTE(3,1,MOD(IP1,4)+1)
  32         LOGICAL MUSTRD                  @ MUSTRD DECIDES IF WE HAVE TO READ THE NEXT INTE RECORD
  33         MUSTRD(IP1)=MOD(IP1,4).EQ.0
  34 C
  35 C       OPEN THE INPUT DATA FILE UNIT 5
  36 C       READ THE FIRST BLOCK OF THE FILE HEADER AND
  37 C        THE DATA HEADER I.E. COMMON CEGSA THE SECOND BLOCK OF UNIT 5
  38 C
  39         IF (REC5.LT.1) DEFINE FILE5(MAXBL5,85,U,REC5)
  40         REC5=1
  41         F1=SAMCNT.EQ.0 .OR. .NOT. COMP @ HEADER OF FILE 5 DOES NOT MATCH THE HEADER OF THE ACTUAL SAMPLE BUFFER
  42         READ (5'REC5) (RCRD0(I),I=1,85) @ READ THE FILE HEADER
  43         IF (F1) SAMCNT=0                @ CLEAR THE ACTUAL SAMPLE BUFFER
  44         IF (F1) COMP=.FALSE.            @ AND THE COMPUTATIONS FLAG TOO
  45         IF (REDVAL.NE.6H2DPWLD) GOTO 20 @ RECORD IS EMPTY
  46         REDVAL=0                        @ FOR SAVETY ONLY
  47         WRITE (TTO,3) (LABEL(I),I=1,LABCNT) @ TYPE OUT THE LABEL OF THIS DATA SET
  48         READ (5'REC5) LCEGSA(1),(LCEGSA(I),I=2,LCEGSA(1)) @ READ THE DATA HEADER BLOCK ( COMMON CEGESA)
  49         SETNUM=SETNU5                   @ INSERT THE NUMBER OF THE ACTUAL DATA SET
  50         CHANEL=CHANE5                   @ AND THE NUMBER OF THE CHANNEL INVESTIGATED TOO
  51 C
  52 C
  53 C       DO THE FFT
  54 C
  55         IF (REC5.LT.1) DEFINE FILE 5(MAXBL5,85,U,REC5) @ OPEN SCRATCH FILE FOR INTERMEDIATE FFT RESULTS
  56 C
  57         REC5=2
  58         READ (5'REC5) (LCEGSA(I),I=1,LCEGSA(1))
  59 C       READ BEGIN AND END OF THE FFT
  60 C
  61         BEGIN=NCOND(PZBEG,PZBEG,BEGIN)
  62         ENDS=MIN0(NCOND(PZEND,PZEND,9999),BEGFFT+4*SPAN)
  63         IF (OPTION.NE.12) CALL ASKHIM(2) @ ASK FOR BEGIN AND ENDS
  64         PZBEG=BEGIN
  65         PZEND=ENDS
  66         WRITE (TTO,4)
  67         READ (TTI,5) BAND
  68 C
  69 C
  70 C
  71         N=0
  72         DO 40 I=0,DATCNT-1              @ LOOP TO FETCH EACH VALUE FROM INPUT FILE
  73         REC5=STSCAN+I/4                 @ COMPUTE THE NUMBER OF THE NEXT RECORD TO READ
  74         IF (MUSTRD(I)) READ(5'REC5) INTE85 @ READ THE NEXT DATA SET
  75         IF (DATTIM(I).LT.BEGIN) GOTO 40
  76         IF (DATTIM(I).GT.ENDS) GOTO 45
  77         LASTIM=NCOND(LOG2(N).GT.0,DATTIM(I),LASTIM) @ WE NEED A TWO'S POWER NUMBER OF POINTS FOR THE FFT
  78         N=N+1                           @ INCREMENT POINTER IN ORDER
  79         X(N)=INTE(1,BAND,MOD(I,4)+1)    @  TO INSERT THE NEXT POINT
  80 40      CONTINUE
  81 45      CONTINUE                        @ WE SCANNED ALL POINTS, SO PREP FOR THE FFT
  82         INCR=2**IABS(LOG2(N))           @ WE NEED A TWO'S POWER NUMBER OF POINTS FOR THE FFT
  83         XMAXI=0                         @ FETCH THE MAXIMUM OF THE SPECTRUM
  84         DO 46 I=1,INCR
  85 46      XMAXI=AMAX1(X(I),XMAXI)         @ AND THEN WE FETCH THE MAXIMUM OF THE SPECTRUM
  86         DO 48 I=1,INCR
  87 48      X(I)=X(I)/XMAXI                 @ NORM TO THE MAXIMUM TO PREVENT FLOATING OVERFLOW
  88         MM=BEGIN/60
  89         HH=TOASCI(MM/60)
  90         MM=TOASCI(MOD(MM,60))
  91         SS=TOASCI(MOD(BEGIN,60))
  92         MMM=LASTIM/60
  93         HHH=TOASCI(MMM/60)
  94         MMM=TOASCI(MOD(MMM,60))
  95         SSS=TOASCI(MOD(LASTIM,60))
  96         ENDS=LASTIM                     @ INSERT THE NEW END OF THE COMPUTATION
  97         WRITE (TTO,2) HH,MM,SS,HHH,MMM,SSS,LASTIM,XMAXI
  98         EXPON=LOG2(INCR)
  99         INCR2=INCR/2
 100         CALL FFTC(X,INCR2,EXPON-1,1.)   @ BLACK MAGIC BOXES
 101         CALL FFTR(X,INCR2,1.,1.)
 102         CALL HANING (X,INCR2)           @ SMOOTH REAL PART
 103         CALL HANING (X(INCR2),INCR2)    @ SMOOTH IMAG PART OF FFT
 104         CALL FTPOWR(X,INCR)             @ COMPUTE THE POWER SPECTRUM AND THE MINIMUM OF THE SPECTRUM
 105         X(1)=0                          @ CLEAR THE FIRST AND SECOND CHANNEL TO
 106         X(2)=0                          @  STRIP OFF THE DC OFFSET
 107         XMAXI=0
 108         DO 50 I=1,INCR2                 @ COMPUTE THE NEW MAXIMUM OF THE POWER SPECTRUM
 109 50      XMAXI=AMAX1(XMAXI,X(I))
 110 C
 111         FILTER=0                        @ NEW DATA, NOTHING FILTERED
 112         CONTNS=BAND                     @ REC3 TO 16 CONTAINS A SCAN POWER SPECTRUM
 113         SPAN=1
 114         REC5=2
 115         WRITE (5'REC5) (LCEGSA(I),I=1,LCEGSA(1)) @ WRITE THE DATA HEADER BLOCK ( COMMON CEGESA)
 116         DO 55 J=1,INCR2+84,85           @ SAVE THE LAST POWER SPECTRUM COMPUTED INTO REC 3-27
 117 55      WRITE (5'REC5) (X(I),I=J,MIN0(1024,J+84)) @ 13 RECORDS TO WRITE
 118         COMP=.TRUE.                     @ SOME COMPUTATIONS DONE
 119         RETURN
 120 C
 121 C
 122 20      CONTINUE                        @ FILE 5 IS EMPTY
 123         COMPUT=0
 124         SAMCNT=0
 125         WRITE (TTO,1)                   @ NO DATA TO PLOT
 126         RETURN
 127 C
 128 1       FORMAT (' KEINE DATEN IN DER DATEI 5')
 129 2       FORMAT (' FFT VON ',2(A2,1H:),A2,' BIS ',2(A2,1H:),A2,I5,
 130      *  1P,E12.2)
 131 3       FORMAT (1X,14A6)
 132 4       FORMAT (' NUMMER DES BANDES? ',$)
 133 5       FORMAT (I1)
 134         END
 135 \1a