(defun rffti1 (n wa ifac) (declare (type fixnum n)) (declare (type (simple-array float (*)) wa)) (declare (type (simple-array float (*)) ifac)) (prog ((ntryh (make-array '(4) :element-type 'fixnum)) (arg 0.0d0) (ii 0) (fi 0.0d0) (argld 0.0d0) (ipm 0) (ido 0) (l2 0) (ld 0) (ip 0) (k1 0) (l1 0) (nfm1 0) (is 0) (argh 0.0d0) (tpi 0.0d0) (ib 0) (i 0) (nr 0) (nq 0) (ntry 0) (j 0) (nf 0) (nl 0) ) (declare (type (simple-array fixnum (*)) ntryh)) (declare (type double-float arg)) (declare (type fixnum ii)) (declare (type double-float fi)) (declare (type double-float argld)) (declare (type fixnum ipm)) (declare (type fixnum ido)) (declare (type fixnum l2)) (declare (type fixnum ld)) (declare (type fixnum ip)) (declare (type fixnum k1)) (declare (type fixnum l1)) (declare (type fixnum nfm1)) (declare (type fixnum is)) (declare (type double-float argh)) (declare (type double-float tpi)) (declare (type fixnum ib)) (declare (type fixnum i)) (declare (type fixnum nr)) (declare (type fixnum nq)) (declare (type fixnum ntry)) (declare (type fixnum j)) (declare (type fixnum nf)) (declare (type fixnum nl)) (replace ntryh '(4 2 3 5) :end 3) (setf nl n) (setf nf 0) (setf j 0) label101 (setf j (+ j 1)) (arithmetic-if (+ j (- 4)) (go label102) (go label102) (go label103)) label102 (setf ntry (fref ntryh j)) (go label104) label103 (setf ntry (+ ntry 2)) label104 (setf nq (/ nl ntry)) (setf nr (+ nl (* (* -1 ntry) nq))) (arithmetic-if nr (go label101) (go label105) (go label101)) label105 (setf nf (+ nf 1)) (fset (fref ifac (+ nf 2)) ntry) (setf nl nq) (if (/= ntry 2) (go label107)) (if (= nf 1) (go label107)) (fdo ((i 2 (+ i 1))) ((> i nf) nil) (tagbody (setf ib (+ (+ nf (- i)) 2)) (fset (fref ifac (+ ib 2)) (fref ifac (+ ib 1))) )) (fset (fref ifac 3) 2) label107 (if (/= nl 1) (go label104)) (fset (fref ifac 1) n) (fset (fref ifac 2) nf) (setf tpi 6.2831855) (setf argh (/ tpi (float n))) (setf is 0) (setf nfm1 (+ nf (- 1))) (setf l1 1) (if (= nfm1 0) (go end_label)) (fdo ((k1 1 (+ k1 1))) ((> k1 nfm1) nil) (tagbody (setf ip (fref ifac (+ k1 2))) (setf ld 0) (setf l2 (* l1 ip)) (setf ido (/ n l2)) (setf ipm (+ ip (- 1))) (fdo ((j 1 (+ j 1))) ((> j ipm) nil) (tagbody (setf ld (+ ld l1)) (setf i is) (setf argld (* (float ld) argh)) (setf fi 0.0) (fdo ((ii 3 (+ ii 2))) ((> ii ido) nil) (tagbody (setf i (+ i 2)) (setf fi (+ fi 1.0)) (setf arg (* fi argld)) (fset (fref wa (+ i (- 1))) (cos arg)) (fset (fref wa i) (sin arg)) )) (setf is (+ is ido)) )) (setf l1 l2) )) (go end_label) end_label (return (values n wa ifac)) ))