;;; Compiled by f2cl version 2.0 beta Date: 2007/05/04 17:29:50 
;;; Using Lisp CMU Common Lisp Snapshot 2007-05 (19D)
;;; 
;;; 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 (*)) yi yr)
             (type (f2cl-lib:integer4) nuf n ikflg kode)
             (type (double-float) alim elim tol fnu zi zr))
    (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)
           (log$ 0))
      (declare (type (integer) log$)
               (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 (abs zi))
      (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 (coerce (realpart (zabs argr argi)) 'double-float))
     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 (coerce (realpart (zabs phir phii)) 'double-float))
      (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
          (setf (f2cl-lib:fref yr (i) ((1 n))) zeror)
          (setf (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 (coerce (realpart (zabs argr argi)) 'double-float))
     label160
      (if (= kode 1) (go label170))
      (setf czr (- czr zbr))
      (setf czi (- czi zbi))
     label170
      (setf aphi (coerce (realpart (zabs phir phii)) 'double-float))
      (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
      (setf (f2cl-lib:fref yr (nn) ((1 n))) zeror)
      (setf (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)))))

(in-package #-gcl #:cl-user #+gcl "CL-USER")
#+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
(eval-when (:load-toplevel :compile-toplevel :execute)
  (setf (gethash 'fortran-to-lisp::zuoik fortran-to-lisp::*f2cl-function-info*)
          (fortran-to-lisp::make-f2cl-finfo
           :arg-types '((double-float) (double-float) (double-float)
                        (fortran-to-lisp::integer4) (fortran-to-lisp::integer4)
                        (fortran-to-lisp::integer4)
                        (simple-array double-float (*))
                        (simple-array double-float (*))
                        (fortran-to-lisp::integer4) (double-float)
                        (double-float) (double-float))
           :return-values '(nil nil nil nil nil nil nil nil
                            fortran-to-lisp::nuf nil nil nil)
           :calls '(fortran-to-lisp::zuchk fortran-to-lisp::zlog
                    fortran-to-lisp::d1mach fortran-to-lisp::zabs
                    fortran-to-lisp::zunhj fortran-to-lisp::zunik))))