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