;;; 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 ((tth 0.6666666666666666)
      (c1 0.3550280538878172)
      (c2 0.2588194037928068)
      (coef 0.18377629847393068)
      (zeror 0.0)
      (zeroi 0.0)
      (coner 1.0)
      (conei 0.0))
  (declare (type (double-float) conei coner zeroi zeror coef c2 c1 tth))
  (defun zairy (zr zi id kode air aii nz ierr)
    (declare (type (f2cl-lib:integer4) ierr nz kode id)
             (type (double-float) aii air zi zr))
    (prog ((cyr (make-array 1 :element-type 'double-float))
           (cyi (make-array 1 :element-type 'double-float)) (iflag 0) (k 0)
           (k1 0) (k2 0) (mr 0) (nn 0) (aa 0.0) (ad 0.0) (ak 0.0) (alim 0.0)
           (atrm 0.0) (az 0.0) (az3 0.0) (bk 0.0) (cc 0.0) (ck 0.0) (csqi 0.0)
           (csqr 0.0) (dig 0.0) (dk 0.0) (d1 0.0) (d2 0.0) (elim 0.0) (fid 0.0)
           (fnu 0.0) (ptr 0.0) (rl 0.0) (r1m5 0.0) (sfac 0.0) (sti 0.0)
           (str 0.0) (s1i 0.0) (s1r 0.0) (s2i 0.0) (s2r 0.0) (tol 0.0)
           (trm1i 0.0) (trm1r 0.0) (trm2i 0.0) (trm2r 0.0) (ztai 0.0)
           (ztar 0.0) (z3i 0.0) (z3r 0.0) (alaz 0.0) (bb 0.0))
      (declare (type (simple-array double-float (1)) cyr cyi)
               (type (double-float) bb alaz z3r z3i ztar ztai trm2r trm2i trm1r
                                    trm1i tol s2r s2i s1r s1i str sti sfac r1m5
                                    rl ptr fnu fid elim d2 d1 dk dig csqr csqi
                                    ck cc bk az3 az atrm alim ak ad aa)
               (type (f2cl-lib:integer4) nn mr k2 k1 k iflag))
      (setf ierr 0)
      (setf nz 0)
      (if (or (< id 0) (> id 1)) (setf ierr 1))
      (if (or (< kode 1) (> kode 2)) (setf ierr 1))
      (if (/= ierr 0) (go end_label))
      (setf az (coerce (realpart (zabs zr zi)) 'double-float))
      (setf tol (max (f2cl-lib:d1mach 4) 1.0e-18))
      (setf fid (coerce (the f2cl-lib:integer4 id) 'double-float))
      (if (> az 1.0) (go label70))
      (setf s1r coner)
      (setf s1i conei)
      (setf s2r coner)
      (setf s2i conei)
      (if (< az tol) (go label170))
      (setf aa (* az az))
      (if (< aa (/ tol az)) (go label40))
      (setf trm1r coner)
      (setf trm1i conei)
      (setf trm2r coner)
      (setf trm2i conei)
      (setf atrm 1.0)
      (setf str (- (* zr zr) (* zi zi)))
      (setf sti (+ (* zr zi) (* zi zr)))
      (setf z3r (- (* str zr) (* sti zi)))
      (setf z3i (+ (* str zi) (* sti zr)))
      (setf az3 (* az aa))
      (setf ak (+ 2.0 fid))
      (setf bk (- 3.0 fid fid))
      (setf ck (- 4.0 fid))
      (setf dk (+ 3.0 fid fid))
      (setf d1 (* ak dk))
      (setf d2 (* bk ck))
      (setf ad (min d1 d2))
      (setf ak (+ 24.0 (* 9.0 fid)))
      (setf bk (- 30.0 (* 9.0 fid)))
      (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
                    ((> k 25) nil)
        (tagbody
          (setf str (/ (- (* trm1r z3r) (* trm1i z3i)) d1))
          (setf trm1i (/ (+ (* trm1r z3i) (* trm1i z3r)) d1))
          (setf trm1r str)
          (setf s1r (+ s1r trm1r))
          (setf s1i (+ s1i trm1i))
          (setf str (/ (- (* trm2r z3r) (* trm2i z3i)) d2))
          (setf trm2i (/ (+ (* trm2r z3i) (* trm2i z3r)) d2))
          (setf trm2r str)
          (setf s2r (+ s2r trm2r))
          (setf s2i (+ s2i trm2i))
          (setf atrm (/ (* atrm az3) ad))
          (setf d1 (+ d1 ak))
          (setf d2 (+ d2 bk))
          (setf ad (min d1 d2))
          (if (< atrm (* tol ad)) (go label40))
          (setf ak (+ ak 18.0))
          (setf bk (+ bk 18.0))
         label30))
     label40
      (if (= id 1) (go label50))
      (setf air (- (* s1r c1) (* c2 (- (* zr s2r) (* zi s2i)))))
      (setf aii (- (* s1i c1) (* c2 (+ (* zr s2i) (* zi s2r)))))
      (if (= kode 1) (go end_label))
      (multiple-value-bind (var-0 var-1 var-2 var-3)
          (zsqrt zr zi str sti)
        (declare (ignore var-0 var-1))
        (setf str var-2)
        (setf sti var-3))
      (setf ztar (* tth (- (* zr str) (* zi sti))))
      (setf ztai (* tth (+ (* zr sti) (* zi str))))
      (multiple-value-bind (var-0 var-1 var-2 var-3)
          (zexp ztar ztai str sti)
        (declare (ignore var-0 var-1))
        (setf str var-2)
        (setf sti var-3))
      (setf ptr (- (* air str) (* aii sti)))
      (setf aii (+ (* air sti) (* aii str)))
      (setf air ptr)
      (go end_label)
     label50
      (setf air (* (- s2r) c2))
      (setf aii (* (- s2i) c2))
      (if (<= az tol) (go label60))
      (setf str (- (* zr s1r) (* zi s1i)))
      (setf sti (+ (* zr s1i) (* zi s1r)))
      (setf cc (/ c1 (+ 1.0 fid)))
      (setf air (+ air (* cc (- (* str zr) (* sti zi)))))
      (setf aii (+ aii (* cc (+ (* str zi) (* sti zr)))))
     label60
      (if (= kode 1) (go end_label))
      (multiple-value-bind (var-0 var-1 var-2 var-3)
          (zsqrt zr zi str sti)
        (declare (ignore var-0 var-1))
        (setf str var-2)
        (setf sti var-3))
      (setf ztar (* tth (- (* zr str) (* zi sti))))
      (setf ztai (* tth (+ (* zr sti) (* zi str))))
      (multiple-value-bind (var-0 var-1 var-2 var-3)
          (zexp ztar ztai str sti)
        (declare (ignore var-0 var-1))
        (setf str var-2)
        (setf sti var-3))
      (setf ptr (- (* str air) (* sti aii)))
      (setf aii (+ (* str aii) (* sti air)))
      (setf air ptr)
      (go end_label)
     label70
      (setf fnu (/ (+ 1.0 fid) 3.0))
      (setf k1 (f2cl-lib:i1mach 15))
      (setf k2 (f2cl-lib:i1mach 16))
      (setf r1m5 (f2cl-lib:d1mach 5))
      (setf k
              (min (the f2cl-lib:integer4 (abs k1))
                   (the f2cl-lib:integer4 (abs k2))))
      (setf elim (* 2.303 (- (* k r1m5) 3.0)))
      (setf k1 (f2cl-lib:int-sub (f2cl-lib:i1mach 14) 1))
      (setf aa (* r1m5 k1))
      (setf dig (min aa 18.0))
      (setf aa (* aa 2.303))
      (setf alim (+ elim (max (- aa) -41.45)))
      (setf rl (+ (* 1.2 dig) 3.0))
      (setf alaz (f2cl-lib:flog az))
      (setf aa (/ 0.5 tol))
      (setf bb (* (f2cl-lib:i1mach 9) 0.5))
      (setf aa (min aa bb))
      (setf aa (expt aa tth))
      (if (> az aa) (go label260))
      (setf aa (f2cl-lib:fsqrt aa))
      (if (> az aa) (setf ierr 3))
      (multiple-value-bind (var-0 var-1 var-2 var-3)
          (zsqrt zr zi csqr csqi)
        (declare (ignore var-0 var-1))
        (setf csqr var-2)
        (setf csqi var-3))
      (setf ztar (* tth (- (* zr csqr) (* zi csqi))))
      (setf ztai (* tth (+ (* zr csqi) (* zi csqr))))
      (setf iflag 0)
      (setf sfac 1.0)
      (setf ak ztai)
      (if (>= zr 0.0) (go label80))
      (setf bk ztar)
      (setf ck (- (abs bk)))
      (setf ztar ck)
      (setf ztai ak)
     label80
      (if (/= zi 0.0) (go label90))
      (if (> zr 0.0) (go label90))
      (setf ztar 0.0)
      (setf ztai ak)
     label90
      (setf aa ztar)
      (if (and (>= aa 0.0) (> zr 0.0)) (go label110))
      (if (= kode 2) (go label100))
      (if (> aa (- alim)) (go label100))
      (setf aa (- (* 0.25 alaz) aa))
      (setf iflag 1)
      (setf sfac tol)
      (if (> aa elim) (go label270))
     label100
      (setf mr 1)
      (if (< zi 0.0) (setf mr -1))
      (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)
          (zacai ztar ztai fnu kode mr 1 cyr cyi nn rl tol elim alim)
        (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-9
                         var-10 var-11 var-12))
        (setf nn var-8))
      (if (< nn 0) (go label280))
      (setf nz (f2cl-lib:int-add nz nn))
      (go label130)
     label110
      (if (= kode 2) (go label120))
      (if (< aa alim) (go label120))
      (setf aa (- (* -0.25 alaz) aa))
      (setf iflag 2)
      (setf sfac (/ 1.0 tol))
      (if (< aa (- elim)) (go label210))
     label120
      (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)
          (zbknu ztar ztai fnu kode 1 cyr cyi nz tol elim alim)
        (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-8 var-9
                         var-10))
        (setf nz var-7))
     label130
      (setf s1r (* (f2cl-lib:fref cyr (1) ((1 1))) coef))
      (setf s1i (* (f2cl-lib:fref cyi (1) ((1 1))) coef))
      (if (/= iflag 0) (go label150))
      (if (= id 1) (go label140))
      (setf air (- (* csqr s1r) (* csqi s1i)))
      (setf aii (+ (* csqr s1i) (* csqi s1r)))
      (go end_label)
     label140
      (setf air (- (- (* zr s1r) (* zi s1i))))
      (setf aii (- (+ (* zr s1i) (* zi s1r))))
      (go end_label)
     label150
      (setf s1r (* s1r sfac))
      (setf s1i (* s1i sfac))
      (if (= id 1) (go label160))
      (setf str (- (* s1r csqr) (* s1i csqi)))
      (setf s1i (+ (* s1r csqi) (* s1i csqr)))
      (setf s1r str)
      (setf air (/ s1r sfac))
      (setf aii (/ s1i sfac))
      (go end_label)
     label160
      (setf str (- (- (* s1r zr) (* s1i zi))))
      (setf s1i (- (+ (* s1r zi) (* s1i zr))))
      (setf s1r str)
      (setf air (/ s1r sfac))
      (setf aii (/ s1i sfac))
      (go end_label)
     label170
      (setf aa (* 1000.0 (f2cl-lib:d1mach 1)))
      (setf s1r zeror)
      (setf s1i zeroi)
      (if (= id 1) (go label190))
      (if (<= az aa) (go label180))
      (setf s1r (* c2 zr))
      (setf s1i (* c2 zi))
     label180
      (setf air (- c1 s1r))
      (setf aii (- s1i))
      (go end_label)
     label190
      (setf air (- c2))
      (setf aii 0.0)
      (setf aa (f2cl-lib:fsqrt aa))
      (if (<= az aa) (go label200))
      (setf s1r (* 0.5 (- (* zr zr) (* zi zi))))
      (setf s1i (* zr zi))
     label200
      (setf air (+ air (* c1 s1r)))
      (setf aii (+ aii (* c1 s1i)))
      (go end_label)
     label210
      (setf nz 1)
      (setf air zeror)
      (setf aii zeroi)
      (go end_label)
     label270
      (setf nz 0)
      (setf ierr 2)
      (go end_label)
     label280
      (if (= nn -1) (go label270))
      (setf nz 0)
      (setf ierr 5)
      (go end_label)
     label260
      (setf ierr 4)
      (setf nz 0)
      (go end_label)
     end_label
      (return (values nil nil nil nil air aii nz ierr)))))

(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::zairy fortran-to-lisp::*f2cl-function-info*)
          (fortran-to-lisp::make-f2cl-finfo
           :arg-types '((double-float) (double-float)
                        (fortran-to-lisp::integer4) (fortran-to-lisp::integer4)
                        (double-float) (double-float)
                        (fortran-to-lisp::integer4)
                        (fortran-to-lisp::integer4))
           :return-values '(nil nil nil nil fortran-to-lisp::air
                            fortran-to-lisp::aii fortran-to-lisp::nz
                            fortran-to-lisp::ierr)
           :calls '(fortran-to-lisp::zbknu fortran-to-lisp::zacai
                    fortran-to-lisp::i1mach fortran-to-lisp::zexp
                    fortran-to-lisp::zsqrt fortran-to-lisp::d1mach
                    fortran-to-lisp::zabs))))