Use github theme and add some comments
[maxima.git] / share / fftpack5 / lisp / cmf3kb.lisp
blob5475591d313c74cde5cde2c88567020727e66d3e
1 ;;; Compiled by f2cl version:
2 ;;; ("f2cl1.l,v 95098eb54f13 2013/04/01 00:45:16 toy $"
3 ;;; "f2cl2.l,v 95098eb54f13 2013/04/01 00:45:16 toy $"
4 ;;; "f2cl3.l,v 96616d88fb7e 2008/02/22 22:19:34 rtoy $"
5 ;;; "f2cl4.l,v 96616d88fb7e 2008/02/22 22:19:34 rtoy $"
6 ;;; "f2cl5.l,v 95098eb54f13 2013/04/01 00:45:16 toy $"
7 ;;; "f2cl6.l,v 1d5cbacbb977 2008/08/24 00:56:27 rtoy $"
8 ;;; "macros.l,v 1409c1352feb 2013/03/24 20:44:50 toy $")
10 ;;; Using Lisp CMU Common Lisp snapshot-2020-04 (21D Unicode)
11 ;;;
12 ;;; Options: ((:prune-labels nil) (:auto-save t) (:relaxed-array-decls t)
13 ;;; (:coerce-assigns :as-needed) (:array-type ':array)
14 ;;; (:array-slicing t) (:declare-common nil)
15 ;;; (:float-format single-float))
17 (in-package "FFTPACK5")
20 (let ((taur -0.5d0) (taui 0.866025403784439d0))
21 (declare (type (double-float) taur taui))
22 (defun cmf3kb (lot ido l1 na cc im1 in1 ch im2 in2 wa)
23 (declare (type (array double-float (*)) wa ch cc)
24 (type (f2cl-lib:integer4) in2 im2 in1 im1 na l1 ido lot))
25 (f2cl-lib:with-multi-array-data
26 ((cc double-float cc-%data% cc-%offset%)
27 (ch double-float ch-%data% ch-%offset%)
28 (wa double-float wa-%data% wa-%offset%))
29 (prog ((di3 0.0d0) (di2 0.0d0) (dr3 0.0d0) (dr2 0.0d0) (i 0) (m2 0)
30 (ci3 0.0d0) (cr3 0.0d0) (ci2 0.0d0) (ti2 0.0d0) (cr2 0.0d0)
31 (tr2 0.0d0) (m1 0) (k 0) (m2s 0) (m1d 0))
32 (declare (type (f2cl-lib:integer4) m1d m2s k m1 m2 i)
33 (type (double-float) tr2 cr2 ti2 ci2 cr3 ci3 dr2 dr3 di2 di3))
34 (setf m1d
35 (f2cl-lib:int-add
36 (f2cl-lib:int-mul (f2cl-lib:int-sub lot 1) im1)
37 1))
38 (setf m2s (f2cl-lib:int-sub 1 im2))
39 (if (or (> ido 1) (= na 1)) (go label102))
40 (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
41 ((> k l1) nil)
42 (tagbody
43 (f2cl-lib:fdo (m1 1 (f2cl-lib:int-add m1 im1))
44 ((> m1 m1d) nil)
45 (tagbody
46 (setf tr2
48 (f2cl-lib:fref cc-%data%
49 (1 m1 k 1 2)
50 ((1 2) (1 in1) (1 l1) (1 ido) (1 3))
51 cc-%offset%)
52 (f2cl-lib:fref cc-%data%
53 (1 m1 k 1 3)
54 ((1 2) (1 in1) (1 l1) (1 ido) (1 3))
55 cc-%offset%)))
56 (setf cr2
58 (f2cl-lib:fref cc-%data%
59 (1 m1 k 1 1)
60 ((1 2) (1 in1) (1 l1) (1 ido) (1 3))
61 cc-%offset%)
62 (* taur tr2)))
63 (setf (f2cl-lib:fref cc-%data%
64 (1 m1 k 1 1)
65 ((1 2) (1 in1) (1 l1) (1 ido) (1 3))
66 cc-%offset%)
68 (f2cl-lib:fref cc-%data%
69 (1 m1 k 1 1)
70 ((1 2) (1 in1) (1 l1) (1 ido) (1 3))
71 cc-%offset%)
72 tr2))
73 (setf ti2
75 (f2cl-lib:fref cc-%data%
76 (2 m1 k 1 2)
77 ((1 2) (1 in1) (1 l1) (1 ido) (1 3))
78 cc-%offset%)
79 (f2cl-lib:fref cc-%data%
80 (2 m1 k 1 3)
81 ((1 2) (1 in1) (1 l1) (1 ido) (1 3))
82 cc-%offset%)))
83 (setf ci2
85 (f2cl-lib:fref cc-%data%
86 (2 m1 k 1 1)
87 ((1 2) (1 in1) (1 l1) (1 ido) (1 3))
88 cc-%offset%)
89 (* taur ti2)))
90 (setf (f2cl-lib:fref cc-%data%
91 (2 m1 k 1 1)
92 ((1 2) (1 in1) (1 l1) (1 ido) (1 3))
93 cc-%offset%)
95 (f2cl-lib:fref cc-%data%
96 (2 m1 k 1 1)
97 ((1 2) (1 in1) (1 l1) (1 ido) (1 3))
98 cc-%offset%)
99 ti2))
100 (setf cr3
101 (* taui
103 (f2cl-lib:fref cc-%data%
104 (1 m1 k 1 2)
105 ((1 2) (1 in1) (1 l1) (1 ido) (1 3))
106 cc-%offset%)
107 (f2cl-lib:fref cc-%data%
108 (1 m1 k 1 3)
109 ((1 2) (1 in1) (1 l1) (1 ido) (1 3))
110 cc-%offset%))))
111 (setf ci3
112 (* taui
114 (f2cl-lib:fref cc-%data%
115 (2 m1 k 1 2)
116 ((1 2) (1 in1) (1 l1) (1 ido) (1 3))
117 cc-%offset%)
118 (f2cl-lib:fref cc-%data%
119 (2 m1 k 1 3)
120 ((1 2) (1 in1) (1 l1) (1 ido) (1 3))
121 cc-%offset%))))
122 (setf (f2cl-lib:fref cc-%data%
123 (1 m1 k 1 2)
124 ((1 2) (1 in1) (1 l1) (1 ido) (1 3))
125 cc-%offset%)
126 (- cr2 ci3))
127 (setf (f2cl-lib:fref cc-%data%
128 (1 m1 k 1 3)
129 ((1 2) (1 in1) (1 l1) (1 ido) (1 3))
130 cc-%offset%)
131 (+ cr2 ci3))
132 (setf (f2cl-lib:fref cc-%data%
133 (2 m1 k 1 2)
134 ((1 2) (1 in1) (1 l1) (1 ido) (1 3))
135 cc-%offset%)
136 (+ ci2 cr3))
137 (setf (f2cl-lib:fref cc-%data%
138 (2 m1 k 1 3)
139 ((1 2) (1 in1) (1 l1) (1 ido) (1 3))
140 cc-%offset%)
141 (- ci2 cr3))
142 label101))))
143 label101
144 (go end_label)
145 label102
146 (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
147 ((> k l1) nil)
148 (tagbody
149 (setf m2 m2s)
150 (f2cl-lib:fdo (m1 1 (f2cl-lib:int-add m1 im1))
151 ((> m1 m1d) nil)
152 (tagbody
153 (setf m2 (f2cl-lib:int-add m2 im2))
154 (setf tr2
156 (f2cl-lib:fref cc-%data%
157 (1 m1 k 1 2)
158 ((1 2) (1 in1) (1 l1) (1 ido) (1 3))
159 cc-%offset%)
160 (f2cl-lib:fref cc-%data%
161 (1 m1 k 1 3)
162 ((1 2) (1 in1) (1 l1) (1 ido) (1 3))
163 cc-%offset%)))
164 (setf cr2
166 (f2cl-lib:fref cc-%data%
167 (1 m1 k 1 1)
168 ((1 2) (1 in1) (1 l1) (1 ido) (1 3))
169 cc-%offset%)
170 (* taur tr2)))
171 (setf (f2cl-lib:fref ch-%data%
172 (1 m2 k 1 1)
173 ((1 2) (1 in2) (1 l1) (1 3) (1 ido))
174 ch-%offset%)
176 (f2cl-lib:fref cc-%data%
177 (1 m1 k 1 1)
178 ((1 2) (1 in1) (1 l1) (1 ido) (1 3))
179 cc-%offset%)
180 tr2))
181 (setf ti2
183 (f2cl-lib:fref cc-%data%
184 (2 m1 k 1 2)
185 ((1 2) (1 in1) (1 l1) (1 ido) (1 3))
186 cc-%offset%)
187 (f2cl-lib:fref cc-%data%
188 (2 m1 k 1 3)
189 ((1 2) (1 in1) (1 l1) (1 ido) (1 3))
190 cc-%offset%)))
191 (setf ci2
193 (f2cl-lib:fref cc-%data%
194 (2 m1 k 1 1)
195 ((1 2) (1 in1) (1 l1) (1 ido) (1 3))
196 cc-%offset%)
197 (* taur ti2)))
198 (setf (f2cl-lib:fref ch-%data%
199 (2 m2 k 1 1)
200 ((1 2) (1 in2) (1 l1) (1 3) (1 ido))
201 ch-%offset%)
203 (f2cl-lib:fref cc-%data%
204 (2 m1 k 1 1)
205 ((1 2) (1 in1) (1 l1) (1 ido) (1 3))
206 cc-%offset%)
207 ti2))
208 (setf cr3
209 (* taui
211 (f2cl-lib:fref cc-%data%
212 (1 m1 k 1 2)
213 ((1 2) (1 in1) (1 l1) (1 ido) (1 3))
214 cc-%offset%)
215 (f2cl-lib:fref cc-%data%
216 (1 m1 k 1 3)
217 ((1 2) (1 in1) (1 l1) (1 ido) (1 3))
218 cc-%offset%))))
219 (setf ci3
220 (* taui
222 (f2cl-lib:fref cc-%data%
223 (2 m1 k 1 2)
224 ((1 2) (1 in1) (1 l1) (1 ido) (1 3))
225 cc-%offset%)
226 (f2cl-lib:fref cc-%data%
227 (2 m1 k 1 3)
228 ((1 2) (1 in1) (1 l1) (1 ido) (1 3))
229 cc-%offset%))))
230 (setf (f2cl-lib:fref ch-%data%
231 (1 m2 k 2 1)
232 ((1 2) (1 in2) (1 l1) (1 3) (1 ido))
233 ch-%offset%)
234 (- cr2 ci3))
235 (setf (f2cl-lib:fref ch-%data%
236 (1 m2 k 3 1)
237 ((1 2) (1 in2) (1 l1) (1 3) (1 ido))
238 ch-%offset%)
239 (+ cr2 ci3))
240 (setf (f2cl-lib:fref ch-%data%
241 (2 m2 k 2 1)
242 ((1 2) (1 in2) (1 l1) (1 3) (1 ido))
243 ch-%offset%)
244 (+ ci2 cr3))
245 (setf (f2cl-lib:fref ch-%data%
246 (2 m2 k 3 1)
247 ((1 2) (1 in2) (1 l1) (1 3) (1 ido))
248 ch-%offset%)
249 (- ci2 cr3))
250 label103))))
251 label103
252 (if (= ido 1) (go end_label))
253 (f2cl-lib:fdo (i 2 (f2cl-lib:int-add i 1))
254 ((> i ido) nil)
255 (tagbody
256 (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
257 ((> k l1) nil)
258 (tagbody
259 (setf m2 m2s)
260 (f2cl-lib:fdo (m1 1 (f2cl-lib:int-add m1 im1))
261 ((> m1 m1d) nil)
262 (tagbody
263 (setf m2 (f2cl-lib:int-add m2 im2))
264 (setf tr2
266 (f2cl-lib:fref cc-%data%
267 (1 m1 k i 2)
268 ((1 2) (1 in1) (1 l1) (1 ido)
269 (1 3))
270 cc-%offset%)
271 (f2cl-lib:fref cc-%data%
272 (1 m1 k i 3)
273 ((1 2) (1 in1) (1 l1) (1 ido)
274 (1 3))
275 cc-%offset%)))
276 (setf cr2
278 (f2cl-lib:fref cc-%data%
279 (1 m1 k i 1)
280 ((1 2) (1 in1) (1 l1) (1 ido)
281 (1 3))
282 cc-%offset%)
283 (* taur tr2)))
284 (setf (f2cl-lib:fref ch-%data%
285 (1 m2 k 1 i)
286 ((1 2) (1 in2) (1 l1) (1 3) (1 ido))
287 ch-%offset%)
289 (f2cl-lib:fref cc-%data%
290 (1 m1 k i 1)
291 ((1 2) (1 in1) (1 l1) (1 ido)
292 (1 3))
293 cc-%offset%)
294 tr2))
295 (setf ti2
297 (f2cl-lib:fref cc-%data%
298 (2 m1 k i 2)
299 ((1 2) (1 in1) (1 l1) (1 ido)
300 (1 3))
301 cc-%offset%)
302 (f2cl-lib:fref cc-%data%
303 (2 m1 k i 3)
304 ((1 2) (1 in1) (1 l1) (1 ido)
305 (1 3))
306 cc-%offset%)))
307 (setf ci2
309 (f2cl-lib:fref cc-%data%
310 (2 m1 k i 1)
311 ((1 2) (1 in1) (1 l1) (1 ido)
312 (1 3))
313 cc-%offset%)
314 (* taur ti2)))
315 (setf (f2cl-lib:fref ch-%data%
316 (2 m2 k 1 i)
317 ((1 2) (1 in2) (1 l1) (1 3) (1 ido))
318 ch-%offset%)
320 (f2cl-lib:fref cc-%data%
321 (2 m1 k i 1)
322 ((1 2) (1 in1) (1 l1) (1 ido)
323 (1 3))
324 cc-%offset%)
325 ti2))
326 (setf cr3
327 (* taui
329 (f2cl-lib:fref cc-%data%
330 (1 m1 k i 2)
331 ((1 2) (1 in1) (1 l1) (1 ido)
332 (1 3))
333 cc-%offset%)
334 (f2cl-lib:fref cc-%data%
335 (1 m1 k i 3)
336 ((1 2) (1 in1) (1 l1) (1 ido)
337 (1 3))
338 cc-%offset%))))
339 (setf ci3
340 (* taui
342 (f2cl-lib:fref cc-%data%
343 (2 m1 k i 2)
344 ((1 2) (1 in1) (1 l1) (1 ido)
345 (1 3))
346 cc-%offset%)
347 (f2cl-lib:fref cc-%data%
348 (2 m1 k i 3)
349 ((1 2) (1 in1) (1 l1) (1 ido)
350 (1 3))
351 cc-%offset%))))
352 (setf dr2 (- cr2 ci3))
353 (setf dr3 (+ cr2 ci3))
354 (setf di2 (+ ci2 cr3))
355 (setf di3 (- ci2 cr3))
356 (setf (f2cl-lib:fref ch-%data%
357 (2 m2 k 2 i)
358 ((1 2) (1 in2) (1 l1) (1 3) (1 ido))
359 ch-%offset%)
362 (f2cl-lib:fref wa-%data%
363 (i 1 1)
364 ((1 ido) (1 2) (1 2))
365 wa-%offset%)
366 di2)
368 (f2cl-lib:fref wa-%data%
369 (i 1 2)
370 ((1 ido) (1 2) (1 2))
371 wa-%offset%)
372 dr2)))
373 (setf (f2cl-lib:fref ch-%data%
374 (1 m2 k 2 i)
375 ((1 2) (1 in2) (1 l1) (1 3) (1 ido))
376 ch-%offset%)
379 (f2cl-lib:fref wa-%data%
380 (i 1 1)
381 ((1 ido) (1 2) (1 2))
382 wa-%offset%)
383 dr2)
385 (f2cl-lib:fref wa-%data%
386 (i 1 2)
387 ((1 ido) (1 2) (1 2))
388 wa-%offset%)
389 di2)))
390 (setf (f2cl-lib:fref ch-%data%
391 (2 m2 k 3 i)
392 ((1 2) (1 in2) (1 l1) (1 3) (1 ido))
393 ch-%offset%)
396 (f2cl-lib:fref wa-%data%
397 (i 2 1)
398 ((1 ido) (1 2) (1 2))
399 wa-%offset%)
400 di3)
402 (f2cl-lib:fref wa-%data%
403 (i 2 2)
404 ((1 ido) (1 2) (1 2))
405 wa-%offset%)
406 dr3)))
407 (setf (f2cl-lib:fref ch-%data%
408 (1 m2 k 3 i)
409 ((1 2) (1 in2) (1 l1) (1 3) (1 ido))
410 ch-%offset%)
413 (f2cl-lib:fref wa-%data%
414 (i 2 1)
415 ((1 ido) (1 2) (1 2))
416 wa-%offset%)
417 dr3)
419 (f2cl-lib:fref wa-%data%
420 (i 2 2)
421 ((1 ido) (1 2) (1 2))
422 wa-%offset%)
423 di3)))
424 label104))))
425 label104
426 label105))
427 (go end_label)
428 end_label
429 (return (values nil nil nil nil nil nil nil nil nil nil nil))))))
431 (in-package #:cl-user)
432 #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
433 (eval-when (:load-toplevel :compile-toplevel :execute)
434 (setf (gethash 'fortran-to-lisp::cmf3kb
435 fortran-to-lisp::*f2cl-function-info*)
436 (fortran-to-lisp::make-f2cl-finfo
437 :arg-types '((fortran-to-lisp::integer4) (fortran-to-lisp::integer4)
438 (fortran-to-lisp::integer4) (fortran-to-lisp::integer4)
439 (array double-float (*)) (fortran-to-lisp::integer4)
440 (fortran-to-lisp::integer4) (array double-float (*))
441 (fortran-to-lisp::integer4) (fortran-to-lisp::integer4)
442 (array double-float (*)))
443 :return-values '(nil nil nil nil nil nil nil nil nil nil nil)
444 :calls 'nil)))