A large commit.
[pdp8.git] / sw / rescue / lab8e_goettingen / disk2_11 / rkb / paroff / haefir.ft
CommitLineData
81e70d48
PH
1C -+-+-+-+-+ \ e H A E F I R . F T \ e -+-+-+-+-+\r
2C\r
3C PLOT THE DATA POINTS\r
4C\r
5 SUBROUTINE FIRPLT\r
6 INCLUDE HAEPTI.FI\r
7 INCLUDE HAEBUF.FI\r
8 INCLUDE HAEGSA.FI\r
9 INCLUDE HAETTY.FI\r
10 INCLUDE HABRK.FI\r
11 INCLUDE HAECSZ.FI\r
12 INCLUDE HAPPEN.FI\r
13 REAL XYSAM,COND\r
14 INTEGER NCOND,TOASCI\r
15 EXTERNAL XYSAM,NCOND,COND,TOASCI\r
16C\r
17\fC\r
18 LOGICAL TIMABZ,TIMORD, @ ABZISSE / ORDINATE IS TIME SCALE\r
19 * ABISMI @ IF THE ABZISSA SCALE EXCEEDS 5 MINUTES THEN .TRUE. ELSE .FALSE.\r
20 INTEGER I,K,J,PENPOS,\r
21 * STEP, @ INCREMENT IN SAMBUF SCAN\r
22 * CA,CO, @ CHANNEL OF ABZISSE, ORDINATE\r
23 * PLBEG,PLEND, @ START/END OF TIME SCALE\r
24 * NUMCN, @ NUMBER OF CHANNELS TO SCAN (NO MEANING IF TIMABZ IS SET .FALSE.)\r
25 * EXPAND @ IF THE TIME SCALE .LE. 5 SECONDS THEN WE MARK EACH 1/10 SECOND ELSE EACH SECOND\r
26 REAL TEMSET, @ DIFFERENCE PLOTTER 0,0 AND PICTURE 0,0 (NO MEANING IF TIMABZ IS SET TO .FALSE.)\r
27 * LEFT,RIGHT,UP,DOWN, @ PLOT SCALES ABZISSE/ ORDINATE\r
28 * TE1,TE2,TE3 @ TEMPS\r
29 REAL OMAX,OMIN, @ MAXIMUM AND MINIMUM OF ORDINATE DATA\r
30 * THRU,THRL @ UPPER, LOWER THRESHOLD\r
31 INTEGER TEXT0(4) @ DIMENSION OF THE TIME AXIS (MIN OR SEC)\r
32 DATA CA,CO,NUMCN,STEP /0,8,2,3/,\r
33 * TEXT0 /'TIME [MIN] TIME [SEC]'/\r
34C\r
35C STATEMENT FUNCTIONS ARE:\r
36C\r
37 BETW(AP0,BP0,CP0)=AP0.LE.BP0.AND.BP0.LT.CP0\r
38 LOGICAL BETW\r
39 FIR(IP0)=-XYSAM(IP0-4,0)-XYSAM(IP0-3,0)+\r
40 * XYSAM(IP0-1,0)+2*XYSAM(IP0,0)+XYSAM(IP0+1,0)-\r
41 * XYSAM(IP0+3,0)-XYSAM(IP0+4,0) @ SAMCNT FINITE IMPULSE RESPONSE FILTER\r
42C\r
43 XF(IP1)=XYSAM(IP1,CA)-LEFT @ RETURNS THE VALUE OF THE ABZISSA WITH CORRECT OFFSET\r
44 DFIR(IP2)=COND(BETW(THRL,FIR(IP2),THRU),0,120.)\r
45 YF(IP1)=COND(CO.EQ.0,FIR(IP1),DFIR(IP1))\r
46C\r
47 IF (SAMCNT.EQ.0) RETURN @ NO SAMPLE, NOTHING TO DO\r
48C \r
49C COMPUTE THE DEFAULT VALUES FOR THE PLOT\r
50C\r
51 IF (OPTION.EQ.11) GOTO 15 @ SP- SKIPS QUESTIONS AND TAKES THE LAST VALUES USED\r
52 CO=0 @ THE ORDINATE IS CHANNEL 0\r
53 CA=8 @ THE ABZISSA IS THE TIME SCALE\r
54 NUMCN=CHNLS-CO @ ALL CHANNELS TO PLOT\r
55 STEP=3 @ WE PLOT EACH THIRD POINT OF THE DATA\r
56 IF (OPTION.NE.12) CALL ASKHIM (2) @ SP* DOES NOT ASK SILLY QUESTIONS\r
57 WRITE (TTO,1) CA,CO,STEP @ READ CHANNEL ##\r
58 READ (TTI,2) I,J,K @ AND STEP INCREMENTS\r
59 IF BREAK(11) RETURN\r
60 CA=NCOND(I,I,CA)\r
61 CO=NCOND(J,J,CO)\r
62 STEP=NCOND(K,K,STEP) @ STEP DEFAULTS TO "STEP"\r
63 TIMABZ=CA.GT.7 @ ABZISSE IS THE TIME SCALE\r
64 TIMORD=CO.GT.7 @ ORDINATE IS THE TIME SCALE\r
65 IF (.NOT.TIMABZ) GOTO 15 @ ABZISSA IS NO TIME SCALE: ONLY TWO CHANNELS (CO,CO+1) TO PLOT\r
66 NUMCN=MIN0(NUMCN,CHNLS-CO) @ COMPUTE CORRECT NUMBER OF CHANNELS\r
67 WRITE (TTO,3) NUMCN @ READ THE NUMBER OF CHANNELS TO SCAN\r
68 READ (TTI,2) I\r
69 NUMCN=MIN0(CHNLS-CO,NCOND(I,I,NUMCN)) @ NO INPUT MEANS CHNLS-CO\r
70 WRITE (TTO,5)\r
71 READ (TTI,6) THRL,THRU\r
7215 CONTINUE\r
73\fC\r
74C COMPUTE THE SCALING LIMITS\r
75C\r
76 S0=BEGIN*SAMRAT @ HERE WE START THE OUTPUT PLOT\r
77 S1=ENDS*SAMRAT @ AND HERE WE END THE PLOT\r
78 PLBEG=BEGIN\r
79 PLEND=ENDS\r
80C\r
81 IF (S1.LE.SAMCNT) GOTO 17 @ IF THE INTERVALL TO PLOT EXCEEDS THE\r
82 TE1=SAMCNT/SAMRAT @ DATA POINTS THEN\r
83 TE2=S1/SAMRAT\r
84 WRITE (TTO,4) TE1,TE2 @ WE PRINT THE OVERFLOW MSG AND\r
85 PLEND=TE1 @ COMPUTE A NEW PLEND VALUE\r
86 S1=PLEND*SAMRAT-1 @ TAKE CARE FOR TRUNCATION ERRORS\r
8717 CONTINUE @ INTERVALL OK, COMPUTE UPPER AND LOWER MARGIN OF PLOT DATA\r
88 RIGHT=COND(TIMABZ,FLOAT(S1),512.) @ ABZISSE MARGIN EITHER TIME OR 10 BIT CONVERTER\r
89 LEFT =COND(TIMABZ,FLOAT(S0),-512.)\r
90 UP =COND(TIMORD,FLOAT(S1),512.) @ ORDINATE MARGIN\r
91 DOWN =COND(TIMORD,FLOAT(S0),-512.)\r
92 IF BREAK(11) RETURN @ USER GETS RID OF PRGRM\r
93 CALL STPLT @ START THE PLOTTER ( CALL PLOTS)\r
94 CALL XYPLOT (XOFSET,YOFSET,-PENUP) @ DRIVE PEN TO PICTURE ZERO\r
95C\r
96C LOOP TO PLOT EACH CHANNEL WITH CORRECT OFFSET, FACTOR AND SCALE\r
97C TEMSET HOLDS THE ORIGIN FOR EACH CHANNEL\r
98C TEMSET=0 PLOT ONE CHANNEL/TIME OR X/Y\r
99C TEMSET=YLEN/NUMCN FOR MORE THAN ONE CHANNEL\r
100C THE TEMSET ORIGIN OFFSET IS RESET AT THE END OF THE LOOP ( ST. 25)\r
101C\r
102C\r
103 TEMSET=0\r
104 DO 20 K=1,NCOND(TIMABZ,NUMCN,1) @ SCAN NUMCN CHANNELS\r
105 IF (NUMCN.EQ.1 .OR. .NOT.TIMABZ) GOTO 51\r
106 TEMSET=FLOAT(NUMCN-K)*YLEN/FLOAT(NUMCN)+(NUMCN-K)*.5 @ TEMPORARY Y OFFSET\r
107 CALL XYPLOT (0,TEMSET,-PENUP) @ SWITCH TO CORRECT PART OF PICTURE\r
108C\r
109C COMPUTE THE FACTOR TO GET A PRETTY PLOT\r
110C\r
111 OMAX=-999.\r
112 OMIN=-OMAX\r
113 DO 50 J=S0,S1 @ FETCH MIN & MAX OF THE DATA\r
114 IF (BREAK(11)) GOTO 25 @ IF THE USER GETS RID OF PLOT THEN WE EXIT VIA 25\r
115 TE1=YF(J) @ COMPUTE FILTER\r
116 OMAX=AMAX1(OMAX,TE1) @ MAXIMUM --> OMAX\r
11750 OMIN=AMIN1(OMIN,TE1) @ MINIMUM --> OMIN\r
118 DOWN=COND(OMIN.LT.-255.,-512.,OMIN.LT.0,-255.,OMIN.LT.256.,0,\r
119 * 255.) @ MAKE 255 STEPS INCREMENT\r
120 UP=COND(OMAX.GT.255.,512.,OMAX.GT.0,255.,OMAX.GT.-255.,0,\r
121 * -255.) @ 255 STEPS INCREMENT\r
122C\r
12351 CONTINUE @ HERE WE COMPUTE THE FACTOR FOR ONE LINE\r
124 IF (TIMABZ) CALL FACTOR (XLEN/(RIGHT-LEFT),\r
125 * (YLEN-NUMCN*.5+.5)/FLOAT(NUMCN)/(UP-DOWN))\r
126 IF (.NOT.TIMABZ) CALL FACTOR (AMIN1(XLEN,YLEN)/(RIGHT-LEFT),\r
127 * AMIN1(XLEN,YLEN)/(UP-DOWN))\r
128 IF BREAK(11) GOTO 25 @ USER GETS RID OF PRGRM\r
129 PENPOS=PENUP\r
130 DO 10 I=S0,S1 @ HERE WE PLOT THE \r
131 CALL XYPLOT (XF(I),YF(I)-DOWN,PENPOS) @ DATA POINTS ONE BY ONE\r
132 PENPOS=PENDWN\r
133 IF BREAK(11) GOTO 25 @ USER GETS RID OF PROGRAM\r
13410 CONTINUE\r
135 IF (.NOT. TIMABZ) GOTO 25 @ WORK DONE FOR X-Y GRAPHICS\r
136C\r
137C MAKE A SCALE FOR THE ORDINATE ( INPUT VOLTAGE )\r
138C\r
139 CALL WHERE (TE1,TE1,TE1,TE2)\r
140 CALL FACTOR (1.,TE2)\r
141 CALL XYPLOT (-.5,0,-PENUP)\r
142 PENPOS=PENUP\r
143 DO 55 I=0,10\r
144 TE1=DOWN+I*(UP-DOWN)/10.\r
145 CALL XYPLOT (0,TE1-DOWN,PENPOS)\r
146 PENPOS=PENDWN\r
147 J=MOD(I,5)\r
148 TE3=COND(J.EQ.0,-.5,-.3)\r
149 CALL XYPLOT (TE3,TE1-DOWN,PENDWN)\r
150 CALL XYPLOT (0,TE1-DOWN,PENDWN)\r
151 IF (MOD(I,10).NE.0) GOTO 55\r
152 CALL FACTOR (1.,1.) @ WRITE LOWER AND UPPER LIMIT ONTO THE\r
153 CALL NUMBER (-XOFSET+2.*YZ,(TE1-DOWN)*TE2-YN*.38,YN*.75,TE1,0,\r
154 * -1) @ AXIS\r
155 CALL FACTOR (1.,TE2)\r
156 CALL XYPLOT (0,TE1-DOWN,PENUP)\r
15755 CONTINUE\r
158 CALL XYPLOT (.5,0,-PENUP)\r
159 CALL FACTOR (1.,1.)\r
160 CALL SYMBOL (-XOFSET+YZ,YLEN/NUMCN*.33,YZ,'CH ',90.,3)\r
161 CALL NUMBER (999.,999.,YZ,CO,90.,-1)\r
162C\r
163C\r
164 CO=CO+1\r
16525 CALL FACTOR (1.,1.)\r
166 CALL XYPLOT (0.,-TEMSET,-PENUP) @ RESET CORRECT ORIGIN OF DIAGRAM\r
167 IF BREAK(11) GOTO 40\r
16820 CONTINUE\r
169\fC\r
170C IF ABZISSA IS TIME SCALE THEN DRAW A TIME SCALE\r
171C\r
172 IF (.NOT.TIMABZ) GOTO 40\r
173 ABISMI=PLEND-PLBEG.GT.300 @ ABZISSE EXCEEDS 5 MINUTES SO WE DRAW A MINUTE SCALING\r
174 CALL FACTOR (XLEN/(PLEND-PLBEG),1.)\r
175 CALL XYPLOT (0.,-.5,-PENUP)\r
176C HERE WE PLOT THE LITTLE BAR INDICATING A SECOND OR MINUTE\r
177 EXPAND=NCOND(PLEND-PLBEG.LE.5,10,1) @ IF THE TIME SCALE IS .LE. 5 SECONDS THEN WE MARK EACH 1/10 SEC\r
178 DO 30 I=PLBEG*EXPAND,PLEND*EXPAND @ 1 SEC INCREMENTS\r
179 TE1=I-PLBEG*EXPAND\r
180 CALL XYPLOT (TE1/EXPAND,0,PENDWN)\r
181 IF (.NOT.ABISMI) TE2=COND(MOD(I,10).EQ.0,-.7, MOD(I,5).EQ.0,-.5,\r
182 * -.3)\r
183 IF (ABISMI) TE2=COND(MOD(I,600).EQ.0,-.7,\r
184 * MOD(I,300).EQ.0,-.5,\r
185 * MOD(I/EXPAND,60).EQ.0,-.3)\r
186 CALL XYPLOT (TE1/EXPAND,TE2,PENDWN)\r
187C HERE WE COMPUTE WHERE TO WRITE A NUMBER ONTO THE TIME AXIS\r
188 TE2=PLEND-PLBEG @ COMPUTE THE SIZE OF THE TIME AXIS\r
189 IF (.NOT.ABISMI) GOTO 31 @ IF WE PLOT A SECONDS AXIS THEN GOTO 31\r
190 IF (MOD(I,\r
191 * NCOND(TE2.GT.5400,1800,TE2.GE.1800,600,TE2.GT.900,300,\r
192 * TE2.GT.300,120,60)).GT.0) GOTO 30 @ COMPUTE THE MINUTE WHERE TO PLOT THE NUMBER\r
193 GOTO 32\r
19431 IF (MOD(I,NCOND(TE2.GT.180,30,TE2.GT.60,20,TE2.GT.30,10,\r
195 * TE2.GT.10,5,TE2.GT.5,2,10)).GT.0) @ WE ASSUME: TE2.LE.5 THEN EXPAND:=10 ELSE EXPAND:=1 !!!\r
196 * GOTO 30\r
197C\r
198C HERE WE PLOT THE NUMBER ONTO THE AXIS\r
199C\r
20032 CONTINUE\r
201 CALL WHERE (TE2,TE2,TE2,TE3) @ GET THE X FACTOR\r
202 CALL FACTOR (1.,1.) @ RESET TO THE NORMAL FACTOR FOR SYMBOL\r
203 CALL NUMBER (TE1/EXPAND*TE2-INT(ALOG10(AMAX0(I/EXPAND,1))+.01)\r
204 * *YN/2.-YN*.3,\r
205 * -1.3,YN,COND(ABISMI,I/60.,I/EXPAND),0,-1)\r
206 CALL FACTOR (TE2,TE3)\r
207 CALL XYPLOT (TE1/EXPAND,0,PENUP)\r
20830 CALL XYPLOT (TE1/EXPAND,0,PENDWN)\r
209 CALL FACTOR (1.,1.)\r
210 CALL XYPLOT (0,.5,-PENUP)\r
211 CALL SYMBOL (XLEN/1.5,-YOFSET,YZ,TEXT0(NCOND(ABISMI,1,3)),0,10)\r
212C\r
213C\r
21440 CALL FACTOR (1.,1.)\r
215 IF (BREAK(11)) GOTO 60 @ USER SWITCHED OFF THE PLOTTER\r
216 CALL LABPLT (0,-YOFSET,PLEND)\r
217 IF (BREAK(11)) GOTO 60\r
218 CALL SYMBOL (YZ,YLEN+YZ,YZ,LABEL,0,MIN0(42,LABCNT*6)) @ PLOT 42 CHARACTERS INTO THE FIRST LINE OF LABEL\r
219 IF (LABCNT.GT.7)\r
220 * CALL SYMBOL (YZ,YLEN,YZ,LABEL(8),0,LABCNT*6-42) @ AND THE REMAINING INTO THE NEXT LINE\r
22160 CONTINUE\r
222 CALL XYPLOT (38.,25.,PENUP)\r
223 CALL EXPLT\r
224 RETURN\r
2251 FORMAT (' KANAL ABZISSE/ORDINATE (ZEITBASIS=8), SCHRITTWEITE',\r
226 * ' (2I1,I3) (',\r
227 * 2I1,I3,')? ',$)\r
2282 FORMAT (2I1,I3)\r
2293 FORMAT (' ANZAHL DER DARZUSTELLENDEN KANAELE (I1) (',I1,\r
230 * ') ? ',$)\r
2314 FORMAT (' NUR FUER',F6.1,' SEK. MESSDATEN JEDOCH',F6.1,\r
232 * ' SEC. ANGEFORDERT. ')\r
2335 FORMAT (' UNTERE, OBERE SCHWELLE? F5.0/F5.0: ')\r
2346 FORMAT (F5.0/F5.0)\r
235 END\r
236\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