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)
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
))
36 (f2cl-lib:int-mul
(f2cl-lib:int-sub lot
1) im1
)
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))
43 (f2cl-lib:fdo
(m1 1 (f2cl-lib:int-add m1 im1
))
48 (f2cl-lib:fref cc-%data%
50 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 3))
52 (f2cl-lib:fref cc-%data%
54 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 3))
58 (f2cl-lib:fref cc-%data%
60 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 3))
63 (setf (f2cl-lib:fref cc-%data%
65 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 3))
68 (f2cl-lib:fref cc-%data%
70 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 3))
75 (f2cl-lib:fref cc-%data%
77 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 3))
79 (f2cl-lib:fref cc-%data%
81 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 3))
85 (f2cl-lib:fref cc-%data%
87 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 3))
90 (setf (f2cl-lib:fref cc-%data%
92 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 3))
95 (f2cl-lib:fref cc-%data%
97 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 3))
103 (f2cl-lib:fref cc-%data%
105 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 3))
107 (f2cl-lib:fref cc-%data%
109 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 3))
114 (f2cl-lib:fref cc-%data%
116 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 3))
118 (f2cl-lib:fref cc-%data%
120 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 3))
122 (setf (f2cl-lib:fref cc-%data%
124 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 3))
127 (setf (f2cl-lib:fref cc-%data%
129 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 3))
132 (setf (f2cl-lib:fref cc-%data%
134 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 3))
137 (setf (f2cl-lib:fref cc-%data%
139 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 3))
146 (f2cl-lib:fdo
(k 1 (f2cl-lib:int-add k
1))
150 (f2cl-lib:fdo
(m1 1 (f2cl-lib:int-add m1 im1
))
153 (setf m2
(f2cl-lib:int-add m2 im2
))
156 (f2cl-lib:fref cc-%data%
158 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 3))
160 (f2cl-lib:fref cc-%data%
162 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 3))
166 (f2cl-lib:fref cc-%data%
168 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 3))
171 (setf (f2cl-lib:fref ch-%data%
173 ((1 2) (1 in2
) (1 l1
) (1 3) (1 ido
))
176 (f2cl-lib:fref cc-%data%
178 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 3))
183 (f2cl-lib:fref cc-%data%
185 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 3))
187 (f2cl-lib:fref cc-%data%
189 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 3))
193 (f2cl-lib:fref cc-%data%
195 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 3))
198 (setf (f2cl-lib:fref ch-%data%
200 ((1 2) (1 in2
) (1 l1
) (1 3) (1 ido
))
203 (f2cl-lib:fref cc-%data%
205 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 3))
211 (f2cl-lib:fref cc-%data%
213 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 3))
215 (f2cl-lib:fref cc-%data%
217 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 3))
222 (f2cl-lib:fref cc-%data%
224 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 3))
226 (f2cl-lib:fref cc-%data%
228 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 3))
230 (setf (f2cl-lib:fref ch-%data%
232 ((1 2) (1 in2
) (1 l1
) (1 3) (1 ido
))
235 (setf (f2cl-lib:fref ch-%data%
237 ((1 2) (1 in2
) (1 l1
) (1 3) (1 ido
))
240 (setf (f2cl-lib:fref ch-%data%
242 ((1 2) (1 in2
) (1 l1
) (1 3) (1 ido
))
245 (setf (f2cl-lib:fref ch-%data%
247 ((1 2) (1 in2
) (1 l1
) (1 3) (1 ido
))
252 (if (= ido
1) (go end_label
))
253 (f2cl-lib:fdo
(i 2 (f2cl-lib:int-add i
1))
256 (f2cl-lib:fdo
(k 1 (f2cl-lib:int-add k
1))
260 (f2cl-lib:fdo
(m1 1 (f2cl-lib:int-add m1 im1
))
263 (setf m2
(f2cl-lib:int-add m2 im2
))
266 (f2cl-lib:fref cc-%data%
268 ((1 2) (1 in1
) (1 l1
) (1 ido
)
271 (f2cl-lib:fref cc-%data%
273 ((1 2) (1 in1
) (1 l1
) (1 ido
)
278 (f2cl-lib:fref cc-%data%
280 ((1 2) (1 in1
) (1 l1
) (1 ido
)
284 (setf (f2cl-lib:fref ch-%data%
286 ((1 2) (1 in2
) (1 l1
) (1 3) (1 ido
))
289 (f2cl-lib:fref cc-%data%
291 ((1 2) (1 in1
) (1 l1
) (1 ido
)
297 (f2cl-lib:fref cc-%data%
299 ((1 2) (1 in1
) (1 l1
) (1 ido
)
302 (f2cl-lib:fref cc-%data%
304 ((1 2) (1 in1
) (1 l1
) (1 ido
)
309 (f2cl-lib:fref cc-%data%
311 ((1 2) (1 in1
) (1 l1
) (1 ido
)
315 (setf (f2cl-lib:fref ch-%data%
317 ((1 2) (1 in2
) (1 l1
) (1 3) (1 ido
))
320 (f2cl-lib:fref cc-%data%
322 ((1 2) (1 in1
) (1 l1
) (1 ido
)
329 (f2cl-lib:fref cc-%data%
331 ((1 2) (1 in1
) (1 l1
) (1 ido
)
334 (f2cl-lib:fref cc-%data%
336 ((1 2) (1 in1
) (1 l1
) (1 ido
)
342 (f2cl-lib:fref cc-%data%
344 ((1 2) (1 in1
) (1 l1
) (1 ido
)
347 (f2cl-lib:fref cc-%data%
349 ((1 2) (1 in1
) (1 l1
) (1 ido
)
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%
358 ((1 2) (1 in2
) (1 l1
) (1 3) (1 ido
))
362 (f2cl-lib:fref wa-%data%
364 ((1 ido
) (1 2) (1 2))
368 (f2cl-lib:fref wa-%data%
370 ((1 ido
) (1 2) (1 2))
373 (setf (f2cl-lib:fref ch-%data%
375 ((1 2) (1 in2
) (1 l1
) (1 3) (1 ido
))
379 (f2cl-lib:fref wa-%data%
381 ((1 ido
) (1 2) (1 2))
385 (f2cl-lib:fref wa-%data%
387 ((1 ido
) (1 2) (1 2))
390 (setf (f2cl-lib:fref ch-%data%
392 ((1 2) (1 in2
) (1 l1
) (1 3) (1 ido
))
396 (f2cl-lib:fref wa-%data%
398 ((1 ido
) (1 2) (1 2))
402 (f2cl-lib:fref wa-%data%
404 ((1 ido
) (1 2) (1 2))
407 (setf (f2cl-lib:fref ch-%data%
409 ((1 2) (1 in2
) (1 l1
) (1 3) (1 ido
))
413 (f2cl-lib:fref wa-%data%
415 ((1 ido
) (1 2) (1 2))
419 (f2cl-lib:fref wa-%data%
421 ((1 ido
) (1 2) (1 2))
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
)