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 c1fgkf (ido ip l1 lid na cc cc1 in1 ch ch1 in2 wa
)
21 (declare (type (array double-float
(*)) wa ch1 ch cc1 cc
)
22 (type (f2cl-lib:integer4
) in2 in1 na lid l1 ip ido
))
23 (f2cl-lib:with-multi-array-data
24 ((cc double-float cc-%data% cc-%offset%
)
25 (cc1 double-float cc1-%data% cc1-%offset%
)
26 (ch double-float ch-%data% ch-%offset%
)
27 (ch1 double-float ch1-%data% ch1-%offset%
)
28 (wa double-float wa-%data% wa-%offset%
))
29 (prog ((k 0) (i 0) (chold2 0.0d0
) (chold1 0.0d0
) (sn 0.0d0
) (wai 0.0d0
)
30 (war 0.0d0
) (idlj 0) (lc 0) (l 0) (jc 0) (j 0) (ki 0) (ipph 0)
32 (declare (type (double-float) war wai sn chold1 chold2
)
33 (type (f2cl-lib:integer4
) ipp2 ipph ki j jc l lc idlj i k
))
34 (setf ipp2
(f2cl-lib:int-add ip
2))
35 (setf ipph
(the f2cl-lib
:integer4
(truncate (+ ip
1) 2)))
36 (f2cl-lib:fdo
(ki 1 (f2cl-lib:int-add ki
1))
39 (setf (f2cl-lib:fref ch1-%data%
41 ((1 in2
) (1 lid
) (1 ip
))
43 (f2cl-lib:fref cc1-%data%
45 ((1 in1
) (1 lid
) (1 ip
))
47 (setf (f2cl-lib:fref ch1-%data%
49 ((1 in2
) (1 lid
) (1 ip
))
51 (f2cl-lib:fref cc1-%data%
53 ((1 in1
) (1 lid
) (1 ip
))
56 (f2cl-lib:fdo
(j 2 (f2cl-lib:int-add j
1))
59 (setf jc
(f2cl-lib:int-sub ipp2 j
))
60 (f2cl-lib:fdo
(ki 1 (f2cl-lib:int-add ki
1))
63 (setf (f2cl-lib:fref ch1-%data%
65 ((1 in2
) (1 lid
) (1 ip
))
68 (f2cl-lib:fref cc1-%data%
70 ((1 in1
) (1 lid
) (1 ip
))
72 (f2cl-lib:fref cc1-%data%
74 ((1 in1
) (1 lid
) (1 ip
))
76 (setf (f2cl-lib:fref ch1-%data%
78 ((1 in2
) (1 lid
) (1 ip
))
81 (f2cl-lib:fref cc1-%data%
83 ((1 in1
) (1 lid
) (1 ip
))
85 (f2cl-lib:fref cc1-%data%
87 ((1 in1
) (1 lid
) (1 ip
))
89 (setf (f2cl-lib:fref ch1-%data%
91 ((1 in2
) (1 lid
) (1 ip
))
94 (f2cl-lib:fref cc1-%data%
96 ((1 in1
) (1 lid
) (1 ip
))
98 (f2cl-lib:fref cc1-%data%
100 ((1 in1
) (1 lid
) (1 ip
))
102 (setf (f2cl-lib:fref ch1-%data%
104 ((1 in2
) (1 lid
) (1 ip
))
107 (f2cl-lib:fref cc1-%data%
109 ((1 in1
) (1 lid
) (1 ip
))
111 (f2cl-lib:fref cc1-%data%
113 ((1 in1
) (1 lid
) (1 ip
))
117 (f2cl-lib:fdo
(j 2 (f2cl-lib:int-add j
1))
120 (f2cl-lib:fdo
(ki 1 (f2cl-lib:int-add ki
1))
123 (setf (f2cl-lib:fref cc1-%data%
125 ((1 in1
) (1 lid
) (1 ip
))
128 (f2cl-lib:fref cc1-%data%
130 ((1 in1
) (1 lid
) (1 ip
))
132 (f2cl-lib:fref ch1-%data%
134 ((1 in2
) (1 lid
) (1 ip
))
136 (setf (f2cl-lib:fref cc1-%data%
138 ((1 in1
) (1 lid
) (1 ip
))
141 (f2cl-lib:fref cc1-%data%
143 ((1 in1
) (1 lid
) (1 ip
))
145 (f2cl-lib:fref ch1-%data%
147 ((1 in2
) (1 lid
) (1 ip
))
151 (f2cl-lib:fdo
(l 2 (f2cl-lib:int-add l
1))
154 (setf lc
(f2cl-lib:int-sub ipp2 l
))
155 (f2cl-lib:fdo
(ki 1 (f2cl-lib:int-add ki
1))
158 (setf (f2cl-lib:fref cc1-%data%
160 ((1 in1
) (1 lid
) (1 ip
))
163 (f2cl-lib:fref ch1-%data%
165 ((1 in2
) (1 lid
) (1 ip
))
168 (f2cl-lib:fref wa-%data%
169 (1 (f2cl-lib:int-sub l
1) 1)
177 (f2cl-lib:fref ch1-%data%
179 ((1 in2
) (1 lid
) (1 ip
))
181 (setf (f2cl-lib:fref cc1-%data%
183 ((1 in1
) (1 lid
) (1 ip
))
187 (f2cl-lib:fref wa-%data%
188 (1 (f2cl-lib:int-sub l
1) 2)
196 (f2cl-lib:fref ch1-%data%
198 ((1 in2
) (1 lid
) (1 ip
))
200 (setf (f2cl-lib:fref cc1-%data%
202 ((1 in1
) (1 lid
) (1 ip
))
205 (f2cl-lib:fref ch1-%data%
207 ((1 in2
) (1 lid
) (1 ip
))
210 (f2cl-lib:fref wa-%data%
211 (1 (f2cl-lib:int-sub l
1) 1)
219 (f2cl-lib:fref ch1-%data%
221 ((1 in2
) (1 lid
) (1 ip
))
223 (setf (f2cl-lib:fref cc1-%data%
225 ((1 in1
) (1 lid
) (1 ip
))
229 (f2cl-lib:fref wa-%data%
230 (1 (f2cl-lib:int-sub l
1) 2)
238 (f2cl-lib:fref ch1-%data%
240 ((1 in2
) (1 lid
) (1 ip
))
243 (f2cl-lib:fdo
(j 3 (f2cl-lib:int-add j
1))
246 (setf jc
(f2cl-lib:int-sub ipp2 j
))
249 (f2cl-lib:int-mul
(f2cl-lib:int-sub l
1)
250 (f2cl-lib:int-sub j
1))
253 (f2cl-lib:fref wa-%data%
258 (f2cl-lib:int-sub
1)))
263 (f2cl-lib:fref wa-%data%
272 (f2cl-lib:fdo
(ki 1 (f2cl-lib:int-add ki
1))
275 (setf (f2cl-lib:fref cc1-%data%
277 ((1 in1
) (1 lid
) (1 ip
))
280 (f2cl-lib:fref cc1-%data%
282 ((1 in1
) (1 lid
) (1 ip
))
285 (f2cl-lib:fref ch1-%data%
287 ((1 in2
) (1 lid
) (1 ip
))
289 (setf (f2cl-lib:fref cc1-%data%
291 ((1 in1
) (1 lid
) (1 ip
))
294 (f2cl-lib:fref cc1-%data%
296 ((1 in1
) (1 lid
) (1 ip
))
299 (f2cl-lib:fref ch1-%data%
301 ((1 in2
) (1 lid
) (1 ip
))
303 (setf (f2cl-lib:fref cc1-%data%
305 ((1 in1
) (1 lid
) (1 ip
))
308 (f2cl-lib:fref cc1-%data%
310 ((1 in1
) (1 lid
) (1 ip
))
313 (f2cl-lib:fref ch1-%data%
315 ((1 in2
) (1 lid
) (1 ip
))
317 (setf (f2cl-lib:fref cc1-%data%
319 ((1 in1
) (1 lid
) (1 ip
))
322 (f2cl-lib:fref cc1-%data%
324 ((1 in1
) (1 lid
) (1 ip
))
327 (f2cl-lib:fref ch1-%data%
329 ((1 in2
) (1 lid
) (1 ip
))
334 (if (> ido
1) (go label136
))
335 (setf sn
(/ 1.0d0
(f2cl-lib:freal
(f2cl-lib:int-mul ip l1
))))
336 (if (= na
1) (go label146
))
337 (f2cl-lib:fdo
(ki 1 (f2cl-lib:int-add ki
1))
340 (setf (f2cl-lib:fref cc1-%data%
342 ((1 in1
) (1 lid
) (1 ip
))
345 (f2cl-lib:fref cc1-%data%
347 ((1 in1
) (1 lid
) (1 ip
))
349 (setf (f2cl-lib:fref cc1-%data%
351 ((1 in1
) (1 lid
) (1 ip
))
354 (f2cl-lib:fref cc1-%data%
356 ((1 in1
) (1 lid
) (1 ip
))
359 (f2cl-lib:fdo
(j 2 (f2cl-lib:int-add j
1))
362 (setf jc
(f2cl-lib:int-sub ipp2 j
))
363 (f2cl-lib:fdo
(ki 1 (f2cl-lib:int-add ki
1))
369 (f2cl-lib:fref cc1-%data%
371 ((1 in1
) (1 lid
) (1 ip
))
373 (f2cl-lib:fref cc1-%data%
375 ((1 in1
) (1 lid
) (1 ip
))
380 (f2cl-lib:fref cc1-%data%
382 ((1 in1
) (1 lid
) (1 ip
))
384 (f2cl-lib:fref cc1-%data%
386 ((1 in1
) (1 lid
) (1 ip
))
388 (setf (f2cl-lib:fref cc1-%data%
390 ((1 in1
) (1 lid
) (1 ip
))
393 (setf (f2cl-lib:fref cc1-%data%
395 ((1 in1
) (1 lid
) (1 ip
))
399 (f2cl-lib:fref cc1-%data%
401 ((1 in1
) (1 lid
) (1 ip
))
403 (f2cl-lib:fref cc1-%data%
405 ((1 in1
) (1 lid
) (1 ip
))
407 (setf (f2cl-lib:fref cc1-%data%
409 ((1 in1
) (1 lid
) (1 ip
))
413 (f2cl-lib:fref cc1-%data%
415 ((1 in1
) (1 lid
) (1 ip
))
417 (f2cl-lib:fref cc1-%data%
419 ((1 in1
) (1 lid
) (1 ip
))
421 (setf (f2cl-lib:fref cc1-%data%
423 ((1 in1
) (1 lid
) (1 ip
))
430 (f2cl-lib:fdo
(ki 1 (f2cl-lib:int-add ki
1))
433 (setf (f2cl-lib:fref ch1-%data%
435 ((1 in2
) (1 lid
) (1 ip
))
438 (f2cl-lib:fref cc1-%data%
440 ((1 in1
) (1 lid
) (1 ip
))
442 (setf (f2cl-lib:fref ch1-%data%
444 ((1 in2
) (1 lid
) (1 ip
))
447 (f2cl-lib:fref cc1-%data%
449 ((1 in1
) (1 lid
) (1 ip
))
452 (f2cl-lib:fdo
(j 2 (f2cl-lib:int-add j
1))
455 (setf jc
(f2cl-lib:int-sub ipp2 j
))
456 (f2cl-lib:fdo
(ki 1 (f2cl-lib:int-add ki
1))
459 (setf (f2cl-lib:fref ch1-%data%
461 ((1 in2
) (1 lid
) (1 ip
))
465 (f2cl-lib:fref cc1-%data%
467 ((1 in1
) (1 lid
) (1 ip
))
469 (f2cl-lib:fref cc1-%data%
471 ((1 in1
) (1 lid
) (1 ip
))
473 (setf (f2cl-lib:fref ch1-%data%
475 ((1 in2
) (1 lid
) (1 ip
))
479 (f2cl-lib:fref cc1-%data%
481 ((1 in1
) (1 lid
) (1 ip
))
483 (f2cl-lib:fref cc1-%data%
485 ((1 in1
) (1 lid
) (1 ip
))
487 (setf (f2cl-lib:fref ch1-%data%
489 ((1 in2
) (1 lid
) (1 ip
))
493 (f2cl-lib:fref cc1-%data%
495 ((1 in1
) (1 lid
) (1 ip
))
497 (f2cl-lib:fref cc1-%data%
499 ((1 in1
) (1 lid
) (1 ip
))
501 (setf (f2cl-lib:fref ch1-%data%
503 ((1 in2
) (1 lid
) (1 ip
))
507 (f2cl-lib:fref cc1-%data%
509 ((1 in1
) (1 lid
) (1 ip
))
511 (f2cl-lib:fref cc1-%data%
513 ((1 in1
) (1 lid
) (1 ip
))
519 (f2cl-lib:fdo
(ki 1 (f2cl-lib:int-add ki
1))
522 (setf (f2cl-lib:fref ch1-%data%
524 ((1 in2
) (1 lid
) (1 ip
))
526 (f2cl-lib:fref cc1-%data%
528 ((1 in1
) (1 lid
) (1 ip
))
530 (setf (f2cl-lib:fref ch1-%data%
532 ((1 in2
) (1 lid
) (1 ip
))
534 (f2cl-lib:fref cc1-%data%
536 ((1 in1
) (1 lid
) (1 ip
))
539 (f2cl-lib:fdo
(j 2 (f2cl-lib:int-add j
1))
542 (setf jc
(f2cl-lib:int-sub ipp2 j
))
543 (f2cl-lib:fdo
(ki 1 (f2cl-lib:int-add ki
1))
546 (setf (f2cl-lib:fref ch1-%data%
548 ((1 in2
) (1 lid
) (1 ip
))
551 (f2cl-lib:fref cc1-%data%
553 ((1 in1
) (1 lid
) (1 ip
))
555 (f2cl-lib:fref cc1-%data%
557 ((1 in1
) (1 lid
) (1 ip
))
559 (setf (f2cl-lib:fref ch1-%data%
561 ((1 in2
) (1 lid
) (1 ip
))
564 (f2cl-lib:fref cc1-%data%
566 ((1 in1
) (1 lid
) (1 ip
))
568 (f2cl-lib:fref cc1-%data%
570 ((1 in1
) (1 lid
) (1 ip
))
572 (setf (f2cl-lib:fref ch1-%data%
574 ((1 in2
) (1 lid
) (1 ip
))
577 (f2cl-lib:fref cc1-%data%
579 ((1 in1
) (1 lid
) (1 ip
))
581 (f2cl-lib:fref cc1-%data%
583 ((1 in1
) (1 lid
) (1 ip
))
585 (setf (f2cl-lib:fref ch1-%data%
587 ((1 in2
) (1 lid
) (1 ip
))
590 (f2cl-lib:fref cc1-%data%
592 ((1 in1
) (1 lid
) (1 ip
))
594 (f2cl-lib:fref cc1-%data%
596 ((1 in1
) (1 lid
) (1 ip
))
600 (f2cl-lib:fdo
(i 1 (f2cl-lib:int-add i
1))
603 (f2cl-lib:fdo
(k 1 (f2cl-lib:int-add k
1))
606 (setf (f2cl-lib:fref cc-%data%
608 ((1 in1
) (1 l1
) (1 ip
) (1 ido
))
610 (f2cl-lib:fref ch-%data%
612 ((1 in2
) (1 l1
) (1 ido
) (1 ip
))
614 (setf (f2cl-lib:fref cc-%data%
616 ((1 in1
) (1 l1
) (1 ip
) (1 ido
))
618 (f2cl-lib:fref ch-%data%
620 ((1 in2
) (1 l1
) (1 ido
) (1 ip
))
624 (f2cl-lib:fdo
(j 2 (f2cl-lib:int-add j
1))
627 (f2cl-lib:fdo
(k 1 (f2cl-lib:int-add k
1))
630 (setf (f2cl-lib:fref cc-%data%
632 ((1 in1
) (1 l1
) (1 ip
) (1 ido
))
634 (f2cl-lib:fref ch-%data%
636 ((1 in2
) (1 l1
) (1 ido
) (1 ip
))
638 (setf (f2cl-lib:fref cc-%data%
640 ((1 in1
) (1 l1
) (1 ip
) (1 ido
))
642 (f2cl-lib:fref ch-%data%
644 ((1 in2
) (1 l1
) (1 ido
) (1 ip
))
648 (f2cl-lib:fdo
(j 2 (f2cl-lib:int-add j
1))
651 (f2cl-lib:fdo
(i 2 (f2cl-lib:int-add i
1))
654 (f2cl-lib:fdo
(k 1 (f2cl-lib:int-add k
1))
657 (setf (f2cl-lib:fref cc-%data%
659 ((1 in1
) (1 l1
) (1 ip
) (1 ido
))
663 (f2cl-lib:fref wa-%data%
664 (i (f2cl-lib:int-sub j
1) 1)
672 (f2cl-lib:fref ch-%data%
674 ((1 in2
) (1 l1
) (1 ido
) (1 ip
))
677 (f2cl-lib:fref wa-%data%
678 (i (f2cl-lib:int-sub j
1) 2)
686 (f2cl-lib:fref ch-%data%
688 ((1 in2
) (1 l1
) (1 ido
) (1 ip
))
690 (setf (f2cl-lib:fref cc-%data%
692 ((1 in1
) (1 l1
) (1 ip
) (1 ido
))
696 (f2cl-lib:fref wa-%data%
697 (i (f2cl-lib:int-sub j
1) 1)
705 (f2cl-lib:fref ch-%data%
707 ((1 in2
) (1 l1
) (1 ido
) (1 ip
))
710 (f2cl-lib:fref wa-%data%
711 (i (f2cl-lib:int-sub j
1) 2)
719 (f2cl-lib:fref ch-%data%
721 ((1 in2
) (1 l1
) (1 ido
) (1 ip
))
728 (return (values nil nil nil nil nil nil nil nil nil nil nil nil
)))))
730 (in-package #:cl-user
)
731 #+#.
(cl:if
(cl:find-package
'#:f2cl
) '(and) '(or))
732 (eval-when (:load-toplevel
:compile-toplevel
:execute
)
733 (setf (gethash 'fortran-to-lisp
::c1fgkf
734 fortran-to-lisp
::*f2cl-function-info
*)
735 (fortran-to-lisp::make-f2cl-finfo
736 :arg-types
'((fortran-to-lisp::integer4
) (fortran-to-lisp::integer4
)
737 (fortran-to-lisp::integer4
) (fortran-to-lisp::integer4
)
738 (fortran-to-lisp::integer4
) (array double-float
(*))
739 (array double-float
(*)) (fortran-to-lisp::integer4
)
740 (array double-float
(*)) (array double-float
(*))
741 (fortran-to-lisp::integer4
) (array double-float
(*)))
742 :return-values
'(nil nil nil nil nil nil nil nil nil nil nil nil
)