C -+-+-+-+-+  H A E Y S C . F T  -+-+-+-+-+ C C FFT OF THE SCAN DATA STORED ON UNIT 5 (INTENSITIES OF POWER SPECTRUM) C SUBROUTINE YSCAN C INCLUDE HAEBUF.FI INCLUDE HAEGSA.FI INCLUDE HAEPTI.FI INCLUDE HAEDEF.FI INCLUDE HAEI85.FI INCLUDE HAETTY.FI INCLUDE HABRK.FI C INTEGER TOASCI,NCOND,LOG2 REAL INTENS,IMAXNT,COND EXTERNAL TOASCI,INTENS,IMAXNT,NCOND,LOG2,COND C INTEGER I,J,K,PNT,BAND, @ DO LOOP COUNTERS & LIMITS * POSIT,POS1, @ START OF THE ACTUAL WINDOW (SAMRAT*SPAN)*N * I1,I2, @ INDEX TO COMPLEX SPECTRUM * LASTIM INTEGER HH,MM,SS,HHH,MMM,SSS @ START OF FFT, END OF FFT IN MINUTES AND SECONDS REAL X(2050) @ BUFFER FOR THE FFT LOGICAL L1, @ TEMPORARY STORAGE * F1 @ SAMPLE BUFFER EMPTY FLAG C C STATEMENT FUNCTIONS ARE: C INTEGER DATTIM @ STARTING TIME OF THIS POWER SPECTRUM DATA RECORD WITHIN THE SAMPLE DATTIM(IP1)=INTE(3,1,MOD(IP1,4)+1) LOGICAL MUSTRD @ MUSTRD DECIDES IF WE HAVE TO READ THE NEXT INTE RECORD MUSTRD(IP1)=MOD(IP1,4).EQ.0 C C OPEN THE INPUT DATA FILE UNIT 5 C READ THE FIRST BLOCK OF THE FILE HEADER AND C THE DATA HEADER I.E. COMMON CEGSA THE SECOND BLOCK OF UNIT 5 C IF (REC5.LT.1) DEFINE FILE5(MAXBL5,85,U,REC5) REC5=1 F1=SAMCNT.EQ.0 .OR. .NOT. COMP @ HEADER OF FILE 5 DOES NOT MATCH THE HEADER OF THE ACTUAL SAMPLE BUFFER READ (5'REC5) (RCRD0(I),I=1,85) @ READ THE FILE HEADER IF (F1) SAMCNT=0 @ CLEAR THE ACTUAL SAMPLE BUFFER IF (F1) COMP=.FALSE. @ AND THE COMPUTATIONS FLAG TOO IF (REDVAL.NE.6H2DPWLD) GOTO 20 @ RECORD IS EMPTY REDVAL=0 @ FOR SAVETY ONLY WRITE (TTO,3) (LABEL(I),I=1,LABCNT) @ TYPE OUT THE LABEL OF THIS DATA SET READ (5'REC5) LCEGSA(1),(LCEGSA(I),I=2,LCEGSA(1)) @ READ THE DATA HEADER BLOCK ( COMMON CEGESA) SETNUM=SETNU5 @ INSERT THE NUMBER OF THE ACTUAL DATA SET CHANEL=CHANE5 @ AND THE NUMBER OF THE CHANNEL INVESTIGATED TOO C C C DO THE FFT C IF (REC5.LT.1) DEFINE FILE 5(MAXBL5,85,U,REC5) @ OPEN SCRATCH FILE FOR INTERMEDIATE FFT RESULTS C REC5=2 READ (5'REC5) (LCEGSA(I),I=1,LCEGSA(1)) C READ BEGIN AND END OF THE FFT C BEGIN=NCOND(PZBEG,PZBEG,BEGIN) ENDS=MIN0(NCOND(PZEND,PZEND,9999),BEGFFT+4*SPAN) IF (OPTION.NE.12) CALL ASKHIM(2) @ ASK FOR BEGIN AND ENDS PZBEG=BEGIN PZEND=ENDS WRITE (TTO,4) READ (TTI,5) BAND C C C N=0 DO 40 I=0,DATCNT-1 @ LOOP TO FETCH EACH VALUE FROM INPUT FILE REC5=STSCAN+I/4 @ COMPUTE THE NUMBER OF THE NEXT RECORD TO READ IF (MUSTRD(I)) READ(5'REC5) INTE85 @ READ THE NEXT DATA SET IF (DATTIM(I).LT.BEGIN) GOTO 40 IF (DATTIM(I).GT.ENDS) GOTO 45 LASTIM=NCOND(LOG2(N).GT.0,DATTIM(I),LASTIM) @ WE NEED A TWO'S POWER NUMBER OF POINTS FOR THE FFT N=N+1 @ INCREMENT POINTER IN ORDER X(N)=INTE(1,BAND,MOD(I,4)+1) @ TO INSERT THE NEXT POINT 40 CONTINUE 45 CONTINUE @ WE SCANNED ALL POINTS, SO PREP FOR THE FFT INCR=2**IABS(LOG2(N)) @ WE NEED A TWO'S POWER NUMBER OF POINTS FOR THE FFT XMAXI=0 @ FETCH THE MAXIMUM OF THE SPECTRUM DO 46 I=1,INCR 46 XMAXI=AMAX1(X(I),XMAXI) @ AND THEN WE FETCH THE MAXIMUM OF THE SPECTRUM DO 48 I=1,INCR 48 X(I)=X(I)/XMAXI @ NORM TO THE MAXIMUM TO PREVENT FLOATING OVERFLOW MM=BEGIN/60 HH=TOASCI(MM/60) MM=TOASCI(MOD(MM,60)) SS=TOASCI(MOD(BEGIN,60)) MMM=LASTIM/60 HHH=TOASCI(MMM/60) MMM=TOASCI(MOD(MMM,60)) SSS=TOASCI(MOD(LASTIM,60)) ENDS=LASTIM @ INSERT THE NEW END OF THE COMPUTATION WRITE (TTO,2) HH,MM,SS,HHH,MMM,SSS,LASTIM,XMAXI EXPON=LOG2(INCR) INCR2=INCR/2 CALL FFTC(X,INCR2,EXPON-1,1.) @ BLACK MAGIC BOXES CALL FFTR(X,INCR2,1.,1.) CALL HANING (X,INCR2) @ SMOOTH REAL PART CALL HANING (X(INCR2),INCR2) @ SMOOTH IMAG PART OF FFT CALL FTPOWR(X,INCR) @ COMPUTE THE POWER SPECTRUM AND THE MINIMUM OF THE SPECTRUM X(1)=0 @ CLEAR THE FIRST AND SECOND CHANNEL TO X(2)=0 @ STRIP OFF THE DC OFFSET XMAXI=0 DO 50 I=1,INCR2 @ COMPUTE THE NEW MAXIMUM OF THE POWER SPECTRUM 50 XMAXI=AMAX1(XMAXI,X(I)) C FILTER=0 @ NEW DATA, NOTHING FILTERED CONTNS=BAND @ REC3 TO 16 CONTAINS A SCAN POWER SPECTRUM SPAN=1 REC5=2 WRITE (5'REC5) (LCEGSA(I),I=1,LCEGSA(1)) @ WRITE THE DATA HEADER BLOCK ( COMMON CEGESA) DO 55 J=1,INCR2+84,85 @ SAVE THE LAST POWER SPECTRUM COMPUTED INTO REC 3-27 55 WRITE (5'REC5) (X(I),I=J,MIN0(1024,J+84)) @ 13 RECORDS TO WRITE COMP=.TRUE. @ SOME COMPUTATIONS DONE RETURN C C 20 CONTINUE @ FILE 5 IS EMPTY COMPUT=0 SAMCNT=0 WRITE (TTO,1) @ NO DATA TO PLOT RETURN C 1 FORMAT (' KEINE DATEN IN DER DATEI 5') 2 FORMAT (' FFT VON ',2(A2,1H:),A2,' BIS ',2(A2,1H:),A2,I5, * 1P,E12.2) 3 FORMAT (1X,14A6) 4 FORMAT (' NUMMER DES BANDES? ',$) 5 FORMAT (I1) END