;;; Compiled by f2cl version 2.0 beta 2002-05-06
;;; 
;;; Options: ((:prune-labels nil) (:auto-save t) (:relaxed-array-decls t)
;;;           (:coerce-assigns :as-needed) (:array-type ':simple-array)
;;;           (:array-slicing nil) (:declare-common nil)
;;;           (:float-format double-float))

(in-package "SLATEC")


(let ((zeror 0.0) (zeroi 0.0) (aic 1.2655121234846454))
  (declare (type double-float aic zeroi zeror))
  (defun zuoik (zr zi fnu kode ikflg n yr yi nuf tol elim alim)
    (declare (type (simple-array double-float (*)) yr yi)
             (type f2cl-lib:integer4 kode ikflg n nuf)
             (type double-float zr zi fnu tol elim alim))
    (prog ((cwrkr (make-array 16 :element-type 'double-float))
           (cwrki (make-array 16 :element-type 'double-float)) (i 0) (idum 0)
           (iform 0) (init 0) (nn 0) (nw 0) (aarg 0.0) (aphi 0.0) (argi 0.0)
           (argr 0.0) (asumi 0.0) (asumr 0.0) (ascle 0.0) (ax 0.0) (ay 0.0)
           (bsumi 0.0) (bsumr 0.0) (czi 0.0) (czr 0.0) (fnn 0.0) (gnn 0.0)
           (gnu 0.0) (phii 0.0) (phir 0.0) (rcz 0.0) (str 0.0) (sti 0.0)
           (sumi 0.0) (sumr 0.0) (zbi 0.0) (zbr 0.0) (zeta1i 0.0) (zeta1r 0.0)
           (zeta2i 0.0) (zeta2r 0.0) (zni 0.0) (znr 0.0) (zri 0.0) (zrr 0.0))
      (declare (type (simple-array double-float (16)) cwrkr cwrki)
               (type double-float zrr zri znr zni zeta2r zeta2i zeta1r zeta1i
                zbr zbi sumr sumi sti str rcz phir phii gnu gnn fnn czr czi
                bsumr bsumi ay ax ascle asumr asumi argr argi aphi aarg)
               (type f2cl-lib:integer4 nw nn init iform idum i))
      (setf nuf 0)
      (setf nn n)
      (setf zrr zr)
      (setf zri zi)
      (if (>= zr 0.0) (go label10))
      (setf zrr (- zr))
      (setf zri (- zi))
     label10
      (setf zbr zrr)
      (setf zbi zri)
      (setf ax (* (abs zr) 1.7321))
      (setf ay (coerce (abs zi) 'double-float))
      (setf iform 1)
      (if (> ay ax) (setf iform 2))
      (setf gnu (max fnu 1.0))
      (if (= ikflg 1) (go label20))
      (setf fnn (coerce (the f2cl-lib:integer4 nn) 'double-float))
      (setf gnn (- (+ fnu fnn) 1.0))
      (setf gnu (max gnn fnn))
     label20
      (if (= iform 2) (go label30))
      (setf init 0)
      (multiple-value-bind
          (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9 var-10
           var-11 var-12 var-13 var-14 var-15 var-16)
          (zunik zrr zri gnu ikflg 1 tol init phir phii zeta1r zeta1i zeta2r
           zeta2i sumr sumi cwrkr cwrki)
        (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-15 var-16))
        (setf init var-6)
        (setf phir var-7)
        (setf phii var-8)
        (setf zeta1r var-9)
        (setf zeta1i var-10)
        (setf zeta2r var-11)
        (setf zeta2i var-12)
        (setf sumr var-13)
        (setf sumi var-14))
      (setf czr (- zeta2r zeta1r))
      (setf czi (- zeta2i zeta1i))
      (go label50)
     label30
      (setf znr zri)
      (setf zni (- zrr))
      (if (> zi 0.0) (go label40))
      (setf znr (- znr))
     label40
      (multiple-value-bind
          (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9 var-10
           var-11 var-12 var-13 var-14 var-15 var-16)
          (zunhj znr zni gnu 1 tol phir phii argr argi zeta1r zeta1i zeta2r
           zeta2i asumr asumi bsumr bsumi)
        (declare (ignore var-0 var-1 var-2 var-3 var-4))
        (setf phir var-5)
        (setf phii var-6)
        (setf argr var-7)
        (setf argi var-8)
        (setf zeta1r var-9)
        (setf zeta1i var-10)
        (setf zeta2r var-11)
        (setf zeta2i var-12)
        (setf asumr var-13)
        (setf asumi var-14)
        (setf bsumr var-15)
        (setf bsumi var-16))
      (setf czr (- zeta2r zeta1r))
      (setf czi (- zeta2i zeta1i))
      (setf aarg (zabs argr argi))
     label50
      (if (= kode 1) (go label60))
      (setf czr (- czr zbr))
      (setf czi (- czi zbi))
     label60
      (if (= ikflg 1) (go label70))
      (setf czr (- czr))
      (setf czi (- czi))
     label70
      (setf aphi (zabs phir phii))
      (setf rcz czr)
      (if (> rcz elim) (go label210))
      (if (< rcz alim) (go label80))
      (setf rcz (+ rcz (f2cl-lib:flog aphi)))
      (if (= iform 2) (setf rcz (- rcz (* 0.25 (f2cl-lib:flog aarg)) aic)))
      (if (> rcz elim) (go label210))
      (go label130)
     label80
      (if (< rcz (- elim)) (go label90))
      (if (> rcz (- alim)) (go label130))
      (setf rcz (+ rcz (f2cl-lib:flog aphi)))
      (if (= iform 2) (setf rcz (- rcz (* 0.25 (f2cl-lib:flog aarg)) aic)))
      (if (> rcz (- elim)) (go label110))
     label90
      (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
                    ((> i nn) nil)
        (tagbody
          (f2cl-lib:fset (f2cl-lib:fref yr (i) ((1 n))) zeror)
          (f2cl-lib:fset (f2cl-lib:fref yi (i) ((1 n))) zeroi)
         label100))
      (setf nuf nn)
      (go end_label)
     label110
      (setf ascle (/ (* 1000.0 (f2cl-lib:d1mach 1)) tol))
      (multiple-value-bind
          (var-0 var-1 var-2 var-3 var-4)
          (zlog phir phii str sti idum)
        (declare (ignore var-0 var-1))
        (setf str var-2)
        (setf sti var-3)
        (setf idum var-4))
      (setf czr (+ czr str))
      (setf czi (+ czi sti))
      (if (= iform 1) (go label120))
      (multiple-value-bind
          (var-0 var-1 var-2 var-3 var-4)
          (zlog argr argi str sti idum)
        (declare (ignore var-0 var-1))
        (setf str var-2)
        (setf sti var-3)
        (setf idum var-4))
      (setf czr (- czr (* 0.25 str) aic))
      (setf czi (- czi (* 0.25 sti)))
     label120
      (setf ax (/ (exp rcz) tol))
      (setf ay czi)
      (setf czr (* ax (cos ay)))
      (setf czi (* ax (sin ay)))
      (multiple-value-bind
          (var-0 var-1 var-2 var-3 var-4)
          (zuchk czr czi nw ascle tol)
        (declare (ignore var-0 var-1 var-3 var-4))
        (setf nw var-2))
      (if (/= nw 0) (go label90))
     label130
      (if (= ikflg 2) (go end_label))
      (if (= n 1) (go end_label))
     label140
      (setf gnu (+ fnu (f2cl-lib:int-sub nn 1)))
      (if (= iform 2) (go label150))
      (setf init 0)
      (multiple-value-bind
          (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9 var-10
           var-11 var-12 var-13 var-14 var-15 var-16)
          (zunik zrr zri gnu ikflg 1 tol init phir phii zeta1r zeta1i zeta2r
           zeta2i sumr sumi cwrkr cwrki)
        (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-15 var-16))
        (setf init var-6)
        (setf phir var-7)
        (setf phii var-8)
        (setf zeta1r var-9)
        (setf zeta1i var-10)
        (setf zeta2r var-11)
        (setf zeta2i var-12)
        (setf sumr var-13)
        (setf sumi var-14))
      (setf czr (- zeta2r zeta1r))
      (setf czi (- zeta2i zeta1i))
      (go label160)
     label150
      (multiple-value-bind
          (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9 var-10
           var-11 var-12 var-13 var-14 var-15 var-16)
          (zunhj znr zni gnu 1 tol phir phii argr argi zeta1r zeta1i zeta2r
           zeta2i asumr asumi bsumr bsumi)
        (declare (ignore var-0 var-1 var-2 var-3 var-4))
        (setf phir var-5)
        (setf phii var-6)
        (setf argr var-7)
        (setf argi var-8)
        (setf zeta1r var-9)
        (setf zeta1i var-10)
        (setf zeta2r var-11)
        (setf zeta2i var-12)
        (setf asumr var-13)
        (setf asumi var-14)
        (setf bsumr var-15)
        (setf bsumi var-16))
      (setf czr (- zeta2r zeta1r))
      (setf czi (- zeta2i zeta1i))
      (setf aarg (zabs argr argi))
     label160
      (if (= kode 1) (go label170))
      (setf czr (- czr zbr))
      (setf czi (- czi zbi))
     label170
      (setf aphi (zabs phir phii))
      (setf rcz czr)
      (if (< rcz (- elim)) (go label180))
      (if (> rcz (- alim)) (go end_label))
      (setf rcz (+ rcz (f2cl-lib:flog aphi)))
      (if (= iform 2) (setf rcz (- rcz (* 0.25 (f2cl-lib:flog aarg)) aic)))
      (if (> rcz (- elim)) (go label190))
     label180
      (f2cl-lib:fset (f2cl-lib:fref yr (nn) ((1 n))) zeror)
      (f2cl-lib:fset (f2cl-lib:fref yi (nn) ((1 n))) zeroi)
      (setf nn (f2cl-lib:int-sub nn 1))
      (setf nuf (f2cl-lib:int-add nuf 1))
      (if (= nn 0) (go end_label))
      (go label140)
     label190
      (setf ascle (/ (* 1000.0 (f2cl-lib:d1mach 1)) tol))
      (multiple-value-bind
          (var-0 var-1 var-2 var-3 var-4)
          (zlog phir phii str sti idum)
        (declare (ignore var-0 var-1))
        (setf str var-2)
        (setf sti var-3)
        (setf idum var-4))
      (setf czr (+ czr str))
      (setf czi (+ czi sti))
      (if (= iform 1) (go label200))
      (multiple-value-bind
          (var-0 var-1 var-2 var-3 var-4)
          (zlog argr argi str sti idum)
        (declare (ignore var-0 var-1))
        (setf str var-2)
        (setf sti var-3)
        (setf idum var-4))
      (setf czr (- czr (* 0.25 str) aic))
      (setf czi (- czi (* 0.25 sti)))
     label200
      (setf ax (/ (exp rcz) tol))
      (setf ay czi)
      (setf czr (* ax (cos ay)))
      (setf czi (* ax (sin ay)))
      (multiple-value-bind
          (var-0 var-1 var-2 var-3 var-4)
          (zuchk czr czi nw ascle tol)
        (declare (ignore var-0 var-1 var-3 var-4))
        (setf nw var-2))
      (if (/= nw 0) (go label180))
      (go end_label)
     label210
      (setf nuf -1)
      (go end_label)
     end_label
      (return (values nil nil nil nil nil nil nil nil nuf nil nil nil)))))

