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 mradbg (m ido ip l1 idl1 cc c1 c2 im1 in1 ch ch2 im2 in2 wa
)
21 (declare (type (array double-float
(*)) wa ch2 ch c2 c1 cc
)
22 (type (f2cl-lib:integer4
) in2 im2 in1 im1 idl1 l1 ip ido m
))
23 (f2cl-lib:with-multi-array-data
24 ((cc double-float cc-%data% cc-%offset%
)
25 (c1 double-float c1-%data% c1-%offset%
)
26 (c2 double-float c2-%data% c2-%offset%
)
27 (ch double-float ch-%data% ch-%offset%
)
28 (ch2 double-float ch2-%data% ch2-%offset%
)
29 (wa double-float wa-%data% wa-%offset%
))
30 (prog ((idij 0) (is 0) (ar2h 0.0d0
) (ai2 0.0d0
) (ar2 0.0d0
) (ds2 0.0d0
)
31 (dc2 0.0d0
) (ik 0) (ar1h 0.0d0
) (lc 0) (l 0) (ai1 0.0d0
) (ar1 0.0d0
)
32 (ic 0) (j2 0) (jc 0) (j 0) (m1 0) (m2 0) (i 0) (k 0) (ipph 0)
33 (ipp2 0) (nbd 0) (idp2 0) (dsp 0.0d0
) (dcp 0.0d0
) (arg 0.0d0
)
34 (tpi 0.0d0
) (m2s 0) (m1d 0))
35 (declare (type (double-float) tpi arg dcp dsp ar1 ai1 ar1h dc2 ds2 ar2
37 (type (f2cl-lib:integer4
) m1d m2s idp2 nbd ipp2 ipph k i m2 m1 j
38 jc j2 ic l lc ik is idij
))
40 (f2cl-lib:int-add
(f2cl-lib:int-mul
(f2cl-lib:int-sub m
1) im1
)
42 (setf m2s
(f2cl-lib:int-sub
1 im2
))
43 (setf tpi
(* 2.0d0
4.0d0
(atan 1.0d0
)))
44 (setf arg
(/ tpi
(f2cl-lib:ffloat ip
)))
47 (setf idp2
(f2cl-lib:int-add ido
2))
48 (setf nbd
(the f2cl-lib
:integer4
(truncate (- ido
1) 2)))
49 (setf ipp2
(f2cl-lib:int-add ip
2))
50 (setf ipph
(the f2cl-lib
:integer4
(truncate (+ ip
1) 2)))
51 (if (< ido l1
) (go label103
))
52 (f2cl-lib:fdo
(k 1 (f2cl-lib:int-add k
1))
55 (f2cl-lib:fdo
(i 1 (f2cl-lib:int-add i
1))
59 (f2cl-lib:fdo
(m1 1 (f2cl-lib:int-add m1 im1
))
62 (setf m2
(f2cl-lib:int-add m2 im2
))
63 (setf (f2cl-lib:fref ch-%data%
65 ((1 in2
) (1 ido
) (1 l1
) (1 ip
))
67 (f2cl-lib:fref cc-%data%
69 ((1 in1
) (1 ido
) (1 ip
) (1 l1
))
76 (f2cl-lib:fdo
(i 1 (f2cl-lib:int-add i
1))
79 (f2cl-lib:fdo
(k 1 (f2cl-lib:int-add k
1))
83 (f2cl-lib:fdo
(m1 1 (f2cl-lib:int-add m1 im1
))
86 (setf m2
(f2cl-lib:int-add m2 im2
))
87 (setf (f2cl-lib:fref ch-%data%
89 ((1 in2
) (1 ido
) (1 l1
) (1 ip
))
91 (f2cl-lib:fref cc-%data%
93 ((1 in1
) (1 ido
) (1 ip
) (1 l1
))
99 (f2cl-lib:fdo
(j 2 (f2cl-lib:int-add j
1))
102 (setf jc
(f2cl-lib:int-sub ipp2 j
))
103 (setf j2
(f2cl-lib:int-add j j
))
104 (f2cl-lib:fdo
(k 1 (f2cl-lib:int-add k
1))
108 (f2cl-lib:fdo
(m1 1 (f2cl-lib:int-add m1 im1
))
111 (setf m2
(f2cl-lib:int-add m2 im2
))
112 (setf (f2cl-lib:fref ch-%data%
114 ((1 in2
) (1 ido
) (1 l1
) (1 ip
))
117 (f2cl-lib:fref cc-%data%
118 (m1 ido
(f2cl-lib:int-sub j2
2) k
)
119 ((1 in1
) (1 ido
) (1 ip
) (1 l1
))
121 (f2cl-lib:fref cc-%data%
122 (m1 ido
(f2cl-lib:int-sub j2
2) k
)
123 ((1 in1
) (1 ido
) (1 ip
) (1 l1
))
125 (setf (f2cl-lib:fref ch-%data%
127 ((1 in2
) (1 ido
) (1 l1
) (1 ip
))
130 (f2cl-lib:fref cc-%data%
131 (m1 1 (f2cl-lib:int-sub j2
1) k
)
132 ((1 in1
) (1 ido
) (1 ip
) (1 l1
))
134 (f2cl-lib:fref cc-%data%
135 (m1 1 (f2cl-lib:int-sub j2
1) k
)
136 ((1 in1
) (1 ido
) (1 ip
) (1 l1
))
141 (if (= ido
1) (go label116
))
142 (if (< nbd l1
) (go label112
))
143 (f2cl-lib:fdo
(j 2 (f2cl-lib:int-add j
1))
146 (setf jc
(f2cl-lib:int-sub ipp2 j
))
147 (f2cl-lib:fdo
(k 1 (f2cl-lib:int-add k
1))
150 (f2cl-lib:fdo
(i 3 (f2cl-lib:int-add i
2))
153 (setf ic
(f2cl-lib:int-sub idp2 i
))
155 (f2cl-lib:fdo
(m1 1 (f2cl-lib:int-add m1 im1
))
158 (setf m2
(f2cl-lib:int-add m2 im2
))
159 (setf (f2cl-lib:fref ch-%data%
160 (m2 (f2cl-lib:int-sub i
1) k j
)
161 ((1 in2
) (1 ido
) (1 l1
) (1 ip
))
164 (f2cl-lib:fref cc-%data%
165 (m1 (f2cl-lib:int-sub i
1)
167 (f2cl-lib:int-mul
2 j
)
170 ((1 in1
) (1 ido
) (1 ip
) (1 l1
))
172 (f2cl-lib:fref cc-%data%
173 (m1 (f2cl-lib:int-sub ic
1)
175 (f2cl-lib:int-mul
2 j
)
178 ((1 in1
) (1 ido
) (1 ip
) (1 l1
))
180 (setf (f2cl-lib:fref ch-%data%
181 (m2 (f2cl-lib:int-sub i
1) k jc
)
182 ((1 in2
) (1 ido
) (1 l1
) (1 ip
))
185 (f2cl-lib:fref cc-%data%
186 (m1 (f2cl-lib:int-sub i
1)
188 (f2cl-lib:int-mul
2 j
)
191 ((1 in1
) (1 ido
) (1 ip
) (1 l1
))
193 (f2cl-lib:fref cc-%data%
194 (m1 (f2cl-lib:int-sub ic
1)
196 (f2cl-lib:int-mul
2 j
)
199 ((1 in1
) (1 ido
) (1 ip
) (1 l1
))
201 (setf (f2cl-lib:fref ch-%data%
203 ((1 in2
) (1 ido
) (1 l1
) (1 ip
))
206 (f2cl-lib:fref cc-%data%
209 (f2cl-lib:int-mul
2 j
)
212 ((1 in1
) (1 ido
) (1 ip
) (1 l1
))
214 (f2cl-lib:fref cc-%data%
217 (f2cl-lib:int-mul
2 j
)
220 ((1 in1
) (1 ido
) (1 ip
) (1 l1
))
222 (setf (f2cl-lib:fref ch-%data%
224 ((1 in2
) (1 ido
) (1 l1
) (1 ip
))
227 (f2cl-lib:fref cc-%data%
230 (f2cl-lib:int-mul
2 j
)
233 ((1 in1
) (1 ido
) (1 ip
) (1 l1
))
235 (f2cl-lib:fref cc-%data%
238 (f2cl-lib:int-mul
2 j
)
241 ((1 in1
) (1 ido
) (1 ip
) (1 l1
))
249 (f2cl-lib:fdo
(j 2 (f2cl-lib:int-add j
1))
252 (setf jc
(f2cl-lib:int-sub ipp2 j
))
253 (f2cl-lib:fdo
(i 3 (f2cl-lib:int-add i
2))
256 (setf ic
(f2cl-lib:int-sub idp2 i
))
257 (f2cl-lib:fdo
(k 1 (f2cl-lib:int-add k
1))
261 (f2cl-lib:fdo
(m1 1 (f2cl-lib:int-add m1 im1
))
264 (setf m2
(f2cl-lib:int-add m2 im2
))
265 (setf (f2cl-lib:fref ch-%data%
266 (m2 (f2cl-lib:int-sub i
1) k j
)
267 ((1 in2
) (1 ido
) (1 l1
) (1 ip
))
270 (f2cl-lib:fref cc-%data%
271 (m1 (f2cl-lib:int-sub i
1)
273 (f2cl-lib:int-mul
2 j
)
276 ((1 in1
) (1 ido
) (1 ip
) (1 l1
))
278 (f2cl-lib:fref cc-%data%
279 (m1 (f2cl-lib:int-sub ic
1)
281 (f2cl-lib:int-mul
2 j
)
284 ((1 in1
) (1 ido
) (1 ip
) (1 l1
))
286 (setf (f2cl-lib:fref ch-%data%
287 (m2 (f2cl-lib:int-sub i
1) k jc
)
288 ((1 in2
) (1 ido
) (1 l1
) (1 ip
))
291 (f2cl-lib:fref cc-%data%
292 (m1 (f2cl-lib:int-sub i
1)
294 (f2cl-lib:int-mul
2 j
)
297 ((1 in1
) (1 ido
) (1 ip
) (1 l1
))
299 (f2cl-lib:fref cc-%data%
300 (m1 (f2cl-lib:int-sub ic
1)
302 (f2cl-lib:int-mul
2 j
)
305 ((1 in1
) (1 ido
) (1 ip
) (1 l1
))
307 (setf (f2cl-lib:fref ch-%data%
309 ((1 in2
) (1 ido
) (1 l1
) (1 ip
))
312 (f2cl-lib:fref cc-%data%
315 (f2cl-lib:int-mul
2 j
)
318 ((1 in1
) (1 ido
) (1 ip
) (1 l1
))
320 (f2cl-lib:fref cc-%data%
323 (f2cl-lib:int-mul
2 j
)
326 ((1 in1
) (1 ido
) (1 ip
) (1 l1
))
328 (setf (f2cl-lib:fref ch-%data%
330 ((1 in2
) (1 ido
) (1 l1
) (1 ip
))
333 (f2cl-lib:fref cc-%data%
336 (f2cl-lib:int-mul
2 j
)
339 ((1 in1
) (1 ido
) (1 ip
) (1 l1
))
341 (f2cl-lib:fref cc-%data%
344 (f2cl-lib:int-mul
2 j
)
347 ((1 in1
) (1 ido
) (1 ip
) (1 l1
))
356 (f2cl-lib:fdo
(l 2 (f2cl-lib:int-add l
1))
359 (setf lc
(f2cl-lib:int-sub ipp2 l
))
360 (setf ar1h
(- (* dcp ar1
) (* dsp ai1
)))
361 (setf ai1
(+ (* dcp ai1
) (* dsp ar1
)))
363 (f2cl-lib:fdo
(ik 1 (f2cl-lib:int-add ik
1))
367 (f2cl-lib:fdo
(m1 1 (f2cl-lib:int-add m1 im1
))
370 (setf m2
(f2cl-lib:int-add m2 im2
))
371 (setf (f2cl-lib:fref c2-%data%
373 ((1 in1
) (1 idl1
) (1 ip
))
376 (f2cl-lib:fref ch2-%data%
378 ((1 in2
) (1 idl1
) (1 ip
))
381 (f2cl-lib:fref ch2-%data%
383 ((1 in2
) (1 idl1
) (1 ip
))
385 (setf (f2cl-lib:fref c2-%data%
387 ((1 in1
) (1 idl1
) (1 ip
))
390 (f2cl-lib:fref ch2-%data%
392 ((1 in2
) (1 idl1
) (1 ip
))
400 (f2cl-lib:fdo
(j 3 (f2cl-lib:int-add j
1))
403 (setf jc
(f2cl-lib:int-sub ipp2 j
))
404 (setf ar2h
(- (* dc2 ar2
) (* ds2 ai2
)))
405 (setf ai2
(+ (* dc2 ai2
) (* ds2 ar2
)))
407 (f2cl-lib:fdo
(ik 1 (f2cl-lib:int-add ik
1))
411 (f2cl-lib:fdo
(m1 1 (f2cl-lib:int-add m1 im1
))
414 (setf m2
(f2cl-lib:int-add m2 im2
))
415 (setf (f2cl-lib:fref c2-%data%
417 ((1 in1
) (1 idl1
) (1 ip
))
420 (f2cl-lib:fref c2-%data%
422 ((1 in1
) (1 idl1
) (1 ip
))
425 (f2cl-lib:fref ch2-%data%
427 ((1 in2
) (1 idl1
) (1 ip
))
429 (setf (f2cl-lib:fref c2-%data%
431 ((1 in1
) (1 idl1
) (1 ip
))
434 (f2cl-lib:fref c2-%data%
436 ((1 in1
) (1 idl1
) (1 ip
))
439 (f2cl-lib:fref ch2-%data%
441 ((1 in2
) (1 idl1
) (1 ip
))
447 (f2cl-lib:fdo
(j 2 (f2cl-lib:int-add j
1))
450 (f2cl-lib:fdo
(ik 1 (f2cl-lib:int-add ik
1))
454 (f2cl-lib:fdo
(m1 1 (f2cl-lib:int-add m1 im1
))
457 (setf m2
(f2cl-lib:int-add m2 im2
))
458 (setf (f2cl-lib:fref ch2-%data%
460 ((1 in2
) (1 idl1
) (1 ip
))
463 (f2cl-lib:fref ch2-%data%
465 ((1 in2
) (1 idl1
) (1 ip
))
467 (f2cl-lib:fref ch2-%data%
469 ((1 in2
) (1 idl1
) (1 ip
))
474 (f2cl-lib:fdo
(j 2 (f2cl-lib:int-add j
1))
477 (setf jc
(f2cl-lib:int-sub ipp2 j
))
478 (f2cl-lib:fdo
(k 1 (f2cl-lib:int-add k
1))
482 (f2cl-lib:fdo
(m1 1 (f2cl-lib:int-add m1 im1
))
485 (setf m2
(f2cl-lib:int-add m2 im2
))
486 (setf (f2cl-lib:fref ch-%data%
488 ((1 in2
) (1 ido
) (1 l1
) (1 ip
))
491 (f2cl-lib:fref c1-%data%
493 ((1 in1
) (1 ido
) (1 l1
) (1 ip
))
495 (f2cl-lib:fref c1-%data%
497 ((1 in1
) (1 ido
) (1 l1
) (1 ip
))
499 (setf (f2cl-lib:fref ch-%data%
501 ((1 in2
) (1 ido
) (1 l1
) (1 ip
))
504 (f2cl-lib:fref c1-%data%
506 ((1 in1
) (1 ido
) (1 l1
) (1 ip
))
508 (f2cl-lib:fref c1-%data%
510 ((1 in1
) (1 ido
) (1 l1
) (1 ip
))
515 (if (= ido
1) (go label132
))
516 (if (< nbd l1
) (go label128
))
517 (f2cl-lib:fdo
(j 2 (f2cl-lib:int-add j
1))
520 (setf jc
(f2cl-lib:int-sub ipp2 j
))
521 (f2cl-lib:fdo
(k 1 (f2cl-lib:int-add k
1))
524 (f2cl-lib:fdo
(i 3 (f2cl-lib:int-add i
2))
528 (f2cl-lib:fdo
(m1 1 (f2cl-lib:int-add m1 im1
))
531 (setf m2
(f2cl-lib:int-add m2 im2
))
532 (setf (f2cl-lib:fref ch-%data%
533 (m2 (f2cl-lib:int-sub i
1) k j
)
534 ((1 in2
) (1 ido
) (1 l1
) (1 ip
))
537 (f2cl-lib:fref c1-%data%
538 (m1 (f2cl-lib:int-sub i
1) k j
)
539 ((1 in1
) (1 ido
) (1 l1
) (1 ip
))
541 (f2cl-lib:fref c1-%data%
543 ((1 in1
) (1 ido
) (1 l1
) (1 ip
))
545 (setf (f2cl-lib:fref ch-%data%
546 (m2 (f2cl-lib:int-sub i
1) k jc
)
547 ((1 in2
) (1 ido
) (1 l1
) (1 ip
))
550 (f2cl-lib:fref c1-%data%
551 (m1 (f2cl-lib:int-sub i
1) k j
)
552 ((1 in1
) (1 ido
) (1 l1
) (1 ip
))
554 (f2cl-lib:fref c1-%data%
556 ((1 in1
) (1 ido
) (1 l1
) (1 ip
))
558 (setf (f2cl-lib:fref ch-%data%
560 ((1 in2
) (1 ido
) (1 l1
) (1 ip
))
563 (f2cl-lib:fref c1-%data%
565 ((1 in1
) (1 ido
) (1 l1
) (1 ip
))
567 (f2cl-lib:fref c1-%data%
568 (m1 (f2cl-lib:int-sub i
1) k jc
)
569 ((1 in1
) (1 ido
) (1 l1
) (1 ip
))
571 (setf (f2cl-lib:fref ch-%data%
573 ((1 in2
) (1 ido
) (1 l1
) (1 ip
))
576 (f2cl-lib:fref c1-%data%
578 ((1 in1
) (1 ido
) (1 l1
) (1 ip
))
580 (f2cl-lib:fref c1-%data%
581 (m1 (f2cl-lib:int-sub i
1) k jc
)
582 ((1 in1
) (1 ido
) (1 l1
) (1 ip
))
590 (f2cl-lib:fdo
(j 2 (f2cl-lib:int-add j
1))
593 (setf jc
(f2cl-lib:int-sub ipp2 j
))
594 (f2cl-lib:fdo
(i 3 (f2cl-lib:int-add i
2))
597 (f2cl-lib:fdo
(k 1 (f2cl-lib:int-add k
1))
601 (f2cl-lib:fdo
(m1 1 (f2cl-lib:int-add m1 im1
))
604 (setf m2
(f2cl-lib:int-add m2 im2
))
605 (setf (f2cl-lib:fref ch-%data%
606 (m2 (f2cl-lib:int-sub i
1) k j
)
607 ((1 in2
) (1 ido
) (1 l1
) (1 ip
))
610 (f2cl-lib:fref c1-%data%
611 (m1 (f2cl-lib:int-sub i
1) k j
)
612 ((1 in1
) (1 ido
) (1 l1
) (1 ip
))
614 (f2cl-lib:fref c1-%data%
616 ((1 in1
) (1 ido
) (1 l1
) (1 ip
))
618 (setf (f2cl-lib:fref ch-%data%
619 (m2 (f2cl-lib:int-sub i
1) k jc
)
620 ((1 in2
) (1 ido
) (1 l1
) (1 ip
))
623 (f2cl-lib:fref c1-%data%
624 (m1 (f2cl-lib:int-sub i
1) k j
)
625 ((1 in1
) (1 ido
) (1 l1
) (1 ip
))
627 (f2cl-lib:fref c1-%data%
629 ((1 in1
) (1 ido
) (1 l1
) (1 ip
))
631 (setf (f2cl-lib:fref ch-%data%
633 ((1 in2
) (1 ido
) (1 l1
) (1 ip
))
636 (f2cl-lib:fref c1-%data%
638 ((1 in1
) (1 ido
) (1 l1
) (1 ip
))
640 (f2cl-lib:fref c1-%data%
641 (m1 (f2cl-lib:int-sub i
1) k jc
)
642 ((1 in1
) (1 ido
) (1 l1
) (1 ip
))
644 (setf (f2cl-lib:fref ch-%data%
646 ((1 in2
) (1 ido
) (1 l1
) (1 ip
))
649 (f2cl-lib:fref c1-%data%
651 ((1 in1
) (1 ido
) (1 l1
) (1 ip
))
653 (f2cl-lib:fref c1-%data%
654 (m1 (f2cl-lib:int-sub i
1) k jc
)
655 ((1 in1
) (1 ido
) (1 l1
) (1 ip
))
662 (if (= ido
1) (go end_label
))
663 (f2cl-lib:fdo
(ik 1 (f2cl-lib:int-add ik
1))
667 (f2cl-lib:fdo
(m1 1 (f2cl-lib:int-add m1 im1
))
670 (setf m2
(f2cl-lib:int-add m2 im2
))
671 (setf (f2cl-lib:fref c2-%data%
673 ((1 in1
) (1 idl1
) (1 ip
))
675 (f2cl-lib:fref ch2-%data%
677 ((1 in2
) (1 idl1
) (1 ip
))
681 (f2cl-lib:fdo
(j 2 (f2cl-lib:int-add j
1))
684 (f2cl-lib:fdo
(k 1 (f2cl-lib:int-add k
1))
688 (f2cl-lib:fdo
(m1 1 (f2cl-lib:int-add m1 im1
))
691 (setf m2
(f2cl-lib:int-add m2 im2
))
692 (setf (f2cl-lib:fref c1-%data%
694 ((1 in1
) (1 ido
) (1 l1
) (1 ip
))
696 (f2cl-lib:fref ch-%data%
698 ((1 in2
) (1 ido
) (1 l1
) (1 ip
))
703 (if (> nbd l1
) (go label139
))
704 (setf is
(f2cl-lib:int-sub ido
))
705 (f2cl-lib:fdo
(j 2 (f2cl-lib:int-add j
1))
708 (setf is
(f2cl-lib:int-add is ido
))
710 (f2cl-lib:fdo
(i 3 (f2cl-lib:int-add i
2))
713 (setf idij
(f2cl-lib:int-add idij
2))
714 (f2cl-lib:fdo
(k 1 (f2cl-lib:int-add k
1))
718 (f2cl-lib:fdo
(m1 1 (f2cl-lib:int-add m1 im1
))
721 (setf m2
(f2cl-lib:int-add m2 im2
))
722 (setf (f2cl-lib:fref c1-%data%
723 (m1 (f2cl-lib:int-sub i
1) k j
)
724 ((1 in1
) (1 ido
) (1 l1
) (1 ip
))
728 (f2cl-lib:fref wa-%data%
729 ((f2cl-lib:int-sub idij
1))
732 (f2cl-lib:fref ch-%data%
733 (m2 (f2cl-lib:int-sub i
1) k j
)
734 ((1 in2
) (1 ido
) (1 l1
) (1 ip
))
737 (f2cl-lib:fref wa-%data%
741 (f2cl-lib:fref ch-%data%
743 ((1 in2
) (1 ido
) (1 l1
) (1 ip
))
745 (setf (f2cl-lib:fref c1-%data%
747 ((1 in1
) (1 ido
) (1 l1
) (1 ip
))
751 (f2cl-lib:fref wa-%data%
752 ((f2cl-lib:int-sub idij
1))
755 (f2cl-lib:fref ch-%data%
757 ((1 in2
) (1 ido
) (1 l1
) (1 ip
))
760 (f2cl-lib:fref wa-%data%
764 (f2cl-lib:fref ch-%data%
765 (m2 (f2cl-lib:int-sub i
1) k j
)
766 ((1 in2
) (1 ido
) (1 l1
) (1 ip
))
774 (setf is
(f2cl-lib:int-sub ido
))
775 (f2cl-lib:fdo
(j 2 (f2cl-lib:int-add j
1))
778 (setf is
(f2cl-lib:int-add is ido
))
779 (f2cl-lib:fdo
(k 1 (f2cl-lib:int-add k
1))
783 (f2cl-lib:fdo
(i 3 (f2cl-lib:int-add i
2))
786 (setf idij
(f2cl-lib:int-add idij
2))
788 (f2cl-lib:fdo
(m1 1 (f2cl-lib:int-add m1 im1
))
791 (setf m2
(f2cl-lib:int-add m2 im2
))
792 (setf (f2cl-lib:fref c1-%data%
793 (m1 (f2cl-lib:int-sub i
1) k j
)
794 ((1 in1
) (1 ido
) (1 l1
) (1 ip
))
798 (f2cl-lib:fref wa-%data%
799 ((f2cl-lib:int-sub idij
1))
802 (f2cl-lib:fref ch-%data%
803 (m2 (f2cl-lib:int-sub i
1) k j
)
804 ((1 in2
) (1 ido
) (1 l1
) (1 ip
))
807 (f2cl-lib:fref wa-%data%
811 (f2cl-lib:fref ch-%data%
813 ((1 in2
) (1 ido
) (1 l1
) (1 ip
))
815 (setf (f2cl-lib:fref c1-%data%
817 ((1 in1
) (1 ido
) (1 l1
) (1 ip
))
821 (f2cl-lib:fref wa-%data%
822 ((f2cl-lib:int-sub idij
1))
825 (f2cl-lib:fref ch-%data%
827 ((1 in2
) (1 ido
) (1 l1
) (1 ip
))
830 (f2cl-lib:fref wa-%data%
834 (f2cl-lib:fref ch-%data%
835 (m2 (f2cl-lib:int-sub i
1) k j
)
836 ((1 in2
) (1 ido
) (1 l1
) (1 ip
))
846 (values nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
)))))
848 (in-package #:cl-user
)
849 #+#.
(cl:if
(cl:find-package
'#:f2cl
) '(and) '(or))
850 (eval-when (:load-toplevel
:compile-toplevel
:execute
)
851 (setf (gethash 'fortran-to-lisp
::mradbg
852 fortran-to-lisp
::*f2cl-function-info
*)
853 (fortran-to-lisp::make-f2cl-finfo
854 :arg-types
'((fortran-to-lisp::integer4
) (fortran-to-lisp::integer4
)
855 (fortran-to-lisp::integer4
) (fortran-to-lisp::integer4
)
856 (fortran-to-lisp::integer4
) (array double-float
(*))
857 (array double-float
(*)) (array double-float
(*))
858 (fortran-to-lisp::integer4
) (fortran-to-lisp::integer4
)
859 (array double-float
(*)) (array double-float
(*))
860 (fortran-to-lisp::integer4
) (fortran-to-lisp::integer4
)
861 (array double-float
(*)))
862 :return-values
'(nil nil nil nil nil nil nil nil nil nil nil nil nil