diff --git a/books/bookvol10.5.pamphlet b/books/bookvol10.5.pamphlet
new file mode 100644
index 0000000..c3e9aa4
--- /dev/null
+++ b/books/bookvol10.5.pamphlet
@@ -0,0 +1,61976 @@
+\documentclass[dvipdfm]{book}
+\usepackage{hyperref}
+\usepackage{amssymb}
+\usepackage{axiom}
+\usepackage{makeidx}
+\makeindex
+\usepackage{graphicx}
+%%
+%% pagehead consolidates standard page indexing
+%%
+\newcommand{\pagehead}[2]{% e.g. \pagehead{name}{abb}
+\section{#1}
+\label{#1}%
+\label{#2}%
+\index{{#1}}%
+\index{{#2}}}%
+%%
+%% pagepic adds an image and an index entry
+%%
+\newcommand{\pagepic}[3]{% e.g. \pagepic{pathandfile}{abb}{scale}
+\includegraphics[scale=#3]{#1}\\%
+\index{images!#2}}
+%%
+%% pageto is a forward link to a referenced page
+%%
+\newcommand{\pageto}[2]{% e.g. \pageto{abb}{name}
+\ \\${\bf\Rightarrow{}}${``#1''} (#2) \ref{#1} on page~\pageref{#1}}
+%%
+%% pageback is a backward link to a referencing page
+%%
+\newcommand{\pagefrom}[2]{% e.g. \pagefrom{name}{abb}
+\ \\${\bf\Leftarrow{}}${``#1''} (#2) \ref{#1} on page~\pageref{#1}}
+%%
+
+%% cross will put the category and function in the index
+%% cross will leave the funcname so it can be put inline.
+%%
+\newcommand{\cross}[2]{% e.g. \pagefrom{cat}{funcname}
+\index{#1!#2}%
+\index{#2!#1}%
+#2}
+
+% special meanings for math characters
+\providecommand{\N}{\mbox{\bbold N}}
+\providecommand{\Natural}{\mbox{\bbold N}}
+\providecommand{\Z}{\mbox{\bbold Z}}
+\providecommand{\Integer}{\mbox{\bbold Z}}
+\providecommand{\Rational}{\mbox{\bbold Q}}
+\providecommand{\Q}{\mbox{\bbold Q}}
+\providecommand{\Complex}{\mbox{\bbold C}}
+\providecommand{\C}{{\mathcal C}}
+\providecommand{\Real}{\mbox{\bbold R}}
+\providecommand{\F}{{\mathcal F}}
+\providecommand{\R}{{\mathcal R}}
+\begin{document}
+\begin{titlepage}
+\center{\includegraphics{ps/axiomfront.ps}}
+\vskip 0.1in
+\includegraphics{ps/bluebayou.ps}\\
+\vskip 0.1in
+{\Huge{The 30 Year Horizon}}
+\vskip 0.1in
+$$
+\begin{array}{lll}
+Manuel\ Bronstein      & William\ Burge   & Timothy\ Daly \\
+James\ Davenport       & Michael\ Dewar   & Martin\ Dunstan \\
+Albrecht\ Fortenbacher & Patrizia\ Gianni & Johannes\ Grabmeier \\
+Jocelyn\ Guidry        & Richard\ Jenks   & Larry\ Lambe \\
+Michael\ Monagan       & Scott\ Morrison  & William\ Sit \\
+Jonathan\ Steinbach    & Robert\ Sutor    & Barry\ Trager \\
+Stephen\ Watt          & Jim\ Wen         & Clifton\ Williamson
+\end{array}
+$$
+\center{\large{Volume 10: Axiom Algebra: Numerical Routines}}
+\end{titlepage}
+\pagenumbering{roman}
+\begin{verbatim}
+Portions Copyright (c) 2005 Timothy Daly
+
+The Blue Bayou image Copyright (c) 2004 Jocelyn Guidry
+
+Portions Copyright (c) 2004 Martin Dunstan
+
+Portions Copyright (c) 1991-2002, 
+The Numerical ALgorithms Group Ltd.
+All rights reserved.
+
+This book and the Axiom software is licensed as follows:
+
+Redistribution and use in source and binary forms, with or 
+without modification, are permitted provided that the following 
+conditions are
+met:
+
+    - Redistributions of source code must retain the above 
+      copyright notice, this list of conditions and the 
+      following disclaimer.
+
+    - Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the 
+      following disclaimer in the documentation and/or other 
+      materials provided with the distribution.
+
+    - Neither the name of The Numerical ALgorithms Group Ltd. 
+      nor the names of its contributors may be used to endorse 
+      or promote products derived from this software without 
+      specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND 
+CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, 
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 
+CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 
+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 
+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 
+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 
+SUCH DAMAGE.
+
+\end{verbatim}
+
+Inclusion of names in the list of credits is based on historical
+information and is as accurate as possible. Inclusion of names
+does not in any way imply an endorsement but represents historical
+influence on Axiom development.
+\vfill
+\eject
+\begin{tabular}{lll}
+Cyril Alberga         & Roy Adler             & Richard Anderson\\
+George Andrews        & Henry Baker           & Stephen Balzac\\
+Yurij Baransky        & David R. Barton       & Gerald Baumgartner\\
+Gilbert Baumslag      & Fred Blair            & Vladimir Bondarenko\\
+Mark Botch            & Alexandre Bouyer      & Peter A. Broadbery\\
+Martin Brock          & Manuel Bronstein      & Florian Bundschuh\\
+William Burge         & Quentin Carpent       & Bob Caviness\\
+Bruce Char            & Cheekai Chin          & David V. Chudnovsky\\
+Gregory V. Chudnovsky & Josh Cohen            & Christophe Conil\\
+Don Coppersmith       & George Corliss        & Robert Corless\\
+Gary Cornell          & Meino Cramer          & Claire Di Crescenzo\\
+Timothy Daly Sr.      & Timothy Daly Jr.      & James H. Davenport\\
+Jean Della Dora       & Gabriel Dos Reis      & Michael Dewar\\
+Claire DiCrescendo    & Sam Dooley            & Lionel Ducos\\
+Martin Dunstan        & Brian Dupee           & Dominique Duval\\
+Robert Edwards        & Heow Eide-Goodman     & Lars Erickson\\
+Richard Fateman       & Bertfried Fauser      & Stuart Feldman\\
+Brian Ford            & Albrecht Fortenbacher & George Frances\\
+Constantine Frangos   & Timothy Freeman       & Korrinn Fu\\
+Marc Gaetano          & Rudiger Gebauer       & Kathy Gerber\\
+Patricia Gianni       & Holger Gollan         & Teresa Gomez-Diaz\\
+Laureano Gonzalez-Vega& Stephen Gortler       & Johannes Grabmeier\\
+Matt Grayson          & James Griesmer        & Vladimir Grinberg\\
+Oswald Gschnitzer     & Jocelyn Guidry        & Steve Hague\\
+Vilya Harvey          & Satoshi Hamaguchi     & Martin Hassner\\
+Ralf Hemmecke         & Henderson             & Antoine Hersen\\
+Pietro Iglio          & Richard Jenks         & Kai Kaminski\\
+Grant Keady           & Tony Kennedy          & Paul Kosinski\\
+Klaus Kusche          & Bernhard Kutzler      & Larry Lambe\\
+Frederic Lehobey      & Michel Levaud         & Howard Levy\\
+Rudiger Loos          & Michael Lucks         & Richard Luczak\\
+Camm Maguire          & Bob McElrath          & Michael McGettrick\\
+Ian Meikle            & David Mentre          & Victor S. Miller\\
+Gerard Milmeister     & Mohammed Mobarak      & H. Michael Moeller\\
+Michael Monagan       & Marc Moreno-Maza      & Scott Morrison\\
+Mark Murray           & William Naylor        & C. Andrew Neff\\
+John Nelder           & Godfrey Nolan         & Arthur Norman\\
+Jinzhong Niu          & Michael O'Connor      & Kostas Oikonomou\\
+Julian A. Padget      & Bill Page             & Jaap Weel\\
+Susan Pelzel          & Michel Petitot        & Didier Pinchon\\
+Claude Quitte         & Norman Ramsey         & Michael Richardson\\
+Renaud Rioboo         & Jean Rivlin           & Nicolas Robidoux\\
+Simon Robinson        & Michael Rothstein     & Martin Rubey\\
+Philip Santas         & Alfred Scheerhorn     & William Schelter\\
+Gerhard Schneider     & Martin Schoenert      & Marshall Schor\\
+Fritz Schwarz         & Nick Simicich         & William Sit\\
+Elena Smirnova        & Jonathan Steinbach    & Christine Sundaresan\\
+Robert Sutor          & Moss E. Sweedler      & Eugene Surowitz\\
+James Thatcher        & Baldir Thomas         & Mike Thomas\\
+Dylan Thurston        & Barry Trager          & Themos T. Tsikas\\
+Gregory Vanuxem       & Bernhard Wall         & Stephen Watt\\
+Juergen Weiss         & M. Weller             & Mark Wegman\\
+James Wen             & Thorsten Werther      & Michael Wester\\
+John M. Wiley         & Berhard Will          & Clifton J. Williamson\\
+Stephen Wilson        & Shmuel Winograd       & Robert Wisbauer\\
+Sandra Wityak         & Waldemar Wiwianka     & Knut Wolf\\
+Clifford Yapp         & David Yun             & Richard Zippel\\
+Evelyn Zoernack       & Bruno Zuercher        & Dan Zwillinger 
+\end{tabular}
+\eject
+\tableofcontents
+\vfill
+\eject
+\setlength{\parindent}{0em}
+\setlength{\parskip}{1ex}
+{\Large{\bf New Foreword}}
+\vskip .25in
+
+On October 1, 2001 Axiom was withdrawn from the market and ended
+life as a commercial product.
+On September 3, 2002 Axiom was released under the Modified BSD
+license, including this document.
+On August 27, 2003 Axiom was released as free and open source
+software available for download from the Free Software Foundation's
+website, Savannah.
+
+Work on Axiom has had the generous support of the Center for 
+Algorithms and Interactive Scientific Computation (CAISS) at
+City College of New York. Special thanks go to Dr. Gilbert 
+Baumslag for his support of the long term goal.
+
+The online version of this documentation is roughly 1000 pages.
+In order to make printed versions we've broken it up into three
+volumes. The first volume is tutorial in nature. The second volume
+is for programmers. The third volume is reference material. We've
+also added a fourth volume for developers. All of these changes
+represent an experiment in print-on-demand delivery of documentation.
+Time will tell whether the experiment succeeded.
+
+Axiom has been in existence for over thirty years. It is estimated to
+contain about three hundred man-years of research and has, as of
+September 3, 2003, 143 people listed in the credits. All of these
+people have contributed directly or indirectly to making Axiom
+available.  Axiom is being passed to the next generation. I'm looking
+forward to future milestones.
+
+With that in mind I've introduced the theme of the ``30 year horizon''.
+We must invent the tools that support the Computational Mathematician
+working 30 years from now. How will research be done when every bit of
+mathematical knowledge is online and instantly available? What happens
+when we scale Axiom by a factor of 100, giving us 1.1 million domains?
+How can we integrate theory with code? How will we integrate theorems
+and proofs of the mathematics with space-time complexity proofs and
+running code? What visualization tools are needed? How do we support
+the conceptual structures and semantics of mathematics in effective
+ways? How do we support results from the sciences? How do we teach
+the next generation to be effective Computational Mathematicians?
+
+The ``30 year horizon'' is much nearer than it appears.
+
+\vskip .25in
+%\noindent
+Tim Daly\\
+CAISS, City College of New York\\
+November 10, 2003 ((iHy))
+\vfill
+\eject
+\pagenumbering{arabic}
+\chapter{Chapter Overview}
+Each routine in the Basic Linear Algebra Subroutine set (BLAS) has
+a prefix where:
+\begin{itemize}
+\item C - Complex
+\item D - Double Precision
+\item S - Real
+\item Z - Complex*16
+\end{itemize}
+Routines in level 2 and level 3 of BLAS use the prefix for type:
+\begin{itemize}
+\item GE - general
+\item GB - general band
+\item SY - symmetric
+\item HE - hermitian
+\item TR - triangular
+\item SB - symmetric band
+\item HB - hermetian band
+\item TB - triangular band
+\item SP - Sum packed
+\item HP - hermitian packed
+\item TP - triangular packed
+\end{itemize}
+For level 2 and level 3 BLAS options the options argument is CHARACTER*1
+and may be passed as character strings. They mean:
+\begin{itemize}
+\item TRANx
+\begin{itemize}
+\item {\bf N}o transpose
+\item {\bf T}ranspose
+\item {\bf C}onjugate transpose ($X$, $X^T$, $X^H$)
+\end{itemize}
+\item UPLO 
+\begin{itemize}
+\item {\bf U}pper triangular
+\item {\bf L}ower triangular
+\end{itemize}
+\item DIAG
+\begin{itemize}
+\item {\bf N}on-unit triangular
+\item {\bf U}nit triangular
+\end{itemize}
+\item SIDE
+\begin{itemize}
+\item {\bf L}eft - A or op(A) on the left
+\item {\bf R}ight - A or op(A) on the right
+\end{itemize}
+\end{itemize}
+For real matrices, TRANSx=T and TRANSx=C have the same meaning.
+For Hermitian matrices, TRANSx=T is not allowed.
+For complex symmetric matrices, TRANSx=H is not allowed.
+\chapter{Algebra Cover Code}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{package BLAS1 BlasLevelOne}
+\pagehead{BlasLevelOne}{BLAS1}
+%\pagepic{ps/v104blaslevelone.ps}{BLAS1}{1.00}
+
+{\bf Exports:}\\
+\begin{tabular}{lllll}
+\cross{AF}{?**?} &
+\end{tabular}
+
+<<package BLAS1 BlasLevelOne>>=
+)abbrev package BLAS1 BlasLevelOne
+++ Author: Gregory Vanuxem
+++ Date Created: 2006
+++ Date Last Updated: Aug 14, 2006
+++ Basic Operations: 
+++ Related Domains: Vector
+++ Also See:
+++ AMS Classifications:
+++ Keywords:
+++ Examples:
+++ References:
+++ Description:
+++ This package provides an interface to the Blas library (level 1)
+-- TODO : dimension of vector and not length
+BlasLevelOne(V) : Exports == Implementation where
+
+  SI ==> SingleInteger
+  R  ==> DoubleFloat
+  V  :   OneDimensionalArrayAggregate(R) with contiguousStorage
+
+  Exports == with
+
+      dot: (SI,V,SI,V,SI) -> R
+      ++ dot(n,x,incx,y,incy) computes the dot product of two vectors, x and y.
+      ++ Parameters:
+      ++ \begin{items}
+      ++ \item {n}: order of vectors x and y;
+      ++ \item {x}: the first vector, \#x must be at least (1+(n-1)*abs(incx));
+      ++ \item {incx}: increment for the elements of x;
+      ++ \item {y}: the second vector, \#y must be at least 
+      ++ (1+(n-1)*abs(incy));
+      ++ \item {incy}: increment for the elements of y.
+      ++ \end{items}
+
+      dot: (V,V) -> R
+      ++ dot(x,y) computes the dot product of two vectors, x and y.
+      ++ If x and y are not of the same length, it is assumed that they both
+      ++ have the same length (the smaller).
+
+      nrm2: (SI,V,SI) -> R
+      ++ nrm2(n,x,incx) computes the euclidean norm of the vector x.
+      ++ Parameters:
+      ++ \begin{items}
+      ++ \item {n}: order of the vector x;
+      ++ \item {x}: the vector, \#x must be at least (1+(n-1)*abs(incx));
+      ++ \item {incx}: Increment for the elements of x.
+      ++ \end{items}
+
+      nrm2: (V) -> R
+      ++ nrm2(x) computes the euclidean norm of the vector x.
+
+      asum: (SI,V,SI) -> R
+      ++ asum(n,x,incx) computes the sum of the absolute values of the vector
+      ++ elements of x. Parameters:
+      ++ \begin{items}
+      ++ \item {n}: order of the vector x;
+      ++ \item {x}: the vector, \#x must be at least (1+(n-1)*abs(incx));
+      ++ \item {incx}: Increment for the elements of x.
+      ++ \end{items}
+
+      asum: (V) -> R
+      ++ asum(x) computes the sum of the absolute values of the vector
+      ++ elements of x.
+
+      iamax: (SI,V,SI) -> SI
+      ++ iamax(n,x,incx) finds the index of element of a vector that has
+      ++ the largest absolute value. Parameters:
+      ++ \begin{items}
+      ++ \item {n}: order of the vector x;
+      ++ \item {x}: the vector, \#x must be at least (1+(n-1)*abs(incx));
+      ++ \item {incx}: Increment for the elements of x.
+      ++ \end{items}
+
+      iamax: (V) -> SI
+      ++ iamax(x) finds the index of element of a vector that has
+      ++ the largest absolute value.
+
+      swap: (SI,V,SI,V,SI) -> Void
+      ++ swap(n,x,incx,y,incy) interchanges two vectors, x and y.
+      ++ Parameters:
+      ++ \begin{items}
+      ++ \item {n}: order of vectors x and y;
+      ++ \item {x}: the first vector, \#x must be at least (1+(n-1)*abs(incx));
+      ++ \item {incx}: increment for the elements of x;
+      ++ \item {y}: the second vector, \#y must be at least
+      ++ (1+(n-1)*abs(incy));
+      ++ \item {incy}: increment for the elements of y.
+      ++ \end{items}
+
+      swap: (V,V) -> Void
+      ++ swap(x,y) interchanges two vectors, x and y.
+      ++ If x and y are not of the same length, it is assumed that they both
+      ++ have the same length (the smaller).
+
+      copy: (SI,V,SI,V,SI) -> Void
+      ++ copy(n,x,incx,y,incy) copies a vector, x, to a vector, y.
+      ++ Parameters:
+      ++ \begin{items}
+      ++ \item {n}: order of vectors x and y;
+      ++ \item {x}: the first vector, \#x must be at least (1+(n-1)*abs(incx));
+      ++ \item {incx}: increment for the elements of x;
+      ++ \item {y}: the second vector, \#y must be at least
+      ++  (1+(n-1)*abs(incy));
+      ++ \item {incy}: increment for the elements of y.
+      ++ \end{items}
+
+      copy: (V,V) -> Void
+      ++ copy(x,y) copies a vector, x, to a vector, y.
+      ++ If x and y are not of the same length, it is assumed that they both
+      ++ have the same length (the smaller).
+
+      axpy: (SI,R,V,SI,V,SI) -> Void
+      ++ axpy(n,alpha,x,incx,y,incy) computes the product of a scalar, alpha,
+      ++ with a vector, x, plus a vector, y.
+      ++ Parameters:
+      ++ \begin{items}
+      ++ \item {n}: order of vectors x and y;
+      ++ \item {alpha}: a scalar;
+      ++ \item {x}: the first vector, \#x must be at least (1+(n-1)*abs(incx));
+      ++ \item {incx}: increment for the elements of x;
+      ++ \item {y}: the second vector, \#y must be at least
+      ++ (1+(n-1)*abs(incy));
+      ++ \item {incy}: increment for the elements of y.
+      ++ \end{items}
+
+      axpy: (R,V,V) -> Void
+      ++ axpy(alpha,x,y) computes the product of a scalar, alpha,
+      ++ with a vector, x, plus a vector, y.
+      ++ If x and y are not of the same length, it is assumed that they both
+      ++ have the same length (the smaller).
+
+      rot: (SI,V,SI,V,SI,R,R) -> Void
+      ++ rot(n,x,incx,y,incy,c,s) applies a plane rotation:
+      ++  x(i) = c*x(i) + s*y(i)
+      ++  y(i) = c*y(i) - s*x(i)
+      ++ Parameters:
+      ++ \begin{items}
+      ++ \item {n}: order of vectors x and y;
+      ++ \item {x}: the first vector, \#x must be at least (1+(n-1)*abs(incx));
+      ++ \item {incx}: increment for the elements of x;
+      ++ \item {y}: the second vector, \#y must be at least
+      ++ (1+(n-1)*abs(incy));
+      ++ \item {incy}: increment for the elements of y;
+      ++ \item {c}:  a scalar;
+      ++ \item {s}: a scalar.
+      ++ \end{items}
+
+      rot: (V,V,R,R) -> Void
+      ++ rot(x,y,c,s) applies a plane rotation:
+      ++  x(i) = c*x(i) + s*y(i)
+      ++  y(i) = c*y(i) - s*x(i)
+      ++ If x and y are not of the same length, it is assumed that they both
+      ++ have the same length (the smaller).
+
+      scal: (SI,R,V,SI) -> Void
+      ++ scal(n,alpha,x,incx) scales a vector, x, by a scalar, alpha.
+      ++ Parameters:
+      ++ \begin{items}
+      ++ \item {n}: order of the vector x;
+      ++ \item {alpha}: a scalar;
+      ++ \item {x}: the vector, \#x must be at least (1+(n-1)*abs(incx));
+      ++ \item {incx}: Increment for the elements of x.
+      ++ \end{items}
+
+      scal: (R,V) -> Void
+      ++ scal(alpha,x) scales a vector, x, by a scalar, alpha.
+
+  Implementation  == add
+
+      dot(n:SI,x:V,incx:SI,y:V,incy:SI): R ==
+        DDOT(n,x,incx,y,incy)$Lisp
+
+      dot(x:V,y:V): R ==
+        n := min(#x,#y)::SI
+        DDOT(n,x,1$SI,y,1$SI)$Lisp
+
+      nrm2(n:SI,x:V,incx:SI): R ==
+        DNRM2(n,x,incx)$Lisp
+
+      nrm2(x:V): R ==
+        DNRM2(#x::SI,x,1$SI)$Lisp
+
+      asum(n:SI,x:V,incx:SI): R ==
+        DASUM(n,x,incx)$Lisp
+
+      asum(x:V): R ==
+        DASUM(#x::SI,x,1$SI)$Lisp
+
+      iamax(n:SI,x:V,incx:SI): SI ==
+        IDAMAX(n,x,incx)$Lisp
+
+      iamax(x:V): SI ==
+        IDAMAX(#x::SI,x,1$SI)$Lisp
+
+      swap(n:SI,x:V,incx:SI,y:V,incy:SI): Void ==
+        DSWAP(n,x,incx,y,incy)$Lisp
+
+      swap(x:V,y:V): Void ==
+        n := min(#x,#y)::SI
+        DSWAP(n,x,1$SI,y,1$SI)$Lisp
+
+      copy(n:SI,x:V,incx:SI,y:V,incy:SI): Void ==
+        DCOPY(n,x,incx,y,incy)$Lisp
+
+      copy(x:V,y:V): Void ==
+        n := min(#x,#y)::SI
+        DCOPY(n,x,1$SI,y,1$SI)$Lisp
+
+      axpy(n:SI,alpha:R,x:V,incx:SI,y:V,incy:SI): Void ==
+        DAXPY(n,alpha,x,incx,y,incy)$Lisp
+
+      axpy(alpha:R,x:V,y:V): Void ==
+        n := min(#x,#y)::SI
+        DAXPY(n,alpha,x,1$SI,y,1$SI)$Lisp
+
+      rot(n:SI,x:V,incx:SI,y:V,incy:SI,c:R,s:R): Void ==
+        DROT(n,x,incx,y,incy,c,s)$Lisp
+
+      rot(x:V,y:V,c:R,s:R): Void ==
+        n := min(#x,#y)::SI
+        DROT(n,x,1$SI,y,1$SI,c,s)$Lisp
+
+      scal(n:SI,alpha:R,x:V,incx:SI): Void ==
+        DSCAL(n,alpha,x,incx)$Lisp
+
+      scal(alpha:R,x:V): Void ==
+        DSCAL(#x::SI,alpha,x,1$SI)$Lisp
+
+@
+<<BLAS1.dotabb>>=
+"BLAS1" [color="#FF4488",href="bookvol10.4.pdf#nameddest=BLAS1"]
+"FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"]
+"ACF" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACF"]
+"BLAS1" -> "FS"
+"BLAS1" -> "ACF"
+
+@
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{package BLAS2 BlasLevelTwo}
+\pagehead{BlasLevelTwo}{BLAS2}
+%\pagepic{ps/v104blasleveltwo.ps}{BLAS2}{1.00}
+
+{\bf Exports:}\\
+\begin{tabular}{lllll}
+\cross{BLAS2}{?**?} &
+\end{tabular}
+
+<<package BLAS2 BlasLevelTwo>>=
+)abbrev package BLAS2 BlasLevelTwo
+++ Author: Gregory Vanuxem
+++ Date Created: 2006
+++ Date Last Updated: Aug 29, 2006
+++ Basic Operations: 
+++ Related Domains: ColumnMajorTwoDimensionnalArray, Vector
+++ Also See:
+++ AMS Classifications:
+++ Keywords:
+++ Examples:
+++ References:
+++ Description:
+++    This package provides an interface to the
+++    Blas library (level 2)
+BlasLevelTwo(Row,Col,M,V) : Exports == Implementation where
+
+  R    ==> DoubleFloat
+  SI   ==> SingleInteger
+  CHAR ==> Character
+  V    :   OneDimensionalArrayAggregate(R) with contiguousStorage
+  Row  :   OneDimensionalArrayAggregate(R) with contiguousStorage
+  Col  :   OneDimensionalArrayAggregate(R) with contiguousStorage
+  M    :   ColumnMajorTwoDimensionalArrayCategory(R,Row,Col)
+
+  Exports == with
+
+      gemv: (CHAR,SI,SI,R,M,SI,V,SI,R,V,SI) -> Void
+      ++ gemv(trans,m,n,alpha,A,lda,x,incx,beta,y,incy) performs one of
+      ++ the matrix-vector operations
+      ++  y := alpha*A*x + beta*y,   or   y := alpha*A'*x + beta*y,
+      ++ where alpha and beta are scalars, x and y are vectors and A is an
+      ++ m by n matrix.
+      ++ Parameters:
+      ++ \begin{items}
+      ++ \item {trans}: on entry, specifies the operation to be performed as
+      ++ follows:
+      ++  trans = 'N' or 'n'   y := alpha*A*x + beta*y.
+      ++  trans = 'T' or 't'   y := alpha*A'*x + beta*y.
+      ++ Unchanged on exit.
+      ++ \item {m}: on entry, specifies the number of rows of the matrix A.
+      ++ m must be at least zero. Unchanged on exit.
+      ++ \item {n}: on entry, specifies the number of columns of the matrix A.
+      ++ n must be at least zero. Unchanged on exit.
+      ++ \item {alpha}:  on entry, specifies the scalar alpha. 
+      ++ Unchanged on exit.
+      ++ \item {A}: before entry, the leading m by n part of the array A must
+      ++ contain the matrix of coefficients. Unchanged on exit.
+      ++ \item {lda}: on entry, specifies the first dimension of A as declared
+      ++ in the calling (sub) program. lda must be at least max( 1, m ).
+      ++ Unchanged on exit.
+      ++ \item {x}: array of dimension at least ( 1 + ( n - 1 )*abs( incx ) )
+      ++ when trans = 'N' or 'n'
+      ++ and at least ( 1 + ( m - 1 )*abs( incx ) ) otherwise. Before entry,
+      ++ the incremented array x must contain the
+      ++ vector x. Unchanged on exit.
+      ++ \item {incx}: increment for the elements of x.
+      ++ \item {beta}: on entry, beta specifies the scalar beta. When beta is
+      ++ supplied as zero then y need not be set on input. Unchanged on exit.
+      ++ \item {y}: array of dimension at least ( 1 + ( m - 1 )*abs( incy ) )
+      ++ when trans = 'N' or 'n'
+      ++ and at least ( 1 + ( n - 1 )*abs( incy ) ) otherwise. 
+      ++ Before entry with beta non-zero,
+      ++ the incremented array y must contain the vector y. On exit, 
+      ++ y is overwritten by the updated vector y.
+      ++ \item {incy}: increment for the elements of y.
+      ++ \end{items}
+
+      gemv: (CHAR,R,M,V,R,V) -> Void
+      ++ gemv(trans,alpha,A,x,beta,y) performs one of
+      ++ the matrix-vector operations
+      ++  y := alpha*A*x + beta*y,   or   y := alpha*A'*x + beta*y,
+      ++ where alpha and beta are scalars, x and y are vectors and A is an
+      ++ m by n matrix.
+      ++ Parameters:
+      ++ \begin{items}
+      ++ \item {trans}: on entry, specifies the operation to be performed as
+      ++ follows:
+      ++  trans = 'N' or 'n'   y := alpha*A*x + beta*y.
+      ++  trans = 'T' or 't'   y := alpha*A'*x + beta*y.
+      ++ Unchanged on exit.
+      ++ \item {alpha}:  on entry, specifies the scalar alpha.
+      ++ Unchanged on exit.
+      ++ \item {A}: before entry, the array A must
+      ++ contain the matrix of coefficients. Unchanged on exit.
+      ++ \item {x}: array of dimension at least n when trans = 'N' or 'n'
+      ++ and at least m otherwise. Before entry, the array x must contain the
+      ++ vector x. Unchanged on exit.
+      ++ \item {beta}: on entry, beta specifies the scalar beta. When beta is
+      ++ supplied as zero then y need not be set on input. Unchanged on exit.
+      ++ \item {y}: array of dimension at least m when trans = 'N' or 'n'
+      ++ and at least n otherwise. Before entry with beta non-zero,
+      ++ the array y must contain the vector y. 
+      ++ On exit, y is overwritten by the updated vector y.
+      ++ \end{items}
+
+      ger: (SI,SI,R,V,SI,V,SI,M,SI) -> Void
+      ++ ger(m,n,alpha,x,incx,y,incy,A,lda) performs the rank 1 operation
+      ++  A := alpha*x*y' + A,
+      ++ where alpha is a scalar, x is an m-element vector, y is an n-element
+      ++ vector and A is an m by n matrix.
+      ++ Parameters:
+      ++ \begin{items}
+      ++ \item {m}: on entry, specifies the number of rows of the matrix A.
+      ++ m must be at least zero. Unchanged on exit.
+      ++ \item {n}: on entry, specifies the number of columns of the matrix A.
+      ++ n must be at least zero. Unchanged on exit.
+      ++ \item {alpha}:  on entry, specifies the scalar alpha.
+      ++ Unchanged on exit.
+      ++ \item {x}: array of dimension at least ( 1 + ( m - 1 )*abs( incx ) ). 
+      ++ Before entry, the incremented array x must contain the
+      ++ m-element vector x. Unchanged on exit.
+      ++ \item {incx}: increment for the elements of x.
+      ++ \item {y}: array of dimension at least ( 1 + ( n - 1 )*abs( incy ) ).
+      ++ Before entry, the incremented array y must contain the 
+      ++ n-element vector y.
+      ++ Unchanged on exit.
+      ++ \item {incy}: increment for the elements of y.
+      ++ \item {A}: before entry, the leading m by n part of the array A must
+      ++ contain the matrix of coefficients. On exit, A is overwritten by the
+      ++ updated matrix.
+      ++ \item {lda}: on entry, specifies the first dimension of A as declared
+      ++ in the calling (sub) program. lda must be at least max( 1, m ).
+      ++ Unchanged on exit.
+      ++ \end{items}
+
+      ger: (R,V,V,M) -> Void
+      ++ ger(alpha,x,y,A) performs the rank 1 operation
+      ++  A := alpha*x*y' + A,
+      ++ where alpha is a scalar, x is an m-element vector, y is an n-element
+      ++ vector and A is an m by n matrix.
+      ++ Parameters:
+      ++ \begin{items}
+      ++ \item {alpha}:  on entry, specifies the scalar alpha. 
+      ++ Unchanged on exit.
+      ++ \item {x}: array of dimension at least m. Before entry, 
+      ++ the array x must
+      ++ contain the m-element vector x. Unchanged on exit.
+      ++ \item {y}: array of dimension at least n. 
+      ++ Before entry, the array y must
+      ++ contain the n-element vector y. Unchanged on exit.
+      ++ \item {A}: before entry, the array A must
+      ++ contain the matrix of coefficients. On exit, A is overwritten by the
+      ++ updated matrix.
+      ++ \end{items}
+
+      symv: (CHAR,SI,R,M,SI,V,SI,R,V,SI) -> Void
+      ++ symv(uplo,n,alpha,A,lda,x,incx,beta,y,incy)
+      ++ performs the matrix-vector operation
+      ++  y := alpha*A*x + beta*y,
+      ++ where alpha and beta are scalars, x and y are n-element vectors and
+      ++ A is an n by n symmetric matrix.
+      ++ Parameters:
+      ++ \begin{items}
+      ++ \item {uplo}: on entry, uplo specifies whether the upper or lower
+      ++ triangular part of the array A is to be referenced as
+      ++ follows:
+      ++  uplo = 'U' or 'u'   only the upper triangular part of A
+      ++  is to be referenced.
+      ++  uplo = 'L' or 'l'   only the lower triangular part of A
+      ++  is to be referenced.
+      ++ Unchanged on exit.
+      ++ \item {n}: on entry, specifies the order of the matrix A.
+      ++ n must be at least zero. Unchanged on exit.
+      ++ \item {alpha}:  on entry, specifies the scalar alpha.
+      ++ Unchanged on exit.
+      ++ \item {A}: before entry with  uplo = 'U' or 'u', the leading n by n
+      ++ upper triangular part of the array A must contain the upper
+      ++ triangular part of the symmetric matrix and the strictly
+      ++ lower triangular part of A is not referenced.
+      ++ Before entry with uplo = 'L' or 'l', the leading n by n
+      ++ lower triangular part of the array A must contain the lower
+      ++ triangular part of the symmetric matrix and the strictly
+      ++ upper triangular part of A is not referenced.
+      ++ Unchanged on exit.
+      ++ \item {x}: array of dimension at least ( 1 + ( n - 1 )*abs( incx ) )
+      ++ Before entry, the incremented array x must contain the
+      ++ n-element vector x. Unchanged on exit.
+      ++ \item {incx}: increment for the elements of x.
+      ++ \item {beta}: on entry, beta specifies the scalar beta. When beta is
+      ++ supplied as zero then y need not be set on input. Unchanged on exit.
+      ++ \item {y}: array of dimension at least ( 1 + ( n - 1 )*abs( incy ) ).
+      ++ Before entry with beta non-zero, the incremented array y must contain
+      ++ the n-element vector y. On exit, y is overwritten by the
+      ++ updated vector y.
+      ++ \item {incy}: increment for the elements of y.
+      ++ \end{items}
+
+      symv: (CHAR,R,M,V,R,V) -> Void
+      ++ symv(uplo,alpha,A,x,beta,y) performs the matrix-vector operation
+      ++  y := alpha*A*x + beta*y,
+      ++ where alpha and beta are scalars, x and y are n-element vectors and
+      ++ A is an n by n symmetric matrix.
+      ++ Parameters:
+      ++ \begin{items}
+      ++ \item {uplo}: on entry, uplo specifies whether the upper or lower
+      ++ triangular part of the array A is to be referenced as
+      ++ follows:
+      ++  uplo = 'U' or 'u'   only the upper triangular part of A
+      ++  is to be referenced.
+      ++  uplo = 'L' or 'l'   only the lower triangular part of A
+      ++  is to be referenced.
+      ++ Unchanged on exit.
+      ++ \item {alpha}:  on entry, specifies the scalar alpha.
+      ++ Unchanged on exit.
+      ++ \item {A}: before entry with  uplo = 'U' or 'u', the
+      ++ upper triangular part of the array A must contain the upper
+      ++ triangular part of the symmetric matrix and the strictly
+      ++ lower triangular part of A is not referenced.
+      ++ Before entry with uplo = 'L' or 'l', the
+      ++ lower triangular part of the array A must contain the lower
+      ++ triangular part of the symmetric matrix and the strictly
+      ++ upper triangular part of A is not referenced.
+      ++ Unchanged on exit.
+      ++ \item {x}: array of dimension at least n.
+      ++ Before entry, the array x must contain the
+      ++ n-element vector x. Unchanged on exit.
+      ++ \item {beta}: on entry, beta specifies the scalar beta. When beta is
+      ++ supplied as zero then y need not be set on input. Unchanged on exit.
+      ++ \item {y}: array of dimension at least n.
+      ++ Before entry with beta non-zero, the array y must contain
+      ++ the n-element vector y. On exit, y is overwritten by the 
+      ++ updated vector y.
+      ++ \end{items}
+
+      syr: (CHAR,SI,R,V,SI,M,SI) -> Void
+      ++ syr(uplo,n,alpha,x,incx,A,lda) performs the symmetric rank 1 operation
+      ++  A := alpha*x*x' + A,
+      ++ where alpha is a scalar, x is an n-element vector and A is an
+      ++ n by n symmetric matrix.
+      ++ Parameters:
+      ++ \begin{items}
+      ++ \item {uplo}: on entry, uplo specifies whether the upper or lower
+      ++ triangular part of the array A is to be referenced as
+      ++ follows:
+      ++  uplo = 'U' or 'u'   only the upper triangular part of A
+      ++  is to be referenced.
+      ++  uplo = 'L' or 'l'   only the lower triangular part of A
+      ++  is to be referenced.
+      ++ Unchanged on exit.
+      ++ \item {n}: on entry, specifies the order of the matrix A.
+      ++ n must be at least zero. Unchanged on exit.
+      ++ \item {alpha}:  on entry, specifies the scalar alpha.
+      ++ Unchanged on exit.
+      ++ \item {x}: array of dimension at least ( 1 + ( n - 1 )*abs( incx ) ).
+      ++ Before entry, the incremented array x must contain the
+      ++ n-element vector x.
+      ++ Unchanged on exit.
+      ++ \item {incx}: increment for the elements of x.
+      ++ \item {A}: before entry with  uplo = 'U' or 'u', the leading n by n
+      ++ upper triangular part of the array A must contain the upper
+      ++ triangular part of the symmetric matrix and the strictly
+      ++ lower triangular part of A is not referenced. On exit, the
+      ++ upper triangular part of the array A is overwritten by the
+      ++ upper triangular part of the updated matrix.
+      ++ Before entry with uplo = 'L' or 'l', the leading n by n
+      ++ lower triangular part of the array A must contain the lower
+      ++ triangular part of the symmetric matrix and the strictly
+      ++ upper triangular part of A is not referenced. On exit, the
+      ++ lower triangular part of the array A is overwritten by the
+      ++ lower triangular part of the updated matrix.
+      ++ \item {lda}: on entry, specifies the first dimension of A as declared
+      ++ in the calling (sub) program. lda must be at least max( 1, n ).
+      ++ Unchanged on exit.
+      ++ \end{items}
+
+      syr: (CHAR,R,V,M) -> Void
+      ++ syr(uplo,alpha,x,A) performs the symmetric rank 1 operation
+      ++  A := alpha*x*x' + A,
+      ++ where alpha is a scalar, x is an n-element vector and A is an
+      ++ n by n symmetric matrix.
+      ++ Parameters:
+      ++ \begin{items}
+      ++ \item {uplo}: on entry, uplo specifies whether the upper or lower
+      ++ triangular part of the array A is to be referenced as
+      ++ follows:
+      ++  uplo = 'U' or 'u'   only the upper triangular part of A
+      ++  is to be referenced.
+      ++  uplo = 'L' or 'l'   only the lower triangular part of A
+      ++  is to be referenced.
+      ++ Unchanged on exit.
+      ++ \item {alpha}:  on entry, specifies the scalar alpha.
+      ++ Unchanged on exit.
+      ++ \item {x}: array of dimension at least ( 1 + ( n - 1 )*abs( incx ) ).
+      ++ Before entry, the array x must contain the n-element vector x.
+      ++ Unchanged on exit.
+      ++ \item {A}: before entry with  uplo = 'U' or 'u', the
+      ++ upper triangular part of the array A must contain the upper
+      ++ triangular part of the symmetric matrix and the strictly
+      ++ lower triangular part of A is not referenced. On exit, the
+      ++ upper triangular part of the array A is overwritten by the
+      ++ upper triangular part of the updated matrix.
+      ++ Before entry with uplo = 'L' or 'l', the
+      ++ lower triangular part of the array A must contain the lower
+      ++ triangular part of the symmetric matrix and the strictly
+      ++ upper triangular part of A is not referenced. On exit, the
+      ++ lower triangular part of the array A is overwritten by the
+      ++ lower triangular part of the updated matrix.
+      ++ \end{items}
+
+      syr2: (CHAR,SI,R,V,SI,V,SI,M,SI) -> Void
+      ++ syr2(uplo,n,alpha,x,incx,y,incy,A,lda)
+      ++ performs the symmetric rank 2 operation
+      ++  A := alpha*x*y' + alpha*y*x' + A,
+      ++ where alpha is a scalar, x and y are n-element vectors and A is an n
+      ++ by n symmetric matrix.
+      ++ Parameters:
+      ++ \begin{items}
+      ++ \item {uplo}: on entry, uplo specifies whether the upper or lower
+      ++ triangular part of the array A is to be referenced as
+      ++ follows:
+      ++  uplo = 'U' or 'u'   only the upper triangular part of A
+      ++  is to be referenced.
+      ++  uplo = 'L' or 'l'   only the lower triangular part of A
+      ++  is to be referenced.
+      ++ Unchanged on exit.
+      ++ \item {n}: on entry, specifies the order of the matrix A.
+      ++ n must be at least zero. Unchanged on exit.
+      ++ \item {alpha}:  on entry, specifies the scalar alpha.
+      ++ Unchanged on exit.
+      ++ \item {x}: array of dimension at least ( 1 + ( n - 1 )*abs( incx ) ).
+      ++ Before entry, the incremented array x must contain the
+      ++ n-element vector x.
+      ++ Unchanged on exit.
+      ++ \item {incx}: increment for the elements of x.
+      ++ \item {y}: array of dimension at least ( 1 + ( n - 1 )*abs( incy ) ).
+      ++ Before entry, the incremented array y must contain the
+      ++ n-element vector y.
+      ++ Unchanged on exit.
+      ++ \item {incy}: increment for the elements of y.
+      ++ \item {A}: before entry with  uplo = 'U' or 'u', the leading n by n
+      ++ upper triangular part of the array A must contain the upper
+      ++ triangular part of the symmetric matrix and the strictly
+      ++ lower triangular part of A is not referenced. On exit, the
+      ++ upper triangular part of the array A is overwritten by the
+      ++ upper triangular part of the updated matrix.
+      ++ Before entry with uplo = 'L' or 'l', the leading n by n
+      ++ lower triangular part of the array A must contain the lower
+      ++ triangular part of the symmetric matrix and the strictly
+      ++ upper triangular part of A is not referenced. On exit, the
+      ++ lower triangular part of the array A is overwritten by the
+      ++ lower triangular part of the updated matrix.
+      ++ \item {lda}: on entry, specifies the first dimension of A as declared
+      ++ in the calling (sub) program. lda must be at least max( 1, n ).
+      ++ Unchanged on exit.
+      ++ \end{items}
+
+      syr2: (CHAR,R,V,V,M) -> Void
+      ++ syr2(uplo,alpha,x,y,A) performs the symmetric rank 2 operation
+      ++  A := alpha*x*y' + alpha*y*x' + A,
+      ++ where alpha is a scalar, x and y are n-element vectors and A is an n
+      ++ by n symmetric matrix.
+      ++ Parameters:
+      ++ \begin{items}
+      ++ \item {uplo}: on entry, uplo specifies whether the upper or lower
+      ++ triangular part of the array A is to be referenced as
+      ++ follows:
+      ++  uplo = 'U' or 'u'   only the upper triangular part of A
+      ++  is to be referenced.
+      ++  uplo = 'L' or 'l'   only the lower triangular part of A
+      ++  is to be referenced.
+      ++ Unchanged on exit.
+      ++ \item {n}: on entry, specifies the order of the matrix A.
+      ++ n must be at least zero. Unchanged on exit.
+      ++ \item {alpha}:  on entry, specifies the scalar alpha.
+      ++ Unchanged on exit.
+      ++ \item {x}: array of dimension at least n.
+      ++ Before entry, the array x must contain the n-element vector x.
+      ++ Unchanged on exit.
+      ++ \item {y}: array of dimension at least n.
+      ++ Before entry, the array y must contain the n-element vector y.
+      ++ Unchanged on exit.
+      ++ \item {A}: before entry with  uplo = 'U' or 'u', the leading n by n
+      ++ upper triangular part of the array A must contain the upper
+      ++ triangular part of the symmetric matrix and the strictly
+      ++ lower triangular part of A is not referenced. On exit, the
+      ++ upper triangular part of the array A is overwritten by the
+      ++ upper triangular part of the updated matrix.
+      ++ Before entry with uplo = 'L' or 'l', the leading n by n
+      ++ lower triangular part of the array A must contain the lower
+      ++ triangular part of the symmetric matrix and the strictly
+      ++ upper triangular part of A is not referenced. On exit, the
+      ++ lower triangular part of the array A is overwritten by the
+      ++ lower triangular part of the updated matrix.
+      ++ \end{items}
+
+      trmv: (CHAR,CHAR,CHAR,SI,M,SI,V,SI) -> Void
+      ++ trmv(uplo,trans,diag,n,A,lda,x,incx)
+      ++ performs one of the matrix-vector operations
+      ++  x := A*x,   or   x := A'*x,
+      ++ where x is an n-element vector and  A is an n by n unit, or non-unit,
+      ++ upper or lower triangular matrix.
+      ++ Parameters:
+      ++ \begin{items}
+      ++ \item {uplo}: on entry, specifies whether the matrix is an upper or
+      ++ lower triangular matrix as follows:
+      ++  uplo = 'U' or 'u'   A is an upper triangular matrix.
+      ++  uplo = 'L' or 'l'   A is a lower triangular matrix.
+      ++ Unchanged on exit.
+      ++ \item {trans}: on entry, specifies the operation to be performed as
+      ++ follows:
+      ++  trans = 'N' or 'n'   x := A*x.
+      ++  trans = 'T' or 't'   x := A'*x.
+      ++ Unchanged on exit.
+      ++ \item {diag}: on entry, specifies whether or not A is unit
+      ++ triangular as follows:
+      ++  diag = 'U' or 'u'   A is assumed to be unit triangular.
+      ++  diag = 'N' or 'n'   A is not assumed to be unit triangular.
+      ++ Unchanged on exit
+      ++ \item {n}: on entry, specifies the order of the matrix A.
+      ++ n must be at least zero. Unchanged on exit.
+      ++ \item {A}: before entry with  uplo = 'U' or 'u', the leading n by n
+      ++ upper triangular part of the array A must contain the upper
+      ++ triangular matrix and the strictly lower triangular part of
+      ++ A is not referenced. 
+      ++ Before entry with uplo = 'L' or 'l', the leading n by n
+      ++ lower triangular part of the array A must contain the lower triangular
+      ++ matrix and the strictly upper triangular part of A is not referenced.
+      ++ Note that when  diag = 'U' or 'u', the diagonal elements of A are not
+      ++ referenced either, but are assumed to be unity. Unchanged on exit.
+      ++ \item {lda}: on entry, specifies the first dimension of A as declared
+      ++ in the calling (sub) program. lda must be at least max( 1, n ).
+      ++ Unchanged on exit.
+      ++ \item {x}: array of dimension at least ( 1 + ( n - 1 )*abs( incx ) ).
+      ++ Before entry, the incremented array x must contain the
+      ++ n-element vector x.
+      ++ On exit, x is overwritten with the tranformed vector x.
+      ++ \item {incx}: increment for the elements of x.
+      ++ \end{items}
+
+      trmv: (CHAR,CHAR,CHAR,M,V) -> Void
+      ++ trmv(uplo,trans,diag,A,x) performs one of the matrix-vector operations
+      ++  x := A*x,   or   x := A'*x,
+      ++ where x is an n-element vector and  A is an n by n unit, or non-unit,
+      ++ upper or lower triangular matrix.
+      ++ Parameters:
+      ++ \begin{items}
+      ++ \item {uplo}: on entry, specifies whether the matrix is an upper or
+      ++ lower triangular matrix as follows:
+      ++  uplo = 'U' or 'u'   A is an upper triangular matrix.
+      ++  uplo = 'L' or 'l'   A is a lower triangular matrix.
+      ++ Unchanged on exit.
+      ++ \item {trans}: on entry, specifies the operation to be performed as
+      ++ follows:
+      ++  trans = 'N' or 'n'   x := A*x.
+      ++  trans = 'T' or 't'   x := A'*x.
+      ++ Unchanged on exit.
+      ++ \item {diag}: on entry, specifies whether or not A is unit
+      ++ triangular as follows:
+      ++  diag = 'U' or 'u'   A is assumed to be unit triangular.
+      ++  diag = 'N' or 'n'   A is not assumed to be unit triangular.
+      ++ Unchanged on exit
+      ++ \item {A}: before entry with  uplo = 'U' or 'u', the 
+      ++ upper triangular part of the array A must contain the upper
+      ++ triangular matrix and the strictly lower triangular part of
+      ++ A is not referenced. Before entry with uplo = 'L' or 'l', the
+      ++ lower triangular part of the array A must contain the lower triangular
+      ++ matrix and the strictly upper triangular part of A is not referenced.
+      ++ Note that when  diag = 'U' or 'u', the diagonal elements of A are not
+      ++ referenced either, but are assumed to be unity. Unchanged on exit.
+      ++ \item {x}: array of dimension at least n.
+      ++ Before entry, the array x must contain the n-element vector x.
+      ++ On exit, x is overwritten with the tranformed vector x.
+      ++ \end{items}
+
+      trsv: (CHAR,CHAR,CHAR,SI,M,SI,V,SI) -> Void
+      ++ trsv(uplo,trans,diag,n,A,lda,x,incx)
+      ++ solves one of the systems of equations
+      ++  A*x = b,   or   A'*x = b,
+      ++ where b and x are n-element vectors and A is an n by n unit, or
+      ++ non-unit, upper or lower triangular matrix.
+      ++ No test for singularity or near-singularity is included in this
+      ++ routine. Such tests must be performed before calling this routine.
+      ++ Parameters:
+      ++ \begin{items}
+      ++ \item {uplo}: on entry, specifies whether the matrix is an upper or
+      ++ lower triangular matrix as follows:
+      ++  uplo = 'U' or 'u'   A is an upper triangular matrix.
+      ++  uplo = 'L' or 'l'   A is a lower triangular matrix.
+      ++ Unchanged on exit.
+      ++ \item {trans}: on entry, specifies the equations to be solved as
+      ++ follows:
+      ++  trans = 'N' or 'n'   A*x = b.
+      ++  trans = 'T' or 't'   A'*x = b.
+      ++ Unchanged on exit.
+      ++ \item {diag}: on entry, specifies whether or not A is unit
+      ++ triangular as follows:
+      ++  diag = 'U' or 'u'   A is assumed to be unit triangular.
+      ++  diag = 'N' or 'n'   A is not assumed to be unit triangular.
+      ++ Unchanged on exit
+      ++ \item {n}: on entry, specifies the order of the matrix A.
+      ++ n must be at least zero. Unchanged on exit.
+      ++ \item {A}: before entry with  uplo = 'U' or 'u', the leading n by n
+      ++ upper triangular part of the array A must contain the upper
+      ++ triangular matrix and the strictly lower triangular part of
+      ++ A is not referenced. Before entry with uplo = 'L' or 'l',
+      ++ the leading n by n
+      ++ lower triangular part of the array A must contain the lower triangular
+      ++ matrix and the strictly upper triangular part of A is not referenced.
+      ++ Note that when  diag = 'U' or 'u', the diagonal elements of A are not
+      ++ referenced either, but are assumed to be unity. Unchanged on exit.
+      ++ \item {lda}: on entry, specifies the first dimension of A as declared
+      ++ in the calling (sub) program. lda must be at least max( 1, n ).
+      ++ Unchanged on exit.
+      ++ \item {x}: array of dimension at least ( 1 + ( n - 1 )*abs( incx ) ).
+      ++ Before entry, the incremented array x must contain the
+      ++ n-element right-hand side vector b. On exit, x is overwritten
+      ++ with the solution vector x.
+      ++ \item {incx}: increment for the elements of x.
+      ++ \end{items}
+
+      trsv: (CHAR,CHAR,CHAR,M,V) -> Void
+      ++ trsv(uplo,trans,diag,A,x) solves one of the systems of equations
+      ++  A*x = b,   or   A'*x = b,
+      ++ where b and x are n-element vectors and A is an n by n unit, or
+      ++ non-unit, upper or lower triangular matrix.
+      ++ No test for singularity or near-singularity is included in this
+      ++ routine. Such tests must be performed before calling this routine.
+      ++ Parameters:
+      ++ \begin{items}
+      ++ \item {uplo}: on entry, specifies whether the matrix is an upper or
+      ++ lower triangular matrix as follows:
+      ++  uplo = 'U' or 'u'   A is an upper triangular matrix.
+      ++  uplo = 'L' or 'l'   A is a lower triangular matrix.
+      ++ Unchanged on exit.
+      ++ \item {trans}: on entry, specifies the equations to be solved as
+      ++ follows:
+      ++  trans = 'N' or 'n'   A*x = b.
+      ++  trans = 'T' or 't'   A'*x = b.
+      ++ Unchanged on exit.
+      ++ \item {diag}: on entry, specifies whether or not A is unit
+      ++ triangular as follows:
+      ++  diag = 'U' or 'u'   A is assumed to be unit triangular.
+      ++  diag = 'N' or 'n'   A is not assumed to be unit triangular.
+      ++ Unchanged on exit
+      ++ \item {A}: before entry with  uplo = 'U' or 'u', the
+      ++ upper triangular part of the array A must contain the upper
+      ++ triangular matrix and the strictly lower triangular part of
+      ++ A is not referenced. Before entry with uplo = 'L' or 'l', the
+      ++ lower triangular part of the array A must contain the lower triangular
+      ++ matrix and the strictly upper triangular part of A is not referenced.
+      ++ Note that when  diag = 'U' or 'u', the diagonal elements of A are not
+      ++ referenced either, but are assumed to be unity. Unchanged on exit.
+      ++ \item {x}: array of dimension at least n.
+      ++ Before entry, the array x must contain the
+      ++ n-element right-hand side vector b. On exit, x is overwritten
+      ++ with the solution vector x.
+      ++ \end{items}
+
+  Implementation  == add
+
+      gemv(trans:CHAR,m:SI,n:SI,alpha:R,A:M,lda:SI,x:V,incx:SI,beta:R,y:V,incy:SI): Void ==
+        DGEMV(trans,m,n,alpha,A,lda,x,incx,beta,y,incy)$Lisp
+
+      gemv(trans:CHAR,alpha:R,A:M,x:V,beta:R,y:V): Void ==
+        m  := nrows(A)::SI
+        n  := ncols(A)::SI
+        nx := #x
+        ny := #y
+        if ((trans = char "N") or (trans = char "n")) then
+          nx < n =>
+            error "gemv: #x must be at least ncols(A)"
+          ny < m =>
+            error "gemv: #y must be at least nrows(A)"
+        else if ((trans = char "T") or (trans = char "t")) then
+          nx < m =>
+            error "gemv: #x must be at least nrows(A)"
+          ny < n =>
+            error "gemv: #y must be at least ncols(A)"
+        else
+          error "gemv: trans must be one of the following values: N, n, T or t"
+        DGEMV(trans,m,n,alpha,A,m,x,1$SI,beta,y,1$SI)$Lisp
+
+      ger(m:SI,n:SI,alpha:R,x:V,incx:SI,y:V,incy:SI,A:M,lda:SI): Void ==
+        DGER(m,n,alpha,x,incx,y,incy,A,lda)$Lisp
+
+      ger(alpha:R,x:V,y:V,A:M): Void ==
+        m  := nrows(A)::SI
+        n  := ncols(A)::SI
+        #x < m =>
+          error "gemv: #x must be at least nrows(A)"
+        #y < n =>
+          error "gemv: #y must be at least ncols(A)"
+        DGER(m,n,alpha,x,1$SI,y,1$SI,A,m)$Lisp
+
+      symv(uplo:CHAR,n:SI,alpha:R,A:M,lda:SI,x:V,incx:SI,beta:R,y:V,incy:SI): Void ==
+        DSYMV(uplo,n,alpha,A,lda,x,incx,beta,y,incy)$Lisp
+
+      symv(uplo:CHAR,alpha:R,A:M,x:V,beta:R,y:V): Void ==
+        (n := nrows(A)::SI) < ncols(A) =>
+          error "symv: nrows(A) must be at least ncols(A)"
+        (#x < n) =>
+          error "symv: #x must be at least nrows(A)"
+        (#y < n) =>
+          error "symv: #y must be at least nrows(A)"
+        (uplo ~= char "U") and (uplo ~= char "u") and (uplo ~= char "L") and_
+                (uplo ~= char "l") =>
+          error "symv: uplo must be one of the following values: u, U, l or L"
+        DSYMV(uplo,n,alpha,A,n,x,1$SI,beta,y,1$SI)$Lisp
+
+      syr(uplo:CHAR,n:SI,alpha:R,x:V,incx:SI,A:M,lda:SI): Void ==
+        DSYR(uplo,n,alpha,x,incx,A,lda)$Lisp
+
+      syr(uplo:CHAR,alpha:R,x:V,A:M): Void ==
+        (n := nrows(A)::SI) < ncols(A) =>
+          error "syr: nrows(A) must be at least ncols(A)"
+        (#x < n) =>
+          error "syr: #x must be at least nrows(A)"
+        (uplo ~= char "U") and (uplo ~= char "u") and (uplo ~= char "L") and_
+                (uplo ~= char "l") =>
+          error "syr: uplo must be one of the following values: u, U, l or L"
+        DSYR(uplo,n,alpha,x,1$SI,A,n)$Lisp
+
+      syr2(uplo:CHAR,n:SI,alpha:R,x:V,incx:SI,y:V,incy:SI,A:M,lda:SI): Void ==
+        DSYR2(uplo,n,alpha,x,incx,y,incy,A,lda)$Lisp
+
+      syr2(uplo:CHAR,alpha:R,x:V,y:V,A:M): Void ==
+        (n := nrows(A)::SI) < ncols(A) =>
+          error "syr2: nrows(A) must be at least ncols(A)"
+        (#x < n) =>
+          error "syr2: #x must be at least nrows(A)"
+        (#y < n) =>
+          error "syr2: #y must be at least nrows(A)"
+        (uplo ~= char "U") and (uplo ~= char "u") and (uplo ~= char "L") and_
+                (uplo ~= char "l") =>
+          error "syr2: uplo must be one of the following values: u, U, l or L"
+        DSYR2(uplo,n,alpha,x,1$SI,A,n)$Lisp
+
+      trmv(uplo:CHAR,trans:CHAR,diag:CHAR,n:SI,A:M,lda:SI,x:V,incx:SI): Void ==
+        DTRMV(uplo,trans,diag,n,A,lda,x,incx)$Lisp
+
+      trmv(uplo:CHAR,trans:CHAR,diag:CHAR,A:M,x:V): Void ==
+        (n := nrows(A)::SI) < ncols(A) =>
+          error "trmv: nrows(A) must be at least ncols(A)"
+        (#x < n) =>
+          error "trmv: #x must be at least nrows(A)"
+        (trans ~= char "N") and (trans ~= char "n") and (trans ~= char "T") and_
+                (trans ~= char "t") =>
+          error "trmv: trans must be one of the following values: N, n, T or t"
+        (uplo ~= char "U") and (uplo ~= char "u") and (uplo ~= char "L") and_
+                (uplo ~= char "l") =>
+          error "trmv: uplo must be one of the following values: u, U, l or L"
+        (diag ~= char "N") and (diag ~= char "n") and (diag ~= char "U") and_
+                (diag ~= char "u") =>
+          error "trmv: diag must be one of the following values: N, n, U or u"
+        DTRMV(uplo,trans,diag,n,A,n,x,1$SI)$Lisp
+
+      trsv(uplo:CHAR,trans:CHAR,diag:CHAR,n:SI,A:M,lda:SI,x:V,incx:SI): Void ==
+        DTRSV(uplo,trans,diag,n,A,lda,x,incx)$Lisp
+
+      trsv(uplo:CHAR,trans:CHAR,diag:CHAR,A:M,x:V): Void ==
+        (n := nrows(A)::SI) < ncols(A) =>
+          error "trsv: nrows(A) must be at least ncols(A)"
+        (#x < n) =>
+          error "trsv: #x must be at least nrows(A)"
+        (trans ~= char "N") and (trans ~= char "n") and (trans ~= char "T") and_
+                (trans ~= char "t") =>
+          error "trsv: trans must be one of the following values: N, n, T or t"
+        (uplo ~= char "U") and (uplo ~= char "u") and (uplo ~= char "L") and_
+                (uplo ~= char "l") =>
+          error "trsv: uplo must be one of the following values: u, U, l or L"
+        (diag ~= char "N") and (diag ~= char "n") and (diag ~= char "U") and_
+                (diag ~= char "u") =>
+          error "trsv: diag must be one of the following values: N, n, U or u"
+        DTRSV(uplo,trans,diag,n,A,n,x,1$SI)$Lisp
+
+@
+<<BLAS2.dotabb>>=
+"BLAS2" [color="#FF4488",href="bookvol10.4.pdf#nameddest=BLAS2"]
+"FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"]
+"ACF" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACF"]
+"BLAS2" -> "FS"
+"BLAS2" -> "ACF"
+
+@
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{package BLAS3 BlasLevelThree}
+\pagehead{BlasLevelThree}{BLAS3}
+%\pagepic{ps/v104blaslevelthree.ps}{BLAS3}{1.00}
+
+{\bf Exports:}\\
+\begin{tabular}{lllll}
+\cross{BLAS3}{?**?} &
+\end{tabular}
+
+<<package BLAS3 BlasLevelThree>>=
+)abbrev package BLAS3 BlasLevelThree
+++ Author: Gregory Vanuxem
+++ Date Created: 2006
+++ Date Last Updated: Sep 9, 2006
+++ Basic Operations: 
+++ Related Domains: ColumnMajorTwoDimensionnalArray
+++ Also See:
+++ AMS Classifications:
+++ Keywords:
+++ Examples:
+++ References:
+++ Description:
+++    This package provides an interface to the
+++    Blas library (level 3)
+-- TODO: "at least" verification
+BlasLevelThree(Row,Col,M) : Exports == Implementation where
+
+  R    ==> DoubleFloat
+  SI   ==> SingleInteger
+  CHAR ==> Character
+  Row  :   OneDimensionalArrayAggregate(R) with contiguousStorage
+  Col  :   OneDimensionalArrayAggregate(R) with contiguousStorage
+  M    :   ColumnMajorTwoDimensionalArrayCategory(R,Row,Col)
+
+  Exports == with
+
+      gemm: (CHAR,CHAR,SI,SI,SI,R,M,SI,M,SI,R,M,SI) -> Void
+      ++ gemm(transa,transb,m,n,k,alpha,A,lda,B,ldb,beta,C,ldc) performs one
+      ++ of the matrix-matrix operations
+      ++  C := alpha*op( A )*op( B ) + beta*C,
+      ++ where  op( X ) is one of
+      ++  op( X ) = X   or   op( X ) = X',
+      ++ alpha and beta are scalars, and A, B and C are matrices, with op( A )
+      ++ an m by k matrix,  op( B )  a  k by n matrix and  C an m by n matrix.
+      ++ Parameters:
+      ++ \begin{items}
+      ++ \item {transa}: on entry, specifies the form of op( A ) to be used in
+      ++ the matrix multiplication as follows:
+      ++  transa = 'N' or 'n',  op( A ) = A.
+      ++  transa = 'T' or 't',  op( A ) = A'.
+      ++ Unchanged on exit.
+      ++ \item{transb}: on entry, specifies the form of op( B ) to be used in
+      ++ the matrix multiplication as follows:
+      ++  transb = 'N' or 'n',  op( B ) = B.
+      ++  transb = 'T' or 't',  op( B ) = B'.
+      ++ Unchanged on exit.
+      ++ \item{m}: on entry,  specifies  the number  of rows  of the  matrix
+      ++ op( A )  and of the  matrix  C.  m  must  be at least  zero.
+      ++ Unchanged on exit.
+      ++ \item{n}: on entry,  specifies the number  of columns of the matrix
+      ++ op( B ) and the number of columns of the matrix C. n must be
+      ++ at least zero. Unchanged on exit.
+      ++ \item{k}: on entry,  specifies  the number of columns of the matrix
+      ++ op( A ) and the number of rows of the matrix op( B ). k must
+      ++ be at least  zero. Unchanged on exit.
+      ++ \item{alpha}:  on entry, specifies the scalar alpha.
+      ++ Unchanged on exit.
+      ++ \item{A}: before entry with  transa = 'N' or 'n',  the leading  m by k
+      ++ part of the array  A  must contain the matrix  A,  otherwise
+      ++ the leading  k by m  part of the array  A  must contain  the
+      ++ matrix A. Unchanged on exit
+      ++ \item{lda}: on entry, specifies the first dimension of A as declared
+      ++ in the calling (sub) program. When  transa = 'N' or 'n' then
+      ++ lda must be at least  max( 1, m ), otherwise  lda must be at
+      ++ least  max( 1, k ). Unchanged on exit
+      ++ \item{B}:  before entry with  transb = 'N' or 'n', 
+      ++ the leading  k by n
+      ++ part of the array  B  must contain the matrix  B,  otherwise
+      ++ the leading  n by k  part of the array  B  must contain  the
+      ++ matrix B. Unchanged on exit.
+      ++ \item{ldb}: on entry, specifies the first dimension of B as declared
+      ++ in the calling (sub) program. When  transb = 'N' or 'n' then
+      ++ ldb must be at least  max( 1, k ), otherwise  ldb must be at
+      ++ least  max( 1, n ). Unchanged on exit.
+      ++ \item{beta}: on entry,  specifies the scalar  beta.  When  beta  is
+      ++ supplied as zero then C need not be set on input. Unchanged on exit.
+      ++ \item{C}: before entry, the leading  m by n  part of the array  C must
+      ++ contain the matrix  C,  except when  beta  is zero, in which
+      ++ case C need not be set on entry.
+      ++ On exit, the array  C  is overwritten by the  m by n  matrix
+      ++ ( alpha*op( A )*op( B ) + beta*C ).
+      ++ \item{ldc}: on entry, specifies the first dimension of C as declared
+      ++ in  the  calling  (sub)  program.   ldc  must  be  at  least
+      ++ max( 1, m ). Unchanged on exit.
+      ++ \end{items}
+
+      gemm: (CHAR,CHAR,R,M,M,R,M) -> Void
+      ++ gemm(transa,transb,alpha,A,B,beta,C) performs one
+      ++ of the matrix-matrix operations
+      ++  C := alpha*op( A )*op( B ) + beta*C,
+      ++ where  op( X ) is one of
+      ++  op( X ) = X   or   op( X ) = X',
+      ++ alpha and beta are scalars, and A, B and C are matrices, with op( A )
+      ++ an m by k matrix,  op( B )  a  k by n matrix and  C an m by n matrix.
+      ++ Parameters:
+      ++ \begin{items}
+      ++ \item {transa}: on entry, specifies the form of op( A ) to be used in
+      ++ the matrix multiplication as follows:
+      ++  transa = 'N',  op( A ) = A.
+      ++  transa = 'T',  op( A ) = A'.
+      ++ Unchanged on exit.
+      ++ \item{transb}: on entry, specifies the form of op( B ) to be used in
+      ++ the matrix multiplication as follows:
+      ++  transb = 'N',  op( B ) = B.
+      ++  transb = 'T',  op( B ) = B'.
+      ++ Unchanged on exit.
+      ++ \item{alpha}:  on entry, specifies the scalar alpha.
+      ++ Unchanged on exit.
+      ++ \item{A}: before entry with  transa = 'N' or 'n',  the leading  m by k
+      ++ part of the array  A  must contain the matrix  A,  otherwise
+      ++ the leading  k by m  part of the array  A  must contain  the
+      ++ matrix A. Unchanged on exit
+      ++ \item{B}:  before entry with  transb = 'N' or 'n', 
+      ++ the leading  k by n
+      ++ part of the array  B  must contain the matrix  B,  otherwise
+      ++ the leading  n by k  part of the array  B  must contain  the
+      ++ matrix B. Unchanged on exit.
+      ++ \item{beta}: on entry,  specifies the scalar  beta.  When  beta  is
+      ++ supplied as zero then C need not be set on input. Unchanged on exit.
+      ++ \item{C}: before entry, the leading  m by n  part of the array  C must
+      ++ contain the matrix  C,  except when  beta  is zero, in which
+      ++ case C need not be set on entry.
+      ++ On exit, the array  C  is overwritten by the  m by n  matrix
+      ++ ( alpha*op( A )*op( B ) + beta*C ).
+      ++ \end{items}
+
+      symm: (CHAR,CHAR,SI,SI,R,M,SI,M,SI,R,M,SI) -> Void
+      ++ symm(side,uplo,m,n,alpha,A,lda,B,ldb,beta,C,ldc) performs one of
+      ++ the matrix-matrix operations
+      ++  C := alpha*A*B + beta*C, or C := alpha*B*A + beta*C,
+      ++ where alpha and beta are scalars,  A is a symmetric matrix and  B and
+      ++ C are  m by n matrices.
+      ++ Parameters:
+      ++ \begin{items}
+      ++ \item {side}: on entry,  specifies whether  the  symmetric matrix  A
+      ++ appears on the  left or right  in the  operation as follows:
+      ++  side = 'L' or 'l'   C := alpha*A*B + beta*C,
+      ++  side = 'R' or 'r'   C := alpha*B*A + beta*C,
+      ++ Unchanged on exit.
+      ++ \item{uplo}: on  entry, specifies  whether  the  upper  or  lower
+      ++ triangular  part  of  the  symmetric  matrix   A  is  to  be
+      ++ referenced as follows:
+      ++  uplo = 'U' or 'u'   Only the upper triangular part of the
+      ++  symmetric matrix is to be referenced.
+      ++  uplo = 'L' or 'l'   Only the lower triangular part of the
+      ++  symmetric matrix is to be referenced.
+      ++ Unchanged on exit.
+      ++ \item{m}: on entry,  specifies  the number  of rows  of the  matrix C.
+      ++ m  must  be at least  zero. Unchanged on exit.
+      ++ \item{n}: on entry,  specifies the number  of columns of the matrix C.
+      ++ n must be at least zero. Unchanged on exit.
+      ++ \item{alpha}:  on entry, specifies the scalar alpha.
+      ++ Unchanged on exit.
+      ++ \item{A}: before entry  with  side = 'L' or 'l',  the  m by m  part of
+      ++ the array  A  must contain the  symmetric matrix,  such that
+      ++ when  uplo = 'U' or 'u', the leading m by m upper triangular
+      ++ part of the array  A  must contain the upper triangular part
+      ++ of the  symmetric matrix and the  strictly  lower triangular
+      ++ part of  A  is not referenced,  and when  uplo = 'L' or 'l',
+      ++ the leading  m by m  lower triangular part  of the  array  A
+      ++ must  contain  the  lower triangular part  of the  symmetric
+      ++ matrix and the  strictly upper triangular part of  A  is not
+      ++ referenced.
+      ++ Before entry  with  side = 'R' or 'r',  the  n by n  part of
+      ++ the array  A  must contain the  symmetric matrix,  such that
+      ++ when  uplo = 'U' or 'u', the leading n by n upper triangular
+      ++ part of the array  A  must contain the upper triangular part
+      ++ of the  symmetric matrix and the  strictly  lower triangular
+      ++ part of  A  is not referenced,  and when  uplo = 'L' or 'l',
+      ++ the leading  n by n  lower triangular part  of the  array  A
+      ++ must  contain  the  lower triangular part  of the  symmetric
+      ++ matrix and the  strictly upper triangular part of  A  is not
+      ++ referenced. Unchanged on exit.
+      ++ \item{lda}: on entry, specifies the first dimension of A as declared
+      ++ in the calling (sub) program.  When  side = 'L' or 'l'  then
+      ++ lda must be at least  max( 1, m ), otherwise  lda must be at
+      ++ least  max( 1, n ). Unchanged on exit.
+      ++ \item{B}: Before entry, the leading  m by n part of the array  B  must
+      ++ contain the matrix B. Unchanged on exit.
+      ++ \item{ldb}: on entry, ldb specifies the first dimension of B as
+      ++ declared in  the  calling  (sub)  program. ldb  must  be  at 
+      ++ least max( 1, m ).
+      ++ Unchanged on exit.
+      ++ \item{beta}: on entry,  specifies the scalar  beta.  When  beta  is
+      ++ supplied as zero then C need not be set on input. Unchanged on exit.
+      ++ \item{C}: before entry, the leading  m by n  part of the array  C must
+      ++ contain the matrix  C,  except when  beta  is zero, in which
+      ++ case C need not be set on entry. On exit, the array  C  is
+      ++ overwritten by the  m by n updated matrix.
+      ++ \item{ldc}: on entry, specifies the first dimension of C as declared
+      ++ in  the  calling  (sub)  program.   ldc  must  be  at  least
+      ++ max( 1, m ). Unchanged on exit.
+      ++ \end{items}
+
+      symm: (CHAR,CHAR,R,M,M,R,M) -> Void
+      ++ symm(side,uplo,alpha,A,B,beta,C) performs one of 
+      ++ the matrix-matrix operations
+      ++  C := alpha*A*B + beta*C, or C := alpha*B*A + beta*C,
+      ++ where alpha and beta are scalars,  A is a symmetric matrix and  B and
+      ++ C are  m by n matrices.
+      ++ Parameters:
+      ++ \begin{items}
+      ++ \item {side}: on entry,  specifies whether  the  symmetric matrix  A
+      ++ appears on the  left or right  in the  operation as follows:
+      ++  side = 'L' or 'l'   C := alpha*A*B + beta*C,
+      ++  side = 'R' or 'r'   C := alpha*B*A + beta*C,
+      ++ Unchanged on exit.
+      ++ \item{uplo}: on  entry, specifies  whether  the  upper  or  lower
+      ++ triangular  part  of  the  symmetric  matrix   A  is  to  be
+      ++ referenced as follows:
+      ++  uplo = 'U' or 'u'   Only the upper triangular part of the
+      ++  symmetric matrix is to be referenced.
+      ++  uplo = 'L' or 'l'   Only the lower triangular part of the
+      ++  symmetric matrix is to be referenced.
+      ++ Unchanged on exit.
+      ++ \item{alpha}:  on entry, specifies the scalar alpha.
+      ++ Unchanged on exit.
+      ++ \item{A}: before entry  with  side = 'L' or 'l',  the  m by m  part of
+      ++ the array  A  must contain the  symmetric matrix,  such that
+      ++ when  uplo = 'U' or 'u', the leading m by m upper triangular
+      ++ part of the array  A  must contain the upper triangular part
+      ++ of the  symmetric matrix and the  strictly  lower triangular
+      ++ part of  A  is not referenced,  and when  uplo = 'L' or 'l',
+      ++ the leading  m by m  lower triangular part  of the  array  A
+      ++ must  contain  the  lower triangular part  of the  symmetric
+      ++ matrix and the  strictly upper triangular part of  A  is not
+      ++ referenced.
+      ++ Before entry  with  side = 'R' or 'r',  the  n by n  part of
+      ++ the array  A  must contain the  symmetric matrix,  such that
+      ++ when  uplo = 'U' or 'u', the leading n by n upper triangular
+      ++ part of the array  A  must contain the upper triangular part
+      ++ of the  symmetric matrix and the  strictly  lower triangular
+      ++ part of  A  is not referenced,  and when  uplo = 'L' or 'l',
+      ++ the leading  n by n  lower triangular part  of the  array  A
+      ++ must  contain  the  lower triangular part  of the  symmetric
+      ++ matrix and the  strictly upper triangular part of  A  is not
+      ++ referenced. Unchanged on exit.
+      ++ \item{B}: Before entry, the leading  m by n part of the array  B  must
+      ++ contain the matrix B. Unchanged on exit.
+      ++ \item{beta}: on entry,  specifies the scalar  beta.  When  beta  is
+      ++ supplied as zero then C need not be set on input. Unchanged on exit.
+      ++ \item{C}: before entry, the leading  m by n  part of the array  C must
+      ++ contain the matrix  C,  except when  beta  is zero, in which
+      ++ case C need not be set on entry. On exit, the array  C  is
+      ++ overwritten by the  m by n updated matrix.
+      ++ \end{items}
+
+
+      syrk: (CHAR,CHAR,SI,SI,R,M,SI,R,M,SI) -> Void
+      ++ syrk(uplo,trans,n,k,alpha,A,lda,beta,C,ldc) performs one of
+      ++ the symmetric rank k operations
+      ++  C := alpha*A*A' + beta*C, or C := alpha*A'*A + beta*C,
+      ++ where  alpha and beta  are scalars, C is an  n by n  symmetric matrix
+      ++ and  A  is an  n by k  matrix in the first case and a  k by n  matrix
+      ++ in the second case.
+      ++ Parameters:
+      ++ \begin{items}
+      ++ \item{uplo}: on entry, specifies  whether  the  upper  or  lower
+      ++ triangular  part  of the  array  C  is to be  referenced  as
+      ++ follows:
+      ++  uplo = 'U' or 'u'   Only the  upper triangular part of  C
+      ++  is to be referenced.
+      ++  uplo = 'L' or 'l'   Only the  lower triangular part of  C
+      ++  is to be referenced.
+      ++ Unchanged on exit.
+      ++ \item{trans}: on entry, specifies the operation to be performed as
+      ++ follows:
+      ++  trans = 'N' or 'n'   C := alpha*A*A' + beta*C.
+      ++  trans = 'T' or 't'   C := alpha*A'*A + beta*C.
+      ++ Unchanged on exit.
+      ++ \item{n}: on entry, specifies the order of the matrix C.  n must be
+      ++ at least zero. Unchanged on exit.
+      ++ \item{k}: on entry with  trans = 'N' or 'n',  k  specifies  the number
+      ++ of  columns   of  the   matrix   A,   and  on   entry   with
+      ++ trans = 'T' or 't',  k  specifies  the  number
+      ++ of rows of the matrix  A.  K must be at least zero. Unchanged on exit.
+      ++ \item{alpha}:  on entry, specifies the scalar alpha.
+      ++ Unchanged on exit.
+      ++ \item{A}: before entry with  trans = 'N' or 'n',  the  leading  n by k
+      ++ part of the array  A  must contain the matrix  A,  otherwise
+      ++ the leading  k by n  part of the array  A  must contain  the
+      ++ matrix A.  Unchanged on exit.
+      ++ \item{lda}: on entry, specifies the first dimension of A as declared
+      ++ in  the  calling  (sub)  program.   When  trans = 'N' or 'n'
+      ++ then  lda must be at least  max( 1, n ), otherwise  lda must
+      ++ be at least  max( 1, k ). Unchanged on exit.
+      ++ \item{beta}: on entry, specifies the scalar beta. Unchanged on exit.
+      ++ \item{C}: before entry  with  uplo = 'U' or 'u',  the leading  n by n
+      ++ upper triangular part of the array C must contain the upper
+      ++ triangular part  of the  symmetric matrix  and the strictly
+      ++ lower triangular part of C is not referenced.  On exit, the
+      ++ upper triangular part of the array  C is overwritten by the
+      ++ upper triangular part of the updated matrix.
+      ++ Before entry  with  uplo = 'L' or 'l',  the leading  n by n
+      ++ lower triangular part of the array C must contain the lower
+      ++ triangular part  of the  symmetric matrix  and the strictly
+      ++ upper triangular part of C is not referenced.  On exit, the
+      ++ lower triangular part of the array  C is overwritten by the
+      ++ lower triangular part of the updated matrix.
+      ++ \item{ldc}: on entry, specifies the first dimension of C as declared
+      ++ in  the  calling  (sub)  program.   ldc  must  be  at  least
+      ++ max( 1, n ). Unchanged on exit.
+      ++ \end{items}
+
+      syrk: (CHAR,CHAR,R,M,R,M) -> Void
+      ++ syrk(uplo,trans,alpha,A,beta,C) performs one of
+      ++ the symmetric rank k operations
+      ++  C := alpha*A*A' + beta*C, or C := alpha*A'*A + beta*C,
+      ++ where  alpha and beta  are scalars, C is an  n by n  symmetric matrix
+      ++ and  A  is an  n by k  matrix in the first case and a  k by n  matrix
+      ++ in the second case.
+      ++ Parameters:
+      ++ \begin{items}
+      ++ \item{uplo}: on entry, specifies  whether  the  upper  or  lower
+      ++ triangular  part  of the  array  C  is to be  referenced  as
+      ++ follows:
+      ++  uplo = 'U' or 'u'   Only the  upper triangular part of  C
+      ++  is to be referenced.
+      ++  uplo = 'L' or 'l'   Only the  lower triangular part of  C
+      ++  is to be referenced.
+      ++ Unchanged on exit.
+      ++ \item{trans}: on entry, specifies the operation to be performed as
+      ++ follows:
+      ++  trans = 'N' or 'n'   C := alpha*A*A' + beta*C.
+      ++  trans = 'T' or 't'   C := alpha*A'*A + beta*C.
+      ++ Unchanged on exit.
+      ++ \item{alpha}:  on entry, specifies the scalar alpha.
+      ++ Unchanged on exit.
+      ++ \item{A}: before entry with  trans = 'N' or 'n',  the  leading  n by k
+      ++ part of the array  A  must contain the matrix  A,  otherwise
+      ++ the leading  k by n  part of the array  A  must contain  the
+      ++ matrix A.  Unchanged on exit.
+      ++ \item{beta}: on entry, specifies the scalar beta. Unchanged on exit.
+      ++ \item{C}: before entry  with  uplo = 'U' or 'u',  the leading  n by n
+      ++ upper triangular part of the array C must contain the upper
+      ++ triangular part  of the  symmetric matrix  and the strictly
+      ++ lower triangular part of C is not referenced.  On exit, the
+      ++ upper triangular part of the array  C is overwritten by the
+      ++ upper triangular part of the updated matrix.
+      ++ Before entry  with  uplo = 'L' or 'l',  the leading  n by n
+      ++ lower triangular part of the array C must contain the lower
+      ++ triangular part  of the  symmetric matrix  and the strictly
+      ++ upper triangular part of C is not referenced.  On exit, the
+      ++ lower triangular part of the array  C is overwritten by the
+      ++ lower triangular part of the updated matrix.
+      ++ \end{items}
+
+      syr2k: (CHAR,CHAR,SI,SI,R,M,SI,M,SI,R,M,SI) -> Void
+      ++ syr2k(uplo,trans,n,k,alpha,A,lda,B,ldb,beta,C,ldc) performs one
+      ++ of the symmetric rank 2k operations
+      ++  C := alpha*A*B' + alpha*B*A' + beta*C, or
+      ++  C := alpha*A'*B + alpha*B'*A + beta*C,
+      ++ where  alpha and beta  are scalars, C is an  n by n  symmetric matrix
+      ++ and  A and B  are  n by k  matrices  in the  first  case  and  k by n
+      ++ matrices in the second case.
+      ++ Parameters:
+      ++ \begin{items}
+      ++ \item{uplo}: on entry, specifies  whether  the  upper  or  lower
+      ++ triangular  part  of the  array  C  is to be  referenced  as
+      ++ follows:
+      ++  uplo = 'U' or 'u'   Only the  upper triangular part of  C
+      ++  is to be referenced.
+      ++  uplo = 'L' or 'l'   Only the  lower triangular part of  C
+      ++  is to be referenced.
+      ++ Unchanged on exit.
+      ++ \item{trans}: on entry, specifies the operation to be performed as
+      ++ follows:
+      ++  trans = 'N' or 'n'   C := alpha*A*B' + alpha*B*A' + beta*C.
+      ++  trans = 'T' or 't'   C := alpha*A'*B + alpha*B'*A + beta*C.
+      ++ Unchanged on exit.
+      ++ \item{n}: on entry, specifies the order of the matrix C.  n must be
+      ++ at least zero. Unchanged on exit.
+      ++ \item{k}: on entry with  trans = 'N' or 'n',  K  specifies  the number
+      ++ of  columns  of the  matrices  A and B,  and on  entry  with
+      ++ trans = 'T' or 't' or 'C' or 'c',  K  specifies  the  number
+      ++ of rows of the matrices  A and B.  K must be at least  zero.
+      ++ Unchanged on exit.
+      ++ \item{alpha}:  on entry, specifies the scalar alpha.
+      ++ Unchanged on exit.
+      ++ \item{A}: before entry with  trans = 'N' or 'n',  the  leading  n by k
+      ++ part of the array  A  must contain the matrix  A,  otherwise
+      ++ the leading  k by n  part of the array  A  must contain  the
+      ++ matrix A.  Unchanged on exit.
+      ++ \item{lda}: on entry, specifies the first dimension of A as declared
+      ++ in  the  calling  (sub)  program.   When  trans = 'N' or 'n'
+      ++ then  lda must be at least  max( 1, n ), otherwise  lda must
+      ++ be at least  max( 1, k ). Unchanged on exit.
+      ++ \item{B}: before entry with  trans = 'N' or 'n',  the  leading  n by k
+      ++ part of the array  B  must contain the matrix  B,  otherwise
+      ++ the leading  k by n  part of the array  B  must contain  the
+      ++ matrix B.  Unchanged on exit.
+      ++ \item{ldb}: on entry, specifies the first dimension of B as declared
+      ++ in  the  calling  (sub)  program.   When  trans = 'N' or 'n'
+      ++ then  ldb must be at least  max( 1, n ), otherwise  ldb must
+      ++ be at least  max( 1, k ). Unchanged on exit.
+      ++ \item{beta}: on entry, specifies the scalar beta. Unchanged on exit.
+      ++ \item{C}: before entry  with  uplo = 'U' or 'u',  the leading  n by n
+      ++ upper triangular part of the array C must contain the upper
+      ++ triangular part  of the  symmetric matrix  and the strictly
+      ++ lower triangular part of C is not referenced.  On exit, the
+      ++ upper triangular part of the array  C is overwritten by the
+      ++ upper triangular part of the updated matrix.
+      ++ Before entry  with  uplo = 'L' or 'l',  the leading  n by n
+      ++ lower triangular part of the array C must contain the lower
+      ++ triangular part  of the  symmetric matrix  and the strictly
+      ++ upper triangular part of C is not referenced.  On exit, the
+      ++ lower triangular part of the array  C is overwritten by the
+      ++ lower triangular part of the updated matrix.
+      ++ \item{ldc}: on entry, specifies the first dimension of C as declared
+      ++ in  the  calling  (sub)  program.   ldc  must  be  at  least
+      ++ max( 1, n ). Unchanged on exit.
+      ++ \end{items}
+
+      syr2k: (CHAR,CHAR,R,M,M,R,M) -> Void
+      ++ syr2k(uplo,trans,alpha,A,B,beta,C) performs one
+      ++ of the symmetric rank 2k operations
+      ++  C := alpha*A*B' + alpha*B*A' + beta*C, or
+      ++  C := alpha*A'*B + alpha*B'*A + beta*C,
+      ++ where  alpha and beta  are scalars, C is an  n by n  symmetric matrix
+      ++ and  A and B  are  n by k  matrices  in the  first  case  and  k by n
+      ++ matrices in the second case.
+      ++ Parameters:
+      ++ \begin{items}
+      ++ \item{uplo}: on entry, specifies  whether  the  upper  or  lower
+      ++ triangular  part  of the  array  C  is to be  referenced  as
+      ++ follows:
+      ++  uplo = 'U' or 'u'   Only the  upper triangular part of  C
+      ++  is to be referenced.
+      ++  uplo = 'L' or 'l'   Only the  lower triangular part of  C
+      ++  is to be referenced.
+      ++ Unchanged on exit.
+      ++ \item{trans}: on entry, specifies the operation to be performed as
+      ++ follows:
+      ++  trans = 'N' or 'n'   C := alpha*A*B' + alpha*B*A' + beta*C.
+      ++  trans = 'T' or 't'   C := alpha*A'*B + alpha*B'*A + beta*C.
+      ++ Unchanged on exit.
+      ++ \item{alpha}:  on entry, specifies the scalar alpha.
+      ++ Unchanged on exit.
+      ++ \item{A}: before entry with  trans = 'N' or 'n',  the  leading  n by k
+      ++ part of the array  A  must contain the matrix  A,  otherwise
+      ++ the leading  k by n  part of the array  A  must contain  the
+      ++ matrix A.  Unchanged on exit.
+      ++ \item{B}: before entry with  trans = 'N' or 'n',  the  leading  n by k
+      ++ part of the array  B  must contain the matrix  B,  otherwise
+      ++ the leading  k by n  part of the array  B  must contain  the
+      ++ matrix B.  Unchanged on exit.
+      ++ \item{beta}: on entry, specifies the scalar beta. Unchanged on exit.
+      ++ \item{C}: before entry  with  uplo = 'U' or 'u',  the leading  n by n
+      ++ upper triangular part of the array C must contain the upper
+      ++ triangular part  of the  symmetric matrix  and the strictly
+      ++ lower triangular part of C is not referenced.  On exit, the
+      ++ upper triangular part of the array  C is overwritten by the
+      ++ upper triangular part of the updated matrix.
+      ++ Before entry  with  uplo = 'L' or 'l',  the leading  n by n
+      ++ lower triangular part of the array C must contain the lower
+      ++ triangular part  of the  symmetric matrix  and the strictly
+      ++ upper triangular part of C is not referenced.  On exit, the
+      ++ lower triangular part of the array  C is overwritten by the
+      ++ lower triangular part of the updated matrix.
+      ++ \end{items}
+
+  Implementation  == add
+
+      gemm(transa:CHAR,transb:CHAR,m:SI,n:SI,k:SI,alpha:R,A:M,lda:SI,B:M,ldb:SI,beta:R,C:M,ldc:SI): Void ==
+        DGEMM(transa,transb,m,n,k,alpha,A,lda,B,ldb,beta,C,ldc)$Lisp
+
+      gemm(transa:CHAR,transb:CHAR,alpha:R,A:M,B:M,beta:R,C:M): Void ==
+        nra := nrows(A)::SI
+        nca := ncols(A)::SI
+        ldb := nrows(B)::SI
+        ldc := nrows(C)::SI
+        if transa = char "N" then
+          ldc < nra => error "gemm: nrows(C) must be at least nrows(A)"
+          if transb = char "N" then
+            ncopb := ncols(B)::SI
+            ldb < nca => error "gemm: nrows(B) must be at least ncols(A)"
+            ncols(C) < ncopb => error "gemm: ncols(C) must be at least ncols(B)"
+            DGEMM(transa,transb,nra,ncopb,nca,alpha,A,nra,B,ldb,beta,C,ldc)$Lisp
+          else if transb = char "T" then
+            ncols(B) < nca => error "gemm: ncols(B) must be at least ncols(A)"
+            ncols(C) < ldb => error "gemm: ncols(C) must be at least nrows(B)"
+            DGEMM(transa,transb,nra,ldb,nca,alpha,A,nra,B,ldb,beta,C,ldc)$Lisp
+          else
+            error "gemm: transb must be N or T"
+        else if transa = char "T" then
+          ldc < nca => error "gemm: nrows(C) must be at least ncols(A)"
+          if transb = char "N" then
+            ncopb := ncols(B)::SI
+            ldb < nra => error "gemm: nrows(B) must be at least nrows(A)"
+            ncols(C) < ncopb => error "gemm: ncols(C) must be at least ncols(B)"
+            DGEMM(transa,transb,nca,ncopb,nra,alpha,A,nra,B,ldb,beta,C,ldc)$Lisp
+          else if transb = char "T" then
+            ncols(B) < nra => error "gemm: ncols(B) must be at least ncols(A)"
+            ncols(C) < ldb => error "gemm: ncols(C) must be at least nrows(B)"
+            DGEMM(transa,transb,nca,ldb,nra,alpha,A,nra,B,ldb,beta,C,ldc)$Lisp
+          else
+            error "gemm: transb must be N or T"
+        else
+          error "gemm: transa must be N or T"
+
+      symm(side:CHAR,uplo:CHAR,m:SI,n:SI,alpha:R,A:M,lda:SI,B:M,ldb:SI,beta:R,C:M,ldc:SI): Void ==
+        DSYMM(side,uplo,m,n,alpha,A,lda,B,ldb,beta,C,ldc)$Lisp
+
+      symm(side:CHAR,uplo:CHAR,alpha:R,A:M,B:M,beta:R,C:M): Void ==
+        uplo ~= char "u" and uplo ~= char "U" and uplo ~= char "l" and uplo ~= char "L"
+          => error "symm: uplo must be one of the following values: u, U, l or L"
+        if side = char "l" or side = char "L" then
+          m := nrows(A)::SI;
+          n := ncols(B)::SI;
+          ncols(A) < m => error "symm: ncols(A) must be at least nrows(A)"
+          (ldb := nrows(B)::SI) < m => error "symm: nrows(B) must be at least nrows(A)"
+          (ldc := nrows(C)::SI) < m => error "symm: nrows(C) must be at least nrows(A)"
+          ncols(C) < n => error "symm: ncols(C) must be at least ncols(B)"
+          DSYMM(side,uplo,m,n,alpha,A,m,B,ldb,beta,C,ldc)$Lisp
+        else if side = char "r" or side = char "R" then
+          n := ncols(A)::SI;
+          m := nrows(B)::SI;
+          nrows(A) < n => error "symm: nrows(A) must be at least ncols(A)"
+          ncols(B) < n => error "symm: ncols(B) must be at least ncols(A)"
+          (ldc := nrows(C)::SI) < m => error "symm: nrows(C) must be at least nrows(B)"
+          ncols(C) < n => error "symm: ncols(C) must be at least ncols(A)"
+          DSYMM(side,uplo,m,n,alpha,A,n,B,m,beta,C,ldc)$Lisp
+        else
+          error "symm: side must be one of the following values: l, L, r or R"
+ 
+      syrk(uplo:CHAR,trans:CHAR,n:SI,k:SI,alpha:R,A:M,lda:SI,beta:R,C:M,ldc:SI): Void ==
+        DSYRK(uplo,trans,n,k,alpha,A,lda,beta,C,ldc)$Lisp
+
+      syrk(uplo:CHAR,trans:CHAR,alpha:R,A:M,beta:R,C:M): Void ==
+        nra := nrows(A)::SI
+        nca := ncols(A)::SI
+        uplo ~= char "u" and uplo ~= char "U" and uplo ~= char "l" and uplo ~= char "L"
+          => error "syrk: uplo must be one of the following values: u, U, l or L"
+        if trans = char "n" or trans = char "N" then
+          (ldc := nrows(C)::SI) < nra => error "syrk: nrows(C) must be at least nrows(A)"
+          ncols(C) < nra => error "syrk: ncols(C) must be at least nrows(A)"
+          DSYRK(uplo,trans,nra,nca,alpha,A,nra,beta,C,ldc)$Lisp
+        else if trans = char "t" or trans = char "T" then
+          (ldc := nrows(C)::SI) < nca => error "syrk: nrows(C) must be at least ncols(A)"
+          ncols(C) < nca => error "syrk: ncols(C) must be at least ncols(A)"
+          DSYRK(uplo,trans,nca,nra,alpha,A,nra,beta,C,ldc)$Lisp
+        else
+          error "syrk: trans must be one of the following values: n, N, t or T"
+
+      syr2k(uplo:CHAR,trans:CHAR,n:SI,k:SI,alpha:R,A:M,lda:SI,B:M,ldb:SI,beta:R,C:M,ldc:SI): Void ==
+        DSYR2K(uplo,trans,n,k,alpha,A,lda,B,ldb,beta,C,ldc)$Lisp
+
+      syr2k(uplo:CHAR,trans:CHAR,alpha:R,A:M,B:M,beta:R,C:M): Void ==
+        nra := nrows(A)::SI
+        nca := ncols(A)::SI
+        uplo ~= char "u" and uplo ~= char "U" and uplo ~= char "l" and uplo ~= char "L"
+          => error "syr2k: uplo must be one of the following values: u, U, l or L"
+        if trans = char "n" or trans = char "N" then
+          (ldb := nrows(B)::SI) < nra => error "syr2k: nrows(B) must be at least nrows(A)"
+          ncols(B) < nca => error "syr2k: ncols(B) must be at least ncols(A)"
+          (ldc := nrows(C)::SI) < nra => error "syr2k: nrows(C) must be at least nrows(A)"
+          ncols(C) < nra => error "syr2k: ncols(C) must be at least nrows(A)"
+          DSYR2K(uplo,trans,nra,nca,alpha,A,nra,B,ldb,beta,C,ldc)$Lisp
+        else if trans = char "t" or trans = char "T" then
+          (ldb := nrows(B)::SI) < nra => error "syr2k: nrows(B) must be at least nrows(A)"
+          ncols(B) < nca => error "syr2k: ncols(B) must be at least ncols(A)"
+          (ldc := nrows(C)::SI) < nca => error "syr2k: nrows(C) must be at least ncols(A)"
+          ncols(C) < nca => error "syr2k: ncols(C) must be at least ncols(A)"
+          DSYR2K(uplo,trans,nca,nra,alpha,A,nra,B,ldb,beta,C,ldc)$Lisp
+        else
+          error "syr2k: trans must be one of the following values: n, N, t or T"
+
+
+@
+<<BLAS3.dotabb>>=
+"BLAS3" [color="#FF4488",href="bookvol10.4.pdf#nameddest=BLAS3"]
+"FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"]
+"ACF" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACF"]
+"BLAS3" -> "FS"
+"BLAS3" -> "ACF"
+
+@
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{package LAPACK Lapack}
+\pagehead{Lapack}{LAPACK}
+%\pagepic{ps/v104lapack.ps}{LAPACK}{1.00}
+
+{\bf Exports:}\\
+\begin{tabular}{lllll}
+\cross{LAPACK}{?**?} &
+\end{tabular}
+
+<<package LAPACK Lapack>>=
+)abbrev package LAPACK Lapack
+++ Author: Gregory Vanuxem
+++ Date Created: 2006
+++ Date Last Updated: Nov 11, 2006
+++ Basic Operations: 
+++ Related Domains: ColumnMajorTwoDimensionnalArray
+++ Also See:
+++ AMS Classifications:
+++ Keywords:
+++ Examples:
+++ References:
+++ Description:
+++    This package provides an interface to the
+++    LAPack library
+-- TODO: "at least" verification
+Lapack(Row,Col,M) : Exports == Implementation where
+
+  R    ==> DoubleFloat
+  SI   ==> SingleInteger
+  CHAR ==> Character
+  VSI  ==> Vector(SI) -- Vector has contiguousStorage
+  VSF  ==> Vector(R) -- Vector has contiguousStorage
+  Row  :   OneDimensionalArrayAggregate(R) with contiguousStorage
+  Col  :   OneDimensionalArrayAggregate(R) with contiguousStorage
+  M    :   ColumnMajorTwoDimensionalArrayCategory(R,Row,Col)
+
+  Exports == with
+
+      getrf: (SI,SI,M,SI,VSI) -> SI
+      ++ gemm(transa,transb,m,n,k,alpha,A,lda,B,ldb,beta,C,ldc) performs one
+      ++ of the matrix-matrix operations
+
+      getri: (SI,M,SI,VSI,VSF,SI) -> SI
+      ++ gemm(transa,transb,m,n,k,alpha,A,lda,B,ldb,beta,C,ldc) performs one
+      ++ of the matrix-matrix operations
+
+  Implementation  == add
+
+      getrf(m:SI,n:SI,A:M,lda:SI,ipiv:VSI): SI ==
+        DGETRF(m,n,A,lda,ipiv)$Lisp
+
+      getri(n:SI,A:M,lda:SI,ipiv:VSI,work:VSF,lwork:SI): SI ==
+        DGETRI(n,A,lda,ipiv,work,lwork)$Lisp
+
+@
+<<LAPACK.dotabb>>=
+"LAPACK" [color="#FF4488",href="bookvol10.4.pdf#nameddest=LAPACK"]
+"FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"]
+"ACF" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACF"]
+"LAPACK" -> "FS"
+"LAPACK" -> "ACF"
+
+@
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\chapter{Chapter A}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\chapter{Chapter B}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\chapter{Chapter C}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\chapter{Chapter D}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dasum BLAS}
+\pagehead{dasum}{dasum}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+Computes doublefloat $asum \leftarrow ||re(x)||_1 + ||im(x)||_1$
+
+Arguments are:
+\begin{itemize}
+\item n - fixnum
+\item dx - array doublefloat
+\item incx - fixnum
+\end{itemize}
+
+Return values are:
+\begin{itemize}
+\item 1 nil
+\item 2 nil
+\item 3 nil
+\end{itemize}
+
+<<BLAS 1 dasum>>=
+(defun dasum (n dx incx)
+ (declare (type (array double-float (*)) dx)
+          (type fixnum incx n))
+ (f2cl-lib:with-multi-array-data ((dx double-float dx-%data% dx-%offset%))
+ (prog ((i 0) (m 0) (mp1 0) (nincx 0) (dtemp 0.0) (dasum 0.0))
+  (declare (type (double-float) dasum dtemp)
+           (type fixnum nincx mp1 m i))
+   (setf dasum 0.0)
+   (setf dtemp 0.0)
+   (if (or (<= n 0) (<= incx 0)) (go end_label))
+   (if (= incx 1) (go label20))
+   (setf nincx (f2cl-lib:int-mul n incx))
+   (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i incx))
+                 ((> i nincx) nil)
+     (tagbody
+      (setf dtemp
+       (the double-float 
+        (+ (the double-float dtemp)
+           (the double-float (abs
+            (the double-float
+              (f2cl-lib:fref dx-%data% (i) ((1 *)) dx-%offset%)))))))))
+   (setf dasum dtemp)
+   (go end_label)
+ label20
+   (setf m (mod n 6))
+   (if (= m 0) (go label40))
+   (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                 ((> i m) nil)
+     (tagbody
+      (setf dtemp
+       (the double-float 
+        (+ (the double-float dtemp)
+           (the double-float (abs
+            (the double-float
+              (f2cl-lib:fref dx-%data% (i) ((1 *)) dx-%offset%)))))))))
+   (if (< n 6) (go label60))
+ label40
+   (setf mp1 (f2cl-lib:int-add m 1))
+   (f2cl-lib:fdo (i mp1 (f2cl-lib:int-add i 6))
+                 ((> i n) nil)
+     (tagbody
+      (setf dtemp
+       (the double-float 
+        (+ (the double-float dtemp)
+         (the double-float (abs
+          (the double-float
+           (f2cl-lib:fref dx-%data% (i) ((1 *)) dx-%offset%))))
+         (the double-float (abs
+          (the double-float
+           (f2cl-lib:fref
+             dx-%data% ((f2cl-lib:int-add i 1)) ((1 *)) dx-%offset%))))
+         (the double-float (abs
+          (the double-float
+           (f2cl-lib:fref 
+             dx-%data% ((f2cl-lib:int-add i 2)) ((1 *)) dx-%offset%))))
+         (the double-float (abs
+          (the double-float
+           (f2cl-lib:fref
+             dx-%data% ((f2cl-lib:int-add i 3)) ((1 *)) dx-%offset%))))
+         (the double-float (abs
+          (the double-float
+           (f2cl-lib:fref 
+             dx-%data% ((f2cl-lib:int-add i 4)) ((1 *)) dx-%offset%))))
+         (the double-float (abs
+          (the double-float
+           (f2cl-lib:fref 
+             dx-%data% ((f2cl-lib:int-add i 5)) ((1 *)) dx-%offset%)))))))))
+ label60
+   (setf dasum dtemp)
+ end_label
+   (return (values dasum nil nil nil)))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{daxpy BLAS}
+\pagehead{daxpy}{daxpy}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+Computes doublefloat $y \leftarrow \alpha{}x + y$
+
+Arguments are:
+\begin{itemize}
+\item n - fixnum
+\item da - doublefloat
+\item dx - array doublefloat
+\item incx - fixnum
+\item dy - array doublefloat
+\item incy - fixnum
+\end{itemize}
+
+Return values are:
+\begin{itemize}
+\item 1 nil
+\item 2 nil
+\item 3 nil
+\item 4 nil
+\item 5 nil
+\item 6 nil
+\end{itemize}
+
+<<BLAS 1 daxpy>>=
+(defun daxpy (n da dx incx dy incy)
+ (declare (type (array double-float (*)) dy dx)
+          (type (double-float) da)
+          (type fixnum incy incx n))
+ (f2cl-lib:with-multi-array-data
+   ((dx double-float dx-%data% dx-%offset%)
+    (dy double-float dy-%data% dy-%offset%))
+   (prog ((i 0) (ix 0) (iy 0) (m 0) (mp1 0))
+    (declare (type fixnum mp1 m iy ix i))
+     (if (<= n 0) (go end_label))
+     (if (= da 0.0) (go end_label))
+     (if (and (= incx 1) (= incy 1)) (go label20))
+     (setf ix 1)
+     (setf iy 1)
+     (if (< incx 0)
+      (setf ix
+       (f2cl-lib:int-add (f2cl-lib:int-mul (f2cl-lib:int-sub 1 n) incx) 1)))
+     (if (< incy 0)
+      (setf iy
+       (f2cl-lib:int-add (f2cl-lib:int-mul (f2cl-lib:int-sub 1 n) incy) 1)))
+     (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                   ((> i n) nil)
+      (tagbody
+        (setf (f2cl-lib:fref dy-%data% (iy) ((1 *)) dy-%offset%)
+         (+ (f2cl-lib:fref dy-%data% (iy) ((1 *)) dy-%offset%)
+          (* da (f2cl-lib:fref dx-%data% (ix) ((1 *)) dx-%offset%))))
+        (setf ix (f2cl-lib:int-add ix incx))
+        (setf iy (f2cl-lib:int-add iy incy))))
+     (go end_label)
+ label20
+     (setf m (mod n 4))
+     (if (= m 0) (go label40))
+     (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                   ((> i m) nil)
+      (tagbody
+       (setf (f2cl-lib:fref dy-%data% (i) ((1 *)) dy-%offset%)
+        (+ (f2cl-lib:fref dy-%data% (i) ((1 *)) dy-%offset%)
+         (* da (f2cl-lib:fref dx-%data% (i) ((1 *)) dx-%offset%))))))
+     (if (< n 4) (go end_label))
+ label40
+     (setf mp1 (f2cl-lib:int-add m 1))
+     (f2cl-lib:fdo (i mp1 (f2cl-lib:int-add i 4))
+                   ((> i n) nil)
+       (tagbody
+        (setf (f2cl-lib:fref dy-%data% (i) ((1 *)) dy-%offset%)
+         (+ (f2cl-lib:fref dy-%data% (i) ((1 *)) dy-%offset%)
+          (* da (f2cl-lib:fref dx-%data% (i) ((1 *)) dx-%offset%))))
+        (setf 
+         (f2cl-lib:fref dy-%data% ((f2cl-lib:int-add i 1)) ((1 *)) dy-%offset%)
+         (+ (f2cl-lib:fref 
+              dy-%data% ((f2cl-lib:int-add i 1)) ((1 *)) dy-%offset%)
+          (* da (f2cl-lib:fref
+                  dx-%data% ((f2cl-lib:int-add i 1)) ((1 *)) dx-%offset%))))
+        (setf 
+         (f2cl-lib:fref dy-%data% ((f2cl-lib:int-add i 2)) ((1 *)) dy-%offset%)
+         (+ (f2cl-lib:fref 
+              dy-%data% ((f2cl-lib:int-add i 2)) ((1 *)) dy-%offset%)
+          (* da (f2cl-lib:fref
+                  dx-%data% ((f2cl-lib:int-add i 2)) ((1 *)) dx-%offset%))))
+        (setf 
+         (f2cl-lib:fref dy-%data% ((f2cl-lib:int-add i 3)) ((1 *)) dy-%offset%)
+         (+ (f2cl-lib:fref
+              dy-%data% ((f2cl-lib:int-add i 3)) ((1 *)) dy-%offset%)
+          (* da (f2cl-lib:fref 
+                  dx-%data% ((f2cl-lib:int-add i 3)) ((1 *)) dx-%offset%))))))
+ end_label
+   (return (values nil nil nil nil nil nil)))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dbdsdc LAPACK}
+\pagehead{dbdsdc}{dbdsdc}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+The input arguments are:
+\begin{itemize}
+\item uplo - simple-array character (1)
+\item compq - (simple-array character (1)
+\item n - fixnum
+\item d - array doublefloat
+\item e - array doublefloat
+\item u - array doublefloat
+\item ldu - fixnum
+\item vt - doublefloat
+\item ldvt - fixnum
+\item q - array doublefloat
+\item iq - array fixnum
+\item work - array doublefloat
+\item iwork - array fixnum
+\item info - fixnum
+\end{itemize}
+
+The return values are:
+\begin{itemize}
+\item uplo - nil
+\item compq - nil
+\item n - nil
+\item d - nil
+\item e - nil
+\item u - nil
+\item ldu - nil
+\item vt - nil
+\item ldvt - nil
+\item q - nil
+\item iq - nil
+\item work - nil
+\item iwork - nil
+\item info - info
+\end{itemize}
+
+\calls{dbdsdc}{dlasr}
+\calls{dbdsdc}{dswap}
+\calls{dbdsdc}{dlasda}
+\calls{dbdsdc}{dlasd0}
+\calls{dbdsdc}{dlamch}
+\calls{dbdsdc}{dlascl}
+\calls{dbdsdc}{dlanst}
+\calls{dbdsdc}{dlaset}
+\calls{dbdsdc}{dlasdq}
+\calls{dbdsdc}{dlartg}
+\calls{dbdsdc}{dcopy}
+\calls{dbdsdc}{ilaenv}
+\calls{dbdsdc}{xerbla}
+\calls{dbdsdc}{lsame}
+
+<<LAPACK dbdsdc>>=
+(let* ((zero 0.0) (one 1.0) (two 2.0))
+ (declare (type (double-float 0.0 0.0) zero)
+          (type (double-float 1.0 1.0) one)
+          (type (double-float 2.0 2.0) two))
+ (defun dbdsdc (uplo compq n d e u ldu vt ldvt q iq work iwork info)
+  (declare (type (array fixnum (*)) iwork iq)
+           (type (array double-float (*)) work q vt u e d)
+           (type fixnum info ldvt ldu n)
+           (type (simple-array character (*)) compq uplo))
+   (f2cl-lib:with-multi-array-data
+    ((uplo character uplo-%data% uplo-%offset%)
+     (compq character compq-%data% compq-%offset%)
+     (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%)
+     (q double-float q-%data% q-%offset%)
+     (work double-float work-%data% work-%offset%)
+     (iq fixnum iq-%data% iq-%offset%)
+     (iwork fixnum iwork-%data% iwork-%offset%))
+    (prog ((cs 0.0) (eps 0.0) (orgnrm 0.0) (p 0.0) (r 0.0) (sn 0.0) (difl 0)
+           (difr 0) (givcol 0) (givnum 0) (givptr 0) (i 0) (ic 0) (icompq 0)
+           (ierr 0) (ii 0) (is 0) (iu 0) (iuplo 0) (ivt 0) (j 0) (k 0) (kk 0)
+           (mlvl 0) (nm1 0) (nsize 0) (perm 0) (poles 0) (qstart 0)
+           (smlsiz 0) (smlszp 0) (sqre 0) (start 0) (wstart 0) (z 0))
+     (declare (type (double-float) cs eps orgnrm p r sn)
+              (type fixnum difl difr givcol givnum givptr i ic
+                                        icompq ierr ii is iu iuplo ivt j k
+                                        kk mlvl nm1 nsize perm poles qstart
+                                        smlsiz smlszp sqre start wstart z))
+      (setf info 0)
+      (setf iuplo 0)
+      (if (lsame uplo "U") (setf iuplo 1))
+      (if (lsame uplo "L") (setf iuplo 2))
+      (cond
+       ((lsame compq "N") (setf icompq 0))
+       ((lsame compq "P") (setf icompq 1))
+       ((lsame compq "I") (setf icompq 2))
+       (t                 (setf icompq -1)))
+      (cond
+       ((= iuplo 0)                                   (setf info -1))
+       ((< icompq 0)                                  (setf info -2))
+       ((< n 0)                                       (setf info -3))
+       ((or (< ldu 1) (and (= icompq 2) (< ldu n)))   (setf info -7))
+       ((or (< ldvt 1) (and (= icompq 2) (< ldvt n))) (setf info -9)))
+      (cond
+       ((/= info 0)
+        (xerbla "DBDSDC" (f2cl-lib:int-sub info))
+        (go end_label)))
+      (if (= n 0) (go end_label))
+      (setf smlsiz (ilaenv 9 "DBDSDC" " " 0 0 0 0))
+      (cond
+       ((= n 1)
+        (cond
+         ((= icompq 1)
+          (setf 
+           (f2cl-lib:fref q-%data% (1) ((1 *)) q-%offset%)
+           (f2cl-lib:sign one
+            (f2cl-lib:fref d-%data% (1) ((1 *)) d-%offset%)))
+          (setf 
+           (f2cl-lib:fref q-%data%
+            ((f2cl-lib:int-add 1 
+             (f2cl-lib:int-mul smlsiz n))) ((1 *)) q-%offset%)
+           one))
+         ((= icompq 2)
+          (setf 
+           (f2cl-lib:fref u-%data% (1 1) ((1 ldu) (1 *)) u-%offset%)
+           (f2cl-lib:sign one (f2cl-lib:fref d-%data% (1) ((1 *)) d-%offset%)))
+          (setf
+            (f2cl-lib:fref vt-%data% (1 1) ((1 ldvt) (1 *)) vt-%offset%)
+            one)))
+        (setf (f2cl-lib:fref d-%data% (1) ((1 *)) d-%offset%)
+               (abs (f2cl-lib:fref d-%data% (1) ((1 *)) d-%offset%)))
+        (go end_label)))
+      (setf nm1 (f2cl-lib:int-sub n 1))
+      (setf wstart 1)
+      (setf qstart 3)
+      (cond
+       ((= icompq 1)
+        (dcopy n d 1 (f2cl-lib:array-slice q double-float (1) ((1 *))) 1)
+        (dcopy (f2cl-lib:int-sub n 1) e 1
+          (f2cl-lib:array-slice q double-float ((+ n 1)) ((1 *))) 1)))
+      (cond
+       ((= iuplo 2)
+        (setf qstart 5)
+        (setf wstart (f2cl-lib:int-sub (f2cl-lib:int-mul 2 n) 1))
+        (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                      ((> i (f2cl-lib:int-add n (f2cl-lib:int-sub 1))) nil)
+         (tagbody
+          (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+           (dlartg (f2cl-lib:fref d-%data% (i) ((1 *)) d-%offset%)
+                   (f2cl-lib:fref e-%data% (i) ((1 *)) e-%offset%) cs sn r)
+            (declare (ignore var-0 var-1))
+            (setf cs var-2)
+            (setf sn var-3)
+            (setf r var-4))
+            (setf (f2cl-lib:fref d-%data% (i) ((1 *)) d-%offset%) r)
+            (setf 
+             (f2cl-lib:fref e-%data% (i) ((1 *)) e-%offset%)
+             (* sn (f2cl-lib:fref 
+                     d-%data% ((f2cl-lib:int-add i 1)) ((1 *)) d-%offset%)))
+            (setf 
+             (f2cl-lib:fref d-%data%
+               ((f2cl-lib:int-add i 1)) ((1 *)) d-%offset%)
+             (* cs (f2cl-lib:fref 
+                     d-%data% ((f2cl-lib:int-add i 1)) ((1 *)) d-%offset%)))
+            (cond
+             ((= icompq 1)
+              (setf 
+               (f2cl-lib:fref q-%data% 
+                ((f2cl-lib:int-add i (f2cl-lib:int-mul 2 n)))
+                 ((1 *)) q-%offset%)
+               cs)
+              (setf 
+               (f2cl-lib:fref q-%data%
+                ((f2cl-lib:int-add i (f2cl-lib:int-mul 3 n)))
+                 ((1 *)) q-%offset%)
+               sn))
+             ((= icompq 2)
+              (setf (f2cl-lib:fref work-%data% (i) ((1 *)) work-%offset%) cs)
+              (setf 
+               (f2cl-lib:fref work-%data%
+                ((f2cl-lib:int-add nm1 i)) ((1 *)) work-%offset%)
+               (- sn))))))))
+      (cond
+       ((= icompq 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)
+         (dlasdq "U" 0 n 0 0 0 d e vt ldvt u ldu u ldu
+          (f2cl-lib:array-slice work double-float (wstart) ((1 *))) 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 label40)))
+      (cond
+       ((<= n smlsiz)
+        (cond
+         ((= icompq 2)
+          (dlaset "A" n n zero one u ldu)
+          (dlaset "A" n n zero one vt ldvt)
+          (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" 0 n n n 0 d e vt ldvt u ldu u ldu
+            (f2cl-lib:array-slice work double-float (wstart) ((1 *)))
+            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)))
+         ((= icompq 1)
+          (setf iu 1)
+          (setf ivt (f2cl-lib:int-add iu n))
+          (dlaset "A" n n zero one
+           (f2cl-lib:array-slice q double-float
+            ((+ iu 
+                (f2cl-lib:int-mul 
+                 (f2cl-lib:int-add qstart (f2cl-lib:int-sub 1)) n)))
+            ((1 *)))
+           n)
+          (dlaset "A" n n zero one
+           (f2cl-lib:array-slice q double-float
+            ((+ ivt
+                (f2cl-lib:int-mul
+                 (f2cl-lib:int-add qstart (f2cl-lib:int-sub 1)) n)))
+            ((1 *)))
+           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 var-13 var-14 var-15)
+           (dlasdq "U" 0 n n n 0 d e
+            (f2cl-lib:array-slice q double-float
+             ((+ ivt
+                 (f2cl-lib:int-mul
+                  (f2cl-lib:int-add qstart (f2cl-lib:int-sub 1))
+                  n)))
+             ((1 *)))
+            n
+            (f2cl-lib:array-slice q double-float
+             ((+ iu
+                 (f2cl-lib:int-mul
+                  (f2cl-lib:int-add qstart (f2cl-lib:int-sub 1))
+                  n)))
+             ((1 *)))
+             n
+             (f2cl-lib:array-slice q double-float
+              ((+ iu
+                  (f2cl-lib:int-mul
+                   (f2cl-lib:int-add qstart (f2cl-lib:int-sub 1))
+                   n)))
+              ((1 *)))
+              n 
+              (f2cl-lib:array-slice work double-float (wstart) ((1 *)))
+              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 label40)))
+      (cond
+       ((= icompq 2)
+        (dlaset "A" n n zero one u ldu)
+        (dlaset "A" n n zero one vt ldvt)))
+      (setf orgnrm (dlanst "M" n d e))
+      (if (= orgnrm zero) (go end_label))
+      (multiple-value-bind
+        (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9)
+        (dlascl "G" 0 0 orgnrm one n 1 d n ierr)
+        (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                  var-8))
+        (setf ierr var-9))
+      (multiple-value-bind
+       (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9)
+       (dlascl "G" 0 0 orgnrm one nm1 1 e nm1 ierr)
+       (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                 var-8))
+       (setf ierr var-9))
+      (setf eps (dlamch "Epsilon"))
+      (setf mlvl
+       (f2cl-lib:int-add
+        (f2cl-lib:int
+         (/
+          (f2cl-lib:flog
+           (/ (coerce (realpart n) 'double-float)
+              (coerce (realpart (f2cl-lib:int-add smlsiz 1)) 'double-float)))
+          (f2cl-lib:flog two)))
+         1))
+      (setf smlszp (f2cl-lib:int-add smlsiz 1))
+      (cond
+       ((= icompq 1)
+        (setf iu 1)
+        (setf ivt (f2cl-lib:int-add 1 smlsiz))
+        (setf difl (f2cl-lib:int-add ivt smlszp))
+        (setf difr (f2cl-lib:int-add difl mlvl))
+        (setf z (f2cl-lib:int-add difr (f2cl-lib:int-mul mlvl 2)))
+        (setf ic (f2cl-lib:int-add z mlvl))
+        (setf is (f2cl-lib:int-add ic 1))
+        (setf poles (f2cl-lib:int-add is 1))
+        (setf givnum (f2cl-lib:int-add poles (f2cl-lib:int-mul 2 mlvl)))
+        (setf k 1)
+        (setf givptr 2)
+        (setf perm 3)
+         (setf givcol (f2cl-lib:int-add perm mlvl))))
+      (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                    ((> i n) nil)
+       (tagbody
+        (cond
+         ((< (abs (f2cl-lib:fref d (i) ((1 *)))) eps)
+          (setf 
+           (f2cl-lib:fref d-%data% (i) ((1 *)) d-%offset%)
+           (f2cl-lib:sign eps 
+            (f2cl-lib:fref d-%data% (i) ((1 *)) d-%offset%)))))))
+      (setf start 1)
+      (setf sqre 0)
+      (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                    ((> i nm1) nil)
+       (tagbody
+        (cond
+         ((or (< (abs (f2cl-lib:fref e (i) ((1 *)))) eps) (= i nm1))
+          (cond
+           ((< i nm1)
+            (setf nsize (f2cl-lib:int-add (f2cl-lib:int-sub i start) 1)))
+           ((>= (abs (f2cl-lib:fref e (i) ((1 *)))) eps)
+            (setf nsize (f2cl-lib:int-add (f2cl-lib:int-sub n start) 1)))
+           (t
+            (setf nsize (f2cl-lib:int-add (f2cl-lib:int-sub i start) 1))
+            (cond
+             ((= icompq 2)
+              (setf 
+               (f2cl-lib:fref u-%data% (n n) ((1 ldu) (1 *)) u-%offset%)
+               (f2cl-lib:sign one 
+                (f2cl-lib:fref d-%data% (n) ((1 *)) d-%offset%)))
+              (setf 
+               (f2cl-lib:fref vt-%data% (n n) ((1 ldvt) (1 *)) vt-%offset%)
+               one))
+             ((= icompq 1)
+              (setf 
+               (f2cl-lib:fref q-%data% 
+                ((f2cl-lib:int-add n 
+                 (f2cl-lib:int-mul (f2cl-lib:int-sub qstart 1) n)))
+                  ((1 *)) q-%offset%)
+               (f2cl-lib:sign one 
+                (f2cl-lib:fref d-%data% (n) ((1 *)) d-%offset%)))
+              (setf 
+               (f2cl-lib:fref q-%data%
+                ((f2cl-lib:int-add n
+                 (f2cl-lib:int-mul
+                  (f2cl-lib:int-sub
+                   (f2cl-lib:int-add smlsiz qstart) 1) n)))
+                ((1 *)) q-%offset%)
+               one)))
+              (setf
+               (f2cl-lib:fref d-%data% (n) ((1 *)) d-%offset%)
+               (abs (f2cl-lib:fref d-%data% (n) ((1 *)) d-%offset%)))))
+          (cond
+           ((= icompq 2)
+            (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)
+             (dlasd0 nsize sqre
+              (f2cl-lib:array-slice d double-float (start) ((1 *)))
+              (f2cl-lib:array-slice e double-float (start) ((1 *)))
+              (f2cl-lib:array-slice u double-float 
+               (start start) ((1 ldu) (1 *)))
+              ldu
+              (f2cl-lib:array-slice vt double-float
+               (start start) ((1 ldvt) (1 *)))
+              ldvt 
+              smlsiz 
+              iwork
+              (f2cl-lib:array-slice work double-float (wstart) ((1 *))) 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))
+             (setf info var-11)))
+           (t
+            (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
+              var-17 var-18 var-19 var-20 var-21 var-22 var-23)
+             (dlasda icompq smlsiz nsize sqre
+              (f2cl-lib:array-slice d double-float (start) ((1 *)))
+              (f2cl-lib:array-slice e double-float (start) ((1 *)))
+              (f2cl-lib:array-slice q double-float
+               ((+ start (f2cl-lib:int-mul (f2cl-lib:int-add iu qstart
+                 (f2cl-lib:int-sub 2)) n))) ((1 *)))
+              n
+              (f2cl-lib:array-slice q double-float
+               ((+ start (f2cl-lib:int-mul (f2cl-lib:int-add ivt qstart
+                 (f2cl-lib:int-sub 2)) n))) ((1 *)))
+              (f2cl-lib:array-slice iq fixnum
+               ((+ start (f2cl-lib:int-mul k n))) ((1 *)))
+              (f2cl-lib:array-slice q double-float
+               ((+ start (f2cl-lib:int-mul (f2cl-lib:int-add difl qstart
+                          (f2cl-lib:int-sub 2)) n))) ((1 *)))
+              (f2cl-lib:array-slice q double-float
+               ((+ start (f2cl-lib:int-mul (f2cl-lib:int-add difr qstart
+                          (f2cl-lib:int-sub 2)) n))) ((1 *)))
+              (f2cl-lib:array-slice q double-float
+               ((+ start (f2cl-lib:int-mul (f2cl-lib:int-add z qstart
+                          (f2cl-lib:int-sub 2)) n))) ((1 *)))
+              (f2cl-lib:array-slice q double-float
+               ((+ start (f2cl-lib:int-mul (f2cl-lib:int-add poles qstart
+                          (f2cl-lib:int-sub 2)) n))) ((1 *)))
+              (f2cl-lib:array-slice iq fixnum
+               ((+ start (f2cl-lib:int-mul givptr n))) ((1 *)))
+              (f2cl-lib:array-slice iq fixnum
+               ((+ start (f2cl-lib:int-mul givcol n))) ((1 *)))
+              n
+              (f2cl-lib:array-slice iq fixnum
+               ((+ start (f2cl-lib:int-mul perm n))) ((1 *)))
+              (f2cl-lib:array-slice q double-float
+               ((+ start (f2cl-lib:int-mul (f2cl-lib:int-add givnum qstart
+                          (f2cl-lib:int-sub 2)) n))) ((1 *)))
+              (f2cl-lib:array-slice q double-float
+               ((+ start (f2cl-lib:int-mul (f2cl-lib:int-add ic qstart
+                          (f2cl-lib:int-sub 2)) n))) ((1 *)))
+              (f2cl-lib:array-slice q double-float
+               ((+ start (f2cl-lib:int-mul (f2cl-lib:int-add is qstart
+                          (f2cl-lib:int-sub 2)) n))) ((1 *)))
+              (f2cl-lib:array-slice work double-float (wstart) ((1 *)))
+              iwork 
+              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 var-15 var-16 var-17 var-18
+                                     var-19 var-20 var-21 var-22))
+              (setf info var-23))
+            (cond
+             ((/= info 0) (go end_label)))))
+          (setf start (f2cl-lib:int-add i 1))))))
+      (multiple-value-bind
+       (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9)
+       (dlascl "G" 0 0 one orgnrm n 1 d n ierr)
+       (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8))
+       (setf ierr var-9))
+ label40
+      (f2cl-lib:fdo (ii 2 (f2cl-lib:int-add ii 1))
+                    ((> ii n) nil)
+       (tagbody
+        (setf i (f2cl-lib:int-sub ii 1))
+        (setf kk i)
+        (setf p (f2cl-lib:fref d-%data% (i) ((1 *)) d-%offset%))
+        (f2cl-lib:fdo (j ii (f2cl-lib:int-add j 1))
+                      ((> j n) nil)
+         (tagbody
+          (cond
+           ((> (f2cl-lib:fref d (j) ((1 *))) p)
+            (setf kk j)
+            (setf p (f2cl-lib:fref d-%data% (j) ((1 *)) d-%offset%))))))
+          (cond
+           ((/= kk i)
+            (setf (f2cl-lib:fref d-%data% (kk) ((1 *)) d-%offset%)
+                  (f2cl-lib:fref d-%data% (i) ((1 *)) d-%offset%))
+            (setf (f2cl-lib:fref d-%data% (i) ((1 *)) d-%offset%) p)
+            (cond
+             ((= icompq 1)
+              (setf (f2cl-lib:fref iq-%data% (i) ((1 *)) iq-%offset%) kk))
+             ((= icompq 2)
+              (dswap n
+               (f2cl-lib:array-slice u double-float (1 i) ((1 ldu) (1 *)))
+               1
+               (f2cl-lib:array-slice u double-float (1 kk) ((1 ldu) (1 *)))
+               1)
+              (dswap n
+               (f2cl-lib:array-slice vt double-float (i 1) ((1 ldvt) (1 *)))
+               ldvt
+               (f2cl-lib:array-slice vt double-float (kk 1) ((1 ldvt) (1 *)))
+               ldvt))))
+           ((= icompq 1)
+            (setf (f2cl-lib:fref iq-%data% (i) ((1 *)) iq-%offset%) i)))))
+      (cond
+       ((= icompq 1)
+        (cond
+         ((= iuplo 1)
+          (setf (f2cl-lib:fref iq-%data% (n) ((1 *)) iq-%offset%) 1))
+         (t
+          (setf (f2cl-lib:fref iq-%data% (n) ((1 *)) iq-%offset%) 0)))))
+      (if (and (= iuplo 2) (= icompq 2))
+       (dlasr "L" "V" "B" n n
+        (f2cl-lib:array-slice work double-float (1) ((1 *)))
+        (f2cl-lib:array-slice work double-float (n) ((1 *))) u ldu))
+ end_label
+      (return
+       (values nil nil nil nil nil nil nil nil nil nil nil nil nil info))))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dcabs1 BLAS}
+\pagehead{dcabs1}{dcabs1}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+The argument is:
+\begin{itemize}
+\item z - (complex double-float)
+\end{itemize}
+
+The result is
+\begin{itemize}
+\item nil
+\end{itemize}
+
+<<BLAS dcabs1>>=
+(defun dcabs1 (z)
+ (declare (type (complex double-float) z))
+ (let ((dcabs1 0.0))
+  (declare (type (double-float) dcabs1))
+  (setf dcabs1
+   (the double-float
+    (+
+     (the double-float (abs
+      (the double-float (coerce (realpart z) 'double-float))))
+     (the double-float (abs (f2cl-lib:dimag z))))))
+  (values dcabs1 nil)))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dbdsqr LAPACK}
+\pagehead{dbdsqr}{dbdsqr}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<LAPACK dbdsqr>>=
+(let* ((zero 0.0)
+       (one 1.0)
+       (negone (- 1.0))
+       (hndrth 0.01)
+       (ten 10.0)
+       (hndrd 100.0)
+       (meigth (- 0.125))
+       (maxitr 6))
+  (declare (type (double-float 0.0 0.0) zero)
+           (type (double-float 1.0 1.0) one)
+           (type (double-float) negone)
+           (type (double-float 0.01 0.01) hndrth)
+           (type (double-float 10.0 10.0) ten)
+           (type (double-float 100.0 100.0) hndrd)
+           (type (double-float) meigth)
+           (type (fixnum 6 6) maxitr))
+  (defun dbdsqr (uplo n ncvt nru ncc d e vt ldvt u ldu c ldc work info)
+    (declare (type (array double-float (*)) work c u vt e d)
+             (type fixnum info ldc ldu ldvt ncc nru ncvt n)
+             (type (simple-array character (*)) uplo))
+    (f2cl-lib:with-multi-array-data
+        ((uplo character uplo-%data% uplo-%offset%)
+         (d double-float d-%data% d-%offset%)
+         (e double-float e-%data% e-%offset%)
+         (vt double-float vt-%data% vt-%offset%)
+         (u double-float u-%data% u-%offset%)
+         (c double-float c-%data% c-%offset%)
+         (work double-float work-%data% work-%offset%))
+      (prog ((abse 0.0) (abss 0.0) (cosl 0.0) (cosr 0.0) (cs 0.0) (eps 0.0)
+             (f 0.0) (g 0.0) (h 0.0) (mu 0.0) (oldcs 0.0) (oldsn 0.0) (r 0.0)
+             (shift 0.0) (sigmn 0.0) (sigmx 0.0) (sinl 0.0) (sinr 0.0)
+             (sll 0.0) (smax 0.0) (smin 0.0) (sminl 0.0) (sminlo 0.0)
+             (sminoa 0.0) (sn 0.0) (thresh 0.0) (tol 0.0) (tolmul 0.0)
+             (unfl 0.0) (i 0) (idir 0) (isub 0) (iter 0) (j 0) (ll 0) (lll 0)
+             (m 0) (maxit 0) (nm1 0) (nm12 0) (nm13 0) (oldll 0) (oldm 0)
+             (lower nil) (rotate nil))
+        (declare (type (double-float) abse abss cosl cosr cs eps f g h mu oldcs
+                                      oldsn r shift sigmn sigmx sinl sinr sll
+                                      smax smin sminl sminlo sminoa sn thresh
+                                      tol tolmul unfl)
+                 (type fixnum i idir isub iter j ll lll m maxit
+                                           nm1 nm12 nm13 oldll oldm)
+                 (type (member t nil) lower rotate))
+        (setf info 0)
+        (setf lower (lsame uplo "L"))
+        (cond
+          ((and (not (lsame uplo "U")) (not lower))
+           (setf info -1))
+          ((< n 0)
+           (setf info -2))
+          ((< ncvt 0)
+           (setf info -3))
+          ((< nru 0)
+           (setf info -4))
+          ((< ncc 0)
+           (setf info -5))
+          ((or (and (= ncvt 0) (< ldvt 1))
+               (and (> ncvt 0)
+                    (< ldvt
+                       (max (the fixnum 1)
+                            (the fixnum n)))))
+           (setf info -9))
+          ((< ldu (max (the fixnum 1) (the fixnum nru)))
+           (setf info -11))
+          ((or (and (= ncc 0) (< ldc 1))
+               (and (> ncc 0)
+                    (< ldc
+                       (max (the fixnum 1)
+                            (the fixnum n)))))
+           (setf info -13)))
+        (cond
+          ((/= info 0)
+           (xerbla "DBDSQR" (f2cl-lib:int-sub info))
+           (go end_label)))
+        (if (= n 0) (go end_label))
+        (if (= n 1) (go label160))
+        (setf rotate (or (> ncvt 0) (> nru 0) (> ncc 0)))
+        (cond
+          ((not rotate)
+           (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+               (dlasq1 n d e work info)
+             (declare (ignore var-0 var-1 var-2 var-3))
+             (setf info var-4))
+           (go end_label)))
+        (setf nm1 (f2cl-lib:int-sub n 1))
+        (setf nm12 (f2cl-lib:int-add nm1 nm1))
+        (setf nm13 (f2cl-lib:int-add nm12 nm1))
+        (setf idir 0)
+        (setf eps (dlamch "Epsilon"))
+        (setf unfl (dlamch "Safe minimum"))
+        (cond
+          (lower
+           (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                         ((> i (f2cl-lib:int-add n (f2cl-lib:int-sub 1))) nil)
+             (tagbody
+               (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                   (dlartg (f2cl-lib:fref d-%data% (i) ((1 *)) d-%offset%)
+                    (f2cl-lib:fref e-%data% (i) ((1 *)) e-%offset%) cs sn r)
+                 (declare (ignore var-0 var-1))
+                 (setf cs var-2)
+                 (setf sn var-3)
+                 (setf r var-4))
+               (setf (f2cl-lib:fref d-%data% (i) ((1 *)) d-%offset%) r)
+               (setf (f2cl-lib:fref e-%data% (i) ((1 *)) e-%offset%)
+                       (* sn
+                          (f2cl-lib:fref d-%data%
+                                         ((f2cl-lib:int-add i 1))
+                                         ((1 *))
+                                         d-%offset%)))
+               (setf (f2cl-lib:fref d-%data%
+                                    ((f2cl-lib:int-add i 1))
+                                    ((1 *))
+                                    d-%offset%)
+                       (* cs
+                          (f2cl-lib:fref d-%data%
+                                         ((f2cl-lib:int-add i 1))
+                                         ((1 *))
+                                         d-%offset%)))
+               (setf (f2cl-lib:fref work-%data% (i) ((1 *)) work-%offset%) cs)
+               (setf (f2cl-lib:fref work-%data%
+                                    ((f2cl-lib:int-add nm1 i))
+                                    ((1 *))
+                                    work-%offset%)
+                       sn)))
+           (if (> nru 0)
+               (dlasr "R" "V" "F" nru n
+                (f2cl-lib:array-slice work double-float (1) ((1 *)))
+                (f2cl-lib:array-slice work double-float (n) ((1 *))) u ldu))
+           (if (> ncc 0)
+               (dlasr "L" "V" "F" n ncc
+                (f2cl-lib:array-slice work double-float (1) ((1 *)))
+                (f2cl-lib:array-slice work double-float (n) ((1 *))) c ldc))))
+        (setf tolmul (max ten (min hndrd (expt eps meigth))))
+        (setf tol (* tolmul eps))
+        (setf smax zero)
+        (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                      ((> i n) nil)
+          (tagbody
+            (setf smax
+                    (max smax
+                         (abs
+                          (f2cl-lib:fref d-%data% (i) ((1 *)) d-%offset%))))))
+        (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                      ((> i (f2cl-lib:int-add n (f2cl-lib:int-sub 1))) nil)
+          (tagbody
+            (setf smax
+                    (max smax
+                         (abs
+                          (f2cl-lib:fref e-%data% (i) ((1 *)) e-%offset%))))))
+        (setf sminl zero)
+        (cond
+          ((>= tol zero)
+           (tagbody
+             (setf sminoa
+                     (abs (f2cl-lib:fref d-%data% (1) ((1 *)) d-%offset%)))
+             (if (= sminoa zero) (go label50))
+             (setf mu sminoa)
+             (f2cl-lib:fdo (i 2 (f2cl-lib:int-add i 1))
+                           ((> i n) nil)
+               (tagbody
+                 (setf mu
+                         (*
+                          (abs (f2cl-lib:fref d-%data% (i) ((1 *)) d-%offset%))
+                          (/ mu
+                             (+ mu
+                                (abs
+                                 (f2cl-lib:fref e-%data%
+                                                ((f2cl-lib:int-sub i 1))
+                                                ((1 *))
+                                                e-%offset%))))))
+                 (setf sminoa (min sminoa mu))
+                 (if (= sminoa zero) (go label50))))
+ label50
+             (setf sminoa 
+              (/ sminoa (f2cl-lib:fsqrt (coerce (realpart n) 'double-float))))
+             (setf thresh (max (* tol sminoa) (* maxitr n n unfl)))))
+          (t
+           (setf thresh (max (* (abs tol) smax) (* maxitr n n unfl)))))
+        (setf maxit (f2cl-lib:int-mul maxitr n n))
+        (setf iter 0)
+        (setf oldll -1)
+        (setf oldm -1)
+        (setf m n)
+ label60
+        (if (<= m 1) (go label160))
+        (if (> iter maxit) (go label200))
+        (if
+         (and (< tol zero)
+              (<= (abs (f2cl-lib:fref d-%data% (m) ((1 *)) d-%offset%))
+                  thresh))
+         (setf (f2cl-lib:fref d-%data% (m) ((1 *)) d-%offset%) zero))
+        (setf smax (abs (f2cl-lib:fref d-%data% (m) ((1 *)) d-%offset%)))
+        (setf smin smax)
+        (f2cl-lib:fdo (lll 1 (f2cl-lib:int-add lll 1))
+                      ((> lll (f2cl-lib:int-add m (f2cl-lib:int-sub 1))) nil)
+          (tagbody
+            (setf ll (f2cl-lib:int-sub m lll))
+            (setf abss (abs (f2cl-lib:fref d-%data% (ll) ((1 *)) d-%offset%)))
+            (setf abse (abs (f2cl-lib:fref e-%data% (ll) ((1 *)) e-%offset%)))
+            (if (and (< tol zero) (<= abss thresh))
+                (setf (f2cl-lib:fref d-%data% (ll) ((1 *)) d-%offset%) zero))
+            (if (<= abse thresh) (go label80))
+            (setf smin (min smin abss))
+            (setf smax (max smax abss abse))))
+        (setf ll 0)
+        (go label90)
+ label80
+        (setf (f2cl-lib:fref e-%data% (ll) ((1 *)) e-%offset%) zero)
+        (cond
+          ((= ll (f2cl-lib:int-add m (f2cl-lib:int-sub 1)))
+           (setf m (f2cl-lib:int-sub m 1))
+           (go label60)))
+ label90
+        (setf ll (f2cl-lib:int-add ll 1))
+        (cond
+          ((= ll (f2cl-lib:int-add m (f2cl-lib:int-sub 1)))
+           (multiple-value-bind
+                 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8)
+               (dlasv2
+                (f2cl-lib:fref d-%data%
+                               ((f2cl-lib:int-sub m 1))
+                               ((1 *))
+                               d-%offset%)
+                (f2cl-lib:fref e-%data%
+                               ((f2cl-lib:int-sub m 1))
+                               ((1 *))
+                               e-%offset%)
+                (f2cl-lib:fref d-%data% (m) ((1 *)) d-%offset%) sigmn sigmx
+                sinr cosr sinl cosl)
+             (declare (ignore var-0 var-1 var-2))
+             (setf sigmn var-3)
+             (setf sigmx var-4)
+             (setf sinr var-5)
+             (setf cosr var-6)
+             (setf sinl var-7)
+             (setf cosl var-8))
+           (setf (f2cl-lib:fref d-%data%
+                                ((f2cl-lib:int-sub m 1))
+                                ((1 *))
+                                d-%offset%)
+                   sigmx)
+           (setf (f2cl-lib:fref e-%data%
+                                ((f2cl-lib:int-sub m 1))
+                                ((1 *))
+                                e-%offset%)
+                   zero)
+           (setf (f2cl-lib:fref d-%data% (m) ((1 *)) d-%offset%) sigmn)
+           (if (> ncvt 0)
+               (drot ncvt
+                (f2cl-lib:array-slice vt
+                                      double-float
+                                      ((+ m (f2cl-lib:int-sub 1)) 1)
+                                      ((1 ldvt) (1 *)))
+                ldvt
+                (f2cl-lib:array-slice vt double-float (m 1) ((1 ldvt) (1 *)))
+                ldvt cosr sinr))
+           (if (> nru 0)
+               (drot nru
+                (f2cl-lib:array-slice u
+                                      double-float
+                                      (1 (f2cl-lib:int-sub m 1))
+                                      ((1 ldu) (1 *)))
+                1 (f2cl-lib:array-slice u double-float (1 m) ((1 ldu) (1 *))) 1
+                cosl sinl))
+           (if (> ncc 0)
+               (drot ncc
+                (f2cl-lib:array-slice c
+                                      double-float
+                                      ((+ m (f2cl-lib:int-sub 1)) 1)
+                                      ((1 ldc) (1 *)))
+                ldc (f2cl-lib:array-slice c double-float (m 1) ((1 ldc) (1 *)))
+                ldc cosl sinl))
+           (setf m (f2cl-lib:int-sub m 2))
+           (go label60)))
+        (cond
+          ((or (> ll oldm) (< m oldll))
+           (cond
+             ((>= (abs (f2cl-lib:fref d (ll) ((1 *))))
+                  (abs (f2cl-lib:fref d (m) ((1 *)))))
+              (setf idir 1))
+             (t
+              (setf idir 2)))))
+        (cond
+          ((= idir 1)
+           (cond
+             ((or
+               (<=
+                (abs
+                 (f2cl-lib:fref e
+                                ((f2cl-lib:int-add m (f2cl-lib:int-sub 1)))
+                                ((1 *))))
+                (* (abs tol) (abs (f2cl-lib:fref d (m) ((1 *))))))
+               (and (< tol zero)
+                    (<=
+                     (abs
+                      (f2cl-lib:fref e
+                                     ((f2cl-lib:int-add m
+                                                        (f2cl-lib:int-sub 1)))
+                                     ((1 *))))
+                     thresh)))
+              (setf (f2cl-lib:fref e-%data%
+                                   ((f2cl-lib:int-sub m 1))
+                                   ((1 *))
+                                   e-%offset%)
+                      zero)
+              (go label60)))
+           (cond
+             ((>= tol zero)
+              (setf mu (abs (f2cl-lib:fref d-%data% (ll) ((1 *)) d-%offset%)))
+              (setf sminl mu)
+              (f2cl-lib:fdo (lll ll (f2cl-lib:int-add lll 1))
+                            ((> lll (f2cl-lib:int-add m (f2cl-lib:int-sub 1)))
+                             nil)
+                (tagbody
+                  (cond
+                    ((<= (abs (f2cl-lib:fref e (lll) ((1 *)))) (* tol mu))
+                     (setf (f2cl-lib:fref e-%data% (lll) ((1 *)) e-%offset%)
+                             zero)
+                     (go label60)))
+                  (setf sminlo sminl)
+                  (setf mu
+                          (*
+                           (abs
+                            (f2cl-lib:fref d-%data%
+                                           ((f2cl-lib:int-add lll 1))
+                                           ((1 *))
+                                           d-%offset%))
+                           (/ mu
+                              (+ mu
+                                 (abs
+                                  (f2cl-lib:fref e-%data%
+                                                 (lll)
+                                                 ((1 *))
+                                                 e-%offset%))))))
+                  (setf sminl (min sminl mu)))))))
+          (t
+           (cond
+             ((or
+               (<= (abs (f2cl-lib:fref e (ll) ((1 *))))
+                   (* (abs tol) (abs (f2cl-lib:fref d (ll) ((1 *))))))
+               (and (< tol zero)
+                    (<= (abs (f2cl-lib:fref e (ll) ((1 *)))) thresh)))
+              (setf (f2cl-lib:fref e-%data% (ll) ((1 *)) e-%offset%) zero)
+              (go label60)))
+           (cond
+             ((>= tol zero)
+              (setf mu (abs (f2cl-lib:fref d-%data% (m) ((1 *)) d-%offset%)))
+              (setf sminl mu)
+              (f2cl-lib:fdo (lll (f2cl-lib:int-add m (f2cl-lib:int-sub 1))
+                             (f2cl-lib:int-add lll (f2cl-lib:int-sub 1)))
+                            ((> lll ll) nil)
+                (tagbody
+                  (cond
+                    ((<= (abs (f2cl-lib:fref e (lll) ((1 *)))) (* tol mu))
+                     (setf (f2cl-lib:fref e-%data% (lll) ((1 *)) e-%offset%)
+                             zero)
+                     (go label60)))
+                  (setf sminlo sminl)
+                  (setf mu
+                          (*
+                           (abs
+                            (f2cl-lib:fref d-%data% (lll) ((1 *)) d-%offset%))
+                           (/ mu
+                              (+ mu
+                                 (abs
+                                  (f2cl-lib:fref e-%data%
+                                                 (lll)
+                                                 ((1 *))
+                                                 e-%offset%))))))
+                  (setf sminl (min sminl mu))))))))
+        (setf oldll ll)
+        (setf oldm m)
+        (cond
+          ((and (>= tol zero)
+                (<= (* n tol (f2cl-lib:f2cl/ sminl smax))
+                    (max eps (* hndrth tol))))
+           (setf shift zero))
+          (t
+           (cond
+             ((= idir 1)
+              (setf sll (abs (f2cl-lib:fref d-%data% (ll) ((1 *)) d-%offset%)))
+              (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                  (dlas2
+                   (f2cl-lib:fref d-%data%
+                                  ((f2cl-lib:int-sub m 1))
+                                  ((1 *))
+                                  d-%offset%)
+                   (f2cl-lib:fref e-%data%
+                                  ((f2cl-lib:int-sub m 1))
+                                  ((1 *))
+                                  e-%offset%)
+                   (f2cl-lib:fref d-%data% (m) ((1 *)) d-%offset%) shift r)
+                (declare (ignore var-0 var-1 var-2))
+                (setf shift var-3)
+                (setf r var-4)))
+             (t
+              (setf sll (abs (f2cl-lib:fref d-%data% (m) ((1 *)) d-%offset%)))
+              (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                  (dlas2 (f2cl-lib:fref d-%data% (ll) ((1 *)) d-%offset%)
+                   (f2cl-lib:fref e-%data% (ll) ((1 *)) e-%offset%)
+                   (f2cl-lib:fref d-%data%
+                                  ((f2cl-lib:int-add ll 1))
+                                  ((1 *))
+                                  d-%offset%)
+                   shift r)
+                (declare (ignore var-0 var-1 var-2))
+                (setf shift var-3)
+                (setf r var-4))))
+           (cond
+             ((> sll zero)
+              (if (< (expt (/ shift sll) 2) eps) (setf shift zero))))))
+        (setf iter (f2cl-lib:int-sub (f2cl-lib:int-add iter m) ll))
+        (cond
+          ((= shift zero)
+           (cond
+             ((= idir 1)
+              (setf cs one)
+              (setf oldcs one)
+              (f2cl-lib:fdo (i ll (f2cl-lib:int-add i 1))
+                            ((> i (f2cl-lib:int-add m (f2cl-lib:int-sub 1)))
+                             nil)
+                (tagbody
+                  (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                      (dlartg
+                       (* (f2cl-lib:fref d-%data% (i) ((1 *)) d-%offset%) cs)
+                       (f2cl-lib:fref e-%data% (i) ((1 *)) e-%offset%) cs sn r)
+                    (declare (ignore var-0 var-1))
+                    (setf cs var-2)
+                    (setf sn var-3)
+                    (setf r var-4))
+                  (if (> i ll)
+                      (setf (f2cl-lib:fref e-%data%
+                                           ((f2cl-lib:int-sub i 1))
+                                           ((1 *))
+                                           e-%offset%)
+                              (* oldsn r)))
+                  (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                      (dlartg (* oldcs r)
+                       (*
+                        (f2cl-lib:fref d-%data%
+                                       ((f2cl-lib:int-add i 1))
+                                       ((1 *))
+                                       d-%offset%)
+                        sn)
+                       oldcs oldsn
+                       (f2cl-lib:fref d-%data% (i) ((1 *)) d-%offset%))
+                    (declare (ignore var-0 var-1))
+                    (setf oldcs var-2)
+                    (setf oldsn var-3)
+                    (setf (f2cl-lib:fref d-%data% (i) ((1 *)) d-%offset%)
+                            var-4))
+                  (setf (f2cl-lib:fref work-%data%
+                                       ((f2cl-lib:int-add
+                                         (f2cl-lib:int-sub i ll)
+                                         1))
+                                       ((1 *))
+                                       work-%offset%)
+                          cs)
+                  (setf (f2cl-lib:fref work-%data%
+                                       ((f2cl-lib:int-add
+                                         (f2cl-lib:int-sub i ll)
+                                         1
+                                         nm1))
+                                       ((1 *))
+                                       work-%offset%)
+                          sn)
+                  (setf (f2cl-lib:fref work-%data%
+                                       ((f2cl-lib:int-add
+                                         (f2cl-lib:int-sub i ll)
+                                         1
+                                         nm12))
+                                       ((1 *))
+                                       work-%offset%)
+                          oldcs)
+                  (setf (f2cl-lib:fref work-%data%
+                                       ((f2cl-lib:int-add
+                                         (f2cl-lib:int-sub i ll)
+                                         1
+                                         nm13))
+                                       ((1 *))
+                                       work-%offset%)
+                          oldsn)))
+              (setf h (* (f2cl-lib:fref d-%data% (m) ((1 *)) d-%offset%) cs))
+              (setf (f2cl-lib:fref d-%data% (m) ((1 *)) d-%offset%) (* h oldcs))
+              (setf (f2cl-lib:fref e-%data%
+                                   ((f2cl-lib:int-sub m 1))
+                                   ((1 *))
+                                   e-%offset%)
+                      (* h oldsn))
+              (if (> ncvt 0)
+                  (dlasr "L" "V" "F"
+                   (f2cl-lib:int-add (f2cl-lib:int-sub m ll) 1) ncvt
+                   (f2cl-lib:array-slice work double-float (1) ((1 *)))
+                   (f2cl-lib:array-slice work double-float (n) ((1 *)))
+                   (f2cl-lib:array-slice vt
+                                         double-float
+                                         (ll 1)
+                                         ((1 ldvt) (1 *)))
+                   ldvt))
+              (if (> nru 0)
+                  (dlasr "R" "V" "F" nru
+                   (f2cl-lib:int-add (f2cl-lib:int-sub m ll) 1)
+                   (f2cl-lib:array-slice work
+                                         double-float
+                                         ((+ nm12 1))
+                                         ((1 *)))
+                   (f2cl-lib:array-slice work
+                                         double-float
+                                         ((+ nm13 1))
+                                         ((1 *)))
+                   (f2cl-lib:array-slice u double-float (1 ll) ((1 ldu) (1 *)))
+                   ldu))
+              (if (> ncc 0)
+                  (dlasr "L" "V" "F"
+                   (f2cl-lib:int-add (f2cl-lib:int-sub m ll) 1) ncc
+                   (f2cl-lib:array-slice work
+                                         double-float
+                                         ((+ nm12 1))
+                                         ((1 *)))
+                   (f2cl-lib:array-slice work
+                                         double-float
+                                         ((+ nm13 1))
+                                         ((1 *)))
+                   (f2cl-lib:array-slice c double-float (ll 1) ((1 ldc) (1 *)))
+                   ldc))
+              (if
+               (<=
+                (abs
+                 (f2cl-lib:fref e-%data%
+                                ((f2cl-lib:int-sub m 1))
+                                ((1 *))
+                                e-%offset%))
+                thresh)
+               (setf (f2cl-lib:fref e-%data%
+                                    ((f2cl-lib:int-sub m 1))
+                                    ((1 *))
+                                    e-%offset%)
+                       zero)))
+             (t
+              (setf cs one)
+              (setf oldcs one)
+              (f2cl-lib:fdo (i m (f2cl-lib:int-add i (f2cl-lib:int-sub 1)))
+                            ((> i (f2cl-lib:int-add ll 1)) nil)
+                (tagbody
+                  (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                      (dlartg
+                       (* (f2cl-lib:fref d-%data% (i) ((1 *)) d-%offset%) cs)
+                       (f2cl-lib:fref e-%data%
+                                      ((f2cl-lib:int-sub i 1))
+                                      ((1 *))
+                                      e-%offset%)
+                       cs sn r)
+                    (declare (ignore var-0 var-1))
+                    (setf cs var-2)
+                    (setf sn var-3)
+                    (setf r var-4))
+                  (if (< i m)
+                      (setf (f2cl-lib:fref e-%data% (i) ((1 *)) e-%offset%)
+                              (* oldsn r)))
+                  (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                      (dlartg (* oldcs r)
+                       (*
+                        (f2cl-lib:fref d-%data%
+                                       ((f2cl-lib:int-sub i 1))
+                                       ((1 *))
+                                       d-%offset%)
+                        sn)
+                       oldcs oldsn
+                       (f2cl-lib:fref d-%data% (i) ((1 *)) d-%offset%))
+                    (declare (ignore var-0 var-1))
+                    (setf oldcs var-2)
+                    (setf oldsn var-3)
+                    (setf (f2cl-lib:fref d-%data% (i) ((1 *)) d-%offset%)
+                            var-4))
+                  (setf (f2cl-lib:fref work-%data%
+                                       ((f2cl-lib:int-sub i ll))
+                                       ((1 *))
+                                       work-%offset%)
+                          cs)
+                  (setf (f2cl-lib:fref work-%data%
+                                       ((f2cl-lib:int-add
+                                         (f2cl-lib:int-sub i ll)
+                                         nm1))
+                                       ((1 *))
+                                       work-%offset%)
+                          (- sn))
+                  (setf (f2cl-lib:fref work-%data%
+                                       ((f2cl-lib:int-add
+                                         (f2cl-lib:int-sub i ll)
+                                         nm12))
+                                       ((1 *))
+                                       work-%offset%)
+                          oldcs)
+                  (setf (f2cl-lib:fref work-%data%
+                                       ((f2cl-lib:int-add
+                                         (f2cl-lib:int-sub i ll)
+                                         nm13))
+                                       ((1 *))
+                                       work-%offset%)
+                          (- oldsn))))
+              (setf h (* (f2cl-lib:fref d-%data% (ll) ((1 *)) d-%offset%) cs))
+              (setf (f2cl-lib:fref d-%data% (ll) ((1 *)) d-%offset%)
+                      (* h oldcs))
+              (setf (f2cl-lib:fref e-%data% (ll) ((1 *)) e-%offset%)
+                      (* h oldsn))
+              (if (> ncvt 0)
+                  (dlasr "L" "V" "B"
+                   (f2cl-lib:int-add (f2cl-lib:int-sub m ll) 1) ncvt
+                   (f2cl-lib:array-slice work
+                                         double-float
+                                         ((+ nm12 1))
+                                         ((1 *)))
+                   (f2cl-lib:array-slice work
+                                         double-float
+                                         ((+ nm13 1))
+                                         ((1 *)))
+                   (f2cl-lib:array-slice vt
+                                         double-float
+                                         (ll 1)
+                                         ((1 ldvt) (1 *)))
+                   ldvt))
+              (if (> nru 0)
+                  (dlasr "R" "V" "B" nru
+                   (f2cl-lib:int-add (f2cl-lib:int-sub m ll) 1)
+                   (f2cl-lib:array-slice work double-float (1) ((1 *)))
+                   (f2cl-lib:array-slice work double-float (n) ((1 *)))
+                   (f2cl-lib:array-slice u double-float (1 ll) ((1 ldu) (1 *)))
+                   ldu))
+              (if (> ncc 0)
+                  (dlasr "L" "V" "B"
+                   (f2cl-lib:int-add (f2cl-lib:int-sub m ll) 1) ncc
+                   (f2cl-lib:array-slice work double-float (1) ((1 *)))
+                   (f2cl-lib:array-slice work double-float (n) ((1 *)))
+                   (f2cl-lib:array-slice c double-float (ll 1) ((1 ldc) (1 *)))
+                   ldc))
+              (if
+               (<= (abs (f2cl-lib:fref e-%data% (ll) ((1 *)) e-%offset%))
+                   thresh)
+               (setf (f2cl-lib:fref e-%data% (ll) ((1 *)) e-%offset%) zero)))))
+          (t
+           (cond
+             ((= idir 1)
+              (setf f
+                      (*
+                       (-
+                        (abs (f2cl-lib:fref d-%data% (ll) ((1 *)) d-%offset%))
+                        shift)
+                       (+
+                        (f2cl-lib:sign one
+                                       (f2cl-lib:fref d-%data%
+                                                      (ll)
+                                                      ((1 *))
+                                                      d-%offset%))
+                        (/ shift
+                           (f2cl-lib:fref d-%data% (ll) ((1 *)) d-%offset%)))))
+              (setf g (f2cl-lib:fref e-%data% (ll) ((1 *)) e-%offset%))
+              (f2cl-lib:fdo (i ll (f2cl-lib:int-add i 1))
+                            ((> i (f2cl-lib:int-add m (f2cl-lib:int-sub 1)))
+                             nil)
+                (tagbody
+                  (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                      (dlartg f g cosr sinr r)
+                    (declare (ignore var-0 var-1))
+                    (setf cosr var-2)
+                    (setf sinr var-3)
+                    (setf r var-4))
+                  (if (> i ll)
+                      (setf (f2cl-lib:fref e-%data%
+                                           ((f2cl-lib:int-sub i 1))
+                                           ((1 *))
+                                           e-%offset%)
+                              r))
+                  (setf f
+                          (+
+                           (* cosr
+                              (f2cl-lib:fref d-%data% (i) ((1 *)) d-%offset%))
+                           (* sinr
+                              (f2cl-lib:fref e-%data%
+                                             (i)
+                                             ((1 *))
+                                             e-%offset%))))
+                  (setf (f2cl-lib:fref e-%data% (i) ((1 *)) e-%offset%)
+                          (-
+                           (* cosr
+                              (f2cl-lib:fref e-%data% (i) ((1 *)) e-%offset%))
+                           (* sinr
+                              (f2cl-lib:fref d-%data%
+                                             (i)
+                                             ((1 *))
+                                             d-%offset%))))
+                  (setf g
+                          (* sinr
+                             (f2cl-lib:fref d-%data%
+                                            ((f2cl-lib:int-add i 1))
+                                            ((1 *))
+                                            d-%offset%)))
+                  (setf (f2cl-lib:fref d-%data%
+                                       ((f2cl-lib:int-add i 1))
+                                       ((1 *))
+                                       d-%offset%)
+                          (* cosr
+                             (f2cl-lib:fref d-%data%
+                                            ((f2cl-lib:int-add i 1))
+                                            ((1 *))
+                                            d-%offset%)))
+                  (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                      (dlartg f g cosl sinl r)
+                    (declare (ignore var-0 var-1))
+                    (setf cosl var-2)
+                    (setf sinl var-3)
+                    (setf r var-4))
+                  (setf (f2cl-lib:fref d-%data% (i) ((1 *)) d-%offset%) r)
+                  (setf f
+                          (+
+                           (* cosl
+                              (f2cl-lib:fref e-%data% (i) ((1 *)) e-%offset%))
+                           (* sinl
+                              (f2cl-lib:fref d-%data%
+                                             ((f2cl-lib:int-add i 1))
+                                             ((1 *))
+                                             d-%offset%))))
+                  (setf (f2cl-lib:fref d-%data%
+                                       ((f2cl-lib:int-add i 1))
+                                       ((1 *))
+                                       d-%offset%)
+                          (-
+                           (* cosl
+                              (f2cl-lib:fref d-%data%
+                                             ((f2cl-lib:int-add i 1))
+                                             ((1 *))
+                                             d-%offset%))
+                           (* sinl
+                              (f2cl-lib:fref e-%data%
+                                             (i)
+                                             ((1 *))
+                                             e-%offset%))))
+                  (cond
+                    ((< i (f2cl-lib:int-add m (f2cl-lib:int-sub 1)))
+                     (setf g
+                             (* sinl
+                                (f2cl-lib:fref e-%data%
+                                               ((f2cl-lib:int-add i 1))
+                                               ((1 *))
+                                               e-%offset%)))
+                     (setf (f2cl-lib:fref e-%data%
+                                          ((f2cl-lib:int-add i 1))
+                                          ((1 *))
+                                          e-%offset%)
+                             (* cosl
+                                (f2cl-lib:fref e-%data%
+                                               ((f2cl-lib:int-add i 1))
+                                               ((1 *))
+                                               e-%offset%)))))
+                  (setf (f2cl-lib:fref work-%data%
+                                       ((f2cl-lib:int-add
+                                         (f2cl-lib:int-sub i ll)
+                                         1))
+                                       ((1 *))
+                                       work-%offset%)
+                          cosr)
+                  (setf (f2cl-lib:fref work-%data%
+                                       ((f2cl-lib:int-add
+                                         (f2cl-lib:int-sub i ll)
+                                         1
+                                         nm1))
+                                       ((1 *))
+                                       work-%offset%)
+                          sinr)
+                  (setf (f2cl-lib:fref work-%data%
+                                       ((f2cl-lib:int-add
+                                         (f2cl-lib:int-sub i ll)
+                                         1
+                                         nm12))
+                                       ((1 *))
+                                       work-%offset%)
+                          cosl)
+                  (setf (f2cl-lib:fref work-%data%
+                                       ((f2cl-lib:int-add
+                                         (f2cl-lib:int-sub i ll)
+                                         1
+                                         nm13))
+                                       ((1 *))
+                                       work-%offset%)
+                          sinl)))
+              (setf (f2cl-lib:fref e-%data%
+                                   ((f2cl-lib:int-sub m 1))
+                                   ((1 *))
+                                   e-%offset%)
+                      f)
+              (if (> ncvt 0)
+                  (dlasr "L" "V" "F"
+                   (f2cl-lib:int-add (f2cl-lib:int-sub m ll) 1) ncvt
+                   (f2cl-lib:array-slice work double-float (1) ((1 *)))
+                   (f2cl-lib:array-slice work double-float (n) ((1 *)))
+                   (f2cl-lib:array-slice vt
+                                         double-float
+                                         (ll 1)
+                                         ((1 ldvt) (1 *)))
+                   ldvt))
+              (if (> nru 0)
+                  (dlasr "R" "V" "F" nru
+                   (f2cl-lib:int-add (f2cl-lib:int-sub m ll) 1)
+                   (f2cl-lib:array-slice work
+                                         double-float
+                                         ((+ nm12 1))
+                                         ((1 *)))
+                   (f2cl-lib:array-slice work
+                                         double-float
+                                         ((+ nm13 1))
+                                         ((1 *)))
+                   (f2cl-lib:array-slice u double-float (1 ll) ((1 ldu) (1 *)))
+                   ldu))
+              (if (> ncc 0)
+                  (dlasr "L" "V" "F"
+                   (f2cl-lib:int-add (f2cl-lib:int-sub m ll) 1) ncc
+                   (f2cl-lib:array-slice work
+                                         double-float
+                                         ((+ nm12 1))
+                                         ((1 *)))
+                   (f2cl-lib:array-slice work
+                                         double-float
+                                         ((+ nm13 1))
+                                         ((1 *)))
+                   (f2cl-lib:array-slice c double-float (ll 1) ((1 ldc) (1 *)))
+                   ldc))
+              (if
+               (<=
+                (abs
+                 (f2cl-lib:fref e-%data%
+                                ((f2cl-lib:int-sub m 1))
+                                ((1 *))
+                                e-%offset%))
+                thresh)
+               (setf (f2cl-lib:fref e-%data%
+                                    ((f2cl-lib:int-sub m 1))
+                                    ((1 *))
+                                    e-%offset%)
+                       zero)))
+             (t
+              (setf f
+                      (*
+                       (- (abs (f2cl-lib:fref d-%data% (m) ((1 *)) d-%offset%))
+                          shift)
+                       (+
+                        (f2cl-lib:sign one
+                                       (f2cl-lib:fref d-%data%
+                                                      (m)
+                                                      ((1 *))
+                                                      d-%offset%))
+                        (/ shift
+                           (f2cl-lib:fref d-%data% (m) ((1 *)) d-%offset%)))))
+              (setf g
+                      (f2cl-lib:fref e-%data%
+                                     ((f2cl-lib:int-sub m 1))
+                                     ((1 *))
+                                     e-%offset%))
+              (f2cl-lib:fdo (i m (f2cl-lib:int-add i (f2cl-lib:int-sub 1)))
+                            ((> i (f2cl-lib:int-add ll 1)) nil)
+                (tagbody
+                  (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                      (dlartg f g cosr sinr r)
+                    (declare (ignore var-0 var-1))
+                    (setf cosr var-2)
+                    (setf sinr var-3)
+                    (setf r var-4))
+                  (if (< i m)
+                      (setf (f2cl-lib:fref e-%data% (i) ((1 *)) e-%offset%) r))
+                  (setf f
+                          (+
+                           (* cosr
+                              (f2cl-lib:fref d-%data% (i) ((1 *)) d-%offset%))
+                           (* sinr
+                              (f2cl-lib:fref e-%data%
+                                             ((f2cl-lib:int-sub i 1))
+                                             ((1 *))
+                                             e-%offset%))))
+                  (setf (f2cl-lib:fref e-%data%
+                                       ((f2cl-lib:int-sub i 1))
+                                       ((1 *))
+                                       e-%offset%)
+                          (-
+                           (* cosr
+                              (f2cl-lib:fref e-%data%
+                                             ((f2cl-lib:int-sub i 1))
+                                             ((1 *))
+                                             e-%offset%))
+                           (* sinr
+                              (f2cl-lib:fref d-%data%
+                                             (i)
+                                             ((1 *))
+                                             d-%offset%))))
+                  (setf g
+                          (* sinr
+                             (f2cl-lib:fref d-%data%
+                                            ((f2cl-lib:int-sub i 1))
+                                            ((1 *))
+                                            d-%offset%)))
+                  (setf (f2cl-lib:fref d-%data%
+                                       ((f2cl-lib:int-sub i 1))
+                                       ((1 *))
+                                       d-%offset%)
+                          (* cosr
+                             (f2cl-lib:fref d-%data%
+                                            ((f2cl-lib:int-sub i 1))
+                                            ((1 *))
+                                            d-%offset%)))
+                  (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                      (dlartg f g cosl sinl r)
+                    (declare (ignore var-0 var-1))
+                    (setf cosl var-2)
+                    (setf sinl var-3)
+                    (setf r var-4))
+                  (setf (f2cl-lib:fref d-%data% (i) ((1 *)) d-%offset%) r)
+                  (setf f
+                          (+
+                           (* cosl
+                              (f2cl-lib:fref e-%data%
+                                             ((f2cl-lib:int-sub i 1))
+                                             ((1 *))
+                                             e-%offset%))
+                           (* sinl
+                              (f2cl-lib:fref d-%data%
+                                             ((f2cl-lib:int-sub i 1))
+                                             ((1 *))
+                                             d-%offset%))))
+                  (setf (f2cl-lib:fref d-%data%
+                                       ((f2cl-lib:int-sub i 1))
+                                       ((1 *))
+                                       d-%offset%)
+                          (-
+                           (* cosl
+                              (f2cl-lib:fref d-%data%
+                                             ((f2cl-lib:int-sub i 1))
+                                             ((1 *))
+                                             d-%offset%))
+                           (* sinl
+                              (f2cl-lib:fref e-%data%
+                                             ((f2cl-lib:int-sub i 1))
+                                             ((1 *))
+                                             e-%offset%))))
+                  (cond
+                    ((> i (f2cl-lib:int-add ll 1))
+                     (setf g
+                             (* sinl
+                                (f2cl-lib:fref e-%data%
+                                               ((f2cl-lib:int-sub i 2))
+                                               ((1 *))
+                                               e-%offset%)))
+                     (setf (f2cl-lib:fref e-%data%
+                                          ((f2cl-lib:int-sub i 2))
+                                          ((1 *))
+                                          e-%offset%)
+                             (* cosl
+                                (f2cl-lib:fref e-%data%
+                                               ((f2cl-lib:int-sub i 2))
+                                               ((1 *))
+                                               e-%offset%)))))
+                  (setf (f2cl-lib:fref work-%data%
+                                       ((f2cl-lib:int-sub i ll))
+                                       ((1 *))
+                                       work-%offset%)
+                          cosr)
+                  (setf (f2cl-lib:fref work-%data%
+                                       ((f2cl-lib:int-add
+                                         (f2cl-lib:int-sub i ll)
+                                         nm1))
+                                       ((1 *))
+                                       work-%offset%)
+                          (- sinr))
+                  (setf (f2cl-lib:fref work-%data%
+                                       ((f2cl-lib:int-add
+                                         (f2cl-lib:int-sub i ll)
+                                         nm12))
+                                       ((1 *))
+                                       work-%offset%)
+                          cosl)
+                  (setf (f2cl-lib:fref work-%data%
+                                       ((f2cl-lib:int-add
+                                         (f2cl-lib:int-sub i ll)
+                                         nm13))
+                                       ((1 *))
+                                       work-%offset%)
+                          (- sinl))))
+              (setf (f2cl-lib:fref e-%data% (ll) ((1 *)) e-%offset%) f)
+              (if
+               (<= (abs (f2cl-lib:fref e-%data% (ll) ((1 *)) e-%offset%))
+                   thresh)
+               (setf (f2cl-lib:fref e-%data% (ll) ((1 *)) e-%offset%) zero))
+              (if (> ncvt 0)
+                  (dlasr "L" "V" "B"
+                   (f2cl-lib:int-add (f2cl-lib:int-sub m ll) 1) ncvt
+                   (f2cl-lib:array-slice work
+                                         double-float
+                                         ((+ nm12 1))
+                                         ((1 *)))
+                   (f2cl-lib:array-slice work
+                                         double-float
+                                         ((+ nm13 1))
+                                         ((1 *)))
+                   (f2cl-lib:array-slice vt
+                                         double-float
+                                         (ll 1)
+                                         ((1 ldvt) (1 *)))
+                   ldvt))
+              (if (> nru 0)
+                  (dlasr "R" "V" "B" nru
+                   (f2cl-lib:int-add (f2cl-lib:int-sub m ll) 1)
+                   (f2cl-lib:array-slice work double-float (1) ((1 *)))
+                   (f2cl-lib:array-slice work double-float (n) ((1 *)))
+                   (f2cl-lib:array-slice u double-float (1 ll) ((1 ldu) (1 *)))
+                   ldu))
+              (if (> ncc 0)
+                  (dlasr "L" "V" "B"
+                   (f2cl-lib:int-add (f2cl-lib:int-sub m ll) 1) ncc
+                   (f2cl-lib:array-slice work double-float (1) ((1 *)))
+                   (f2cl-lib:array-slice work double-float (n) ((1 *)))
+                   (f2cl-lib:array-slice c double-float (ll 1) ((1 ldc) (1 *)))
+                   ldc))))))
+        (go label60)
+ label160
+        (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                      ((> i n) nil)
+          (tagbody
+            (cond
+              ((< (f2cl-lib:fref d (i) ((1 *))) zero)
+               (setf (f2cl-lib:fref d-%data% (i) ((1 *)) d-%offset%)
+                       (- (f2cl-lib:fref d-%data% (i) ((1 *)) d-%offset%)))
+               (if (> ncvt 0)
+                   (dscal ncvt negone
+                    (f2cl-lib:array-slice vt
+                                          double-float
+                                          (i 1)
+                                          ((1 ldvt) (1 *)))
+                    ldvt))))))
+        (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                      ((> i (f2cl-lib:int-add n (f2cl-lib:int-sub 1))) nil)
+          (tagbody
+            (setf isub 1)
+            (setf smin (f2cl-lib:fref d-%data% (1) ((1 *)) d-%offset%))
+            (f2cl-lib:fdo (j 2 (f2cl-lib:int-add j 1))
+                          ((> j (f2cl-lib:int-add n 1 (f2cl-lib:int-sub i)))
+                           nil)
+              (tagbody
+                (cond
+                  ((<= (f2cl-lib:fref d (j) ((1 *))) smin)
+                   (setf isub j)
+                   (setf smin
+                          (f2cl-lib:fref d-%data% (j) ((1 *)) d-%offset%))))))
+            (cond
+              ((/= isub (f2cl-lib:int-add n 1 (f2cl-lib:int-sub i)))
+               (setf (f2cl-lib:fref d-%data% (isub) ((1 *)) d-%offset%)
+                       (f2cl-lib:fref d-%data%
+                                      ((f2cl-lib:int-sub (f2cl-lib:int-add n 1)
+                                                         i))
+                                      ((1 *))
+                                      d-%offset%))
+               (setf (f2cl-lib:fref d-%data%
+                                    ((f2cl-lib:int-sub (f2cl-lib:int-add n 1)
+                                                       i))
+                                    ((1 *))
+                                    d-%offset%)
+                       smin)
+               (if (> ncvt 0)
+                   (dswap ncvt
+                    (f2cl-lib:array-slice vt
+                                          double-float
+                                          (isub 1)
+                                          ((1 ldvt) (1 *)))
+                    ldvt
+                    (f2cl-lib:array-slice vt
+                                          double-float
+                                          ((+ n 1 (f2cl-lib:int-sub i)) 1)
+                                          ((1 ldvt) (1 *)))
+                    ldvt))
+               (if (> nru 0)
+                   (dswap nru
+                    (f2cl-lib:array-slice u
+                                          double-float
+                                          (1 isub)
+                                          ((1 ldu) (1 *)))
+                    1
+                    (f2cl-lib:array-slice u
+                                          double-float
+                                          (1
+                                           (f2cl-lib:int-sub
+                                            (f2cl-lib:int-add n 1)
+                                            i))
+                                          ((1 ldu) (1 *)))
+                    1))
+               (if (> ncc 0)
+                   (dswap ncc
+                    (f2cl-lib:array-slice c
+                                          double-float
+                                          (isub 1)
+                                          ((1 ldc) (1 *)))
+                    ldc
+                    (f2cl-lib:array-slice c
+                                          double-float
+                                          ((+ n 1 (f2cl-lib:int-sub i)) 1)
+                                          ((1 ldc) (1 *)))
+                    ldc))))))
+        (go end_label)
+ label200
+        (setf info 0)
+        (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                      ((> i (f2cl-lib:int-add n (f2cl-lib:int-sub 1))) nil)
+          (tagbody
+            (if (/= (f2cl-lib:fref e-%data% (i) ((1 *)) e-%offset%) zero)
+                (setf info (f2cl-lib:int-add info 1)))))
+ end_label
+        (return
+         (values nil
+                 nil
+                 nil
+                 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::dbdsqr
+                 fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '((simple-array character (1))
+                        fixnum fixnum
+                        fixnum fixnum
+                        (array double-float (*)) (array double-float (*))
+                        (array double-float (*)) fixnum
+                        (array double-float (*)) fixnum
+                        (array double-float (*)) fixnum
+                        (array double-float (*)) fixnum)
+           :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil nil
+                            nil fortran-to-lisp::info)
+           :calls '(fortran-to-lisp::dswap fortran-to-lisp::dscal
+                    fortran-to-lisp::dlas2 fortran-to-lisp::drot
+                    fortran-to-lisp::dlasv2 fortran-to-lisp::dlasr
+                    fortran-to-lisp::dlartg fortran-to-lisp::dlamch
+                    fortran-to-lisp::dlasq1 fortran-to-lisp::xerbla
+                    fortran-to-lisp::lsame))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dcopy BLAS}
+\pagehead{dcopy}{dcopy}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<BLAS 1 dcopy>>=
+(defun dcopy (n dx incx dy incy)
+  (declare (type (array double-float (*)) dy dx)
+           (type fixnum incy incx n))
+  (f2cl-lib:with-multi-array-data
+      ((dx double-float dx-%data% dx-%offset%)
+       (dy double-float dy-%data% dy-%offset%))
+    (prog ((i 0) (ix 0) (iy 0) (m 0) (mp1 0))
+      (declare (type fixnum mp1 m iy ix i))
+      (if (<= n 0) (go end_label))
+      (if (and (= incx 1) (= incy 1)) (go label20))
+      (setf ix 1)
+      (setf iy 1)
+      (if (< incx 0)
+          (setf ix
+                  (f2cl-lib:int-add
+                   (f2cl-lib:int-mul (f2cl-lib:int-sub 1 n) incx)
+                   1)))
+      (if (< incy 0)
+          (setf iy
+                  (f2cl-lib:int-add
+                   (f2cl-lib:int-mul (f2cl-lib:int-sub 1 n) incy)
+                   1)))
+      (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                    ((> i n) nil)
+        (tagbody
+          (setf (f2cl-lib:fref dy-%data% (iy) ((1 *)) dy-%offset%)
+                  (f2cl-lib:fref dx-%data% (ix) ((1 *)) dx-%offset%))
+          (setf ix (f2cl-lib:int-add ix incx))
+          (setf iy (f2cl-lib:int-add iy incy))))
+      (go end_label)
+ label20
+      (setf m (mod n 7))
+      (if (= m 0) (go label40))
+      (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                    ((> i m) nil)
+        (tagbody
+          (setf (f2cl-lib:fref dy-%data% (i) ((1 *)) dy-%offset%)
+                  (f2cl-lib:fref dx-%data% (i) ((1 *)) dx-%offset%))))
+      (if (< n 7) (go end_label))
+ label40
+      (setf mp1 (f2cl-lib:int-add m 1))
+      (f2cl-lib:fdo (i mp1 (f2cl-lib:int-add i 7))
+                    ((> i n) nil)
+        (tagbody
+          (setf (f2cl-lib:fref dy-%data% (i) ((1 *)) dy-%offset%)
+                  (f2cl-lib:fref dx-%data% (i) ((1 *)) dx-%offset%))
+          (setf (f2cl-lib:fref dy-%data%
+                               ((f2cl-lib:int-add i 1))
+                               ((1 *))
+                               dy-%offset%)
+                  (f2cl-lib:fref dx-%data%
+                                 ((f2cl-lib:int-add i 1))
+                                 ((1 *))
+                                 dx-%offset%))
+          (setf (f2cl-lib:fref dy-%data%
+                               ((f2cl-lib:int-add i 2))
+                               ((1 *))
+                               dy-%offset%)
+                  (f2cl-lib:fref dx-%data%
+                                 ((f2cl-lib:int-add i 2))
+                                 ((1 *))
+                                 dx-%offset%))
+          (setf (f2cl-lib:fref dy-%data%
+                               ((f2cl-lib:int-add i 3))
+                               ((1 *))
+                               dy-%offset%)
+                  (f2cl-lib:fref dx-%data%
+                                 ((f2cl-lib:int-add i 3))
+                                 ((1 *))
+                                 dx-%offset%))
+          (setf (f2cl-lib:fref dy-%data%
+                               ((f2cl-lib:int-add i 4))
+                               ((1 *))
+                               dy-%offset%)
+                  (f2cl-lib:fref dx-%data%
+                                 ((f2cl-lib:int-add i 4))
+                                 ((1 *))
+                                 dx-%offset%))
+          (setf (f2cl-lib:fref dy-%data%
+                               ((f2cl-lib:int-add i 5))
+                               ((1 *))
+                               dy-%offset%)
+                  (f2cl-lib:fref dx-%data%
+                                 ((f2cl-lib:int-add i 5))
+                                 ((1 *))
+                                 dx-%offset%))
+          (setf (f2cl-lib:fref dy-%data%
+                               ((f2cl-lib:int-add i 6))
+                               ((1 *))
+                               dy-%offset%)
+                  (f2cl-lib:fref dx-%data%
+                                 ((f2cl-lib:int-add i 6))
+                                 ((1 *))
+                                 dx-%offset%))))
+ end_label
+      (return (values 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::dcopy fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '(fixnum (array double-float (*))
+                        fixnum (array double-float (*))
+                        fixnum)
+           :return-values '(nil nil nil nil nil)
+           :calls 'nil)))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{ddisna LAPACK}
+\pagehead{ddisna}{ddisna}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<LAPACK ddisna>>=
+(let* ((zero 0.0))
+  (declare (type (double-float 0.0 0.0) zero))
+  (defun ddisna (job m n d sep info)
+    (declare (type (array double-float (*)) sep d)
+             (type fixnum info n m)
+             (type (simple-array character (*)) job))
+    (f2cl-lib:with-multi-array-data
+        ((job character job-%data% job-%offset%)
+         (d double-float d-%data% d-%offset%)
+         (sep double-float sep-%data% sep-%offset%))
+      (prog ((anorm 0.0) (eps 0.0) (newgap 0.0) (oldgap 0.0) (safmin 0.0)
+             (thresh 0.0) (i 0) (k 0) (decr nil) (eigen nil) (incr nil)
+             (left nil) (right nil) (sing nil))
+        (declare (type (double-float) anorm eps newgap oldgap safmin thresh)
+                 (type fixnum i k)
+                 (type (member t nil) decr eigen incr left right sing))
+        (setf info 0)
+        (setf eigen (lsame job "E"))
+        (setf left (lsame job "L"))
+        (setf right (lsame job "R"))
+        (setf sing (or left right))
+        (cond
+          (eigen
+           (setf k m))
+          (sing
+           (setf k (min (the fixnum m) (the fixnum n)))))
+        (cond
+          ((and (not eigen) (not sing))
+           (setf info -1))
+          ((< m 0)
+           (setf info -2))
+          ((< k 0)
+           (setf info -3))
+          (t
+           (setf incr t)
+           (setf decr t)
+           (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                         ((> i (f2cl-lib:int-add k (f2cl-lib:int-sub 1))) nil)
+             (tagbody
+               (if incr
+                   (setf incr
+                           (and incr
+                                (<=
+                                 (f2cl-lib:fref d-%data%
+                                                (i)
+                                                ((1 *))
+                                                d-%offset%)
+                                 (f2cl-lib:fref d-%data%
+                                                ((f2cl-lib:int-add i 1))
+                                                ((1 *))
+                                                d-%offset%)))))
+               (if decr
+                   (setf decr
+                           (and decr
+                                (>=
+                                 (f2cl-lib:fref d-%data%
+                                                (i)
+                                                ((1 *))
+                                                d-%offset%)
+                                 (f2cl-lib:fref d-%data%
+                                                ((f2cl-lib:int-add i 1))
+                                                ((1 *))
+                                                d-%offset%)))))))
+           (cond
+             ((and sing (> k 0))
+              (if incr
+                  (setf incr
+                          (and incr
+                               (<= zero
+                                   (f2cl-lib:fref d-%data%
+                                                  (1)
+                                                  ((1 *))
+                                                  d-%offset%)))))
+              (if decr
+                  (setf decr
+                          (and decr
+                               (>=
+                                (f2cl-lib:fref d-%data% (k) ((1 *)) d-%offset%)
+                                zero))))))
+           (if (not (or incr decr)) (setf info -4))))
+        (cond
+          ((/= info 0)
+           (xerbla "DDISNA" (f2cl-lib:int-sub info))
+           (go end_label)))
+        (if (= k 0) (go end_label))
+        (cond
+          ((= k 1)
+           (setf (f2cl-lib:fref sep-%data% (1) ((1 *)) sep-%offset%)
+                   (dlamch "O")))
+          (t
+           (setf oldgap
+                   (abs
+                    (- (f2cl-lib:fref d-%data% (2) ((1 *)) d-%offset%)
+                       (f2cl-lib:fref d-%data% (1) ((1 *)) d-%offset%))))
+           (setf (f2cl-lib:fref sep-%data% (1) ((1 *)) sep-%offset%) oldgap)
+           (f2cl-lib:fdo (i 2 (f2cl-lib:int-add i 1))
+                         ((> i (f2cl-lib:int-add k (f2cl-lib:int-sub 1))) nil)
+             (tagbody
+               (setf newgap
+                       (abs
+                        (-
+                         (f2cl-lib:fref d-%data%
+                                        ((f2cl-lib:int-add i 1))
+                                        ((1 *))
+                                        d-%offset%)
+                         (f2cl-lib:fref d-%data% (i) ((1 *)) d-%offset%))))
+               (setf (f2cl-lib:fref sep-%data% (i) ((1 *)) sep-%offset%)
+                       (min oldgap newgap))
+               (setf oldgap newgap)))
+           (setf (f2cl-lib:fref sep-%data% (k) ((1 *)) sep-%offset%) oldgap)))
+        (cond
+          (sing
+           (cond
+             ((or (and left (> m n)) (and right (< m n)))
+              (if incr
+                  (setf (f2cl-lib:fref sep-%data% (1) ((1 *)) sep-%offset%)
+                          (min
+                           (f2cl-lib:fref sep-%data% (1) ((1 *)) sep-%offset%)
+                           (f2cl-lib:fref d-%data% (1) ((1 *)) d-%offset%))))
+              (if decr
+                  (setf (f2cl-lib:fref sep-%data% (k) ((1 *)) sep-%offset%)
+                          (min
+                           (f2cl-lib:fref sep-%data% (k) ((1 *)) sep-%offset%)
+                           (f2cl-lib:fref d-%data%
+                                          (k)
+                                          ((1 *))
+                                          d-%offset%))))))))
+        (setf eps (dlamch "E"))
+        (setf safmin (dlamch "S"))
+        (setf anorm
+                (max (abs (f2cl-lib:fref d-%data% (1) ((1 *)) d-%offset%))
+                     (abs (f2cl-lib:fref d-%data% (k) ((1 *)) d-%offset%))))
+        (cond
+          ((= anorm zero)
+           (setf thresh eps))
+          (t
+           (setf thresh (max (* eps anorm) safmin))))
+        (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                      ((> i k) nil)
+          (tagbody
+            (setf (f2cl-lib:fref sep-%data% (i) ((1 *)) sep-%offset%)
+                    (max (f2cl-lib:fref sep-%data% (i) ((1 *)) sep-%offset%)
+                         thresh))))
+ end_label
+        (return (values 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::ddisna
+                 fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '((simple-array character (1))
+                        fixnum fixnum
+                        (array double-float (*)) (array double-float (*))
+                        fixnum)
+           :return-values '(nil nil nil nil nil fortran-to-lisp::info)
+           :calls '(fortran-to-lisp::dlamch fortran-to-lisp::xerbla
+                    fortran-to-lisp::lsame))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{ddot BLAS}
+\pagehead{ddot}{ddot}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<BLAS 1 ddot>>=
+(defun ddot (n dx incx dy incy)
+  (declare (type (array double-float (*)) dy dx)
+           (type fixnum incy incx n))
+  (f2cl-lib:with-multi-array-data
+      ((dx double-float dx-%data% dx-%offset%)
+       (dy double-float dy-%data% dy-%offset%))
+    (prog ((i 0) (ix 0) (iy 0) (m 0) (mp1 0) (dtemp 0.0) (ddot 0.0))
+      (declare (type (double-float) ddot dtemp)
+               (type fixnum mp1 m iy ix i))
+      (setf ddot 0.0)
+      (setf dtemp 0.0)
+      (if (<= n 0) (go end_label))
+      (if (and (= incx 1) (= incy 1)) (go label20))
+      (setf ix 1)
+      (setf iy 1)
+      (if (< incx 0)
+          (setf ix
+                  (f2cl-lib:int-add
+                   (f2cl-lib:int-mul (f2cl-lib:int-sub 1 n) incx)
+                   1)))
+      (if (< incy 0)
+          (setf iy
+                  (f2cl-lib:int-add
+                   (f2cl-lib:int-mul (f2cl-lib:int-sub 1 n) incy)
+                   1)))
+      (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                    ((> i n) nil)
+        (tagbody
+          (setf dtemp
+                  (+ dtemp
+                     (* (f2cl-lib:fref dx-%data% (ix) ((1 *)) dx-%offset%)
+                        (f2cl-lib:fref dy-%data% (iy) ((1 *)) dy-%offset%))))
+          (setf ix (f2cl-lib:int-add ix incx))
+          (setf iy (f2cl-lib:int-add iy incy))))
+      (setf ddot dtemp)
+      (go end_label)
+ label20
+      (setf m (mod n 5))
+      (if (= m 0) (go label40))
+      (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                    ((> i m) nil)
+        (tagbody
+          (setf dtemp
+                  (+ dtemp
+                     (* (f2cl-lib:fref dx-%data% (i) ((1 *)) dx-%offset%)
+                        (f2cl-lib:fref dy-%data% (i) ((1 *)) dy-%offset%))))))
+      (if (< n 5) (go label60))
+ label40
+      (setf mp1 (f2cl-lib:int-add m 1))
+      (f2cl-lib:fdo (i mp1 (f2cl-lib:int-add i 5))
+                    ((> i n) nil)
+        (tagbody
+          (setf dtemp
+                  (+ dtemp
+                     (* (f2cl-lib:fref dx-%data% (i) ((1 *)) dx-%offset%)
+                        (f2cl-lib:fref dy-%data% (i) ((1 *)) dy-%offset%))
+                     (*
+                      (f2cl-lib:fref dx-%data%
+                                     ((f2cl-lib:int-add i 1))
+                                     ((1 *))
+                                     dx-%offset%)
+                      (f2cl-lib:fref dy-%data%
+                                     ((f2cl-lib:int-add i 1))
+                                     ((1 *))
+                                     dy-%offset%))
+                     (*
+                      (f2cl-lib:fref dx-%data%
+                                     ((f2cl-lib:int-add i 2))
+                                     ((1 *))
+                                     dx-%offset%)
+                      (f2cl-lib:fref dy-%data%
+                                     ((f2cl-lib:int-add i 2))
+                                     ((1 *))
+                                     dy-%offset%))
+                     (*
+                      (f2cl-lib:fref dx-%data%
+                                     ((f2cl-lib:int-add i 3))
+                                     ((1 *))
+                                     dx-%offset%)
+                      (f2cl-lib:fref dy-%data%
+                                     ((f2cl-lib:int-add i 3))
+                                     ((1 *))
+                                     dy-%offset%))
+                     (*
+                      (f2cl-lib:fref dx-%data%
+                                     ((f2cl-lib:int-add i 4))
+                                     ((1 *))
+                                     dx-%offset%)
+                      (f2cl-lib:fref dy-%data%
+                                     ((f2cl-lib:int-add i 4))
+                                     ((1 *))
+                                     dy-%offset%))))))
+ label60
+      (setf ddot dtemp)
+ end_label
+      (return (values ddot 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::ddot fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '(fixnum (array double-float (*))
+                        fixnum (array double-float (*))
+                        fixnum)
+           :return-values '(nil nil nil nil nil)
+           :calls 'nil)))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dgbmv BLAS}
+\pagehead{dgbmv}{dgbmv}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<BLAS 2 dgbmv>>=
+(let* ((one 1.0) (zero 0.0))
+  (declare (type (double-float 1.0 1.0) one)
+           (type (double-float 0.0 0.0) zero))
+  (defun dgbmv (trans m n kl ku alpha a lda x incx beta y incy)
+    (declare (type (array double-float (*)) y x a)
+             (type (double-float) beta alpha)
+             (type fixnum incy incx lda ku kl n m)
+             (type (simple-array character (*)) trans))
+    (f2cl-lib:with-multi-array-data
+        ((trans character trans-%data% trans-%offset%)
+         (a double-float a-%data% a-%offset%)
+         (x double-float x-%data% x-%offset%)
+         (y double-float y-%data% y-%offset%))
+      (prog ((i 0) (info 0) (ix 0) (iy 0) (j 0) (jx 0) (jy 0) (k 0) (kup1 0)
+             (kx 0) (ky 0) (lenx 0) (leny 0) (temp 0.0))
+        (declare (type fixnum i info ix iy j jx jy k kup1 kx ky
+                                           lenx leny)
+                 (type (double-float) temp))
+        (setf info 0)
+        (cond
+          ((and (not (lsame trans "N"))
+                (not (lsame trans "T"))
+                (not (lsame trans "C")))
+           (setf info 1))
+          ((< m 0)
+           (setf info 2))
+          ((< n 0)
+           (setf info 3))
+          ((< kl 0)
+           (setf info 4))
+          ((< ku 0)
+           (setf info 5))
+          ((< lda (f2cl-lib:int-add kl ku 1))
+           (setf info 8))
+          ((= incx 0)
+           (setf info 10))
+          ((= incy 0)
+           (setf info 13)))
+        (cond
+          ((/= info 0)
+           (xerbla "DGBMV " info)
+           (go end_label)))
+        (if (or (= m 0) (= n 0) (and (= alpha zero) (= beta one)))
+            (go end_label))
+        (cond
+          ((lsame trans "N")
+           (setf lenx n)
+           (setf leny m))
+          (t
+           (setf lenx m)
+           (setf leny n)))
+        (cond
+          ((> incx 0)
+           (setf kx 1))
+          (t
+           (setf kx
+                   (f2cl-lib:int-sub 1
+                                     (f2cl-lib:int-mul
+                                      (f2cl-lib:int-sub lenx 1)
+                                      incx)))))
+        (cond
+          ((> incy 0)
+           (setf ky 1))
+          (t
+           (setf ky
+                   (f2cl-lib:int-sub 1
+                                     (f2cl-lib:int-mul
+                                      (f2cl-lib:int-sub leny 1)
+                                      incy)))))
+        (cond
+          ((/= beta one)
+           (cond
+             ((= incy 1)
+              (cond
+                ((= beta zero)
+                 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                               ((> i leny) nil)
+                   (tagbody
+                     (setf (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%)
+                             zero))))
+                (t
+                 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                               ((> i leny) nil)
+                   (tagbody
+                     (setf (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%)
+                             (* beta
+                                (f2cl-lib:fref y-%data%
+                                               (i)
+                                               ((1 *))
+                                               y-%offset%))))))))
+             (t
+              (setf iy ky)
+              (cond
+                ((= beta zero)
+                 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                               ((> i leny) nil)
+                   (tagbody
+                     (setf (f2cl-lib:fref y-%data% (iy) ((1 *)) y-%offset%)
+                             zero)
+                     (setf iy (f2cl-lib:int-add iy incy)))))
+                (t
+                 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                               ((> i leny) nil)
+                   (tagbody
+                     (setf (f2cl-lib:fref y-%data% (iy) ((1 *)) y-%offset%)
+                             (* beta
+                                (f2cl-lib:fref y-%data%
+                                               (iy)
+                                               ((1 *))
+                                               y-%offset%)))
+                     (setf iy (f2cl-lib:int-add iy incy))))))))))
+        (if (= alpha zero) (go end_label))
+        (setf kup1 (f2cl-lib:int-add ku 1))
+        (cond
+          ((lsame trans "N")
+           (setf jx kx)
+           (cond
+             ((= incy 1)
+              (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
+                            ((> j n) nil)
+                (tagbody
+                  (cond
+                    ((/= (f2cl-lib:fref x (jx) ((1 *))) zero)
+                     (setf temp
+                             (* alpha
+                                (f2cl-lib:fref x-%data%
+                                               (jx)
+                                               ((1 *))
+                                               x-%offset%)))
+                     (setf k (f2cl-lib:int-sub kup1 j))
+                     (f2cl-lib:fdo (i
+                                    (max (the fixnum 1)
+                                         (the fixnum
+                                              (f2cl-lib:int-add j
+                                                                (f2cl-lib:int-sub
+                                                                 ku))))
+                                    (f2cl-lib:int-add i 1))
+                                   ((> i
+                                       (min (the fixnum m)
+                                            (the fixnum
+                                                 (f2cl-lib:int-add j kl))))
+                                    nil)
+                       (tagbody
+                         (setf (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%)
+                                 (+
+                                  (f2cl-lib:fref y-%data%
+                                                 (i)
+                                                 ((1 *))
+                                                 y-%offset%)
+                                  (* temp
+                                     (f2cl-lib:fref a-%data%
+                                                    ((f2cl-lib:int-add k i) j)
+                                                    ((1 lda) (1 *))
+                                                    a-%offset%))))))))
+                  (setf jx (f2cl-lib:int-add jx incx)))))
+             (t
+              (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
+                            ((> j n) nil)
+                (tagbody
+                  (cond
+                    ((/= (f2cl-lib:fref x (jx) ((1 *))) zero)
+                     (setf temp
+                             (* alpha
+                                (f2cl-lib:fref x-%data%
+                                               (jx)
+                                               ((1 *))
+                                               x-%offset%)))
+                     (setf iy ky)
+                     (setf k (f2cl-lib:int-sub kup1 j))
+                     (f2cl-lib:fdo (i
+                                    (max (the fixnum 1)
+                                         (the fixnum
+                                              (f2cl-lib:int-add j
+                                                                (f2cl-lib:int-sub
+                                                                 ku))))
+                                    (f2cl-lib:int-add i 1))
+                                   ((> i
+                                       (min (the fixnum m)
+                                            (the fixnum
+                                                 (f2cl-lib:int-add j kl))))
+                                    nil)
+                       (tagbody
+                         (setf (f2cl-lib:fref y-%data% (iy) ((1 *)) y-%offset%)
+                                 (+
+                                  (f2cl-lib:fref y-%data%
+                                                 (iy)
+                                                 ((1 *))
+                                                 y-%offset%)
+                                  (* temp
+                                     (f2cl-lib:fref a-%data%
+                                                    ((f2cl-lib:int-add k i) j)
+                                                    ((1 lda) (1 *))
+                                                    a-%offset%))))
+                         (setf iy (f2cl-lib:int-add iy incy))))))
+                  (setf jx (f2cl-lib:int-add jx incx))
+                  (if (> j ku) (setf ky (f2cl-lib:int-add ky incy))))))))
+          (t
+           (setf jy ky)
+           (cond
+             ((= incx 1)
+              (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
+                            ((> j n) nil)
+                (tagbody
+                  (setf temp zero)
+                  (setf k (f2cl-lib:int-sub kup1 j))
+                  (f2cl-lib:fdo (i
+                                 (max (the fixnum 1)
+                                      (the fixnum
+                                           (f2cl-lib:int-add j
+                                                             (f2cl-lib:int-sub
+                                                              ku))))
+                                 (f2cl-lib:int-add i 1))
+                                ((> i
+                                    (min (the fixnum m)
+                                         (the fixnum
+                                              (f2cl-lib:int-add j kl))))
+                                 nil)
+                    (tagbody
+                      (setf temp
+                              (+ temp
+                                 (*
+                                  (f2cl-lib:fref a-%data%
+                                                 ((f2cl-lib:int-add k i) j)
+                                                 ((1 lda) (1 *))
+                                                 a-%offset%)
+                                  (f2cl-lib:fref x-%data%
+                                                 (i)
+                                                 ((1 *))
+                                                 x-%offset%))))))
+                  (setf (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%)
+                          (+ (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%)
+                             (* alpha temp)))
+                  (setf jy (f2cl-lib:int-add jy incy)))))
+             (t
+              (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
+                            ((> j n) nil)
+                (tagbody
+                  (setf temp zero)
+                  (setf ix kx)
+                  (setf k (f2cl-lib:int-sub kup1 j))
+                  (f2cl-lib:fdo (i
+                                 (max (the fixnum 1)
+                                      (the fixnum
+                                           (f2cl-lib:int-add j
+                                                             (f2cl-lib:int-sub
+                                                              ku))))
+                                 (f2cl-lib:int-add i 1))
+                                ((> i
+                                    (min (the fixnum m)
+                                         (the fixnum
+                                              (f2cl-lib:int-add j kl))))
+                                 nil)
+                    (tagbody
+                      (setf temp
+                              (+ temp
+                                 (*
+                                  (f2cl-lib:fref a-%data%
+                                                 ((f2cl-lib:int-add k i) j)
+                                                 ((1 lda) (1 *))
+                                                 a-%offset%)
+                                  (f2cl-lib:fref x-%data%
+                                                 (ix)
+                                                 ((1 *))
+                                                 x-%offset%))))
+                      (setf ix (f2cl-lib:int-add ix incx))))
+                  (setf (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%)
+                          (+ (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%)
+                             (* alpha temp)))
+                  (setf jy (f2cl-lib:int-add jy incy))
+                  (if (> j ku) (setf kx (f2cl-lib:int-add kx incx)))))))))
+ end_label
+        (return
+         (values nil nil nil nil nil nil nil nil 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::dgbmv fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '((simple-array character (1))
+                        fixnum fixnum
+                        fixnum fixnum
+                        (double-float) (array double-float (*))
+                        fixnum (array double-float (*))
+                        fixnum (double-float)
+                        (array double-float (*)) fixnum)
+           :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil
+                            nil)
+           :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dgebak LAPACK}
+\pagehead{dgebak}{dgebak}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<LAPACK dgebak>>=
+(let* ((one 1.0))
+  (declare (type (double-float 1.0 1.0) one))
+  (defun dgebak (job side n ilo ihi scale m v ldv info)
+    (declare (type (array double-float (*)) v scale)
+             (type fixnum info ldv m ihi ilo n)
+             (type (simple-array character (*)) side job))
+    (f2cl-lib:with-multi-array-data
+        ((job character job-%data% job-%offset%)
+         (side character side-%data% side-%offset%)
+         (scale double-float scale-%data% scale-%offset%)
+         (v double-float v-%data% v-%offset%))
+      (prog ((s 0.0) (i 0) (ii 0) (k 0) (leftv nil) (rightv nil))
+        (declare (type (double-float) s)
+                 (type fixnum i ii k)
+                 (type (member t nil) leftv rightv))
+        (setf rightv (lsame side "R"))
+        (setf leftv (lsame side "L"))
+        (setf info 0)
+        (cond
+          ((and (not (lsame job "N"))
+                (not (lsame job "P"))
+                (not (lsame job "S"))
+                (not (lsame job "B")))
+           (setf info -1))
+          ((and (not rightv) (not leftv))
+           (setf info -2))
+          ((< n 0)
+           (setf info -3))
+          ((or (< ilo 1)
+               (> ilo
+                  (max (the fixnum 1) (the fixnum n))))
+           (setf info -4))
+          ((or
+            (< ihi (min (the fixnum ilo) (the fixnum n)))
+            (> ihi n))
+           (setf info -5))
+          ((< m 0)
+           (setf info -7))
+          ((< ldv (max (the fixnum 1) (the fixnum n)))
+           (setf info -9)))
+        (cond
+          ((/= info 0)
+           (xerbla "DGEBAK" (f2cl-lib:int-sub info))
+           (go end_label)))
+        (if (= n 0) (go end_label))
+        (if (= m 0) (go end_label))
+        (if (lsame job "N") (go end_label))
+        (if (= ilo ihi) (go label30))
+        (cond
+          ((or (lsame job "S") (lsame job "B"))
+           (cond
+             (rightv
+              (f2cl-lib:fdo (i ilo (f2cl-lib:int-add i 1))
+                            ((> i ihi) nil)
+                (tagbody
+                  (setf s
+                          (f2cl-lib:fref scale-%data%
+                                         (i)
+                                         ((1 *))
+                                         scale-%offset%))
+                  (dscal m s
+                   (f2cl-lib:array-slice v double-float (i 1) ((1 ldv) (1 *)))
+                   ldv)))))
+           (cond
+             (leftv
+              (f2cl-lib:fdo (i ilo (f2cl-lib:int-add i 1))
+                            ((> i ihi) nil)
+                (tagbody
+                  (setf s
+                          (/ one
+                             (f2cl-lib:fref scale-%data%
+                                            (i)
+                                            ((1 *))
+                                            scale-%offset%)))
+                  (dscal m s
+                   (f2cl-lib:array-slice v double-float (i 1) ((1 ldv) (1 *)))
+                   ldv)))))))
+ label30
+        (cond
+          ((or (lsame job "P") (lsame job "B"))
+           (cond
+             (rightv
+              (f2cl-lib:fdo (ii 1 (f2cl-lib:int-add ii 1))
+                            ((> ii n) nil)
+                (tagbody
+                  (setf i ii)
+                  (if (and (>= i ilo) (<= i ihi)) (go label40))
+                  (if (< i ilo) (setf i (f2cl-lib:int-sub ilo ii)))
+                  (setf k
+                          (f2cl-lib:int
+                           (f2cl-lib:fref scale-%data%
+                                          (i)
+                                          ((1 *))
+                                          scale-%offset%)))
+                  (if (= k i) (go label40))
+                  (dswap m
+                   (f2cl-lib:array-slice v double-float (i 1) ((1 ldv) (1 *)))
+                   ldv
+                   (f2cl-lib:array-slice v double-float (k 1) ((1 ldv) (1 *)))
+                   ldv)
+ label40))))
+           (cond
+             (leftv
+              (f2cl-lib:fdo (ii 1 (f2cl-lib:int-add ii 1))
+                            ((> ii n) nil)
+                (tagbody
+                  (setf i ii)
+                  (if (and (>= i ilo) (<= i ihi)) (go label50))
+                  (if (< i ilo) (setf i (f2cl-lib:int-sub ilo ii)))
+                  (setf k
+                          (f2cl-lib:int
+                           (f2cl-lib:fref scale-%data%
+                                          (i)
+                                          ((1 *))
+                                          scale-%offset%)))
+                  (if (= k i) (go label50))
+                  (dswap m
+                   (f2cl-lib:array-slice v double-float (i 1) ((1 ldv) (1 *)))
+                   ldv
+                   (f2cl-lib:array-slice v double-float (k 1) ((1 ldv) (1 *)))
+                   ldv)
+ label50))))))
+ end_label
+        (return (values 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::dgebak
+                 fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '((simple-array character (1))
+                        (simple-array character (1))
+                        fixnum fixnum
+                        fixnum (array double-float (*))
+                        fixnum (array double-float (*))
+                        fixnum
+                        fixnum)
+           :return-values '(nil nil nil nil nil nil nil nil nil
+                            fortran-to-lisp::info)
+           :calls '(fortran-to-lisp::dswap fortran-to-lisp::dscal
+                    fortran-to-lisp::xerbla fortran-to-lisp::lsame))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dgebal LAPACK}
+\pagehead{dgebal}{dgebal}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<LAPACK dgebal>>=
+(let* ((zero 0.0) (one 1.0) (sclfac 8.0) (factor 0.95))
+  (declare (type (double-float 0.0 0.0) zero)
+           (type (double-float 1.0 1.0) one)
+           (type (double-float 8.0 8.0) sclfac)
+           (type (double-float 0.95 0.95) factor))
+  (defun dgebal (job n a lda ilo ihi scale info)
+    (declare (type (array double-float (*)) scale a)
+             (type fixnum info ihi ilo lda n)
+             (type (simple-array character (*)) job))
+    (f2cl-lib:with-multi-array-data
+        ((job character job-%data% job-%offset%)
+         (a double-float a-%data% a-%offset%)
+         (scale double-float scale-%data% scale-%offset%))
+      (prog ((c 0.0) (ca 0.0) (f 0.0) (g 0.0) (r 0.0) (ra 0.0) (s 0.0)
+             (sfmax1 0.0) (sfmax2 0.0) (sfmin1 0.0) (sfmin2 0.0) (i 0) (ica 0)
+             (iexc 0) (ira 0) (j 0) (k 0) (l 0) (m 0) (noconv nil))
+        (declare (type (double-float) c ca f g r ra s sfmax1 sfmax2 sfmin1
+                                      sfmin2)
+                 (type fixnum i ica iexc ira j k l m)
+                 (type (member t nil) noconv))
+        (setf info 0)
+        (cond
+          ((and (not (lsame job "N"))
+                (not (lsame job "P"))
+                (not (lsame job "S"))
+                (not (lsame job "B")))
+           (setf info -1))
+          ((< n 0)
+           (setf info -2))
+          ((< lda (max (the fixnum 1) (the fixnum n)))
+           (setf info -4)))
+        (cond
+          ((/= info 0)
+           (xerbla "DGEBAL" (f2cl-lib:int-sub info))
+           (go end_label)))
+        (setf k 1)
+        (setf l n)
+        (if (= n 0) (go label210))
+        (cond
+          ((lsame job "N")
+           (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                         ((> i n) nil)
+             (tagbody
+               (setf (f2cl-lib:fref scale-%data% (i) ((1 *)) scale-%offset%)
+                       one)))
+           (go label210)))
+        (if (lsame job "S") (go label120))
+        (go label50)
+ label20
+        (setf (f2cl-lib:fref scale-%data% (m) ((1 *)) scale-%offset%)
+                (coerce (the fixnum j) 'double-float))
+        (if (= j m) (go label30))
+        (dswap l (f2cl-lib:array-slice a double-float (1 j) ((1 lda) (1 *))) 1
+         (f2cl-lib:array-slice a double-float (1 m) ((1 lda) (1 *))) 1)
+        (dswap (f2cl-lib:int-add (f2cl-lib:int-sub n k) 1)
+         (f2cl-lib:array-slice a double-float (j k) ((1 lda) (1 *))) lda
+         (f2cl-lib:array-slice a double-float (m k) ((1 lda) (1 *))) lda)
+ label30
+        (f2cl-lib:computed-goto (label40 label80) iexc)
+ label40
+        (if (= l 1) (go label210))
+        (setf l (f2cl-lib:int-sub l 1))
+ label50
+        (f2cl-lib:fdo (j l (f2cl-lib:int-add j (f2cl-lib:int-sub 1)))
+                      ((> j 1) nil)
+          (tagbody
+            (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                          ((> i l) nil)
+              (tagbody
+                (if (= i j) (go label60))
+                (if
+                 (/= (f2cl-lib:fref a-%data% (j i) ((1 lda) (1 *)) a-%offset%)
+                     zero)
+                 (go label70))
+ label60))
+            (setf m l)
+            (setf iexc 1)
+            (go label20)
+ label70))
+        (go label90)
+ label80
+        (setf k (f2cl-lib:int-add k 1))
+ label90
+        (f2cl-lib:fdo (j k (f2cl-lib:int-add j 1))
+                      ((> j l) nil)
+          (tagbody
+            (f2cl-lib:fdo (i k (f2cl-lib:int-add i 1))
+                          ((> i l) nil)
+              (tagbody
+                (if (= i j) (go label100))
+                (if
+                 (/= (f2cl-lib:fref a-%data% (i j) ((1 lda) (1 *)) a-%offset%)
+                     zero)
+                 (go label110))
+ label100))
+            (setf m k)
+            (setf iexc 2)
+            (go label20)
+ label110))
+ label120
+        (f2cl-lib:fdo (i k (f2cl-lib:int-add i 1))
+                      ((> i l) nil)
+          (tagbody
+           (setf (f2cl-lib:fref scale-%data% (i) ((1 *)) scale-%offset%) one)))
+        (if (lsame job "P") (go label210))
+        (setf sfmin1 (/ (dlamch "S") (dlamch "P")))
+        (setf sfmax1 (/ one sfmin1))
+        (setf sfmin2 (* sfmin1 sclfac))
+        (setf sfmax2 (/ one sfmin2))
+ label140
+        (setf noconv nil)
+        (f2cl-lib:fdo (i k (f2cl-lib:int-add i 1))
+                      ((> i l) nil)
+          (tagbody
+            (setf c zero)
+            (setf r zero)
+            (f2cl-lib:fdo (j k (f2cl-lib:int-add j 1))
+                          ((> j l) nil)
+              (tagbody
+                (if (= j i) (go label150))
+                (setf c
+                        (+ c
+                           (abs
+                            (f2cl-lib:fref a-%data%
+                                           (j i)
+                                           ((1 lda) (1 *))
+                                           a-%offset%))))
+                (setf r
+                        (+ r
+                           (abs
+                            (f2cl-lib:fref a-%data%
+                                           (i j)
+                                           ((1 lda) (1 *))
+                                           a-%offset%))))
+ label150))
+            (setf ica
+                    (idamax l
+                     (f2cl-lib:array-slice a
+                                           double-float
+                                           (1 i)
+                                           ((1 lda) (1 *)))
+                     1))
+            (setf ca
+                    (abs
+                     (f2cl-lib:fref a-%data%
+                                    (ica i)
+                                    ((1 lda) (1 *))
+                                    a-%offset%)))
+            (setf ira
+                    (idamax (f2cl-lib:int-add (f2cl-lib:int-sub n k) 1)
+                     (f2cl-lib:array-slice a
+                                           double-float
+                                           (i k)
+                                           ((1 lda) (1 *)))
+                     lda))
+            (setf ra
+                    (abs
+                     (f2cl-lib:fref a-%data%
+                                    (i
+                                     (f2cl-lib:int-sub (f2cl-lib:int-add ira k)
+                                                       1))
+                                    ((1 lda) (1 *))
+                                    a-%offset%)))
+            (if (or (= c zero) (= r zero)) (go label200))
+            (setf g (/ r sclfac))
+            (setf f one)
+            (setf s (+ c r))
+ label160
+            (if (or (>= c g) (>= (max f c ca) sfmax2) (<= (min r g ra) sfmin2))
+                (go label170))
+            (setf f (* f sclfac))
+            (setf c (* c sclfac))
+            (setf ca (* ca sclfac))
+            (setf r (/ r sclfac))
+            (setf g (/ g sclfac))
+            (setf ra (/ ra sclfac))
+            (go label160)
+ label170
+            (setf g (/ c sclfac))
+ label180
+            (if (or (< g r) (>= (max r ra) sfmax2) (<= (min f c g ca) sfmin2))
+                (go label190))
+            (setf f (/ f sclfac))
+            (setf c (/ c sclfac))
+            (setf g (/ g sclfac))
+            (setf ca (/ ca sclfac))
+            (setf r (* r sclfac))
+            (setf ra (* ra sclfac))
+            (go label180)
+ label190
+            (if (>= (+ c r) (* factor s)) (go label200))
+            (cond
+              ((and (< f one) (< (f2cl-lib:fref scale (i) ((1 *))) one))
+               (if
+                (<=
+                 (* f (f2cl-lib:fref scale-%data% (i) ((1 *)) scale-%offset%))
+                 sfmin1)
+                (go label200))))
+            (cond
+              ((and (> f one) (> (f2cl-lib:fref scale (i) ((1 *))) one))
+               (if
+                (>= (f2cl-lib:fref scale-%data% (i) ((1 *)) scale-%offset%)
+                    (/ sfmax1 f))
+                (go label200))))
+            (setf g (/ one f))
+            (setf (f2cl-lib:fref scale-%data% (i) ((1 *)) scale-%offset%)
+                    (* (f2cl-lib:fref scale-%data% (i) ((1 *)) scale-%offset%)
+                       f))
+            (setf noconv t)
+            (dscal (f2cl-lib:int-add (f2cl-lib:int-sub n k) 1) g
+             (f2cl-lib:array-slice a double-float (i k) ((1 lda) (1 *))) lda)
+            (dscal l f
+             (f2cl-lib:array-slice a double-float (1 i) ((1 lda) (1 *))) 1)
+ label200))
+        (if noconv (go label140))
+ label210
+        (setf ilo k)
+        (setf ihi l)
+ end_label
+        (return (values nil nil nil nil ilo ihi 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::dgebal
+                 fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '((simple-array character (1))
+                        fixnum (array double-float (*))
+                        fixnum fixnum
+                        fixnum (array double-float (*))
+                        fixnum)
+           :return-values '(nil nil nil nil fortran-to-lisp::ilo
+                            fortran-to-lisp::ihi nil fortran-to-lisp::info)
+           :calls '(fortran-to-lisp::dscal fortran-to-lisp::idamax
+                    fortran-to-lisp::dlamch fortran-to-lisp::dswap
+                    fortran-to-lisp::xerbla fortran-to-lisp::lsame))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dgebd2 LAPACK}
+\pagehead{dgebd2}{dgebd2}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<LAPACK dgebd2>>=
+(let* ((zero 0.0) (one 1.0))
+  (declare (type (double-float 0.0 0.0) zero)
+           (type (double-float 1.0 1.0) one))
+  (defun dgebd2 (m n a lda d e tauq taup work info)
+    (declare (type (array double-float (*)) work taup tauq e d a)
+             (type fixnum info lda n m))
+    (f2cl-lib:with-multi-array-data
+        ((a double-float a-%data% a-%offset%)
+         (d double-float d-%data% d-%offset%)
+         (e double-float e-%data% e-%offset%)
+         (tauq double-float tauq-%data% tauq-%offset%)
+         (taup double-float taup-%data% taup-%offset%)
+         (work double-float work-%data% work-%offset%))
+      (prog ((i 0))
+        (declare (type fixnum i))
+        (setf info 0)
+        (cond
+          ((< m 0)
+           (setf info -1))
+          ((< n 0)
+           (setf info -2))
+          ((< lda (max (the fixnum 1) (the fixnum m)))
+           (setf info -4)))
+        (cond
+          ((< info 0)
+           (xerbla "DGEBD2" (f2cl-lib:int-sub info))
+           (go end_label)))
+        (cond
+          ((>= m n)
+           (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                         ((> i n) nil)
+             (tagbody
+               (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                   (dlarfg (f2cl-lib:int-add (f2cl-lib:int-sub m i) 1)
+                    (f2cl-lib:fref a-%data% (i i) ((1 lda) (1 *)) a-%offset%)
+                    (f2cl-lib:array-slice a
+                                          double-float
+                                          ((min (f2cl-lib:int-add i 1) m) i)
+                                          ((1 lda) (1 *)))
+                    1 (f2cl-lib:fref tauq-%data% (i) ((1 *)) tauq-%offset%))
+                 (declare (ignore var-0 var-2 var-3))
+                 (setf (f2cl-lib:fref a-%data%
+                                      (i i)
+                                      ((1 lda) (1 *))
+                                      a-%offset%)
+                         var-1)
+                 (setf (f2cl-lib:fref tauq-%data% (i) ((1 *)) tauq-%offset%)
+                         var-4))
+               (setf (f2cl-lib:fref d-%data% (i) ((1 *)) d-%offset%)
+                       (f2cl-lib:fref a-%data%
+                                      (i i)
+                                      ((1 lda) (1 *))
+                                      a-%offset%))
+               (setf (f2cl-lib:fref a-%data% (i i) ((1 lda) (1 *)) a-%offset%)
+                       one)
+               (dlarf "Left" (f2cl-lib:int-add (f2cl-lib:int-sub m i) 1)
+                (f2cl-lib:int-sub n i)
+                (f2cl-lib:array-slice a double-float (i i) ((1 lda) (1 *))) 1
+                (f2cl-lib:fref tauq-%data% (i) ((1 *)) tauq-%offset%)
+                (f2cl-lib:array-slice a
+                                      double-float
+                                      (i (f2cl-lib:int-add i 1))
+                                      ((1 lda) (1 *)))
+                lda work)
+               (setf (f2cl-lib:fref a-%data% (i i) ((1 lda) (1 *)) a-%offset%)
+                       (f2cl-lib:fref d-%data% (i) ((1 *)) d-%offset%))
+               (cond
+                 ((< i n)
+                  (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                      (dlarfg (f2cl-lib:int-sub n i)
+                       (f2cl-lib:fref a-%data%
+                                      (i (f2cl-lib:int-add i 1))
+                                      ((1 lda) (1 *))
+                                      a-%offset%)
+                       (f2cl-lib:array-slice a
+                                             double-float
+                                             (i
+                                              (min
+                                               (the fixnum
+                                                    (f2cl-lib:int-add i 2))
+                                               (the fixnum n)))
+                                             ((1 lda) (1 *)))
+                       lda
+                       (f2cl-lib:fref taup-%data% (i) ((1 *)) taup-%offset%))
+                    (declare (ignore var-0 var-2 var-3))
+                    (setf (f2cl-lib:fref a-%data%
+                                         (i (f2cl-lib:int-add i 1))
+                                         ((1 lda) (1 *))
+                                         a-%offset%)
+                            var-1)
+                    (setf (f2cl-lib:fref taup-%data% (i) ((1 *)) taup-%offset%)
+                            var-4))
+                  (setf (f2cl-lib:fref e-%data% (i) ((1 *)) e-%offset%)
+                          (f2cl-lib:fref a-%data%
+                                         (i (f2cl-lib:int-add i 1))
+                                         ((1 lda) (1 *))
+                                         a-%offset%))
+                  (setf (f2cl-lib:fref a-%data%
+                                       (i (f2cl-lib:int-add i 1))
+                                       ((1 lda) (1 *))
+                                       a-%offset%)
+                          one)
+                  (dlarf "Right" (f2cl-lib:int-sub m i) (f2cl-lib:int-sub n i)
+                   (f2cl-lib:array-slice a
+                                         double-float
+                                         (i (f2cl-lib:int-add i 1))
+                                         ((1 lda) (1 *)))
+                   lda (f2cl-lib:fref taup-%data% (i) ((1 *)) taup-%offset%)
+                   (f2cl-lib:array-slice a
+                                         double-float
+                                         ((+ i 1) (f2cl-lib:int-add i 1))
+                                         ((1 lda) (1 *)))
+                   lda work)
+                  (setf (f2cl-lib:fref a-%data%
+                                       (i (f2cl-lib:int-add i 1))
+                                       ((1 lda) (1 *))
+                                       a-%offset%)
+                          (f2cl-lib:fref e-%data% (i) ((1 *)) e-%offset%)))
+                 (t
+                  (setf (f2cl-lib:fref taup-%data% (i) ((1 *)) taup-%offset%)
+                          zero))))))
+          (t
+           (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                         ((> i m) nil)
+             (tagbody
+               (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                   (dlarfg (f2cl-lib:int-add (f2cl-lib:int-sub n i) 1)
+                    (f2cl-lib:fref a-%data% (i i) ((1 lda) (1 *)) a-%offset%)
+                    (f2cl-lib:array-slice a
+                                          double-float
+                                          (i
+                                           (min
+                                            (the fixnum
+                                                 (f2cl-lib:int-add i 1))
+                                            (the fixnum n)))
+                                          ((1 lda) (1 *)))
+                    lda (f2cl-lib:fref taup-%data% (i) ((1 *)) taup-%offset%))
+                 (declare (ignore var-0 var-2 var-3))
+                 (setf (f2cl-lib:fref a-%data%
+                                      (i i)
+                                      ((1 lda) (1 *))
+                                      a-%offset%)
+                         var-1)
+                 (setf (f2cl-lib:fref taup-%data% (i) ((1 *)) taup-%offset%)
+                         var-4))
+               (setf (f2cl-lib:fref d-%data% (i) ((1 *)) d-%offset%)
+                       (f2cl-lib:fref a-%data%
+                                      (i i)
+                                      ((1 lda) (1 *))
+                                      a-%offset%))
+               (setf (f2cl-lib:fref a-%data% (i i) ((1 lda) (1 *)) a-%offset%)
+                       one)
+               (dlarf "Right" (f2cl-lib:int-sub m i)
+                (f2cl-lib:int-add (f2cl-lib:int-sub n i) 1)
+                (f2cl-lib:array-slice a double-float (i i) ((1 lda) (1 *))) lda
+                (f2cl-lib:fref taup-%data% (i) ((1 *)) taup-%offset%)
+                (f2cl-lib:array-slice a
+                                      double-float
+                                      ((min (f2cl-lib:int-add i 1) m) i)
+                                      ((1 lda) (1 *)))
+                lda work)
+               (setf (f2cl-lib:fref a-%data% (i i) ((1 lda) (1 *)) a-%offset%)
+                       (f2cl-lib:fref d-%data% (i) ((1 *)) d-%offset%))
+               (cond
+                 ((< i m)
+                  (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                      (dlarfg (f2cl-lib:int-sub m i)
+                       (f2cl-lib:fref a-%data%
+                                      ((f2cl-lib:int-add i 1) i)
+                                      ((1 lda) (1 *))
+                                      a-%offset%)
+                       (f2cl-lib:array-slice a
+                                             double-float
+                                             ((min (f2cl-lib:int-add i 2) m) i)
+                                             ((1 lda) (1 *)))
+                       1 (f2cl-lib:fref tauq-%data% (i) ((1 *)) tauq-%offset%))
+                    (declare (ignore var-0 var-2 var-3))
+                    (setf (f2cl-lib:fref a-%data%
+                                         ((f2cl-lib:int-add i 1) i)
+                                         ((1 lda) (1 *))
+                                         a-%offset%)
+                            var-1)
+                    (setf (f2cl-lib:fref tauq-%data% (i) ((1 *)) tauq-%offset%)
+                            var-4))
+                  (setf (f2cl-lib:fref e-%data% (i) ((1 *)) e-%offset%)
+                          (f2cl-lib:fref a-%data%
+                                         ((f2cl-lib:int-add i 1) i)
+                                         ((1 lda) (1 *))
+                                         a-%offset%))
+                  (setf (f2cl-lib:fref a-%data%
+                                       ((f2cl-lib:int-add i 1) i)
+                                       ((1 lda) (1 *))
+                                       a-%offset%)
+                          one)
+                  (dlarf "Left" (f2cl-lib:int-sub m i) (f2cl-lib:int-sub n i)
+                   (f2cl-lib:array-slice a
+                                         double-float
+                                         ((+ i 1) i)
+                                         ((1 lda) (1 *)))
+                   1 (f2cl-lib:fref tauq-%data% (i) ((1 *)) tauq-%offset%)
+                   (f2cl-lib:array-slice a
+                                         double-float
+                                         ((+ i 1) (f2cl-lib:int-add i 1))
+                                         ((1 lda) (1 *)))
+                   lda work)
+                  (setf (f2cl-lib:fref a-%data%
+                                       ((f2cl-lib:int-add i 1) i)
+                                       ((1 lda) (1 *))
+                                       a-%offset%)
+                          (f2cl-lib:fref e-%data% (i) ((1 *)) e-%offset%)))
+                 (t
+                  (setf (f2cl-lib:fref tauq-%data% (i) ((1 *)) tauq-%offset%)
+                          zero)))))))
+ end_label
+        (return (values 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::dgebd2
+                 fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '(fixnum fixnum
+                        (array double-float (*)) fixnum
+                        (array double-float (*)) (array double-float (*))
+                        (array double-float (*)) (array double-float (*))
+                        (array double-float (*)) fixnum)
+           :return-values '(nil nil nil nil nil nil nil nil nil
+                            fortran-to-lisp::info)
+           :calls '(fortran-to-lisp::dlarf fortran-to-lisp::dlarfg
+                    fortran-to-lisp::xerbla))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dgebrd LAPACK}
+\pagehead{dgebrd}{dgebrd}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<LAPACK dgebrd>>=
+(let* ((one 1.0))
+  (declare (type (double-float 1.0 1.0) one))
+  (defun dgebrd (m n a lda d e tauq taup work lwork info)
+    (declare (type (array double-float (*)) work taup tauq e d a)
+             (type fixnum info lwork lda n m))
+    (f2cl-lib:with-multi-array-data
+        ((a double-float a-%data% a-%offset%)
+         (d double-float d-%data% d-%offset%)
+         (e double-float e-%data% e-%offset%)
+         (tauq double-float tauq-%data% tauq-%offset%)
+         (taup double-float taup-%data% taup-%offset%)
+         (work double-float work-%data% work-%offset%))
+      (prog ((ws 0.0) (i 0) (iinfo 0) (j 0) (ldwrkx 0) (ldwrky 0) (lwkopt 0)
+             (minmn 0) (nb 0) (nbmin 0) (nx 0) (lquery nil))
+        (declare (type (double-float) ws)
+                 (type fixnum i iinfo j ldwrkx ldwrky lwkopt minmn
+                                           nb nbmin nx)
+                 (type (member t nil) lquery))
+        (setf info 0)
+        (setf nb
+                (max (the fixnum 1)
+                     (the fixnum
+                          (ilaenv 1 "DGEBRD" " " m n -1 -1))))
+        (setf lwkopt (f2cl-lib:int-mul (f2cl-lib:int-add m n) nb))
+        (setf (f2cl-lib:fref work-%data% (1) ((1 *)) work-%offset%)
+                (coerce (realpart lwkopt) 'double-float))
+        (setf lquery (coerce (= lwork -1) '(member t nil)))
+        (cond
+          ((< m 0)
+           (setf info -1))
+          ((< n 0)
+           (setf info -2))
+          ((< lda (max (the fixnum 1) (the fixnum m)))
+           (setf info -4))
+          ((and
+            (< lwork
+               (max (the fixnum 1)
+                    (the fixnum m)
+                    (the fixnum n)))
+            (not lquery))
+           (setf info -10)))
+        (cond
+          ((< info 0)
+           (xerbla "DGEBRD" (f2cl-lib:int-sub info))
+           (go end_label))
+          (lquery
+           (go end_label)))
+        (setf minmn (min (the fixnum m) (the fixnum n)))
+        (cond
+          ((= minmn 0)
+           (setf (f2cl-lib:fref work-%data% (1) ((1 *)) work-%offset%)
+                   (coerce (the fixnum 1) 'double-float))
+           (go end_label)))
+        (setf ws
+                (coerce
+                 (the fixnum
+                      (max (the fixnum m)
+                           (the fixnum n)))
+                 'double-float))
+        (setf ldwrkx m)
+        (setf ldwrky n)
+        (cond
+          ((and (> nb 1) (< nb minmn))
+           (setf nx
+                   (max (the fixnum nb)
+                        (the fixnum
+                             (ilaenv 3 "DGEBRD" " " m n -1 -1))))
+           (cond
+             ((< nx minmn)
+              (setf ws
+                      (coerce
+                       (the fixnum
+                            (f2cl-lib:int-mul (f2cl-lib:int-add m n) nb))
+                       'double-float))
+              (cond
+                ((< lwork ws)
+                 (setf nbmin (ilaenv 2 "DGEBRD" " " m n -1 -1))
+                 (cond
+                   ((>= lwork (f2cl-lib:int-mul (f2cl-lib:int-add m n) nbmin))
+                    (setf nb (the fixnum (truncate lwork (+ m n)))))
+                   (t
+                    (setf nb 1)
+                    (setf nx minmn))))))))
+          (t
+           (setf nx minmn)))
+        (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i nb))
+                      ((> i (f2cl-lib:int-add minmn (f2cl-lib:int-sub nx))) nil)
+          (tagbody
+            (dlabrd (f2cl-lib:int-add (f2cl-lib:int-sub m i) 1)
+             (f2cl-lib:int-add (f2cl-lib:int-sub n i) 1) nb
+             (f2cl-lib:array-slice a double-float (i i) ((1 lda) (1 *))) lda
+             (f2cl-lib:array-slice d double-float (i) ((1 *)))
+             (f2cl-lib:array-slice e double-float (i) ((1 *)))
+             (f2cl-lib:array-slice tauq double-float (i) ((1 *)))
+             (f2cl-lib:array-slice taup double-float (i) ((1 *))) work ldwrkx
+             (f2cl-lib:array-slice work
+                                   double-float
+                                   ((+ (f2cl-lib:int-mul ldwrkx nb) 1))
+                                   ((1 *)))
+             ldwrky)
+            (dgemm "No transpose" "Transpose"
+             (f2cl-lib:int-add (f2cl-lib:int-sub m i nb) 1)
+             (f2cl-lib:int-add (f2cl-lib:int-sub n i nb) 1) nb (- one)
+             (f2cl-lib:array-slice a double-float ((+ i nb) i) ((1 lda) (1 *)))
+             lda
+             (f2cl-lib:array-slice work
+                                   double-float
+                                   ((+ (f2cl-lib:int-mul ldwrkx nb) nb 1))
+                                   ((1 *)))
+             ldwrky one
+             (f2cl-lib:array-slice a
+                                   double-float
+                                   ((+ i nb) (f2cl-lib:int-add i nb))
+                                   ((1 lda) (1 *)))
+             lda)
+            (dgemm "No transpose" "No transpose"
+             (f2cl-lib:int-add (f2cl-lib:int-sub m i nb) 1)
+             (f2cl-lib:int-add (f2cl-lib:int-sub n i nb) 1) nb (- one)
+             (f2cl-lib:array-slice work double-float ((+ nb 1)) ((1 *))) ldwrkx
+             (f2cl-lib:array-slice a
+                                   double-float
+                                   (i (f2cl-lib:int-add i nb))
+                                   ((1 lda) (1 *)))
+             lda one
+             (f2cl-lib:array-slice a
+                                   double-float
+                                   ((+ i nb) (f2cl-lib:int-add i nb))
+                                   ((1 lda) (1 *)))
+             lda)
+            (cond
+              ((>= m n)
+               (f2cl-lib:fdo (j i (f2cl-lib:int-add j 1))
+                             ((> j
+                                 (f2cl-lib:int-add i nb (f2cl-lib:int-sub 1)))
+                              nil)
+                 (tagbody
+                   (setf (f2cl-lib:fref a-%data%
+                                        (j j)
+                                        ((1 lda) (1 *))
+                                        a-%offset%)
+                           (f2cl-lib:fref d-%data% (j) ((1 *)) d-%offset%))
+                   (setf (f2cl-lib:fref a-%data%
+                                        (j (f2cl-lib:int-add j 1))
+                                        ((1 lda) (1 *))
+                                        a-%offset%)
+                           (f2cl-lib:fref e-%data% (j) ((1 *)) e-%offset%)))))
+              (t
+               (f2cl-lib:fdo (j i (f2cl-lib:int-add j 1))
+                             ((> j
+                                 (f2cl-lib:int-add i nb (f2cl-lib:int-sub 1)))
+                              nil)
+                 (tagbody
+                   (setf (f2cl-lib:fref a-%data%
+                                        (j j)
+                                        ((1 lda) (1 *))
+                                        a-%offset%)
+                           (f2cl-lib:fref d-%data% (j) ((1 *)) d-%offset%))
+                   (setf (f2cl-lib:fref a-%data%
+                                        ((f2cl-lib:int-add j 1) j)
+                                        ((1 lda) (1 *))
+                                        a-%offset%)
+                         (f2cl-lib:fref e-%data% (j) ((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)
+            (dgebd2 (f2cl-lib:int-add (f2cl-lib:int-sub m i) 1)
+             (f2cl-lib:int-add (f2cl-lib:int-sub n i) 1)
+             (f2cl-lib:array-slice a double-float (i i) ((1 lda) (1 *))) lda
+             (f2cl-lib:array-slice d double-float (i) ((1 *)))
+             (f2cl-lib:array-slice e double-float (i) ((1 *)))
+             (f2cl-lib:array-slice tauq double-float (i) ((1 *)))
+             (f2cl-lib:array-slice taup double-float (i) ((1 *))) work iinfo)
+          (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                           var-8))
+          (setf iinfo var-9))
+        (setf (f2cl-lib:fref work-%data% (1) ((1 *)) work-%offset%) ws)
+ end_label
+        (return (values 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::dgebrd
+                 fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '(fixnum fixnum
+                        (array double-float (*)) fixnum
+                        (array double-float (*)) (array double-float (*))
+                        (array double-float (*)) (array double-float (*))
+                        (array double-float (*)) fixnum
+                        fixnum)
+           :return-values '(nil nil nil nil nil nil nil nil nil nil
+                            fortran-to-lisp::info)
+           :calls '(fortran-to-lisp::dgebd2 fortran-to-lisp::dgemm
+                    fortran-to-lisp::dlabrd fortran-to-lisp::xerbla
+                    fortran-to-lisp::ilaenv))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dgeev LAPACK}
+\pagehead{dgeev}{dgeev}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<LAPACK dgeev>>=
+(let* ((zero 0.0) (one 1.0))
+  (declare (type (double-float 0.0 0.0) zero)
+           (type (double-float 1.0 1.0) one))
+  (defun dgeev (jobvl jobvr n a lda wr wi vl ldvl vr ldvr work lwork info)
+    (declare (type (array double-float (*)) work vr vl wi wr a)
+             (type fixnum info lwork ldvr ldvl lda n)
+             (type (simple-array character (*)) jobvr jobvl))
+    (f2cl-lib:with-multi-array-data
+        ((jobvl character jobvl-%data% jobvl-%offset%)
+         (jobvr character jobvr-%data% jobvr-%offset%)
+         (a double-float a-%data% a-%offset%)
+         (wr double-float wr-%data% wr-%offset%)
+         (wi double-float wi-%data% wi-%offset%)
+         (vl double-float vl-%data% vl-%offset%)
+         (vr double-float vr-%data% vr-%offset%)
+         (work double-float work-%data% work-%offset%))
+      (prog ((dum (make-array 1 :element-type 'double-float))
+             (select (make-array 1 :element-type 't)) (anrm 0.0) (bignum 0.0)
+             (cs 0.0) (cscale 0.0) (eps 0.0) (r 0.0) (scl 0.0) (smlnum 0.0)
+             (sn 0.0) (hswork 0) (i 0) (ibal 0) (ierr 0) (ihi 0) (ilo 0)
+             (itau 0) (iwrk 0) (k 0) (maxb 0) (maxwrk 0) (minwrk 0) (nout 0)
+             (side
+              (make-array '(1) :element-type 'character :initial-element #\ ))
+             (lquery nil) (scalea nil) (wantvl nil) (wantvr nil))
+        (declare (type (array double-float (1)) dum)
+                 (type (array (member t nil) (1)) select)
+                 (type (double-float) anrm bignum cs cscale eps r scl smlnum
+                                      sn)
+                 (type fixnum hswork i ibal ierr ihi ilo itau iwrk
+                                           k maxb maxwrk minwrk nout)
+                 (type (simple-array character (1)) side)
+                 (type (member t nil) lquery scalea wantvl wantvr))
+        (setf info 0)
+        (setf lquery (coerce (= lwork -1) '(member t nil)))
+        (setf wantvl (lsame jobvl "V"))
+        (setf wantvr (lsame jobvr "V"))
+        (cond
+          ((and (not wantvl) (not (lsame jobvl "N")))
+           (setf info -1))
+          ((and (not wantvr) (not (lsame jobvr "N")))
+           (setf info -2))
+          ((< n 0)
+           (setf info -3))
+          ((< lda (max (the fixnum 1) (the fixnum n)))
+           (setf info -5))
+          ((or (< ldvl 1) (and wantvl (< ldvl n)))
+           (setf info -9))
+          ((or (< ldvr 1) (and wantvr (< ldvr n)))
+           (setf info -11)))
+        (setf minwrk 1)
+        (cond
+          ((and (= info 0) (or (>= lwork 1) lquery))
+           (setf maxwrk
+                   (f2cl-lib:int-add (f2cl-lib:int-mul 2 n)
+                                     (f2cl-lib:int-mul n
+                                                       (ilaenv 1 "DGEHRD" " " n
+                                                        1 n 0))))
+           (cond
+             ((and (not wantvl) (not wantvr))
+              (setf minwrk
+                      (max (the fixnum 1)
+                           (the fixnum (f2cl-lib:int-mul 3 n))))
+              (setf maxb
+                      (max
+                       (the fixnum
+                            (ilaenv 8 "DHSEQR" "EN" n 1 n -1))
+                       (the fixnum 2)))
+              (setf k
+                      (min (the fixnum maxb)
+                           (the fixnum n)
+                           (the fixnum
+                                (max (the fixnum 2)
+                                     (the fixnum
+                                          (ilaenv 4 "DHSEQR" "EN" n 1 n -1))))))
+              (setf hswork
+                      (max
+                       (the fixnum
+                            (f2cl-lib:int-mul k (f2cl-lib:int-add k 2)))
+                       (the fixnum (f2cl-lib:int-mul 2 n))))
+              (setf maxwrk
+                      (max (the fixnum maxwrk)
+                           (the fixnum (f2cl-lib:int-add n 1))
+                           (the fixnum
+                                (f2cl-lib:int-add n hswork)))))
+             (t
+              (setf minwrk
+                      (max (the fixnum 1)
+                           (the fixnum (f2cl-lib:int-mul 4 n))))
+              (setf maxwrk
+                      (max (the fixnum maxwrk)
+                           (the fixnum
+                                (f2cl-lib:int-add (f2cl-lib:int-mul 2 n)
+                                                  (f2cl-lib:int-mul
+                                                   (f2cl-lib:int-sub n 1)
+                                                   (ilaenv 1 "DORGHR" " " n 1 n
+                                                    -1))))))
+              (setf maxb
+                      (max
+                       (the fixnum
+                            (ilaenv 8 "DHSEQR" "SV" n 1 n -1))
+                       (the fixnum 2)))
+              (setf k
+                      (min (the fixnum maxb)
+                           (the fixnum n)
+                           (the fixnum
+                                (max (the fixnum 2)
+                                     (the fixnum
+                                          (ilaenv 4 "DHSEQR" "SV" n 1 n -1))))))
+              (setf hswork
+                      (max
+                       (the fixnum
+                            (f2cl-lib:int-mul k (f2cl-lib:int-add k 2)))
+                       (the fixnum (f2cl-lib:int-mul 2 n))))
+              (setf maxwrk
+                      (max (the fixnum maxwrk)
+                           (the fixnum (f2cl-lib:int-add n 1))
+                           (the fixnum (f2cl-lib:int-add n hswork))))
+              (setf maxwrk
+                      (max (the fixnum maxwrk)
+                           (the fixnum (f2cl-lib:int-mul 4 n))))))
+           (setf (f2cl-lib:fref work-%data% (1) ((1 *)) work-%offset%)
+                   (coerce (the fixnum maxwrk) 'double-float))))
+        (cond
+          ((and (< lwork minwrk) (not lquery))
+           (setf info -13)))
+        (cond
+          ((/= info 0)
+           (xerbla "DGEEV " (f2cl-lib:int-sub info))
+           (go end_label))
+          (lquery
+           (go end_label)))
+        (if (= n 0) (go end_label))
+        (setf eps (dlamch "P"))
+        (setf smlnum (dlamch "S"))
+        (setf bignum (/ one smlnum))
+        (multiple-value-bind (var-0 var-1)
+            (dlabad smlnum bignum)
+          (declare (ignore))
+          (setf smlnum var-0)
+          (setf bignum var-1))
+        (setf smlnum (/ (f2cl-lib:fsqrt smlnum) eps))
+        (setf bignum (/ one smlnum))
+        (setf anrm (dlange "M" n n a lda dum))
+        (setf scalea nil)
+        (cond
+          ((and (> anrm zero) (< anrm smlnum))
+           (setf scalea t)
+           (setf cscale smlnum))
+          ((> anrm bignum)
+           (setf scalea t)
+           (setf cscale bignum)))
+        (if scalea
+            (multiple-value-bind
+                  (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9)
+                (dlascl "G" 0 0 anrm cscale n n a lda ierr)
+              (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                               var-8))
+              (setf ierr var-9)))
+        (setf ibal 1)
+        (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+            (dgebal "B" n a lda ilo ihi
+             (f2cl-lib:array-slice work double-float (ibal) ((1 *))) ierr)
+          (declare (ignore var-0 var-1 var-2 var-3 var-6))
+          (setf ilo var-4)
+          (setf ihi var-5)
+          (setf ierr var-7))
+        (setf itau (f2cl-lib:int-add ibal n))
+        (setf iwrk (f2cl-lib:int-add itau n))
+        (multiple-value-bind
+              (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8)
+            (dgehrd n ilo ihi a lda
+             (f2cl-lib:array-slice work double-float (itau) ((1 *)))
+             (f2cl-lib:array-slice work double-float (iwrk) ((1 *)))
+             (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwrk) 1) ierr)
+          (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7))
+          (setf ierr var-8))
+        (cond
+          (wantvl
+           (f2cl-lib:f2cl-set-string side "L" (string 1))
+           (dlacpy "L" n n a lda vl ldvl)
+           (multiple-value-bind
+                 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8)
+               (dorghr n ilo ihi vl ldvl
+                (f2cl-lib:array-slice work double-float (itau) ((1 *)))
+                (f2cl-lib:array-slice work double-float (iwrk) ((1 *)))
+                (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwrk) 1) ierr)
+             (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7))
+             (setf ierr var-8))
+           (setf iwrk itau)
+           (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)
+               (dhseqr "S" "V" n ilo ihi a lda wr wi vl ldvl
+                (f2cl-lib:array-slice work double-float (iwrk) ((1 *)))
+                (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwrk) 1) 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))
+             (setf info var-13))
+           (cond
+             (wantvr
+              (f2cl-lib:f2cl-set-string side "B" (string 1))
+              (dlacpy "F" n n vl ldvl vr ldvr))))
+          (wantvr
+           (f2cl-lib:f2cl-set-string side "R" (string 1))
+           (dlacpy "L" n n a lda vr ldvr)
+           (multiple-value-bind
+                 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8)
+               (dorghr n ilo ihi vr ldvr
+                (f2cl-lib:array-slice work double-float (itau) ((1 *)))
+                (f2cl-lib:array-slice work double-float (iwrk) ((1 *)))
+                (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwrk) 1) ierr)
+             (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7))
+             (setf ierr var-8))
+           (setf iwrk itau)
+           (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)
+               (dhseqr "S" "V" n ilo ihi a lda wr wi vr ldvr
+                (f2cl-lib:array-slice work double-float (iwrk) ((1 *)))
+                (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwrk) 1) 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))
+             (setf info var-13)))
+          (t
+           (setf iwrk itau)
+           (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)
+               (dhseqr "E" "N" n ilo ihi a lda wr wi vr ldvr
+                (f2cl-lib:array-slice work double-float (iwrk) ((1 *)))
+                (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwrk) 1) 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))
+             (setf info var-13))))
+        (if (> info 0) (go label50))
+        (cond
+          ((or wantvl wantvr)
+           (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)
+               (dtrevc side "B" select n a lda vl ldvl vr ldvr n nout
+                (f2cl-lib:array-slice work double-float (iwrk) ((1 *))) ierr)
+             (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-12))
+             (setf nout var-11)
+             (setf ierr var-13))))
+        (cond
+          (wantvl
+           (multiple-value-bind
+                 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9)
+               (dgebak "B" "L" n ilo ihi
+                (f2cl-lib:array-slice work double-float (ibal) ((1 *))) n vl
+                ldvl ierr)
+             (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8))
+             (setf ierr var-9))
+           (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                         ((> i n) nil)
+             (tagbody
+               (cond
+                 ((= (f2cl-lib:fref wi (i) ((1 *))) zero)
+                  (setf scl
+                          (/ one
+                             (dnrm2 n
+                              (f2cl-lib:array-slice vl
+                                                    double-float
+                                                    (1 i)
+                                                    ((1 ldvl) (1 *)))
+                              1)))
+                  (dscal n scl
+                   (f2cl-lib:array-slice vl
+                                         double-float
+                                         (1 i)
+                                         ((1 ldvl) (1 *)))
+                   1))
+                 ((> (f2cl-lib:fref wi (i) ((1 *))) zero)
+                  (setf scl
+                          (/ one
+                             (dlapy2
+                              (dnrm2 n
+                               (f2cl-lib:array-slice vl
+                                                     double-float
+                                                     (1 i)
+                                                     ((1 ldvl) (1 *)))
+                               1)
+                              (dnrm2 n
+                               (f2cl-lib:array-slice vl
+                                                     double-float
+                                                     (1 (f2cl-lib:int-add i 1))
+                                                     ((1 ldvl) (1 *)))
+                               1))))
+                  (dscal n scl
+                   (f2cl-lib:array-slice vl
+                                         double-float
+                                         (1 i)
+                                         ((1 ldvl) (1 *)))
+                   1)
+                  (dscal n scl
+                   (f2cl-lib:array-slice vl
+                                         double-float
+                                         (1 (f2cl-lib:int-add i 1))
+                                         ((1 ldvl) (1 *)))
+                   1)
+                  (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
+                                ((> k n) nil)
+                    (tagbody
+                      (setf (f2cl-lib:fref work-%data%
+                                           ((f2cl-lib:int-sub
+                                             (f2cl-lib:int-add iwrk k)
+                                             1))
+                                           ((1 *))
+                                           work-%offset%)
+                              (+
+                               (expt
+                                (f2cl-lib:fref vl-%data%
+                                               (k i)
+                                               ((1 ldvl) (1 *))
+                                               vl-%offset%)
+                                2)
+                               (expt
+                                (f2cl-lib:fref vl-%data%
+                                               (k (f2cl-lib:int-add i 1))
+                                               ((1 ldvl) (1 *))
+                                               vl-%offset%)
+                                2)))))
+                  (setf k
+                          (idamax n
+                           (f2cl-lib:array-slice work
+                                                 double-float
+                                                 (iwrk)
+                                                 ((1 *)))
+                           1))
+                  (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                      (dlartg
+                       (f2cl-lib:fref vl-%data%
+                                      (k i)
+                                      ((1 ldvl) (1 *))
+                                      vl-%offset%)
+                       (f2cl-lib:fref vl-%data%
+                                      (k (f2cl-lib:int-add i 1))
+                                      ((1 ldvl) (1 *))
+                                      vl-%offset%)
+                       cs sn r)
+                    (declare (ignore var-0 var-1))
+                    (setf cs var-2)
+                    (setf sn var-3)
+                    (setf r var-4))
+                  (drot n
+                   (f2cl-lib:array-slice vl
+                                         double-float
+                                         (1 i)
+                                         ((1 ldvl) (1 *)))
+                   1
+                   (f2cl-lib:array-slice vl
+                                         double-float
+                                         (1 (f2cl-lib:int-add i 1))
+                                         ((1 ldvl) (1 *)))
+                   1 cs sn)
+                  (setf (f2cl-lib:fref vl-%data%
+                                       (k (f2cl-lib:int-add i 1))
+                                       ((1 ldvl) (1 *))
+                                       vl-%offset%)
+                          zero)))))))
+        (cond
+          (wantvr
+           (multiple-value-bind
+                 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9)
+               (dgebak "B" "R" n ilo ihi
+                (f2cl-lib:array-slice work double-float (ibal) ((1 *))) n vr
+                ldvr ierr)
+             (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8))
+             (setf ierr var-9))
+           (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                         ((> i n) nil)
+             (tagbody
+               (cond
+                 ((= (f2cl-lib:fref wi (i) ((1 *))) zero)
+                  (setf scl
+                          (/ one
+                             (dnrm2 n
+                              (f2cl-lib:array-slice vr
+                                                    double-float
+                                                    (1 i)
+                                                    ((1 ldvr) (1 *)))
+                              1)))
+                  (dscal n scl
+                   (f2cl-lib:array-slice vr
+                                         double-float
+                                         (1 i)
+                                         ((1 ldvr) (1 *)))
+                   1))
+                 ((> (f2cl-lib:fref wi (i) ((1 *))) zero)
+                  (setf scl
+                          (/ one
+                             (dlapy2
+                              (dnrm2 n
+                               (f2cl-lib:array-slice vr
+                                                     double-float
+                                                     (1 i)
+                                                     ((1 ldvr) (1 *)))
+                               1)
+                              (dnrm2 n
+                               (f2cl-lib:array-slice vr
+                                                     double-float
+                                                     (1 (f2cl-lib:int-add i 1))
+                                                     ((1 ldvr) (1 *)))
+                               1))))
+                  (dscal n scl
+                   (f2cl-lib:array-slice vr
+                                         double-float
+                                         (1 i)
+                                         ((1 ldvr) (1 *)))
+                   1)
+                  (dscal n scl
+                   (f2cl-lib:array-slice vr
+                                         double-float
+                                         (1 (f2cl-lib:int-add i 1))
+                                         ((1 ldvr) (1 *)))
+                   1)
+                  (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
+                                ((> k n) nil)
+                    (tagbody
+                      (setf (f2cl-lib:fref work-%data%
+                                           ((f2cl-lib:int-sub
+                                             (f2cl-lib:int-add iwrk k)
+                                             1))
+                                           ((1 *))
+                                           work-%offset%)
+                              (+
+                               (expt
+                                (f2cl-lib:fref vr-%data%
+                                               (k i)
+                                               ((1 ldvr) (1 *))
+                                               vr-%offset%)
+                                2)
+                               (expt
+                                (f2cl-lib:fref vr-%data%
+                                               (k (f2cl-lib:int-add i 1))
+                                               ((1 ldvr) (1 *))
+                                               vr-%offset%)
+                                2)))))
+                  (setf k
+                          (idamax n
+                           (f2cl-lib:array-slice work
+                                                 double-float
+                                                 (iwrk)
+                                                 ((1 *)))
+                           1))
+                  (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                      (dlartg
+                       (f2cl-lib:fref vr-%data%
+                                      (k i)
+                                      ((1 ldvr) (1 *))
+                                      vr-%offset%)
+                       (f2cl-lib:fref vr-%data%
+                                      (k (f2cl-lib:int-add i 1))
+                                      ((1 ldvr) (1 *))
+                                      vr-%offset%)
+                       cs sn r)
+                    (declare (ignore var-0 var-1))
+                    (setf cs var-2)
+                    (setf sn var-3)
+                    (setf r var-4))
+                  (drot n
+                   (f2cl-lib:array-slice vr
+                                         double-float
+                                         (1 i)
+                                         ((1 ldvr) (1 *)))
+                   1
+                   (f2cl-lib:array-slice vr
+                                         double-float
+                                         (1 (f2cl-lib:int-add i 1))
+                                         ((1 ldvr) (1 *)))
+                   1 cs sn)
+                  (setf (f2cl-lib:fref vr-%data%
+                                       (k (f2cl-lib:int-add i 1))
+                                       ((1 ldvr) (1 *))
+                                       vr-%offset%)
+                          zero)))))))
+ label50
+        (cond
+          (scalea
+           (multiple-value-bind
+                 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9)
+               (dlascl "G" 0 0 cscale anrm (f2cl-lib:int-sub n info) 1
+                (f2cl-lib:array-slice wr double-float ((+ info 1)) ((1 *)))
+                (max (the fixnum (f2cl-lib:int-sub n info))
+                     (the fixnum 1))
+                ierr)
+             (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8))
+             (setf ierr var-9))
+           (multiple-value-bind
+                 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9)
+               (dlascl "G" 0 0 cscale anrm (f2cl-lib:int-sub n info) 1
+                (f2cl-lib:array-slice wi double-float ((+ info 1)) ((1 *)))
+                (max (the fixnum (f2cl-lib:int-sub n info))
+                     (the fixnum 1))
+                ierr)
+             (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8))
+             (setf ierr var-9))
+           (cond
+             ((> info 0)
+              (multiple-value-bind
+                    (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8
+                     var-9)
+                  (dlascl "G" 0 0 cscale anrm (f2cl-lib:int-sub ilo 1) 1 wr n
+                   ierr)
+                (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                 var-7 var-8))
+                (setf ierr var-9))
+              (multiple-value-bind
+                    (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8
+                     var-9)
+                  (dlascl "G" 0 0 cscale anrm (f2cl-lib:int-sub ilo 1) 1 wi n
+                   ierr)
+                (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                 var-7 var-8))
+                (setf ierr var-9))))))
+        (setf (f2cl-lib:fref work-%data% (1) ((1 *)) work-%offset%)
+                (coerce (the fixnum maxwrk) 'double-float))
+ end_label
+        (return
+         (values nil nil 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::dgeev fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '((simple-array character (1))
+                        (simple-array character (1))
+                        fixnum (array double-float (*))
+                        fixnum (array double-float (*))
+                        (array double-float (*)) (array double-float (*))
+                        fixnum (array double-float (*))
+                        fixnum (array double-float (*))
+                        fixnum
+                        fixnum)
+           :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil nil
+                            fortran-to-lisp::info)
+           :calls '(fortran-to-lisp::drot fortran-to-lisp::dlartg
+                    fortran-to-lisp::idamax fortran-to-lisp::dlapy2
+                    fortran-to-lisp::dscal fortran-to-lisp::dnrm2
+                    fortran-to-lisp::dgebak fortran-to-lisp::dtrevc
+                    fortran-to-lisp::dhseqr fortran-to-lisp::dorghr
+                    fortran-to-lisp::dlacpy fortran-to-lisp::dgehrd
+                    fortran-to-lisp::dgebal fortran-to-lisp::dlascl
+                    fortran-to-lisp::dlange fortran-to-lisp::dlabad
+                    fortran-to-lisp::dlamch fortran-to-lisp::xerbla
+                    fortran-to-lisp::ilaenv fortran-to-lisp::lsame))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dgeevx LAPACK}
+\pagehead{dgeevx}{dgeevx}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<LAPACK dgeevx>>=
+(let* ((zero 0.0) (one 1.0))
+  (declare (type (double-float 0.0 0.0) zero)
+           (type (double-float 1.0 1.0) one))
+  (defun dgeevx
+         (balanc jobvl jobvr sense n a lda wr wi vl ldvl vr ldvr ilo ihi scale
+          abnrm rconde rcondv work lwork iwork info)
+    (declare (type (array fixnum (*)) iwork)
+             (type (double-float) abnrm)
+             (type (array double-float (*)) work rcondv rconde scale vr vl wi
+                                            wr a)
+             (type fixnum info lwork ihi ilo ldvr ldvl lda n)
+             (type (simple-array character (*)) sense jobvr jobvl balanc))
+    (f2cl-lib:with-multi-array-data
+        ((balanc character balanc-%data% balanc-%offset%)
+         (jobvl character jobvl-%data% jobvl-%offset%)
+         (jobvr character jobvr-%data% jobvr-%offset%)
+         (sense character sense-%data% sense-%offset%)
+         (a double-float a-%data% a-%offset%)
+         (wr double-float wr-%data% wr-%offset%)
+         (wi double-float wi-%data% wi-%offset%)
+         (vl double-float vl-%data% vl-%offset%)
+         (vr double-float vr-%data% vr-%offset%)
+         (scale double-float scale-%data% scale-%offset%)
+         (rconde double-float rconde-%data% rconde-%offset%)
+         (rcondv double-float rcondv-%data% rcondv-%offset%)
+         (work double-float work-%data% work-%offset%)
+         (iwork fixnum iwork-%data% iwork-%offset%))
+      (prog ((dum (make-array 1 :element-type 'double-float))
+             (select (make-array 1 :element-type 't)) (anrm 0.0) (bignum 0.0)
+             (cs 0.0) (cscale 0.0) (eps 0.0) (r 0.0) (scl 0.0) (smlnum 0.0)
+             (sn 0.0) (hswork 0) (i 0) (icond 0) (ierr 0) (itau 0) (iwrk 0)
+             (k 0) (maxb 0) (maxwrk 0) (minwrk 0) (nout 0)
+             (job
+              (make-array '(1) :element-type 'character :initial-element #\ ))
+             (side
+              (make-array '(1) :element-type 'character :initial-element #\ ))
+             (lquery nil) (scalea nil) (wantvl nil) (wantvr nil) (wntsnb nil)
+             (wntsne nil) (wntsnn nil) (wntsnv nil))
+        (declare (type (array double-float (1)) dum)
+                 (type (array (member t nil) (1)) select)
+                 (type (double-float) anrm bignum cs cscale eps r scl smlnum
+                                      sn)
+                 (type fixnum hswork i icond ierr itau iwrk k maxb
+                                           maxwrk minwrk nout)
+                 (type (simple-array character (1)) job side)
+                 (type (member t nil) lquery scalea wantvl wantvr wntsnb
+                                        wntsne wntsnn wntsnv))
+        (setf info 0)
+        (setf lquery (coerce (= lwork -1) '(member t nil)))
+        (setf wantvl (lsame jobvl "V"))
+        (setf wantvr (lsame jobvr "V"))
+        (setf wntsnn (lsame sense "N"))
+        (setf wntsne (lsame sense "E"))
+        (setf wntsnv (lsame sense "V"))
+        (setf wntsnb (lsame sense "B"))
+        (cond
+          ((not
+            (or (lsame balanc "N")
+                (lsame balanc "S")
+                (lsame balanc "P")
+                (lsame balanc "B")))
+           (setf info -1))
+          ((and (not wantvl) (not (lsame jobvl "N")))
+           (setf info -2))
+          ((and (not wantvr) (not (lsame jobvr "N")))
+           (setf info -3))
+          ((or (not (or wntsnn wntsne wntsnb wntsnv))
+               (and (or wntsne wntsnb) (not (and wantvl wantvr))))
+           (setf info -4))
+          ((< n 0)
+           (setf info -5))
+          ((< lda (max (the fixnum 1) (the fixnum n)))
+           (setf info -7))
+          ((or (< ldvl 1) (and wantvl (< ldvl n)))
+           (setf info -11))
+          ((or (< ldvr 1) (and wantvr (< ldvr n)))
+           (setf info -13)))
+        (setf minwrk 1)
+        (cond
+          ((and (= info 0) (or (>= lwork 1) lquery))
+           (setf maxwrk
+                   (f2cl-lib:int-add n
+                                     (f2cl-lib:int-mul n
+                                                       (ilaenv 1 "DGEHRD" " " n
+                                                        1 n 0))))
+           (cond
+             ((and (not wantvl) (not wantvr))
+              (setf minwrk
+                      (max (the fixnum 1)
+                           (the fixnum (f2cl-lib:int-mul 2 n))))
+              (if (not wntsnn)
+                  (setf minwrk
+                          (max (the fixnum minwrk)
+                               (the fixnum
+                                    (f2cl-lib:int-add (f2cl-lib:int-mul n n)
+                                                      (f2cl-lib:int-mul 6
+                                                                        n))))))
+              (setf maxb
+                      (max
+                       (the fixnum
+                            (ilaenv 8 "DHSEQR" "SN" n 1 n -1))
+                       (the fixnum 2)))
+              (cond
+                (wntsnn
+                 (setf k
+                         (min (the fixnum maxb)
+                              (the fixnum n)
+                              (the fixnum
+                                   (max (the fixnum 2)
+                                        (the fixnum
+                                             (ilaenv 4 "DHSEQR" "EN" n 1 n
+                                              -1)))))))
+                (t
+                 (setf k
+                         (min (the fixnum maxb)
+                              (the fixnum n)
+                              (the fixnum
+                                   (max (the fixnum 2)
+                                        (the fixnum
+                                             (ilaenv 4 "DHSEQR" "SN" n 1 n
+                                              -1))))))))
+              (setf hswork
+                      (max
+                       (the fixnum
+                            (f2cl-lib:int-mul k (f2cl-lib:int-add k 2)))
+                       (the fixnum (f2cl-lib:int-mul 2 n))))
+              (setf maxwrk
+                      (max (the fixnum maxwrk)
+                           (the fixnum 1)
+                           (the fixnum hswork)))
+              (if (not wntsnn)
+                  (setf maxwrk
+                          (max (the fixnum maxwrk)
+                               (the fixnum
+                                    (f2cl-lib:int-add (f2cl-lib:int-mul n n)
+                                                      (f2cl-lib:int-mul 6
+                                                                        n)))))))
+             (t
+              (setf minwrk
+                      (max (the fixnum 1)
+                           (the fixnum (f2cl-lib:int-mul 3 n))))
+              (if (and (not wntsnn) (not wntsne))
+                  (setf minwrk
+                          (max (the fixnum minwrk)
+                               (the fixnum
+                                    (f2cl-lib:int-add (f2cl-lib:int-mul n n)
+                                                      (f2cl-lib:int-mul 6
+                                                                        n))))))
+              (setf maxb
+                      (max
+                       (the fixnum
+                            (ilaenv 8 "DHSEQR" "SN" n 1 n -1))
+                       (the fixnum 2)))
+              (setf k
+                      (min (the fixnum maxb)
+                           (the fixnum n)
+                           (the fixnum
+                                (max (the fixnum 2)
+                                     (the fixnum
+                                          (ilaenv 4 "DHSEQR" "EN" n 1 n -1))))))
+              (setf hswork
+                      (max
+                       (the fixnum
+                            (f2cl-lib:int-mul k (f2cl-lib:int-add k 2)))
+                       (the fixnum (f2cl-lib:int-mul 2 n))))
+              (setf maxwrk
+                      (max (the fixnum maxwrk)
+                           (the fixnum 1)
+                           (the fixnum hswork)))
+              (setf maxwrk
+                      (max (the fixnum maxwrk)
+                           (the fixnum
+                                (f2cl-lib:int-add n
+                                                  (f2cl-lib:int-mul
+                                                   (f2cl-lib:int-sub n 1)
+                                                   (ilaenv 1 "DORGHR" " " n 1 n
+                                                    -1))))))
+              (if (and (not wntsnn) (not wntsne))
+                  (setf maxwrk
+                          (max (the fixnum maxwrk)
+                               (the fixnum
+                                    (f2cl-lib:int-add (f2cl-lib:int-mul n n)
+                                                      (f2cl-lib:int-mul 6
+                                                                        n))))))
+              (setf maxwrk
+                      (max (the fixnum maxwrk)
+                           (the fixnum (f2cl-lib:int-mul 3 n))
+                           (the fixnum 1)))))
+           (setf (f2cl-lib:fref work-%data% (1) ((1 *)) work-%offset%)
+                   (coerce (the fixnum maxwrk) 'double-float))))
+        (cond
+          ((and (< lwork minwrk) (not lquery))
+           (setf info -21)))
+        (cond
+          ((/= info 0)
+           (xerbla "DGEEVX" (f2cl-lib:int-sub info))
+           (go end_label))
+          (lquery
+           (go end_label)))
+        (if (= n 0) (go end_label))
+        (setf eps (dlamch "P"))
+        (setf smlnum (dlamch "S"))
+        (setf bignum (/ one smlnum))
+        (multiple-value-bind (var-0 var-1)
+            (dlabad smlnum bignum)
+          (declare (ignore))
+          (setf smlnum var-0)
+          (setf bignum var-1))
+        (setf smlnum (/ (f2cl-lib:fsqrt smlnum) eps))
+        (setf bignum (/ one smlnum))
+        (setf icond 0)
+        (setf anrm (dlange "M" n n a lda dum))
+        (setf scalea nil)
+        (cond
+          ((and (> anrm zero) (< anrm smlnum))
+           (setf scalea t)
+           (setf cscale smlnum))
+          ((> anrm bignum)
+           (setf scalea t)
+           (setf cscale bignum)))
+        (if scalea
+            (multiple-value-bind
+                  (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9)
+                (dlascl "G" 0 0 anrm cscale n n a lda ierr)
+              (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                               var-8))
+              (setf ierr var-9)))
+        (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+            (dgebal balanc n a lda ilo ihi scale ierr)
+          (declare (ignore var-0 var-1 var-2 var-3 var-6))
+          (setf ilo var-4)
+          (setf ihi var-5)
+          (setf ierr var-7))
+        (setf abnrm (dlange "1" n n a lda dum))
+        (cond
+          (scalea
+           (setf (f2cl-lib:fref dum (1) ((1 1))) abnrm)
+           (multiple-value-bind
+                 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9)
+               (dlascl "G" 0 0 cscale anrm 1 1 dum 1 ierr)
+             (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8))
+             (setf ierr var-9))
+           (setf abnrm (f2cl-lib:fref dum (1) ((1 1))))))
+        (setf itau 1)
+        (setf iwrk (f2cl-lib:int-add itau n))
+        (multiple-value-bind
+              (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8)
+            (dgehrd n ilo ihi a lda
+             (f2cl-lib:array-slice work double-float (itau) ((1 *)))
+             (f2cl-lib:array-slice work double-float (iwrk) ((1 *)))
+             (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwrk) 1) ierr)
+          (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7))
+          (setf ierr var-8))
+        (cond
+          (wantvl
+           (f2cl-lib:f2cl-set-string side "L" (string 1))
+           (dlacpy "L" n n a lda vl ldvl)
+           (multiple-value-bind
+                 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8)
+               (dorghr n ilo ihi vl ldvl
+                (f2cl-lib:array-slice work double-float (itau) ((1 *)))
+                (f2cl-lib:array-slice work double-float (iwrk) ((1 *)))
+                (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwrk) 1) ierr)
+             (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7))
+             (setf ierr var-8))
+           (setf iwrk itau)
+           (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)
+               (dhseqr "S" "V" n ilo ihi a lda wr wi vl ldvl
+                (f2cl-lib:array-slice work double-float (iwrk) ((1 *)))
+                (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwrk) 1) 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))
+             (setf info var-13))
+           (cond
+             (wantvr
+              (f2cl-lib:f2cl-set-string side "B" (string 1))
+              (dlacpy "F" n n vl ldvl vr ldvr))))
+          (wantvr
+           (f2cl-lib:f2cl-set-string side "R" (string 1))
+           (dlacpy "L" n n a lda vr ldvr)
+           (multiple-value-bind
+                 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8)
+               (dorghr n ilo ihi vr ldvr
+                (f2cl-lib:array-slice work double-float (itau) ((1 *)))
+                (f2cl-lib:array-slice work double-float (iwrk) ((1 *)))
+                (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwrk) 1) ierr)
+             (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7))
+             (setf ierr var-8))
+           (setf iwrk itau)
+           (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)
+               (dhseqr "S" "V" n ilo ihi a lda wr wi vr ldvr
+                (f2cl-lib:array-slice work double-float (iwrk) ((1 *)))
+                (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwrk) 1) 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))
+             (setf info var-13)))
+          (t
+           (cond
+             (wntsnn
+              (f2cl-lib:f2cl-set-string job "E" (string 1)))
+             (t
+              (f2cl-lib:f2cl-set-string job "S" (string 1))))
+           (setf iwrk itau)
+           (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)
+               (dhseqr job "N" n ilo ihi a lda wr wi vr ldvr
+                (f2cl-lib:array-slice work double-float (iwrk) ((1 *)))
+                (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwrk) 1) 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))
+             (setf info var-13))))
+        (if (> info 0) (go label50))
+        (cond
+          ((or wantvl wantvr)
+           (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)
+               (dtrevc side "B" select n a lda vl ldvl vr ldvr n nout
+                (f2cl-lib:array-slice work double-float (iwrk) ((1 *))) ierr)
+             (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-12))
+             (setf nout var-11)
+             (setf ierr var-13))))
+        (cond
+          ((not wntsnn)
+           (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 var-17)
+               (dtrsna sense "A" select n a lda vl ldvl vr ldvr rconde rcondv n
+                nout (f2cl-lib:array-slice work double-float (iwrk) ((1 *))) n
+                iwork icond)
+             (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-14 var-15
+                              var-16))
+             (setf nout var-13)
+             (setf icond var-17))))
+        (cond
+          (wantvl
+           (multiple-value-bind
+                 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9)
+               (dgebak balanc "L" n ilo ihi scale n vl ldvl ierr)
+             (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8))
+             (setf ierr var-9))
+           (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                         ((> i n) nil)
+             (tagbody
+               (cond
+                 ((= (f2cl-lib:fref wi (i) ((1 *))) zero)
+                  (setf scl
+                          (/ one
+                             (dnrm2 n
+                              (f2cl-lib:array-slice vl
+                                                    double-float
+                                                    (1 i)
+                                                    ((1 ldvl) (1 *)))
+                              1)))
+                  (dscal n scl
+                   (f2cl-lib:array-slice vl
+                                         double-float
+                                         (1 i)
+                                         ((1 ldvl) (1 *)))
+                   1))
+                 ((> (f2cl-lib:fref wi (i) ((1 *))) zero)
+                  (setf scl
+                          (/ one
+                             (dlapy2
+                              (dnrm2 n
+                               (f2cl-lib:array-slice vl
+                                                     double-float
+                                                     (1 i)
+                                                     ((1 ldvl) (1 *)))
+                               1)
+                              (dnrm2 n
+                               (f2cl-lib:array-slice vl
+                                                     double-float
+                                                     (1 (f2cl-lib:int-add i 1))
+                                                     ((1 ldvl) (1 *)))
+                               1))))
+                  (dscal n scl
+                   (f2cl-lib:array-slice vl
+                                         double-float
+                                         (1 i)
+                                         ((1 ldvl) (1 *)))
+                   1)
+                  (dscal n scl
+                   (f2cl-lib:array-slice vl
+                                         double-float
+                                         (1 (f2cl-lib:int-add i 1))
+                                         ((1 ldvl) (1 *)))
+                   1)
+                  (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
+                                ((> k n) nil)
+                    (tagbody
+                      (setf (f2cl-lib:fref work-%data%
+                                           (k)
+                                           ((1 *))
+                                           work-%offset%)
+                              (+
+                               (expt
+                                (f2cl-lib:fref vl-%data%
+                                               (k i)
+                                               ((1 ldvl) (1 *))
+                                               vl-%offset%)
+                                2)
+                               (expt
+                                (f2cl-lib:fref vl-%data%
+                                               (k (f2cl-lib:int-add i 1))
+                                               ((1 ldvl) (1 *))
+                                               vl-%offset%)
+                                2)))))
+                  (setf k (idamax n work 1))
+                  (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                      (dlartg
+                       (f2cl-lib:fref vl-%data%
+                                      (k i)
+                                      ((1 ldvl) (1 *))
+                                      vl-%offset%)
+                       (f2cl-lib:fref vl-%data%
+                                      (k (f2cl-lib:int-add i 1))
+                                      ((1 ldvl) (1 *))
+                                      vl-%offset%)
+                       cs sn r)
+                    (declare (ignore var-0 var-1))
+                    (setf cs var-2)
+                    (setf sn var-3)
+                    (setf r var-4))
+                  (drot n
+                   (f2cl-lib:array-slice vl
+                                         double-float
+                                         (1 i)
+                                         ((1 ldvl) (1 *)))
+                   1
+                   (f2cl-lib:array-slice vl
+                                         double-float
+                                         (1 (f2cl-lib:int-add i 1))
+                                         ((1 ldvl) (1 *)))
+                   1 cs sn)
+                  (setf (f2cl-lib:fref vl-%data%
+                                       (k (f2cl-lib:int-add i 1))
+                                       ((1 ldvl) (1 *))
+                                       vl-%offset%)
+                          zero)))))))
+        (cond
+          (wantvr
+           (multiple-value-bind
+                 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9)
+               (dgebak balanc "R" n ilo ihi scale n vr ldvr ierr)
+             (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8))
+             (setf ierr var-9))
+           (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                         ((> i n) nil)
+             (tagbody
+               (cond
+                 ((= (f2cl-lib:fref wi (i) ((1 *))) zero)
+                  (setf scl
+                          (/ one
+                             (dnrm2 n
+                              (f2cl-lib:array-slice vr
+                                                    double-float
+                                                    (1 i)
+                                                    ((1 ldvr) (1 *)))
+                              1)))
+                  (dscal n scl
+                   (f2cl-lib:array-slice vr
+                                         double-float
+                                         (1 i)
+                                         ((1 ldvr) (1 *)))
+                   1))
+                 ((> (f2cl-lib:fref wi (i) ((1 *))) zero)
+                  (setf scl
+                          (/ one
+                             (dlapy2
+                              (dnrm2 n
+                               (f2cl-lib:array-slice vr
+                                                     double-float
+                                                     (1 i)
+                                                     ((1 ldvr) (1 *)))
+                               1)
+                              (dnrm2 n
+                               (f2cl-lib:array-slice vr
+                                                     double-float
+                                                     (1 (f2cl-lib:int-add i 1))
+                                                     ((1 ldvr) (1 *)))
+                               1))))
+                  (dscal n scl
+                   (f2cl-lib:array-slice vr
+                                         double-float
+                                         (1 i)
+                                         ((1 ldvr) (1 *)))
+                   1)
+                  (dscal n scl
+                   (f2cl-lib:array-slice vr
+                                         double-float
+                                         (1 (f2cl-lib:int-add i 1))
+                                         ((1 ldvr) (1 *)))
+                   1)
+                  (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
+                                ((> k n) nil)
+                    (tagbody
+                      (setf (f2cl-lib:fref work-%data%
+                                           (k)
+                                           ((1 *))
+                                           work-%offset%)
+                              (+
+                               (expt
+                                (f2cl-lib:fref vr-%data%
+                                               (k i)
+                                               ((1 ldvr) (1 *))
+                                               vr-%offset%)
+                                2)
+                               (expt
+                                (f2cl-lib:fref vr-%data%
+                                               (k (f2cl-lib:int-add i 1))
+                                               ((1 ldvr) (1 *))
+                                               vr-%offset%)
+                                2)))))
+                  (setf k (idamax n work 1))
+                  (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                      (dlartg
+                       (f2cl-lib:fref vr-%data%
+                                      (k i)
+                                      ((1 ldvr) (1 *))
+                                      vr-%offset%)
+                       (f2cl-lib:fref vr-%data%
+                                      (k (f2cl-lib:int-add i 1))
+                                      ((1 ldvr) (1 *))
+                                      vr-%offset%)
+                       cs sn r)
+                    (declare (ignore var-0 var-1))
+                    (setf cs var-2)
+                    (setf sn var-3)
+                    (setf r var-4))
+                  (drot n
+                   (f2cl-lib:array-slice vr
+                                         double-float
+                                         (1 i)
+                                         ((1 ldvr) (1 *)))
+                   1
+                   (f2cl-lib:array-slice vr
+                                         double-float
+                                         (1 (f2cl-lib:int-add i 1))
+                                         ((1 ldvr) (1 *)))
+                   1 cs sn)
+                  (setf (f2cl-lib:fref vr-%data%
+                                       (k (f2cl-lib:int-add i 1))
+                                       ((1 ldvr) (1 *))
+                                       vr-%offset%)
+                          zero)))))))
+ label50
+        (cond
+          (scalea
+           (multiple-value-bind
+                 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9)
+               (dlascl "G" 0 0 cscale anrm (f2cl-lib:int-sub n info) 1
+                (f2cl-lib:array-slice wr double-float ((+ info 1)) ((1 *)))
+                (max (the fixnum (f2cl-lib:int-sub n info))
+                     (the fixnum 1))
+                ierr)
+             (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8))
+             (setf ierr var-9))
+           (multiple-value-bind
+                 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9)
+               (dlascl "G" 0 0 cscale anrm (f2cl-lib:int-sub n info) 1
+                (f2cl-lib:array-slice wi double-float ((+ info 1)) ((1 *)))
+                (max (the fixnum (f2cl-lib:int-sub n info))
+                     (the fixnum 1))
+                ierr)
+             (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8))
+             (setf ierr var-9))
+           (cond
+             ((= info 0)
+              (if (and (or wntsnv wntsnb) (= icond 0))
+                  (multiple-value-bind
+                        (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8
+                         var-9)
+                      (dlascl "G" 0 0 cscale anrm n 1 rcondv n ierr)
+                    (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                     var-7 var-8))
+                    (setf ierr var-9))))
+             (t
+              (multiple-value-bind
+                    (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8
+                     var-9)
+                  (dlascl "G" 0 0 cscale anrm (f2cl-lib:int-sub ilo 1) 1 wr n
+                   ierr)
+                (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                 var-7 var-8))
+                (setf ierr var-9))
+              (multiple-value-bind
+                    (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8
+                     var-9)
+                  (dlascl "G" 0 0 cscale anrm (f2cl-lib:int-sub ilo 1) 1 wi n
+                   ierr)
+                (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                 var-7 var-8))
+                (setf ierr var-9))))))
+        (setf (f2cl-lib:fref work-%data% (1) ((1 *)) work-%offset%)
+                (coerce (the fixnum maxwrk) 'double-float))
+ end_label
+        (return
+         (values nil
+                 nil
+                 nil
+                 nil
+                 nil
+                 nil
+                 nil
+                 nil
+                 nil
+                 nil
+                 nil
+                 nil
+                 nil
+                 ilo
+                 ihi
+                 nil
+                 abnrm
+                 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::dgeevx
+                 fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '((simple-array character (1))
+                        (simple-array character (1))
+                        (simple-array character (1))
+                        (simple-array character (1))
+                        fixnum (array double-float (*))
+                        fixnum (array double-float (*))
+                        (array double-float (*)) (array double-float (*))
+                        fixnum (array double-float (*))
+                        fixnum fixnum
+                        fixnum (array double-float (*))
+                        (double-float) (array double-float (*))
+                        (array double-float (*)) (array double-float (*))
+                        fixnum
+                        (array fixnum (*))
+                        fixnum)
+           :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil nil
+                            fortran-to-lisp::ilo fortran-to-lisp::ihi nil
+                            fortran-to-lisp::abnrm nil nil nil nil nil
+                            fortran-to-lisp::info)
+           :calls '(fortran-to-lisp::dtrsna fortran-to-lisp::drot
+                    fortran-to-lisp::dlartg fortran-to-lisp::idamax
+                    fortran-to-lisp::dlapy2 fortran-to-lisp::dscal
+                    fortran-to-lisp::dnrm2 fortran-to-lisp::dgebak
+                    fortran-to-lisp::dtrevc fortran-to-lisp::dhseqr
+                    fortran-to-lisp::dorghr fortran-to-lisp::dlacpy
+                    fortran-to-lisp::dgehrd fortran-to-lisp::dgebal
+                    fortran-to-lisp::dlascl fortran-to-lisp::dlange
+                    fortran-to-lisp::dlabad fortran-to-lisp::dlamch
+                    fortran-to-lisp::xerbla fortran-to-lisp::ilaenv
+                    fortran-to-lisp::lsame))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dgehd2 LAPACK}
+\pagehead{dgehd2}{dgehd2}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<LAPACK dgehd2>>=
+(let* ((one 1.0))
+  (declare (type (double-float 1.0 1.0) one))
+  (defun dgehd2 (n ilo ihi a lda tau work info)
+    (declare (type (array double-float (*)) work tau a)
+             (type fixnum info lda ihi ilo n))
+    (f2cl-lib:with-multi-array-data
+        ((a double-float a-%data% a-%offset%)
+         (tau double-float tau-%data% tau-%offset%)
+         (work double-float work-%data% work-%offset%))
+      (prog ((aii 0.0) (i 0))
+        (declare (type (double-float) aii) (type fixnum i))
+        (setf info 0)
+        (cond
+          ((< n 0)
+           (setf info -1))
+          ((or (< ilo 1)
+               (> ilo
+                  (max (the fixnum 1) (the fixnum n))))
+           (setf info -2))
+          ((or
+            (< ihi (min (the fixnum ilo) (the fixnum n)))
+            (> ihi n))
+           (setf info -3))
+          ((< lda (max (the fixnum 1) (the fixnum n)))
+           (setf info -5)))
+        (cond
+          ((/= info 0)
+           (xerbla "DGEHD2" (f2cl-lib:int-sub info))
+           (go end_label)))
+        (f2cl-lib:fdo (i ilo (f2cl-lib:int-add i 1))
+                      ((> i (f2cl-lib:int-add ihi (f2cl-lib:int-sub 1))) nil)
+          (tagbody
+            (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                (dlarfg (f2cl-lib:int-sub ihi i)
+                 (f2cl-lib:fref a-%data%
+                                ((f2cl-lib:int-add i 1) i)
+                                ((1 lda) (1 *))
+                                a-%offset%)
+                 (f2cl-lib:array-slice a
+                                       double-float
+                                       ((min (f2cl-lib:int-add i 2) n) i)
+                                       ((1 lda) (1 *)))
+                 1 (f2cl-lib:fref tau-%data% (i) ((1 *)) tau-%offset%))
+              (declare (ignore var-0 var-2 var-3))
+              (setf (f2cl-lib:fref a-%data%
+                                   ((f2cl-lib:int-add i 1) i)
+                                   ((1 lda) (1 *))
+                                   a-%offset%)
+                      var-1)
+              (setf (f2cl-lib:fref tau-%data% (i) ((1 *)) tau-%offset%) var-4))
+            (setf aii
+                    (f2cl-lib:fref a-%data%
+                                   ((f2cl-lib:int-add i 1) i)
+                                   ((1 lda) (1 *))
+                                   a-%offset%))
+            (setf (f2cl-lib:fref a-%data%
+                                 ((f2cl-lib:int-add i 1) i)
+                                 ((1 lda) (1 *))
+                                 a-%offset%)
+                    one)
+            (dlarf "Right" ihi (f2cl-lib:int-sub ihi i)
+             (f2cl-lib:array-slice a double-float ((+ i 1) i) ((1 lda) (1 *)))
+             1 (f2cl-lib:fref tau-%data% (i) ((1 *)) tau-%offset%)
+             (f2cl-lib:array-slice a
+                                   double-float
+                                   (1 (f2cl-lib:int-add i 1))
+                                   ((1 lda) (1 *)))
+             lda work)
+            (dlarf "Left" (f2cl-lib:int-sub ihi i) (f2cl-lib:int-sub n i)
+             (f2cl-lib:array-slice a double-float ((+ i 1) i) ((1 lda) (1 *)))
+             1 (f2cl-lib:fref tau-%data% (i) ((1 *)) tau-%offset%)
+             (f2cl-lib:array-slice a
+                                   double-float
+                                   ((+ i 1) (f2cl-lib:int-add i 1))
+                                   ((1 lda) (1 *)))
+             lda work)
+            (setf (f2cl-lib:fref a-%data%
+                                 ((f2cl-lib:int-add i 1) i)
+                                 ((1 lda) (1 *))
+                                 a-%offset%)
+                    aii)))
+ end_label
+        (return (values 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::dgehd2
+                 fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '(fixnum fixnum
+                        fixnum (array double-float (*))
+                        fixnum (array double-float (*))
+                        (array double-float (*)) fixnum)
+           :return-values '(nil nil nil nil nil nil nil fortran-to-lisp::info)
+           :calls '(fortran-to-lisp::dlarf fortran-to-lisp::dlarfg
+                    fortran-to-lisp::xerbla))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dgehrd LAPACK}
+\pagehead{dgehrd}{dgehrd}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<LAPACK dgehrd>>=
+(let* ((nbmax 64) (ldt (+ nbmax 1)) (zero 0.0) (one 1.0))
+  (declare (type (fixnum 64 64) nbmax)
+           (type fixnum ldt)
+           (type (double-float 0.0 0.0) zero)
+           (type (double-float 1.0 1.0) one))
+  (defun dgehrd (n ilo ihi a lda tau work lwork info)
+    (declare (type (array double-float (*)) work tau a)
+             (type fixnum info lwork lda ihi ilo n))
+    (f2cl-lib:with-multi-array-data
+        ((a double-float a-%data% a-%offset%)
+         (tau double-float tau-%data% tau-%offset%)
+         (work double-float work-%data% work-%offset%))
+      (prog ((ei 0.0) (i 0) (ib 0) (iinfo 0) (iws 0) (ldwork 0) (lwkopt 0)
+             (nb 0) (nbmin 0) (nh 0) (nx 0) (lquery nil)
+             (t$
+              (make-array (the fixnum (reduce #'* (list ldt nbmax)))
+                          :element-type 'double-float)))
+        (declare (type (array double-float (*)) t$)
+                 (type (double-float) ei)
+                 (type fixnum i ib iinfo iws ldwork lwkopt nb
+                                           nbmin nh nx)
+                 (type (member t nil) lquery))
+        (setf info 0)
+        (setf nb
+                (min (the fixnum nbmax)
+                     (the fixnum
+                          (ilaenv 1 "DGEHRD" " " n ilo ihi -1))))
+        (setf lwkopt (f2cl-lib:int-mul n nb))
+        (setf (f2cl-lib:fref work-%data% (1) ((1 *)) work-%offset%)
+                (coerce (the fixnum lwkopt) 'double-float))
+        (setf lquery (coerce (= lwork -1) '(member t nil)))
+        (cond
+          ((< n 0)
+           (setf info -1))
+          ((or (< ilo 1)
+               (> ilo
+                  (max (the fixnum 1) (the fixnum n))))
+           (setf info -2))
+          ((or
+            (< ihi (min (the fixnum ilo) (the fixnum n)))
+            (> ihi n))
+           (setf info -3))
+          ((< lda (max (the fixnum 1) (the fixnum n)))
+           (setf info -5))
+          ((and
+            (< lwork (max (the fixnum 1) (the fixnum n)))
+            (not lquery))
+           (setf info -8)))
+        (cond
+          ((/= info 0)
+           (xerbla "DGEHRD" (f2cl-lib:int-sub info))
+           (go end_label))
+          (lquery
+           (go end_label)))
+        (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                      ((> i (f2cl-lib:int-add ilo (f2cl-lib:int-sub 1))) nil)
+          (tagbody
+            (setf (f2cl-lib:fref tau-%data% (i) ((1 *)) tau-%offset%) zero)))
+        (f2cl-lib:fdo (i
+                       (max (the fixnum 1)
+                            (the fixnum ihi))
+                       (f2cl-lib:int-add i 1))
+                      ((> i (f2cl-lib:int-add n (f2cl-lib:int-sub 1))) nil)
+          (tagbody
+            (setf (f2cl-lib:fref tau-%data% (i) ((1 *)) tau-%offset%) zero)))
+        (setf nh (f2cl-lib:int-add (f2cl-lib:int-sub ihi ilo) 1))
+        (cond
+          ((<= nh 1)
+           (setf (f2cl-lib:fref work-%data% (1) ((1 *)) work-%offset%)
+                   (coerce (the fixnum 1) 'double-float))
+           (go end_label)))
+        (setf nb
+                (min (the fixnum nbmax)
+                     (the fixnum
+                          (ilaenv 1 "DGEHRD" " " n ilo ihi -1))))
+        (setf nbmin 2)
+        (setf iws 1)
+        (cond
+          ((and (> nb 1) (< nb nh))
+           (setf nx
+                   (max (the fixnum nb)
+                        (the fixnum
+                             (ilaenv 3 "DGEHRD" " " n ilo ihi -1))))
+           (cond
+             ((< nx nh)
+              (setf iws (f2cl-lib:int-mul n nb))
+              (cond
+                ((< lwork iws)
+                 (setf nbmin
+                         (max (the fixnum 2)
+                              (the fixnum
+                                   (ilaenv 2 "DGEHRD" " " n ilo ihi -1))))
+                 (cond
+                   ((>= lwork (f2cl-lib:int-mul n nbmin))
+                    (setf nb (the fixnum (truncate lwork n))))
+                   (t
+                    (setf nb 1)))))))))
+        (setf ldwork n)
+        (cond
+          ((or (< nb nbmin) (>= nb nh))
+           (setf i ilo))
+          (t
+           (f2cl-lib:fdo (i ilo (f2cl-lib:int-add i nb))
+                         ((> i
+                             (f2cl-lib:int-add ihi
+                                               (f2cl-lib:int-sub 1)
+                                               (f2cl-lib:int-sub nx)))
+                          nil)
+             (tagbody
+               (setf ib
+                       (min (the fixnum nb)
+                            (the fixnum (f2cl-lib:int-sub ihi i))))
+               (dlahrd ihi i ib
+                (f2cl-lib:array-slice a double-float (1 i) ((1 lda) (1 *))) lda
+                (f2cl-lib:array-slice tau double-float (i) ((1 *))) t$ ldt work
+                ldwork)
+               (setf ei
+                       (f2cl-lib:fref a-%data%
+                                      ((f2cl-lib:int-add i ib)
+                                       (f2cl-lib:int-sub
+                                        (f2cl-lib:int-add i ib)
+                                        1))
+                                      ((1 lda) (1 *))
+                                      a-%offset%))
+               (setf (f2cl-lib:fref a-%data%
+                                    ((f2cl-lib:int-add i ib)
+                                     (f2cl-lib:int-sub (f2cl-lib:int-add i ib)
+                                                       1))
+                                    ((1 lda) (1 *))
+                                    a-%offset%)
+                       one)
+               (dgemm "No transpose" "Transpose" ihi
+                (f2cl-lib:int-add (f2cl-lib:int-sub ihi i ib) 1) ib (- one)
+                work ldwork
+                (f2cl-lib:array-slice a
+                                      double-float
+                                      ((+ i ib) i)
+                                      ((1 lda) (1 *)))
+                lda one
+                (f2cl-lib:array-slice a
+                                      double-float
+                                      (1 (f2cl-lib:int-add i ib))
+                                      ((1 lda) (1 *)))
+                lda)
+               (setf (f2cl-lib:fref a-%data%
+                                    ((f2cl-lib:int-add i ib)
+                                     (f2cl-lib:int-sub (f2cl-lib:int-add i ib)
+                                                       1))
+                                    ((1 lda) (1 *))
+                                    a-%offset%)
+                       ei)
+               (dlarfb "Left" "Transpose" "Forward" "Columnwise"
+                (f2cl-lib:int-sub ihi i)
+                (f2cl-lib:int-add (f2cl-lib:int-sub n i ib) 1) ib
+                (f2cl-lib:array-slice a
+                                      double-float
+                                      ((+ i 1) i)
+                                      ((1 lda) (1 *)))
+                lda t$ ldt
+                (f2cl-lib:array-slice a
+                                      double-float
+                                      ((+ i 1) (f2cl-lib:int-add i ib))
+                                      ((1 lda) (1 *)))
+                lda work ldwork)))))
+        (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+            (dgehd2 n i ihi a lda tau work iinfo)
+          (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6))
+          (setf iinfo var-7))
+        (setf (f2cl-lib:fref work-%data% (1) ((1 *)) work-%offset%)
+                (coerce (the fixnum iws) 'double-float))
+ end_label
+        (return (values 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::dgehrd
+                 fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '(fixnum fixnum
+                        fixnum (array double-float (*))
+                        fixnum (array double-float (*))
+                        (array double-float (*)) fixnum
+                        fixnum)
+           :return-values '(nil nil nil nil nil nil nil nil
+                            fortran-to-lisp::info)
+           :calls '(fortran-to-lisp::dgehd2 fortran-to-lisp::dlarfb
+                    fortran-to-lisp::dgemm fortran-to-lisp::dlahrd
+                    fortran-to-lisp::xerbla fortran-to-lisp::ilaenv))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dgelq2 LAPACK}
+\pagehead{dgelq2}{dgelq2}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<LAPACK dgelq2>>=
+(let* ((one 1.0))
+  (declare (type (double-float 1.0 1.0) one))
+  (defun dgelq2 (m n a lda tau work info)
+    (declare (type (array double-float (*)) work tau a)
+             (type fixnum info lda n m))
+    (f2cl-lib:with-multi-array-data
+        ((a double-float a-%data% a-%offset%)
+         (tau double-float tau-%data% tau-%offset%)
+         (work double-float work-%data% work-%offset%))
+      (prog ((aii 0.0) (i 0) (k 0))
+        (declare (type (double-float) aii) (type fixnum i k))
+        (setf info 0)
+        (cond
+          ((< m 0)
+           (setf info -1))
+          ((< n 0)
+           (setf info -2))
+          ((< lda (max (the fixnum 1) (the fixnum m)))
+           (setf info -4)))
+        (cond
+          ((/= info 0)
+           (xerbla "DGELQ2" (f2cl-lib:int-sub info))
+           (go end_label)))
+        (setf k (min (the fixnum m) (the fixnum n)))
+        (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                      ((> i k) nil)
+          (tagbody
+            (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                (dlarfg (f2cl-lib:int-add (f2cl-lib:int-sub n i) 1)
+                 (f2cl-lib:fref a-%data% (i i) ((1 lda) (1 *)) a-%offset%)
+                 (f2cl-lib:array-slice a
+                                       double-float
+                                       (i
+                                        (min
+                                         (the fixnum
+                                              (f2cl-lib:int-add i 1))
+                                         (the fixnum n)))
+                                       ((1 lda) (1 *)))
+                 lda (f2cl-lib:fref tau-%data% (i) ((1 *)) tau-%offset%))
+              (declare (ignore var-0 var-2 var-3))
+              (setf (f2cl-lib:fref a-%data% (i i) ((1 lda) (1 *)) a-%offset%)
+                      var-1)
+              (setf (f2cl-lib:fref tau-%data% (i) ((1 *)) tau-%offset%) var-4))
+            (cond
+              ((< i m)
+               (setf aii
+                       (f2cl-lib:fref a-%data%
+                                      (i i)
+                                      ((1 lda) (1 *))
+                                      a-%offset%))
+               (setf (f2cl-lib:fref a-%data% (i i) ((1 lda) (1 *)) a-%offset%)
+                       one)
+               (dlarf "Right" (f2cl-lib:int-sub m i)
+                (f2cl-lib:int-add (f2cl-lib:int-sub n i) 1)
+                (f2cl-lib:array-slice a double-float (i i) ((1 lda) (1 *))) lda
+                (f2cl-lib:fref tau-%data% (i) ((1 *)) tau-%offset%)
+                (f2cl-lib:array-slice a
+                                      double-float
+                                      ((+ i 1) i)
+                                      ((1 lda) (1 *)))
+                lda work)
+               (setf (f2cl-lib:fref a-%data% (i i) ((1 lda) (1 *)) a-%offset%)
+                       aii)))))
+ end_label
+        (return (values 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::dgelq2
+                 fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '(fixnum fixnum
+                        (array double-float (*)) fixnum
+                        (array double-float (*)) (array double-float (*))
+                        fixnum)
+           :return-values '(nil nil nil nil nil nil fortran-to-lisp::info)
+           :calls '(fortran-to-lisp::dlarf fortran-to-lisp::dlarfg
+                    fortran-to-lisp::xerbla))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dgelqf LAPACK}
+\pagehead{dgelqf}{dgelqf}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<LAPACK dgelqf>>=
+(defun dgelqf (m n a lda tau work lwork info)
+  (declare (type (array double-float (*)) work tau a)
+           (type fixnum info lwork lda n m))
+  (f2cl-lib:with-multi-array-data
+      ((a double-float a-%data% a-%offset%)
+       (tau double-float tau-%data% tau-%offset%)
+       (work double-float work-%data% work-%offset%))
+    (prog ((i 0) (ib 0) (iinfo 0) (iws 0) (k 0) (ldwork 0) (lwkopt 0) (nb 0)
+           (nbmin 0) (nx 0) (lquery nil))
+      (declare (type (member t nil) lquery)
+               (type fixnum nx nbmin nb lwkopt ldwork k iws iinfo
+                                         ib i))
+      (setf info 0)
+      (setf nb (ilaenv 1 "DGELQF" " " m n -1 -1))
+      (setf lwkopt (f2cl-lib:int-mul m nb))
+      (setf (f2cl-lib:fref work-%data% (1) ((1 *)) work-%offset%)
+              (coerce (the fixnum lwkopt) 'double-float))
+      (setf lquery (coerce (= lwork -1) '(member t nil)))
+      (cond
+        ((< m 0)
+         (setf info -1))
+        ((< n 0)
+         (setf info -2))
+        ((< lda (max (the fixnum 1) (the fixnum m)))
+         (setf info -4))
+        ((and
+          (< lwork (max (the fixnum 1) (the fixnum m)))
+          (not lquery))
+         (setf info -7)))
+      (cond
+        ((/= info 0)
+         (xerbla "DGELQF" (f2cl-lib:int-sub info))
+         (go end_label))
+        (lquery
+         (go end_label)))
+      (setf k (min (the fixnum m) (the fixnum n)))
+      (cond
+        ((= k 0)
+         (setf (f2cl-lib:fref work-%data% (1) ((1 *)) work-%offset%)
+                 (coerce (the fixnum 1) 'double-float))
+         (go end_label)))
+      (setf nbmin 2)
+      (setf nx 0)
+      (setf iws m)
+      (cond
+        ((and (> nb 1) (< nb k))
+         (setf nx
+                 (max (the fixnum 0)
+                      (the fixnum
+                           (ilaenv 3 "DGELQF" " " m n -1 -1))))
+         (cond
+           ((< nx k)
+            (setf ldwork m)
+            (setf iws (f2cl-lib:int-mul ldwork nb))
+            (cond
+              ((< lwork iws)
+               (setf nb (the fixnum (truncate lwork ldwork)))
+               (setf nbmin
+                       (max (the fixnum 2)
+                            (the fixnum
+                                 (ilaenv 2 "DGELQF" " " m n -1 -1))))))))))
+      (cond
+        ((and (>= nb nbmin) (< nb k) (< nx k))
+         (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i nb))
+                       ((> i (f2cl-lib:int-add k (f2cl-lib:int-sub nx))) nil)
+           (tagbody
+             (setf ib
+                     (min
+                      (the fixnum
+                           (f2cl-lib:int-add (f2cl-lib:int-sub k i) 1))
+                      (the fixnum nb)))
+             (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5 var-6)
+                 (dgelq2 ib (f2cl-lib:int-add (f2cl-lib:int-sub n i) 1)
+                  (f2cl-lib:array-slice a double-float (i i) ((1 lda) (1 *)))
+                  lda (f2cl-lib:array-slice tau double-float (i) ((1 *))) work
+                  iinfo)
+               (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5))
+               (setf iinfo var-6))
+             (cond
+               ((<= (f2cl-lib:int-add i ib) m)
+                (dlarft "Forward" "Rowwise"
+                 (f2cl-lib:int-add (f2cl-lib:int-sub n i) 1) ib
+                 (f2cl-lib:array-slice a double-float (i i) ((1 lda) (1 *)))
+                 lda (f2cl-lib:array-slice tau double-float (i) ((1 *))) work
+                 ldwork)
+                (dlarfb "Right" "No transpose" "Forward" "Rowwise"
+                 (f2cl-lib:int-add (f2cl-lib:int-sub m i ib) 1)
+                 (f2cl-lib:int-add (f2cl-lib:int-sub n i) 1) ib
+                 (f2cl-lib:array-slice a double-float (i i) ((1 lda) (1 *)))
+                 lda work ldwork
+                 (f2cl-lib:array-slice a
+                                       double-float
+                                       ((+ i ib) i)
+                                       ((1 lda) (1 *)))
+                 lda
+                 (f2cl-lib:array-slice work double-float ((+ ib 1)) ((1 *)))
+                 ldwork))))))
+        (t
+         (setf i 1)))
+      (if (<= i k)
+          (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5 var-6)
+              (dgelq2 (f2cl-lib:int-add (f2cl-lib:int-sub m i) 1)
+               (f2cl-lib:int-add (f2cl-lib:int-sub n i) 1)
+               (f2cl-lib:array-slice a double-float (i i) ((1 lda) (1 *))) lda
+               (f2cl-lib:array-slice tau double-float (i) ((1 *))) work iinfo)
+            (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5))
+            (setf iinfo var-6)))
+      (setf (f2cl-lib:fref work-%data% (1) ((1 *)) work-%offset%)
+              (coerce (the fixnum iws) 'double-float))
+ end_label
+      (return (values 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::dgelqf
+                 fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '(fixnum fixnum
+                        (array double-float (*)) fixnum
+                        (array double-float (*)) (array double-float (*))
+                        fixnum
+                        fixnum)
+           :return-values '(nil nil nil nil nil nil nil fortran-to-lisp::info)
+           :calls '(fortran-to-lisp::dlarfb fortran-to-lisp::dlarft
+                    fortran-to-lisp::dgelq2 fortran-to-lisp::xerbla
+                    fortran-to-lisp::ilaenv))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dgemm BLAS}
+\pagehead{dgemm}{dgemm}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<BLAS 3 dgemm>>=
+(let* ((one 1.0) (zero 0.0))
+  (declare (type (double-float 1.0 1.0) one)
+           (type (double-float 0.0 0.0) zero))
+  (defun dgemm (transa transb m n k alpha a lda b ldb$ beta c ldc)
+    (declare (type (array double-float (*)) c b a)
+             (type (double-float) beta alpha)
+             (type fixnum ldc ldb$ lda k n m)
+             (type (simple-array character (*)) transb transa))
+    (f2cl-lib:with-multi-array-data
+        ((transa character transa-%data% transa-%offset%)
+         (transb character transb-%data% transb-%offset%)
+         (a double-float a-%data% a-%offset%)
+         (b double-float b-%data% b-%offset%)
+         (c double-float c-%data% c-%offset%))
+      (prog ((temp 0.0) (i 0) (info 0) (j 0) (l 0) (ncola 0) (nrowa 0)
+             (nrowb 0) (nota nil) (notb nil))
+        (declare (type (double-float) temp)
+                 (type fixnum i info j l ncola nrowa nrowb)
+                 (type (member t nil) nota notb))
+        (setf nota (lsame transa "N"))
+        (setf notb (lsame transb "N"))
+        (cond
+          (nota
+           (setf nrowa m)
+           (setf ncola k))
+          (t
+           (setf nrowa k)
+           (setf ncola m)))
+        (cond
+          (notb
+           (setf nrowb k))
+          (t
+           (setf nrowb n)))
+        (setf info 0)
+        (cond
+          ((and (not nota) (not (lsame transa "C")) (not (lsame transa "T")))
+           (setf info 1))
+          ((and (not notb) (not (lsame transb "C")) (not (lsame transb "T")))
+           (setf info 2))
+          ((< m 0)
+           (setf info 3))
+          ((< n 0)
+           (setf info 4))
+          ((< k 0)
+           (setf info 5))
+          ((< lda (max (the fixnum 1) (the fixnum nrowa)))
+           (setf info 8))
+          ((< ldb$
+              (max (the fixnum 1) (the fixnum nrowb)))
+           (setf info 10))
+          ((< ldc (max (the fixnum 1) (the fixnum m)))
+           (setf info 13)))
+        (cond
+          ((/= info 0)
+           (xerbla "DGEMM " info)
+           (go end_label)))
+        (if (or (= m 0) (= n 0) (and (or (= alpha zero) (= k 0)) (= beta one)))
+            (go end_label))
+        (cond
+          ((= alpha zero)
+           (cond
+             ((= beta zero)
+              (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
+                            ((> j n) nil)
+                (tagbody
+                  (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                                ((> i m) nil)
+                    (tagbody
+                      (setf (f2cl-lib:fref c-%data%
+                                           (i j)
+                                           ((1 ldc) (1 *))
+                                           c-%offset%)
+                              zero))))))
+             (t
+              (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
+                            ((> j n) nil)
+                (tagbody
+                  (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                                ((> i m) nil)
+                    (tagbody
+                      (setf (f2cl-lib:fref c-%data%
+                                           (i j)
+                                           ((1 ldc) (1 *))
+                                           c-%offset%)
+                              (* beta
+                                 (f2cl-lib:fref c-%data%
+                                                (i j)
+                                                ((1 ldc) (1 *))
+                                                c-%offset%)))))))))
+           (go end_label)))
+        (cond
+          (notb
+           (cond
+             (nota
+              (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
+                            ((> j n) nil)
+                (tagbody
+                  (cond
+                    ((= beta zero)
+                     (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                                   ((> i m) nil)
+                       (tagbody
+                         (setf (f2cl-lib:fref c-%data%
+                                              (i j)
+                                              ((1 ldc) (1 *))
+                                              c-%offset%)
+                                 zero))))
+                    ((/= beta one)
+                     (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                                   ((> i m) nil)
+                       (tagbody
+                         (setf (f2cl-lib:fref c-%data%
+                                              (i j)
+                                              ((1 ldc) (1 *))
+                                              c-%offset%)
+                                 (* beta
+                                    (f2cl-lib:fref c-%data%
+                                                   (i j)
+                                                   ((1 ldc) (1 *))
+                                                   c-%offset%)))))))
+                  (f2cl-lib:fdo (l 1 (f2cl-lib:int-add l 1))
+                                ((> l k) nil)
+                    (tagbody
+                      (cond
+                        ((/= (f2cl-lib:fref b (l j) ((1 ldb$) (1 *))) zero)
+                         (setf temp
+                                 (* alpha
+                                    (f2cl-lib:fref b-%data%
+                                                   (l j)
+                                                   ((1 ldb$) (1 *))
+                                                   b-%offset%)))
+                         (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                                       ((> i m) nil)
+                           (tagbody
+                             (setf (f2cl-lib:fref c-%data%
+                                                  (i j)
+                                                  ((1 ldc) (1 *))
+                                                  c-%offset%)
+                                     (+
+                                      (f2cl-lib:fref c-%data%
+                                                     (i j)
+                                                     ((1 ldc) (1 *))
+                                                     c-%offset%)
+                                      (* temp
+                                         (f2cl-lib:fref a-%data%
+                                                        (i l)
+                                                        ((1 lda) (1 *))
+                                                        a-%offset%)))))))))))))
+             (t
+              (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
+                            ((> j n) nil)
+                (tagbody
+                  (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                                ((> i m) nil)
+                    (tagbody
+                      (setf temp zero)
+                      (f2cl-lib:fdo (l 1 (f2cl-lib:int-add l 1))
+                                    ((> l k) nil)
+                        (tagbody
+                          (setf temp
+                                  (+ temp
+                                     (*
+                                      (f2cl-lib:fref a-%data%
+                                                     (l i)
+                                                     ((1 lda) (1 *))
+                                                     a-%offset%)
+                                      (f2cl-lib:fref b-%data%
+                                                     (l j)
+                                                     ((1 ldb$) (1 *))
+                                                     b-%offset%))))))
+                      (cond
+                        ((= beta zero)
+                         (setf (f2cl-lib:fref c-%data%
+                                              (i j)
+                                              ((1 ldc) (1 *))
+                                              c-%offset%)
+                                 (* alpha temp)))
+                        (t
+                         (setf (f2cl-lib:fref c-%data%
+                                              (i j)
+                                              ((1 ldc) (1 *))
+                                              c-%offset%)
+                                 (+ (* alpha temp)
+                                    (* beta
+                                       (f2cl-lib:fref c-%data%
+                                                      (i j)
+                                                      ((1 ldc) (1 *))
+                                                      c-%offset%)))))))))))))
+          (t
+           (cond
+             (nota
+              (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
+                            ((> j n) nil)
+                (tagbody
+                  (cond
+                    ((= beta zero)
+                     (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                                   ((> i m) nil)
+                       (tagbody
+                         (setf (f2cl-lib:fref c-%data%
+                                              (i j)
+                                              ((1 ldc) (1 *))
+                                              c-%offset%)
+                                 zero))))
+                    ((/= beta one)
+                     (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                                   ((> i m) nil)
+                       (tagbody
+                         (setf (f2cl-lib:fref c-%data%
+                                              (i j)
+                                              ((1 ldc) (1 *))
+                                              c-%offset%)
+                                 (* beta
+                                    (f2cl-lib:fref c-%data%
+                                                   (i j)
+                                                   ((1 ldc) (1 *))
+                                                   c-%offset%)))))))
+                  (f2cl-lib:fdo (l 1 (f2cl-lib:int-add l 1))
+                                ((> l k) nil)
+                    (tagbody
+                      (cond
+                        ((/= (f2cl-lib:fref b (j l) ((1 ldb$) (1 *))) zero)
+                         (setf temp
+                                 (* alpha
+                                    (f2cl-lib:fref b-%data%
+                                                   (j l)
+                                                   ((1 ldb$) (1 *))
+                                                   b-%offset%)))
+                         (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                                       ((> i m) nil)
+                           (tagbody
+                             (setf (f2cl-lib:fref c-%data%
+                                                  (i j)
+                                                  ((1 ldc) (1 *))
+                                                  c-%offset%)
+                                     (+
+                                      (f2cl-lib:fref c-%data%
+                                                     (i j)
+                                                     ((1 ldc) (1 *))
+                                                     c-%offset%)
+                                      (* temp
+                                         (f2cl-lib:fref a-%data%
+                                                        (i l)
+                                                        ((1 lda) (1 *))
+                                                        a-%offset%)))))))))))))
+             (t
+              (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
+                            ((> j n) nil)
+                (tagbody
+                  (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                                ((> i m) nil)
+                    (tagbody
+                      (setf temp zero)
+                      (f2cl-lib:fdo (l 1 (f2cl-lib:int-add l 1))
+                                    ((> l k) nil)
+                        (tagbody
+                          (setf temp
+                                  (+ temp
+                                     (*
+                                      (f2cl-lib:fref a-%data%
+                                                     (l i)
+                                                     ((1 lda) (1 *))
+                                                     a-%offset%)
+                                      (f2cl-lib:fref b-%data%
+                                                     (j l)
+                                                     ((1 ldb$) (1 *))
+                                                     b-%offset%))))))
+                      (cond
+                        ((= beta zero)
+                         (setf (f2cl-lib:fref c-%data%
+                                              (i j)
+                                              ((1 ldc) (1 *))
+                                              c-%offset%)
+                                 (* alpha temp)))
+                        (t
+                         (setf (f2cl-lib:fref c-%data%
+                                              (i j)
+                                              ((1 ldc) (1 *))
+                                              c-%offset%)
+                                 (+ (* alpha temp)
+                                    (* beta
+                                       (f2cl-lib:fref c-%data%
+                                                      (i j)
+                                                      ((1 ldc) (1 *))
+                                                      c-%offset%))))))))))))))
+ end_label
+        (return
+         (values nil nil nil nil nil nil nil nil 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::dgemm fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '((simple-array character (1))
+                        (simple-array character (1))
+                        fixnum fixnum
+                        fixnum (double-float)
+                        (array double-float (*)) fixnum
+                        (array double-float (*)) fixnum
+                        (double-float) (array double-float (*))
+                        fixnum)
+           :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil
+                            nil)
+           :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dgemv BLAS}
+\pagehead{dgemv}{dgemv}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<BLAS 2 dgemv>>=
+(let* ((one 1.0) (zero 0.0))
+  (declare (type (double-float 1.0 1.0) one)
+           (type (double-float 0.0 0.0) zero))
+  (defun dgemv (trans m n alpha a lda x incx beta y incy)
+    (declare (type (array double-float (*)) y x a)
+             (type (double-float) beta alpha)
+             (type fixnum incy incx lda n m)
+             (type (simple-array character (*)) trans))
+    (f2cl-lib:with-multi-array-data
+        ((trans character trans-%data% trans-%offset%)
+         (a double-float a-%data% a-%offset%)
+         (x double-float x-%data% x-%offset%)
+         (y double-float y-%data% y-%offset%))
+      (prog ((i 0) (info 0) (ix 0) (iy 0) (j 0) (jx 0) (jy 0) (kx 0) (ky 0)
+             (lenx 0) (leny 0) (temp 0.0))
+        (declare (type fixnum i info ix iy j jx jy kx ky lenx
+                                           leny)
+                 (type (double-float) temp))
+        (setf info 0)
+        (cond
+          ((and (not (lsame trans "N"))
+                (not (lsame trans "T"))
+                (not (lsame trans "C")))
+           (setf info 1))
+          ((< m 0)
+           (setf info 2))
+          ((< n 0)
+           (setf info 3))
+          ((< lda (max (the fixnum 1) (the fixnum m)))
+           (setf info 6))
+          ((= incx 0)
+           (setf info 8))
+          ((= incy 0)
+           (setf info 11)))
+        (cond
+          ((/= info 0)
+           (xerbla "DGEMV " info)
+           (go end_label)))
+        (if (or (= m 0) (= n 0) (and (= alpha zero) (= beta one)))
+            (go end_label))
+        (cond
+          ((lsame trans "N")
+           (setf lenx n)
+           (setf leny m))
+          (t
+           (setf lenx m)
+           (setf leny n)))
+        (cond
+          ((> incx 0)
+           (setf kx 1))
+          (t
+           (setf kx
+                   (f2cl-lib:int-sub 1
+                                     (f2cl-lib:int-mul
+                                      (f2cl-lib:int-sub lenx 1)
+                                      incx)))))
+        (cond
+          ((> incy 0)
+           (setf ky 1))
+          (t
+           (setf ky
+                   (f2cl-lib:int-sub 1
+                                     (f2cl-lib:int-mul
+                                      (f2cl-lib:int-sub leny 1)
+                                      incy)))))
+        (cond
+          ((/= beta one)
+           (cond
+             ((= incy 1)
+              (cond
+                ((= beta zero)
+                 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                               ((> i leny) nil)
+                   (tagbody
+                     (setf (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%)
+                             zero))))
+                (t
+                 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                               ((> i leny) nil)
+                   (tagbody
+                     (setf (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%)
+                             (* beta
+                                (f2cl-lib:fref y-%data%
+                                               (i)
+                                               ((1 *))
+                                               y-%offset%))))))))
+             (t
+              (setf iy ky)
+              (cond
+                ((= beta zero)
+                 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                               ((> i leny) nil)
+                   (tagbody
+                     (setf (f2cl-lib:fref y-%data% (iy) ((1 *)) y-%offset%)
+                             zero)
+                     (setf iy (f2cl-lib:int-add iy incy)))))
+                (t
+                 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                               ((> i leny) nil)
+                   (tagbody
+                     (setf (f2cl-lib:fref y-%data% (iy) ((1 *)) y-%offset%)
+                             (* beta
+                                (f2cl-lib:fref y-%data%
+                                               (iy)
+                                               ((1 *))
+                                               y-%offset%)))
+                     (setf iy (f2cl-lib:int-add iy incy))))))))))
+        (if (= alpha zero) (go end_label))
+        (cond
+          ((lsame trans "N")
+           (setf jx kx)
+           (cond
+             ((= incy 1)
+              (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
+                            ((> j n) nil)
+                (tagbody
+                  (cond
+                    ((/= (f2cl-lib:fref x (jx) ((1 *))) zero)
+                     (setf temp
+                             (* alpha
+                                (f2cl-lib:fref x-%data%
+                                               (jx)
+                                               ((1 *))
+                                               x-%offset%)))
+                     (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                                   ((> i m) nil)
+                       (tagbody
+                         (setf (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%)
+                                 (+
+                                  (f2cl-lib:fref y-%data%
+                                                 (i)
+                                                 ((1 *))
+                                                 y-%offset%)
+                                  (* temp
+                                     (f2cl-lib:fref a-%data%
+                                                    (i j)
+                                                    ((1 lda) (1 *))
+                                                    a-%offset%))))))))
+                  (setf jx (f2cl-lib:int-add jx incx)))))
+             (t
+              (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
+                            ((> j n) nil)
+                (tagbody
+                  (cond
+                    ((/= (f2cl-lib:fref x (jx) ((1 *))) zero)
+                     (setf temp
+                             (* alpha
+                                (f2cl-lib:fref x-%data%
+                                               (jx)
+                                               ((1 *))
+                                               x-%offset%)))
+                     (setf iy ky)
+                     (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                                   ((> i m) nil)
+                       (tagbody
+                         (setf (f2cl-lib:fref y-%data% (iy) ((1 *)) y-%offset%)
+                                 (+
+                                  (f2cl-lib:fref y-%data%
+                                                 (iy)
+                                                 ((1 *))
+                                                 y-%offset%)
+                                  (* temp
+                                     (f2cl-lib:fref a-%data%
+                                                    (i j)
+                                                    ((1 lda) (1 *))
+                                                    a-%offset%))))
+                         (setf iy (f2cl-lib:int-add iy incy))))))
+                  (setf jx (f2cl-lib:int-add jx incx)))))))
+          (t
+           (setf jy ky)
+           (cond
+             ((= incx 1)
+              (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
+                            ((> j n) nil)
+                (tagbody
+                  (setf temp zero)
+                  (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                                ((> i m) nil)
+                    (tagbody
+                      (setf temp
+                              (+ temp
+                                 (*
+                                  (f2cl-lib:fref a-%data%
+                                                 (i j)
+                                                 ((1 lda) (1 *))
+                                                 a-%offset%)
+                                  (f2cl-lib:fref x-%data%
+                                                 (i)
+                                                 ((1 *))
+                                                 x-%offset%))))))
+                  (setf (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%)
+                          (+ (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%)
+                             (* alpha temp)))
+                  (setf jy (f2cl-lib:int-add jy incy)))))
+             (t
+              (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
+                            ((> j n) nil)
+                (tagbody
+                  (setf temp zero)
+                  (setf ix kx)
+                  (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                                ((> i m) nil)
+                    (tagbody
+                      (setf temp
+                              (+ temp
+                                 (*
+                                  (f2cl-lib:fref a-%data%
+                                                 (i j)
+                                                 ((1 lda) (1 *))
+                                                 a-%offset%)
+                                  (f2cl-lib:fref x-%data%
+                                                 (ix)
+                                                 ((1 *))
+                                                 x-%offset%))))
+                      (setf ix (f2cl-lib:int-add ix incx))))
+                  (setf (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%)
+                          (+ (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%)
+                             (* alpha temp)))
+                  (setf jy (f2cl-lib:int-add jy incy))))))))
+ end_label
+        (return (values nil nil nil nil nil nil 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::dgemv fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '((simple-array character (1))
+                        fixnum fixnum
+                        (double-float) (array double-float (*))
+                        fixnum (array double-float (*))
+                        fixnum (double-float)
+                        (array double-float (*)) fixnum)
+           :return-values '(nil nil nil nil nil nil nil nil nil nil nil)
+           :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dgeqr2 LAPACK}
+\pagehead{dgeqr2}{dgeqr2}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<LAPACK dgeqr2>>=
+(let* ((one 1.0))
+  (declare (type (double-float 1.0 1.0) one))
+  (defun dgeqr2 (m n a lda tau work info)
+    (declare (type (array double-float (*)) work tau a)
+             (type fixnum info lda n m))
+    (f2cl-lib:with-multi-array-data
+        ((a double-float a-%data% a-%offset%)
+         (tau double-float tau-%data% tau-%offset%)
+         (work double-float work-%data% work-%offset%))
+      (prog ((aii 0.0) (i 0) (k 0))
+        (declare (type (double-float) aii) (type fixnum i k))
+        (setf info 0)
+        (cond
+          ((< m 0)
+           (setf info -1))
+          ((< n 0)
+           (setf info -2))
+          ((< lda (max (the fixnum 1) (the fixnum m)))
+           (setf info -4)))
+        (cond
+          ((/= info 0)
+           (xerbla "DGEQR2" (f2cl-lib:int-sub info))
+           (go end_label)))
+        (setf k (min (the fixnum m) (the fixnum n)))
+        (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                      ((> i k) nil)
+          (tagbody
+            (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                (dlarfg (f2cl-lib:int-add (f2cl-lib:int-sub m i) 1)
+                 (f2cl-lib:fref a-%data% (i i) ((1 lda) (1 *)) a-%offset%)
+                 (f2cl-lib:array-slice a
+                                       double-float
+                                       ((min (f2cl-lib:int-add i 1) m) i)
+                                       ((1 lda) (1 *)))
+                 1 (f2cl-lib:fref tau-%data% (i) ((1 *)) tau-%offset%))
+              (declare (ignore var-0 var-2 var-3))
+              (setf (f2cl-lib:fref a-%data% (i i) ((1 lda) (1 *)) a-%offset%)
+                      var-1)
+              (setf (f2cl-lib:fref tau-%data% (i) ((1 *)) tau-%offset%) var-4))
+            (cond
+              ((< i n)
+               (setf aii
+                       (f2cl-lib:fref a-%data%
+                                      (i i)
+                                      ((1 lda) (1 *))
+                                      a-%offset%))
+               (setf (f2cl-lib:fref a-%data% (i i) ((1 lda) (1 *)) a-%offset%)
+                       one)
+               (dlarf "Left" (f2cl-lib:int-add (f2cl-lib:int-sub m i) 1)
+                (f2cl-lib:int-sub n i)
+                (f2cl-lib:array-slice a double-float (i i) ((1 lda) (1 *))) 1
+                (f2cl-lib:fref tau-%data% (i) ((1 *)) tau-%offset%)
+                (f2cl-lib:array-slice a
+                                      double-float
+                                      (i (f2cl-lib:int-add i 1))
+                                      ((1 lda) (1 *)))
+                lda work)
+               (setf (f2cl-lib:fref a-%data% (i i) ((1 lda) (1 *)) a-%offset%)
+                       aii)))))
+ end_label
+        (return (values 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::dgeqr2
+                 fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '(fixnum fixnum
+                        (array double-float (*)) fixnum
+                        (array double-float (*)) (array double-float (*))
+                        fixnum)
+           :return-values '(nil nil nil nil nil nil fortran-to-lisp::info)
+           :calls '(fortran-to-lisp::dlarf fortran-to-lisp::dlarfg
+                    fortran-to-lisp::xerbla))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dgeqrf LAPACK}
+\pagehead{dgeqrf}{dgeqrf}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<LAPACK dgeqrf>>=
+(defun dgeqrf (m n a lda tau work lwork info)
+  (declare (type (array double-float (*)) work tau a)
+           (type fixnum info lwork lda n m))
+  (f2cl-lib:with-multi-array-data
+      ((a double-float a-%data% a-%offset%)
+       (tau double-float tau-%data% tau-%offset%)
+       (work double-float work-%data% work-%offset%))
+    (prog ((i 0) (ib 0) (iinfo 0) (iws 0) (k 0) (ldwork 0) (lwkopt 0) (nb 0)
+           (nbmin 0) (nx 0) (lquery nil))
+      (declare (type (member t nil) lquery)
+               (type fixnum nx nbmin nb lwkopt ldwork k iws iinfo
+                                         ib i))
+      (setf info 0)
+      (setf nb (ilaenv 1 "DGEQRF" " " m n -1 -1))
+      (setf lwkopt (f2cl-lib:int-mul n nb))
+      (setf (f2cl-lib:fref work-%data% (1) ((1 *)) work-%offset%)
+              (coerce (the fixnum lwkopt) 'double-float))
+      (setf lquery (coerce (= lwork -1) '(member t nil)))
+      (cond
+        ((< m 0)
+         (setf info -1))
+        ((< n 0)
+         (setf info -2))
+        ((< lda (max (the fixnum 1) (the fixnum m)))
+         (setf info -4))
+        ((and
+          (< lwork (max (the fixnum 1) (the fixnum n)))
+          (not lquery))
+         (setf info -7)))
+      (cond
+        ((/= info 0)
+         (xerbla "DGEQRF" (f2cl-lib:int-sub info))
+         (go end_label))
+        (lquery
+         (go end_label)))
+      (setf k (min (the fixnum m) (the fixnum n)))
+      (cond
+        ((= k 0)
+         (setf (f2cl-lib:fref work-%data% (1) ((1 *)) work-%offset%)
+                 (coerce (the fixnum 1) 'double-float))
+         (go end_label)))
+      (setf nbmin 2)
+      (setf nx 0)
+      (setf iws n)
+      (cond
+        ((and (> nb 1) (< nb k))
+         (setf nx
+                 (max (the fixnum 0)
+                      (the fixnum
+                           (ilaenv 3 "DGEQRF" " " m n -1 -1))))
+         (cond
+           ((< nx k)
+            (setf ldwork n)
+            (setf iws (f2cl-lib:int-mul ldwork nb))
+            (cond
+              ((< lwork iws)
+               (setf nb (the fixnum (truncate lwork ldwork)))
+               (setf nbmin
+                       (max (the fixnum 2)
+                            (the fixnum
+                                 (ilaenv 2 "DGEQRF" " " m n -1 -1))))))))))
+      (cond
+        ((and (>= nb nbmin) (< nb k) (< nx k))
+         (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i nb))
+                       ((> i (f2cl-lib:int-add k (f2cl-lib:int-sub nx))) nil)
+           (tagbody
+             (setf ib
+                     (min
+                      (the fixnum
+                           (f2cl-lib:int-add (f2cl-lib:int-sub k i) 1))
+                      (the fixnum nb)))
+             (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5 var-6)
+                 (dgeqr2 (f2cl-lib:int-add (f2cl-lib:int-sub m i) 1) ib
+                  (f2cl-lib:array-slice a double-float (i i) ((1 lda) (1 *)))
+                  lda (f2cl-lib:array-slice tau double-float (i) ((1 *))) work
+                  iinfo)
+               (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5))
+               (setf iinfo var-6))
+             (cond
+               ((<= (f2cl-lib:int-add i ib) n)
+                (dlarft "Forward" "Columnwise"
+                 (f2cl-lib:int-add (f2cl-lib:int-sub m i) 1) ib
+                 (f2cl-lib:array-slice a double-float (i i) ((1 lda) (1 *)))
+                 lda (f2cl-lib:array-slice tau double-float (i) ((1 *))) work
+                 ldwork)
+                (dlarfb "Left" "Transpose" "Forward" "Columnwise"
+                 (f2cl-lib:int-add (f2cl-lib:int-sub m i) 1)
+                 (f2cl-lib:int-add (f2cl-lib:int-sub n i ib) 1) ib
+                 (f2cl-lib:array-slice a double-float (i i) ((1 lda) (1 *)))
+                 lda work ldwork
+                 (f2cl-lib:array-slice a
+                                       double-float
+                                       (i (f2cl-lib:int-add i ib))
+                                       ((1 lda) (1 *)))
+                 lda
+                 (f2cl-lib:array-slice work double-float ((+ ib 1)) ((1 *)))
+                 ldwork))))))
+        (t
+         (setf i 1)))
+      (if (<= i k)
+          (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5 var-6)
+              (dgeqr2 (f2cl-lib:int-add (f2cl-lib:int-sub m i) 1)
+               (f2cl-lib:int-add (f2cl-lib:int-sub n i) 1)
+               (f2cl-lib:array-slice a double-float (i i) ((1 lda) (1 *))) lda
+               (f2cl-lib:array-slice tau double-float (i) ((1 *))) work iinfo)
+            (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5))
+            (setf iinfo var-6)))
+      (setf (f2cl-lib:fref work-%data% (1) ((1 *)) work-%offset%)
+              (coerce (the fixnum iws) 'double-float))
+ end_label
+      (return (values 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::dgeqrf
+                 fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '(fixnum fixnum
+                        (array double-float (*)) fixnum
+                        (array double-float (*)) (array double-float (*))
+                        fixnum
+                        fixnum)
+           :return-values '(nil nil nil nil nil nil nil fortran-to-lisp::info)
+           :calls '(fortran-to-lisp::dlarfb fortran-to-lisp::dlarft
+                    fortran-to-lisp::dgeqr2 fortran-to-lisp::xerbla
+                    fortran-to-lisp::ilaenv))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dger BLAS}
+\pagehead{dger}{dger}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<BLAS 2 dger>>=
+(let* ((zero 0.0))
+  (declare (type (double-float 0.0 0.0) zero))
+  (defun dger (m n alpha x incx y incy a lda)
+    (declare (type (array double-float (*)) a y x)
+             (type (double-float) alpha)
+             (type fixnum lda incy incx n m))
+    (f2cl-lib:with-multi-array-data
+        ((x double-float x-%data% x-%offset%)
+         (y double-float y-%data% y-%offset%)
+         (a double-float a-%data% a-%offset%))
+      (prog ((i 0) (info 0) (ix 0) (j 0) (jy 0) (kx 0) (temp 0.0))
+        (declare (type fixnum i info ix j jy kx)
+                 (type (double-float) temp))
+        (setf info 0)
+        (cond
+          ((< m 0)
+           (setf info 1))
+          ((< n 0)
+           (setf info 2))
+          ((= incx 0)
+           (setf info 5))
+          ((= incy 0)
+           (setf info 7))
+          ((< lda (max (the fixnum 1) (the fixnum m)))
+           (setf info 9)))
+        (cond
+          ((/= info 0)
+           (xerbla "DGER  " info)
+           (go end_label)))
+        (if (or (= m 0) (= n 0) (= alpha zero)) (go end_label))
+        (cond
+          ((> incy 0)
+           (setf jy 1))
+          (t
+           (setf jy
+                   (f2cl-lib:int-sub 1
+                                     (f2cl-lib:int-mul (f2cl-lib:int-sub n 1)
+                                                       incy)))))
+        (cond
+          ((= incx 1)
+           (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
+                         ((> j n) nil)
+             (tagbody
+               (cond
+                 ((/= (f2cl-lib:fref y (jy) ((1 *))) zero)
+                  (setf temp
+                          (* alpha
+                             (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%)))
+                  (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                                ((> i m) nil)
+                    (tagbody
+                      (setf (f2cl-lib:fref a-%data%
+                                           (i j)
+                                           ((1 lda) (1 *))
+                                           a-%offset%)
+                              (+
+                               (f2cl-lib:fref a-%data%
+                                              (i j)
+                                              ((1 lda) (1 *))
+                                              a-%offset%)
+                               (*
+                                (f2cl-lib:fref x-%data% (i) ((1 *)) x-%offset%)
+                                temp)))))))
+               (setf jy (f2cl-lib:int-add jy incy)))))
+          (t
+           (cond
+             ((> incx 0)
+              (setf kx 1))
+             (t
+              (setf kx
+                      (f2cl-lib:int-sub 1
+                                        (f2cl-lib:int-mul
+                                         (f2cl-lib:int-sub m 1)
+                                         incx)))))
+           (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
+                         ((> j n) nil)
+             (tagbody
+               (cond
+                 ((/= (f2cl-lib:fref y (jy) ((1 *))) zero)
+                  (setf temp
+                          (* alpha
+                             (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%)))
+                  (setf ix kx)
+                  (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                                ((> i m) nil)
+                    (tagbody
+                      (setf (f2cl-lib:fref a-%data%
+                                           (i j)
+                                           ((1 lda) (1 *))
+                                           a-%offset%)
+                              (+
+                               (f2cl-lib:fref a-%data%
+                                              (i j)
+                                              ((1 lda) (1 *))
+                                              a-%offset%)
+                               (*
+                                (f2cl-lib:fref x-%data%
+                                               (ix)
+                                               ((1 *))
+                                               x-%offset%)
+                                temp)))
+                      (setf ix (f2cl-lib:int-add ix incx))))))
+               (setf jy (f2cl-lib:int-add jy incy))))))
+ end_label
+        (return (values nil nil nil nil 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::dger fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '(fixnum fixnum
+                        (double-float) (array double-float (*))
+                        fixnum (array double-float (*))
+                        fixnum (array double-float (*))
+                        fixnum)
+           :return-values '(nil nil nil nil nil nil nil nil nil)
+           :calls '(fortran-to-lisp::xerbla))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dgesdd LAPACK}
+\pagehead{dgesdd}{dgesdd}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<LAPACK dgesdd>>=
+(let* ((zero 0.0) (one 1.0))
+  (declare (type (double-float 0.0 0.0) zero)
+           (type (double-float 1.0 1.0) one))
+  (defun dgesdd (jobz m n a lda s u ldu vt ldvt work lwork iwork info)
+    (declare (type (array fixnum (*)) iwork)
+             (type (array double-float (*)) work vt u s a)
+             (type fixnum info lwork ldvt ldu lda n m)
+             (type (simple-array character (*)) jobz))
+    (f2cl-lib:with-multi-array-data
+        ((jobz character jobz-%data% jobz-%offset%)
+         (a double-float a-%data% a-%offset%)
+         (s double-float s-%data% s-%offset%)
+         (u double-float u-%data% u-%offset%)
+         (vt double-float vt-%data% vt-%offset%)
+         (work double-float work-%data% work-%offset%)
+         (iwork fixnum iwork-%data% iwork-%offset%))
+      (prog ((dum (make-array 1 :element-type 'double-float))
+             (idum (make-array 1 :element-type 'fixnum)) (anrm 0.0)
+             (bignum 0.0) (eps 0.0) (smlnum 0.0) (bdspac 0) (blk 0) (chunk 0)
+             (i 0) (ie 0) (ierr 0) (il 0) (ir 0) (iscl 0) (itau 0) (itaup 0)
+             (itauq 0) (iu 0) (ivt 0) (ldwkvt 0) (ldwrkl 0) (ldwrkr 0)
+             (ldwrku 0) (maxwrk 0) (minmn 0) (minwrk 0) (mnthr 0) (nwork 0)
+             (wrkbl 0) (lquery nil) (wntqa nil) (wntqas nil) (wntqn nil)
+             (wntqo nil) (wntqs nil))
+        (declare (type (array double-float (1)) dum)
+                 (type (array fixnum (1)) idum)
+                 (type (double-float) anrm bignum eps smlnum)
+                 (type fixnum bdspac blk chunk i ie ierr il ir
+                                           iscl itau itaup itauq iu ivt ldwkvt
+                                           ldwrkl ldwrkr ldwrku maxwrk minmn
+                                           minwrk mnthr nwork wrkbl)
+                 (type (member t nil) lquery wntqa wntqas wntqn wntqo wntqs))
+        (setf info 0)
+        (setf minmn (min (the fixnum m) (the fixnum n)))
+        (setf mnthr (f2cl-lib:int (/ (* minmn 11.0) 6.0)))
+        (setf wntqa (lsame jobz "A"))
+        (setf wntqs (lsame jobz "S"))
+        (setf wntqas (or wntqa wntqs))
+        (setf wntqo (lsame jobz "O"))
+        (setf wntqn (lsame jobz "N"))
+        (setf minwrk 1)
+        (setf maxwrk 1)
+        (setf lquery (coerce (= lwork -1) '(member t nil)))
+        (cond
+          ((not (or wntqa wntqs wntqo wntqn))
+           (setf info -1))
+          ((< m 0)
+           (setf info -2))
+          ((< n 0)
+           (setf info -3))
+          ((< lda (max (the fixnum 1) (the fixnum m)))
+           (setf info -5))
+          ((or (< ldu 1) (and wntqas (< ldu m)) (and wntqo (< m n) (< ldu m)))
+           (setf info -8))
+          ((or (< ldvt 1)
+               (and wntqa (< ldvt n))
+               (and wntqs (< ldvt minmn))
+               (and wntqo (>= m n) (< ldvt n)))
+           (setf info -10)))
+        (cond
+          ((and (= info 0) (> m 0) (> n 0))
+           (cond
+             ((>= m n)
+              (cond
+                (wntqn
+                 (setf bdspac (f2cl-lib:int-mul 7 n)))
+                (t
+                 (setf bdspac
+                         (f2cl-lib:int-add (f2cl-lib:int-mul 3 n n)
+                                           (f2cl-lib:int-mul 4 n)))))
+              (cond
+                ((>= m mnthr)
+                 (cond
+                   (wntqn
+                    (setf wrkbl
+                            (f2cl-lib:int-add n
+                                              (f2cl-lib:int-mul n
+                                                                (ilaenv 1
+                                                                 "DGEQRF" " " m
+                                                                 n -1 -1))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul 2
+                                                                          n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DGEBRD"
+                                                                           " "
+                                                                           n n
+                                                                           -1
+                                                                           -1))))))
+                    (setf maxwrk
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add bdspac n))))
+                    (setf minwrk (f2cl-lib:int-add bdspac n)))
+                   (wntqo
+                    (setf wrkbl
+                            (f2cl-lib:int-add n
+                                              (f2cl-lib:int-mul n
+                                                                (ilaenv 1
+                                                                 "DGEQRF" " " m
+                                                                 n -1 -1))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add n
+                                                        (f2cl-lib:int-mul n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGQR"
+                                                                           " "
+                                                                           m n
+                                                                           n
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul 2
+                                                                          n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DGEBRD"
+                                                                           " "
+                                                                           n n
+                                                                           -1
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORMBR"
+                                                                           "QLN"
+                                                                           n n
+                                                                           n
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORMBR"
+                                                                           "PRT"
+                                                                           n n
+                                                                           n
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add bdspac
+                                                        (f2cl-lib:int-mul 3
+                                                                          n)))))
+                    (setf maxwrk
+                            (f2cl-lib:int-add wrkbl (f2cl-lib:int-mul 2 n n)))
+                    (setf minwrk
+                            (f2cl-lib:int-add bdspac
+                                              (f2cl-lib:int-mul 2 n n)
+                                              (f2cl-lib:int-mul 3 n))))
+                   (wntqs
+                    (setf wrkbl
+                            (f2cl-lib:int-add n
+                                              (f2cl-lib:int-mul n
+                                                                (ilaenv 1
+                                                                 "DGEQRF" " " m
+                                                                 n -1 -1))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add n
+                                                        (f2cl-lib:int-mul n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGQR"
+                                                                           " "
+                                                                           m n
+                                                                           n
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul 2
+                                                                          n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DGEBRD"
+                                                                           " "
+                                                                           n n
+                                                                           -1
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORMBR"
+                                                                           "QLN"
+                                                                           n n
+                                                                           n
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORMBR"
+                                                                           "PRT"
+                                                                           n n
+                                                                           n
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add bdspac
+                                                        (f2cl-lib:int-mul 3
+                                                                          n)))))
+                    (setf maxwrk
+                            (f2cl-lib:int-add wrkbl (f2cl-lib:int-mul n n)))
+                    (setf minwrk
+                            (f2cl-lib:int-add bdspac
+                                              (f2cl-lib:int-mul n n)
+                                              (f2cl-lib:int-mul 3 n))))
+                   (wntqa
+                    (setf wrkbl
+                            (f2cl-lib:int-add n
+                                              (f2cl-lib:int-mul n
+                                                                (ilaenv 1
+                                                                 "DGEQRF" " " m
+                                                                 n -1 -1))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add n
+                                                        (f2cl-lib:int-mul m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGQR"
+                                                                           " "
+                                                                           m m
+                                                                           n
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul 2
+                                                                          n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DGEBRD"
+                                                                           " "
+                                                                           n n
+                                                                           -1
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORMBR"
+                                                                           "QLN"
+                                                                           n n
+                                                                           n
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORMBR"
+                                                                           "PRT"
+                                                                           n n
+                                                                           n
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add bdspac
+                                                        (f2cl-lib:int-mul 3
+                                                                          n)))))
+                    (setf maxwrk
+                            (f2cl-lib:int-add wrkbl (f2cl-lib:int-mul n n)))
+                    (setf minwrk
+                            (f2cl-lib:int-add bdspac
+                                              (f2cl-lib:int-mul n n)
+                                              (f2cl-lib:int-mul 3 n))))))
+                (t
+                 (setf wrkbl
+                         (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                           (f2cl-lib:int-mul
+                                            (f2cl-lib:int-add m n)
+                                            (ilaenv 1 "DGEBRD" " " m n -1 -1))))
+                 (cond
+                   (wntqn
+                    (setf maxwrk
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add bdspac
+                                                        (f2cl-lib:int-mul 3
+                                                                          n)))))
+                    (setf minwrk
+                            (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                              (max (the fixnum m)
+                                                   (the fixnum
+                                                        bdspac)))))
+                   (wntqo
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORMBR"
+                                                                           "QLN"
+                                                                           m n
+                                                                           n
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORMBR"
+                                                                           "PRT"
+                                                                           n n
+                                                                           n
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add bdspac
+                                                        (f2cl-lib:int-mul 3
+                                                                          n)))))
+                    (setf maxwrk
+                            (f2cl-lib:int-add wrkbl (f2cl-lib:int-mul m n)))
+                    (setf minwrk
+                            (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                              (max (the fixnum m)
+                                                   (the fixnum
+                                                        (f2cl-lib:int-add
+                                                         (f2cl-lib:int-mul n n)
+                                                         bdspac))))))
+                   (wntqs
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORMBR"
+                                                                           "QLN"
+                                                                           m n
+                                                                           n
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORMBR"
+                                                                           "PRT"
+                                                                           n n
+                                                                           n
+                                                                           -1))))))
+                    (setf maxwrk
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add bdspac
+                                                        (f2cl-lib:int-mul 3
+                                                                          n)))))
+                    (setf minwrk
+                            (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                              (max (the fixnum m)
+                                                   (the fixnum
+                                                        bdspac)))))
+                   (wntqa
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORMBR"
+                                                                           "QLN"
+                                                                           m m
+                                                                           n
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORMBR"
+                                                                           "PRT"
+                                                                           n n
+                                                                           n
+                                                                           -1))))))
+                    (setf maxwrk
+                            (max (the fixnum maxwrk)
+                                 (the fixnum
+                                      (f2cl-lib:int-add bdspac
+                                                        (f2cl-lib:int-mul 3
+                                                                          n)))))
+                    (setf minwrk
+                            (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                              (max (the fixnum m)
+                                                   (the fixnum
+                                                        bdspac)))))))))
+             (t
+              (cond
+                (wntqn
+                 (setf bdspac (f2cl-lib:int-mul 7 m)))
+                (t
+                 (setf bdspac
+                         (f2cl-lib:int-add (f2cl-lib:int-mul 3 m m)
+                                           (f2cl-lib:int-mul 4 m)))))
+              (cond
+                ((>= n mnthr)
+                 (cond
+                   (wntqn
+                    (setf wrkbl
+                            (f2cl-lib:int-add m
+                                              (f2cl-lib:int-mul m
+                                                                (ilaenv 1
+                                                                 "DGELQF" " " m
+                                                                 n -1 -1))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul 2
+                                                                          m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DGEBRD"
+                                                                           " "
+                                                                           m m
+                                                                           -1
+                                                                           -1))))))
+                    (setf maxwrk
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add bdspac m))))
+                    (setf minwrk (f2cl-lib:int-add bdspac m)))
+                   (wntqo
+                    (setf wrkbl
+                            (f2cl-lib:int-add m
+                                              (f2cl-lib:int-mul m
+                                                                (ilaenv 1
+                                                                 "DGELQF" " " m
+                                                                 n -1 -1))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add m
+                                                        (f2cl-lib:int-mul m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGLQ"
+                                                                           " "
+                                                                           m n
+                                                                           m
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul 2
+                                                                          m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DGEBRD"
+                                                                           " "
+                                                                           m m
+                                                                           -1
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORMBR"
+                                                                           "QLN"
+                                                                           m m
+                                                                           m
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORMBR"
+                                                                           "PRT"
+                                                                           m m
+                                                                           m
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add bdspac
+                                                        (f2cl-lib:int-mul 3
+                                                                          m)))))
+                    (setf maxwrk
+                            (f2cl-lib:int-add wrkbl (f2cl-lib:int-mul 2 m m)))
+                    (setf minwrk
+                            (f2cl-lib:int-add bdspac
+                                              (f2cl-lib:int-mul 2 m m)
+                                              (f2cl-lib:int-mul 3 m))))
+                   (wntqs
+                    (setf wrkbl
+                            (f2cl-lib:int-add m
+                                              (f2cl-lib:int-mul m
+                                                                (ilaenv 1
+                                                                 "DGELQF" " " m
+                                                                 n -1 -1))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add m
+                                                        (f2cl-lib:int-mul m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGLQ"
+                                                                           " "
+                                                                           m n
+                                                                           m
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul 2
+                                                                          m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DGEBRD"
+                                                                           " "
+                                                                           m m
+                                                                           -1
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORMBR"
+                                                                           "QLN"
+                                                                           m m
+                                                                           m
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORMBR"
+                                                                           "PRT"
+                                                                           m m
+                                                                           m
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add bdspac
+                                                        (f2cl-lib:int-mul 3
+                                                                          m)))))
+                    (setf maxwrk
+                            (f2cl-lib:int-add wrkbl (f2cl-lib:int-mul m m)))
+                    (setf minwrk
+                            (f2cl-lib:int-add bdspac
+                                              (f2cl-lib:int-mul m m)
+                                              (f2cl-lib:int-mul 3 m))))
+                   (wntqa
+                    (setf wrkbl
+                            (f2cl-lib:int-add m
+                                              (f2cl-lib:int-mul m
+                                                                (ilaenv 1
+                                                                 "DGELQF" " " m
+                                                                 n -1 -1))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add m
+                                                        (f2cl-lib:int-mul n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGLQ"
+                                                                           " "
+                                                                           n n
+                                                                           m
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul 2
+                                                                          m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DGEBRD"
+                                                                           " "
+                                                                           m m
+                                                                           -1
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORMBR"
+                                                                           "QLN"
+                                                                           m m
+                                                                           m
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORMBR"
+                                                                           "PRT"
+                                                                           m m
+                                                                           m
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add bdspac
+                                                        (f2cl-lib:int-mul 3
+                                                                          m)))))
+                    (setf maxwrk
+                            (f2cl-lib:int-add wrkbl (f2cl-lib:int-mul m m)))
+                    (setf minwrk
+                            (f2cl-lib:int-add bdspac
+                                              (f2cl-lib:int-mul m m)
+                                              (f2cl-lib:int-mul 3 m))))))
+                (t
+                 (setf wrkbl
+                         (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                           (f2cl-lib:int-mul
+                                            (f2cl-lib:int-add m n)
+                                            (ilaenv 1 "DGEBRD" " " m n -1 -1))))
+                 (cond
+                   (wntqn
+                    (setf maxwrk
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add bdspac
+                                                        (f2cl-lib:int-mul 3
+                                                                          m)))))
+                    (setf minwrk
+                            (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                              (max (the fixnum n)
+                                                   (the fixnum
+                                                        bdspac)))))
+                   (wntqo
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORMBR"
+                                                                           "QLN"
+                                                                           m m
+                                                                           n
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORMBR"
+                                                                           "PRT"
+                                                                           m n
+                                                                           m
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add bdspac
+                                                        (f2cl-lib:int-mul 3
+                                                                          m)))))
+                    (setf maxwrk
+                            (f2cl-lib:int-add wrkbl (f2cl-lib:int-mul m n)))
+                    (setf minwrk
+                            (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                              (max (the fixnum n)
+                                                   (the fixnum
+                                                        (f2cl-lib:int-add
+                                                         (f2cl-lib:int-mul m m)
+                                                         bdspac))))))
+                   (wntqs
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORMBR"
+                                                                           "QLN"
+                                                                           m m
+                                                                           n
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORMBR"
+                                                                           "PRT"
+                                                                           m n
+                                                                           m
+                                                                           -1))))))
+                    (setf maxwrk
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add bdspac
+                                                        (f2cl-lib:int-mul 3
+                                                                          m)))))
+                    (setf minwrk
+                            (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                              (max (the fixnum n)
+                                                   (the fixnum
+                                                        bdspac)))))
+                   (wntqa
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORMBR"
+                                                                           "QLN"
+                                                                           m m
+                                                                           n
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORMBR"
+                                                                           "PRT"
+                                                                           n n
+                                                                           m
+                                                                           -1))))))
+                    (setf maxwrk
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add bdspac
+                                                        (f2cl-lib:int-mul 3
+                                                                          m)))))
+                    (setf minwrk
+                            (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                              (max (the fixnum n)
+                                                   (the fixnum
+                                                        bdspac))))))))))
+           (setf (f2cl-lib:fref work-%data% (1) ((1 *)) work-%offset%)
+                   (coerce (the fixnum maxwrk) 'double-float))))
+        (cond
+          ((and (< lwork minwrk) (not lquery))
+           (setf info -12)))
+        (cond
+          ((/= info 0)
+           (xerbla "DGESDD" (f2cl-lib:int-sub info))
+           (go end_label))
+          (lquery
+           (go end_label)))
+        (cond
+          ((or (= m 0) (= n 0))
+           (if (>= lwork 1)
+               (setf (f2cl-lib:fref work-%data% (1) ((1 *)) work-%offset%) one))
+           (go end_label)))
+        (setf eps (dlamch "P"))
+        (setf smlnum (/ (f2cl-lib:fsqrt (dlamch "S")) eps))
+        (setf bignum (/ one smlnum))
+        (setf anrm (dlange "M" m n a lda dum))
+        (setf iscl 0)
+        (cond
+          ((and (> anrm zero) (< anrm smlnum))
+           (setf iscl 1)
+           (multiple-value-bind
+                 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9)
+               (dlascl "G" 0 0 anrm smlnum m n a lda ierr)
+             (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8))
+             (setf ierr var-9)))
+          ((> anrm bignum)
+           (setf iscl 1)
+           (multiple-value-bind
+                 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9)
+               (dlascl "G" 0 0 anrm bignum m n a lda ierr)
+             (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8))
+             (setf ierr var-9))))
+        (cond
+          ((>= m n)
+           (cond
+             ((>= m mnthr)
+              (cond
+                (wntqn
+                 (setf itau 1)
+                 (setf nwork (f2cl-lib:int-add itau n))
+                 (multiple-value-bind
+                       (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                     (dgeqrf m n a lda
+                      (f2cl-lib:array-slice work double-float (itau) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6))
+                   (setf ierr var-7))
+                 (dlaset "L" (f2cl-lib:int-sub n 1) (f2cl-lib:int-sub n 1) zero
+                  zero
+                  (f2cl-lib:array-slice a double-float (2 1) ((1 lda) (1 *)))
+                  lda)
+                 (setf ie 1)
+                 (setf itauq (f2cl-lib:int-add ie n))
+                 (setf itaup (f2cl-lib:int-add itauq n))
+                 (setf nwork (f2cl-lib:int-add itaup 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)
+                     (dgebrd n n a lda s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (itauq) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (itaup) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                    var-7 var-8 var-9))
+                   (setf ierr var-10))
+                 (setf nwork (f2cl-lib:int-add ie 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 var-13)
+                     (dbdsdc "U" "N" n s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *))) dum
+                      1 dum 1 dum idum
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      iwork 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))
+                   (setf info var-13)))
+                (wntqo
+                 (setf ir 1)
+                 (cond
+                   ((>= lwork
+                        (f2cl-lib:int-add (f2cl-lib:int-mul lda n)
+                                          (f2cl-lib:int-mul n n)
+                                          (f2cl-lib:int-mul 3 n)
+                                          bdspac))
+                    (setf ldwrkr lda))
+                   (t
+                    (setf ldwrkr
+                            (the fixnum
+                                 (truncate (- lwork (* n n) (* 3 n) bdspac)
+                                           n)))))
+                 (setf itau (f2cl-lib:int-add ir (f2cl-lib:int-mul ldwrkr n)))
+                 (setf nwork (f2cl-lib:int-add itau n))
+                 (multiple-value-bind
+                       (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                     (dgeqrf m n a lda
+                      (f2cl-lib:array-slice work double-float (itau) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6))
+                   (setf ierr var-7))
+                 (dlacpy "U" n n a lda
+                  (f2cl-lib:array-slice work double-float (ir) ((1 *))) ldwrkr)
+                 (dlaset "L" (f2cl-lib:int-sub n 1) (f2cl-lib:int-sub n 1) zero
+                  zero
+                  (f2cl-lib:array-slice work double-float ((+ ir 1)) ((1 *)))
+                  ldwrkr)
+                 (multiple-value-bind
+                       (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8)
+                     (dorgqr m n n a lda
+                      (f2cl-lib:array-slice work double-float (itau) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                    var-7))
+                   (setf ierr var-8))
+                 (setf ie itau)
+                 (setf itauq (f2cl-lib:int-add ie n))
+                 (setf itaup (f2cl-lib:int-add itauq n))
+                 (setf nwork (f2cl-lib:int-add itaup 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)
+                     (dgebrd n n
+                      (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                      ldwrkr s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (itauq) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (itaup) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                    var-7 var-8 var-9))
+                   (setf ierr var-10))
+                 (setf iu nwork)
+                 (setf nwork (f2cl-lib:int-add iu (f2cl-lib:int-mul n 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 var-13)
+                     (dbdsdc "U" "I" n s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (iu) ((1 *))) n
+                      vt ldvt dum idum
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      iwork 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))
+                   (setf info var-13))
+                 (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)
+                     (dormbr "Q" "L" "N" n n n
+                      (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                      ldwrkr
+                      (f2cl-lib:array-slice work double-float (itauq) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (iu) ((1 *))) n
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (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))
+                   (setf ierr var-13))
+                 (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)
+                     (dormbr "P" "R" "T" n n n
+                      (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                      ldwrkr
+                      (f2cl-lib:array-slice work double-float (itaup) ((1 *)))
+                      vt ldvt
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (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))
+                   (setf ierr var-13))
+                 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i ldwrkr))
+                               ((> i m) nil)
+                   (tagbody
+                     (setf chunk
+                             (min
+                              (the fixnum
+                                   (f2cl-lib:int-add (f2cl-lib:int-sub m i) 1))
+                              (the fixnum ldwrkr)))
+                     (dgemm "N" "N" chunk n n one
+                      (f2cl-lib:array-slice a
+                                            double-float
+                                            (i 1)
+                                            ((1 lda) (1 *)))
+                      lda (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                      n zero
+                      (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                      ldwrkr)
+                     (dlacpy "F" chunk n
+                      (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                      ldwrkr
+                      (f2cl-lib:array-slice a
+                                            double-float
+                                            (i 1)
+                                            ((1 lda) (1 *)))
+                      lda))))
+                (wntqs
+                 (setf ir 1)
+                 (setf ldwrkr n)
+                 (setf itau (f2cl-lib:int-add ir (f2cl-lib:int-mul ldwrkr n)))
+                 (setf nwork (f2cl-lib:int-add itau n))
+                 (multiple-value-bind
+                       (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                     (dgeqrf m n a lda
+                      (f2cl-lib:array-slice work double-float (itau) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6))
+                   (setf ierr var-7))
+                 (dlacpy "U" n n a lda
+                  (f2cl-lib:array-slice work double-float (ir) ((1 *))) ldwrkr)
+                 (dlaset "L" (f2cl-lib:int-sub n 1) (f2cl-lib:int-sub n 1) zero
+                  zero
+                  (f2cl-lib:array-slice work double-float ((+ ir 1)) ((1 *)))
+                  ldwrkr)
+                 (multiple-value-bind
+                       (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8)
+                     (dorgqr m n n a lda
+                      (f2cl-lib:array-slice work double-float (itau) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                    var-7))
+                   (setf ierr var-8))
+                 (setf ie itau)
+                 (setf itauq (f2cl-lib:int-add ie n))
+                 (setf itaup (f2cl-lib:int-add itauq n))
+                 (setf nwork (f2cl-lib:int-add itaup 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)
+                     (dgebrd n n
+                      (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                      ldwrkr s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (itauq) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (itaup) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                    var-7 var-8 var-9))
+                   (setf ierr var-10))
+                 (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)
+                     (dbdsdc "U" "I" n s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *))) u
+                      ldu vt ldvt dum idum
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      iwork 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))
+                   (setf info var-13))
+                 (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)
+                     (dormbr "Q" "L" "N" n n n
+                      (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                      ldwrkr
+                      (f2cl-lib:array-slice work double-float (itauq) ((1 *)))
+                      u ldu
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (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))
+                   (setf ierr var-13))
+                 (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)
+                     (dormbr "P" "R" "T" n n n
+                      (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                      ldwrkr
+                      (f2cl-lib:array-slice work double-float (itaup) ((1 *)))
+                      vt ldvt
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (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))
+                   (setf ierr var-13))
+                 (dlacpy "F" n n u ldu
+                  (f2cl-lib:array-slice work double-float (ir) ((1 *))) ldwrkr)
+                 (dgemm "N" "N" m n n one a lda
+                  (f2cl-lib:array-slice work double-float (ir) ((1 *))) ldwrkr
+                  zero u ldu))
+                (wntqa
+                 (setf iu 1)
+                 (setf ldwrku n)
+                 (setf itau (f2cl-lib:int-add iu (f2cl-lib:int-mul ldwrku n)))
+                 (setf nwork (f2cl-lib:int-add itau n))
+                 (multiple-value-bind
+                       (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                     (dgeqrf m n a lda
+                      (f2cl-lib:array-slice work double-float (itau) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6))
+                   (setf ierr var-7))
+                 (dlacpy "L" m n a lda u ldu)
+                 (multiple-value-bind
+                       (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8)
+                     (dorgqr m m n u ldu
+                      (f2cl-lib:array-slice work double-float (itau) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                    var-7))
+                   (setf ierr var-8))
+                 (dlaset "L" (f2cl-lib:int-sub n 1) (f2cl-lib:int-sub n 1) zero
+                  zero
+                  (f2cl-lib:array-slice a double-float (2 1) ((1 lda) (1 *)))
+                  lda)
+                 (setf ie itau)
+                 (setf itauq (f2cl-lib:int-add ie n))
+                 (setf itaup (f2cl-lib:int-add itauq n))
+                 (setf nwork (f2cl-lib:int-add itaup 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)
+                     (dgebrd n n a lda s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (itauq) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (itaup) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                    var-7 var-8 var-9))
+                   (setf ierr var-10))
+                 (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)
+                     (dbdsdc "U" "I" n s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (iu) ((1 *))) n
+                      vt ldvt dum idum
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      iwork 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))
+                   (setf info var-13))
+                 (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)
+                     (dormbr "Q" "L" "N" n n n a lda
+                      (f2cl-lib:array-slice work double-float (itauq) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                      ldwrku
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (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))
+                   (setf ierr var-13))
+                 (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)
+                     (dormbr "P" "R" "T" n n n a lda
+                      (f2cl-lib:array-slice work double-float (itaup) ((1 *)))
+                      vt ldvt
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (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))
+                   (setf ierr var-13))
+                 (dgemm "N" "N" m n n one u ldu
+                  (f2cl-lib:array-slice work double-float (iu) ((1 *))) ldwrku
+                  zero a lda)
+                 (dlacpy "F" m n a lda u ldu))))
+             (t
+              (setf ie 1)
+              (setf itauq (f2cl-lib:int-add ie n))
+              (setf itaup (f2cl-lib:int-add itauq n))
+              (setf nwork (f2cl-lib:int-add itaup 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)
+                  (dgebrd m n a lda s
+                   (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                   (f2cl-lib:array-slice work double-float (itauq) ((1 *)))
+                   (f2cl-lib:array-slice work double-float (itaup) ((1 *)))
+                   (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                   (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                 var-7 var-8 var-9))
+                (setf ierr var-10))
+              (cond
+                (wntqn
+                 (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)
+                     (dbdsdc "U" "N" n s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *))) dum
+                      1 dum 1 dum idum
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      iwork 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))
+                   (setf info var-13)))
+                (wntqo
+                 (setf iu nwork)
+                 (cond
+                   ((>= lwork
+                        (f2cl-lib:int-add (f2cl-lib:int-mul m n)
+                                          (f2cl-lib:int-mul 3 n)
+                                          bdspac))
+                    (setf ldwrku m)
+                    (setf nwork
+                            (f2cl-lib:int-add iu (f2cl-lib:int-mul ldwrku n)))
+                    (dlaset "F" m n zero zero
+                     (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                     ldwrku))
+                   (t
+                    (setf ldwrku n)
+                    (setf nwork
+                            (f2cl-lib:int-add iu (f2cl-lib:int-mul ldwrku n)))
+                    (setf ir nwork)
+                    (setf ldwrkr
+                            (the fixnum
+                                 (truncate (- lwork (* n n) (* 3 n)) n)))))
+                 (setf nwork (f2cl-lib:int-add iu (f2cl-lib:int-mul ldwrku 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 var-13)
+                     (dbdsdc "U" "I" n s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                      ldwrku vt ldvt dum idum
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      iwork 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))
+                   (setf info var-13))
+                 (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)
+                     (dormbr "P" "R" "T" n n n a lda
+                      (f2cl-lib:array-slice work double-float (itaup) ((1 *)))
+                      vt ldvt
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (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))
+                   (setf ierr var-13))
+                 (cond
+                   ((>= lwork
+                        (f2cl-lib:int-add (f2cl-lib:int-mul m n)
+                                          (f2cl-lib:int-mul 3 n)
+                                          bdspac))
+                    (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)
+                        (dormbr "Q" "L" "N" m n n a lda
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itauq)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                         ldwrku
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (nwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1)
+                         ierr)
+                      (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))
+                      (setf ierr var-13))
+                    (dlacpy "F" m n
+                     (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                     ldwrku a lda))
+                   (t
+                    (multiple-value-bind
+                          (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                           var-8 var-9)
+                        (dorgbr "Q" m n n a lda
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itauq)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (nwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6 var-7 var-8))
+                      (setf ierr var-9))
+                    (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i ldwrkr))
+                                  ((> i m) nil)
+                      (tagbody
+                        (setf chunk
+                                (min
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-sub m i)
+                                                        1))
+                                 (the fixnum ldwrkr)))
+                        (dgemm "N" "N" chunk n n one
+                         (f2cl-lib:array-slice a
+                                               double-float
+                                               (i 1)
+                                               ((1 lda) (1 *)))
+                         lda
+                         (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                         ldwrku zero
+                         (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                         ldwrkr)
+                        (dlacpy "F" chunk n
+                         (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                         ldwrkr
+                         (f2cl-lib:array-slice a
+                                               double-float
+                                               (i 1)
+                                               ((1 lda) (1 *)))
+                         lda))))))
+                (wntqs
+                 (dlaset "F" m n zero zero u ldu)
+                 (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)
+                     (dbdsdc "U" "I" n s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *))) u
+                      ldu vt ldvt dum idum
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      iwork 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))
+                   (setf info var-13))
+                 (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)
+                     (dormbr "Q" "L" "N" m n n a lda
+                      (f2cl-lib:array-slice work double-float (itauq) ((1 *)))
+                      u ldu
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (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))
+                   (setf ierr var-13))
+                 (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)
+                     (dormbr "P" "R" "T" n n n a lda
+                      (f2cl-lib:array-slice work double-float (itaup) ((1 *)))
+                      vt ldvt
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (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))
+                   (setf ierr var-13)))
+                (wntqa
+                 (dlaset "F" m m zero zero u ldu)
+                 (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)
+                     (dbdsdc "U" "I" n s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *))) u
+                      ldu vt ldvt dum idum
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      iwork 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))
+                   (setf info var-13))
+                 (dlaset "F" (f2cl-lib:int-sub m n) (f2cl-lib:int-sub m n) zero
+                  one
+                  (f2cl-lib:array-slice u
+                                        double-float
+                                        ((+ n 1) (f2cl-lib:int-add n 1))
+                                        ((1 ldu) (1 *)))
+                  ldu)
+                 (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)
+                     (dormbr "Q" "L" "N" m m n a lda
+                      (f2cl-lib:array-slice work double-float (itauq) ((1 *)))
+                      u ldu
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (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))
+                   (setf ierr var-13))
+                 (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)
+                     (dormbr "P" "R" "T" n n m a lda
+                      (f2cl-lib:array-slice work double-float (itaup) ((1 *)))
+                      vt ldvt
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (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))
+                   (setf ierr var-13)))))))
+          (t
+           (cond
+             ((>= n mnthr)
+              (cond
+                (wntqn
+                 (setf itau 1)
+                 (setf nwork (f2cl-lib:int-add itau m))
+                 (multiple-value-bind
+                       (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                     (dgelqf m n a lda
+                      (f2cl-lib:array-slice work double-float (itau) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6))
+                   (setf ierr var-7))
+                 (dlaset "U" (f2cl-lib:int-sub m 1) (f2cl-lib:int-sub m 1) zero
+                  zero
+                  (f2cl-lib:array-slice a double-float (1 2) ((1 lda) (1 *)))
+                  lda)
+                 (setf ie 1)
+                 (setf itauq (f2cl-lib:int-add ie m))
+                 (setf itaup (f2cl-lib:int-add itauq m))
+                 (setf nwork (f2cl-lib:int-add itaup m))
+                 (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)
+                     (dgebrd m m a lda s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (itauq) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (itaup) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                    var-7 var-8 var-9))
+                   (setf ierr var-10))
+                 (setf nwork (f2cl-lib:int-add ie m))
+                 (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)
+                     (dbdsdc "U" "N" m s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *))) dum
+                      1 dum 1 dum idum
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      iwork 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))
+                   (setf info var-13)))
+                (wntqo
+                 (setf ivt 1)
+                 (setf il (f2cl-lib:int-add ivt (f2cl-lib:int-mul m m)))
+                 (cond
+                   ((>= lwork
+                        (f2cl-lib:int-add (f2cl-lib:int-mul m n)
+                                          (f2cl-lib:int-mul m m)
+                                          (f2cl-lib:int-mul 3 m)
+                                          bdspac))
+                    (setf ldwrkl m)
+                    (setf chunk n))
+                   (t
+                    (setf ldwrkl m)
+                    (setf chunk
+                            (the fixnum
+                                 (truncate (- lwork (* m m)) m)))))
+                 (setf itau (f2cl-lib:int-add il (f2cl-lib:int-mul ldwrkl m)))
+                 (setf nwork (f2cl-lib:int-add itau m))
+                 (multiple-value-bind
+                       (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                     (dgelqf m n a lda
+                      (f2cl-lib:array-slice work double-float (itau) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6))
+                   (setf ierr var-7))
+                 (dlacpy "L" m m a lda
+                  (f2cl-lib:array-slice work double-float (il) ((1 *))) ldwrkl)
+                 (dlaset "U" (f2cl-lib:int-sub m 1) (f2cl-lib:int-sub m 1) zero
+                  zero
+                  (f2cl-lib:array-slice work
+                                        double-float
+                                        ((+ il ldwrkl))
+                                        ((1 *)))
+                  ldwrkl)
+                 (multiple-value-bind
+                       (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8)
+                     (dorglq m n m a lda
+                      (f2cl-lib:array-slice work double-float (itau) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                    var-7))
+                   (setf ierr var-8))
+                 (setf ie itau)
+                 (setf itauq (f2cl-lib:int-add ie m))
+                 (setf itaup (f2cl-lib:int-add itauq m))
+                 (setf nwork (f2cl-lib:int-add itaup m))
+                 (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)
+                     (dgebrd m m
+                      (f2cl-lib:array-slice work double-float (il) ((1 *)))
+                      ldwrkl s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (itauq) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (itaup) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                    var-7 var-8 var-9))
+                   (setf ierr var-10))
+                 (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)
+                     (dbdsdc "U" "I" m s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *))) u
+                      ldu
+                      (f2cl-lib:array-slice work double-float (ivt) ((1 *))) m
+                      dum idum
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      iwork 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))
+                   (setf info var-13))
+                 (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)
+                     (dormbr "Q" "L" "N" m m m
+                      (f2cl-lib:array-slice work double-float (il) ((1 *)))
+                      ldwrkl
+                      (f2cl-lib:array-slice work double-float (itauq) ((1 *)))
+                      u ldu
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (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))
+                   (setf ierr var-13))
+                 (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)
+                     (dormbr "P" "R" "T" m m m
+                      (f2cl-lib:array-slice work double-float (il) ((1 *)))
+                      ldwrkl
+                      (f2cl-lib:array-slice work double-float (itaup) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (ivt) ((1 *))) m
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (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))
+                   (setf ierr var-13))
+                 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i chunk))
+                               ((> i n) nil)
+                   (tagbody
+                     (setf blk
+                             (min
+                              (the fixnum
+                                   (f2cl-lib:int-add (f2cl-lib:int-sub n i) 1))
+                              (the fixnum chunk)))
+                     (dgemm "N" "N" m blk m one
+                      (f2cl-lib:array-slice work double-float (ivt) ((1 *))) m
+                      (f2cl-lib:array-slice a
+                                            double-float
+                                            (1 i)
+                                            ((1 lda) (1 *)))
+                      lda zero
+                      (f2cl-lib:array-slice work double-float (il) ((1 *)))
+                      ldwrkl)
+                     (dlacpy "F" m blk
+                      (f2cl-lib:array-slice work double-float (il) ((1 *)))
+                      ldwrkl
+                      (f2cl-lib:array-slice a
+                                            double-float
+                                            (1 i)
+                                            ((1 lda) (1 *)))
+                      lda))))
+                (wntqs
+                 (setf il 1)
+                 (setf ldwrkl m)
+                 (setf itau (f2cl-lib:int-add il (f2cl-lib:int-mul ldwrkl m)))
+                 (setf nwork (f2cl-lib:int-add itau m))
+                 (multiple-value-bind
+                       (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                     (dgelqf m n a lda
+                      (f2cl-lib:array-slice work double-float (itau) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6))
+                   (setf ierr var-7))
+                 (dlacpy "L" m m a lda
+                  (f2cl-lib:array-slice work double-float (il) ((1 *))) ldwrkl)
+                 (dlaset "U" (f2cl-lib:int-sub m 1) (f2cl-lib:int-sub m 1) zero
+                  zero
+                  (f2cl-lib:array-slice work
+                                        double-float
+                                        ((+ il ldwrkl))
+                                        ((1 *)))
+                  ldwrkl)
+                 (multiple-value-bind
+                       (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8)
+                     (dorglq m n m a lda
+                      (f2cl-lib:array-slice work double-float (itau) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                    var-7))
+                   (setf ierr var-8))
+                 (setf ie itau)
+                 (setf itauq (f2cl-lib:int-add ie m))
+                 (setf itaup (f2cl-lib:int-add itauq m))
+                 (setf nwork (f2cl-lib:int-add itaup m))
+                 (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)
+                     (dgebrd m m
+                      (f2cl-lib:array-slice work double-float (il) ((1 *)))
+                      ldwrkl s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (itauq) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (itaup) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                    var-7 var-8 var-9))
+                   (setf ierr var-10))
+                 (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)
+                     (dbdsdc "U" "I" m s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *))) u
+                      ldu vt ldvt dum idum
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      iwork 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))
+                   (setf info var-13))
+                 (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)
+                     (dormbr "Q" "L" "N" m m m
+                      (f2cl-lib:array-slice work double-float (il) ((1 *)))
+                      ldwrkl
+                      (f2cl-lib:array-slice work double-float (itauq) ((1 *)))
+                      u ldu
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (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))
+                   (setf ierr var-13))
+                 (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)
+                     (dormbr "P" "R" "T" m m m
+                      (f2cl-lib:array-slice work double-float (il) ((1 *)))
+                      ldwrkl
+                      (f2cl-lib:array-slice work double-float (itaup) ((1 *)))
+                      vt ldvt
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (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))
+                   (setf ierr var-13))
+                 (dlacpy "F" m m vt ldvt
+                  (f2cl-lib:array-slice work double-float (il) ((1 *))) ldwrkl)
+                 (dgemm "N" "N" m n m one
+                  (f2cl-lib:array-slice work double-float (il) ((1 *))) ldwrkl
+                  a lda zero vt ldvt))
+                (wntqa
+                 (setf ivt 1)
+                 (setf ldwkvt m)
+                 (setf itau (f2cl-lib:int-add ivt (f2cl-lib:int-mul ldwkvt m)))
+                 (setf nwork (f2cl-lib:int-add itau m))
+                 (multiple-value-bind
+                       (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                     (dgelqf m n a lda
+                      (f2cl-lib:array-slice work double-float (itau) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6))
+                   (setf ierr var-7))
+                 (dlacpy "U" m n a lda vt ldvt)
+                 (multiple-value-bind
+                       (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8)
+                     (dorglq n n m vt ldvt
+                      (f2cl-lib:array-slice work double-float (itau) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                    var-7))
+                   (setf ierr var-8))
+                 (dlaset "U" (f2cl-lib:int-sub m 1) (f2cl-lib:int-sub m 1) zero
+                  zero
+                  (f2cl-lib:array-slice a double-float (1 2) ((1 lda) (1 *)))
+                  lda)
+                 (setf ie itau)
+                 (setf itauq (f2cl-lib:int-add ie m))
+                 (setf itaup (f2cl-lib:int-add itauq m))
+                 (setf nwork (f2cl-lib:int-add itaup m))
+                 (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)
+                     (dgebrd m m a lda s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (itauq) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (itaup) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                    var-7 var-8 var-9))
+                   (setf ierr var-10))
+                 (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)
+                     (dbdsdc "U" "I" m s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *))) u
+                      ldu
+                      (f2cl-lib:array-slice work double-float (ivt) ((1 *)))
+                      ldwkvt dum idum
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      iwork 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))
+                   (setf info var-13))
+                 (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)
+                     (dormbr "Q" "L" "N" m m m a lda
+                      (f2cl-lib:array-slice work double-float (itauq) ((1 *)))
+                      u ldu
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (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))
+                   (setf ierr var-13))
+                 (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)
+                     (dormbr "P" "R" "T" m m m a lda
+                      (f2cl-lib:array-slice work double-float (itaup) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (ivt) ((1 *)))
+                      ldwkvt
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (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))
+                   (setf ierr var-13))
+                 (dgemm "N" "N" m n m one
+                  (f2cl-lib:array-slice work double-float (ivt) ((1 *))) ldwkvt
+                  vt ldvt zero a lda)
+                 (dlacpy "F" m n a lda vt ldvt))))
+             (t
+              (setf ie 1)
+              (setf itauq (f2cl-lib:int-add ie m))
+              (setf itaup (f2cl-lib:int-add itauq m))
+              (setf nwork (f2cl-lib:int-add itaup m))
+              (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)
+                  (dgebrd m n a lda s
+                   (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                   (f2cl-lib:array-slice work double-float (itauq) ((1 *)))
+                   (f2cl-lib:array-slice work double-float (itaup) ((1 *)))
+                   (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                   (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                 var-7 var-8 var-9))
+                (setf ierr var-10))
+              (cond
+                (wntqn
+                 (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)
+                     (dbdsdc "L" "N" m s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *))) dum
+                      1 dum 1 dum idum
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      iwork 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))
+                   (setf info var-13)))
+                (wntqo
+                 (setf ldwkvt m)
+                 (setf ivt nwork)
+                 (cond
+                   ((>= lwork
+                        (f2cl-lib:int-add (f2cl-lib:int-mul m n)
+                                          (f2cl-lib:int-mul 3 m)
+                                          bdspac))
+                    (dlaset "F" m n zero zero
+                     (f2cl-lib:array-slice work double-float (ivt) ((1 *)))
+                     ldwkvt)
+                    (setf nwork
+                            (f2cl-lib:int-add ivt (f2cl-lib:int-mul ldwkvt n))))
+                   (t
+                    (setf nwork
+                            (f2cl-lib:int-add ivt (f2cl-lib:int-mul ldwkvt m)))
+                    (setf il nwork)
+                    (setf chunk
+                            (the fixnum
+                                 (truncate (- lwork (* m m) (* 3 m)) m)))))
+                 (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)
+                     (dbdsdc "L" "I" m s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *))) u
+                      ldu
+                      (f2cl-lib:array-slice work double-float (ivt) ((1 *)))
+                      ldwkvt dum idum
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      iwork 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))
+                   (setf info var-13))
+                 (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)
+                     (dormbr "Q" "L" "N" m m n a lda
+                      (f2cl-lib:array-slice work double-float (itauq) ((1 *)))
+                      u ldu
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (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))
+                   (setf ierr var-13))
+                 (cond
+                   ((>= lwork
+                        (f2cl-lib:int-add (f2cl-lib:int-mul m n)
+                                          (f2cl-lib:int-mul 3 m)
+                                          bdspac))
+                    (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)
+                        (dormbr "P" "R" "T" m n m a lda
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itaup)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work double-float (ivt) ((1 *)))
+                         ldwkvt
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (nwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1)
+                         ierr)
+                      (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))
+                      (setf ierr var-13))
+                    (dlacpy "F" m n
+                     (f2cl-lib:array-slice work double-float (ivt) ((1 *)))
+                     ldwkvt a lda))
+                   (t
+                    (multiple-value-bind
+                          (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                           var-8 var-9)
+                        (dorgbr "P" m n m a lda
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itaup)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (nwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6 var-7 var-8))
+                      (setf ierr var-9))
+                    (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i chunk))
+                                  ((> i n) nil)
+                      (tagbody
+                        (setf blk
+                                (min
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-sub n i)
+                                                        1))
+                                 (the fixnum chunk)))
+                        (dgemm "N" "N" m blk m one
+                         (f2cl-lib:array-slice work double-float (ivt) ((1 *)))
+                         ldwkvt
+                         (f2cl-lib:array-slice a
+                                               double-float
+                                               (1 i)
+                                               ((1 lda) (1 *)))
+                         lda zero
+                         (f2cl-lib:array-slice work double-float (il) ((1 *)))
+                         m)
+                        (dlacpy "F" m blk
+                         (f2cl-lib:array-slice work double-float (il) ((1 *)))
+                         m
+                         (f2cl-lib:array-slice a
+                                               double-float
+                                               (1 i)
+                                               ((1 lda) (1 *)))
+                         lda))))))
+                (wntqs
+                 (dlaset "F" m n zero zero vt ldvt)
+                 (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)
+                     (dbdsdc "L" "I" m s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *))) u
+                      ldu vt ldvt dum idum
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      iwork 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))
+                   (setf info var-13))
+                 (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)
+                     (dormbr "Q" "L" "N" m m n a lda
+                      (f2cl-lib:array-slice work double-float (itauq) ((1 *)))
+                      u ldu
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (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))
+                   (setf ierr var-13))
+                 (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)
+                     (dormbr "P" "R" "T" m n m a lda
+                      (f2cl-lib:array-slice work double-float (itaup) ((1 *)))
+                      vt ldvt
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (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))
+                   (setf ierr var-13)))
+                (wntqa
+                 (dlaset "F" n n zero zero vt ldvt)
+                 (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)
+                     (dbdsdc "L" "I" m s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *))) u
+                      ldu vt ldvt dum idum
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      iwork 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))
+                   (setf info var-13))
+                 (dlaset "F" (f2cl-lib:int-sub n m) (f2cl-lib:int-sub n m) zero
+                  one
+                  (f2cl-lib:array-slice vt
+                                        double-float
+                                        ((+ m 1) (f2cl-lib:int-add m 1))
+                                        ((1 ldvt) (1 *)))
+                  ldvt)
+                 (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)
+                     (dormbr "Q" "L" "N" m m n a lda
+                      (f2cl-lib:array-slice work double-float (itauq) ((1 *)))
+                      u ldu
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (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))
+                   (setf ierr var-13))
+                 (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)
+                     (dormbr "P" "R" "T" n n m a lda
+                      (f2cl-lib:array-slice work double-float (itaup) ((1 *)))
+                      vt ldvt
+                      (f2cl-lib:array-slice work double-float (nwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork nwork) 1) ierr)
+                   (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))
+                   (setf ierr var-13))))))))
+        (cond
+          ((= iscl 1)
+           (if (> anrm bignum)
+               (multiple-value-bind
+                     (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8
+                      var-9)
+                   (dlascl "G" 0 0 bignum anrm minmn 1 s minmn ierr)
+                 (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                  var-7 var-8))
+                 (setf ierr var-9)))
+           (if (< anrm smlnum)
+               (multiple-value-bind
+                     (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8
+                      var-9)
+                   (dlascl "G" 0 0 smlnum anrm minmn 1 s minmn ierr)
+                 (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                  var-7 var-8))
+                 (setf ierr var-9)))))
+        (setf (f2cl-lib:fref work-%data% (1) ((1 *)) work-%offset%)
+                (coerce (realpart maxwrk) 'double-float))
+ end_label
+        (return
+         (values nil nil 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::dgesdd
+                 fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '((simple-array character (1))
+                        fixnum fixnum
+                        (array double-float (*)) fixnum
+                        (array double-float (*)) (array double-float (*))
+                        fixnum (array double-float (*))
+                        fixnum (array double-float (*))
+                        fixnum
+                        (array fixnum (*))
+                        fixnum)
+           :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil nil
+                            fortran-to-lisp::info)
+           :calls '(fortran-to-lisp::dorglq fortran-to-lisp::dgelqf
+                    fortran-to-lisp::dorgbr fortran-to-lisp::dgemm
+                    fortran-to-lisp::dormbr fortran-to-lisp::dorgqr
+                    fortran-to-lisp::dlacpy fortran-to-lisp::dbdsdc
+                    fortran-to-lisp::dgebrd fortran-to-lisp::dlaset
+                    fortran-to-lisp::dgeqrf fortran-to-lisp::dlascl
+                    fortran-to-lisp::dlange fortran-to-lisp::dlamch
+                    fortran-to-lisp::xerbla fortran-to-lisp::ilaenv
+                    fortran-to-lisp::lsame))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dgesvd LAPACK}
+\pagehead{dgesvd}{dgesvd}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<LAPACK dgesvd>>=
+(let* ((zero 0.0) (one 1.0))
+  (declare (type (double-float 0.0 0.0) zero)
+           (type (double-float 1.0 1.0) one))
+  (defun dgesvd (jobu jobvt m n a lda s u ldu vt ldvt work lwork info)
+    (declare (type (array double-float (*)) work vt u s a)
+             (type fixnum info lwork ldvt ldu lda n m)
+             (type (simple-array character (*)) jobvt jobu))
+    (f2cl-lib:with-multi-array-data
+        ((jobu character jobu-%data% jobu-%offset%)
+         (jobvt character jobvt-%data% jobvt-%offset%)
+         (a double-float a-%data% a-%offset%)
+         (s double-float s-%data% s-%offset%)
+         (u double-float u-%data% u-%offset%)
+         (vt double-float vt-%data% vt-%offset%)
+         (work double-float work-%data% work-%offset%))
+      (prog ((dum (make-array 1 :element-type 'double-float)) (anrm 0.0)
+             (bignum 0.0) (eps 0.0) (smlnum 0.0) (bdspac 0) (blk 0) (chunk 0)
+             (i 0) (ie 0) (ierr 0) (ir 0) (iscl 0) (itau 0) (itaup 0) (itauq 0)
+             (iu 0) (iwork 0) (ldwrkr 0) (ldwrku 0) (maxwrk 0) (minmn 0)
+             (minwrk 0) (mnthr 0) (ncu 0) (ncvt 0) (nru 0) (nrvt 0) (wrkbl 0)
+             (lquery nil) (wntua nil) (wntuas nil) (wntun nil) (wntuo nil)
+             (wntus nil) (wntva nil) (wntvas nil) (wntvn nil) (wntvo nil)
+             (wntvs nil))
+        (declare (type (array double-float (1)) dum)
+                 (type (double-float) anrm bignum eps smlnum)
+                 (type fixnum bdspac blk chunk i ie ierr ir iscl
+                                           itau itaup itauq iu iwork ldwrkr
+                                           ldwrku maxwrk minmn minwrk mnthr ncu
+                                           ncvt nru nrvt wrkbl)
+                 (type (member t nil) lquery wntua wntuas wntun wntuo wntus
+                                        wntva wntvas wntvn wntvo wntvs))
+        (setf info 0)
+        (setf minmn (min (the fixnum m) (the fixnum n)))
+        (setf mnthr (ilaenv 6 "DGESVD" (f2cl-lib:f2cl-// jobu jobvt) m n 0 0))
+        (setf wntua (lsame jobu "A"))
+        (setf wntus (lsame jobu "S"))
+        (setf wntuas (or wntua wntus))
+        (setf wntuo (lsame jobu "O"))
+        (setf wntun (lsame jobu "N"))
+        (setf wntva (lsame jobvt "A"))
+        (setf wntvs (lsame jobvt "S"))
+        (setf wntvas (or wntva wntvs))
+        (setf wntvo (lsame jobvt "O"))
+        (setf wntvn (lsame jobvt "N"))
+        (setf minwrk 1)
+        (setf lquery (coerce (= lwork -1) '(member t nil)))
+        (cond
+          ((not (or wntua wntus wntuo wntun))
+           (setf info -1))
+          ((or (not (or wntva wntvs wntvo wntvn)) (and wntvo wntuo))
+           (setf info -2))
+          ((< m 0)
+           (setf info -3))
+          ((< n 0)
+           (setf info -4))
+          ((< lda (max (the fixnum 1) (the fixnum m)))
+           (setf info -6))
+          ((or (< ldu 1) (and wntuas (< ldu m)))
+           (setf info -9))
+          ((or (< ldvt 1) (and wntva (< ldvt n)) (and wntvs (< ldvt minmn)))
+           (setf info -11)))
+        (cond
+          ((and (= info 0) (or (>= lwork 1) lquery) (> m 0) (> n 0))
+           (cond
+             ((>= m n)
+              (setf bdspac (f2cl-lib:int-mul 5 n))
+              (cond
+                ((>= m mnthr)
+                 (cond
+                   (wntun
+                    (setf maxwrk
+                            (f2cl-lib:int-add n
+                                              (f2cl-lib:int-mul n
+                                                                (ilaenv 1
+                                                                 "DGEQRF" " " m
+                                                                 n -1 -1))))
+                    (setf maxwrk
+                            (max (the fixnum maxwrk)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul 2
+                                                                          n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DGEBRD"
+                                                                           " "
+                                                                           n n
+                                                                           -1
+                                                                           -1))))))
+                    (if (or wntvo wntvas)
+                        (setf maxwrk
+                                (max (the fixnum maxwrk)
+                                     (the fixnum
+                                          (f2cl-lib:int-add
+                                           (f2cl-lib:int-mul 3 n)
+                                           (f2cl-lib:int-mul
+                                            (f2cl-lib:int-sub n 1)
+                                            (ilaenv 1 "DORGBR" "P" n n n
+                                             -1)))))))
+                    (setf maxwrk
+                            (max (the fixnum maxwrk)
+                                 (the fixnum bdspac)))
+                    (setf minwrk
+                            (max (the fixnum (f2cl-lib:int-mul 4 n))
+                                 (the fixnum bdspac)))
+                    (setf maxwrk
+                            (max (the fixnum maxwrk)
+                                 (the fixnum minwrk))))
+                   ((and wntuo wntvn)
+                    (setf wrkbl
+                            (f2cl-lib:int-add n
+                                              (f2cl-lib:int-mul n
+                                                                (ilaenv 1
+                                                                 "DGEQRF" " " m
+                                                                 n -1 -1))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add n
+                                                        (f2cl-lib:int-mul n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGQR"
+                                                                           " "
+                                                                           m n
+                                                                           n
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul 2
+                                                                          n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DGEBRD"
+                                                                           " "
+                                                                           n n
+                                                                           -1
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGBR"
+                                                                           "Q"
+                                                                           n n
+                                                                           n
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum bdspac)))
+                    (setf maxwrk
+                            (max
+                             (the fixnum
+                                  (f2cl-lib:int-add (f2cl-lib:int-mul n n)
+                                                    wrkbl))
+                             (the fixnum
+                                  (f2cl-lib:int-add (f2cl-lib:int-mul n n)
+                                                    (f2cl-lib:int-mul m n)
+                                                    n))))
+                    (setf minwrk
+                            (max
+                             (the fixnum
+                                  (f2cl-lib:int-add (f2cl-lib:int-mul 3 n) m))
+                             (the fixnum bdspac)))
+                    (setf maxwrk
+                            (max (the fixnum maxwrk)
+                                 (the fixnum minwrk))))
+                   ((and wntuo wntvas)
+                    (setf wrkbl
+                            (f2cl-lib:int-add n
+                                              (f2cl-lib:int-mul n
+                                                                (ilaenv 1
+                                                                 "DGEQRF" " " m
+                                                                 n -1 -1))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add n
+                                                        (f2cl-lib:int-mul n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGQR"
+                                                                           " "
+                                                                           m n
+                                                                           n
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul 2
+                                                                          n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DGEBRD"
+                                                                           " "
+                                                                           n n
+                                                                           -1
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGBR"
+                                                                           "Q"
+                                                                           n n
+                                                                           n
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul
+                                                         (f2cl-lib:int-sub n 1)
+                                                         (ilaenv 1 "DORGBR" "P"
+                                                          n n n -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum bdspac)))
+                    (setf maxwrk
+                            (max
+                             (the fixnum
+                                  (f2cl-lib:int-add (f2cl-lib:int-mul n n)
+                                                    wrkbl))
+                             (the fixnum
+                                  (f2cl-lib:int-add (f2cl-lib:int-mul n n)
+                                                    (f2cl-lib:int-mul m n)
+                                                    n))))
+                    (setf minwrk
+                            (max
+                             (the fixnum
+                                  (f2cl-lib:int-add (f2cl-lib:int-mul 3 n) m))
+                             (the fixnum bdspac)))
+                    (setf maxwrk
+                            (max (the fixnum maxwrk)
+                                 (the fixnum minwrk))))
+                   ((and wntus wntvn)
+                    (setf wrkbl
+                            (f2cl-lib:int-add n
+                                              (f2cl-lib:int-mul n
+                                                                (ilaenv 1
+                                                                 "DGEQRF" " " m
+                                                                 n -1 -1))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add n
+                                                        (f2cl-lib:int-mul n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGQR"
+                                                                           " "
+                                                                           m n
+                                                                           n
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul 2
+                                                                          n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DGEBRD"
+                                                                           " "
+                                                                           n n
+                                                                           -1
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGBR"
+                                                                           "Q"
+                                                                           n n
+                                                                           n
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum bdspac)))
+                    (setf maxwrk
+                            (f2cl-lib:int-add (f2cl-lib:int-mul n n) wrkbl))
+                    (setf minwrk
+                            (max
+                             (the fixnum
+                                  (f2cl-lib:int-add (f2cl-lib:int-mul 3 n) m))
+                             (the fixnum bdspac)))
+                    (setf maxwrk
+                            (max (the fixnum maxwrk)
+                                 (the fixnum minwrk))))
+                   ((and wntus wntvo)
+                    (setf wrkbl
+                            (f2cl-lib:int-add n
+                                              (f2cl-lib:int-mul n
+                                                                (ilaenv 1
+                                                                 "DGEQRF" " " m
+                                                                 n -1 -1))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add n
+                                                        (f2cl-lib:int-mul n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGQR"
+                                                                           " "
+                                                                           m n
+                                                                           n
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul 2
+                                                                          n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DGEBRD"
+                                                                           " "
+                                                                           n n
+                                                                           -1
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGBR"
+                                                                           "Q"
+                                                                           n n
+                                                                           n
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul
+                                                         (f2cl-lib:int-sub n 1)
+                                                         (ilaenv 1 "DORGBR" "P"
+                                                          n n n -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum bdspac)))
+                    (setf maxwrk
+                            (f2cl-lib:int-add (f2cl-lib:int-mul 2 n n) wrkbl))
+                    (setf minwrk
+                            (max
+                             (the fixnum
+                                  (f2cl-lib:int-add (f2cl-lib:int-mul 3 n) m))
+                             (the fixnum bdspac)))
+                    (setf maxwrk
+                            (max (the fixnum maxwrk)
+                                 (the fixnum minwrk))))
+                   ((and wntus wntvas)
+                    (setf wrkbl
+                            (f2cl-lib:int-add n
+                                              (f2cl-lib:int-mul n
+                                                                (ilaenv 1
+                                                                 "DGEQRF" " " m
+                                                                 n -1 -1))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add n
+                                                        (f2cl-lib:int-mul n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGQR"
+                                                                           " "
+                                                                           m n
+                                                                           n
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul 2
+                                                                          n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DGEBRD"
+                                                                           " "
+                                                                           n n
+                                                                           -1
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGBR"
+                                                                           "Q"
+                                                                           n n
+                                                                           n
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul
+                                                         (f2cl-lib:int-sub n 1)
+                                                         (ilaenv 1 "DORGBR" "P"
+                                                          n n n -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum bdspac)))
+                    (setf maxwrk
+                            (f2cl-lib:int-add (f2cl-lib:int-mul n n) wrkbl))
+                    (setf minwrk
+                            (max
+                             (the fixnum
+                                  (f2cl-lib:int-add (f2cl-lib:int-mul 3 n) m))
+                             (the fixnum bdspac)))
+                    (setf maxwrk
+                            (max (the fixnum maxwrk)
+                                 (the fixnum minwrk))))
+                   ((and wntua wntvn)
+                    (setf wrkbl
+                            (f2cl-lib:int-add n
+                                              (f2cl-lib:int-mul n
+                                                                (ilaenv 1
+                                                                 "DGEQRF" " " m
+                                                                 n -1 -1))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add n
+                                                        (f2cl-lib:int-mul m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGQR"
+                                                                           " "
+                                                                           m m
+                                                                           n
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul 2
+                                                                          n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DGEBRD"
+                                                                           " "
+                                                                           n n
+                                                                           -1
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGBR"
+                                                                           "Q"
+                                                                           n n
+                                                                           n
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum bdspac)))
+                    (setf maxwrk
+                            (f2cl-lib:int-add (f2cl-lib:int-mul n n) wrkbl))
+                    (setf minwrk
+                            (max
+                             (the fixnum
+                                  (f2cl-lib:int-add (f2cl-lib:int-mul 3 n) m))
+                             (the fixnum bdspac)))
+                    (setf maxwrk
+                            (max (the fixnum maxwrk)
+                                 (the fixnum minwrk))))
+                   ((and wntua wntvo)
+                    (setf wrkbl
+                            (f2cl-lib:int-add n
+                                              (f2cl-lib:int-mul n
+                                                                (ilaenv 1
+                                                                 "DGEQRF" " " m
+                                                                 n -1 -1))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add n
+                                                        (f2cl-lib:int-mul m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGQR"
+                                                                           " "
+                                                                           m m
+                                                                           n
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul 2
+                                                                          n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DGEBRD"
+                                                                           " "
+                                                                           n n
+                                                                           -1
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGBR"
+                                                                           "Q"
+                                                                           n n
+                                                                           n
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul
+                                                         (f2cl-lib:int-sub n 1)
+                                                         (ilaenv 1 "DORGBR" "P"
+                                                          n n n -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum bdspac)))
+                    (setf maxwrk
+                            (f2cl-lib:int-add (f2cl-lib:int-mul 2 n n) wrkbl))
+                    (setf minwrk
+                            (max
+                             (the fixnum
+                                  (f2cl-lib:int-add (f2cl-lib:int-mul 3 n) m))
+                             (the fixnum bdspac)))
+                    (setf maxwrk
+                            (max (the fixnum maxwrk)
+                                 (the fixnum minwrk))))
+                   ((and wntua wntvas)
+                    (setf wrkbl
+                            (f2cl-lib:int-add n
+                                              (f2cl-lib:int-mul n
+                                                                (ilaenv 1
+                                                                 "DGEQRF" " " m
+                                                                 n -1 -1))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add n
+                                                        (f2cl-lib:int-mul m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGQR"
+                                                                           " "
+                                                                           m m
+                                                                           n
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul 2
+                                                                          n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DGEBRD"
+                                                                           " "
+                                                                           n n
+                                                                           -1
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGBR"
+                                                                           "Q"
+                                                                           n n
+                                                                           n
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                        (f2cl-lib:int-mul
+                                                         (f2cl-lib:int-sub n 1)
+                                                         (ilaenv 1 "DORGBR" "P"
+                                                          n n n -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum bdspac)))
+                    (setf maxwrk
+                            (f2cl-lib:int-add (f2cl-lib:int-mul n n) wrkbl))
+                    (setf minwrk
+                            (max
+                             (the fixnum
+                                  (f2cl-lib:int-add (f2cl-lib:int-mul 3 n) m))
+                             (the fixnum bdspac)))
+                    (setf maxwrk
+                            (max (the fixnum maxwrk)
+                                 (the fixnum minwrk))))))
+                (t
+                 (setf maxwrk
+                         (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                           (f2cl-lib:int-mul
+                                            (f2cl-lib:int-add m n)
+                                            (ilaenv 1 "DGEBRD" " " m n -1 -1))))
+                 (if (or wntus wntuo)
+                     (setf maxwrk
+                             (max (the fixnum maxwrk)
+                                  (the fixnum
+                                       (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                         (f2cl-lib:int-mul n
+                                                                           (ilaenv
+                                                                            1
+                                                                            "DORGBR"
+                                                                            "Q"
+                                                                            m n
+                                                                            n
+                                                                            -1)))))))
+                 (if wntua
+                     (setf maxwrk
+                             (max (the fixnum maxwrk)
+                                  (the fixnum
+                                       (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                         (f2cl-lib:int-mul m
+                                                                           (ilaenv
+                                                                            1
+                                                                            "DORGBR"
+                                                                            "Q"
+                                                                            m m
+                                                                            n
+                                                                            -1)))))))
+                 (if (not wntvn)
+                     (setf maxwrk
+                             (max (the fixnum maxwrk)
+                                  (the fixnum
+                                       (f2cl-lib:int-add (f2cl-lib:int-mul 3 n)
+                                                         (f2cl-lib:int-mul
+                                                          (f2cl-lib:int-sub n
+                                                                            1)
+                                                          (ilaenv 1 "DORGBR"
+                                                           "P" n n n -1)))))))
+                 (setf maxwrk
+                         (max (the fixnum maxwrk)
+                              (the fixnum bdspac)))
+                 (setf minwrk
+                         (max
+                          (the fixnum
+                               (f2cl-lib:int-add (f2cl-lib:int-mul 3 n) m))
+                          (the fixnum bdspac)))
+                 (setf maxwrk
+                         (max (the fixnum maxwrk)
+                              (the fixnum minwrk))))))
+             (t
+              (setf bdspac (f2cl-lib:int-mul 5 m))
+              (cond
+                ((>= n mnthr)
+                 (cond
+                   (wntvn
+                    (setf maxwrk
+                            (f2cl-lib:int-add m
+                                              (f2cl-lib:int-mul m
+                                                                (ilaenv 1
+                                                                 "DGELQF" " " m
+                                                                 n -1 -1))))
+                    (setf maxwrk
+                            (max (the fixnum maxwrk)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul 2
+                                                                          m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DGEBRD"
+                                                                           " "
+                                                                           m m
+                                                                           -1
+                                                                           -1))))))
+                    (if (or wntuo wntuas)
+                        (setf maxwrk
+                                (max (the fixnum maxwrk)
+                                     (the fixnum
+                                          (f2cl-lib:int-add
+                                           (f2cl-lib:int-mul 3 m)
+                                           (f2cl-lib:int-mul m
+                                                             (ilaenv 1 "DORGBR"
+                                                              "Q" m m m
+                                                              -1)))))))
+                    (setf maxwrk
+                            (max (the fixnum maxwrk)
+                                 (the fixnum bdspac)))
+                    (setf minwrk
+                            (max (the fixnum (f2cl-lib:int-mul 4 m))
+                                 (the fixnum bdspac)))
+                    (setf maxwrk
+                            (max (the fixnum maxwrk)
+                                 (the fixnum minwrk))))
+                   ((and wntvo wntun)
+                    (setf wrkbl
+                            (f2cl-lib:int-add m
+                                              (f2cl-lib:int-mul m
+                                                                (ilaenv 1
+                                                                 "DGELQF" " " m
+                                                                 n -1 -1))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add m
+                                                        (f2cl-lib:int-mul m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGLQ"
+                                                                           " "
+                                                                           m n
+                                                                           m
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul 2
+                                                                          m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DGEBRD"
+                                                                           " "
+                                                                           m m
+                                                                           -1
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul
+                                                         (f2cl-lib:int-sub m 1)
+                                                         (ilaenv 1 "DORGBR" "P"
+                                                          m m m -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum bdspac)))
+                    (setf maxwrk
+                            (max
+                             (the fixnum
+                                  (f2cl-lib:int-add (f2cl-lib:int-mul m m)
+                                                    wrkbl))
+                             (the fixnum
+                                  (f2cl-lib:int-add (f2cl-lib:int-mul m m)
+                                                    (f2cl-lib:int-mul m n)
+                                                    m))))
+                    (setf minwrk
+                            (max
+                             (the fixnum
+                                  (f2cl-lib:int-add (f2cl-lib:int-mul 3 m) n))
+                             (the fixnum bdspac)))
+                    (setf maxwrk
+                            (max (the fixnum maxwrk)
+                                 (the fixnum minwrk))))
+                   ((and wntvo wntuas)
+                    (setf wrkbl
+                            (f2cl-lib:int-add m
+                                              (f2cl-lib:int-mul m
+                                                                (ilaenv 1
+                                                                 "DGELQF" " " m
+                                                                 n -1 -1))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add m
+                                                        (f2cl-lib:int-mul m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGLQ"
+                                                                           " "
+                                                                           m n
+                                                                           m
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul 2
+                                                                          m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DGEBRD"
+                                                                           " "
+                                                                           m m
+                                                                           -1
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul
+                                                         (f2cl-lib:int-sub m 1)
+                                                         (ilaenv 1 "DORGBR" "P"
+                                                          m m m -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGBR"
+                                                                           "Q"
+                                                                           m m
+                                                                           m
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum bdspac)))
+                    (setf maxwrk
+                            (max
+                             (the fixnum
+                                  (f2cl-lib:int-add (f2cl-lib:int-mul m m)
+                                                    wrkbl))
+                             (the fixnum
+                                  (f2cl-lib:int-add (f2cl-lib:int-mul m m)
+                                                    (f2cl-lib:int-mul m n)
+                                                    m))))
+                    (setf minwrk
+                            (max
+                             (the fixnum
+                                  (f2cl-lib:int-add (f2cl-lib:int-mul 3 m) n))
+                             (the fixnum bdspac)))
+                    (setf maxwrk
+                            (max (the fixnum maxwrk)
+                                 (the fixnum minwrk))))
+                   ((and wntvs wntun)
+                    (setf wrkbl
+                            (f2cl-lib:int-add m
+                                              (f2cl-lib:int-mul m
+                                                                (ilaenv 1
+                                                                 "DGELQF" " " m
+                                                                 n -1 -1))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add m
+                                                        (f2cl-lib:int-mul m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGLQ"
+                                                                           " "
+                                                                           m n
+                                                                           m
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul 2
+                                                                          m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DGEBRD"
+                                                                           " "
+                                                                           m m
+                                                                           -1
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul
+                                                         (f2cl-lib:int-sub m 1)
+                                                         (ilaenv 1 "DORGBR" "P"
+                                                          m m m -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum bdspac)))
+                    (setf maxwrk
+                            (f2cl-lib:int-add (f2cl-lib:int-mul m m) wrkbl))
+                    (setf minwrk
+                            (max
+                             (the fixnum
+                                  (f2cl-lib:int-add (f2cl-lib:int-mul 3 m) n))
+                             (the fixnum bdspac)))
+                    (setf maxwrk
+                            (max (the fixnum maxwrk)
+                                 (the fixnum minwrk))))
+                   ((and wntvs wntuo)
+                    (setf wrkbl
+                            (f2cl-lib:int-add m
+                                              (f2cl-lib:int-mul m
+                                                                (ilaenv 1
+                                                                 "DGELQF" " " m
+                                                                 n -1 -1))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add m
+                                                        (f2cl-lib:int-mul m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGLQ"
+                                                                           " "
+                                                                           m n
+                                                                           m
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul 2
+                                                                          m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DGEBRD"
+                                                                           " "
+                                                                           m m
+                                                                           -1
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul
+                                                         (f2cl-lib:int-sub m 1)
+                                                         (ilaenv 1 "DORGBR" "P"
+                                                          m m m -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGBR"
+                                                                           "Q"
+                                                                           m m
+                                                                           m
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum bdspac)))
+                    (setf maxwrk
+                            (f2cl-lib:int-add (f2cl-lib:int-mul 2 m m) wrkbl))
+                    (setf minwrk
+                            (max
+                             (the fixnum
+                                  (f2cl-lib:int-add (f2cl-lib:int-mul 3 m) n))
+                             (the fixnum bdspac)))
+                    (setf maxwrk
+                            (max (the fixnum maxwrk)
+                                 (the fixnum minwrk))))
+                   ((and wntvs wntuas)
+                    (setf wrkbl
+                            (f2cl-lib:int-add m
+                                              (f2cl-lib:int-mul m
+                                                                (ilaenv 1
+                                                                 "DGELQF" " " m
+                                                                 n -1 -1))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add m
+                                                        (f2cl-lib:int-mul m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGLQ"
+                                                                           " "
+                                                                           m n
+                                                                           m
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul 2
+                                                                          m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DGEBRD"
+                                                                           " "
+                                                                           m m
+                                                                           -1
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul
+                                                         (f2cl-lib:int-sub m 1)
+                                                         (ilaenv 1 "DORGBR" "P"
+                                                          m m m -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGBR"
+                                                                           "Q"
+                                                                           m m
+                                                                           m
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum bdspac)))
+                    (setf maxwrk
+                            (f2cl-lib:int-add (f2cl-lib:int-mul m m) wrkbl))
+                    (setf minwrk
+                            (max
+                             (the fixnum
+                                  (f2cl-lib:int-add (f2cl-lib:int-mul 3 m) n))
+                             (the fixnum bdspac)))
+                    (setf maxwrk
+                            (max (the fixnum maxwrk)
+                                 (the fixnum minwrk))))
+                   ((and wntva wntun)
+                    (setf wrkbl
+                            (f2cl-lib:int-add m
+                                              (f2cl-lib:int-mul m
+                                                                (ilaenv 1
+                                                                 "DGELQF" " " m
+                                                                 n -1 -1))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add m
+                                                        (f2cl-lib:int-mul n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGLQ"
+                                                                           " "
+                                                                           n n
+                                                                           m
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul 2
+                                                                          m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DGEBRD"
+                                                                           " "
+                                                                           m m
+                                                                           -1
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul
+                                                         (f2cl-lib:int-sub m 1)
+                                                         (ilaenv 1 "DORGBR" "P"
+                                                          m m m -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum bdspac)))
+                    (setf maxwrk
+                            (f2cl-lib:int-add (f2cl-lib:int-mul m m) wrkbl))
+                    (setf minwrk
+                            (max
+                             (the fixnum
+                                  (f2cl-lib:int-add (f2cl-lib:int-mul 3 m) n))
+                             (the fixnum bdspac)))
+                    (setf maxwrk
+                            (max (the fixnum maxwrk)
+                                 (the fixnum minwrk))))
+                   ((and wntva wntuo)
+                    (setf wrkbl
+                            (f2cl-lib:int-add m
+                                              (f2cl-lib:int-mul m
+                                                                (ilaenv 1
+                                                                 "DGELQF" " " m
+                                                                 n -1 -1))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add m
+                                                        (f2cl-lib:int-mul n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGLQ"
+                                                                           " "
+                                                                           n n
+                                                                           m
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul 2
+                                                                          m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DGEBRD"
+                                                                           " "
+                                                                           m m
+                                                                           -1
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul
+                                                         (f2cl-lib:int-sub m 1)
+                                                         (ilaenv 1 "DORGBR" "P"
+                                                          m m m -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGBR"
+                                                                           "Q"
+                                                                           m m
+                                                                           m
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum bdspac)))
+                    (setf maxwrk
+                            (f2cl-lib:int-add (f2cl-lib:int-mul 2 m m) wrkbl))
+                    (setf minwrk
+                            (max
+                             (the fixnum
+                                  (f2cl-lib:int-add (f2cl-lib:int-mul 3 m) n))
+                             (the fixnum bdspac)))
+                    (setf maxwrk
+                            (max (the fixnum maxwrk)
+                                 (the fixnum minwrk))))
+                   ((and wntva wntuas)
+                    (setf wrkbl
+                            (f2cl-lib:int-add m
+                                              (f2cl-lib:int-mul m
+                                                                (ilaenv 1
+                                                                 "DGELQF" " " m
+                                                                 n -1 -1))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add m
+                                                        (f2cl-lib:int-mul n
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGLQ"
+                                                                           " "
+                                                                           n n
+                                                                           m
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul 2
+                                                                          m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DGEBRD"
+                                                                           " "
+                                                                           m m
+                                                                           -1
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul
+                                                         (f2cl-lib:int-sub m 1)
+                                                         (ilaenv 1 "DORGBR" "P"
+                                                          m m m -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                        (f2cl-lib:int-mul m
+                                                                          (ilaenv
+                                                                           1
+                                                                           "DORGBR"
+                                                                           "Q"
+                                                                           m m
+                                                                           m
+                                                                           -1))))))
+                    (setf wrkbl
+                            (max (the fixnum wrkbl)
+                                 (the fixnum bdspac)))
+                    (setf maxwrk
+                            (f2cl-lib:int-add (f2cl-lib:int-mul m m) wrkbl))
+                    (setf minwrk
+                            (max
+                             (the fixnum
+                                  (f2cl-lib:int-add (f2cl-lib:int-mul 3 m) n))
+                             (the fixnum bdspac)))
+                    (setf maxwrk
+                            (max (the fixnum maxwrk)
+                                 (the fixnum minwrk))))))
+                (t
+                 (setf maxwrk
+                         (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                           (f2cl-lib:int-mul
+                                            (f2cl-lib:int-add m n)
+                                            (ilaenv 1 "DGEBRD" " " m n -1 -1))))
+                 (if (or wntvs wntvo)
+                     (setf maxwrk
+                             (max (the fixnum maxwrk)
+                                  (the fixnum
+                                       (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                         (f2cl-lib:int-mul m
+                                                                           (ilaenv
+                                                                            1
+                                                                            "DORGBR"
+                                                                            "P"
+                                                                            m n
+                                                                            m
+                                                                            -1)))))))
+                 (if wntva
+                     (setf maxwrk
+                             (max (the fixnum maxwrk)
+                                  (the fixnum
+                                       (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                         (f2cl-lib:int-mul n
+                                                                           (ilaenv
+                                                                            1
+                                                                            "DORGBR"
+                                                                            "P"
+                                                                            n n
+                                                                            m
+                                                                            -1)))))))
+                 (if (not wntun)
+                     (setf maxwrk
+                             (max (the fixnum maxwrk)
+                                  (the fixnum
+                                       (f2cl-lib:int-add (f2cl-lib:int-mul 3 m)
+                                                         (f2cl-lib:int-mul
+                                                          (f2cl-lib:int-sub m
+                                                                            1)
+                                                          (ilaenv 1 "DORGBR"
+                                                           "Q" m m m -1)))))))
+                 (setf maxwrk
+                         (max (the fixnum maxwrk)
+                              (the fixnum bdspac)))
+                 (setf minwrk
+                         (max
+                          (the fixnum
+                               (f2cl-lib:int-add (f2cl-lib:int-mul 3 m) n))
+                          (the fixnum bdspac)))
+                 (setf maxwrk
+                         (max (the fixnum maxwrk)
+                              (the fixnum minwrk)))))))
+           (setf (f2cl-lib:fref work-%data% (1) ((1 *)) work-%offset%)
+                   (coerce (the fixnum maxwrk) 'double-float))))
+        (cond
+          ((and (< lwork minwrk) (not lquery))
+           (setf info -13)))
+        (cond
+          ((/= info 0)
+           (xerbla "DGESVD" (f2cl-lib:int-sub info))
+           (go end_label))
+          (lquery
+           (go end_label)))
+        (cond
+          ((or (= m 0) (= n 0))
+           (if (>= lwork 1)
+               (setf (f2cl-lib:fref work-%data% (1) ((1 *)) work-%offset%) one))
+           (go end_label)))
+        (setf eps (dlamch "P"))
+        (setf smlnum (/ (f2cl-lib:fsqrt (dlamch "S")) eps))
+        (setf bignum (/ one smlnum))
+        (setf anrm (dlange "M" m n a lda dum))
+        (setf iscl 0)
+        (cond
+          ((and (> anrm zero) (< anrm smlnum))
+           (setf iscl 1)
+           (multiple-value-bind
+                 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9)
+               (dlascl "G" 0 0 anrm smlnum m n a lda ierr)
+             (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8))
+             (setf ierr var-9)))
+          ((> anrm bignum)
+           (setf iscl 1)
+           (multiple-value-bind
+                 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9)
+               (dlascl "G" 0 0 anrm bignum m n a lda ierr)
+             (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8))
+             (setf ierr var-9))))
+        (cond
+          ((>= m n)
+           (cond
+             ((>= m mnthr)
+              (cond
+                (wntun
+                 (setf itau 1)
+                 (setf iwork (f2cl-lib:int-add itau n))
+                 (multiple-value-bind
+                       (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                     (dgeqrf m n a lda
+                      (f2cl-lib:array-slice work double-float (itau) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (iwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6))
+                   (setf ierr var-7))
+                 (dlaset "L" (f2cl-lib:int-sub n 1) (f2cl-lib:int-sub n 1) zero
+                  zero
+                  (f2cl-lib:array-slice a double-float (2 1) ((1 lda) (1 *)))
+                  lda)
+                 (setf ie 1)
+                 (setf itauq (f2cl-lib:int-add ie n))
+                 (setf itaup (f2cl-lib:int-add itauq n))
+                 (setf iwork (f2cl-lib:int-add itaup 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)
+                     (dgebrd n n a lda s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (itauq) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (itaup) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (iwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                    var-7 var-8 var-9))
+                   (setf ierr var-10))
+                 (setf ncvt 0)
+                 (cond
+                   ((or wntvo wntvas)
+                    (multiple-value-bind
+                          (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                           var-8 var-9)
+                        (dorgbr "P" n n n a lda
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itaup)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6 var-7 var-8))
+                      (setf ierr var-9))
+                    (setf ncvt n)))
+                 (setf iwork (f2cl-lib:int-add ie 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 var-13 var-14)
+                     (dbdsqr "U" n ncvt 0 0 s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *))) a
+                      lda dum 1 dum 1
+                      (f2cl-lib:array-slice work double-float (iwork) ((1 *)))
+                      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))
+                   (setf info var-14))
+                 (if wntvas (dlacpy "F" n n a lda vt ldvt)))
+                ((and wntuo wntvn)
+                 (cond
+                   ((>= lwork
+                        (f2cl-lib:int-add (f2cl-lib:int-mul n n)
+                                          (max
+                                           (the fixnum
+                                                (f2cl-lib:int-mul 4 n))
+                                           (the fixnum bdspac))))
+                    (setf ir 1)
+                    (cond
+                      ((>= lwork
+                           (f2cl-lib:int-add
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add
+                                       (f2cl-lib:int-mul lda n)
+                                       n)))
+                            (f2cl-lib:int-mul lda n)))
+                       (setf ldwrku lda)
+                       (setf ldwrkr lda))
+                      ((>= lwork
+                           (f2cl-lib:int-add
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add
+                                       (f2cl-lib:int-mul lda n)
+                                       n)))
+                            (f2cl-lib:int-mul n n)))
+                       (setf ldwrku lda)
+                       (setf ldwrkr n))
+                      (t
+                       (setf ldwrku
+                               (the fixnum
+                                    (truncate (- lwork (* n n) n) n)))
+                       (setf ldwrkr n)))
+                    (setf itau
+                            (f2cl-lib:int-add ir (f2cl-lib:int-mul ldwrkr n)))
+                    (setf iwork (f2cl-lib:int-add itau n))
+                    (multiple-value-bind
+                          (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                        (dgeqrf m n a lda
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itau)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6))
+                      (setf ierr var-7))
+                    (dlacpy "U" n n a lda
+                     (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                     ldwrkr)
+                    (dlaset "L" (f2cl-lib:int-sub n 1) (f2cl-lib:int-sub n 1)
+                     zero zero
+                     (f2cl-lib:array-slice work
+                                           double-float
+                                           ((+ ir 1))
+                                           ((1 *)))
+                     ldwrkr)
+                    (multiple-value-bind
+                          (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                           var-8)
+                        (dorgqr m n n a lda
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itau)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6 var-7))
+                      (setf ierr var-8))
+                    (setf ie itau)
+                    (setf itauq (f2cl-lib:int-add ie n))
+                    (setf itaup (f2cl-lib:int-add itauq n))
+                    (setf iwork (f2cl-lib:int-add itaup 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)
+                        (dgebrd n n
+                         (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                         ldwrkr s
+                         (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itauq)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itaup)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6 var-7 var-8 var-9))
+                      (setf ierr var-10))
+                    (multiple-value-bind
+                          (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                           var-8 var-9)
+                        (dorgbr "Q" n n n
+                         (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                         ldwrkr
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itauq)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6 var-7 var-8))
+                      (setf ierr var-9))
+                    (setf iwork (f2cl-lib:int-add ie 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 var-13 var-14)
+                        (dbdsqr "U" n 0 n 0 s
+                         (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                         dum 1
+                         (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                         ldwrkr dum 1
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         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))
+                      (setf info var-14))
+                    (setf iu (f2cl-lib:int-add ie n))
+                    (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i ldwrku))
+                                  ((> i m) nil)
+                      (tagbody
+                        (setf chunk
+                                (min
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-sub m i)
+                                                        1))
+                                 (the fixnum ldwrku)))
+                        (dgemm "N" "N" chunk n n one
+                         (f2cl-lib:array-slice a
+                                               double-float
+                                               (i 1)
+                                               ((1 lda) (1 *)))
+                         lda
+                         (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                         ldwrkr zero
+                         (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                         ldwrku)
+                        (dlacpy "F" chunk n
+                         (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                         ldwrku
+                         (f2cl-lib:array-slice a
+                                               double-float
+                                               (i 1)
+                                               ((1 lda) (1 *)))
+                         lda))))
+                   (t
+                    (setf ie 1)
+                    (setf itauq (f2cl-lib:int-add ie n))
+                    (setf itaup (f2cl-lib:int-add itauq n))
+                    (setf iwork (f2cl-lib:int-add itaup 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)
+                        (dgebrd m n a lda s
+                         (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itauq)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itaup)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6 var-7 var-8 var-9))
+                      (setf ierr var-10))
+                    (multiple-value-bind
+                          (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                           var-8 var-9)
+                        (dorgbr "Q" m n n a lda
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itauq)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6 var-7 var-8))
+                      (setf ierr var-9))
+                    (setf iwork (f2cl-lib:int-add ie 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 var-13 var-14)
+                        (dbdsqr "U" n 0 m 0 s
+                         (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                         dum 1 a lda dum 1
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         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))
+                      (setf info var-14)))))
+                ((and wntuo wntvas)
+                 (cond
+                   ((>= lwork
+                        (f2cl-lib:int-add (f2cl-lib:int-mul n n)
+                                          (max
+                                           (the fixnum
+                                                (f2cl-lib:int-mul 4 n))
+                                           (the fixnum bdspac))))
+                    (setf ir 1)
+                    (cond
+                      ((>= lwork
+                           (f2cl-lib:int-add
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add
+                                       (f2cl-lib:int-mul lda n)
+                                       n)))
+                            (f2cl-lib:int-mul lda n)))
+                       (setf ldwrku lda)
+                       (setf ldwrkr lda))
+                      ((>= lwork
+                           (f2cl-lib:int-add
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add
+                                       (f2cl-lib:int-mul lda n)
+                                       n)))
+                            (f2cl-lib:int-mul n n)))
+                       (setf ldwrku lda)
+                       (setf ldwrkr n))
+                      (t
+                       (setf ldwrku
+                               (the fixnum
+                                    (truncate (- lwork (* n n) n) n)))
+                       (setf ldwrkr n)))
+                    (setf itau
+                            (f2cl-lib:int-add ir (f2cl-lib:int-mul ldwrkr n)))
+                    (setf iwork (f2cl-lib:int-add itau n))
+                    (multiple-value-bind
+                          (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                        (dgeqrf m n a lda
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itau)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6))
+                      (setf ierr var-7))
+                    (dlacpy "U" n n a lda vt ldvt)
+                    (dlaset "L" (f2cl-lib:int-sub n 1) (f2cl-lib:int-sub n 1)
+                     zero zero
+                     (f2cl-lib:array-slice vt
+                                           double-float
+                                           (2 1)
+                                           ((1 ldvt) (1 *)))
+                     ldvt)
+                    (multiple-value-bind
+                          (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                           var-8)
+                        (dorgqr m n n a lda
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itau)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6 var-7))
+                      (setf ierr var-8))
+                    (setf ie itau)
+                    (setf itauq (f2cl-lib:int-add ie n))
+                    (setf itaup (f2cl-lib:int-add itauq n))
+                    (setf iwork (f2cl-lib:int-add itaup 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)
+                        (dgebrd n n vt ldvt s
+                         (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itauq)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itaup)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6 var-7 var-8 var-9))
+                      (setf ierr var-10))
+                    (dlacpy "L" n n vt ldvt
+                     (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                     ldwrkr)
+                    (multiple-value-bind
+                          (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                           var-8 var-9)
+                        (dorgbr "Q" n n n
+                         (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                         ldwrkr
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itauq)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6 var-7 var-8))
+                      (setf ierr var-9))
+                    (multiple-value-bind
+                          (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                           var-8 var-9)
+                        (dorgbr "P" n n n vt ldvt
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itaup)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6 var-7 var-8))
+                      (setf ierr var-9))
+                    (setf iwork (f2cl-lib:int-add ie 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 var-13 var-14)
+                        (dbdsqr "U" n n n 0 s
+                         (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                         vt ldvt
+                         (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                         ldwrkr dum 1
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         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))
+                      (setf info var-14))
+                    (setf iu (f2cl-lib:int-add ie n))
+                    (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i ldwrku))
+                                  ((> i m) nil)
+                      (tagbody
+                        (setf chunk
+                                (min
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-sub m i)
+                                                        1))
+                                 (the fixnum ldwrku)))
+                        (dgemm "N" "N" chunk n n one
+                         (f2cl-lib:array-slice a
+                                               double-float
+                                               (i 1)
+                                               ((1 lda) (1 *)))
+                         lda
+                         (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                         ldwrkr zero
+                         (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                         ldwrku)
+                        (dlacpy "F" chunk n
+                         (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                         ldwrku
+                         (f2cl-lib:array-slice a
+                                               double-float
+                                               (i 1)
+                                               ((1 lda) (1 *)))
+                         lda))))
+                   (t
+                    (setf itau 1)
+                    (setf iwork (f2cl-lib:int-add itau n))
+                    (multiple-value-bind
+                          (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                        (dgeqrf m n a lda
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itau)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6))
+                      (setf ierr var-7))
+                    (dlacpy "U" n n a lda vt ldvt)
+                    (dlaset "L" (f2cl-lib:int-sub n 1) (f2cl-lib:int-sub n 1)
+                     zero zero
+                     (f2cl-lib:array-slice vt
+                                           double-float
+                                           (2 1)
+                                           ((1 ldvt) (1 *)))
+                     ldvt)
+                    (multiple-value-bind
+                          (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                           var-8)
+                        (dorgqr m n n a lda
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itau)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6 var-7))
+                      (setf ierr var-8))
+                    (setf ie itau)
+                    (setf itauq (f2cl-lib:int-add ie n))
+                    (setf itaup (f2cl-lib:int-add itauq n))
+                    (setf iwork (f2cl-lib:int-add itaup 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)
+                        (dgebrd n n vt ldvt s
+                         (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itauq)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itaup)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6 var-7 var-8 var-9))
+                      (setf ierr var-10))
+                    (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)
+                        (dormbr "Q" "R" "N" m n n vt ldvt
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itauq)
+                                               ((1 *)))
+                         a lda
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (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))
+                      (setf ierr var-13))
+                    (multiple-value-bind
+                          (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                           var-8 var-9)
+                        (dorgbr "P" n n n vt ldvt
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itaup)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6 var-7 var-8))
+                      (setf ierr var-9))
+                    (setf iwork (f2cl-lib:int-add ie 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 var-13 var-14)
+                        (dbdsqr "U" n n m 0 s
+                         (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                         vt ldvt a lda dum 1
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         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))
+                      (setf info var-14)))))
+                (wntus
+                 (cond
+                   (wntvn
+                    (cond
+                      ((>= lwork
+                           (f2cl-lib:int-add (f2cl-lib:int-mul n n)
+                                             (max
+                                              (the fixnum
+                                                   (f2cl-lib:int-mul 4 n))
+                                              (the fixnum bdspac))))
+                       (setf ir 1)
+                       (cond
+                         ((>= lwork
+                              (f2cl-lib:int-add wrkbl (f2cl-lib:int-mul lda n)))
+                          (setf ldwrkr lda))
+                         (t
+                          (setf ldwrkr n)))
+                       (setf itau
+                               (f2cl-lib:int-add ir
+                                                 (f2cl-lib:int-mul ldwrkr n)))
+                       (setf iwork (f2cl-lib:int-add itau n))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                           (dgeqrf m n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6))
+                         (setf ierr var-7))
+                       (dlacpy "U" n n a lda
+                        (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                        ldwrkr)
+                       (dlaset "L" (f2cl-lib:int-sub n 1)
+                        (f2cl-lib:int-sub n 1) zero zero
+                        (f2cl-lib:array-slice work
+                                              double-float
+                                              ((+ ir 1))
+                                              ((1 *)))
+                        ldwrkr)
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8)
+                           (dorgqr m n n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7))
+                         (setf ierr var-8))
+                       (setf ie itau)
+                       (setf itauq (f2cl-lib:int-add ie n))
+                       (setf itaup (f2cl-lib:int-add itauq n))
+                       (setf iwork (f2cl-lib:int-add itaup 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)
+                           (dgebrd n n
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ir)
+                                                  ((1 *)))
+                            ldwrkr s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8 var-9))
+                         (setf ierr var-10))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8 var-9)
+                           (dorgbr "Q" n n n
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ir)
+                                                  ((1 *)))
+                            ldwrkr
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8))
+                         (setf ierr var-9))
+                       (setf iwork (f2cl-lib:int-add ie 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 var-13 var-14)
+                           (dbdsqr "U" n 0 n 0 s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            dum 1
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ir)
+                                                  ((1 *)))
+                            ldwrkr dum 1
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            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))
+                         (setf info var-14))
+                       (dgemm "N" "N" m n n one a lda
+                        (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                        ldwrkr zero u ldu))
+                      (t
+                       (setf itau 1)
+                       (setf iwork (f2cl-lib:int-add itau n))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                           (dgeqrf m n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6))
+                         (setf ierr var-7))
+                       (dlacpy "L" m n a lda u ldu)
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8)
+                           (dorgqr m n n u ldu
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7))
+                         (setf ierr var-8))
+                       (setf ie itau)
+                       (setf itauq (f2cl-lib:int-add ie n))
+                       (setf itaup (f2cl-lib:int-add itauq n))
+                       (setf iwork (f2cl-lib:int-add itaup n))
+                       (dlaset "L" (f2cl-lib:int-sub n 1)
+                        (f2cl-lib:int-sub n 1) zero zero
+                        (f2cl-lib:array-slice a
+                                              double-float
+                                              (2 1)
+                                              ((1 lda) (1 *)))
+                        lda)
+                       (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)
+                           (dgebrd n n a lda s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8 var-9))
+                         (setf ierr var-10))
+                       (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)
+                           (dormbr "Q" "R" "N" m n n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            u ldu
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (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))
+                         (setf ierr var-13))
+                       (setf iwork (f2cl-lib:int-add ie 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 var-13 var-14)
+                           (dbdsqr "U" n 0 m 0 s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            dum 1 u ldu dum 1
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            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))
+                         (setf info var-14)))))
+                   (wntvo
+                    (cond
+                      ((>= lwork
+                           (f2cl-lib:int-add (f2cl-lib:int-mul 2 n n)
+                                             (max
+                                              (the fixnum
+                                                   (f2cl-lib:int-mul 4 n))
+                                              (the fixnum bdspac))))
+                       (setf iu 1)
+                       (cond
+                         ((>= lwork
+                              (f2cl-lib:int-add wrkbl
+                                                (f2cl-lib:int-mul 2 lda n)))
+                          (setf ldwrku lda)
+                          (setf ir
+                                  (f2cl-lib:int-add iu
+                                                    (f2cl-lib:int-mul ldwrku
+                                                                      n)))
+                          (setf ldwrkr lda))
+                         ((>= lwork
+                              (f2cl-lib:int-add wrkbl
+                                                (f2cl-lib:int-mul
+                                                 (f2cl-lib:int-add lda n)
+                                                 n)))
+                          (setf ldwrku lda)
+                          (setf ir
+                                  (f2cl-lib:int-add iu
+                                                    (f2cl-lib:int-mul ldwrku
+                                                                      n)))
+                          (setf ldwrkr n))
+                         (t
+                          (setf ldwrku n)
+                          (setf ir
+                                  (f2cl-lib:int-add iu
+                                                    (f2cl-lib:int-mul ldwrku
+                                                                      n)))
+                          (setf ldwrkr n)))
+                       (setf itau
+                               (f2cl-lib:int-add ir
+                                                 (f2cl-lib:int-mul ldwrkr n)))
+                       (setf iwork (f2cl-lib:int-add itau n))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                           (dgeqrf m n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6))
+                         (setf ierr var-7))
+                       (dlacpy "U" n n a lda
+                        (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                        ldwrku)
+                       (dlaset "L" (f2cl-lib:int-sub n 1)
+                        (f2cl-lib:int-sub n 1) zero zero
+                        (f2cl-lib:array-slice work
+                                              double-float
+                                              ((+ iu 1))
+                                              ((1 *)))
+                        ldwrku)
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8)
+                           (dorgqr m n n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7))
+                         (setf ierr var-8))
+                       (setf ie itau)
+                       (setf itauq (f2cl-lib:int-add ie n))
+                       (setf itaup (f2cl-lib:int-add itauq n))
+                       (setf iwork (f2cl-lib:int-add itaup 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)
+                           (dgebrd n n
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iu)
+                                                  ((1 *)))
+                            ldwrku s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8 var-9))
+                         (setf ierr var-10))
+                       (dlacpy "U" n n
+                        (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                        ldwrku
+                        (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                        ldwrkr)
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8 var-9)
+                           (dorgbr "Q" n n n
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iu)
+                                                  ((1 *)))
+                            ldwrku
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8))
+                         (setf ierr var-9))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8 var-9)
+                           (dorgbr "P" n n n
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ir)
+                                                  ((1 *)))
+                            ldwrkr
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8))
+                         (setf ierr var-9))
+                       (setf iwork (f2cl-lib:int-add ie 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 var-13 var-14)
+                           (dbdsqr "U" n n n 0 s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ir)
+                                                  ((1 *)))
+                            ldwrkr
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iu)
+                                                  ((1 *)))
+                            ldwrku dum 1
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            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))
+                         (setf info var-14))
+                       (dgemm "N" "N" m n n one a lda
+                        (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                        ldwrku zero u ldu)
+                       (dlacpy "F" n n
+                        (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                        ldwrkr a lda))
+                      (t
+                       (setf itau 1)
+                       (setf iwork (f2cl-lib:int-add itau n))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                           (dgeqrf m n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6))
+                         (setf ierr var-7))
+                       (dlacpy "L" m n a lda u ldu)
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8)
+                           (dorgqr m n n u ldu
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7))
+                         (setf ierr var-8))
+                       (setf ie itau)
+                       (setf itauq (f2cl-lib:int-add ie n))
+                       (setf itaup (f2cl-lib:int-add itauq n))
+                       (setf iwork (f2cl-lib:int-add itaup n))
+                       (dlaset "L" (f2cl-lib:int-sub n 1)
+                        (f2cl-lib:int-sub n 1) zero zero
+                        (f2cl-lib:array-slice a
+                                              double-float
+                                              (2 1)
+                                              ((1 lda) (1 *)))
+                        lda)
+                       (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)
+                           (dgebrd n n a lda s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8 var-9))
+                         (setf ierr var-10))
+                       (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)
+                           (dormbr "Q" "R" "N" m n n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            u ldu
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (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))
+                         (setf ierr var-13))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8 var-9)
+                           (dorgbr "P" n n n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8))
+                         (setf ierr var-9))
+                       (setf iwork (f2cl-lib:int-add ie 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 var-13 var-14)
+                           (dbdsqr "U" n n m 0 s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            a lda u ldu dum 1
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            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))
+                         (setf info var-14)))))
+                   (wntvas
+                    (cond
+                      ((>= lwork
+                           (f2cl-lib:int-add (f2cl-lib:int-mul n n)
+                                             (max
+                                              (the fixnum
+                                                   (f2cl-lib:int-mul 4 n))
+                                              (the fixnum bdspac))))
+                       (setf iu 1)
+                       (cond
+                         ((>= lwork
+                              (f2cl-lib:int-add wrkbl (f2cl-lib:int-mul lda n)))
+                          (setf ldwrku lda))
+                         (t
+                          (setf ldwrku n)))
+                       (setf itau
+                               (f2cl-lib:int-add iu
+                                                 (f2cl-lib:int-mul ldwrku n)))
+                       (setf iwork (f2cl-lib:int-add itau n))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                           (dgeqrf m n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6))
+                         (setf ierr var-7))
+                       (dlacpy "U" n n a lda
+                        (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                        ldwrku)
+                       (dlaset "L" (f2cl-lib:int-sub n 1)
+                        (f2cl-lib:int-sub n 1) zero zero
+                        (f2cl-lib:array-slice work
+                                              double-float
+                                              ((+ iu 1))
+                                              ((1 *)))
+                        ldwrku)
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8)
+                           (dorgqr m n n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7))
+                         (setf ierr var-8))
+                       (setf ie itau)
+                       (setf itauq (f2cl-lib:int-add ie n))
+                       (setf itaup (f2cl-lib:int-add itauq n))
+                       (setf iwork (f2cl-lib:int-add itaup 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)
+                           (dgebrd n n
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iu)
+                                                  ((1 *)))
+                            ldwrku s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8 var-9))
+                         (setf ierr var-10))
+                       (dlacpy "U" n n
+                        (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                        ldwrku vt ldvt)
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8 var-9)
+                           (dorgbr "Q" n n n
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iu)
+                                                  ((1 *)))
+                            ldwrku
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8))
+                         (setf ierr var-9))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8 var-9)
+                           (dorgbr "P" n n n vt ldvt
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8))
+                         (setf ierr var-9))
+                       (setf iwork (f2cl-lib:int-add ie 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 var-13 var-14)
+                           (dbdsqr "U" n n n 0 s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            vt ldvt
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iu)
+                                                  ((1 *)))
+                            ldwrku dum 1
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            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))
+                         (setf info var-14))
+                       (dgemm "N" "N" m n n one a lda
+                        (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                        ldwrku zero u ldu))
+                      (t
+                       (setf itau 1)
+                       (setf iwork (f2cl-lib:int-add itau n))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                           (dgeqrf m n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6))
+                         (setf ierr var-7))
+                       (dlacpy "L" m n a lda u ldu)
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8)
+                           (dorgqr m n n u ldu
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7))
+                         (setf ierr var-8))
+                       (dlacpy "U" n n a lda vt ldvt)
+                       (dlaset "L" (f2cl-lib:int-sub n 1)
+                        (f2cl-lib:int-sub n 1) zero zero
+                        (f2cl-lib:array-slice vt
+                                              double-float
+                                              (2 1)
+                                              ((1 ldvt) (1 *)))
+                        ldvt)
+                       (setf ie itau)
+                       (setf itauq (f2cl-lib:int-add ie n))
+                       (setf itaup (f2cl-lib:int-add itauq n))
+                       (setf iwork (f2cl-lib:int-add itaup 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)
+                           (dgebrd n n vt ldvt s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8 var-9))
+                         (setf ierr var-10))
+                       (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)
+                           (dormbr "Q" "R" "N" m n n vt ldvt
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            u ldu
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (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))
+                         (setf ierr var-13))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8 var-9)
+                           (dorgbr "P" n n n vt ldvt
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8))
+                         (setf ierr var-9))
+                       (setf iwork (f2cl-lib:int-add ie 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 var-13 var-14)
+                           (dbdsqr "U" n n m 0 s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            vt ldvt u ldu dum 1
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            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))
+                         (setf info var-14)))))))
+                (wntua
+                 (cond
+                   (wntvn
+                    (cond
+                      ((>= lwork
+                           (f2cl-lib:int-add (f2cl-lib:int-mul n n)
+                                             (max
+                                              (the fixnum
+                                                   (f2cl-lib:int-add n m))
+                                              (the fixnum
+                                                   (f2cl-lib:int-mul 4 n))
+                                              (the fixnum bdspac))))
+                       (setf ir 1)
+                       (cond
+                         ((>= lwork
+                              (f2cl-lib:int-add wrkbl (f2cl-lib:int-mul lda n)))
+                          (setf ldwrkr lda))
+                         (t
+                          (setf ldwrkr n)))
+                       (setf itau
+                               (f2cl-lib:int-add ir
+                                                 (f2cl-lib:int-mul ldwrkr n)))
+                       (setf iwork (f2cl-lib:int-add itau n))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                           (dgeqrf m n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6))
+                         (setf ierr var-7))
+                       (dlacpy "L" m n a lda u ldu)
+                       (dlacpy "U" n n a lda
+                        (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                        ldwrkr)
+                       (dlaset "L" (f2cl-lib:int-sub n 1)
+                        (f2cl-lib:int-sub n 1) zero zero
+                        (f2cl-lib:array-slice work
+                                              double-float
+                                              ((+ ir 1))
+                                              ((1 *)))
+                        ldwrkr)
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8)
+                           (dorgqr m m n u ldu
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7))
+                         (setf ierr var-8))
+                       (setf ie itau)
+                       (setf itauq (f2cl-lib:int-add ie n))
+                       (setf itaup (f2cl-lib:int-add itauq n))
+                       (setf iwork (f2cl-lib:int-add itaup 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)
+                           (dgebrd n n
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ir)
+                                                  ((1 *)))
+                            ldwrkr s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8 var-9))
+                         (setf ierr var-10))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8 var-9)
+                           (dorgbr "Q" n n n
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ir)
+                                                  ((1 *)))
+                            ldwrkr
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8))
+                         (setf ierr var-9))
+                       (setf iwork (f2cl-lib:int-add ie 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 var-13 var-14)
+                           (dbdsqr "U" n 0 n 0 s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            dum 1
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ir)
+                                                  ((1 *)))
+                            ldwrkr dum 1
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            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))
+                         (setf info var-14))
+                       (dgemm "N" "N" m n n one u ldu
+                        (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                        ldwrkr zero a lda)
+                       (dlacpy "F" m n a lda u ldu))
+                      (t
+                       (setf itau 1)
+                       (setf iwork (f2cl-lib:int-add itau n))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                           (dgeqrf m n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6))
+                         (setf ierr var-7))
+                       (dlacpy "L" m n a lda u ldu)
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8)
+                           (dorgqr m m n u ldu
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7))
+                         (setf ierr var-8))
+                       (setf ie itau)
+                       (setf itauq (f2cl-lib:int-add ie n))
+                       (setf itaup (f2cl-lib:int-add itauq n))
+                       (setf iwork (f2cl-lib:int-add itaup n))
+                       (dlaset "L" (f2cl-lib:int-sub n 1)
+                        (f2cl-lib:int-sub n 1) zero zero
+                        (f2cl-lib:array-slice a
+                                              double-float
+                                              (2 1)
+                                              ((1 lda) (1 *)))
+                        lda)
+                       (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)
+                           (dgebrd n n a lda s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8 var-9))
+                         (setf ierr var-10))
+                       (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)
+                           (dormbr "Q" "R" "N" m n n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            u ldu
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (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))
+                         (setf ierr var-13))
+                       (setf iwork (f2cl-lib:int-add ie 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 var-13 var-14)
+                           (dbdsqr "U" n 0 m 0 s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            dum 1 u ldu dum 1
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            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))
+                         (setf info var-14)))))
+                   (wntvo
+                    (cond
+                      ((>= lwork
+                           (f2cl-lib:int-add (f2cl-lib:int-mul 2 n n)
+                                             (max
+                                              (the fixnum
+                                                   (f2cl-lib:int-add n m))
+                                              (the fixnum
+                                                   (f2cl-lib:int-mul 4 n))
+                                              (the fixnum bdspac))))
+                       (setf iu 1)
+                       (cond
+                         ((>= lwork
+                              (f2cl-lib:int-add wrkbl
+                                                (f2cl-lib:int-mul 2 lda n)))
+                          (setf ldwrku lda)
+                          (setf ir
+                                  (f2cl-lib:int-add iu
+                                                    (f2cl-lib:int-mul ldwrku
+                                                                      n)))
+                          (setf ldwrkr lda))
+                         ((>= lwork
+                              (f2cl-lib:int-add wrkbl
+                                                (f2cl-lib:int-mul
+                                                 (f2cl-lib:int-add lda n)
+                                                 n)))
+                          (setf ldwrku lda)
+                          (setf ir
+                                  (f2cl-lib:int-add iu
+                                                    (f2cl-lib:int-mul ldwrku
+                                                                      n)))
+                          (setf ldwrkr n))
+                         (t
+                          (setf ldwrku n)
+                          (setf ir
+                                  (f2cl-lib:int-add iu
+                                                    (f2cl-lib:int-mul ldwrku
+                                                                      n)))
+                          (setf ldwrkr n)))
+                       (setf itau
+                               (f2cl-lib:int-add ir
+                                                 (f2cl-lib:int-mul ldwrkr n)))
+                       (setf iwork (f2cl-lib:int-add itau n))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                           (dgeqrf m n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6))
+                         (setf ierr var-7))
+                       (dlacpy "L" m n a lda u ldu)
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8)
+                           (dorgqr m m n u ldu
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7))
+                         (setf ierr var-8))
+                       (dlacpy "U" n n a lda
+                        (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                        ldwrku)
+                       (dlaset "L" (f2cl-lib:int-sub n 1)
+                        (f2cl-lib:int-sub n 1) zero zero
+                        (f2cl-lib:array-slice work
+                                              double-float
+                                              ((+ iu 1))
+                                              ((1 *)))
+                        ldwrku)
+                       (setf ie itau)
+                       (setf itauq (f2cl-lib:int-add ie n))
+                       (setf itaup (f2cl-lib:int-add itauq n))
+                       (setf iwork (f2cl-lib:int-add itaup 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)
+                           (dgebrd n n
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iu)
+                                                  ((1 *)))
+                            ldwrku s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8 var-9))
+                         (setf ierr var-10))
+                       (dlacpy "U" n n
+                        (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                        ldwrku
+                        (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                        ldwrkr)
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8 var-9)
+                           (dorgbr "Q" n n n
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iu)
+                                                  ((1 *)))
+                            ldwrku
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8))
+                         (setf ierr var-9))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8 var-9)
+                           (dorgbr "P" n n n
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ir)
+                                                  ((1 *)))
+                            ldwrkr
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8))
+                         (setf ierr var-9))
+                       (setf iwork (f2cl-lib:int-add ie 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 var-13 var-14)
+                           (dbdsqr "U" n n n 0 s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ir)
+                                                  ((1 *)))
+                            ldwrkr
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iu)
+                                                  ((1 *)))
+                            ldwrku dum 1
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            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))
+                         (setf info var-14))
+                       (dgemm "N" "N" m n n one u ldu
+                        (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                        ldwrku zero a lda)
+                       (dlacpy "F" m n a lda u ldu)
+                       (dlacpy "F" n n
+                        (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                        ldwrkr a lda))
+                      (t
+                       (setf itau 1)
+                       (setf iwork (f2cl-lib:int-add itau n))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                           (dgeqrf m n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6))
+                         (setf ierr var-7))
+                       (dlacpy "L" m n a lda u ldu)
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8)
+                           (dorgqr m m n u ldu
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7))
+                         (setf ierr var-8))
+                       (setf ie itau)
+                       (setf itauq (f2cl-lib:int-add ie n))
+                       (setf itaup (f2cl-lib:int-add itauq n))
+                       (setf iwork (f2cl-lib:int-add itaup n))
+                       (dlaset "L" (f2cl-lib:int-sub n 1)
+                        (f2cl-lib:int-sub n 1) zero zero
+                        (f2cl-lib:array-slice a
+                                              double-float
+                                              (2 1)
+                                              ((1 lda) (1 *)))
+                        lda)
+                       (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)
+                           (dgebrd n n a lda s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8 var-9))
+                         (setf ierr var-10))
+                       (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)
+                           (dormbr "Q" "R" "N" m n n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            u ldu
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (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))
+                         (setf ierr var-13))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8 var-9)
+                           (dorgbr "P" n n n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8))
+                         (setf ierr var-9))
+                       (setf iwork (f2cl-lib:int-add ie 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 var-13 var-14)
+                           (dbdsqr "U" n n m 0 s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            a lda u ldu dum 1
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            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))
+                         (setf info var-14)))))
+                   (wntvas
+                    (cond
+                      ((>= lwork
+                           (f2cl-lib:int-add (f2cl-lib:int-mul n n)
+                                             (max
+                                              (the fixnum
+                                                   (f2cl-lib:int-add n m))
+                                              (the fixnum
+                                                   (f2cl-lib:int-mul 4 n))
+                                              (the fixnum bdspac))))
+                       (setf iu 1)
+                       (cond
+                         ((>= lwork
+                              (f2cl-lib:int-add wrkbl (f2cl-lib:int-mul lda n)))
+                          (setf ldwrku lda))
+                         (t
+                          (setf ldwrku n)))
+                       (setf itau
+                               (f2cl-lib:int-add iu
+                                                 (f2cl-lib:int-mul ldwrku n)))
+                       (setf iwork (f2cl-lib:int-add itau n))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                           (dgeqrf m n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6))
+                         (setf ierr var-7))
+                       (dlacpy "L" m n a lda u ldu)
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8)
+                           (dorgqr m m n u ldu
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7))
+                         (setf ierr var-8))
+                       (dlacpy "U" n n a lda
+                        (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                        ldwrku)
+                       (dlaset "L" (f2cl-lib:int-sub n 1)
+                        (f2cl-lib:int-sub n 1) zero zero
+                        (f2cl-lib:array-slice work
+                                              double-float
+                                              ((+ iu 1))
+                                              ((1 *)))
+                        ldwrku)
+                       (setf ie itau)
+                       (setf itauq (f2cl-lib:int-add ie n))
+                       (setf itaup (f2cl-lib:int-add itauq n))
+                       (setf iwork (f2cl-lib:int-add itaup 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)
+                           (dgebrd n n
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iu)
+                                                  ((1 *)))
+                            ldwrku s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8 var-9))
+                         (setf ierr var-10))
+                       (dlacpy "U" n n
+                        (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                        ldwrku vt ldvt)
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8 var-9)
+                           (dorgbr "Q" n n n
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iu)
+                                                  ((1 *)))
+                            ldwrku
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8))
+                         (setf ierr var-9))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8 var-9)
+                           (dorgbr "P" n n n vt ldvt
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8))
+                         (setf ierr var-9))
+                       (setf iwork (f2cl-lib:int-add ie 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 var-13 var-14)
+                           (dbdsqr "U" n n n 0 s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            vt ldvt
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iu)
+                                                  ((1 *)))
+                            ldwrku dum 1
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            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))
+                         (setf info var-14))
+                       (dgemm "N" "N" m n n one u ldu
+                        (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                        ldwrku zero a lda)
+                       (dlacpy "F" m n a lda u ldu))
+                      (t
+                       (setf itau 1)
+                       (setf iwork (f2cl-lib:int-add itau n))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                           (dgeqrf m n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6))
+                         (setf ierr var-7))
+                       (dlacpy "L" m n a lda u ldu)
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8)
+                           (dorgqr m m n u ldu
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7))
+                         (setf ierr var-8))
+                       (dlacpy "U" n n a lda vt ldvt)
+                       (dlaset "L" (f2cl-lib:int-sub n 1)
+                        (f2cl-lib:int-sub n 1) zero zero
+                        (f2cl-lib:array-slice vt
+                                              double-float
+                                              (2 1)
+                                              ((1 ldvt) (1 *)))
+                        ldvt)
+                       (setf ie itau)
+                       (setf itauq (f2cl-lib:int-add ie n))
+                       (setf itaup (f2cl-lib:int-add itauq n))
+                       (setf iwork (f2cl-lib:int-add itaup 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)
+                           (dgebrd n n vt ldvt s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8 var-9))
+                         (setf ierr var-10))
+                       (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)
+                           (dormbr "Q" "R" "N" m n n vt ldvt
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            u ldu
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (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))
+                         (setf ierr var-13))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8 var-9)
+                           (dorgbr "P" n n n vt ldvt
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8))
+                         (setf ierr var-9))
+                       (setf iwork (f2cl-lib:int-add ie 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 var-13 var-14)
+                           (dbdsqr "U" n n m 0 s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            vt ldvt u ldu dum 1
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            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))
+                         (setf info var-14)))))))))
+             (t
+              (setf ie 1)
+              (setf itauq (f2cl-lib:int-add ie n))
+              (setf itaup (f2cl-lib:int-add itauq n))
+              (setf iwork (f2cl-lib:int-add itaup 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)
+                  (dgebrd m n a lda s
+                   (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                   (f2cl-lib:array-slice work double-float (itauq) ((1 *)))
+                   (f2cl-lib:array-slice work double-float (itaup) ((1 *)))
+                   (f2cl-lib:array-slice work double-float (iwork) ((1 *)))
+                   (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1) ierr)
+                (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                 var-7 var-8 var-9))
+                (setf ierr var-10))
+              (cond
+                (wntuas
+                 (dlacpy "L" m n a lda u ldu)
+                 (if wntus (setf ncu n))
+                 (if wntua (setf ncu m))
+                 (multiple-value-bind
+                       (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8
+                        var-9)
+                     (dorgbr "Q" m ncu n u ldu
+                      (f2cl-lib:array-slice work double-float (itauq) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (iwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                    var-7 var-8))
+                   (setf ierr var-9))))
+              (cond
+                (wntvas
+                 (dlacpy "U" n n a lda vt ldvt)
+                 (multiple-value-bind
+                       (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8
+                        var-9)
+                     (dorgbr "P" n n n vt ldvt
+                      (f2cl-lib:array-slice work double-float (itaup) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (iwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                    var-7 var-8))
+                   (setf ierr var-9))))
+              (cond
+                (wntuo
+                 (multiple-value-bind
+                       (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8
+                        var-9)
+                     (dorgbr "Q" m n n a lda
+                      (f2cl-lib:array-slice work double-float (itauq) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (iwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                    var-7 var-8))
+                   (setf ierr var-9))))
+              (cond
+                (wntvo
+                 (multiple-value-bind
+                       (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8
+                        var-9)
+                     (dorgbr "P" n n n a lda
+                      (f2cl-lib:array-slice work double-float (itaup) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (iwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                    var-7 var-8))
+                   (setf ierr var-9))))
+              (setf iwork (f2cl-lib:int-add ie n))
+              (if (or wntuas wntuo) (setf nru m))
+              (if wntun (setf nru 0))
+              (if (or wntvas wntvo) (setf ncvt n))
+              (if wntvn (setf ncvt 0))
+              (cond
+                ((and (not wntuo) (not wntvo))
+                 (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)
+                     (dbdsqr "U" n ncvt nru 0 s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *))) vt
+                      ldvt u ldu dum 1
+                      (f2cl-lib:array-slice work double-float (iwork) ((1 *)))
+                      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))
+                   (setf info var-14)))
+                ((and (not wntuo) wntvo)
+                 (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)
+                     (dbdsqr "U" n ncvt nru 0 s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *))) a
+                      lda u ldu dum 1
+                      (f2cl-lib:array-slice work double-float (iwork) ((1 *)))
+                      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))
+                   (setf info var-14)))
+                (t
+                 (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)
+                     (dbdsqr "U" n ncvt nru 0 s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *))) vt
+                      ldvt a lda dum 1
+                      (f2cl-lib:array-slice work double-float (iwork) ((1 *)))
+                      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))
+                   (setf info var-14)))))))
+          (t
+           (cond
+             ((>= n mnthr)
+              (cond
+                (wntvn
+                 (setf itau 1)
+                 (setf iwork (f2cl-lib:int-add itau m))
+                 (multiple-value-bind
+                       (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                     (dgelqf m n a lda
+                      (f2cl-lib:array-slice work double-float (itau) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (iwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6))
+                   (setf ierr var-7))
+                 (dlaset "U" (f2cl-lib:int-sub m 1) (f2cl-lib:int-sub m 1) zero
+                  zero
+                  (f2cl-lib:array-slice a double-float (1 2) ((1 lda) (1 *)))
+                  lda)
+                 (setf ie 1)
+                 (setf itauq (f2cl-lib:int-add ie m))
+                 (setf itaup (f2cl-lib:int-add itauq m))
+                 (setf iwork (f2cl-lib:int-add itaup m))
+                 (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)
+                     (dgebrd m m a lda s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (itauq) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (itaup) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (iwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                    var-7 var-8 var-9))
+                   (setf ierr var-10))
+                 (cond
+                   ((or wntuo wntuas)
+                    (multiple-value-bind
+                          (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                           var-8 var-9)
+                        (dorgbr "Q" m m m a lda
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itauq)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6 var-7 var-8))
+                      (setf ierr var-9))))
+                 (setf iwork (f2cl-lib:int-add ie m))
+                 (setf nru 0)
+                 (if (or wntuo wntuas) (setf nru m))
+                 (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)
+                     (dbdsqr "U" m 0 nru 0 s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *))) dum
+                      1 a lda dum 1
+                      (f2cl-lib:array-slice work double-float (iwork) ((1 *)))
+                      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))
+                   (setf info var-14))
+                 (if wntuas (dlacpy "F" m m a lda u ldu)))
+                ((and wntvo wntun)
+                 (cond
+                   ((>= lwork
+                        (f2cl-lib:int-add (f2cl-lib:int-mul m m)
+                                          (max
+                                           (the fixnum
+                                                (f2cl-lib:int-mul 4 m))
+                                           (the fixnum bdspac))))
+                    (setf ir 1)
+                    (cond
+                      ((>= lwork
+                           (f2cl-lib:int-add
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add
+                                       (f2cl-lib:int-mul lda n)
+                                       m)))
+                            (f2cl-lib:int-mul lda m)))
+                       (setf ldwrku lda)
+                       (setf chunk n)
+                       (setf ldwrkr lda))
+                      ((>= lwork
+                           (f2cl-lib:int-add
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add
+                                       (f2cl-lib:int-mul lda n)
+                                       m)))
+                            (f2cl-lib:int-mul m m)))
+                       (setf ldwrku lda)
+                       (setf chunk n)
+                       (setf ldwrkr m))
+                      (t
+                       (setf ldwrku m)
+                       (setf chunk
+                               (the fixnum
+                                    (truncate (- lwork (* m m) m) m)))
+                       (setf ldwrkr m)))
+                    (setf itau
+                            (f2cl-lib:int-add ir (f2cl-lib:int-mul ldwrkr m)))
+                    (setf iwork (f2cl-lib:int-add itau m))
+                    (multiple-value-bind
+                          (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                        (dgelqf m n a lda
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itau)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6))
+                      (setf ierr var-7))
+                    (dlacpy "L" m m a lda
+                     (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                     ldwrkr)
+                    (dlaset "U" (f2cl-lib:int-sub m 1) (f2cl-lib:int-sub m 1)
+                     zero zero
+                     (f2cl-lib:array-slice work
+                                           double-float
+                                           ((+ ir ldwrkr))
+                                           ((1 *)))
+                     ldwrkr)
+                    (multiple-value-bind
+                          (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                           var-8)
+                        (dorglq m n m a lda
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itau)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6 var-7))
+                      (setf ierr var-8))
+                    (setf ie itau)
+                    (setf itauq (f2cl-lib:int-add ie m))
+                    (setf itaup (f2cl-lib:int-add itauq m))
+                    (setf iwork (f2cl-lib:int-add itaup m))
+                    (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)
+                        (dgebrd m m
+                         (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                         ldwrkr s
+                         (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itauq)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itaup)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6 var-7 var-8 var-9))
+                      (setf ierr var-10))
+                    (multiple-value-bind
+                          (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                           var-8 var-9)
+                        (dorgbr "P" m m m
+                         (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                         ldwrkr
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itaup)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6 var-7 var-8))
+                      (setf ierr var-9))
+                    (setf iwork (f2cl-lib:int-add ie m))
+                    (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)
+                        (dbdsqr "U" m m 0 0 s
+                         (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                         (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                         ldwrkr dum 1 dum 1
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         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))
+                      (setf info var-14))
+                    (setf iu (f2cl-lib:int-add ie m))
+                    (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i chunk))
+                                  ((> i n) nil)
+                      (tagbody
+                        (setf blk
+                                (min
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-sub n i)
+                                                        1))
+                                 (the fixnum chunk)))
+                        (dgemm "N" "N" m blk m one
+                         (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                         ldwrkr
+                         (f2cl-lib:array-slice a
+                                               double-float
+                                               (1 i)
+                                               ((1 lda) (1 *)))
+                         lda zero
+                         (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                         ldwrku)
+                        (dlacpy "F" m blk
+                         (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                         ldwrku
+                         (f2cl-lib:array-slice a
+                                               double-float
+                                               (1 i)
+                                               ((1 lda) (1 *)))
+                         lda))))
+                   (t
+                    (setf ie 1)
+                    (setf itauq (f2cl-lib:int-add ie m))
+                    (setf itaup (f2cl-lib:int-add itauq m))
+                    (setf iwork (f2cl-lib:int-add itaup m))
+                    (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)
+                        (dgebrd m n a lda s
+                         (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itauq)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itaup)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6 var-7 var-8 var-9))
+                      (setf ierr var-10))
+                    (multiple-value-bind
+                          (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                           var-8 var-9)
+                        (dorgbr "P" m n m a lda
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itaup)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6 var-7 var-8))
+                      (setf ierr var-9))
+                    (setf iwork (f2cl-lib:int-add ie m))
+                    (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)
+                        (dbdsqr "L" m n 0 0 s
+                         (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                         a lda dum 1 dum 1
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         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))
+                      (setf info var-14)))))
+                ((and wntvo wntuas)
+                 (cond
+                   ((>= lwork
+                        (f2cl-lib:int-add (f2cl-lib:int-mul m m)
+                                          (max
+                                           (the fixnum
+                                                (f2cl-lib:int-mul 4 m))
+                                           (the fixnum bdspac))))
+                    (setf ir 1)
+                    (cond
+                      ((>= lwork
+                           (f2cl-lib:int-add
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add
+                                       (f2cl-lib:int-mul lda n)
+                                       m)))
+                            (f2cl-lib:int-mul lda m)))
+                       (setf ldwrku lda)
+                       (setf chunk n)
+                       (setf ldwrkr lda))
+                      ((>= lwork
+                           (f2cl-lib:int-add
+                            (max (the fixnum wrkbl)
+                                 (the fixnum
+                                      (f2cl-lib:int-add
+                                       (f2cl-lib:int-mul lda n)
+                                       m)))
+                            (f2cl-lib:int-mul m m)))
+                       (setf ldwrku lda)
+                       (setf chunk n)
+                       (setf ldwrkr m))
+                      (t
+                       (setf ldwrku m)
+                       (setf chunk
+                               (the fixnum
+                                    (truncate (- lwork (* m m) m) m)))
+                       (setf ldwrkr m)))
+                    (setf itau
+                            (f2cl-lib:int-add ir (f2cl-lib:int-mul ldwrkr m)))
+                    (setf iwork (f2cl-lib:int-add itau m))
+                    (multiple-value-bind
+                          (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                        (dgelqf m n a lda
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itau)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6))
+                      (setf ierr var-7))
+                    (dlacpy "L" m m a lda u ldu)
+                    (dlaset "U" (f2cl-lib:int-sub m 1) (f2cl-lib:int-sub m 1)
+                     zero zero
+                     (f2cl-lib:array-slice u
+                                           double-float
+                                           (1 2)
+                                           ((1 ldu) (1 *)))
+                     ldu)
+                    (multiple-value-bind
+                          (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                           var-8)
+                        (dorglq m n m a lda
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itau)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6 var-7))
+                      (setf ierr var-8))
+                    (setf ie itau)
+                    (setf itauq (f2cl-lib:int-add ie m))
+                    (setf itaup (f2cl-lib:int-add itauq m))
+                    (setf iwork (f2cl-lib:int-add itaup m))
+                    (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)
+                        (dgebrd m m u ldu s
+                         (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itauq)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itaup)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6 var-7 var-8 var-9))
+                      (setf ierr var-10))
+                    (dlacpy "U" m m u ldu
+                     (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                     ldwrkr)
+                    (multiple-value-bind
+                          (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                           var-8 var-9)
+                        (dorgbr "P" m m m
+                         (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                         ldwrkr
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itaup)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6 var-7 var-8))
+                      (setf ierr var-9))
+                    (multiple-value-bind
+                          (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                           var-8 var-9)
+                        (dorgbr "Q" m m m u ldu
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itauq)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6 var-7 var-8))
+                      (setf ierr var-9))
+                    (setf iwork (f2cl-lib:int-add ie m))
+                    (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)
+                        (dbdsqr "U" m m m 0 s
+                         (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                         (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                         ldwrkr u ldu dum 1
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         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))
+                      (setf info var-14))
+                    (setf iu (f2cl-lib:int-add ie m))
+                    (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i chunk))
+                                  ((> i n) nil)
+                      (tagbody
+                        (setf blk
+                                (min
+                                 (the fixnum
+                                      (f2cl-lib:int-add (f2cl-lib:int-sub n i)
+                                                        1))
+                                 (the fixnum chunk)))
+                        (dgemm "N" "N" m blk m one
+                         (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                         ldwrkr
+                         (f2cl-lib:array-slice a
+                                               double-float
+                                               (1 i)
+                                               ((1 lda) (1 *)))
+                         lda zero
+                         (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                         ldwrku)
+                        (dlacpy "F" m blk
+                         (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                         ldwrku
+                         (f2cl-lib:array-slice a
+                                               double-float
+                                               (1 i)
+                                               ((1 lda) (1 *)))
+                         lda))))
+                   (t
+                    (setf itau 1)
+                    (setf iwork (f2cl-lib:int-add itau m))
+                    (multiple-value-bind
+                          (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                        (dgelqf m n a lda
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itau)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6))
+                      (setf ierr var-7))
+                    (dlacpy "L" m m a lda u ldu)
+                    (dlaset "U" (f2cl-lib:int-sub m 1) (f2cl-lib:int-sub m 1)
+                     zero zero
+                     (f2cl-lib:array-slice u
+                                           double-float
+                                           (1 2)
+                                           ((1 ldu) (1 *)))
+                     ldu)
+                    (multiple-value-bind
+                          (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                           var-8)
+                        (dorglq m n m a lda
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itau)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6 var-7))
+                      (setf ierr var-8))
+                    (setf ie itau)
+                    (setf itauq (f2cl-lib:int-add ie m))
+                    (setf itaup (f2cl-lib:int-add itauq m))
+                    (setf iwork (f2cl-lib:int-add itaup m))
+                    (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)
+                        (dgebrd m m u ldu s
+                         (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itauq)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itaup)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6 var-7 var-8 var-9))
+                      (setf ierr var-10))
+                    (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)
+                        (dormbr "P" "L" "T" m n m u ldu
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itaup)
+                                               ((1 *)))
+                         a lda
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (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))
+                      (setf ierr var-13))
+                    (multiple-value-bind
+                          (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                           var-8 var-9)
+                        (dorgbr "Q" m m m u ldu
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (itauq)
+                                               ((1 *)))
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                         ierr)
+                      (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                       var-6 var-7 var-8))
+                      (setf ierr var-9))
+                    (setf iwork (f2cl-lib:int-add ie m))
+                    (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)
+                        (dbdsqr "U" m n m 0 s
+                         (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                         a lda u ldu dum 1
+                         (f2cl-lib:array-slice work
+                                               double-float
+                                               (iwork)
+                                               ((1 *)))
+                         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))
+                      (setf info var-14)))))
+                (wntvs
+                 (cond
+                   (wntun
+                    (cond
+                      ((>= lwork
+                           (f2cl-lib:int-add (f2cl-lib:int-mul m m)
+                                             (max
+                                              (the fixnum
+                                                   (f2cl-lib:int-mul 4 m))
+                                              (the fixnum bdspac))))
+                       (setf ir 1)
+                       (cond
+                         ((>= lwork
+                              (f2cl-lib:int-add wrkbl (f2cl-lib:int-mul lda m)))
+                          (setf ldwrkr lda))
+                         (t
+                          (setf ldwrkr m)))
+                       (setf itau
+                               (f2cl-lib:int-add ir
+                                                 (f2cl-lib:int-mul ldwrkr m)))
+                       (setf iwork (f2cl-lib:int-add itau m))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                           (dgelqf m n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6))
+                         (setf ierr var-7))
+                       (dlacpy "L" m m a lda
+                        (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                        ldwrkr)
+                       (dlaset "U" (f2cl-lib:int-sub m 1)
+                        (f2cl-lib:int-sub m 1) zero zero
+                        (f2cl-lib:array-slice work
+                                              double-float
+                                              ((+ ir ldwrkr))
+                                              ((1 *)))
+                        ldwrkr)
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8)
+                           (dorglq m n m a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7))
+                         (setf ierr var-8))
+                       (setf ie itau)
+                       (setf itauq (f2cl-lib:int-add ie m))
+                       (setf itaup (f2cl-lib:int-add itauq m))
+                       (setf iwork (f2cl-lib:int-add itaup m))
+                       (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)
+                           (dgebrd m m
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ir)
+                                                  ((1 *)))
+                            ldwrkr s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8 var-9))
+                         (setf ierr var-10))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8 var-9)
+                           (dorgbr "P" m m m
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ir)
+                                                  ((1 *)))
+                            ldwrkr
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8))
+                         (setf ierr var-9))
+                       (setf iwork (f2cl-lib:int-add ie m))
+                       (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)
+                           (dbdsqr "U" m m 0 0 s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ir)
+                                                  ((1 *)))
+                            ldwrkr dum 1 dum 1
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            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))
+                         (setf info var-14))
+                       (dgemm "N" "N" m n m one
+                        (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                        ldwrkr a lda zero vt ldvt))
+                      (t
+                       (setf itau 1)
+                       (setf iwork (f2cl-lib:int-add itau m))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                           (dgelqf m n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6))
+                         (setf ierr var-7))
+                       (dlacpy "U" m n a lda vt ldvt)
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8)
+                           (dorglq m n m vt ldvt
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7))
+                         (setf ierr var-8))
+                       (setf ie itau)
+                       (setf itauq (f2cl-lib:int-add ie m))
+                       (setf itaup (f2cl-lib:int-add itauq m))
+                       (setf iwork (f2cl-lib:int-add itaup m))
+                       (dlaset "U" (f2cl-lib:int-sub m 1)
+                        (f2cl-lib:int-sub m 1) zero zero
+                        (f2cl-lib:array-slice a
+                                              double-float
+                                              (1 2)
+                                              ((1 lda) (1 *)))
+                        lda)
+                       (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)
+                           (dgebrd m m a lda s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8 var-9))
+                         (setf ierr var-10))
+                       (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)
+                           (dormbr "P" "L" "T" m n m a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            vt ldvt
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (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))
+                         (setf ierr var-13))
+                       (setf iwork (f2cl-lib:int-add ie m))
+                       (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)
+                           (dbdsqr "U" m n 0 0 s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            vt ldvt dum 1 dum 1
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            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))
+                         (setf info var-14)))))
+                   (wntuo
+                    (cond
+                      ((>= lwork
+                           (f2cl-lib:int-add (f2cl-lib:int-mul 2 m m)
+                                             (max
+                                              (the fixnum
+                                                   (f2cl-lib:int-mul 4 m))
+                                              (the fixnum bdspac))))
+                       (setf iu 1)
+                       (cond
+                         ((>= lwork
+                              (f2cl-lib:int-add wrkbl
+                                                (f2cl-lib:int-mul 2 lda m)))
+                          (setf ldwrku lda)
+                          (setf ir
+                                  (f2cl-lib:int-add iu
+                                                    (f2cl-lib:int-mul ldwrku
+                                                                      m)))
+                          (setf ldwrkr lda))
+                         ((>= lwork
+                              (f2cl-lib:int-add wrkbl
+                                                (f2cl-lib:int-mul
+                                                 (f2cl-lib:int-add lda m)
+                                                 m)))
+                          (setf ldwrku lda)
+                          (setf ir
+                                  (f2cl-lib:int-add iu
+                                                    (f2cl-lib:int-mul ldwrku
+                                                                      m)))
+                          (setf ldwrkr m))
+                         (t
+                          (setf ldwrku m)
+                          (setf ir
+                                  (f2cl-lib:int-add iu
+                                                    (f2cl-lib:int-mul ldwrku
+                                                                      m)))
+                          (setf ldwrkr m)))
+                       (setf itau
+                               (f2cl-lib:int-add ir
+                                                 (f2cl-lib:int-mul ldwrkr m)))
+                       (setf iwork (f2cl-lib:int-add itau m))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                           (dgelqf m n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6))
+                         (setf ierr var-7))
+                       (dlacpy "L" m m a lda
+                        (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                        ldwrku)
+                       (dlaset "U" (f2cl-lib:int-sub m 1)
+                        (f2cl-lib:int-sub m 1) zero zero
+                        (f2cl-lib:array-slice work
+                                              double-float
+                                              ((+ iu ldwrku))
+                                              ((1 *)))
+                        ldwrku)
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8)
+                           (dorglq m n m a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7))
+                         (setf ierr var-8))
+                       (setf ie itau)
+                       (setf itauq (f2cl-lib:int-add ie m))
+                       (setf itaup (f2cl-lib:int-add itauq m))
+                       (setf iwork (f2cl-lib:int-add itaup m))
+                       (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)
+                           (dgebrd m m
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iu)
+                                                  ((1 *)))
+                            ldwrku s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8 var-9))
+                         (setf ierr var-10))
+                       (dlacpy "L" m m
+                        (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                        ldwrku
+                        (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                        ldwrkr)
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8 var-9)
+                           (dorgbr "P" m m m
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iu)
+                                                  ((1 *)))
+                            ldwrku
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8))
+                         (setf ierr var-9))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8 var-9)
+                           (dorgbr "Q" m m m
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ir)
+                                                  ((1 *)))
+                            ldwrkr
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8))
+                         (setf ierr var-9))
+                       (setf iwork (f2cl-lib:int-add ie m))
+                       (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)
+                           (dbdsqr "U" m m m 0 s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iu)
+                                                  ((1 *)))
+                            ldwrku
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ir)
+                                                  ((1 *)))
+                            ldwrkr dum 1
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            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))
+                         (setf info var-14))
+                       (dgemm "N" "N" m n m one
+                        (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                        ldwrku a lda zero vt ldvt)
+                       (dlacpy "F" m m
+                        (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                        ldwrkr a lda))
+                      (t
+                       (setf itau 1)
+                       (setf iwork (f2cl-lib:int-add itau m))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                           (dgelqf m n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6))
+                         (setf ierr var-7))
+                       (dlacpy "U" m n a lda vt ldvt)
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8)
+                           (dorglq m n m vt ldvt
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7))
+                         (setf ierr var-8))
+                       (setf ie itau)
+                       (setf itauq (f2cl-lib:int-add ie m))
+                       (setf itaup (f2cl-lib:int-add itauq m))
+                       (setf iwork (f2cl-lib:int-add itaup m))
+                       (dlaset "U" (f2cl-lib:int-sub m 1)
+                        (f2cl-lib:int-sub m 1) zero zero
+                        (f2cl-lib:array-slice a
+                                              double-float
+                                              (1 2)
+                                              ((1 lda) (1 *)))
+                        lda)
+                       (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)
+                           (dgebrd m m a lda s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8 var-9))
+                         (setf ierr var-10))
+                       (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)
+                           (dormbr "P" "L" "T" m n m a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            vt ldvt
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (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))
+                         (setf ierr var-13))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8 var-9)
+                           (dorgbr "Q" m m m a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8))
+                         (setf ierr var-9))
+                       (setf iwork (f2cl-lib:int-add ie m))
+                       (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)
+                           (dbdsqr "U" m n m 0 s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            vt ldvt a lda dum 1
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            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))
+                         (setf info var-14)))))
+                   (wntuas
+                    (cond
+                      ((>= lwork
+                           (f2cl-lib:int-add (f2cl-lib:int-mul m m)
+                                             (max
+                                              (the fixnum
+                                                   (f2cl-lib:int-mul 4 m))
+                                              (the fixnum bdspac))))
+                       (setf iu 1)
+                       (cond
+                         ((>= lwork
+                              (f2cl-lib:int-add wrkbl (f2cl-lib:int-mul lda m)))
+                          (setf ldwrku lda))
+                         (t
+                          (setf ldwrku m)))
+                       (setf itau
+                               (f2cl-lib:int-add iu
+                                                 (f2cl-lib:int-mul ldwrku m)))
+                       (setf iwork (f2cl-lib:int-add itau m))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                           (dgelqf m n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6))
+                         (setf ierr var-7))
+                       (dlacpy "L" m m a lda
+                        (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                        ldwrku)
+                       (dlaset "U" (f2cl-lib:int-sub m 1)
+                        (f2cl-lib:int-sub m 1) zero zero
+                        (f2cl-lib:array-slice work
+                                              double-float
+                                              ((+ iu ldwrku))
+                                              ((1 *)))
+                        ldwrku)
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8)
+                           (dorglq m n m a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7))
+                         (setf ierr var-8))
+                       (setf ie itau)
+                       (setf itauq (f2cl-lib:int-add ie m))
+                       (setf itaup (f2cl-lib:int-add itauq m))
+                       (setf iwork (f2cl-lib:int-add itaup m))
+                       (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)
+                           (dgebrd m m
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iu)
+                                                  ((1 *)))
+                            ldwrku s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8 var-9))
+                         (setf ierr var-10))
+                       (dlacpy "L" m m
+                        (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                        ldwrku u ldu)
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8 var-9)
+                           (dorgbr "P" m m m
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iu)
+                                                  ((1 *)))
+                            ldwrku
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8))
+                         (setf ierr var-9))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8 var-9)
+                           (dorgbr "Q" m m m u ldu
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8))
+                         (setf ierr var-9))
+                       (setf iwork (f2cl-lib:int-add ie m))
+                       (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)
+                           (dbdsqr "U" m m m 0 s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iu)
+                                                  ((1 *)))
+                            ldwrku u ldu dum 1
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            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))
+                         (setf info var-14))
+                       (dgemm "N" "N" m n m one
+                        (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                        ldwrku a lda zero vt ldvt))
+                      (t
+                       (setf itau 1)
+                       (setf iwork (f2cl-lib:int-add itau m))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                           (dgelqf m n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6))
+                         (setf ierr var-7))
+                       (dlacpy "U" m n a lda vt ldvt)
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8)
+                           (dorglq m n m vt ldvt
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7))
+                         (setf ierr var-8))
+                       (dlacpy "L" m m a lda u ldu)
+                       (dlaset "U" (f2cl-lib:int-sub m 1)
+                        (f2cl-lib:int-sub m 1) zero zero
+                        (f2cl-lib:array-slice u
+                                              double-float
+                                              (1 2)
+                                              ((1 ldu) (1 *)))
+                        ldu)
+                       (setf ie itau)
+                       (setf itauq (f2cl-lib:int-add ie m))
+                       (setf itaup (f2cl-lib:int-add itauq m))
+                       (setf iwork (f2cl-lib:int-add itaup m))
+                       (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)
+                           (dgebrd m m u ldu s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8 var-9))
+                         (setf ierr var-10))
+                       (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)
+                           (dormbr "P" "L" "T" m n m u ldu
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            vt ldvt
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (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))
+                         (setf ierr var-13))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8 var-9)
+                           (dorgbr "Q" m m m u ldu
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8))
+                         (setf ierr var-9))
+                       (setf iwork (f2cl-lib:int-add ie m))
+                       (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)
+                           (dbdsqr "U" m n m 0 s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            vt ldvt u ldu dum 1
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            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))
+                         (setf info var-14)))))))
+                (wntva
+                 (cond
+                   (wntun
+                    (cond
+                      ((>= lwork
+                           (f2cl-lib:int-add (f2cl-lib:int-mul m m)
+                                             (max
+                                              (the fixnum
+                                                   (f2cl-lib:int-add n m))
+                                              (the fixnum
+                                                   (f2cl-lib:int-mul 4 m))
+                                              (the fixnum bdspac))))
+                       (setf ir 1)
+                       (cond
+                         ((>= lwork
+                              (f2cl-lib:int-add wrkbl (f2cl-lib:int-mul lda m)))
+                          (setf ldwrkr lda))
+                         (t
+                          (setf ldwrkr m)))
+                       (setf itau
+                               (f2cl-lib:int-add ir
+                                                 (f2cl-lib:int-mul ldwrkr m)))
+                       (setf iwork (f2cl-lib:int-add itau m))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                           (dgelqf m n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6))
+                         (setf ierr var-7))
+                       (dlacpy "U" m n a lda vt ldvt)
+                       (dlacpy "L" m m a lda
+                        (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                        ldwrkr)
+                       (dlaset "U" (f2cl-lib:int-sub m 1)
+                        (f2cl-lib:int-sub m 1) zero zero
+                        (f2cl-lib:array-slice work
+                                              double-float
+                                              ((+ ir ldwrkr))
+                                              ((1 *)))
+                        ldwrkr)
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8)
+                           (dorglq n n m vt ldvt
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7))
+                         (setf ierr var-8))
+                       (setf ie itau)
+                       (setf itauq (f2cl-lib:int-add ie m))
+                       (setf itaup (f2cl-lib:int-add itauq m))
+                       (setf iwork (f2cl-lib:int-add itaup m))
+                       (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)
+                           (dgebrd m m
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ir)
+                                                  ((1 *)))
+                            ldwrkr s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8 var-9))
+                         (setf ierr var-10))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8 var-9)
+                           (dorgbr "P" m m m
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ir)
+                                                  ((1 *)))
+                            ldwrkr
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8))
+                         (setf ierr var-9))
+                       (setf iwork (f2cl-lib:int-add ie m))
+                       (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)
+                           (dbdsqr "U" m m 0 0 s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ir)
+                                                  ((1 *)))
+                            ldwrkr dum 1 dum 1
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            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))
+                         (setf info var-14))
+                       (dgemm "N" "N" m n m one
+                        (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                        ldwrkr vt ldvt zero a lda)
+                       (dlacpy "F" m n a lda vt ldvt))
+                      (t
+                       (setf itau 1)
+                       (setf iwork (f2cl-lib:int-add itau m))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                           (dgelqf m n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6))
+                         (setf ierr var-7))
+                       (dlacpy "U" m n a lda vt ldvt)
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8)
+                           (dorglq n n m vt ldvt
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7))
+                         (setf ierr var-8))
+                       (setf ie itau)
+                       (setf itauq (f2cl-lib:int-add ie m))
+                       (setf itaup (f2cl-lib:int-add itauq m))
+                       (setf iwork (f2cl-lib:int-add itaup m))
+                       (dlaset "U" (f2cl-lib:int-sub m 1)
+                        (f2cl-lib:int-sub m 1) zero zero
+                        (f2cl-lib:array-slice a
+                                              double-float
+                                              (1 2)
+                                              ((1 lda) (1 *)))
+                        lda)
+                       (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)
+                           (dgebrd m m a lda s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8 var-9))
+                         (setf ierr var-10))
+                       (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)
+                           (dormbr "P" "L" "T" m n m a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            vt ldvt
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (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))
+                         (setf ierr var-13))
+                       (setf iwork (f2cl-lib:int-add ie m))
+                       (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)
+                           (dbdsqr "U" m n 0 0 s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            vt ldvt dum 1 dum 1
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            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))
+                         (setf info var-14)))))
+                   (wntuo
+                    (cond
+                      ((>= lwork
+                           (f2cl-lib:int-add (f2cl-lib:int-mul 2 m m)
+                                             (max
+                                              (the fixnum
+                                                   (f2cl-lib:int-add n m))
+                                              (the fixnum
+                                                   (f2cl-lib:int-mul 4 m))
+                                              (the fixnum bdspac))))
+                       (setf iu 1)
+                       (cond
+                         ((>= lwork
+                              (f2cl-lib:int-add wrkbl
+                                                (f2cl-lib:int-mul 2 lda m)))
+                          (setf ldwrku lda)
+                          (setf ir
+                                  (f2cl-lib:int-add iu
+                                                    (f2cl-lib:int-mul ldwrku
+                                                                      m)))
+                          (setf ldwrkr lda))
+                         ((>= lwork
+                              (f2cl-lib:int-add wrkbl
+                                                (f2cl-lib:int-mul
+                                                 (f2cl-lib:int-add lda m)
+                                                 m)))
+                          (setf ldwrku lda)
+                          (setf ir
+                                  (f2cl-lib:int-add iu
+                                                    (f2cl-lib:int-mul ldwrku
+                                                                      m)))
+                          (setf ldwrkr m))
+                         (t
+                          (setf ldwrku m)
+                          (setf ir
+                                  (f2cl-lib:int-add iu
+                                                    (f2cl-lib:int-mul ldwrku
+                                                                      m)))
+                          (setf ldwrkr m)))
+                       (setf itau
+                               (f2cl-lib:int-add ir
+                                                 (f2cl-lib:int-mul ldwrkr m)))
+                       (setf iwork (f2cl-lib:int-add itau m))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                           (dgelqf m n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6))
+                         (setf ierr var-7))
+                       (dlacpy "U" m n a lda vt ldvt)
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8)
+                           (dorglq n n m vt ldvt
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7))
+                         (setf ierr var-8))
+                       (dlacpy "L" m m a lda
+                        (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                        ldwrku)
+                       (dlaset "U" (f2cl-lib:int-sub m 1)
+                        (f2cl-lib:int-sub m 1) zero zero
+                        (f2cl-lib:array-slice work
+                                              double-float
+                                              ((+ iu ldwrku))
+                                              ((1 *)))
+                        ldwrku)
+                       (setf ie itau)
+                       (setf itauq (f2cl-lib:int-add ie m))
+                       (setf itaup (f2cl-lib:int-add itauq m))
+                       (setf iwork (f2cl-lib:int-add itaup m))
+                       (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)
+                           (dgebrd m m
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iu)
+                                                  ((1 *)))
+                            ldwrku s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8 var-9))
+                         (setf ierr var-10))
+                       (dlacpy "L" m m
+                        (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                        ldwrku
+                        (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                        ldwrkr)
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8 var-9)
+                           (dorgbr "P" m m m
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iu)
+                                                  ((1 *)))
+                            ldwrku
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8))
+                         (setf ierr var-9))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8 var-9)
+                           (dorgbr "Q" m m m
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ir)
+                                                  ((1 *)))
+                            ldwrkr
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8))
+                         (setf ierr var-9))
+                       (setf iwork (f2cl-lib:int-add ie m))
+                       (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)
+                           (dbdsqr "U" m m m 0 s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iu)
+                                                  ((1 *)))
+                            ldwrku
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ir)
+                                                  ((1 *)))
+                            ldwrkr dum 1
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            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))
+                         (setf info var-14))
+                       (dgemm "N" "N" m n m one
+                        (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                        ldwrku vt ldvt zero a lda)
+                       (dlacpy "F" m n a lda vt ldvt)
+                       (dlacpy "F" m m
+                        (f2cl-lib:array-slice work double-float (ir) ((1 *)))
+                        ldwrkr a lda))
+                      (t
+                       (setf itau 1)
+                       (setf iwork (f2cl-lib:int-add itau m))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                           (dgelqf m n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6))
+                         (setf ierr var-7))
+                       (dlacpy "U" m n a lda vt ldvt)
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8)
+                           (dorglq n n m vt ldvt
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7))
+                         (setf ierr var-8))
+                       (setf ie itau)
+                       (setf itauq (f2cl-lib:int-add ie m))
+                       (setf itaup (f2cl-lib:int-add itauq m))
+                       (setf iwork (f2cl-lib:int-add itaup m))
+                       (dlaset "U" (f2cl-lib:int-sub m 1)
+                        (f2cl-lib:int-sub m 1) zero zero
+                        (f2cl-lib:array-slice a
+                                              double-float
+                                              (1 2)
+                                              ((1 lda) (1 *)))
+                        lda)
+                       (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)
+                           (dgebrd m m a lda s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8 var-9))
+                         (setf ierr var-10))
+                       (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)
+                           (dormbr "P" "L" "T" m n m a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            vt ldvt
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (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))
+                         (setf ierr var-13))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8 var-9)
+                           (dorgbr "Q" m m m a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8))
+                         (setf ierr var-9))
+                       (setf iwork (f2cl-lib:int-add ie m))
+                       (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)
+                           (dbdsqr "U" m n m 0 s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            vt ldvt a lda dum 1
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            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))
+                         (setf info var-14)))))
+                   (wntuas
+                    (cond
+                      ((>= lwork
+                           (f2cl-lib:int-add (f2cl-lib:int-mul m m)
+                                             (max
+                                              (the fixnum
+                                                   (f2cl-lib:int-add n m))
+                                              (the fixnum
+                                                   (f2cl-lib:int-mul 4 m))
+                                              (the fixnum bdspac))))
+                       (setf iu 1)
+                       (cond
+                         ((>= lwork
+                              (f2cl-lib:int-add wrkbl (f2cl-lib:int-mul lda m)))
+                          (setf ldwrku lda))
+                         (t
+                          (setf ldwrku m)))
+                       (setf itau
+                               (f2cl-lib:int-add iu
+                                                 (f2cl-lib:int-mul ldwrku m)))
+                       (setf iwork (f2cl-lib:int-add itau m))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                           (dgelqf m n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6))
+                         (setf ierr var-7))
+                       (dlacpy "U" m n a lda vt ldvt)
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8)
+                           (dorglq n n m vt ldvt
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7))
+                         (setf ierr var-8))
+                       (dlacpy "L" m m a lda
+                        (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                        ldwrku)
+                       (dlaset "U" (f2cl-lib:int-sub m 1)
+                        (f2cl-lib:int-sub m 1) zero zero
+                        (f2cl-lib:array-slice work
+                                              double-float
+                                              ((+ iu ldwrku))
+                                              ((1 *)))
+                        ldwrku)
+                       (setf ie itau)
+                       (setf itauq (f2cl-lib:int-add ie m))
+                       (setf itaup (f2cl-lib:int-add itauq m))
+                       (setf iwork (f2cl-lib:int-add itaup m))
+                       (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)
+                           (dgebrd m m
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iu)
+                                                  ((1 *)))
+                            ldwrku s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8 var-9))
+                         (setf ierr var-10))
+                       (dlacpy "L" m m
+                        (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                        ldwrku u ldu)
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8 var-9)
+                           (dorgbr "P" m m m
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iu)
+                                                  ((1 *)))
+                            ldwrku
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8))
+                         (setf ierr var-9))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8 var-9)
+                           (dorgbr "Q" m m m u ldu
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8))
+                         (setf ierr var-9))
+                       (setf iwork (f2cl-lib:int-add ie m))
+                       (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)
+                           (dbdsqr "U" m m m 0 s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iu)
+                                                  ((1 *)))
+                            ldwrku u ldu dum 1
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            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))
+                         (setf info var-14))
+                       (dgemm "N" "N" m n m one
+                        (f2cl-lib:array-slice work double-float (iu) ((1 *)))
+                        ldwrku vt ldvt zero a lda)
+                       (dlacpy "F" m n a lda vt ldvt))
+                      (t
+                       (setf itau 1)
+                       (setf iwork (f2cl-lib:int-add itau m))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
+                           (dgelqf m n a lda
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6))
+                         (setf ierr var-7))
+                       (dlacpy "U" m n a lda vt ldvt)
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8)
+                           (dorglq n n m vt ldvt
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itau)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7))
+                         (setf ierr var-8))
+                       (dlacpy "L" m m a lda u ldu)
+                       (dlaset "U" (f2cl-lib:int-sub m 1)
+                        (f2cl-lib:int-sub m 1) zero zero
+                        (f2cl-lib:array-slice u
+                                              double-float
+                                              (1 2)
+                                              ((1 ldu) (1 *)))
+                        ldu)
+                       (setf ie itau)
+                       (setf itauq (f2cl-lib:int-add ie m))
+                       (setf itaup (f2cl-lib:int-add itauq m))
+                       (setf iwork (f2cl-lib:int-add itaup m))
+                       (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)
+                           (dgebrd m m u ldu s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8 var-9))
+                         (setf ierr var-10))
+                       (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)
+                           (dormbr "P" "L" "T" m n m u ldu
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itaup)
+                                                  ((1 *)))
+                            vt ldvt
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (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))
+                         (setf ierr var-13))
+                       (multiple-value-bind
+                             (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7
+                              var-8 var-9)
+                           (dorgbr "Q" m m m u ldu
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (itauq)
+                                                  ((1 *)))
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1)
+                            ierr)
+                         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5
+                                          var-6 var-7 var-8))
+                         (setf ierr var-9))
+                       (setf iwork (f2cl-lib:int-add ie m))
+                       (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)
+                           (dbdsqr "U" m n m 0 s
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (ie)
+                                                  ((1 *)))
+                            vt ldvt u ldu dum 1
+                            (f2cl-lib:array-slice work
+                                                  double-float
+                                                  (iwork)
+                                                  ((1 *)))
+                            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))
+                         (setf info var-14)))))))))
+             (t
+              (setf ie 1)
+              (setf itauq (f2cl-lib:int-add ie m))
+              (setf itaup (f2cl-lib:int-add itauq m))
+              (setf iwork (f2cl-lib:int-add itaup m))
+              (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)
+                  (dgebrd m n a lda s
+                   (f2cl-lib:array-slice work double-float (ie) ((1 *)))
+                   (f2cl-lib:array-slice work double-float (itauq) ((1 *)))
+                   (f2cl-lib:array-slice work double-float (itaup) ((1 *)))
+                   (f2cl-lib:array-slice work double-float (iwork) ((1 *)))
+                   (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1) ierr)
+                (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                 var-7 var-8 var-9))
+                (setf ierr var-10))
+              (cond
+                (wntuas
+                 (dlacpy "L" m m a lda u ldu)
+                 (multiple-value-bind
+                       (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8
+                        var-9)
+                     (dorgbr "Q" m m n u ldu
+                      (f2cl-lib:array-slice work double-float (itauq) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (iwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                    var-7 var-8))
+                   (setf ierr var-9))))
+              (cond
+                (wntvas
+                 (dlacpy "U" m n a lda vt ldvt)
+                 (if wntva (setf nrvt n))
+                 (if wntvs (setf nrvt m))
+                 (multiple-value-bind
+                       (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8
+                        var-9)
+                     (dorgbr "P" nrvt n m vt ldvt
+                      (f2cl-lib:array-slice work double-float (itaup) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (iwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                    var-7 var-8))
+                   (setf ierr var-9))))
+              (cond
+                (wntuo
+                 (multiple-value-bind
+                       (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8
+                        var-9)
+                     (dorgbr "Q" m m n a lda
+                      (f2cl-lib:array-slice work double-float (itauq) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (iwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                    var-7 var-8))
+                   (setf ierr var-9))))
+              (cond
+                (wntvo
+                 (multiple-value-bind
+                       (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8
+                        var-9)
+                     (dorgbr "P" m n m a lda
+                      (f2cl-lib:array-slice work double-float (itaup) ((1 *)))
+                      (f2cl-lib:array-slice work double-float (iwork) ((1 *)))
+                      (f2cl-lib:int-add (f2cl-lib:int-sub lwork iwork) 1) ierr)
+                   (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                    var-7 var-8))
+                   (setf ierr var-9))))
+              (setf iwork (f2cl-lib:int-add ie m))
+              (if (or wntuas wntuo) (setf nru m))
+              (if wntun (setf nru 0))
+              (if (or wntvas wntvo) (setf ncvt n))
+              (if wntvn (setf ncvt 0))
+              (cond
+                ((and (not wntuo) (not wntvo))
+                 (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)
+                     (dbdsqr "L" m ncvt nru 0 s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *))) vt
+                      ldvt u ldu dum 1
+                      (f2cl-lib:array-slice work double-float (iwork) ((1 *)))
+                      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))
+                   (setf info var-14)))
+                ((and (not wntuo) wntvo)
+                 (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)
+                     (dbdsqr "L" m ncvt nru 0 s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *))) a
+                      lda u ldu dum 1
+                      (f2cl-lib:array-slice work double-float (iwork) ((1 *)))
+                      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))
+                   (setf info var-14)))
+                (t
+                 (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)
+                     (dbdsqr "L" m ncvt nru 0 s
+                      (f2cl-lib:array-slice work double-float (ie) ((1 *))) vt
+                      ldvt a lda dum 1
+                      (f2cl-lib:array-slice work double-float (iwork) ((1 *)))
+                      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))
+                   (setf info var-14))))))))
+        (cond
+          ((/= info 0)
+           (cond
+             ((> ie 2)
+              (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                            ((> i
+                                (f2cl-lib:int-add minmn (f2cl-lib:int-sub 1)))
+                             nil)
+                (tagbody
+                  (setf (f2cl-lib:fref work-%data%
+                                       ((f2cl-lib:int-add i 1))
+                                       ((1 *))
+                                       work-%offset%)
+                          (f2cl-lib:fref work-%data%
+                                         ((f2cl-lib:int-sub
+                                           (f2cl-lib:int-add i ie)
+                                           1))
+                                         ((1 *))
+                                         work-%offset%))))))
+           (cond
+             ((< ie 2)
+              (f2cl-lib:fdo (i (f2cl-lib:int-add minmn (f2cl-lib:int-sub 1))
+                             (f2cl-lib:int-add i (f2cl-lib:int-sub 1)))
+                            ((> i 1) nil)
+                (tagbody
+                  (setf (f2cl-lib:fref work-%data%
+                                       ((f2cl-lib:int-add i 1))
+                                       ((1 *))
+                                       work-%offset%)
+                          (f2cl-lib:fref work-%data%
+                                         ((f2cl-lib:int-sub
+                                           (f2cl-lib:int-add i ie)
+                                           1))
+                                         ((1 *))
+                                         work-%offset%))))))))
+        (cond
+          ((= iscl 1)
+           (if (> anrm bignum)
+               (multiple-value-bind
+                     (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8
+                      var-9)
+                   (dlascl "G" 0 0 bignum anrm minmn 1 s minmn ierr)
+                 (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                  var-7 var-8))
+                 (setf ierr var-9)))
+           (if (and (/= info 0) (> anrm bignum))
+               (multiple-value-bind
+                     (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8
+                      var-9)
+                   (dlascl "G" 0 0 bignum anrm (f2cl-lib:int-sub minmn 1) 1
+                    (f2cl-lib:array-slice work double-float (2) ((1 *))) minmn
+                    ierr)
+                 (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                  var-7 var-8))
+                 (setf ierr var-9)))
+           (if (< anrm smlnum)
+               (multiple-value-bind
+                     (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8
+                      var-9)
+                   (dlascl "G" 0 0 smlnum anrm minmn 1 s minmn ierr)
+                 (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                  var-7 var-8))
+                 (setf ierr var-9)))
+           (if (and (/= info 0) (< anrm smlnum))
+               (multiple-value-bind
+                     (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8
+                      var-9)
+                   (dlascl "G" 0 0 smlnum anrm (f2cl-lib:int-sub minmn 1) 1
+                    (f2cl-lib:array-slice work double-float (2) ((1 *))) minmn
+                    ierr)
+                 (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6
+                                  var-7 var-8))
+                 (setf ierr var-9)))))
+        (setf (f2cl-lib:fref work-%data% (1) ((1 *)) work-%offset%)
+                (coerce (the fixnum maxwrk) 'double-float))
+ end_label
+        (return
+         (values nil nil 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::dgesvd
+                 fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '((simple-array character (1))
+                        (simple-array character (1))
+                        fixnum fixnum
+                        (array double-float (*)) fixnum
+                        (array double-float (*)) (array double-float (*))
+                        fixnum (array double-float (*))
+                        fixnum (array double-float (*))
+                        fixnum
+                        fixnum)
+           :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil nil
+                            fortran-to-lisp::info)
+           :calls '(fortran-to-lisp::dorglq fortran-to-lisp::dgelqf
+                    fortran-to-lisp::dormbr fortran-to-lisp::dgemm
+                    fortran-to-lisp::dorgqr fortran-to-lisp::dlacpy
+                    fortran-to-lisp::dbdsqr fortran-to-lisp::dorgbr
+                    fortran-to-lisp::dgebrd fortran-to-lisp::dlaset
+                    fortran-to-lisp::dgeqrf fortran-to-lisp::dlascl
+                    fortran-to-lisp::dlange fortran-to-lisp::dlamch
+                    fortran-to-lisp::xerbla fortran-to-lisp::lsame
+                    fortran-to-lisp::ilaenv))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dgesv LAPACK}
+\pagehead{dgesv}{dgesv}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<LAPACK dgesv>>=
+(defun dgesv (n nrhs a lda ipiv b ldb$ info)
+  (declare (type (array fixnum (*)) ipiv)
+           (type (array double-float (*)) b a)
+           (type fixnum info ldb$ lda nrhs n))
+  (f2cl-lib:with-multi-array-data
+      ((a double-float a-%data% a-%offset%)
+       (b double-float b-%data% b-%offset%)
+       (ipiv fixnum ipiv-%data% ipiv-%offset%))
+    (prog ()
+      (declare)
+      (setf info 0)
+      (cond
+        ((< n 0)
+         (setf info -1))
+        ((< nrhs 0)
+         (setf info -2))
+        ((< lda (max (the fixnum 1) (the fixnum n)))
+         (setf info -4))
+        ((< ldb$ (max (the fixnum 1) (the fixnum n)))
+         (setf info -7)))
+      (cond
+        ((/= info 0)
+         (xerbla "DGESV " (f2cl-lib:int-sub info))
+         (go end_label)))
+      (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5)
+          (dgetrf n n a lda ipiv info)
+        (declare (ignore var-0 var-1 var-2 var-3 var-4))
+        (setf info var-5))
+      (cond
+        ((= info 0)
+         (multiple-value-bind
+               (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8)
+             (dgetrs "No transpose" n nrhs a lda ipiv b ldb$ info)
+           (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7))
+           (setf info var-8))))
+      (go end_label)
+ end_label
+      (return (values 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::dgesv fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '(fixnum fixnum
+                        (array double-float (*)) fixnum
+                        (array fixnum (*))
+                        (array double-float (*)) fixnum
+                        fixnum)
+           :return-values '(nil nil nil nil nil nil nil fortran-to-lisp::info)
+           :calls '(fortran-to-lisp::dgetrs fortran-to-lisp::dgetrf
+                    fortran-to-lisp::xerbla))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dgetf2 LAPACK}
+\pagehead{dgetf2}{dgetf2}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<LAPACK dgetf2>>=
+(let* ((one 1.0) (zero 0.0))
+  (declare (type (double-float 1.0 1.0) one)
+           (type (double-float 0.0 0.0) zero))
+  (defun dgetf2 (m n a lda ipiv info)
+    (declare (type (array fixnum (*)) ipiv)
+             (type (array double-float (*)) a)
+             (type fixnum info lda n m))
+    (f2cl-lib:with-multi-array-data
+        ((a double-float a-%data% a-%offset%)
+         (ipiv fixnum ipiv-%data% ipiv-%offset%))
+      (prog ((j 0) (jp 0))
+        (declare (type fixnum j jp))
+        (setf info 0)
+        (cond
+          ((< m 0)
+           (setf info -1))
+          ((< n 0)
+           (setf info -2))
+          ((< lda (max (the fixnum 1) (the fixnum m)))
+           (setf info -4)))
+        (cond
+          ((/= info 0)
+           (xerbla "DGETF2" (f2cl-lib:int-sub info))
+           (go end_label)))
+        (if (or (= m 0) (= n 0)) (go end_label))
+        (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
+                      ((> j
+                          (min (the fixnum m)
+                               (the fixnum n)))
+                       nil)
+          (tagbody
+            (setf jp
+                    (f2cl-lib:int-add (f2cl-lib:int-sub j 1)
+                                      (idamax
+                                       (f2cl-lib:int-add (f2cl-lib:int-sub m j)
+                                                         1)
+                                       (f2cl-lib:array-slice a
+                                                             double-float
+                                                             (j j)
+                                                             ((1 lda) (1 *)))
+                                       1)))
+            (setf (f2cl-lib:fref ipiv-%data% (j) ((1 *)) ipiv-%offset%) jp)
+            (cond
+              ((/= (f2cl-lib:fref a (jp j) ((1 lda) (1 *))) zero)
+               (if (/= jp j)
+                   (dswap n
+                    (f2cl-lib:array-slice a double-float (j 1) ((1 lda) (1 *)))
+                    lda
+                    (f2cl-lib:array-slice a
+                                          double-float
+                                          (jp 1)
+                                          ((1 lda) (1 *)))
+                    lda))
+               (if (< j m)
+                   (dscal (f2cl-lib:int-sub m j)
+                    (/ one
+                       (f2cl-lib:fref a-%data%
+                                      (j j)
+                                      ((1 lda) (1 *))
+                                      a-%offset%))
+                    (f2cl-lib:array-slice a
+                                          double-float
+                                          ((+ j 1) j)
+                                          ((1 lda) (1 *)))
+                    1)))
+              ((= info 0)
+               (setf info j)))
+            (cond
+              ((< j (min (the fixnum m) (the fixnum n)))
+               (dger (f2cl-lib:int-sub m j) (f2cl-lib:int-sub n j) (- one)
+                (f2cl-lib:array-slice a
+                                      double-float
+                                      ((+ j 1) j)
+                                      ((1 lda) (1 *)))
+                1
+                (f2cl-lib:array-slice a
+                                      double-float
+                                      (j (f2cl-lib:int-add j 1))
+                                      ((1 lda) (1 *)))
+                lda
+                (f2cl-lib:array-slice a
+                                      double-float
+                                      ((+ j 1) (f2cl-lib:int-add j 1))
+                                      ((1 lda) (1 *)))
+                lda)))))
+        (go end_label)
+ end_label
+        (return (values 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::dgetf2
+                 fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '(fixnum fixnum
+                        (array double-float (*)) fixnum
+                        (array fixnum (*))
+                        fixnum)
+           :return-values '(nil nil nil nil nil fortran-to-lisp::info)
+           :calls '(fortran-to-lisp::dger fortran-to-lisp::dscal
+                    fortran-to-lisp::dswap fortran-to-lisp::idamax
+                    fortran-to-lisp::xerbla))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dgetrf LAPACK}
+\pagehead{dgetrf}{dgetrf}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<LAPACK dgetrf>>=
+(let* ((one 1.0))
+  (declare (type (double-float 1.0 1.0) one))
+  (defun dgetrf (m n a lda ipiv info)
+    (declare (type (array fixnum (*)) ipiv)
+             (type (array double-float (*)) a)
+             (type fixnum info lda n m))
+    (f2cl-lib:with-multi-array-data
+        ((a double-float a-%data% a-%offset%)
+         (ipiv fixnum ipiv-%data% ipiv-%offset%))
+      (prog ((i 0) (iinfo 0) (j 0) (jb 0) (nb 0))
+        (declare (type fixnum i iinfo j jb nb))
+        (setf info 0)
+        (cond
+          ((< m 0)
+           (setf info -1))
+          ((< n 0)
+           (setf info -2))
+          ((< lda (max (the fixnum 1) (the fixnum m)))
+           (setf info -4)))
+        (cond
+          ((/= info 0)
+           (xerbla "DGETRF" (f2cl-lib:int-sub info))
+           (go end_label)))
+        (if (or (= m 0) (= n 0)) (go end_label))
+        (setf nb (ilaenv 1 "DGETRF" " " m n -1 -1))
+        (cond
+          ((or (<= nb 1)
+               (>= nb
+                   (min (the fixnum m) (the fixnum n))))
+           (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5)
+               (dgetf2 m n a lda ipiv info)
+             (declare (ignore var-0 var-1 var-2 var-3 var-4))
+             (setf info var-5)))
+          (t
+           (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j nb))
+                         ((> j
+                             (min (the fixnum m)
+                                  (the fixnum n)))
+                          nil)
+             (tagbody
+               (setf jb
+                       (min
+                        (the fixnum
+                             (f2cl-lib:int-add
+                              (f2cl-lib:int-sub
+                               (min (the fixnum m)
+                                    (the fixnum n))
+                               j)
+                              1))
+                        (the fixnum nb)))
+               (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5)
+                   (dgetf2 (f2cl-lib:int-add (f2cl-lib:int-sub m j) 1) jb
+                    (f2cl-lib:array-slice a double-float (j j) ((1 lda) (1 *)))
+                    lda
+                    (f2cl-lib:array-slice ipiv fixnum (j) ((1 *)))
+                    iinfo)
+                 (declare (ignore var-0 var-1 var-2 var-3 var-4))
+                 (setf iinfo var-5))
+               (if (and (= info 0) (> iinfo 0))
+                   (setf info (f2cl-lib:int-sub (f2cl-lib:int-add iinfo j) 1)))
+               (f2cl-lib:fdo (i j (f2cl-lib:int-add i 1))
+                             ((> i
+                                 (min (the fixnum m)
+                                      (the fixnum
+                                           (f2cl-lib:int-add j
+                                                             jb
+                                                             (f2cl-lib:int-sub
+                                                              1)))))
+                              nil)
+                 (tagbody
+                   (setf (f2cl-lib:fref ipiv-%data% (i) ((1 *)) ipiv-%offset%)
+                           (f2cl-lib:int-add (f2cl-lib:int-sub j 1)
+                                             (f2cl-lib:fref ipiv-%data%
+                                                            (i)
+                                                            ((1 *))
+                                                            ipiv-%offset%)))))
+               (dlaswp (f2cl-lib:int-sub j 1) a lda j
+                (f2cl-lib:int-sub (f2cl-lib:int-add j jb) 1) ipiv 1)
+               (cond
+                 ((<= (f2cl-lib:int-add j jb) n)
+                  (dlaswp (f2cl-lib:int-add (f2cl-lib:int-sub n j jb) 1)
+                   (f2cl-lib:array-slice a
+                                         double-float
+                                         (1 (f2cl-lib:int-add j jb))
+                                         ((1 lda) (1 *)))
+                   lda j (f2cl-lib:int-sub (f2cl-lib:int-add j jb) 1) ipiv 1)
+                  (dtrsm "Left" "Lower" "No transpose" "Unit" jb
+                   (f2cl-lib:int-add (f2cl-lib:int-sub n j jb) 1) one
+                   (f2cl-lib:array-slice a double-float (j j) ((1 lda) (1 *)))
+                   lda
+                   (f2cl-lib:array-slice a
+                                         double-float
+                                         (j (f2cl-lib:int-add j jb))
+                                         ((1 lda) (1 *)))
+                   lda)
+                  (cond
+                    ((<= (f2cl-lib:int-add j jb) m)
+                     (dgemm "No transpose" "No transpose"
+                      (f2cl-lib:int-add (f2cl-lib:int-sub m j jb) 1)
+                      (f2cl-lib:int-add (f2cl-lib:int-sub n j jb) 1) jb (- one)
+                      (f2cl-lib:array-slice a
+                                            double-float
+                                            ((+ j jb) j)
+                                            ((1 lda) (1 *)))
+                      lda
+                      (f2cl-lib:array-slice a
+                                            double-float
+                                            (j (f2cl-lib:int-add j jb))
+                                            ((1 lda) (1 *)))
+                      lda one
+                      (f2cl-lib:array-slice a
+                                            double-float
+                                            ((+ j jb) (f2cl-lib:int-add j jb))
+                                            ((1 lda) (1 *)))
+                      lda)))))))))
+ end_label
+        (return (values 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::dgetrf
+                 fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '(fixnum fixnum
+                        (array double-float (*)) fixnum
+                        (array fixnum (*))
+                        fixnum)
+           :return-values '(nil nil nil nil nil fortran-to-lisp::info)
+           :calls '(fortran-to-lisp::dgemm fortran-to-lisp::dtrsm
+                    fortran-to-lisp::dlaswp fortran-to-lisp::dgetf2
+                    fortran-to-lisp::ilaenv fortran-to-lisp::xerbla))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dgetrs LAPACK}
+\pagehead{dgetrs}{dgetrs}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<LAPACK dgetrs>>=
+(let* ((one 1.0))
+  (declare (type (double-float 1.0 1.0) one))
+  (defun dgetrs (trans n nrhs a lda ipiv b ldb$ info)
+    (declare (type (array fixnum (*)) ipiv)
+             (type (array double-float (*)) b a)
+             (type fixnum info ldb$ lda nrhs n)
+             (type (simple-array character (*)) trans))
+    (f2cl-lib:with-multi-array-data
+        ((trans character trans-%data% trans-%offset%)
+         (a double-float a-%data% a-%offset%)
+         (b double-float b-%data% b-%offset%)
+         (ipiv fixnum ipiv-%data% ipiv-%offset%))
+      (prog ((notran nil))
+        (declare (type (member t nil) notran))
+        (setf info 0)
+        (setf notran (lsame trans "N"))
+        (cond
+          ((and (not notran) (not (lsame trans "T")) (not (lsame trans "C")))
+           (setf info -1))
+          ((< n 0)
+           (setf info -2))
+          ((< nrhs 0)
+           (setf info -3))
+          ((< lda (max (the fixnum 1) (the fixnum n)))
+           (setf info -5))
+          ((< ldb$ (max (the fixnum 1) (the fixnum n)))
+           (setf info -8)))
+        (cond
+          ((/= info 0)
+           (xerbla "DGETRS" (f2cl-lib:int-sub info))
+           (go end_label)))
+        (if (or (= n 0) (= nrhs 0)) (go end_label))
+        (cond
+          (notran
+           (dlaswp nrhs b ldb$ 1 n ipiv 1)
+           (dtrsm "Left" "Lower" "No transpose" "Unit" n nrhs one a lda b ldb$)
+           (dtrsm "Left" "Upper" "No transpose" "Non-unit" n nrhs one a lda b
+            ldb$))
+          (t
+           (dtrsm "Left" "Upper" "Transpose" "Non-unit" n nrhs one a lda b ldb$)
+           (dtrsm "Left" "Lower" "Transpose" "Unit" n nrhs one a lda b ldb$)
+           (dlaswp nrhs b ldb$ 1 n ipiv -1)))
+        (go end_label)
+ end_label
+        (return (values 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::dgetrs
+                 fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '((simple-array character (1))
+                        fixnum fixnum
+                        (array double-float (*)) fixnum
+                        (array fixnum (*))
+                        (array double-float (*)) fixnum
+                        fixnum)
+           :return-values '(nil nil nil nil nil nil nil nil
+                            fortran-to-lisp::info)
+           :calls '(fortran-to-lisp::dtrsm fortran-to-lisp::dlaswp
+                    fortran-to-lisp::xerbla fortran-to-lisp::lsame))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dhseqr LAPACK}
+\pagehead{dhseqr}{dhseqr}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<LAPACK dhseqr>>=
+(let* ((zero 0.0) (one 1.0) (two 2.0) (const 1.5) (nsmax 15) (lds nsmax))
+  (declare (type (double-float 0.0 0.0) zero)
+           (type (double-float 1.0 1.0) one)
+           (type (double-float 2.0 2.0) two)
+           (type (double-float 1.5 1.5) const)
+           (type (fixnum 15 15) nsmax)
+           (type fixnum lds))
+  (defun dhseqr (job compz n ilo ihi h ldh wr wi z ldz work lwork info)
+    (declare (type (array double-float (*)) work z wi wr h)
+             (type fixnum info lwork ldz ldh ihi ilo n)
+             (type (simple-array character (*)) compz job))
+    (f2cl-lib:with-multi-array-data
+        ((job character job-%data% job-%offset%)
+         (compz character compz-%data% compz-%offset%)
+         (h double-float h-%data% h-%offset%)
+         (wr double-float wr-%data% wr-%offset%)
+         (wi double-float wi-%data% wi-%offset%)
+         (z double-float z-%data% z-%offset%)
+         (work double-float work-%data% work-%offset%))
+      (prog ((s
+              (make-array (the fixnum (reduce #'* (list lds nsmax)))
+                          :element-type 'double-float))
+             (v
+              (make-array (f2cl-lib:int-add nsmax 1)
+                          :element-type 'double-float))
+             (vv
+              (make-array (f2cl-lib:int-add nsmax 1)
+                          :element-type 'double-float))
+             (absw 0.0) (ovfl 0.0) (smlnum 0.0) (tau 0.0) (temp 0.0) (tst1 0.0)
+             (ulp 0.0) (unfl 0.0) (i 0) (i1 0) (i2 0) (ierr 0) (ii 0) (itemp 0)
+             (itn 0) (its 0) (j 0) (k 0) (l 0) (maxb 0) (nh 0) (nr 0) (ns 0)
+             (nv 0) (initz nil) (lquery nil) (wantt nil) (wantz nil))
+        (declare (type (array double-float (*)) s v vv)
+                 (type (double-float) absw ovfl smlnum tau temp tst1 ulp unfl)
+                 (type fixnum i i1 i2 ierr ii itemp itn its j k l
+                                           maxb nh nr ns nv)
+                 (type (member t nil) initz lquery wantt wantz))
+        (setf wantt (lsame job "S"))
+        (setf initz (lsame compz "I"))
+        (setf wantz (or initz (lsame compz "V")))
+        (setf info 0)
+        (setf (f2cl-lib:fref work-%data% (1) ((1 *)) work-%offset%)
+                (coerce
+                 (the fixnum
+                      (max (the fixnum 1)
+                           (the fixnum n)))
+                 'double-float))
+        (setf lquery (coerce (= lwork -1) '(member t nil)))
+        (cond
+          ((and (not (lsame job "E")) (not wantt))
+           (setf info -1))
+          ((and (not (lsame compz "N")) (not wantz))
+           (setf info -2))
+          ((< n 0)
+           (setf info -3))
+          ((or (< ilo 1)
+               (> ilo
+                  (max (the fixnum 1) (the fixnum n))))
+           (setf info -4))
+          ((or
+            (< ihi (min (the fixnum ilo) (the fixnum n)))
+            (> ihi n))
+           (setf info -5))
+          ((< ldh (max (the fixnum 1) (the fixnum n)))
+           (setf info -7))
+          ((or (< ldz 1)
+               (and wantz
+                    (< ldz
+                       (max (the fixnum 1)
+                            (the fixnum n)))))
+           (setf info -11))
+          ((and
+            (< lwork (max (the fixnum 1) (the fixnum n)))
+            (not lquery))
+           (setf info -13)))
+        (cond
+          ((/= info 0)
+           (xerbla "DHSEQR" (f2cl-lib:int-sub info))
+           (go end_label))
+          (lquery
+           (go end_label)))
+        (if initz (dlaset "Full" n n zero one z ldz))
+        (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                      ((> i (f2cl-lib:int-add ilo (f2cl-lib:int-sub 1))) nil)
+          (tagbody
+            (setf (f2cl-lib:fref wr-%data% (i) ((1 *)) wr-%offset%)
+                    (f2cl-lib:fref h-%data% (i i) ((1 ldh) (1 *)) h-%offset%))
+            (setf (f2cl-lib:fref wi-%data% (i) ((1 *)) wi-%offset%) zero)))
+        (f2cl-lib:fdo (i (f2cl-lib:int-add ihi 1) (f2cl-lib:int-add i 1))
+                      ((> i n) nil)
+          (tagbody
+            (setf (f2cl-lib:fref wr-%data% (i) ((1 *)) wr-%offset%)
+                    (f2cl-lib:fref h-%data% (i i) ((1 ldh) (1 *)) h-%offset%))
+            (setf (f2cl-lib:fref wi-%data% (i) ((1 *)) wi-%offset%) zero)))
+        (if (= n 0) (go end_label))
+        (cond
+          ((= ilo ihi)
+           (setf (f2cl-lib:fref wr-%data% (ilo) ((1 *)) wr-%offset%)
+                   (f2cl-lib:fref h-%data%
+                                  (ilo ilo)
+                                  ((1 ldh) (1 *))
+                                  h-%offset%))
+           (setf (f2cl-lib:fref wi-%data% (ilo) ((1 *)) wi-%offset%) zero)
+           (go end_label)))
+        (f2cl-lib:fdo (j ilo (f2cl-lib:int-add j 1))
+                      ((> j (f2cl-lib:int-add ihi (f2cl-lib:int-sub 2))) nil)
+          (tagbody
+            (f2cl-lib:fdo (i (f2cl-lib:int-add j 2) (f2cl-lib:int-add i 1))
+                          ((> i n) nil)
+              (tagbody
+                (setf (f2cl-lib:fref h-%data% (i j) ((1 ldh) (1 *)) h-%offset%)
+                        zero)))))
+        (setf nh (f2cl-lib:int-add (f2cl-lib:int-sub ihi ilo) 1))
+        (setf ns (ilaenv 4 "DHSEQR" (f2cl-lib:f2cl-// job compz) n ilo ihi -1))
+        (setf maxb
+                (ilaenv 8 "DHSEQR" (f2cl-lib:f2cl-// job compz) n ilo ihi -1))
+        (cond
+          ((or (<= ns 2) (> ns nh) (>= maxb nh))
+           (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)
+               (dlahqr wantt wantz n ilo ihi h ldh wr wi ilo ihi z ldz 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))
+             (setf info var-13))
+           (go end_label)))
+        (setf maxb
+                (max (the fixnum 3) (the fixnum maxb)))
+        (setf ns
+                (min (the fixnum ns)
+                     (the fixnum maxb)
+                     (the fixnum nsmax)))
+        (setf unfl (dlamch "Safe minimum"))
+        (setf ovfl (/ one unfl))
+        (multiple-value-bind (var-0 var-1)
+            (dlabad unfl ovfl)
+          (declare (ignore))
+          (setf unfl var-0)
+          (setf ovfl var-1))
+        (setf ulp (dlamch "Precision"))
+        (setf smlnum (* unfl (/ nh ulp)))
+        (cond
+          (wantt
+           (setf i1 1)
+           (setf i2 n)))
+        (setf itn (f2cl-lib:int-mul 30 nh))
+        (setf i ihi)
+ label50
+        (setf l ilo)
+        (if (< i ilo) (go label170))
+        (f2cl-lib:fdo (its 0 (f2cl-lib:int-add its 1))
+                      ((> its itn) nil)
+          (tagbody
+            (f2cl-lib:fdo (k i (f2cl-lib:int-add k (f2cl-lib:int-sub 1)))
+                          ((> k (f2cl-lib:int-add l 1)) nil)
+              (tagbody
+                (setf tst1
+                        (+
+                         (abs
+                          (f2cl-lib:fref h-%data%
+                                         ((f2cl-lib:int-sub k 1)
+                                          (f2cl-lib:int-sub k 1))
+                                         ((1 ldh) (1 *))
+                                         h-%offset%))
+                         (abs
+                          (f2cl-lib:fref h-%data%
+                                         (k k)
+                                         ((1 ldh) (1 *))
+                                         h-%offset%))))
+                (if (= tst1 zero)
+                    (setf tst1
+                            (dlanhs "1"
+                             (f2cl-lib:int-add (f2cl-lib:int-sub i l) 1)
+                             (f2cl-lib:array-slice h
+                                                   double-float
+                                                   (l l)
+                                                   ((1 ldh) (1 *)))
+                             ldh work)))
+                (if
+                 (<=
+                  (abs
+                   (f2cl-lib:fref h-%data%
+                                  (k (f2cl-lib:int-sub k 1))
+                                  ((1 ldh) (1 *))
+                                  h-%offset%))
+                  (max (* ulp tst1) smlnum))
+                 (go label70))))
+ label70
+            (setf l k)
+            (cond
+              ((> l ilo)
+               (setf (f2cl-lib:fref h-%data%
+                                    (l (f2cl-lib:int-sub l 1))
+                                    ((1 ldh) (1 *))
+                                    h-%offset%)
+                       zero)))
+            (if (>= l (f2cl-lib:int-add (f2cl-lib:int-sub i maxb) 1))
+                (go label160))
+            (cond
+              ((not wantt)
+               (setf i1 l)
+               (setf i2 i)))
+            (cond
+              ((or (= its 20) (= its 30))
+               (f2cl-lib:fdo (ii (f2cl-lib:int-add i (f2cl-lib:int-sub ns) 1)
+                              (f2cl-lib:int-add ii 1))
+                             ((> ii i) nil)
+                 (tagbody
+                   (setf (f2cl-lib:fref wr-%data% (ii) ((1 *)) wr-%offset%)
+                           (* const
+                              (+
+                               (abs
+                                (f2cl-lib:fref h-%data%
+                                               (ii (f2cl-lib:int-sub ii 1))
+                                               ((1 ldh) (1 *))
+                                               h-%offset%))
+                               (abs
+                                (f2cl-lib:fref h-%data%
+                                               (ii ii)
+                                               ((1 ldh) (1 *))
+                                               h-%offset%)))))
+                   (setf (f2cl-lib:fref wi-%data% (ii) ((1 *)) wi-%offset%)
+                           zero))))
+              (t
+               (dlacpy "Full" ns ns
+                (f2cl-lib:array-slice h
+                                      double-float
+                                      ((+ i (f2cl-lib:int-sub ns) 1)
+                                       (f2cl-lib:int-add
+                                        (f2cl-lib:int-sub i ns)
+                                        1))
+                                      ((1 ldh) (1 *)))
+                ldh s lds)
+               (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)
+                   (dlahqr nil nil ns 1 ns s lds
+                    (f2cl-lib:array-slice wr
+                                          double-float
+                                          ((+ i (f2cl-lib:int-sub ns) 1))
+                                          ((1 *)))
+                    (f2cl-lib:array-slice wi
+                                          double-float
+                                          ((+ i (f2cl-lib:int-sub ns) 1))
+                                          ((1 *)))
+                    1 ns z ldz ierr)
+                 (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))
+                 (setf ierr var-13))
+               (cond
+                 ((> ierr 0)
+                  (f2cl-lib:fdo (ii 1 (f2cl-lib:int-add ii 1))
+                                ((> ii ierr) nil)
+                    (tagbody
+                      (setf (f2cl-lib:fref wr-%data%
+                                           ((f2cl-lib:int-add
+                                             (f2cl-lib:int-sub i ns)
+                                             ii))
+                                           ((1 *))
+                                           wr-%offset%)
+                              (f2cl-lib:fref s (ii ii) ((1 lds) (1 nsmax))))
+                      (setf (f2cl-lib:fref wi-%data%
+                                           ((f2cl-lib:int-add
+                                             (f2cl-lib:int-sub i ns)
+                                             ii))
+                                           ((1 *))
+                                           wi-%offset%)
+                              zero)))))))
+            (setf (f2cl-lib:fref v (1) ((1 (f2cl-lib:int-add nsmax 1)))) one)
+            (f2cl-lib:fdo (ii 2 (f2cl-lib:int-add ii 1))
+                          ((> ii (f2cl-lib:int-add ns 1)) nil)
+              (tagbody
+                (setf (f2cl-lib:fref v (ii) ((1 (f2cl-lib:int-add nsmax 1))))
+                        zero)))
+            (setf nv 1)
+            (f2cl-lib:fdo (j (f2cl-lib:int-add i (f2cl-lib:int-sub ns) 1)
+                           (f2cl-lib:int-add j 1))
+                          ((> j i) nil)
+              (tagbody
+                (cond
+                  ((>= (f2cl-lib:fref wi (j) ((1 *))) zero)
+                   (cond
+                     ((= (f2cl-lib:fref wi (j) ((1 *))) zero)
+                      (dcopy (f2cl-lib:int-add nv 1) v 1 vv 1)
+                      (dgemv "No transpose" (f2cl-lib:int-add nv 1) nv one
+                       (f2cl-lib:array-slice h
+                                             double-float
+                                             (l l)
+                                             ((1 ldh) (1 *)))
+                       ldh vv 1
+                       (- (f2cl-lib:fref wr-%data% (j) ((1 *)) wr-%offset%)) v
+                       1)
+                      (setf nv (f2cl-lib:int-add nv 1)))
+                     ((> (f2cl-lib:fref wi (j) ((1 *))) zero)
+                      (dcopy (f2cl-lib:int-add nv 1) v 1 vv 1)
+                      (dgemv "No transpose" (f2cl-lib:int-add nv 1) nv one
+                       (f2cl-lib:array-slice h
+                                             double-float
+                                             (l l)
+                                             ((1 ldh) (1 *)))
+                       ldh v 1
+                       (* (- two)
+                          (f2cl-lib:fref wr-%data% (j) ((1 *)) wr-%offset%))
+                       vv 1)
+                      (setf itemp (idamax (f2cl-lib:int-add nv 1) vv 1))
+                      (setf temp
+                              (/ one
+                                 (max
+                                  (abs
+                                   (f2cl-lib:fref vv
+                                                  (itemp)
+                                                  ((1
+                                                    (f2cl-lib:int-add nsmax
+                                                                      1)))))
+                                  smlnum)))
+                      (dscal (f2cl-lib:int-add nv 1) temp vv 1)
+                      (setf absw
+                              (dlapy2
+                               (f2cl-lib:fref wr-%data%
+                                              (j)
+                                              ((1 *))
+                                              wr-%offset%)
+                               (f2cl-lib:fref wi-%data%
+                                              (j)
+                                              ((1 *))
+                                              wi-%offset%)))
+                      (setf temp (* temp absw absw))
+                      (dgemv "No transpose" (f2cl-lib:int-add nv 2)
+                       (f2cl-lib:int-add nv 1) one
+                       (f2cl-lib:array-slice h
+                                             double-float
+                                             (l l)
+                                             ((1 ldh) (1 *)))
+                       ldh vv 1 temp v 1)
+                      (setf nv (f2cl-lib:int-add nv 2))))
+                   (setf itemp (idamax nv v 1))
+                   (setf temp
+                           (abs
+                            (f2cl-lib:fref v
+                                           (itemp)
+                                           ((1 (f2cl-lib:int-add nsmax 1))))))
+                   (cond
+                     ((= temp zero)
+                      (setf (f2cl-lib:fref v
+                                           (1)
+                                           ((1 (f2cl-lib:int-add nsmax 1))))
+                              one)
+                      (f2cl-lib:fdo (ii 2 (f2cl-lib:int-add ii 1))
+                                    ((> ii nv) nil)
+                        (tagbody
+                          (setf (f2cl-lib:fref v
+                                               (ii)
+                                               ((1
+                                                 (f2cl-lib:int-add nsmax 1))))
+                                  zero))))
+                     (t
+                      (setf temp (max temp smlnum))
+                      (dscal nv (/ one temp) v 1)))))))
+            (f2cl-lib:fdo (k l (f2cl-lib:int-add k 1))
+                          ((> k (f2cl-lib:int-add i (f2cl-lib:int-sub 1))) nil)
+              (tagbody
+                (setf nr
+                        (min (the fixnum (f2cl-lib:int-add ns 1))
+                             (the fixnum
+                                  (f2cl-lib:int-add (f2cl-lib:int-sub i k)
+                                                    1))))
+                (if (> k l)
+                    (dcopy nr
+                     (f2cl-lib:array-slice h
+                                           double-float
+                                           (k (f2cl-lib:int-sub k 1))
+                                           ((1 ldh) (1 *)))
+                     1 v 1))
+                (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                    (dlarfg nr
+                     (f2cl-lib:fref v (1) ((1 (f2cl-lib:int-add nsmax 1))))
+                     (f2cl-lib:array-slice v
+                                           double-float
+                                           (2)
+                                           ((1 (f2cl-lib:int-add nsmax 1))))
+                     1 tau)
+                  (declare (ignore var-0 var-2 var-3))
+                  (setf (f2cl-lib:fref v (1) ((1 (f2cl-lib:int-add nsmax 1))))
+                          var-1)
+                  (setf tau var-4))
+                (cond
+                  ((> k l)
+                   (setf (f2cl-lib:fref h-%data%
+                                        (k (f2cl-lib:int-sub k 1))
+                                        ((1 ldh) (1 *))
+                                        h-%offset%)
+                           (f2cl-lib:fref v
+                                          (1)
+                                          ((1 (f2cl-lib:int-add nsmax 1)))))
+                   (f2cl-lib:fdo (ii (f2cl-lib:int-add k 1)
+                                  (f2cl-lib:int-add ii 1))
+                                 ((> ii i) nil)
+                     (tagbody
+                       (setf (f2cl-lib:fref h-%data%
+                                            (ii (f2cl-lib:int-sub k 1))
+                                            ((1 ldh) (1 *))
+                                            h-%offset%)
+                               zero)))))
+                (setf (f2cl-lib:fref v (1) ((1 (f2cl-lib:int-add nsmax 1))))
+                        one)
+                (dlarfx "Left" nr (f2cl-lib:int-add (f2cl-lib:int-sub i2 k) 1)
+                 v tau
+                 (f2cl-lib:array-slice h double-float (k k) ((1 ldh) (1 *)))
+                 ldh work)
+                (dlarfx "Right"
+                 (f2cl-lib:int-add
+                  (f2cl-lib:int-sub
+                   (min (the fixnum (f2cl-lib:int-add k nr))
+                        (the fixnum i))
+                   i1)
+                  1)
+                 nr v tau
+                 (f2cl-lib:array-slice h double-float (i1 k) ((1 ldh) (1 *)))
+                 ldh work)
+                (cond
+                  (wantz
+                   (dlarfx "Right" nh nr v tau
+                    (f2cl-lib:array-slice z
+                                          double-float
+                                          (ilo k)
+                                          ((1 ldz) (1 *)))
+                    ldz work)))))))
+        (setf info i)
+        (go end_label)
+ label160
+        (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)
+            (dlahqr wantt wantz n l i h ldh wr wi ilo ihi z ldz 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))
+          (setf info var-13))
+        (if (> info 0) (go end_label))
+        (setf itn (f2cl-lib:int-sub itn its))
+        (setf i (f2cl-lib:int-sub l 1))
+        (go label50)
+ label170
+        (setf (f2cl-lib:fref work-%data% (1) ((1 *)) work-%offset%)
+                (coerce
+                 (the fixnum
+                      (max (the fixnum 1)
+                           (the fixnum n)))
+                 'double-float))
+ end_label
+        (return
+         (values nil nil 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::dhseqr
+                 fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '((simple-array character (1))
+                        (simple-array character (1))
+                        fixnum fixnum
+                        fixnum (array double-float (*))
+                        fixnum (array double-float (*))
+                        (array double-float (*)) (array double-float (*))
+                        fixnum (array double-float (*))
+                        fixnum
+                        fixnum)
+           :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil nil
+                            fortran-to-lisp::info)
+           :calls '(fortran-to-lisp::dlarfx fortran-to-lisp::dlarfg
+                    fortran-to-lisp::dlapy2 fortran-to-lisp::dscal
+                    fortran-to-lisp::idamax fortran-to-lisp::dgemv
+                    fortran-to-lisp::dcopy fortran-to-lisp::dlacpy
+                    fortran-to-lisp::dlanhs fortran-to-lisp::dlabad
+                    fortran-to-lisp::dlamch fortran-to-lisp::dlahqr
+                    fortran-to-lisp::ilaenv fortran-to-lisp::dlaset
+                    fortran-to-lisp::xerbla fortran-to-lisp::lsame))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dlabad LAPACK}
+\pagehead{dlabad}{dlabad}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<LAPACK dlabad>>=
+(defun dlabad (small large)
+  (declare (type (double-float) large small))
+  (prog ()
+    (declare)
+    (cond
+      ((> (f2cl-lib:log10 large) 2000.0)
+       (setf small (f2cl-lib:fsqrt small))
+       (setf large (f2cl-lib:fsqrt large))))
+    (return (values small large))))
+
+(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::dlabad
+                 fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '((double-float) (double-float))
+           :return-values '(fortran-to-lisp::small fortran-to-lisp::large)
+           :calls 'nil)))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dlabrd LAPACK}
+\pagehead{dlabrd}{dlabrd}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<LAPACK dlabrd>>=
+(let* ((zero 0.0) (one 1.0))
+  (declare (type (double-float 0.0 0.0) zero)
+           (type (double-float 1.0 1.0) one))
+  (defun dlabrd (m n nb a lda d e tauq taup x ldx y ldy)
+    (declare (type (array double-float (*)) y x taup tauq e d a)
+             (type fixnum ldy ldx lda nb n m))
+    (f2cl-lib:with-multi-array-data
+        ((a double-float a-%data% a-%offset%)
+         (d double-float d-%data% d-%offset%)
+         (e double-float e-%data% e-%offset%)
+         (tauq double-float tauq-%data% tauq-%offset%)
+         (taup double-float taup-%data% taup-%offset%)
+         (x double-float x-%data% x-%offset%)
+         (y double-float y-%data% y-%offset%))
+      (prog ((i 0))
+        (declare (type fixnum i))
+        (if (or (<= m 0) (<= n 0)) (go end_label))
+        (cond
+          ((>= m n)
+           (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                         ((> i nb) nil)
+             (tagbody
+               (dgemv "No transpose"
+                (f2cl-lib:int-add (f2cl-lib:int-sub m i) 1)
+                (f2cl-lib:int-sub i 1) (- one)
+                (f2cl-lib:array-slice a double-float (i 1) ((1 lda) (1 *))) lda
+                (f2cl-lib:array-slice y double-float (i 1) ((1 ldy) (1 *))) ldy
+                one (f2cl-lib:array-slice a double-float (i i) ((1 lda) (1 *)))
+                1)
+               (dgemv "No transpose"
+                (f2cl-lib:int-add (f2cl-lib:int-sub m i) 1)
+                (f2cl-lib:int-sub i 1) (- one)
+                (f2cl-lib:array-slice x double-float (i 1) ((1 ldx) (1 *))) ldx
+                (f2cl-lib:array-slice a double-float (1 i) ((1 lda) (1 *))) 1
+                one (f2cl-lib:array-slice a double-float (i i) ((1 lda) (1 *)))
+                1)
+               (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                   (dlarfg (f2cl-lib:int-add (f2cl-lib:int-sub m i) 1)
+                    (f2cl-lib:fref a-%data% (i i) ((1 lda) (1 *)) a-%offset%)
+                    (f2cl-lib:array-slice a
+                                          double-float
+                                          ((min (f2cl-lib:int-add i 1) m) i)
+                                          ((1 lda) (1 *)))
+                    1 (f2cl-lib:fref tauq-%data% (i) ((1 *)) tauq-%offset%))
+                 (declare (ignore var-0 var-2 var-3))
+                 (setf (f2cl-lib:fref a-%data%
+                                      (i i)
+                                      ((1 lda) (1 *))
+                                      a-%offset%)
+                         var-1)
+                 (setf (f2cl-lib:fref tauq-%data% (i) ((1 *)) tauq-%offset%)
+                         var-4))
+               (setf (f2cl-lib:fref d-%data% (i) ((1 *)) d-%offset%)
+                       (f2cl-lib:fref a-%data%
+                                      (i i)
+                                      ((1 lda) (1 *))
+                                      a-%offset%))
+               (cond
+                 ((< i n)
+                  (setf (f2cl-lib:fref a-%data%
+                                       (i i)
+                                       ((1 lda) (1 *))
+                                       a-%offset%)
+                          one)
+                  (dgemv "Transpose"
+                   (f2cl-lib:int-add (f2cl-lib:int-sub m i) 1)
+                   (f2cl-lib:int-sub n i) one
+                   (f2cl-lib:array-slice a
+                                         double-float
+                                         (i (f2cl-lib:int-add i 1))
+                                         ((1 lda) (1 *)))
+                   lda
+                   (f2cl-lib:array-slice a double-float (i i) ((1 lda) (1 *)))
+                   1 zero
+                   (f2cl-lib:array-slice y
+                                         double-float
+                                         ((+ i 1) i)
+                                         ((1 ldy) (1 *)))
+                   1)
+                  (dgemv "Transpose"
+                   (f2cl-lib:int-add (f2cl-lib:int-sub m i) 1)
+                   (f2cl-lib:int-sub i 1) one
+                   (f2cl-lib:array-slice a double-float (i 1) ((1 lda) (1 *)))
+                   lda
+                   (f2cl-lib:array-slice a double-float (i i) ((1 lda) (1 *)))
+                   1 zero
+                   (f2cl-lib:array-slice y double-float (1 i) ((1 ldy) (1 *)))
+                   1)
+                  (dgemv "No transpose" (f2cl-lib:int-sub n i)
+                   (f2cl-lib:int-sub i 1) (- one)
+                   (f2cl-lib:array-slice y
+                                         double-float
+                                         ((+ i 1) 1)
+                                         ((1 ldy) (1 *)))
+                   ldy
+                   (f2cl-lib:array-slice y double-float (1 i) ((1 ldy) (1 *)))
+                   1 one
+                   (f2cl-lib:array-slice y
+                                         double-float
+                                         ((+ i 1) i)
+                                         ((1 ldy) (1 *)))
+                   1)
+                  (dgemv "Transpose"
+                   (f2cl-lib:int-add (f2cl-lib:int-sub m i) 1)
+                   (f2cl-lib:int-sub i 1) one
+                   (f2cl-lib:array-slice x double-float (i 1) ((1 ldx) (1 *)))
+                   ldx
+                   (f2cl-lib:array-slice a double-float (i i) ((1 lda) (1 *)))
+                   1 zero
+                   (f2cl-lib:array-slice y double-float (1 i) ((1 ldy) (1 *)))
+                   1)
+                  (dgemv "Transpose" (f2cl-lib:int-sub i 1)
+                   (f2cl-lib:int-sub n i) (- one)
+                   (f2cl-lib:array-slice a
+                                         double-float
+                                         (1 (f2cl-lib:int-add i 1))
+                                         ((1 lda) (1 *)))
+                   lda
+                   (f2cl-lib:array-slice y double-float (1 i) ((1 ldy) (1 *)))
+                   1 one
+                   (f2cl-lib:array-slice y
+                                         double-float
+                                         ((+ i 1) i)
+                                         ((1 ldy) (1 *)))
+                   1)
+                  (dscal (f2cl-lib:int-sub n i)
+                   (f2cl-lib:fref tauq-%data% (i) ((1 *)) tauq-%offset%)
+                   (f2cl-lib:array-slice y
+                                         double-float
+                                         ((+ i 1) i)
+                                         ((1 ldy) (1 *)))
+                   1)
+                  (dgemv "No transpose" (f2cl-lib:int-sub n i) i (- one)
+                   (f2cl-lib:array-slice y
+                                         double-float
+                                         ((+ i 1) 1)
+                                         ((1 ldy) (1 *)))
+                   ldy
+                   (f2cl-lib:array-slice a double-float (i 1) ((1 lda) (1 *)))
+                   lda one
+                   (f2cl-lib:array-slice a
+                                         double-float
+                                         (i (f2cl-lib:int-add i 1))
+                                         ((1 lda) (1 *)))
+                   lda)
+                  (dgemv "Transpose" (f2cl-lib:int-sub i 1)
+                   (f2cl-lib:int-sub n i) (- one)
+                   (f2cl-lib:array-slice a
+                                         double-float
+                                         (1 (f2cl-lib:int-add i 1))
+                                         ((1 lda) (1 *)))
+                   lda
+                   (f2cl-lib:array-slice x double-float (i 1) ((1 ldx) (1 *)))
+                   ldx one
+                   (f2cl-lib:array-slice a
+                                         double-float
+                                         (i (f2cl-lib:int-add i 1))
+                                         ((1 lda) (1 *)))
+                   lda)
+                  (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                      (dlarfg (f2cl-lib:int-sub n i)
+                       (f2cl-lib:fref a-%data%
+                                      (i (f2cl-lib:int-add i 1))
+                                      ((1 lda) (1 *))
+                                      a-%offset%)
+                       (f2cl-lib:array-slice a
+                                             double-float
+                                             (i
+                                              (min
+                                               (the fixnum
+                                                    (f2cl-lib:int-add i 2))
+                                               (the fixnum n)))
+                                             ((1 lda) (1 *)))
+                       lda
+                       (f2cl-lib:fref taup-%data% (i) ((1 *)) taup-%offset%))
+                    (declare (ignore var-0 var-2 var-3))
+                    (setf (f2cl-lib:fref a-%data%
+                                         (i (f2cl-lib:int-add i 1))
+                                         ((1 lda) (1 *))
+                                         a-%offset%)
+                            var-1)
+                    (setf (f2cl-lib:fref taup-%data% (i) ((1 *)) taup-%offset%)
+                            var-4))
+                  (setf (f2cl-lib:fref e-%data% (i) ((1 *)) e-%offset%)
+                          (f2cl-lib:fref a-%data%
+                                         (i (f2cl-lib:int-add i 1))
+                                         ((1 lda) (1 *))
+                                         a-%offset%))
+                  (setf (f2cl-lib:fref a-%data%
+                                       (i (f2cl-lib:int-add i 1))
+                                       ((1 lda) (1 *))
+                                       a-%offset%)
+                          one)
+                  (dgemv "No transpose" (f2cl-lib:int-sub m i)
+                   (f2cl-lib:int-sub n i) one
+                   (f2cl-lib:array-slice a
+                                         double-float
+                                         ((+ i 1) (f2cl-lib:int-add i 1))
+                                         ((1 lda) (1 *)))
+                   lda
+                   (f2cl-lib:array-slice a
+                                         double-float
+                                         (i (f2cl-lib:int-add i 1))
+                                         ((1 lda) (1 *)))
+                   lda zero
+                   (f2cl-lib:array-slice x
+                                         double-float
+                                         ((+ i 1) i)
+                                         ((1 ldx) (1 *)))
+                   1)
+                  (dgemv "Transpose" (f2cl-lib:int-sub n i) i one
+                   (f2cl-lib:array-slice y
+                                         double-float
+                                         ((+ i 1) 1)
+                                         ((1 ldy) (1 *)))
+                   ldy
+                   (f2cl-lib:array-slice a
+                                         double-float
+                                         (i (f2cl-lib:int-add i 1))
+                                         ((1 lda) (1 *)))
+                   lda zero
+                   (f2cl-lib:array-slice x double-float (1 i) ((1 ldx) (1 *)))
+                   1)
+                  (dgemv "No transpose" (f2cl-lib:int-sub m i) i (- one)
+                   (f2cl-lib:array-slice a
+                                         double-float
+                                         ((+ i 1) 1)
+                                         ((1 lda) (1 *)))
+                   lda
+                   (f2cl-lib:array-slice x double-float (1 i) ((1 ldx) (1 *)))
+                   1 one
+                   (f2cl-lib:array-slice x
+                                         double-float
+                                         ((+ i 1) i)
+                                         ((1 ldx) (1 *)))
+                   1)
+                  (dgemv "No transpose" (f2cl-lib:int-sub i 1)
+                   (f2cl-lib:int-sub n i) one
+                   (f2cl-lib:array-slice a
+                                         double-float
+                                         (1 (f2cl-lib:int-add i 1))
+                                         ((1 lda) (1 *)))
+                   lda
+                   (f2cl-lib:array-slice a
+                                         double-float
+                                         (i (f2cl-lib:int-add i 1))
+                                         ((1 lda) (1 *)))
+                   lda zero
+                   (f2cl-lib:array-slice x double-float (1 i) ((1 ldx) (1 *)))
+                   1)
+                  (dgemv "No transpose" (f2cl-lib:int-sub m i)
+                   (f2cl-lib:int-sub i 1) (- one)
+                   (f2cl-lib:array-slice x
+                                         double-float
+                                         ((+ i 1) 1)
+                                         ((1 ldx) (1 *)))
+                   ldx
+                   (f2cl-lib:array-slice x double-float (1 i) ((1 ldx) (1 *)))
+                   1 one
+                   (f2cl-lib:array-slice x
+                                         double-float
+                                         ((+ i 1) i)
+                                         ((1 ldx) (1 *)))
+                   1)
+                  (dscal (f2cl-lib:int-sub m i)
+                   (f2cl-lib:fref taup-%data% (i) ((1 *)) taup-%offset%)
+                   (f2cl-lib:array-slice x
+                                         double-float
+                                         ((+ i 1) i)
+                                         ((1 ldx) (1 *)))
+                   1))))))
+          (t
+           (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                         ((> i nb) nil)
+             (tagbody
+               (dgemv "No transpose"
+                (f2cl-lib:int-add (f2cl-lib:int-sub n i) 1)
+                (f2cl-lib:int-sub i 1) (- one)
+                (f2cl-lib:array-slice y double-float (i 1) ((1 ldy) (1 *))) ldy
+                (f2cl-lib:array-slice a double-float (i 1) ((1 lda) (1 *))) lda
+                one (f2cl-lib:array-slice a double-float (i i) ((1 lda) (1 *)))
+                lda)
+               (dgemv "Transpose" (f2cl-lib:int-sub i 1)
+                (f2cl-lib:int-add (f2cl-lib:int-sub n i) 1) (- one)
+                (f2cl-lib:array-slice a double-float (1 i) ((1 lda) (1 *))) lda
+                (f2cl-lib:array-slice x double-float (i 1) ((1 ldx) (1 *))) ldx
+                one (f2cl-lib:array-slice a double-float (i i) ((1 lda) (1 *)))
+                lda)
+               (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                   (dlarfg (f2cl-lib:int-add (f2cl-lib:int-sub n i) 1)
+                    (f2cl-lib:fref a-%data% (i i) ((1 lda) (1 *)) a-%offset%)
+                    (f2cl-lib:array-slice a
+                                          double-float
+                                          (i
+                                           (min
+                                            (the fixnum
+                                                 (f2cl-lib:int-add i 1))
+                                            (the fixnum n)))
+                                          ((1 lda) (1 *)))
+                    lda (f2cl-lib:fref taup-%data% (i) ((1 *)) taup-%offset%))
+                 (declare (ignore var-0 var-2 var-3))
+                 (setf (f2cl-lib:fref a-%data%
+                                      (i i)
+                                      ((1 lda) (1 *))
+                                      a-%offset%)
+                         var-1)
+                 (setf (f2cl-lib:fref taup-%data% (i) ((1 *)) taup-%offset%)
+                         var-4))
+               (setf (f2cl-lib:fref d-%data% (i) ((1 *)) d-%offset%)
+                       (f2cl-lib:fref a-%data%
+                                      (i i)
+                                      ((1 lda) (1 *))
+                                      a-%offset%))
+               (cond
+                 ((< i m)
+                  (setf (f2cl-lib:fref a-%data%
+                                       (i i)
+                                       ((1 lda) (1 *))
+                                       a-%offset%)
+                          one)
+                  (dgemv "No transpose" (f2cl-lib:int-sub m i)
+                   (f2cl-lib:int-add (f2cl-lib:int-sub n i) 1) one
+                   (f2cl-lib:array-slice a
+                                         double-float
+                                         ((+ i 1) i)
+                                         ((1 lda) (1 *)))
+                   lda
+                   (f2cl-lib:array-slice a double-float (i i) ((1 lda) (1 *)))
+                   lda zero
+                   (f2cl-lib:array-slice x
+                                         double-float
+                                         ((+ i 1) i)
+                                         ((1 ldx) (1 *)))
+                   1)
+                  (dgemv "Transpose"
+                   (f2cl-lib:int-add (f2cl-lib:int-sub n i) 1)
+                   (f2cl-lib:int-sub i 1) one
+                   (f2cl-lib:array-slice y double-float (i 1) ((1 ldy) (1 *)))
+                   ldy
+                   (f2cl-lib:array-slice a double-float (i i) ((1 lda) (1 *)))
+                   lda zero
+                   (f2cl-lib:array-slice x double-float (1 i) ((1 ldx) (1 *)))
+                   1)
+                  (dgemv "No transpose" (f2cl-lib:int-sub m i)
+                   (f2cl-lib:int-sub i 1) (- one)
+                   (f2cl-lib:array-slice a
+                                         double-float
+                                         ((+ i 1) 1)
+                                         ((1 lda) (1 *)))
+                   lda
+                   (f2cl-lib:array-slice x double-float (1 i) ((1 ldx) (1 *)))
+                   1 one
+                   (f2cl-lib:array-slice x
+                                         double-float
+                                         ((+ i 1) i)
+                                         ((1 ldx) (1 *)))
+                   1)
+                  (dgemv "No transpose" (f2cl-lib:int-sub i 1)
+                   (f2cl-lib:int-add (f2cl-lib:int-sub n i) 1) one
+                   (f2cl-lib:array-slice a double-float (1 i) ((1 lda) (1 *)))
+                   lda
+                   (f2cl-lib:array-slice a double-float (i i) ((1 lda) (1 *)))
+                   lda zero
+                   (f2cl-lib:array-slice x double-float (1 i) ((1 ldx) (1 *)))
+                   1)
+                  (dgemv "No transpose" (f2cl-lib:int-sub m i)
+                   (f2cl-lib:int-sub i 1) (- one)
+                   (f2cl-lib:array-slice x
+                                         double-float
+                                         ((+ i 1) 1)
+                                         ((1 ldx) (1 *)))
+                   ldx
+                   (f2cl-lib:array-slice x double-float (1 i) ((1 ldx) (1 *)))
+                   1 one
+                   (f2cl-lib:array-slice x
+                                         double-float
+                                         ((+ i 1) i)
+                                         ((1 ldx) (1 *)))
+                   1)
+                  (dscal (f2cl-lib:int-sub m i)
+                   (f2cl-lib:fref taup-%data% (i) ((1 *)) taup-%offset%)
+                   (f2cl-lib:array-slice x
+                                         double-float
+                                         ((+ i 1) i)
+                                         ((1 ldx) (1 *)))
+                   1)
+                  (dgemv "No transpose" (f2cl-lib:int-sub m i)
+                   (f2cl-lib:int-sub i 1) (- one)
+                   (f2cl-lib:array-slice a
+                                         double-float
+                                         ((+ i 1) 1)
+                                         ((1 lda) (1 *)))
+                   lda
+                   (f2cl-lib:array-slice y double-float (i 1) ((1 ldy) (1 *)))
+                   ldy one
+                   (f2cl-lib:array-slice a
+                                         double-float
+                                         ((+ i 1) i)
+                                         ((1 lda) (1 *)))
+                   1)
+                  (dgemv "No transpose" (f2cl-lib:int-sub m i) i (- one)
+                   (f2cl-lib:array-slice x
+                                         double-float
+                                         ((+ i 1) 1)
+                                         ((1 ldx) (1 *)))
+                   ldx
+                   (f2cl-lib:array-slice a double-float (1 i) ((1 lda) (1 *)))
+                   1 one
+                   (f2cl-lib:array-slice a
+                                         double-float
+                                         ((+ i 1) i)
+                                         ((1 lda) (1 *)))
+                   1)
+                  (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                      (dlarfg (f2cl-lib:int-sub m i)
+                       (f2cl-lib:fref a-%data%
+                                      ((f2cl-lib:int-add i 1) i)
+                                      ((1 lda) (1 *))
+                                      a-%offset%)
+                       (f2cl-lib:array-slice a
+                                             double-float
+                                             ((min (f2cl-lib:int-add i 2) m) i)
+                                             ((1 lda) (1 *)))
+                       1 (f2cl-lib:fref tauq-%data% (i) ((1 *)) tauq-%offset%))
+                    (declare (ignore var-0 var-2 var-3))
+                    (setf (f2cl-lib:fref a-%data%
+                                         ((f2cl-lib:int-add i 1) i)
+                                         ((1 lda) (1 *))
+                                         a-%offset%)
+                            var-1)
+                    (setf (f2cl-lib:fref tauq-%data% (i) ((1 *)) tauq-%offset%)
+                            var-4))
+                  (setf (f2cl-lib:fref e-%data% (i) ((1 *)) e-%offset%)
+                          (f2cl-lib:fref a-%data%
+                                         ((f2cl-lib:int-add i 1) i)
+                                         ((1 lda) (1 *))
+                                         a-%offset%))
+                  (setf (f2cl-lib:fref a-%data%
+                                       ((f2cl-lib:int-add i 1) i)
+                                       ((1 lda) (1 *))
+                                       a-%offset%)
+                          one)
+                  (dgemv "Transpose" (f2cl-lib:int-sub m i)
+                   (f2cl-lib:int-sub n i) one
+                   (f2cl-lib:array-slice a
+                                         double-float
+                                         ((+ i 1) (f2cl-lib:int-add i 1))
+                                         ((1 lda) (1 *)))
+                   lda
+                   (f2cl-lib:array-slice a
+                                         double-float
+                                         ((+ i 1) i)
+                                         ((1 lda) (1 *)))
+                   1 zero
+                   (f2cl-lib:array-slice y
+                                         double-float
+                                         ((+ i 1) i)
+                                         ((1 ldy) (1 *)))
+                   1)
+                  (dgemv "Transpose" (f2cl-lib:int-sub m i)
+                   (f2cl-lib:int-sub i 1) one
+                   (f2cl-lib:array-slice a
+                                         double-float
+                                         ((+ i 1) 1)
+                                         ((1 lda) (1 *)))
+                   lda
+                   (f2cl-lib:array-slice a
+                                         double-float
+                                         ((+ i 1) i)
+                                         ((1 lda) (1 *)))
+                   1 zero
+                   (f2cl-lib:array-slice y double-float (1 i) ((1 ldy) (1 *)))
+                   1)
+                  (dgemv "No transpose" (f2cl-lib:int-sub n i)
+                   (f2cl-lib:int-sub i 1) (- one)
+                   (f2cl-lib:array-slice y
+                                         double-float
+                                         ((+ i 1) 1)
+                                         ((1 ldy) (1 *)))
+                   ldy
+                   (f2cl-lib:array-slice y double-float (1 i) ((1 ldy) (1 *)))
+                   1 one
+                   (f2cl-lib:array-slice y
+                                         double-float
+                                         ((+ i 1) i)
+                                         ((1 ldy) (1 *)))
+                   1)
+                  (dgemv "Transpose" (f2cl-lib:int-sub m i) i one
+                   (f2cl-lib:array-slice x
+                                         double-float
+                                         ((+ i 1) 1)
+                                         ((1 ldx) (1 *)))
+                   ldx
+                   (f2cl-lib:array-slice a
+                                         double-float
+                                         ((+ i 1) i)
+                                         ((1 lda) (1 *)))
+                   1 zero
+                   (f2cl-lib:array-slice y double-float (1 i) ((1 ldy) (1 *)))
+                   1)
+                  (dgemv "Transpose" i (f2cl-lib:int-sub n i) (- one)
+                   (f2cl-lib:array-slice a
+                                         double-float
+                                         (1 (f2cl-lib:int-add i 1))
+                                         ((1 lda) (1 *)))
+                   lda
+                   (f2cl-lib:array-slice y double-float (1 i) ((1 ldy) (1 *)))
+                   1 one
+                   (f2cl-lib:array-slice y
+                                         double-float
+                                         ((+ i 1) i)
+                                         ((1 ldy) (1 *)))
+                   1)
+                  (dscal (f2cl-lib:int-sub n i)
+                   (f2cl-lib:fref tauq-%data% (i) ((1 *)) tauq-%offset%)
+                   (f2cl-lib:array-slice y
+                                         double-float
+                                         ((+ i 1) i)
+                                         ((1 ldy) (1 *)))
+                   1)))))))
+ end_label
+        (return
+         (values nil nil nil nil nil nil nil nil 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::dlabrd
+                 fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '(fixnum fixnum
+                        fixnum (array double-float (*))
+                        fixnum (array double-float (*))
+                        (array double-float (*)) (array double-float (*))
+                        (array double-float (*)) (array double-float (*))
+                        fixnum (array double-float (*))
+                        fixnum)
+           :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil
+                            nil)
+           :calls '(fortran-to-lisp::dscal fortran-to-lisp::dlarfg
+                    fortran-to-lisp::dgemv))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dlacon LAPACK}
+\pagehead{dlacon}{dlacon}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<LAPACK dlacon>>=
+(let* ((itmax 5) (zero 0.0) (one 1.0) (two 2.0))
+  (declare (type (fixnum 5 5) itmax)
+           (type (double-float 0.0 0.0) zero)
+           (type (double-float 1.0 1.0) one)
+           (type (double-float 2.0 2.0) two))
+  (let ((altsgn 0.0)
+        (estold 0.0)
+        (temp 0.0)
+        (i 0)
+        (iter 0)
+        (j 0)
+        (jlast 0)
+        (jump 0))
+    (declare (type fixnum itmax jump jlast j iter i)
+             (type (double-float) two one zero temp estold altsgn))
+    (defun dlacon (n v x isgn est kase)
+      (declare (type (double-float) est)
+               (type (array fixnum (*)) isgn)
+               (type (array double-float (*)) x v)
+               (type fixnum kase n))
+      (f2cl-lib:with-multi-array-data
+          ((v double-float v-%data% v-%offset%)
+           (x double-float x-%data% x-%offset%)
+           (isgn fixnum isgn-%data% isgn-%offset%))
+        (prog ()
+          (declare)
+          (cond
+            ((= kase 0)
+             (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                           ((> i n) nil)
+               (tagbody
+                 (setf (f2cl-lib:fref x-%data% (i) ((1 *)) x-%offset%)
+                         (/ one (coerce (realpart n) 'double-float)))))
+             (setf kase 1)
+             (setf jump 1)
+             (go end_label)))
+          (f2cl-lib:computed-goto (label20 label40 label70 label110 label140)
+                                  jump)
+ label20
+          (cond
+            ((= n 1)
+             (setf (f2cl-lib:fref v-%data% (1) ((1 *)) v-%offset%)
+                     (f2cl-lib:fref x-%data% (1) ((1 *)) x-%offset%))
+             (setf est (abs (f2cl-lib:fref v-%data% (1) ((1 *)) v-%offset%)))
+             (go label150)))
+          (setf est (dasum n x 1))
+          (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                        ((> i n) nil)
+            (tagbody
+              (setf (f2cl-lib:fref x-%data% (i) ((1 *)) x-%offset%)
+                      (f2cl-lib:sign one
+                                     (f2cl-lib:fref x-%data%
+                                                    (i)
+                                                    ((1 *))
+                                                    x-%offset%)))
+              (setf (f2cl-lib:fref isgn-%data% (i) ((1 *)) isgn-%offset%)
+                      (values (round
+                       (f2cl-lib:fref x-%data% (i) ((1 *)) x-%offset%))))))
+          (setf kase 2)
+          (setf jump 2)
+          (go end_label)
+ label40
+          (setf j (idamax n x 1))
+          (setf iter 2)
+ label50
+          (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                        ((> i n) nil)
+            (tagbody
+              (setf (f2cl-lib:fref x-%data% (i) ((1 *)) x-%offset%) zero)))
+          (setf (f2cl-lib:fref x-%data% (j) ((1 *)) x-%offset%) one)
+          (setf kase 1)
+          (setf jump 3)
+          (go end_label)
+ label70
+          (dcopy n x 1 v 1)
+          (setf estold est)
+          (setf est (dasum n v 1))
+          (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                        ((> i n) nil)
+            (tagbody
+              (if
+               (/=
+                (values (round
+                 (f2cl-lib:sign one
+                                (f2cl-lib:fref x-%data%
+                                               (i)
+                                               ((1 *))
+                                               x-%offset%))))
+                (f2cl-lib:fref isgn-%data% (i) ((1 *)) isgn-%offset%))
+               (go label90))))
+          (go label120)
+ label90
+          (if (<= est estold) (go label120))
+          (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                        ((> i n) nil)
+            (tagbody
+              (setf (f2cl-lib:fref x-%data% (i) ((1 *)) x-%offset%)
+                      (f2cl-lib:sign one
+                                     (f2cl-lib:fref x-%data%
+                                                    (i)
+                                                    ((1 *))
+                                                    x-%offset%)))
+              (setf (f2cl-lib:fref isgn-%data% (i) ((1 *)) isgn-%offset%)
+                      (values (round
+                       (f2cl-lib:fref x-%data% (i) ((1 *)) x-%offset%))))))
+          (setf kase 2)
+          (setf jump 4)
+          (go end_label)
+ label110
+          (setf jlast j)
+          (setf j (idamax n x 1))
+          (cond
+            ((and
+              (/= (f2cl-lib:fref x (jlast) ((1 *)))
+                  (abs (f2cl-lib:fref x (j) ((1 *)))))
+              (< iter itmax))
+             (setf iter (f2cl-lib:int-add iter 1))
+             (go label50)))
+ label120
+          (setf altsgn one)
+          (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                        ((> i n) nil)
+            (tagbody
+              (setf (f2cl-lib:fref x-%data% (i) ((1 *)) x-%offset%)
+               (* altsgn
+                (+ one
+                 (/ 
+                  (coerce (realpart (f2cl-lib:int-sub i 1)) 'double-float)
+                  (coerce (realpart (f2cl-lib:int-sub n 1)) 'double-float)))))
+              (setf altsgn (- altsgn))))
+          (setf kase 1)
+          (setf jump 5)
+          (go end_label)
+ label140
+          (setf temp
+           (* two
+            (/ (dasum n x 1)
+               (coerce (realpart (f2cl-lib:int-mul 3 n)) 'double-float))))
+          (cond
+            ((> temp est)
+             (dcopy n x 1 v 1)
+             (setf est temp)))
+ label150
+          (setf kase 0)
+ end_label
+          (return (values nil nil nil nil est kase)))))))
+
+(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::dlacon
+                 fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '(fixnum (array double-float (*))
+                        (array double-float (*))
+                        (array fixnum (*)) (double-float)
+                        fixnum)
+           :return-values '(nil nil nil nil fortran-to-lisp::est
+                            fortran-to-lisp::kase)
+           :calls '(fortran-to-lisp::dcopy fortran-to-lisp::idamax
+                    fortran-to-lisp::dasum))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dlacpy LAPACK}
+\pagehead{dlacpy}{dlacpy}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<LAPACK dlacpy>>=
+(defun dlacpy (uplo m n a lda b ldb$)
+  (declare (type (array double-float (*)) b a)
+           (type fixnum ldb$ lda n m)
+           (type (simple-array character (*)) uplo))
+  (f2cl-lib:with-multi-array-data
+      ((uplo character uplo-%data% uplo-%offset%)
+       (a double-float a-%data% a-%offset%)
+       (b double-float b-%data% b-%offset%))
+    (prog ((i 0) (j 0))
+      (declare (type fixnum j i))
+      (cond
+        ((lsame uplo "U")
+         (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
+                       ((> j n) nil)
+           (tagbody
+             (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                           ((> i
+                               (min (the fixnum j)
+                                    (the fixnum m)))
+                            nil)
+               (tagbody
+                 (setf (f2cl-lib:fref b-%data%
+                                      (i j)
+                                      ((1 ldb$) (1 *))
+                                      b-%offset%)
+                         (f2cl-lib:fref a-%data%
+                                        (i j)
+                                        ((1 lda) (1 *))
+                                        a-%offset%)))))))
+        ((lsame uplo "L")
+         (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
+                       ((> j n) nil)
+           (tagbody
+             (f2cl-lib:fdo (i j (f2cl-lib:int-add i 1))
+                           ((> i m) nil)
+               (tagbody
+                 (setf (f2cl-lib:fref b-%data%
+                                      (i j)
+                                      ((1 ldb$) (1 *))
+                                      b-%offset%)
+                         (f2cl-lib:fref a-%data%
+                                        (i j)
+                                        ((1 lda) (1 *))
+                                        a-%offset%)))))))
+        (t
+         (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
+                       ((> j n) nil)
+           (tagbody
+             (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                           ((> i m) nil)
+               (tagbody
+                 (setf (f2cl-lib:fref b-%data%
+                                      (i j)
+                                      ((1 ldb$) (1 *))
+                                      b-%offset%)
+                         (f2cl-lib:fref a-%data%
+                                        (i j)
+                                        ((1 lda) (1 *))
+                                        a-%offset%))))))))
+ end_label
+      (return (values nil nil 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::dlacpy
+                 fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '((simple-array character (1))
+                        fixnum fixnum
+                        (array double-float (*)) fixnum
+                        (array double-float (*)) fixnum)
+           :return-values '(nil nil nil nil nil nil nil)
+           :calls '(fortran-to-lisp::lsame))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dladiv LAPACK}
+\pagehead{dladiv}{dladiv}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<LAPACK dladiv>>=
+(defun dladiv (a b c d p q)
+  (declare (type (double-float) q p d c b a))
+  (prog ((e 0.0) (f 0.0))
+    (declare (type (double-float) f e))
+    (cond
+      ((< (abs d) (abs c))
+       (setf e (/ d c))
+       (setf f (+ c (* d e)))
+       (setf p (/ (+ a (* b e)) f))
+       (setf q (/ (- b (* a e)) f)))
+      (t
+       (setf e (/ c d))
+       (setf f (+ d (* c e)))
+       (setf p (/ (+ b (* a e)) f))
+       (setf q (/ (- (* b e) a) f))))
+    (return (values nil nil nil nil p q))))
+
+(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::dladiv
+                 fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '((double-float) (double-float) (double-float)
+                        (double-float) (double-float) (double-float))
+           :return-values '(nil nil nil nil fortran-to-lisp::p
+                            fortran-to-lisp::q)
+           :calls 'nil)))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dlaed6 LAPACK}
+\pagehead{dlaed6}{dlaed6}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<LAPACK dlaed6>>=
+(let* ((maxit 20)
+       (zero 0.0)
+       (one 1.0)
+       (two 2.0)
+       (three 3.0)
+       (four 4.0)
+       (eight 8.0))
+  (declare (type (fixnum 20 20) maxit)
+           (type (double-float 0.0 0.0) zero)
+           (type (double-float 1.0 1.0) one)
+           (type (double-float 2.0 2.0) two)
+           (type (double-float 3.0 3.0) three)
+           (type (double-float 4.0 4.0) four)
+           (type (double-float 8.0 8.0) eight))
+  (let ((small1 0.0)
+        (sminv1 0.0)
+        (small2 0.0)
+        (sminv2 0.0)
+        (eps 0.0)
+        (first$ nil))
+    (declare (type (member t nil) first$)
+             (type (double-float) eps sminv2 small2 sminv1 small1))
+    (setq first$ t)
+    (defun dlaed6 (kniter orgati rho d z finit tau info)
+      (declare (type (array double-float (*)) z d)
+               (type (double-float) tau finit rho)
+               (type (member t nil) orgati)
+               (type fixnum info kniter))
+      (f2cl-lib:with-multi-array-data
+          ((d double-float d-%data% d-%offset%)
+           (z double-float z-%data% z-%offset%))
+        (prog ((a 0.0) (b 0.0) (base 0.0) (c 0.0) (ddf 0.0) (df 0.0)
+               (erretm 0.0) (eta 0.0) (f 0.0) (fc 0.0) (sclfac 0.0)
+               (sclinv 0.0) (temp 0.0) (temp1 0.0) (temp2 0.0) (temp3 0.0)
+               (temp4 0.0) (i 0) (iter 0) (niter 0) (scale nil)
+               (dscale (make-array 3 :element-type 'double-float))
+               (zscale (make-array 3 :element-type 'double-float)))
+          (declare (type (double-float) a b base c ddf df erretm eta f fc
+                                        sclfac sclinv temp temp1 temp2 temp3
+                                        temp4)
+                   (type fixnum i iter niter)
+                   (type (member t nil) scale)
+                   (type (array double-float (3)) dscale zscale))
+          (setf info 0)
+          (setf niter 1)
+          (setf tau zero)
+          (cond
+            ((= kniter 2)
+             (cond
+               (orgati
+                (setf temp
+                        (/
+                         (- (f2cl-lib:fref d-%data% (3) ((1 3)) d-%offset%)
+                            (f2cl-lib:fref d-%data% (2) ((1 3)) d-%offset%))
+                         two))
+                (setf c
+                        (+ rho
+                           (/ (f2cl-lib:fref z-%data% (1) ((1 3)) z-%offset%)
+                              (-
+                               (f2cl-lib:fref d-%data% (1) ((1 3)) d-%offset%)
+                               (f2cl-lib:fref d-%data% (2) ((1 3)) d-%offset%)
+                               temp))))
+                (setf a
+                        (+
+                         (* c
+                            (+ (f2cl-lib:fref d-%data% (2) ((1 3)) d-%offset%)
+                               (f2cl-lib:fref d-%data%
+                                              (3)
+                                              ((1 3))
+                                              d-%offset%)))
+                         (f2cl-lib:fref z-%data% (2) ((1 3)) z-%offset%)
+                         (f2cl-lib:fref z-%data% (3) ((1 3)) z-%offset%)))
+                (setf b
+                        (+
+                         (* c
+                            (f2cl-lib:fref d-%data% (2) ((1 3)) d-%offset%)
+                            (f2cl-lib:fref d-%data% (3) ((1 3)) d-%offset%))
+                         (* (f2cl-lib:fref z-%data% (2) ((1 3)) z-%offset%)
+                            (f2cl-lib:fref d-%data% (3) ((1 3)) d-%offset%))
+                         (* (f2cl-lib:fref z-%data% (3) ((1 3)) z-%offset%)
+                            (f2cl-lib:fref d-%data% (2) ((1 3)) d-%offset%)))))
+               (t
+                (setf temp
+                        (/
+                         (- (f2cl-lib:fref d-%data% (1) ((1 3)) d-%offset%)
+                            (f2cl-lib:fref d-%data% (2) ((1 3)) d-%offset%))
+                         two))
+                (setf c
+                        (+ rho
+                           (/ (f2cl-lib:fref z-%data% (3) ((1 3)) z-%offset%)
+                              (-
+                               (f2cl-lib:fref d-%data% (3) ((1 3)) d-%offset%)
+                               (f2cl-lib:fref d-%data% (2) ((1 3)) d-%offset%)
+                               temp))))
+                (setf a
+                        (+
+                         (* c
+                            (+ (f2cl-lib:fref d-%data% (1) ((1 3)) d-%offset%)
+                               (f2cl-lib:fref d-%data%
+                                              (2)
+                                              ((1 3))
+                                              d-%offset%)))
+                         (f2cl-lib:fref z-%data% (1) ((1 3)) z-%offset%)
+                         (f2cl-lib:fref z-%data% (2) ((1 3)) z-%offset%)))
+                (setf b
+                        (+
+                         (* c
+                            (f2cl-lib:fref d-%data% (1) ((1 3)) d-%offset%)
+                            (f2cl-lib:fref d-%data% (2) ((1 3)) d-%offset%))
+                         (* (f2cl-lib:fref z-%data% (1) ((1 3)) z-%offset%)
+                            (f2cl-lib:fref d-%data% (2) ((1 3)) d-%offset%))
+                         (* (f2cl-lib:fref z-%data% (2) ((1 3)) z-%offset%)
+                            (f2cl-lib:fref d-%data% (1) ((1 3)) d-%offset%))))))
+             (setf temp (max (abs a) (abs b) (abs c)))
+             (setf a (/ a temp))
+             (setf b (/ b temp))
+             (setf c (/ c temp))
+             (cond
+               ((= c zero)
+                (setf tau (/ b a)))
+               ((<= a zero)
+                (setf tau
+                        (/
+                         (- a
+                            (f2cl-lib:fsqrt
+                             (abs (+ (* a a) (* (- four) b c)))))
+                         (* two c))))
+               (t
+                (setf tau
+                        (/ (* two b)
+                           (+ a
+                              (f2cl-lib:fsqrt
+                               (abs (+ (* a a) (* (- four) b c)))))))))
+             (setf temp
+                     (+ rho
+                        (/ (f2cl-lib:fref z-%data% (1) ((1 3)) z-%offset%)
+                           (- (f2cl-lib:fref d-%data% (1) ((1 3)) d-%offset%)
+                              tau))
+                        (/ (f2cl-lib:fref z-%data% (2) ((1 3)) z-%offset%)
+                           (- (f2cl-lib:fref d-%data% (2) ((1 3)) d-%offset%)
+                              tau))
+                        (/ (f2cl-lib:fref z-%data% (3) ((1 3)) z-%offset%)
+                           (- (f2cl-lib:fref d-%data% (3) ((1 3)) d-%offset%)
+                              tau))))
+             (if (<= (abs finit) (abs temp)) (setf tau zero))))
+          (cond
+            (first$
+             (setf eps (dlamch "Epsilon"))
+             (setf base (dlamch "Base"))
+             (setf small1
+                     (expt base
+                           (f2cl-lib:int
+                            (/
+                             (/ (f2cl-lib:flog (dlamch "SafMin"))
+                                (f2cl-lib:flog base))
+                             three))))
+             (setf sminv1 (/ one small1))
+             (setf small2 (* small1 small1))
+             (setf sminv2 (* sminv1 sminv1))
+             (setf first$ nil)))
+          (cond
+            (orgati
+             (setf temp
+                     (min
+                      (abs
+                       (- (f2cl-lib:fref d-%data% (2) ((1 3)) d-%offset%) tau))
+                      (abs
+                       (- (f2cl-lib:fref d-%data% (3) ((1 3)) d-%offset%)
+                          tau)))))
+            (t
+             (setf temp
+                     (min
+                      (abs
+                       (- (f2cl-lib:fref d-%data% (1) ((1 3)) d-%offset%) tau))
+                      (abs
+                       (- (f2cl-lib:fref d-%data% (2) ((1 3)) d-%offset%)
+                          tau))))))
+          (setf scale nil)
+          (cond
+            ((<= temp small1)
+             (setf scale t)
+             (cond
+               ((<= temp small2)
+                (setf sclfac sminv2)
+                (setf sclinv small2))
+               (t
+                (setf sclfac sminv1)
+                (setf sclinv small1)))
+             (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                           ((> i 3) nil)
+               (tagbody
+                 (setf (f2cl-lib:fref dscale (i) ((1 3)))
+                         (* (f2cl-lib:fref d-%data% (i) ((1 3)) d-%offset%)
+                            sclfac))
+                 (setf (f2cl-lib:fref zscale (i) ((1 3)))
+                         (* (f2cl-lib:fref z-%data% (i) ((1 3)) z-%offset%)
+                            sclfac))))
+             (setf tau (* tau sclfac)))
+            (t
+             (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                           ((> i 3) nil)
+               (tagbody
+                 (setf (f2cl-lib:fref dscale (i) ((1 3)))
+                         (f2cl-lib:fref d-%data% (i) ((1 3)) d-%offset%))
+                 (setf (f2cl-lib:fref zscale (i) ((1 3)))
+                         (f2cl-lib:fref z-%data% (i) ((1 3)) z-%offset%))))))
+          (setf fc zero)
+          (setf df zero)
+          (setf ddf zero)
+          (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                        ((> i 3) nil)
+            (tagbody
+              (setf temp (/ one (- (f2cl-lib:fref dscale (i) ((1 3))) tau)))
+              (setf temp1 (* (f2cl-lib:fref zscale (i) ((1 3))) temp))
+              (setf temp2 (* temp1 temp))
+              (setf temp3 (* temp2 temp))
+              (setf fc (+ fc (/ temp1 (f2cl-lib:fref dscale (i) ((1 3))))))
+              (setf df (+ df temp2))
+              (setf ddf (+ ddf temp3))))
+          (setf f (+ finit (* tau fc)))
+          (if (<= (abs f) zero) (go label60))
+          (setf iter (f2cl-lib:int-add niter 1))
+          (f2cl-lib:fdo (niter iter (f2cl-lib:int-add niter 1))
+                        ((> niter maxit) nil)
+            (tagbody
+              (cond
+                (orgati
+                 (setf temp1 (- (f2cl-lib:fref dscale (2) ((1 3))) tau))
+                 (setf temp2 (- (f2cl-lib:fref dscale (3) ((1 3))) tau)))
+                (t
+                 (setf temp1 (- (f2cl-lib:fref dscale (1) ((1 3))) tau))
+                 (setf temp2 (- (f2cl-lib:fref dscale (2) ((1 3))) tau))))
+              (setf a (+ (* (+ temp1 temp2) f) (* (- temp1) temp2 df)))
+              (setf b (* temp1 temp2 f))
+              (setf c (+ (- f (* (+ temp1 temp2) df)) (* temp1 temp2 ddf)))
+              (setf temp (max (abs a) (abs b) (abs c)))
+              (setf a (/ a temp))
+              (setf b (/ b temp))
+              (setf c (/ c temp))
+              (cond
+                ((= c zero)
+                 (setf eta (/ b a)))
+                ((<= a zero)
+                 (setf eta
+                         (/
+                          (- a
+                             (f2cl-lib:fsqrt
+                              (abs (+ (* a a) (* (- four) b c)))))
+                          (* two c))))
+                (t
+                 (setf eta
+                         (/ (* two b)
+                            (+ a
+                               (f2cl-lib:fsqrt
+                                (abs (+ (* a a) (* (- four) b c)))))))))
+              (cond
+                ((>= (* f eta) zero)
+                 (setf eta (/ (- f) df))))
+              (setf temp (+ eta tau))
+              (cond
+                (orgati
+                 (if
+                  (and (> eta zero)
+                       (>= temp (f2cl-lib:fref dscale (3) ((1 3)))))
+                  (setf eta (/ (- (f2cl-lib:fref dscale (3) ((1 3))) tau) two)))
+                 (if
+                  (and (< eta zero)
+                       (<= temp (f2cl-lib:fref dscale (2) ((1 3)))))
+                  (setf eta
+                          (/ (- (f2cl-lib:fref dscale (2) ((1 3))) tau) two))))
+                (t
+                 (if
+                  (and (> eta zero)
+                       (>= temp (f2cl-lib:fref dscale (2) ((1 3)))))
+                  (setf eta (/ (- (f2cl-lib:fref dscale (2) ((1 3))) tau) two)))
+                 (if
+                  (and (< eta zero)
+                       (<= temp (f2cl-lib:fref dscale (1) ((1 3)))))
+                  (setf eta
+                          (/ (- (f2cl-lib:fref dscale (1) ((1 3))) tau)
+                             two)))))
+              (setf tau (+ tau eta))
+              (setf fc zero)
+              (setf erretm zero)
+              (setf df zero)
+              (setf ddf zero)
+              (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                            ((> i 3) nil)
+                (tagbody
+                  (setf temp
+                          (/ one (- (f2cl-lib:fref dscale (i) ((1 3))) tau)))
+                  (setf temp1 (* (f2cl-lib:fref zscale (i) ((1 3))) temp))
+                  (setf temp2 (* temp1 temp))
+                  (setf temp3 (* temp2 temp))
+                  (setf temp4 (/ temp1 (f2cl-lib:fref dscale (i) ((1 3)))))
+                  (setf fc (+ fc temp4))
+                  (setf erretm (+ erretm (abs temp4)))
+                  (setf df (+ df temp2))
+                  (setf ddf (+ ddf temp3))))
+              (setf f (+ finit (* tau fc)))
+              (setf erretm
+                      (+ (* eight (+ (abs finit) (* (abs tau) erretm)))
+                         (* (abs tau) df)))
+              (if (<= (abs f) (* eps erretm)) (go label60))))
+          (setf info 1)
+ label60
+          (if scale (setf tau (* tau sclinv)))
+ end_label
+          (return (values nil nil nil nil nil nil tau 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::dlaed6
+                 fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '(fixnum (member t nil)
+                        (double-float) (array double-float (3))
+                        (array double-float (3)) (double-float) (double-float)
+                        fixnum)
+           :return-values '(nil nil nil nil nil nil fortran-to-lisp::tau
+                            fortran-to-lisp::info)
+           :calls '(fortran-to-lisp::dlamch))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dlaexc LAPACK}
+\pagehead{dlaexc}{dlaexc}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<LAPACK dlaexc>>=
+(let* ((zero 0.0) (one 1.0) (ten 10.0) (ldd 4) (ldx 2))
+  (declare (type (double-float 0.0 0.0) zero)
+           (type (double-float 1.0 1.0) one)
+           (type (double-float 10.0 10.0) ten)
+           (type (fixnum 4 4) ldd)
+           (type (fixnum 2 2) ldx))
+  (defun dlaexc (wantq n t$ ldt q ldq j1 n1 n2 work info)
+    (declare (type (array double-float (*)) work q t$)
+             (type fixnum info n2 n1 j1 ldq ldt n)
+             (type (member t nil) wantq))
+    (f2cl-lib:with-multi-array-data
+        ((t$ double-float t$-%data% t$-%offset%)
+         (q double-float q-%data% q-%offset%)
+         (work double-float work-%data% work-%offset%))
+      (prog ((d
+              (make-array (the fixnum (reduce #'* (list ldd 4)))
+                          :element-type 'double-float))
+             (u (make-array 3 :element-type 'double-float))
+             (u1 (make-array 3 :element-type 'double-float))
+             (u2 (make-array 3 :element-type 'double-float))
+             (x
+              (make-array (the fixnum (reduce #'* (list ldx 2)))
+                          :element-type 'double-float))
+             (cs 0.0) (dnorm 0.0) (eps 0.0) (scale 0.0) (smlnum 0.0) (sn 0.0)
+             (t11 0.0) (t22 0.0) (t33 0.0) (tau 0.0) (tau1 0.0) (tau2 0.0)
+             (temp 0.0) (thresh 0.0) (wi1 0.0) (wi2 0.0) (wr1 0.0) (wr2 0.0)
+             (xnorm 0.0) (ierr 0) (j2 0) (j3 0) (j4 0) (k 0) (nd 0))
+        (declare (type (array double-float (3)) u u1 u2)
+                 (type (array double-float (*)) d x)
+                 (type (double-float) cs dnorm eps scale smlnum sn t11 t22 t33
+                                      tau tau1 tau2 temp thresh wi1 wi2 wr1 wr2
+                                      xnorm)
+                 (type fixnum ierr j2 j3 j4 k nd))
+        (setf info 0)
+        (if (or (= n 0) (= n1 0) (= n2 0)) (go end_label))
+        (if (> (f2cl-lib:int-add j1 n1) n) (go end_label))
+        (setf j2 (f2cl-lib:int-add j1 1))
+        (setf j3 (f2cl-lib:int-add j1 2))
+        (setf j4 (f2cl-lib:int-add j1 3))
+        (cond
+          ((and (= n1 1) (= n2 1))
+           (setf t11
+                   (f2cl-lib:fref t$-%data%
+                                  (j1 j1)
+                                  ((1 ldt) (1 *))
+                                  t$-%offset%))
+           (setf t22
+                   (f2cl-lib:fref t$-%data%
+                                  (j2 j2)
+                                  ((1 ldt) (1 *))
+                                  t$-%offset%))
+           (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+               (dlartg
+                (f2cl-lib:fref t$-%data% (j1 j2) ((1 ldt) (1 *)) t$-%offset%)
+                (- t22 t11) cs sn temp)
+             (declare (ignore var-0 var-1))
+             (setf cs var-2)
+             (setf sn var-3)
+             (setf temp var-4))
+           (if (<= j3 n)
+               (drot (f2cl-lib:int-sub n j1 1)
+                (f2cl-lib:array-slice t$ double-float (j1 j3) ((1 ldt) (1 *)))
+                ldt
+                (f2cl-lib:array-slice t$ double-float (j2 j3) ((1 ldt) (1 *)))
+                ldt cs sn))
+           (drot (f2cl-lib:int-sub j1 1)
+            (f2cl-lib:array-slice t$ double-float (1 j1) ((1 ldt) (1 *))) 1
+            (f2cl-lib:array-slice t$ double-float (1 j2) ((1 ldt) (1 *))) 1 cs
+            sn)
+           (setf (f2cl-lib:fref t$-%data% (j1 j1) ((1 ldt) (1 *)) t$-%offset%)
+                   t22)
+           (setf (f2cl-lib:fref t$-%data% (j2 j2) ((1 ldt) (1 *)) t$-%offset%)
+                   t11)
+           (cond
+             (wantq
+              (drot n
+               (f2cl-lib:array-slice q double-float (1 j1) ((1 ldq) (1 *))) 1
+               (f2cl-lib:array-slice q double-float (1 j2) ((1 ldq) (1 *))) 1
+               cs sn))))
+          (t
+           (tagbody
+             (setf nd (f2cl-lib:int-add n1 n2))
+             (dlacpy "Full" nd nd
+              (f2cl-lib:array-slice t$ double-float (j1 j1) ((1 ldt) (1 *)))
+              ldt d ldd)
+             (setf dnorm (dlange "Max" nd nd d ldd work))
+             (setf eps (dlamch "P"))
+             (setf smlnum (/ (dlamch "S") eps))
+             (setf thresh (max (* ten eps dnorm) smlnum))
+             (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)
+                 (dlasy2 nil nil -1 n1 n2 d ldd
+                  (f2cl-lib:array-slice d
+                                        double-float
+                                        ((+ n1 1) (f2cl-lib:int-add n1 1))
+                                        ((1 ldd) (1 4)))
+                  ldd
+                  (f2cl-lib:array-slice d
+                                        double-float
+                                        (1 (f2cl-lib:int-add n1 1))
+                                        ((1 ldd) (1 4)))
+                  ldd scale x ldx xnorm ierr)
+               (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-12 var-13))
+               (setf scale var-11)
+               (setf xnorm var-14)
+               (setf ierr var-15))
+             (setf k (f2cl-lib:int-sub (f2cl-lib:int-add n1 n1 n2) 3))
+             (f2cl-lib:computed-goto (label10 label20 label30) k)
+ label10
+             (setf (f2cl-lib:fref u (1) ((1 3))) scale)
+             (setf (f2cl-lib:fref u (2) ((1 3)))
+                     (f2cl-lib:fref x (1 1) ((1 ldx) (1 2))))
+             (setf (f2cl-lib:fref u (3) ((1 3)))
+                     (f2cl-lib:fref x (1 2) ((1 ldx) (1 2))))
+             (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                 (dlarfg 3 (f2cl-lib:fref u (3) ((1 3))) u 1 tau)
+               (declare (ignore var-0 var-2 var-3))
+               (setf (f2cl-lib:fref u (3) ((1 3))) var-1)
+               (setf tau var-4))
+             (setf (f2cl-lib:fref u (3) ((1 3))) one)
+             (setf t11
+                     (f2cl-lib:fref t$-%data%
+                                    (j1 j1)
+                                    ((1 ldt) (1 *))
+                                    t$-%offset%))
+             (dlarfx "L" 3 3 u tau d ldd work)
+             (dlarfx "R" 3 3 u tau d ldd work)
+             (if
+              (>
+               (max (abs (f2cl-lib:fref d (3 1) ((1 ldd) (1 4))))
+                    (abs (f2cl-lib:fref d (3 2) ((1 ldd) (1 4))))
+                    (abs (- (f2cl-lib:fref d (3 3) ((1 ldd) (1 4))) t11)))
+               thresh)
+              (go label50))
+             (dlarfx "L" 3 (f2cl-lib:int-add (f2cl-lib:int-sub n j1) 1) u tau
+              (f2cl-lib:array-slice t$ double-float (j1 j1) ((1 ldt) (1 *)))
+              ldt work)
+             (dlarfx "R" j2 3 u tau
+              (f2cl-lib:array-slice t$ double-float (1 j1) ((1 ldt) (1 *))) ldt
+              work)
+             (setf (f2cl-lib:fref t$-%data%
+                                  (j3 j1)
+                                  ((1 ldt) (1 *))
+                                  t$-%offset%)
+                     zero)
+             (setf (f2cl-lib:fref t$-%data%
+                                  (j3 j2)
+                                  ((1 ldt) (1 *))
+                                  t$-%offset%)
+                     zero)
+             (setf (f2cl-lib:fref t$-%data%
+                                  (j3 j3)
+                                  ((1 ldt) (1 *))
+                                  t$-%offset%)
+                     t11)
+             (cond
+               (wantq
+                (dlarfx "R" n 3 u tau
+                 (f2cl-lib:array-slice q double-float (1 j1) ((1 ldq) (1 *)))
+                 ldq work)))
+             (go label40)
+ label20
+             (setf (f2cl-lib:fref u (1) ((1 3)))
+                     (- (f2cl-lib:fref x (1 1) ((1 ldx) (1 2)))))
+             (setf (f2cl-lib:fref u (2) ((1 3)))
+                     (- (f2cl-lib:fref x (2 1) ((1 ldx) (1 2)))))
+             (setf (f2cl-lib:fref u (3) ((1 3))) scale)
+             (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                 (dlarfg 3 (f2cl-lib:fref u (1) ((1 3)))
+                  (f2cl-lib:array-slice u double-float (2) ((1 3))) 1 tau)
+               (declare (ignore var-0 var-2 var-3))
+               (setf (f2cl-lib:fref u (1) ((1 3))) var-1)
+               (setf tau var-4))
+             (setf (f2cl-lib:fref u (1) ((1 3))) one)
+             (setf t33
+                     (f2cl-lib:fref t$-%data%
+                                    (j3 j3)
+                                    ((1 ldt) (1 *))
+                                    t$-%offset%))
+             (dlarfx "L" 3 3 u tau d ldd work)
+             (dlarfx "R" 3 3 u tau d ldd work)
+             (if
+              (>
+               (max (abs (f2cl-lib:fref d (2 1) ((1 ldd) (1 4))))
+                    (abs (f2cl-lib:fref d (3 1) ((1 ldd) (1 4))))
+                    (abs (- (f2cl-lib:fref d (1 1) ((1 ldd) (1 4))) t33)))
+               thresh)
+              (go label50))
+             (dlarfx "R" j3 3 u tau
+              (f2cl-lib:array-slice t$ double-float (1 j1) ((1 ldt) (1 *))) ldt
+              work)
+             (dlarfx "L" 3 (f2cl-lib:int-sub n j1) u tau
+              (f2cl-lib:array-slice t$ double-float (j1 j2) ((1 ldt) (1 *)))
+              ldt work)
+             (setf (f2cl-lib:fref t$-%data%
+                                  (j1 j1)
+                                  ((1 ldt) (1 *))
+                                  t$-%offset%)
+                     t33)
+             (setf (f2cl-lib:fref t$-%data%
+                                  (j2 j1)
+                                  ((1 ldt) (1 *))
+                                  t$-%offset%)
+                     zero)
+             (setf (f2cl-lib:fref t$-%data%
+                                  (j3 j1)
+                                  ((1 ldt) (1 *))
+                                  t$-%offset%)
+                     zero)
+             (cond
+               (wantq
+                (dlarfx "R" n 3 u tau
+                 (f2cl-lib:array-slice q double-float (1 j1) ((1 ldq) (1 *)))
+                 ldq work)))
+             (go label40)
+ label30
+             (setf (f2cl-lib:fref u1 (1) ((1 3)))
+                     (- (f2cl-lib:fref x (1 1) ((1 ldx) (1 2)))))
+             (setf (f2cl-lib:fref u1 (2) ((1 3)))
+                     (- (f2cl-lib:fref x (2 1) ((1 ldx) (1 2)))))
+             (setf (f2cl-lib:fref u1 (3) ((1 3))) scale)
+             (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                 (dlarfg 3 (f2cl-lib:fref u1 (1) ((1 3)))
+                  (f2cl-lib:array-slice u1 double-float (2) ((1 3))) 1 tau1)
+               (declare (ignore var-0 var-2 var-3))
+               (setf (f2cl-lib:fref u1 (1) ((1 3))) var-1)
+               (setf tau1 var-4))
+             (setf (f2cl-lib:fref u1 (1) ((1 3))) one)
+             (setf temp
+                     (* (- tau1)
+                        (+ (f2cl-lib:fref x (1 2) ((1 ldx) (1 2)))
+                           (* (f2cl-lib:fref u1 (2) ((1 3)))
+                              (f2cl-lib:fref x (2 2) ((1 ldx) (1 2)))))))
+             (setf (f2cl-lib:fref u2 (1) ((1 3)))
+                     (- (* (- temp) (f2cl-lib:fref u1 (2) ((1 3))))
+                        (f2cl-lib:fref x (2 2) ((1 ldx) (1 2)))))
+             (setf (f2cl-lib:fref u2 (2) ((1 3)))
+                     (* (- temp) (f2cl-lib:fref u1 (3) ((1 3)))))
+             (setf (f2cl-lib:fref u2 (3) ((1 3))) scale)
+             (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                 (dlarfg 3 (f2cl-lib:fref u2 (1) ((1 3)))
+                  (f2cl-lib:array-slice u2 double-float (2) ((1 3))) 1 tau2)
+               (declare (ignore var-0 var-2 var-3))
+               (setf (f2cl-lib:fref u2 (1) ((1 3))) var-1)
+               (setf tau2 var-4))
+             (setf (f2cl-lib:fref u2 (1) ((1 3))) one)
+             (dlarfx "L" 3 4 u1 tau1 d ldd work)
+             (dlarfx "R" 4 3 u1 tau1 d ldd work)
+             (dlarfx "L" 3 4 u2 tau2
+              (f2cl-lib:array-slice d double-float (2 1) ((1 ldd) (1 4))) ldd
+              work)
+             (dlarfx "R" 4 3 u2 tau2
+              (f2cl-lib:array-slice d double-float (1 2) ((1 ldd) (1 4))) ldd
+              work)
+             (if
+              (>
+               (max (abs (f2cl-lib:fref d (3 1) ((1 ldd) (1 4))))
+                    (abs (f2cl-lib:fref d (3 2) ((1 ldd) (1 4))))
+                    (abs (f2cl-lib:fref d (4 1) ((1 ldd) (1 4))))
+                    (abs (f2cl-lib:fref d (4 2) ((1 ldd) (1 4)))))
+               thresh)
+              (go label50))
+             (dlarfx "L" 3 (f2cl-lib:int-add (f2cl-lib:int-sub n j1) 1) u1 tau1
+              (f2cl-lib:array-slice t$ double-float (j1 j1) ((1 ldt) (1 *)))
+              ldt work)
+             (dlarfx "R" j4 3 u1 tau1
+              (f2cl-lib:array-slice t$ double-float (1 j1) ((1 ldt) (1 *))) ldt
+              work)
+             (dlarfx "L" 3 (f2cl-lib:int-add (f2cl-lib:int-sub n j1) 1) u2 tau2
+              (f2cl-lib:array-slice t$ double-float (j2 j1) ((1 ldt) (1 *)))
+              ldt work)
+             (dlarfx "R" j4 3 u2 tau2
+              (f2cl-lib:array-slice t$ double-float (1 j2) ((1 ldt) (1 *))) ldt
+              work)
+             (setf (f2cl-lib:fref t$-%data%
+                                  (j3 j1)
+                                  ((1 ldt) (1 *))
+                                  t$-%offset%)
+                     zero)
+             (setf (f2cl-lib:fref t$-%data%
+                                  (j3 j2)
+                                  ((1 ldt) (1 *))
+                                  t$-%offset%)
+                     zero)
+             (setf (f2cl-lib:fref t$-%data%
+                                  (j4 j1)
+                                  ((1 ldt) (1 *))
+                                  t$-%offset%)
+                     zero)
+             (setf (f2cl-lib:fref t$-%data%
+                                  (j4 j2)
+                                  ((1 ldt) (1 *))
+                                  t$-%offset%)
+                     zero)
+             (cond
+               (wantq
+                (dlarfx "R" n 3 u1 tau1
+                 (f2cl-lib:array-slice q double-float (1 j1) ((1 ldq) (1 *)))
+                 ldq work)
+                (dlarfx "R" n 3 u2 tau2
+                 (f2cl-lib:array-slice q double-float (1 j2) ((1 ldq) (1 *)))
+                 ldq work)))
+ label40
+             (cond
+               ((= n2 2)
+                (multiple-value-bind
+                      (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8
+                       var-9)
+                    (dlanv2
+                     (f2cl-lib:fref t$-%data%
+                                    (j1 j1)
+                                    ((1 ldt) (1 *))
+                                    t$-%offset%)
+                     (f2cl-lib:fref t$-%data%
+                                    (j1 j2)
+                                    ((1 ldt) (1 *))
+                                    t$-%offset%)
+                     (f2cl-lib:fref t$-%data%
+                                    (j2 j1)
+                                    ((1 ldt) (1 *))
+                                    t$-%offset%)
+                     (f2cl-lib:fref t$-%data%
+                                    (j2 j2)
+                                    ((1 ldt) (1 *))
+                                    t$-%offset%)
+                     wr1 wi1 wr2 wi2 cs sn)
+                  (declare (ignore))
+                  (setf (f2cl-lib:fref t$-%data%
+                                       (j1 j1)
+                                       ((1 ldt) (1 *))
+                                       t$-%offset%)
+                          var-0)
+                  (setf (f2cl-lib:fref t$-%data%
+                                       (j1 j2)
+                                       ((1 ldt) (1 *))
+                                       t$-%offset%)
+                          var-1)
+                  (setf (f2cl-lib:fref t$-%data%
+                                       (j2 j1)
+                                       ((1 ldt) (1 *))
+                                       t$-%offset%)
+                          var-2)
+                  (setf (f2cl-lib:fref t$-%data%
+                                       (j2 j2)
+                                       ((1 ldt) (1 *))
+                                       t$-%offset%)
+                          var-3)
+                  (setf wr1 var-4)
+                  (setf wi1 var-5)
+                  (setf wr2 var-6)
+                  (setf wi2 var-7)
+                  (setf cs var-8)
+                  (setf sn var-9))
+                (drot (f2cl-lib:int-sub n j1 1)
+                 (f2cl-lib:array-slice t$
+                                       double-float
+                                       (j1 (f2cl-lib:int-add j1 2))
+                                       ((1 ldt) (1 *)))
+                 ldt
+                 (f2cl-lib:array-slice t$
+                                       double-float
+                                       (j2 (f2cl-lib:int-add j1 2))
+                                       ((1 ldt) (1 *)))
+                 ldt cs sn)
+                (drot (f2cl-lib:int-sub j1 1)
+                 (f2cl-lib:array-slice t$ double-float (1 j1) ((1 ldt) (1 *)))
+                 1
+                 (f2cl-lib:array-slice t$ double-float (1 j2) ((1 ldt) (1 *)))
+                 1 cs sn)
+                (if wantq
+                    (drot n
+                     (f2cl-lib:array-slice q
+                                           double-float
+                                           (1 j1)
+                                           ((1 ldq) (1 *)))
+                     1
+                     (f2cl-lib:array-slice q
+                                           double-float
+                                           (1 j2)
+                                           ((1 ldq) (1 *)))
+                     1 cs sn))))
+             (cond
+               ((= n1 2)
+                (setf j3 (f2cl-lib:int-add j1 n2))
+                (setf j4 (f2cl-lib:int-add j3 1))
+                (multiple-value-bind
+                      (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8
+                       var-9)
+                    (dlanv2
+                     (f2cl-lib:fref t$-%data%
+                                    (j3 j3)
+                                    ((1 ldt) (1 *))
+                                    t$-%offset%)
+                     (f2cl-lib:fref t$-%data%
+                                    (j3 j4)
+                                    ((1 ldt) (1 *))
+                                    t$-%offset%)
+                     (f2cl-lib:fref t$-%data%
+                                    (j4 j3)
+                                    ((1 ldt) (1 *))
+                                    t$-%offset%)
+                     (f2cl-lib:fref t$-%data%
+                                    (j4 j4)
+                                    ((1 ldt) (1 *))
+                                    t$-%offset%)
+                     wr1 wi1 wr2 wi2 cs sn)
+                  (declare (ignore))
+                  (setf (f2cl-lib:fref t$-%data%
+                                       (j3 j3)
+                                       ((1 ldt) (1 *))
+                                       t$-%offset%)
+                          var-0)
+                  (setf (f2cl-lib:fref t$-%data%
+                                       (j3 j4)
+                                       ((1 ldt) (1 *))
+                                       t$-%offset%)
+                          var-1)
+                  (setf (f2cl-lib:fref t$-%data%
+                                       (j4 j3)
+                                       ((1 ldt) (1 *))
+                                       t$-%offset%)
+                          var-2)
+                  (setf (f2cl-lib:fref t$-%data%
+                                       (j4 j4)
+                                       ((1 ldt) (1 *))
+                                       t$-%offset%)
+                          var-3)
+                  (setf wr1 var-4)
+                  (setf wi1 var-5)
+                  (setf wr2 var-6)
+                  (setf wi2 var-7)
+                  (setf cs var-8)
+                  (setf sn var-9))
+                (if (<= (f2cl-lib:int-add j3 2) n)
+                    (drot (f2cl-lib:int-sub n j3 1)
+                     (f2cl-lib:array-slice t$
+                                           double-float
+                                           (j3 (f2cl-lib:int-add j3 2))
+                                           ((1 ldt) (1 *)))
+                     ldt
+                     (f2cl-lib:array-slice t$
+                                           double-float
+                                           (j4 (f2cl-lib:int-add j3 2))
+                                           ((1 ldt) (1 *)))
+                     ldt cs sn))
+                (drot (f2cl-lib:int-sub j3 1)
+                 (f2cl-lib:array-slice t$ double-float (1 j3) ((1 ldt) (1 *)))
+                 1
+                 (f2cl-lib:array-slice t$ double-float (1 j4) ((1 ldt) (1 *)))
+                 1 cs sn)
+                (if wantq
+                    (drot n
+                     (f2cl-lib:array-slice q
+                                           double-float
+                                           (1 j3)
+                                           ((1 ldq) (1 *)))
+                     1
+                     (f2cl-lib:array-slice q
+                                           double-float
+                                           (1 j4)
+                                           ((1 ldq) (1 *)))
+                     1 cs sn)))))))
+        (go end_label)
+ label50
+        (setf info 1)
+ end_label
+        (return (values 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::dlaexc
+                 fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '((member t nil) fixnum
+                        (array double-float (*)) fixnum
+                        (array double-float (*)) fixnum
+                        fixnum fixnum
+                        fixnum (array double-float (*))
+                        fixnum)
+           :return-values '(nil nil nil nil nil nil nil nil nil nil
+                            fortran-to-lisp::info)
+           :calls '(fortran-to-lisp::dlanv2 fortran-to-lisp::dlarfx
+                    fortran-to-lisp::dlarfg fortran-to-lisp::dlasy2
+                    fortran-to-lisp::dlamch fortran-to-lisp::dlange
+                    fortran-to-lisp::dlacpy fortran-to-lisp::drot
+                    fortran-to-lisp::dlartg))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dlahqr LAPACK}
+\pagehead{dlahqr}{dlahqr}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<LAPACK dlahqr>>=
+(let* ((zero 0.0) (one 1.0) (half 0.5) (dat1 0.75) (dat2 (- 0.4375)))
+  (declare (type (double-float 0.0 0.0) zero)
+           (type (double-float 1.0 1.0) one)
+           (type (double-float 0.5 0.5) half)
+           (type (double-float 0.75 0.75) dat1)
+           (type (double-float) dat2))
+  (defun dlahqr (wantt wantz n ilo ihi h ldh wr wi iloz ihiz z ldz info)
+    (declare (type (array double-float (*)) z wi wr h)
+             (type fixnum info ldz ihiz iloz ldh ihi ilo n)
+             (type (member t nil) wantz wantt))
+    (f2cl-lib:with-multi-array-data
+        ((h double-float h-%data% h-%offset%)
+         (wr double-float wr-%data% wr-%offset%)
+         (wi double-float wi-%data% wi-%offset%)
+         (z double-float z-%data% z-%offset%))
+      (prog ((v (make-array 3 :element-type 'double-float))
+             (work (make-array 1 :element-type 'double-float)) (ave 0.0)
+             (cs 0.0) (disc 0.0) (h00 0.0) (h10 0.0) (h11 0.0) (h12 0.0)
+             (h21 0.0) (h22 0.0) (h33 0.0) (h33s 0.0) (h43h34 0.0) (h44 0.0)
+             (h44s 0.0) (ovfl 0.0) (s 0.0) (smlnum 0.0) (sn 0.0) (sum 0.0)
+             (t1 0.0) (t2 0.0) (t3 0.0) (tst1 0.0) (ulp 0.0) (unfl 0.0)
+             (v1 0.0) (v2 0.0) (v3 0.0) (i 0) (i1 0) (i2 0) (itn 0) (its 0)
+             (j 0) (k 0) (l 0) (m 0) (nh 0) (nr 0) (nz 0))
+        (declare (type (array double-float (3)) v)
+                 (type (array double-float (1)) work)
+                 (type (double-float) ave cs disc h00 h10 h11 h12 h21 h22 h33
+                                      h33s h43h34 h44 h44s ovfl s smlnum sn sum
+                                      t1 t2 t3 tst1 ulp unfl v1 v2 v3)
+                 (type fixnum i i1 i2 itn its j k l m nh nr nz))
+        (setf info 0)
+        (if (= n 0) (go end_label))
+        (cond
+          ((= ilo ihi)
+           (setf (f2cl-lib:fref wr-%data% (ilo) ((1 *)) wr-%offset%)
+                   (f2cl-lib:fref h-%data%
+                                  (ilo ilo)
+                                  ((1 ldh) (1 *))
+                                  h-%offset%))
+           (setf (f2cl-lib:fref wi-%data% (ilo) ((1 *)) wi-%offset%) zero)
+           (go end_label)))
+        (setf nh (f2cl-lib:int-add (f2cl-lib:int-sub ihi ilo) 1))
+        (setf nz (f2cl-lib:int-add (f2cl-lib:int-sub ihiz iloz) 1))
+        (setf unfl (dlamch "Safe minimum"))
+        (setf ovfl (/ one unfl))
+        (multiple-value-bind (var-0 var-1)
+            (dlabad unfl ovfl)
+          (declare (ignore))
+          (setf unfl var-0)
+          (setf ovfl var-1))
+        (setf ulp (dlamch "Precision"))
+        (setf smlnum (* unfl (/ nh ulp)))
+        (cond
+          (wantt
+           (setf i1 1)
+           (setf i2 n)))
+        (setf itn (f2cl-lib:int-mul 30 nh))
+        (setf i ihi)
+ label10
+        (setf l ilo)
+        (if (< i ilo) (go end_label))
+        (f2cl-lib:fdo (its 0 (f2cl-lib:int-add its 1))
+                      ((> its itn) nil)
+          (tagbody
+            (f2cl-lib:fdo (k i (f2cl-lib:int-add k (f2cl-lib:int-sub 1)))
+                          ((> k (f2cl-lib:int-add l 1)) nil)
+              (tagbody
+                (setf tst1
+                        (+
+                         (abs
+                          (f2cl-lib:fref h-%data%
+                                         ((f2cl-lib:int-sub k 1)
+                                          (f2cl-lib:int-sub k 1))
+                                         ((1 ldh) (1 *))
+                                         h-%offset%))
+                         (abs
+                          (f2cl-lib:fref h-%data%
+                                         (k k)
+                                         ((1 ldh) (1 *))
+                                         h-%offset%))))
+                (if (= tst1 zero)
+                    (setf tst1
+                            (dlanhs "1"
+                             (f2cl-lib:int-add (f2cl-lib:int-sub i l) 1)
+                             (f2cl-lib:array-slice h
+                                                   double-float
+                                                   (l l)
+                                                   ((1 ldh) (1 *)))
+                             ldh work)))
+                (if
+                 (<=
+                  (abs
+                   (f2cl-lib:fref h-%data%
+                                  (k (f2cl-lib:int-sub k 1))
+                                  ((1 ldh) (1 *))
+                                  h-%offset%))
+                  (max (* ulp tst1) smlnum))
+                 (go label30))))
+ label30
+            (setf l k)
+            (cond
+              ((> l ilo)
+               (setf (f2cl-lib:fref h-%data%
+                                    (l (f2cl-lib:int-sub l 1))
+                                    ((1 ldh) (1 *))
+                                    h-%offset%)
+                       zero)))
+            (if (>= l (f2cl-lib:int-sub i 1)) (go label140))
+            (cond
+              ((not wantt)
+               (setf i1 l)
+               (setf i2 i)))
+            (cond
+              ((or (= its 10) (= its 20))
+               (setf s
+                       (+
+                        (abs
+                         (f2cl-lib:fref h-%data%
+                                        (i (f2cl-lib:int-sub i 1))
+                                        ((1 ldh) (1 *))
+                                        h-%offset%))
+                        (abs
+                         (f2cl-lib:fref h-%data%
+                                        ((f2cl-lib:int-sub i 1)
+                                         (f2cl-lib:int-sub i 2))
+                                        ((1 ldh) (1 *))
+                                        h-%offset%))))
+               (setf h44
+                       (+ (* dat1 s)
+                          (f2cl-lib:fref h-%data%
+                                         (i i)
+                                         ((1 ldh) (1 *))
+                                         h-%offset%)))
+               (setf h33 h44)
+               (setf h43h34 (* dat2 s s)))
+              (t
+               (setf h44
+                       (f2cl-lib:fref h-%data%
+                                      (i i)
+                                      ((1 ldh) (1 *))
+                                      h-%offset%))
+               (setf h33
+                       (f2cl-lib:fref h-%data%
+                                      ((f2cl-lib:int-sub i 1)
+                                       (f2cl-lib:int-sub i 1))
+                                      ((1 ldh) (1 *))
+                                      h-%offset%))
+               (setf h43h34
+                       (*
+                        (f2cl-lib:fref h-%data%
+                                       (i (f2cl-lib:int-sub i 1))
+                                       ((1 ldh) (1 *))
+                                       h-%offset%)
+                        (f2cl-lib:fref h-%data%
+                                       ((f2cl-lib:int-sub i 1) i)
+                                       ((1 ldh) (1 *))
+                                       h-%offset%)))
+               (setf s
+                       (*
+                        (f2cl-lib:fref h-%data%
+                                       ((f2cl-lib:int-sub i 1)
+                                        (f2cl-lib:int-sub i 2))
+                                       ((1 ldh) (1 *))
+                                       h-%offset%)
+                        (f2cl-lib:fref h-%data%
+                                       ((f2cl-lib:int-sub i 1)
+                                        (f2cl-lib:int-sub i 2))
+                                       ((1 ldh) (1 *))
+                                       h-%offset%)))
+               (setf disc (* (- h33 h44) half))
+               (setf disc (+ (* disc disc) h43h34))
+               (cond
+                 ((> disc zero)
+                  (setf disc (f2cl-lib:fsqrt disc))
+                  (setf ave (* half (+ h33 h44)))
+                  (cond
+                    ((> (+ (abs h33) (- (abs h44))) zero)
+                     (setf h33 (- (* h33 h44) h43h34))
+                     (setf h44 (/ h33 (+ (f2cl-lib:sign disc ave) ave))))
+                    (t
+                     (setf h44 (+ (f2cl-lib:sign disc ave) ave))))
+                  (setf h33 h44)
+                  (setf h43h34 zero)))))
+            (f2cl-lib:fdo (m (f2cl-lib:int-add i (f2cl-lib:int-sub 2))
+                           (f2cl-lib:int-add m (f2cl-lib:int-sub 1)))
+                          ((> m l) nil)
+              (tagbody
+                (setf h11
+                        (f2cl-lib:fref h-%data%
+                                       (m m)
+                                       ((1 ldh) (1 *))
+                                       h-%offset%))
+                (setf h22
+                        (f2cl-lib:fref h-%data%
+                                       ((f2cl-lib:int-add m 1)
+                                        (f2cl-lib:int-add m 1))
+                                       ((1 ldh) (1 *))
+                                       h-%offset%))
+                (setf h21
+                        (f2cl-lib:fref h-%data%
+                                       ((f2cl-lib:int-add m 1) m)
+                                       ((1 ldh) (1 *))
+                                       h-%offset%))
+                (setf h12
+                        (f2cl-lib:fref h-%data%
+                                       (m (f2cl-lib:int-add m 1))
+                                       ((1 ldh) (1 *))
+                                       h-%offset%))
+                (setf h44s (- h44 h11))
+                (setf h33s (- h33 h11))
+                (setf v1 (+ (/ (- (* h33s h44s) h43h34) h21) h12))
+                (setf v2 (- h22 h11 h33s h44s))
+                (setf v3
+                        (f2cl-lib:fref h-%data%
+                                       ((f2cl-lib:int-add m 2)
+                                        (f2cl-lib:int-add m 1))
+                                       ((1 ldh) (1 *))
+                                       h-%offset%))
+                (setf s (+ (abs v1) (abs v2) (abs v3)))
+                (setf v1 (/ v1 s))
+                (setf v2 (/ v2 s))
+                (setf v3 (/ v3 s))
+                (setf (f2cl-lib:fref v (1) ((1 3))) v1)
+                (setf (f2cl-lib:fref v (2) ((1 3))) v2)
+                (setf (f2cl-lib:fref v (3) ((1 3))) v3)
+                (if (= m l) (go label50))
+                (setf h00
+                        (f2cl-lib:fref h-%data%
+                                       ((f2cl-lib:int-sub m 1)
+                                        (f2cl-lib:int-sub m 1))
+                                       ((1 ldh) (1 *))
+                                       h-%offset%))
+                (setf h10
+                        (f2cl-lib:fref h-%data%
+                                       (m (f2cl-lib:int-sub m 1))
+                                       ((1 ldh) (1 *))
+                                       h-%offset%))
+                (setf tst1 (* (abs v1) (+ (abs h00) (abs h11) (abs h22))))
+                (if (<= (* (abs h10) (+ (abs v2) (abs v3))) (* ulp tst1))
+                    (go label50))))
+ label50
+            (f2cl-lib:fdo (k m (f2cl-lib:int-add k 1))
+                          ((> k (f2cl-lib:int-add i (f2cl-lib:int-sub 1))) nil)
+              (tagbody
+                (setf nr
+                        (min (the fixnum 3)
+                             (the fixnum
+                                  (f2cl-lib:int-add (f2cl-lib:int-sub i k)
+                                                    1))))
+                (if (> k m)
+                    (dcopy nr
+                     (f2cl-lib:array-slice h
+                                           double-float
+                                           (k (f2cl-lib:int-sub k 1))
+                                           ((1 ldh) (1 *)))
+                     1 v 1))
+                (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                    (dlarfg nr (f2cl-lib:fref v (1) ((1 3)))
+                     (f2cl-lib:array-slice v double-float (2) ((1 3))) 1 t1)
+                  (declare (ignore var-0 var-2 var-3))
+                  (setf (f2cl-lib:fref v (1) ((1 3))) var-1)
+                  (setf t1 var-4))
+                (cond
+                  ((> k m)
+                   (setf (f2cl-lib:fref h-%data%
+                                        (k (f2cl-lib:int-sub k 1))
+                                        ((1 ldh) (1 *))
+                                        h-%offset%)
+                           (f2cl-lib:fref v (1) ((1 3))))
+                   (setf (f2cl-lib:fref h-%data%
+                                        ((f2cl-lib:int-add k 1)
+                                         (f2cl-lib:int-sub k 1))
+                                        ((1 ldh) (1 *))
+                                        h-%offset%)
+                           zero)
+                   (if (< k (f2cl-lib:int-sub i 1))
+                       (setf (f2cl-lib:fref h-%data%
+                                            ((f2cl-lib:int-add k 2)
+                                             (f2cl-lib:int-sub k 1))
+                                            ((1 ldh) (1 *))
+                                            h-%offset%)
+                               zero)))
+                  ((> m l)
+                   (setf (f2cl-lib:fref h-%data%
+                                        (k (f2cl-lib:int-sub k 1))
+                                        ((1 ldh) (1 *))
+                                        h-%offset%)
+                           (-
+                            (f2cl-lib:fref h-%data%
+                                           (k (f2cl-lib:int-sub k 1))
+                                           ((1 ldh) (1 *))
+                                           h-%offset%)))))
+                (setf v2 (f2cl-lib:fref v (2) ((1 3))))
+                (setf t2 (* t1 v2))
+                (cond
+                  ((= nr 3)
+                   (setf v3 (f2cl-lib:fref v (3) ((1 3))))
+                   (setf t3 (* t1 v3))
+                   (f2cl-lib:fdo (j k (f2cl-lib:int-add j 1))
+                                 ((> j i2) nil)
+                     (tagbody
+                       (setf sum
+                               (+
+                                (f2cl-lib:fref h-%data%
+                                               (k j)
+                                               ((1 ldh) (1 *))
+                                               h-%offset%)
+                                (* v2
+                                   (f2cl-lib:fref h-%data%
+                                                  ((f2cl-lib:int-add k 1) j)
+                                                  ((1 ldh) (1 *))
+                                                  h-%offset%))
+                                (* v3
+                                   (f2cl-lib:fref h-%data%
+                                                  ((f2cl-lib:int-add k 2) j)
+                                                  ((1 ldh) (1 *))
+                                                  h-%offset%))))
+                       (setf (f2cl-lib:fref h-%data%
+                                            (k j)
+                                            ((1 ldh) (1 *))
+                                            h-%offset%)
+                               (-
+                                (f2cl-lib:fref h-%data%
+                                               (k j)
+                                               ((1 ldh) (1 *))
+                                               h-%offset%)
+                                (* sum t1)))
+                       (setf (f2cl-lib:fref h-%data%
+                                            ((f2cl-lib:int-add k 1) j)
+                                            ((1 ldh) (1 *))
+                                            h-%offset%)
+                               (-
+                                (f2cl-lib:fref h-%data%
+                                               ((f2cl-lib:int-add k 1) j)
+                                               ((1 ldh) (1 *))
+                                               h-%offset%)
+                                (* sum t2)))
+                       (setf (f2cl-lib:fref h-%data%
+                                            ((f2cl-lib:int-add k 2) j)
+                                            ((1 ldh) (1 *))
+                                            h-%offset%)
+                               (-
+                                (f2cl-lib:fref h-%data%
+                                               ((f2cl-lib:int-add k 2) j)
+                                               ((1 ldh) (1 *))
+                                               h-%offset%)
+                                (* sum t3)))))
+                   (f2cl-lib:fdo (j i1 (f2cl-lib:int-add j 1))
+                                 ((> j
+                                     (min
+                                      (the fixnum
+                                           (f2cl-lib:int-add k 3))
+                                      (the fixnum i)))
+                                  nil)
+                     (tagbody
+                       (setf sum
+                               (+
+                                (f2cl-lib:fref h-%data%
+                                               (j k)
+                                               ((1 ldh) (1 *))
+                                               h-%offset%)
+                                (* v2
+                                   (f2cl-lib:fref h-%data%
+                                                  (j (f2cl-lib:int-add k 1))
+                                                  ((1 ldh) (1 *))
+                                                  h-%offset%))
+                                (* v3
+                                   (f2cl-lib:fref h-%data%
+                                                  (j (f2cl-lib:int-add k 2))
+                                                  ((1 ldh) (1 *))
+                                                  h-%offset%))))
+                       (setf (f2cl-lib:fref h-%data%
+                                            (j k)
+                                            ((1 ldh) (1 *))
+                                            h-%offset%)
+                               (-
+                                (f2cl-lib:fref h-%data%
+                                               (j k)
+                                               ((1 ldh) (1 *))
+                                               h-%offset%)
+                                (* sum t1)))
+                       (setf (f2cl-lib:fref h-%data%
+                                            (j (f2cl-lib:int-add k 1))
+                                            ((1 ldh) (1 *))
+                                            h-%offset%)
+                               (-
+                                (f2cl-lib:fref h-%data%
+                                               (j (f2cl-lib:int-add k 1))
+                                               ((1 ldh) (1 *))
+                                               h-%offset%)
+                                (* sum t2)))
+                       (setf (f2cl-lib:fref h-%data%
+                                            (j (f2cl-lib:int-add k 2))
+                                            ((1 ldh) (1 *))
+                                            h-%offset%)
+                               (-
+                                (f2cl-lib:fref h-%data%
+                                               (j (f2cl-lib:int-add k 2))
+                                               ((1 ldh) (1 *))
+                                               h-%offset%)
+                                (* sum t3)))))
+                   (cond
+                     (wantz
+                      (f2cl-lib:fdo (j iloz (f2cl-lib:int-add j 1))
+                                    ((> j ihiz) nil)
+                        (tagbody
+                          (setf sum
+                                  (+
+                                   (f2cl-lib:fref z-%data%
+                                                  (j k)
+                                                  ((1 ldz) (1 *))
+                                                  z-%offset%)
+                                   (* v2
+                                      (f2cl-lib:fref z-%data%
+                                                     (j (f2cl-lib:int-add k 1))
+                                                     ((1 ldz) (1 *))
+                                                     z-%offset%))
+                                   (* v3
+                                      (f2cl-lib:fref z-%data%
+                                                     (j (f2cl-lib:int-add k 2))
+                                                     ((1 ldz) (1 *))
+                                                     z-%offset%))))
+                          (setf (f2cl-lib:fref z-%data%
+                                               (j k)
+                                               ((1 ldz) (1 *))
+                                               z-%offset%)
+                                  (-
+                                   (f2cl-lib:fref z-%data%
+                                                  (j k)
+                                                  ((1 ldz) (1 *))
+                                                  z-%offset%)
+                                   (* sum t1)))
+                          (setf (f2cl-lib:fref z-%data%
+                                               (j (f2cl-lib:int-add k 1))
+                                               ((1 ldz) (1 *))
+                                               z-%offset%)
+                                  (-
+                                   (f2cl-lib:fref z-%data%
+                                                  (j (f2cl-lib:int-add k 1))
+                                                  ((1 ldz) (1 *))
+                                                  z-%offset%)
+                                   (* sum t2)))
+                          (setf (f2cl-lib:fref z-%data%
+                                               (j (f2cl-lib:int-add k 2))
+                                               ((1 ldz) (1 *))
+                                               z-%offset%)
+                                  (-
+                                   (f2cl-lib:fref z-%data%
+                                                  (j (f2cl-lib:int-add k 2))
+                                                  ((1 ldz) (1 *))
+                                                  z-%offset%)
+                                   (* sum t3))))))))
+                  ((= nr 2)
+                   (f2cl-lib:fdo (j k (f2cl-lib:int-add j 1))
+                                 ((> j i2) nil)
+                     (tagbody
+                       (setf sum
+                               (+
+                                (f2cl-lib:fref h-%data%
+                                               (k j)
+                                               ((1 ldh) (1 *))
+                                               h-%offset%)
+                                (* v2
+                                   (f2cl-lib:fref h-%data%
+                                                  ((f2cl-lib:int-add k 1) j)
+                                                  ((1 ldh) (1 *))
+                                                  h-%offset%))))
+                       (setf (f2cl-lib:fref h-%data%
+                                            (k j)
+                                            ((1 ldh) (1 *))
+                                            h-%offset%)
+                               (-
+                                (f2cl-lib:fref h-%data%
+                                               (k j)
+                                               ((1 ldh) (1 *))
+                                               h-%offset%)
+                                (* sum t1)))
+                       (setf (f2cl-lib:fref h-%data%
+                                            ((f2cl-lib:int-add k 1) j)
+                                            ((1 ldh) (1 *))
+                                            h-%offset%)
+                               (-
+                                (f2cl-lib:fref h-%data%
+                                               ((f2cl-lib:int-add k 1) j)
+                                               ((1 ldh) (1 *))
+                                               h-%offset%)
+                                (* sum t2)))))
+                   (f2cl-lib:fdo (j i1 (f2cl-lib:int-add j 1))
+                                 ((> j i) nil)
+                     (tagbody
+                       (setf sum
+                               (+
+                                (f2cl-lib:fref h-%data%
+                                               (j k)
+                                               ((1 ldh) (1 *))
+                                               h-%offset%)
+                                (* v2
+                                   (f2cl-lib:fref h-%data%
+                                                  (j (f2cl-lib:int-add k 1))
+                                                  ((1 ldh) (1 *))
+                                                  h-%offset%))))
+                       (setf (f2cl-lib:fref h-%data%
+                                            (j k)
+                                            ((1 ldh) (1 *))
+                                            h-%offset%)
+                               (-
+                                (f2cl-lib:fref h-%data%
+                                               (j k)
+                                               ((1 ldh) (1 *))
+                                               h-%offset%)
+                                (* sum t1)))
+                       (setf (f2cl-lib:fref h-%data%
+                                            (j (f2cl-lib:int-add k 1))
+                                            ((1 ldh) (1 *))
+                                            h-%offset%)
+                               (-
+                                (f2cl-lib:fref h-%data%
+                                               (j (f2cl-lib:int-add k 1))
+                                               ((1 ldh) (1 *))
+                                               h-%offset%)
+                                (* sum t2)))))
+                   (cond
+                     (wantz
+                      (f2cl-lib:fdo (j iloz (f2cl-lib:int-add j 1))
+                                    ((> j ihiz) nil)
+                        (tagbody
+                          (setf sum
+                                  (+
+                                   (f2cl-lib:fref z-%data%
+                                                  (j k)
+                                                  ((1 ldz) (1 *))
+                                                  z-%offset%)
+                                   (* v2
+                                      (f2cl-lib:fref z-%data%
+                                                     (j (f2cl-lib:int-add k 1))
+                                                     ((1 ldz) (1 *))
+                                                     z-%offset%))))
+                          (setf (f2cl-lib:fref z-%data%
+                                               (j k)
+                                               ((1 ldz) (1 *))
+                                               z-%offset%)
+                                  (-
+                                   (f2cl-lib:fref z-%data%
+                                                  (j k)
+                                                  ((1 ldz) (1 *))
+                                                  z-%offset%)
+                                   (* sum t1)))
+                          (setf (f2cl-lib:fref z-%data%
+                                               (j (f2cl-lib:int-add k 1))
+                                               ((1 ldz) (1 *))
+                                               z-%offset%)
+                                  (-
+                                   (f2cl-lib:fref z-%data%
+                                                  (j (f2cl-lib:int-add k 1))
+                                                  ((1 ldz) (1 *))
+                                                  z-%offset%)
+                                   (* sum t2)))))))))))))
+        (setf info i)
+        (go end_label)
+ label140
+        (cond
+          ((= l i)
+           (setf (f2cl-lib:fref wr-%data% (i) ((1 *)) wr-%offset%)
+                   (f2cl-lib:fref h-%data% (i i) ((1 ldh) (1 *)) h-%offset%))
+           (setf (f2cl-lib:fref wi-%data% (i) ((1 *)) wi-%offset%) zero))
+          ((= l (f2cl-lib:int-add i (f2cl-lib:int-sub 1)))
+           (multiple-value-bind
+                 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9)
+               (dlanv2
+                (f2cl-lib:fref h-%data%
+                               ((f2cl-lib:int-sub i 1) (f2cl-lib:int-sub i 1))
+                               ((1 ldh) (1 *))
+                               h-%offset%)
+                (f2cl-lib:fref h-%data%
+                               ((f2cl-lib:int-sub i 1) i)
+                               ((1 ldh) (1 *))
+                               h-%offset%)
+                (f2cl-lib:fref h-%data%
+                               (i (f2cl-lib:int-sub i 1))
+                               ((1 ldh) (1 *))
+                               h-%offset%)
+                (f2cl-lib:fref h-%data% (i i) ((1 ldh) (1 *)) h-%offset%)
+                (f2cl-lib:fref wr-%data%
+                               ((f2cl-lib:int-sub i 1))
+                               ((1 *))
+                               wr-%offset%)
+                (f2cl-lib:fref wi-%data%
+                               ((f2cl-lib:int-sub i 1))
+                               ((1 *))
+                               wi-%offset%)
+                (f2cl-lib:fref wr-%data% (i) ((1 *)) wr-%offset%)
+                (f2cl-lib:fref wi-%data% (i) ((1 *)) wi-%offset%) cs sn)
+             (declare (ignore))
+             (setf (f2cl-lib:fref h-%data%
+                                  ((f2cl-lib:int-sub i 1)
+                                   (f2cl-lib:int-sub i 1))
+                                  ((1 ldh) (1 *))
+                                  h-%offset%)
+                     var-0)
+             (setf (f2cl-lib:fref h-%data%
+                                  ((f2cl-lib:int-sub i 1) i)
+                                  ((1 ldh) (1 *))
+                                  h-%offset%)
+                     var-1)
+             (setf (f2cl-lib:fref h-%data%
+                                  (i (f2cl-lib:int-sub i 1))
+                                  ((1 ldh) (1 *))
+                                  h-%offset%)
+                     var-2)
+             (setf (f2cl-lib:fref h-%data% (i i) ((1 ldh) (1 *)) h-%offset%)
+                     var-3)
+             (setf (f2cl-lib:fref wr-%data%
+                                  ((f2cl-lib:int-sub i 1))
+                                  ((1 *))
+                                  wr-%offset%)
+                     var-4)
+             (setf (f2cl-lib:fref wi-%data%
+                                  ((f2cl-lib:int-sub i 1))
+                                  ((1 *))
+                                  wi-%offset%)
+                     var-5)
+             (setf (f2cl-lib:fref wr-%data% (i) ((1 *)) wr-%offset%) var-6)
+             (setf (f2cl-lib:fref wi-%data% (i) ((1 *)) wi-%offset%) var-7)
+             (setf cs var-8)
+             (setf sn var-9))
+           (cond
+             (wantt
+              (if (> i2 i)
+                  (drot (f2cl-lib:int-sub i2 i)
+                   (f2cl-lib:array-slice h
+                                         double-float
+                                         ((+ i (f2cl-lib:int-sub 1))
+                                          (f2cl-lib:int-add i 1))
+                                         ((1 ldh) (1 *)))
+                   ldh
+                   (f2cl-lib:array-slice h
+                                         double-float
+                                         (i (f2cl-lib:int-add i 1))
+                                         ((1 ldh) (1 *)))
+                   ldh cs sn))
+              (drot (f2cl-lib:int-sub i i1 1)
+               (f2cl-lib:array-slice h
+                                     double-float
+                                     (i1 (f2cl-lib:int-sub i 1))
+                                     ((1 ldh) (1 *)))
+               1 (f2cl-lib:array-slice h double-float (i1 i) ((1 ldh) (1 *))) 1
+               cs sn)))
+           (cond
+             (wantz
+              (drot nz
+               (f2cl-lib:array-slice z
+                                     double-float
+                                     (iloz (f2cl-lib:int-sub i 1))
+                                     ((1 ldz) (1 *)))
+               1 (f2cl-lib:array-slice z double-float (iloz i) ((1 ldz) (1 *)))
+               1 cs sn)))))
+        (setf itn (f2cl-lib:int-sub itn its))
+        (setf i (f2cl-lib:int-sub l 1))
+        (go label10)
+ end_label
+        (return
+         (values nil nil 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::dlahqr
+                 fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '((member t nil) (member t nil)
+                        fixnum fixnum
+                        fixnum (array double-float (*))
+                        fixnum (array double-float (*))
+                        (array double-float (*)) fixnum
+                        fixnum (array double-float (*))
+                        fixnum
+                        fixnum)
+           :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil nil
+                            fortran-to-lisp::info)
+           :calls '(fortran-to-lisp::drot fortran-to-lisp::dlanv2
+                    fortran-to-lisp::dlarfg fortran-to-lisp::dcopy
+                    fortran-to-lisp::dlanhs fortran-to-lisp::dlabad
+                    fortran-to-lisp::dlamch))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dlahrd LAPACK}
+\pagehead{dlahrd}{dlahrd}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<LAPACK dlahrd>>=
+(let* ((zero 0.0) (one 1.0))
+  (declare (type (double-float 0.0 0.0) zero)
+           (type (double-float 1.0 1.0) one))
+  (defun dlahrd (n k nb a lda tau t$ ldt y ldy)
+    (declare (type (array double-float (*)) y t$ tau a)
+             (type fixnum ldy ldt lda nb k n))
+    (f2cl-lib:with-multi-array-data
+        ((a double-float a-%data% a-%offset%)
+         (tau double-float tau-%data% tau-%offset%)
+         (t$ double-float t$-%data% t$-%offset%)
+         (y double-float y-%data% y-%offset%))
+      (prog ((ei 0.0) (i 0))
+        (declare (type (double-float) ei) (type fixnum i))
+        (if (<= n 1) (go end_label))
+        (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
+                      ((> i nb) nil)
+          (tagbody
+            (cond
+              ((> i 1)
+               (dgemv "No transpose" n (f2cl-lib:int-sub i 1) (- one) y ldy
+                (f2cl-lib:array-slice a
+                                      double-float
+                                      ((+ k i (f2cl-lib:int-sub 1)) 1)
+                                      ((1 lda) (1 *)))
+                lda one
+                (f2cl-lib:array-slice a double-float (1 i) ((1 lda) (1 *))) 1)
+               (dcopy (f2cl-lib:int-sub i 1)
+                (f2cl-lib:array-slice a
+                                      double-float
+                                      ((+ k 1) i)
+                                      ((1 lda) (1 *)))
+                1
+                (f2cl-lib:array-slice t$ double-float (1 nb) ((1 ldt) (1 nb)))
+                1)
+               (dtrmv "Lower" "Transpose" "Unit" (f2cl-lib:int-sub i 1)
+                (f2cl-lib:array-slice a
+                                      double-float
+                                      ((+ k 1) 1)
+                                      ((1 lda) (1 *)))
+                lda
+                (f2cl-lib:array-slice t$ double-float (1 nb) ((1 ldt) (1 nb)))
+                1)
+               (dgemv "Transpose" (f2cl-lib:int-add (f2cl-lib:int-sub n k i) 1)
+                (f2cl-lib:int-sub i 1) one
+                (f2cl-lib:array-slice a
+                                      double-float
+                                      ((+ k i) 1)
+                                      ((1 lda) (1 *)))
+                lda
+                (f2cl-lib:array-slice a
+                                      double-float
+                                      ((+ k i) i)
+                                      ((1 lda) (1 *)))
+                1 one
+                (f2cl-lib:array-slice t$ double-float (1 nb) ((1 ldt) (1 nb)))
+                1)
+               (dtrmv "Upper" "Transpose" "Non-unit" (f2cl-lib:int-sub i 1) t$
+                ldt
+                (f2cl-lib:array-slice t$ double-float (1 nb) ((1 ldt) (1 nb)))
+                1)
+               (dgemv "No transpose"
+                (f2cl-lib:int-add (f2cl-lib:int-sub n k i) 1)
+                (f2cl-lib:int-sub i 1) (- one)
+                (f2cl-lib:array-slice a
+                                      double-float
+                                      ((+ k i) 1)
+                                      ((1 lda) (1 *)))
+                lda
+                (f2cl-lib:array-slice t$ double-float (1 nb) ((1 ldt) (1 nb)))
+                1 one
+                (f2cl-lib:array-slice a
+                                      double-float
+                                      ((+ k i) i)
+                                      ((1 lda) (1 *)))
+                1)
+               (dtrmv "Lower" "No transpose" "Unit" (f2cl-lib:int-sub i 1)
+                (f2cl-lib:array-slice a
+                                      double-float
+                                      ((+ k 1) 1)
+                                      ((1 lda) (1 *)))
+                lda
+                (f2cl-lib:array-slice t$ double-float (1 nb) ((1 ldt) (1 nb)))
+                1)
+               (daxpy (f2cl-lib:int-sub i 1) (- one)
+                (f2cl-lib:array-slice t$ double-float (1 nb) ((1 ldt) (1 nb)))
+                1
+                (f2cl-lib:array-slice a
+                                      double-float
+                                      ((+ k 1) i)
+                                      ((1 lda) (1 *)))
+                1)
+               (setf (f2cl-lib:fref a-%data%
+                                    ((f2cl-lib:int-sub (f2cl-lib:int-add k i)
+                                                       1)
+                                     (f2cl-lib:int-sub i 1))
+                                    ((1 lda) (1 *))
+                                    a-%offset%)
+                       ei)))
+            (multiple-value-bind (var-0 var-1 var-2 var-3 var-4)
+                (dlarfg (f2cl-lib:int-add (f2cl-lib:int-sub n k i) 1)
+                 (f2cl-lib:fref a-%data%
+                                ((f2cl-lib:int-add k i) i)
+                                ((1 lda) (1 *))
+                                a-%offset%)
+                 (f2cl-lib:array-slice a
+                                       double-float
+                                       ((min (f2cl-lib:int-add k i 1) n) i)
+                                       ((1 lda) (1 *)))
+                 1 (f2cl-lib:fref tau-%data% (i) ((1 nb)) tau-%offset%))
+              (declare (ignore var-0 var-2 var-3))
+              (setf (f2cl-lib:fref a-%data%
+                                   ((f2cl-lib:int-add k i) i)
+                                   ((1 lda) (1 *))
+                                   a-%offset%)
+                      var-1)
+              (setf (f2cl-lib:fref tau-%data% (i) ((1 nb)) tau-%offset%)
+                      var-4))
+            (setf ei
+                    (f2cl-lib:fref a-%data%
+                                   ((f2cl-lib:int-add k i) i)
+                                   ((1 lda) (1 *))
+                                   a-%offset%))
+            (setf (f2cl-lib:fref a-%data%
+                                 ((f2cl-lib:int-add k i) i)
+                                 ((1 lda) (1 *))
+                                 a-%offset%)
+                    one)
+            (dgemv "No transpose" n
+             (f2cl-lib:int-add (f2cl-lib:int-sub n k i) 1) one
+             (f2cl-lib:array-slice a
+                                   double-float
+                                   (1 (f2cl-lib:int-add i 1))
+                                   ((1 lda) (1 *)))
+             lda
+             (f2cl-lib:array-slice a double-float ((+ k i) i) ((1 lda) (1 *)))
+             1 zero
+             (f2cl-lib:array-slice y double-float (1 i) ((1 ldy) (1 nb))) 1)
+            (dgemv "Transpose" (f2cl-lib:int-add (f2cl-lib:int-sub n k i) 1)
+             (f2cl-lib:int-sub i 1) one
+             (f2cl-lib:array-slice a double-float ((+ k i) 1) ((1 lda) (1 *)))
+             lda
+             (f2cl-lib:array-slice a double-float ((+ k i) i) ((1 lda) (1 *)))
+             1 zero
+             (f2cl-lib:array-slice t$ double-float (1 i) ((1 ldt) (1 nb))) 1)
+            (dgemv "No transpose" n (f2cl-lib:int-sub i 1) (- one) y ldy
+             (f2cl-lib:array-slice t$ double-float (1 i) ((1 ldt) (1 nb))) 1
+             one (f2cl-lib:array-slice y double-float (1 i) ((1 ldy) (1 nb)))
+             1)
+            (dscal n (f2cl-lib:fref tau-%data% (i) ((1 nb)) tau-%offset%)
+             (f2cl-lib:array-slice y double-float (1 i) ((1 ldy) (1 nb))) 1)
+            (dscal (f2cl-lib:int-sub i 1)
+             (- (f2cl-lib:fref tau-%data% (i) ((1 nb)) tau-%offset%))
+             (f2cl-lib:array-slice t$ double-float (1 i) ((1 ldt) (1 nb))) 1)
+            (dtrmv "Upper" "No transpose" "Non-unit" (f2cl-lib:int-sub i 1) t$
+             ldt (f2cl-lib:array-slice t$ double-float (1 i) ((1 ldt) (1 nb)))
+             1)
+            (setf (f2cl-lib:fref t$-%data% (i i) ((1 ldt) (1 nb)) t$-%offset%)
+                    (f2cl-lib:fref tau-%data% (i) ((1 nb)) tau-%offset%))))
+        (setf (f2cl-lib:fref a-%data%
+                             ((f2cl-lib:int-add k nb) nb)
+                             ((1 lda) (1 *))
+                             a-%offset%)
+                ei)
+ end_label
+        (return (values nil nil nil nil nil 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::dlahrd
+                 fortran-to-lisp::*f2cl-function-info*)
+          (fortran-to-lisp::make-f2cl-finfo
+           :arg-types '(fixnum fixnum
+                        fixnum (array double-float (*))
+                        fixnum (array double-float (*))
+                        (array double-float (*)) fixnum
+                        (array double-float (*)) fixnum)
+           :return-values '(nil nil nil nil nil nil nil nil nil nil)
+           :calls '(fortran-to-lisp::dscal fortran-to-lisp::dlarfg
+                    fortran-to-lisp::daxpy fortran-to-lisp::dtrmv
+                    fortran-to-lisp::dcopy fortran-to-lisp::dgemv))))
+
+@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{dlaln2 LAPACK}
+\pagehead{dlaln2}{dlaln2}
+%\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00}
+
+<<LAPACK dlaln2>>=
+(let* ((zero 0.0) (one 1.0) (two 2.0))
+  (declare (type (double-float 0.0 0.0) zero)
+           (type (double-float 1.0 1.0) one)
+           (type (double-float 2.0 2.0) two))
+  (let ((zswap
+         (make-array 4 :element-type 't :initial-contents '(nil nil t t)))
+        (rswap
+         (make-array 4 :element-type 't :initial-contents '(nil t nil t)))
+        (ipivot
+         (make-array 16
+                     :element-type 'fixnum
+                     :initial-contents '(1 2 3 4 2 1 4 3 3 4 1 2 4 3 2 1))))
+    (declare (type (array fixnum (16)) ipivot)
+             (type (array (member t nil) (4)) rswap zswap))
+    (defun dlaln2
+           (ltrans na nw smin ca a lda d1 d2 b ldb$ wr wi x ldx scale xnorm
+            info)
+      (declare (type (array double-float (*)) x b a)
+               (type (double-float) xnorm scale wi wr d2 d1 ca smin)
+               (type fixnum info ldx ldb$ lda nw na)
+               (type (member t nil) ltrans))
+      (f2cl-lib:with-multi-array-data
+          ((a double-float a-%data% a-%offset%)
+           (b double-float b-%data% b-%offset%)
+           (x double-float x-%data% x-%offset%))
+        (prog ((ci (make-array 4 :element-type 'double-float))
+               (civ (make-array 4 :element-type 'double-float))
+               (cr (make-array 4 :element-type 'double-float))
+               (crv (make-array 4 :element-type 'double-float)) (bbnd 0.0)
+               (bi1 0.0) (bi2 0.0) (bignum 0.0) (bnorm 0.0) (br1 0.0) (br2 0.0)
+               (ci21 0.0) (ci22 0.0) (cmax 0.0) (cnorm 0.0) (cr21 0.0)
+               (cr22 0.0) (csi 0.0) (csr 0.0) (li21 0.0) (lr21 0.0) (smini 0.0)
+               (smlnum 0.0) (temp 0.0) (u22abs 0.0) (ui11 0.0) (ui11r 0.0)
+               (ui12 0.0) (ui12s 0.0) (ui22 0.0) (ur11 0.0) (ur11r 0.0)
+               (ur12 0.0) (ur12s 0.0) (ur22 0.0) (xi1 0.0) (xi2 0.0) (xr1 0.0)
+               (xr2 0.0) (icmax 0) (j 0))
+          (declare (type (array double-float (4)) ci civ cr crv)
+                   (type (double-float) bbnd bi1 bi2 bignum bnorm br1 br2 ci21
+                                        ci22 cmax cnorm cr21 cr22 csi csr li21
+                                        lr21 smini smlnum temp u22abs ui11
+                                        ui11r ui12 ui12s ui22 ur11 ur11r ur12
+                                        ur12s ur22 xi1 xi2 xr1 xr2)
+                   (type fixnum icmax j))
+          (setf smlnum (* two (dlamch "Safe minimum")))
+          (setf bignum (/ one smlnum))
+          (setf smini (max smin smlnum))
+          (setf info 0)
+          (setf scale one)
+          (cond
+            ((= na 1)
+             (cond
+               ((= nw 1)
+                (setf csr
+                        (-
+                         (* ca
+                            (f2cl-lib:fref a-%data%
+                                           (1 1)
+                                           ((1 lda) (1 *))
+                                           a-%offset%))
+                         (* wr d1)))
+                (setf cnorm (abs csr))
+                (cond
+                  ((< cnorm smini)
+                   (setf csr smini)
+                   (setf cnorm smini)
+                   (setf info 1)))
+                (setf bnorm
+                        (abs
+                         (f2cl-lib:fref b-%data%
+                                        (1 1)
+                                        ((1 ldb$) (1 *))
+                                        b-%offset%)))
+                (cond
+                  ((and (< cnorm one) (> bnorm one))
+                   (if (> bnorm (* bignum cnorm)) (setf scale (/ one bnorm)))))
+                (setf (f2cl-lib:fref x-%data% (1 1) ((1 ldx) (1 *)) x-%offset%)
+                        (/
+                         (*
+                          (f2cl-lib:fref b-%data%
+                                         (1 1)
+                                         ((1 ldb$) (1 *))
+                                         b-%offset%)
+                          scale)
+                         csr))
+                (setf xnorm
+                        (abs
+                         (f2cl-lib:fref x-%data%
+                                        (1 1)
+                                        ((1 ldx) (1 *))
+                                        x-%offset%))))
+               (t
+                (setf csr
+                        (-
+                         (* ca
+                            (f2cl-lib:fref a-%data%
+                                           (1 1)
+                                           ((1 lda) (1 *))
+                                           a-%offset%))
+                         (* wr d1)))
+                (setf csi (* (- wi) d1))
+                (setf cnorm (+ (abs csr) (abs csi)))
+                (cond
+                  ((< cnorm smini)
+                   (setf csr smini)
+                   (setf csi zero)
+                   (setf cnorm smini)
+                   (setf info 1)))
+                (setf bnorm
+                        (+
+                         (abs
+                          (f2cl-lib:fref b-%data%
+                                         (1 1)
+                                         ((1 ldb$) (1 *))
+                                         b-%offset%))
+                         (abs
+                          (f2cl-lib:fref b-%data%
+                                         (1 2)
+                                         ((1 ldb$) (1 *))
+                                         b-%offset%))))
+                (cond
+                  ((and (< cnorm one) (> bnorm one))
+                   (if (> bnorm (* bignum cnorm)) (setf scale (/ one bnorm)))))
+                (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5)
+                    (dladiv
+                     (* scale
+                        (f2cl-lib:fref b-%data%
+                                       (1 1)
+                                       ((1 ldb$) (1 *))
+                                       b-%offset%))
+                     (* scale
+                        (f2cl-lib:fref b-%data%
+                                       (1 2)
+                                       ((1 ldb$) (1 *))
+                                       b-%offset%))
+                     csr csi
+                     (f2cl-lib:fref x-%data% (1 1) ((1 ldx) (1 *)) x-%offset%)
+                     (f2cl-lib:fref x-%data% (1 2) ((1 ldx) (1 *)) x-%offset%))
+                  (declare (ignore var-0 var-1 var-2 var-3))
+                  (setf (f2cl-lib:fref x-%data%
+                                       (1 1)
+                                       ((1 ldx) (1 *))
+                                       x-%offset%)
+                          var-4)
+                  (setf (f2cl-lib:fref x-%data%
+                                       (1 2)
+                                       ((1 ldx) (1 *))
+                                       x-%offset%)
+                          var-5))
+                (setf xnorm
+                        (+
+                         (abs
+                          (f2cl-lib:fref x-%data%
+                                         (1 1)
+                                         ((1 ldx) (1 *))
+                                         x-%offset%))
+                         (abs
+                          (f2cl-lib:fref x-%data%
+                                         (1 2)
+                                         ((1 ldx) (1 *))
+                                         x-%offset%)))))))
+            (t
+             (setf (f2cl-lib:fref crv (1) ((1 4)))
+                     (-
+                      (* ca
+                         (f2cl-lib:fref a-%data%
+                                        (1 1)
+                                        ((1 lda) (1 *))
+                                        a-%offset%))
+                      (* wr d1)))
+             (setf (f2cl-lib:fref crv (4) ((1 4)))
+                     (-
+                      (* ca
+                         (f2cl-lib:fref a-%data%
+                                        (2 2)
+                                        ((1 lda) (1 *))
+                                        a-%offset%))
+                      (* wr d2)))
+             (cond
+               (ltrans
+                (setf (f2cl-lib:fref crv (3) ((1 4)))
+                        (* ca
+                           (f2cl-lib:fref a-%data%
+                                          (2 1)
+                                          ((1 lda) (1 *))
+                                          a-%offset%)))
+                (setf (f2cl-lib:fref crv (2) ((1 4)))
+                        (* ca
+                           (f2cl-lib:fref a-%data%
+                                          (1 2)
+                                          ((1 lda) (1 *))
+                                          a-%offset%))))
+               (t
+                (setf (f2cl-lib:fref crv (2) ((1 4)))
+                        (* ca
+                           (f2cl-lib:fref a-%data%
+                                          (2 1)
+                                          ((1 lda) (1 *))
+                                          a-%offset%)))
+                (setf (f2cl-lib:fref crv (3) ((1 4)))
+                        (* ca
+                           (f2cl-lib:fref a-%data%
+                                          (1 2)
+                                          ((1 lda) (1 *))
+                                          a-%offset%)))))
+             (cond
+               ((= nw 1)
+                (setf cmax zero)
+                (setf icmax 0)
+                (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
+                              ((> j 4) nil)
+                  (tagbody
+                    (cond
+                      ((> (abs (f2cl-lib:fref crv (j) ((1 4)))) cmax)
+                       (setf cmax (abs (f2cl-lib:fref crv (j) ((1 4)))))
+                       (setf icmax j)))))
+                (cond
+                  ((< cmax smini)
+                   (setf bnorm
+                           (max
+                            (abs
+                             (f2cl-lib:fref b-%data%
+                                            (1 1)
+                                            ((1 ldb$) (1 *))
+                                            b-%offset%))
+                            (abs
+                             (f2cl-lib:fref b-%data%
+                                            (2 1)
+                                            ((1 ldb$) (1 *))
+                                            b-%offset%))))
+                   (cond
+                     ((and (< smini one) (> bnorm one))
+                      (if (> bnorm (* bignum smini))
+                          (setf scale (/ one bnorm)))))
+                   (setf temp (/ scale smini))
+                   (setf (f2cl-lib:fref x-%data%
+                                        (1 1)
+                                        ((1 ldx) (1 *))
+                                        x-%offset%)
+                           (* temp
+                              (f2cl-lib:fref b-%data%
+                                             (1 1)
+                                             ((1 ldb$) (1 *))
+                                             b-%offset%)))
+                   (setf (f2cl-lib:fref x-%data%
+                                        (2 1)
+                                        ((1 ldx) (1 *))
+                                        x-%offset%)
+                           (* temp
+                              (f2cl-lib:fref b-%data%
+                                             (2 1)
+                                             ((1 ldb$) (1 *))
+                                             b-%offset%)))
+                   (setf xnorm (* temp bnorm))
+                   (setf info 1)
+                   (go end_label)))
+                (setf ur11 (f2cl-lib:fref crv (icmax) ((1 4))))
+                (setf cr21
+                        (f2cl-lib:fref crv
+                                       ((f2cl-lib:fref ipivot
+                                                       (2 icmax)
+                                                       ((1 4) (1 4))))
+                                       ((1 4))))
+                (setf ur12
+                        (f2cl-lib:fref crv
+                                       ((f2cl-lib:fref ipivot
+                                                       (3 icmax)
+                                                       ((1 4) (1 4))))
+                                       ((1 4))))
+                (setf cr22
+                        (f2cl-lib:fref crv
+                                       ((f2cl-lib:fref ipivot
+                                                       (4 icmax)
+                                                       ((1 4) (1 4))))
+                                       ((1 4))))
+                (setf ur11r (/ one ur11))
+                (setf lr21 (* ur11r cr21))
+                (setf ur22 (- cr22 (* ur12 lr21)))
+                (cond
+                  ((< (abs ur22) smini)
+                   (setf ur22 smini)
+                   (setf info 1)))
+                (cond
+                  ((f2cl-lib:fref rswap (icmax) ((1 4)))
+                   (setf br1
+                           (f2cl-lib:fref b-%data%
+                                          (2 1)
+                                          ((1 ldb$) (1 *))
+                                          b-%offset%))
+                   (setf br2
+                           (f2cl-lib:fref b-%data%
+                                          (1 1)
+                                          ((1 ldb$) (1 *))
+                                          b-%offset%)))
+                  (t
+                   (setf br1
+                           (f2cl-lib:fref b-%data%
+                                          (1 1)
+                                          ((1 ldb$) (1 *))
+                                          b-%offset%))
+                   (setf br2
+                           (f2cl-lib:fref b-%data%
+                                          (2 1)
+                                          ((1 ldb$) (1 *))
+                                          b-%offset%))))
+                (setf br2 (- br2 (* lr21 br1)))
+                (setf bbnd (max (abs (* br1 (* ur22 ur11r))) (abs br2)))
+                (cond
+                  ((and (> bbnd one) (< (abs ur22) one))
+                   (if (>= bbnd (* bignum (abs ur22)))
+                       (setf scale (/ one bbnd)))))
+                (setf xr2 (/ (* br2 scale) ur22))
+                (setf xr1 (- (* scale br1 ur11r) (* xr2 (* ur11r ur12))))
+                (cond
+                  ((f2cl-lib:fref zswap (icmax) ((1 4)))
+                   (setf (f2cl-lib:fref x-%data%
+                                        (1 1)
+                                        ((1 ldx) (1 *))
+                                        x-%offset%)
+                           xr2)
+                   (setf (f2cl-lib:fref x-%data%
+                                        (2 1)
+                                        ((1 ldx) (1 *))
+                                        x-%offset%)
+                           xr1))
+                  (t
+                   (setf (f2cl-lib:fref x-%data%
+                                        (1 1)
+                                        ((1 ldx) (1 *))
+                                        x-%offset%)
+                           xr1)
+                   (setf (f2cl-lib:fref x-%data%
+                                        (2 1)
+                                        ((1 ldx) (1 *))
+                                        x-%offset%)
+                           xr2)))
+                (setf xnorm (max (abs xr1) (abs xr2)))
+                (cond
+                  ((and (> xnorm one) (> cmax one))
+                   (cond
+                     ((> xnorm (f2cl-lib:f2cl/ bignum cmax))
+                      (setf temp (/ cmax bignum))
+                      (setf (f2cl-lib:fref x-%data%
+                                           (1 1)
+                                           ((1 ldx) (1 *))
+                                           x-%offset%)
+                              (* temp
+                                 (f2cl-lib:fref x-%data%
+                                                (1 1)
+                                                ((1 ldx) (1 *))
+                                                x-%offset%)))
+                      (setf (f2cl-lib:fref x-%data%
+                                           (2 1)
+                                           ((1 ldx) (1 *))
+                                           x-%offset%)
+                              (* temp
+                                 (f2cl-lib:fref x-%data%
+                                                (2 1)
+                                                ((1 ldx) (1 *))
+                                                x-%offset%)))
+                      (setf xnorm (* temp xnorm))
+                      (setf scale (* temp scale)))))))
+               (t
+                (setf (f2cl-lib:fref civ (1) ((1 4))) (* (- wi) d1))
+                (setf (f2cl-lib:fref civ (2) ((1 4))) zero)
+                (setf (f2cl-lib:fref civ (3) ((1 4))) zero)
+                (setf (f2cl-lib:fref civ (4) ((1 4))) (* (- wi) d2))
+                (setf cmax zero)
+                (setf icmax 0)
+                (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
+                              ((> j 4) nil)
+                  (tagbody
+                    (cond
+                      ((>
+                        (+ (abs (f2cl-lib:fref crv (j) ((1 4))))
+                           (abs (f2cl-lib:fref civ (j) ((1 4)))))
+                        cmax)
+                       (setf cmax
+                               (+ (abs (f2cl-lib:fref crv (j) ((1 4))))
+                                  (abs (f2cl-lib:fref civ (j) ((1 4))))))
+                       (setf icmax j)))))
+                (cond
+                  ((< cmax smini)
+                   (setf bnorm
+                           (max
+                            (+
+                             (abs
+                              (f2cl-lib:fref b-%data%
+                                             (1 1)
+                                             ((1 ldb$) (1 *))
+                                             b-%offset%))
+                             (abs
+                              (f2cl-lib:fref b-%data%
+                                             (1 2)
+                                             ((1 ldb$) (1 *))
+                                             b-%offset%)))
+                            (+
+                             (abs
+                              (f2cl-lib:fref b-%data%
+                                             (2 1)
+                                             ((1 ldb$) (1 *))
+                                             b-%offset%))
+                             (abs
+                              (f2cl-lib:fref b-%data%
+                                             (2 2)
+                                             ((1 ldb$) (1 *))
+                                             b-%offset%)))))
+                   (cond
+                     ((and (< smini one) (> bnorm one))
+                      (if (> bnorm (* bignum smini))
+                          (setf scale (/ one bnorm)))))
+                   (setf temp (/ scale smini))
+                   (setf (f2cl-lib:fref x-%data%
+                                        (1 1)
+                                        ((1 ldx) (1 *))
+                                        x-%offset%)
+                           (* temp
+                              (f2cl-lib:fref b-%data%
+                                             (1 1)
+                                             ((1 ldb$) (1 *))
+                                             b-%offset%)))
+                   (setf (f2cl-lib:fref x-%data%
+                                        (2 1)
+                                        ((1 ldx) (1 *))
+                                        x-%offset%)
+                           (* temp
+                              (f2cl-lib:fref b-%data%
+                                             (2 1)
+                                             ((1 ldb$) (1 *))
+                                             b-%offset%)))
+                   (setf (f2cl-lib:fref x-%data%
+                                        (1 2)
+                                        ((1 ldx) (1 *))
+                                        x-%offset%)
+                           (* temp
+                              (f2cl-lib:fref b-%data%
+                                             (1 2)
+                                             ((1 ldb$) (1 *))
+                                             b-%offset%)))
+                   (setf (f2cl-lib:fref x-%data%
+                                        (2 2)
+                                        ((1 ldx) (1 *))
+                                        x-%offset%)
+                           (* temp
+                              (f2cl-lib:fref b-%data%
+                                             (2 2)
+                                             ((1 ldb$) (1 *))
+                                             b-%offset%)))
+                   (setf xnorm (* temp bnorm))
+                   (setf info 1)
+                   (go end_label)))
+                (setf ur11 (f2cl-lib:fref crv (icmax) ((1 4))))
+                (setf ui11 (f2cl-lib:fref civ (icmax) ((1 4))))
+                (setf cr21
+                        (f2cl-lib:fref crv
+                                       ((f2cl-lib:fref ipivot
+                                                       (2 icmax)
+                                                       ((1 4) (1 4))))
+                                       ((1 4))))
+                (setf ci21
+                        (f2cl-lib:fref civ
+                                       ((f2cl-lib:fref ipivot
+                                                       (2 icmax)
+                                                       ((1 4) (1 4))))
+                                       ((1 4))))
+                (setf ur12
+                        (f2cl-lib:fref crv
+                                       ((f2cl-lib:fref ipivot
+                                                       (3 icmax)
+                                                       ((1 4) (1 4))))
+                                       ((1 4))))
+                (setf ui12
+                        (f2cl-lib:fref civ
+                                       ((f2cl-lib:fref ipivot
+                                                       (3 icmax)
+                                                       ((1 4) (1 4))))
+                                       ((1 4))))
+                (setf cr22
+                        (f2cl-lib:fref crv
+                                       ((f2cl-lib:fref ipivot
+                                                       (4 icmax)
+                                                       ((1 4) (1 4))))
+                                       ((1 4))))
+                (setf ci22
+                        (f2cl-lib:fref civ
+                                       ((f2cl-lib:fref ipivot
+                                                       (4 icmax)
+                                                       ((1 4) (1 4))))
+                                       ((1 4))))
+                (cond
+                  ((or (= icmax 1) (= icmax 4))
+                   (cond
+                     ((> (abs ur11) (abs ui11))
+                      (setf temp (/ ui11 ur11))
+                      (setf ur11r (/ one (* ur11 (+ one (expt temp 2)))))
+                      (setf ui11r (* (- temp) ur11r)))
+                     (t
+                      (setf temp (/ ur11 ui11))
+                      (setf ui11r (/ (- one) (* ui11 (+ one (expt temp 2)))))
+                      (setf ur11r (* (- temp) ui11r))))
+                   (setf lr21 (* cr21 ur11r))
+                   (setf li21 (* cr21 ui11r))
+                   (setf ur12s (* ur12 ur11r))
+                   (setf ui12s (* ur12 ui11r))
+                   (setf ur22 (- cr22 (* ur12 lr21)))
+                   (setf ui22 (- ci22 (* ur12 li21))))
+                  (t
+                   (setf ur11r (/ one ur11))
+                   (setf ui11r zero)
+                   (setf lr21 (* cr21 ur11r))
+                   (setf li21 (* ci21 ur11r))
+                   (setf ur12s (* ur12 ur11r))
+                   (setf ui12s (* ui12 ur11r))
+                   (setf ur22 (+ (- cr22 (* ur12 lr21)) (* ui12 li21)))
+                   (setf ui22 (- (* (- ur12) li21) (* ui12 lr21)))))
+                (setf u22abs (+ (abs ur22) (abs ui22)))
+                (cond
+                  ((< u22abs smini)
+                   (setf ur22 smini)
+                   (setf ui22 zero)
+                   (setf info 1)))
+                (cond
+                  ((f2cl-lib:fref rswap (icmax) ((1 4)))
+                   (setf br2
+                           (f2cl-lib:fref b-%data%
+                                          (1 1)
+                                          ((1 ldb$) (1 *))
+                                          b-%offset%))
+                   (setf br1
+                           (f2cl-lib:fref b-%data%
+                                          (2 1)
+                                          ((1 ldb$) (1 *))
+                                          b-%offset%))
+                   (setf bi2
+                           (f2cl-lib:fref b-%data%
+                                          (1 2)
+                                          ((1 ldb$) (1 *))
+                                          b-%offset%))
+                   (setf bi1
+                           (f2cl-lib:fref b-%data%
+                                          (2 2)
+                                          ((1 ldb$) (1 *))
+                                          b-%offset%)))
+                  (t
+                   (setf br1
+                           (f2cl-lib:fref b-%data%
+                                          (1 1)
+                                          ((1 ldb$) (1 *))
+                                          b-%offset%))
+                   (setf br2
+                           (f2cl-lib:fref b-%data%
+                                          (2 1)
+                                          ((1 ldb$) (1 *))
+                                          b-%offset%))
+                   (setf bi1
+                           (f2cl-lib:fref b-%data%
+                                          (1 2)
+                                          ((1 ldb$) (1 *))
+                                          b-%offset%))
+                   (setf bi2
+                           (f2cl-lib:fref b-%data%
+                                          (2 2)
+                                          ((1 ldb$) (1 *))
+                                          b-%offset%))))
+                (setf br2 (+ (- br2 (* lr21 br1)) (* li21 bi1)))
+                (setf bi2 (- bi2 (* li21 br1) (* lr21 bi1)))
+                (setf bbnd
+                        (max
+                         (* (+ (abs br1) (abs bi1))
+                            (* u22abs (+ (abs ur11r) (abs ui11r))))
+                         (+ (abs br2) (abs bi2))))
+                (cond
+                  ((and (> bbnd one) (< u22abs one))
+                   (cond
+                     ((>= bbnd (* bignum u22abs))
+                      (setf scale (/ one bbnd))
+                      (setf br1 (* scale br1))
+                      (setf bi1 (* scale bi1))
+                      (setf br2 (* scale br2))
+                      (setf bi2 (* scale bi2))))))
+                (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5)
+                    (dladiv br2 bi2 ur22 ui22 xr2 xi2)
+                  (declare (ignore var-0 var-1 var-2 var-3))
+                  (setf xr2 var-4)
+                  (setf xi2 var-5))
+                (setf xr1
+                        (+ (- (* ur11r br1) (* ui11r bi1) (* ur12s xr2))
+                   