;;; Compiled by f2cl version:
;;; ("f2cl1.l,v 1.215 2009/04/07 22:05:21 rtoy Exp $"
;;;  "f2cl2.l,v 1.37 2008/02/22 22:19:33 rtoy Exp $"
;;;  "f2cl3.l,v 1.6 2008/02/22 22:19:33 rtoy Exp $"
;;;  "f2cl4.l,v 1.7 2008/02/22 22:19:34 rtoy Exp $"
;;;  "f2cl5.l,v 1.200 2009/01/19 02:38:17 rtoy Exp $"
;;;  "f2cl6.l,v 1.48 2008/08/24 00:56:27 rtoy Exp $"
;;;  "macros.l,v 1.112 2009/01/08 12:57:19 rtoy Exp $")

;;; Using Lisp CMU Common Lisp 19f (19F)
;;; 
;;; Options: ((:prune-labels nil) (:auto-save t) (:relaxed-array-decls t)
;;;           (:coerce-assigns :as-needed) (:array-type ':array)
;;;           (:array-slicing t) (:declare-common nil)
;;;           (:float-format double-float))

(in-package :lapack)


(defun dlasd0 (n sqre d e u ldu vt ldvt smlsiz iwork work info)
  (declare (type (array f2cl-lib:integer4 (*)) iwork)
           (type (array double-float (*)) work vt u e d)
           (type (f2cl-lib:integer4) info smlsiz ldvt ldu sqre n))
  (f2cl-lib:with-multi-array-data
      ((d double-float d-%data% d-%offset%)
       (e double-float e-%data% e-%offset%)
       (u double-float u-%data% u-%offset%)
       (vt double-float vt-%data% vt-%offset%)
       (work double-float work-%data% work-%offset%)
       (iwork f2cl-lib:integer4 iwork-%data% iwork-%offset%))
    (prog ((alpha 0.0) (beta 0.0) (i 0) (i1 0) (ic 0) (idxq 0) (idxqc 0)
           (im1 0) (inode 0) (itemp 0) (iwk 0) (j 0) (lf 0) (ll 0) (lvl 0)
           (m 0) (ncc 0) (nd 0) (ndb1 0) (ndiml 0) (ndimr 0) (nl 0) (nlf 0)
           (nlp1 0) (nlvl 0) (nr 0) (nrf 0) (nrp1 0) (sqrei 0))
      (declare (type (f2cl-lib:integer4) sqrei nrp1 nrf nr nlvl nlp1 nlf nl
                                         ndimr ndiml ndb1 nd ncc m lvl ll lf j
                                         iwk itemp inode im1 idxqc idxq ic i1
                                         i)
               (type (double-float) beta alpha))
      (setf info 0)
      (cond
        ((< n 0)
         (setf info -1))
        ((or (< sqre 0) (> sqre 1))
         (setf info -2)))
      (setf m (f2cl-lib:int-add n sqre))
      (cond
        ((< ldu n)
         (setf info -6))
        ((< ldvt m)
         (setf info -8))
        ((< smlsiz 3)
         (setf info -9)))
      (cond
        ((/= info 0)
         (xerbla "DLASD0" (f2cl-lib:int-sub info))
         (go end_label)))
      (cond
        ((<= n smlsiz)
         (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)
             (dlasdq "U" sqre n m n 0 d e vt ldvt u ldu u ldu work info)
           (declare (ignore 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))
           (setf info var-15))
         (go end_label)))
      (setf inode 1)
      (setf ndiml (f2cl-lib:int-add inode n))
      (setf ndimr (f2cl-lib:int-add ndiml n))
      (setf idxq (f2cl-lib:int-add ndimr n))
      (setf iwk (f2cl-lib:int-add idxq n))
      (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5 var-6)
          (dlasdt n nlvl nd
           (f2cl-lib:array-slice iwork f2cl-lib:integer4 (inode) ((1 *)))
           (f2cl-lib:array-slice iwork f2cl-lib:integer4 (ndiml) ((1 *)))
           (f2cl-lib:array-slice iwork f2cl-lib:integer4 (ndimr) ((1 *)))
           smlsiz)
        (declare (ignore var-0 var-3 var-4 var-5 var-6))
        (setf nlvl var-1)
        (setf nd var-2))
      (setf ndb1 (the f2cl-lib:integer4 (truncate (+ nd 1) 2)))
      (setf ncc 0)
      (f2cl-lib:fdo (i ndb1 (f2cl-lib:int-add i 1))
                    ((> i nd) nil)
        (tagbody
          (setf i1 (f2cl-lib:int-sub i 1))
          (setf ic
                  (f2cl-lib:fref iwork-%data%
                                 ((f2cl-lib:int-add inode i1))
                                 ((1 *))
                                 iwork-%offset%))
          (setf nl
                  (f2cl-lib:fref iwork-%data%
                                 ((f2cl-lib:int-add ndiml i1))
                                 ((1 *))
                                 iwork-%offset%))
          (setf nlp1 (f2cl-lib:int-add nl 1))
          (setf nr
                  (f2cl-lib:fref iwork-%data%
                                 ((f2cl-lib:int-add ndimr i1))
                                 ((1 *))
                                 iwork-%offset%))
          (setf nrp1 (f2cl-lib:int-add nr 1))
          (setf nlf (f2cl-lib:int-sub ic nl))
          (setf nrf (f2cl-lib:int-add ic 1))
          (setf sqrei 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 var-13 var-14 var-15)
              (dlasdq "U" sqrei nl nlp1 nl ncc
               (f2cl-lib:array-slice d double-float (nlf) ((1 *)))
               (f2cl-lib:array-slice e double-float (nlf) ((1 *)))
               (f2cl-lib:array-slice vt
                                     double-float
                                     (nlf nlf)
                                     ((1 ldvt) (1 *)))
               ldvt
               (f2cl-lib:array-slice u double-float (nlf nlf) ((1 ldu) (1 *)))
               ldu
               (f2cl-lib:array-slice u double-float (nlf nlf) ((1 ldu) (1 *)))
               ldu work info)
            (declare (ignore 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))
            (setf info var-15))
          (cond
            ((/= info 0)
             (go end_label)))
          (setf itemp (f2cl-lib:int-sub (f2cl-lib:int-add idxq nlf) 2))
          (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
                        ((> j nl) nil)
            (tagbody
              (setf (f2cl-lib:fref iwork-%data%
                                   ((f2cl-lib:int-add itemp j))
                                   ((1 *))
                                   iwork-%offset%)
                      j)
             label10))
          (cond
            ((= i nd)
             (setf sqrei sqre))
            (t
             (setf sqrei 1)))
          (setf nrp1 (f2cl-lib:int-add nr sqrei))
          (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)
              (dlasdq "U" sqrei nr nrp1 nr ncc
               (f2cl-lib:array-slice d double-float (nrf) ((1 *)))
               (f2cl-lib:array-slice e double-float (nrf) ((1 *)))
               (f2cl-lib:array-slice vt
                                     double-float
                                     (nrf nrf)
                                     ((1 ldvt) (1 *)))
               ldvt
               (f2cl-lib:array-slice u double-float (nrf nrf) ((1 ldu) (1 *)))
               ldu
               (f2cl-lib:array-slice u double-float (nrf nrf) ((1 ldu) (1 *)))
               ldu work info)
            (declare (ignore 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))
            (setf info var-15))
          (cond
            ((/= info 0)
             (go end_label)))
          (setf itemp (f2cl-lib:int-add idxq ic))
          (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
                        ((> j nr) nil)
            (tagbody
              (setf (f2cl-lib:fref iwork-%data%
                                   ((f2cl-lib:int-sub
                                     (f2cl-lib:int-add itemp j)
                                     1))
                                   ((1 *))
                                   iwork-%offset%)
                      j)
             label20))
         label30))
      (f2cl-lib:fdo (lvl nlvl (f2cl-lib:int-add lvl (f2cl-lib:int-sub 1)))
                    ((> lvl 1) nil)
        (tagbody
          (cond
            ((= lvl 1)
             (setf lf 1)
             (setf ll 1))
            (t
             (setf lf (expt 2 (f2cl-lib:int-sub lvl 1)))
             (setf ll (f2cl-lib:int-sub (f2cl-lib:int-mul 2 lf) 1))))
          (f2cl-lib:fdo (i lf (f2cl-lib:int-add i 1))
                        ((> i ll) nil)
            (tagbody
              (setf im1 (f2cl-lib:int-sub i 1))
              (setf ic
                      (f2cl-lib:fref iwork-%data%
                                     ((f2cl-lib:int-add inode im1))
                                     ((1 *))
                                     iwork-%offset%))
              (setf nl
                      (f2cl-lib:fref iwork-%data%
                                     ((f2cl-lib:int-add ndiml im1))
                                     ((1 *))
                                     iwork-%offset%))
              (setf nr
                      (f2cl-lib:fref iwork-%data%
                                     ((f2cl-lib:int-add ndimr im1))
                                     ((1 *))
                                     iwork-%offset%))
              (setf nlf (f2cl-lib:int-sub ic nl))
              (cond
                ((and (= sqre 0) (= i ll))
                 (setf sqrei sqre))
                (t
                 (setf sqrei 1)))
              (setf idxqc (f2cl-lib:int-sub (f2cl-lib:int-add idxq nlf) 1))
              (setf alpha (f2cl-lib:fref d-%data% (ic) ((1 *)) d-%offset%))
              (setf beta (f2cl-lib:fref e-%data% (ic) ((1 *)) e-%offset%))
              (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)
                  (dlasd1 nl nr sqrei
                   (f2cl-lib:array-slice d double-float (nlf) ((1 *))) alpha
                   beta
                   (f2cl-lib:array-slice u
                                         double-float
                                         (nlf nlf)
                                         ((1 ldu) (1 *)))
                   ldu
                   (f2cl-lib:array-slice vt
                                         double-float
                                         (nlf nlf)
                                         ((1 ldvt) (1 *)))
                   ldvt
                   (f2cl-lib:array-slice iwork
                                         f2cl-lib:integer4
                                         (idxqc)
                                         ((1 *)))
                   (f2cl-lib:array-slice iwork f2cl-lib:integer4 (iwk) ((1 *)))
                   work info)
                (declare (ignore var-0 var-1 var-2 var-3 var-6 var-7 var-8
                                 var-9 var-10 var-11 var-12))
                (setf alpha var-4)
                (setf beta var-5)
                (setf info var-13))
              (cond
                ((/= info 0)
                 (go end_label)))
             label40))
         label50))
      (go end_label)
     end_label
      (return (values nil nil nil nil nil nil nil nil nil nil nil info)))))

(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::dlasd0
                 fortran-to-lisp::*f2cl-function-info*)
          (fortran-to-lisp::make-f2cl-finfo
           :arg-types '((fortran-to-lisp::integer4) (fortran-to-lisp::integer4)
                        (array double-float (*)) (array double-float (*))
                        (array double-float (*)) (fortran-to-lisp::integer4)
                        (array double-float (*)) (fortran-to-lisp::integer4)
                        (fortran-to-lisp::integer4)
                        (array fortran-to-lisp::integer4 (*))
                        (array double-float (*)) (fortran-to-lisp::integer4))
           :return-values '(nil nil nil nil nil nil nil nil nil nil nil
                            fortran-to-lisp::info)
           :calls '(fortran-to-lisp::dlasd1 fortran-to-lisp::dlasdt
                    fortran-to-lisp::dlasdq fortran-to-lisp::xerbla))))

