Discrete fourier transform

Contributions to this software library are always welcome. Please ensure that you post program listings rather than .raw files. They give a reasonable idea of what your program does without having to load them into a DM42 and you can also include comments in your code. Check out the following link for a decoder/encoder: https://technical.swissmicros.com/decoders/dm42/

You can then copy/paste the listing and post it in "code" tags.
Post Reply
dk-
Posts: 16
Joined: Wed Sep 23, 2020 7:46 pm

Discrete fourier transform

Post by dk- »

I made a program that functions like the regular plot, but prints the discrete fourier transform of the supplied function. (Function can have arguments as menuvars).

The number of bins needs to be a power of two, and 1024 seems to be the max that the DM42 can handle. Free42 can go higher.

The code below contains two functions to test it with, AM and FM. They do exactly what it sounds like.

Code: Select all

00 { 1218-Byte Prgm }
01▸LBL "DFT"
02 MVAR "XMIN"
03 MVAR "XMAX"
04 MVAR "BINS"
05 VARMENU "DFT"
06 "Enter values, t"
07 ├"hen R/S"
08 PROMPT
09▸LBL 00
10 "FCN=?"
11 SF 25
12 RCL "PFCN"
13 FC?C 25
14 GTO 01
15 ├" <"
16 ARCL ST X
17 ├">"
18▸LBL 01
19 AVIEW
20 CLA
21 SF 25
22 ARCL "PFCN"
23 CF 25
24 AON
25 STOP
26 AOFF
27 ALENG
28 X=0?
29 GTO 00
30 ASTO "PFCN"
31 SF 25
32 VARMENU IND "PFCN"
33 FS?C 25
34 STOP
35 XEQ 20
36 XEQ 90
37 CLV "RESULT"
38 GTO "DFT"
@ Outer FFT function
39▸LBL 20
40 RCL "BINS"
41 1
42 NEWMAT
43 ENTER
44 COMPLEX
45 STO "RESULT"
46 INDEX "RESULT"
47 0
48 0
49 RCL "BINS"
50 1
51 XEQ 30
52 0
53 STO "MAXBIN"
54 1
55 LSTO "IDX"
@ Loop to find the highest absolue value
@ and then use it as divisor, scaling
@ the values to max 1.0
56▸LBL 40
57 RCL "IDX"
58 1
59 STOIJ
60 RCL "MAXBIN"
61 RCLEL
62 ABS
63 X>Y?
64 STO "MAXBIN"
65 1
66 STO+ "IDX"
67 RCL "BINS"
68 1
69 +
70 RCL "IDX"
71 X<Y?
72 GTO 40
73 1
74 LSTO "IDX"
@ Divisor loop
75▸LBL 50
76 RCL "IDX"
77 1
78 STOIJ
79 RCLEL
80 RCL "MAXBIN"
81 ÷
82 STOEL
83 1
84 STO+ "IDX"
85 RCL "BINS"
86 1
87 +
88 RCL "IDX"
89 X<Y?
90 GTO 50
91 RTN
@ Inner FFT function
92▸LBL 30
93 LSTO "S"
94 R↓
95 LSTO "N"
96 R↓
97 LSTO "SRCOFF"
98 R↓
99 LSTO "DSTOFF"
100 RCL "N"
101 1
102 X=Y?
103 GTO 02
104 GTO 03
105▸LBL 02 @ N = 1
106 RCL "DSTOFF"
107 1
108 +
109 1
110 STOIJ
111 RCL "XMAX"
112 RCL "XMIN"
113 -
114 RCL "BINS"
115 ÷
116 RCL "SRCOFF"
117 ×
118 RCL "XMIN"
119 +
120 XEQ IND "PFCN"
121 STOEL
122 GTO 04
123▸LBL 03 @ N != 1
124 RCL "S"
125 2
126 ×
127 LSTO "NS"
128 RCL "N"
129 2
130 ÷
131 LSTO "NN"
132 RCL "DSTOFF"
133 RCL "SRCOFF"
134 RCL "NN"
135 RCL "NS"
136 XEQ 30
137 RCL "DSTOFF"
138 RCL "NN"
139 +
140 RCL "SRCOFF"
141 RCL "S"
142 +
143 RCL "NN"
144 RCL "NS"
145 XEQ 30
@ Loop setup                              
146 0
147 LSTO "CTR"
@ Combine even and odd FFT
148▸LBL 10
149 0
150 1
151 COMPLEX
152 PI
153 ×
154 -2
155 ×
156 RCL "CTR"
157 ×
158 RCL "N"
159 ÷
160 E^X
161 LSTO "CON"
162 RCL "DSTOFF"
163 RCL "CTR"
164 +
165 1
166 +
167 1
168 STOIJ
169 RCLEL
170 LSTO "T"
171 RCL "DSTOFF"
172 RCL "CTR"
173 RCL "N"
174 2
175 ÷
176 +
177 +
178 1
179 +
180 1
181 STOIJ
182 RCLEL
183 LSTO "DSTC"
184 RCL "DSTC"
185 RCL "CON"
186 ×
187 RCL "T"
188 +
189 RCL "DSTOFF"
190 RCL "CTR"
191 +
192 1
193 +
194 1
195 STOIJ
196 R↓
197 R↓
198 STOEL
199 RCL "DSTC"
200 RCL "CON"
201 ×
202 +/-
203 RCL "T"
204 +
205 RCL "DSTOFF"
206 RCL "CTR"
207 +
208 RCL "N"
209 2
210 ÷
211 +
212 1
213 +
214 1
215 STOIJ
216 R↓
217 R↓
218 STOEL
@ Increment and test for loop condition                                                      
219 1
220 STO+ "CTR"
221 RCL "N"
222 2
223 ÷
224 RCL "CTR"
225 X<Y?
226 GTO 10
@ End of loop
227▸LBL 04
228 RTN
229▸LBL 90 @ Print the FFT bins
230 SF 21
231 "DFT of:"
232 AVIEW
233 ADV
234 CLA
235 SF 12
236 ARCL "PFCN"
237 PRA
238 CF 12
239 ADV
240 VIEW "XMIN"
241 VIEW "XMAX"
242 VIEW "BINS"
243 VIEW "MAXBIN"
244 CLLCD
245 31.13101
246 LSTO "LP"
247▸LBL 70
248 15
249 RCL "LP"
250 IP
251 PIXEL
252 ISG "LP"
253 GTO 70
254 14
255 31
256 PIXEL
257 13
258 31
259 PIXEL
260 12
261 31
262 PIXEL
263 14
264 131
265 PIXEL
266 13
267 131
268 PIXEL
269 12
270 131
271 PIXEL
272 0
273 LSTO "IDX"
@ Loop through bins                                                 
274▸LBL 60
275 RCL "IDX"
276 16
277 MOD
278 LSTO "Y"
279 X=0?
280 XEQ 65
281 RCL "IDX"
282 1
283 +
284 1
285 STOIJ
286 RCLEL
287 ABS
288 101
289 ×
290 IP
291 LSTO "PIX"
292 1
293 LSTO "X"
294▸LBL 61
295 RCL "Y"
296 1
297 +
298 RCL "X"
299 30
300 +
301 PIXEL
302 1
303 STO+ "X"
304 RCL "PIX"
305 RCL "X"
306 X<Y?
307 GTO 61
308 1
309 STO+ "IDX"
310 RCL "BINS"
311 RCL "IDX"
312 X<Y?
313 GTO 60
314 PRLCD
315 ADV
316 ADV
317 ADV
318 RTN
319▸LBL 65 @ Print current content of LCD and setup for next 16 rows
320 PRLCD
321 CLLCD
322 CF 21
323 CLA
324 RCL "IDX"
325 AIP
326 AVIEW
327 SF 21
328 1
329 27
330 PIXEL
331 1
332 28
333 PIXEL
334 1
335 29
336 PIXEL
337 1
338 30
339 PIXEL
340 RTN
341▸LBL "TONE" @ x = t, y = frequency, z = amplitude, t = phase
342 LSTO "t"
343 R↓
344 LSTO "f"
345 R↓
346 LSTO "a"
347 R↓
348 LSTO "Ph"
349 2
350 PI
351 ×
352 RCL "f"
353 ×
354 RCL "t"
355 ×
356 RCL "Ph"
357 +
358 COS
359 RCL "a"
360 ×
361 RTN
362▸LBL "AM"
363 MVAR "m" @ Modulation index
364 MVAR "Fc" @ Carrier frequency
365 MVAR "Fm" @ Modulation frequency
366 MVAR "Ac" @ Carrier amplitude
367 MVAR "Am" @ Modulation amplitude
368 LSTO "t"
369 1
370 RCL "Ac"
371 RCL "Fc"
372 RCL "t"
373 XEQ "TONE"
374 LSTO "x"
375 1
376 RCL "Am"
377 RCL "Fm"
378 RCL "t"
379 XEQ "TONE"
380 RCL "m"
381 ×
382 1
383 +
384 RCL "x"
385 ×
386 RTN
387▸LBL "FM"
388 MVAR "d" @ Peak deviation
389 MVAR "Fc" @ Carrier frequency
390 MVAR "Fm" @ Modulation frequency
391 MVAR "Ac" @ Carrier amplitude
392 MVAR "Am" @ Modulation amplitude
393 LSTO "t"
394 1
395 RCL "Am"
396 RCL "Fm"
397 RCL "t"
398 XEQ "TONE"
399 RCL "d"
400 ×
401 RCL "Fm"
402 ÷
@ Phase is now the output from the baseband signal
403 RCL "Ac"
404 RCL "Fc"
405 RCL "t"
406 XEQ "TONE"
407 RTN
408 END
Image
Post Reply