projects / pdp8.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Add README.md
[pdp8.git] / sw / rescue / lab8e_goettingen / disk2_11 / rkb / paroff / haepfl.ft
CommitLineData
81e70d48
PH		 1C -+-+-+-+-+ \ e H A E P F L . F T \ e -+-+-+-+-+\r
2C\r
3C HERE WE PLOT THE SUMMED POWER SPECTRUM (INTENSITY) TO THE FREQUENCY\r
4C OF THE FFT DATA STORED ON UNIT 5\r
5C\r
6C * UP 26-JAN-83\r
7C\r
8 SUBROUTINE PFLOT\r
9 INCLUDE HAEBUF.FI\r
10 INCLUDE HAEGSA.FI\r
11 INCLUDE HAEPTI.FI\r
12 INCLUDE HABRK.FI\r
13 INCLUDE HAEI85.FI\r
14 INCLUDE HAECSZ.FI\r
15 INCLUDE HAPPEN.FI\r
16 INCLUDE HAETTY.FI\r
17C\r
18\fC\r
19 REAL COND\r
20 INTEGER NCOND\r
21 EXTERNAL COND,NCOND\r
22C\r
23 REAL FFTX(85), @ PART OF THE FFT BUFFER\r
24 * ORD,ABZ,\r
25 * TE1,TE2,TE3, @ TEMPORARY STORAGE\r
26 * INTFAC,ORDMAX, @ FACTOR TO SCALE THE INTENSITY OF EACH BAND, MAXIMUM OF THE ORDINATE\r
27 * SUMM, @ SUMM OF ALL INTENSITIES\r
28 * TEMSET @ TEMP Y OFFSET FOR OPTION '1' PLOTTS (OVERPLOT)\r
29 INTEGER I,J,K,INCR2,PNT,BAND,\r
30 * RELABS @ ABS INTENSITY =1, REL INTENSITY =2\r
31 LOGICAL F1, @ SAMPLE BUFFER IS EMPTY FLAG\r
32 * L1 @ TEMPORARY STORAGE\r
33 INTEGER PENPOS @ TEMPORARY PEN STATUS\r
34C\r
35C\r
36C\r
37C OPEN THE INPUT DATA FILE UNIT 5\r
38C READ THE FILE HEADER FIRST BLOCK AND\r
39C THE DATA HEADER, THE SECOND BLOCK OF UNIT 5\r
40C INSERT THE COMMON CEGESA FROM THE DATA FILE\r
41C\r
42 IF (REC5.LT.1) DEFINE FILE5(MAXBL5,85,U,REC5)\r
43 REC5=1\r
44 F1=SAMCNT.EQ.0 .OR. .NOT. COMP @ HEADER OF FILE 5 DOES NOT MATCH THE HEADER OF THE ACTUAL SAMPLE BUFFER\r
45 READ (5'REC5) (RCRD0(I),I=1,85) @ READ THE FILE HEADER\r
46 IF (F1) SAMCNT=0 @ CLEAR THE ACTUAL SAMPLE BUFFER\r
47 IF (F1) COMP=.FALSE. @ AND THE COMPUTATIONS FLAG TOO\r
48 IF (REDVAL.NE.6H2DPWLD) GOTO 20 @ RECORD IS EMPTY\r
49 REDVAL=0 @ FOR SAVETY ONLY\r
50 READ (5'REC5) LCEGSA(1),(LCEGSA(I),I=2,LCEGSA(1)) @ READ THE DATA HEADER BLOCK ( COMMON CEGESA)\r
51 SETNUM=SETNU5\r
52 CHANEL=CHANE5\r
53C HERE WE PLOT THE LAST POWER SPECTRUM STORED ON UNIT 5 REC 3 TO STSCAN\r
54C\r
55 INCR2=INCR/2 @ NUMBER OF DATA POINTS IN POWER SPECTRUM\r
56 PLTEND=NCOND(PLTEND,PLTEND,SAMRAT/2) @ DEFAULT END OF FREQUENCY SCALE\r
57C\r
58C READ THE FREQUENCY AND INTENSITY RANGE OF THE PLOT\r
59 IF (OPTION.EQ.12) GOTO 34 @ PF* TAKES THE DEFAULT VALUES AND DOESNT ASK QUESTIONS\r
6032 WRITE (TTO,4) PLTEND,PLTBEG\r
61 READ (TTI,6) I,J @ ASK FOR THE FREQUENCY WINDOW TO PLOT\r
62 IF BREAK(11) RETURN @ USER ABORTS PROGRAM\r
63 PLTEND=NCOND(I,I,PLTEND) @ NO INPUT LOADS DEFAULT VALUES\r
64 PLTBEG=NCOND(J,J,PLTBEG)\r
6534 IF (PLTEND-PLTBEG .LE.0) GOTO 32 @ UPPER AND LOWER LIMITS MIXED, USER HAS TO RETYPE\r
66C\r
67C\r
68C COMPUTE THE WHOLE SUMM OF ALL INTENSITIES\r
69C\r
70 XMAXI=0 @ THIS HOLDS THE SUMM \r
71 DO 40 I=1,INCR/2\r
72 J=MOD(I-1,85)\r
73 IF (J.EQ.0) READ (5'REC5) FFTX\r
7440 XMAXI=FFTX(J+1)+XMAXI\r
75C\r
76 IF (OPTION.EQ.12) GOTO 30 @ PF* TAKES THE DEFAULT VALUES AND DOESNT ASK QUESTIONS\r
7733 WRITE (TTO,5) XMAXI @ ASK FOR THE SIZE OF INTENSITY SCALE\r
78 READ (TTI,7) TE1\r
79 IF BREAK(11) RETURN @ USER SWITCHED OFF THE TASK\r
80 TE1=COND(TE1.LT.100.,TE1*XMAXI*.01,TE1)\r
81 XMAXI=COND(TE1,TE1,XMAXI) @ NO INPUT MEANS THE ACTUAL MAXIMUM\r
82 IF (XMAXI.LE.0) GOTO 33 @ NEGATIVE POWER SPECRUM INTENSITY IS NOT VALID\r
8330 CONTINUE\r
84C\r
85CXCX XMAXI=ALOG(XMAXI) @ CXCX DISABLES LOG INTENSITY VERSION OF HAEPLO\r
86 CALL STPLT @ OPEN THE PLOTTER ( CALL PLOTS)\r
87 NUMCN=NCOND(OPTION.NE.1,1,2)\r
88 CALL XYPLOT (XOFSET,YOFSET,-PENUP)\r
89 TEMSET=(NUMCN-(CHANEL+1))*\r
90 * YLEN/FLOAT(NUMCN)+(NUMCN-(CHANEL+1))*.5 @ SEE HAESPL FOR DETAILS!\r
91 IF (OPTION.EQ.1) CALL XYPLOT(0,TEMSET,-PENUP) @ SET NEW OFFSET FOR OVERPLOT OPTION \r
92 IF (OPTION.NE.1) CALL FACTOR (XLEN/(SPAN*(PLTEND-PLTBEG)),\r
93 * YLEN/XMAXI) @ FACTOR FOR NORMAL PLOT (ONE PER PAGE)\r
94 IF (OPTION.EQ.1) CALL FACTOR (XLEN/(SPAN*(PLTEND-PLTBEG)),\r
95 * ((YLEN-NUMCN*.5+COND(NUMCN-1,.5))/FLOAT(NUMCN)/XMAXI)) @ SIZE OF DIAGRAM\r
96C\r
97 L1=.FALSE.\r
98 REC5=3\r
99 SUMM=0\r
100 PENPOS=PENUP\r
101 DO 10 I=PLTBEG*SPAN,PLTEND*SPAN,1\r
102 IF (BREAK(11)) GOTO 11 @ USER GETS RID OF PROGRAM, RESET TEMSET OFFSET AND THEN WE ABORT\r
103 J=MOD(I,85)\r
104 IF (J.EQ.0) READ (5'REC5) FFTX\r
105 ABZ=I\r
106 SUMM=FFTX(J+1)+SUMM\r
107 ORD=SUMM\r
108CXCX ORD=AMIN1(ALOG(AMAX1(.1,FFTX(J+1))),XMAXI)\r
109 L1=ORD.GT.XMAXI .AND. L1 @ TRUNCATE SUCH POINTS WHICH ARE TOO LARGE FOR THIS INTENSITY SCALE\r
110 PENPOS=NCOND(L1,PENUP,PENPOS)\r
111 L1=ORD.GT.XMAXI\r
112 ORD=AMIN1(ORD,XMAXI) @ PLOT TO THE BOUNDER OF THIS DIAGRAM\r
113 CALL XYPLOT (ABZ,ORD,PENPOS)\r
114 PENPOS=PENDWN\r
11510 CONTINUE\r
11611 CONTINUE @ WORK DONE, RESET ORIGIN\r
117 CALL FACTOR (1.)\r
118 IF (OPTION.EQ.1) CALL XYPLOT (0,-TEMSET,-PENUP) @ RESET OVERPLOTT OFFSET\r
119\fC \r
120C MAKE A SCALE\r
121C\r
122C FREQUENCY SCALE FROM PLTBEG TO PLTEND HERTZ\r
123C\r
124 IF (BREAK(11)) GOTO 15\r
125 IF (OPTION.EQ.1) GOTO 15 @ OVERPLOT OPTION - NO SCALE\r
126 CALL FACTOR (XLEN/(PLTEND-PLTBEG),1.)\r
127 CALL XYPLOT (0,-.5,-PENUP)\r
128 DO 12 I=PLTBEG,PLTEND @ 1 HERTZ STEP SIZE\r
129 TE1=FLOAT(I-PLTBEG)\r
130 CALL XYPLOT (TE1,0,PENDWN)\r
131 J=MOD(I,NCOND(PLTEND.GT.30,10, PLTEND.GT.15,5,\r
132 * PLTEND.GT.6,2,1))\r
133 TE2=COND(J.EQ.0,-.7, J.EQ.5,-.5, -.3)\r
134 CALL XYPLOT (TE1,TE2,PENDWN)\r
135 IF (J.NE.0) GOTO 12\r
136 CALL WHERE (TE2,TE2,TE2,TE3) @ GET THE X FACTOR\r
137 CALL FACTOR (1.)\r
138 CALL NUMBER (TE1*TE2-INT(ALOG10(AMAX1(1.,TE1))\r
139 * +.01)*YN/2.-YN*.3,\r
140 * -1.3,YN,TE1,0,-1)\r
141 CALL FACTOR (TE2,TE3)\r
142 CALL XYPLOT (TE1,0,PENUP)\r
14312 CALL XYPLOT (TE1,0,PENDWN)\r
144 CALL XYPLOT (0,.5,-PENUP)\r
145 CALL FACTOR (1.)\r
146 IF (.NOT. BREAK(9))\r
147 * CALL SYMBOL (XLEN/2.,-YOFSET,YZ,\r
148 * 'FREQUENCY [HZ]',0,14)\r
149C\r
150C INTENSITY SCALE LINEAR FROM 0 TO XMAXI\r
151C\r
152 IF BREAK(11) GOTO 15\r
153 CALL FACTOR (1.,YLEN/XMAXI)\r
154 CALL XYPLOT (-.5,0,-PENUP)\r
155 TE2=XMAXI/10.\r
156 DO 14 I=0,10\r
157 TE1=TE2*I\r
158 CALL XYPLOT (0,TE1,PENDWN)\r
159 J=MOD(I,10)\r
160 TE3=COND(J.EQ.0,-.7, J.EQ.5,-.5, -.3)\r
161 CALL XYPLOT (TE3,TE1,PENDWN)\r
16214 CALL XYPLOT (0,TE1,PENDWN)\r
163C INSERT THE INTENSITY SCALE MAXIMUM\r
164 CALL WHERE (TE2,TE2,TE2,TE3)\r
165 CALL FACTOR (1.)\r
166 CALL ENUMBR (-1.1,TE1*TE3-4.*YN,YN,XMAXI,90.,1)\r
167 CALL FACTOR (TE2,TE3)\r
168 CALL XYPLOT (.5,0,-PENUP)\r
169 CALL FACTOR (1.)\r
170 IF (.NOT. BREAK(9))\r
171 * CALL SYMBOL (-XOFSET,0,YZ,\r
172 * ' INTENSITY SUMM [ARB. UNITS]',90.,30)\r
173C\r
174C\r
17515 CONTINUE @ ENTRY HERE IF USER SWITCHED OFF PLOTTING\r
176 CALL FACTOR (1.)\r
177 IF (OPTION.EQ.1) GOTO 50 @ '1' OPTION, NO COMMENT AT ALL!\r
178 CALL SYMBOL (YZ,YLEN+YZ,YZ,LABEL,0,MIN0(42,LABCNT*6))\r
179 IF (LABCNT.GT.7)\r
180 * CALL SYMBOL (3.*YZ,YLENYZ,YZ,LABEL(8),0,LABCNT*6-42)\r
181C\r
182 IF (.NOT. BREAK(9))\r
183 * CALL LABPLT (0.,-YOFSET,BEGIN+SPAN) @ INSERT CHANNEL AND TIME\r
18450 CONTINUE @ WE COME HERE IF '1' OPTION ON\r
185 CALL XYPLOT(38.,25.,PENUP)\r
186 CALL EXPLT @ CLOSE THE PLOTTER\r
187 RETURN\r
188C\r
189C\r
19020 CONTINUE @ FILE 5 IS EMPTY\r
191 COMPUT=0\r
192 SAMCNT=0\r
193 WRITE (TTO,1) @ NO DATA TO PLOT\r
194 RETURN\r
195C\r
196\fC\r
1971 FORMAT (' KEINE DATEN IN DER DATEI 5')\r
1982 FORMAT (' SUMME DER LEISTUNGSSPEKTREN UEBER ',F4.1,' -->',\r
199 * F5.1,' GEZEICHNET.')\r
2004 FORMAT (' FREQUENZSKALA ENDE, ANFANG? (',I2,1H,,I2,\r
201 * ') ? ',$)\r
2025 FORMAT (' ORDINATEN MAXIMUM? (',1P,E8.1,') ? ',$)\r
2036 FORMAT (I2,1X,I2)\r
2047 FORMAT (E8.1)\r
205 END\r
206\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
My complete PDP-8 universe