;;; 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 ((pi$ 3.141592653589793) (zeror 0.0) (coner 1.0))
  (declare (type (double-float) coner zeror pi$))
  (defun zacon (zr zi fnu kode mr n yr yi nz rl fnul tol elim alim)
    (declare (type (simple-array double-float (*)) yi yr)
             (type (f2cl-lib:integer4) nz n mr kode)
             (type (double-float) alim elim tol fnul rl fnu zi zr))
    (prog ((cyr (make-array 2 :element-type 'double-float))
           (cyi (make-array 2 :element-type 'double-float))
           (cssr (make-array 3 :element-type 'double-float))
           (csrr (make-array 3 :element-type 'double-float))
           (bry (make-array 3 :element-type 'double-float)) (i 0) (inu 0)
           (iuf 0) (kflag 0) (nn 0) (nw 0) (arg 0.0) (ascle 0.0) (as2 0.0)
           (azn 0.0) (bscle 0.0) (cki 0.0) (ckr 0.0) (cpn 0.0) (cscl 0.0)
           (cscr 0.0) (csgni 0.0) (csgnr 0.0) (cspni 0.0) (cspnr 0.0) (csr 0.0)
           (c1i 0.0) (c1m 0.0) (c1r 0.0) (c2i 0.0) (c2r 0.0) (fmr 0.0) (fn 0.0)
           (pti 0.0) (ptr 0.0) (razn 0.0) (rzi 0.0) (rzr 0.0) (sc1i 0.0)
           (sc1r 0.0) (sc2i 0.0) (sc2r 0.0) (sgn 0.0) (spn 0.0) (sti 0.0)
           (str 0.0) (s1i 0.0) (s1r 0.0) (s2i 0.0) (s2r 0.0) (yy 0.0) (zni 0.0)
           (znr 0.0))
      (declare (type (simple-array double-float (2)) cyr cyi)
               (type (simple-array double-float (3)) cssr csrr bry)
               (type (double-float) znr zni yy s2r s2i s1r s1i str sti spn sgn
                                    sc2r sc2i sc1r sc1i rzr rzi razn ptr pti fn
                                    fmr c2r c2i c1r c1m c1i csr cspnr cspni
                                    csgnr csgni cscr cscl cpn ckr cki bscle azn
                                    as2 ascle arg)
               (type (f2cl-lib:integer4) nw nn kflag iuf inu i))
      (setf nz 0)
      (setf znr (- zr))
      (setf zni (- zi))
      (setf nn n)
      (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)
          (zbinu znr zni fnu kode nn yr yi nw rl fnul 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 var-11 var-12))
        (setf nw var-7))
      (if (< nw 0) (go label90))
      (setf nn (min (the f2cl-lib:integer4 2) (the f2cl-lib:integer4 n)))
      (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 znr zni fnu kode nn cyr cyi nw 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 nw var-7))
      (if (/= nw 0) (go label90))
      (setf s1r (f2cl-lib:fref cyr (1) ((1 2))))
      (setf s1i (f2cl-lib:fref cyi (1) ((1 2))))
      (setf fmr (coerce (the f2cl-lib:integer4 mr) 'double-float))
      (setf sgn (coerce (- (f2cl-lib:dsign pi$ fmr)) 'double-float))
      (setf csgnr zeror)
      (setf csgni sgn)
      (if (= kode 1) (go label10))
      (setf yy (- zni))
      (setf cpn (cos yy))
      (setf spn (sin yy))
      (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5)
          (zmlt csgnr csgni cpn spn csgnr csgni)
        (declare (ignore var-0 var-1 var-2 var-3))
        (setf csgnr var-4)
        (setf csgni var-5))
     label10
      (setf inu (f2cl-lib:int fnu))
      (setf arg (* (- fnu inu) sgn))
      (setf cpn (cos arg))
      (setf spn (sin arg))
      (setf cspnr cpn)
      (setf cspni spn)
      (if (= (mod inu 2) 0) (go label20))
      (setf cspnr (- cspnr))
      (setf cspni (- cspni))
     label20
      (setf iuf 0)
      (setf c1r s1r)
      (setf c1i s1i)
      (setf c2r (f2cl-lib:fref yr (1) ((1 n))))
      (setf c2i (f2cl-lib:fref yi (1) ((1 n))))
      (setf ascle (/ (* 1000.0 (f2cl-lib:d1mach 1)) tol))
      (if (= kode 1) (go label30))
      (multiple-value-bind
            (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9)
          (zs1s2 znr zni c1r c1i c2r c2i nw ascle alim iuf)
        (declare (ignore var-0 var-1 var-7 var-8))
        (setf c1r var-2)
        (setf c1i var-3)
        (setf c2r var-4)
        (setf c2i var-5)
        (setf nw var-6)
        (setf iuf var-9))
      (setf nz (f2cl-lib:int-add nz nw))
      (setf sc1r c1r)
      (setf sc1i c1i)
     label30
      (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5)
          (zmlt cspnr cspni c1r c1i str sti)
        (declare (ignore var-0 var-1 var-2 var-3))
        (setf str var-4)
        (setf sti var-5))
      (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5)
          (zmlt csgnr csgni c2r c2i ptr pti)
        (declare (ignore var-0 var-1 var-2 var-3))
        (setf ptr var-4)
        (setf pti var-5))
      (setf (f2cl-lib:fref yr (1) ((1 n))) (+ str ptr))
      (setf (f2cl-lib:fref yi (1) ((1 n))) (+ sti pti))
      (if (= n 1) (go end_label))
      (setf cspnr (- cspnr))
      (setf cspni (- cspni))
      (setf s2r (f2cl-lib:fref cyr (2) ((1 2))))
      (setf s2i (f2cl-lib:fref cyi (2) ((1 2))))
      (setf c1r s2r)
      (setf c1i s2i)
      (setf c2r (f2cl-lib:fref yr (2) ((1 n))))
      (setf c2i (f2cl-lib:fref yi (2) ((1 n))))
      (if (= kode 1) (go label40))
      (multiple-value-bind
            (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9)
          (zs1s2 znr zni c1r c1i c2r c2i nw ascle alim iuf)
        (declare (ignore var-0 var-1 var-7 var-8))
        (setf c1r var-2)
        (setf c1i var-3)
        (setf c2r var-4)
        (setf c2i var-5)
        (setf nw var-6)
        (setf iuf var-9))
      (setf nz (f2cl-lib:int-add nz nw))
      (setf sc2r c1r)
      (setf sc2i c1i)
     label40
      (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5)
          (zmlt cspnr cspni c1r c1i str sti)
        (declare (ignore var-0 var-1 var-2 var-3))
        (setf str var-4)
        (setf sti var-5))
      (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5)
          (zmlt csgnr csgni c2r c2i ptr pti)
        (declare (ignore var-0 var-1 var-2 var-3))
        (setf ptr var-4)
        (setf pti var-5))
      (setf (f2cl-lib:fref yr (2) ((1 n))) (+ str ptr))
      (setf (f2cl-lib:fref yi (2) ((1 n))) (+ sti pti))
      (if (= n 2) (go end_label))
      (setf cspnr (- cspnr))
      (setf cspni (- cspni))
      (setf azn (coerce (realpart (zabs znr zni)) 'double-float))
      (setf razn (/ 1.0 azn))
      (setf str (* znr razn))
      (setf sti (* (- zni) razn))
      (setf rzr (* (+ str str) razn))
      (setf rzi (* (+ sti sti) razn))
      (setf fn (+ fnu 1.0))
      (setf ckr (* fn rzr))
      (setf cki (* fn rzi))
      (setf cscl (/ 1.0 tol))
      (setf cscr tol)
      (setf (f2cl-lib:fref cssr (1) ((1 3))) cscl)
      (setf (f2cl-lib:fref cssr (2) ((1 3))) coner)
      (setf (f2cl-lib:fref cssr (3) ((1 3))) cscr)
      (setf (f2cl-lib:fref csrr (1) ((1 3))) cscr)
      (setf (f2cl-lib:fref csrr (2) ((1 3))) coner)
      (setf (f2cl-lib:fref csrr (3) ((1 3))) cscl)
      (setf (f2cl-lib:fref bry (1) ((1 3))) ascle)
      (setf (f2cl-lib:fref bry (2) ((1 3))) (/ 1.0 ascle))
      (setf (f2cl-lib:fref bry (3) ((1 3))) (f2cl-lib:d1mach 2))
      (setf as2 (coerce (realpart (zabs s2r s2i)) 'double-float))
      (setf kflag 2)
      (if (> as2 (f2cl-lib:fref bry (1) ((1 3)))) (go label50))
      (setf kflag 1)
      (go label60)
     label50
      (if (< as2 (f2cl-lib:fref bry (2) ((1 3)))) (go label60))
      (setf kflag 3)
     label60
      (setf bscle (f2cl-lib:fref bry (kflag) ((1 3))))
      (setf s1r (* s1r (f2cl-lib:fref cssr (kflag) ((1 3)))))
      (setf s1i (* s1i (f2cl-lib:fref cssr (kflag) ((1 3)))))
      (setf s2r (* s2r (f2cl-lib:fref cssr (kflag) ((1 3)))))
      (setf s2i (* s2i (f2cl-lib:fref cssr (kflag) ((1 3)))))
      (setf csr (f2cl-lib:fref csrr (kflag) ((1 3))))
      (f2cl-lib:fdo (i 3 (f2cl-lib:int-add i 1))
                    ((> i n) nil)
        (tagbody
          (setf str s2r)
          (setf sti s2i)
          (setf s2r (+ (- (* ckr str) (* cki sti)) s1r))
          (setf s2i (+ (* ckr sti) (* cki str) s1i))
          (setf s1r str)
          (setf s1i sti)
          (setf c1r (* s2r csr))
          (setf c1i (* s2i csr))
          (setf str c1r)
          (setf sti c1i)
          (setf c2r (f2cl-lib:fref yr (i) ((1 n))))
          (setf c2i (f2cl-lib:fref yi (i) ((1 n))))
          (if (= kode 1) (go label70))
          (if (< iuf 0) (go label70))
          (multiple-value-bind
                (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9)
              (zs1s2 znr zni c1r c1i c2r c2i nw ascle alim iuf)
            (declare (ignore var-0 var-1 var-7 var-8))
            (setf c1r var-2)
            (setf c1i var-3)
            (setf c2r var-4)
            (setf c2i var-5)
            (setf nw var-6)
            (setf iuf var-9))
          (setf nz (f2cl-lib:int-add nz nw))
          (setf sc1r sc2r)
          (setf sc1i sc2i)
          (setf sc2r c1r)
          (setf sc2i c1i)
          (if (/= iuf 3) (go label70))
          (setf iuf -4)
          (setf s1r (* sc1r (f2cl-lib:fref cssr (kflag) ((1 3)))))
          (setf s1i (* sc1i (f2cl-lib:fref cssr (kflag) ((1 3)))))
          (setf s2r (* sc2r (f2cl-lib:fref cssr (kflag) ((1 3)))))
          (setf s2i (* sc2i (f2cl-lib:fref cssr (kflag) ((1 3)))))
          (setf str sc2r)
          (setf sti sc2i)
         label70
          (setf ptr (- (* cspnr c1r) (* cspni c1i)))
          (setf pti (+ (* cspnr c1i) (* cspni c1r)))
          (setf (f2cl-lib:fref yr (i) ((1 n)))
                  (- (+ ptr (* csgnr c2r)) (* csgni c2i)))
          (setf (f2cl-lib:fref yi (i) ((1 n)))
                  (+ pti (* csgnr c2i) (* csgni c2r)))
          (setf ckr (+ ckr rzr))
          (setf cki (+ cki rzi))
          (setf cspnr (- cspnr))
          (setf cspni (- cspni))
          (if (>= kflag 3) (go label80))
          (setf ptr (abs c1r))
          (setf pti (abs c1i))
          (setf c1m (max ptr pti))
          (if (<= c1m bscle) (go label80))
          (setf kflag (f2cl-lib:int-add kflag 1))
          (setf bscle (f2cl-lib:fref bry (kflag) ((1 3))))
          (setf s1r (* s1r csr))
          (setf s1i (* s1i csr))
          (setf s2r str)
          (setf s2i sti)
          (setf s1r (* s1r (f2cl-lib:fref cssr (kflag) ((1 3)))))
          (setf s1i (* s1i (f2cl-lib:fref cssr (kflag) ((1 3)))))
          (setf s2r (* s2r (f2cl-lib:fref cssr (kflag) ((1 3)))))
          (setf s2i (* s2i (f2cl-lib:fref cssr (kflag) ((1 3)))))
          (setf csr (f2cl-lib:fref csrr (kflag) ((1 3))))
         label80))
      (go end_label)
     label90
      (setf nz -1)
      (if (= nw -2) (setf nz -2))
      (go end_label)
     end_label
      (return
       (values nil nil nil nil nil nil nil nil nz nil nil 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::zacon 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) (double-float)
                        (double-float))
           :return-values '(nil nil nil nil nil nil nil nil fortran-to-lisp::nz
                            nil nil nil nil nil)
           :calls '(fortran-to-lisp::zabs fortran-to-lisp::zs1s2
                    fortran-to-lisp::d1mach fortran-to-lisp::zmlt
                    fortran-to-lisp::zbknu fortran-to-lisp::zbinu))))