(defun jmc (z i1 i2 i1m i2m) (declare (type complex z)) (declare (type complex i1)) (declare (type complex i2)) (declare (type complex i1m)) (declare (type complex i2m)) (prog ((m 0.0d0) (ia1 0.0d0) (ia2 0.0d0) (ia3 0.0d0) (ib1 0.0d0) (ib2 0.0d0) (ib3 0.0d0) (sz 0.0d0) (zh 0.0d0) (e 0.0d0) (cf1 0.0d0) (cf2 0.0d0) (cf3 0.0d0) (cf4 0.0d0) (cfb 0.0d0) (cfa 0.0d0) (i 0) (n1 0) (n 0) (c2 0.0d0) (cn2 0.0d0) (c1 0.0d0) (cn1 0.0d0) (an 0.0d0) (b 0.0d0) (a 0.0d0) ) (declare (type float m)) (declare (type complex ia1)) (declare (type complex ia2)) (declare (type complex ia3)) (declare (type complex ib1)) (declare (type complex ib2)) (declare (type complex ib3)) (declare (type complex sz)) (declare (type complex zh)) (declare (type complex e)) (declare (type complex cf1)) (declare (type complex cf2)) (declare (type complex cf3)) (declare (type complex cf4)) (declare (type double-float cfb)) (declare (type double-float cfa)) (declare (type fixnum i)) (declare (type fixnum n1)) (declare (type fixnum n)) (declare (type double-float c2)) (declare (type double-float cn2)) (declare (type double-float c1)) (declare (type double-float cn1)) (declare (type double-float an)) (declare (type double-float b)) (declare (type double-float a)) (setq c1 0.33333334) (setq c2 0.6666667) (setq gm1 0.8929795) (setq gm2 0.9027453) (setf zh (* 0.5 z)) (setf sz (* zh zh)) (setf a (real zh)) (setf b (aimag zh)) (setf an (aint (+ (* a a) (* b b)))) (setf cn1 (+ c1 an)) (setf cn2 (+ c2 an)) (multiple-value-setq (z cn1 ia1) (bjm z cn1 ia1)) (multiple-value-setq (z dummy_var ia2) (bjm z (+ cn1 1.0) ia2)) (multiple-value-setq (z cn2 ib1) (bjm z cn2 ib1)) (multiple-value-setq (z dummy_var ib2) (bjm z (+ cn2 1.0) ib2)) (setf n an) (setf n1 (+ n 1)) (setf m an) (fdo ((i 1 (+ i 1))) ((> i n1) nil) (tagbody (setf ia3 ia2) (setf ia2 ia1) (setf ib3 ib2) (setf ib2 ib1) (setf cfa (* (+ m c1) (+ (+ m c1) 1.0))) (setf cfb (* (+ m c2) (+ (+ m c2) 1.0))) (setf m (+ m (- 1.0))) (setf ia1 (+ ia2 (* (* -1 (/ sz cfa)) ia3))) (setf ib1 (+ ib2 (* (* -1 (/ sz cfb)) ib3))) )) (setf e (cexp (* c1 (clog zh)))) (setf cf1 (/ e gm1)) (setf cf2 (/ (* e e) gm2)) (setf cf3 (/ (* c2 cf2) zh)) (setf cf4 (/ (* c1 cf1) zh)) (setf i1 (* cf1 ia2)) (setf i2 (* cf2 ib2)) (setf i1m (* cf3 ib1)) (setf i2m (* cf4 ia1)) (return (values z i1 i2 i1m i2m)) ))