C -+-+-+-+-+  H A E F I 1 . F T  -+-+-+-+-+ C C 11 POINT FILTER C SUBROUTINE FI1LTR INCLUDE HAEBUF.FI INCLUDE HAEGSA.FI INCLUDE HAEPTI.FI INCLUDE HABRK.FI INCLUDE HAEI85.FI INCLUDE HAETTY.FI C C REAL COND INTEGER NCOND EXTERNAL COND,NCOND C REAL FFTX(85), @ PART OF THE FFT BUFFER * ORD,ABZ,TEMSET, * FFTMIN,FFTMAX, @ HERE WE SAVE THE NEW MINIMUM AND MAXIMUM * X(11),Y(11), @ TEMPORARY STORAGE * A(6) @ SCALING INTEGER I,J,K,INCR2,PNT,BAND LOGICAL F1, @ SAMPLE BUFFER IS EMPTY FLAG * W @ BUFFER CHANGED FLAG DATA A /.1038,.1956,.1608,.0488,.021,-.03/ C C C C OPEN THE INPUT DATA FILE UNIT 5 C READ THE FILE HEADER FIRST BLOCK AND C THE DATA HEADER, THE SECOND BLOCK OF UNIT 5 C INSERT THE COMMON CEGESA FROM THE DATA FILE 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 READ (5'REC5) LCEGSA(1),(LCEGSA(I),I=2,LCEGSA(1)) @ READ THE DATA HEADER BLOCK ( COMMON CEGESA) IF (FILTER.EQ.0) GOTO 40 @ ONLY ONE FILTER SCAN ALLOWED WRITE (TTY,2) FILTER @ ' DATA SET ALREADY WITH N POINT FILTER SMOOTHED' RETURN 40 CONTINUE INCR2=INCR/2 @ NUMBER OF DATA POINTS IN POWER SPECTRUM C C HERE WE SCAN WITH A 11 POINT FILTER THE POWER SPECTRUM C C CALL MOVE (-11,0,Y) W=.FALSE. FFTMAX=0 FFTMIN=5E55 DO 10 I=1,INCR2 J=MOD(I-1,85) IF (J.NE.0) GOTO 15 IF (W) WRITE (5'REC5) FFTX W=.FALSE. READ (5'REC5) FFTX REC5=REC5-1 15 CONTINUE CALL MOVE (10,Y(2),Y) Y(11)=FFTX(J+1) FFTX(J+1)=0 DO 16 K=1,6 FFTX(J+1)=FFTX(J+1)+A(K)*(Y(7-K)+Y(5+K)) FFTMIN=AMIN1(FFTMIN,FFTX(J+1)) FFTMAX=AMAX1(FFTMAX,FFTX(J+1)) 16 CONTINUE W=.TRUE. 10 CONTINUE IF (W) WRITE (5'REC5) FFTX C C HERE WE SCAN THE BAND INTENSITY C W=.FALSE. DO 30 BAND=1,5 CALL MOVE (-11,0,Y) CALL MOVE (-11,0,X) DO 30 I=0,DATCNT-1 PNT=MOD(I,4)+1 IF (PNT.NE.1) GOTO 35 IF (W) WRITE (5'REC5) INTE85 W=.FALSE. REC5=STSCAN+I/4 READ (5'REC5) INTE85 REC5=REC5-1 35 CONTINUE CALL MOVE (10,Y(2),Y) CALL MOVE (10,X(2),X) Y(11)=INTE(1,BAND,PNT) X(11)=INTE(4,BAND,PNT) INTE(1,BAND,PNT)=0 INTE(4,BAND,PNT)=0 DO 36 K=1,6 INTE(1,BAND,PNT)=INTE(1,BAND,PNT)+A(K)*(Y(7-K)+Y(5+K)) 36 INTE(4,BAND,PNT)=INTE(4,BAND,PNT)+A(K)*(X(7-K)+X(5+K)) W=.TRUE. 30 CONTINUE IF (W) WRITE (5'REC5) INTE85 C INSERT THE NEW MIN/MAX INTO THE SECOND DATA HEADER BLOCK REC5=2 @ READ THE HEADER AGAIN XMINI=FFTMIN XMAXI=FFTMAX @ INSERT THE NEW MIN/MAX FILTER=11 @ 11 POINT FILTER WRITE (5'REC5) LCEGSA(1),(LCEGSA(I),I=2,LCEGSA(1)) @ WRITE THE DATA HEADER BLOCK ( COMMON CEGESA) RETURN C 20 CONTINUE @ FILE 5 IS EMPTY COMPUT=0 SAMCNT=0 WRITE (TTO,1) @ NO DATA FOUND RETURN C 1 FORMAT (' KEINE DATEN IN DER DATEI 5') 2 FORMAT (' LEISTUNGS SPECTRUM BEREITS MIT ',I3,' PUNKT FILTER', * 'GEGELAETET.') END