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 mradf4 (m ido l1 cc im1 in1 ch im2 in2 wa1 wa2 wa3
)
21 (declare (type (array double-float
(*)) wa3 wa2 wa1 ch cc
)
22 (type (f2cl-lib:integer4
) in2 im2 in1 im1 l1 ido m
))
23 (f2cl-lib:with-multi-array-data
24 ((cc double-float cc-%data% cc-%offset%
)
25 (ch double-float ch-%data% ch-%offset%
)
26 (wa1 double-float wa1-%data% wa1-%offset%
)
27 (wa2 double-float wa2-%data% wa2-%offset%
)
28 (wa3 double-float wa3-%data% wa3-%offset%
))
29 (prog ((ic 0) (i 0) (idp2 0) (m1 0) (m2 0) (k 0) (m2s 0) (m1d 0)
31 (declare (type (double-float) hsqt2
)
32 (type (f2cl-lib:integer4
) m1d m2s k m2 m1 idp2 i ic
))
33 (setf hsqt2
(/ (f2cl-lib:fsqrt
2.0d0
) 2.0d0
))
35 (f2cl-lib:int-add
(f2cl-lib:int-mul
(f2cl-lib:int-sub m
1) im1
)
37 (setf m2s
(f2cl-lib:int-sub
1 im2
))
38 (f2cl-lib:fdo
(k 1 (f2cl-lib:int-add k
1))
42 (f2cl-lib:fdo
(m1 1 (f2cl-lib:int-add m1 im1
))
45 (setf m2
(f2cl-lib:int-add m2 im2
))
46 (setf (f2cl-lib:fref ch-%data%
48 ((1 in2
) (1 ido
) (1 4) (1 l1
))
51 (f2cl-lib:fref cc-%data%
53 ((1 in1
) (1 ido
) (1 l1
) (1 4))
55 (f2cl-lib:fref cc-%data%
57 ((1 in1
) (1 ido
) (1 l1
) (1 4))
60 (f2cl-lib:fref cc-%data%
62 ((1 in1
) (1 ido
) (1 l1
) (1 4))
64 (f2cl-lib:fref cc-%data%
66 ((1 in1
) (1 ido
) (1 l1
) (1 4))
68 (setf (f2cl-lib:fref ch-%data%
70 ((1 in2
) (1 ido
) (1 4) (1 l1
))
74 (f2cl-lib:fref cc-%data%
76 ((1 in1
) (1 ido
) (1 l1
) (1 4))
78 (f2cl-lib:fref cc-%data%
80 ((1 in1
) (1 ido
) (1 l1
) (1 4))
83 (f2cl-lib:fref cc-%data%
85 ((1 in1
) (1 ido
) (1 l1
) (1 4))
87 (f2cl-lib:fref cc-%data%
89 ((1 in1
) (1 ido
) (1 l1
) (1 4))
91 (setf (f2cl-lib:fref ch-%data%
93 ((1 in2
) (1 ido
) (1 4) (1 l1
))
96 (f2cl-lib:fref cc-%data%
98 ((1 in1
) (1 ido
) (1 l1
) (1 4))
100 (f2cl-lib:fref cc-%data%
102 ((1 in1
) (1 ido
) (1 l1
) (1 4))
104 (setf (f2cl-lib:fref ch-%data%
106 ((1 in2
) (1 ido
) (1 4) (1 l1
))
109 (f2cl-lib:fref cc-%data%
111 ((1 in1
) (1 ido
) (1 l1
) (1 4))
113 (f2cl-lib:fref cc-%data%
115 ((1 in1
) (1 ido
) (1 l1
) (1 4))
119 (f2cl-lib:arithmetic-if
(f2cl-lib:int-sub ido
2)
124 (setf idp2
(f2cl-lib:int-add ido
2))
125 (f2cl-lib:fdo
(k 1 (f2cl-lib:int-add k
1))
128 (f2cl-lib:fdo
(i 3 (f2cl-lib:int-add i
2))
131 (setf ic
(f2cl-lib:int-sub idp2 i
))
133 (f2cl-lib:fdo
(m1 1 (f2cl-lib:int-add m1 im1
))
136 (setf m2
(f2cl-lib:int-add m2 im2
))
137 (setf (f2cl-lib:fref ch-%data%
138 (m2 (f2cl-lib:int-sub i
1) 1 k
)
139 ((1 in2
) (1 ido
) (1 4) (1 l1
))
143 (f2cl-lib:fref wa1-%data%
144 ((f2cl-lib:int-sub i
2))
147 (f2cl-lib:fref cc-%data%
148 (m1 (f2cl-lib:int-sub i
1) k
2)
149 ((1 in1
) (1 ido
) (1 l1
) (1 4))
152 (f2cl-lib:fref wa1-%data%
153 ((f2cl-lib:int-sub i
1))
156 (f2cl-lib:fref cc-%data%
158 ((1 in1
) (1 ido
) (1 l1
) (1 4))
162 (f2cl-lib:fref wa3-%data%
163 ((f2cl-lib:int-sub i
2))
166 (f2cl-lib:fref cc-%data%
167 (m1 (f2cl-lib:int-sub i
1) k
4)
168 ((1 in1
) (1 ido
) (1 l1
) (1 4))
171 (f2cl-lib:fref wa3-%data%
172 ((f2cl-lib:int-sub i
1))
175 (f2cl-lib:fref cc-%data%
177 ((1 in1
) (1 ido
) (1 l1
) (1 4))
180 (f2cl-lib:fref cc-%data%
181 (m1 (f2cl-lib:int-sub i
1) k
1)
182 ((1 in1
) (1 ido
) (1 l1
) (1 4))
186 (f2cl-lib:fref wa2-%data%
187 ((f2cl-lib:int-sub i
2))
190 (f2cl-lib:fref cc-%data%
191 (m1 (f2cl-lib:int-sub i
1) k
3)
192 ((1 in1
) (1 ido
) (1 l1
) (1 4))
195 (f2cl-lib:fref wa2-%data%
196 ((f2cl-lib:int-sub i
1))
199 (f2cl-lib:fref cc-%data%
201 ((1 in1
) (1 ido
) (1 l1
) (1 4))
203 (setf (f2cl-lib:fref ch-%data%
204 (m2 (f2cl-lib:int-sub ic
1) 4 k
)
205 ((1 in2
) (1 ido
) (1 4) (1 l1
))
209 (f2cl-lib:fref cc-%data%
210 (m1 (f2cl-lib:int-sub i
1) k
1)
211 ((1 in1
) (1 ido
) (1 l1
) (1 4))
215 (f2cl-lib:fref wa2-%data%
216 ((f2cl-lib:int-sub i
2))
219 (f2cl-lib:fref cc-%data%
220 (m1 (f2cl-lib:int-sub i
1) k
3)
221 ((1 in1
) (1 ido
) (1 l1
) (1 4))
224 (f2cl-lib:fref wa2-%data%
225 ((f2cl-lib:int-sub i
1))
228 (f2cl-lib:fref cc-%data%
230 ((1 in1
) (1 ido
) (1 l1
) (1 4))
234 (f2cl-lib:fref wa1-%data%
235 ((f2cl-lib:int-sub i
2))
238 (f2cl-lib:fref cc-%data%
239 (m1 (f2cl-lib:int-sub i
1) k
2)
240 ((1 in1
) (1 ido
) (1 l1
) (1 4))
243 (f2cl-lib:fref wa1-%data%
244 ((f2cl-lib:int-sub i
1))
247 (f2cl-lib:fref cc-%data%
249 ((1 in1
) (1 ido
) (1 l1
) (1 4))
253 (f2cl-lib:fref wa3-%data%
254 ((f2cl-lib:int-sub i
2))
257 (f2cl-lib:fref cc-%data%
258 (m1 (f2cl-lib:int-sub i
1) k
4)
259 ((1 in1
) (1 ido
) (1 l1
) (1 4))
262 (f2cl-lib:fref wa3-%data%
263 ((f2cl-lib:int-sub i
1))
266 (f2cl-lib:fref cc-%data%
268 ((1 in1
) (1 ido
) (1 l1
) (1 4))
270 (setf (f2cl-lib:fref ch-%data%
272 ((1 in2
) (1 ido
) (1 4) (1 l1
))
277 (f2cl-lib:fref wa1-%data%
278 ((f2cl-lib:int-sub i
2))
281 (f2cl-lib:fref cc-%data%
283 ((1 in1
) (1 ido
) (1 l1
) (1 4))
286 (f2cl-lib:fref wa1-%data%
287 ((f2cl-lib:int-sub i
1))
290 (f2cl-lib:fref cc-%data%
291 (m1 (f2cl-lib:int-sub i
1) k
2)
292 ((1 in1
) (1 ido
) (1 l1
) (1 4))
296 (f2cl-lib:fref wa3-%data%
297 ((f2cl-lib:int-sub i
2))
300 (f2cl-lib:fref cc-%data%
302 ((1 in1
) (1 ido
) (1 l1
) (1 4))
305 (f2cl-lib:fref wa3-%data%
306 ((f2cl-lib:int-sub i
1))
309 (f2cl-lib:fref cc-%data%
310 (m1 (f2cl-lib:int-sub i
1) k
4)
311 ((1 in1
) (1 ido
) (1 l1
) (1 4))
314 (f2cl-lib:fref cc-%data%
316 ((1 in1
) (1 ido
) (1 l1
) (1 4))
320 (f2cl-lib:fref wa2-%data%
321 ((f2cl-lib:int-sub i
2))
324 (f2cl-lib:fref cc-%data%
326 ((1 in1
) (1 ido
) (1 l1
) (1 4))
329 (f2cl-lib:fref wa2-%data%
330 ((f2cl-lib:int-sub i
1))
333 (f2cl-lib:fref cc-%data%
334 (m1 (f2cl-lib:int-sub i
1) k
3)
335 ((1 in1
) (1 ido
) (1 l1
) (1 4))
337 (setf (f2cl-lib:fref ch-%data%
339 ((1 in2
) (1 ido
) (1 4) (1 l1
))
345 (f2cl-lib:fref wa1-%data%
346 ((f2cl-lib:int-sub i
2))
349 (f2cl-lib:fref cc-%data%
351 ((1 in1
) (1 ido
) (1 l1
) (1 4))
354 (f2cl-lib:fref wa1-%data%
355 ((f2cl-lib:int-sub i
1))
358 (f2cl-lib:fref cc-%data%
359 (m1 (f2cl-lib:int-sub i
1) k
2)
360 ((1 in1
) (1 ido
) (1 l1
) (1 4))
364 (f2cl-lib:fref wa3-%data%
365 ((f2cl-lib:int-sub i
2))
368 (f2cl-lib:fref cc-%data%
370 ((1 in1
) (1 ido
) (1 l1
) (1 4))
373 (f2cl-lib:fref wa3-%data%
374 ((f2cl-lib:int-sub i
1))
377 (f2cl-lib:fref cc-%data%
378 (m1 (f2cl-lib:int-sub i
1) k
4)
379 ((1 in1
) (1 ido
) (1 l1
) (1 4))
382 (f2cl-lib:fref cc-%data%
384 ((1 in1
) (1 ido
) (1 l1
) (1 4))
388 (f2cl-lib:fref wa2-%data%
389 ((f2cl-lib:int-sub i
2))
392 (f2cl-lib:fref cc-%data%
394 ((1 in1
) (1 ido
) (1 l1
) (1 4))
397 (f2cl-lib:fref wa2-%data%
398 ((f2cl-lib:int-sub i
1))
401 (f2cl-lib:fref cc-%data%
402 (m1 (f2cl-lib:int-sub i
1) k
3)
403 ((1 in1
) (1 ido
) (1 l1
) (1 4))
405 (setf (f2cl-lib:fref ch-%data%
406 (m2 (f2cl-lib:int-sub i
1) 3 k
)
407 ((1 in2
) (1 ido
) (1 4) (1 l1
))
412 (f2cl-lib:fref wa1-%data%
413 ((f2cl-lib:int-sub i
2))
416 (f2cl-lib:fref cc-%data%
418 ((1 in1
) (1 ido
) (1 l1
) (1 4))
421 (f2cl-lib:fref wa1-%data%
422 ((f2cl-lib:int-sub i
1))
425 (f2cl-lib:fref cc-%data%
426 (m1 (f2cl-lib:int-sub i
1) k
2)
427 ((1 in1
) (1 ido
) (1 l1
) (1 4))
431 (f2cl-lib:fref wa3-%data%
432 ((f2cl-lib:int-sub i
2))
435 (f2cl-lib:fref cc-%data%
437 ((1 in1
) (1 ido
) (1 l1
) (1 4))
440 (f2cl-lib:fref wa3-%data%
441 ((f2cl-lib:int-sub i
1))
444 (f2cl-lib:fref cc-%data%
445 (m1 (f2cl-lib:int-sub i
1) k
4)
446 ((1 in1
) (1 ido
) (1 l1
) (1 4))
449 (f2cl-lib:fref cc-%data%
450 (m1 (f2cl-lib:int-sub i
1) k
1)
451 ((1 in1
) (1 ido
) (1 l1
) (1 4))
455 (f2cl-lib:fref wa2-%data%
456 ((f2cl-lib:int-sub i
2))
459 (f2cl-lib:fref cc-%data%
460 (m1 (f2cl-lib:int-sub i
1) k
3)
461 ((1 in1
) (1 ido
) (1 l1
) (1 4))
464 (f2cl-lib:fref wa2-%data%
465 ((f2cl-lib:int-sub i
1))
468 (f2cl-lib:fref cc-%data%
470 ((1 in1
) (1 ido
) (1 l1
) (1 4))
472 (setf (f2cl-lib:fref ch-%data%
473 (m2 (f2cl-lib:int-sub ic
1) 2 k
)
474 ((1 in2
) (1 ido
) (1 4) (1 l1
))
477 (f2cl-lib:fref cc-%data%
478 (m1 (f2cl-lib:int-sub i
1) k
1)
479 ((1 in1
) (1 ido
) (1 l1
) (1 4))
483 (f2cl-lib:fref wa2-%data%
484 ((f2cl-lib:int-sub i
2))
487 (f2cl-lib:fref cc-%data%
488 (m1 (f2cl-lib:int-sub i
1) k
3)
489 ((1 in1
) (1 ido
) (1 l1
) (1 4))
492 (f2cl-lib:fref wa2-%data%
493 ((f2cl-lib:int-sub i
1))
496 (f2cl-lib:fref cc-%data%
498 ((1 in1
) (1 ido
) (1 l1
) (1 4))
502 (f2cl-lib:fref wa1-%data%
503 ((f2cl-lib:int-sub i
2))
506 (f2cl-lib:fref cc-%data%
508 ((1 in1
) (1 ido
) (1 l1
) (1 4))
511 (f2cl-lib:fref wa1-%data%
512 ((f2cl-lib:int-sub i
1))
515 (f2cl-lib:fref cc-%data%
516 (m1 (f2cl-lib:int-sub i
1) k
2)
517 ((1 in1
) (1 ido
) (1 l1
) (1 4))
521 (f2cl-lib:fref wa3-%data%
522 ((f2cl-lib:int-sub i
2))
525 (f2cl-lib:fref cc-%data%
527 ((1 in1
) (1 ido
) (1 l1
) (1 4))
530 (f2cl-lib:fref wa3-%data%
531 ((f2cl-lib:int-sub i
1))
534 (f2cl-lib:fref cc-%data%
535 (m1 (f2cl-lib:int-sub i
1) k
4)
536 ((1 in1
) (1 ido
) (1 l1
) (1 4))
538 (setf (f2cl-lib:fref ch-%data%
540 ((1 in2
) (1 ido
) (1 4) (1 l1
))
546 (f2cl-lib:fref wa3-%data%
547 ((f2cl-lib:int-sub i
2))
550 (f2cl-lib:fref cc-%data%
551 (m1 (f2cl-lib:int-sub i
1) k
4)
552 ((1 in1
) (1 ido
) (1 l1
) (1 4))
555 (f2cl-lib:fref wa3-%data%
556 ((f2cl-lib:int-sub i
1))
559 (f2cl-lib:fref cc-%data%
561 ((1 in1
) (1 ido
) (1 l1
) (1 4))
565 (f2cl-lib:fref wa1-%data%
566 ((f2cl-lib:int-sub i
2))
569 (f2cl-lib:fref cc-%data%
570 (m1 (f2cl-lib:int-sub i
1) k
2)
571 ((1 in1
) (1 ido
) (1 l1
) (1 4))
574 (f2cl-lib:fref wa1-%data%
575 ((f2cl-lib:int-sub i
1))
578 (f2cl-lib:fref cc-%data%
580 ((1 in1
) (1 ido
) (1 l1
) (1 4))
583 (f2cl-lib:fref cc-%data%
585 ((1 in1
) (1 ido
) (1 l1
) (1 4))
589 (f2cl-lib:fref wa2-%data%
590 ((f2cl-lib:int-sub i
2))
593 (f2cl-lib:fref cc-%data%
595 ((1 in1
) (1 ido
) (1 l1
) (1 4))
598 (f2cl-lib:fref wa2-%data%
599 ((f2cl-lib:int-sub i
1))
602 (f2cl-lib:fref cc-%data%
603 (m1 (f2cl-lib:int-sub i
1) k
3)
604 ((1 in1
) (1 ido
) (1 l1
) (1 4))
606 (setf (f2cl-lib:fref ch-%data%
608 ((1 in2
) (1 ido
) (1 4) (1 l1
))
613 (f2cl-lib:fref wa3-%data%
614 ((f2cl-lib:int-sub i
2))
617 (f2cl-lib:fref cc-%data%
618 (m1 (f2cl-lib:int-sub i
1) k
4)
619 ((1 in1
) (1 ido
) (1 l1
) (1 4))
622 (f2cl-lib:fref wa3-%data%
623 ((f2cl-lib:int-sub i
1))
626 (f2cl-lib:fref cc-%data%
628 ((1 in1
) (1 ido
) (1 l1
) (1 4))
632 (f2cl-lib:fref wa1-%data%
633 ((f2cl-lib:int-sub i
2))
636 (f2cl-lib:fref cc-%data%
637 (m1 (f2cl-lib:int-sub i
1) k
2)
638 ((1 in1
) (1 ido
) (1 l1
) (1 4))
641 (f2cl-lib:fref wa1-%data%
642 ((f2cl-lib:int-sub i
1))
645 (f2cl-lib:fref cc-%data%
647 ((1 in1
) (1 ido
) (1 l1
) (1 4))
650 (f2cl-lib:fref cc-%data%
652 ((1 in1
) (1 ido
) (1 l1
) (1 4))
656 (f2cl-lib:fref wa2-%data%
657 ((f2cl-lib:int-sub i
2))
660 (f2cl-lib:fref cc-%data%
662 ((1 in1
) (1 ido
) (1 l1
) (1 4))
665 (f2cl-lib:fref wa2-%data%
666 ((f2cl-lib:int-sub i
1))
669 (f2cl-lib:fref cc-%data%
670 (m1 (f2cl-lib:int-sub i
1) k
3)
671 ((1 in1
) (1 ido
) (1 l1
) (1 4))
676 (if (= (mod ido
2) 1) (go end_label
))
678 (f2cl-lib:fdo
(k 1 (f2cl-lib:int-add k
1))
682 (f2cl-lib:fdo
(m1 1 (f2cl-lib:int-add m1 im1
))
685 (setf m2
(f2cl-lib:int-add m2 im2
))
686 (setf (f2cl-lib:fref ch-%data%
688 ((1 in2
) (1 ido
) (1 4) (1 l1
))
693 (f2cl-lib:fref cc-%data%
695 ((1 in1
) (1 ido
) (1 l1
) (1 4))
697 (f2cl-lib:fref cc-%data%
699 ((1 in1
) (1 ido
) (1 l1
) (1 4))
701 (f2cl-lib:fref cc-%data%
703 ((1 in1
) (1 ido
) (1 l1
) (1 4))
705 (setf (f2cl-lib:fref ch-%data%
707 ((1 in2
) (1 ido
) (1 4) (1 l1
))
710 (f2cl-lib:fref cc-%data%
712 ((1 in1
) (1 ido
) (1 l1
) (1 4))
716 (f2cl-lib:fref cc-%data%
718 ((1 in1
) (1 ido
) (1 l1
) (1 4))
720 (f2cl-lib:fref cc-%data%
722 ((1 in1
) (1 ido
) (1 l1
) (1 4))
724 (setf (f2cl-lib:fref ch-%data%
726 ((1 in2
) (1 ido
) (1 4) (1 l1
))
731 (f2cl-lib:fref cc-%data%
733 ((1 in1
) (1 ido
) (1 l1
) (1 4))
735 (f2cl-lib:fref cc-%data%
737 ((1 in1
) (1 ido
) (1 l1
) (1 4))
739 (f2cl-lib:fref cc-%data%
741 ((1 in1
) (1 ido
) (1 l1
) (1 4))
743 (setf (f2cl-lib:fref ch-%data%
745 ((1 in2
) (1 ido
) (1 4) (1 l1
))
750 (f2cl-lib:fref cc-%data%
752 ((1 in1
) (1 ido
) (1 l1
) (1 4))
754 (f2cl-lib:fref cc-%data%
756 ((1 in1
) (1 ido
) (1 l1
) (1 4))
758 (f2cl-lib:fref cc-%data%
760 ((1 in1
) (1 ido
) (1 l1
) (1 4))
767 (return (values nil nil nil nil nil nil nil nil nil nil nil nil
)))))
769 (in-package #:cl-user
)
770 #+#.
(cl:if
(cl:find-package
'#:f2cl
) '(and) '(or))
771 (eval-when (:load-toplevel
:compile-toplevel
:execute
)
772 (setf (gethash 'fortran-to-lisp
::mradf4
773 fortran-to-lisp
::*f2cl-function-info
*)
774 (fortran-to-lisp::make-f2cl-finfo
775 :arg-types
'((fortran-to-lisp::integer4
) (fortran-to-lisp::integer4
)
776 (fortran-to-lisp::integer4
) (array double-float
(*))
777 (fortran-to-lisp::integer4
) (fortran-to-lisp::integer4
)
778 (array double-float
(*)) (fortran-to-lisp::integer4
)
779 (fortran-to-lisp::integer4
) (array double-float
(*))
780 (array double-float
(*)) (array double-float
(*)))
781 :return-values
'(nil nil nil nil nil nil nil nil nil nil nil nil
)