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 (defun cmf4kf (lot ido l1 na cc im1 in1 ch im2 in2 wa
)
21 (declare (type (array double-float
(*)) wa ch cc
)
22 (type (f2cl-lib:integer4
) in2 im2 in1 im1 na l1 ido lot
))
23 (f2cl-lib:with-multi-array-data
24 ((cc double-float cc-%data% cc-%offset%
)
25 (ch double-float ch-%data% ch-%offset%
)
26 (wa double-float wa-%data% wa-%offset%
))
27 (prog ((ci4 0.0d0
) (ci2 0.0d0
) (cr4 0.0d0
) (cr2 0.0d0
) (ci3 0.0d0
)
28 (cr3 0.0d0
) (i 0) (m2 0) (tr3 0.0d0
) (ti4 0.0d0
) (tr2 0.0d0
)
29 (tr1 0.0d0
) (ti3 0.0d0
) (tr4 0.0d0
) (ti2 0.0d0
) (ti1 0.0d0
) (m1 0)
30 (k 0) (sn 0.0d0
) (m2s 0) (m1d 0))
31 (declare (type (f2cl-lib:integer4
) m1d m2s k m1 m2 i
)
32 (type (double-float) sn ti1 ti2 tr4 ti3 tr1 tr2 ti4 tr3 cr3 ci3
35 (f2cl-lib:int-add
(f2cl-lib:int-mul
(f2cl-lib:int-sub lot
1) im1
)
37 (setf m2s
(f2cl-lib:int-sub
1 im2
))
38 (if (> ido
1) (go label102
))
39 (setf sn
(/ 1.0d0
(f2cl-lib:freal
(f2cl-lib:int-mul
4 l1
))))
40 (if (= na
1) (go label106
))
41 (f2cl-lib:fdo
(k 1 (f2cl-lib:int-add k
1))
44 (f2cl-lib:fdo
(m1 1 (f2cl-lib:int-add m1 im1
))
49 (f2cl-lib:fref cc-%data%
51 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
53 (f2cl-lib:fref cc-%data%
55 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
59 (f2cl-lib:fref cc-%data%
61 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
63 (f2cl-lib:fref cc-%data%
65 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
69 (f2cl-lib:fref cc-%data%
71 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
73 (f2cl-lib:fref cc-%data%
75 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
79 (f2cl-lib:fref cc-%data%
81 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
83 (f2cl-lib:fref cc-%data%
85 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
89 (f2cl-lib:fref cc-%data%
91 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
93 (f2cl-lib:fref cc-%data%
95 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
99 (f2cl-lib:fref cc-%data%
101 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
103 (f2cl-lib:fref cc-%data%
105 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
109 (f2cl-lib:fref cc-%data%
111 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
113 (f2cl-lib:fref cc-%data%
115 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
119 (f2cl-lib:fref cc-%data%
121 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
123 (f2cl-lib:fref cc-%data%
125 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
127 (setf (f2cl-lib:fref cc-%data%
129 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
132 (setf (f2cl-lib:fref cc-%data%
134 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
137 (setf (f2cl-lib:fref cc-%data%
139 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
142 (setf (f2cl-lib:fref cc-%data%
144 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
147 (setf (f2cl-lib:fref cc-%data%
149 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
152 (setf (f2cl-lib:fref cc-%data%
154 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
157 (setf (f2cl-lib:fref cc-%data%
159 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
162 (setf (f2cl-lib:fref cc-%data%
164 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
171 (f2cl-lib:fdo
(k 1 (f2cl-lib:int-add k
1))
175 (f2cl-lib:fdo
(m1 1 (f2cl-lib:int-add m1 im1
))
178 (setf m2
(f2cl-lib:int-add m2 im2
))
181 (f2cl-lib:fref cc-%data%
183 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
185 (f2cl-lib:fref cc-%data%
187 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
191 (f2cl-lib:fref cc-%data%
193 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
195 (f2cl-lib:fref cc-%data%
197 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
201 (f2cl-lib:fref cc-%data%
203 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
205 (f2cl-lib:fref cc-%data%
207 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
211 (f2cl-lib:fref cc-%data%
213 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
215 (f2cl-lib:fref cc-%data%
217 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
221 (f2cl-lib:fref cc-%data%
223 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
225 (f2cl-lib:fref cc-%data%
227 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
231 (f2cl-lib:fref cc-%data%
233 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
235 (f2cl-lib:fref cc-%data%
237 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
241 (f2cl-lib:fref cc-%data%
243 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
245 (f2cl-lib:fref cc-%data%
247 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
251 (f2cl-lib:fref cc-%data%
253 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
255 (f2cl-lib:fref cc-%data%
257 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
259 (setf (f2cl-lib:fref ch-%data%
261 ((1 2) (1 in2
) (1 l1
) (1 4) (1 ido
))
264 (setf (f2cl-lib:fref ch-%data%
266 ((1 2) (1 in2
) (1 l1
) (1 4) (1 ido
))
269 (setf (f2cl-lib:fref ch-%data%
271 ((1 2) (1 in2
) (1 l1
) (1 4) (1 ido
))
274 (setf (f2cl-lib:fref ch-%data%
276 ((1 2) (1 in2
) (1 l1
) (1 4) (1 ido
))
279 (setf (f2cl-lib:fref ch-%data%
281 ((1 2) (1 in2
) (1 l1
) (1 4) (1 ido
))
284 (setf (f2cl-lib:fref ch-%data%
286 ((1 2) (1 in2
) (1 l1
) (1 4) (1 ido
))
289 (setf (f2cl-lib:fref ch-%data%
291 ((1 2) (1 in2
) (1 l1
) (1 4) (1 ido
))
294 (setf (f2cl-lib:fref ch-%data%
296 ((1 2) (1 in2
) (1 l1
) (1 4) (1 ido
))
303 (f2cl-lib:fdo
(k 1 (f2cl-lib:int-add k
1))
307 (f2cl-lib:fdo
(m1 1 (f2cl-lib:int-add m1 im1
))
310 (setf m2
(f2cl-lib:int-add m2 im2
))
313 (f2cl-lib:fref cc-%data%
315 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
317 (f2cl-lib:fref cc-%data%
319 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
323 (f2cl-lib:fref cc-%data%
325 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
327 (f2cl-lib:fref cc-%data%
329 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
333 (f2cl-lib:fref cc-%data%
335 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
337 (f2cl-lib:fref cc-%data%
339 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
343 (f2cl-lib:fref cc-%data%
345 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
347 (f2cl-lib:fref cc-%data%
349 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
353 (f2cl-lib:fref cc-%data%
355 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
357 (f2cl-lib:fref cc-%data%
359 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
363 (f2cl-lib:fref cc-%data%
365 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
367 (f2cl-lib:fref cc-%data%
369 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
373 (f2cl-lib:fref cc-%data%
375 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
377 (f2cl-lib:fref cc-%data%
379 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
383 (f2cl-lib:fref cc-%data%
385 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
387 (f2cl-lib:fref cc-%data%
389 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
391 (setf (f2cl-lib:fref ch-%data%
393 ((1 2) (1 in2
) (1 l1
) (1 4) (1 ido
))
396 (setf (f2cl-lib:fref ch-%data%
398 ((1 2) (1 in2
) (1 l1
) (1 4) (1 ido
))
401 (setf (f2cl-lib:fref ch-%data%
403 ((1 2) (1 in2
) (1 l1
) (1 4) (1 ido
))
406 (setf (f2cl-lib:fref ch-%data%
408 ((1 2) (1 in2
) (1 l1
) (1 4) (1 ido
))
411 (setf (f2cl-lib:fref ch-%data%
413 ((1 2) (1 in2
) (1 l1
) (1 4) (1 ido
))
416 (setf (f2cl-lib:fref ch-%data%
418 ((1 2) (1 in2
) (1 l1
) (1 4) (1 ido
))
421 (setf (f2cl-lib:fref ch-%data%
423 ((1 2) (1 in2
) (1 l1
) (1 4) (1 ido
))
426 (setf (f2cl-lib:fref ch-%data%
428 ((1 2) (1 in2
) (1 l1
) (1 4) (1 ido
))
433 (f2cl-lib:fdo
(i 2 (f2cl-lib:int-add i
1))
436 (f2cl-lib:fdo
(k 1 (f2cl-lib:int-add k
1))
440 (f2cl-lib:fdo
(m1 1 (f2cl-lib:int-add m1 im1
))
443 (setf m2
(f2cl-lib:int-add m2 im2
))
446 (f2cl-lib:fref cc-%data%
448 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
450 (f2cl-lib:fref cc-%data%
452 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
456 (f2cl-lib:fref cc-%data%
458 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
460 (f2cl-lib:fref cc-%data%
462 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
466 (f2cl-lib:fref cc-%data%
468 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
470 (f2cl-lib:fref cc-%data%
472 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
476 (f2cl-lib:fref cc-%data%
478 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
480 (f2cl-lib:fref cc-%data%
482 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
486 (f2cl-lib:fref cc-%data%
488 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
490 (f2cl-lib:fref cc-%data%
492 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
496 (f2cl-lib:fref cc-%data%
498 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
500 (f2cl-lib:fref cc-%data%
502 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
506 (f2cl-lib:fref cc-%data%
508 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
510 (f2cl-lib:fref cc-%data%
512 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
516 (f2cl-lib:fref cc-%data%
518 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
520 (f2cl-lib:fref cc-%data%
522 ((1 2) (1 in1
) (1 l1
) (1 ido
) (1 4))
524 (setf (f2cl-lib:fref ch-%data%
526 ((1 2) (1 in2
) (1 l1
) (1 4) (1 ido
))
529 (setf cr3
(- tr2 tr3
))
530 (setf (f2cl-lib:fref ch-%data%
532 ((1 2) (1 in2
) (1 l1
) (1 4) (1 ido
))
535 (setf ci3
(- ti2 ti3
))
536 (setf cr2
(+ tr1 tr4
))
537 (setf cr4
(- tr1 tr4
))
538 (setf ci2
(+ ti1 ti4
))
539 (setf ci4
(- ti1 ti4
))
540 (setf (f2cl-lib:fref ch-%data%
542 ((1 2) (1 in2
) (1 l1
) (1 4) (1 ido
))
546 (f2cl-lib:fref wa-%data%
548 ((1 ido
) (1 3) (1 2))
552 (f2cl-lib:fref wa-%data%
554 ((1 ido
) (1 3) (1 2))
557 (setf (f2cl-lib:fref ch-%data%
559 ((1 2) (1 in2
) (1 l1
) (1 4) (1 ido
))
563 (f2cl-lib:fref wa-%data%
565 ((1 ido
) (1 3) (1 2))
569 (f2cl-lib:fref wa-%data%
571 ((1 ido
) (1 3) (1 2))
574 (setf (f2cl-lib:fref ch-%data%
576 ((1 2) (1 in2
) (1 l1
) (1 4) (1 ido
))
580 (f2cl-lib:fref wa-%data%
582 ((1 ido
) (1 3) (1 2))
586 (f2cl-lib:fref wa-%data%
588 ((1 ido
) (1 3) (1 2))
591 (setf (f2cl-lib:fref ch-%data%
593 ((1 2) (1 in2
) (1 l1
) (1 4) (1 ido
))
597 (f2cl-lib:fref wa-%data%
599 ((1 ido
) (1 3) (1 2))
603 (f2cl-lib:fref wa-%data%
605 ((1 ido
) (1 3) (1 2))
608 (setf (f2cl-lib:fref ch-%data%
610 ((1 2) (1 in2
) (1 l1
) (1 4) (1 ido
))
614 (f2cl-lib:fref wa-%data%
616 ((1 ido
) (1 3) (1 2))
620 (f2cl-lib:fref wa-%data%
622 ((1 ido
) (1 3) (1 2))
625 (setf (f2cl-lib:fref ch-%data%
627 ((1 2) (1 in2
) (1 l1
) (1 4) (1 ido
))
631 (f2cl-lib:fref wa-%data%
633 ((1 ido
) (1 3) (1 2))
637 (f2cl-lib:fref wa-%data%
639 ((1 ido
) (1 3) (1 2))
647 (return (values nil nil nil nil nil nil nil nil nil nil nil
)))))
649 (in-package #:cl-user
)
650 #+#.
(cl:if
(cl:find-package
'#:f2cl
) '(and) '(or))
651 (eval-when (:load-toplevel
:compile-toplevel
:execute
)
652 (setf (gethash 'fortran-to-lisp
::cmf4kf
653 fortran-to-lisp
::*f2cl-function-info
*)
654 (fortran-to-lisp::make-f2cl-finfo
655 :arg-types
'((fortran-to-lisp::integer4
) (fortran-to-lisp::integer4
)
656 (fortran-to-lisp::integer4
) (fortran-to-lisp::integer4
)
657 (array double-float
(*)) (fortran-to-lisp::integer4
)
658 (fortran-to-lisp::integer4
) (array double-float
(*))
659 (fortran-to-lisp::integer4
) (fortran-to-lisp::integer4
)
660 (array double-float
(*)))
661 :return-values
'(nil nil nil nil nil nil nil nil nil nil nil
)