(defun aii (ind z ai aip ierr) (declare (type fixnum ind)) (declare (type complex z)) (declare (type complex ai)) (declare (type complex aip)) (declare (type fixnum ierr)) (prog ((z1 0.0d0) (z2 0.0d0) (z3 0.0d0) (zm 0.0d0) (w1 0.0d0) (w2 0.0d0) (w1m 0.0d0) (w2m 0.0d0) (e 0.0d0) (c1 0.0d0) (r 0.0d0) (b 0.0d0) (a 0.0d0) ) (declare (type complex z1)) (declare (type complex z2)) (declare (type complex z3)) (declare (type complex zm)) (declare (type complex w1)) (declare (type complex w2)) (declare (type complex w1m)) (declare (type complex w2m)) (declare (type complex e)) (declare (type double-float c1)) (declare (type double-float r)) (declare (type double-float b)) (declare (type double-float a)) (setq c1 0.1837763) (setf ierr 0) (setf a (real z)) (setf b (aimag z)) (setf r (cpabs a b)) (setf z1 (csqrt z)) (setf z2 (/ (* z1 z) 1.5)) (if (< (abs b) (* (* -1 5.0) a)) (go label10)) (multiple-value-setq (ind z2 w1 w2) (ka ind z2 w1 w2)) (setf ai (* (* c1 z1) w1)) (setf aip (* (* (* -1 c1) z) w2)) (go end_label) label10 (if (< (abs b) (* (* -1 1.74) a)) (go label30)) (if (>= r 8.2) (go label40)) label20 (setf zm (- z)) (setf z1 (csqrt zm)) (setf z3 (/ (* z1 zm) 1.5)) (multiple-value-setq (z3 w1 w2 w1m w2m) (ja z3 w1 w2 w1m w2m)) (setf ai (* (/ z1 3.0) (+ w1m w1))) (setf aip (* (/ z 3.0) (+ w2m (- w2)))) (if (= ind 0) (go end_label)) (setf e (cexp z2)) (setf ai (* ai e)) (setf aip (* aip e)) (go end_label) label30 (if (< r 7.4) (go label20)) label40 (multiple-value-setq (ind z ai aip ierr) (aia ind z ai aip ierr)) (go end_label) end_label (return (values ind z ai aip ierr)) ))