praat/dwsys/NUMclapack.cpp

/* NUMclapack.c */

/* -- LAPACK driver routines (version 3.0) -- Univ. of Tennessee, Univ. of
   California Berkeley, NAG Ltd., Courant Institute, Argonne National Lab,
   and Rice University October 31, 1999 -- translated by f2c (version
   19990503).

	Adapted by David Weenink 20021201

 djmw 20030205 Latest modification
*/
/* #include "blaswrap.h" */
#include "NUMf2c.h"
#include "NUMclapack.h"
#include "NUMcblas.h"
#include "NUM2.h"
#include "melder.h"
#define FALSE  0
#define TRUE  1

/* Table of constant values */

static integer c__0 = 0;
static integer c__1 = 1;
static integer c_n1 = -1;
static integer c__2 = 2;
static integer c__3 = 3;
static integer c__4 = 4;
static integer c__6 = 6;
static integer c__10 = 10;
static integer c__11 = 11;
static double c_b15 = -.125;
static double c_b49 = 1.;
static double c_b72 = -1.;
static double c_b74 = 0.;
static double c_b108 = 1.;
static double c_b416 = 0.;
static double c_b438 = 1.;

#define MAX(m,n) ((m) > (n) ? (m) : (n))
#define MIN(m,n) ((m) < (n) ? (m) : (n))

#define a_ref(a_1,a_2) a[(a_2)*a_dim1 + a_1]
#define c___ref(a_1,a_2) c__[(a_2)*c_dim1 + a_1]

/* --------------------------------------------------- */

#define u_ref(a_1,a_2) u[(a_2)*u_dim1 + a_1]
#define vt_ref(a_1,a_2) vt[(a_2)*vt_dim1 + a_1]

int NUMlapack_dbdsqr (const char *uplo, integer *n, integer *ncvt, integer *nru, integer *ncc, double *d__, double *e, double *vt,
                      integer *ldvt, double *u, integer *ldu, double *c__, integer *ldc, double *work, integer *info) {
	/* System generated locals */
	integer c_dim1, c_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__1, i__2;
	double d__1, d__2, d__3, d__4;

	/* Local variables */
	static double abse;
	static integer idir;
	static double abss;
	static integer oldm;
	static double cosl;
	static integer isub, iter;
	static double unfl, sinl, cosr, smin, smax, sinr;
	static double f, g, h__;
	static integer i__, j, m;
	static double r__;
	static double oldcs;
	static integer oldll;
	static double shift, sigmn, oldsn;
	static integer maxit;
	static double sminl, sigmx;
	static integer lower;
	static double cs;
	static integer ll;
	static double sn, mu;
	static double sminoa, thresh;
	static integer rotate;
	static double sminlo;
	static integer nm1;
	static double tolmul;
	static integer nm12, nm13, lll;
	static double eps, sll, tol;

	/* Parameter adjustments */
	--d__;
	--e;
	vt_dim1 = *ldvt;
	vt_offset = 1 + vt_dim1 * 1;
	vt -= vt_offset;
	u_dim1 = *ldu;
	u_offset = 1 + u_dim1 * 1;
	u -= u_offset;
	c_dim1 = *ldc;
	c_offset = 1 + c_dim1 * 1;
	c__ -= c_offset;
	--work;

	/* Function Body */
	*info = 0;
	lower = lsame_ (uplo, "L");
	if (!lsame_ (uplo, "U") && !lower) {
		*info = -1;
	} else if (*n < 0) {
		*info = -2;
	} else if (*ncvt < 0) {
		*info = -3;
	} else if (*nru < 0) {
		*info = -4;
	} else if (*ncc < 0) {
		*info = -5;
	} else if (*ncvt == 0 && *ldvt < 1 || *ncvt > 0 && *ldvt < MAX (1, *n)) {
		*info = -9;
	} else if (*ldu < MAX (1, *nru)) {
		*info = -11;
	} else if (*ncc == 0 && *ldc < 1 || *ncc > 0 && *ldc < MAX (1, *n)) {
		*info = -13;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DBDSQR", &i__1);
		return 0;
	}
	if (*n == 0) {
		return 0;
	}
	if (*n == 1) {
		goto L160;
	}

	/* ROTATE is true if any singular vectors desired, false otherwise */

	rotate = *ncvt > 0 || *nru > 0 || *ncc > 0;

	/* If no singular vectors desired, use qd algorithm */

	if (!rotate) {
		NUMlapack_dlasq1 (n, &d__[1], &e[1], &work[1], info);
		return 0;
	}

	nm1 = *n - 1;
	nm12 = nm1 + nm1;
	nm13 = nm12 + nm1;
	idir = 0;

	/* Get machine constants */

	eps = NUMblas_dlamch ("Epsilon");
	unfl = NUMblas_dlamch ("Safe minimum");

	/* If matrix lower bidiagonal, rotate to be upper bidiagonal by applying
	   Givens rotations on the left */

	if (lower) {
		i__1 = *n - 1;
		for (i__ = 1; i__ <= i__1; ++i__) {
			NUMlapack_dlartg (&d__[i__], &e[i__], &cs, &sn, &r__);
			d__[i__] = r__;
			e[i__] = sn * d__[i__ + 1];
			d__[i__ + 1] = cs * d__[i__ + 1];
			work[i__] = cs;
			work[nm1 + i__] = sn;
			/* L10: */
		}

		/* Update singular vectors if desired */

		if (*nru > 0) {
			NUMlapack_dlasr ("R", "V", "F", nru, n, &work[1], &work[*n], &u[u_offset], ldu);
		}
		if (*ncc > 0) {
			NUMlapack_dlasr ("L", "V", "F", n, ncc, &work[1], &work[*n], &c__[c_offset], ldc);
		}
	}

	/* Compute singular values to relative accuracy TOL (By setting TOL to be
	   negative, algorithm will compute singular values to absolute accuracy
	   ABS(TOL)*norm(input matrix))

	   Computing MAX Computing MIN */
	d__3 = 100., d__4 = pow (eps, c_b15);
	d__1 = 10., d__2 = MIN (d__3, d__4);
	tolmul = MAX (d__1, d__2);
	tol = tolmul * eps;

	/* Compute approximate maximum, minimum singular values */

	smax = 0.;
	i__1 = *n;
	for (i__ = 1; i__ <= i__1; ++i__) {
		/* Computing MAX */
		d__2 = smax, d__3 = (d__1 = d__[i__], fabs (d__1));
		smax = MAX (d__2, d__3);
		/* L20: */
	}
	i__1 = *n - 1;
	for (i__ = 1; i__ <= i__1; ++i__) {
		/* Computing MAX */
		d__2 = smax, d__3 = (d__1 = e[i__], fabs (d__1));
		smax = MAX (d__2, d__3);
		/* L30: */
	}
	sminl = 0.;
	if (tol >= 0.) {

		/* Relative accuracy desired */

		sminoa = fabs (d__[1]);
		if (sminoa == 0.) {
			goto L50;
		}
		mu = sminoa;
		i__1 = *n;
		for (i__ = 2; i__ <= i__1; ++i__) {
			mu = (d__2 = d__[i__], fabs (d__2)) * (mu / (mu + (d__1 = e[i__ - 1], fabs (d__1))));
			sminoa = MIN (sminoa, mu);
			if (sminoa == 0.) {
				goto L50;
			}
			/* L40: */
		}
L50:
		sminoa /= sqrt ( (double) (*n));
		/* Computing MAX */
		d__1 = tol * sminoa, d__2 = *n * 6 * *n * unfl;
		thresh = MAX (d__1, d__2);
	} else {

		/* Absolute accuracy desired

		   Computing MAX */
		d__1 = fabs (tol) * smax, d__2 = *n * 6 * *n * unfl;
		thresh = MAX (d__1, d__2);
	}

	/* Prepare for main iteration loop for the singular values (MAXIT is the
	   maximum number of passes through the inner loop permitted before
	   nonconvergence signalled.) */

	maxit = *n * 6 * *n;
	iter = 0;
	oldll = -1;
	oldm = -1;

	/* M points to last element of unconverged part of matrix */

	m = *n;

	/* Begin main iteration loop */

L60:

	/* Check for convergence or exceeding iteration count */

	if (m <= 1) {
		goto L160;
	}
	if (iter > maxit) {
		goto L200;
	}

	/* Find diagonal block of matrix to work on */

	if (tol < 0. && (d__1 = d__[m], fabs (d__1)) <= thresh) {
		d__[m] = 0.;
	}
	smax = (d__1 = d__[m], fabs (d__1));
	smin = smax;
	i__1 = m - 1;
	for (lll = 1; lll <= i__1; ++lll) {
		ll = m - lll;
		abss = (d__1 = d__[ll], fabs (d__1));
		abse = (d__1 = e[ll], fabs (d__1));
		if (tol < 0. && abss <= thresh) {
			d__[ll] = 0.;
		}
		if (abse <= thresh) {
			goto L80;
		}
		smin = MIN (smin, abss);
		/* Computing MAX */
		d__1 = MAX (smax, abss);
		smax = MAX (d__1, abse);
		/* L70: */
	}
	ll = 0;
	goto L90;
L80:
	e[ll] = 0.;

	/* Matrix splits since E(LL) = 0 */

	if (ll == m - 1) {

		/* Convergence of bottom singular value, return to top of loop */

		--m;
		goto L60;
	}
L90:
	++ll;

	/* E(LL) through E(M-1) are nonzero, E(LL-1) is zero */

	if (ll == m - 1) {

		/* 2 by 2 block, handle separately */

		NUMlapack_dlasv2 (&d__[m - 1], &e[m - 1], &d__[m], &sigmn, &sigmx, &sinr, &cosr, &sinl, &cosl);
		d__[m - 1] = sigmx;
		e[m - 1] = 0.;
		d__[m] = sigmn;

		/* Compute singular vectors, if desired */

		if (*ncvt > 0) {
			NUMblas_drot (ncvt, &vt_ref (m - 1, 1), ldvt, &vt_ref (m, 1), ldvt, &cosr, &sinr);
		}
		if (*nru > 0) {
			NUMblas_drot (nru, &u_ref (1, m - 1), &c__1, &u_ref (1, m), &c__1, &cosl, &sinl);
		}
		if (*ncc > 0) {
			NUMblas_drot (ncc, &c___ref (m - 1, 1), ldc, &c___ref (m, 1), ldc, &cosl, &sinl);
		}
		m += -2;
		goto L60;
	}

	/* If working on new submatrix, choose shift direction (from larger end
	   diagonal element towards smaller) */

	if (ll > oldm || m < oldll) {
		if ( (d__1 = d__[ll], fabs (d__1)) >= (d__2 = d__[m], fabs (d__2))) {

			/* Chase bulge from top (big end) to bottom (small end) */

			idir = 1;
		} else {

			/* Chase bulge from bottom (big end) to top (small end) */

			idir = 2;
		}
	}

	/* Apply convergence tests */

	if (idir == 1) {

		/* Run convergence test in forward direction First apply standard
		   test to bottom of matrix */

		if ( (d__2 = e[m - 1], fabs (d__2)) <= fabs (tol) * (d__1 = d__[m], fabs (d__1)) || tol < 0. &&
		        (d__3 = e[m - 1], fabs (d__3)) <= thresh) {
			e[m - 1] = 0.;
			goto L60;
		}

		if (tol >= 0.) {

			/* If relative accuracy desired, apply convergence criterion
			   forward */

			mu = (d__1 = d__[ll], fabs (d__1));
			sminl = mu;
			i__1 = m - 1;
			for (lll = ll; lll <= i__1; ++lll) {
				if ( (d__1 = e[lll], fabs (d__1)) <= tol * mu) {
					e[lll] = 0.;
					goto L60;
				}
				sminlo = sminl;
				mu = (d__2 = d__[lll + 1], fabs (d__2)) * (mu / (mu + (d__1 = e[lll], fabs (d__1))));
				sminl = MIN (sminl, mu);
				/* L100: */
			}
		}

	} else {

		/* Run convergence test in backward direction First apply standard
		   test to top of matrix */

		if ( (d__2 = e[ll], fabs (d__2)) <= fabs (tol) * (d__1 = d__[ll], fabs (d__1)) || tol < 0. &&
		        (d__3 = e[ll], fabs (d__3)) <= thresh) {
			e[ll] = 0.;
			goto L60;
		}

		if (tol >= 0.) {

			/* If relative accuracy desired, apply convergence criterion
			   backward */

			mu = (d__1 = d__[m], fabs (d__1));
			sminl = mu;
			i__1 = ll;
			for (lll = m - 1; lll >= i__1; --lll) {
				if ( (d__1 = e[lll], fabs (d__1)) <= tol * mu) {
					e[lll] = 0.;
					goto L60;
				}
				sminlo = sminl;
				mu = (d__2 = d__[lll], fabs (d__2)) * (mu / (mu + (d__1 = e[lll], fabs (d__1))));
				sminl = MIN (sminl, mu);
				/* L110: */
			}
		}
	}
	oldll = ll;
	oldm = m;

	/* Compute shift.  First, test if shifting would ruin relative accuracy,
	   and if so set the shift to zero.

	   Computing MAX */
	d__1 = eps, d__2 = tol * .01;
	if (tol >= 0. && *n * tol * (sminl / smax) <= MAX (d__1, d__2)) {

		/* Use a zero shift to avoid loss of relative accuracy */

		shift = 0.;
	} else {

		/* Compute the shift from 2-by-2 block at end of matrix */

		if (idir == 1) {
			sll = (d__1 = d__[ll], fabs (d__1));
			NUMlapack_dlas2 (&d__[m - 1], &e[m - 1], &d__[m], &shift, &r__);
		} else {
			sll = (d__1 = d__[m], fabs (d__1));
			NUMlapack_dlas2 (&d__[ll], &e[ll], &d__[ll + 1], &shift, &r__);
		}

		/* Test if shift negligible, and if so set to zero */

		if (sll > 0.) {
			/* Computing 2nd power */
			d__1 = shift / sll;
			if (d__1 * d__1 < eps) {
				shift = 0.;
			}
		}
	}

	/* Increment iteration count */

	iter = iter + m - ll;

	/* If SHIFT = 0, do simplified QR iteration */

	if (shift == 0.) {
		if (idir == 1) {

			/* Chase bulge from top to bottom Save cosines and sines for
			   later singular vector updates */

			cs = 1.;
			oldcs = 1.;
			i__1 = m - 1;
			for (i__ = ll; i__ <= i__1; ++i__) {
				d__1 = d__[i__] * cs;
				NUMlapack_dlartg (&d__1, &e[i__], &cs, &sn, &r__);
				if (i__ > ll) {
					e[i__ - 1] = oldsn * r__;
				}
				d__1 = oldcs * r__;
				d__2 = d__[i__ + 1] * sn;
				NUMlapack_dlartg (&d__1, &d__2, &oldcs, &oldsn, &d__[i__]);
				work[i__ - ll + 1] = cs;
				work[i__ - ll + 1 + nm1] = sn;
				work[i__ - ll + 1 + nm12] = oldcs;
				work[i__ - ll + 1 + nm13] = oldsn;
				/* L120: */
			}
			h__ = d__[m] * cs;
			d__[m] = h__ * oldcs;
			e[m - 1] = h__ * oldsn;

			/* Update singular vectors */

			if (*ncvt > 0) {
				i__1 = m - ll + 1;
				NUMlapack_dlasr ("L", "V", "F", &i__1, ncvt, &work[1], &work[*n], &vt_ref (ll, 1), ldvt);
			}
			if (*nru > 0) {
				i__1 = m - ll + 1;
				NUMlapack_dlasr ("R", "V", "F", nru, &i__1, &work[nm12 + 1], &work[nm13 + 1], &u_ref (1, ll),
				                 ldu);
			}
			if (*ncc > 0) {
				i__1 = m - ll + 1;
				NUMlapack_dlasr ("L", "V", "F", &i__1, ncc, &work[nm12 + 1], &work[nm13 + 1], &c___ref (ll, 1),
				                 ldc);
			}

			/* Test convergence */

			if ( (d__1 = e[m - 1], fabs (d__1)) <= thresh) {
				e[m - 1] = 0.;
			}

		} else {

			/* Chase bulge from bottom to top Save cosines and sines for
			   later singular vector updates */

			cs = 1.;
			oldcs = 1.;
			i__1 = ll + 1;
			for (i__ = m; i__ >= i__1; --i__) {
				d__1 = d__[i__] * cs;
				NUMlapack_dlartg (&d__1, &e[i__ - 1], &cs, &sn, &r__);
				if (i__ < m) {
					e[i__] = oldsn * r__;
				}
				d__1 = oldcs * r__;
				d__2 = d__[i__ - 1] * sn;
				NUMlapack_dlartg (&d__1, &d__2, &oldcs, &oldsn, &d__[i__]);
				work[i__ - ll] = cs;
				work[i__ - ll + nm1] = -sn;
				work[i__ - ll + nm12] = oldcs;
				work[i__ - ll + nm13] = -oldsn;
				/* L130: */
			}
			h__ = d__[ll] * cs;
			d__[ll] = h__ * oldcs;
			e[ll] = h__ * oldsn;

			/* Update singular vectors */

			if (*ncvt > 0) {
				i__1 = m - ll + 1;
				NUMlapack_dlasr ("L", "V", "B", &i__1, ncvt, &work[nm12 + 1], &work[nm13 + 1], &vt_ref (ll, 1),
				                 ldvt);
			}
			if (*nru > 0) {
				i__1 = m - ll + 1;
				NUMlapack_dlasr ("R", "V", "B", nru, &i__1, &work[1], &work[*n], &u_ref (1, ll), ldu);
			}
			if (*ncc > 0) {
				i__1 = m - ll + 1;
				NUMlapack_dlasr ("L", "V", "B", &i__1, ncc, &work[1], &work[*n], &c___ref (ll, 1), ldc);
			}

			/* Test convergence */

			if ( (d__1 = e[ll], fabs (d__1)) <= thresh) {
				e[ll] = 0.;
			}
		}
	} else {

		/* Use nonzero shift */

		if (idir == 1) {

			/* Chase bulge from top to bottom Save cosines and sines for
			   later singular vector updates */

			f = ( (d__1 = d__[ll], fabs (d__1)) - shift) * (d_sign (&c_b49, &d__[ll]) + shift / d__[ll]);
			g = e[ll];
			i__1 = m - 1;
			for (i__ = ll; i__ <= i__1; ++i__) {
				NUMlapack_dlartg (&f, &g, &cosr, &sinr, &r__);
				if (i__ > ll) {
					e[i__ - 1] = r__;
				}
				f = cosr * d__[i__] + sinr * e[i__];
				e[i__] = cosr * e[i__] - sinr * d__[i__];
				g = sinr * d__[i__ + 1];
				d__[i__ + 1] = cosr * d__[i__ + 1];
				NUMlapack_dlartg (&f, &g, &cosl, &sinl, &r__);
				d__[i__] = r__;
				f = cosl * e[i__] + sinl * d__[i__ + 1];
				d__[i__ + 1] = cosl * d__[i__ + 1] - sinl * e[i__];
				if (i__ < m - 1) {
					g = sinl * e[i__ + 1];
					e[i__ + 1] = cosl * e[i__ + 1];
				}
				work[i__ - ll + 1] = cosr;
				work[i__ - ll + 1 + nm1] = sinr;
				work[i__ - ll + 1 + nm12] = cosl;
				work[i__ - ll + 1 + nm13] = sinl;
				/* L140: */
			}
			e[m - 1] = f;

			/* Update singular vectors */

			if (*ncvt > 0) {
				i__1 = m - ll + 1;
				NUMlapack_dlasr ("L", "V", "F", &i__1, ncvt, &work[1], &work[*n], &vt_ref (ll, 1), ldvt);
			}
			if (*nru > 0) {
				i__1 = m - ll + 1;
				NUMlapack_dlasr ("R", "V", "F", nru, &i__1, &work[nm12 + 1], &work[nm13 + 1], &u_ref (1, ll),
				                 ldu);
			}
			if (*ncc > 0) {
				i__1 = m - ll + 1;
				NUMlapack_dlasr ("L", "V", "F", &i__1, ncc, &work[nm12 + 1], &work[nm13 + 1], &c___ref (ll, 1),
				                 ldc);
			}

			/* Test convergence */

			if ( (d__1 = e[m - 1], fabs (d__1)) <= thresh) {
				e[m - 1] = 0.;
			}

		} else {

			/* Chase bulge from bottom to top Save cosines and sines for
			   later singular vector updates */

			f = ( (d__1 = d__[m], fabs (d__1)) - shift) * (d_sign (&c_b49, &d__[m]) + shift / d__[m]);
			g = e[m - 1];
			i__1 = ll + 1;
			for (i__ = m; i__ >= i__1; --i__) {
				NUMlapack_dlartg (&f, &g, &cosr, &sinr, &r__);
				if (i__ < m) {
					e[i__] = r__;
				}
				f = cosr * d__[i__] + sinr * e[i__ - 1];
				e[i__ - 1] = cosr * e[i__ - 1] - sinr * d__[i__];
				g = sinr * d__[i__ - 1];
				d__[i__ - 1] = cosr * d__[i__ - 1];
				NUMlapack_dlartg (&f, &g, &cosl, &sinl, &r__);
				d__[i__] = r__;
				f = cosl * e[i__ - 1] + sinl * d__[i__ - 1];
				d__[i__ - 1] = cosl * d__[i__ - 1] - sinl * e[i__ - 1];
				if (i__ > ll + 1) {
					g = sinl * e[i__ - 2];
					e[i__ - 2] = cosl * e[i__ - 2];
				}
				work[i__ - ll] = cosr;
				work[i__ - ll + nm1] = -sinr;
				work[i__ - ll + nm12] = cosl;
				work[i__ - ll + nm13] = -sinl;
				/* L150: */
			}
			e[ll] = f;

			/* Test convergence */

			if ( (d__1 = e[ll], fabs (d__1)) <= thresh) {
				e[ll] = 0.;
			}

			/* Update singular vectors if desired */

			if (*ncvt > 0) {
				i__1 = m - ll + 1;
				NUMlapack_dlasr ("L", "V", "B", &i__1, ncvt, &work[nm12 + 1], &work[nm13 + 1], &vt_ref (ll, 1),
				                 ldvt);
			}
			if (*nru > 0) {
				i__1 = m - ll + 1;
				NUMlapack_dlasr ("R", "V", "B", nru, &i__1, &work[1], &work[*n], &u_ref (1, ll), ldu);
			}
			if (*ncc > 0) {
				i__1 = m - ll + 1;
				NUMlapack_dlasr ("L", "V", "B", &i__1, ncc, &work[1], &work[*n], &c___ref (ll, 1), ldc);
			}
		}
	}

	/* QR iteration finished, go back and check convergence */

	goto L60;

	/* All singular values converged, so make them positive */

L160:
	i__1 = *n;
	for (i__ = 1; i__ <= i__1; ++i__) {
		if (d__[i__] < 0.) {
			d__[i__] = -d__[i__];

			/* Change sign of singular vectors, if desired */

			if (*ncvt > 0) {
				NUMblas_dscal (ncvt, &c_b72, &vt_ref (i__, 1), ldvt);
			}
		}
		/* L170: */
	}

	/* Sort the singular values into decreasing order (insertion sort on
	   singular values, but only one transposition per singular vector) */

	i__1 = *n - 1;
	for (i__ = 1; i__ <= i__1; ++i__) {

		/* Scan for smallest D(I) */

		isub = 1;
		smin = d__[1];
		i__2 = *n + 1 - i__;
		for (j = 2; j <= i__2; ++j) {
			if (d__[j] <= smin) {
				isub = j;
				smin = d__[j];
			}
			/* L180: */
		}
		if (isub != *n + 1 - i__) {

			/* Swap singular values and vectors */

			d__[isub] = d__[*n + 1 - i__];
			d__[*n + 1 - i__] = smin;
			if (*ncvt > 0) {
				NUMblas_dswap (ncvt, &vt_ref (isub, 1), ldvt, &vt_ref (*n + 1 - i__, 1), ldvt);
			}
			if (*nru > 0) {
				NUMblas_dswap (nru, &u_ref (1, isub), &c__1, &u_ref (1, *n + 1 - i__), &c__1);
			}
			if (*ncc > 0) {
				NUMblas_dswap (ncc, &c___ref (isub, 1), ldc, &c___ref (*n + 1 - i__, 1), ldc);
			}
		}
		/* L190: */
	}
	goto L220;

	/* Maximum number of iterations exceeded, failure to converge */

L200:
	*info = 0;
	i__1 = *n - 1;
	for (i__ = 1; i__ <= i__1; ++i__) {
		if (e[i__] != 0.) {
			++ (*info);
		}
		/* L210: */
	}
L220:
	return 0;
}								/* NUMlapack_dbdsqr */

#undef vt_ref
#undef u_ref


int NUMlapack_dgebd2 (integer *m, integer *n, double *a, integer *lda, double *d__, double *e, double *tauq,
                      double *taup, double *work, integer *info) {
	/* Table of constant values */
	static integer c__1 = 1;

	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2, i__3, i__4;

	/* Local variables */
	static integer i__;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--d__;
	--e;
	--tauq;
	--taup;
	--work;

	/* Function Body */
	*info = 0;
	if (*m < 0) {
		*info = -1;
	} else if (*n < 0) {
		*info = -2;
	} else if (*lda < MAX (1, *m)) {
		*info = -4;
	}
	if (*info < 0) {
		i__1 = - (*info);
		xerbla_ ("DGEBD2", &i__1);
		return 0;
	}

	if (*m >= *n) {

		/* Reduce to upper bidiagonal form */

		i__1 = *n;
		for (i__ = 1; i__ <= i__1; ++i__) {

			/* Generate elementary reflector H(i) to annihilate A(i+1:m,i)

			   Computing MIN */
			i__2 = i__ + 1;
			i__3 = *m - i__ + 1;
			NUMlapack_dlarfg (&i__3, &a_ref (i__, i__), &a_ref (MIN (i__2, *m), i__), &c__1, &tauq[i__]);
			d__[i__] = a_ref (i__, i__);
			a_ref (i__, i__) = 1.;

			/* Apply H(i) to A(i:m,i+1:n) from the left */

			i__2 = *m - i__ + 1;
			i__3 = *n - i__;
			NUMlapack_dlarf ("Left", &i__2, &i__3, &a_ref (i__, i__), &c__1, &tauq[i__], &a_ref (i__, i__ + 1),
			                 lda, &work[1]);
			a_ref (i__, i__) = d__[i__];

			if (i__ < *n) {

				/* Generate elementary reflector G(i) to annihilate
				   A(i,i+2:n)

				   Computing MIN */
				i__2 = i__ + 2;
				i__3 = *n - i__;
				NUMlapack_dlarfg (&i__3, &a_ref (i__, i__ + 1), &a_ref (i__, MIN (i__2, *n)), lda, &taup[i__]);
				e[i__] = a_ref (i__, i__ + 1);
				a_ref (i__, i__ + 1) = 1.;

				/* Apply G(i) to A(i+1:m,i+1:n) from the right */

				i__2 = *m - i__;
				i__3 = *n - i__;
				NUMlapack_dlarf ("Right", &i__2, &i__3, &a_ref (i__, i__ + 1), lda, &taup[i__], &a_ref (i__ + 1,
				                 i__ + 1), lda, &work[1]);
				a_ref (i__, i__ + 1) = e[i__];
			} else {
				taup[i__] = 0.;
			}
			/* L10: */
		}
	} else {

		/* Reduce to lower bidiagonal form */

		i__1 = *m;
		for (i__ = 1; i__ <= i__1; ++i__) {

			/* Generate elementary reflector G(i) to annihilate A(i,i+1:n)

			   Computing MIN */
			i__2 = i__ + 1;
			i__3 = *n - i__ + 1;
			NUMlapack_dlarfg (&i__3, &a_ref (i__, i__), &a_ref (i__, MIN (i__2, *n)), lda, &taup[i__]);
			d__[i__] = a_ref (i__, i__);
			a_ref (i__, i__) = 1.;

			/* Apply G(i) to A(i+1:m,i:n) from the right

			   Computing MIN */
			i__2 = i__ + 1;
			i__3 = *m - i__;
			i__4 = *n - i__ + 1;
			NUMlapack_dlarf ("Right", &i__3, &i__4, &a_ref (i__, i__), lda, &taup[i__], &a_ref (MIN (i__2, *m),
			                 i__), lda, &work[1]);
			a_ref (i__, i__) = d__[i__];

			if (i__ < *m) {

				/* Generate elementary reflector H(i) to annihilate
				   A(i+2:m,i)

				   Computing MIN */
				i__2 = i__ + 2;
				i__3 = *m - i__;
				NUMlapack_dlarfg (&i__3, &a_ref (i__ + 1, i__), &a_ref (MIN (i__2, *m), i__), &c__1,
				                  &tauq[i__]);
				e[i__] = a_ref (i__ + 1, i__);
				a_ref (i__ + 1, i__) = 1.;

				/* Apply H(i) to A(i+1:m,i+1:n) from the left */

				i__2 = *m - i__;
				i__3 = *n - i__;
				NUMlapack_dlarf ("Left", &i__2, &i__3, &a_ref (i__ + 1, i__), &c__1, &tauq[i__],
				                 &a_ref (i__ + 1, i__ + 1), lda, &work[1]);
				a_ref (i__ + 1, i__) = e[i__];
			} else {
				tauq[i__] = 0.;
			}
			/* L20: */
		}
	}
	return 0;
}								/* NUMlapack_dgebd2 */


int NUMlapack_dgebak (const char *job, const char *side, integer *n, integer *ilo, integer *ihi, double *scale, integer *m,
                      double *v, integer *ldv, integer *info) {
	/* System generated locals */
	integer v_dim1, v_offset, i__1;

	/* Local variables */
	static integer i__, k;
	static double s;
	static int leftv;
	static integer ii;
	static int rightv;

#define v_ref(a_1,a_2) v[(a_2)*v_dim1 + a_1]

	--scale;
	v_dim1 = *ldv;
	v_offset = 1 + v_dim1 * 1;
	v -= v_offset;

	/* Function Body */
	rightv = lsame_ (side, "R");
	leftv = lsame_ (side, "L");

	*info = 0;
	if (!lsame_ (job, "N") && !lsame_ (job, "P") && !lsame_ (job, "S") && !lsame_ (job, "B")) {
		*info = -1;
	} else if (!rightv && !leftv) {
		*info = -2;
	} else if (*n < 0) {
		*info = -3;
	} else if (*ilo < 1 || *ilo > MAX (1, *n)) {
		*info = -4;
	} else if (*ihi < MIN (*ilo, *n) || *ihi > *n) {
		*info = -5;
	} else if (*m < 0) {
		*info = -7;
	} else if (*ldv < MAX (1, *n)) {
		*info = -9;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("NUMlapack_dgebak ", &i__1);
		return 0;
	}

	/* Quick return if possible */

	if (*n == 0) {
		return 0;
	}
	if (*m == 0) {
		return 0;
	}
	if (lsame_ (job, "N")) {
		return 0;
	}

	if (*ilo == *ihi) {
		goto L30;
	}

	/* Backward balance */

	if (lsame_ (job, "S") || lsame_ (job, "B")) {

		if (rightv) {
			i__1 = *ihi;
			for (i__ = *ilo; i__ <= i__1; ++i__) {
				s = scale[i__];
				NUMblas_dscal (m, &s, &v_ref (i__, 1), ldv);
				/* L10: */
			}
		}

		if (leftv) {
			i__1 = *ihi;
			for (i__ = *ilo; i__ <= i__1; ++i__) {
				s = 1. / scale[i__];
				NUMblas_dscal (m, &s, &v_ref (i__, 1), ldv);
				/* L20: */
			}
		}

	}

	/* Backward permutation

	   For I = ILO-1 step -1 until 1, IHI+1 step 1 until N do -- */

L30:
	if (lsame_ (job, "P") || lsame_ (job, "B")) {
		if (rightv) {
			i__1 = *n;
			for (ii = 1; ii <= i__1; ++ii) {
				i__ = ii;
				if (i__ >= *ilo && i__ <= *ihi) {
					goto L40;
				}
				if (i__ < *ilo) {
					i__ = *ilo - ii;
				}
				k = (integer) scale[i__];
				if (k == i__) {
					goto L40;
				}
				NUMblas_dswap (m, &v_ref (i__, 1), ldv, &v_ref (k, 1), ldv);
L40:
				;
			}
		}

		if (leftv) {
			i__1 = *n;
			for (ii = 1; ii <= i__1; ++ii) {
				i__ = ii;
				if (i__ >= *ilo && i__ <= *ihi) {
					goto L50;
				}
				if (i__ < *ilo) {
					i__ = *ilo - ii;
				}
				k = (integer) scale[i__];
				if (k == i__) {
					goto L50;
				}
				NUMblas_dswap (m, &v_ref (i__, 1), ldv, &v_ref (k, 1), ldv);
L50:
				;
			}
		}
	}

	return 0;
}								/* NUMlapack_dgebak */

#undef v_ref

int NUMlapack_dgebal (const char *job, integer *n, double *a, integer *lda, integer *ilo, integer *ihi, double *scale,
                      integer *info) {
	/* Table of constant values */
	static integer c__1 = 1;

	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2;
	double d__1, d__2;

	/* Local variables */
	static integer iexc;
	static double c__, f, g;
	static integer i__, j, k, l, m;
	static double r__, s;
	static double sfmin1, sfmin2, sfmax1, sfmax2, ca, ra;
	static int noconv;
	static integer ica, ira;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--scale;

	/* Function Body */
	*info = 0;
	if (!lsame_ (job, "N") && !lsame_ (job, "P") && !lsame_ (job, "S") && !lsame_ (job, "B")) {
		*info = -1;
	} else if (*n < 0) {
		*info = -2;
	} else if (*lda < MAX (1, *n)) {
		*info = -4;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("NUMlapack_dgebal ", &i__1);
		return 0;
	}

	k = 1;
	l = *n;

	if (*n == 0) {
		goto L210;
	}

	if (lsame_ (job, "N")) {
		i__1 = *n;
		for (i__ = 1; i__ <= i__1; ++i__) {
			scale[i__] = 1.;
			/* L10: */
		}
		goto L210;
	}

	if (lsame_ (job, "S")) {
		goto L120;
	}

	/* Permutation to isolate eigenvalues if possible */

	goto L50;

	/* Row and column exchange. */

L20:
	scale[m] = (double) j;
	if (j == m) {
		goto L30;
	}

	NUMblas_dswap (&l, &a_ref (1, j), &c__1, &a_ref (1, m), &c__1);
	i__1 = *n - k + 1;
	NUMblas_dswap (&i__1, &a_ref (j, k), lda, &a_ref (m, k), lda);

L30:
	switch (iexc) {
		case 1:
			goto L40;
		case 2:
			goto L80;
	}

	/* Search for rows isolating an eigenvalue and push them down. */

L40:
	if (l == 1) {
		goto L210;
	}
	--l;

L50:
	for (j = l; j >= 1; --j) {

		i__1 = l;
		for (i__ = 1; i__ <= i__1; ++i__) {
			if (i__ == j) {
				goto L60;
			}
			if (a_ref (j, i__) != 0.) {
				goto L70;
			}
L60:
			;
		}

		m = l;
		iexc = 1;
		goto L20;
L70:
		;
	}

	goto L90;

	/* Search for columns isolating an eigenvalue and push them left. */

L80:
	++k;

L90:
	i__1 = l;
	for (j = k; j <= i__1; ++j) {

		i__2 = l;
		for (i__ = k; i__ <= i__2; ++i__) {
			if (i__ == j) {
				goto L100;
			}
			if (a_ref (i__, j) != 0.) {
				goto L110;
			}
L100:
			;
		}

		m = k;
		iexc = 2;
		goto L20;
L110:
		;
	}

L120:
	i__1 = l;
	for (i__ = k; i__ <= i__1; ++i__) {
		scale[i__] = 1.;
		/* L130: */
	}

	if (lsame_ (job, "P")) {
		goto L210;
	}

	/* Balance the submatrix in rows K to L.

	   Iterative loop for norm reduction */

	sfmin1 = NUMblas_dlamch ("S") / NUMblas_dlamch ("P");
	sfmax1 = 1. / sfmin1;
	sfmin2 = sfmin1 * 8.;
	sfmax2 = 1. / sfmin2;
L140:
	noconv = FALSE;

	i__1 = l;
	for (i__ = k; i__ <= i__1; ++i__) {
		c__ = 0.;
		r__ = 0.;

		i__2 = l;
		for (j = k; j <= i__2; ++j) {
			if (j == i__) {
				goto L150;
			}
			c__ += (d__1 = a_ref (j, i__), fabs (d__1));
			r__ += (d__1 = a_ref (i__, j), fabs (d__1));
L150:
			;
		}
		ica = NUMblas_idamax (&l, &a_ref (1, i__), &c__1);
		ca = (d__1 = a_ref (ica, i__), fabs (d__1));
		i__2 = *n - k + 1;
		ira = NUMblas_idamax (&i__2, &a_ref (i__, k), lda);
		ra = (d__1 = a_ref (i__, ira + k - 1), fabs (d__1));

		/* Guard against zero C or R due to underflow. */

		if (c__ == 0. || r__ == 0.) {
			goto L200;
		}
		g = r__ / 8.;
		f = 1.;
		s = c__ + r__;
L160:
		/* Computing MAX */
		d__1 = MAX (f, c__);
		/* Computing MIN */
		d__2 = MIN (r__, g);
		if (c__ >= g || MAX (d__1, ca) >= sfmax2 || MIN (d__2, ra) <= sfmin2) {
			goto L170;
		}
		f *= 8.;
		c__ *= 8.;
		ca *= 8.;
		r__ /= 8.;
		g /= 8.;
		ra /= 8.;
		goto L160;

L170:
		g = c__ / 8.;
L180:
		/* Computing MIN */
		d__1 = MIN (f, c__), d__1 = MIN (d__1, g);
		if (g < r__ || MAX (r__, ra) >= sfmax2 || MIN (d__1, ca) <= sfmin2) {
			goto L190;
		}
		f /= 8.;
		c__ /= 8.;
		g /= 8.;
		ca /= 8.;
		r__ *= 8.;
		ra *= 8.;
		goto L180;

		/* Now balance. */

L190:
		if (c__ + r__ >= s * .95) {
			goto L200;
		}
		if (f < 1. && scale[i__] < 1.) {
			if (f * scale[i__] <= sfmin1) {
				goto L200;
			}
		}
		if (f > 1. && scale[i__] > 1.) {
			if (scale[i__] >= sfmax1 / f) {
				goto L200;
			}
		}
		g = 1. / f;
		scale[i__] *= f;
		noconv = TRUE;

		i__2 = *n - k + 1;
		NUMblas_dscal (&i__2, &g, &a_ref (i__, k), lda);
		NUMblas_dscal (&l, &f, &a_ref (1, i__), &c__1);

L200:
		;
	}

	if (noconv) {
		goto L140;
	}

L210:
	*ilo = k;
	*ihi = l;

	return 0;
}								/* NUMlapack_dgebal */


int NUMlapack_dgebrd (integer *m, integer *n, double *a, integer *lda, double *d__, double *e, double *tauq,
                      double *taup, double *work, integer *lwork, integer *info) {
	/* Table of constant values */
	static integer c__1 = 1;
	static integer c_n1 = -1;
	static integer c__3 = 3;
	static integer c__2 = 2;
	static double c_b21 = -1.;
	static double c_b22 = 1.;

	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2, i__3, i__4;

	/* Local variables */
	static integer i__, j;
	static integer nbmin, iinfo, minmn;
	static integer nb;
	static integer nx;
	static double ws;
	static integer ldwrkx, ldwrky, lwkopt;
	static integer lquery;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--d__;
	--e;
	--tauq;
	--taup;
	--work;

	/* Function Body */
	*info = 0;
	/* Computing MAX */
	i__1 = 1, i__2 = NUMlapack_ilaenv (&c__1, "DGEBRD", " ", m, n, &c_n1, &c_n1, 6, 1);
	nb = MAX (i__1, i__2);
	lwkopt = (*m + *n) * nb;
	work[1] = (double) lwkopt;
	lquery = *lwork == -1;
	if (*m < 0) {
		*info = -1;
	} else if (*n < 0) {
		*info = -2;
	} else if (*lda < MAX (1, *m)) {
		*info = -4;
	} else {					/* if(complicated condition) */
		/* Computing MAX */
		i__1 = MAX (1, *m);
		if (*lwork < MAX (i__1, *n) && !lquery) {
			*info = -10;
		}
	}
	if (*info < 0) {
		i__1 = - (*info);
		xerbla_ ("DGEBRD", &i__1);
		return 0;
	} else if (lquery) {
		return 0;
	}

	/* Quick return if possible */

	minmn = MIN (*m, *n);
	if (minmn == 0) {
		work[1] = 1.;
		return 0;
	}

	ws = (double) MAX (*m, *n);
	ldwrkx = *m;
	ldwrky = *n;

	if (nb > 1 && nb < minmn) {

		/* Set the crossover point NX.

		   Computing MAX */
		i__1 = nb, i__2 = NUMlapack_ilaenv (&c__3, "DGEBRD", " ", m, n, &c_n1, &c_n1, 6, 1);
		nx = MAX (i__1, i__2);

		/* Determine when to switch from blocked to unblocked code. */

		if (nx < minmn) {
			ws = (double) ( (*m + *n) * nb);
			if ( (double) (*lwork) < ws) {

				/* Not enough work space for the optimal NB, consider using a
				   smaller block size. */

				nbmin = NUMlapack_ilaenv (&c__2, "DGEBRD", " ", m, n, &c_n1, &c_n1, 6, 1);
				if (*lwork >= (*m + *n) * nbmin) {
					nb = *lwork / (*m + *n);
				} else {
					nb = 1;
					nx = minmn;
				}
			}
		}
	} else {
		nx = minmn;
	}

	i__1 = minmn - nx;
	i__2 = nb;
	for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {

		/* Reduce rows and columns i:i+nb-1 to bidiagonal form and return the
		   matrices X and Y which are needed to update the unreduced part of
		   the matrix */

		i__3 = *m - i__ + 1;
		i__4 = *n - i__ + 1;
		NUMlapack_dlabrd (&i__3, &i__4, &nb, &a_ref (i__, i__), lda, &d__[i__], &e[i__], &tauq[i__], &taup[i__],
		                  &work[1], &ldwrkx, &work[ldwrkx * nb + 1], &ldwrky);

		/* Update the trailing submatrix A(i+nb:m,i+nb:n), using an update of
		   the form A := A - V*Y' - X*U' */

		i__3 = *m - i__ - nb + 1;
		i__4 = *n - i__ - nb + 1;
		NUMblas_dgemm ("No transpose", "Transpose", &i__3, &i__4, &nb, &c_b21, &a_ref (i__ + nb, i__), lda,
		               &work[ldwrkx * nb + nb + 1], &ldwrky, &c_b22, &a_ref (i__ + nb, i__ + nb), lda);
		i__3 = *m - i__ - nb + 1;
		i__4 = *n - i__ - nb + 1;
		NUMblas_dgemm ("No transpose", "No transpose", &i__3, &i__4, &nb, &c_b21, &work[nb + 1], &ldwrkx,
		               &a_ref (i__, i__ + nb), lda, &c_b22, &a_ref (i__ + nb, i__ + nb), lda);

		/* Copy diagonal and off-diagonal elements of B back into A */

		if (*m >= *n) {
			i__3 = i__ + nb - 1;
			for (j = i__; j <= i__3; ++j) {
				a_ref (j, j) = d__[j];
				a_ref (j, j + 1) = e[j];
				/* L10: */
			}
		} else {
			i__3 = i__ + nb - 1;
			for (j = i__; j <= i__3; ++j) {
				a_ref (j, j) = d__[j];
				a_ref (j + 1, j) = e[j];
				/* L20: */
			}
		}
		/* L30: */
	}

	/* Use unblocked code to reduce the remainder of the matrix */

	i__2 = *m - i__ + 1;
	i__1 = *n - i__ + 1;
	NUMlapack_dgebd2 (&i__2, &i__1, &a_ref (i__, i__), lda, &d__[i__], &e[i__], &tauq[i__], &taup[i__],
	                  &work[1], &iinfo);
	work[1] = ws;
	return 0;
}								/* NUMlapack_dgebrd */


int NUMlapack_dgeev (const char *jobvl, const char *jobvr, integer *n, double *a, integer *lda, double *wr, double *wi,
                     double *vl, integer *ldvl, double *vr, integer *ldvr, double *work, integer *lwork, integer *info) {
	/* Table of constant values */
	static integer c__8 = 8;
	static integer c_n1 = -1;

	/* System generated locals */
	integer a_dim1, a_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1, i__2, i__3, i__4;
	double d__1, d__2;

	/* Local variables */
	static integer ibal;
	static char side[1];
	static integer maxb;
	static double anrm;
	static integer ierr, itau;
	static integer iwrk, nout;
	static integer i__, k;
	static double r__;
	static double cs;
	static int scalea;
	static double cscale;
	static double sn;
	static int select[1];
	static double bignum;
	static integer minwrk, maxwrk;
	static int wantvl;
	static double smlnum;
	static integer hswork;
	static int lquery, wantvr;
	static integer ihi;
	static double scl;
	static integer ilo;
	static double dum[1], eps;

#define vl_ref(a_1,a_2) vl[(a_2)*vl_dim1 + a_1]
#define vr_ref(a_1,a_2) vr[(a_2)*vr_dim1 + a_1]

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--wr;
	--wi;
	vl_dim1 = *ldvl;
	vl_offset = 1 + vl_dim1 * 1;
	vl -= vl_offset;
	vr_dim1 = *ldvr;
	vr_offset = 1 + vr_dim1 * 1;
	vr -= vr_offset;
	--work;

	/* Function Body */
	*info = 0;
	lquery = *lwork == -1;
	wantvl = lsame_ (jobvl, "V");
	wantvr = lsame_ (jobvr, "V");
	if (!wantvl && !lsame_ (jobvl, "N")) {
		*info = -1;
	} else if (!wantvr && !lsame_ (jobvr, "N")) {
		*info = -2;
	} else if (*n < 0) {
		*info = -3;
	} else if (*lda < MAX (1, *n)) {
		*info = -5;
	} else if (*ldvl < 1 || wantvl && *ldvl < *n) {
		*info = -9;
	} else if (*ldvr < 1 || wantvr && *ldvr < *n) {
		*info = -11;
	}

	/* Compute workspace (Note: Comments in the code beginning "Workspace:"
	   describe the minimal amount of workspace needed at that point in the
	   code, as well as the preferred amount for good performance. NB refers
	   to the optimal block size for the immediately following subroutine, as
	   returned by ILAENV. HSWORK refers to the workspace preferred by
	   NUMlapack_dhseqr , as calculated below. HSWORK is computed assuming
	   ILO=1 and IHI=N, the worst case.) */

	minwrk = 1;
	if (*info == 0 && (*lwork >= 1 || lquery)) {
		maxwrk =
		    (*n << 1) + *n * NUMlapack_ilaenv (&c__1, "NUMlapack_dgehrd ", " ", n, &c__1, n, &c__0, 6, 1);
		if (!wantvl && !wantvr) {
			/* Computing MAX */
			i__1 = 1, i__2 = *n * 3;
			minwrk = MAX (i__1, i__2);
			/* Computing MAX */
			i__1 = NUMlapack_ilaenv (&c__8, "NUMlapack_dhseqr ", "EN", n, &c__1, n, &c_n1, 6, 2);
			maxb = MAX (i__1, 2);
			/* Computing MIN Computing MAX */
			i__3 = 2, i__4 = NUMlapack_ilaenv (&c__4, "NUMlapack_dhseqr ", "EN", n, &c__1, n, &c_n1, 6, 2);
			i__1 = MIN (maxb, *n), i__2 = MAX (i__3, i__4);
			k = MIN (i__1, i__2);
			/* Computing MAX */
			i__1 = k * (k + 2), i__2 = *n << 1;
			hswork = MAX (i__1, i__2);
			/* Computing MAX */
			i__1 = maxwrk, i__2 = *n + 1, i__1 = MAX (i__1, i__2), i__2 = *n + hswork;
			maxwrk = MAX (i__1, i__2);
		} else {
			/* Computing MAX */
			i__1 = 1, i__2 = *n << 2;
			minwrk = MAX (i__1, i__2);
			/* Computing MAX */
			i__1 = maxwrk, i__2 =
			           (*n << 1) + (*n - 1) * NUMlapack_ilaenv (&c__1, "DOR" "GHR", " ", n, &c__1, n, &c_n1, 6, 1);
			maxwrk = MAX (i__1, i__2);
			/* Computing MAX */
			i__1 = NUMlapack_ilaenv (&c__8, "NUMlapack_dhseqr ", "SV", n, &c__1, n, &c_n1, 6, 2);
			maxb = MAX (i__1, 2);
			/* Computing MIN Computing MAX */
			i__3 = 2, i__4 = NUMlapack_ilaenv (&c__4, "NUMlapack_dhseqr ", "SV", n, &c__1, n, &c_n1, 6, 2);
			i__1 = MIN (maxb, *n), i__2 = MAX (i__3, i__4);
			k = MIN (i__1, i__2);
			/* Computing MAX */
			i__1 = k * (k + 2), i__2 = *n << 1;
			hswork = MAX (i__1, i__2);
			/* Computing MAX */
			i__1 = maxwrk, i__2 = *n + 1, i__1 = MAX (i__1, i__2), i__2 = *n + hswork;
			maxwrk = MAX (i__1, i__2);
			/* Computing MAX */
			i__1 = maxwrk, i__2 = *n << 2;
			maxwrk = MAX (i__1, i__2);
		}
		work[1] = (double) maxwrk;
	}
	if (*lwork < minwrk && !lquery) {
		*info = -13;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("NUMlapack_dgeev ", &i__1);
		return 0;
	} else if (lquery) {
		return 0;
	}

	/* Quick return if possible */

	if (*n == 0) {
		return 0;
	}

	/* Get machine constants */

	eps = NUMblas_dlamch ("P");
	smlnum = NUMblas_dlamch ("S");
	bignum = 1. / smlnum;
	NUMlapack_dlabad (&smlnum, &bignum);
	smlnum = sqrt (smlnum) / eps;
	bignum = 1. / smlnum;

	/* Scale A if max element outside range [SMLNUM,BIGNUM] */

	anrm = NUMlapack_dlange ("M", n, n, &a[a_offset], lda, dum);
	scalea = FALSE;
	if (anrm > 0. && anrm < smlnum) {
		scalea = TRUE;
		cscale = smlnum;
	} else if (anrm > bignum) {
		scalea = TRUE;
		cscale = bignum;
	}
	if (scalea) {
		NUMlapack_dlascl ("G", &c__0, &c__0, &anrm, &cscale, n, n, &a[a_offset], lda, &ierr);
	}

	/* Balance the matrix (Workspace: need N) */

	ibal = 1;
	NUMlapack_dgebal ("B", n, &a[a_offset], lda, &ilo, &ihi, &work[ibal], &ierr);

	/* Reduce to upper Hessenberg form (Workspace: need 3*N, prefer 2*N+N*NB)
	 */

	itau = ibal + *n;
	iwrk = itau + *n;
	i__1 = *lwork - iwrk + 1;
	NUMlapack_dgehrd (n, &ilo, &ihi, &a[a_offset], lda, &work[itau], &work[iwrk], &i__1, &ierr);

	if (wantvl) {

		/* Want left eigenvectors Copy Householder vectors to VL */

		* (unsigned char *) side = 'L';
		NUMlapack_dlacpy ("L", n, n, &a[a_offset], lda, &vl[vl_offset], ldvl);

		/* Generate orthogonal matrix in VL (Workspace: need 3*N-1, prefer
		   2*N+(N-1)*NB) */

		i__1 = *lwork - iwrk + 1;
		NUMlapack_dorghr (n, &ilo, &ihi, &vl[vl_offset], ldvl, &work[itau], &work[iwrk], &i__1, &ierr);

		/* Perform QR iteration, accumulating Schur vectors in VL (Workspace:
		   need N+1, prefer N+HSWORK (see comments) ) */

		iwrk = itau;
		i__1 = *lwork - iwrk + 1;
		NUMlapack_dhseqr ("S", "V", n, &ilo, &ihi, &a[a_offset], lda, &wr[1], &wi[1], &vl[vl_offset], ldvl,
		                  &work[iwrk], &i__1, info);

		if (wantvr) {

			/* Want left and right eigenvectors Copy Schur vectors to VR */

			* (unsigned char *) side = 'B';
			NUMlapack_dlacpy ("F", n, n, &vl[vl_offset], ldvl, &vr[vr_offset], ldvr);
		}

	} else if (wantvr) {

		/* Want right eigenvectors Copy Householder vectors to VR */

		* (unsigned char *) side = 'R';
		NUMlapack_dlacpy ("L", n, n, &a[a_offset], lda, &vr[vr_offset], ldvr);

		/* Generate orthogonal matrix in VR (Workspace: need 3*N-1, prefer
		   2*N+(N-1)*NB) */

		i__1 = *lwork - iwrk + 1;
		NUMlapack_dorghr (n, &ilo, &ihi, &vr[vr_offset], ldvr, &work[itau], &work[iwrk], &i__1, &ierr);

		/* Perform QR iteration, accumulating Schur vectors in VR (Workspace:
		   need N+1, prefer N+HSWORK (see comments) ) */

		iwrk = itau;
		i__1 = *lwork - iwrk + 1;
		NUMlapack_dhseqr ("S", "V", n, &ilo, &ihi, &a[a_offset], lda, &wr[1], &wi[1], &vr[vr_offset], ldvr,
		                  &work[iwrk], &i__1, info);

	} else {

		/* Compute eigenvalues only (Workspace: need N+1, prefer N+HSWORK
		   (see comments) ) */

		iwrk = itau;
		i__1 = *lwork - iwrk + 1;
		NUMlapack_dhseqr ("E", "N", n, &ilo, &ihi, &a[a_offset], lda, &wr[1], &wi[1], &vr[vr_offset], ldvr,
		                  &work[iwrk], &i__1, info);
	}

	/* If INFO > 0 from NUMlapack_dhseqr , then quit */

	if (*info > 0) {
		goto L50;
	}

	if (wantvl || wantvr) {

		/* Compute left and/or right eigenvectors (Workspace: need 4*N) */

		NUMlapack_dtrevc (side, "B", select, n, &a[a_offset], lda, &vl[vl_offset], ldvl, &vr[vr_offset],
		                  ldvr, n, &nout, &work[iwrk], &ierr);
	}

	if (wantvl) {

		/* Undo balancing of left eigenvectors (Workspace: need N) */

		NUMlapack_dgebak ("B", "L", n, &ilo, &ihi, &work[ibal], n, &vl[vl_offset], ldvl, &ierr);

		/* Normalize left eigenvectors and make largest component real */

		i__1 = *n;
		for (i__ = 1; i__ <= i__1; ++i__) {
			if (wi[i__] == 0.) {
				scl = 1. / NUMblas_dnrm2 (n, &vl_ref (1, i__), &c__1);
				NUMblas_dscal (n, &scl, &vl_ref (1, i__), &c__1);
			} else if (wi[i__] > 0.) {
				d__1 = NUMblas_dnrm2 (n, &vl_ref (1, i__), &c__1);
				d__2 = NUMblas_dnrm2 (n, &vl_ref (1, i__ + 1), &c__1);
				scl = 1. / NUMlapack_dlapy2 (&d__1, &d__2);
				NUMblas_dscal (n, &scl, &vl_ref (1, i__), &c__1);
				NUMblas_dscal (n, &scl, &vl_ref (1, i__ + 1), &c__1);
				i__2 = *n;
				for (k = 1; k <= i__2; ++k) {
					/* Computing 2nd power */
					d__1 = vl_ref (k, i__);
					/* Computing 2nd power */
					d__2 = vl_ref (k, i__ + 1);
					work[iwrk + k - 1] = d__1 * d__1 + d__2 * d__2;
					/* L10: */
				}
				k = NUMblas_idamax (n, &work[iwrk], &c__1);
				NUMlapack_dlartg (&vl_ref (k, i__), &vl_ref (k, i__ + 1), &cs, &sn, &r__);
				NUMblas_drot (n, &vl_ref (1, i__), &c__1, &vl_ref (1, i__ + 1), &c__1, &cs, &sn);
				vl_ref (k, i__ + 1) = 0.;
			}
			/* L20: */
		}
	}

	if (wantvr) {

		/* Undo balancing of right eigenvectors (Workspace: need N) */

		NUMlapack_dgebak ("B", "R", n, &ilo, &ihi, &work[ibal], n, &vr[vr_offset], ldvr, &ierr);

		/* Normalize right eigenvectors and make largest component real */

		i__1 = *n;
		for (i__ = 1; i__ <= i__1; ++i__) {
			if (wi[i__] == 0.) {
				scl = 1. / NUMblas_dnrm2 (n, &vr_ref (1, i__), &c__1);
				NUMblas_dscal (n, &scl, &vr_ref (1, i__), &c__1);
			} else if (wi[i__] > 0.) {
				d__1 = NUMblas_dnrm2 (n, &vr_ref (1, i__), &c__1);
				d__2 = NUMblas_dnrm2 (n, &vr_ref (1, i__ + 1), &c__1);
				scl = 1. / NUMlapack_dlapy2 (&d__1, &d__2);
				NUMblas_dscal (n, &scl, &vr_ref (1, i__), &c__1);
				NUMblas_dscal (n, &scl, &vr_ref (1, i__ + 1), &c__1);
				i__2 = *n;
				for (k = 1; k <= i__2; ++k) {
					/* Computing 2nd power */
					d__1 = vr_ref (k, i__);
					/* Computing 2nd power */
					d__2 = vr_ref (k, i__ + 1);
					work[iwrk + k - 1] = d__1 * d__1 + d__2 * d__2;
					/* L30: */
				}
				k = NUMblas_idamax (n, &work[iwrk], &c__1);
				NUMlapack_dlartg (&vr_ref (k, i__), &vr_ref (k, i__ + 1), &cs, &sn, &r__);
				NUMblas_drot (n, &vr_ref (1, i__), &c__1, &vr_ref (1, i__ + 1), &c__1, &cs, &sn);
				vr_ref (k, i__ + 1) = 0.;
			}
			/* L40: */
		}
	}

	/* Undo scaling if necessary */

L50:
	if (scalea) {
		i__1 = *n - *info;
		/* Computing MAX */
		i__3 = *n - *info;
		i__2 = MAX (i__3, 1);
		NUMlapack_dlascl ("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &wr[*info + 1], &i__2, &ierr);
		i__1 = *n - *info;
		/* Computing MAX */
		i__3 = *n - *info;
		i__2 = MAX (i__3, 1);
		NUMlapack_dlascl ("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &wi[*info + 1], &i__2, &ierr);
		if (*info > 0) {
			i__1 = ilo - 1;
			NUMlapack_dlascl ("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &wr[1], n, &ierr);
			i__1 = ilo - 1;
			NUMlapack_dlascl ("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &wi[1], n, &ierr);
		}
	}

	work[1] = (double) maxwrk;
	return 0;
}								/* NUMlapack_dgeev */

#undef vr_ref
#undef vl_ref


int NUMlapack_dgehd2 (integer *n, integer *ilo, integer *ihi, double *a, integer *lda, double *tau, double *work,
                      integer *info) {
	/* Table of constant values */
	static integer c__1 = 1;

	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2, i__3;

	/* Local variables */
	static integer i__;
	static double aii;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--tau;
	--work;

	/* Function Body */
	*info = 0;
	if (*n < 0) {
		*info = -1;
	} else if (*ilo < 1 || *ilo > MAX (1, *n)) {
		*info = -2;
	} else if (*ihi < MIN (*ilo, *n) || *ihi > *n) {
		*info = -3;
	} else if (*lda < MAX (1, *n)) {
		*info = -5;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("NUMlapack_dgehd2 ", &i__1);
		return 0;
	}

	i__1 = *ihi - 1;
	for (i__ = *ilo; i__ <= i__1; ++i__) {

		/* Compute elementary reflector H(i) to annihilate A(i+2:ihi,i)

		   Computing MIN */
		i__2 = i__ + 2;
		i__3 = *ihi - i__;
		NUMlapack_dlarfg (&i__3, &a_ref (i__ + 1, i__), &a_ref (MIN (i__2, *n), i__), &c__1, &tau[i__]);
		aii = a_ref (i__ + 1, i__);
		a_ref (i__ + 1, i__) = 1.;

		/* Apply H(i) to A(1:ihi,i+1:ihi) from the right */

		i__2 = *ihi - i__;
		NUMlapack_dlarf ("Right", ihi, &i__2, &a_ref (i__ + 1, i__), &c__1, &tau[i__], &a_ref (1, i__ + 1),
		                 lda, &work[1]);

		/* Apply H(i) to A(i+1:ihi,i+1:n) from the left */

		i__2 = *ihi - i__;
		i__3 = *n - i__;
		NUMlapack_dlarf ("Left", &i__2, &i__3, &a_ref (i__ + 1, i__), &c__1, &tau[i__], &a_ref (i__ + 1,
		                 i__ + 1), lda, &work[1]);

		a_ref (i__ + 1, i__) = aii;
		/* L10: */
	}

	return 0;
}								/* NUMlapack_dgehd2 */


int NUMlapack_dgehrd (integer *n, integer *ilo, integer *ihi, double *a, integer *lda, double *tau, double *work,
                      integer *lwork, integer *info) {
	/* Table of constant values */
	static integer c__1 = 1;
	static integer c_n1 = -1;
	static integer c__3 = 3;
	static integer c__2 = 2;
	static integer c__65 = 65;
	static double c_b25 = -1.;
	static double c_b26 = 1.;

	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2, i__3, i__4;

	/* Local variables */
	static integer i__;
	static double t[4160] /* was [65][64] */ ;
	static integer nbmin, iinfo;
	static integer ib;
	static double ei;
	static integer nb, nh;
	static integer nx;
	static integer ldwork, lwkopt;
	static int lquery;
	static integer iws;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--tau;
	--work;

	/* Function Body */
	*info = 0;
	/* Computing MIN */
	i__1 = 64, i__2 = NUMlapack_ilaenv (&c__1, "NUMlapack_dgehrd ", " ", n, ilo, ihi, &c_n1, 6, 1);
	nb = MIN (i__1, i__2);
	lwkopt = *n * nb;
	work[1] = (double) lwkopt;
	lquery = *lwork == -1;
	if (*n < 0) {
		*info = -1;
	} else if (*ilo < 1 || *ilo > MAX (1, *n)) {
		*info = -2;
	} else if (*ihi < MIN (*ilo, *n) || *ihi > *n) {
		*info = -3;
	} else if (*lda < MAX (1, *n)) {
		*info = -5;
	} else if (*lwork < MAX (1, *n) && !lquery) {
		*info = -8;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("NUMlapack_dgehrd ", &i__1);
		return 0;
	} else if (lquery) {
		return 0;
	}

	/* Set elements 1:ILO-1 and IHI:N-1 of TAU to zero */

	i__1 = *ilo - 1;
	for (i__ = 1; i__ <= i__1; ++i__) {
		tau[i__] = 0.;
		/* L10: */
	}
	i__1 = *n - 1;
	for (i__ = MAX (1, *ihi); i__ <= i__1; ++i__) {
		tau[i__] = 0.;
		/* L20: */
	}

	/* Quick return if possible */

	nh = *ihi - *ilo + 1;
	if (nh <= 1) {
		work[1] = 1.;
		return 0;
	}

	/* Determine the block size.

	   Computing MIN */
	i__1 = 64, i__2 = NUMlapack_ilaenv (&c__1, "NUMlapack_dgehrd ", " ", n, ilo, ihi, &c_n1, 6, 1);
	nb = MIN (i__1, i__2);
	nbmin = 2;
	iws = 1;
	if (nb > 1 && nb < nh) {

		/* Determine when to cross over from blocked to unblocked code (last
		   block is always handled by unblocked code).

		   Computing MAX */
		i__1 = nb, i__2 = NUMlapack_ilaenv (&c__3, "NUMlapack_dgehrd ", " ", n, ilo, ihi, &c_n1, 6, 1);
		nx = MAX (i__1, i__2);
		if (nx < nh) {

			/* Determine if workspace is large enough for blocked code. */

			iws = *n * nb;
			if (*lwork < iws) {

				/* Not enough workspace to use optimal NB: determine the
				   minimum value of NB, and reduce NB or force use of
				   unblocked code.

				   Computing MAX */
				i__1 = 2, i__2 =
				           NUMlapack_ilaenv (&c__2, "NUMlapack_dgehrd ", " ", n, ilo, ihi, &c_n1, 6, 1);
				nbmin = MAX (i__1, i__2);
				if (*lwork >= *n * nbmin) {
					nb = *lwork / *n;
				} else {
					nb = 1;
				}
			}
		}
	}
	ldwork = *n;

	if (nb < nbmin || nb >= nh) {

		/* Use unblocked code below */

		i__ = *ilo;

	} else {

		/* Use blocked code */

		i__1 = *ihi - 1 - nx;
		i__2 = nb;
		for (i__ = *ilo; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
			/* Computing MIN */
			i__3 = nb, i__4 = *ihi - i__;
			ib = MIN (i__3, i__4);

			/* Reduce columns i:i+ib-1 to Hessenberg form, returning the
			   matrices V and T of the block reflector H = I - V*T*V' which
			   performs the reduction, and also the matrix Y = A*V*T */

			NUMlapack_dlahrd (ihi, &i__, &ib, &a_ref (1, i__), lda, &tau[i__], t, &c__65, &work[1], &ldwork);

			/* Apply the block reflector H to A(1:ihi,i+ib:ihi) from the
			   right, computing A := A - Y * V'. V(i+ib,ib-1) should be set to
			   1. */

			ei = a_ref (i__ + ib, i__ + ib - 1);
			a_ref (i__ + ib, i__ + ib - 1) = 1.;
			i__3 = *ihi - i__ - ib + 1;
			NUMblas_dgemm ("No transpose", "Transpose", ihi, &i__3, &ib, &c_b25, &work[1], &ldwork,
			               &a_ref (i__ + ib, i__), lda, &c_b26, &a_ref (1, i__ + ib), lda);
			a_ref (i__ + ib, i__ + ib - 1) = ei;

			/* Apply the block reflector H to A(i+1:ihi,i+ib:n) from the left
			 */

			i__3 = *ihi - i__;
			i__4 = *n - i__ - ib + 1;
			NUMlapack_dlarfb ("Left", "Transpose", "Forward", "Columnwise", &i__3, &i__4, &ib,
			                  &a_ref (i__ + 1, i__), lda, t, &c__65, &a_ref (i__ + 1, i__ + ib), lda, &work[1], &ldwork);
			/* L30: */
		}
	}

	/* Use unblocked code to reduce the rest of the matrix */

	NUMlapack_dgehd2 (n, &i__, ihi, &a[a_offset], lda, &tau[1], &work[1], &iinfo);
	work[1] = (double) iws;

	return 0;
}								/* NUMlapack_dgehrd */

int NUMlapack_dgelq2 (integer *m, integer *n, double *a, integer *lda, double *tau, double *work, integer *info) {
	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2, i__3;

	/* Local variables */
	static integer i__, k;
	static double aii;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--tau;
	--work;

	/* Function Body */
	*info = 0;
	if (*m < 0) {
		*info = -1;
	} else if (*n < 0) {
		*info = -2;
	} else if (*lda < MAX (1, *m)) {
		*info = -4;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DGELQ2", &i__1);
		return 0;
	}

	k = MIN (*m, *n);

	i__1 = k;
	for (i__ = 1; i__ <= i__1; ++i__) {

		/* Generate elementary reflector H(i) to annihilate A(i,i+1:n)

		   Computing MIN */
		i__2 = i__ + 1;
		i__3 = *n - i__ + 1;
		NUMlapack_dlarfg (&i__3, &a_ref (i__, i__), &a_ref (i__, MIN (i__2, *n)), lda, &tau[i__]);
		if (i__ < *m) {

			/* Apply H(i) to A(i+1:m,i:n) from the right */

			aii = a_ref (i__, i__);
			a_ref (i__, i__) = 1.;
			i__2 = *m - i__;
			i__3 = *n - i__ + 1;
			NUMlapack_dlarf ("Right", &i__2, &i__3, &a_ref (i__, i__), lda, &tau[i__], &a_ref (i__ + 1, i__),
			                 lda, &work[1]);
			a_ref (i__, i__) = aii;
		}
		/* L10: */
	}
	return 0;
}								/* NUMlapack_dgelq2 */

int NUMlapack_dgelqf (integer *m, integer *n, double *a, integer *lda, double *tau, double *work, integer *lwork,
                      integer *info) {
	/* Table of constant values */
	static integer c__1 = 1;
	static integer c_n1 = -1;
	static integer c__3 = 3;
	static integer c__2 = 2;

	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2, i__3, i__4;

	/* Local variables */
	static integer i__, k, nbmin, iinfo;
	static integer ib, nb;
	static integer nx;
	static integer ldwork, lwkopt;
	static integer lquery;
	static integer iws;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--tau;
	--work;

	/* Function Body */
	*info = 0;
	nb = NUMlapack_ilaenv (&c__1, "DGELQF", " ", m, n, &c_n1, &c_n1, 6, 1);
	lwkopt = *m * nb;
	work[1] = (double) lwkopt;
	lquery = *lwork == -1;
	if (*m < 0) {
		*info = -1;
	} else if (*n < 0) {
		*info = -2;
	} else if (*lda < MAX (1, *m)) {
		*info = -4;
	} else if (*lwork < MAX (1, *m) && !lquery) {
		*info = -7;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DGELQF", &i__1);
		return 0;
	} else if (lquery) {
		return 0;
	}

	/* Quick return if possible */

	k = MIN (*m, *n);
	if (k == 0) {
		work[1] = 1.;
		return 0;
	}

	nbmin = 2;
	nx = 0;
	iws = *m;
	if (nb > 1 && nb < k) {

		/* Determine when to cross over from blocked to unblocked code.

		   Computing MAX */
		i__1 = 0, i__2 = NUMlapack_ilaenv (&c__3, "DGELQF", " ", m, n, &c_n1, &c_n1, 6, 1);
		nx = MAX (i__1, i__2);
		if (nx < k) {

			/* Determine if workspace is large enough for blocked code. */

			ldwork = *m;
			iws = ldwork * nb;
			if (*lwork < iws) {

				/* Not enough workspace to use optimal NB: reduce NB and
				   determine the minimum value of NB. */

				nb = *lwork / ldwork;
				/* Computing MAX */
				i__1 = 2, i__2 = NUMlapack_ilaenv (&c__2, "DGELQF", " ", m, n, &c_n1, &c_n1, 6, 1);
				nbmin = MAX (i__1, i__2);
			}
		}
	}

	if (nb >= nbmin && nb < k && nx < k) {

		/* Use blocked code initially */

		i__1 = k - nx;
		i__2 = nb;
		for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
			/* Computing MIN */
			i__3 = k - i__ + 1;
			ib = MIN (i__3, nb);

			/* Compute the LQ factorization of the current block
			   A(i:i+ib-1,i:n) */

			i__3 = *n - i__ + 1;
			NUMlapack_dgelq2 (&ib, &i__3, &a_ref (i__, i__), lda, &tau[i__], &work[1], &iinfo);
			if (i__ + ib <= *m) {

				/* Form the triangular factor of the block reflector H = H(i)
				   H(i+1) . . . H(i+ib-1) */

				i__3 = *n - i__ + 1;
				NUMlapack_dlarft ("Forward", "Rowwise", &i__3, &ib, &a_ref (i__, i__), lda, &tau[i__], &work[1],
				                  &ldwork);

				/* Apply H to A(i+ib:m,i:n) from the right */

				i__3 = *m - i__ - ib + 1;
				i__4 = *n - i__ + 1;
				NUMlapack_dlarfb ("Right", "No transpose", "Forward", "Rowwise", &i__3, &i__4, &ib, &a_ref (i__,
				                  i__), lda, &work[1], &ldwork, &a_ref (i__ + ib, i__), lda, &work[ib + 1], &ldwork);
			}
			/* L10: */
		}
	} else {
		i__ = 1;
	}

	/* Use unblocked code to factor the last or only block. */

	if (i__ <= k) {
		i__2 = *m - i__ + 1;
		i__1 = *n - i__ + 1;
		NUMlapack_dgelq2 (&i__2, &i__1, &a_ref (i__, i__), lda, &tau[i__], &work[1], &iinfo);
	}

	work[1] = (double) iws;
	return 0;
}								/* NUMlapack_dgelqf */

#define b_ref(a_1,a_2) b[(a_2)*b_dim1 + a_1]

int NUMlapack_dgelss (integer *m, integer *n, integer *nrhs, double *a, integer *lda, double *b, integer *ldb, double *s,
                      double *rcond, integer *rank, double *work, integer *lwork, integer *info) {
	/* System generated locals */
	integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4;
	double d__1;

	/* Local variables */
	static double anrm, bnrm;
	static integer itau;
	static double vdum[1];
	static integer i__;
	static integer iascl, ibscl;
	static integer chunk;
	static double sfmin;
	static integer minmn;
	static integer maxmn, itaup, itauq, mnthr, iwork;
	static integer bl, ie, il;
	static integer mm;
	static integer bdspac;
	static double bignum;
	static integer ldwork;
	static integer minwrk, maxwrk;
	static double smlnum;
	static integer lquery;
	static double eps, thr;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	b_dim1 = *ldb;
	b_offset = 1 + b_dim1 * 1;
	b -= b_offset;
	--s;
	--work;

	/* Function Body */
	*info = 0;
	minmn = MIN (*m, *n);
	maxmn = MAX (*m, *n);
	mnthr = NUMlapack_ilaenv (&c__6, "DGELSS", " ", m, n, nrhs, &c_n1, 6, 1);
	lquery = *lwork == -1;
	if (*m < 0) {
		*info = -1;
	} else if (*n < 0) {
		*info = -2;
	} else if (*nrhs < 0) {
		*info = -3;
	} else if (*lda < MAX (1, *m)) {
		*info = -5;
	} else if (*ldb < MAX (1, maxmn)) {
		*info = -7;
	}

	/* Compute workspace (Note: Comments in the code beginning "Workspace:"
	   describe the minimal amount of workspace needed at that point in the
	   code, as well as the preferred amount for good performance. NB refers
	   to the optimal block size for the immediately following subroutine, as
	   returned by ILAENV.) */

	minwrk = 1;
	if (*info == 0 && (*lwork >= 1 || lquery)) {
		maxwrk = 0;
		mm = *m;
		if (*m >= *n && *m >= mnthr) {

			/* Path 1a - overdetermined, with many more rows than columns */

			mm = *n;
			/* Computing MAX */
			i__1 = maxwrk, i__2 = *n + *n * NUMlapack_ilaenv (&c__1, "DGEQRF", " ", m, n, &c_n1, &c_n1, 6, 1);
			maxwrk = MAX (i__1, i__2);
			/* Computing MAX */
			i__1 = maxwrk, i__2 =
			           *n + *nrhs * NUMlapack_ilaenv (&c__1, "DORMQR", "LT", m, nrhs, n, &c_n1, 6, 2);
			maxwrk = MAX (i__1, i__2);
		}
		if (*m >= *n) {

			/* Path 1 - overdetermined or exactly determined

			   Compute workspace needed for DBDSQR

			   Computing MAX */
			i__1 = 1, i__2 = *n * 5;
			bdspac = MAX (i__1, i__2);
			/* Computing MAX */
			i__1 = maxwrk, i__2 =
			           *n * 3 + (mm + *n) * NUMlapack_ilaenv (&c__1, "DGEBRD", " ", &mm, n, &c_n1, &c_n1, 6, 1);
			maxwrk = MAX (i__1, i__2);
			/* Computing MAX */
			i__1 = maxwrk, i__2 =
			           *n * 3 + *nrhs * NUMlapack_ilaenv (&c__1, "DORMBR", "QLT", &mm, nrhs, n, &c_n1, 6, 3);
			maxwrk = MAX (i__1, i__2);
			/* Computing MAX */
			i__1 = maxwrk, i__2 =
			           *n * 3 + (*n - 1) * NUMlapack_ilaenv (&c__1, "DORGBR", "P", n, n, n, &c_n1, 6, 1);
			maxwrk = MAX (i__1, i__2);
			maxwrk = MAX (maxwrk, bdspac);
			/* Computing MAX */
			i__1 = maxwrk, i__2 = *n * *nrhs;
			maxwrk = MAX (i__1, i__2);
			/* Computing MAX */
			i__1 = *n * 3 + mm, i__2 = *n * 3 + *nrhs, i__1 = MAX (i__1, i__2);
			minwrk = MAX (i__1, bdspac);
			maxwrk = MAX (minwrk, maxwrk);
		}
		if (*n > *m) {

			/* Compute workspace needed for DBDSQR

			   Computing MAX */
			i__1 = 1, i__2 = *m * 5;
			bdspac = MAX (i__1, i__2);
			/* Computing MAX */
			i__1 = *m * 3 + *nrhs, i__2 = *m * 3 + *n, i__1 = MAX (i__1, i__2);
			minwrk = MAX (i__1, bdspac);
			if (*n >= mnthr) {

				/* Path 2a - underdetermined, with many more columns than
				   rows */

				maxwrk = *m + *m * NUMlapack_ilaenv (&c__1, "DGELQF", " ", m, n, &c_n1, &c_n1, 6, 1);
				/* Computing MAX */
				i__1 = maxwrk, i__2 =
				           *m * *m + (*m << 2) + (*m << 1) * NUMlapack_ilaenv (&c__1, "DGEBRD", " ", m, m, &c_n1,
				                   &c_n1, 6, 1);
				maxwrk = MAX (i__1, i__2);
				/* Computing MAX */
				i__1 = maxwrk, i__2 =
				           *m * *m + (*m << 2) + *nrhs * NUMlapack_ilaenv (&c__1, "DORMBR", "QLT", m, nrhs, m, &c_n1,
				                   6, 3);
				maxwrk = MAX (i__1, i__2);
				/* Computing MAX */
				i__1 = maxwrk, i__2 =
				           *m * *m + (*m << 2) + (*m - 1) * NUMlapack_ilaenv (&c__1, "DORGBR", "P", m, m, m, &c_n1, 6,
				                   1);
				maxwrk = MAX (i__1, i__2);
				/* Computing MAX */
				i__1 = maxwrk, i__2 = *m * *m + *m + bdspac;
				maxwrk = MAX (i__1, i__2);
				if (*nrhs > 1) {
					/* Computing MAX */
					i__1 = maxwrk, i__2 = *m * *m + *m + *m * *nrhs;
					maxwrk = MAX (i__1, i__2);
				} else {
					/* Computing MAX */
					i__1 = maxwrk, i__2 = *m * *m + (*m << 1);
					maxwrk = MAX (i__1, i__2);
				}
				/* Computing MAX */
				i__1 = maxwrk, i__2 =
				           *m + *nrhs * NUMlapack_ilaenv (&c__1, "DORMLQ", "LT", n, nrhs, m, &c_n1, 6, 2);
				maxwrk = MAX (i__1, i__2);
			} else {

				/* Path 2 - underdetermined */

				maxwrk = *m * 3 + (*n + *m) * NUMlapack_ilaenv (&c__1, "DGEBRD", " ", m, n, &c_n1, &c_n1, 6, 1);
				/* Computing MAX */
				i__1 = maxwrk, i__2 =
				           *m * 3 + *nrhs * NUMlapack_ilaenv (&c__1, "DORMBR", "QLT", m, nrhs, m, &c_n1, 6, 3);
				maxwrk = MAX (i__1, i__2);
				/* Computing MAX */
				i__1 = maxwrk, i__2 =
				           *m * 3 + *m * NUMlapack_ilaenv (&c__1, "DORGBR", "P", m, n, m, &c_n1, 6, 1);
				maxwrk = MAX (i__1, i__2);
				maxwrk = MAX (maxwrk, bdspac);
				/* Computing MAX */
				i__1 = maxwrk, i__2 = *n * *nrhs;
				maxwrk = MAX (i__1, i__2);
			}
		}
		maxwrk = MAX (minwrk, maxwrk);
		work[1] = (double) maxwrk;
	}

	minwrk = MAX (minwrk, 1);
	if (*lwork < minwrk && !lquery) {
		*info = -12;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DGELSS", &i__1);
		return 0;
	} else if (lquery) {
		return 0;
	}

	/* Quick return if possible */

	if (*m == 0 || *n == 0) {
		*rank = 0;
		return 0;
	}

	/* Get machine parameters */

	eps = NUMblas_dlamch ("P");
	sfmin = NUMblas_dlamch ("S");
	smlnum = sfmin / eps;
	bignum = 1. / smlnum;
	NUMlapack_dlabad (&smlnum, &bignum);

	/* Scale A if max element outside range [SMLNUM,BIGNUM] */

	anrm = NUMlapack_dlange ("M", m, n, &a[a_offset], lda, &work[1]);
	iascl = 0;
	if (anrm > 0. && anrm < smlnum) {

		/* Scale matrix norm up to SMLNUM */

		NUMlapack_dlascl ("G", &c__0, &c__0, &anrm, &smlnum, m, n, &a[a_offset], lda, info);
		iascl = 1;
	} else if (anrm > bignum) {

		/* Scale matrix norm down to BIGNUM */

		NUMlapack_dlascl ("G", &c__0, &c__0, &anrm, &bignum, m, n, &a[a_offset], lda, info);
		iascl = 2;
	} else if (anrm == 0.) {

		/* Matrix all zero. Return zero solution. */

		i__1 = MAX (*m, *n);
		NUMlapack_dlaset ("F", &i__1, nrhs, &c_b74, &c_b74, &b[b_offset], ldb);
		NUMlapack_dlaset ("F", &minmn, &c__1, &c_b74, &c_b74, &s[1], &c__1);
		*rank = 0;
		goto L70;
	}

	/* Scale B if max element outside range [SMLNUM,BIGNUM] */

	bnrm = NUMlapack_dlange ("M", m, nrhs, &b[b_offset], ldb, &work[1]);
	ibscl = 0;
	if (bnrm > 0. && bnrm < smlnum) {

		/* Scale matrix norm up to SMLNUM */

		NUMlapack_dlascl ("G", &c__0, &c__0, &bnrm, &smlnum, m, nrhs, &b[b_offset], ldb, info);
		ibscl = 1;
	} else if (bnrm > bignum) {

		/* Scale matrix norm down to BIGNUM */

		NUMlapack_dlascl ("G", &c__0, &c__0, &bnrm, &bignum, m, nrhs, &b[b_offset], ldb, info);
		ibscl = 2;
	}

	/* Overdetermined case */

	if (*m >= *n) {

		/* Path 1 - overdetermined or exactly determined */

		mm = *m;
		if (*m >= mnthr) {

			/* Path 1a - overdetermined, with many more rows than columns */

			mm = *n;
			itau = 1;
			iwork = itau + *n;

			/* Compute A=Q*R (Workspace: need 2*N, prefer N+N*NB) */

			i__1 = *lwork - iwork + 1;
			NUMlapack_dgeqrf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__1, info);

			/* Multiply B by transpose(Q) (Workspace: need N+NRHS, prefer
			   N+NRHS*NB) */

			i__1 = *lwork - iwork + 1;
			NUMlapack_dormqr ("L", "T", m, nrhs, n, &a[a_offset], lda, &work[itau], &b[b_offset], ldb,
			                  &work[iwork], &i__1, info);

			/* Zero out below R */

			if (*n > 1) {
				i__1 = *n - 1;
				i__2 = *n - 1;
				NUMlapack_dlaset ("L", &i__1, &i__2, &c_b74, &c_b74, &a_ref (2, 1), lda);
			}
		}

		ie = 1;
		itauq = ie + *n;
		itaup = itauq + *n;
		iwork = itaup + *n;

		/* Bidiagonalize R in A (Workspace: need 3*N+MM, prefer
		   3*N+(MM+N)*NB) */

		i__1 = *lwork - iwork + 1;
		NUMlapack_dgebrd (&mm, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &work[itaup], &work[iwork],
		                  &i__1, info);

		/* Multiply B by transpose of left bidiagonalizing vectors of R
		   (Workspace: need 3*N+NRHS, prefer 3*N+NRHS*NB) */

		i__1 = *lwork - iwork + 1;
		NUMlapack_dormbr ("Q", "L", "T", &mm, nrhs, n, &a[a_offset], lda, &work[itauq], &b[b_offset], ldb,
		                  &work[iwork], &i__1, info);

		/* Generate right bidiagonalizing vectors of R in A (Workspace: need
		   4*N-1, prefer 3*N+(N-1)*NB) */

		i__1 = *lwork - iwork + 1;
		NUMlapack_dorgbr ("P", n, n, n, &a[a_offset], lda, &work[itaup], &work[iwork], &i__1, info);
		iwork = ie + *n;

		/* Perform bidiagonal QR iteration multiply B by transpose of left
		   singular vectors compute right singular vectors in A (Workspace:
		   need BDSPAC) */

		NUMlapack_dbdsqr ("U", n, n, &c__0, nrhs, &s[1], &work[ie], &a[a_offset], lda, vdum, &c__1,
		                  &b[b_offset], ldb, &work[iwork], info);
		if (*info != 0) {
			goto L70;
		}

		/* Multiply B by reciprocals of singular values

		   Computing MAX */
		d__1 = *rcond * s[1];
		thr = MAX (d__1, sfmin);
		if (*rcond < 0.) {
			/* Computing MAX */
			d__1 = eps * s[1];
			thr = MAX (d__1, sfmin);
		}
		*rank = 0;
		i__1 = *n;
		for (i__ = 1; i__ <= i__1; ++i__) {
			if (s[i__] > thr) {
				NUMlapack_drscl (nrhs, &s[i__], &b_ref (i__, 1), ldb);
				++ (*rank);
			} else {
				NUMlapack_dlaset ("F", &c__1, nrhs, &c_b74, &c_b74, &b_ref (i__, 1), ldb);
			}
			/* L10: */
		}

		/* Multiply B by right singular vectors (Workspace: need N, prefer
		   N*NRHS) */

		if (*lwork >= *ldb * *nrhs && *nrhs > 1) {
			NUMblas_dgemm ("T", "N", n, nrhs, n, &c_b108, &a[a_offset], lda, &b[b_offset], ldb, &c_b74, &work[1],
			               ldb);
			NUMlapack_dlacpy ("G", n, nrhs, &work[1], ldb, &b[b_offset], ldb);
		} else if (*nrhs > 1) {
			chunk = *lwork / *n;
			i__1 = *nrhs;
			i__2 = chunk;
			for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
				/* Computing MIN */
				i__3 = *nrhs - i__ + 1;
				bl = MIN (i__3, chunk);
				NUMblas_dgemm ("T", "N", n, &bl, n, &c_b108, &a[a_offset], lda, &b_ref (1, i__), ldb, &c_b74,
				               &work[1], n);
				NUMlapack_dlacpy ("G", n, &bl, &work[1], n, &b_ref (1, i__), ldb);
				/* L20: */
			}
		} else {
			NUMblas_dgemv ("T", n, n, &c_b108, &a[a_offset], lda, &b[b_offset], &c__1, &c_b74, &work[1], &c__1);
			NUMblas_dcopy (n, &work[1], &c__1, &b[b_offset], &c__1);
		}

	} else {					/* if(complicated condition) */
		/* Computing MAX */
		i__2 = *m, i__1 = (*m << 1) - 4, i__2 = MAX (i__2, i__1), i__2 = MAX (i__2, *nrhs), i__1 =
		        *n - *m * 3;
		if (*n >= mnthr && *lwork >= (*m << 2) + *m * *m + MAX (i__2, i__1)) {

			/* Path 2a - underdetermined, with many more columns than rows
			   and sufficient workspace for an efficient algorithm */

			ldwork = *m;
			/* Computing MAX Computing MAX */
			i__3 = *m, i__4 = (*m << 1) - 4, i__3 = MAX (i__3, i__4), i__3 = MAX (i__3, *nrhs), i__4 =
			        *n - *m * 3;
			i__2 = (*m << 2) + *m * *lda + MAX (i__3, i__4), i__1 = *m * *lda + *m + *m * *nrhs;
			if (*lwork >= MAX (i__2, i__1)) {
				ldwork = *lda;
			}
			itau = 1;
			iwork = *m + 1;

			/* Compute A=L*Q (Workspace: need 2*M, prefer M+M*NB) */

			i__2 = *lwork - iwork + 1;
			NUMlapack_dgelqf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, info);
			il = iwork;

			/* Copy L to WORK(IL), zeroing out above it */

			NUMlapack_dlacpy ("L", m, m, &a[a_offset], lda, &work[il], &ldwork);
			i__2 = *m - 1;
			i__1 = *m - 1;
			NUMlapack_dlaset ("U", &i__2, &i__1, &c_b74, &c_b74, &work[il + ldwork], &ldwork);
			ie = il + ldwork * *m;
			itauq = ie + *m;
			itaup = itauq + *m;
			iwork = itaup + *m;

			/* Bidiagonalize L in WORK(IL) (Workspace: need M*M+5*M, prefer
			   M*M+4*M+2*M*NB) */

			i__2 = *lwork - iwork + 1;
			NUMlapack_dgebrd (m, m, &work[il], &ldwork, &s[1], &work[ie], &work[itauq], &work[itaup],
			                  &work[iwork], &i__2, info);

			/* Multiply B by transpose of left bidiagonalizing vectors of L
			   (Workspace: need M*M+4*M+NRHS, prefer M*M+4*M+NRHS*NB) */

			i__2 = *lwork - iwork + 1;
			NUMlapack_dormbr ("Q", "L", "T", m, nrhs, m, &work[il], &ldwork, &work[itauq], &b[b_offset], ldb,
			                  &work[iwork], &i__2, info);

			/* Generate right bidiagonalizing vectors of R in WORK(IL)
			   (Workspace: need M*M+5*M-1, prefer M*M+4*M+(M-1)*NB) */

			i__2 = *lwork - iwork + 1;
			NUMlapack_dorgbr ("P", m, m, m, &work[il], &ldwork, &work[itaup], &work[iwork], &i__2, info);
			iwork = ie + *m;

			/* Perform bidiagonal QR iteration, computing right singular
			   vectors of L in WORK(IL) and multiplying B by transpose of
			   left singular vectors (Workspace: need M*M+M+BDSPAC) */

			NUMlapack_dbdsqr ("U", m, m, &c__0, nrhs, &s[1], &work[ie], &work[il], &ldwork, &a[a_offset], lda,
			                  &b[b_offset], ldb, &work[iwork], info);
			if (*info != 0) {
				goto L70;
			}

			/* Multiply B by reciprocals of singular values

			   Computing MAX */
			d__1 = *rcond * s[1];
			thr = MAX (d__1, sfmin);
			if (*rcond < 0.) {
				/* Computing MAX */
				d__1 = eps * s[1];
				thr = MAX (d__1, sfmin);
			}
			*rank = 0;
			i__2 = *m;
			for (i__ = 1; i__ <= i__2; ++i__) {
				if (s[i__] > thr) {
					NUMlapack_drscl (nrhs, &s[i__], &b_ref (i__, 1), ldb);
					++ (*rank);
				} else {
					NUMlapack_dlaset ("F", &c__1, nrhs, &c_b74, &c_b74, &b_ref (i__, 1), ldb);
				}
				/* L30: */
			}
			iwork = ie;

			/* Multiply B by right singular vectors of L in WORK(IL)
			   (Workspace: need M*M+2*M, prefer M*M+M+M*NRHS) */

			if (*lwork >= *ldb * *nrhs + iwork - 1 && *nrhs > 1) {
				NUMblas_dgemm ("T", "N", m, nrhs, m, &c_b108, &work[il], &ldwork, &b[b_offset], ldb, &c_b74,
				               &work[iwork], ldb);
				NUMlapack_dlacpy ("G", m, nrhs, &work[iwork], ldb, &b[b_offset], ldb);
			} else if (*nrhs > 1) {
				chunk = (*lwork - iwork + 1) / *m;
				i__2 = *nrhs;
				i__1 = chunk;
				for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__1) {
					/* Computing MIN */
					i__3 = *nrhs - i__ + 1;
					bl = MIN (i__3, chunk);
					NUMblas_dgemm ("T", "N", m, &bl, m, &c_b108, &work[il], &ldwork, &b_ref (1, i__), ldb, &c_b74,
					               &work[iwork], n);
					NUMlapack_dlacpy ("G", m, &bl, &work[iwork], n, &b_ref (1, i__), ldb);
					/* L40: */
				}
			} else {
				NUMblas_dgemv ("T", m, m, &c_b108, &work[il], &ldwork, &b_ref (1, 1), &c__1, &c_b74, &work[iwork],
				               &c__1);
				NUMblas_dcopy (m, &work[iwork], &c__1, &b_ref (1, 1), &c__1);
			}

			/* Zero out below first M rows of B */

			i__1 = *n - *m;
			NUMlapack_dlaset ("F", &i__1, nrhs, &c_b74, &c_b74, &b_ref (*m + 1, 1), ldb);
			iwork = itau + *m;

			/* Multiply transpose(Q) by B (Workspace: need M+NRHS, prefer
			   M+NRHS*NB) */

			i__1 = *lwork - iwork + 1;
			NUMlapack_dormlq ("L", "T", n, nrhs, m, &a[a_offset], lda, &work[itau], &b[b_offset], ldb,
			                  &work[iwork], &i__1, info);

		} else {

			/* Path 2 - remaining underdetermined cases */

			ie = 1;
			itauq = ie + *m;
			itaup = itauq + *m;
			iwork = itaup + *m;

			/* Bidiagonalize A (Workspace: need 3*M+N, prefer 3*M+(M+N)*NB) */

			i__1 = *lwork - iwork + 1;
			NUMlapack_dgebrd (m, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &work[itaup],
			                  &work[iwork], &i__1, info);

			/* Multiply B by transpose of left bidiagonalizing vectors
			   (Workspace: need 3*M+NRHS, prefer 3*M+NRHS*NB) */

			i__1 = *lwork - iwork + 1;
			NUMlapack_dormbr ("Q", "L", "T", m, nrhs, n, &a[a_offset], lda, &work[itauq], &b[b_offset], ldb,
			                  &work[iwork], &i__1, info);

			/* Generate right bidiagonalizing vectors in A (Workspace: need
			   4*M, prefer 3*M+M*NB) */

			i__1 = *lwork - iwork + 1;
			NUMlapack_dorgbr ("P", m, n, m, &a[a_offset], lda, &work[itaup], &work[iwork], &i__1, info);
			iwork = ie + *m;

			/* Perform bidiagonal QR iteration, computing right singular
			   vectors of A in A and multiplying B by transpose of left
			   singular vectors (Workspace: need BDSPAC) */

			NUMlapack_dbdsqr ("L", m, n, &c__0, nrhs, &s[1], &work[ie], &a[a_offset], lda, vdum, &c__1,
			                  &b[b_offset], ldb, &work[iwork], info);
			if (*info != 0) {
				goto L70;
			}

			/* Multiply B by reciprocals of singular values

			   Computing MAX */
			d__1 = *rcond * s[1];
			thr = MAX (d__1, sfmin);
			if (*rcond < 0.) {
				/* Computing MAX */
				d__1 = eps * s[1];
				thr = MAX (d__1, sfmin);
			}
			*rank = 0;
			i__1 = *m;
			for (i__ = 1; i__ <= i__1; ++i__) {
				if (s[i__] > thr) {
					NUMlapack_drscl (nrhs, &s[i__], &b_ref (i__, 1), ldb);
					++ (*rank);
				} else {
					NUMlapack_dlaset ("F", &c__1, nrhs, &c_b74, &c_b74, &b_ref (i__, 1), ldb);
				}
				/* L50: */
			}

			/* Multiply B by right singular vectors of A (Workspace: need N,
			   prefer N*NRHS) */

			if (*lwork >= *ldb * *nrhs && *nrhs > 1) {
				NUMblas_dgemm ("T", "N", n, nrhs, m, &c_b108, &a[a_offset], lda, &b[b_offset], ldb, &c_b74, &work[1],
				               ldb);
				NUMlapack_dlacpy ("F", n, nrhs, &work[1], ldb, &b[b_offset], ldb);
			} else if (*nrhs > 1) {
				chunk = *lwork / *n;
				i__1 = *nrhs;
				i__2 = chunk;
				for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
					/* Computing MIN */
					i__3 = *nrhs - i__ + 1;
					bl = MIN (i__3, chunk);
					NUMblas_dgemm ("T", "N", n, &bl, m, &c_b108, &a[a_offset], lda, &b_ref (1, i__), ldb, &c_b74,
					               &work[1], n);
					NUMlapack_dlacpy ("F", n, &bl, &work[1], n, &b_ref (1, i__), ldb);
					/* L60: */
				}
			} else {
				NUMblas_dgemv ("T", m, n, &c_b108, &a[a_offset], lda, &b[b_offset], &c__1, &c_b74, &work[1], &c__1);
				NUMblas_dcopy (n, &work[1], &c__1, &b[b_offset], &c__1);
			}
		}
	}

	/* Undo scaling */

	if (iascl == 1) {
		NUMlapack_dlascl ("G", &c__0, &c__0, &anrm, &smlnum, n, nrhs, &b[b_offset], ldb, info);
		NUMlapack_dlascl ("G", &c__0, &c__0, &smlnum, &anrm, &minmn, &c__1, &s[1], &minmn, info);
	} else if (iascl == 2) {
		NUMlapack_dlascl ("G", &c__0, &c__0, &anrm, &bignum, n, nrhs, &b[b_offset], ldb, info);
		NUMlapack_dlascl ("G", &c__0, &c__0, &bignum, &anrm, &minmn, &c__1, &s[1], &minmn, info);
	}
	if (ibscl == 1) {
		NUMlapack_dlascl ("G", &c__0, &c__0, &smlnum, &bnrm, n, nrhs, &b[b_offset], ldb, info);
	} else if (ibscl == 2) {
		NUMlapack_dlascl ("G", &c__0, &c__0, &bignum, &bnrm, n, nrhs, &b[b_offset], ldb, info);
	}

L70:
	work[1] = (double) maxwrk;
	return 0;
}								/* NUMlapack_dgelss */

#undef b_ref

int NUMlapack_dgeqpf (integer *m, integer *n, double *a, integer *lda, integer *jpvt, double *tau, double *work, integer *info) {
	/* Table of constant values */
	static integer c__1 = 1;

	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2, i__3;
	double d__1, d__2;

	/* Local variables */
	static double temp;
	static double temp2;
	static integer i__, j;
	static integer itemp;
	static integer ma, mn;
	static double aii;
	static integer pvt;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--jpvt;
	--tau;
	--work;

	/* Function Body */
	*info = 0;
	if (*m < 0) {
		*info = -1;
	} else if (*n < 0) {
		*info = -2;
	} else if (*lda < MAX (1, *m)) {
		*info = -4;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DGEQPF", &i__1);
		return 0;
	}

	mn = MIN (*m, *n);

	/* Move initial columns up front */

	itemp = 1;
	i__1 = *n;
	for (i__ = 1; i__ <= i__1; ++i__) {
		if (jpvt[i__] != 0) {
			if (i__ != itemp) {
				NUMblas_dswap (m, &a_ref (1, i__), &c__1, &a_ref (1, itemp), &c__1);
				jpvt[i__] = jpvt[itemp];
				jpvt[itemp] = i__;
			} else {
				jpvt[i__] = i__;
			}
			++itemp;
		} else {
			jpvt[i__] = i__;
		}
		/* L10: */
	}
	--itemp;

	/* Compute the QR factorization and update remaining columns */

	if (itemp > 0) {
		ma = MIN (itemp, *m);
		NUMlapack_dgeqr2 (m, &ma, &a[a_offset], lda, &tau[1], &work[1], info);
		if (ma < *n) {
			i__1 = *n - ma;
			NUMlapack_dorm2r ("Left", "Transpose", m, &i__1, &ma, &a[a_offset], lda, &tau[1], &a_ref (1,
			                  ma + 1), lda, &work[1], info);
		}
	}

	if (itemp < mn) {

		/* Initialize partial column norms. The first n elements of work
		   store the exact column norms. */

		i__1 = *n;
		for (i__ = itemp + 1; i__ <= i__1; ++i__) {
			i__2 = *m - itemp;
			work[i__] = NUMblas_dnrm2 (&i__2, &a_ref (itemp + 1, i__), &c__1);
			work[*n + i__] = work[i__];
			/* L20: */
		}

		/* Compute factorization */

		i__1 = mn;
		for (i__ = itemp + 1; i__ <= i__1; ++i__) {

			/* Determine ith pivot column and swap if necessary */

			i__2 = *n - i__ + 1;
			pvt = i__ - 1 + NUMblas_idamax (&i__2, &work[i__], &c__1);

			if (pvt != i__) {
				NUMblas_dswap (m, &a_ref (1, pvt), &c__1, &a_ref (1, i__), &c__1);
				itemp = jpvt[pvt];
				jpvt[pvt] = jpvt[i__];
				jpvt[i__] = itemp;
				work[pvt] = work[i__];
				work[*n + pvt] = work[*n + i__];
			}

			/* Generate elementary reflector H(i) */

			if (i__ < *m) {
				i__2 = *m - i__ + 1;
				NUMlapack_dlarfg (&i__2, &a_ref (i__, i__), &a_ref (i__ + 1, i__), &c__1, &tau[i__]);
			} else {
				NUMlapack_dlarfg (&c__1, &a_ref (*m, *m), &a_ref (*m, *m), &c__1, &tau[*m]);
			}

			if (i__ < *n) {

				/* Apply H(i) to A(i:m,i+1:n) from the left */

				aii = a_ref (i__, i__);
				a_ref (i__, i__) = 1.;
				i__2 = *m - i__ + 1;
				i__3 = *n - i__;
				NUMlapack_dlarf ("LEFT", &i__2, &i__3, &a_ref (i__, i__), &c__1, &tau[i__], &a_ref (i__,
				                 i__ + 1), lda, &work[ (*n << 1) + 1]);
				a_ref (i__, i__) = aii;
			}

			/* Update partial column norms */

			i__2 = *n;
			for (j = i__ + 1; j <= i__2; ++j) {
				if (work[j] != 0.) {
					/* Computing 2nd power */
					d__2 = (d__1 = a_ref (i__, j), fabs (d__1)) / work[j];
					temp = 1. - d__2 * d__2;
					temp = MAX (temp, 0.);
					/* Computing 2nd power */
					d__1 = work[j] / work[*n + j];
					temp2 = temp * .05 * (d__1 * d__1) + 1.;
					if (temp2 == 1.) {
						if (*m - i__ > 0) {
							i__3 = *m - i__;
							work[j] = NUMblas_dnrm2 (&i__3, &a_ref (i__ + 1, j), &c__1);
							work[*n + j] = work[j];
						} else {
							work[j] = 0.;
							work[*n + j] = 0.;
						}
					} else {
						work[j] *= sqrt (temp);
					}
				}
				/* L30: */
			}

			/* L40: */
		}
	}
	return 0;
}								/* NUMlapack_dgeqpf */

int NUMlapack_dgeqr2 (integer *m, integer *n, double *a, integer *lda, double *tau, double *work, integer *info) {
	/* Table of constant values */
	static integer c__1 = 1;

	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2, i__3;

	/* Local variables */
	static integer i__, k;
	static double aii;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--tau;
	--work;

	/* Function Body */
	*info = 0;
	if (*m < 0) {
		*info = -1;
	} else if (*n < 0) {
		*info = -2;
	} else if (*lda < MAX (1, *m)) {
		*info = -4;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DGEQR2", &i__1);
		return 0;
	}

	k = MIN (*m, *n);

	i__1 = k;
	for (i__ = 1; i__ <= i__1; ++i__) {

		/* Generate elementary reflector H(i) to annihilate A(i+1:m,i)

		   Computing MIN */
		i__2 = i__ + 1;
		i__3 = *m - i__ + 1;
		NUMlapack_dlarfg (&i__3, &a_ref (i__, i__), &a_ref (MIN (i__2, *m), i__), &c__1, &tau[i__]);
		if (i__ < *n) {

			/* Apply H(i) to A(i:m,i+1:n) from the left */

			aii = a_ref (i__, i__);
			a_ref (i__, i__) = 1.;
			i__2 = *m - i__ + 1;
			i__3 = *n - i__;
			NUMlapack_dlarf ("Left", &i__2, &i__3, &a_ref (i__, i__), &c__1, &tau[i__], &a_ref (i__, i__ + 1),
			                 lda, &work[1]);
			a_ref (i__, i__) = aii;
		}
		/* L10: */
	}
	return 0;
}								/* NUMlapack_dgeqr2 */

int NUMlapack_dgeqrf (integer *m, integer *n, double *a, integer *lda, double *tau, double *work, integer *lwork,
                      integer *info) {
	/* Table of constant values */
	static integer c__1 = 1;
	static integer c_n1 = -1;
	static integer c__3 = 3;
	static integer c__2 = 2;

	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2, i__3, i__4;

	/* Local variables */
	static integer i__, k, nbmin, iinfo;
	static integer ib, nb;
	static integer nx;
	static integer ldwork, lwkopt;
	static integer lquery;
	static integer iws;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--tau;
	--work;

	/* Function Body */
	*info = 0;
	nb = NUMlapack_ilaenv (&c__1, "DGEQRF", " ", m, n, &c_n1, &c_n1, 6, 1);
	lwkopt = *n * nb;
	work[1] = (double) lwkopt;
	lquery = *lwork == -1;
	if (*m < 0) {
		*info = -1;
	} else if (*n < 0) {
		*info = -2;
	} else if (*lda < MAX (1, *m)) {
		*info = -4;
	} else if (*lwork < MAX (1, *n) && !lquery) {
		*info = -7;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DGEQRF", &i__1);
		return 0;
	} else if (lquery) {
		return 0;
	}

	/* Quick return if possible */

	k = MIN (*m, *n);
	if (k == 0) {
		work[1] = 1.;
		return 0;
	}

	nbmin = 2;
	nx = 0;
	iws = *n;
	if (nb > 1 && nb < k) {

		/* Determine when to cross over from blocked to unblocked code.

		   Computing MAX */
		i__1 = 0, i__2 = NUMlapack_ilaenv (&c__3, "DGEQRF", " ", m, n, &c_n1, &c_n1, 6, 1);
		nx = MAX (i__1, i__2);
		if (nx < k) {

			/* Determine if workspace is large enough for blocked code. */

			ldwork = *n;
			iws = ldwork * nb;
			if (*lwork < iws) {

				/* Not enough workspace to use optimal NB: reduce NB and
				   determine the minimum value of NB. */

				nb = *lwork / ldwork;
				/* Computing MAX */
				i__1 = 2, i__2 = NUMlapack_ilaenv (&c__2, "DGEQRF", " ", m, n, &c_n1, &c_n1, 6, 1);
				nbmin = MAX (i__1, i__2);
			}
		}
	}

	if (nb >= nbmin && nb < k && nx < k) {

		/* Use blocked code initially */

		i__1 = k - nx;
		i__2 = nb;
		for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
			/* Computing MIN */
			i__3 = k - i__ + 1;
			ib = MIN (i__3, nb);

			/* Compute the QR factorization of the current block
			   A(i:m,i:i+ib-1) */

			i__3 = *m - i__ + 1;
			NUMlapack_dgeqr2 (&i__3, &ib, &a_ref (i__, i__), lda, &tau[i__], &work[1], &iinfo);
			if (i__ + ib <= *n) {

				/* Form the triangular factor of the block reflector H = H(i)
				   H(i+1) . . . H(i+ib-1) */

				i__3 = *m - i__ + 1;
				NUMlapack_dlarft ("Forward", "Columnwise", &i__3, &ib, &a_ref (i__, i__), lda, &tau[i__],
				                  &work[1], &ldwork);

				/* Apply H' to A(i:m,i+ib:n) from the left */

				i__3 = *m - i__ + 1;
				i__4 = *n - i__ - ib + 1;
				NUMlapack_dlarfb ("Left", "Transpose", "Forward", "Columnwise", &i__3, &i__4, &ib, &a_ref (i__,
				                  i__), lda, &work[1], &ldwork, &a_ref (i__, i__ + ib), lda, &work[ib + 1], &ldwork);
			}
			/* L10: */
		}
	} else {
		i__ = 1;
	}

	/* Use unblocked code to factor the last or only block. */

	if (i__ <= k) {
		i__2 = *m - i__ + 1;
		i__1 = *n - i__ + 1;
		NUMlapack_dgeqr2 (&i__2, &i__1, &a_ref (i__, i__), lda, &tau[i__], &work[1], &iinfo);
	}

	work[1] = (double) iws;
	return 0;
}								/* NUMlapack_dgeqrf */

int NUMlapack_dgerq2 (integer *m, integer *n, double *a, integer *lda, double *tau, double *work, integer *info) {
	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2;

	/* Local variables */
	static integer i__, k;
	static double aii;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--tau;
	--work;

	/* Function Body */
	*info = 0;
	if (*m < 0) {
		*info = -1;
	} else if (*n < 0) {
		*info = -2;
	} else if (*lda < MAX (1, *m)) {
		*info = -4;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DGERQ2", &i__1);
		return 0;
	}

	k = MIN (*m, *n);

	for (i__ = k; i__ >= 1; --i__) {

		/* Generate elementary reflector H(i) to annihilate
		   A(m-k+i,1:n-k+i-1) */

		i__1 = *n - k + i__;
		NUMlapack_dlarfg (&i__1, &a_ref (*m - k + i__, *n - k + i__), &a_ref (*m - k + i__, 1), lda, &tau[i__]);

		/* Apply H(i) to A(1:m-k+i-1,1:n-k+i) from the right */

		aii = a_ref (*m - k + i__, *n - k + i__);
		a_ref (*m - k + i__, *n - k + i__) = 1.;
		i__1 = *m - k + i__ - 1;
		i__2 = *n - k + i__;
		NUMlapack_dlarf ("Right", &i__1, &i__2, &a_ref (*m - k + i__, 1), lda, &tau[i__], &a[a_offset], lda,
		                 &work[1]);
		a_ref (*m - k + i__, *n - k + i__) = aii;
		/* L10: */
	}
	return 0;
}								/* NUMlapack_dgerq2 */

int NUMlapack_dgesv (integer *n, integer *nrhs, double *a, integer *lda, integer *ipiv, double *b, integer *ldb, integer *info) {
	/* System generated locals */
	integer a_dim1, a_offset, b_dim1, b_offset, i__1;

	/* Local variables */

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--ipiv;
	b_dim1 = *ldb;
	b_offset = 1 + b_dim1 * 1;
	b -= b_offset;

	/* Function Body */
	*info = 0;
	if (*n < 0) {
		*info = -1;
	} else if (*nrhs < 0) {
		*info = -2;
	} else if (*lda < MAX (1, *n)) {
		*info = -4;
	} else if (*ldb < MAX (1, *n)) {
		*info = -7;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DGESV ", &i__1);
		return 0;
	}

	/* Compute the LU factorization of A. */

	NUMlapack_dgetrf (n, n, &a[a_offset], lda, &ipiv[1], info);
	if (*info == 0) {

		/* Solve the system A*X = B, overwriting B with X. */

		NUMlapack_dgetrs ("No transpose", n, nrhs, &a[a_offset], lda, &ipiv[1], &b[b_offset], ldb, info);
	}
	return 0;
}								/* NUMlapack_dgesv */

#define u_ref(a_1,a_2) u[(a_2)*u_dim1 + a_1]
#define vt_ref(a_1,a_2) vt[(a_2)*vt_dim1 + a_1]

int NUMlapack_dgesvd (const char *jobu, const char *jobvt, integer *m, integer *n, double *a, integer *lda, double *s, double *u,
                      integer *ldu, double *vt, integer *ldvt, double *work, integer *lwork, integer *info) {
	/* System generated locals */
	const char *a__1[2];
	integer a_dim1, a_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__1[2], i__2, i__3, i__4;
	char ch__1[2];

	/* Local variables */
	static integer iscl;
	static double anrm;
	static integer ierr, itau, ncvt, nrvt, i__;
	static integer chunk, minmn, wrkbl, itaup, itauq, mnthr, iwork;
	static integer wntua, wntva, wntun, wntuo, wntvn, wntvo, wntus, wntvs;
	static integer ie;
	static integer ir, bdspac, iu;
	static double bignum;
	static integer ldwrkr, minwrk, ldwrku, maxwrk;
	static double smlnum;
	static integer lquery, wntuas, wntvas;
	static integer blk, ncu;
	static double dum[1], eps;
	static integer nru;

	/* Parameter adjustments */
	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--s;
	u_dim1 = *ldu;
	u_offset = 1 + u_dim1 * 1;
	u -= u_offset;
	vt_dim1 = *ldvt;
	vt_offset = 1 + vt_dim1 * 1;
	vt -= vt_offset;
	--work;

	/* Function Body */
	*info = 0;
	minmn = MIN (*m, *n);
	/* Writing concatenation */
	i__1[0] = 1, a__1[0] = jobu;
	i__1[1] = 1, a__1[1] = jobvt;
	s_cat (ch__1, a__1, i__1, &c__2, 2);
	mnthr = NUMlapack_ilaenv (&c__6, "DGESVD", ch__1, m, n, &c__0, &c__0, 6, 2);
	wntua = lsame_ (jobu, "A");
	wntus = lsame_ (jobu, "S");
	wntuas = wntua || wntus;
	wntuo = lsame_ (jobu, "O");
	wntun = lsame_ (jobu, "N");
	wntva = lsame_ (jobvt, "A");
	wntvs = lsame_ (jobvt, "S");
	wntvas = wntva || wntvs;
	wntvo = lsame_ (jobvt, "O");
	wntvn = lsame_ (jobvt, "N");
	minwrk = 1;
	lquery = *lwork == -1;

	if (! (wntua || wntus || wntuo || wntun)) {
		*info = -1;
	} else if (! (wntva || wntvs || wntvo || wntvn) || wntvo && wntuo) {
		*info = -2;
	} else if (*m < 0) {
		*info = -3;
	} else if (*n < 0) {
		*info = -4;
	} else if (*lda < MAX (1, *m)) {
		*info = -6;
	} else if (*ldu < 1 || wntuas && *ldu < *m) {
		*info = -9;
	} else if (*ldvt < 1 || wntva && *ldvt < *n || wntvs && *ldvt < minmn) {
		*info = -11;
	}

	/* Compute workspace (Note: Comments in the code beginning "Workspace:"
	   describe the minimal amount of workspace needed at that point in the
	   code, as well as the preferred amount for good performance. NB refers
	   to the optimal block size for the immediately following subroutine, as
	   returned by ILAENV.) */

	if (*info == 0 && (*lwork >= 1 || lquery) && *m > 0 && *n > 0) {
		if (*m >= *n) {

			/* Compute space needed for DBDSQR */

			bdspac = *n * 5;
			if (*m >= mnthr) {
				if (wntun) {

					/* Path 1 (M much larger than N, JOBU='N') */

					maxwrk = *n + *n * NUMlapack_ilaenv (&c__1, "DGEQRF", " ", m, n, &c_n1, &c_n1, 6, 1);
					/* Computing MAX */
					i__2 = maxwrk, i__3 =
					           *n * 3 + (*n << 1) * NUMlapack_ilaenv (&c__1, "DGEBRD", " ", n, n, &c_n1, &c_n1, 6, 1);
					maxwrk = MAX (i__2, i__3);
					if (wntvo || wntvas) {
						/* Computing MAX */
						i__2 = maxwrk, i__3 =
						           *n * 3 + (*n - 1) * NUMlapack_ilaenv (&c__1, "DORGBR", "P", n, n, n, &c_n1, 6, 1);
						maxwrk = MAX (i__2, i__3);
					}
					maxwrk = MAX (maxwrk, bdspac);
					/* Computing MAX */
					i__2 = *n << 2;
					minwrk = MAX (i__2, bdspac);
					maxwrk = MAX (maxwrk, minwrk);
				} else if (wntuo && wntvn) {

					/* Path 2 (M much larger than N, JOBU='O', JOBVT='N') */

					wrkbl = *n + *n * NUMlapack_ilaenv (&c__1, "DGEQRF", " ", m, n, &c_n1, &c_n1, 6, 1);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *n + *n * NUMlapack_ilaenv (&c__1, "DORGQR", " ", m, n, n, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *n * 3 + (*n << 1) * NUMlapack_ilaenv (&c__1, "DGEBRD", " ", n, n, &c_n1, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *n * 3 + *n * NUMlapack_ilaenv (&c__1, "DORGBR", "Q", n, n, n, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					wrkbl = MAX (wrkbl, bdspac);
					/* Computing MAX */
					i__2 = *n * *n + wrkbl, i__3 = *n * *n + *m * *n + *n;
					maxwrk = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = *n * 3 + *m;
					minwrk = MAX (i__2, bdspac);
					maxwrk = MAX (maxwrk, minwrk);
				} else if (wntuo && wntvas) {

					/* Path 3 (M much larger than N, JOBU='O', JOBVT='S' or
					   'A') */

					wrkbl = *n + *n * NUMlapack_ilaenv (&c__1, "DGEQRF", " ", m, n, &c_n1, &c_n1, 6, 1);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *n + *n * NUMlapack_ilaenv (&c__1, "DORGQR", " ", m, n, n, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *n * 3 + (*n << 1) * NUMlapack_ilaenv (&c__1, "DGEBRD", " ", n, n, &c_n1, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *n * 3 + *n * NUMlapack_ilaenv (&c__1, "DORGBR", "Q", n, n, n, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *n * 3 + (*n - 1) * NUMlapack_ilaenv (&c__1, "DORGBR", "P", n, n, n, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					wrkbl = MAX (wrkbl, bdspac);
					/* Computing MAX */
					i__2 = *n * *n + wrkbl, i__3 = *n * *n + *m * *n + *n;
					maxwrk = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = *n * 3 + *m;
					minwrk = MAX (i__2, bdspac);
					maxwrk = MAX (maxwrk, minwrk);
				} else if (wntus && wntvn) {

					/* Path 4 (M much larger than N, JOBU='S', JOBVT='N') */

					wrkbl = *n + *n * NUMlapack_ilaenv (&c__1, "DGEQRF", " ", m, n, &c_n1, &c_n1, 6, 1);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *n + *n * NUMlapack_ilaenv (&c__1, "DORGQR", " ", m, n, n, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *n * 3 + (*n << 1) * NUMlapack_ilaenv (&c__1, "DGEBRD", " ", n, n, &c_n1, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *n * 3 + *n * NUMlapack_ilaenv (&c__1, "DORGBR", "Q", n, n, n, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					wrkbl = MAX (wrkbl, bdspac);
					maxwrk = *n * *n + wrkbl;
					/* Computing MAX */
					i__2 = *n * 3 + *m;
					minwrk = MAX (i__2, bdspac);
					maxwrk = MAX (maxwrk, minwrk);
				} else if (wntus && wntvo) {

					/* Path 5 (M much larger than N, JOBU='S', JOBVT='O') */

					wrkbl = *n + *n * NUMlapack_ilaenv (&c__1, "DGEQRF", " ", m, n, &c_n1, &c_n1, 6, 1);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *n + *n * NUMlapack_ilaenv (&c__1, "DORGQR", " ", m, n, n, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *n * 3 + (*n << 1) * NUMlapack_ilaenv (&c__1, "DGEBRD", " ", n, n, &c_n1, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *n * 3 + *n * NUMlapack_ilaenv (&c__1, "DORGBR", "Q", n, n, n, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *n * 3 + (*n - 1) * NUMlapack_ilaenv (&c__1, "DORGBR", "P", n, n, n, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					wrkbl = MAX (wrkbl, bdspac);
					maxwrk = (*n << 1) * *n + wrkbl;
					/* Computing MAX */
					i__2 = *n * 3 + *m;
					minwrk = MAX (i__2, bdspac);
					maxwrk = MAX (maxwrk, minwrk);
				} else if (wntus && wntvas) {

					/* Path 6 (M much larger than N, JOBU='S', JOBVT='S' or
					   'A') */

					wrkbl = *n + *n * NUMlapack_ilaenv (&c__1, "DGEQRF", " ", m, n, &c_n1, &c_n1, 6, 1);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *n + *n * NUMlapack_ilaenv (&c__1, "DORGQR", " ", m, n, n, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *n * 3 + (*n << 1) * NUMlapack_ilaenv (&c__1, "DGEBRD", " ", n, n, &c_n1, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *n * 3 + *n * NUMlapack_ilaenv (&c__1, "DORGBR", "Q", n, n, n, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *n * 3 + (*n - 1) * NUMlapack_ilaenv (&c__1, "DORGBR", "P", n, n, n, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					wrkbl = MAX (wrkbl, bdspac);
					maxwrk = *n * *n + wrkbl;
					/* Computing MAX */
					i__2 = *n * 3 + *m;
					minwrk = MAX (i__2, bdspac);
					maxwrk = MAX (maxwrk, minwrk);
				} else if (wntua && wntvn) {

					/* Path 7 (M much larger than N, JOBU='A', JOBVT='N') */

					wrkbl = *n + *n * NUMlapack_ilaenv (&c__1, "DGEQRF", " ", m, n, &c_n1, &c_n1, 6, 1);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *n + *m * NUMlapack_ilaenv (&c__1, "DORGQR", " ", m, m, n, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *n * 3 + (*n << 1) * NUMlapack_ilaenv (&c__1, "DGEBRD", " ", n, n, &c_n1, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *n * 3 + *n * NUMlapack_ilaenv (&c__1, "DORGBR", "Q", n, n, n, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					wrkbl = MAX (wrkbl, bdspac);
					maxwrk = *n * *n + wrkbl;
					/* Computing MAX */
					i__2 = *n * 3 + *m;
					minwrk = MAX (i__2, bdspac);
					maxwrk = MAX (maxwrk, minwrk);
				} else if (wntua && wntvo) {

					/* Path 8 (M much larger than N, JOBU='A', JOBVT='O') */

					wrkbl = *n + *n * NUMlapack_ilaenv (&c__1, "DGEQRF", " ", m, n, &c_n1, &c_n1, 6, 1);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *n + *m * NUMlapack_ilaenv (&c__1, "DORGQR", " ", m, m, n, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *n * 3 + (*n << 1) * NUMlapack_ilaenv (&c__1, "DGEBRD", " ", n, n, &c_n1, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *n * 3 + *n * NUMlapack_ilaenv (&c__1, "DORGBR", "Q", n, n, n, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *n * 3 + (*n - 1) * NUMlapack_ilaenv (&c__1, "DORGBR", "P", n, n, n, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					wrkbl = MAX (wrkbl, bdspac);
					maxwrk = (*n << 1) * *n + wrkbl;
					/* Computing MAX */
					i__2 = *n * 3 + *m;
					minwrk = MAX (i__2, bdspac);
					maxwrk = MAX (maxwrk, minwrk);
				} else if (wntua && wntvas) {

					/* Path 9 (M much larger than N, JOBU='A', JOBVT='S' or
					   'A') */

					wrkbl = *n + *n * NUMlapack_ilaenv (&c__1, "DGEQRF", " ", m, n, &c_n1, &c_n1, 6, 1);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *n + *m * NUMlapack_ilaenv (&c__1, "DORGQR", " ", m, m, n, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *n * 3 + (*n << 1) * NUMlapack_ilaenv (&c__1, "DGEBRD", " ", n, n, &c_n1, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *n * 3 + *n * NUMlapack_ilaenv (&c__1, "DORGBR", "Q", n, n, n, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *n * 3 + (*n - 1) * NUMlapack_ilaenv (&c__1, "DORGBR", "P", n, n, n, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					wrkbl = MAX (wrkbl, bdspac);
					maxwrk = *n * *n + wrkbl;
					/* Computing MAX */
					i__2 = *n * 3 + *m;
					minwrk = MAX (i__2, bdspac);
					maxwrk = MAX (maxwrk, minwrk);
				}
			} else {

				/* Path 10 (M at least N, but not much larger) */

				maxwrk = *n * 3 + (*m + *n) * NUMlapack_ilaenv (&c__1, "DGEBRD", " ", m, n, &c_n1, &c_n1, 6, 1);
				if (wntus || wntuo) {
					/* Computing MAX */
					i__2 = maxwrk, i__3 =
					           *n * 3 + *n * NUMlapack_ilaenv (&c__1, "DORG" "BR", "Q", m, n, n, &c_n1, 6, 1);
					maxwrk = MAX (i__2, i__3);
				}
				if (wntua) {
					/* Computing MAX */
					i__2 = maxwrk, i__3 =
					           *n * 3 + *m * NUMlapack_ilaenv (&c__1, "DORG" "BR", "Q", m, m, n, &c_n1, 6, 1);
					maxwrk = MAX (i__2, i__3);
				}
				if (!wntvn) {
					/* Computing MAX */
					i__2 = maxwrk, i__3 =
					           *n * 3 + (*n - 1) * NUMlapack_ilaenv (&c__1, "DORGBR", "P", n, n, n, &c_n1, 6, 1);
					maxwrk = MAX (i__2, i__3);
				}
				maxwrk = MAX (maxwrk, bdspac);
				/* Computing MAX */
				i__2 = *n * 3 + *m;
				minwrk = MAX (i__2, bdspac);
				maxwrk = MAX (maxwrk, minwrk);
			}
		} else {

			/* Compute space needed for DBDSQR */

			bdspac = *m * 5;
			if (*n >= mnthr) {
				if (wntvn) {

					/* Path 1t(N much larger than M, JOBVT='N') */

					maxwrk = *m + *m * NUMlapack_ilaenv (&c__1, "DGELQF", " ", m, n, &c_n1, &c_n1, 6, 1);
					/* Computing MAX */
					i__2 = maxwrk, i__3 =
					           *m * 3 + (*m << 1) * NUMlapack_ilaenv (&c__1, "DGEBRD", " ", m, m, &c_n1, &c_n1, 6, 1);
					maxwrk = MAX (i__2, i__3);
					if (wntuo || wntuas) {
						/* Computing MAX */
						i__2 = maxwrk, i__3 =
						           *m * 3 + *m * NUMlapack_ilaenv (&c__1, "DORGBR", "Q", m, m, m, &c_n1, 6, 1);
						maxwrk = MAX (i__2, i__3);
					}
					maxwrk = MAX (maxwrk, bdspac);
					/* Computing MAX */
					i__2 = *m << 2;
					minwrk = MAX (i__2, bdspac);
					maxwrk = MAX (maxwrk, minwrk);
				} else if (wntvo && wntun) {

					/* Path 2t(N much larger than M, JOBU='N', JOBVT='O') */

					wrkbl = *m + *m * NUMlapack_ilaenv (&c__1, "DGELQF", " ", m, n, &c_n1, &c_n1, 6, 1);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *m + *m * NUMlapack_ilaenv (&c__1, "DORGLQ", " ", m, n, m, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *m * 3 + (*m << 1) * NUMlapack_ilaenv (&c__1, "DGEBRD", " ", m, m, &c_n1, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *m * 3 + (*m - 1) * NUMlapack_ilaenv (&c__1, "DORGBR", "P", m, m, m, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					wrkbl = MAX (wrkbl, bdspac);
					/* Computing MAX */
					i__2 = *m * *m + wrkbl, i__3 = *m * *m + *m * *n + *m;
					maxwrk = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = *m * 3 + *n;
					minwrk = MAX (i__2, bdspac);
					maxwrk = MAX (maxwrk, minwrk);
				} else if (wntvo && wntuas) {

					/* Path 3t(N much larger than M, JOBU='S' or 'A',
					   JOBVT='O') */

					wrkbl = *m + *m * NUMlapack_ilaenv (&c__1, "DGELQF", " ", m, n, &c_n1, &c_n1, 6, 1);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *m + *m * NUMlapack_ilaenv (&c__1, "DORGLQ", " ", m, n, m, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *m * 3 + (*m << 1) * NUMlapack_ilaenv (&c__1, "DGEBRD", " ", m, m, &c_n1, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *m * 3 + (*m - 1) * NUMlapack_ilaenv (&c__1, "DORGBR", "P", m, m, m, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *m * 3 + *m * NUMlapack_ilaenv (&c__1, "DORGBR", "Q", m, m, m, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					wrkbl = MAX (wrkbl, bdspac);
					/* Computing MAX */
					i__2 = *m * *m + wrkbl, i__3 = *m * *m + *m * *n + *m;
					maxwrk = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = *m * 3 + *n;
					minwrk = MAX (i__2, bdspac);
					maxwrk = MAX (maxwrk, minwrk);
				} else if (wntvs && wntun) {

					/* Path 4t(N much larger than M, JOBU='N', JOBVT='S') */

					wrkbl = *m + *m * NUMlapack_ilaenv (&c__1, "DGELQF", " ", m, n, &c_n1, &c_n1, 6, 1);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *m + *m * NUMlapack_ilaenv (&c__1, "DORGLQ", " ", m, n, m, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *m * 3 + (*m << 1) * NUMlapack_ilaenv (&c__1, "DGEBRD", " ", m, m, &c_n1, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *m * 3 + (*m - 1) * NUMlapack_ilaenv (&c__1, "DORGBR", "P", m, m, m, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					wrkbl = MAX (wrkbl, bdspac);
					maxwrk = *m * *m + wrkbl;
					/* Computing MAX */
					i__2 = *m * 3 + *n;
					minwrk = MAX (i__2, bdspac);
					maxwrk = MAX (maxwrk, minwrk);
				} else if (wntvs && wntuo) {

					/* Path 5t(N much larger than M, JOBU='O', JOBVT='S') */

					wrkbl = *m + *m * NUMlapack_ilaenv (&c__1, "DGELQF", " ", m, n, &c_n1, &c_n1, 6, 1);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *m + *m * NUMlapack_ilaenv (&c__1, "DORGLQ", " ", m, n, m, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *m * 3 + (*m << 1) * NUMlapack_ilaenv (&c__1, "DGEBRD", " ", m, m, &c_n1, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *m * 3 + (*m - 1) * NUMlapack_ilaenv (&c__1, "DORGBR", "P", m, m, m, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *m * 3 + *m * NUMlapack_ilaenv (&c__1, "DORGBR", "Q", m, m, m, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					wrkbl = MAX (wrkbl, bdspac);
					maxwrk = (*m << 1) * *m + wrkbl;
					/* Computing MAX */
					i__2 = *m * 3 + *n;
					minwrk = MAX (i__2, bdspac);
					maxwrk = MAX (maxwrk, minwrk);
				} else if (wntvs && wntuas) {

					/* Path 6t(N much larger than M, JOBU='S' or 'A',
					   JOBVT='S') */

					wrkbl = *m + *m * NUMlapack_ilaenv (&c__1, "DGELQF", " ", m, n, &c_n1, &c_n1, 6, 1);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *m + *m * NUMlapack_ilaenv (&c__1, "DORGLQ", " ", m, n, m, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *m * 3 + (*m << 1) * NUMlapack_ilaenv (&c__1, "DGEBRD", " ", m, m, &c_n1, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *m * 3 + (*m - 1) * NUMlapack_ilaenv (&c__1, "DORGBR", "P", m, m, m, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *m * 3 + *m * NUMlapack_ilaenv (&c__1, "DORGBR", "Q", m, m, m, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					wrkbl = MAX (wrkbl, bdspac);
					maxwrk = *m * *m + wrkbl;
					/* Computing MAX */
					i__2 = *m * 3 + *n;
					minwrk = MAX (i__2, bdspac);
					maxwrk = MAX (maxwrk, minwrk);
				} else if (wntva && wntun) {

					/* Path 7t(N much larger than M, JOBU='N', JOBVT='A') */

					wrkbl = *m + *m * NUMlapack_ilaenv (&c__1, "DGELQF", " ", m, n, &c_n1, &c_n1, 6, 1);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *m + *n * NUMlapack_ilaenv (&c__1, "DORGLQ", " ", n, n, m, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *m * 3 + (*m << 1) * NUMlapack_ilaenv (&c__1, "DGEBRD", " ", m, m, &c_n1, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *m * 3 + (*m - 1) * NUMlapack_ilaenv (&c__1, "DORGBR", "P", m, m, m, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					wrkbl = MAX (wrkbl, bdspac);
					maxwrk = *m * *m + wrkbl;
					/* Computing MAX */
					i__2 = *m * 3 + *n;
					minwrk = MAX (i__2, bdspac);
					maxwrk = MAX (maxwrk, minwrk);
				} else if (wntva && wntuo) {

					/* Path 8t(N much larger than M, JOBU='O', JOBVT='A') */

					wrkbl = *m + *m * NUMlapack_ilaenv (&c__1, "DGELQF", " ", m, n, &c_n1, &c_n1, 6, 1);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *m + *n * NUMlapack_ilaenv (&c__1, "DORGLQ", " ", n, n, m, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *m * 3 + (*m << 1) * NUMlapack_ilaenv (&c__1, "DGEBRD", " ", m, m, &c_n1, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *m * 3 + (*m - 1) * NUMlapack_ilaenv (&c__1, "DORGBR", "P", m, m, m, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *m * 3 + *m * NUMlapack_ilaenv (&c__1, "DORGBR", "Q", m, m, m, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					wrkbl = MAX (wrkbl, bdspac);
					maxwrk = (*m << 1) * *m + wrkbl;
					/* Computing MAX */
					i__2 = *m * 3 + *n;
					minwrk = MAX (i__2, bdspac);
					maxwrk = MAX (maxwrk, minwrk);
				} else if (wntva && wntuas) {

					/* Path 9t(N much larger than M, JOBU='S' or 'A',
					   JOBVT='A') */

					wrkbl = *m + *m * NUMlapack_ilaenv (&c__1, "DGELQF", " ", m, n, &c_n1, &c_n1, 6, 1);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *m + *n * NUMlapack_ilaenv (&c__1, "DORGLQ", " ", n, n, m, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *m * 3 + (*m << 1) * NUMlapack_ilaenv (&c__1, "DGEBRD", " ", m, m, &c_n1, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *m * 3 + (*m - 1) * NUMlapack_ilaenv (&c__1, "DORGBR", "P", m, m, m, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					/* Computing MAX */
					i__2 = wrkbl, i__3 =
					           *m * 3 + *m * NUMlapack_ilaenv (&c__1, "DORGBR", "Q", m, m, m, &c_n1, 6, 1);
					wrkbl = MAX (i__2, i__3);
					wrkbl = MAX (wrkbl, bdspac);
					maxwrk = *m * *m + wrkbl;
					/* Computing MAX */
					i__2 = *m * 3 + *n;
					minwrk = MAX (i__2, bdspac);
					maxwrk = MAX (maxwrk, minwrk);
				}
			} else {

				/* Path 10t(N greater than M, but not much larger) */

				maxwrk = *m * 3 + (*m + *n) * NUMlapack_ilaenv (&c__1, "DGEBRD", " ", m, n, &c_n1, &c_n1, 6, 1);
				if (wntvs || wntvo) {
					/* Computing MAX */
					i__2 = maxwrk, i__3 =
					           *m * 3 + *m * NUMlapack_ilaenv (&c__1, "DORG" "BR", "P", m, n, m, &c_n1, 6, 1);
					maxwrk = MAX (i__2, i__3);
				}
				if (wntva) {
					/* Computing MAX */
					i__2 = maxwrk, i__3 =
					           *m * 3 + *n * NUMlapack_ilaenv (&c__1, "DORG" "BR", "P", n, n, m, &c_n1, 6, 1);
					maxwrk = MAX (i__2, i__3);
				}
				if (!wntun) {
					/* Computing MAX */
					i__2 = maxwrk, i__3 =
					           *m * 3 + (*m - 1) * NUMlapack_ilaenv (&c__1, "DORGBR", "Q", m, m, m, &c_n1, 6, 1);
					maxwrk = MAX (i__2, i__3);
				}
				maxwrk = MAX (maxwrk, bdspac);
				/* Computing MAX */
				i__2 = *m * 3 + *n;
				minwrk = MAX (i__2, bdspac);
				maxwrk = MAX (maxwrk, minwrk);
			}
		}
		work[1] = (double) maxwrk;
	}

	if (*lwork < minwrk && !lquery) {
		*info = -13;
	}
	if (*info != 0) {
		i__2 = - (*info);
		xerbla_ ("DGESVD", &i__2);
		return 0;
	} else if (lquery) {
		return 0;
	}

	/* Quick return if possible */

	if (*m == 0 || *n == 0) {
		if (*lwork >= 1) {
			work[1] = 1.;
		}
		return 0;
	}

	/* Get machine constants */

	eps = NUMblas_dlamch ("P");
	smlnum = sqrt (NUMblas_dlamch ("S")) / eps;
	bignum = 1. / smlnum;

	/* Scale A if max element outside range [SMLNUM,BIGNUM] */

	anrm = NUMlapack_dlange ("M", m, n, &a[a_offset], lda, dum);
	iscl = 0;
	if (anrm > 0. && anrm < smlnum) {
		iscl = 1;
		NUMlapack_dlascl ("G", &c__0, &c__0, &anrm, &smlnum, m, n, &a[a_offset], lda, &ierr);
	} else if (anrm > bignum) {
		iscl = 1;
		NUMlapack_dlascl ("G", &c__0, &c__0, &anrm, &bignum, m, n, &a[a_offset], lda, &ierr);
	}

	if (*m >= *n) {

		/* A has at least as many rows as columns. If A has sufficiently more
		   rows than columns, first reduce using the QR decomposition (if
		   sufficient workspace available) */

		if (*m >= mnthr) {

			if (wntun) {

				/* Path 1 (M much larger than N, JOBU='N') No left singular
				   vectors to be computed */

				itau = 1;
				iwork = itau + *n;

				/* Compute A=Q*R (Workspace: need 2*N, prefer N+N*NB) */

				i__2 = *lwork - iwork + 1;
				NUMlapack_dgeqrf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);

				/* Zero out below R */

				i__2 = *n - 1;
				i__3 = *n - 1;
				NUMlapack_dlaset ("L", &i__2, &i__3, &c_b416, &c_b416, &a_ref (2, 1), lda);
				ie = 1;
				itauq = ie + *n;
				itaup = itauq + *n;
				iwork = itaup + *n;

				/* Bidiagonalize R in A (Workspace: need 4*N, prefer
				   3*N+2*N*NB) */

				i__2 = *lwork - iwork + 1;
				NUMlapack_dgebrd (n, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &work[itaup],
				                  &work[iwork], &i__2, &ierr);
				ncvt = 0;
				if (wntvo || wntvas) {

					/* If right singular vectors desired, generate P'.
					   (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) */

					i__2 = *lwork - iwork + 1;
					NUMlapack_dorgbr ("P", n, n, n, &a[a_offset], lda, &work[itaup], &work[iwork], &i__2,
					                  &ierr);
					ncvt = *n;
				}
				iwork = ie + *n;

				/* Perform bidiagonal QR iteration, computing right singular
				   vectors of A in A if desired (Workspace: need BDSPAC) */

				NUMlapack_dbdsqr ("U", n, &ncvt, &c__0, &c__0, &s[1], &work[ie], &a[a_offset], lda, dum, &c__1,
				                  dum, &c__1, &work[iwork], info);

				/* If right singular vectors desired in VT, copy them there */

				if (wntvas) {
					NUMlapack_dlacpy ("F", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
				}

			} else if (wntuo && wntvn) {

				/* Path 2 (M much larger than N, JOBU='O', JOBVT='N') N left
				   singular vectors to be overwritten on A and no right
				   singular vectors to be computed

				   Computing MAX */
				i__2 = *n << 2;
				if (*lwork >= *n * *n + MAX (i__2, bdspac)) {

					/* Sufficient workspace for a fast algorithm */

					ir = 1;
					/* Computing MAX */
					i__2 = wrkbl, i__3 = *lda * *n + *n;
					if (*lwork >= MAX (i__2, i__3) + *lda * *n) {

						/* WORK(IU) is LDA by N, WORK(IR) is LDA by N */

						ldwrku = *lda;
						ldwrkr = *lda;
					} else {	/* if(complicated condition) */
						/* Computing MAX */
						i__2 = wrkbl, i__3 = *lda * *n + *n;
						if (*lwork >= MAX (i__2, i__3) + *n * *n) {

							/* WORK(IU) is LDA by N, WORK(IR) is N by N */

							ldwrku = *lda;
							ldwrkr = *n;
						} else {

							/* WORK(IU) is LDWRKU by N, WORK(IR) is N by N */

							ldwrku = (*lwork - *n * *n - *n) / *n;
							ldwrkr = *n;
						}
					}
					itau = ir + ldwrkr * *n;
					iwork = itau + *n;

					/* Compute A=Q*R (Workspace: need N*N+2*N, prefer
					   N*N+N+N*NB) */

					i__2 = *lwork - iwork + 1;
					NUMlapack_dgeqrf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);

					/* Copy R to WORK(IR) and zero out below it */

					NUMlapack_dlacpy ("U", n, n, &a[a_offset], lda, &work[ir], &ldwrkr);
					i__2 = *n - 1;
					i__3 = *n - 1;
					NUMlapack_dlaset ("L", &i__2, &i__3, &c_b416, &c_b416, &work[ir + 1], &ldwrkr);

					/* Generate Q in A (Workspace: need N*N+2*N, prefer
					   N*N+N+N*NB) */

					i__2 = *lwork - iwork + 1;
					NUMlapack_dorgqr (m, n, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);
					ie = itau;
					itauq = ie + *n;
					itaup = itauq + *n;
					iwork = itaup + *n;

					/* Bidiagonalize R in WORK(IR) (Workspace: need N*N+4*N,
					   prefer N*N+3*N+2*N*NB) */

					i__2 = *lwork - iwork + 1;
					NUMlapack_dgebrd (n, n, &work[ir], &ldwrkr, &s[1], &work[ie], &work[itauq], &work[itaup],
					                  &work[iwork], &i__2, &ierr);

					/* Generate left vectors bidiagonalizing R (Workspace:
					   need N*N+4*N, prefer N*N+3*N+N*NB) */

					i__2 = *lwork - iwork + 1;
					NUMlapack_dorgbr ("Q", n, n, n, &work[ir], &ldwrkr, &work[itauq], &work[iwork], &i__2,
					                  &ierr);
					iwork = ie + *n;

					/* Perform bidiagonal QR iteration, computing left
					   singular vectors of R in WORK(IR) (Workspace: need
					   N*N+BDSPAC) */

					NUMlapack_dbdsqr ("U", n, &c__0, n, &c__0, &s[1], &work[ie], dum, &c__1, &work[ir], &ldwrkr,
					                  dum, &c__1, &work[iwork], info);
					iu = ie + *n;

					/* Multiply Q in A by left singular vectors of R in
					   WORK(IR), storing result in WORK(IU) and copying to A
					   (Workspace: need N*N+2*N, prefer N*N+M*N+N) */

					i__2 = *m;
					i__3 = ldwrku;
					for (i__ = 1; i__3 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__3) {
						/* Computing MIN */
						i__4 = *m - i__ + 1;
						chunk = MIN (i__4, ldwrku);
						NUMblas_dgemm ("N", "N", &chunk, n, n, &c_b438, &a_ref (i__, 1), lda, &work[ir], &ldwrkr,
						               &c_b416, &work[iu], &ldwrku);
						NUMlapack_dlacpy ("F", &chunk, n, &work[iu], &ldwrku, &a_ref (i__, 1), lda);
						/* L10: */
					}

				} else {

					/* Insufficient workspace for a fast algorithm */

					ie = 1;
					itauq = ie + *n;
					itaup = itauq + *n;
					iwork = itaup + *n;

					/* Bidiagonalize A (Workspace: need 3*N+M, prefer
					   3*N+(M+N)*NB) */

					i__3 = *lwork - iwork + 1;
					NUMlapack_dgebrd (m, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &work[itaup],
					                  &work[iwork], &i__3, &ierr);

					/* Generate left vectors bidiagonalizing A (Workspace:
					   need 4*N, prefer 3*N+N*NB) */

					i__3 = *lwork - iwork + 1;
					NUMlapack_dorgbr ("Q", m, n, n, &a[a_offset], lda, &work[itauq], &work[iwork], &i__3,
					                  &ierr);
					iwork = ie + *n;

					/* Perform bidiagonal QR iteration, computing left
					   singular vectors of A in A (Workspace: need BDSPAC) */

					NUMlapack_dbdsqr ("U", n, &c__0, m, &c__0, &s[1], &work[ie], dum, &c__1, &a[a_offset], lda,
					                  dum, &c__1, &work[iwork], info);

				}

			} else if (wntuo && wntvas) {

				/* Path 3 (M much larger than N, JOBU='O', JOBVT='S' or 'A')
				   N left singular vectors to be overwritten on A and N right
				   singular vectors to be computed in VT

				   Computing MAX */
				i__3 = *n << 2;
				if (*lwork >= *n * *n + MAX (i__3, bdspac)) {

					/* Sufficient workspace for a fast algorithm */

					ir = 1;
					/* Computing MAX */
					i__3 = wrkbl, i__2 = *lda * *n + *n;
					if (*lwork >= MAX (i__3, i__2) + *lda * *n) {

						/* WORK(IU) is LDA by N and WORK(IR) is LDA by N */

						ldwrku = *lda;
						ldwrkr = *lda;
					} else {	/* if(complicated condition) */
						/* Computing MAX */
						i__3 = wrkbl, i__2 = *lda * *n + *n;
						if (*lwork >= MAX (i__3, i__2) + *n * *n) {

							/* WORK(IU) is LDA by N and WORK(IR) is N by N */

							ldwrku = *lda;
							ldwrkr = *n;
						} else {

							/* WORK(IU) is LDWRKU by N and WORK(IR) is N by N
							 */

							ldwrku = (*lwork - *n * *n - *n) / *n;
							ldwrkr = *n;
						}
					}
					itau = ir + ldwrkr * *n;
					iwork = itau + *n;

					/* Compute A=Q*R (Workspace: need N*N+2*N, prefer
					   N*N+N+N*NB) */

					i__3 = *lwork - iwork + 1;
					NUMlapack_dgeqrf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__3, &ierr);

					/* Copy R to VT, zeroing out below it */

					NUMlapack_dlacpy ("U", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
					i__3 = *n - 1;
					i__2 = *n - 1;
					NUMlapack_dlaset ("L", &i__3, &i__2, &c_b416, &c_b416, &vt_ref (2, 1), ldvt);

					/* Generate Q in A (Workspace: need N*N+2*N, prefer
					   N*N+N+N*NB) */

					i__3 = *lwork - iwork + 1;
					NUMlapack_dorgqr (m, n, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__3, &ierr);
					ie = itau;
					itauq = ie + *n;
					itaup = itauq + *n;
					iwork = itaup + *n;

					/* Bidiagonalize R in VT, copying result to WORK(IR)
					   (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) */

					i__3 = *lwork - iwork + 1;
					NUMlapack_dgebrd (n, n, &vt[vt_offset], ldvt, &s[1], &work[ie], &work[itauq], &work[itaup],
					                  &work[iwork], &i__3, &ierr);
					NUMlapack_dlacpy ("L", n, n, &vt[vt_offset], ldvt, &work[ir], &ldwrkr);

					/* Generate left vectors bidiagonalizing R in WORK(IR)
					   (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB) */

					i__3 = *lwork - iwork + 1;
					NUMlapack_dorgbr ("Q", n, n, n, &work[ir], &ldwrkr, &work[itauq], &work[iwork], &i__3,
					                  &ierr);

					/* Generate right vectors bidiagonalizing R in VT
					   (Workspace: need N*N+4*N-1, prefer N*N+3*N+(N-1)*NB) */

					i__3 = *lwork - iwork + 1;
					NUMlapack_dorgbr ("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup], &work[iwork], &i__3,
					                  &ierr);
					iwork = ie + *n;

					/* Perform bidiagonal QR iteration, computing left
					   singular vectors of R in WORK(IR) and computing right
					   singular vectors of R in VT (Workspace: need
					   N*N+BDSPAC) */

					NUMlapack_dbdsqr ("U", n, n, n, &c__0, &s[1], &work[ie], &vt[vt_offset], ldvt, &work[ir],
					                  &ldwrkr, dum, &c__1, &work[iwork], info);
					iu = ie + *n;

					/* Multiply Q in A by left singular vectors of R in
					   WORK(IR), storing result in WORK(IU) and copying to A
					   (Workspace: need N*N+2*N, prefer N*N+M*N+N) */

					i__3 = *m;
					i__2 = ldwrku;
					for (i__ = 1; i__2 < 0 ? i__ >= i__3 : i__ <= i__3; i__ += i__2) {
						/* Computing MIN */
						i__4 = *m - i__ + 1;
						chunk = MIN (i__4, ldwrku);
						NUMblas_dgemm ("N", "N", &chunk, n, n, &c_b438, &a_ref (i__, 1), lda, &work[ir], &ldwrkr,
						               &c_b416, &work[iu], &ldwrku);
						NUMlapack_dlacpy ("F", &chunk, n, &work[iu], &ldwrku, &a_ref (i__, 1), lda);
						/* L20: */
					}

				} else {

					/* Insufficient workspace for a fast algorithm */

					itau = 1;
					iwork = itau + *n;

					/* Compute A=Q*R (Workspace: need 2*N, prefer N+N*NB) */

					i__2 = *lwork - iwork + 1;
					NUMlapack_dgeqrf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);

					/* Copy R to VT, zeroing out below it */

					NUMlapack_dlacpy ("U", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
					i__2 = *n - 1;
					i__3 = *n - 1;
					NUMlapack_dlaset ("L", &i__2, &i__3, &c_b416, &c_b416, &vt_ref (2, 1), ldvt);

					/* Generate Q in A (Workspace: need 2*N, prefer N+N*NB) */

					i__2 = *lwork - iwork + 1;
					NUMlapack_dorgqr (m, n, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);
					ie = itau;
					itauq = ie + *n;
					itaup = itauq + *n;
					iwork = itaup + *n;

					/* Bidiagonalize R in VT (Workspace: need 4*N, prefer
					   3*N+2*N*NB) */

					i__2 = *lwork - iwork + 1;
					NUMlapack_dgebrd (n, n, &vt[vt_offset], ldvt, &s[1], &work[ie], &work[itauq], &work[itaup],
					                  &work[iwork], &i__2, &ierr);

					/* Multiply Q in A by left vectors bidiagonalizing R
					   (Workspace: need 3*N+M, prefer 3*N+M*NB) */

					i__2 = *lwork - iwork + 1;
					NUMlapack_dormbr ("Q", "R", "N", m, n, n, &vt[vt_offset], ldvt, &work[itauq], &a[a_offset],
					                  lda, &work[iwork], &i__2, &ierr);

					/* Generate right vectors bidiagonalizing R in VT
					   (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) */

					i__2 = *lwork - iwork + 1;
					NUMlapack_dorgbr ("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup], &work[iwork], &i__2,
					                  &ierr);
					iwork = ie + *n;

					/* Perform bidiagonal QR iteration, computing left
					   singular vectors of A in A and computing right
					   singular vectors of A in VT (Workspace: need BDSPAC) */

					NUMlapack_dbdsqr ("U", n, n, m, &c__0, &s[1], &work[ie], &vt[vt_offset], ldvt, &a[a_offset],
					                  lda, dum, &c__1, &work[iwork], info);

				}

			} else if (wntus) {

				if (wntvn) {

					/* Path 4 (M much larger than N, JOBU='S', JOBVT='N') N
					   left singular vectors to be computed in U and no right
					   singular vectors to be computed

					   Computing MAX */
					i__2 = *n << 2;
					if (*lwork >= *n * *n + MAX (i__2, bdspac)) {

						/* Sufficient workspace for a fast algorithm */

						ir = 1;
						if (*lwork >= wrkbl + *lda * *n) {

							/* WORK(IR) is LDA by N */

							ldwrkr = *lda;
						} else {

							/* WORK(IR) is N by N */

							ldwrkr = *n;
						}
						itau = ir + ldwrkr * *n;
						iwork = itau + *n;

						/* Compute A=Q*R (Workspace: need N*N+2*N, prefer
						   N*N+N+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgeqrf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);

						/* Copy R to WORK(IR), zeroing out below it */

						NUMlapack_dlacpy ("U", n, n, &a[a_offset], lda, &work[ir], &ldwrkr);
						i__2 = *n - 1;
						i__3 = *n - 1;
						NUMlapack_dlaset ("L", &i__2, &i__3, &c_b416, &c_b416, &work[ir + 1], &ldwrkr);

						/* Generate Q in A (Workspace: need N*N+2*N, prefer
						   N*N+N+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgqr (m, n, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);
						ie = itau;
						itauq = ie + *n;
						itaup = itauq + *n;
						iwork = itaup + *n;

						/* Bidiagonalize R in WORK(IR) (Workspace: need
						   N*N+4*N, prefer N*N+3*N+2*N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgebrd (n, n, &work[ir], &ldwrkr, &s[1], &work[ie], &work[itauq],
						                  &work[itaup], &work[iwork], &i__2, &ierr);

						/* Generate left vectors bidiagonalizing R in
						   WORK(IR) (Workspace: need N*N+4*N, prefer
						   N*N+3*N+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgbr ("Q", n, n, n, &work[ir], &ldwrkr, &work[itauq], &work[iwork], &i__2,
						                  &ierr);
						iwork = ie + *n;

						/* Perform bidiagonal QR iteration, computing left
						   singular vectors of R in WORK(IR) (Workspace: need
						   N*N+BDSPAC) */

						NUMlapack_dbdsqr ("U", n, &c__0, n, &c__0, &s[1], &work[ie], dum, &c__1, &work[ir],
						                  &ldwrkr, dum, &c__1, &work[iwork], info);

						/* Multiply Q in A by left singular vectors of R in
						   WORK(IR), storing result in U (Workspace: need
						   N*N) */

						NUMblas_dgemm ("N", "N", m, n, n, &c_b438, &a[a_offset], lda, &work[ir], &ldwrkr, &c_b416,
						               &u[u_offset], ldu);

					} else {

						/* Insufficient workspace for a fast algorithm */

						itau = 1;
						iwork = itau + *n;

						/* Compute A=Q*R, copying result to U (Workspace:
						   need 2*N, prefer N+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgeqrf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);
						NUMlapack_dlacpy ("L", m, n, &a[a_offset], lda, &u[u_offset], ldu);

						/* Generate Q in U (Workspace: need 2*N, prefer
						   N+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgqr (m, n, n, &u[u_offset], ldu, &work[itau], &work[iwork], &i__2, &ierr);
						ie = itau;
						itauq = ie + *n;
						itaup = itauq + *n;
						iwork = itaup + *n;

						/* Zero out below R in A */

						i__2 = *n - 1;
						i__3 = *n - 1;
						NUMlapack_dlaset ("L", &i__2, &i__3, &c_b416, &c_b416, &a_ref (2, 1), lda);

						/* Bidiagonalize R in A (Workspace: need 4*N, prefer
						   3*N+2*N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgebrd (n, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &work[itaup],
						                  &work[iwork], &i__2, &ierr);

						/* Multiply Q in U by left vectors bidiagonalizing R
						   (Workspace: need 3*N+M, prefer 3*N+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dormbr ("Q", "R", "N", m, n, n, &a[a_offset], lda, &work[itauq], &u[u_offset],
						                  ldu, &work[iwork], &i__2, &ierr);
						iwork = ie + *n;

						/* Perform bidiagonal QR iteration, computing left
						   singular vectors of A in U (Workspace: need
						   BDSPAC) */

						NUMlapack_dbdsqr ("U", n, &c__0, m, &c__0, &s[1], &work[ie], dum, &c__1, &u[u_offset],
						                  ldu, dum, &c__1, &work[iwork], info);

					}

				} else if (wntvo) {

					/* Path 5 (M much larger than N, JOBU='S', JOBVT='O') N
					   left singular vectors to be computed in U and N right
					   singular vectors to be overwritten on A

					   Computing MAX */
					i__2 = *n << 2;
					if (*lwork >= (*n << 1) * *n + MAX (i__2, bdspac)) {

						/* Sufficient workspace for a fast algorithm */

						iu = 1;
						if (*lwork >= wrkbl + (*lda << 1) * *n) {

							/* WORK(IU) is LDA by N and WORK(IR) is LDA by N */

							ldwrku = *lda;
							ir = iu + ldwrku * *n;
							ldwrkr = *lda;
						} else if (*lwork >= wrkbl + (*lda + *n) * *n) {

							/* WORK(IU) is LDA by N and WORK(IR) is N by N */

							ldwrku = *lda;
							ir = iu + ldwrku * *n;
							ldwrkr = *n;
						} else {

							/* WORK(IU) is N by N and WORK(IR) is N by N */

							ldwrku = *n;
							ir = iu + ldwrku * *n;
							ldwrkr = *n;
						}
						itau = ir + ldwrkr * *n;
						iwork = itau + *n;

						/* Compute A=Q*R (Workspace: need 2*N*N+2*N, prefer
						   2*N*N+N+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgeqrf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);

						/* Copy R to WORK(IU), zeroing out below it */

						NUMlapack_dlacpy ("U", n, n, &a[a_offset], lda, &work[iu], &ldwrku);
						i__2 = *n - 1;
						i__3 = *n - 1;
						NUMlapack_dlaset ("L", &i__2, &i__3, &c_b416, &c_b416, &work[iu + 1], &ldwrku);

						/* Generate Q in A (Workspace: need 2*N*N+2*N, prefer
						   2*N*N+N+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgqr (m, n, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);
						ie = itau;
						itauq = ie + *n;
						itaup = itauq + *n;
						iwork = itaup + *n;

						/* Bidiagonalize R in WORK(IU), copying result to
						   WORK(IR) (Workspace: need 2*N*N+4*N, prefer
						   2*N*N+3*N+2*N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgebrd (n, n, &work[iu], &ldwrku, &s[1], &work[ie], &work[itauq],
						                  &work[itaup], &work[iwork], &i__2, &ierr);
						NUMlapack_dlacpy ("U", n, n, &work[iu], &ldwrku, &work[ir], &ldwrkr);

						/* Generate left bidiagonalizing vectors in WORK(IU)
						   (Workspace: need 2*N*N+4*N, prefer 2*N*N+3*N+N*NB)
						 */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgbr ("Q", n, n, n, &work[iu], &ldwrku, &work[itauq], &work[iwork], &i__2,
						                  &ierr);

						/* Generate right bidiagonalizing vectors in WORK(IR)
						   (Workspace: need 2*N*N+4*N-1, prefer
						   2*N*N+3*N+(N-1)*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgbr ("P", n, n, n, &work[ir], &ldwrkr, &work[itaup], &work[iwork], &i__2,
						                  &ierr);
						iwork = ie + *n;

						/* Perform bidiagonal QR iteration, computing left
						   singular vectors of R in WORK(IU) and computing
						   right singular vectors of R in WORK(IR)
						   (Workspace: need 2*N*N+BDSPAC) */

						NUMlapack_dbdsqr ("U", n, n, n, &c__0, &s[1], &work[ie], &work[ir], &ldwrkr, &work[iu],
						                  &ldwrku, dum, &c__1, &work[iwork], info);

						/* Multiply Q in A by left singular vectors of R in
						   WORK(IU), storing result in U (Workspace: need
						   N*N) */

						NUMblas_dgemm ("N", "N", m, n, n, &c_b438, &a[a_offset], lda, &work[iu], &ldwrku, &c_b416,
						               &u[u_offset], ldu);

						/* Copy right singular vectors of R to A (Workspace:
						   need N*N) */

						NUMlapack_dlacpy ("F", n, n, &work[ir], &ldwrkr, &a[a_offset], lda);

					} else {

						/* Insufficient workspace for a fast algorithm */

						itau = 1;
						iwork = itau + *n;

						/* Compute A=Q*R, copying result to U (Workspace:
						   need 2*N, prefer N+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgeqrf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);
						NUMlapack_dlacpy ("L", m, n, &a[a_offset], lda, &u[u_offset], ldu);

						/* Generate Q in U (Workspace: need 2*N, prefer
						   N+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgqr (m, n, n, &u[u_offset], ldu, &work[itau], &work[iwork], &i__2, &ierr);
						ie = itau;
						itauq = ie + *n;
						itaup = itauq + *n;
						iwork = itaup + *n;

						/* Zero out below R in A */

						i__2 = *n - 1;
						i__3 = *n - 1;
						NUMlapack_dlaset ("L", &i__2, &i__3, &c_b416, &c_b416, &a_ref (2, 1), lda);

						/* Bidiagonalize R in A (Workspace: need 4*N, prefer
						   3*N+2*N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgebrd (n, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &work[itaup],
						                  &work[iwork], &i__2, &ierr);

						/* Multiply Q in U by left vectors bidiagonalizing R
						   (Workspace: need 3*N+M, prefer 3*N+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dormbr ("Q", "R", "N", m, n, n, &a[a_offset], lda, &work[itauq], &u[u_offset],
						                  ldu, &work[iwork], &i__2, &ierr);

						/* Generate right vectors bidiagonalizing R in A
						   (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgbr ("P", n, n, n, &a[a_offset], lda, &work[itaup], &work[iwork], &i__2,
						                  &ierr);
						iwork = ie + *n;

						/* Perform bidiagonal QR iteration, computing left
						   singular vectors of A in U and computing right
						   singular vectors of A in A (Workspace: need
						   BDSPAC) */

						NUMlapack_dbdsqr ("U", n, n, m, &c__0, &s[1], &work[ie], &a[a_offset], lda,
						                  &u[u_offset], ldu, dum, &c__1, &work[iwork], info);

					}

				} else if (wntvas) {

					/* Path 6 (M much larger than N, JOBU='S', JOBVT='S' or
					   'A') N left singular vectors to be computed in U and N
					   right singular vectors to be computed in VT

					   Computing MAX */
					i__2 = *n << 2;
					if (*lwork >= *n * *n + MAX (i__2, bdspac)) {

						/* Sufficient workspace for a fast algorithm */

						iu = 1;
						if (*lwork >= wrkbl + *lda * *n) {

							/* WORK(IU) is LDA by N */

							ldwrku = *lda;
						} else {

							/* WORK(IU) is N by N */

							ldwrku = *n;
						}
						itau = iu + ldwrku * *n;
						iwork = itau + *n;

						/* Compute A=Q*R (Workspace: need N*N+2*N, prefer
						   N*N+N+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgeqrf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);

						/* Copy R to WORK(IU), zeroing out below it */

						NUMlapack_dlacpy ("U", n, n, &a[a_offset], lda, &work[iu], &ldwrku);
						i__2 = *n - 1;
						i__3 = *n - 1;
						NUMlapack_dlaset ("L", &i__2, &i__3, &c_b416, &c_b416, &work[iu + 1], &ldwrku);

						/* Generate Q in A (Workspace: need N*N+2*N, prefer
						   N*N+N+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgqr (m, n, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);
						ie = itau;
						itauq = ie + *n;
						itaup = itauq + *n;
						iwork = itaup + *n;

						/* Bidiagonalize R in WORK(IU), copying result to VT
						   (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgebrd (n, n, &work[iu], &ldwrku, &s[1], &work[ie], &work[itauq],
						                  &work[itaup], &work[iwork], &i__2, &ierr);
						NUMlapack_dlacpy ("U", n, n, &work[iu], &ldwrku, &vt[vt_offset], ldvt);

						/* Generate left bidiagonalizing vectors in WORK(IU)
						   (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgbr ("Q", n, n, n, &work[iu], &ldwrku, &work[itauq], &work[iwork], &i__2,
						                  &ierr);

						/* Generate right bidiagonalizing vectors in VT
						   (Workspace: need N*N+4*N-1, prefer
						   N*N+3*N+(N-1)*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgbr ("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup], &work[iwork], &i__2,
						                  &ierr);
						iwork = ie + *n;

						/* Perform bidiagonal QR iteration, computing left
						   singular vectors of R in WORK(IU) and computing
						   right singular vectors of R in VT (Workspace: need
						   N*N+BDSPAC) */

						NUMlapack_dbdsqr ("U", n, n, n, &c__0, &s[1], &work[ie], &vt[vt_offset], ldvt,
						                  &work[iu], &ldwrku, dum, &c__1, &work[iwork], info);

						/* Multiply Q in A by left singular vectors of R in
						   WORK(IU), storing result in U (Workspace: need
						   N*N) */

						NUMblas_dgemm ("N", "N", m, n, n, &c_b438, &a[a_offset], lda, &work[iu], &ldwrku, &c_b416,
						               &u[u_offset], ldu);

					} else {

						/* Insufficient workspace for a fast algorithm */

						itau = 1;
						iwork = itau + *n;

						/* Compute A=Q*R, copying result to U (Workspace:
						   need 2*N, prefer N+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgeqrf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);
						NUMlapack_dlacpy ("L", m, n, &a[a_offset], lda, &u[u_offset], ldu);

						/* Generate Q in U (Workspace: need 2*N, prefer
						   N+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgqr (m, n, n, &u[u_offset], ldu, &work[itau], &work[iwork], &i__2, &ierr);

						/* Copy R to VT, zeroing out below it */

						NUMlapack_dlacpy ("U", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
						i__2 = *n - 1;
						i__3 = *n - 1;
						NUMlapack_dlaset ("L", &i__2, &i__3, &c_b416, &c_b416, &vt_ref (2, 1), ldvt);
						ie = itau;
						itauq = ie + *n;
						itaup = itauq + *n;
						iwork = itaup + *n;

						/* Bidiagonalize R in VT (Workspace: need 4*N, prefer
						   3*N+2*N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgebrd (n, n, &vt[vt_offset], ldvt, &s[1], &work[ie], &work[itauq],
						                  &work[itaup], &work[iwork], &i__2, &ierr);

						/* Multiply Q in U by left bidiagonalizing vectors in
						   VT (Workspace: need 3*N+M, prefer 3*N+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dormbr ("Q", "R", "N", m, n, n, &vt[vt_offset], ldvt, &work[itauq],
						                  &u[u_offset], ldu, &work[iwork], &i__2, &ierr);

						/* Generate right bidiagonalizing vectors in VT
						   (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgbr ("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup], &work[iwork], &i__2,
						                  &ierr);
						iwork = ie + *n;

						/* Perform bidiagonal QR iteration, computing left
						   singular vectors of A in U and computing right
						   singular vectors of A in VT (Workspace: need
						   BDSPAC) */

						NUMlapack_dbdsqr ("U", n, n, m, &c__0, &s[1], &work[ie], &vt[vt_offset], ldvt,
						                  &u[u_offset], ldu, dum, &c__1, &work[iwork], info);

					}

				}

			} else if (wntua) {

				if (wntvn) {

					/* Path 7 (M much larger than N, JOBU='A', JOBVT='N') M
					   left singular vectors to be computed in U and no right
					   singular vectors to be computed

					   Computing MAX */
					i__2 = *n + *m, i__3 = *n << 2, i__2 = MAX (i__2, i__3);
					if (*lwork >= *n * *n + MAX (i__2, bdspac)) {

						/* Sufficient workspace for a fast algorithm */

						ir = 1;
						if (*lwork >= wrkbl + *lda * *n) {

							/* WORK(IR) is LDA by N */

							ldwrkr = *lda;
						} else {

							/* WORK(IR) is N by N */

							ldwrkr = *n;
						}
						itau = ir + ldwrkr * *n;
						iwork = itau + *n;

						/* Compute A=Q*R, copying result to U (Workspace:
						   need N*N+2*N, prefer N*N+N+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgeqrf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);
						NUMlapack_dlacpy ("L", m, n, &a[a_offset], lda, &u[u_offset], ldu);

						/* Copy R to WORK(IR), zeroing out below it */

						NUMlapack_dlacpy ("U", n, n, &a[a_offset], lda, &work[ir], &ldwrkr);
						i__2 = *n - 1;
						i__3 = *n - 1;
						NUMlapack_dlaset ("L", &i__2, &i__3, &c_b416, &c_b416, &work[ir + 1], &ldwrkr);

						/* Generate Q in U (Workspace: need N*N+N+M, prefer
						   N*N+N+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgqr (m, m, n, &u[u_offset], ldu, &work[itau], &work[iwork], &i__2, &ierr);
						ie = itau;
						itauq = ie + *n;
						itaup = itauq + *n;
						iwork = itaup + *n;

						/* Bidiagonalize R in WORK(IR) (Workspace: need
						   N*N+4*N, prefer N*N+3*N+2*N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgebrd (n, n, &work[ir], &ldwrkr, &s[1], &work[ie], &work[itauq],
						                  &work[itaup], &work[iwork], &i__2, &ierr);

						/* Generate left bidiagonalizing vectors in WORK(IR)
						   (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgbr ("Q", n, n, n, &work[ir], &ldwrkr, &work[itauq], &work[iwork], &i__2,
						                  &ierr);
						iwork = ie + *n;

						/* Perform bidiagonal QR iteration, computing left
						   singular vectors of R in WORK(IR) (Workspace: need
						   N*N+BDSPAC) */

						NUMlapack_dbdsqr ("U", n, &c__0, n, &c__0, &s[1], &work[ie], dum, &c__1, &work[ir],
						                  &ldwrkr, dum, &c__1, &work[iwork], info);

						/* Multiply Q in U by left singular vectors of R in
						   WORK(IR), storing result in A (Workspace: need
						   N*N) */

						NUMblas_dgemm ("N", "N", m, n, n, &c_b438, &u[u_offset], ldu, &work[ir], &ldwrkr, &c_b416,
						               &a[a_offset], lda);

						/* Copy left singular vectors of A from A to U */

						NUMlapack_dlacpy ("F", m, n, &a[a_offset], lda, &u[u_offset], ldu);

					} else {

						/* Insufficient workspace for a fast algorithm */

						itau = 1;
						iwork = itau + *n;

						/* Compute A=Q*R, copying result to U (Workspace:
						   need 2*N, prefer N+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgeqrf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);
						NUMlapack_dlacpy ("L", m, n, &a[a_offset], lda, &u[u_offset], ldu);

						/* Generate Q in U (Workspace: need N+M, prefer
						   N+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgqr (m, m, n, &u[u_offset], ldu, &work[itau], &work[iwork], &i__2, &ierr);
						ie = itau;
						itauq = ie + *n;
						itaup = itauq + *n;
						iwork = itaup + *n;

						/* Zero out below R in A */

						i__2 = *n - 1;
						i__3 = *n - 1;
						NUMlapack_dlaset ("L", &i__2, &i__3, &c_b416, &c_b416, &a_ref (2, 1), lda);

						/* Bidiagonalize R in A (Workspace: need 4*N, prefer
						   3*N+2*N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgebrd (n, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &work[itaup],
						                  &work[iwork], &i__2, &ierr);

						/* Multiply Q in U by left bidiagonalizing vectors in
						   A (Workspace: need 3*N+M, prefer 3*N+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dormbr ("Q", "R", "N", m, n, n, &a[a_offset], lda, &work[itauq], &u[u_offset],
						                  ldu, &work[iwork], &i__2, &ierr);
						iwork = ie + *n;

						/* Perform bidiagonal QR iteration, computing left
						   singular vectors of A in U (Workspace: need
						   BDSPAC) */

						NUMlapack_dbdsqr ("U", n, &c__0, m, &c__0, &s[1], &work[ie], dum, &c__1, &u[u_offset],
						                  ldu, dum, &c__1, &work[iwork], info);

					}

				} else if (wntvo) {

					/* Path 8 (M much larger than N, JOBU='A', JOBVT='O') M
					   left singular vectors to be computed in U and N right
					   singular vectors to be overwritten on A

					   Computing MAX */
					i__2 = *n + *m, i__3 = *n << 2, i__2 = MAX (i__2, i__3);
					if (*lwork >= (*n << 1) * *n + MAX (i__2, bdspac)) {

						/* Sufficient workspace for a fast algorithm */

						iu = 1;
						if (*lwork >= wrkbl + (*lda << 1) * *n) {

							/* WORK(IU) is LDA by N and WORK(IR) is LDA by N */

							ldwrku = *lda;
							ir = iu + ldwrku * *n;
							ldwrkr = *lda;
						} else if (*lwork >= wrkbl + (*lda + *n) * *n) {

							/* WORK(IU) is LDA by N and WORK(IR) is N by N */

							ldwrku = *lda;
							ir = iu + ldwrku * *n;
							ldwrkr = *n;
						} else {

							/* WORK(IU) is N by N and WORK(IR) is N by N */

							ldwrku = *n;
							ir = iu + ldwrku * *n;
							ldwrkr = *n;
						}
						itau = ir + ldwrkr * *n;
						iwork = itau + *n;

						/* Compute A=Q*R, copying result to U (Workspace:
						   need 2*N*N+2*N, prefer 2*N*N+N+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgeqrf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);
						NUMlapack_dlacpy ("L", m, n, &a[a_offset], lda, &u[u_offset], ldu);

						/* Generate Q in U (Workspace: need 2*N*N+N+M, prefer
						   2*N*N+N+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgqr (m, m, n, &u[u_offset], ldu, &work[itau], &work[iwork], &i__2, &ierr);

						/* Copy R to WORK(IU), zeroing out below it */

						NUMlapack_dlacpy ("U", n, n, &a[a_offset], lda, &work[iu], &ldwrku);
						i__2 = *n - 1;
						i__3 = *n - 1;
						NUMlapack_dlaset ("L", &i__2, &i__3, &c_b416, &c_b416, &work[iu + 1], &ldwrku);
						ie = itau;
						itauq = ie + *n;
						itaup = itauq + *n;
						iwork = itaup + *n;

						/* Bidiagonalize R in WORK(IU), copying result to
						   WORK(IR) (Workspace: need 2*N*N+4*N, prefer
						   2*N*N+3*N+2*N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgebrd (n, n, &work[iu], &ldwrku, &s[1], &work[ie], &work[itauq],
						                  &work[itaup], &work[iwork], &i__2, &ierr);
						NUMlapack_dlacpy ("U", n, n, &work[iu], &ldwrku, &work[ir], &ldwrkr);

						/* Generate left bidiagonalizing vectors in WORK(IU)
						   (Workspace: need 2*N*N+4*N, prefer 2*N*N+3*N+N*NB)
						 */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgbr ("Q", n, n, n, &work[iu], &ldwrku, &work[itauq], &work[iwork], &i__2,
						                  &ierr);

						/* Generate right bidiagonalizing vectors in WORK(IR)
						   (Workspace: need 2*N*N+4*N-1, prefer
						   2*N*N+3*N+(N-1)*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgbr ("P", n, n, n, &work[ir], &ldwrkr, &work[itaup], &work[iwork], &i__2,
						                  &ierr);
						iwork = ie + *n;

						/* Perform bidiagonal QR iteration, computing left
						   singular vectors of R in WORK(IU) and computing
						   right singular vectors of R in WORK(IR)
						   (Workspace: need 2*N*N+BDSPAC) */

						NUMlapack_dbdsqr ("U", n, n, n, &c__0, &s[1], &work[ie], &work[ir], &ldwrkr, &work[iu],
						                  &ldwrku, dum, &c__1, &work[iwork], info);

						/* Multiply Q in U by left singular vectors of R in
						   WORK(IU), storing result in A (Workspace: need
						   N*N) */

						NUMblas_dgemm ("N", "N", m, n, n, &c_b438, &u[u_offset], ldu, &work[iu], &ldwrku, &c_b416,
						               &a[a_offset], lda);

						/* Copy left singular vectors of A from A to U */

						NUMlapack_dlacpy ("F", m, n, &a[a_offset], lda, &u[u_offset], ldu);

						/* Copy right singular vectors of R from WORK(IR) to
						   A */

						NUMlapack_dlacpy ("F", n, n, &work[ir], &ldwrkr, &a[a_offset], lda);

					} else {

						/* Insufficient workspace for a fast algorithm */

						itau = 1;
						iwork = itau + *n;

						/* Compute A=Q*R, copying result to U (Workspace:
						   need 2*N, prefer N+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgeqrf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);
						NUMlapack_dlacpy ("L", m, n, &a[a_offset], lda, &u[u_offset], ldu);

						/* Generate Q in U (Workspace: need N+M, prefer
						   N+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgqr (m, m, n, &u[u_offset], ldu, &work[itau], &work[iwork], &i__2, &ierr);
						ie = itau;
						itauq = ie + *n;
						itaup = itauq + *n;
						iwork = itaup + *n;

						/* Zero out below R in A */

						i__2 = *n - 1;
						i__3 = *n - 1;
						NUMlapack_dlaset ("L", &i__2, &i__3, &c_b416, &c_b416, &a_ref (2, 1), lda);

						/* Bidiagonalize R in A (Workspace: need 4*N, prefer
						   3*N+2*N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgebrd (n, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &work[itaup],
						                  &work[iwork], &i__2, &ierr);

						/* Multiply Q in U by left bidiagonalizing vectors in
						   A (Workspace: need 3*N+M, prefer 3*N+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dormbr ("Q", "R", "N", m, n, n, &a[a_offset], lda, &work[itauq], &u[u_offset],
						                  ldu, &work[iwork], &i__2, &ierr);

						/* Generate right bidiagonalizing vectors in A
						   (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgbr ("P", n, n, n, &a[a_offset], lda, &work[itaup], &work[iwork], &i__2,
						                  &ierr);
						iwork = ie + *n;

						/* Perform bidiagonal QR iteration, computing left
						   singular vectors of A in U and computing right
						   singular vectors of A in A (Workspace: need
						   BDSPAC) */

						NUMlapack_dbdsqr ("U", n, n, m, &c__0, &s[1], &work[ie], &a[a_offset], lda,
						                  &u[u_offset], ldu, dum, &c__1, &work[iwork], info);

					}

				} else if (wntvas) {

					/* Path 9 (M much larger than N, JOBU='A', JOBVT='S' or
					   'A') M left singular vectors to be computed in U and N
					   right singular vectors to be computed in VT

					   Computing MAX */
					i__2 = *n + *m, i__3 = *n << 2, i__2 = MAX (i__2, i__3);
					if (*lwork >= *n * *n + MAX (i__2, bdspac)) {

						/* Sufficient workspace for a fast algorithm */

						iu = 1;
						if (*lwork >= wrkbl + *lda * *n) {

							/* WORK(IU) is LDA by N */

							ldwrku = *lda;
						} else {

							/* WORK(IU) is N by N */

							ldwrku = *n;
						}
						itau = iu + ldwrku * *n;
						iwork = itau + *n;

						/* Compute A=Q*R, copying result to U (Workspace:
						   need N*N+2*N, prefer N*N+N+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgeqrf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);
						NUMlapack_dlacpy ("L", m, n, &a[a_offset], lda, &u[u_offset], ldu);

						/* Generate Q in U (Workspace: need N*N+N+M, prefer
						   N*N+N+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgqr (m, m, n, &u[u_offset], ldu, &work[itau], &work[iwork], &i__2, &ierr);

						/* Copy R to WORK(IU), zeroing out below it */

						NUMlapack_dlacpy ("U", n, n, &a[a_offset], lda, &work[iu], &ldwrku);
						i__2 = *n - 1;
						i__3 = *n - 1;
						NUMlapack_dlaset ("L", &i__2, &i__3, &c_b416, &c_b416, &work[iu + 1], &ldwrku);
						ie = itau;
						itauq = ie + *n;
						itaup = itauq + *n;
						iwork = itaup + *n;

						/* Bidiagonalize R in WORK(IU), copying result to VT
						   (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgebrd (n, n, &work[iu], &ldwrku, &s[1], &work[ie], &work[itauq],
						                  &work[itaup], &work[iwork], &i__2, &ierr);
						NUMlapack_dlacpy ("U", n, n, &work[iu], &ldwrku, &vt[vt_offset], ldvt);

						/* Generate left bidiagonalizing vectors in WORK(IU)
						   (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgbr ("Q", n, n, n, &work[iu], &ldwrku, &work[itauq], &work[iwork], &i__2,
						                  &ierr);

						/* Generate right bidiagonalizing vectors in VT
						   (Workspace: need N*N+4*N-1, prefer
						   N*N+3*N+(N-1)*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgbr ("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup], &work[iwork], &i__2,
						                  &ierr);
						iwork = ie + *n;

						/* Perform bidiagonal QR iteration, computing left
						   singular vectors of R in WORK(IU) and computing
						   right singular vectors of R in VT (Workspace: need
						   N*N+BDSPAC) */

						NUMlapack_dbdsqr ("U", n, n, n, &c__0, &s[1], &work[ie], &vt[vt_offset], ldvt,
						                  &work[iu], &ldwrku, dum, &c__1, &work[iwork], info);

						/* Multiply Q in U by left singular vectors of R in
						   WORK(IU), storing result in A (Workspace: need
						   N*N) */

						NUMblas_dgemm ("N", "N", m, n, n, &c_b438, &u[u_offset], ldu, &work[iu], &ldwrku, &c_b416,
						               &a[a_offset], lda);

						/* Copy left singular vectors of A from A to U */

						NUMlapack_dlacpy ("F", m, n, &a[a_offset], lda, &u[u_offset], ldu);

					} else {

						/* Insufficient workspace for a fast algorithm */

						itau = 1;
						iwork = itau + *n;

						/* Compute A=Q*R, copying result to U (Workspace:
						   need 2*N, prefer N+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgeqrf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);
						NUMlapack_dlacpy ("L", m, n, &a[a_offset], lda, &u[u_offset], ldu);

						/* Generate Q in U (Workspace: need N+M, prefer
						   N+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgqr (m, m, n, &u[u_offset], ldu, &work[itau], &work[iwork], &i__2, &ierr);

						/* Copy R from A to VT, zeroing out below it */

						NUMlapack_dlacpy ("U", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
						i__2 = *n - 1;
						i__3 = *n - 1;
						NUMlapack_dlaset ("L", &i__2, &i__3, &c_b416, &c_b416, &vt_ref (2, 1), ldvt);
						ie = itau;
						itauq = ie + *n;
						itaup = itauq + *n;
						iwork = itaup + *n;

						/* Bidiagonalize R in VT (Workspace: need 4*N, prefer
						   3*N+2*N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgebrd (n, n, &vt[vt_offset], ldvt, &s[1], &work[ie], &work[itauq],
						                  &work[itaup], &work[iwork], &i__2, &ierr);

						/* Multiply Q in U by left bidiagonalizing vectors in
						   VT (Workspace: need 3*N+M, prefer 3*N+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dormbr ("Q", "R", "N", m, n, n, &vt[vt_offset], ldvt, &work[itauq],
						                  &u[u_offset], ldu, &work[iwork], &i__2, &ierr);

						/* Generate right bidiagonalizing vectors in VT
						   (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgbr ("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup], &work[iwork], &i__2,
						                  &ierr);
						iwork = ie + *n;

						/* Perform bidiagonal QR iteration, computing left
						   singular vectors of A in U and computing right
						   singular vectors of A in VT (Workspace: need
						   BDSPAC) */

						NUMlapack_dbdsqr ("U", n, n, m, &c__0, &s[1], &work[ie], &vt[vt_offset], ldvt,
						                  &u[u_offset], ldu, dum, &c__1, &work[iwork], info);

					}

				}

			}

		} else {

			/* M .LT. MNTHR

			   Path 10 (M at least N, but not much larger) Reduce to
			   bidiagonal form without QR decomposition */

			ie = 1;
			itauq = ie + *n;
			itaup = itauq + *n;
			iwork = itaup + *n;

			/* Bidiagonalize A (Workspace: need 3*N+M, prefer 3*N+(M+N)*NB) */

			i__2 = *lwork - iwork + 1;
			NUMlapack_dgebrd (m, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &work[itaup],
			                  &work[iwork], &i__2, &ierr);
			if (wntuas) {

				/* If left singular vectors desired in U, copy result to U
				   and generate left bidiagonalizing vectors in U (Workspace:
				   need 3*N+NCU, prefer 3*N+NCU*NB) */

				NUMlapack_dlacpy ("L", m, n, &a[a_offset], lda, &u[u_offset], ldu);
				if (wntus) {
					ncu = *n;
				}
				if (wntua) {
					ncu = *m;
				}
				i__2 = *lwork - iwork + 1;
				NUMlapack_dorgbr ("Q", m, &ncu, n, &u[u_offset], ldu, &work[itauq], &work[iwork], &i__2, &ierr);
			}
			if (wntvas) {

				/* If right singular vectors desired in VT, copy result to VT
				   and generate right bidiagonalizing vectors in VT
				   (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) */

				NUMlapack_dlacpy ("U", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
				i__2 = *lwork - iwork + 1;
				NUMlapack_dorgbr ("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup], &work[iwork], &i__2, &ierr);
			}
			if (wntuo) {

				/* If left singular vectors desired in A, generate left
				   bidiagonalizing vectors in A (Workspace: need 4*N, prefer
				   3*N+N*NB) */

				i__2 = *lwork - iwork + 1;
				NUMlapack_dorgbr ("Q", m, n, n, &a[a_offset], lda, &work[itauq], &work[iwork], &i__2, &ierr);
			}
			if (wntvo) {

				/* If right singular vectors desired in A, generate right
				   bidiagonalizing vectors in A (Workspace: need 4*N-1,
				   prefer 3*N+(N-1)*NB) */

				i__2 = *lwork - iwork + 1;
				NUMlapack_dorgbr ("P", n, n, n, &a[a_offset], lda, &work[itaup], &work[iwork], &i__2, &ierr);
			}
			iwork = ie + *n;
			if (wntuas || wntuo) {
				nru = *m;
			}
			if (wntun) {
				nru = 0;
			}
			if (wntvas || wntvo) {
				ncvt = *n;
			}
			if (wntvn) {
				ncvt = 0;
			}
			if (!wntuo && !wntvo) {

				/* Perform bidiagonal QR iteration, if desired, computing
				   left singular vectors in U and computing right singular
				   vectors in VT (Workspace: need BDSPAC) */

				NUMlapack_dbdsqr ("U", n, &ncvt, &nru, &c__0, &s[1], &work[ie], &vt[vt_offset], ldvt,
				                  &u[u_offset], ldu, dum, &c__1, &work[iwork], info);
			} else if (!wntuo && wntvo) {

				/* Perform bidiagonal QR iteration, if desired, computing
				   left singular vectors in U and computing right singular
				   vectors in A (Workspace: need BDSPAC) */

				NUMlapack_dbdsqr ("U", n, &ncvt, &nru, &c__0, &s[1], &work[ie], &a[a_offset], lda, &u[u_offset],
				                  ldu, dum, &c__1, &work[iwork], info);
			} else {

				/* Perform bidiagonal QR iteration, if desired, computing
				   left singular vectors in A and computing right singular
				   vectors in VT (Workspace: need BDSPAC) */

				NUMlapack_dbdsqr ("U", n, &ncvt, &nru, &c__0, &s[1], &work[ie], &vt[vt_offset], ldvt,
				                  &a[a_offset], lda, dum, &c__1, &work[iwork], info);
			}

		}

	} else {

		/* A has more columns than rows. If A has sufficiently more columns
		   than rows, first reduce using the LQ decomposition (if sufficient
		   workspace available) */

		if (*n >= mnthr) {

			if (wntvn) {

				/* Path 1t(N much larger than M, JOBVT='N') No right singular
				   vectors to be computed */

				itau = 1;
				iwork = itau + *m;

				/* Compute A=L*Q (Workspace: need 2*M, prefer M+M*NB) */

				i__2 = *lwork - iwork + 1;
				NUMlapack_dgelqf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);

				/* Zero out above L */

				i__2 = *m - 1;
				i__3 = *m - 1;
				NUMlapack_dlaset ("U", &i__2, &i__3, &c_b416, &c_b416, &a_ref (1, 2), lda);
				ie = 1;
				itauq = ie + *m;
				itaup = itauq + *m;
				iwork = itaup + *m;

				/* Bidiagonalize L in A (Workspace: need 4*M, prefer
				   3*M+2*M*NB) */

				i__2 = *lwork - iwork + 1;
				NUMlapack_dgebrd (m, m, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &work[itaup],
				                  &work[iwork], &i__2, &ierr);
				if (wntuo || wntuas) {

					/* If left singular vectors desired, generate Q
					   (Workspace: need 4*M, prefer 3*M+M*NB) */

					i__2 = *lwork - iwork + 1;
					NUMlapack_dorgbr ("Q", m, m, m, &a[a_offset], lda, &work[itauq], &work[iwork], &i__2,
					                  &ierr);
				}
				iwork = ie + *m;
				nru = 0;
				if (wntuo || wntuas) {
					nru = *m;
				}

				/* Perform bidiagonal QR iteration, computing left singular
				   vectors of A in A if desired (Workspace: need BDSPAC) */

				NUMlapack_dbdsqr ("U", m, &c__0, &nru, &c__0, &s[1], &work[ie], dum, &c__1, &a[a_offset], lda,
				                  dum, &c__1, &work[iwork], info);

				/* If left singular vectors desired in U, copy them there */

				if (wntuas) {
					NUMlapack_dlacpy ("F", m, m, &a[a_offset], lda, &u[u_offset], ldu);
				}

			} else if (wntvo && wntun) {

				/* Path 2t(N much larger than M, JOBU='N', JOBVT='O') M right
				   singular vectors to be overwritten on A and no left
				   singular vectors to be computed

				   Computing MAX */
				i__2 = *m << 2;
				if (*lwork >= *m * *m + MAX (i__2, bdspac)) {

					/* Sufficient workspace for a fast algorithm */

					ir = 1;
					/* Computing MAX */
					i__2 = wrkbl, i__3 = *lda * *n + *m;
					if (*lwork >= MAX (i__2, i__3) + *lda * *m) {

						/* WORK(IU) is LDA by N and WORK(IR) is LDA by M */

						ldwrku = *lda;
						chunk = *n;
						ldwrkr = *lda;
					} else {	/* if(complicated condition) */
						/* Computing MAX */
						i__2 = wrkbl, i__3 = *lda * *n + *m;
						if (*lwork >= MAX (i__2, i__3) + *m * *m) {

							/* WORK(IU) is LDA by N and WORK(IR) is M by M */

							ldwrku = *lda;
							chunk = *n;
							ldwrkr = *m;
						} else {

							/* WORK(IU) is M by CHUNK and WORK(IR) is M by M */

							ldwrku = *m;
							chunk = (*lwork - *m * *m - *m) / *m;
							ldwrkr = *m;
						}
					}
					itau = ir + ldwrkr * *m;
					iwork = itau + *m;

					/* Compute A=L*Q (Workspace: need M*M+2*M, prefer
					   M*M+M+M*NB) */

					i__2 = *lwork - iwork + 1;
					NUMlapack_dgelqf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);

					/* Copy L to WORK(IR) and zero out above it */

					NUMlapack_dlacpy ("L", m, m, &a[a_offset], lda, &work[ir], &ldwrkr);
					i__2 = *m - 1;
					i__3 = *m - 1;
					NUMlapack_dlaset ("U", &i__2, &i__3, &c_b416, &c_b416, &work[ir + ldwrkr], &ldwrkr);

					/* Generate Q in A (Workspace: need M*M+2*M, prefer
					   M*M+M+M*NB) */

					i__2 = *lwork - iwork + 1;
					NUMlapack_dorglq (m, n, m, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);
					ie = itau;
					itauq = ie + *m;
					itaup = itauq + *m;
					iwork = itaup + *m;

					/* Bidiagonalize L in WORK(IR) (Workspace: need M*M+4*M,
					   prefer M*M+3*M+2*M*NB) */

					i__2 = *lwork - iwork + 1;
					NUMlapack_dgebrd (m, m, &work[ir], &ldwrkr, &s[1], &work[ie], &work[itauq], &work[itaup],
					                  &work[iwork], &i__2, &ierr);

					/* Generate right vectors bidiagonalizing L (Workspace:
					   need M*M+4*M-1, prefer M*M+3*M+(M-1)*NB) */

					i__2 = *lwork - iwork + 1;
					NUMlapack_dorgbr ("P", m, m, m, &work[ir], &ldwrkr, &work[itaup], &work[iwork], &i__2,
					                  &ierr);
					iwork = ie + *m;

					/* Perform bidiagonal QR iteration, computing right
					   singular vectors of L in WORK(IR) (Workspace: need
					   M*M+BDSPAC) */

					NUMlapack_dbdsqr ("U", m, m, &c__0, &c__0, &s[1], &work[ie], &work[ir], &ldwrkr, dum, &c__1,
					                  dum, &c__1, &work[iwork], info);
					iu = ie + *m;

					/* Multiply right singular vectors of L in WORK(IR) by Q
					   in A, storing result in WORK(IU) and copying to A
					   (Workspace: need M*M+2*M, prefer M*M+M*N+M) */

					i__2 = *n;
					i__3 = chunk;
					for (i__ = 1; i__3 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__3) {
						/* Computing MIN */
						i__4 = *n - i__ + 1;
						blk = MIN (i__4, chunk);
						NUMblas_dgemm ("N", "N", m, &blk, m, &c_b438, &work[ir], &ldwrkr, &a_ref (1, i__), lda,
						               &c_b416, &work[iu], &ldwrku);
						NUMlapack_dlacpy ("F", m, &blk, &work[iu], &ldwrku, &a_ref (1, i__), lda);
						/* L30: */
					}

				} else {

					/* Insufficient workspace for a fast algorithm */

					ie = 1;
					itauq = ie + *m;
					itaup = itauq + *m;
					iwork = itaup + *m;

					/* Bidiagonalize A (Workspace: need 3*M+N, prefer
					   3*M+(M+N)*NB) */

					i__3 = *lwork - iwork + 1;
					NUMlapack_dgebrd (m, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &work[itaup],
					                  &work[iwork], &i__3, &ierr);

					/* Generate right vectors bidiagonalizing A (Workspace:
					   need 4*M, prefer 3*M+M*NB) */

					i__3 = *lwork - iwork + 1;
					NUMlapack_dorgbr ("P", m, n, m, &a[a_offset], lda, &work[itaup], &work[iwork], &i__3,
					                  &ierr);
					iwork = ie + *m;

					/* Perform bidiagonal QR iteration, computing right
					   singular vectors of A in A (Workspace: need BDSPAC) */

					NUMlapack_dbdsqr ("L", m, n, &c__0, &c__0, &s[1], &work[ie], &a[a_offset], lda, dum, &c__1,
					                  dum, &c__1, &work[iwork], info);

				}

			} else if (wntvo && wntuas) {

				/* Path 3t(N much larger than M, JOBU='S' or 'A', JOBVT='O')
				   M right singular vectors to be overwritten on A and M left
				   singular vectors to be computed in U

				   Computing MAX */
				i__3 = *m << 2;
				if (*lwork >= *m * *m + MAX (i__3, bdspac)) {

					/* Sufficient workspace for a fast algorithm */

					ir = 1;
					/* Computing MAX */
					i__3 = wrkbl, i__2 = *lda * *n + *m;
					if (*lwork >= MAX (i__3, i__2) + *lda * *m) {

						/* WORK(IU) is LDA by N and WORK(IR) is LDA by M */

						ldwrku = *lda;
						chunk = *n;
						ldwrkr = *lda;
					} else {	/* if(complicated condition) */
						/* Computing MAX */
						i__3 = wrkbl, i__2 = *lda * *n + *m;
						if (*lwork >= MAX (i__3, i__2) + *m * *m) {

							/* WORK(IU) is LDA by N and WORK(IR) is M by M */

							ldwrku = *lda;
							chunk = *n;
							ldwrkr = *m;
						} else {

							/* WORK(IU) is M by CHUNK and WORK(IR) is M by M */

							ldwrku = *m;
							chunk = (*lwork - *m * *m - *m) / *m;
							ldwrkr = *m;
						}
					}
					itau = ir + ldwrkr * *m;
					iwork = itau + *m;

					/* Compute A=L*Q (Workspace: need M*M+2*M, prefer
					   M*M+M+M*NB) */

					i__3 = *lwork - iwork + 1;
					NUMlapack_dgelqf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__3, &ierr);

					/* Copy L to U, zeroing about above it */

					NUMlapack_dlacpy ("L", m, m, &a[a_offset], lda, &u[u_offset], ldu);
					i__3 = *m - 1;
					i__2 = *m - 1;
					NUMlapack_dlaset ("U", &i__3, &i__2, &c_b416, &c_b416, &u_ref (1, 2), ldu);

					/* Generate Q in A (Workspace: need M*M+2*M, prefer
					   M*M+M+M*NB) */

					i__3 = *lwork - iwork + 1;
					NUMlapack_dorglq (m, n, m, &a[a_offset], lda, &work[itau], &work[iwork], &i__3, &ierr);
					ie = itau;
					itauq = ie + *m;
					itaup = itauq + *m;
					iwork = itaup + *m;

					/* Bidiagonalize L in U, copying result to WORK(IR)
					   (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) */

					i__3 = *lwork - iwork + 1;
					NUMlapack_dgebrd (m, m, &u[u_offset], ldu, &s[1], &work[ie], &work[itauq], &work[itaup],
					                  &work[iwork], &i__3, &ierr);
					NUMlapack_dlacpy ("U", m, m, &u[u_offset], ldu, &work[ir], &ldwrkr);

					/* Generate right vectors bidiagonalizing L in WORK(IR)
					   (Workspace: need M*M+4*M-1, prefer M*M+3*M+(M-1)*NB) */

					i__3 = *lwork - iwork + 1;
					NUMlapack_dorgbr ("P", m, m, m, &work[ir], &ldwrkr, &work[itaup], &work[iwork], &i__3,
					                  &ierr);

					/* Generate left vectors bidiagonalizing L in U
					   (Workspace: need M*M+4*M, prefer M*M+3*M+M*NB) */

					i__3 = *lwork - iwork + 1;
					NUMlapack_dorgbr ("Q", m, m, m, &u[u_offset], ldu, &work[itauq], &work[iwork], &i__3,
					                  &ierr);
					iwork = ie + *m;

					/* Perform bidiagonal QR iteration, computing left
					   singular vectors of L in U, and computing right
					   singular vectors of L in WORK(IR) (Workspace: need
					   M*M+BDSPAC) */

					NUMlapack_dbdsqr ("U", m, m, m, &c__0, &s[1], &work[ie], &work[ir], &ldwrkr, &u[u_offset],
					                  ldu, dum, &c__1, &work[iwork], info);
					iu = ie + *m;

					/* Multiply right singular vectors of L in WORK(IR) by Q
					   in A, storing result in WORK(IU) and copying to A
					   (Workspace: need M*M+2*M, prefer M*M+M*N+M)) */

					i__3 = *n;
					i__2 = chunk;
					for (i__ = 1; i__2 < 0 ? i__ >= i__3 : i__ <= i__3; i__ += i__2) {
						/* Computing MIN */
						i__4 = *n - i__ + 1;
						blk = MIN (i__4, chunk);
						NUMblas_dgemm ("N", "N", m, &blk, m, &c_b438, &work[ir], &ldwrkr, &a_ref (1, i__), lda,
						               &c_b416, &work[iu], &ldwrku);
						NUMlapack_dlacpy ("F", m, &blk, &work[iu], &ldwrku, &a_ref (1, i__), lda);
						/* L40: */
					}

				} else {

					/* Insufficient workspace for a fast algorithm */

					itau = 1;
					iwork = itau + *m;

					/* Compute A=L*Q (Workspace: need 2*M, prefer M+M*NB) */

					i__2 = *lwork - iwork + 1;
					NUMlapack_dgelqf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);

					/* Copy L to U, zeroing out above it */

					NUMlapack_dlacpy ("L", m, m, &a[a_offset], lda, &u[u_offset], ldu);
					i__2 = *m - 1;
					i__3 = *m - 1;
					NUMlapack_dlaset ("U", &i__2, &i__3, &c_b416, &c_b416, &u_ref (1, 2), ldu);

					/* Generate Q in A (Workspace: need 2*M, prefer M+M*NB) */

					i__2 = *lwork - iwork + 1;
					NUMlapack_dorglq (m, n, m, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);
					ie = itau;
					itauq = ie + *m;
					itaup = itauq + *m;
					iwork = itaup + *m;

					/* Bidiagonalize L in U (Workspace: need 4*M, prefer
					   3*M+2*M*NB) */

					i__2 = *lwork - iwork + 1;
					NUMlapack_dgebrd (m, m, &u[u_offset], ldu, &s[1], &work[ie], &work[itauq], &work[itaup],
					                  &work[iwork], &i__2, &ierr);

					/* Multiply right vectors bidiagonalizing L by Q in A
					   (Workspace: need 3*M+N, prefer 3*M+N*NB) */

					i__2 = *lwork - iwork + 1;
					NUMlapack_dormbr ("P", "L", "T", m, n, m, &u[u_offset], ldu, &work[itaup], &a[a_offset],
					                  lda, &work[iwork], &i__2, &ierr);

					/* Generate left vectors bidiagonalizing L in U
					   (Workspace: need 4*M, prefer 3*M+M*NB) */

					i__2 = *lwork - iwork + 1;
					NUMlapack_dorgbr ("Q", m, m, m, &u[u_offset], ldu, &work[itauq], &work[iwork], &i__2,
					                  &ierr);
					iwork = ie + *m;

					/* Perform bidiagonal QR iteration, computing left
					   singular vectors of A in U and computing right
					   singular vectors of A in A (Workspace: need BDSPAC) */

					NUMlapack_dbdsqr ("U", m, n, m, &c__0, &s[1], &work[ie], &a[a_offset], lda, &u[u_offset],
					                  ldu, dum, &c__1, &work[iwork], info);

				}

			} else if (wntvs) {

				if (wntun) {

					/* Path 4t(N much larger than M, JOBU='N', JOBVT='S') M
					   right singular vectors to be computed in VT and no
					   left singular vectors to be computed

					   Computing MAX */
					i__2 = *m << 2;
					if (*lwork >= *m * *m + MAX (i__2, bdspac)) {

						/* Sufficient workspace for a fast algorithm */

						ir = 1;
						if (*lwork >= wrkbl + *lda * *m) {

							/* WORK(IR) is LDA by M */

							ldwrkr = *lda;
						} else {

							/* WORK(IR) is M by M */

							ldwrkr = *m;
						}
						itau = ir + ldwrkr * *m;
						iwork = itau + *m;

						/* Compute A=L*Q (Workspace: need M*M+2*M, prefer
						   M*M+M+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgelqf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);

						/* Copy L to WORK(IR), zeroing out above it */

						NUMlapack_dlacpy ("L", m, m, &a[a_offset], lda, &work[ir], &ldwrkr);
						i__2 = *m - 1;
						i__3 = *m - 1;
						NUMlapack_dlaset ("U", &i__2, &i__3, &c_b416, &c_b416, &work[ir + ldwrkr], &ldwrkr);

						/* Generate Q in A (Workspace: need M*M+2*M, prefer
						   M*M+M+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorglq (m, n, m, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);
						ie = itau;
						itauq = ie + *m;
						itaup = itauq + *m;
						iwork = itaup + *m;

						/* Bidiagonalize L in WORK(IR) (Workspace: need
						   M*M+4*M, prefer M*M+3*M+2*M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgebrd (m, m, &work[ir], &ldwrkr, &s[1], &work[ie], &work[itauq],
						                  &work[itaup], &work[iwork], &i__2, &ierr);

						/* Generate right vectors bidiagonalizing L in
						   WORK(IR) (Workspace: need M*M+4*M, prefer
						   M*M+3*M+(M-1)*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgbr ("P", m, m, m, &work[ir], &ldwrkr, &work[itaup], &work[iwork], &i__2,
						                  &ierr);
						iwork = ie + *m;

						/* Perform bidiagonal QR iteration, computing right
						   singular vectors of L in WORK(IR) (Workspace: need
						   M*M+BDSPAC) */

						NUMlapack_dbdsqr ("U", m, m, &c__0, &c__0, &s[1], &work[ie], &work[ir], &ldwrkr, dum,
						                  &c__1, dum, &c__1, &work[iwork], info);

						/* Multiply right singular vectors of L in WORK(IR)
						   by Q in A, storing result in VT (Workspace: need
						   M*M) */

						NUMblas_dgemm ("N", "N", m, n, m, &c_b438, &work[ir], &ldwrkr, &a[a_offset], lda, &c_b416,
						               &vt[vt_offset], ldvt);

					} else {

						/* Insufficient workspace for a fast algorithm */

						itau = 1;
						iwork = itau + *m;

						/* Compute A=L*Q (Workspace: need 2*M, prefer M+M*NB)
						 */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgelqf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);

						/* Copy result to VT */

						NUMlapack_dlacpy ("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt);

						/* Generate Q in VT (Workspace: need 2*M, prefer
						   M+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorglq (m, n, m, &vt[vt_offset], ldvt, &work[itau], &work[iwork], &i__2,
						                  &ierr);
						ie = itau;
						itauq = ie + *m;
						itaup = itauq + *m;
						iwork = itaup + *m;

						/* Zero out above L in A */

						i__2 = *m - 1;
						i__3 = *m - 1;
						NUMlapack_dlaset ("U", &i__2, &i__3, &c_b416, &c_b416, &a_ref (1, 2), lda);

						/* Bidiagonalize L in A (Workspace: need 4*M, prefer
						   3*M+2*M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgebrd (m, m, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &work[itaup],
						                  &work[iwork], &i__2, &ierr);

						/* Multiply right vectors bidiagonalizing L by Q in
						   VT (Workspace: need 3*M+N, prefer 3*M+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dormbr ("P", "L", "T", m, n, m, &a[a_offset], lda, &work[itaup],
						                  &vt[vt_offset], ldvt, &work[iwork], &i__2, &ierr);
						iwork = ie + *m;

						/* Perform bidiagonal QR iteration, computing right
						   singular vectors of A in VT (Workspace: need
						   BDSPAC) */

						NUMlapack_dbdsqr ("U", m, n, &c__0, &c__0, &s[1], &work[ie], &vt[vt_offset], ldvt, dum,
						                  &c__1, dum, &c__1, &work[iwork], info);

					}

				} else if (wntuo) {

					/* Path 5t(N much larger than M, JOBU='O', JOBVT='S') M
					   right singular vectors to be computed in VT and M left
					   singular vectors to be overwritten on A

					   Computing MAX */
					i__2 = *m << 2;
					if (*lwork >= (*m << 1) * *m + MAX (i__2, bdspac)) {

						/* Sufficient workspace for a fast algorithm */

						iu = 1;
						if (*lwork >= wrkbl + (*lda << 1) * *m) {

							/* WORK(IU) is LDA by M and WORK(IR) is LDA by M */

							ldwrku = *lda;
							ir = iu + ldwrku * *m;
							ldwrkr = *lda;
						} else if (*lwork >= wrkbl + (*lda + *m) * *m) {

							/* WORK(IU) is LDA by M and WORK(IR) is M by M */

							ldwrku = *lda;
							ir = iu + ldwrku * *m;
							ldwrkr = *m;
						} else {

							/* WORK(IU) is M by M and WORK(IR) is M by M */

							ldwrku = *m;
							ir = iu + ldwrku * *m;
							ldwrkr = *m;
						}
						itau = ir + ldwrkr * *m;
						iwork = itau + *m;

						/* Compute A=L*Q (Workspace: need 2*M*M+2*M, prefer
						   2*M*M+M+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgelqf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);

						/* Copy L to WORK(IU), zeroing out below it */

						NUMlapack_dlacpy ("L", m, m, &a[a_offset], lda, &work[iu], &ldwrku);
						i__2 = *m - 1;
						i__3 = *m - 1;
						NUMlapack_dlaset ("U", &i__2, &i__3, &c_b416, &c_b416, &work[iu + ldwrku], &ldwrku);

						/* Generate Q in A (Workspace: need 2*M*M+2*M, prefer
						   2*M*M+M+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorglq (m, n, m, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);
						ie = itau;
						itauq = ie + *m;
						itaup = itauq + *m;
						iwork = itaup + *m;

						/* Bidiagonalize L in WORK(IU), copying result to
						   WORK(IR) (Workspace: need 2*M*M+4*M, prefer
						   2*M*M+3*M+2*M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgebrd (m, m, &work[iu], &ldwrku, &s[1], &work[ie], &work[itauq],
						                  &work[itaup], &work[iwork], &i__2, &ierr);
						NUMlapack_dlacpy ("L", m, m, &work[iu], &ldwrku, &work[ir], &ldwrkr);

						/* Generate right bidiagonalizing vectors in WORK(IU)
						   (Workspace: need 2*M*M+4*M-1, prefer
						   2*M*M+3*M+(M-1)*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgbr ("P", m, m, m, &work[iu], &ldwrku, &work[itaup], &work[iwork], &i__2,
						                  &ierr);

						/* Generate left bidiagonalizing vectors in WORK(IR)
						   (Workspace: need 2*M*M+4*M, prefer 2*M*M+3*M+M*NB)
						 */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgbr ("Q", m, m, m, &work[ir], &ldwrkr, &work[itauq], &work[iwork], &i__2,
						                  &ierr);
						iwork = ie + *m;

						/* Perform bidiagonal QR iteration, computing left
						   singular vectors of L in WORK(IR) and computing
						   right singular vectors of L in WORK(IU)
						   (Workspace: need 2*M*M+BDSPAC) */

						NUMlapack_dbdsqr ("U", m, m, m, &c__0, &s[1], &work[ie], &work[iu], &ldwrku, &work[ir],
						                  &ldwrkr, dum, &c__1, &work[iwork], info);

						/* Multiply right singular vectors of L in WORK(IU)
						   by Q in A, storing result in VT (Workspace: need
						   M*M) */

						NUMblas_dgemm ("N", "N", m, n, m, &c_b438, &work[iu], &ldwrku, &a[a_offset], lda, &c_b416,
						               &vt[vt_offset], ldvt);

						/* Copy left singular vectors of L to A (Workspace:
						   need M*M) */

						NUMlapack_dlacpy ("F", m, m, &work[ir], &ldwrkr, &a[a_offset], lda);

					} else {

						/* Insufficient workspace for a fast algorithm */

						itau = 1;
						iwork = itau + *m;

						/* Compute A=L*Q, copying result to VT (Workspace:
						   need 2*M, prefer M+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgelqf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);
						NUMlapack_dlacpy ("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt);

						/* Generate Q in VT (Workspace: need 2*M, prefer
						   M+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorglq (m, n, m, &vt[vt_offset], ldvt, &work[itau], &work[iwork], &i__2,
						                  &ierr);
						ie = itau;
						itauq = ie + *m;
						itaup = itauq + *m;
						iwork = itaup + *m;

						/* Zero out above L in A */

						i__2 = *m - 1;
						i__3 = *m - 1;
						NUMlapack_dlaset ("U", &i__2, &i__3, &c_b416, &c_b416, &a_ref (1, 2), lda);

						/* Bidiagonalize L in A (Workspace: need 4*M, prefer
						   3*M+2*M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgebrd (m, m, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &work[itaup],
						                  &work[iwork], &i__2, &ierr);

						/* Multiply right vectors bidiagonalizing L by Q in
						   VT (Workspace: need 3*M+N, prefer 3*M+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dormbr ("P", "L", "T", m, n, m, &a[a_offset], lda, &work[itaup],
						                  &vt[vt_offset], ldvt, &work[iwork], &i__2, &ierr);

						/* Generate left bidiagonalizing vectors of L in A
						   (Workspace: need 4*M, prefer 3*M+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgbr ("Q", m, m, m, &a[a_offset], lda, &work[itauq], &work[iwork], &i__2,
						                  &ierr);
						iwork = ie + *m;

						/* Perform bidiagonal QR iteration, compute left
						   singular vectors of A in A and compute right
						   singular vectors of A in VT (Workspace: need
						   BDSPAC) */

						NUMlapack_dbdsqr ("U", m, n, m, &c__0, &s[1], &work[ie], &vt[vt_offset], ldvt,
						                  &a[a_offset], lda, dum, &c__1, &work[iwork], info);

					}

				} else if (wntuas) {

					/* Path 6t(N much larger than M, JOBU='S' or 'A',
					   JOBVT='S') M right singular vectors to be computed in
					   VT and M left singular vectors to be computed in U

					   Computing MAX */
					i__2 = *m << 2;
					if (*lwork >= *m * *m + MAX (i__2, bdspac)) {

						/* Sufficient workspace for a fast algorithm */

						iu = 1;
						if (*lwork >= wrkbl + *lda * *m) {

							/* WORK(IU) is LDA by N */

							ldwrku = *lda;
						} else {

							/* WORK(IU) is LDA by M */

							ldwrku = *m;
						}
						itau = iu + ldwrku * *m;
						iwork = itau + *m;

						/* Compute A=L*Q (Workspace: need M*M+2*M, prefer
						   M*M+M+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgelqf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);

						/* Copy L to WORK(IU), zeroing out above it */

						NUMlapack_dlacpy ("L", m, m, &a[a_offset], lda, &work[iu], &ldwrku);
						i__2 = *m - 1;
						i__3 = *m - 1;
						NUMlapack_dlaset ("U", &i__2, &i__3, &c_b416, &c_b416, &work[iu + ldwrku], &ldwrku);

						/* Generate Q in A (Workspace: need M*M+2*M, prefer
						   M*M+M+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorglq (m, n, m, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);
						ie = itau;
						itauq = ie + *m;
						itaup = itauq + *m;
						iwork = itaup + *m;

						/* Bidiagonalize L in WORK(IU), copying result to U
						   (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgebrd (m, m, &work[iu], &ldwrku, &s[1], &work[ie], &work[itauq],
						                  &work[itaup], &work[iwork], &i__2, &ierr);
						NUMlapack_dlacpy ("L", m, m, &work[iu], &ldwrku, &u[u_offset], ldu);

						/* Generate right bidiagonalizing vectors in WORK(IU)
						   (Workspace: need M*M+4*M-1, prefer
						   M*M+3*M+(M-1)*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgbr ("P", m, m, m, &work[iu], &ldwrku, &work[itaup], &work[iwork], &i__2,
						                  &ierr);

						/* Generate left bidiagonalizing vectors in U
						   (Workspace: need M*M+4*M, prefer M*M+3*M+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgbr ("Q", m, m, m, &u[u_offset], ldu, &work[itauq], &work[iwork], &i__2,
						                  &ierr);
						iwork = ie + *m;

						/* Perform bidiagonal QR iteration, computing left
						   singular vectors of L in U and computing right
						   singular vectors of L in WORK(IU) (Workspace: need
						   M*M+BDSPAC) */

						NUMlapack_dbdsqr ("U", m, m, m, &c__0, &s[1], &work[ie], &work[iu], &ldwrku,
						                  &u[u_offset], ldu, dum, &c__1, &work[iwork], info);

						/* Multiply right singular vectors of L in WORK(IU)
						   by Q in A, storing result in VT (Workspace: need
						   M*M) */

						NUMblas_dgemm ("N", "N", m, n, m, &c_b438, &work[iu], &ldwrku, &a[a_offset], lda, &c_b416,
						               &vt[vt_offset], ldvt);

					} else {

						/* Insufficient workspace for a fast algorithm */

						itau = 1;
						iwork = itau + *m;

						/* Compute A=L*Q, copying result to VT (Workspace:
						   need 2*M, prefer M+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgelqf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);
						NUMlapack_dlacpy ("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt);

						/* Generate Q in VT (Workspace: need 2*M, prefer
						   M+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorglq (m, n, m, &vt[vt_offset], ldvt, &work[itau], &work[iwork], &i__2,
						                  &ierr);

						/* Copy L to U, zeroing out above it */

						NUMlapack_dlacpy ("L", m, m, &a[a_offset], lda, &u[u_offset], ldu);
						i__2 = *m - 1;
						i__3 = *m - 1;
						NUMlapack_dlaset ("U", &i__2, &i__3, &c_b416, &c_b416, &u_ref (1, 2), ldu);
						ie = itau;
						itauq = ie + *m;
						itaup = itauq + *m;
						iwork = itaup + *m;

						/* Bidiagonalize L in U (Workspace: need 4*M, prefer
						   3*M+2*M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgebrd (m, m, &u[u_offset], ldu, &s[1], &work[ie], &work[itauq], &work[itaup],
						                  &work[iwork], &i__2, &ierr);

						/* Multiply right bidiagonalizing vectors in U by Q
						   in VT (Workspace: need 3*M+N, prefer 3*M+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dormbr ("P", "L", "T", m, n, m, &u[u_offset], ldu, &work[itaup],
						                  &vt[vt_offset], ldvt, &work[iwork], &i__2, &ierr);

						/* Generate left bidiagonalizing vectors in U
						   (Workspace: need 4*M, prefer 3*M+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgbr ("Q", m, m, m, &u[u_offset], ldu, &work[itauq], &work[iwork], &i__2,
						                  &ierr);
						iwork = ie + *m;

						/* Perform bidiagonal QR iteration, computing left
						   singular vectors of A in U and computing right
						   singular vectors of A in VT (Workspace: need
						   BDSPAC) */

						NUMlapack_dbdsqr ("U", m, n, m, &c__0, &s[1], &work[ie], &vt[vt_offset], ldvt,
						                  &u[u_offset], ldu, dum, &c__1, &work[iwork], info);

					}

				}

			} else if (wntva) {

				if (wntun) {

					/* Path 7t(N much larger than M, JOBU='N', JOBVT='A') N
					   right singular vectors to be computed in VT and no
					   left singular vectors to be computed

					   Computing MAX */
					i__2 = *n + *m, i__3 = *m << 2, i__2 = MAX (i__2, i__3);
					if (*lwork >= *m * *m + MAX (i__2, bdspac)) {

						/* Sufficient workspace for a fast algorithm */

						ir = 1;
						if (*lwork >= wrkbl + *lda * *m) {

							/* WORK(IR) is LDA by M */

							ldwrkr = *lda;
						} else {

							/* WORK(IR) is M by M */

							ldwrkr = *m;
						}
						itau = ir + ldwrkr * *m;
						iwork = itau + *m;

						/* Compute A=L*Q, copying result to VT (Workspace:
						   need M*M+2*M, prefer M*M+M+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgelqf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);
						NUMlapack_dlacpy ("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt);

						/* Copy L to WORK(IR), zeroing out above it */

						NUMlapack_dlacpy ("L", m, m, &a[a_offset], lda, &work[ir], &ldwrkr);
						i__2 = *m - 1;
						i__3 = *m - 1;
						NUMlapack_dlaset ("U", &i__2, &i__3, &c_b416, &c_b416, &work[ir + ldwrkr], &ldwrkr);

						/* Generate Q in VT (Workspace: need M*M+M+N, prefer
						   M*M+M+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorglq (n, n, m, &vt[vt_offset], ldvt, &work[itau], &work[iwork], &i__2,
						                  &ierr);
						ie = itau;
						itauq = ie + *m;
						itaup = itauq + *m;
						iwork = itaup + *m;

						/* Bidiagonalize L in WORK(IR) (Workspace: need
						   M*M+4*M, prefer M*M+3*M+2*M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgebrd (m, m, &work[ir], &ldwrkr, &s[1], &work[ie], &work[itauq],
						                  &work[itaup], &work[iwork], &i__2, &ierr);

						/* Generate right bidiagonalizing vectors in WORK(IR)
						   (Workspace: need M*M+4*M-1, prefer
						   M*M+3*M+(M-1)*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgbr ("P", m, m, m, &work[ir], &ldwrkr, &work[itaup], &work[iwork], &i__2,
						                  &ierr);
						iwork = ie + *m;

						/* Perform bidiagonal QR iteration, computing right
						   singular vectors of L in WORK(IR) (Workspace: need
						   M*M+BDSPAC) */

						NUMlapack_dbdsqr ("U", m, m, &c__0, &c__0, &s[1], &work[ie], &work[ir], &ldwrkr, dum,
						                  &c__1, dum, &c__1, &work[iwork], info);

						/* Multiply right singular vectors of L in WORK(IR)
						   by Q in VT, storing result in A (Workspace: need
						   M*M) */

						NUMblas_dgemm ("N", "N", m, n, m, &c_b438, &work[ir], &ldwrkr, &vt[vt_offset], ldvt, &c_b416,
						               &a[a_offset], lda);

						/* Copy right singular vectors of A from A to VT */

						NUMlapack_dlacpy ("F", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt);

					} else {

						/* Insufficient workspace for a fast algorithm */

						itau = 1;
						iwork = itau + *m;

						/* Compute A=L*Q, copying result to VT (Workspace:
						   need 2*M, prefer M+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgelqf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);
						NUMlapack_dlacpy ("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt);

						/* Generate Q in VT (Workspace: need M+N, prefer
						   M+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorglq (n, n, m, &vt[vt_offset], ldvt, &work[itau], &work[iwork], &i__2,
						                  &ierr);
						ie = itau;
						itauq = ie + *m;
						itaup = itauq + *m;
						iwork = itaup + *m;

						/* Zero out above L in A */

						i__2 = *m - 1;
						i__3 = *m - 1;
						NUMlapack_dlaset ("U", &i__2, &i__3, &c_b416, &c_b416, &a_ref (1, 2), lda);

						/* Bidiagonalize L in A (Workspace: need 4*M, prefer
						   3*M+2*M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgebrd (m, m, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &work[itaup],
						                  &work[iwork], &i__2, &ierr);

						/* Multiply right bidiagonalizing vectors in A by Q
						   in VT (Workspace: need 3*M+N, prefer 3*M+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dormbr ("P", "L", "T", m, n, m, &a[a_offset], lda, &work[itaup],
						                  &vt[vt_offset], ldvt, &work[iwork], &i__2, &ierr);
						iwork = ie + *m;

						/* Perform bidiagonal QR iteration, computing right
						   singular vectors of A in VT (Workspace: need
						   BDSPAC) */

						NUMlapack_dbdsqr ("U", m, n, &c__0, &c__0, &s[1], &work[ie], &vt[vt_offset], ldvt, dum,
						                  &c__1, dum, &c__1, &work[iwork], info);

					}

				} else if (wntuo) {

					/* Path 8t(N much larger than M, JOBU='O', JOBVT='A') N
					   right singular vectors to be computed in VT and M left
					   singular vectors to be overwritten on A

					   Computing MAX */
					i__2 = *n + *m, i__3 = *m << 2, i__2 = MAX (i__2, i__3);
					if (*lwork >= (*m << 1) * *m + MAX (i__2, bdspac)) {

						/* Sufficient workspace for a fast algorithm */

						iu = 1;
						if (*lwork >= wrkbl + (*lda << 1) * *m) {

							/* WORK(IU) is LDA by M and WORK(IR) is LDA by M */

							ldwrku = *lda;
							ir = iu + ldwrku * *m;
							ldwrkr = *lda;
						} else if (*lwork >= wrkbl + (*lda + *m) * *m) {

							/* WORK(IU) is LDA by M and WORK(IR) is M by M */

							ldwrku = *lda;
							ir = iu + ldwrku * *m;
							ldwrkr = *m;
						} else {

							/* WORK(IU) is M by M and WORK(IR) is M by M */

							ldwrku = *m;
							ir = iu + ldwrku * *m;
							ldwrkr = *m;
						}
						itau = ir + ldwrkr * *m;
						iwork = itau + *m;

						/* Compute A=L*Q, copying result to VT (Workspace:
						   need 2*M*M+2*M, prefer 2*M*M+M+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgelqf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);
						NUMlapack_dlacpy ("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt);

						/* Generate Q in VT (Workspace: need 2*M*M+M+N,
						   prefer 2*M*M+M+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorglq (n, n, m, &vt[vt_offset], ldvt, &work[itau], &work[iwork], &i__2,
						                  &ierr);

						/* Copy L to WORK(IU), zeroing out above it */

						NUMlapack_dlacpy ("L", m, m, &a[a_offset], lda, &work[iu], &ldwrku);
						i__2 = *m - 1;
						i__3 = *m - 1;
						NUMlapack_dlaset ("U", &i__2, &i__3, &c_b416, &c_b416, &work[iu + ldwrku], &ldwrku);
						ie = itau;
						itauq = ie + *m;
						itaup = itauq + *m;
						iwork = itaup + *m;

						/* Bidiagonalize L in WORK(IU), copying result to
						   WORK(IR) (Workspace: need 2*M*M+4*M, prefer
						   2*M*M+3*M+2*M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgebrd (m, m, &work[iu], &ldwrku, &s[1], &work[ie], &work[itauq],
						                  &work[itaup], &work[iwork], &i__2, &ierr);
						NUMlapack_dlacpy ("L", m, m, &work[iu], &ldwrku, &work[ir], &ldwrkr);

						/* Generate right bidiagonalizing vectors in WORK(IU)
						   (Workspace: need 2*M*M+4*M-1, prefer
						   2*M*M+3*M+(M-1)*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgbr ("P", m, m, m, &work[iu], &ldwrku, &work[itaup], &work[iwork], &i__2,
						                  &ierr);

						/* Generate left bidiagonalizing vectors in WORK(IR)
						   (Workspace: need 2*M*M+4*M, prefer 2*M*M+3*M+M*NB)
						 */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgbr ("Q", m, m, m, &work[ir], &ldwrkr, &work[itauq], &work[iwork], &i__2,
						                  &ierr);
						iwork = ie + *m;

						/* Perform bidiagonal QR iteration, computing left
						   singular vectors of L in WORK(IR) and computing
						   right singular vectors of L in WORK(IU)
						   (Workspace: need 2*M*M+BDSPAC) */

						NUMlapack_dbdsqr ("U", m, m, m, &c__0, &s[1], &work[ie], &work[iu], &ldwrku, &work[ir],
						                  &ldwrkr, dum, &c__1, &work[iwork], info);

						/* Multiply right singular vectors of L in WORK(IU)
						   by Q in VT, storing result in A (Workspace: need
						   M*M) */

						NUMblas_dgemm ("N", "N", m, n, m, &c_b438, &work[iu], &ldwrku, &vt[vt_offset], ldvt, &c_b416,
						               &a[a_offset], lda);

						/* Copy right singular vectors of A from A to VT */

						NUMlapack_dlacpy ("F", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt);

						/* Copy left singular vectors of A from WORK(IR) to A
						 */

						NUMlapack_dlacpy ("F", m, m, &work[ir], &ldwrkr, &a[a_offset], lda);

					} else {

						/* Insufficient workspace for a fast algorithm */

						itau = 1;
						iwork = itau + *m;

						/* Compute A=L*Q, copying result to VT (Workspace:
						   need 2*M, prefer M+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgelqf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);
						NUMlapack_dlacpy ("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt);

						/* Generate Q in VT (Workspace: need M+N, prefer
						   M+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorglq (n, n, m, &vt[vt_offset], ldvt, &work[itau], &work[iwork], &i__2,
						                  &ierr);
						ie = itau;
						itauq = ie + *m;
						itaup = itauq + *m;
						iwork = itaup + *m;

						/* Zero out above L in A */

						i__2 = *m - 1;
						i__3 = *m - 1;
						NUMlapack_dlaset ("U", &i__2, &i__3, &c_b416, &c_b416, &a_ref (1, 2), lda);

						/* Bidiagonalize L in A (Workspace: need 4*M, prefer
						   3*M+2*M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgebrd (m, m, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &work[itaup],
						                  &work[iwork], &i__2, &ierr);

						/* Multiply right bidiagonalizing vectors in A by Q
						   in VT (Workspace: need 3*M+N, prefer 3*M+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dormbr ("P", "L", "T", m, n, m, &a[a_offset], lda, &work[itaup],
						                  &vt[vt_offset], ldvt, &work[iwork], &i__2, &ierr);

						/* Generate left bidiagonalizing vectors in A
						   (Workspace: need 4*M, prefer 3*M+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgbr ("Q", m, m, m, &a[a_offset], lda, &work[itauq], &work[iwork], &i__2,
						                  &ierr);
						iwork = ie + *m;

						/* Perform bidiagonal QR iteration, computing left
						   singular vectors of A in A and computing right
						   singular vectors of A in VT (Workspace: need
						   BDSPAC) */

						NUMlapack_dbdsqr ("U", m, n, m, &c__0, &s[1], &work[ie], &vt[vt_offset], ldvt,
						                  &a[a_offset], lda, dum, &c__1, &work[iwork], info);

					}

				} else if (wntuas) {

					/* Path 9t(N much larger than M, JOBU='S' or 'A',
					   JOBVT='A') N right singular vectors to be computed in
					   VT and M left singular vectors to be computed in U

					   Computing MAX */
					i__2 = *n + *m, i__3 = *m << 2, i__2 = MAX (i__2, i__3);
					if (*lwork >= *m * *m + MAX (i__2, bdspac)) {

						/* Sufficient workspace for a fast algorithm */

						iu = 1;
						if (*lwork >= wrkbl + *lda * *m) {

							/* WORK(IU) is LDA by M */

							ldwrku = *lda;
						} else {

							/* WORK(IU) is M by M */

							ldwrku = *m;
						}
						itau = iu + ldwrku * *m;
						iwork = itau + *m;

						/* Compute A=L*Q, copying result to VT (Workspace:
						   need M*M+2*M, prefer M*M+M+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgelqf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);
						NUMlapack_dlacpy ("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt);

						/* Generate Q in VT (Workspace: need M*M+M+N, prefer
						   M*M+M+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorglq (n, n, m, &vt[vt_offset], ldvt, &work[itau], &work[iwork], &i__2,
						                  &ierr);

						/* Copy L to WORK(IU), zeroing out above it */

						NUMlapack_dlacpy ("L", m, m, &a[a_offset], lda, &work[iu], &ldwrku);
						i__2 = *m - 1;
						i__3 = *m - 1;
						NUMlapack_dlaset ("U", &i__2, &i__3, &c_b416, &c_b416, &work[iu + ldwrku], &ldwrku);
						ie = itau;
						itauq = ie + *m;
						itaup = itauq + *m;
						iwork = itaup + *m;

						/* Bidiagonalize L in WORK(IU), copying result to U
						   (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgebrd (m, m, &work[iu], &ldwrku, &s[1], &work[ie], &work[itauq],
						                  &work[itaup], &work[iwork], &i__2, &ierr);
						NUMlapack_dlacpy ("L", m, m, &work[iu], &ldwrku, &u[u_offset], ldu);

						/* Generate right bidiagonalizing vectors in WORK(IU)
						   (Workspace: need M*M+4*M, prefer M*M+3*M+(M-1)*NB)
						 */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgbr ("P", m, m, m, &work[iu], &ldwrku, &work[itaup], &work[iwork], &i__2,
						                  &ierr);

						/* Generate left bidiagonalizing vectors in U
						   (Workspace: need M*M+4*M, prefer M*M+3*M+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgbr ("Q", m, m, m, &u[u_offset], ldu, &work[itauq], &work[iwork], &i__2,
						                  &ierr);
						iwork = ie + *m;

						/* Perform bidiagonal QR iteration, computing left
						   singular vectors of L in U and computing right
						   singular vectors of L in WORK(IU) (Workspace: need
						   M*M+BDSPAC) */

						NUMlapack_dbdsqr ("U", m, m, m, &c__0, &s[1], &work[ie], &work[iu], &ldwrku,
						                  &u[u_offset], ldu, dum, &c__1, &work[iwork], info);

						/* Multiply right singular vectors of L in WORK(IU)
						   by Q in VT, storing result in A (Workspace: need
						   M*M) */

						NUMblas_dgemm ("N", "N", m, n, m, &c_b438, &work[iu], &ldwrku, &vt[vt_offset], ldvt, &c_b416,
						               &a[a_offset], lda);

						/* Copy right singular vectors of A from A to VT */

						NUMlapack_dlacpy ("F", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt);

					} else {

						/* Insufficient workspace for a fast algorithm */

						itau = 1;
						iwork = itau + *m;

						/* Compute A=L*Q, copying result to VT (Workspace:
						   need 2*M, prefer M+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgelqf (m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, &ierr);
						NUMlapack_dlacpy ("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt);

						/* Generate Q in VT (Workspace: need M+N, prefer
						   M+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorglq (n, n, m, &vt[vt_offset], ldvt, &work[itau], &work[iwork], &i__2,
						                  &ierr);

						/* Copy L to U, zeroing out above it */

						NUMlapack_dlacpy ("L", m, m, &a[a_offset], lda, &u[u_offset], ldu);
						i__2 = *m - 1;
						i__3 = *m - 1;
						NUMlapack_dlaset ("U", &i__2, &i__3, &c_b416, &c_b416, &u_ref (1, 2), ldu);
						ie = itau;
						itauq = ie + *m;
						itaup = itauq + *m;
						iwork = itaup + *m;

						/* Bidiagonalize L in U (Workspace: need 4*M, prefer
						   3*M+2*M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dgebrd (m, m, &u[u_offset], ldu, &s[1], &work[ie], &work[itauq], &work[itaup],
						                  &work[iwork], &i__2, &ierr);

						/* Multiply right bidiagonalizing vectors in U by Q
						   in VT (Workspace: need 3*M+N, prefer 3*M+N*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dormbr ("P", "L", "T", m, n, m, &u[u_offset], ldu, &work[itaup],
						                  &vt[vt_offset], ldvt, &work[iwork], &i__2, &ierr);

						/* Generate left bidiagonalizing vectors in U
						   (Workspace: need 4*M, prefer 3*M+M*NB) */

						i__2 = *lwork - iwork + 1;
						NUMlapack_dorgbr ("Q", m, m, m, &u[u_offset], ldu, &work[itauq], &work[iwork], &i__2,
						                  &ierr);
						iwork = ie + *m;

						/* Perform bidiagonal QR iteration, computing left
						   singular vectors of A in U and computing right
						   singular vectors of A in VT (Workspace: need
						   BDSPAC) */

						NUMlapack_dbdsqr ("U", m, n, m, &c__0, &s[1], &work[ie], &vt[vt_offset], ldvt,
						                  &u[u_offset], ldu, dum, &c__1, &work[iwork], info);

					}

				}

			}

		} else {

			/* N .LT. MNTHR

			   Path 10t(N greater than M, but not much larger) Reduce to
			   bidiagonal form without LQ decomposition */

			ie = 1;
			itauq = ie + *m;
			itaup = itauq + *m;
			iwork = itaup + *m;

			/* Bidiagonalize A (Workspace: need 3*M+N, prefer 3*M+(M+N)*NB) */

			i__2 = *lwork - iwork + 1;
			NUMlapack_dgebrd (m, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &work[itaup],
			                  &work[iwork], &i__2, &ierr);
			if (wntuas) {

				/* If left singular vectors desired in U, copy result to U
				   and generate left bidiagonalizing vectors in U (Workspace:
				   need 4*M-1, prefer 3*M+(M-1)*NB) */

				NUMlapack_dlacpy ("L", m, m, &a[a_offset], lda, &u[u_offset], ldu);
				i__2 = *lwork - iwork + 1;
				NUMlapack_dorgbr ("Q", m, m, n, &u[u_offset], ldu, &work[itauq], &work[iwork], &i__2, &ierr);
			}
			if (wntvas) {

				/* If right singular vectors desired in VT, copy result to VT
				   and generate right bidiagonalizing vectors in VT
				   (Workspace: need 3*M+NRVT, prefer 3*M+NRVT*NB) */

				NUMlapack_dlacpy ("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
				if (wntva) {
					nrvt = *n;
				}
				if (wntvs) {
					nrvt = *m;
				}
				i__2 = *lwork - iwork + 1;
				NUMlapack_dorgbr ("P", &nrvt, n, m, &vt[vt_offset], ldvt, &work[itaup], &work[iwork], &i__2,
				                  &ierr);
			}
			if (wntuo) {

				/* If left singular vectors desired in A, generate left
				   bidiagonalizing vectors in A (Workspace: need 4*M-1,
				   prefer 3*M+(M-1)*NB) */

				i__2 = *lwork - iwork + 1;
				NUMlapack_dorgbr ("Q", m, m, n, &a[a_offset], lda, &work[itauq], &work[iwork], &i__2, &ierr);
			}
			if (wntvo) {

				/* If right singular vectors desired in A, generate right
				   bidiagonalizing vectors in A (Workspace: need 4*M, prefer
				   3*M+M*NB) */

				i__2 = *lwork - iwork + 1;
				NUMlapack_dorgbr ("P", m, n, m, &a[a_offset], lda, &work[itaup], &work[iwork], &i__2, &ierr);
			}
			iwork = ie + *m;
			if (wntuas || wntuo) {
				nru = *m;
			}
			if (wntun) {
				nru = 0;
			}
			if (wntvas || wntvo) {
				ncvt = *n;
			}
			if (wntvn) {
				ncvt = 0;
			}
			if (!wntuo && !wntvo) {

				/* Perform bidiagonal QR iteration, if desired, computing
				   left singular vectors in U and computing right singular
				   vectors in VT (Workspace: need BDSPAC) */

				NUMlapack_dbdsqr ("L", m, &ncvt, &nru, &c__0, &s[1], &work[ie], &vt[vt_offset], ldvt,
				                  &u[u_offset], ldu, dum, &c__1, &work[iwork], info);
			} else if (!wntuo && wntvo) {

				/* Perform bidiagonal QR iteration, if desired, computing
				   left singular vectors in U and computing right singular
				   vectors in A (Workspace: need BDSPAC) */

				NUMlapack_dbdsqr ("L", m, &ncvt, &nru, &c__0, &s[1], &work[ie], &a[a_offset], lda, &u[u_offset],
				                  ldu, dum, &c__1, &work[iwork], info);
			} else {

				/* Perform bidiagonal QR iteration, if desired, computing
				   left singular vectors in A and computing right singular
				   vectors in VT (Workspace: need BDSPAC) */

				NUMlapack_dbdsqr ("L", m, &ncvt, &nru, &c__0, &s[1], &work[ie], &vt[vt_offset], ldvt,
				                  &a[a_offset], lda, dum, &c__1, &work[iwork], info);
			}

		}

	}

	/* If DBDSQR failed to converge, copy unconverged superdiagonals to WORK(
	   2:MINMN ) */

	if (*info != 0) {
		if (ie > 2) {
			i__2 = minmn - 1;
			for (i__ = 1; i__ <= i__2; ++i__) {
				work[i__ + 1] = work[i__ + ie - 1];
				/* L50: */
			}
		}
		if (ie < 2) {
			for (i__ = minmn - 1; i__ >= 1; --i__) {
				work[i__ + 1] = work[i__ + ie - 1];
				/* L60: */
			}
		}
	}

	/* Undo scaling if necessary */

	if (iscl == 1) {
		if (anrm > bignum) {
			NUMlapack_dlascl ("G", &c__0, &c__0, &bignum, &anrm, &minmn, &c__1, &s[1], &minmn, &ierr);
		}
		if (*info != 0 && anrm > bignum) {
			i__2 = minmn - 1;
			NUMlapack_dlascl ("G", &c__0, &c__0, &bignum, &anrm, &i__2, &c__1, &work[2], &minmn, &ierr);
		}
		if (anrm < smlnum) {
			NUMlapack_dlascl ("G", &c__0, &c__0, &smlnum, &anrm, &minmn, &c__1, &s[1], &minmn, &ierr);
		}
		if (*info != 0 && anrm < smlnum) {
			i__2 = minmn - 1;
			NUMlapack_dlascl ("G", &c__0, &c__0, &smlnum, &anrm, &i__2, &c__1, &work[2], &minmn, &ierr);
		}
	}

	/* Return optimal workspace in WORK(1) */

	work[1] = (double) maxwrk;
	return 0;
}								/* NUMlapack_dgesvd */

#undef vt_ref
#undef u_ref

int NUMlapack_dgetf2 (integer *m, integer *n, double *a, integer *lda, integer *ipiv, integer *info) {
	/* Table of constant values */
	static integer c__1 = 1;
	static double c_b6 = -1.;

	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2, i__3;
	double d__1;

	/* Local variables */
	static integer j;
	static integer jp;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--ipiv;

	/* Function Body */
	*info = 0;
	if (*m < 0) {
		*info = -1;
	} else if (*n < 0) {
		*info = -2;
	} else if (*lda < MAX (1, *m)) {
		*info = -4;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DGETF2", &i__1);
		return 0;
	}

	/* Quick return if possible */

	if (*m == 0 || *n == 0) {
		return 0;
	}

	i__1 = MIN (*m, *n);
	for (j = 1; j <= i__1; ++j) {

		/* Find pivot and test for singularity. */

		i__2 = *m - j + 1;
		jp = j - 1 + NUMblas_idamax (&i__2, &a_ref (j, j), &c__1);
		ipiv[j] = jp;
		if (a_ref (jp, j) != 0.) {

			/* Apply the interchange to columns 1:N. */

			if (jp != j) {
				NUMblas_dswap (n, &a_ref (j, 1), lda, &a_ref (jp, 1), lda);
			}

			/* Compute elements J+1:M of J-th column. */

			if (j < *m) {
				i__2 = *m - j;
				d__1 = 1. / a_ref (j, j);
				NUMblas_dscal (&i__2, &d__1, &a_ref (j + 1, j), &c__1);
			}

		} else if (*info == 0) {

			*info = j;
		}

		if (j < MIN (*m, *n)) {

			/* Update trailing submatrix. */

			i__2 = *m - j;
			i__3 = *n - j;
			NUMblas_dger (&i__2, &i__3, &c_b6, &a_ref (j + 1, j), &c__1, &a_ref (j, j + 1), lda, &a_ref (j + 1,
			              j + 1), lda);
		}
		/* L10: */
	}
	return 0;
}								/* NUMlapack_dgetf2 */

int NUMlapack_dgetri (integer *n, double *a, integer *lda, integer *ipiv, double *work, integer *lwork, integer *info) {
	/* Table of constant values */
	static integer c__1 = 1;
	static integer c_n1 = -1;
	static integer c__2 = 2;
	static double c_b20 = -1.;
	static double c_b22 = 1.;

	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2, i__3;

	/* Local variables */
	static integer i__, j;
	static integer nbmin;
	static integer jb, nb, jj, jp, nn;
	static integer ldwork;
	static integer lwkopt;
	static integer lquery;
	static integer iws;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--ipiv;
	--work;

	/* Function Body */
	*info = 0;
	nb = NUMlapack_ilaenv (&c__1, "DGETRI", " ", n, &c_n1, &c_n1, &c_n1, 6, 1);
	lwkopt = *n * nb;
	work[1] = (double) lwkopt;
	lquery = *lwork == -1;
	if (*n < 0) {
		*info = -1;
	} else if (*lda < MAX (1, *n)) {
		*info = -3;
	} else if (*lwork < MAX (1, *n) && !lquery) {
		*info = -6;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DGETRI", &i__1);
		return 0;
	} else if (lquery) {
		return 0;
	}

	/* Quick return if possible */

	if (*n == 0) {
		return 0;
	}

	/* Form inv(U).  If INFO > 0 from DTRTRI, then U is singular, and the
	   inverse is not computed. */

	NUMlapack_dtrtri ("Upper", "Non-unit", n, &a[a_offset], lda, info);
	if (*info > 0) {
		return 0;
	}

	nbmin = 2;
	ldwork = *n;
	if (nb > 1 && nb < *n) {
		/* Computing MAX */
		i__1 = ldwork * nb;
		iws = MAX (i__1, 1);
		if (*lwork < iws) {
			nb = *lwork / ldwork;
			/* Computing MAX */
			i__1 = 2, i__2 = NUMlapack_ilaenv (&c__2, "DGETRI", " ", n, &c_n1, &c_n1, &c_n1, 6, 1);
			nbmin = MAX (i__1, i__2);
		}
	} else {
		iws = *n;
	}

	/* Solve the equation inv(A)*L = inv(U) for inv(A). */

	if (nb < nbmin || nb >= *n) {

		/* Use unblocked code. */

		for (j = *n; j >= 1; --j) {

			/* Copy current column of L to WORK and replace with zeros. */

			i__1 = *n;
			for (i__ = j + 1; i__ <= i__1; ++i__) {
				work[i__] = a_ref (i__, j);
				a_ref (i__, j) = 0.;
				/* L10: */
			}

			/* Compute current column of inv(A). */

			if (j < *n) {
				i__1 = *n - j;
				NUMblas_dgemv ("No transpose", n, &i__1, &c_b20, &a_ref (1, j + 1), lda, &work[j + 1], &c__1, &c_b22,
				               &a_ref (1, j), &c__1);
			}
			/* L20: */
		}
	} else {

		/* Use blocked code. */

		nn = (*n - 1) / nb * nb + 1;
		i__1 = -nb;
		for (j = nn; i__1 < 0 ? j >= 1 : j <= 1; j += i__1) {
			/* Computing MIN */
			i__2 = nb, i__3 = *n - j + 1;
			jb = MIN (i__2, i__3);

			/* Copy current block column of L to WORK and replace with zeros.
			 */

			i__2 = j + jb - 1;
			for (jj = j; jj <= i__2; ++jj) {
				i__3 = *n;
				for (i__ = jj + 1; i__ <= i__3; ++i__) {
					work[i__ + (jj - j) * ldwork] = a_ref (i__, jj);
					a_ref (i__, jj) = 0.;
					/* L30: */
				}
				/* L40: */
			}

			/* Compute current block column of inv(A). */

			if (j + jb <= *n) {
				i__2 = *n - j - jb + 1;
				NUMblas_dgemm ("No transpose", "No transpose", n, &jb, &i__2, &c_b20, &a_ref (1, j + jb), lda,
				               &work[j + jb], &ldwork, &c_b22, &a_ref (1, j), lda);
			}
			NUMblas_dtrsm ("Right", "Lower", "No transpose", "Unit", n, &jb, &c_b22, &work[j], &ldwork, &a_ref (1,
			               j), lda);
			/* L50: */
		}
	}

	/* Apply column interchanges. */

	for (j = *n - 1; j >= 1; --j) {
		jp = ipiv[j];
		if (jp != j) {
			NUMblas_dswap (n, &a_ref (1, j), &c__1, &a_ref (1, jp), &c__1);
		}
		/* L60: */
	}

	work[1] = (double) iws;
	return 0;
}								/* NUMlapack_dgetri */

int NUMlapack_dgetrf (integer *m, integer *n, double *a, integer *lda, integer *ipiv, integer *info) {
	/* Table of constant values */
	static integer c__1 = 1;
	static integer c_n1 = -1;
	static double c_b16 = 1.;
	static double c_b19 = -1.;

	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;

	/* Local variables */
	static integer i__, j;
	static integer iinfo;
	static integer jb, nb;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--ipiv;

	/* Function Body */
	*info = 0;
	if (*m < 0) {
		*info = -1;
	} else if (*n < 0) {
		*info = -2;
	} else if (*lda < MAX (1, *m)) {
		*info = -4;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DGETRF", &i__1);
		return 0;
	}

	/* Quick return if possible */

	if (*m == 0 || *n == 0) {
		return 0;
	}

	/* Determine the block size for this environment. */

	nb = NUMlapack_ilaenv (&c__1, "DGETRF", " ", m, n, &c_n1, &c_n1, 6, 1);
	if (nb <= 1 || nb >= MIN (*m, *n)) {

		/* Use unblocked code. */

		NUMlapack_dgetf2 (m, n, &a[a_offset], lda, &ipiv[1], info);
	} else {

		/* Use blocked code. */

		i__1 = MIN (*m, *n);
		i__2 = nb;
		for (j = 1; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) {
			/* Computing MIN */
			i__3 = MIN (*m, *n) - j + 1;
			jb = MIN (i__3, nb);

			/* Factor diagonal and subdiagonal blocks and test for exact
			   singularity. */

			i__3 = *m - j + 1;
			NUMlapack_dgetf2 (&i__3, &jb, &a_ref (j, j), lda, &ipiv[j], &iinfo);

			/* Adjust INFO and the pivot indices. */

			if (*info == 0 && iinfo > 0) {
				*info = iinfo + j - 1;
			}
			/* Computing MIN */
			i__4 = *m, i__5 = j + jb - 1;
			i__3 = MIN (i__4, i__5);
			for (i__ = j; i__ <= i__3; ++i__) {
				ipiv[i__] = j - 1 + ipiv[i__];
				/* L10: */
			}

			/* Apply interchanges to columns 1:J-1. */

			i__3 = j - 1;
			i__4 = j + jb - 1;
			NUMlapack_dlaswp (&i__3, &a[a_offset], lda, &j, &i__4, &ipiv[1], &c__1);

			if (j + jb <= *n) {

				/* Apply interchanges to columns J+JB:N. */

				i__3 = *n - j - jb + 1;
				i__4 = j + jb - 1;
				NUMlapack_dlaswp (&i__3, &a_ref (1, j + jb), lda, &j, &i__4, &ipiv[1], &c__1);

				/* Compute block row of U. */

				i__3 = *n - j - jb + 1;
				NUMblas_dtrsm ("Left", "Lower", "No transpose", "Unit", &jb, &i__3, &c_b16, &a_ref (j, j), lda,
				               &a_ref (j, j + jb), lda);
				if (j + jb <= *m) {

					/* Update trailing submatrix. */

					i__3 = *m - j - jb + 1;
					i__4 = *n - j - jb + 1;
					NUMblas_dgemm ("No transpose", "No transpose", &i__3, &i__4, &jb, &c_b19, &a_ref (j + jb, j),
					               lda, &a_ref (j, j + jb), lda, &c_b16, &a_ref (j + jb, j + jb), lda);
				}
			}
			/* L20: */
		}
	}
	return 0;
}								/* NUMlapack_dgetrf */

int NUMlapack_dgetrs (const char *trans, integer *n, integer *nrhs, double *a, integer *lda, integer *ipiv, double *b, integer *ldb,
                      integer *info) {
	/* Table of constant values */
	static integer c__1 = 1;
	static double c_b12 = 1.;
	static integer c_n1 = -1;

	/* System generated locals */
	integer a_dim1, a_offset, b_dim1, b_offset, i__1;

	/* Local variables */
	static integer notran;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--ipiv;
	b_dim1 = *ldb;
	b_offset = 1 + b_dim1 * 1;
	b -= b_offset;

	/* Function Body */
	*info = 0;
	notran = lsame_ (trans, "N");
	if (!notran && !lsame_ (trans, "T") && !lsame_ (trans, "C")) {
		*info = -1;
	} else if (*n < 0) {
		*info = -2;
	} else if (*nrhs < 0) {
		*info = -3;
	} else if (*lda < MAX (1, *n)) {
		*info = -5;
	} else if (*ldb < MAX (1, *n)) {
		*info = -8;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DGETRS", &i__1);
		return 0;
	}

	/* Quick return if possible */

	if (*n == 0 || *nrhs == 0) {
		return 0;
	}

	if (notran) {

		/* Solve A * X = B.

		   Apply row interchanges to the right hand sides. */

		NUMlapack_dlaswp (nrhs, &b[b_offset], ldb, &c__1, n, &ipiv[1], &c__1);

		/* Solve L*X = B, overwriting B with X. */

		NUMblas_dtrsm ("Left", "Lower", "No transpose", "Unit", n, nrhs, &c_b12, &a[a_offset], lda, &b[b_offset],
		               ldb);

		/* Solve U*X = B, overwriting B with X. */

		NUMblas_dtrsm ("Left", "Upper", "No transpose", "Non-unit", n, nrhs, &c_b12, &a[a_offset], lda, &b[b_offset],
		               ldb);
	} else {

		/* Solve A' * X = B.

		   Solve U'*X = B, overwriting B with X. */

		NUMblas_dtrsm ("Left", "Upper", "Transpose", "Non-unit", n, nrhs, &c_b12, &a[a_offset], lda, &b[b_offset],
		               ldb);

		/* Solve L'*X = B, overwriting B with X. */

		NUMblas_dtrsm ("Left", "Lower", "Transpose", "Unit", n, nrhs, &c_b12, &a[a_offset], lda, &b[b_offset], ldb);

		/* Apply row interchanges to the solution vectors. */

		NUMlapack_dlaswp (nrhs, &b[b_offset], ldb, &c__1, n, &ipiv[1], &c_n1);
	}

	return 0;
}								/* NUMlapack_dgetrs */

int NUMlapack_dggsvd (const char *jobu, const char *jobv, const char *jobq, integer *m, integer *n, integer *p, integer *k, integer *l,
                      double *a, integer *lda, double *b, integer *ldb, double *alpha, double *beta, double *u, integer *ldu, double *v,
                      integer *ldv, double *q, integer *ldq, double *work, integer *iwork, integer *info) {
	/* Table of constant values */
	static integer c__1 = 1;

	/* System generated locals */
	integer a_dim1, a_offset, b_dim1, b_offset, q_dim1, q_offset, u_dim1, u_offset, v_dim1, v_offset, i__1, i__2;

	/* Local variables */
	static integer ibnd;
	static double tola;
	static integer isub;
	static double tolb, unfl, temp, smax;
	static integer i__, j;
	static double anorm, bnorm;
	static integer wantq, wantu, wantv;
	static integer ncycle;
	static double ulp;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	b_dim1 = *ldb;
	b_offset = 1 + b_dim1 * 1;
	b -= b_offset;
	--alpha;
	--beta;
	u_dim1 = *ldu;
	u_offset = 1 + u_dim1 * 1;
	u -= u_offset;
	v_dim1 = *ldv;
	v_offset = 1 + v_dim1 * 1;
	v -= v_offset;
	q_dim1 = *ldq;
	q_offset = 1 + q_dim1 * 1;
	q -= q_offset;
	--work;
	--iwork;

	/* Function Body */
	wantu = lsame_ (jobu, "U");
	wantv = lsame_ (jobv, "V");
	wantq = lsame_ (jobq, "Q");

	*info = 0;
	if (! (wantu || lsame_ (jobu, "N"))) {
		*info = -1;
	} else if (! (wantv || lsame_ (jobv, "N"))) {
		*info = -2;
	} else if (! (wantq || lsame_ (jobq, "N"))) {
		*info = -3;
	} else if (*m < 0) {
		*info = -4;
	} else if (*n < 0) {
		*info = -5;
	} else if (*p < 0) {
		*info = -6;
	} else if (*lda < MAX (1, *m)) {
		*info = -10;
	} else if (*ldb < MAX (1, *p)) {
		*info = -12;
	} else if (*ldu < 1 || wantu && *ldu < *m) {
		*info = -16;
	} else if (*ldv < 1 || wantv && *ldv < *p) {
		*info = -18;
	} else if (*ldq < 1 || wantq && *ldq < *n) {
		*info = -20;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DGGSVD", &i__1);
		return 0;
	}

	/* Compute the Frobenius norm of matrices A and B */

	anorm = NUMlapack_dlange ("1", m, n, &a[a_offset], lda, &work[1]);
	bnorm = NUMlapack_dlange ("1", p, n, &b[b_offset], ldb, &work[1]);

	/* Get machine precision and set up threshold for determining the
	   effective numerical rank of the matrices A and B. */

	ulp = NUMblas_dlamch ("Precision");
	unfl = NUMblas_dlamch ("Safe Minimum");
	tola = MAX (*m, *n) * MAX (anorm, unfl) * ulp;
	tolb = MAX (*p, *n) * MAX (bnorm, unfl) * ulp;

	/* Preprocessing */

	NUMlapack_dggsvp (jobu, jobv, jobq, m, p, n, &a[a_offset], lda, &b[b_offset], ldb, &tola, &tolb, k, l,
	                  &u[u_offset], ldu, &v[v_offset], ldv, &q[q_offset], ldq, &iwork[1], &work[1], &work[*n + 1], info);

	/* Compute the GSVD of two upper "triangular" matrices */

	NUMlapack_dtgsja (jobu, jobv, jobq, m, p, n, k, l, &a[a_offset], lda, &b[b_offset], ldb, &tola, &tolb,
	                  &alpha[1], &beta[1], &u[u_offset], ldu, &v[v_offset], ldv, &q[q_offset], ldq, &work[1], &ncycle,
	                  info);

	/* Sort the singular values and store the pivot indices in IWORK Copy
	   ALPHA to WORK, then sort ALPHA in WORK */

	NUMblas_dcopy (n, &alpha[1], &c__1, &work[1], &c__1);
	/* Computing MIN */
	i__1 = *l, i__2 = *m - *k;
	ibnd = MIN (i__1, i__2);
	i__1 = ibnd;
	for (i__ = 1; i__ <= i__1; ++i__) {

		/* Scan for largest ALPHA(K+I) */

		isub = i__;
		smax = work[*k + i__];
		i__2 = ibnd;
		for (j = i__ + 1; j <= i__2; ++j) {
			temp = work[*k + j];
			if (temp > smax) {
				isub = j;
				smax = temp;
			}
			/* L10: */
		}
		if (isub != i__) {
			work[*k + isub] = work[*k + i__];
			work[*k + i__] = smax;
			iwork[*k + i__] = *k + isub;
		} else {
			iwork[*k + i__] = *k + i__;
		}
		/* L20: */
	}

	return 0;
}								/* NUMlapack_dggsvd */

#define b_ref(a_1,a_2) b[(a_2)*b_dim1 + a_1]
#define u_ref(a_1,a_2) u[(a_2)*u_dim1 + a_1]
#define v_ref(a_1,a_2) v[(a_2)*v_dim1 + a_1]

int NUMlapack_dggsvp (const char *jobu, const char *jobv, const char *jobq, integer *m, integer *p, integer *n, double *a, integer *lda,
                      double *b, integer *ldb, double *tola, double *tolb, integer *k, integer *l, double *u, integer *ldu, double *v,
                      integer *ldv, double *q, integer *ldq, integer *iwork, double *tau, double *work, integer *info) {
	/* Table of constant values */
	static double c_b12 = 0.;
	static double c_b22 = 1.;

	/* System generated locals */
	integer a_dim1, a_offset, b_dim1, b_offset, q_dim1, q_offset, u_dim1, u_offset, v_dim1, v_offset, i__1, i__2,
	     i__3;
	double d__1;

	/* Local variables */
	static integer i__, j;
	static integer wantq, wantu, wantv;
	static integer forwrd;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	b_dim1 = *ldb;
	b_offset = 1 + b_dim1 * 1;
	b -= b_offset;
	u_dim1 = *ldu;
	u_offset = 1 + u_dim1 * 1;
	u -= u_offset;
	v_dim1 = *ldv;
	v_offset = 1 + v_dim1 * 1;
	v -= v_offset;
	q_dim1 = *ldq;
	q_offset = 1 + q_dim1 * 1;
	q -= q_offset;
	--iwork;
	--tau;
	--work;

	/* Function Body */
	wantu = lsame_ (jobu, "U");
	wantv = lsame_ (jobv, "V");
	wantq = lsame_ (jobq, "Q");
	forwrd = TRUE;

	*info = 0;
	if (! (wantu || lsame_ (jobu, "N"))) {
		*info = -1;
	} else if (! (wantv || lsame_ (jobv, "N"))) {
		*info = -2;
	} else if (! (wantq || lsame_ (jobq, "N"))) {
		*info = -3;
	} else if (*m < 0) {
		*info = -4;
	} else if (*p < 0) {
		*info = -5;
	} else if (*n < 0) {
		*info = -6;
	} else if (*lda < MAX (1, *m)) {
		*info = -8;
	} else if (*ldb < MAX (1, *p)) {
		*info = -10;
	} else if (*ldu < 1 || wantu && *ldu < *m) {
		*info = -16;
	} else if (*ldv < 1 || wantv && *ldv < *p) {
		*info = -18;
	} else if (*ldq < 1 || wantq && *ldq < *n) {
		*info = -20;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DGGSVP", &i__1);
		return 0;
	}

	/* QR with column pivoting of B: B*P = V*( S11 S12 ) ( 0 0 ) */

	i__1 = *n;
	for (i__ = 1; i__ <= i__1; ++i__) {
		iwork[i__] = 0;
		/* L10: */
	}
	NUMlapack_dgeqpf (p, n, &b[b_offset], ldb, &iwork[1], &tau[1], &work[1], info);

	/* Update A := A*P */

	NUMlapack_dlapmt (&forwrd, m, n, &a[a_offset], lda, &iwork[1]);

	/* Determine the effective rank of matrix B. */

	*l = 0;
	i__1 = MIN (*p, *n);
	for (i__ = 1; i__ <= i__1; ++i__) {
		if ( (d__1 = b_ref (i__, i__), fabs (d__1)) > *tolb) {
			++ (*l);
		}
		/* L20: */
	}

	if (wantv) {

		/* Copy the details of V, and form V. */

		NUMlapack_dlaset ("Full", p, p, &c_b12, &c_b12, &v[v_offset], ldv);
		if (*p > 1) {
			i__1 = *p - 1;
			NUMlapack_dlacpy ("Lower", &i__1, n, &b_ref (2, 1), ldb, &v_ref (2, 1), ldv);
		}
		i__1 = MIN (*p, *n);
		NUMlapack_dorg2r (p, p, &i__1, &v[v_offset], ldv, &tau[1], &work[1], info);
	}

	/* Clean up B */

	i__1 = *l - 1;
	for (j = 1; j <= i__1; ++j) {
		i__2 = *l;
		for (i__ = j + 1; i__ <= i__2; ++i__) {
			b_ref (i__, j) = 0.;
			/* L30: */
		}
		/* L40: */
	}
	if (*p > *l) {
		i__1 = *p - *l;
		NUMlapack_dlaset ("Full", &i__1, n, &c_b12, &c_b12, &b_ref (*l + 1, 1), ldb);
	}

	if (wantq) {

		/* Set Q = I and Update Q := Q*P */

		NUMlapack_dlaset ("Full", n, n, &c_b12, &c_b22, &q[q_offset], ldq);
		NUMlapack_dlapmt (&forwrd, n, n, &q[q_offset], ldq, &iwork[1]);
	}

	if (*p >= *l && *n != *l) {

		/* RQ factorization of (S11 S12): ( S11 S12 ) = ( 0 S12 )*Z */

		NUMlapack_dgerq2 (l, n, &b[b_offset], ldb, &tau[1], &work[1], info);

		/* Update A := A*Z' */

		NUMlapack_dormr2 ("Right", "Transpose", m, n, l, &b[b_offset], ldb, &tau[1], &a[a_offset], lda,
		                  &work[1], info);

		if (wantq) {

			/* Update Q := Q*Z' */

			NUMlapack_dormr2 ("Right", "Transpose", n, n, l, &b[b_offset], ldb, &tau[1], &q[q_offset], ldq,
			                  &work[1], info);
		}

		/* Clean up B */

		i__1 = *n - *l;
		NUMlapack_dlaset ("Full", l, &i__1, &c_b12, &c_b12, &b[b_offset], ldb);
		i__1 = *n;
		for (j = *n - *l + 1; j <= i__1; ++j) {
			i__2 = *l;
			for (i__ = j - *n + *l + 1; i__ <= i__2; ++i__) {
				b_ref (i__, j) = 0.;
				/* L50: */
			}
			/* L60: */
		}

	}

	/* Let N-L L A = ( A11 A12 ) M,

	   then the following does the complete QR decomposition of A11:

	   A11 = U*( 0 T12 )*P1' ( 0 0 ) */

	i__1 = *n - *l;
	for (i__ = 1; i__ <= i__1; ++i__) {
		iwork[i__] = 0;
		/* L70: */
	}
	i__1 = *n - *l;
	NUMlapack_dgeqpf (m, &i__1, &a[a_offset], lda, &iwork[1], &tau[1], &work[1], info);

	/* Determine the effective rank of A11 */

	*k = 0;
	/* Computing MIN */
	i__2 = *m, i__3 = *n - *l;
	i__1 = MIN (i__2, i__3);
	for (i__ = 1; i__ <= i__1; ++i__) {
		if ( (d__1 = a_ref (i__, i__), fabs (d__1)) > *tola) {
			++ (*k);
		}
		/* L80: */
	}

	/* Update A12 := U'*A12, where A12 = A( 1:M, N-L+1:N )

	   Computing MIN */
	i__2 = *m, i__3 = *n - *l;
	i__1 = MIN (i__2, i__3);
	NUMlapack_dorm2r ("Left", "Transpose", m, l, &i__1, &a[a_offset], lda, &tau[1], &a_ref (1, *n - *l + 1),
	                  lda, &work[1], info);

	if (wantu) {

		/* Copy the details of U, and form U */

		NUMlapack_dlaset ("Full", m, m, &c_b12, &c_b12, &u[u_offset], ldu);
		if (*m > 1) {
			i__1 = *m - 1;
			i__2 = *n - *l;
			NUMlapack_dlacpy ("Lower", &i__1, &i__2, &a_ref (2, 1), lda, &u_ref (2, 1), ldu);
		}
		/* Computing MIN */
		i__2 = *m, i__3 = *n - *l;
		i__1 = MIN (i__2, i__3);
		NUMlapack_dorg2r (m, m, &i__1, &u[u_offset], ldu, &tau[1], &work[1], info);
	}

	if (wantq) {

		/* Update Q( 1:N, 1:N-L ) = Q( 1:N, 1:N-L )*P1 */

		i__1 = *n - *l;
		NUMlapack_dlapmt (&forwrd, n, &i__1, &q[q_offset], ldq, &iwork[1]);
	}

	/* Clean up A: set the strictly lower triangular part of A(1:K, 1:K) = 0,
	   and A( K+1:M, 1:N-L ) = 0. */

	i__1 = *k - 1;
	for (j = 1; j <= i__1; ++j) {
		i__2 = *k;
		for (i__ = j + 1; i__ <= i__2; ++i__) {
			a_ref (i__, j) = 0.;
			/* L90: */
		}
		/* L100: */
	}
	if (*m > *k) {
		i__1 = *m - *k;
		i__2 = *n - *l;
		NUMlapack_dlaset ("Full", &i__1, &i__2, &c_b12, &c_b12, &a_ref (*k + 1, 1), lda);
	}

	if (*n - *l > *k) {

		/* RQ factorization of ( T11 T12 ) = ( 0 T12 )*Z1 */

		i__1 = *n - *l;
		NUMlapack_dgerq2 (k, &i__1, &a[a_offset], lda, &tau[1], &work[1], info);

		if (wantq) {

			/* Update Q( 1:N,1:N-L ) = Q( 1:N,1:N-L )*Z1' */

			i__1 = *n - *l;
			NUMlapack_dormr2 ("Right", "Transpose", n, &i__1, k, &a[a_offset], lda, &tau[1], &q[q_offset], ldq,
			                  &work[1], info);
		}

		/* Clean up A */

		i__1 = *n - *l - *k;
		NUMlapack_dlaset ("Full", k, &i__1, &c_b12, &c_b12, &a[a_offset], lda);
		i__1 = *n - *l;
		for (j = *n - *l - *k + 1; j <= i__1; ++j) {
			i__2 = *k;
			for (i__ = j - *n + *l + *k + 1; i__ <= i__2; ++i__) {
				a_ref (i__, j) = 0.;
				/* L110: */
			}
			/* L120: */
		}

	}

	if (*m > *k) {

		/* QR factorization of A( K+1:M,N-L+1:N ) */

		i__1 = *m - *k;
		NUMlapack_dgeqr2 (&i__1, l, &a_ref (*k + 1, *n - *l + 1), lda, &tau[1], &work[1], info);

		if (wantu) {

			/* Update U(:,K+1:M) := U(:,K+1:M)*U1 */

			i__1 = *m - *k;
			/* Computing MIN */
			i__3 = *m - *k;
			i__2 = MIN (i__3, *l);
			NUMlapack_dorm2r ("Right", "No transpose", m, &i__1, &i__2, &a_ref (*k + 1, *n - *l + 1), lda,
			                  &tau[1], &u_ref (1, *k + 1), ldu, &work[1], info);
		}

		/* Clean up */

		i__1 = *n;
		for (j = *n - *l + 1; j <= i__1; ++j) {
			i__2 = *m;
			for (i__ = j - *n + *k + *l + 1; i__ <= i__2; ++i__) {
				a_ref (i__, j) = 0.;
				/* L130: */
			}
			/* L140: */
		}

	}
	return 0;
}								/* NUMlapack_dggsvp */

#undef v_ref
#undef u_ref
#undef b_ref


int NUMlapack_dhseqr (const char *job, const char *compz, integer *n, integer *ilo, integer *ihi, double *h__, integer *ldh,
                      double *wr, double *wi, double *z__, integer *ldz, double *work, integer *lwork, integer *info) {
	/* Table of constant values */
	static double c_b9 = 0.;
	static double c_b10 = 1.;
	static integer c__4 = 4;
	static integer c_n1 = -1;
	static integer c__2 = 2;
	static integer c__8 = 8;
	static integer c__15 = 15;
	static int c_false = FALSE;
	static integer c__1 = 1;

	/* System generated locals */
	const char *a__1[2];
	integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2, i__3[2], i__4, i__5;
	double d__1, d__2;
	char ch__1[2];

	/* Local variables */
	static integer maxb;
	static double absw;
	static integer ierr;
	static double unfl, temp, ovfl;
	static integer i__, j, k, l;
	static double s[225] /* was [15][15] */ , v[16];
	static integer itemp;
	static integer i1, i2;
	static int initz, wantt, wantz;
	static integer ii, nh;
	static integer nr, ns;
	static integer nv;
	static double vv[16];
	static double smlnum;
	static int lquery;
	static integer itn;
	static double tau;
	static integer its;
	static double ulp, tst1;

#define h___ref(a_1,a_2) h__[(a_2)*h_dim1 + a_1]
#define s_ref(a_1,a_2) s[(a_2)*15 + a_1 - 16]
#define z___ref(a_1,a_2) z__[(a_2)*z_dim1 + a_1]

	h_dim1 = *ldh;
	h_offset = 1 + h_dim1 * 1;
	h__ -= h_offset;
	--wr;
	--wi;
	z_dim1 = *ldz;
	z_offset = 1 + z_dim1 * 1;
	z__ -= z_offset;
	--work;

	/* Function Body */
	wantt = lsame_ (job, "S");
	initz = lsame_ (compz, "I");
	wantz = initz || lsame_ (compz, "V");

	*info = 0;
	work[1] = (double) MAX (1, *n);
	lquery = *lwork == -1;
	if (!lsame_ (job, "E") && !wantt) {
		*info = -1;
	} else if (!lsame_ (compz, "N") && !wantz) {
		*info = -2;
	} else if (*n < 0) {
		*info = -3;
	} else if (*ilo < 1 || *ilo > MAX (1, *n)) {
		*info = -4;
	} else if (*ihi < MIN (*ilo, *n) || *ihi > *n) {
		*info = -5;
	} else if (*ldh < MAX (1, *n)) {
		*info = -7;
	} else if (*ldz < 1 || wantz && *ldz < MAX (1, *n)) {
		*info = -11;
	} else if (*lwork < MAX (1, *n) && !lquery) {
		*info = -13;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("NUMlapack_dhseqr ", &i__1);
		return 0;
	} else if (lquery) {
		return 0;
	}

	/* Initialize Z, if necessary */

	if (initz) {
		NUMlapack_dlaset ("Full", n, n, &c_b9, &c_b10, &z__[z_offset], ldz);
	}

	/* Store the eigenvalues isolated by NUMlapack_dgebal. */

	i__1 = *ilo - 1;
	for (i__ = 1; i__ <= i__1; ++i__) {
		wr[i__] = h___ref (i__, i__);
		wi[i__] = 0.;
		/* L10: */
	}
	i__1 = *n;
	for (i__ = *ihi + 1; i__ <= i__1; ++i__) {
		wr[i__] = h___ref (i__, i__);
		wi[i__] = 0.;
		/* L20: */
	}

	/* Quick return if possible. */

	if (*n == 0) {
		return 0;
	}
	if (*ilo == *ihi) {
		wr[*ilo] = h___ref (*ilo, *ilo);
		wi[*ilo] = 0.;
		return 0;
	}

	/* Set rows and columns ILO to IHI to zero below the first subdiagonal. */

	i__1 = *ihi - 2;
	for (j = *ilo; j <= i__1; ++j) {
		i__2 = *n;
		for (i__ = j + 2; i__ <= i__2; ++i__) {
			h___ref (i__, j) = 0.;
			/* L30: */
		}
		/* L40: */
	}
	nh = *ihi - *ilo + 1;

	/* Determine the order of the multi-shift QR algorithm to be used.

	   Writing concatenation */
	i__3[0] = 1, a__1[0] = job;
	i__3[1] = 1, a__1[1] = compz;
	s_cat ( (char *) ch__1, a__1, i__3, &c__2, 2);
	ns = NUMlapack_ilaenv (&c__4, "NUMlapack_dhseqr ", ch__1, n, ilo, ihi, &c_n1, 6, 2);
	/* Writing concatenation */
	i__3[0] = 1, a__1[0] = job;
	i__3[1] = 1, a__1[1] = compz;
	s_cat (ch__1, a__1, i__3, &c__2, 2);
	maxb = NUMlapack_ilaenv (&c__8, "NUMlapack_dhseqr ", ch__1, n, ilo, ihi, &c_n1, 6, 2);
	if (ns <= 2 || ns > nh || maxb >= nh) {

		/* Use the standard double-shift algorithm */

		NUMlapack_dlahqr (&wantt, &wantz, n, ilo, ihi, &h__[h_offset], ldh, &wr[1], &wi[1], ilo, ihi,
		                  &z__[z_offset], ldz, info);
		return 0;
	}
	maxb = MAX (3, maxb);
	/* Computing MIN */
	i__1 = MIN (ns, maxb);
	ns = MIN (i__1, 15);

	/* Now 2 < NS <= MAXB < NH.

	   Set machine-dependent constants for the stopping criterion. If norm(H)
	   <= sqrt(OVFL), overflow should not occur. */

	unfl = NUMblas_dlamch ("Safe minimum");
	ovfl = 1. / unfl;
	NUMlapack_dlabad (&unfl, &ovfl);
	ulp = NUMblas_dlamch ("Precision");
	smlnum = unfl * (nh / ulp);

	/* I1 and I2 are the indices of the first row and last column of H to
	   which transformations should be applied. If eigenvalues only are being
	   computed, I1 and I2 are set inside the main loop. */

	if (wantt) {
		i1 = 1;
		i2 = *n;
	}

	/* ITN is the total number of multiple-shift QR iterations allowed. */

	itn = nh * 30;

	/* The main loop begins here. I is the loop index and decreases from IHI
	   to ILO in steps of at most MAXB. Each iteration of the loop works with
	   the active submatrix in rows and columns L to I. Eigenvalues I+1 to IHI
	   have already converged. Either L = ILO or H(L,L-1) is negligible so
	   that the matrix splits. */

	i__ = *ihi;
L50:
	l = *ilo;
	if (i__ < *ilo) {
		goto L170;
	}

	/* Perform multiple-shift QR iterations on rows and columns ILO to I
	   until a submatrix of order at most MAXB splits off at the bottom
	   because a subdiagonal element has become negligible. */

	i__1 = itn;
	for (its = 0; its <= i__1; ++its) {

		/* Look for a single small subdiagonal element. */

		i__2 = l + 1;
		for (k = i__; k >= i__2; --k) {
			tst1 = (d__1 = h___ref (k - 1, k - 1), fabs (d__1)) + (d__2 = h___ref (k, k), fabs (d__2));
			if (tst1 == 0.) {
				i__4 = i__ - l + 1;
				tst1 = NUMlapack_dlanhs ("1", &i__4, &h___ref (l, l), ldh, &work[1]);
			}
			/* Computing MAX */
			d__2 = ulp * tst1;
			if ( (d__1 = h___ref (k, k - 1), fabs (d__1)) <= MAX (d__2, smlnum)) {
				goto L70;
			}
			/* L60: */
		}
L70:
		l = k;
		if (l > *ilo) {

			/* H(L,L-1) is negligible. */

			h___ref (l, l - 1) = 0.;
		}

		/* Exit from loop if a submatrix of order <= MAXB has split off. */

		if (l >= i__ - maxb + 1) {
			goto L160;
		}

		/* Now the active submatrix is in rows and columns L to I. If
		   eigenvalues only are being computed, only the active submatrix
		   need be transformed. */

		if (!wantt) {
			i1 = l;
			i2 = i__;
		}

		if (its == 20 || its == 30) {

			/* Exceptional shifts. */

			i__2 = i__;
			for (ii = i__ - ns + 1; ii <= i__2; ++ii) {
				wr[ii] = ( (d__1 = h___ref (ii, ii - 1), fabs (d__1)) + (d__2 =
				               h___ref (ii, ii), fabs (d__2))) * 1.5;
				wi[ii] = 0.;
				/* L80: */
			}
		} else {

			/* Use eigenvalues of trailing submatrix of order NS as shifts. */

			NUMlapack_dlacpy ("Full", &ns, &ns, &h___ref (i__ - ns + 1, i__ - ns + 1), ldh, s, &c__15);
			NUMlapack_dlahqr (&c_false, &c_false, &ns, &c__1, &ns, s, &c__15, &wr[i__ - ns + 1],
			                  &wi[i__ - ns + 1], &c__1, &ns, &z__[z_offset], ldz, &ierr);
			if (ierr > 0) {

				/* If NUMlapack_dlahqr failed to compute all NS eigenvalues,
				   use the unconverged diagonal elements as the remaining
				   shifts. */

				i__2 = ierr;
				for (ii = 1; ii <= i__2; ++ii) {
					wr[i__ - ns + ii] = s_ref (ii, ii);
					wi[i__ - ns + ii] = 0.;
					/* L90: */
				}
			}
		}

		/* Form the first column of (G-w(1)) (G-w(2)) . . . (G-w(ns)) where G
		   is the Hessenberg submatrix H(L:I,L:I) and w is the vector of
		   shifts (stored in WR and WI). The result is stored in the local
		   array V. */

		v[0] = 1.;
		i__2 = ns + 1;
		for (ii = 2; ii <= i__2; ++ii) {
			v[ii - 1] = 0.;
			/* L100: */
		}
		nv = 1;
		i__2 = i__;
		for (j = i__ - ns + 1; j <= i__2; ++j) {
			if (wi[j] >= 0.) {
				if (wi[j] == 0.) {

					/* real shift */

					i__4 = nv + 1;
					NUMblas_dcopy (&i__4, v, &c__1, vv, &c__1);
					i__4 = nv + 1;
					d__1 = -wr[j];
					NUMblas_dgemv ("No transpose", &i__4, &nv, &c_b10, &h___ref (l, l), ldh, vv, &c__1,
					               &d__1, v, &c__1);
					++nv;
				} else if (wi[j] > 0.) {

					/* complex conjugate pair of shifts */

					i__4 = nv + 1;
					NUMblas_dcopy (&i__4, v, &c__1, vv, &c__1);
					i__4 = nv + 1;
					d__1 = wr[j] * -2.;
					NUMblas_dgemv ("No transpose", &i__4, &nv, &c_b10, &h___ref (l, l), ldh, v, &c__1, &d__1,
					               vv, &c__1);
					i__4 = nv + 1;
					itemp = NUMblas_idamax (&i__4, vv, &c__1);
					/* Computing MAX */
					d__2 = (d__1 = vv[itemp - 1], fabs (d__1));
					temp = 1. / MAX (d__2, smlnum);
					i__4 = nv + 1;
					NUMblas_dscal (&i__4, &temp, vv, &c__1);
					absw = NUMlapack_dlapy2 (&wr[j], &wi[j]);
					temp = temp * absw * absw;
					i__4 = nv + 2;
					i__5 = nv + 1;
					NUMblas_dgemv ("No transpose", &i__4, &i__5, &c_b10, &h___ref (l, l), ldh, vv, &c__1,
					               &temp, v, &c__1);
					nv += 2;
				}

				/* Scale V(1:NV) so that MAX (fabs (V(i))) = 1. If V is zero,
				   reset it to the unit vector. */

				itemp = NUMblas_idamax (&nv, v, &c__1);
				temp = (d__1 = v[itemp - 1], fabs (d__1));
				if (temp == 0.) {
					v[0] = 1.;
					i__4 = nv;
					for (ii = 2; ii <= i__4; ++ii) {
						v[ii - 1] = 0.;
						/* L110: */
					}
				} else {
					temp = MAX (temp, smlnum);
					d__1 = 1. / temp;
					NUMblas_dscal (&nv, &d__1, v, &c__1);
				}
			}
			/* L120: */
		}

		/* Multiple-shift QR step */

		i__2 = i__ - 1;
		for (k = l; k <= i__2; ++k) {

			/* The first iteration of this loop determines a reflection G
			   from the vector V and applies it from left and right to H,
			   thus creating a nonzero bulge below the subdiagonal.

			   Each subsequent iteration determines a reflection G to restore
			   the Hessenberg form in the (K-1)th column, and thus chases the
			   bulge one step toward the bottom of the active submatrix. NR
			   is the order of G.

			   Computing MIN */
			i__4 = ns + 1, i__5 = i__ - k + 1;
			nr = MIN (i__4, i__5);
			if (k > l) {
				NUMblas_dcopy (&nr, &h___ref (k, k - 1), &c__1, v, &c__1);
			}
			NUMlapack_dlarfg (&nr, v, &v[1], &c__1, &tau);
			if (k > l) {
				h___ref (k, k - 1) = v[0];
				i__4 = i__;
				for (ii = k + 1; ii <= i__4; ++ii) {
					h___ref (ii, k - 1) = 0.;
					/* L130: */
				}
			}
			v[0] = 1.;

			/* Apply G from the left to transform the rows of the matrix in
			   columns K to I2. */

			i__4 = i2 - k + 1;
			NUMlapack_dlarfx ("Left", &nr, &i__4, v, &tau, &h___ref (k, k), ldh, &work[1]);

			/* Apply G from the right to transform the columns of the matrix
			   in rows I1 to MIN (K+NR,I).

			   Computing MIN */
			i__5 = k + nr;
			i__4 = MIN (i__5, i__) - i1 + 1;
			NUMlapack_dlarfx ("Right", &i__4, &nr, v, &tau, &h___ref (i1, k), ldh, &work[1]);

			if (wantz) {

				/* Accumulate transformations in the matrix Z */

				NUMlapack_dlarfx ("Right", &nh, &nr, v, &tau, &z___ref (*ilo, k), ldz, &work[1]);
			}
			/* L140: */
		}

		/* L150: */
	}

	/* Failure to converge in remaining number of iterations */

	*info = i__;
	return 0;

L160:

	/* A submatrix of order <= MAXB in rows and columns L to I has split off.
	   Use the double-shift QR algorithm to handle it. */

	NUMlapack_dlahqr (&wantt, &wantz, n, &l, &i__, &h__[h_offset], ldh, &wr[1], &wi[1], ilo, ihi,
	                  &z__[z_offset], ldz, info);
	if (*info > 0) {
		return 0;
	}

	/* Decrement number of remaining iterations, and return to start of the
	   main loop with a new value of I. */

	itn -= its;
	i__ = l - 1;
	goto L50;

L170:
	work[1] = (double) MAX (1, *n);
	return 0;
}								/* NUMlapack_dhseqr */

#undef z___ref
#undef s_ref
#undef h___ref

int NUMlapack_dlabad (double *smal, double *large) {

	if (log10 (*large) > 2e3) {
		*smal = sqrt (*smal);
		*large = sqrt (*large);
	}

	return 0;
}								/* NUMlapack_dlabad */

#define x_ref(a_1,a_2) x[(a_2)*x_dim1 + a_1]
#define y_ref(a_1,a_2) y[(a_2)*y_dim1 + a_1]

int NUMlapack_dlabrd (integer *m, integer *n, integer *nb, double *a, integer *lda, double *d__, double *e, double *tauq,
                      double *taup, double *x, integer *ldx, double *y, integer *ldy) {
	/* Table of constant values */
	static double c_b4 = -1.;
	static double c_b5 = 1.;
	static integer c__1 = 1;
	static double c_b16 = 0.;

	/* System generated locals */
	integer a_dim1, a_offset, x_dim1, x_offset, y_dim1, y_offset, i__1, i__2, i__3;

	/* Local variables */
	static integer i__;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--d__;
	--e;
	--tauq;
	--taup;
	x_dim1 = *ldx;
	x_offset = 1 + x_dim1 * 1;
	x -= x_offset;
	y_dim1 = *ldy;
	y_offset = 1 + y_dim1 * 1;
	y -= y_offset;

	/* Function Body */
	if (*m <= 0 || *n <= 0) {
		return 0;
	}

	if (*m >= *n) {

		/* Reduce to upper bidiagonal form */

		i__1 = *nb;
		for (i__ = 1; i__ <= i__1; ++i__) {

			/* Update A(i:m,i) */

			i__2 = *m - i__ + 1;
			i__3 = i__ - 1;
			NUMblas_dgemv ("No transpose", &i__2, &i__3, &c_b4, &a_ref (i__, 1), lda, &y_ref (i__, 1), ldy, &c_b5,
			               &a_ref (i__, i__), &c__1);
			i__2 = *m - i__ + 1;
			i__3 = i__ - 1;
			NUMblas_dgemv ("No transpose", &i__2, &i__3, &c_b4, &x_ref (i__, 1), ldx, &a_ref (1, i__), &c__1, &c_b5,
			               &a_ref (i__, i__), &c__1);

			/* Generate reflection Q(i) to annihilate A(i+1:m,i)

			   Computing MIN */
			i__2 = i__ + 1;
			i__3 = *m - i__ + 1;
			NUMlapack_dlarfg (&i__3, &a_ref (i__, i__), &a_ref (MIN (i__2, *m), i__), &c__1, &tauq[i__]);
			d__[i__] = a_ref (i__, i__);
			if (i__ < *n) {
				a_ref (i__, i__) = 1.;

				/* Compute Y(i+1:n,i) */

				i__2 = *m - i__ + 1;
				i__3 = *n - i__;
				NUMblas_dgemv ("Transpose", &i__2, &i__3, &c_b5, &a_ref (i__, i__ + 1), lda, &a_ref (i__, i__),
				               &c__1, &c_b16, &y_ref (i__ + 1, i__), &c__1);
				i__2 = *m - i__ + 1;
				i__3 = i__ - 1;
				NUMblas_dgemv ("Transpose", &i__2, &i__3, &c_b5, &a_ref (i__, 1), lda, &a_ref (i__, i__), &c__1,
				               &c_b16, &y_ref (1, i__), &c__1);
				i__2 = *n - i__;
				i__3 = i__ - 1;
				NUMblas_dgemv ("No transpose", &i__2, &i__3, &c_b4, &y_ref (i__ + 1, 1), ldy, &y_ref (1, i__), &c__1,
				               &c_b5, &y_ref (i__ + 1, i__), &c__1);
				i__2 = *m - i__ + 1;
				i__3 = i__ - 1;
				NUMblas_dgemv ("Transpose", &i__2, &i__3, &c_b5, &x_ref (i__, 1), ldx, &a_ref (i__, i__), &c__1,
				               &c_b16, &y_ref (1, i__), &c__1);
				i__2 = i__ - 1;
				i__3 = *n - i__;
				NUMblas_dgemv ("Transpose", &i__2, &i__3, &c_b4, &a_ref (1, i__ + 1), lda, &y_ref (1, i__), &c__1,
				               &c_b5, &y_ref (i__ + 1, i__), &c__1);
				i__2 = *n - i__;
				NUMblas_dscal (&i__2, &tauq[i__], &y_ref (i__ + 1, i__), &c__1);

				/* Update A(i,i+1:n) */

				i__2 = *n - i__;
				NUMblas_dgemv ("No transpose", &i__2, &i__, &c_b4, &y_ref (i__ + 1, 1), ldy, &a_ref (i__, 1), lda,
				               &c_b5, &a_ref (i__, i__ + 1), lda);
				i__2 = i__ - 1;
				i__3 = *n - i__;
				NUMblas_dgemv ("Transpose", &i__2, &i__3, &c_b4, &a_ref (1, i__ + 1), lda, &x_ref (i__, 1), ldx,
				               &c_b5, &a_ref (i__, i__ + 1), lda);

				/* Generate reflection P(i) to annihilate A(i,i+2:n)

				   Computing MIN */
				i__2 = i__ + 2;
				i__3 = *n - i__;
				NUMlapack_dlarfg (&i__3, &a_ref (i__, i__ + 1), &a_ref (i__, MIN (i__2, *n)), lda, &taup[i__]);
				e[i__] = a_ref (i__, i__ + 1);
				a_ref (i__, i__ + 1) = 1.;

				/* Compute X(i+1:m,i) */

				i__2 = *m - i__;
				i__3 = *n - i__;
				NUMblas_dgemv ("No transpose", &i__2, &i__3, &c_b5, &a_ref (i__ + 1, i__ + 1), lda, &a_ref (i__,
				               i__ + 1), lda, &c_b16, &x_ref (i__ + 1, i__), &c__1);
				i__2 = *n - i__;
				NUMblas_dgemv ("Transpose", &i__2, &i__, &c_b5, &y_ref (i__ + 1, 1), ldy, &a_ref (i__, i__ + 1), lda,
				               &c_b16, &x_ref (1, i__), &c__1);
				i__2 = *m - i__;
				NUMblas_dgemv ("No transpose", &i__2, &i__, &c_b4, &a_ref (i__ + 1, 1), lda, &x_ref (1, i__), &c__1,
				               &c_b5, &x_ref (i__ + 1, i__), &c__1);
				i__2 = i__ - 1;
				i__3 = *n - i__;
				NUMblas_dgemv ("No transpose", &i__2, &i__3, &c_b5, &a_ref (1, i__ + 1), lda, &a_ref (i__, i__ + 1),
				               lda, &c_b16, &x_ref (1, i__), &c__1);
				i__2 = *m - i__;
				i__3 = i__ - 1;
				NUMblas_dgemv ("No transpose", &i__2, &i__3, &c_b4, &x_ref (i__ + 1, 1), ldx, &x_ref (1, i__), &c__1,
				               &c_b5, &x_ref (i__ + 1, i__), &c__1);
				i__2 = *m - i__;
				NUMblas_dscal (&i__2, &taup[i__], &x_ref (i__ + 1, i__), &c__1);
			}
			/* L10: */
		}
	} else {

		/* Reduce to lower bidiagonal form */

		i__1 = *nb;
		for (i__ = 1; i__ <= i__1; ++i__) {

			/* Update A(i,i:n) */

			i__2 = *n - i__ + 1;
			i__3 = i__ - 1;
			NUMblas_dgemv ("No transpose", &i__2, &i__3, &c_b4, &y_ref (i__, 1), ldy, &a_ref (i__, 1), lda, &c_b5,
			               &a_ref (i__, i__), lda);
			i__2 = i__ - 1;
			i__3 = *n - i__ + 1;
			NUMblas_dgemv ("Transpose", &i__2, &i__3, &c_b4, &a_ref (1, i__), lda, &x_ref (i__, 1), ldx, &c_b5,
			               &a_ref (i__, i__), lda);

			/* Generate reflection P(i) to annihilate A(i,i+1:n)

			   Computing MIN */
			i__2 = i__ + 1;
			i__3 = *n - i__ + 1;
			NUMlapack_dlarfg (&i__3, &a_ref (i__, i__), &a_ref (i__, MIN (i__2, *n)), lda, &taup[i__]);
			d__[i__] = a_ref (i__, i__);
			if (i__ < *m) {
				a_ref (i__, i__) = 1.;

				/* Compute X(i+1:m,i) */

				i__2 = *m - i__;
				i__3 = *n - i__ + 1;
				NUMblas_dgemv ("No transpose", &i__2, &i__3, &c_b5, &a_ref (i__ + 1, i__), lda, &a_ref (i__, i__),
				               lda, &c_b16, &x_ref (i__ + 1, i__), &c__1);
				i__2 = *n - i__ + 1;
				i__3 = i__ - 1;
				NUMblas_dgemv ("Transpose", &i__2, &i__3, &c_b5, &y_ref (i__, 1), ldy, &a_ref (i__, i__), lda,
				               &c_b16, &x_ref (1, i__), &c__1);
				i__2 = *m - i__;
				i__3 = i__ - 1;
				NUMblas_dgemv ("No transpose", &i__2, &i__3, &c_b4, &a_ref (i__ + 1, 1), lda, &x_ref (1, i__), &c__1,
				               &c_b5, &x_ref (i__ + 1, i__), &c__1);
				i__2 = i__ - 1;
				i__3 = *n - i__ + 1;
				NUMblas_dgemv ("No transpose", &i__2, &i__3, &c_b5, &a_ref (1, i__), lda, &a_ref (i__, i__), lda,
				               &c_b16, &x_ref (1, i__), &c__1);
				i__2 = *m - i__;
				i__3 = i__ - 1;
				NUMblas_dgemv ("No transpose", &i__2, &i__3, &c_b4, &x_ref (i__ + 1, 1), ldx, &x_ref (1, i__), &c__1,
				               &c_b5, &x_ref (i__ + 1, i__), &c__1);
				i__2 = *m - i__;
				NUMblas_dscal (&i__2, &taup[i__], &x_ref (i__ + 1, i__), &c__1);

				/* Update A(i+1:m,i) */

				i__2 = *m - i__;
				i__3 = i__ - 1;
				NUMblas_dgemv ("No transpose", &i__2, &i__3, &c_b4, &a_ref (i__ + 1, 1), lda, &y_ref (i__, 1), ldy,
				               &c_b5, &a_ref (i__ + 1, i__), &c__1);
				i__2 = *m - i__;
				NUMblas_dgemv ("No transpose", &i__2, &i__, &c_b4, &x_ref (i__ + 1, 1), ldx, &a_ref (1, i__), &c__1,
				               &c_b5, &a_ref (i__ + 1, i__), &c__1);

				/* Generate reflection Q(i) to annihilate A(i+2:m,i)

				   Computing MIN */
				i__2 = i__ + 2;
				i__3 = *m - i__;
				NUMlapack_dlarfg (&i__3, &a_ref (i__ + 1, i__), &a_ref (MIN (i__2, *m), i__), &c__1,
				                  &tauq[i__]);
				e[i__] = a_ref (i__ + 1, i__);
				a_ref (i__ + 1, i__) = 1.;

				/* Compute Y(i+1:n,i) */

				i__2 = *m - i__;
				i__3 = *n - i__;
				NUMblas_dgemv ("Transpose", &i__2, &i__3, &c_b5, &a_ref (i__ + 1, i__ + 1), lda, &a_ref (i__ + 1,
				               i__), &c__1, &c_b16, &y_ref (i__ + 1, i__), &c__1);
				i__2 = *m - i__;
				i__3 = i__ - 1;
				NUMblas_dgemv ("Transpose", &i__2, &i__3, &c_b5, &a_ref (i__ + 1, 1), lda, &a_ref (i__ + 1, i__),
				               &c__1, &c_b16, &y_ref (1, i__), &c__1);
				i__2 = *n - i__;
				i__3 = i__ - 1;
				NUMblas_dgemv ("No transpose", &i__2, &i__3, &c_b4, &y_ref (i__ + 1, 1), ldy, &y_ref (1, i__), &c__1,
				               &c_b5, &y_ref (i__ + 1, i__), &c__1);
				i__2 = *m - i__;
				NUMblas_dgemv ("Transpose", &i__2, &i__, &c_b5, &x_ref (i__ + 1, 1), ldx, &a_ref (i__ + 1, i__),
				               &c__1, &c_b16, &y_ref (1, i__), &c__1);
				i__2 = *n - i__;
				NUMblas_dgemv ("Transpose", &i__, &i__2, &c_b4, &a_ref (1, i__ + 1), lda, &y_ref (1, i__), &c__1,
				               &c_b5, &y_ref (i__ + 1, i__), &c__1);
				i__2 = *n - i__;
				NUMblas_dscal (&i__2, &tauq[i__], &y_ref (i__ + 1, i__), &c__1);
			}
			/* L20: */
		}
	}
	return 0;
}								/* NUMlapack_dlabrd */

#undef y_ref
#undef x_ref

#define b_ref(a_1,a_2) b[(a_2)*b_dim1 + a_1]

int NUMlapack_dlacpy (const char *uplo, integer *m, integer *n, double *a, integer *lda, double *b, integer *ldb) {
	/* System generated locals */
	integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2;

	/* Local variables */
	static integer i__, j;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	b_dim1 = *ldb;
	b_offset = 1 + b_dim1 * 1;
	b -= b_offset;

	/* Function Body */
	if (lsame_ (uplo, "U")) {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
			i__2 = MIN (j, *m);
			for (i__ = 1; i__ <= i__2; ++i__) {
				b_ref (i__, j) = a_ref (i__, j);
				/* L10: */
			}
			/* L20: */
		}
	} else if (lsame_ (uplo, "L")) {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
			i__2 = *m;
			for (i__ = j; i__ <= i__2; ++i__) {
				b_ref (i__, j) = a_ref (i__, j);
				/* L30: */
			}
			/* L40: */
		}
	} else {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
			i__2 = *m;
			for (i__ = 1; i__ <= i__2; ++i__) {
				b_ref (i__, j) = a_ref (i__, j);
				/* L50: */
			}
			/* L60: */
		}
	}
	return 0;
}								/* NUMlapack_dlacpy */

#undef b_ref


int NUMlapack_dladiv (double *a, double *b, double *c, double *d, double *p, double *q) {
	static double e, f;

	if (fabs (*d) < fabs (*c)) {
		e = *d / *c;
		f = *c + *d * e;
		*p = (*a + *b * e) / f;
		*q = (*b - *a * e) / f;
	} else {
		e = *c / *d;
		f = *d + *c * e;
		*p = (*b + *a * e) / f;
		*q = (- (*a) + *b * e) / f;
	}

	return 0;
}								/* NUMlapack_dladiv */


int NUMlapack_dlae2 (double *a, double *b, double *c__, double *rt1, double *rt2) {
	/* System generated locals */
	double d__1;

	/* Local variables */
	static double acmn, acmx, ab, df, tb, sm, rt, adf;
	sm = *a + *c__;
	df = *a - *c__;
	adf = fabs (df);
	tb = *b + *b;
	ab = fabs (tb);
	// djmw 20110721 changed abs(*a) to fabs(*a)
	if (fabs (*a) > fabs (*c__)) {
		acmx = *a;
		acmn = *c__;
	} else {
		acmx = *c__;
		acmn = *a;
	}
	if (adf > ab) {
		/* Computing 2nd power */
		d__1 = ab / adf;
		rt = adf * sqrt (d__1 * d__1 + 1.);
	} else if (adf < ab) {
		/* Computing 2nd power */
		d__1 = adf / ab;
		rt = ab * sqrt (d__1 * d__1 + 1.);
	} else {

		/* Includes case AB=ADF=0 */

		rt = ab * sqrt (2.);
	}
	if (sm < 0.) {
		*rt1 = (sm - rt) * .5;

		/* Order of execution important. To get fully accurate smaller
		   eigenvalue, next line needs to be executed in higher precision. */

		*rt2 = acmx / *rt1 * acmn - *b / *rt1 * *b;
	} else if (sm > 0.) {
		*rt1 = (sm + rt) * .5;

		/* Order of execution important. To get fully accurate smaller
		   eigenvalue, next line needs to be executed in higher precision. */

		*rt2 = acmx / *rt1 * acmn - *b / *rt1 * *b;
	} else {

		/* Includes case RT1 = RT2 = 0 */

		*rt1 = rt * .5;
		*rt2 = rt * -.5;
	}
	return 0;
}								/* NUMlapack_dlae2 */

int NUMlapack_dlaev2 (double *a, double *b, double *c__, double *rt1, double *rt2, double *cs1, double *sn1) {
	/* System generated locals */
	double d__1;

	/* Local variables */
	static double acmn, acmx, ab, df, cs, ct, tb, sm, tn, rt, adf, acs;
	static integer sgn1, sgn2;

	sm = *a + *c__;
	df = *a - *c__;
	adf = fabs (df);
	tb = *b + *b;
	ab = fabs (tb);
	if (fabs (*a) > fabs (*c__)) {
		acmx = *a;
		acmn = *c__;
	} else {
		acmx = *c__;
		acmn = *a;
	}
	if (adf > ab) {
		/* Computing 2nd power */
		d__1 = ab / adf;
		rt = adf * sqrt (d__1 * d__1 + 1.);
	} else if (adf < ab) {
		/* Computing 2nd power */
		d__1 = adf / ab;
		rt = ab * sqrt (d__1 * d__1 + 1.);
	} else {

		/* Includes case AB=ADF=0 */

		rt = ab * sqrt (2.);
	}
	if (sm < 0.) {
		*rt1 = (sm - rt) * .5;
		sgn1 = -1;

		/* Order of execution important. To get fully accurate smaller
		   eigenvalue, next line needs to be executed in higher precision. */

		*rt2 = acmx / *rt1 * acmn - *b / *rt1 * *b;
	} else if (sm > 0.) {
		*rt1 = (sm + rt) * .5;
		sgn1 = 1;

		/* Order of execution important. To get fully accurate smaller
		   eigenvalue, next line needs to be executed in higher precision. */

		*rt2 = acmx / *rt1 * acmn - *b / *rt1 * *b;
	} else {

		/* Includes case RT1 = RT2 = 0 */

		*rt1 = rt * .5;
		*rt2 = rt * -.5;
		sgn1 = 1;
	}

	/* Compute the eigenvector */

	if (df >= 0.) {
		cs = df + rt;
		sgn2 = 1;
	} else {
		cs = df - rt;
		sgn2 = -1;
	}
	acs = fabs (cs);
	if (acs > ab) {
		ct = -tb / cs;
		*sn1 = 1. / sqrt (ct * ct + 1.);
		*cs1 = ct * *sn1;
	} else {
		if (ab == 0.) {
			*cs1 = 1.;
			*sn1 = 0.;
		} else {
			tn = -cs / tb;
			*cs1 = 1. / sqrt (tn * tn + 1.);
			*sn1 = tn * *cs1;
		}
	}
	if (sgn1 == sgn2) {
		tn = *cs1;
		*cs1 = - (*sn1);
		*sn1 = tn;
	}
	return 0;
}								/* NUMlapack_dlaev2 */

int NUMlapack_dlags2 (integer *upper, double *a1, double *a2, double *a3, double *b1, double *b2, double *b3,
                      double *csu, double *snu, double *csv, double *snv, double *csq, double *snq) {
	/* System generated locals */
	double d__1;

	/* Local variables */
	static double aua11, aua12, aua21, aua22, avb11, avb12, avb21, avb22;
	double ua11r, ua22r, vb11r, vb22r, a, b, c__, d__, r__, s1, s2;
	static double ua11, ua12, ua21, ua22, vb11, vb12, vb21, vb22, csl, csr, snl, snr;

	if (*upper) {

		/* Input matrices A and B are upper triangular matrices

		   Form matrix C = A*adj(B) = ( a b ) ( 0 d ) */

		a = *a1 * *b3;
		d__ = *a3 * *b1;
		b = *a2 * *b1 - *a1 * *b2;

		/* The SVD of real 2-by-2 triangular C

		   ( CSL -SNL )*( A B )*( CSR SNR ) = ( R 0 ) ( SNL CSL ) ( 0 D ) (
		   -SNR CSR ) ( 0 T ) */

		NUMlapack_dlasv2 (&a, &b, &d__, &s1, &s2, &snr, &csr, &snl, &csl);

		if (fabs (csl) >= fabs (snl) || fabs (csr) >= fabs (snr)) {

			/* Compute the (1,1) and (1,2) elements of U'*A and V'*B, and
			   (1,2) element of |U|'*|A| and |V|'*|B|. */

			ua11r = csl * *a1;
			ua12 = csl * *a2 + snl * *a3;

			vb11r = csr * *b1;
			vb12 = csr * *b2 + snr * *b3;

			aua12 = fabs (csl) * fabs (*a2) + fabs (snl) * fabs (*a3);
			avb12 = fabs (csr) * fabs (*b2) + fabs (snr) * fabs (*b3);

			/* zero (1,2) elements of U'*A and V'*B */

			if (fabs (ua11r) + fabs (ua12) != 0.) {
				if (aua12 / (fabs (ua11r) + fabs (ua12)) <= avb12 / (fabs (vb11r) + fabs (vb12))) {
					d__1 = -ua11r;
					NUMlapack_dlartg (&d__1, &ua12, csq, snq, &r__);
				} else {
					d__1 = -vb11r;
					NUMlapack_dlartg (&d__1, &vb12, csq, snq, &r__);
				}
			} else {
				d__1 = -vb11r;
				NUMlapack_dlartg (&d__1, &vb12, csq, snq, &r__);
			}

			*csu = csl;
			*snu = -snl;
			*csv = csr;
			*snv = -snr;

		} else {

			/* Compute the (2,1) and (2,2) elements of U'*A and V'*B, and
			   (2,2) element of |U|'*|A| and |V|'*|B|. */

			ua21 = -snl * *a1;
			ua22 = -snl * *a2 + csl * *a3;

			vb21 = -snr * *b1;
			vb22 = -snr * *b2 + csr * *b3;

			aua22 = fabs (snl) * fabs (*a2) + fabs (csl) * fabs (*a3);
			avb22 = fabs (snr) * fabs (*b2) + fabs (csr) * fabs (*b3);

			/* zero (2,2) elements of U'*A and V'*B, and then swap. */

			if (fabs (ua21) + fabs (ua22) != 0.) {
				if (aua22 / (fabs (ua21) + fabs (ua22)) <= avb22 / (fabs (vb21) + fabs (vb22))) {
					d__1 = -ua21;
					NUMlapack_dlartg (&d__1, &ua22, csq, snq, &r__);
				} else {
					d__1 = -vb21;
					NUMlapack_dlartg (&d__1, &vb22, csq, snq, &r__);
				}
			} else {
				d__1 = -vb21;
				NUMlapack_dlartg (&d__1, &vb22, csq, snq, &r__);
			}

			*csu = snl;
			*snu = csl;
			*csv = snr;
			*snv = csr;

		}

	} else {

		/* Input matrices A and B are lower triangular matrices Form matrix C
		   = A*adj(B) = ( a 0 ) ( c d ) */

		a = *a1 * *b3;
		d__ = *a3 * *b1;
		c__ = *a2 * *b3 - *a3 * *b2;

		/* The SVD of real 2-by-2 triangular C

		   ( CSL -SNL )*( A 0 )*( CSR SNR ) = ( R 0 ) ( SNL CSL ) ( C D ) (
		   -SNR CSR ) ( 0 T ) */

		NUMlapack_dlasv2 (&a, &c__, &d__, &s1, &s2, &snr, &csr, &snl, &csl);

		if (fabs (csr) >= fabs (snr) || fabs (csl) >= fabs (snl)) {

			/* Compute the (2,1) and (2,2) elements of U'*A and V'*B, and
			   (2,1) element of |U|'*|A| and |V|'*|B|. */

			ua21 = -snr * *a1 + csr * *a2;
			ua22r = csr * *a3;

			vb21 = -snl * *b1 + csl * *b2;
			vb22r = csl * *b3;

			aua21 = fabs (snr) * fabs (*a1) + fabs (csr) * fabs (*a2);
			avb21 = fabs (snl) * fabs (*b1) + fabs (csl) * fabs (*b2);

			/* zero (2,1) elements of U'*A and V'*B. */

			if (fabs (ua21) + fabs (ua22r) != 0.) {
				if (aua21 / (fabs (ua21) + fabs (ua22r)) <= avb21 / (fabs (vb21) + fabs (vb22r))) {
					NUMlapack_dlartg (&ua22r, &ua21, csq, snq, &r__);
				} else {
					NUMlapack_dlartg (&vb22r, &vb21, csq, snq, &r__);
				}
			} else {
				NUMlapack_dlartg (&vb22r, &vb21, csq, snq, &r__);
			}

			*csu = csr;
			*snu = -snr;
			*csv = csl;
			*snv = -snl;

		} else {

			/* Compute the (1,1) and (1,2) elements of U'*A and V'*B, and
			   (1,1) element of |U|'*|A| and |V|'*|B|. */

			ua11 = csr * *a1 + snr * *a2;
			ua12 = snr * *a3;

			vb11 = csl * *b1 + snl * *b2;
			vb12 = snl * *b3;

			aua11 = fabs (csr) * fabs (*a1) + fabs (snr) * fabs (*a2);
			avb11 = fabs (csl) * fabs (*b1) + fabs (snl) * fabs (*b2);

			/* zero (1,1) elements of U'*A and V'*B, and then swap. */

			if (fabs (ua11) + fabs (ua12) != 0.) {
				if (aua11 / (fabs (ua11) + fabs (ua12)) <= avb11 / (fabs (vb11) + fabs (vb12))) {
					NUMlapack_dlartg (&ua12, &ua11, csq, snq, &r__);
				} else {
					NUMlapack_dlartg (&vb12, &vb11, csq, snq, &r__);
				}
			} else {
				NUMlapack_dlartg (&vb12, &vb11, csq, snq, &r__);
			}

			*csu = snr;
			*snu = csr;
			*csv = snl;
			*snv = csl;
		}
	}
	return 0;
}								/* NUMlapack_dlags2 */


int NUMlapack_dlahqr (int *wantt, int *wantz, integer *n, integer *ilo, integer *ihi, double *h__, integer *ldh,
                      double *wr, double *wi, integer *iloz, integer *ihiz, double *z__, integer *ldz, integer *info) {
	/* Table of constant values */
	static integer c__1 = 1;

	/* System generated locals */
	integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4;
	double d__1, d__2;

	/* Local variables */
	static double h43h34, disc, unfl, ovfl;
	static double work[1];
	static integer i__, j, k, l, m;
	static double s, v[3];
	static integer i1, i2;
	static double t1, t2, t3, v1, v2, v3;
	static double h00, h10, h11, h12, h21, h22, h33, h44;
	static integer nh;
	static double cs;
	static integer nr;
	static double sn;
	static integer nz;
	static double smlnum, ave, h33s, h44s;
	static integer itn, its;
	static double ulp, sum, tst1;

#define h___ref(a_1,a_2) h__[(a_2)*h_dim1 + a_1]
#define z___ref(a_1,a_2) z__[(a_2)*z_dim1 + a_1]

	h_dim1 = *ldh;
	h_offset = 1 + h_dim1 * 1;
	h__ -= h_offset;
	--wr;
	--wi;
	z_dim1 = *ldz;
	z_offset = 1 + z_dim1 * 1;
	z__ -= z_offset;

	/* Function Body */
	*info = 0;

	/* Quick return if possible */

	if (*n == 0) {
		return 0;
	}
	if (*ilo == *ihi) {
		wr[*ilo] = h___ref (*ilo, *ilo);
		wi[*ilo] = 0.;
		return 0;
	}

	nh = *ihi - *ilo + 1;
	nz = *ihiz - *iloz + 1;

	/* Set machine-dependent constants for the stopping criterion. If norm(H)
	   <= sqrt(OVFL), overflow should not occur. */

	unfl = NUMblas_dlamch ("Safe minimum");
	ovfl = 1. / unfl;
	NUMlapack_dlabad (&unfl, &ovfl);
	ulp = NUMblas_dlamch ("Precision");
	smlnum = unfl * (nh / ulp);

	/* I1 and I2 are the indices of the first row and last column of H to
	   which transformations should be applied. If eigenvalues only are being
	   computed, I1 and I2 are set inside the main loop. */

	if (*wantt) {
		i1 = 1;
		i2 = *n;
	}

	/* ITN is the total number of QR iterations allowed. */

	itn = nh * 30;

	/* The main loop begins here. I is the loop index and decreases from IHI
	   to ILO in steps of 1 or 2. Each iteration of the loop works with the
	   active submatrix in rows and columns L to I. Eigenvalues I+1 to IHI
	   have already converged. Either L = ILO or H(L,L-1) is negligible so
	   that the matrix splits. */

	i__ = *ihi;
L10:
	l = *ilo;
	if (i__ < *ilo) {
		goto L150;
	}

	/* Perform QR iterations on rows and columns ILO to I until a submatrix
	   of order 1 or 2 splits off at the bottom because a subdiagonal element
	   has become negligible. */

	i__1 = itn;
	for (its = 0; its <= i__1; ++its) {

		/* Look for a single small subdiagonal element. */

		i__2 = l + 1;
		for (k = i__; k >= i__2; --k) {
			tst1 = (d__1 = h___ref (k - 1, k - 1), fabs (d__1)) + (d__2 = h___ref (k, k), fabs (d__2));
			if (tst1 == 0.) {
				i__3 = i__ - l + 1;
				tst1 = NUMlapack_dlanhs ("1", &i__3, &h___ref (l, l), ldh, work);
			}
			/* Computing MAX */
			d__2 = ulp * tst1;
			if ( (d__1 = h___ref (k, k - 1), fabs (d__1)) <= MAX (d__2, smlnum)) {
				goto L30;
			}
			/* L20: */
		}
L30:
		l = k;
		if (l > *ilo) {

			/* H(L,L-1) is negligible */

			h___ref (l, l - 1) = 0.;
		}

		/* Exit from loop if a submatrix of order 1 or 2 has split off. */

		if (l >= i__ - 1) {
			goto L140;
		}

		/* Now the active submatrix is in rows and columns L to I. If
		   eigenvalues only are being computed, only the active submatrix
		   need be transformed. */

		if (! (*wantt)) {
			i1 = l;
			i2 = i__;
		}

		if (its == 10 || its == 20) {

			/* Exceptional shift. */

			s = (d__1 = h___ref (i__, i__ - 1), fabs (d__1)) + (d__2 =
			            h___ref (i__ - 1, i__ - 2), fabs (d__2));
			h44 = s * .75 + h___ref (i__, i__);
			h33 = h44;
			h43h34 = s * -.4375 * s;
		} else {

			/* Prepare to use Francis' double shift (i.e. 2nd degree
			   generalized Rayleigh quotient) */

			h44 = h___ref (i__, i__);
			h33 = h___ref (i__ - 1, i__ - 1);
			h43h34 = h___ref (i__, i__ - 1) * h___ref (i__ - 1, i__);
			s = h___ref (i__ - 1, i__ - 2) * h___ref (i__ - 1, i__ - 2);
			disc = (h33 - h44) * .5;
			disc = disc * disc + h43h34;
			if (disc > 0.) {

				/* Real roots: use Wilkinson's shift twice */

				disc = sqrt (disc);
				ave = (h33 + h44) * .5;
				if (fabs (h33) - fabs (h44) > 0.) {
					h33 = h33 * h44 - h43h34;
					h44 = h33 / (d_sign (&disc, &ave) + ave);
				} else {
					h44 = d_sign (&disc, &ave) + ave;
				}
				h33 = h44;
				h43h34 = 0.;
			}
		}

		/* Look for two consecutive small subdiagonal elements. */

		i__2 = l;
		for (m = i__ - 2; m >= i__2; --m) {
			/* Determine the effect of starting the double-shift QR iteration
			   at row M, and see if this would make H(M,M-1) negligible. */

			h11 = h___ref (m, m);
			h22 = h___ref (m + 1, m + 1);
			h21 = h___ref (m + 1, m);
			h12 = h___ref (m, m + 1);
			h44s = h44 - h11;
			h33s = h33 - h11;
			v1 = (h33s * h44s - h43h34) / h21 + h12;
			v2 = h22 - h11 - h33s - h44s;
			v3 = h___ref (m + 2, m + 1);
			s = fabs (v1) + fabs (v2) + fabs (v3);
			v1 /= s;
			v2 /= s;
			v3 /= s;
			v[0] = v1;
			v[1] = v2;
			v[2] = v3;
			if (m == l) {
				goto L50;
			}
			h00 = h___ref (m - 1, m - 1);
			h10 = h___ref (m, m - 1);
			tst1 = fabs (v1) * (fabs (h00) + fabs (h11) + fabs (h22));
			if (fabs (h10) * (fabs (v2) + fabs (v3)) <= ulp * tst1) {
				goto L50;
			}
			/* L40: */
		}
L50:

		/* Double-shift QR step */

		i__2 = i__ - 1;
		for (k = m; k <= i__2; ++k) {

			/* The first iteration of this loop determines a reflection G
			   from the vector V and applies it from left and right to H,
			   thus creating a nonzero bulge below the subdiagonal.

			   Each subsequent iteration determines a reflection G to restore
			   the Hessenberg form in the (K-1)th column, and thus chases the
			   bulge one step toward the bottom of the active submatrix. NR
			   is the order of G.

			   Computing MIN */
			i__3 = 3, i__4 = i__ - k + 1;
			nr = MIN (i__3, i__4);
			if (k > m) {
				NUMblas_dcopy (&nr, &h___ref (k, k - 1), &c__1, v, &c__1);
			}
			NUMlapack_dlarfg (&nr, v, &v[1], &c__1, &t1);
			if (k > m) {
				h___ref (k, k - 1) = v[0];
				h___ref (k + 1, k - 1) = 0.;
				if (k < i__ - 1) {
					h___ref (k + 2, k - 1) = 0.;
				}
			} else if (m > l) {
				h___ref (k, k - 1) = -h___ref (k, k - 1);
			}
			v2 = v[1];
			t2 = t1 * v2;
			if (nr == 3) {
				v3 = v[2];
				t3 = t1 * v3;

				/* Apply G from the left to transform the rows of the matrix
				   in columns K to I2. */

				i__3 = i2;
				for (j = k; j <= i__3; ++j) {
					sum = h___ref (k, j) + v2 * h___ref (k + 1, j) + v3 * h___ref (k + 2, j);
					h___ref (k, j) = h___ref (k, j) - sum * t1;
					h___ref (k + 1, j) = h___ref (k + 1, j) - sum * t2;
					h___ref (k + 2, j) = h___ref (k + 2, j) - sum * t3;
					/* L60: */
				}

				/* Apply G from the right to transform the columns of the
				   matrix in rows I1 to MIN (K+3,I).

				   Computing MIN */
				i__4 = k + 3;
				i__3 = MIN (i__4, i__);
				for (j = i1; j <= i__3; ++j) {
					sum = h___ref (j, k) + v2 * h___ref (j, k + 1) + v3 * h___ref (j, k + 2);
					h___ref (j, k) = h___ref (j, k) - sum * t1;
					h___ref (j, k + 1) = h___ref (j, k + 1) - sum * t2;
					h___ref (j, k + 2) = h___ref (j, k + 2) - sum * t3;
					/* L70: */
				}

				if (*wantz) {

					/* Accumulate transformations in the matrix Z */

					i__3 = *ihiz;
					for (j = *iloz; j <= i__3; ++j) {
						sum = z___ref (j, k) + v2 * z___ref (j, k + 1) + v3 * z___ref (j, k + 2);
						z___ref (j, k) = z___ref (j, k) - sum * t1;
						z___ref (j, k + 1) = z___ref (j, k + 1) - sum * t2;
						z___ref (j, k + 2) = z___ref (j, k + 2) - sum * t3;
						/* L80: */
					}
				}
			} else if (nr == 2) {

				/* Apply G from the left to transform the rows of the matrix
				   in columns K to I2. */

				i__3 = i2;
				for (j = k; j <= i__3; ++j) {
					sum = h___ref (k, j) + v2 * h___ref (k + 1, j);
					h___ref (k, j) = h___ref (k, j) - sum * t1;
					h___ref (k + 1, j) = h___ref (k + 1, j) - sum * t2;
					/* L90: */
				}

				/* Apply G from the right to transform the columns of the
				   matrix in rows I1 to MIN (K+3,I). */

				i__3 = i__;
				for (j = i1; j <= i__3; ++j) {
					sum = h___ref (j, k) + v2 * h___ref (j, k + 1);
					h___ref (j, k) = h___ref (j, k) - sum * t1;
					h___ref (j, k + 1) = h___ref (j, k + 1) - sum * t2;
					/* L100: */
				}

				if (*wantz) {

					/* Accumulate transformations in the matrix Z */

					i__3 = *ihiz;
					for (j = *iloz; j <= i__3; ++j) {
						sum = z___ref (j, k) + v2 * z___ref (j, k + 1);
						z___ref (j, k) = z___ref (j, k) - sum * t1;
						z___ref (j, k + 1) = z___ref (j, k + 1) - sum * t2;
						/* L110: */
					}
				}
			}
			/* L120: */
		}

		/* L130: */
	}

	/* Failure to converge in remaining number of iterations */

	*info = i__;
	return 0;

L140:

	if (l == i__) {

		/* H(I,I-1) is negligible: one eigenvalue has converged. */

		wr[i__] = h___ref (i__, i__);
		wi[i__] = 0.;
	} else if (l == i__ - 1) {

		/* H(I-1,I-2) is negligible: a pair of eigenvalues have converged.

		   Transform the 2-by-2 submatrix to standard Schur form, and compute
		   and store the eigenvalues. */

		NUMlapack_dlanv2 (&h___ref (i__ - 1, i__ - 1), &h___ref (i__ - 1, i__), &h___ref (i__, i__ - 1),
		                  &h___ref (i__, i__), &wr[i__ - 1], &wi[i__ - 1], &wr[i__], &wi[i__], &cs, &sn);

		if (*wantt) {

			/* Apply the transformation to the rest of H. */

			if (i2 > i__) {
				i__1 = i2 - i__;
				NUMblas_drot (&i__1, &h___ref (i__ - 1, i__ + 1), ldh, &h___ref (i__, i__ + 1), ldh, &cs,
				              &sn);
			}
			i__1 = i__ - i1 - 1;
			NUMblas_drot (&i__1, &h___ref (i1, i__ - 1), &c__1, &h___ref (i1, i__), &c__1, &cs, &sn);
		}
		if (*wantz) {

			/* Apply the transformation to Z. */

			NUMblas_drot (&nz, &z___ref (*iloz, i__ - 1), &c__1, &z___ref (*iloz, i__), &c__1, &cs, &sn);
		}
	}

	/* Decrement number of remaining iterations, and return to start of the
	   main loop with new value of I. */

	itn -= its;
	i__ = l - 1;
	goto L10;

L150:
	return 0;
}								/* NUMlapack_dlahqr */

#undef z___ref
#undef h___ref


int NUMlapack_dlahrd (integer *n, integer *k, integer *nb, double *a, integer *lda, double *tau, double *t, integer *ldt,
                      double *y, integer *ldy) {
	/* Table of constant values */
	static double c_b4 = -1.;
	static double c_b5 = 1.;
	static integer c__1 = 1;
	static double c_b38 = 0.;

	/* System generated locals */
	integer a_dim1, a_offset, t_dim1, t_offset, y_dim1, y_offset, i__1, i__2, i__3;
	double d__1;

	/* Local variables */
	static integer i__;
	static double ei;

#define t_ref(a_1,a_2) t[(a_2)*t_dim1 + a_1]
#define y_ref(a_1,a_2) y[(a_2)*y_dim1 + a_1]

	--tau;
	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	t_dim1 = *ldt;
	t_offset = 1 + t_dim1 * 1;
	t -= t_offset;
	y_dim1 = *ldy;
	y_offset = 1 + y_dim1 * 1;
	y -= y_offset;

	/* Function Body */
	if (*n <= 1) {
		return 0;
	}

	i__1 = *nb;
	for (i__ = 1; i__ <= i__1; ++i__) {
		if (i__ > 1) {

			/* Update A(1:n,i)

			   Compute i-th column of A - Y * V' */

			i__2 = i__ - 1;
			NUMblas_dgemv ("No transpose", n, &i__2, &c_b4, &y[y_offset], ldy, &a_ref (*k + i__ - 1, 1), lda,
			               &c_b5, &a_ref (1, i__), &c__1);

			/* Apply I - V * T' * V' to this column (call it b) from the
			   left, using the last column of T as workspace

			   Let V = ( V1 ) and b = ( b1 ) (first I-1 rows) ( V2 ) ( b2 )

			   where V1 is unit lower triangular

			   w := V1' * b1 */

			i__2 = i__ - 1;
			NUMblas_dcopy (&i__2, &a_ref (*k + 1, i__), &c__1, &t_ref (1, *nb), &c__1);
			i__2 = i__ - 1;
			NUMblas_dtrmv ("Lower", "Transpose", "Unit", &i__2, &a_ref (*k + 1, 1), lda, &t_ref (1, *nb),
			               &c__1);

			/* w := w + V2'*b2 */

			i__2 = *n - *k - i__ + 1;
			i__3 = i__ - 1;
			NUMblas_dgemv ("Transpose", &i__2, &i__3, &c_b5, &a_ref (*k + i__, 1), lda, &a_ref (*k + i__,
			               i__), &c__1, &c_b5, &t_ref (1, *nb), &c__1);

			/* w := T'*w */

			i__2 = i__ - 1;
			NUMblas_dtrmv ("Upper", "Transpose", "Non-unit", &i__2, &t[t_offset], ldt, &t_ref (1, *nb),
			               &c__1);

			/* b2 := b2 - V2*w */

			i__2 = *n - *k - i__ + 1;
			i__3 = i__ - 1;
			NUMblas_dgemv ("No transpose", &i__2, &i__3, &c_b4, &a_ref (*k + i__, 1), lda, &t_ref (1, *nb),
			               &c__1, &c_b5, &a_ref (*k + i__, i__), &c__1);

			/* b1 := b1 - V1*w */

			i__2 = i__ - 1;
			NUMblas_dtrmv ("Lower", "No transpose", "Unit", &i__2, &a_ref (*k + 1, 1), lda, &t_ref (1, *nb),
			               &c__1);
			i__2 = i__ - 1;
			NUMblas_daxpy (&i__2, &c_b4, &t_ref (1, *nb), &c__1, &a_ref (*k + 1, i__), &c__1);

			a_ref (*k + i__ - 1, i__ - 1) = ei;
		}

		/* Generate the elementary reflector H(i) to annihilate A(k+i+1:n,i)
		   Computing MIN */
		i__2 = *k + i__ + 1;
		i__3 = *n - *k - i__ + 1;
		NUMlapack_dlarfg (&i__3, &a_ref (*k + i__, i__), &a_ref (MIN (i__2, *n), i__), &c__1, &tau[i__]);
		ei = a_ref (*k + i__, i__);
		a_ref (*k + i__, i__) = 1.;

		/* Compute Y(1:n,i) */

		i__2 = *n - *k - i__ + 1;
		NUMblas_dgemv ("No transpose", n, &i__2, &c_b5, &a_ref (1, i__ + 1), lda, &a_ref (*k + i__, i__),
		               &c__1, &c_b38, &y_ref (1, i__), &c__1);
		i__2 = *n - *k - i__ + 1;
		i__3 = i__ - 1;
		NUMblas_dgemv ("Transpose", &i__2, &i__3, &c_b5, &a_ref (*k + i__, 1), lda, &a_ref (*k + i__, i__),
		               &c__1, &c_b38, &t_ref (1, i__), &c__1);
		i__2 = i__ - 1;
		NUMblas_dgemv ("No transpose", n, &i__2, &c_b4, &y[y_offset], ldy, &t_ref (1, i__), &c__1, &c_b5,
		               &y_ref (1, i__), &c__1);
		NUMblas_dscal (n, &tau[i__], &y_ref (1, i__), &c__1);

		/* Compute T(1:i,i) */

		i__2 = i__ - 1;
		d__1 = -tau[i__];
		NUMblas_dscal (&i__2, &d__1, &t_ref (1, i__), &c__1);
		i__2 = i__ - 1;
		NUMblas_dtrmv ("Upper", "No transpose", "Non-unit", &i__2, &t[t_offset], ldt, &t_ref (1, i__),
		               &c__1);
		t_ref (i__, i__) = tau[i__];

		/* L10: */
	}
	a_ref (*k + *nb, *nb) = ei;

	return 0;
}								/* NUMlapack_dlahrd */

#undef y_ref
#undef t_ref


int NUMlapack_dlaln2 (int *ltrans, integer *na, integer *nw, double *smin, double *ca, double *a, integer *lda,
                      double *d1, double *d2, double *b, integer *ldb, double *wr, double *wi, double *x, integer *ldx, double *scale,
                      double *xnorm, integer *info) {
	/* Initialized data */
	static int zswap[4] = { FALSE, FALSE, TRUE, TRUE };
	static int rswap[4] = { FALSE, TRUE, FALSE, TRUE };
	static integer ipivot[16] /* was [4][4] */  = { 1, 2, 3, 4, 2, 1, 4, 3, 3, 4, 1, 2,
	        4, 3, 2, 1
	                                           };
	/* System generated locals */
	integer a_dim1, a_offset, b_dim1, b_offset, x_dim1, x_offset;
	double d__1, d__2, d__3, d__4, d__5, d__6;
	static double equiv_0[4], equiv_1[4];

	/* Local variables */
	static double bbnd, cmax, ui11r, ui12s, temp, ur11r, ur12s;
	static integer j;
	static double u22abs;
	static integer icmax;
	static double bnorm, cnorm, smini;

#define ci (equiv_0)
#define cr (equiv_1)
	static double bignum, bi1, bi2, br1, br2, smlnum, xi1, xi2, xr1, xr2, ci21, ci22, cr21, cr22, li21, csi,
	       ui11, lr21, ui12, ui22;
#define civ (equiv_0)
	static double csr, ur11, ur12, ur22;

#define crv (equiv_1)
#define b_ref(a_1,a_2) b[(a_2)*b_dim1 + a_1]
#define x_ref(a_1,a_2) x[(a_2)*x_dim1 + a_1]
#define ci_ref(a_1,a_2) ci[(a_2)*2 + a_1 - 3]
#define cr_ref(a_1,a_2) cr[(a_2)*2 + a_1 - 3]
#define ipivot_ref(a_1,a_2) ipivot[(a_2)*4 + a_1 - 5]

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	b_dim1 = *ldb;
	b_offset = 1 + b_dim1 * 1;
	b -= b_offset;
	x_dim1 = *ldx;
	x_offset = 1 + x_dim1 * 1;
	x -= x_offset;

	/* Function Body

	   Compute BIGNUM */

	smlnum = 2. * NUMblas_dlamch ("Safe minimum");
	bignum = 1. / smlnum;
	smini = MAX (*smin, smlnum);

	/* Don't check for input errors */

	*info = 0;

	/* Standard Initializations */

	*scale = 1.;

	if (*na == 1) {

		/* 1 x 1 (i.e., scalar) system C X = B */

		if (*nw == 1) {

			/* Real 1x1 system.

			   C = ca A - w D */

			csr = *ca * a_ref (1, 1) - *wr * *d1;
			cnorm = fabs (csr);

			/* If | C | < SMINI, use C = SMINI */

			if (cnorm < smini) {
				csr = smini;
				cnorm = smini;
				*info = 1;
			}

			/* Check scaling for X = B / C */

			bnorm = (d__1 = b_ref (1, 1), fabs (d__1));
			if (cnorm < 1. && bnorm > 1.) {
				if (bnorm > bignum * cnorm) {
					*scale = 1. / bnorm;
				}
			}

			/* Compute X */

			x_ref (1, 1) = b_ref (1, 1) * *scale / csr;
			*xnorm = (d__1 = x_ref (1, 1), fabs (d__1));
		} else {

			/* Complex 1x1 system (w is complex)

			   C = ca A - w D */

			csr = *ca * a_ref (1, 1) - *wr * *d1;
			csi = - (*wi) * *d1;
			cnorm = fabs (csr) + fabs (csi);

			/* If | C | < SMINI, use C = SMINI */

			if (cnorm < smini) {
				csr = smini;
				csi = 0.;
				cnorm = smini;
				*info = 1;
			}

			/* Check scaling for X = B / C */

			bnorm = (d__1 = b_ref (1, 1), fabs (d__1)) + (d__2 = b_ref (1, 2), fabs (d__2));
			if (cnorm < 1. && bnorm > 1.) {
				if (bnorm > bignum * cnorm) {
					*scale = 1. / bnorm;
				}
			}

			/* Compute X */

			d__1 = *scale * b_ref (1, 1);
			d__2 = *scale * b_ref (1, 2);
			NUMlapack_dladiv (&d__1, &d__2, &csr, &csi, &x_ref (1, 1), &x_ref (1, 2));
			*xnorm = (d__1 = x_ref (1, 1), fabs (d__1)) + (d__2 = x_ref (1, 2), fabs (d__2));
		}

	} else {

		/* 2x2 System

		   Compute the real part of C = ca A - w D (or ca A' - w D ) */

		cr_ref (1, 1) = *ca * a_ref (1, 1) - *wr * *d1;
		cr_ref (2, 2) = *ca * a_ref (2, 2) - *wr * *d2;
		if (*ltrans) {
			cr_ref (1, 2) = *ca * a_ref (2, 1);
			cr_ref (2, 1) = *ca * a_ref (1, 2);
		} else {
			cr_ref (2, 1) = *ca * a_ref (2, 1);
			cr_ref (1, 2) = *ca * a_ref (1, 2);
		}

		if (*nw == 1) {

			/* Real 2x2 system (w is real)

			   Find the largest element in C */

			cmax = 0.;
			icmax = 0;

			for (j = 1; j <= 4; ++j) {
				if ( (d__1 = crv[j - 1], fabs (d__1)) > cmax) {
					cmax = (d__1 = crv[j - 1], fabs (d__1));
					icmax = j;
				}
				/* L10: */
			}

			/* If norm(C) < SMINI, use SMINI*identity. */

			if (cmax < smini) {
				/* Computing MAX */
				d__3 = (d__1 = b_ref (1, 1), fabs (d__1)), d__4 = (d__2 = b_ref (2, 1), fabs (d__2));
				bnorm = MAX (d__3, d__4);
				if (smini < 1. && bnorm > 1.) {
					if (bnorm > bignum * smini) {
						*scale = 1. / bnorm;
					}
				}
				temp = *scale / smini;
				x_ref (1, 1) = temp * b_ref (1, 1);
				x_ref (2, 1) = temp * b_ref (2, 1);
				*xnorm = temp * bnorm;
				*info = 1;
				return 0;
			}

			/* Gaussian elimination with complete pivoting. */

			ur11 = crv[icmax - 1];
			cr21 = crv[ipivot_ref (2, icmax) - 1];
			ur12 = crv[ipivot_ref (3, icmax) - 1];
			cr22 = crv[ipivot_ref (4, icmax) - 1];
			ur11r = 1. / ur11;
			lr21 = ur11r * cr21;
			ur22 = cr22 - ur12 * lr21;

			/* If smaller pivot < SMINI, use SMINI */

			if (fabs (ur22) < smini) {
				ur22 = smini;
				*info = 1;
			}
			if (rswap[icmax - 1]) {
				br1 = b_ref (2, 1);
				br2 = b_ref (1, 1);
			} else {
				br1 = b_ref (1, 1);
				br2 = b_ref (2, 1);
			}
			br2 -= lr21 * br1;
			/* Computing MAX */
			d__2 = (d__1 = br1 * (ur22 * ur11r), fabs (d__1)), d__3 = fabs (br2);
			bbnd = MAX (d__2, d__3);
			if (bbnd > 1. && fabs (ur22) < 1.) {
				if (bbnd >= bignum * fabs (ur22)) {
					*scale = 1. / bbnd;
				}
			}

			xr2 = br2 * *scale / ur22;
			xr1 = *scale * br1 * ur11r - xr2 * (ur11r * ur12);
			if (zswap[icmax - 1]) {
				x_ref (1, 1) = xr2;
				x_ref (2, 1) = xr1;
			} else {
				x_ref (1, 1) = xr1;
				x_ref (2, 1) = xr2;
			}
			/* Computing MAX */
			d__1 = fabs (xr1), d__2 = fabs (xr2);
			*xnorm = MAX (d__1, d__2);

			/* Further scaling if norm(A) norm(X) > overflow */

			if (*xnorm > 1. && cmax > 1.) {
				if (*xnorm > bignum / cmax) {
					temp = cmax / bignum;
					x_ref (1, 1) = temp * x_ref (1, 1);
					x_ref (2, 1) = temp * x_ref (2, 1);
					*xnorm = temp * *xnorm;
					*scale = temp * *scale;
				}
			}
		} else {

			/* Complex 2x2 system (w is complex)

			   Find the largest element in C */

			ci_ref (1, 1) = - (*wi) * *d1;
			ci_ref (2, 1) = 0.;
			ci_ref (1, 2) = 0.;
			ci_ref (2, 2) = - (*wi) * *d2;
			cmax = 0.;
			icmax = 0;

			for (j = 1; j <= 4; ++j) {
				if ( (d__1 = crv[j - 1], fabs (d__1)) + (d__2 = civ[j - 1], fabs (d__2)) > cmax) {
					cmax = (d__1 = crv[j - 1], fabs (d__1)) + (d__2 = civ[j - 1], fabs (d__2));
					icmax = j;
				}
				/* L20: */
			}

			/* If norm(C) < SMINI, use SMINI*identity. */

			if (cmax < smini) {
				/* Computing MAX */
				d__5 = (d__1 = b_ref (1, 1), fabs (d__1)) + (d__2 = b_ref (1, 2), fabs (d__2)), d__6 = (d__3 =
				            b_ref (2, 1), fabs (d__3)) + (d__4 = b_ref (2, 2), fabs (d__4));
				bnorm = MAX (d__5, d__6);
				if (smini < 1. && bnorm > 1.) {
					if (bnorm > bignum * smini) {
						*scale = 1. / bnorm;
					}
				}
				temp = *scale / smini;
				x_ref (1, 1) = temp * b_ref (1, 1);
				x_ref (2, 1) = temp * b_ref (2, 1);
				x_ref (1, 2) = temp * b_ref (1, 2);
				x_ref (2, 2) = temp * b_ref (2, 2);
				*xnorm = temp * bnorm;
				*info = 1;
				return 0;
			}

			/* Gaussian elimination with complete pivoting. */

			ur11 = crv[icmax - 1];
			ui11 = civ[icmax - 1];
			cr21 = crv[ipivot_ref (2, icmax) - 1];
			ci21 = civ[ipivot_ref (2, icmax) - 1];
			ur12 = crv[ipivot_ref (3, icmax) - 1];
			ui12 = civ[ipivot_ref (3, icmax) - 1];
			cr22 = crv[ipivot_ref (4, icmax) - 1];
			ci22 = civ[ipivot_ref (4, icmax) - 1];
			if (icmax == 1 || icmax == 4) {

				/* Code when off-diagonals of pivoted C are real */

				if (fabs (ur11) > fabs (ui11)) {
					temp = ui11 / ur11;
					/* Computing 2nd power */
					d__1 = temp;
					ur11r = 1. / (ur11 * (d__1 * d__1 + 1.));
					ui11r = -temp * ur11r;
				} else {
					temp = ur11 / ui11;
					/* Computing 2nd power */
					d__1 = temp;
					ui11r = -1. / (ui11 * (d__1 * d__1 + 1.));
					ur11r = -temp * ui11r;
				}
				lr21 = cr21 * ur11r;
				li21 = cr21 * ui11r;
				ur12s = ur12 * ur11r;
				ui12s = ur12 * ui11r;
				ur22 = cr22 - ur12 * lr21;
				ui22 = ci22 - ur12 * li21;
			} else {

				/* Code when diagonals of pivoted C are real */

				ur11r = 1. / ur11;
				ui11r = 0.;
				lr21 = cr21 * ur11r;
				li21 = ci21 * ur11r;
				ur12s = ur12 * ur11r;
				ui12s = ui12 * ur11r;
				ur22 = cr22 - ur12 * lr21 + ui12 * li21;
				ui22 = -ur12 * li21 - ui12 * lr21;
			}
			u22abs = fabs (ur22) + fabs (ui22);

			/* If smaller pivot < SMINI, use SMINI */

			if (u22abs < smini) {
				ur22 = smini;
				ui22 = 0.;
				*info = 1;
			}
			if (rswap[icmax - 1]) {
				br2 = b_ref (1, 1);
				br1 = b_ref (2, 1);
				bi2 = b_ref (1, 2);
				bi1 = b_ref (2, 2);
			} else {
				br1 = b_ref (1, 1);
				br2 = b_ref (2, 1);
				bi1 = b_ref (1, 2);
				bi2 = b_ref (2, 2);
			}
			br2 = br2 - lr21 * br1 + li21 * bi1;
			bi2 = bi2 - li21 * br1 - lr21 * bi1;
			/* Computing MAX */
			// djmw 20110721 changed abs(br2) to fabs(br2)
			d__1 = (fabs (br1) + fabs (bi1)) * (u22abs * (fabs (ur11r) + fabs (ui11r))), d__2 =
			           fabs (br2) + fabs (bi2);
			bbnd = MAX (d__1, d__2);
			if (bbnd > 1. && u22abs < 1.) {
				if (bbnd >= bignum * u22abs) {
					*scale = 1. / bbnd;
					br1 = *scale * br1;
					bi1 = *scale * bi1;
					br2 = *scale * br2;
					bi2 = *scale * bi2;
				}
			}

			NUMlapack_dladiv (&br2, &bi2, &ur22, &ui22, &xr2, &xi2);
			xr1 = ur11r * br1 - ui11r * bi1 - ur12s * xr2 + ui12s * xi2;
			xi1 = ui11r * br1 + ur11r * bi1 - ui12s * xr2 - ur12s * xi2;
			if (zswap[icmax - 1]) {
				x_ref (1, 1) = xr2;
				x_ref (2, 1) = xr1;
				x_ref (1, 2) = xi2;
				x_ref (2, 2) = xi1;
			} else {
				x_ref (1, 1) = xr1;
				x_ref (2, 1) = xr2;
				x_ref (1, 2) = xi1;
				x_ref (2, 2) = xi2;
			}
			/* Computing MAX */
			d__1 = fabs (xr1) + fabs (xi1), d__2 = fabs (xr2) + fabs (xi2);
			*xnorm = MAX (d__1, d__2);

			/* Further scaling if norm(A) norm(X) > overflow */

			if (*xnorm > 1. && cmax > 1.) {
				if (*xnorm > bignum / cmax) {
					temp = cmax / bignum;
					x_ref (1, 1) = temp * x_ref (1, 1);
					x_ref (2, 1) = temp * x_ref (2, 1);
					x_ref (1, 2) = temp * x_ref (1, 2);
					x_ref (2, 2) = temp * x_ref (2, 2);
					*xnorm = temp * *xnorm;
					*scale = temp * *scale;
				}
			}
		}
	}

	return 0;
}								/* NUMlapack_NUMlapack_dlaln2 */

#undef ipivot_ref
#undef cr_ref
#undef ci_ref
#undef x_ref
#undef b_ref
#undef crv
#undef civ
#undef cr
#undef ci


double NUMlapack_dlange (const char *norm, integer *m, integer *n, double *a, integer *lda, double *work) {
	/* Table of constant values */
	static integer c__1 = 1;

	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2;
	double ret_val, d__1, d__2, d__3;

	/* Local variables */
	static integer i__, j;
	static double scale;
	static double value;
	static double sum;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--work;

	/* Function Body */
	if (MIN (*m, *n) == 0) {
		value = 0.;
	} else if (lsame_ (norm, "M")) {

		/* Find MAX(abs(A(i,j))). */

		value = 0.;
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
			i__2 = *m;
			for (i__ = 1; i__ <= i__2; ++i__) {
				/* Computing MAX */
				d__2 = value, d__3 = (d__1 = a_ref (i__, j), fabs (d__1));
				value = MAX (d__2, d__3);
				/* L10: */
			}
			/* L20: */
		}
	} else if (lsame_ (norm, "O") || * (unsigned char *) norm == '1') {

		/* Find norm1(A). */

		value = 0.;
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
			sum = 0.;
			i__2 = *m;
			for (i__ = 1; i__ <= i__2; ++i__) {
				sum += (d__1 = a_ref (i__, j), fabs (d__1));
				/* L30: */
			}
			value = MAX (value, sum);
			/* L40: */
		}
	} else if (lsame_ (norm, "I")) {

		/* Find normI(A). */

		i__1 = *m;
		for (i__ = 1; i__ <= i__1; ++i__) {
			work[i__] = 0.;
			/* L50: */
		}
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
			i__2 = *m;
			for (i__ = 1; i__ <= i__2; ++i__) {
				work[i__] += (d__1 = a_ref (i__, j), fabs (d__1));
				/* L60: */
			}
			/* L70: */
		}
		value = 0.;
		i__1 = *m;
		for (i__ = 1; i__ <= i__1; ++i__) {
			/* Computing MAX */
			d__1 = value, d__2 = work[i__];
			value = MAX (d__1, d__2);
			/* L80: */
		}
	} else if (lsame_ (norm, "F") || lsame_ (norm, "E")) {

		/* Find normF(A). */

		scale = 0.;
		sum = 1.;
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
			NUMlapack_dlassq (m, &a_ref (1, j), &c__1, &scale, &sum);
			/* L90: */
		}
		value = scale * sqrt (sum);
	}

	ret_val = value;
	return ret_val;
}								/* NUMlapack_dlange */


double NUMlapack_dlanhs (const char *norm, integer *n, double *a, integer *lda, double *work) {
	/* Table of constant values */
	static integer c__1 = 1;

	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
	double ret_val, d__1, d__2, d__3;

	/* Local variables */
	static integer i__, j;
	static double scale;
	static double value;
	static double sum;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--work;

	/* Function Body */
	if (*n == 0) {
		value = 0.;
	} else if (lsame_ (norm, "M")) {

		/* Find MAX (fabs (A(i,j))). */

		value = 0.;
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
			/* Computing MIN */
			i__3 = *n, i__4 = j + 1;
			i__2 = MIN (i__3, i__4);
			for (i__ = 1; i__ <= i__2; ++i__) {
				/* Computing MAX */
				d__2 = value, d__3 = (d__1 = a_ref (i__, j), fabs (d__1));
				value = MAX (d__2, d__3);
				/* L10: */
			}
			/* L20: */
		}
	} else if (lsame_ (norm, "O") || * (unsigned char *) norm == '1') {

		/* Find norm1(A). */

		value = 0.;
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
			sum = 0.;
			/* Computing MIN */
			i__3 = *n, i__4 = j + 1;
			i__2 = MIN (i__3, i__4);
			for (i__ = 1; i__ <= i__2; ++i__) {
				sum += (d__1 = a_ref (i__, j), fabs (d__1));
				/* L30: */
			}
			value = MAX (value, sum);
			/* L40: */
		}
	} else if (lsame_ (norm, "I")) {

		/* Find normI(A). */

		i__1 = *n;
		for (i__ = 1; i__ <= i__1; ++i__) {
			work[i__] = 0.;
			/* L50: */
		}
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
			/* Computing MIN */
			i__3 = *n, i__4 = j + 1;
			i__2 = MIN (i__3, i__4);
			for (i__ = 1; i__ <= i__2; ++i__) {
				work[i__] += (d__1 = a_ref (i__, j), fabs (d__1));
				/* L60: */
			}
			/* L70: */
		}
		value = 0.;
		i__1 = *n;
		for (i__ = 1; i__ <= i__1; ++i__) {
			/* Computing MAX */
			d__1 = value, d__2 = work[i__];
			value = MAX (d__1, d__2);
			/* L80: */
		}
	} else if (lsame_ (norm, "F") || lsame_ (norm, "E")) {

		/* Find normF(A). */

		scale = 0.;
		sum = 1.;
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
			/* Computing MIN */
			i__3 = *n, i__4 = j + 1;
			i__2 = MIN (i__3, i__4);
			NUMlapack_dlassq (&i__2, &a_ref (1, j), &c__1, &scale, &sum);
			/* L90: */
		}
		value = scale * sqrt (sum);
	}

	ret_val = value;
	return ret_val;
}								/* NUMlapack_dlanhs */


double NUMlapack_dlanst (const char *norm, integer *n, double *d__, double *e) {
	/* Table of constant values */
	static integer c__1 = 1;

	/* System generated locals */
	integer i__1;
	double ret_val, d__1, d__2, d__3, d__4, d__5;
	static integer i__;
	static double scale;
	static double anorm;
	static double sum;

	--e;
	--d__;

	/* Function Body */
	if (*n <= 0) {
		anorm = 0.;
	} else if (lsame_ (norm, "M")) {

		/* Find max(abs(A(i,j))). */

		anorm = (d__1 = d__[*n], fabs (d__1));
		i__1 = *n - 1;
		for (i__ = 1; i__ <= i__1; ++i__) {
			/* Computing MAX */
			d__2 = anorm, d__3 = (d__1 = d__[i__], fabs (d__1));
			anorm = MAX (d__2, d__3);
			/* Computing MAX */
			d__2 = anorm, d__3 = (d__1 = e[i__], fabs (d__1));
			anorm = MAX (d__2, d__3);
			/* L10: */
		}
	} else if (lsame_ (norm, "O") || * (unsigned char *) norm == '1' || lsame_ (norm, "I")) {

		/* Find norm1(A). */

		if (*n == 1) {
			anorm = fabs (d__[1]);
		} else {
			/* Computing MAX */
			d__3 = fabs (d__[1]) + fabs (e[1]), d__4 = (d__1 = e[*n - 1], fabs (d__1)) + (d__2 =
			            d__[*n], fabs (d__2));
			anorm = MAX (d__3, d__4);
			i__1 = *n - 1;
			for (i__ = 2; i__ <= i__1; ++i__) {
				/* Computing MAX */
				d__4 = anorm, d__5 = (d__1 = d__[i__], fabs (d__1)) + (d__2 = e[i__], fabs (d__2)) + (d__3 =
				                         e[i__ - 1], fabs (d__3));
				anorm = MAX (d__4, d__5);
				/* L20: */
			}
		}
	} else if (lsame_ (norm, "F") || lsame_ (norm, "E")) {

		/* Find normF(A). */

		scale = 0.;
		sum = 1.;
		if (*n > 1) {
			i__1 = *n - 1;
			NUMlapack_dlassq (&i__1, &e[1], &c__1, &scale, &sum);
			sum *= 2;
		}
		NUMlapack_dlassq (n, &d__[1], &c__1, &scale, &sum);
		anorm = scale * sqrt (sum);
	}

	ret_val = anorm;
	return ret_val;
}								/* NUMlapack_dlanst */

double NUMlapack_dlansy (const char *norm, const char *uplo, integer *n, double *a, integer *lda, double *work) {
	/* Table of constant values */
	static integer c__1 = 1;

	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2;
	double ret_val, d__1, d__2, d__3;

	/* Local variables */
	static double absa;
	static integer i__, j;
	static double scale;
	static double value;
	static double sum;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--work;

	/* Function Body */
	if (*n == 0) {
		value = 0.;
	} else if (lsame_ (norm, "M")) {

		/* Find max(abs(A(i,j))). */

		value = 0.;
		if (lsame_ (uplo, "U")) {
			i__1 = *n;
			for (j = 1; j <= i__1; ++j) {
				i__2 = j;
				for (i__ = 1; i__ <= i__2; ++i__) {
					/* Computing MAX */
					d__2 = value, d__3 = (d__1 = a_ref (i__, j), fabs (d__1));
					value = MAX (d__2, d__3);
					/* L10: */
				}
				/* L20: */
			}
		} else {
			i__1 = *n;
			for (j = 1; j <= i__1; ++j) {
				i__2 = *n;
				for (i__ = j; i__ <= i__2; ++i__) {
					/* Computing MAX */
					d__2 = value, d__3 = (d__1 = a_ref (i__, j), fabs (d__1));
					value = MAX (d__2, d__3);
					/* L30: */
				}
				/* L40: */
			}
		}
	} else if (lsame_ (norm, "I") || lsame_ (norm, "O") || * (unsigned char *) norm == '1') {

		/* Find normI(A) ( = norm1(A), since A is symmetric). */

		value = 0.;
		if (lsame_ (uplo, "U")) {
			i__1 = *n;
			for (j = 1; j <= i__1; ++j) {
				sum = 0.;
				i__2 = j - 1;
				for (i__ = 1; i__ <= i__2; ++i__) {
					absa = (d__1 = a_ref (i__, j), fabs (d__1));
					sum += absa;
					work[i__] += absa;
					/* L50: */
				}
				work[j] = sum + (d__1 = a_ref (j, j), fabs (d__1));
				/* L60: */
			}
			i__1 = *n;
			for (i__ = 1; i__ <= i__1; ++i__) {
				/* Computing MAX */
				d__1 = value, d__2 = work[i__];
				value = MAX (d__1, d__2);
				/* L70: */
			}
		} else {
			i__1 = *n;
			for (i__ = 1; i__ <= i__1; ++i__) {
				work[i__] = 0.;
				/* L80: */
			}
			i__1 = *n;
			for (j = 1; j <= i__1; ++j) {
				sum = work[j] + (d__1 = a_ref (j, j), fabs (d__1));
				i__2 = *n;
				for (i__ = j + 1; i__ <= i__2; ++i__) {
					absa = (d__1 = a_ref (i__, j), fabs (d__1));
					sum += absa;
					work[i__] += absa;
					/* L90: */
				}
				value = MAX (value, sum);
				/* L100: */
			}
		}
	} else if (lsame_ (norm, "F") || lsame_ (norm, "E")) {

		/* Find normF(A). */

		scale = 0.;
		sum = 1.;
		if (lsame_ (uplo, "U")) {
			i__1 = *n;
			for (j = 2; j <= i__1; ++j) {
				i__2 = j - 1;
				NUMlapack_dlassq (&i__2, &a_ref (1, j), &c__1, &scale, &sum);
				/* L110: */
			}
		} else {
			i__1 = *n - 1;
			for (j = 1; j <= i__1; ++j) {
				i__2 = *n - j;
				NUMlapack_dlassq (&i__2, &a_ref (j + 1, j), &c__1, &scale, &sum);
				/* L120: */
			}
		}
		sum *= 2;
		i__1 = *lda + 1;
		NUMlapack_dlassq (n, &a[a_offset], &i__1, &scale, &sum);
		value = scale * sqrt (sum);
	}

	ret_val = value;
	return ret_val;
}								/* NUMlapack_dlansy */


int NUMlapack_dlanv2 (double *a, double *b, double *c__, double *d__, double *rt1r, double *rt1i,
                      double *rt2r, double *rt2i, double *cs, double *sn) {
	/* Table of constant values */
	static double c_b4 = 1.;

	/* System generated locals */
	double d__1, d__2;

	/* Local variables */
	static double temp, p, scale, bcmax, z__, bcmis, sigma;
	static double aa, bb, cc, dd;
	static double cs1, sn1, sab, sac, eps, tau;

	eps = NUMblas_dlamch ("P");
	if (*c__ == 0.) {
		*cs = 1.;
		*sn = 0.;
		goto L10;

	} else if (*b == 0.) {

		/* Swap rows and columns */

		*cs = 0.;
		*sn = 1.;
		temp = *d__;
		*d__ = *a;
		*a = temp;
		*b = - (*c__);
		*c__ = 0.;
		goto L10;
	} else if (*a - *d__ == 0. && d_sign (&c_b4, b) != d_sign (&c_b4, c__)) {
		*cs = 1.;
		*sn = 0.;
		goto L10;
	} else {

		temp = *a - *d__;
		p = temp * .5;
		/* Computing MAX */
		d__1 = fabs (*b), d__2 = fabs (*c__);
		bcmax = MAX (d__1, d__2);
		/* Computing MIN */
		d__1 = fabs (*b), d__2 = fabs (*c__);
		bcmis = MIN (d__1, d__2) * d_sign (&c_b4, b) * d_sign (&c_b4, c__);
		/* Computing MAX */
		d__1 = fabs (p);
		scale = MAX (d__1, bcmax);
		z__ = p / scale * p + bcmax / scale * bcmis;

		/* If Z is of the order of the machine accuracy, postpone the
		   decision on the nature of eigenvalues */

		if (z__ >= eps * 4.) {

			/* Real eigenvalues. Compute A and D. */

			d__1 = sqrt (scale) * sqrt (z__);
			z__ = p + d_sign (&d__1, &p);
			*a = *d__ + z__;
			*d__ -= bcmax / z__ * bcmis;

			/* Compute B and the rotation matrix */

			tau = NUMlapack_dlapy2 (c__, &z__);
			*cs = z__ / tau;
			*sn = *c__ / tau;
			*b -= *c__;
			*c__ = 0.;
		} else {

			/* Complex eigenvalues, or real (almost) equal eigenvalues. Make
			   diagonal elements equal. */

			sigma = *b + *c__;
			tau = NUMlapack_dlapy2 (&sigma, &temp);
			*cs = sqrt ( (fabs (sigma) / tau + 1.) * .5);
			*sn = - (p / (tau * *cs)) * d_sign (&c_b4, &sigma);

			/* Compute [ AA BB ] = [ A B ] [ CS -SN ] [ CC DD ] [ C D ] [ SN
			   CS ] */

			aa = *a * *cs + *b * *sn;
			bb = - (*a) * *sn + *b * *cs;
			cc = *c__ * *cs + *d__ * *sn;
			dd = - (*c__) * *sn + *d__ * *cs;

			/* Compute [ A B ] = [ CS SN ] [ AA BB ] [ C D ] [-SN CS ] [ CC
			   DD ] */

			*a = aa * *cs + cc * *sn;
			*b = bb * *cs + dd * *sn;
			*c__ = -aa * *sn + cc * *cs;
			*d__ = -bb * *sn + dd * *cs;

			temp = (*a + *d__) * .5;
			*a = temp;
			*d__ = temp;

			if (*c__ != 0.) {
				if (*b != 0.) {
					if (d_sign (&c_b4, b) == d_sign (&c_b4, c__)) {

						/* Real eigenvalues: reduce to upper triangular form */

						sab = sqrt ( (fabs (*b)));
						sac = sqrt ( (fabs (*c__)));
						d__1 = sab * sac;
						p = d_sign (&d__1, c__);
						tau = 1. / sqrt ( (d__1 = *b + *c__, fabs (d__1)));
						*a = temp + p;
						*d__ = temp - p;
						*b -= *c__;
						*c__ = 0.;
						cs1 = sab * tau;
						sn1 = sac * tau;
						temp = *cs * cs1 - *sn * sn1;
						*sn = *cs * sn1 + *sn * cs1;
						*cs = temp;
					}
				} else {
					*b = - (*c__);
					*c__ = 0.;
					temp = *cs;
					*cs = - (*sn);
					*sn = temp;
				}
			}
		}

	}

L10:

	/* Store eigenvalues in (RT1R,RT1I) and (RT2R,RT2I). */

	*rt1r = *a;
	*rt2r = *d__;
	if (*c__ == 0.) {
		*rt1i = 0.;
		*rt2i = 0.;
	} else {
		*rt1i = sqrt ( (fabs (*b))) * sqrt ( (fabs (*c__)));
		*rt2i = - (*rt1i);
	}
	return 0;
}								/* NUMlapack_dlanv2 */


int NUMlapack_dlapll (integer *n, double *x, integer *incx, double *y, integer *incy, double *ssmin) {
	/* System generated locals */
	integer i__1;

	/* Local variables */
	static double c__;
	static double ssmax, a11, a12, a22;
	static double tau;

	--y;
	--x;

	/* Function Body */
	if (*n <= 1) {
		*ssmin = 0.;
		return 0;
	}

	/* Compute the QR factorization of the N-by-2 matrix ( X Y ) */

	NUMlapack_dlarfg (n, &x[1], &x[*incx + 1], incx, &tau);
	a11 = x[1];
	x[1] = 1.;

	c__ = -tau * NUMblas_ddot (n, &x[1], incx, &y[1], incy);
	NUMblas_daxpy (n, &c__, &x[1], incx, &y[1], incy);

	i__1 = *n - 1;
	NUMlapack_dlarfg (&i__1, &y[*incy + 1], &y[ (*incy << 1) + 1], incy, &tau);

	a12 = y[1];
	a22 = y[*incy + 1];

	/* Compute the SVD of 2-by-2 Upper triangular matrix. */

	NUMlapack_dlas2 (&a11, &a12, &a22, ssmin, &ssmax);

	return 0;
}

/* NUMlapack_dlapll */

#define x_ref(a_1,a_2) x[(a_2)*x_dim1 + a_1]

int NUMlapack_dlapmt (integer *forwrd, integer *m, integer *n, double *x, integer *ldx, integer *k) {
	/* System generated locals */
	integer x_dim1, x_offset, i__1, i__2;

	/* Local variables */
	static double temp;
	static integer i__, j, ii, in;

	x_dim1 = *ldx;
	x_offset = 1 + x_dim1 * 1;
	x -= x_offset;
	--k;

	/* Function Body */
	if (*n <= 1) {
		return 0;
	}

	i__1 = *n;
	for (i__ = 1; i__ <= i__1; ++i__) {
		k[i__] = -k[i__];
		/* L10: */
	}

	if (*forwrd) {

		/* Forward permutation */

		i__1 = *n;
		for (i__ = 1; i__ <= i__1; ++i__) {

			if (k[i__] > 0) {
				goto L40;
			}

			j = i__;
			k[j] = -k[j];
			in = k[j];

L20:
			if (k[in] > 0) {
				goto L40;
			}

			i__2 = *m;
			for (ii = 1; ii <= i__2; ++ii) {
				temp = x_ref (ii, j);
				x_ref (ii, j) = x_ref (ii, in);
				x_ref (ii, in) = temp;
				/* L30: */
			}

			k[in] = -k[in];
			j = in;
			in = k[in];
			goto L20;

L40:

			/* L50: */
			;
		}

	} else {

		/* Backward permutation */

		i__1 = *n;
		for (i__ = 1; i__ <= i__1; ++i__) {

			if (k[i__] > 0) {
				goto L80;
			}

			k[i__] = -k[i__];
			j = k[i__];
L60:
			if (j == i__) {
				goto L80;
			}

			i__2 = *m;
			for (ii = 1; ii <= i__2; ++ii) {
				temp = x_ref (ii, i__);
				x_ref (ii, i__) = x_ref (ii, j);
				x_ref (ii, j) = temp;
				/* L70: */
			}

			k[j] = -k[j];
			j = k[j];
			goto L60;

L80:

			/* L90: */
			;
		}

	}

	return 0;
}								/* NUMlapack_dlapmt */

#undef x_ref

double NUMlapack_dlapy2 (double *x, double *y) {
	/* System generated locals */
	double ret_val, d__1;

	/* Local variables */
	static double xabs, yabs, w, z__;

	xabs = fabs (*x);
	yabs = fabs (*y);
	w = MAX (xabs, yabs);
	z__ = MIN (xabs, yabs);
	if (z__ == 0.) {
		ret_val = w;
	} else {
		/* Computing 2nd power */
		d__1 = z__ / w;
		ret_val = w * sqrt (d__1 * d__1 + 1.);
	}
	return ret_val;
}								/* NUMlapack_dlapy2 */

#define work_ref(a_1,a_2) work[(a_2)*work_dim1 + a_1]
#define v_ref(a_1,a_2) v[(a_2)*v_dim1 + a_1]

int NUMlapack_dlarfb (const char *side, const char *trans, const char *direct, const char *storev, integer *m, integer *n, integer *k, double *v,
                      integer *ldv, double *t, integer *ldt, double *c__, integer *ldc, double *work, integer *ldwork) {
	/* Table of constant values */
	static integer c__1 = 1;
	static double c_b14 = 1.;
	static double c_b25 = -1.;

	/* System generated locals */
	integer c_dim1, c_offset, t_dim1, t_offset, v_dim1, v_offset;
	integer work_dim1, work_offset, i__1, i__2;

	/* Local variables */
	static integer i__, j;
	static char transt[1];

	v_dim1 = *ldv;
	v_offset = 1 + v_dim1 * 1;
	v -= v_offset;
	t_dim1 = *ldt;
	t_offset = 1 + t_dim1 * 1;
	t -= t_offset;
	c_dim1 = *ldc;
	c_offset = 1 + c_dim1 * 1;
	c__ -= c_offset;
	work_dim1 = *ldwork;
	work_offset = 1 + work_dim1 * 1;
	work -= work_offset;

	/* Function Body */
	if (*m <= 0 || *n <= 0) {
		return 0;
	}

	if (lsame_ (trans, "N")) {
		* (unsigned char *) transt = 'T';
	} else {
		* (unsigned char *) transt = 'N';
	}

	if (lsame_ (storev, "C")) {

		if (lsame_ (direct, "F")) {

			/* Let V = ( V1 ) (first K rows) ( V2 ) where V1 is unit lower
			   triangular. */

			if (lsame_ (side, "L")) {

				/* Form H * C or H' * C where C = ( C1 ) ( C2 )

				   W := C' * V = (C1'*V1 + C2'*V2) (stored in WORK)

				   W := C1' */

				i__1 = *k;
				for (j = 1; j <= i__1; ++j) {
					NUMblas_dcopy (n, &c___ref (j, 1), ldc, &work_ref (1, j), &c__1);
					/* L10: */
				}

				/* W := W * V1 */

				NUMblas_dtrmm ("Right", "Lower", "No transpose", "Unit", n, k, &c_b14, &v[v_offset], ldv,
				               &work[work_offset], ldwork);
				if (*m > *k) {

					/* W := W + C2'*V2 */

					i__1 = *m - *k;
					NUMblas_dgemm ("Transpose", "No transpose", n, k, &i__1, &c_b14, &c___ref (*k + 1, 1), ldc,
					               &v_ref (*k + 1, 1), ldv, &c_b14, &work[work_offset], ldwork);
				}

				/* W := W * T' or W * T */

				NUMblas_dtrmm ("Right", "Upper", transt, "Non-unit", n, k, &c_b14, &t[t_offset], ldt,
				               &work[work_offset], ldwork);

				/* C := C - V * W' */

				if (*m > *k) {

					/* C2 := C2 - V2 * W' */

					i__1 = *m - *k;
					NUMblas_dgemm ("No transpose", "Transpose", &i__1, n, k, &c_b25, &v_ref (*k + 1, 1), ldv,
					               &work[work_offset], ldwork, &c_b14, &c___ref (*k + 1, 1), ldc);
				}

				/* W := W * V1' */

				NUMblas_dtrmm ("Right", "Lower", "Transpose", "Unit", n, k, &c_b14, &v[v_offset], ldv,
				               &work[work_offset], ldwork);

				/* C1 := C1 - W' */

				i__1 = *k;
				for (j = 1; j <= i__1; ++j) {
					i__2 = *n;
					for (i__ = 1; i__ <= i__2; ++i__) {
						c___ref (j, i__) = c___ref (j, i__) - work_ref (i__, j);
						/* L20: */
					}
					/* L30: */
				}

			} else if (lsame_ (side, "R")) {

				/* Form C * H or C * H' where C = ( C1 C2 )

				   W := C * V = (C1*V1 + C2*V2) (stored in WORK)

				   W := C1 */

				i__1 = *k;
				for (j = 1; j <= i__1; ++j) {
					NUMblas_dcopy (m, &c___ref (1, j), &c__1, &work_ref (1, j), &c__1);
					/* L40: */
				}

				/* W := W * V1 */

				NUMblas_dtrmm ("Right", "Lower", "No transpose", "Unit", m, k, &c_b14, &v[v_offset], ldv,
				               &work[work_offset], ldwork);
				if (*n > *k) {

					/* W := W + C2 * V2 */

					i__1 = *n - *k;
					NUMblas_dgemm ("No transpose", "No transpose", m, k, &i__1, &c_b14, &c___ref (1, *k + 1), ldc,
					               &v_ref (*k + 1, 1), ldv, &c_b14, &work[work_offset], ldwork);
				}

				/* W := W * T or W * T' */

				NUMblas_dtrmm ("Right", "Upper", trans, "Non-unit", m, k, &c_b14, &t[t_offset], ldt,
				               &work[work_offset], ldwork);

				/* C := C - W * V' */

				if (*n > *k) {

					/* C2 := C2 - W * V2' */

					i__1 = *n - *k;
					NUMblas_dgemm ("No transpose", "Transpose", m, &i__1, k, &c_b25, &work[work_offset], ldwork,
					               &v_ref (*k + 1, 1), ldv, &c_b14, &c___ref (1, *k + 1), ldc);
				}

				/* W := W * V1' */

				NUMblas_dtrmm ("Right", "Lower", "Transpose", "Unit", m, k, &c_b14, &v[v_offset], ldv,
				               &work[work_offset], ldwork);

				/* C1 := C1 - W */

				i__1 = *k;
				for (j = 1; j <= i__1; ++j) {
					i__2 = *m;
					for (i__ = 1; i__ <= i__2; ++i__) {
						c___ref (i__, j) = c___ref (i__, j) - work_ref (i__, j);
						/* L50: */
					}
					/* L60: */
				}
			}

		} else {

			/* Let V = ( V1 ) ( V2 ) (last K rows) where V2 is unit upper
			   triangular. */

			if (lsame_ (side, "L")) {

				/* Form H * C or H' * C where C = ( C1 ) ( C2 )

				   W := C' * V = (C1'*V1 + C2'*V2) (stored in WORK)

				   W := C2' */

				i__1 = *k;
				for (j = 1; j <= i__1; ++j) {
					NUMblas_dcopy (n, &c___ref (*m - *k + j, 1), ldc, &work_ref (1, j), &c__1);
					/* L70: */
				}

				/* W := W * V2 */

				NUMblas_dtrmm ("Right", "Upper", "No transpose", "Unit", n, k, &c_b14, &v_ref (*m - *k + 1, 1), ldv,
				               &work[work_offset], ldwork);
				if (*m > *k) {

					/* W := W + C1'*V1 */

					i__1 = *m - *k;
					NUMblas_dgemm ("Transpose", "No transpose", n, k, &i__1, &c_b14, &c__[c_offset], ldc,
					               &v[v_offset], ldv, &c_b14, &work[work_offset], ldwork);
				}

				/* W := W * T' or W * T */

				NUMblas_dtrmm ("Right", "Lower", transt, "Non-unit", n, k, &c_b14, &t[t_offset], ldt,
				               &work[work_offset], ldwork);

				/* C := C - V * W' */

				if (*m > *k) {

					/* C1 := C1 - V1 * W' */

					i__1 = *m - *k;
					NUMblas_dgemm ("No transpose", "Transpose", &i__1, n, k, &c_b25, &v[v_offset], ldv,
					               &work[work_offset], ldwork, &c_b14, &c__[c_offset], ldc);
				}

				/* W := W * V2' */

				NUMblas_dtrmm ("Right", "Upper", "Transpose", "Unit", n, k, &c_b14, &v_ref (*m - *k + 1, 1), ldv,
				               &work[work_offset], ldwork);

				/* C2 := C2 - W' */

				i__1 = *k;
				for (j = 1; j <= i__1; ++j) {
					i__2 = *n;
					for (i__ = 1; i__ <= i__2; ++i__) {
						c___ref (*m - *k + j, i__) = c___ref (*m - *k + j, i__) - work_ref (i__, j);
						/* L80: */
					}
					/* L90: */
				}

			} else if (lsame_ (side, "R")) {

				/* Form C * H or C * H' where C = ( C1 C2 )

				   W := C * V = (C1*V1 + C2*V2) (stored in WORK)

				   W := C2 */

				i__1 = *k;
				for (j = 1; j <= i__1; ++j) {
					NUMblas_dcopy (m, &c___ref (1, *n - *k + j), &c__1, &work_ref (1, j), &c__1);
					/* L100: */
				}

				/* W := W * V2 */

				NUMblas_dtrmm ("Right", "Upper", "No transpose", "Unit", m, k, &c_b14, &v_ref (*n - *k + 1, 1), ldv,
				               &work[work_offset], ldwork);
				if (*n > *k) {

					/* W := W + C1 * V1 */

					i__1 = *n - *k;
					NUMblas_dgemm ("No transpose", "No transpose", m, k, &i__1, &c_b14, &c__[c_offset], ldc,
					               &v[v_offset], ldv, &c_b14, &work[work_offset], ldwork);
				}

				/* W := W * T or W * T' */

				NUMblas_dtrmm ("Right", "Lower", trans, "Non-unit", m, k, &c_b14, &t[t_offset], ldt,
				               &work[work_offset], ldwork);

				/* C := C - W * V' */

				if (*n > *k) {

					/* C1 := C1 - W * V1' */

					i__1 = *n - *k;
					NUMblas_dgemm ("No transpose", "Transpose", m, &i__1, k, &c_b25, &work[work_offset], ldwork,
					               &v[v_offset], ldv, &c_b14, &c__[c_offset], ldc);
				}

				/* W := W * V2' */

				NUMblas_dtrmm ("Right", "Upper", "Transpose", "Unit", m, k, &c_b14, &v_ref (*n - *k + 1, 1), ldv,
				               &work[work_offset], ldwork);

				/* C2 := C2 - W */

				i__1 = *k;
				for (j = 1; j <= i__1; ++j) {
					i__2 = *m;
					for (i__ = 1; i__ <= i__2; ++i__) {
						c___ref (i__, *n - *k + j) = c___ref (i__, *n - *k + j) - work_ref (i__, j);
						/* L110: */
					}
					/* L120: */
				}
			}
		}

	} else if (lsame_ (storev, "R")) {

		if (lsame_ (direct, "F")) {

			/* Let V = ( V1 V2 ) (V1: first K columns) where V1 is unit upper
			   triangular. */

			if (lsame_ (side, "L")) {

				/* Form H * C or H' * C where C = ( C1 ) ( C2 )

				   W := C' * V' = (C1'*V1' + C2'*V2') (stored in WORK)

				   W := C1' */

				i__1 = *k;
				for (j = 1; j <= i__1; ++j) {
					NUMblas_dcopy (n, &c___ref (j, 1), ldc, &work_ref (1, j), &c__1);
					/* L130: */
				}

				/* W := W * V1' */

				NUMblas_dtrmm ("Right", "Upper", "Transpose", "Unit", n, k, &c_b14, &v[v_offset], ldv,
				               &work[work_offset], ldwork);
				if (*m > *k) {

					/* W := W + C2'*V2' */

					i__1 = *m - *k;
					NUMblas_dgemm ("Transpose", "Transpose", n, k, &i__1, &c_b14, &c___ref (*k + 1, 1), ldc,
					               &v_ref (1, *k + 1), ldv, &c_b14, &work[work_offset], ldwork);
				}

				/* W := W * T' or W * T */

				NUMblas_dtrmm ("Right", "Upper", transt, "Non-unit", n, k, &c_b14, &t[t_offset], ldt,
				               &work[work_offset], ldwork);

				/* C := C - V' * W' */

				if (*m > *k) {

					/* C2 := C2 - V2' * W' */

					i__1 = *m - *k;
					NUMblas_dgemm ("Transpose", "Transpose", &i__1, n, k, &c_b25, &v_ref (1, *k + 1), ldv,
					               &work[work_offset], ldwork, &c_b14, &c___ref (*k + 1, 1), ldc);
				}

				/* W := W * V1 */

				NUMblas_dtrmm ("Right", "Upper", "No transpose", "Unit", n, k, &c_b14, &v[v_offset], ldv,
				               &work[work_offset], ldwork);

				/* C1 := C1 - W' */

				i__1 = *k;
				for (j = 1; j <= i__1; ++j) {
					i__2 = *n;
					for (i__ = 1; i__ <= i__2; ++i__) {
						c___ref (j, i__) = c___ref (j, i__) - work_ref (i__, j);
						/* L140: */
					}
					/* L150: */
				}

			} else if (lsame_ (side, "R")) {

				/* Form C * H or C * H' where C = ( C1 C2 )

				   W := C * V' = (C1*V1' + C2*V2') (stored in WORK)

				   W := C1 */

				i__1 = *k;
				for (j = 1; j <= i__1; ++j) {
					NUMblas_dcopy (m, &c___ref (1, j), &c__1, &work_ref (1, j), &c__1);
					/* L160: */
				}

				/* W := W * V1' */

				NUMblas_dtrmm ("Right", "Upper", "Transpose", "Unit", m, k, &c_b14, &v[v_offset], ldv,
				               &work[work_offset], ldwork);
				if (*n > *k) {

					/* W := W + C2 * V2' */

					i__1 = *n - *k;
					NUMblas_dgemm ("No transpose", "Transpose", m, k, &i__1, &c_b14, &c___ref (1, *k + 1), ldc,
					               &v_ref (1, *k + 1), ldv, &c_b14, &work[work_offset], ldwork);
				}

				/* W := W * T or W * T' */

				NUMblas_dtrmm ("Right", "Upper", trans, "Non-unit", m, k, &c_b14, &t[t_offset], ldt,
				               &work[work_offset], ldwork);

				/* C := C - W * V */

				if (*n > *k) {

					/* C2 := C2 - W * V2 */

					i__1 = *n - *k;
					NUMblas_dgemm ("No transpose", "No transpose", m, &i__1, k, &c_b25, &work[work_offset], ldwork,
					               &v_ref (1, *k + 1), ldv, &c_b14, &c___ref (1, *k + 1), ldc);
				}

				/* W := W * V1 */

				NUMblas_dtrmm ("Right", "Upper", "No transpose", "Unit", m, k, &c_b14, &v[v_offset], ldv,
				               &work[work_offset], ldwork);

				/* C1 := C1 - W */

				i__1 = *k;
				for (j = 1; j <= i__1; ++j) {
					i__2 = *m;
					for (i__ = 1; i__ <= i__2; ++i__) {
						c___ref (i__, j) = c___ref (i__, j) - work_ref (i__, j);
						/* L170: */
					}
					/* L180: */
				}

			}

		} else {

			/* Let V = ( V1 V2 ) (V2: last K columns) where V2 is unit lower
			   triangular. */

			if (lsame_ (side, "L")) {

				/* Form H * C or H' * C where C = ( C1 ) ( C2 )

				   W := C' * V' = (C1'*V1' + C2'*V2') (stored in WORK)

				   W := C2' */

				i__1 = *k;
				for (j = 1; j <= i__1; ++j) {
					NUMblas_dcopy (n, &c___ref (*m - *k + j, 1), ldc, &work_ref (1, j), &c__1);
					/* L190: */
				}

				/* W := W * V2' */

				NUMblas_dtrmm ("Right", "Lower", "Transpose", "Unit", n, k, &c_b14, &v_ref (1, *m - *k + 1), ldv,
				               &work[work_offset], ldwork);
				if (*m > *k) {

					/* W := W + C1'*V1' */

					i__1 = *m - *k;
					NUMblas_dgemm ("Transpose", "Transpose", n, k, &i__1, &c_b14, &c__[c_offset], ldc, &v[v_offset],
					               ldv, &c_b14, &work[work_offset], ldwork);
				}

				/* W := W * T' or W * T */

				NUMblas_dtrmm ("Right", "Lower", transt, "Non-unit", n, k, &c_b14, &t[t_offset], ldt,
				               &work[work_offset], ldwork);

				/* C := C - V' * W' */

				if (*m > *k) {

					/* C1 := C1 - V1' * W' */

					i__1 = *m - *k;
					NUMblas_dgemm ("Transpose", "Transpose", &i__1, n, k, &c_b25, &v[v_offset], ldv,
					               &work[work_offset], ldwork, &c_b14, &c__[c_offset], ldc);
				}

				/* W := W * V2 */

				NUMblas_dtrmm ("Right", "Lower", "No transpose", "Unit", n, k, &c_b14, &v_ref (1, *m - *k + 1), ldv,
				               &work[work_offset], ldwork);

				/* C2 := C2 - W' */

				i__1 = *k;
				for (j = 1; j <= i__1; ++j) {
					i__2 = *n;
					for (i__ = 1; i__ <= i__2; ++i__) {
						c___ref (*m - *k + j, i__) = c___ref (*m - *k + j, i__) - work_ref (i__, j);
						/* L200: */
					}
					/* L210: */
				}

			} else if (lsame_ (side, "R")) {

				/* Form C * H or C * H' where C = ( C1 C2 )

				   W := C * V' = (C1*V1' + C2*V2') (stored in WORK)

				   W := C2 */

				i__1 = *k;
				for (j = 1; j <= i__1; ++j) {
					NUMblas_dcopy (m, &c___ref (1, *n - *k + j), &c__1, &work_ref (1, j), &c__1);
					/* L220: */
				}

				/* W := W * V2' */

				NUMblas_dtrmm ("Right", "Lower", "Transpose", "Unit", m, k, &c_b14, &v_ref (1, *n - *k + 1), ldv,
				               &work[work_offset], ldwork);
				if (*n > *k) {

					/* W := W + C1 * V1' */

					i__1 = *n - *k;
					NUMblas_dgemm ("No transpose", "Transpose", m, k, &i__1, &c_b14, &c__[c_offset], ldc,
					               &v[v_offset], ldv, &c_b14, &work[work_offset], ldwork);
				}

				/* W := W * T or W * T' */

				NUMblas_dtrmm ("Right", "Lower", trans, "Non-unit", m, k, &c_b14, &t[t_offset], ldt,
				               &work[work_offset], ldwork);

				/* C := C - W * V */

				if (*n > *k) {

					/* C1 := C1 - W * V1 */

					i__1 = *n - *k;
					NUMblas_dgemm ("No transpose", "No transpose", m, &i__1, k, &c_b25, &work[work_offset], ldwork,
					               &v[v_offset], ldv, &c_b14, &c__[c_offset], ldc);
				}

				/* W := W * V2 */

				NUMblas_dtrmm ("Right", "Lower", "No transpose", "Unit", m, k, &c_b14, &v_ref (1, *n - *k + 1), ldv,
				               &work[work_offset], ldwork);

				/* C1 := C1 - W */

				i__1 = *k;
				for (j = 1; j <= i__1; ++j) {
					i__2 = *m;
					for (i__ = 1; i__ <= i__2; ++i__) {
						c___ref (i__, *n - *k + j) = c___ref (i__, *n - *k + j) - work_ref (i__, j);
						/* L230: */
					}
					/* L240: */
				}

			}

		}
	}

	return 0;
}								/* NUMlapack_dlarfb */

#undef v_ref
#undef work_ref

int NUMlapack_dlarf (const char *side, integer *m, integer *n, double *v, integer *incv, double *tau, double *c__, integer *ldc,
                     double *work) {
	/* Table of constant values */
	static double c_b4 = 1.;
	static double c_b5 = 0.;
	static integer c__1 = 1;

	/* System generated locals */
	integer c_dim1, c_offset;
	double d__1;

	/* Local variables */

	--v;
	c_dim1 = *ldc;
	c_offset = 1 + c_dim1 * 1;
	c__ -= c_offset;
	--work;

	/* Function Body */
	if (lsame_ (side, "L")) {

		/* Form H * C */

		if (*tau != 0.) {

			/* w := C' * v */

			NUMblas_dgemv ("Transpose", m, n, &c_b4, &c__[c_offset], ldc, &v[1], incv, &c_b5, &work[1], &c__1);

			/* C := C - v * w' */

			d__1 = - (*tau);
			NUMblas_dger (m, n, &d__1, &v[1], incv, &work[1], &c__1, &c__[c_offset], ldc);
		}
	} else {

		/* Form C * H */

		if (*tau != 0.) {

			/* w := C * v */

			NUMblas_dgemv ("No transpose", m, n, &c_b4, &c__[c_offset], ldc, &v[1], incv, &c_b5, &work[1], &c__1);

			/* C := C - w * v' */

			d__1 = - (*tau);
			NUMblas_dger (m, n, &d__1, &work[1], &c__1, &v[1], incv, &c__[c_offset], ldc);
		}
	}
	return 0;
}								/* NUMlapack_dlarf */

int NUMlapack_dlarfg (integer *n, double *alpha, double *x, integer *incx, double *tau) {
	/* System generated locals */
	integer i__1;
	double d__1;

	/* Local variables */
	static double beta;
	static integer j;
	static double xnorm;
	static double safmin, rsafmn;
	static integer knt;

	--x;

	/* Function Body */
	if (*n <= 1) {
		*tau = 0.;
		return 0;
	}

	i__1 = *n - 1;
	xnorm = NUMblas_dnrm2 (&i__1, &x[1], incx);

	if (xnorm == 0.) {

		/* H = I */

		*tau = 0.;
	} else {

		/* general case */

		d__1 = NUMlapack_dlapy2 (alpha, &xnorm);
		beta = -d_sign (&d__1, alpha);
		safmin = NUMblas_dlamch ("S") / NUMblas_dlamch ("E");
		if (fabs (beta) < safmin) {

			/* XNORM, BETA may be inaccurate; scale X and recompute them */

			rsafmn = 1. / safmin;
			knt = 0;
L10:
			++knt;
			i__1 = *n - 1;
			NUMblas_dscal (&i__1, &rsafmn, &x[1], incx);
			beta *= rsafmn;
			*alpha *= rsafmn;
			if (fabs (beta) < safmin) {
				goto L10;
			}

			/* New BETA is at most 1, at least SAFMIN */

			i__1 = *n - 1;
			xnorm = NUMblas_dnrm2 (&i__1, &x[1], incx);
			d__1 = NUMlapack_dlapy2 (alpha, &xnorm);
			beta = -d_sign (&d__1, alpha);
			*tau = (beta - *alpha) / beta;
			i__1 = *n - 1;
			d__1 = 1. / (*alpha - beta);
			NUMblas_dscal (&i__1, &d__1, &x[1], incx);

			/* If ALPHA is subnormal, it may lose relative accuracy */

			*alpha = beta;
			i__1 = knt;
			for (j = 1; j <= i__1; ++j) {
				*alpha *= safmin;
				/* L20: */
			}
		} else {
			*tau = (beta - *alpha) / beta;
			i__1 = *n - 1;
			d__1 = 1. / (*alpha - beta);
			NUMblas_dscal (&i__1, &d__1, &x[1], incx);
			*alpha = beta;
		}
	}

	return 0;
}								/* NUMlapack_dlarfg */

#define t_ref(a_1,a_2) t[(a_2)*t_dim1 + a_1]
#define v_ref(a_1,a_2) v[(a_2)*v_dim1 + a_1]

int NUMlapack_dlarft (const char *direct, const char *storev, integer *n, integer *k, double *v, integer *ldv, double *tau,
                      double *t, integer *ldt) {
	/* Table of constant values */
	static integer c__1 = 1;
	static double c_b8 = 0.;

	/* System generated locals */
	integer t_dim1, t_offset, v_dim1, v_offset, i__1, i__2, i__3;
	double d__1;

	/* Local variables */
	static integer i__, j;
	static double vii;

	v_dim1 = *ldv;
	v_offset = 1 + v_dim1 * 1;
	v -= v_offset;
	--tau;
	t_dim1 = *ldt;
	t_offset = 1 + t_dim1 * 1;
	t -= t_offset;

	/* Function Body */
	if (*n == 0) {
		return 0;
	}

	if (lsame_ (direct, "F")) {
		i__1 = *k;
		for (i__ = 1; i__ <= i__1; ++i__) {
			if (tau[i__] == 0.) {

				/* H(i) = I */

				i__2 = i__;
				for (j = 1; j <= i__2; ++j) {
					t_ref (j, i__) = 0.;
					/* L10: */
				}
			} else {

				/* general case */

				vii = v_ref (i__, i__);
				v_ref (i__, i__) = 1.;
				if (lsame_ (storev, "C")) {

					/* T(1:i-1,i) := - tau(i) * V(i:n,1:i-1)' * V(i:n,i) */

					i__2 = *n - i__ + 1;
					i__3 = i__ - 1;
					d__1 = -tau[i__];
					NUMblas_dgemv ("Transpose", &i__2, &i__3, &d__1, &v_ref (i__, 1), ldv, &v_ref (i__, i__), &c__1,
					               &c_b8, &t_ref (1, i__), &c__1);
				} else {

					/* T(1:i-1,i) := - tau(i) * V(1:i-1,i:n) * V(i,i:n)' */

					i__2 = i__ - 1;
					i__3 = *n - i__ + 1;
					d__1 = -tau[i__];
					NUMblas_dgemv ("No transpose", &i__2, &i__3, &d__1, &v_ref (1, i__), ldv, &v_ref (i__, i__), ldv,
					               &c_b8, &t_ref (1, i__), &c__1);
				}
				v_ref (i__, i__) = vii;

				/* T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i) */

				i__2 = i__ - 1;
				NUMblas_dtrmv ("Upper", "No transpose", "Non-unit", &i__2, &t[t_offset], ldt, &t_ref (1, i__),
				               &c__1);
				t_ref (i__, i__) = tau[i__];
			}
			/* L20: */
		}
	} else {
		for (i__ = *k; i__ >= 1; --i__) {
			if (tau[i__] == 0.) {

				/* H(i) = I */

				i__1 = *k;
				for (j = i__; j <= i__1; ++j) {
					t_ref (j, i__) = 0.;
					/* L30: */
				}
			} else {

				/* general case */

				if (i__ < *k) {
					if (lsame_ (storev, "C")) {
						vii = v_ref (*n - *k + i__, i__);
						v_ref (*n - *k + i__, i__) = 1.;

						/* T(i+1:k,i) := - tau(i) * V(1:n-k+i,i+1:k)' *
						   V(1:n-k+i,i) */

						i__1 = *n - *k + i__;
						i__2 = *k - i__;
						d__1 = -tau[i__];
						NUMblas_dgemv ("Transpose", &i__1, &i__2, &d__1, &v_ref (1, i__ + 1), ldv, &v_ref (1, i__),
						               &c__1, &c_b8, &t_ref (i__ + 1, i__), &c__1);
						v_ref (*n - *k + i__, i__) = vii;
					} else {
						vii = v_ref (i__, *n - *k + i__);
						v_ref (i__, *n - *k + i__) = 1.;

						/* T(i+1:k,i) := - tau(i) * V(i+1:k,1:n-k+i) *
						   V(i,1:n-k+i)' */

						i__1 = *k - i__;
						i__2 = *n - *k + i__;
						d__1 = -tau[i__];
						NUMblas_dgemv ("No transpose", &i__1, &i__2, &d__1, &v_ref (i__ + 1, 1), ldv, &v_ref (i__,
						               1), ldv, &c_b8, &t_ref (i__ + 1, i__), &c__1);
						v_ref (i__, *n - *k + i__) = vii;
					}

					/* T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i) */

					i__1 = *k - i__;
					NUMblas_dtrmv ("Lower", "No transpose", "Non-unit", &i__1, &t_ref (i__ + 1, i__ + 1), ldt,
					               &t_ref (i__ + 1, i__), &c__1);
				}
				t_ref (i__, i__) = tau[i__];
			}
			/* L40: */
		}
	}
	return 0;
}								/* NUMlapack_dlarft */

#undef v_ref
#undef t_ref

int NUMlapack_dlartg (double *f, double *g, double *cs, double *sn, double *r__) {
	/* Initialized data */
	static integer first = TRUE;

	/* System generated locals */
	integer i__1;
	double d__1, d__2;

	/* Local variables */
	static integer i__;
	static double scale;
	static integer count;
	static double f1, g1, safmn2, safmx2;
	static double safmin, eps;

	if (first) {
		first = FALSE;
		safmin = NUMblas_dlamch ("S");
		eps = NUMblas_dlamch ("E");
		d__1 = NUMblas_dlamch ("B");
		i__1 = (integer) (log (safmin / eps) / log (NUMblas_dlamch ("B")) / 2.);
		safmn2 = pow_di (&d__1, &i__1);
		safmx2 = 1. / safmn2;
	}
	if (*g == 0.) {
		*cs = 1.;
		*sn = 0.;
		*r__ = *f;
	} else if (*f == 0.) {
		*cs = 0.;
		*sn = 1.;
		*r__ = *g;
	} else {
		f1 = *f;
		g1 = *g;
		/* Computing MAX */
		d__1 = fabs (f1), d__2 = fabs (g1);
		scale = MAX (d__1, d__2);
		if (scale >= safmx2) {
			count = 0;
L10:
			++count;
			f1 *= safmn2;
			g1 *= safmn2;
			/* Computing MAX */
			d__1 = fabs (f1), d__2 = fabs (g1);
			scale = MAX (d__1, d__2);
			if (scale >= safmx2) {
				goto L10;
			}
			/* Computing 2nd power */
			d__1 = f1;
			/* Computing 2nd power */
			d__2 = g1;
			*r__ = sqrt (d__1 * d__1 + d__2 * d__2);
			*cs = f1 / *r__;
			*sn = g1 / *r__;
			i__1 = count;
			for (i__ = 1; i__ <= i__1; ++i__) {
				*r__ *= safmx2;
				/* L20: */
			}
		} else if (scale <= safmn2) {
			count = 0;
L30:
			++count;
			f1 *= safmx2;
			g1 *= safmx2;
			/* Computing MAX */
			d__1 = fabs (f1), d__2 = fabs (g1);
			scale = MAX (d__1, d__2);
			if (scale <= safmn2) {
				goto L30;
			}
			/* Computing 2nd power */
			d__1 = f1;
			/* Computing 2nd power */
			d__2 = g1;
			*r__ = sqrt (d__1 * d__1 + d__2 * d__2);
			*cs = f1 / *r__;
			*sn = g1 / *r__;
			i__1 = count;
			for (i__ = 1; i__ <= i__1; ++i__) {
				*r__ *= safmn2;
				/* L40: */
			}
		} else {
			/* Computing 2nd power */
			d__1 = f1;
			/* Computing 2nd power */
			d__2 = g1;
			*r__ = sqrt (d__1 * d__1 + d__2 * d__2);
			*cs = f1 / *r__;
			*sn = g1 / *r__;
		}
		if (fabs (*f) > fabs (*g) && *cs < 0.) {
			*cs = - (*cs);
			*sn = - (*sn);
			*r__ = - (*r__);
		}
	}
	return 0;
}								/* NUMlapack_dlartg */

int NUMlapack_dlarfx (const char *side, integer *m, integer *n, double *v, double *tau, double *c__, integer *ldc,
                      double *work) {
	/* Table of constant values */
	static double c_b14 = 1.;
	static integer c__1 = 1;
	static double c_b16 = 0.;

	/* System generated locals */
	integer c_dim1, c_offset, i__1;
	double d__1;

	/* Local variables */
	static integer j;
	static double t1, t2, t3, t4, t5, t6, t7, t8, t9, v1, v2, v3, v4, v5, v6, v7, v8, v9, t10, v10, sum;

	--v;
	c_dim1 = *ldc;
	c_offset = 1 + c_dim1 * 1;
	c__ -= c_offset;
	--work;

	/* Function Body */
	if (*tau == 0.) {
		return 0;
	}
	if (lsame_ (side, "L")) {

		/* Form H * C, where H has order m. */

		switch (*m) {
			case 1:
				goto L10;
			case 2:
				goto L30;
			case 3:
				goto L50;
			case 4:
				goto L70;
			case 5:
				goto L90;
			case 6:
				goto L110;
			case 7:
				goto L130;
			case 8:
				goto L150;
			case 9:
				goto L170;
			case 10:
				goto L190;
		}

		/* Code for general M

		   w := C'*v */

		NUMblas_dgemv ("Transpose", m, n, &c_b14, &c__[c_offset], ldc, &v[1], &c__1, &c_b16, &work[1],
		               &c__1);

		/* C := C - tau * v * w' */

		d__1 = - (*tau);
		NUMblas_dger (m, n, &d__1, &v[1], &c__1, &work[1], &c__1, &c__[c_offset], ldc);
		goto L410;
L10:

		/* Special code for 1 x 1 Householder */

		t1 = 1. - *tau * v[1] * v[1];
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
			c___ref (1, j) = t1 * c___ref (1, j);
			/* L20: */
		}
		goto L410;
L30:

		/* Special code for 2 x 2 Householder */

		v1 = v[1];
		t1 = *tau * v1;
		v2 = v[2];
		t2 = *tau * v2;
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
			sum = v1 * c___ref (1, j) + v2 * c___ref (2, j);
			c___ref (1, j) = c___ref (1, j) - sum * t1;
			c___ref (2, j) = c___ref (2, j) - sum * t2;
			/* L40: */
		}
		goto L410;
L50:

		/* Special code for 3 x 3 Householder */

		v1 = v[1];
		t1 = *tau * v1;
		v2 = v[2];
		t2 = *tau * v2;
		v3 = v[3];
		t3 = *tau * v3;
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
			sum = v1 * c___ref (1, j) + v2 * c___ref (2, j) + v3 * c___ref (3, j);
			c___ref (1, j) = c___ref (1, j) - sum * t1;
			c___ref (2, j) = c___ref (2, j) - sum * t2;
			c___ref (3, j) = c___ref (3, j) - sum * t3;
			/* L60: */
		}
		goto L410;
L70:

		/* Special code for 4 x 4 Householder */

		v1 = v[1];
		t1 = *tau * v1;
		v2 = v[2];
		t2 = *tau * v2;
		v3 = v[3];
		t3 = *tau * v3;
		v4 = v[4];
		t4 = *tau * v4;
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
			sum = v1 * c___ref (1, j) + v2 * c___ref (2, j) + v3 * c___ref (3, j) + v4 * c___ref (4, j);
			c___ref (1, j) = c___ref (1, j) - sum * t1;
			c___ref (2, j) = c___ref (2, j) - sum * t2;
			c___ref (3, j) = c___ref (3, j) - sum * t3;
			c___ref (4, j) = c___ref (4, j) - sum * t4;
			/* L80: */
		}
		goto L410;
L90:

		/* Special code for 5 x 5 Householder */

		v1 = v[1];
		t1 = *tau * v1;
		v2 = v[2];
		t2 = *tau * v2;
		v3 = v[3];
		t3 = *tau * v3;
		v4 = v[4];
		t4 = *tau * v4;
		v5 = v[5];
		t5 = *tau * v5;
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
			sum =
			    v1 * c___ref (1, j) + v2 * c___ref (2, j) + v3 * c___ref (3, j) + v4 * c___ref (4,
			            j) + v5 * c___ref (5, j);
			c___ref (1, j) = c___ref (1, j) - sum * t1;
			c___ref (2, j) = c___ref (2, j) - sum * t2;
			c___ref (3, j) = c___ref (3, j) - sum * t3;
			c___ref (4, j) = c___ref (4, j) - sum * t4;
			c___ref (5, j) = c___ref (5, j) - sum * t5;
			/* L100: */
		}
		goto L410;
L110:

		/* Special code for 6 x 6 Householder */

		v1 = v[1];
		t1 = *tau * v1;
		v2 = v[2];
		t2 = *tau * v2;
		v3 = v[3];
		t3 = *tau * v3;
		v4 = v[4];
		t4 = *tau * v4;
		v5 = v[5];
		t5 = *tau * v5;
		v6 = v[6];
		t6 = *tau * v6;
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
			sum =
			    v1 * c___ref (1, j) + v2 * c___ref (2, j) + v3 * c___ref (3, j) + v4 * c___ref (4,
			            j) + v5 * c___ref (5, j) + v6 * c___ref (6, j);
			c___ref (1, j) = c___ref (1, j) - sum * t1;
			c___ref (2, j) = c___ref (2, j) - sum * t2;
			c___ref (3, j) = c___ref (3, j) - sum * t3;
			c___ref (4, j) = c___ref (4, j) - sum * t4;
			c___ref (5, j) = c___ref (5, j) - sum * t5;
			c___ref (6, j) = c___ref (6, j) - sum * t6;
			/* L120: */
		}
		goto L410;
L130:

		/* Special code for 7 x 7 Householder */

		v1 = v[1];
		t1 = *tau * v1;
		v2 = v[2];
		t2 = *tau * v2;
		v3 = v[3];
		t3 = *tau * v3;
		v4 = v[4];
		t4 = *tau * v4;
		v5 = v[5];
		t5 = *tau * v5;
		v6 = v[6];
		t6 = *tau * v6;
		v7 = v[7];
		t7 = *tau * v7;
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
			sum =
			    v1 * c___ref (1, j) + v2 * c___ref (2, j) + v3 * c___ref (3, j) + v4 * c___ref (4,
			            j) + v5 * c___ref (5, j) + v6 * c___ref (6, j) + v7 * c___ref (7, j);
			c___ref (1, j) = c___ref (1, j) - sum * t1;
			c___ref (2, j) = c___ref (2, j) - sum * t2;
			c___ref (3, j) = c___ref (3, j) - sum * t3;
			c___ref (4, j) = c___ref (4, j) - sum * t4;
			c___ref (5, j) = c___ref (5, j) - sum * t5;
			c___ref (6, j) = c___ref (6, j) - sum * t6;
			c___ref (7, j) = c___ref (7, j) - sum * t7;
			/* L140: */
		}
		goto L410;
L150:

		/* Special code for 8 x 8 Householder */

		v1 = v[1];
		t1 = *tau * v1;
		v2 = v[2];
		t2 = *tau * v2;
		v3 = v[3];
		t3 = *tau * v3;
		v4 = v[4];
		t4 = *tau * v4;
		v5 = v[5];
		t5 = *tau * v5;
		v6 = v[6];
		t6 = *tau * v6;
		v7 = v[7];
		t7 = *tau * v7;
		v8 = v[8];
		t8 = *tau * v8;
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
			sum =
			    v1 * c___ref (1, j) + v2 * c___ref (2, j) + v3 * c___ref (3, j) + v4 * c___ref (4,
			            j) + v5 * c___ref (5, j) + v6 * c___ref (6, j) + v7 * c___ref (7, j) + v8 * c___ref (8, j);
			c___ref (1, j) = c___ref (1, j) - sum * t1;
			c___ref (2, j) = c___ref (2, j) - sum * t2;
			c___ref (3, j) = c___ref (3, j) - sum * t3;
			c___ref (4, j) = c___ref (4, j) - sum * t4;
			c___ref (5, j) = c___ref (5, j) - sum * t5;
			c___ref (6, j) = c___ref (6, j) - sum * t6;
			c___ref (7, j) = c___ref (7, j) - sum * t7;
			c___ref (8, j) = c___ref (8, j) - sum * t8;
			/* L160: */
		}
		goto L410;
L170:

		/* Special code for 9 x 9 Householder */

		v1 = v[1];
		t1 = *tau * v1;
		v2 = v[2];
		t2 = *tau * v2;
		v3 = v[3];
		t3 = *tau * v3;
		v4 = v[4];
		t4 = *tau * v4;
		v5 = v[5];
		t5 = *tau * v5;
		v6 = v[6];
		t6 = *tau * v6;
		v7 = v[7];
		t7 = *tau * v7;
		v8 = v[8];
		t8 = *tau * v8;
		v9 = v[9];
		t9 = *tau * v9;
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
			sum =
			    v1 * c___ref (1, j) + v2 * c___ref (2, j) + v3 * c___ref (3, j) + v4 * c___ref (4,
			            j) + v5 * c___ref (5, j) + v6 * c___ref (6, j) + v7 * c___ref (7, j) + v8 * c___ref (8,
			                    j) + v9 * c___ref (9, j);
			c___ref (1, j) = c___ref (1, j) - sum * t1;
			c___ref (2, j) = c___ref (2, j) - sum * t2;
			c___ref (3, j) = c___ref (3, j) - sum * t3;
			c___ref (4, j) = c___ref (4, j) - sum * t4;
			c___ref (5, j) = c___ref (5, j) - sum * t5;
			c___ref (6, j) = c___ref (6, j) - sum * t6;
			c___ref (7, j) = c___ref (7, j) - sum * t7;
			c___ref (8, j) = c___ref (8, j) - sum * t8;
			c___ref (9, j) = c___ref (9, j) - sum * t9;
			/* L180: */
		}
		goto L410;
L190:

		/* Special code for 10 x 10 Householder */

		v1 = v[1];
		t1 = *tau * v1;
		v2 = v[2];
		t2 = *tau * v2;
		v3 = v[3];
		t3 = *tau * v3;
		v4 = v[4];
		t4 = *tau * v4;
		v5 = v[5];
		t5 = *tau * v5;
		v6 = v[6];
		t6 = *tau * v6;
		v7 = v[7];
		t7 = *tau * v7;
		v8 = v[8];
		t8 = *tau * v8;
		v9 = v[9];
		t9 = *tau * v9;
		v10 = v[10];
		t10 = *tau * v10;
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
			sum =
			    v1 * c___ref (1, j) + v2 * c___ref (2, j) + v3 * c___ref (3, j) + v4 * c___ref (4,
			            j) + v5 * c___ref (5, j) + v6 * c___ref (6, j) + v7 * c___ref (7, j) + v8 * c___ref (8,
			                    j) + v9 * c___ref (9, j) + v10 * c___ref (10, j);
			c___ref (1, j) = c___ref (1, j) - sum * t1;
			c___ref (2, j) = c___ref (2, j) - sum * t2;
			c___ref (3, j) = c___ref (3, j) - sum * t3;
			c___ref (4, j) = c___ref (4, j) - sum * t4;
			c___ref (5, j) = c___ref (5, j) - sum * t5;
			c___ref (6, j) = c___ref (6, j) - sum * t6;
			c___ref (7, j) = c___ref (7, j) - sum * t7;
			c___ref (8, j) = c___ref (8, j) - sum * t8;
			c___ref (9, j) = c___ref (9, j) - sum * t9;
			c___ref (10, j) = c___ref (10, j) - sum * t10;
			/* L200: */
		}
		goto L410;
	} else {

		/* Form C * H, where H has order n. */

		switch (*n) {
			case 1:
				goto L210;
			case 2:
				goto L230;
			case 3:
				goto L250;
			case 4:
				goto L270;
			case 5:
				goto L290;
			case 6:
				goto L310;
			case 7:
				goto L330;
			case 8:
				goto L350;
			case 9:
				goto L370;
			case 10:
				goto L390;
		}

		/* Code for general N

		   w := C * v */

		NUMblas_dgemv ("No transpose", m, n, &c_b14, &c__[c_offset], ldc, &v[1], &c__1, &c_b16, &work[1],
		               &c__1);

		/* C := C - tau * w * v' */

		d__1 = - (*tau);
		NUMblas_dger (m, n, &d__1, &work[1], &c__1, &v[1], &c__1, &c__[c_offset], ldc);
		goto L410;
L210:

		/* Special code for 1 x 1 Householder */

		t1 = 1. - *tau * v[1] * v[1];
		i__1 = *m;
		for (j = 1; j <= i__1; ++j) {
			c___ref (j, 1) = t1 * c___ref (j, 1);
			/* L220: */
		}
		goto L410;
L230:

		/* Special code for 2 x 2 Householder */

		v1 = v[1];
		t1 = *tau * v1;
		v2 = v[2];
		t2 = *tau * v2;
		i__1 = *m;
		for (j = 1; j <= i__1; ++j) {
			sum = v1 * c___ref (j, 1) + v2 * c___ref (j, 2);
			c___ref (j, 1) = c___ref (j, 1) - sum * t1;
			c___ref (j, 2) = c___ref (j, 2) - sum * t2;
			/* L240: */
		}
		goto L410;
L250:

		/* Special code for 3 x 3 Householder */

		v1 = v[1];
		t1 = *tau * v1;
		v2 = v[2];
		t2 = *tau * v2;
		v3 = v[3];
		t3 = *tau * v3;
		i__1 = *m;
		for (j = 1; j <= i__1; ++j) {
			sum = v1 * c___ref (j, 1) + v2 * c___ref (j, 2) + v3 * c___ref (j, 3);
			c___ref (j, 1) = c___ref (j, 1) - sum * t1;
			c___ref (j, 2) = c___ref (j, 2) - sum * t2;
			c___ref (j, 3) = c___ref (j, 3) - sum * t3;
			/* L260: */
		}
		goto L410;
L270:

		/* Special code for 4 x 4 Householder */

		v1 = v[1];
		t1 = *tau * v1;
		v2 = v[2];
		t2 = *tau * v2;
		v3 = v[3];
		t3 = *tau * v3;
		v4 = v[4];
		t4 = *tau * v4;
		i__1 = *m;
		for (j = 1; j <= i__1; ++j) {
			sum = v1 * c___ref (j, 1) + v2 * c___ref (j, 2) + v3 * c___ref (j, 3) + v4 * c___ref (j, 4);
			c___ref (j, 1) = c___ref (j, 1) - sum * t1;
			c___ref (j, 2) = c___ref (j, 2) - sum * t2;
			c___ref (j, 3) = c___ref (j, 3) - sum * t3;
			c___ref (j, 4) = c___ref (j, 4) - sum * t4;
			/* L280: */
		}
		goto L410;
L290:

		/* Special code for 5 x 5 Householder */

		v1 = v[1];
		t1 = *tau * v1;
		v2 = v[2];
		t2 = *tau * v2;
		v3 = v[3];
		t3 = *tau * v3;
		v4 = v[4];
		t4 = *tau * v4;
		v5 = v[5];
		t5 = *tau * v5;
		i__1 = *m;
		for (j = 1; j <= i__1; ++j) {
			sum =
			    v1 * c___ref (j, 1) + v2 * c___ref (j, 2) + v3 * c___ref (j, 3) + v4 * c___ref (j,
			            4) + v5 * c___ref (j, 5);
			c___ref (j, 1) = c___ref (j, 1) - sum * t1;
			c___ref (j, 2) = c___ref (j, 2) - sum * t2;
			c___ref (j, 3) = c___ref (j, 3) - sum * t3;
			c___ref (j, 4) = c___ref (j, 4) - sum * t4;
			c___ref (j, 5) = c___ref (j, 5) - sum * t5;
			/* L300: */
		}
		goto L410;
L310:

		/* Special code for 6 x 6 Householder */

		v1 = v[1];
		t1 = *tau * v1;
		v2 = v[2];
		t2 = *tau * v2;
		v3 = v[3];
		t3 = *tau * v3;
		v4 = v[4];
		t4 = *tau * v4;
		v5 = v[5];
		t5 = *tau * v5;
		v6 = v[6];
		t6 = *tau * v6;
		i__1 = *m;
		for (j = 1; j <= i__1; ++j) {
			sum =
			    v1 * c___ref (j, 1) + v2 * c___ref (j, 2) + v3 * c___ref (j, 3) + v4 * c___ref (j,
			            4) + v5 * c___ref (j, 5) + v6 * c___ref (j, 6);
			c___ref (j, 1) = c___ref (j, 1) - sum * t1;
			c___ref (j, 2) = c___ref (j, 2) - sum * t2;
			c___ref (j, 3) = c___ref (j, 3) - sum * t3;
			c___ref (j, 4) = c___ref (j, 4) - sum * t4;
			c___ref (j, 5) = c___ref (j, 5) - sum * t5;
			c___ref (j, 6) = c___ref (j, 6) - sum * t6;
			/* L320: */
		}
		goto L410;
L330:

		/* Special code for 7 x 7 Householder */

		v1 = v[1];
		t1 = *tau * v1;
		v2 = v[2];
		t2 = *tau * v2;
		v3 = v[3];
		t3 = *tau * v3;
		v4 = v[4];
		t4 = *tau * v4;
		v5 = v[5];
		t5 = *tau * v5;
		v6 = v[6];
		t6 = *tau * v6;
		v7 = v[7];
		t7 = *tau * v7;
		i__1 = *m;
		for (j = 1; j <= i__1; ++j) {
			sum =
			    v1 * c___ref (j, 1) + v2 * c___ref (j, 2) + v3 * c___ref (j, 3) + v4 * c___ref (j,
			            4) + v5 * c___ref (j, 5) + v6 * c___ref (j, 6) + v7 * c___ref (j, 7);
			c___ref (j, 1) = c___ref (j, 1) - sum * t1;
			c___ref (j, 2) = c___ref (j, 2) - sum * t2;
			c___ref (j, 3) = c___ref (j, 3) - sum * t3;
			c___ref (j, 4) = c___ref (j, 4) - sum * t4;
			c___ref (j, 5) = c___ref (j, 5) - sum * t5;
			c___ref (j, 6) = c___ref (j, 6) - sum * t6;
			c___ref (j, 7) = c___ref (j, 7) - sum * t7;
			/* L340: */
		}
		goto L410;
L350:

		/* Special code for 8 x 8 Householder */

		v1 = v[1];
		t1 = *tau * v1;
		v2 = v[2];
		t2 = *tau * v2;
		v3 = v[3];
		t3 = *tau * v3;
		v4 = v[4];
		t4 = *tau * v4;
		v5 = v[5];
		t5 = *tau * v5;
		v6 = v[6];
		t6 = *tau * v6;
		v7 = v[7];
		t7 = *tau * v7;
		v8 = v[8];
		t8 = *tau * v8;
		i__1 = *m;
		for (j = 1; j <= i__1; ++j) {
			sum =
			    v1 * c___ref (j, 1) + v2 * c___ref (j, 2) + v3 * c___ref (j, 3) + v4 * c___ref (j,
			            4) + v5 * c___ref (j, 5) + v6 * c___ref (j, 6) + v7 * c___ref (j, 7) + v8 * c___ref (j, 8);
			c___ref (j, 1) = c___ref (j, 1) - sum * t1;
			c___ref (j, 2) = c___ref (j, 2) - sum * t2;
			c___ref (j, 3) = c___ref (j, 3) - sum * t3;
			c___ref (j, 4) = c___ref (j, 4) - sum * t4;
			c___ref (j, 5) = c___ref (j, 5) - sum * t5;
			c___ref (j, 6) = c___ref (j, 6) - sum * t6;
			c___ref (j, 7) = c___ref (j, 7) - sum * t7;
			c___ref (j, 8) = c___ref (j, 8) - sum * t8;
			/* L360: */
		}
		goto L410;
L370:

		/* Special code for 9 x 9 Householder */

		v1 = v[1];
		t1 = *tau * v1;
		v2 = v[2];
		t2 = *tau * v2;
		v3 = v[3];
		t3 = *tau * v3;
		v4 = v[4];
		t4 = *tau * v4;
		v5 = v[5];
		t5 = *tau * v5;
		v6 = v[6];
		t6 = *tau * v6;
		v7 = v[7];
		t7 = *tau * v7;
		v8 = v[8];
		t8 = *tau * v8;
		v9 = v[9];
		t9 = *tau * v9;
		i__1 = *m;
		for (j = 1; j <= i__1; ++j) {
			sum =
			    v1 * c___ref (j, 1) + v2 * c___ref (j, 2) + v3 * c___ref (j, 3) + v4 * c___ref (j,
			            4) + v5 * c___ref (j, 5) + v6 * c___ref (j, 6) + v7 * c___ref (j, 7) + v8 * c___ref (j,
			                    8) + v9 * c___ref (j, 9);
			c___ref (j, 1) = c___ref (j, 1) - sum * t1;
			c___ref (j, 2) = c___ref (j, 2) - sum * t2;
			c___ref (j, 3) = c___ref (j, 3) - sum * t3;
			c___ref (j, 4) = c___ref (j, 4) - sum * t4;
			c___ref (j, 5) = c___ref (j, 5) - sum * t5;
			c___ref (j, 6) = c___ref (j, 6) - sum * t6;
			c___ref (j, 7) = c___ref (j, 7) - sum * t7;
			c___ref (j, 8) = c___ref (j, 8) - sum * t8;
			c___ref (j, 9) = c___ref (j, 9) - sum * t9;
			/* L380: */
		}
		goto L410;
L390:

		/* Special code for 10 x 10 Householder */

		v1 = v[1];
		t1 = *tau * v1;
		v2 = v[2];
		t2 = *tau * v2;
		v3 = v[3];
		t3 = *tau * v3;
		v4 = v[4];
		t4 = *tau * v4;
		v5 = v[5];
		t5 = *tau * v5;
		v6 = v[6];
		t6 = *tau * v6;
		v7 = v[7];
		t7 = *tau * v7;
		v8 = v[8];
		t8 = *tau * v8;
		v9 = v[9];
		t9 = *tau * v9;
		v10 = v[10];
		t10 = *tau * v10;
		i__1 = *m;
		for (j = 1; j <= i__1; ++j) {
			sum =
			    v1 * c___ref (j, 1) + v2 * c___ref (j, 2) + v3 * c___ref (j, 3) + v4 * c___ref (j,
			            4) + v5 * c___ref (j, 5) + v6 * c___ref (j, 6) + v7 * c___ref (j, 7) + v8 * c___ref (j,
			                    8) + v9 * c___ref (j, 9) + v10 * c___ref (j, 10);
			c___ref (j, 1) = c___ref (j, 1) - sum * t1;
			c___ref (j, 2) = c___ref (j, 2) - sum * t2;
			c___ref (j, 3) = c___ref (j, 3) - sum * t3;
			c___ref (j, 4) = c___ref (j, 4) - sum * t4;
			c___ref (j, 5) = c___ref (j, 5) - sum * t5;
			c___ref (j, 6) = c___ref (j, 6) - sum * t6;
			c___ref (j, 7) = c___ref (j, 7) - sum * t7;
			c___ref (j, 8) = c___ref (j, 8) - sum * t8;
			c___ref (j, 9) = c___ref (j, 9) - sum * t9;
			c___ref (j, 10) = c___ref (j, 10) - sum * t10;
			/* L400: */
		}
		goto L410;
	}
L410:
	return 0;
}								/* NUMlapack_dlarfx */


int NUMlapack_dlas2 (double *f, double *g, double *h__, double *ssmin, double *ssmax) {
	/* System generated locals */
	double d__1, d__2;

	/* Local variables */
	static double fhmn, fhmx, c__, fa, ga, ha, as, at, au;

	fa = fabs (*f);
	ga = fabs (*g);
	ha = fabs (*h__);
	fhmn = MIN (fa, ha);
	fhmx = MAX (fa, ha);
	if (fhmn == 0.) {
		*ssmin = 0.;
		if (fhmx == 0.) {
			*ssmax = ga;
		} else {
			/* Computing 2nd power */
			d__1 = MIN (fhmx, ga) / MAX (fhmx, ga);
			*ssmax = MAX (fhmx, ga) * sqrt (d__1 * d__1 + 1.);
		}
	} else {
		if (ga < fhmx) {
			as = fhmn / fhmx + 1.;
			at = (fhmx - fhmn) / fhmx;
			/* Computing 2nd power */
			d__1 = ga / fhmx;
			au = d__1 * d__1;
			c__ = 2. / (sqrt (as * as + au) + sqrt (at * at + au));
			*ssmin = fhmn * c__;
			*ssmax = fhmx / c__;
		} else {
			au = fhmx / ga;
			if (au == 0.) {

				/* Avoid possible harmful underflow if exponent range
				   asymmetric (true SSMIN may not underflow even if AU
				   underflows) */

				*ssmin = fhmn * fhmx / ga;
				*ssmax = ga;
			} else {
				as = fhmn / fhmx + 1.;
				at = (fhmx - fhmn) / fhmx;
				/* Computing 2nd power */
				d__1 = as * au;
				/* Computing 2nd power */
				d__2 = at * au;
				c__ = 1. / (sqrt (d__1 * d__1 + 1.) + sqrt (d__2 * d__2 + 1.));
				*ssmin = fhmn * c__ * au;
				*ssmin += *ssmin;
				*ssmax = ga / (c__ + c__);
			}
		}
	}
	return 0;
}								/* NUMlapack_dlas2 */

int NUMlapack_dlascl (const char *type__, integer *kl, integer *ku, double *cfrom, double *cto, integer *m, integer *n, double *a,
                      integer *lda, integer *info) {
	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;

	/* Local variables */
	static integer done;
	static double ctoc;
	static integer i__, j;
	static integer itype, k1, k2, k3, k4;
	static double cfrom1;
	static double cfromc;
	static double bignum, smlnum, mul, cto1;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;

	/* Function Body */
	*info = 0;

	if (lsame_ (type__, "G")) {
		itype = 0;
	} else if (lsame_ (type__, "L")) {
		itype = 1;
	} else if (lsame_ (type__, "U")) {
		itype = 2;
	} else if (lsame_ (type__, "H")) {
		itype = 3;
	} else if (lsame_ (type__, "B")) {
		itype = 4;
	} else if (lsame_ (type__, "Q")) {
		itype = 5;
	} else if (lsame_ (type__, "Z")) {
		itype = 6;
	} else {
		itype = -1;
	}

	if (itype == -1) {
		*info = -1;
	} else if (*cfrom == 0.) {
		*info = -4;
	} else if (*m < 0) {
		*info = -6;
	} else if (*n < 0 || itype == 4 && *n != *m || itype == 5 && *n != *m) {
		*info = -7;
	} else if (itype <= 3 && *lda < MAX (1, *m)) {
		*info = -9;
	} else if (itype >= 4) {
		/* Computing MAX */
		i__1 = *m - 1;
		if (*kl < 0 || *kl > MAX (i__1, 0)) {
			*info = -2;
		} else {				/* if(complicated condition) */
			/* Computing MAX */
			i__1 = *n - 1;
			if (*ku < 0 || *ku > MAX (i__1, 0) || (itype == 4 || itype == 5) && *kl != *ku) {
				*info = -3;
			} else if (itype == 4 && *lda < *kl + 1 || itype == 5 && *lda < *ku + 1 || itype == 6 &&
			           *lda < (*kl << 1) + *ku + 1) {
				*info = -9;
			}
		}
	}

	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DLASCL", &i__1);
		return 0;
	}

	/* Quick return if possible */

	if (*n == 0 || *m == 0) {
		return 0;
	}

	/* Get machine parameters */

	smlnum = NUMblas_dlamch ("S");
	bignum = 1. / smlnum;

	cfromc = *cfrom;
	ctoc = *cto;

L10:
	cfrom1 = cfromc * smlnum;
	cto1 = ctoc / bignum;
	if (fabs (cfrom1) > fabs (ctoc) && ctoc != 0.) {
		mul = smlnum;
		done = FALSE;
		cfromc = cfrom1;
	} else if (fabs (cto1) > fabs (cfromc)) {
		mul = bignum;
		done = FALSE;
		ctoc = cto1;
	} else {
		mul = ctoc / cfromc;
		done = TRUE;
	}

	if (itype == 0) {

		/* Full matrix */

		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
			i__2 = *m;
			for (i__ = 1; i__ <= i__2; ++i__) {
				a_ref (i__, j) = a_ref (i__, j) * mul;
				/* L20: */
			}
			/* L30: */
		}

	} else if (itype == 1) {

		/* Lower triangular matrix */

		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
			i__2 = *m;
			for (i__ = j; i__ <= i__2; ++i__) {
				a_ref (i__, j) = a_ref (i__, j) * mul;
				/* L40: */
			}
			/* L50: */
		}

	} else if (itype == 2) {

		/* Upper triangular matrix */

		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
			i__2 = MIN (j, *m);
			for (i__ = 1; i__ <= i__2; ++i__) {
				a_ref (i__, j) = a_ref (i__, j) * mul;
				/* L60: */
			}
			/* L70: */
		}

	} else if (itype == 3) {

		/* Upper Hessenberg matrix */

		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
			/* Computing MIN */
			i__3 = j + 1;
			i__2 = MIN (i__3, *m);
			for (i__ = 1; i__ <= i__2; ++i__) {
				a_ref (i__, j) = a_ref (i__, j) * mul;
				/* L80: */
			}
			/* L90: */
		}

	} else if (itype == 4) {

		/* Lower half of a symmetric band matrix */

		k3 = *kl + 1;
		k4 = *n + 1;
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
			/* Computing MIN */
			i__3 = k3, i__4 = k4 - j;
			i__2 = MIN (i__3, i__4);
			for (i__ = 1; i__ <= i__2; ++i__) {
				a_ref (i__, j) = a_ref (i__, j) * mul;
				/* L100: */
			}
			/* L110: */
		}

	} else if (itype == 5) {

		/* Upper half of a symmetric band matrix */

		k1 = *ku + 2;
		k3 = *ku + 1;
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
			/* Computing MAX */
			i__2 = k1 - j;
			i__3 = k3;
			for (i__ = MAX (i__2, 1); i__ <= i__3; ++i__) {
				a_ref (i__, j) = a_ref (i__, j) * mul;
				/* L120: */
			}
			/* L130: */
		}

	} else if (itype == 6) {

		/* Band matrix */

		k1 = *kl + *ku + 2;
		k2 = *kl + 1;
		k3 = (*kl << 1) + *ku + 1;
		k4 = *kl + *ku + 1 + *m;
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
			/* Computing MAX */
			i__3 = k1 - j;
			/* Computing MIN */
			i__4 = k3, i__5 = k4 - j;
			i__2 = MIN (i__4, i__5);
			for (i__ = MAX (i__3, k2); i__ <= i__2; ++i__) {
				a_ref (i__, j) = a_ref (i__, j) * mul;
				/* L140: */
			}
			/* L150: */
		}

	}

	if (!done) {
		goto L10;
	}

	return 0;
}								/* NUMlapack_dlascl */

int NUMlapack_dlaset (const char *uplo, integer *m, integer *n, double *alpha, double *beta, double *a, integer *lda) {
	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2, i__3;

	/* Local variables */
	static integer i__, j;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;

	/* Function Body */
	if (lsame_ (uplo, "U")) {

		/* Set the strictly upper triangular or trapezoidal part of the array
		   to ALPHA. */

		i__1 = *n;
		for (j = 2; j <= i__1; ++j) {
			/* Computing MIN */
			i__3 = j - 1;
			i__2 = MIN (i__3, *m);
			for (i__ = 1; i__ <= i__2; ++i__) {
				a_ref (i__, j) = *alpha;
				/* L10: */
			}
			/* L20: */
		}

	} else if (lsame_ (uplo, "L")) {

		/* Set the strictly lower triangular or trapezoidal part of the array
		   to ALPHA. */

		i__1 = MIN (*m, *n);
		for (j = 1; j <= i__1; ++j) {
			i__2 = *m;
			for (i__ = j + 1; i__ <= i__2; ++i__) {
				a_ref (i__, j) = *alpha;
				/* L30: */
			}
			/* L40: */
		}

	} else {

		/* Set the leading m-by-n submatrix to ALPHA. */

		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
			i__2 = *m;
			for (i__ = 1; i__ <= i__2; ++i__) {
				a_ref (i__, j) = *alpha;
				/* L50: */
			}
			/* L60: */
		}
	}

	/* Set the first MIN(M,N) diagonal elements to BETA. */

	i__1 = MIN (*m, *n);
	for (i__ = 1; i__ <= i__1; ++i__) {
		a_ref (i__, i__) = *beta;
		/* L70: */
	}

	return 0;
}								/* NUMlapack_dlaset */

int NUMlapack_dlasq1 (integer *n, double *d__, double *e, double *work, integer *info) {
	/* System generated locals */
	integer i__1, i__2;
	double d__1, d__2, d__3;

	/* Local variables */
	static integer i__;
	static double scale;
	static integer iinfo;
	static double sigmn;
	static double sigmx;
	static double safmin;
	static double eps;

	/* Parameter adjustments */
	--work;
	--e;
	--d__;

	/* Function Body */
	*info = 0;
	if (*n < 0) {
		*info = -2;
		i__1 = - (*info);
		xerbla_ ("DLASQ1", &i__1);
		return 0;
	} else if (*n == 0) {
		return 0;
	} else if (*n == 1) {
		d__[1] = fabs (d__[1]);
		return 0;
	} else if (*n == 2) {
		NUMlapack_dlas2 (&d__[1], &e[1], &d__[2], &sigmn, &sigmx);
		d__[1] = sigmx;
		d__[2] = sigmn;
		return 0;
	}

	/* Estimate the largest singular value. */

	sigmx = 0.;
	i__1 = *n - 1;
	for (i__ = 1; i__ <= i__1; ++i__) {
		d__[i__] = (d__1 = d__[i__], fabs (d__1));
		/* Computing MAX */
		d__2 = sigmx, d__3 = (d__1 = e[i__], fabs (d__1));
		sigmx = MAX (d__2, d__3);
		/* L10: */
	}
	d__[*n] = (d__1 = d__[*n], fabs (d__1));

	/* Early return if SIGMX is zero (matrix is already diagonal). */

	if (sigmx == 0.) {
		NUMlapack_dlasrt ("D", n, &d__[1], &iinfo);
		return 0;
	}

	i__1 = *n;
	for (i__ = 1; i__ <= i__1; ++i__) {
		/* Computing MAX */
		d__1 = sigmx, d__2 = d__[i__];
		sigmx = MAX (d__1, d__2);
		/* L20: */
	}

	/* Copy D and E into WORK (in the Z format) and scale (squaring the input
	   data makes scaling by a power of the radix pointless). */

	eps = NUMblas_dlamch ("Precision");
	safmin = NUMblas_dlamch ("Safe minimum");
	scale = sqrt (eps / safmin);
	NUMblas_dcopy (n, &d__[1], &c__1, &work[1], &c__2);
	i__1 = *n - 1;
	NUMblas_dcopy (&i__1, &e[1], &c__1, &work[2], &c__2);
	i__1 = (*n << 1) - 1;
	i__2 = (*n << 1) - 1;
	NUMlapack_dlascl ("G", &c__0, &c__0, &sigmx, &scale, &i__1, &c__1, &work[1], &i__2, &iinfo);

	/* Compute the q's and e's. */

	i__1 = (*n << 1) - 1;
	for (i__ = 1; i__ <= i__1; ++i__) {
		/* Computing 2nd power */
		d__1 = work[i__];
		work[i__] = d__1 * d__1;
		/* L30: */
	}
	work[*n * 2] = 0.;

	NUMlapack_dlasq2 (n, &work[1], info);

	if (*info == 0) {
		i__1 = *n;
		for (i__ = 1; i__ <= i__1; ++i__) {
			d__[i__] = sqrt (work[i__]);
			/* L40: */
		}
		NUMlapack_dlascl ("G", &c__0, &c__0, &scale, &sigmx, n, &c__1, &d__[1], n, &iinfo);
	}

	return 0;

}								/* NUMlapack_dlasq1 */

int NUMlapack_dlasq2 (integer *n, double *z__, integer *info) {
	/* System generated locals */
	integer i__1, i__2, i__3;
	double d__1, d__2;

	/* Local variables */
	static integer ieee;
	static integer nbig;
	static double dmin__, emin, emax;
	static integer ndiv, iter;
	static double qmin, temp, qmax, zmax;
	static integer splt;
	static double d__, e;
	static integer k;
	static double s, t;
	static integer nfail;
	static double desig, trace, sigma;
	static integer iinfo, i0, i4, n0;
	static integer pp, iwhila, iwhilb;
	static double oldemn, safmin;
	static double eps, tol;
	static integer ipn4;
	static double tol2;

	/* Parameter adjustments */
	--z__;

	/* Function Body */
	*info = 0;
	eps = NUMblas_dlamch ("Precision");
	safmin = NUMblas_dlamch ("Safe minimum");
	tol = eps * 100.;
	/* Computing 2nd power */
	d__1 = tol;
	tol2 = d__1 * d__1;

	if (*n < 0) {
		*info = -1;
		xerbla_ ("DLASQ2", &c__1);
		return 0;
	} else if (*n == 0) {
		return 0;
	} else if (*n == 1) {

		/* 1-by-1 case. */

		if (z__[1] < 0.) {
			*info = -201;
			xerbla_ ("DLASQ2", &c__2);
		}
		return 0;
	} else if (*n == 2) {

		/* 2-by-2 case. */

		if (z__[2] < 0. || z__[3] < 0.) {
			*info = -2;
			xerbla_ ("DLASQ2", &c__2);
			return 0;
		} else if (z__[3] > z__[1]) {
			d__ = z__[3];
			z__[3] = z__[1];
			z__[1] = d__;
		}
		z__[5] = z__[1] + z__[2] + z__[3];
		if (z__[2] > z__[3] * tol2) {
			t = (z__[1] - z__[3] + z__[2]) * .5;
			s = z__[3] * (z__[2] / t);
			if (s <= t) {
				s = z__[3] * (z__[2] / (t * (sqrt (s / t + 1.) + 1.)));
			} else {
				s = z__[3] * (z__[2] / (t + sqrt (t) * sqrt (t + s)));
			}
			t = z__[1] + (s + z__[2]);
			z__[3] *= z__[1] / t;
			z__[1] = t;
		}
		z__[2] = z__[3];
		z__[6] = z__[2] + z__[1];
		return 0;
	}

	/* Check for negative data and compute sums of q's and e's. */

	z__[*n * 2] = 0.;
	emin = z__[2];
	qmax = 0.;
	zmax = 0.;
	d__ = 0.;
	e = 0.;

	i__1 = *n - 1 << 1;
	for (k = 1; k <= i__1; k += 2) {
		if (z__[k] < 0.) {
			*info = - (k + 200);
			xerbla_ ("DLASQ2", &c__2);
			return 0;
		} else if (z__[k + 1] < 0.) {
			*info = - (k + 201);
			xerbla_ ("DLASQ2", &c__2);
			return 0;
		}
		d__ += z__[k];
		e += z__[k + 1];
		/* Computing MAX */
		d__1 = qmax, d__2 = z__[k];
		qmax = MAX (d__1, d__2);
		/* Computing MIN */
		d__1 = emin, d__2 = z__[k + 1];
		emin = MIN (d__1, d__2);
		/* Computing MAX */
		d__1 = MAX (qmax, zmax), d__2 = z__[k + 1];
		zmax = MAX (d__1, d__2);
		/* L10: */
	}
	if (z__[ (*n << 1) - 1] < 0.) {
		*info = - ( (*n << 1) + 199);
		xerbla_ ("DLASQ2", &c__2);
		return 0;
	}
	d__ += z__[ (*n << 1) - 1];
	/* Computing MAX */
	d__1 = qmax, d__2 = z__[ (*n << 1) - 1];
	qmax = MAX (d__1, d__2);
	zmax = MAX (qmax, zmax);

	/* Check for diagonality. */

	if (e == 0.) {
		i__1 = *n;
		for (k = 2; k <= i__1; ++k) {
			z__[k] = z__[ (k << 1) - 1];
			/* L20: */
		}
		NUMlapack_dlasrt ("D", n, &z__[1], &iinfo);
		z__[ (*n << 1) - 1] = d__;
		return 0;
	}

	trace = d__ + e;

	/* Check for zero data. */

	if (trace == 0.) {
		z__[ (*n << 1) - 1] = 0.;
		return 0;
	}

	/* Check whether the machine is IEEE conformable. */

	ieee = NUMlapack_ilaenv (&c__10, "DLASQ2", "N", &c__1, &c__2, &c__3, &c__4, 6, 1) == 1 &&
	       NUMlapack_ilaenv (&c__11, "DLASQ2", "N", &c__1, &c__2, &c__3, &c__4, 6, 1) == 1;

	/* Rearrange data for locality: Z=(q1,qq1,e1,ee1,q2,qq2,e2,ee2,...). */

	for (k = *n << 1; k >= 2; k += -2) {
		z__[k * 2] = 0.;
		z__[ (k << 1) - 1] = z__[k];
		z__[ (k << 1) - 2] = 0.;
		z__[ (k << 1) - 3] = z__[k - 1];
		/* L30: */
	}

	i0 = 1;
	n0 = *n;

	/* Reverse the qd-array, if warranted. */

	if (z__[ (i0 << 2) - 3] * 1.5 < z__[ (n0 << 2) - 3]) {
		ipn4 = i0 + n0 << 2;
		i__1 = i0 + n0 - 1 << 1;
		for (i4 = i0 << 2; i4 <= i__1; i4 += 4) {
			temp = z__[i4 - 3];
			z__[i4 - 3] = z__[ipn4 - i4 - 3];
			z__[ipn4 - i4 - 3] = temp;
			temp = z__[i4 - 1];
			z__[i4 - 1] = z__[ipn4 - i4 - 5];
			z__[ipn4 - i4 - 5] = temp;
			/* L40: */
		}
	}

	/* Initial split checking via dqd and Li's test. */

	pp = 0;

	for (k = 1; k <= 2; ++k) {

		d__ = z__[ (n0 << 2) + pp - 3];
		i__1 = (i0 << 2) + pp;
		for (i4 = (n0 - 1 << 2) + pp; i4 >= i__1; i4 += -4) {
			if (z__[i4 - 1] <= tol2 * d__) {
				z__[i4 - 1] = 0.;
				d__ = z__[i4 - 3];
			} else {
				d__ = z__[i4 - 3] * (d__ / (d__ + z__[i4 - 1]));
			}
			/* L50: */
		}

		/* dqd maps Z to ZZ plus Li's test. */

		emin = z__[ (i0 << 2) + pp + 1];
		d__ = z__[ (i0 << 2) + pp - 3];
		i__1 = (n0 - 1 << 2) + pp;
		for (i4 = (i0 << 2) + pp; i4 <= i__1; i4 += 4) {
			z__[i4 - (pp << 1) - 2] = d__ + z__[i4 - 1];
			if (z__[i4 - 1] <= tol2 * d__) {
				z__[i4 - 1] = 0.;
				z__[i4 - (pp << 1) - 2] = d__;
				z__[i4 - (pp << 1)] = 0.;
				d__ = z__[i4 + 1];
			} else if (safmin * z__[i4 + 1] < z__[i4 - (pp << 1) - 2] &&
			           safmin * z__[i4 - (pp << 1) - 2] < z__[i4 + 1]) {
				temp = z__[i4 + 1] / z__[i4 - (pp << 1) - 2];
				z__[i4 - (pp << 1)] = z__[i4 - 1] * temp;
				d__ *= temp;
			} else {
				z__[i4 - (pp << 1)] = z__[i4 + 1] * (z__[i4 - 1] / z__[i4 - (pp << 1) - 2]);
				d__ = z__[i4 + 1] * (d__ / z__[i4 - (pp << 1) - 2]);
			}
			/* Computing MIN */
			d__1 = emin, d__2 = z__[i4 - (pp << 1)];
			emin = MIN (d__1, d__2);
			/* L60: */
		}
		z__[ (n0 << 2) - pp - 2] = d__;

		/* Now find qmax. */

		qmax = z__[ (i0 << 2) - pp - 2];
		i__1 = (n0 << 2) - pp - 2;
		for (i4 = (i0 << 2) - pp + 2; i4 <= i__1; i4 += 4) {
			/* Computing MAX */
			d__1 = qmax, d__2 = z__[i4];
			qmax = MAX (d__1, d__2);
			/* L70: */
		}

		/* Prepare for the next iteration on K. */

		pp = 1 - pp;
		/* L80: */
	}

	iter = 2;
	nfail = 0;
	ndiv = n0 - i0 << 1;

	i__1 = *n + 1;
	for (iwhila = 1; iwhila <= i__1; ++iwhila) {
		if (n0 < 1) {
			goto L150;
		}

		/* While array unfinished do

		   E(N0) holds the value of SIGMA when submatrix in I0:N0 splits from
		   the rest of the array, but is negated. */

		desig = 0.;
		if (n0 == *n) {
			sigma = 0.;
		} else {
			sigma = -z__[ (n0 << 2) - 1];
		}
		if (sigma < 0.) {
			*info = 1;
			return 0;
		}

		/* Find last unreduced submatrix's top index I0, find QMAX and EMIN.
		   Find Gershgorin-type bound if Q's much greater than E's. */

		emax = 0.;
		if (n0 > i0) {
			emin = (d__1 = z__[ (n0 << 2) - 5], fabs (d__1));
		} else {
			emin = 0.;
		}
		qmin = z__[ (n0 << 2) - 3];
		qmax = qmin;
		for (i4 = n0 << 2; i4 >= 8; i4 += -4) {
			if (z__[i4 - 5] <= 0.) {
				goto L100;
			}
			if (qmin >= emax * 4.) {
				/* Computing MIN */
				d__1 = qmin, d__2 = z__[i4 - 3];
				qmin = MIN (d__1, d__2);
				/* Computing MAX */
				d__1 = emax, d__2 = z__[i4 - 5];
				emax = MAX (d__1, d__2);
			}
			/* Computing MAX */
			d__1 = qmax, d__2 = z__[i4 - 7] + z__[i4 - 5];
			qmax = MAX (d__1, d__2);
			/* Computing MIN */
			d__1 = emin, d__2 = z__[i4 - 5];
			emin = MIN (d__1, d__2);
			/* L90: */
		}
		i4 = 4;

L100:
		i0 = i4 / 4;

		/* Store EMIN for passing to DLASQ3. */

		z__[ (n0 << 2) - 1] = emin;

		/* Put -(initial shift) into DMIN.

		   Computing MAX */
		d__1 = 0., d__2 = qmin - sqrt (qmin) * 2. * sqrt (emax);
		dmin__ = -MAX (d__1, d__2);

		/* Now I0:N0 is unreduced. PP = 0 for ping, PP = 1 for pong. */

		pp = 0;

		nbig = (n0 - i0 + 1) * 30;
		i__2 = nbig;
		for (iwhilb = 1; iwhilb <= i__2; ++iwhilb) {
			if (i0 > n0) {
				goto L130;
			}

			/* While submatrix unfinished take a good dqds step. */

			NUMlapack_dlasq3 (&i0, &n0, &z__[1], &pp, &dmin__, &sigma, &desig, &qmax, &nfail, &iter, &ndiv,
			                  &ieee);

			pp = 1 - pp;

			/* When EMIN is very small check for splits. */

			if (pp == 0 && n0 - i0 >= 3) {
				if (z__[n0 * 4] <= tol2 * qmax || z__[ (n0 << 2) - 1] <= tol2 * sigma) {
					splt = i0 - 1;
					qmax = z__[ (i0 << 2) - 3];
					emin = z__[ (i0 << 2) - 1];
					oldemn = z__[i0 * 4];
					i__3 = n0 - 3 << 2;
					for (i4 = i0 << 2; i4 <= i__3; i4 += 4) {
						if (z__[i4] <= tol2 * z__[i4 - 3] || z__[i4 - 1] <= tol2 * sigma) {
							z__[i4 - 1] = -sigma;
							splt = i4 / 4;
							qmax = 0.;
							emin = z__[i4 + 3];
							oldemn = z__[i4 + 4];
						} else {
							/* Computing MAX */
							d__1 = qmax, d__2 = z__[i4 + 1];
							qmax = MAX (d__1, d__2);
							/* Computing MIN */
							d__1 = emin, d__2 = z__[i4 - 1];
							emin = MIN (d__1, d__2);
							/* Computing MIN */
							d__1 = oldemn, d__2 = z__[i4];
							oldemn = MIN (d__1, d__2);
						}
						/* L110: */
					}
					z__[ (n0 << 2) - 1] = emin;
					z__[n0 * 4] = oldemn;
					i0 = splt + 1;
				}
			}

			/* L120: */
		}

		*info = 2;
		return 0;

		/* end IWHILB */

L130:

		/* L140: */
		;
	}

	*info = 3;
	return 0;

	/* end IWHILA */

L150:

	/* Move q's to the front. */

	i__1 = *n;
	for (k = 2; k <= i__1; ++k) {
		z__[k] = z__[ (k << 2) - 3];
		/* L160: */
	}

	/* Sort and compute sum of eigenvalues. */

	NUMlapack_dlasrt ("D", n, &z__[1], &iinfo);

	e = 0.;
	for (k = *n; k >= 1; --k) {
		e += z__[k];
		/* L170: */
	}

	/* Store trace, sum(eigenvalues) and information on performance. */

	z__[ (*n << 1) + 1] = trace;
	z__[ (*n << 1) + 2] = e;
	z__[ (*n << 1) + 3] = (double) iter;
	/* Computing 2nd power */
	i__1 = *n;
	z__[ (*n << 1) + 4] = (double) ndiv / (double) (i__1 * i__1);
	z__[ (*n << 1) + 5] = nfail * 100. / (double) iter;
	return 0;
}								/* NUMlapack_dlasq2 */

int NUMlapack_dlasq3 (integer *i0, integer *n0, double *z__, integer *pp, double *dmin__, double *sigma, double *desig,
                      double *qmax, integer *nfail, integer *iter, integer *ndiv, integer *ieee) {
	/* Initialized data */
	static integer ttype = 0;
	static double dmin1 = 0.;
	static double dmin2 = 0.;
	static double dn = 0.;
	static double dn1 = 0.;
	static double dn2 = 0.;
	static double tau = 0.;

	/* System generated locals */
	integer i__1;
	double d__1, d__2;

	/* Local variables */
	static double temp, s, t;
	static integer j4;
	static integer nn;
	static double safmin, eps, tol;
	static integer n0in, ipn4;
	static double tol2;

	--z__;

	/* Function Body */

	n0in = *n0;
	eps = NUMblas_dlamch ("Precision");
	safmin = NUMblas_dlamch ("Safe minimum");
	tol = eps * 100.;
	/* Computing 2nd power */
	d__1 = tol;
	tol2 = d__1 * d__1;

	/* Check for deflation. */

L10:

	if (*n0 < *i0) {
		return 0;
	}
	if (*n0 == *i0) {
		goto L20;
	}
	nn = (*n0 << 2) + *pp;
	if (*n0 == *i0 + 1) {
		goto L40;
	}

	/* Check whether E(N0-1) is negligible, 1 eigenvalue. */

	if (z__[nn - 5] > tol2 * (*sigma + z__[nn - 3]) && z__[nn - (*pp << 1) - 4] > tol2 * z__[nn - 7]) {
		goto L30;
	}

L20:

	z__[ (*n0 << 2) - 3] = z__[ (*n0 << 2) + *pp - 3] + *sigma;
	-- (*n0);
	goto L10;

	/* Check whether E(N0-2) is negligible, 2 eigenvalues. */

L30:

	if (z__[nn - 9] > tol2 * *sigma && z__[nn - (*pp << 1) - 8] > tol2 * z__[nn - 11]) {
		goto L50;
	}

L40:

	if (z__[nn - 3] > z__[nn - 7]) {
		s = z__[nn - 3];
		z__[nn - 3] = z__[nn - 7];
		z__[nn - 7] = s;
	}
	if (z__[nn - 5] > z__[nn - 3] * tol2) {
		t = (z__[nn - 7] - z__[nn - 3] + z__[nn - 5]) * .5;
		s = z__[nn - 3] * (z__[nn - 5] / t);
		if (s <= t) {
			s = z__[nn - 3] * (z__[nn - 5] / (t * (sqrt (s / t + 1.) + 1.)));
		} else {
			s = z__[nn - 3] * (z__[nn - 5] / (t + sqrt (t) * sqrt (t + s)));
		}
		t = z__[nn - 7] + (s + z__[nn - 5]);
		z__[nn - 3] *= z__[nn - 7] / t;
		z__[nn - 7] = t;
	}
	z__[ (*n0 << 2) - 7] = z__[nn - 7] + *sigma;
	z__[ (*n0 << 2) - 3] = z__[nn - 3] + *sigma;
	*n0 += -2;
	goto L10;

L50:

	/* Reverse the qd-array, if warranted. */

	if (*dmin__ <= 0. || *n0 < n0in) {
		if (z__[ (*i0 << 2) + *pp - 3] * 1.5 < z__[ (*n0 << 2) + *pp - 3]) {
			ipn4 = *i0 + *n0 << 2;
			i__1 = *i0 + *n0 - 1 << 1;
			for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) {
				temp = z__[j4 - 3];
				z__[j4 - 3] = z__[ipn4 - j4 - 3];
				z__[ipn4 - j4 - 3] = temp;
				temp = z__[j4 - 2];
				z__[j4 - 2] = z__[ipn4 - j4 - 2];
				z__[ipn4 - j4 - 2] = temp;
				temp = z__[j4 - 1];
				z__[j4 - 1] = z__[ipn4 - j4 - 5];
				z__[ipn4 - j4 - 5] = temp;
				temp = z__[j4];
				z__[j4] = z__[ipn4 - j4 - 4];
				z__[ipn4 - j4 - 4] = temp;
				/* L60: */
			}
			if (*n0 - *i0 <= 4) {
				z__[ (*n0 << 2) + *pp - 1] = z__[ (*i0 << 2) + *pp - 1];
				z__[ (*n0 << 2) - *pp] = z__[ (*i0 << 2) - *pp];
			}
			/* Computing MIN */
			d__1 = dmin2, d__2 = z__[ (*n0 << 2) + *pp - 1];
			dmin2 = MIN (d__1, d__2);
			/* Computing MIN */
			d__1 = z__[ (*n0 << 2) + *pp - 1], d__2 = z__[ (*i0 << 2) + *pp - 1], d__1 =
			            MIN (d__1, d__2), d__2 = z__[ (*i0 << 2) + *pp + 3];
			z__[ (*n0 << 2) + *pp - 1] = MIN (d__1, d__2);
			/* Computing MIN */
			d__1 = z__[ (*n0 << 2) - *pp], d__2 = z__[ (*i0 << 2) - *pp], d__1 = MIN (d__1, d__2), d__2 =
			        z__[ (*i0 << 2) - *pp + 4];
			z__[ (*n0 << 2) - *pp] = MIN (d__1, d__2);
			/* Computing MAX */
			d__1 = *qmax, d__2 = z__[ (*i0 << 2) + *pp - 3], d__1 = MAX (d__1, d__2), d__2 =
			                         z__[ (*i0 << 2) + *pp + 1];
			*qmax = MAX (d__1, d__2);
			*dmin__ = 0.;
		}
	}

	/* L70:

	   Computing MIN */
	d__1 = z__[ (*n0 << 2) + *pp - 1], d__2 = z__[ (*n0 << 2) + *pp - 9], d__1 = MIN (d__1, d__2), d__2 =
	            dmin2 + z__[ (*n0 << 2) - *pp];
	if (*dmin__ < 0. || safmin * *qmax < MIN (d__1, d__2)) {

		/* Choose a shift. */

		NUMlapack_dlasq4 (i0, n0, &z__[1], pp, &n0in, dmin__, &dmin1, &dmin2, &dn, &dn1, &dn2, &tau, &ttype);

		/* Call dqds until DMIN > 0. */

L80:

		NUMlapack_dlasq5 (i0, n0, &z__[1], pp, &tau, dmin__, &dmin1, &dmin2, &dn, &dn1, &dn2, ieee);

		*ndiv += *n0 - *i0 + 2;
		++ (*iter);

		/* Check status. */

		if (*dmin__ >= 0. && dmin1 > 0.) {

			/* Success. */

			goto L100;

		} else if (*dmin__ < 0. && dmin1 > 0. && z__[ (*n0 - 1 << 2) - *pp] < tol * (*sigma + dn1) &&
		           fabs (dn) < tol * *sigma) {

			/* Convergence hidden by negative DN. */

			z__[ (*n0 - 1 << 2) - *pp + 2] = 0.;
			*dmin__ = 0.;
			goto L100;
		} else if (*dmin__ < 0.) {

			/* TAU too big. Select new TAU and try again. */

			++ (*nfail);
			if (ttype < -22) {

				/* Failed twice. Play it safe. */

				tau = 0.;
			} else if (dmin1 > 0.) {

				/* Late failure. Gives excellent shift. */

				tau = (tau + *dmin__) * (1. - eps * 2.);
				ttype += -11;
			} else {

				/* Early failure. Divide by 4. */

				tau *= .25;
				ttype += -12;
			}
			goto L80;
		} else if (*dmin__ != *dmin__) {

			/* NaN. */

			tau = 0.;
			goto L80;
		} else {

			/* Possible underflow. Play it safe. */

			goto L90;
		}
	}

	/* Risk of underflow. */

L90:
	NUMlapack_dlasq6 (i0, n0, &z__[1], pp, dmin__, &dmin1, &dmin2, &dn, &dn1, &dn2);
	*ndiv += *n0 - *i0 + 2;
	++ (*iter);
	tau = 0.;

L100:
	if (tau < *sigma) {
		*desig += tau;
		t = *sigma + *desig;
		*desig -= t - *sigma;
	} else {
		t = *sigma + tau;
		*desig = *sigma - (t - tau) + *desig;
	}
	*sigma = t;

	return 0;
}								/* NUMlapack_dlasq3 */

int NUMlapack_dlasq4 (integer *i0, integer *n0, double *z__, integer *pp, integer *n0in, double *dmin__, double *dmin1,
                      double *dmin2, double *dn, double *dn1, double *dn2, double *tau, integer *ttype) {
	/* Initialized data */

	static double g = 0.;

	/* System generated locals */
	integer i__1;
	double d__1, d__2;

	/* Local variables */
	static double s, a2, b1, b2;
	static integer i4, nn, np;
	static double gam, gap1, gap2;

	/* Parameter adjustments */
	--z__;

	/* Function Body

	   A negative DMIN forces the shift to take that absolute value TTYPE
	   records the type of shift. */

	if (*dmin__ <= 0.) {
		*tau = - (*dmin__);
		*ttype = -1;
		return 0;
	}

	nn = (*n0 << 2) + *pp;
	if (*n0in == *n0) {

		/* No eigenvalues deflated. */

		if (*dmin__ == *dn || *dmin__ == *dn1) {

			b1 = sqrt (z__[nn - 3]) * sqrt (z__[nn - 5]);
			b2 = sqrt (z__[nn - 7]) * sqrt (z__[nn - 9]);
			a2 = z__[nn - 7] + z__[nn - 5];

			/* Cases 2 and 3. */

			if (*dmin__ == *dn && *dmin1 == *dn1) {
				gap2 = *dmin2 - a2 - *dmin2 * .25;
				if (gap2 > 0. && gap2 > b2) {
					gap1 = a2 - *dn - b2 / gap2 * b2;
				} else {
					gap1 = a2 - *dn - (b1 + b2);
				}
				if (gap1 > 0. && gap1 > b1) {
					/* Computing MAX */
					d__1 = *dn - b1 / gap1 * b1, d__2 = *dmin__ * .5;
					s = MAX (d__1, d__2);
					*ttype = -2;
				} else {
					s = 0.;
					if (*dn > b1) {
						s = *dn - b1;
					}
					if (a2 > b1 + b2) {
						/* Computing MIN */
						d__1 = s, d__2 = a2 - (b1 + b2);
						s = MIN (d__1, d__2);
					}
					/* Computing MAX */
					d__1 = s, d__2 = *dmin__ * .333;
					s = MAX (d__1, d__2);
					*ttype = -3;
				}
			} else {

				/* Case 4. */

				*ttype = -4;
				s = *dmin__ * .25;
				if (*dmin__ == *dn) {
					gam = *dn;
					a2 = 0.;
					if (z__[nn - 5] > z__[nn - 7]) {
						return 0;
					}
					b2 = z__[nn - 5] / z__[nn - 7];
					np = nn - 9;
				} else {
					np = nn - (*pp << 1);
					b2 = z__[np - 2];
					gam = *dn1;
					if (z__[np - 4] > z__[np - 2]) {
						return 0;
					}
					a2 = z__[np - 4] / z__[np - 2];
					if (z__[nn - 9] > z__[nn - 11]) {
						return 0;
					}
					b2 = z__[nn - 9] / z__[nn - 11];
					np = nn - 13;
				}

				/* Approximate contribution to norm squared from I < NN-1. */

				a2 += b2;
				i__1 = (*i0 << 2) - 1 + *pp;
				for (i4 = np; i4 >= i__1; i4 += -4) {
					if (b2 == 0.) {
						goto L20;
					}
					b1 = b2;
					if (z__[i4] > z__[i4 - 2]) {
						return 0;
					}
					b2 *= z__[i4] / z__[i4 - 2];
					a2 += b2;
					if (MAX (b2, b1) * 100. < a2 || .563 < a2) {
						goto L20;
					}
					/* L10: */
				}
L20:
				a2 *= 1.05;

				/* Rayleigh quotient residual bound. */

				if (a2 < .563) {
					s = gam * (1. - sqrt (a2)) / (a2 + 1.);
				}
			}
		} else if (*dmin__ == *dn2) {

			/* Case 5. */

			*ttype = -5;
			s = *dmin__ * .25;

			/* Compute contribution to norm squared from I > NN-2. */

			np = nn - (*pp << 1);
			b1 = z__[np - 2];
			b2 = z__[np - 6];
			gam = *dn2;
			if (z__[np - 8] > b2 || z__[np - 4] > b1) {
				return 0;
			}
			a2 = z__[np - 8] / b2 * (z__[np - 4] / b1 + 1.);

			/* Approximate contribution to norm squared from I < NN-2. */

			if (*n0 - *i0 > 2) {
				b2 = z__[nn - 13] / z__[nn - 15];
				a2 += b2;
				i__1 = (*i0 << 2) - 1 + *pp;
				for (i4 = nn - 17; i4 >= i__1; i4 += -4) {
					if (b2 == 0.) {
						goto L40;
					}
					b1 = b2;
					if (z__[i4] > z__[i4 - 2]) {
						return 0;
					}
					b2 *= z__[i4] / z__[i4 - 2];
					a2 += b2;
					if (MAX (b2, b1) * 100. < a2 || .563 < a2) {
						goto L40;
					}
					/* L30: */
				}
L40:
				a2 *= 1.05;
			}

			if (a2 < .563) {
				s = gam * (1. - sqrt (a2)) / (a2 + 1.);
			}
		} else {

			/* Case 6, no information to guide us. */

			if (*ttype == -6) {
				g += (1. - g) * .333;
			} else if (*ttype == -18) {
				g = .083250000000000005;
			} else {
				g = .25;
			}
			s = g * *dmin__;
			*ttype = -6;
		}

	} else if (*n0in == *n0 + 1) {

		/* One eigenvalue just deflated. Use DMIN1, DN1 for DMIN and DN. */

		if (*dmin1 == *dn1 && *dmin2 == *dn2) {

			/* Cases 7 and 8. */

			*ttype = -7;
			s = *dmin1 * .333;
			if (z__[nn - 5] > z__[nn - 7]) {
				return 0;
			}
			b1 = z__[nn - 5] / z__[nn - 7];
			b2 = b1;
			if (b2 == 0.) {
				goto L60;
			}
			i__1 = (*i0 << 2) - 1 + *pp;
			for (i4 = (*n0 << 2) - 9 + *pp; i4 >= i__1; i4 += -4) {
				a2 = b1;
				if (z__[i4] > z__[i4 - 2]) {
					return 0;
				}
				b1 *= z__[i4] / z__[i4 - 2];
				b2 += b1;
				if (MAX (b1, a2) * 100. < b2) {
					goto L60;
				}
				/* L50: */
			}
L60:
			b2 = sqrt (b2 * 1.05);
			/* Computing 2nd power */
			d__1 = b2;
			a2 = *dmin1 / (d__1 * d__1 + 1.);
			gap2 = *dmin2 * .5 - a2;
			if (gap2 > 0. && gap2 > b2 * a2) {
				/* Computing MAX */
				d__1 = s, d__2 = a2 * (1. - a2 * 1.01 * (b2 / gap2) * b2);
				s = MAX (d__1, d__2);
			} else {
				/* Computing MAX */
				d__1 = s, d__2 = a2 * (1. - b2 * 1.01);
				s = MAX (d__1, d__2);
				*ttype = -8;
			}
		} else {

			/* Case 9. */

			s = *dmin1 * .25;
			if (*dmin1 == *dn1) {
				s = *dmin1 * .5;
			}
			*ttype = -9;
		}

	} else if (*n0in == *n0 + 2) {

		/* Two eigenvalues deflated. Use DMIN2, DN2 for DMIN and DN.

		   Cases 10 and 11. */

		if (*dmin2 == *dn2 && z__[nn - 5] * 2. < z__[nn - 7]) {
			*ttype = -10;
			s = *dmin2 * .333;
			if (z__[nn - 5] > z__[nn - 7]) {
				return 0;
			}
			b1 = z__[nn - 5] / z__[nn - 7];
			b2 = b1;
			if (b2 == 0.) {
				goto L80;
			}
			i__1 = (*i0 << 2) - 1 + *pp;
			for (i4 = (*n0 << 2) - 9 + *pp; i4 >= i__1; i4 += -4) {
				if (z__[i4] > z__[i4 - 2]) {
					return 0;
				}
				b1 *= z__[i4] / z__[i4 - 2];
				b2 += b1;
				if (b1 * 100. < b2) {
					goto L80;
				}
				/* L70: */
			}
L80:
			b2 = sqrt (b2 * 1.05);
			/* Computing 2nd power */
			d__1 = b2;
			a2 = *dmin2 / (d__1 * d__1 + 1.);
			gap2 = z__[nn - 7] + z__[nn - 9] - sqrt (z__[nn - 11]) * sqrt (z__[nn - 9]) - a2;
			if (gap2 > 0. && gap2 > b2 * a2) {
				/* Computing MAX */
				d__1 = s, d__2 = a2 * (1. - a2 * 1.01 * (b2 / gap2) * b2);
				s = MAX (d__1, d__2);
			} else {
				/* Computing MAX */
				d__1 = s, d__2 = a2 * (1. - b2 * 1.01);
				s = MAX (d__1, d__2);
			}
		} else {
			s = *dmin2 * .25;
			*ttype = -11;
		}
	} else if (*n0in > *n0 + 2) {

		/* Case 12, more than two eigenvalues deflated. No information. */

		s = 0.;
		*ttype = -12;
	}

	*tau = s;
	return 0;
}								/* NUMlapack_dlasq4 */

int NUMlapack_dlasq5 (integer *i0, integer *n0, double *z__, integer *pp, double *tau, double *dmin__, double *dmin1,
                      double *dmin2, double *dn, double *dnm1, double *dnm2, integer *ieee) {
	/* System generated locals */
	integer i__1;
	double d__1, d__2;

	/* Local variables */
	static double emin, temp, d__;
	static integer j4, j4p2;

	--z__;

	/* Function Body */
	if (*n0 - *i0 - 1 <= 0) {
		return 0;
	}

	j4 = (*i0 << 2) + *pp - 3;
	emin = z__[j4 + 4];
	d__ = z__[j4] - *tau;
	*dmin__ = d__;
	*dmin1 = -z__[j4];

	if (*ieee) {

		/* Code for IEEE arithmetic. */

		if (*pp == 0) {
			i__1 = *n0 - 3 << 2;
			for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) {
				z__[j4 - 2] = d__ + z__[j4 - 1];
				temp = z__[j4 + 1] / z__[j4 - 2];
				d__ = d__ * temp - *tau;
				*dmin__ = MIN (*dmin__, d__);
				z__[j4] = z__[j4 - 1] * temp;
				/* Computing MIN */
				d__1 = z__[j4];
				emin = MIN (d__1, emin);
				/* L10: */
			}
		} else {
			i__1 = *n0 - 3 << 2;
			for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) {
				z__[j4 - 3] = d__ + z__[j4];
				temp = z__[j4 + 2] / z__[j4 - 3];
				d__ = d__ * temp - *tau;
				*dmin__ = MIN (*dmin__, d__);
				z__[j4 - 1] = z__[j4] * temp;
				/* Computing MIN */
				d__1 = z__[j4 - 1];
				emin = MIN (d__1, emin);
				/* L20: */
			}
		}

		/* Unroll last two steps. */

		*dnm2 = d__;
		*dmin2 = *dmin__;
		j4 = (*n0 - 2 << 2) - *pp;
		j4p2 = j4 + (*pp << 1) - 1;
		z__[j4 - 2] = *dnm2 + z__[j4p2];
		z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]);
		*dnm1 = z__[j4p2 + 2] * (*dnm2 / z__[j4 - 2]) - *tau;
		*dmin__ = MIN (*dmin__, *dnm1);

		*dmin1 = *dmin__;
		j4 += 4;
		j4p2 = j4 + (*pp << 1) - 1;
		z__[j4 - 2] = *dnm1 + z__[j4p2];
		z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]);
		*dn = z__[j4p2 + 2] * (*dnm1 / z__[j4 - 2]) - *tau;
		*dmin__ = MIN (*dmin__, *dn);

	} else {

		/* Code for non IEEE arithmetic. */

		if (*pp == 0) {
			i__1 = *n0 - 3 << 2;
			for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) {
				z__[j4 - 2] = d__ + z__[j4 - 1];
				if (d__ < 0.) {
					return 0;
				} else {
					z__[j4] = z__[j4 + 1] * (z__[j4 - 1] / z__[j4 - 2]);
					d__ = z__[j4 + 1] * (d__ / z__[j4 - 2]) - *tau;
				}
				*dmin__ = MIN (*dmin__, d__);
				/* Computing MIN */
				d__1 = emin, d__2 = z__[j4];
				emin = MIN (d__1, d__2);
				/* L30: */
			}
		} else {
			i__1 = *n0 - 3 << 2;
			for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) {
				z__[j4 - 3] = d__ + z__[j4];
				if (d__ < 0.) {
					return 0;
				} else {
					z__[j4 - 1] = z__[j4 + 2] * (z__[j4] / z__[j4 - 3]);
					d__ = z__[j4 + 2] * (d__ / z__[j4 - 3]) - *tau;
				}
				*dmin__ = MIN (*dmin__, d__);
				/* Computing MIN */
				d__1 = emin, d__2 = z__[j4 - 1];
				emin = MIN (d__1, d__2);
				/* L40: */
			}
		}

		/* Unroll last two steps. */

		*dnm2 = d__;
		*dmin2 = *dmin__;
		j4 = (*n0 - 2 << 2) - *pp;
		j4p2 = j4 + (*pp << 1) - 1;
		z__[j4 - 2] = *dnm2 + z__[j4p2];
		if (*dnm2 < 0.) {
			return 0;
		} else {
			z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]);
			*dnm1 = z__[j4p2 + 2] * (*dnm2 / z__[j4 - 2]) - *tau;
		}
		*dmin__ = MIN (*dmin__, *dnm1);

		*dmin1 = *dmin__;
		j4 += 4;
		j4p2 = j4 + (*pp << 1) - 1;
		z__[j4 - 2] = *dnm1 + z__[j4p2];
		if (*dnm1 < 0.) {
			return 0;
		} else {
			z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]);
			*dn = z__[j4p2 + 2] * (*dnm1 / z__[j4 - 2]) - *tau;
		}
		*dmin__ = MIN (*dmin__, *dn);

	}

	z__[j4 + 2] = *dn;
	z__[ (*n0 << 2) - *pp] = emin;
	return 0;
}								/* NUMlapack_dlasq5 */

int NUMlapack_dlasq6 (integer *i0, integer *n0, double *z__, integer *pp, double *dmin__, double *dmin1, double *dmin2,
                      double *dn, double *dnm1, double *dnm2) {
	/* System generated locals */
	integer i__1;
	double d__1, d__2;

	/* Local variables */
	static double emin, temp, d__;
	static integer j4;
	static double safmin;
	static integer j4p2;

	/* Parameter adjustments */
	--z__;

	/* Function Body */
	if (*n0 - *i0 - 1 <= 0) {
		return 0;
	}

	safmin = NUMblas_dlamch ("Safe minimum");
	j4 = (*i0 << 2) + *pp - 3;
	emin = z__[j4 + 4];
	d__ = z__[j4];
	*dmin__ = d__;

	if (*pp == 0) {
		i__1 = *n0 - 3 << 2;
		for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) {
			z__[j4 - 2] = d__ + z__[j4 - 1];
			if (z__[j4 - 2] == 0.) {
				z__[j4] = 0.;
				d__ = z__[j4 + 1];
				*dmin__ = d__;
				emin = 0.;
			} else if (safmin * z__[j4 + 1] < z__[j4 - 2] && safmin * z__[j4 - 2] < z__[j4 + 1]) {
				temp = z__[j4 + 1] / z__[j4 - 2];
				z__[j4] = z__[j4 - 1] * temp;
				d__ *= temp;
			} else {
				z__[j4] = z__[j4 + 1] * (z__[j4 - 1] / z__[j4 - 2]);
				d__ = z__[j4 + 1] * (d__ / z__[j4 - 2]);
			}
			*dmin__ = MIN (*dmin__, d__);
			/* Computing MIN */
			d__1 = emin, d__2 = z__[j4];
			emin = MIN (d__1, d__2);
			/* L10: */
		}
	} else {
		i__1 = *n0 - 3 << 2;
		for (j4 = *i0 << 2; j4 <= i__1; j4 += 4) {
			z__[j4 - 3] = d__ + z__[j4];
			if (z__[j4 - 3] == 0.) {
				z__[j4 - 1] = 0.;
				d__ = z__[j4 + 2];
				*dmin__ = d__;
				emin = 0.;
			} else if (safmin * z__[j4 + 2] < z__[j4 - 3] && safmin * z__[j4 - 3] < z__[j4 + 2]) {
				temp = z__[j4 + 2] / z__[j4 - 3];
				z__[j4 - 1] = z__[j4] * temp;
				d__ *= temp;
			} else {
				z__[j4 - 1] = z__[j4 + 2] * (z__[j4] / z__[j4 - 3]);
				d__ = z__[j4 + 2] * (d__ / z__[j4 - 3]);
			}
			*dmin__ = MIN (*dmin__, d__);
			/* Computing MIN */
			d__1 = emin, d__2 = z__[j4 - 1];
			emin = MIN (d__1, d__2);
			/* L20: */
		}
	}

	/* Unroll last two steps. */

	*dnm2 = d__;
	*dmin2 = *dmin__;
	j4 = (*n0 - 2 << 2) - *pp;
	j4p2 = j4 + (*pp << 1) - 1;
	z__[j4 - 2] = *dnm2 + z__[j4p2];
	if (z__[j4 - 2] == 0.) {
		z__[j4] = 0.;
		*dnm1 = z__[j4p2 + 2];
		*dmin__ = *dnm1;
		emin = 0.;
	} else if (safmin * z__[j4p2 + 2] < z__[j4 - 2] && safmin * z__[j4 - 2] < z__[j4p2 + 2]) {
		temp = z__[j4p2 + 2] / z__[j4 - 2];
		z__[j4] = z__[j4p2] * temp;
		*dnm1 = *dnm2 * temp;
	} else {
		z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]);
		*dnm1 = z__[j4p2 + 2] * (*dnm2 / z__[j4 - 2]);
	}
	*dmin__ = MIN (*dmin__, *dnm1);

	*dmin1 = *dmin__;
	j4 += 4;
	j4p2 = j4 + (*pp << 1) - 1;
	z__[j4 - 2] = *dnm1 + z__[j4p2];
	if (z__[j4 - 2] == 0.) {
		z__[j4] = 0.;
		*dn = z__[j4p2 + 2];
		*dmin__ = *dn;
		emin = 0.;
	} else if (safmin * z__[j4p2 + 2] < z__[j4 - 2] && safmin * z__[j4 - 2] < z__[j4p2 + 2]) {
		temp = z__[j4p2 + 2] / z__[j4 - 2];
		z__[j4] = z__[j4p2] * temp;
		*dn = *dnm1 * temp;
	} else {
		z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]);
		*dn = z__[j4p2 + 2] * (*dnm1 / z__[j4 - 2]);
	}
	*dmin__ = MIN (*dmin__, *dn);

	z__[j4 + 2] = *dn;
	z__[ (*n0 << 2) - *pp] = emin;
	return 0;
}								/* NUMlapack_dlasq6 */

int NUMlapack_dlasr (const char *side, const char *pivot, const char *direct, integer *m, integer *n, double *c__, double *s, double *a,
                     integer *lda) {
	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2;

	/* Local variables */
	static integer info;
	static double temp;
	static integer i__, j;
	static double ctemp, stemp;

	--c__;
	--s;
	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;

	/* Function Body */
	info = 0;
	if (! (lsame_ (side, "L") || lsame_ (side, "R"))) {
		info = 1;
	} else if (! (lsame_ (pivot, "V") || lsame_ (pivot, "T") || lsame_ (pivot, "B"))) {
		info = 2;
	} else if (! (lsame_ (direct, "F") || lsame_ (direct, "B"))) {
		info = 3;
	} else if (*m < 0) {
		info = 4;
	} else if (*n < 0) {
		info = 5;
	} else if (*lda < MAX (1, *m)) {
		info = 9;
	}
	if (info != 0) {
		xerbla_ ("DLASR ", &info);
		return 0;
	}

	/* Quick return if possible */

	if (*m == 0 || *n == 0) {
		return 0;
	}
	if (lsame_ (side, "L")) {

		/* Form P * A */

		if (lsame_ (pivot, "V")) {
			if (lsame_ (direct, "F")) {
				i__1 = *m - 1;
				for (j = 1; j <= i__1; ++j) {
					ctemp = c__[j];
					stemp = s[j];
					if (ctemp != 1. || stemp != 0.) {
						i__2 = *n;
						for (i__ = 1; i__ <= i__2; ++i__) {
							temp = a_ref (j + 1, i__);
							a_ref (j + 1, i__) = ctemp * temp - stemp * a_ref (j, i__);
							a_ref (j, i__) = stemp * temp + ctemp * a_ref (j, i__);
							/* L10: */
						}
					}
					/* L20: */
				}
			} else if (lsame_ (direct, "B")) {
				for (j = *m - 1; j >= 1; --j) {
					ctemp = c__[j];
					stemp = s[j];
					if (ctemp != 1. || stemp != 0.) {
						i__1 = *n;
						for (i__ = 1; i__ <= i__1; ++i__) {
							temp = a_ref (j + 1, i__);
							a_ref (j + 1, i__) = ctemp * temp - stemp * a_ref (j, i__);
							a_ref (j, i__) = stemp * temp + ctemp * a_ref (j, i__);
							/* L30: */
						}
					}
					/* L40: */
				}
			}
		} else if (lsame_ (pivot, "T")) {
			if (lsame_ (direct, "F")) {
				i__1 = *m;
				for (j = 2; j <= i__1; ++j) {
					ctemp = c__[j - 1];
					stemp = s[j - 1];
					if (ctemp != 1. || stemp != 0.) {
						i__2 = *n;
						for (i__ = 1; i__ <= i__2; ++i__) {
							temp = a_ref (j, i__);
							a_ref (j, i__) = ctemp * temp - stemp * a_ref (1, i__);
							a_ref (1, i__) = stemp * temp + ctemp * a_ref (1, i__);
							/* L50: */
						}
					}
					/* L60: */
				}
			} else if (lsame_ (direct, "B")) {
				for (j = *m; j >= 2; --j) {
					ctemp = c__[j - 1];
					stemp = s[j - 1];
					if (ctemp != 1. || stemp != 0.) {
						i__1 = *n;
						for (i__ = 1; i__ <= i__1; ++i__) {
							temp = a_ref (j, i__);
							a_ref (j, i__) = ctemp * temp - stemp * a_ref (1, i__);
							a_ref (1, i__) = stemp * temp + ctemp * a_ref (1, i__);
							/* L70: */
						}
					}
					/* L80: */
				}
			}
		} else if (lsame_ (pivot, "B")) {
			if (lsame_ (direct, "F")) {
				i__1 = *m - 1;
				for (j = 1; j <= i__1; ++j) {
					ctemp = c__[j];
					stemp = s[j];
					if (ctemp != 1. || stemp != 0.) {
						i__2 = *n;
						for (i__ = 1; i__ <= i__2; ++i__) {
							temp = a_ref (j, i__);
							a_ref (j, i__) = stemp * a_ref (*m, i__) + ctemp * temp;
							a_ref (*m, i__) = ctemp * a_ref (*m, i__) - stemp * temp;
							/* L90: */
						}
					}
					/* L100: */
				}
			} else if (lsame_ (direct, "B")) {
				for (j = *m - 1; j >= 1; --j) {
					ctemp = c__[j];
					stemp = s[j];
					if (ctemp != 1. || stemp != 0.) {
						i__1 = *n;
						for (i__ = 1; i__ <= i__1; ++i__) {
							temp = a_ref (j, i__);
							a_ref (j, i__) = stemp * a_ref (*m, i__) + ctemp * temp;
							a_ref (*m, i__) = ctemp * a_ref (*m, i__) - stemp * temp;
							/* L110: */
						}
					}
					/* L120: */
				}
			}
		}
	} else if (lsame_ (side, "R")) {

		/* Form A * P' */

		if (lsame_ (pivot, "V")) {
			if (lsame_ (direct, "F")) {
				i__1 = *n - 1;
				for (j = 1; j <= i__1; ++j) {
					ctemp = c__[j];
					stemp = s[j];
					if (ctemp != 1. || stemp != 0.) {
						i__2 = *m;
						for (i__ = 1; i__ <= i__2; ++i__) {
							temp = a_ref (i__, j + 1);
							a_ref (i__, j + 1) = ctemp * temp - stemp * a_ref (i__, j);
							a_ref (i__, j) = stemp * temp + ctemp * a_ref (i__, j);
							/* L130: */
						}
					}
					/* L140: */
				}
			} else if (lsame_ (direct, "B")) {
				for (j = *n - 1; j >= 1; --j) {
					ctemp = c__[j];
					stemp = s[j];
					if (ctemp != 1. || stemp != 0.) {
						i__1 = *m;
						for (i__ = 1; i__ <= i__1; ++i__) {
							temp = a_ref (i__, j + 1);
							a_ref (i__, j + 1) = ctemp * temp - stemp * a_ref (i__, j);
							a_ref (i__, j) = stemp * temp + ctemp * a_ref (i__, j);
							/* L150: */
						}
					}
					/* L160: */
				}
			}
		} else if (lsame_ (pivot, "T")) {
			if (lsame_ (direct, "F")) {
				i__1 = *n;
				for (j = 2; j <= i__1; ++j) {
					ctemp = c__[j - 1];
					stemp = s[j - 1];
					if (ctemp != 1. || stemp != 0.) {
						i__2 = *m;
						for (i__ = 1; i__ <= i__2; ++i__) {
							temp = a_ref (i__, j);
							a_ref (i__, j) = ctemp * temp - stemp * a_ref (i__, 1);
							a_ref (i__, 1) = stemp * temp + ctemp * a_ref (i__, 1);
							/* L170: */
						}
					}
					/* L180: */
				}
			} else if (lsame_ (direct, "B")) {
				for (j = *n; j >= 2; --j) {
					ctemp = c__[j - 1];
					stemp = s[j - 1];
					if (ctemp != 1. || stemp != 0.) {
						i__1 = *m;
						for (i__ = 1; i__ <= i__1; ++i__) {
							temp = a_ref (i__, j);
							a_ref (i__, j) = ctemp * temp - stemp * a_ref (i__, 1);
							a_ref (i__, 1) = stemp * temp + ctemp * a_ref (i__, 1);
							/* L190: */
						}
					}
					/* L200: */
				}
			}
		} else if (lsame_ (pivot, "B")) {
			if (lsame_ (direct, "F")) {
				i__1 = *n - 1;
				for (j = 1; j <= i__1; ++j) {
					ctemp = c__[j];
					stemp = s[j];
					if (ctemp != 1. || stemp != 0.) {
						i__2 = *m;
						for (i__ = 1; i__ <= i__2; ++i__) {
							temp = a_ref (i__, j);
							a_ref (i__, j) = stemp * a_ref (i__, *n) + ctemp * temp;
							a_ref (i__, *n) = ctemp * a_ref (i__, *n) - stemp * temp;
							/* L210: */
						}
					}
					/* L220: */
				}
			} else if (lsame_ (direct, "B")) {
				for (j = *n - 1; j >= 1; --j) {
					ctemp = c__[j];
					stemp = s[j];
					if (ctemp != 1. || stemp != 0.) {
						i__1 = *m;
						for (i__ = 1; i__ <= i__1; ++i__) {
							temp = a_ref (i__, j);
							a_ref (i__, j) = stemp * a_ref (i__, *n) + ctemp * temp;
							a_ref (i__, *n) = ctemp * a_ref (i__, *n) - stemp * temp;
							/* L230: */
						}
					}
					/* L240: */
				}
			}
		}
	}

	return 0;
}								/* NUMlapack_dlasr */

#define stack_ref(a_1,a_2) stack[(a_2)*2 + a_1 - 3]

int NUMlapack_dlasrt (const char *id, integer *n, double *d__, integer *info) {
	/* System generated locals */
	integer i__1, i__2;

	/* Local variables */
	static integer endd, i__, j;
	static integer stack[64] /* was [2][32] */ ;
	static double dmnmx, d1, d2, d3;
	static integer start;
	static integer stkpnt, dir;
	static double tmp;

	--d__;

	/* Function Body */
	*info = 0;
	dir = -1;
	if (lsame_ (id, "D")) {
		dir = 0;
	} else if (lsame_ (id, "I")) {
		dir = 1;
	}
	if (dir == -1) {
		*info = -1;
	} else if (*n < 0) {
		*info = -2;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DLASRT", &i__1);
		return 0;
	}

	/* Quick return if possible */

	if (*n <= 1) {
		return 0;
	}

	stkpnt = 1;
	stack_ref (1, 1) = 1;
	stack_ref (2, 1) = *n;
L10:
	start = stack_ref (1, stkpnt);
	endd = stack_ref (2, stkpnt);
	--stkpnt;
	if (endd - start <= 20 && endd - start > 0) {

		/* Do Insertion sort on D( START:ENDD ) */

		if (dir == 0) {

			/* Sort into decreasing order */

			i__1 = endd;
			for (i__ = start + 1; i__ <= i__1; ++i__) {
				i__2 = start + 1;
				for (j = i__; j >= i__2; --j) {
					if (d__[j] > d__[j - 1]) {
						dmnmx = d__[j];
						d__[j] = d__[j - 1];
						d__[j - 1] = dmnmx;
					} else {
						goto L30;
					}
					/* L20: */
				}
L30:
				;
			}

		} else {

			/* Sort into increasing order */

			i__1 = endd;
			for (i__ = start + 1; i__ <= i__1; ++i__) {
				i__2 = start + 1;
				for (j = i__; j >= i__2; --j) {
					if (d__[j] < d__[j - 1]) {
						dmnmx = d__[j];
						d__[j] = d__[j - 1];
						d__[j - 1] = dmnmx;
					} else {
						goto L50;
					}
					/* L40: */
				}
L50:
				;
			}

		}

	} else if (endd - start > 20) {

		/* Partition D( START:ENDD ) and stack parts, largest one first

		   Choose partition entry as median of 3 */

		d1 = d__[start];
		d2 = d__[endd];
		i__ = (start + endd) / 2;
		d3 = d__[i__];
		if (d1 < d2) {
			if (d3 < d1) {
				dmnmx = d1;
			} else if (d3 < d2) {
				dmnmx = d3;
			} else {
				dmnmx = d2;
			}
		} else {
			if (d3 < d2) {
				dmnmx = d2;
			} else if (d3 < d1) {
				dmnmx = d3;
			} else {
				dmnmx = d1;
			}
		}

		if (dir == 0) {

			/* Sort into decreasing order */

			i__ = start - 1;
			j = endd + 1;
L60:
L70:
			--j;
			if (d__[j] < dmnmx) {
				goto L70;
			}
L80:
			++i__;
			if (d__[i__] > dmnmx) {
				goto L80;
			}
			if (i__ < j) {
				tmp = d__[i__];
				d__[i__] = d__[j];
				d__[j] = tmp;
				goto L60;
			}
			if (j - start > endd - j - 1) {
				++stkpnt;
				stack_ref (1, stkpnt) = start;
				stack_ref (2, stkpnt) = j;
				++stkpnt;
				stack_ref (1, stkpnt) = j + 1;
				stack_ref (2, stkpnt) = endd;
			} else {
				++stkpnt;
				stack_ref (1, stkpnt) = j + 1;
				stack_ref (2, stkpnt) = endd;
				++stkpnt;
				stack_ref (1, stkpnt) = start;
				stack_ref (2, stkpnt) = j;
			}
		} else {

			/* Sort into increasing order */

			i__ = start - 1;
			j = endd + 1;
L90:
L100:
			--j;
			if (d__[j] > dmnmx) {
				goto L100;
			}
L110:
			++i__;
			if (d__[i__] < dmnmx) {
				goto L110;
			}
			if (i__ < j) {
				tmp = d__[i__];
				d__[i__] = d__[j];
				d__[j] = tmp;
				goto L90;
			}
			if (j - start > endd - j - 1) {
				++stkpnt;
				stack_ref (1, stkpnt) = start;
				stack_ref (2, stkpnt) = j;
				++stkpnt;
				stack_ref (1, stkpnt) = j + 1;
				stack_ref (2, stkpnt) = endd;
			} else {
				++stkpnt;
				stack_ref (1, stkpnt) = j + 1;
				stack_ref (2, stkpnt) = endd;
				++stkpnt;
				stack_ref (1, stkpnt) = start;
				stack_ref (2, stkpnt) = j;
			}
		}
	}
	if (stkpnt > 0) {
		goto L10;
	}
	return 0;
}								/* NUMlapack_dlasrt */

#undef stack_ref

int NUMlapack_dlassq (integer *n, double *x, integer *incx, double *scale, double *sumsq) {
	/* System generated locals */
	integer i__1, i__2;
	double d__1;

	/* Local variables */
	static double absxi;
	static integer ix;

	--x;

	/* Function Body */
	if (*n > 0) {
		i__1 = (*n - 1) * *incx + 1;
		i__2 = *incx;
		for (ix = 1; i__2 < 0 ? ix >= i__1 : ix <= i__1; ix += i__2) {
			if (x[ix] != 0.) {
				absxi = (d__1 = x[ix], fabs (d__1));
				if (*scale < absxi) {
					/* Computing 2nd power */
					d__1 = *scale / absxi;
					*sumsq = *sumsq * (d__1 * d__1) + 1;
					*scale = absxi;
				} else {
					/* Computing 2nd power */
					d__1 = absxi / *scale;
					*sumsq += d__1 * d__1;
				}
			}
			/* L10: */
		}
	}
	return 0;
}								/* NUMlapack_dlassq */

int NUMlapack_dlasv2 (double *f, double *g, double *h__, double *ssmin, double *ssmax, double *snr, double *csr,
                      double *snl, double *csl) {
	/* Table of constant values */
	static double c_b3 = 2.;
	static double c_b4 = 1.;

	/* System generated locals */
	double d__1;

	/* Local variables */
	static integer pmax;
	static double temp;
	static integer swap;
	static double a, d__, l, m, r__, s, t, tsign, fa, ga, ha;
	static double ft, gt, ht, mm;
	static integer gasmal;
	static double tt, clt, crt, slt, srt;

	ft = *f;
	fa = fabs (ft);
	ht = *h__;
	ha = fabs (*h__);

	/* PMAX points to the maximum absolute element of matrix PMAX = 1 if F
	   largest in absolute values PMAX = 2 if G largest in absolute values
	   PMAX = 3 if H largest in absolute values */

	pmax = 1;
	swap = ha > fa;
	if (swap) {
		pmax = 3;
		temp = ft;
		ft = ht;
		ht = temp;
		temp = fa;
		fa = ha;
		ha = temp;

		/* Now FA .ge. HA */

	}
	gt = *g;
	ga = fabs (gt);
	if (ga == 0.) {

		/* Diagonal matrix */

		*ssmin = ha;
		*ssmax = fa;
		clt = 1.;
		crt = 1.;
		slt = 0.;
		srt = 0.;
	} else {
		gasmal = TRUE;
		if (ga > fa) {
			pmax = 2;
			if (fa / ga < NUMblas_dlamch ("EPS")) {

				/* Case of very large GA */

				gasmal = FALSE;
				*ssmax = ga;
				if (ha > 1.) {
					*ssmin = fa / (ga / ha);
				} else {
					*ssmin = fa / ga * ha;
				}
				clt = 1.;
				slt = ht / gt;
				srt = 1.;
				crt = ft / gt;
			}
		}
		if (gasmal) {

			/* Normal case */

			d__ = fa - ha;
			if (d__ == fa) {

				/* Copes with infinite F or H */

				l = 1.;
			} else {
				l = d__ / fa;
			}

			/* Note that 0 .le. L .le. 1 */

			m = gt / ft;

			/* Note that abs(M) .le. 1/macheps */

			t = 2. - l;

			/* Note that T .ge. 1 */

			mm = m * m;
			tt = t * t;
			s = sqrt (tt + mm);

			/* Note that 1 .le. S .le. 1 + 1/macheps */

			if (l == 0.) {
				r__ = fabs (m);
			} else {
				r__ = sqrt (l * l + mm);
			}

			/* Note that 0 .le. R .le. 1 + 1/macheps */

			a = (s + r__) * .5;

			/* Note that 1 .le. A .le. 1 + abs(M) */

			*ssmin = ha / a;
			*ssmax = fa * a;
			if (mm == 0.) {

				/* Note that M is very tiny */

				if (l == 0.) {
					t = d_sign (&c_b3, &ft) * d_sign (&c_b4, &gt);
				} else {
					t = gt / d_sign (&d__, &ft) + m / t;
				}
			} else {
				t = (m / (s + t) + m / (r__ + l)) * (a + 1.);
			}
			l = sqrt (t * t + 4.);
			crt = 2. / l;
			srt = t / l;
			clt = (crt + srt * m) / a;
			slt = ht / ft * srt / a;
		}
	}
	if (swap) {
		*csl = srt;
		*snl = crt;
		*csr = slt;
		*snr = clt;
	} else {
		*csl = clt;
		*snl = slt;
		*csr = crt;
		*snr = srt;
	}

	/* Correct signs of SSMAX and SSMIN */

	if (pmax == 1) {
		tsign = d_sign (&c_b4, csr) * d_sign (&c_b4, csl) * d_sign (&c_b4, f);
	}
	if (pmax == 2) {
		tsign = d_sign (&c_b4, snr) * d_sign (&c_b4, csl) * d_sign (&c_b4, g);
	}
	if (pmax == 3) {
		tsign = d_sign (&c_b4, snr) * d_sign (&c_b4, snl) * d_sign (&c_b4, h__);
	}
	*ssmax = d_sign (ssmax, &tsign);
	d__1 = tsign * d_sign (&c_b4, f) * d_sign (&c_b4, h__);
	*ssmin = d_sign (ssmin, &d__1);
	return 0;
}								/* NUMlapack_dlasv2 */

int NUMlapack_dlaswp (integer *n, double *a, integer *lda, integer *k1, integer *k2, integer *ipiv, integer *incx) {
	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2, i__3, i__4;

	/* Local variables */
	static double temp;
	static integer i__, j, k, i1, i2, n32, ip, ix, ix0, inc;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--ipiv;

	/* Function Body */
	if (*incx > 0) {
		ix0 = *k1;
		i1 = *k1;
		i2 = *k2;
		inc = 1;
	} else if (*incx < 0) {
		ix0 = (1 - *k2) * *incx + 1;
		i1 = *k2;
		i2 = *k1;
		inc = -1;
	} else {
		return 0;
	}

	n32 = *n / 32 << 5;
	if (n32 != 0) {
		i__1 = n32;
		for (j = 1; j <= i__1; j += 32) {
			ix = ix0;
			i__2 = i2;
			i__3 = inc;
			for (i__ = i1; i__3 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__3) {
				ip = ipiv[ix];
				if (ip != i__) {
					i__4 = j + 31;
					for (k = j; k <= i__4; ++k) {
						temp = a_ref (i__, k);
						a_ref (i__, k) = a_ref (ip, k);
						a_ref (ip, k) = temp;
						/* L10: */
					}
				}
				ix += *incx;
				/* L20: */
			}
			/* L30: */
		}
	}
	if (n32 != *n) {
		++n32;
		ix = ix0;
		i__1 = i2;
		i__3 = inc;
		for (i__ = i1; i__3 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__3) {
			ip = ipiv[ix];
			if (ip != i__) {
				i__2 = *n;
				for (k = n32; k <= i__2; ++k) {
					temp = a_ref (i__, k);
					a_ref (i__, k) = a_ref (ip, k);
					a_ref (ip, k) = temp;
					/* L40: */
				}
			}
			ix += *incx;
			/* L50: */
		}
	}
	return 0;
}								/* NUMlapack_dlaswp */

#define w_ref(a_1,a_2) w[(a_2)*w_dim1 + a_1]

int NUMlapack_dlatrd (const char *uplo, integer *n, integer *nb, double *a, integer *lda, double *e, double *tau, double *w,
                      integer *ldw) {
	/* Table of constant values */
	static double c_b5 = -1.;
	static double c_b6 = 1.;
	static integer c__1 = 1;
	static double c_b16 = 0.;

	/* System generated locals */
	integer a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3;

	/* Local variables */
	static integer i__;
	static double alpha;
	static integer iw;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--e;
	--tau;
	w_dim1 = *ldw;
	w_offset = 1 + w_dim1 * 1;
	w -= w_offset;

	/* Function Body */
	if (*n <= 0) {
		return 0;
	}

	if (lsame_ (uplo, "U")) {

		/* Reduce last NB columns of upper triangle */

		i__1 = *n - *nb + 1;
		for (i__ = *n; i__ >= i__1; --i__) {
			iw = i__ - *n + *nb;
			if (i__ < *n) {

				/* Update A(1:i,i) */

				i__2 = *n - i__;
				NUMblas_dgemv ("No transpose", &i__, &i__2, &c_b5, &a_ref (1, i__ + 1), lda, &w_ref (i__, iw + 1),
				               ldw, &c_b6, &a_ref (1, i__), &c__1);
				i__2 = *n - i__;
				NUMblas_dgemv ("No transpose", &i__, &i__2, &c_b5, &w_ref (1, iw + 1), ldw, &a_ref (i__, i__ + 1),
				               lda, &c_b6, &a_ref (1, i__), &c__1);
			}
			if (i__ > 1) {

				/* Generate elementary reflector H(i) to annihilate
				   A(1:i-2,i) */

				i__2 = i__ - 1;
				NUMlapack_dlarfg (&i__2, &a_ref (i__ - 1, i__), &a_ref (1, i__), &c__1, &tau[i__ - 1]);
				e[i__ - 1] = a_ref (i__ - 1, i__);
				a_ref (i__ - 1, i__) = 1.;

				/* Compute W(1:i-1,i) */

				i__2 = i__ - 1;
				NUMblas_dsymv ("Upper", &i__2, &c_b6, &a[a_offset], lda, &a_ref (1, i__), &c__1, &c_b16, &w_ref (1,
				               iw), &c__1);
				if (i__ < *n) {
					i__2 = i__ - 1;
					i__3 = *n - i__;
					NUMblas_dgemv ("Transpose", &i__2, &i__3, &c_b6, &w_ref (1, iw + 1), ldw, &a_ref (1, i__), &c__1,
					               &c_b16, &w_ref (i__ + 1, iw), &c__1);
					i__2 = i__ - 1;
					i__3 = *n - i__;
					NUMblas_dgemv ("No transpose", &i__2, &i__3, &c_b5, &a_ref (1, i__ + 1), lda, &w_ref (i__ + 1,
					               iw), &c__1, &c_b6, &w_ref (1, iw), &c__1);
					i__2 = i__ - 1;
					i__3 = *n - i__;
					NUMblas_dgemv ("Transpose", &i__2, &i__3, &c_b6, &a_ref (1, i__ + 1), lda, &a_ref (1, i__),
					               &c__1, &c_b16, &w_ref (i__ + 1, iw), &c__1);
					i__2 = i__ - 1;
					i__3 = *n - i__;
					NUMblas_dgemv ("No transpose", &i__2, &i__3, &c_b5, &w_ref (1, iw + 1), ldw, &w_ref (i__ + 1,
					               iw), &c__1, &c_b6, &w_ref (1, iw), &c__1);
				}
				i__2 = i__ - 1;
				NUMblas_dscal (&i__2, &tau[i__ - 1], &w_ref (1, iw), &c__1);
				i__2 = i__ - 1;
				alpha = tau[i__ - 1] * -.5 * NUMblas_ddot (&i__2, &w_ref (1, iw), &c__1, &a_ref (1, i__), &c__1);
				i__2 = i__ - 1;
				NUMblas_daxpy (&i__2, &alpha, &a_ref (1, i__), &c__1, &w_ref (1, iw), &c__1);
			}

			/* L10: */
		}
	} else {

		/* Reduce first NB columns of lower triangle */

		i__1 = *nb;
		for (i__ = 1; i__ <= i__1; ++i__) {

			/* Update A(i:n,i) */

			i__2 = *n - i__ + 1;
			i__3 = i__ - 1;
			NUMblas_dgemv ("No transpose", &i__2, &i__3, &c_b5, &a_ref (i__, 1), lda, &w_ref (i__, 1), ldw, &c_b6,
			               &a_ref (i__, i__), &c__1);
			i__2 = *n - i__ + 1;
			i__3 = i__ - 1;
			NUMblas_dgemv ("No transpose", &i__2, &i__3, &c_b5, &w_ref (i__, 1), ldw, &a_ref (i__, 1), lda, &c_b6,
			               &a_ref (i__, i__), &c__1);
			if (i__ < *n) {

				/* Generate elementary reflector H(i) to annihilate
				   A(i+2:n,i)

				   Computing MIN */
				i__2 = i__ + 2;
				i__3 = *n - i__;
				NUMlapack_dlarfg (&i__3, &a_ref (i__ + 1, i__), &a_ref (MIN (i__2, *n), i__), &c__1, &tau[i__]);
				e[i__] = a_ref (i__ + 1, i__);
				a_ref (i__ + 1, i__) = 1.;

				/* Compute W(i+1:n,i) */

				i__2 = *n - i__;
				NUMblas_dsymv ("Lower", &i__2, &c_b6, &a_ref (i__ + 1, i__ + 1), lda, &a_ref (i__ + 1, i__), &c__1,
				               &c_b16, &w_ref (i__ + 1, i__), &c__1);
				i__2 = *n - i__;
				i__3 = i__ - 1;
				NUMblas_dgemv ("Transpose", &i__2, &i__3, &c_b6, &w_ref (i__ + 1, 1), ldw, &a_ref (i__ + 1, i__),
				               &c__1, &c_b16, &w_ref (1, i__), &c__1);
				i__2 = *n - i__;
				i__3 = i__ - 1;
				NUMblas_dgemv ("No transpose", &i__2, &i__3, &c_b5, &a_ref (i__ + 1, 1), lda, &w_ref (1, i__), &c__1,
				               &c_b6, &w_ref (i__ + 1, i__), &c__1);
				i__2 = *n - i__;
				i__3 = i__ - 1;
				NUMblas_dgemv ("Transpose", &i__2, &i__3, &c_b6, &a_ref (i__ + 1, 1), lda, &a_ref (i__ + 1, i__),
				               &c__1, &c_b16, &w_ref (1, i__), &c__1);
				i__2 = *n - i__;
				i__3 = i__ - 1;
				NUMblas_dgemv ("No transpose", &i__2, &i__3, &c_b5, &w_ref (i__ + 1, 1), ldw, &w_ref (1, i__), &c__1,
				               &c_b6, &w_ref (i__ + 1, i__), &c__1);
				i__2 = *n - i__;
				NUMblas_dscal (&i__2, &tau[i__], &w_ref (i__ + 1, i__), &c__1);
				i__2 = *n - i__;
				alpha =
				    tau[i__] * -.5 * NUMblas_ddot (&i__2, &w_ref (i__ + 1, i__), &c__1, &a_ref (i__ + 1, i__),
				                                   &c__1);
				i__2 = *n - i__;
				NUMblas_daxpy (&i__2, &alpha, &a_ref (i__ + 1, i__), &c__1, &w_ref (i__ + 1, i__), &c__1);
			}

			/* L20: */
		}
	}

	return 0;
}								/* NUMlapack_dlatrd */

#undef w_ref

int NUMlapack_dorg2l (integer *m, integer *n, integer *k, double *a, integer *lda, double *tau, double *work, integer *info) {
	/* Table of constant values */
	static integer c__1 = 1;

	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2, i__3;
	double d__1;

	/* Local variables */
	static integer i__, j, l;
	static integer ii;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--tau;
	--work;

	/* Function Body */
	*info = 0;
	if (*m < 0) {
		*info = -1;
	} else if (*n < 0 || *n > *m) {
		*info = -2;
	} else if (*k < 0 || *k > *n) {
		*info = -3;
	} else if (*lda < MAX (1, *m)) {
		*info = -5;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DORG2L", &i__1);
		return 0;
	}

	/* Quick return if possible */

	if (*n <= 0) {
		return 0;
	}

	/* Initialise columns 1:n-k to columns of the unit matrix */

	i__1 = *n - *k;
	for (j = 1; j <= i__1; ++j) {
		i__2 = *m;
		for (l = 1; l <= i__2; ++l) {
			a_ref (l, j) = 0.;
			/* L10: */
		}
		a_ref (*m - *n + j, j) = 1.;
		/* L20: */
	}

	i__1 = *k;
	for (i__ = 1; i__ <= i__1; ++i__) {
		ii = *n - *k + i__;

		/* Apply H(i) to A(1:m-k+i,1:n-k+i) from the left */

		a_ref (*m - *n + ii, ii) = 1.;
		i__2 = *m - *n + ii;
		i__3 = ii - 1;
		NUMlapack_dlarf ("Left", &i__2, &i__3, &a_ref (1, ii), &c__1, &tau[i__], &a[a_offset], lda, &work[1]);
		i__2 = *m - *n + ii - 1;
		d__1 = -tau[i__];
		NUMblas_dscal (&i__2, &d__1, &a_ref (1, ii), &c__1);
		a_ref (*m - *n + ii, ii) = 1. - tau[i__];

		/* Set A(m-k+i+1:m,n-k+i) to zero */

		i__2 = *m;
		for (l = *m - *n + ii + 1; l <= i__2; ++l) {
			a_ref (l, ii) = 0.;
			/* L30: */
		}
		/* L40: */
	}
	return 0;
}								/* NUMlapack_dorg2l */

int NUMlapack_dorg2r (integer *m, integer *n, integer *k, double *a, integer *lda, double *tau, double *work, integer *info) {
	/* Table of constant values */
	static integer c__1 = 1;

	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2;
	double d__1;

	/* Local variables */
	static integer i__, j, l;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--tau;
	--work;

	/* Function Body */
	*info = 0;
	if (*m < 0) {
		*info = -1;
	} else if (*n < 0 || *n > *m) {
		*info = -2;
	} else if (*k < 0 || *k > *n) {
		*info = -3;
	} else if (*lda < MAX (1, *m)) {
		*info = -5;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DORG2R", &i__1);
		return 0;
	}

	/* Quick return if possible */

	if (*n <= 0) {
		return 0;
	}

	/* Initialise columns k+1:n to columns of the unit matrix */

	i__1 = *n;
	for (j = *k + 1; j <= i__1; ++j) {
		i__2 = *m;
		for (l = 1; l <= i__2; ++l) {
			a_ref (l, j) = 0.;
			/* L10: */
		}
		a_ref (j, j) = 1.;
		/* L20: */
	}

	for (i__ = *k; i__ >= 1; --i__) {

		/* Apply H(i) to A(i:m,i:n) from the left */

		if (i__ < *n) {
			a_ref (i__, i__) = 1.;
			i__1 = *m - i__ + 1;
			i__2 = *n - i__;
			NUMlapack_dlarf ("Left", &i__1, &i__2, &a_ref (i__, i__), &c__1, &tau[i__], &a_ref (i__, i__ + 1),
			                 lda, &work[1]);
		}
		if (i__ < *m) {
			i__1 = *m - i__;
			d__1 = -tau[i__];
			NUMblas_dscal (&i__1, &d__1, &a_ref (i__ + 1, i__), &c__1);
		}
		a_ref (i__, i__) = 1. - tau[i__];

		/* Set A(1:i-1,i) to zero */

		i__1 = i__ - 1;
		for (l = 1; l <= i__1; ++l) {
			a_ref (l, i__) = 0.;
			/* L30: */
		}
		/* L40: */
	}
	return 0;
}								/* NUMlapack_dorg2r */

int NUMlapack_dorgbr (const char *vect, integer *m, integer *n, integer *k, double *a, integer *lda, double *tau, double *work,
                      integer *lwork, integer *info) {
	/* Table of constant values */
	static integer c__1 = 1;
	static integer c_n1 = -1;

	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2, i__3;

	/* Local variables */
	static integer i__, j;
	static integer iinfo;
	static integer wantq;
	static integer nb, mn;
	static integer lwkopt;
	static integer lquery;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--tau;
	--work;

	/* Function Body */
	*info = 0;
	wantq = lsame_ (vect, "Q");
	mn = MIN (*m, *n);
	lquery = *lwork == -1;
	if (!wantq && !lsame_ (vect, "P")) {
		*info = -1;
	} else if (*m < 0) {
		*info = -2;
	} else if (*n < 0 || wantq && (*n > *m || *n < MIN (*m, *k)) || !wantq && (*m > *n || *m < MIN (*n, *k))) {
		*info = -3;
	} else if (*k < 0) {
		*info = -4;
	} else if (*lda < MAX (1, *m)) {
		*info = -6;
	} else if (*lwork < MAX (1, mn) && !lquery) {
		*info = -9;
	}

	if (*info == 0) {
		if (wantq) {
			nb = NUMlapack_ilaenv (&c__1, "DORGQR", " ", m, n, k, &c_n1, 6, 1);
		} else {
			nb = NUMlapack_ilaenv (&c__1, "DORGLQ", " ", m, n, k, &c_n1, 6, 1);
		}
		lwkopt = MAX (1, mn) * nb;
		work[1] = (double) lwkopt;
	}

	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DORGBR", &i__1);
		return 0;
	} else if (lquery) {
		return 0;
	}

	/* Quick return if possible */

	if (*m == 0 || *n == 0) {
		work[1] = 1.;
		return 0;
	}

	if (wantq) {

		/* Form Q, determined by a call to DGEBRD to reduce an m-by-k matrix */

		if (*m >= *k) {

			/* If m >= k, assume m >= n >= k */

			NUMlapack_dorgqr (m, n, k, &a[a_offset], lda, &tau[1], &work[1], lwork, &iinfo);

		} else {

			/* If m < k, assume m = n

			   Shift the vectors which define the elementary reflectors one
			   column to the right, and set the first row and column of Q to
			   those of the unit matrix */

			for (j = *m; j >= 2; --j) {
				a_ref (1, j) = 0.;
				i__1 = *m;
				for (i__ = j + 1; i__ <= i__1; ++i__) {
					a_ref (i__, j) = a_ref (i__, j - 1);
					/* L10: */
				}
				/* L20: */
			}
			a_ref (1, 1) = 1.;
			i__1 = *m;
			for (i__ = 2; i__ <= i__1; ++i__) {
				a_ref (i__, 1) = 0.;
				/* L30: */
			}
			if (*m > 1) {

				/* Form Q(2:m,2:m) */

				i__1 = *m - 1;
				i__2 = *m - 1;
				i__3 = *m - 1;
				NUMlapack_dorgqr (&i__1, &i__2, &i__3, &a_ref (2, 2), lda, &tau[1], &work[1], lwork, &iinfo);
			}
		}
	} else {

		/* Form P', determined by a call to DGEBRD to reduce a k-by-n matrix */

		if (*k < *n) {

			/* If k < n, assume k <= m <= n */

			NUMlapack_dorglq (m, n, k, &a[a_offset], lda, &tau[1], &work[1], lwork, &iinfo);

		} else {

			/* If k >= n, assume m = n

			   Shift the vectors which define the elementary reflectors one
			   row downward, and set the first row and column of P' to those
			   of the unit matrix */

			a_ref (1, 1) = 1.;
			i__1 = *n;
			for (i__ = 2; i__ <= i__1; ++i__) {
				a_ref (i__, 1) = 0.;
				/* L40: */
			}
			i__1 = *n;
			for (j = 2; j <= i__1; ++j) {
				for (i__ = j - 1; i__ >= 2; --i__) {
					a_ref (i__, j) = a_ref (i__ - 1, j);
					/* L50: */
				}
				a_ref (1, j) = 0.;
				/* L60: */
			}
			if (*n > 1) {

				/* Form P'(2:n,2:n) */

				i__1 = *n - 1;
				i__2 = *n - 1;
				i__3 = *n - 1;
				NUMlapack_dorglq (&i__1, &i__2, &i__3, &a_ref (2, 2), lda, &tau[1], &work[1], lwork, &iinfo);
			}
		}
	}
	work[1] = (double) lwkopt;
	return 0;
}								/* NUMlapack_dorgbr */


int NUMlapack_dorghr (integer *n, integer *ilo, integer *ihi, double *a, integer *lda, double *tau, double *work,
                      integer *lwork, integer *info) {
	/* Table of constant values */
	static integer c__1 = 1;
	static integer c_n1 = -1;

	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2;

	/* Local variables */
	static integer i__, j, iinfo, nb, nh;
	static integer lwkopt;
	static int lquery;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--tau;
	--work;

	/* Function Body */
	*info = 0;
	nh = *ihi - *ilo;
	lquery = *lwork == -1;
	if (*n < 0) {
		*info = -1;
	} else if (*ilo < 1 || *ilo > MAX (1, *n)) {
		*info = -2;
	} else if (*ihi < MIN (*ilo, *n) || *ihi > *n) {
		*info = -3;
	} else if (*lda < MAX (1, *n)) {
		*info = -5;
	} else if (*lwork < MAX (1, nh) && !lquery) {
		*info = -8;
	}

	if (*info == 0) {
		nb = NUMlapack_ilaenv (&c__1, "DORGQR", " ", &nh, &nh, &nh, &c_n1, 6, 1);
		lwkopt = MAX (1, nh) * nb;
		work[1] = (double) lwkopt;
	}

	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DORGHR", &i__1);
		return 0;
	} else if (lquery) {
		return 0;
	}

	/* Quick return if possible */

	if (*n == 0) {
		work[1] = 1.;
		return 0;
	}

	/* Shift the vectors which define the elementary reflectors one column to
	   the right, and set the first ilo and the last n-ihi rows and columns
	   to those of the unit matrix */

	i__1 = *ilo + 1;
	for (j = *ihi; j >= i__1; --j) {
		i__2 = j - 1;
		for (i__ = 1; i__ <= i__2; ++i__) {
			a_ref (i__, j) = 0.;
			/* L10: */
		}
		i__2 = *ihi;
		for (i__ = j + 1; i__ <= i__2; ++i__) {
			a_ref (i__, j) = a_ref (i__, j - 1);
			/* L20: */
		}
		i__2 = *n;
		for (i__ = *ihi + 1; i__ <= i__2; ++i__) {
			a_ref (i__, j) = 0.;
			/* L30: */
		}
		/* L40: */
	}
	i__1 = *ilo;
	for (j = 1; j <= i__1; ++j) {
		i__2 = *n;
		for (i__ = 1; i__ <= i__2; ++i__) {
			a_ref (i__, j) = 0.;
			/* L50: */
		}
		a_ref (j, j) = 1.;
		/* L60: */
	}
	i__1 = *n;
	for (j = *ihi + 1; j <= i__1; ++j) {
		i__2 = *n;
		for (i__ = 1; i__ <= i__2; ++i__) {
			a_ref (i__, j) = 0.;
			/* L70: */
		}
		a_ref (j, j) = 1.;
		/* L80: */
	}

	if (nh > 0) {

		/* Generate Q(ilo+1:ihi,ilo+1:ihi) */

		NUMlapack_dorgqr (&nh, &nh, &nh, &a_ref (*ilo + 1, *ilo + 1), lda, &tau[*ilo], &work[1], lwork,
		                  &iinfo);
	}
	work[1] = (double) lwkopt;
	return 0;
}								/* NUMlapack_dorghr */


int NUMlapack_dorgl2 (integer *m, integer *n, integer *k, double *a, integer *lda, double *tau, double *work, integer *info) {
	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2;
	double d__1;

	/* Local variables */
	static integer i__, j, l;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--tau;
	--work;

	/* Function Body */
	*info = 0;
	if (*m < 0) {
		*info = -1;
	} else if (*n < *m) {
		*info = -2;
	} else if (*k < 0 || *k > *m) {
		*info = -3;
	} else if (*lda < MAX (1, *m)) {
		*info = -5;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DORGL2", &i__1);
		return 0;
	}

	/* Quick return if possible */

	if (*m <= 0) {
		return 0;
	}

	if (*k < *m) {

		/* Initialise rows k+1:m to rows of the unit matrix */

		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
			i__2 = *m;
			for (l = *k + 1; l <= i__2; ++l) {
				a_ref (l, j) = 0.;
				/* L10: */
			}
			if (j > *k && j <= *m) {
				a_ref (j, j) = 1.;
			}
			/* L20: */
		}
	}

	for (i__ = *k; i__ >= 1; --i__) {

		/* Apply H(i) to A(i:m,i:n) from the right */

		if (i__ < *n) {
			if (i__ < *m) {
				a_ref (i__, i__) = 1.;
				i__1 = *m - i__;
				i__2 = *n - i__ + 1;
				NUMlapack_dlarf ("Right", &i__1, &i__2, &a_ref (i__, i__), lda, &tau[i__], &a_ref (i__ + 1,
				                 i__), lda, &work[1]);
			}
			i__1 = *n - i__;
			d__1 = -tau[i__];
			NUMblas_dscal (&i__1, &d__1, &a_ref (i__, i__ + 1), lda);
		}
		a_ref (i__, i__) = 1. - tau[i__];

		/* Set A(i,1:i-1) to zero */

		i__1 = i__ - 1;
		for (l = 1; l <= i__1; ++l) {
			a_ref (i__, l) = 0.;
			/* L30: */
		}
		/* L40: */
	}
	return 0;
}								/* NUMlapack_dorgl2 */

int NUMlapack_dorglq (integer *m, integer *n, integer *k, double *a, integer *lda, double *tau, double *work, integer *lwork,
                      integer *info) {
	/* Table of constant values */
	static integer c__1 = 1;
	static integer c_n1 = -1;
	static integer c__3 = 3;
	static integer c__2 = 2;

	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2, i__3;

	/* Local variables */
	static integer i__, j, l, nbmin, iinfo;
	static integer ib, nb, ki, kk;
	static integer nx;
	static integer ldwork, lwkopt;
	static integer lquery;
	static integer iws;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--tau;
	--work;

	/* Function Body */
	*info = 0;
	nb = NUMlapack_ilaenv (&c__1, "DORGLQ", " ", m, n, k, &c_n1, 6, 1);
	lwkopt = MAX (1, *m) * nb;
	work[1] = (double) lwkopt;
	lquery = *lwork == -1;
	if (*m < 0) {
		*info = -1;
	} else if (*n < *m) {
		*info = -2;
	} else if (*k < 0 || *k > *m) {
		*info = -3;
	} else if (*lda < MAX (1, *m)) {
		*info = -5;
	} else if (*lwork < MAX (1, *m) && !lquery) {
		*info = -8;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DORGLQ", &i__1);
		return 0;
	} else if (lquery) {
		return 0;
	}

	/* Quick return if possible */

	if (*m <= 0) {
		work[1] = 1.;
		return 0;
	}

	nbmin = 2;
	nx = 0;
	iws = *m;
	if (nb > 1 && nb < *k) {

		/* Determine when to cross over from blocked to unblocked code.

		   Computing MAX */
		i__1 = 0, i__2 = NUMlapack_ilaenv (&c__3, "DORGLQ", " ", m, n, k, &c_n1, 6, 1);
		nx = MAX (i__1, i__2);
		if (nx < *k) {

			/* Determine if workspace is large enough for blocked code. */

			ldwork = *m;
			iws = ldwork * nb;
			if (*lwork < iws) {

				/* Not enough workspace to use optimal NB: reduce NB and
				   determine the minimum value of NB. */

				nb = *lwork / ldwork;
				/* Computing MAX */
				i__1 = 2, i__2 = NUMlapack_ilaenv (&c__2, "DORGLQ", " ", m, n, k, &c_n1, 6, 1);
				nbmin = MAX (i__1, i__2);
			}
		}
	}

	if (nb >= nbmin && nb < *k && nx < *k) {

		/* Use blocked code after the last block. The first kk rows are
		   handled by the block method. */

		ki = (*k - nx - 1) / nb * nb;
		/* Computing MIN */
		i__1 = *k, i__2 = ki + nb;
		kk = MIN (i__1, i__2);

		/* Set A(kk+1:m,1:kk) to zero. */

		i__1 = kk;
		for (j = 1; j <= i__1; ++j) {
			i__2 = *m;
			for (i__ = kk + 1; i__ <= i__2; ++i__) {
				a_ref (i__, j) = 0.;
				/* L10: */
			}
			/* L20: */
		}
	} else {
		kk = 0;
	}

	/* Use unblocked code for the last or only block. */

	if (kk < *m) {
		i__1 = *m - kk;
		i__2 = *n - kk;
		i__3 = *k - kk;
		NUMlapack_dorgl2 (&i__1, &i__2, &i__3, &a_ref (kk + 1, kk + 1), lda, &tau[kk + 1], &work[1], &iinfo);
	}

	if (kk > 0) {

		/* Use blocked code */

		i__1 = -nb;
		for (i__ = ki + 1; i__1 < 0 ? i__ >= 1 : i__ <= 1; i__ += i__1) {
			/* Computing MIN */
			i__2 = nb, i__3 = *k - i__ + 1;
			ib = MIN (i__2, i__3);
			if (i__ + ib <= *m) {

				/* Form the triangular factor of the block reflector H = H(i)
				   H(i+1) . . . H(i+ib-1) */

				i__2 = *n - i__ + 1;
				NUMlapack_dlarft ("Forward", "Rowwise", &i__2, &ib, &a_ref (i__, i__), lda, &tau[i__], &work[1],
				                  &ldwork);

				/* Apply H' to A(i+ib:m,i:n) from the right */

				i__2 = *m - i__ - ib + 1;
				i__3 = *n - i__ + 1;
				NUMlapack_dlarfb ("Right", "Transpose", "Forward", "Rowwise", &i__2, &i__3, &ib, &a_ref (i__,
				                  i__), lda, &work[1], &ldwork, &a_ref (i__ + ib, i__), lda, &work[ib + 1], &ldwork);
			}

			/* Apply H' to columns i:n of current block */

			i__2 = *n - i__ + 1;
			NUMlapack_dorgl2 (&ib, &i__2, &ib, &a_ref (i__, i__), lda, &tau[i__], &work[1], &iinfo);

			/* Set columns 1:i-1 of current block to zero */

			i__2 = i__ - 1;
			for (j = 1; j <= i__2; ++j) {
				i__3 = i__ + ib - 1;
				for (l = i__; l <= i__3; ++l) {
					a_ref (l, j) = 0.;
					/* L30: */
				}
				/* L40: */
			}
			/* L50: */
		}
	}

	work[1] = (double) iws;
	return 0;
}								/* NUMlapack_dorglq */

int NUMlapack_dorgql (integer *m, integer *n, integer *k, double *a, integer *lda, double *tau, double *work, integer *lwork,
                      integer *info) {
	/* Table of constant values */
	static integer c__1 = 1;
	static integer c_n1 = -1;
	static integer c__3 = 3;
	static integer c__2 = 2;

	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2, i__3, i__4;

	/* Local variables */
	static integer i__, j, l, nbmin, iinfo;
	static integer ib, nb, kk;
	static integer nx;
	static integer ldwork, lwkopt;
	static integer lquery;
	static integer iws;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--tau;
	--work;

	/* Function Body */
	*info = 0;
	nb = NUMlapack_ilaenv (&c__1, "DORGQL", " ", m, n, k, &c_n1, 6, 1);
	lwkopt = MAX (1, *n) * nb;
	work[1] = (double) lwkopt;
	lquery = *lwork == -1;
	if (*m < 0) {
		*info = -1;
	} else if (*n < 0 || *n > *m) {
		*info = -2;
	} else if (*k < 0 || *k > *n) {
		*info = -3;
	} else if (*lda < MAX (1, *m)) {
		*info = -5;
	} else if (*lwork < MAX (1, *n) && !lquery) {
		*info = -8;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DORGQL", &i__1);
		return 0;
	} else if (lquery) {
		return 0;
	}

	/* Quick return if possible */

	if (*n <= 0) {
		work[1] = 1.;
		return 0;
	}

	nbmin = 2;
	nx = 0;
	iws = *n;
	if (nb > 1 && nb < *k) {

		/* Determine when to cross over from blocked to unblocked code.

		   Computing MAX */
		i__1 = 0, i__2 = NUMlapack_ilaenv (&c__3, "DORGQL", " ", m, n, k, &c_n1, 6, 1);
		nx = MAX (i__1, i__2);
		if (nx < *k) {

			/* Determine if workspace is large enough for blocked code. */

			ldwork = *n;
			iws = ldwork * nb;
			if (*lwork < iws) {

				/* Not enough workspace to use optimal NB: reduce NB and
				   determine the minimum value of NB. */

				nb = *lwork / ldwork;
				/* Computing MAX */
				i__1 = 2, i__2 = NUMlapack_ilaenv (&c__2, "DORGQL", " ", m, n, k, &c_n1, 6, 1);
				nbmin = MAX (i__1, i__2);
			}
		}
	}

	if (nb >= nbmin && nb < *k && nx < *k) {

		/* Use blocked code after the first block. The last kk columns are
		   handled by the block method.

		   Computing MIN */
		i__1 = *k, i__2 = (*k - nx + nb - 1) / nb * nb;
		kk = MIN (i__1, i__2);

		/* Set A(m-kk+1:m,1:n-kk) to zero. */

		i__1 = *n - kk;
		for (j = 1; j <= i__1; ++j) {
			i__2 = *m;
			for (i__ = *m - kk + 1; i__ <= i__2; ++i__) {
				a_ref (i__, j) = 0.;
				/* L10: */
			}
			/* L20: */
		}
	} else {
		kk = 0;
	}

	/* Use unblocked code for the first or only block. */

	i__1 = *m - kk;
	i__2 = *n - kk;
	i__3 = *k - kk;
	NUMlapack_dorg2l (&i__1, &i__2, &i__3, &a[a_offset], lda, &tau[1], &work[1], &iinfo);

	if (kk > 0) {

		/* Use blocked code */

		i__1 = *k;
		i__2 = nb;
		for (i__ = *k - kk + 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
			/* Computing MIN */
			i__3 = nb, i__4 = *k - i__ + 1;
			ib = MIN (i__3, i__4);
			if (*n - *k + i__ > 1) {

				/* Form the triangular factor of the block reflector H =
				   H(i+ib-1) . . . H(i+1) H(i) */

				i__3 = *m - *k + i__ + ib - 1;
				NUMlapack_dlarft ("Backward", "Columnwise", &i__3, &ib, &a_ref (1, *n - *k + i__), lda,
				                  &tau[i__], &work[1], &ldwork);

				/* Apply H to A(1:m-k+i+ib-1,1:n-k+i-1) from the left */

				i__3 = *m - *k + i__ + ib - 1;
				i__4 = *n - *k + i__ - 1;
				NUMlapack_dlarfb ("Left", "No transpose", "Backward", "Columnwise", &i__3, &i__4, &ib,
				                  &a_ref (1, *n - *k + i__), lda, &work[1], &ldwork, &a[a_offset], lda, &work[ib + 1],
				                  &ldwork);
			}

			/* Apply H to rows 1:m-k+i+ib-1 of current block */

			i__3 = *m - *k + i__ + ib - 1;
			NUMlapack_dorg2l (&i__3, &ib, &ib, &a_ref (1, *n - *k + i__), lda, &tau[i__], &work[1], &iinfo);

			/* Set rows m-k+i+ib:m of current block to zero */

			i__3 = *n - *k + i__ + ib - 1;
			for (j = *n - *k + i__; j <= i__3; ++j) {
				i__4 = *m;
				for (l = *m - *k + i__ + ib; l <= i__4; ++l) {
					a_ref (l, j) = 0.;
					/* L30: */
				}
				/* L40: */
			}
			/* L50: */
		}
	}

	work[1] = (double) iws;
	return 0;
}								/* NUMlapack_dorgql */

int NUMlapack_dorgqr (integer *m, integer *n, integer *k, double *a, integer *lda, double *tau, double *work, integer *lwork,
                      integer *info) {
	/* Table of constant values */
	static integer c__1 = 1;
	static integer c_n1 = -1;
	static integer c__3 = 3;
	static integer c__2 = 2;

	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2, i__3;

	/* Local variables */
	static integer i__, j, l, nbmin, iinfo;
	static integer ib, nb, ki, kk;
	static integer nx;
	static integer ldwork, lwkopt;
	static integer lquery;
	static integer iws;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--tau;
	--work;

	/* Function Body */
	*info = 0;
	nb = NUMlapack_ilaenv (&c__1, "DORGQR", " ", m, n, k, &c_n1, 6, 1);
	lwkopt = MAX (1, *n) * nb;
	work[1] = (double) lwkopt;
	lquery = *lwork == -1;
	if (*m < 0) {
		*info = -1;
	} else if (*n < 0 || *n > *m) {
		*info = -2;
	} else if (*k < 0 || *k > *n) {
		*info = -3;
	} else if (*lda < MAX (1, *m)) {
		*info = -5;
	} else if (*lwork < MAX (1, *n) && !lquery) {
		*info = -8;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DORGQR", &i__1);
		return 0;
	} else if (lquery) {
		return 0;
	}

	/* Quick return if possible */

	if (*n <= 0) {
		work[1] = 1.;
		return 0;
	}

	nbmin = 2;
	nx = 0;
	iws = *n;
	if (nb > 1 && nb < *k) {

		/* Determine when to cross over from blocked to unblocked code.

		   Computing MAX */
		i__1 = 0, i__2 = NUMlapack_ilaenv (&c__3, "DORGQR", " ", m, n, k, &c_n1, 6, 1);
		nx = MAX (i__1, i__2);
		if (nx < *k) {

			/* Determine if workspace is large enough for blocked code. */

			ldwork = *n;
			iws = ldwork * nb;
			if (*lwork < iws) {

				/* Not enough workspace to use optimal NB: reduce NB and
				   determine the minimum value of NB. */

				nb = *lwork / ldwork;
				/* Computing MAX */
				i__1 = 2, i__2 = NUMlapack_ilaenv (&c__2, "DORGQR", " ", m, n, k, &c_n1, 6, 1);
				nbmin = MAX (i__1, i__2);
			}
		}
	}

	if (nb >= nbmin && nb < *k && nx < *k) {

		/* Use blocked code after the last block. The first kk columns are
		   handled by the block method. */

		ki = (*k - nx - 1) / nb * nb;
		/* Computing MIN */
		i__1 = *k, i__2 = ki + nb;
		kk = MIN (i__1, i__2);

		/* Set A(1:kk,kk+1:n) to zero. */

		i__1 = *n;
		for (j = kk + 1; j <= i__1; ++j) {
			i__2 = kk;
			for (i__ = 1; i__ <= i__2; ++i__) {
				a_ref (i__, j) = 0.;
				/* L10: */
			}
			/* L20: */
		}
	} else {
		kk = 0;
	}

	/* Use unblocked code for the last or only block. */

	if (kk < *n) {
		i__1 = *m - kk;
		i__2 = *n - kk;
		i__3 = *k - kk;
		NUMlapack_dorg2r (&i__1, &i__2, &i__3, &a_ref (kk + 1, kk + 1), lda, &tau[kk + 1], &work[1], &iinfo);
	}

	if (kk > 0) {

		/* Use blocked code */

		i__1 = -nb;
		for (i__ = ki + 1; i__1 < 0 ? i__ >= 1 : i__ <= 1; i__ += i__1) {
			/* Computing MIN */
			i__2 = nb, i__3 = *k - i__ + 1;
			ib = MIN (i__2, i__3);
			if (i__ + ib <= *n) {

				/* Form the triangular factor of the block reflector H = H(i)
				   H(i+1) . . . H(i+ib-1) */

				i__2 = *m - i__ + 1;
				NUMlapack_dlarft ("Forward", "Columnwise", &i__2, &ib, &a_ref (i__, i__), lda, &tau[i__],
				                  &work[1], &ldwork);

				/* Apply H to A(i:m,i+ib:n) from the left */

				i__2 = *m - i__ + 1;
				i__3 = *n - i__ - ib + 1;
				NUMlapack_dlarfb ("Left", "No transpose", "Forward", "Columnwise", &i__2, &i__3, &ib,
				                  &a_ref (i__, i__), lda, &work[1], &ldwork, &a_ref (i__, i__ + ib), lda, &work[ib + 1],
				                  &ldwork);
			}

			/* Apply H to rows i:m of current block */

			i__2 = *m - i__ + 1;
			NUMlapack_dorg2r (&i__2, &ib, &ib, &a_ref (i__, i__), lda, &tau[i__], &work[1], &iinfo);

			/* Set rows 1:i-1 of current block to zero */

			i__2 = i__ + ib - 1;
			for (j = i__; j <= i__2; ++j) {
				i__3 = i__ - 1;
				for (l = 1; l <= i__3; ++l) {
					a_ref (l, j) = 0.;
					/* L30: */
				}
				/* L40: */
			}
			/* L50: */
		}
	}

	work[1] = (double) iws;
	return 0;
}								/* NUMlapack_dorgqr */

int NUMlapack_dorgtr (const char *uplo, integer *n, double *a, integer *lda, double *tau, double *work, integer *lwork,
                      integer *info) {
	/* Table of constant values */
	static integer c__1 = 1;
	static integer c_n1 = -1;

	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2, i__3;

	/* Local variables */
	static integer i__, j;
	static integer iinfo;
	static integer upper;
	static integer nb;
	static integer lwkopt;
	static integer lquery;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--tau;
	--work;

	/* Function Body */
	*info = 0;
	lquery = *lwork == -1;
	upper = lsame_ (uplo, "U");
	if (!upper && !lsame_ (uplo, "L")) {
		*info = -1;
	} else if (*n < 0) {
		*info = -2;
	} else if (*lda < MAX (1, *n)) {
		*info = -4;
	} else {					/* if(complicated condition) */
		/* Computing MAX */
		i__1 = 1, i__2 = *n - 1;
		if (*lwork < MAX (i__1, i__2) && !lquery) {
			*info = -7;
		}
	}

	if (*info == 0) {
		if (upper) {
			i__1 = *n - 1;
			i__2 = *n - 1;
			i__3 = *n - 1;
			nb = NUMlapack_ilaenv (&c__1, "DORGQL", " ", &i__1, &i__2, &i__3, &c_n1, 6, 1);
		} else {
			i__1 = *n - 1;
			i__2 = *n - 1;
			i__3 = *n - 1;
			nb = NUMlapack_ilaenv (&c__1, "DORGQR", " ", &i__1, &i__2, &i__3, &c_n1, 6, 1);
		}
		/* Computing MAX */
		i__1 = 1, i__2 = *n - 1;
		lwkopt = MAX (i__1, i__2) * nb;
		work[1] = (double) lwkopt;
	}

	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DORGTR", &i__1);
		return 0;
	} else if (lquery) {
		return 0;
	}

	/* Quick return if possible */

	if (*n == 0) {
		work[1] = 1.;
		return 0;
	}

	if (upper) {

		/* Q was determined by a call to DSYTRD with UPLO = 'U'

		   Shift the vectors which define the elementary reflectors one
		   column to the left, and set the last row and column of Q to those
		   of the unit matrix */

		i__1 = *n - 1;
		for (j = 1; j <= i__1; ++j) {
			i__2 = j - 1;
			for (i__ = 1; i__ <= i__2; ++i__) {
				a_ref (i__, j) = a_ref (i__, j + 1);
				/* L10: */
			}
			a_ref (*n, j) = 0.;
			/* L20: */
		}
		i__1 = *n - 1;
		for (i__ = 1; i__ <= i__1; ++i__) {
			a_ref (i__, *n) = 0.;
			/* L30: */
		}
		a_ref (*n, *n) = 1.;

		/* Generate Q(1:n-1,1:n-1) */

		i__1 = *n - 1;
		i__2 = *n - 1;
		i__3 = *n - 1;
		NUMlapack_dorgql (&i__1, &i__2, &i__3, &a[a_offset], lda, &tau[1], &work[1], lwork, &iinfo);

	} else {

		/* Q was determined by a call to DSYTRD with UPLO = 'L'.

		   Shift the vectors which define the elementary reflectors one
		   column to the right, and set the first row and column of Q to
		   those of the unit matrix */

		for (j = *n; j >= 2; --j) {
			a_ref (1, j) = 0.;
			i__1 = *n;
			for (i__ = j + 1; i__ <= i__1; ++i__) {
				a_ref (i__, j) = a_ref (i__, j - 1);
				/* L40: */
			}
			/* L50: */
		}
		a_ref (1, 1) = 1.;
		i__1 = *n;
		for (i__ = 2; i__ <= i__1; ++i__) {
			a_ref (i__, 1) = 0.;
			/* L60: */
		}
		if (*n > 1) {

			/* Generate Q(2:n,2:n) */

			i__1 = *n - 1;
			i__2 = *n - 1;
			i__3 = *n - 1;
			NUMlapack_dorgqr (&i__1, &i__2, &i__3, &a_ref (2, 2), lda, &tau[1], &work[1], lwork, &iinfo);
		}
	}
	work[1] = (double) lwkopt;
	return 0;
}								/* NUMlapack_dorgtr */

int NUMlapack_dorm2r (const char *side, const char *trans, integer *m, integer *n, integer *k, double *a, integer *lda, double *tau,
                      double *c__, integer *ldc, double *work, integer *info) {
	/* Table of constant values */
	static integer c__1 = 1;

	/* System generated locals */
	integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2;

	/* Local variables */
	static integer left;
	static integer i__;
	static integer i1, i2, i3, ic, jc, mi, ni, nq;
	static integer notran;
	static double aii;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--tau;
	c_dim1 = *ldc;
	c_offset = 1 + c_dim1 * 1;
	c__ -= c_offset;
	--work;

	/* Function Body */
	*info = 0;
	left = lsame_ (side, "L");
	notran = lsame_ (trans, "N");

	/* NQ is the order of Q */

	if (left) {
		nq = *m;
	} else {
		nq = *n;
	}
	if (!left && !lsame_ (side, "R")) {
		*info = -1;
	} else if (!notran && !lsame_ (trans, "T")) {
		*info = -2;
	} else if (*m < 0) {
		*info = -3;
	} else if (*n < 0) {
		*info = -4;
	} else if (*k < 0 || *k > nq) {
		*info = -5;
	} else if (*lda < MAX (1, nq)) {
		*info = -7;
	} else if (*ldc < MAX (1, *m)) {
		*info = -10;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DORM2R", &i__1);
		return 0;
	}

	/* Quick return if possible */

	if (*m == 0 || *n == 0 || *k == 0) {
		return 0;
	}

	if (left && !notran || !left && notran) {
		i1 = 1;
		i2 = *k;
		i3 = 1;
	} else {
		i1 = *k;
		i2 = 1;
		i3 = -1;
	}

	if (left) {
		ni = *n;
		jc = 1;
	} else {
		mi = *m;
		ic = 1;
	}

	i__1 = i2;
	i__2 = i3;
	for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
		if (left) {

			/* H(i) is applied to C(i:m,1:n) */

			mi = *m - i__ + 1;
			ic = i__;
		} else {

			/* H(i) is applied to C(1:m,i:n) */

			ni = *n - i__ + 1;
			jc = i__;
		}

		/* Apply H(i) */

		aii = a_ref (i__, i__);
		a_ref (i__, i__) = 1.;
		NUMlapack_dlarf (side, &mi, &ni, &a_ref (i__, i__), &c__1, &tau[i__], &c___ref (ic, jc), ldc, &work[1]);
		a_ref (i__, i__) = aii;
		/* L10: */
	}
	return 0;
}								/* NUMlapack_dorm2r */

int NUMlapack_dormbr (const char *vect, const char *side, const char *trans, integer *m, integer *n, integer *k, double *a, integer *lda,
                      double *tau, double *c__, integer *ldc, double *work, integer *lwork, integer *info) {
	/* Table of constant values */
	static integer c__1 = 1;
	static integer c_n1 = -1;
	static integer c__2 = 2;

	/* System generated locals */
	const char *a__1[2];
	integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2];
	char ch__1[2];

	/* Local variables */
	static integer left;
	static integer iinfo, i1, i2, nb, mi, ni, nq, nw;
	static integer notran;
	static integer applyq;
	static char transt[1];
	static integer lwkopt;
	static integer lquery;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--tau;
	c_dim1 = *ldc;
	c_offset = 1 + c_dim1 * 1;
	c__ -= c_offset;
	--work;

	/* Function Body */
	*info = 0;
	applyq = lsame_ (vect, "Q");
	left = lsame_ (side, "L");
	notran = lsame_ (trans, "N");
	lquery = *lwork == -1;

	/* NQ is the order of Q or P and NW is the minimum dimension of WORK */

	if (left) {
		nq = *m;
		nw = *n;
	} else {
		nq = *n;
		nw = *m;
	}
	if (!applyq && !lsame_ (vect, "P")) {
		*info = -1;
	} else if (!left && !lsame_ (side, "R")) {
		*info = -2;
	} else if (!notran && !lsame_ (trans, "T")) {
		*info = -3;
	} else if (*m < 0) {
		*info = -4;
	} else if (*n < 0) {
		*info = -5;
	} else if (*k < 0) {
		*info = -6;
	} else {					/* if(complicated condition) */
		/* Computing MAX */
		i__1 = 1, i__2 = MIN (nq, *k);
		if (applyq && *lda < MAX (1, nq) || !applyq && *lda < MAX (i__1, i__2)) {
			*info = -8;
		} else if (*ldc < MAX (1, *m)) {
			*info = -11;
		} else if (*lwork < MAX (1, nw) && !lquery) {
			*info = -13;
		}
	}

	if (*info == 0) {
		if (applyq) {
			if (left) {
				/* Writing concatenation */
				i__3[0] = 1, a__1[0] = side;
				i__3[1] = 1, a__1[1] = trans;
				s_cat (ch__1, a__1, i__3, &c__2, 2);
				i__1 = *m - 1;
				i__2 = *m - 1;
				nb = NUMlapack_ilaenv (&c__1, "DORMQR", ch__1, &i__1, n, &i__2, &c_n1, 6, 2);
			} else {
				/* Writing concatenation */
				i__3[0] = 1, a__1[0] = side;
				i__3[1] = 1, a__1[1] = trans;
				s_cat (ch__1, a__1, i__3, &c__2, 2);
				i__1 = *n - 1;
				i__2 = *n - 1;
				nb = NUMlapack_ilaenv (&c__1, "DORMQR", ch__1, m, &i__1, &i__2, &c_n1, 6, 2);
			}
		} else {
			if (left) {
				/* Writing concatenation */
				i__3[0] = 1, a__1[0] = side;
				i__3[1] = 1, a__1[1] = trans;
				s_cat (ch__1, a__1, i__3, &c__2, 2);
				i__1 = *m - 1;
				i__2 = *m - 1;
				nb = NUMlapack_ilaenv (&c__1, "DORMLQ", ch__1, &i__1, n, &i__2, &c_n1, 6, 2);
			} else {
				/* Writing concatenation */
				i__3[0] = 1, a__1[0] = side;
				i__3[1] = 1, a__1[1] = trans;
				s_cat (ch__1, a__1, i__3, &c__2, 2);
				i__1 = *n - 1;
				i__2 = *n - 1;
				nb = NUMlapack_ilaenv (&c__1, "DORMLQ", ch__1, m, &i__1, &i__2, &c_n1, 6, 2);
			}
		}
		lwkopt = MAX (1, nw) * nb;
		work[1] = (double) lwkopt;
	}

	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DORMBR", &i__1);
		return 0;
	} else if (lquery) {
		return 0;
	}

	/* Quick return if possible */

	work[1] = 1.;
	if (*m == 0 || *n == 0) {
		return 0;
	}

	if (applyq) {

		/* Apply Q */

		if (nq >= *k) {

			/* Q was determined by a call to DGEBRD with nq >= k */

			NUMlapack_dormqr (side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[c_offset], ldc, &work[1],
			                  lwork, &iinfo);
		} else if (nq > 1) {

			/* Q was determined by a call to DGEBRD with nq < k */

			if (left) {
				mi = *m - 1;
				ni = *n;
				i1 = 2;
				i2 = 1;
			} else {
				mi = *m;
				ni = *n - 1;
				i1 = 1;
				i2 = 2;
			}
			i__1 = nq - 1;
			NUMlapack_dormqr (side, trans, &mi, &ni, &i__1, &a_ref (2, 1), lda, &tau[1], &c___ref (i1, i2), ldc,
			                  &work[1], lwork, &iinfo);
		}
	} else {

		/* Apply P */

		if (notran) {
			* (unsigned char *) transt = 'T';
		} else {
			* (unsigned char *) transt = 'N';
		}
		if (nq > *k) {

			/* P was determined by a call to DGEBRD with nq > k */

			NUMlapack_dormlq (side, transt, m, n, k, &a[a_offset], lda, &tau[1], &c__[c_offset], ldc, &work[1],
			                  lwork, &iinfo);
		} else if (nq > 1) {

			/* P was determined by a call to DGEBRD with nq <= k */

			if (left) {
				mi = *m - 1;
				ni = *n;
				i1 = 2;
				i2 = 1;
			} else {
				mi = *m;
				ni = *n - 1;
				i1 = 1;
				i2 = 2;
			}
			i__1 = nq - 1;
			NUMlapack_dormlq (side, transt, &mi, &ni, &i__1, &a_ref (1, 2), lda, &tau[1], &c___ref (i1, i2),
			                  ldc, &work[1], lwork, &iinfo);
		}
	}
	work[1] = (double) lwkopt;
	return 0;
}								/* NUMlapack_dormbr */

int NUMlapack_dorml2 (const char *side, const char *trans, integer *m, integer *n, integer *k, double *a, integer *lda, double *tau,
                      double *c__, integer *ldc, double *work, integer *info) {
	/* System generated locals */
	integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2;

	/* Local variables */
	static integer left;
	static integer i__;
	static integer i1, i2, i3, ic, jc, mi, ni, nq;
	static integer notran;
	static double aii;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--tau;
	c_dim1 = *ldc;
	c_offset = 1 + c_dim1 * 1;
	c__ -= c_offset;
	--work;

	/* Function Body */
	*info = 0;
	left = lsame_ (side, "L");
	notran = lsame_ (trans, "N");

	/* NQ is the order of Q */

	if (left) {
		nq = *m;
	} else {
		nq = *n;
	}
	if (!left && !lsame_ (side, "R")) {
		*info = -1;
	} else if (!notran && !lsame_ (trans, "T")) {
		*info = -2;
	} else if (*m < 0) {
		*info = -3;
	} else if (*n < 0) {
		*info = -4;
	} else if (*k < 0 || *k > nq) {
		*info = -5;
	} else if (*lda < MAX (1, *k)) {
		*info = -7;
	} else if (*ldc < MAX (1, *m)) {
		*info = -10;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DORML2", &i__1);
		return 0;
	}

	/* Quick return if possible */

	if (*m == 0 || *n == 0 || *k == 0) {
		return 0;
	}

	if (left && notran || !left && !notran) {
		i1 = 1;
		i2 = *k;
		i3 = 1;
	} else {
		i1 = *k;
		i2 = 1;
		i3 = -1;
	}

	if (left) {
		ni = *n;
		jc = 1;
	} else {
		mi = *m;
		ic = 1;
	}

	i__1 = i2;
	i__2 = i3;
	for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
		if (left) {

			/* H(i) is applied to C(i:m,1:n) */

			mi = *m - i__ + 1;
			ic = i__;
		} else {

			/* H(i) is applied to C(1:m,i:n) */

			ni = *n - i__ + 1;
			jc = i__;
		}

		/* Apply H(i) */

		aii = a_ref (i__, i__);
		a_ref (i__, i__) = 1.;
		NUMlapack_dlarf (side, &mi, &ni, &a_ref (i__, i__), lda, &tau[i__], &c___ref (ic, jc), ldc, &work[1]);
		a_ref (i__, i__) = aii;
		/* L10: */
	}
	return 0;

}								/* NUMlapack_dorml2 */

int NUMlapack_dormlq (const char *side, const char *trans, integer *m, integer *n, integer *k, double *a, integer *lda, double *tau,
                      double *c__, integer *ldc, double *work, integer *lwork, integer *info) {
	/* Table of constant values */
	static integer c__1 = 1;
	static integer c_n1 = -1;
	static integer c__2 = 2;
	static integer c__65 = 65;

	/* System generated locals */
	char *a__1[2];
	integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4, i__5;
	char ch__1[2];

	/* Local variables */
	static integer left;
	static integer i__;
	static double t[4160] /* was [65][64] */ ;
	static integer nbmin, iinfo, i1, i2, i3;
	static integer ib, ic, jc, nb, mi, ni;
	static integer nq, nw;
	static integer notran;
	static integer ldwork;
	static char transt[1];
	static integer lwkopt;
	static integer lquery;
	static integer iws;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--tau;
	c_dim1 = *ldc;
	c_offset = 1 + c_dim1 * 1;
	c__ -= c_offset;
	--work;

	/* Function Body */
	*info = 0;
	left = lsame_ (side, "L");
	notran = lsame_ (trans, "N");
	lquery = *lwork == -1;

	/* NQ is the order of Q and NW is the minimum dimension of WORK */

	if (left) {
		nq = *m;
		nw = *n;
	} else {
		nq = *n;
		nw = *m;
	}
	if (!left && !lsame_ (side, "R")) {
		*info = -1;
	} else if (!notran && !lsame_ (trans, "T")) {
		*info = -2;
	} else if (*m < 0) {
		*info = -3;
	} else if (*n < 0) {
		*info = -4;
	} else if (*k < 0 || *k > nq) {
		*info = -5;
	} else if (*lda < MAX (1, *k)) {
		*info = -7;
	} else if (*ldc < MAX (1, *m)) {
		*info = -10;
	} else if (*lwork < MAX (1, nw) && !lquery) {
		*info = -12;
	}

	if (*info == 0) {

		/* Determine the block size.  NB may be at most NBMAX, where NBMAX is
		   used to define the local array T.

		   Computing MIN Writing concatenation */
		i__3[0] = 1, a__1[0] = (char *) side;
		i__3[1] = 1, a__1[1] = (char *) trans;
		s_cat (ch__1, (const char **) a__1, i__3, &c__2, 2);
		i__1 = 64, i__2 = NUMlapack_ilaenv (&c__1, "DORMLQ", ch__1, m, n, k, &c_n1, 6, 2);
		nb = MIN (i__1, i__2);
		lwkopt = MAX (1, nw) * nb;
		work[1] = (double) lwkopt;
	}

	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DORMLQ", &i__1);
		return 0;
	} else if (lquery) {
		return 0;
	}

	/* Quick return if possible */

	if (*m == 0 || *n == 0 || *k == 0) {
		work[1] = 1.;
		return 0;
	}

	nbmin = 2;
	ldwork = nw;
	if (nb > 1 && nb < *k) {
		iws = nw * nb;
		if (*lwork < iws) {
			nb = *lwork / ldwork;
			/* Computing MAX Writing concatenation */
			i__3[0] = 1, a__1[0] = (char *) side;
			i__3[1] = 1, a__1[1] = (char *) trans;
			s_cat (ch__1, (const char **) a__1, i__3, &c__2, 2);
			i__1 = 2, i__2 = NUMlapack_ilaenv (&c__2, "DORMLQ", ch__1, m, n, k, &c_n1, 6, 2);
			nbmin = MAX (i__1, i__2);
		}
	} else {
		iws = nw;
	}

	if (nb < nbmin || nb >= *k) {

		/* Use unblocked code */

		NUMlapack_dorml2 (side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[c_offset], ldc, &work[1],
		                  &iinfo);
	} else {

		/* Use blocked code */

		if (left && notran || !left && !notran) {
			i1 = 1;
			i2 = *k;
			i3 = nb;
		} else {
			i1 = (*k - 1) / nb * nb + 1;
			i2 = 1;
			i3 = -nb;
		}

		if (left) {
			ni = *n;
			jc = 1;
		} else {
			mi = *m;
			ic = 1;
		}

		if (notran) {
			* (unsigned char *) transt = 'T';
		} else {
			* (unsigned char *) transt = 'N';
		}

		i__1 = i2;
		i__2 = i3;
		for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
			/* Computing MIN */
			i__4 = nb, i__5 = *k - i__ + 1;
			ib = MIN (i__4, i__5);

			/* Form the triangular factor of the block reflector H = H(i)
			   H(i+1) . . . H(i+ib-1) */

			i__4 = nq - i__ + 1;
			NUMlapack_dlarft ("Forward", "Rowwise", &i__4, &ib, &a_ref (i__, i__), lda, &tau[i__], t, &c__65);
			if (left) {

				/* H or H' is applied to C(i:m,1:n) */

				mi = *m - i__ + 1;
				ic = i__;
			} else {

				/* H or H' is applied to C(1:m,i:n) */

				ni = *n - i__ + 1;
				jc = i__;
			}

			/* Apply H or H' */

			NUMlapack_dlarfb (side, transt, "Forward", "Rowwise", &mi, &ni, &ib, &a_ref (i__, i__), lda, t,
			                  &c__65, &c___ref (ic, jc), ldc, &work[1], &ldwork);
			/* L10: */
		}
	}
	work[1] = (double) lwkopt;
	return 0;
}								/* NUMlapack_dormlq */

int NUMlapack_dormqr (const char *side, const char *trans, integer *m, integer *n, integer *k, double *a, integer *lda, double *tau,
                      double *c__, integer *ldc, double *work, integer *lwork, integer *info) {
	/* Table of constant values */
	static integer c__1 = 1;
	static integer c_n1 = -1;
	static integer c__2 = 2;
	static integer c__65 = 65;

	/* System generated locals */
	char *a__1[2];
	integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4, i__5;
	char ch__1[2];

	/* Local variables */
	static integer left;
	static integer i__;
	static double t[4160] /* was [65][64] */ ;
	static integer nbmin, iinfo, i1, i2, i3;
	static integer ib, ic, jc, nb, mi, ni;
	static integer nq, nw;
	static integer notran;
	static integer ldwork, lwkopt;
	static integer lquery;
	static integer iws;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--tau;
	c_dim1 = *ldc;
	c_offset = 1 + c_dim1 * 1;
	c__ -= c_offset;
	--work;

	/* Function Body */
	*info = 0;
	left = lsame_ (side, "L");
	notran = lsame_ (trans, "N");
	lquery = *lwork == -1;

	/* NQ is the order of Q and NW is the minimum dimension of WORK */

	if (left) {
		nq = *m;
		nw = *n;
	} else {
		nq = *n;
		nw = *m;
	}
	if (!left && !lsame_ (side, "R")) {
		*info = -1;
	} else if (!notran && !lsame_ (trans, "T")) {
		*info = -2;
	} else if (*m < 0) {
		*info = -3;
	} else if (*n < 0) {
		*info = -4;
	} else if (*k < 0 || *k > nq) {
		*info = -5;
	} else if (*lda < MAX (1, nq)) {
		*info = -7;
	} else if (*ldc < MAX (1, *m)) {
		*info = -10;
	} else if (*lwork < MAX (1, nw) && !lquery) {
		*info = -12;
	}

	if (*info == 0) {

		/* Determine the block size.  NB may be at most NBMAX, where NBMAX is
		   used to define the local array T.

		   Computing MIN Writing concatenation */
		i__3[0] = 1, a__1[0] = (char *) side;
		i__3[1] = 1, a__1[1] = (char *) trans;
		s_cat (ch__1, (const char **) a__1, i__3, &c__2, 2);
		i__1 = 64, i__2 = NUMlapack_ilaenv (&c__1, "DORMQR", ch__1, m, n, k, &c_n1, 6, 2);
		nb = MIN (i__1, i__2);
		lwkopt = MAX (1, nw) * nb;
		work[1] = (double) lwkopt;
	}

	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DORMQR", &i__1);
		return 0;
	} else if (lquery) {
		return 0;
	}

	/* Quick return if possible */

	if (*m == 0 || *n == 0 || *k == 0) {
		work[1] = 1.;
		return 0;
	}

	nbmin = 2;
	ldwork = nw;
	if (nb > 1 && nb < *k) {
		iws = nw * nb;
		if (*lwork < iws) {
			nb = *lwork / ldwork;
			/* Computing MAX Writing concatenation */
			i__3[0] = 1, a__1[0] = (char *) side;
			i__3[1] = 1, a__1[1] = (char *) trans;
			s_cat (ch__1, (const char **) a__1, i__3, &c__2, 2);
			i__1 = 2, i__2 = NUMlapack_ilaenv (&c__2, "DORMQR", ch__1, m, n, k, &c_n1, 6, 2);
			nbmin = MAX (i__1, i__2);
		}
	} else {
		iws = nw;
	}

	if (nb < nbmin || nb >= *k) {

		/* Use unblocked code */

		NUMlapack_dorm2r (side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[c_offset], ldc, &work[1],
		                  &iinfo);
	} else {

		/* Use blocked code */

		if (left && !notran || !left && notran) {
			i1 = 1;
			i2 = *k;
			i3 = nb;
		} else {
			i1 = (*k - 1) / nb * nb + 1;
			i2 = 1;
			i3 = -nb;
		}

		if (left) {
			ni = *n;
			jc = 1;
		} else {
			mi = *m;
			ic = 1;
		}

		i__1 = i2;
		i__2 = i3;
		for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
			/* Computing MIN */
			i__4 = nb, i__5 = *k - i__ + 1;
			ib = MIN (i__4, i__5);

			/* Form the triangular factor of the block reflector H = H(i)
			   H(i+1) . . . H(i+ib-1) */

			i__4 = nq - i__ + 1;
			NUMlapack_dlarft ("Forward", "Columnwise", &i__4, &ib, &a_ref (i__, i__), lda, &tau[i__], t,
			                  &c__65);
			if (left) {

				/* H or H' is applied to C(i:m,1:n) */

				mi = *m - i__ + 1;
				ic = i__;
			} else {

				/* H or H' is applied to C(1:m,i:n) */

				ni = *n - i__ + 1;
				jc = i__;
			}

			/* Apply H or H' */

			NUMlapack_dlarfb (side, trans, "Forward", "Columnwise", &mi, &ni, &ib, &a_ref (i__, i__), lda, t,
			                  &c__65, &c___ref (ic, jc), ldc, &work[1], &ldwork);
			/* L10: */
		}
	}
	work[1] = (double) lwkopt;
	return 0;
}								/* NUMlapack_dormqr */

int NUMlapack_dormr2 (const char *side, const char *trans, integer *m, integer *n, integer *k, double *a, integer *lda, double *tau,
                      double *c__, integer *ldc, double *work, integer *info) {
	/* System generated locals */
	integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2;

	/* Local variables */
	static integer left;
	static integer i__;
	static integer i1, i2, i3, mi, ni, nq;
	static integer notran;
	static double aii;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--tau;
	c_dim1 = *ldc;
	c_offset = 1 + c_dim1 * 1;
	c__ -= c_offset;
	--work;

	/* Function Body */
	*info = 0;
	left = lsame_ (side, "L");
	notran = lsame_ (trans, "N");

	/* NQ is the order of Q */

	if (left) {
		nq = *m;
	} else {
		nq = *n;
	}
	if (!left && !lsame_ (side, "R")) {
		*info = -1;
	} else if (!notran && !lsame_ (trans, "T")) {
		*info = -2;
	} else if (*m < 0) {
		*info = -3;
	} else if (*n < 0) {
		*info = -4;
	} else if (*k < 0 || *k > nq) {
		*info = -5;
	} else if (*lda < MAX (1, *k)) {
		*info = -7;
	} else if (*ldc < MAX (1, *m)) {
		*info = -10;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DORMR2", &i__1);
		return 0;
	}

	/* Quick return if possible */

	if (*m == 0 || *n == 0 || *k == 0) {
		return 0;
	}

	if (left && !notran || !left && notran) {
		i1 = 1;
		i2 = *k;
		i3 = 1;
	} else {
		i1 = *k;
		i2 = 1;
		i3 = -1;
	}

	if (left) {
		ni = *n;
	} else {
		mi = *m;
	}

	i__1 = i2;
	i__2 = i3;
	for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
		if (left) {

			/* H(i) is applied to C(1:m-k+i,1:n) */

			mi = *m - *k + i__;
		} else {

			/* H(i) is applied to C(1:m,1:n-k+i) */

			ni = *n - *k + i__;
		}

		/* Apply H(i) */

		aii = a_ref (i__, nq - *k + i__);
		a_ref (i__, nq - *k + i__) = 1.;
		NUMlapack_dlarf (side, &mi, &ni, &a_ref (i__, 1), lda, &tau[i__], &c__[c_offset], ldc, &work[1]);
		a_ref (i__, nq - *k + i__) = aii;
		/* L10: */
	}
	return 0;
}								/* NUMlapack_dormr2 */

int NUMlapack_dpotf2 (const char *uplo, integer *n, double *a, integer *lda, integer *info) {
	/* Table of constant values */
	static double c_b10 = -1.;
	static double c_b12 = 1.;

	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2, i__3;
	double d__1;

	/* Local variables */
	static integer j;
	static int upper;
	static double ajj;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;

	/* Function Body */
	*info = 0;
	upper = lsame_ (uplo, "U");
	if (!upper && !lsame_ (uplo, "L")) {
		*info = -1;
	} else if (*n < 0) {
		*info = -2;
	} else if (*lda < MAX (1, *n)) {
		*info = -4;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DPOTF2", &i__1);
		return 0;
	}

	/* Quick return if possible */

	if (*n == 0) {
		return 0;
	}

	if (upper) {

		/* Compute the Cholesky factorization A = U'*U. */

		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {

			/* Compute U(J,J) and test for non-positive-definiteness. */

			i__2 = j - 1;
			ajj = a_ref (j, j) - NUMblas_ddot (&i__2, &a_ref (1, j), &c__1, &a_ref (1, j), &c__1);
			if (ajj <= 0.) {
				a_ref (j, j) = ajj;
				goto L30;
			}
			ajj = sqrt (ajj);
			a_ref (j, j) = ajj;

			/* Compute elements J+1:N of row J. */

			if (j < *n) {
				i__2 = j - 1;
				i__3 = *n - j;
				NUMblas_dgemv ("Transpose", &i__2, &i__3, &c_b10, &a_ref (1, j + 1), lda, &a_ref (1, j),
				               &c__1, &c_b12, &a_ref (j, j + 1), lda);
				i__2 = *n - j;
				d__1 = 1. / ajj;
				NUMblas_dscal (&i__2, &d__1, &a_ref (j, j + 1), lda);
			}
			/* L10: */
		}
	} else {

		/* Compute the Cholesky factorization A = L*L'. */

		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {

			/* Compute L(J,J) and test for non-positive-definiteness. */

			i__2 = j - 1;
			ajj = a_ref (j, j) - NUMblas_ddot (&i__2, &a_ref (j, 1), lda, &a_ref (j, 1), lda);
			if (ajj <= 0.) {
				a_ref (j, j) = ajj;
				goto L30;
			}
			ajj = sqrt (ajj);
			a_ref (j, j) = ajj;

			/* Compute elements J+1:N of column J. */

			if (j < *n) {
				i__2 = *n - j;
				i__3 = j - 1;
				NUMblas_dgemv ("No transpose", &i__2, &i__3, &c_b10, &a_ref (j + 1, 1), lda, &a_ref (j, 1),
				               lda, &c_b12, &a_ref (j + 1, j), &c__1);
				i__2 = *n - j;
				d__1 = 1. / ajj;
				NUMblas_dscal (&i__2, &d__1, &a_ref (j + 1, j), &c__1);
			}
			/* L20: */
		}
	}
	goto L40;

L30:
	*info = j;

L40:
	return 0;
}				/* NUMlapack_dpotf2_ */

int NUMlapack_drscl (integer *n, double *sa, double *sx, integer *incx) {
	static double cden;
	static integer done;
	static double cnum, cden1, cnum1;
	static double bignum, smlnum, mul;

	--sx;

	/* Function Body */
	if (*n <= 0) {
		return 0;
	}

	/* Get machine parameters */

	smlnum = NUMblas_dlamch ("S");
	bignum = 1. / smlnum;
	NUMlapack_dlabad (&smlnum, &bignum);

	/* Initialize the denominator to SA and the numerator to 1. */

	cden = *sa;
	cnum = 1.;

L10:
	cden1 = cden * smlnum;
	cnum1 = cnum / bignum;
	if (fabs (cden1) > fabs (cnum) && cnum != 0.) {

		/* Pre-multiply X by SMLNUM if CDEN is large compared to CNUM. */

		mul = smlnum;
		done = FALSE;
		cden = cden1;
	} else if (fabs (cnum1) > fabs (cden)) {

		/* Pre-multiply X by BIGNUM if CDEN is small compared to CNUM. */

		mul = bignum;
		done = FALSE;
		cnum = cnum1;
	} else {

		/* Multiply X by CNUM / CDEN and return. */

		mul = cnum / cden;
		done = TRUE;
	}

	/* Scale the vector X by MUL */

	NUMblas_dscal (n, &mul, &sx[1], incx);

	if (!done) {
		goto L10;
	}

	return 0;
}								/* NUMlapack_drscl */

#define z___ref(a_1,a_2) z__[(a_2)*z_dim1 + a_1]

int NUMlapack_dsteqr (const char *compz, integer *n, double *d__, double *e, double *z__, integer *ldz, double *work,
                      integer *info) {
	/* Table of constant values */
	static double c_b9 = 0.;
	static double c_b10 = 1.;
	static integer c__0 = 0;
	static integer c__1 = 1;
	static integer c__2 = 2;

	/* System generated locals */
	integer z_dim1, z_offset, i__1, i__2;
	double d__1, d__2;

	/* Local variables */
	static integer lend, jtot;
	static double b, c__, f, g;
	static integer i__, j, k, l, m;
	static double p, r__, s;
	static double anorm;
	static integer l1;
	static integer lendm1, lendp1;
	static integer ii;
	static integer mm, iscale;
	static double safmin;
	static double safmax;
	static integer lendsv;
	static double ssfmin;
	static integer nmaxit, icompz;
	static double ssfmax;
	static integer lm1, mm1, nm1;
	static double rt1, rt2, eps;
	static integer lsv;
	static double tst, eps2;

	--d__;
	--e;
	z_dim1 = *ldz;
	z_offset = 1 + z_dim1 * 1;
	z__ -= z_offset;
	--work;

	/* Function Body */
	*info = 0;

	if (lsame_ (compz, "N")) {
		icompz = 0;
	} else if (lsame_ (compz, "V")) {
		icompz = 1;
	} else if (lsame_ (compz, "I")) {
		icompz = 2;
	} else {
		icompz = -1;
	}
	if (icompz < 0) {
		*info = -1;
	} else if (*n < 0) {
		*info = -2;
	} else if (*ldz < 1 || icompz > 0 && *ldz < MAX (1, *n)) {
		*info = -6;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DSTEQR", &i__1);
		return 0;
	}

	/* Quick return if possible */

	if (*n == 0) {
		return 0;
	}

	if (*n == 1) {
		if (icompz == 2) {
			z___ref (1, 1) = 1.;
		}
		return 0;
	}

	/* Determine the unit roundoff and over/underflow thresholds. */

	eps = NUMblas_dlamch ("E");
	/* Computing 2nd power */
	d__1 = eps;
	eps2 = d__1 * d__1;
	safmin = NUMblas_dlamch ("S");
	safmax = 1. / safmin;
	ssfmax = sqrt (safmax) / 3.;
	ssfmin = sqrt (safmin) / eps2;

	/* Compute the eigenvalues and eigenvectors of the tridiagonal matrix. */

	if (icompz == 2) {
		NUMlapack_dlaset ("Full", n, n, &c_b9, &c_b10, &z__[z_offset], ldz);
	}

	nmaxit = *n * 30;
	jtot = 0;

	/* Determine where the matrix splits and choose QL or QR iteration for
	   each block, according to whether top or bottom diagonal element is
	   smaller. */

	l1 = 1;
	nm1 = *n - 1;

L10:
	if (l1 > *n) {
		goto L160;
	}
	if (l1 > 1) {
		e[l1 - 1] = 0.;
	}
	if (l1 <= nm1) {
		i__1 = nm1;
		for (m = l1; m <= i__1; ++m) {
			tst = (d__1 = e[m], fabs (d__1));
			if (tst == 0.) {
				goto L30;
			}
			if (tst <= sqrt ( (d__1 = d__[m], fabs (d__1))) * sqrt ( (d__2 = d__[m + 1], fabs (d__2))) * eps) {
				e[m] = 0.;
				goto L30;
			}
			/* L20: */
		}
	}
	m = *n;

L30:
	l = l1;
	lsv = l;
	lend = m;
	lendsv = lend;
	l1 = m + 1;
	if (lend == l) {
		goto L10;
	}

	/* Scale submatrix in rows and columns L to LEND */

	i__1 = lend - l + 1;
	anorm = NUMlapack_dlanst ("I", &i__1, &d__[l], &e[l]);
	iscale = 0;
	if (anorm == 0.) {
		goto L10;
	}
	if (anorm > ssfmax) {
		iscale = 1;
		i__1 = lend - l + 1;
		NUMlapack_dlascl ("G", &c__0, &c__0, &anorm, &ssfmax, &i__1, &c__1, &d__[l], n, info);
		i__1 = lend - l;
		NUMlapack_dlascl ("G", &c__0, &c__0, &anorm, &ssfmax, &i__1, &c__1, &e[l], n, info);
	} else if (anorm < ssfmin) {
		iscale = 2;
		i__1 = lend - l + 1;
		NUMlapack_dlascl ("G", &c__0, &c__0, &anorm, &ssfmin, &i__1, &c__1, &d__[l], n, info);
		i__1 = lend - l;
		NUMlapack_dlascl ("G", &c__0, &c__0, &anorm, &ssfmin, &i__1, &c__1, &e[l], n, info);
	}

	/* Choose between QL and QR iteration */

	if ( (d__1 = d__[lend], fabs (d__1)) < (d__2 = d__[l], fabs (d__2))) {
		lend = lsv;
		l = lendsv;
	}

	if (lend > l) {

		/* QL Iteration

		   Look for small subdiagonal element. */

L40:
		if (l != lend) {
			lendm1 = lend - 1;
			i__1 = lendm1;
			for (m = l; m <= i__1; ++m) {
				/* Computing 2nd power */
				d__2 = (d__1 = e[m], fabs (d__1));
				tst = d__2 * d__2;
				if (tst <= eps2 * (d__1 = d__[m], fabs (d__1)) * (d__2 = d__[m + 1], fabs (d__2)) + safmin) {
					goto L60;
				}
				/* L50: */
			}
		}

		m = lend;

L60:
		if (m < lend) {
			e[m] = 0.;
		}
		p = d__[l];
		if (m == l) {
			goto L80;
		}

		/* If remaining matrix is 2-by-2, use DLAE2 or SLAEV2 to compute its
		   eigensystem. */

		if (m == l + 1) {
			if (icompz > 0) {
				NUMlapack_dlaev2 (&d__[l], &e[l], &d__[l + 1], &rt1, &rt2, &c__, &s);
				work[l] = c__;
				work[*n - 1 + l] = s;
				NUMlapack_dlasr ("R", "V", "B", n, &c__2, &work[l], &work[*n - 1 + l], &z___ref (1, l), ldz);
			} else {
				NUMlapack_dlae2 (&d__[l], &e[l], &d__[l + 1], &rt1, &rt2);
			}
			d__[l] = rt1;
			d__[l + 1] = rt2;
			e[l] = 0.;
			l += 2;
			if (l <= lend) {
				goto L40;
			}
			goto L140;
		}

		if (jtot == nmaxit) {
			goto L140;
		}
		++jtot;

		/* Form shift. */

		g = (d__[l + 1] - p) / (e[l] * 2.);
		r__ = NUMlapack_dlapy2 (&g, &c_b10);
		g = d__[m] - p + e[l] / (g + d_sign (&r__, &g));

		s = 1.;
		c__ = 1.;
		p = 0.;

		/* Inner loop */

		mm1 = m - 1;
		i__1 = l;
		for (i__ = mm1; i__ >= i__1; --i__) {
			f = s * e[i__];
			b = c__ * e[i__];
			NUMlapack_dlartg (&g, &f, &c__, &s, &r__);
			if (i__ != m - 1) {
				e[i__ + 1] = r__;
			}
			g = d__[i__ + 1] - p;
			r__ = (d__[i__] - g) * s + c__ * 2. * b;
			p = s * r__;
			d__[i__ + 1] = g + p;
			g = c__ * r__ - b;

			/* If eigenvectors are desired, then save rotations. */

			if (icompz > 0) {
				work[i__] = c__;
				work[*n - 1 + i__] = -s;
			}

			/* L70: */
		}

		/* If eigenvectors are desired, then apply saved rotations. */

		if (icompz > 0) {
			mm = m - l + 1;
			NUMlapack_dlasr ("R", "V", "B", n, &mm, &work[l], &work[*n - 1 + l], &z___ref (1, l), ldz);
		}

		d__[l] -= p;
		e[l] = g;
		goto L40;

		/* Eigenvalue found. */

L80:
		d__[l] = p;

		++l;
		if (l <= lend) {
			goto L40;
		}
		goto L140;

	} else {

		/* QR Iteration

		   Look for small superdiagonal element. */

L90:
		if (l != lend) {
			lendp1 = lend + 1;
			i__1 = lendp1;
			for (m = l; m >= i__1; --m) {
				/* Computing 2nd power */
				d__2 = (d__1 = e[m - 1], fabs (d__1));
				tst = d__2 * d__2;
				if (tst <= eps2 * (d__1 = d__[m], fabs (d__1)) * (d__2 = d__[m - 1], fabs (d__2)) + safmin) {
					goto L110;
				}
				/* L100: */
			}
		}

		m = lend;

L110:
		if (m > lend) {
			e[m - 1] = 0.;
		}
		p = d__[l];
		if (m == l) {
			goto L130;
		}

		/* If remaining matrix is 2-by-2, use DLAE2 or SLAEV2 to compute its
		   eigensystem. */

		if (m == l - 1) {
			if (icompz > 0) {
				NUMlapack_dlaev2 (&d__[l - 1], &e[l - 1], &d__[l], &rt1, &rt2, &c__, &s);
				work[m] = c__;
				work[*n - 1 + m] = s;
				NUMlapack_dlasr ("R", "V", "F", n, &c__2, &work[m], &work[*n - 1 + m], &z___ref (1, l - 1),
				                 ldz);
			} else {
				NUMlapack_dlae2 (&d__[l - 1], &e[l - 1], &d__[l], &rt1, &rt2);
			}
			d__[l - 1] = rt1;
			d__[l] = rt2;
			e[l - 1] = 0.;
			l += -2;
			if (l >= lend) {
				goto L90;
			}
			goto L140;
		}

		if (jtot == nmaxit) {
			goto L140;
		}
		++jtot;

		/* Form shift. */

		g = (d__[l - 1] - p) / (e[l - 1] * 2.);
		r__ = NUMlapack_dlapy2 (&g, &c_b10);
		g = d__[m] - p + e[l - 1] / (g + d_sign (&r__, &g));

		s = 1.;
		c__ = 1.;
		p = 0.;

		/* Inner loop */

		lm1 = l - 1;
		i__1 = lm1;
		for (i__ = m; i__ <= i__1; ++i__) {
			f = s * e[i__];
			b = c__ * e[i__];
			NUMlapack_dlartg (&g, &f, &c__, &s, &r__);
			if (i__ != m) {
				e[i__ - 1] = r__;
			}
			g = d__[i__] - p;
			r__ = (d__[i__ + 1] - g) * s + c__ * 2. * b;
			p = s * r__;
			d__[i__] = g + p;
			g = c__ * r__ - b;

			/* If eigenvectors are desired, then save rotations. */

			if (icompz > 0) {
				work[i__] = c__;
				work[*n - 1 + i__] = s;
			}

			/* L120: */
		}

		/* If eigenvectors are desired, then apply saved rotations. */

		if (icompz > 0) {
			mm = l - m + 1;
			NUMlapack_dlasr ("R", "V", "F", n, &mm, &work[m], &work[*n - 1 + m], &z___ref (1, m), ldz);
		}

		d__[l] -= p;
		e[lm1] = g;
		goto L90;

		/* Eigenvalue found. */

L130:
		d__[l] = p;

		--l;
		if (l >= lend) {
			goto L90;
		}
		goto L140;

	}

	/* Undo scaling if necessary */

L140:
	if (iscale == 1) {
		i__1 = lendsv - lsv + 1;
		NUMlapack_dlascl ("G", &c__0, &c__0, &ssfmax, &anorm, &i__1, &c__1, &d__[lsv], n, info);
		i__1 = lendsv - lsv;
		NUMlapack_dlascl ("G", &c__0, &c__0, &ssfmax, &anorm, &i__1, &c__1, &e[lsv], n, info);
	} else if (iscale == 2) {
		i__1 = lendsv - lsv + 1;
		NUMlapack_dlascl ("G", &c__0, &c__0, &ssfmin, &anorm, &i__1, &c__1, &d__[lsv], n, info);
		i__1 = lendsv - lsv;
		NUMlapack_dlascl ("G", &c__0, &c__0, &ssfmin, &anorm, &i__1, &c__1, &e[lsv], n, info);
	}

	/* Check for no convergence to an eigenvalue after a total of N*MAXIT
	   iterations. */

	if (jtot < nmaxit) {
		goto L10;
	}
	i__1 = *n - 1;
	for (i__ = 1; i__ <= i__1; ++i__) {
		if (e[i__] != 0.) {
			++ (*info);
		}
		/* L150: */
	}
	goto L190;

	/* Order eigenvalues and eigenvectors. */

L160:
	if (icompz == 0) {

		/* Use Quick Sort */

		NUMlapack_dlasrt ("I", n, &d__[1], info);

	} else {

		/* Use Selection Sort to minimize swaps of eigenvectors */

		i__1 = *n;
		for (ii = 2; ii <= i__1; ++ii) {
			i__ = ii - 1;
			k = i__;
			p = d__[i__];
			i__2 = *n;
			for (j = ii; j <= i__2; ++j) {
				if (d__[j] < p) {
					k = j;
					p = d__[j];
				}
				/* L170: */
			}
			if (k != i__) {
				d__[k] = d__[i__];
				d__[i__] = p;
				NUMblas_dswap (n, &z___ref (1, i__), &c__1, &z___ref (1, k), &c__1);
			}
			/* L180: */
		}
	}

L190:
	return 0;
}								/* NUMlapack_dsteqr */

#undef z___ref

int NUMlapack_dsterf (integer *n, double *d__, double *e, integer *info) {
	/* Table of constant values */
	static integer c__0 = 0;
	static integer c__1 = 1;
	static double c_b32 = 1.;

	/* System generated locals */
	integer i__1;
	double d__1, d__2, d__3;

	/* Local variables */
	static double oldc;
	static integer lend, jtot;
	static double c__;
	static integer i__, l, m;
	static double p, gamma, r__, s, alpha, sigma, anorm;
	static integer l1;
	static double bb;
	static integer iscale;
	static double oldgam, safmin;
	static double safmax;
	static integer lendsv;
	static double ssfmin;
	static integer nmaxit;
	static double ssfmax, rt1, rt2, eps, rte;
	static integer lsv;
	static double eps2;

	--e;
	--d__;

	/* Function Body */
	*info = 0;

	/* Quick return if possible */

	if (*n < 0) {
		*info = -1;
		i__1 = - (*info);
		xerbla_ ("DSTERF", &i__1);
		return 0;
	}
	if (*n <= 1) {
		return 0;
	}

	/* Determine the unit roundoff for this environment. */

	eps = NUMblas_dlamch ("E");
	/* Computing 2nd power */
	d__1 = eps;
	eps2 = d__1 * d__1;
	safmin = NUMblas_dlamch ("S");
	safmax = 1. / safmin;
	ssfmax = sqrt (safmax) / 3.;
	ssfmin = sqrt (safmin) / eps2;

	/* Compute the eigenvalues of the tridiagonal matrix. */

	nmaxit = *n * 30;
	sigma = 0.;
	jtot = 0;

	/* Determine where the matrix splits and choose QL or QR iteration for
	   each block, according to whether top or bottom diagonal element is
	   smaller. */

	l1 = 1;

L10:
	if (l1 > *n) {
		goto L170;
	}
	if (l1 > 1) {
		e[l1 - 1] = 0.;
	}
	i__1 = *n - 1;
	for (m = l1; m <= i__1; ++m) {
		if ( (d__3 = e[m], fabs (d__3)) <= sqrt ( (d__1 = d__[m], fabs (d__1))) * sqrt ( (d__2 =
		            d__[m + 1], fabs (d__2))) * eps) {
			e[m] = 0.;
			goto L30;
		}
		/* L20: */
	}
	m = *n;

L30:
	l = l1;
	lsv = l;
	lend = m;
	lendsv = lend;
	l1 = m + 1;
	if (lend == l) {
		goto L10;
	}

	/* Scale submatrix in rows and columns L to LEND */

	i__1 = lend - l + 1;
	anorm = NUMlapack_dlanst ("I", &i__1, &d__[l], &e[l]);
	iscale = 0;
	if (anorm > ssfmax) {
		iscale = 1;
		i__1 = lend - l + 1;
		NUMlapack_dlascl ("G", &c__0, &c__0, &anorm, &ssfmax, &i__1, &c__1, &d__[l], n, info);
		i__1 = lend - l;
		NUMlapack_dlascl ("G", &c__0, &c__0, &anorm, &ssfmax, &i__1, &c__1, &e[l], n, info);
	} else if (anorm < ssfmin) {
		iscale = 2;
		i__1 = lend - l + 1;
		NUMlapack_dlascl ("G", &c__0, &c__0, &anorm, &ssfmin, &i__1, &c__1, &d__[l], n, info);
		i__1 = lend - l;
		NUMlapack_dlascl ("G", &c__0, &c__0, &anorm, &ssfmin, &i__1, &c__1, &e[l], n, info);
	}

	i__1 = lend - 1;
	for (i__ = l; i__ <= i__1; ++i__) {
		/* Computing 2nd power */
		d__1 = e[i__];
		e[i__] = d__1 * d__1;
		/* L40: */
	}

	/* Choose between QL and QR iteration */

	if ( (d__1 = d__[lend], fabs (d__1)) < (d__2 = d__[l], fabs (d__2))) {
		lend = lsv;
		l = lendsv;
	}

	if (lend >= l) {

		/* QL Iteration

		   Look for small subdiagonal element. */

L50:
		if (l != lend) {
			i__1 = lend - 1;
			for (m = l; m <= i__1; ++m) {
				if ( (d__2 = e[m], fabs (d__2)) <= eps2 * (d__1 = d__[m] * d__[m + 1], fabs (d__1))) {
					goto L70;
				}
				/* L60: */
			}
		}
		m = lend;

L70:
		if (m < lend) {
			e[m] = 0.;
		}
		p = d__[l];
		if (m == l) {
			goto L90;
		}

		/* If remaining matrix is 2 by 2, use DLAE2 to compute its
		   eigenvalues. */

		if (m == l + 1) {
			rte = sqrt (e[l]);
			NUMlapack_dlae2 (&d__[l], &rte, &d__[l + 1], &rt1, &rt2);
			d__[l] = rt1;
			d__[l + 1] = rt2;
			e[l] = 0.;
			l += 2;
			if (l <= lend) {
				goto L50;
			}
			goto L150;
		}

		if (jtot == nmaxit) {
			goto L150;
		}
		++jtot;

		/* Form shift. */

		rte = sqrt (e[l]);
		sigma = (d__[l + 1] - p) / (rte * 2.);
		r__ = NUMlapack_dlapy2 (&sigma, &c_b32);
		sigma = p - rte / (sigma + d_sign (&r__, &sigma));

		c__ = 1.;
		s = 0.;
		gamma = d__[m] - sigma;
		p = gamma * gamma;

		/* Inner loop */

		i__1 = l;
		for (i__ = m - 1; i__ >= i__1; --i__) {
			bb = e[i__];
			r__ = p + bb;
			if (i__ != m - 1) {
				e[i__ + 1] = s * r__;
			}
			oldc = c__;
			c__ = p / r__;
			s = bb / r__;
			oldgam = gamma;
			alpha = d__[i__];
			gamma = c__ * (alpha - sigma) - s * oldgam;
			d__[i__ + 1] = oldgam + (alpha - gamma);
			if (c__ != 0.) {
				p = gamma * gamma / c__;
			} else {
				p = oldc * bb;
			}
			/* L80: */
		}

		e[l] = s * p;
		d__[l] = sigma + gamma;
		goto L50;

		/* Eigenvalue found. */

L90:
		d__[l] = p;

		++l;
		if (l <= lend) {
			goto L50;
		}
		goto L150;

	} else {

		/* QR Iteration

		   Look for small superdiagonal element. */

L100:
		i__1 = lend + 1;
		for (m = l; m >= i__1; --m) {
			if ( (d__2 = e[m - 1], fabs (d__2)) <= eps2 * (d__1 = d__[m] * d__[m - 1], fabs (d__1))) {
				goto L120;
			}
			/* L110: */
		}
		m = lend;

L120:
		if (m > lend) {
			e[m - 1] = 0.;
		}
		p = d__[l];
		if (m == l) {
			goto L140;
		}

		/* If remaining matrix is 2 by 2, use DLAE2 to compute its
		   eigenvalues. */

		if (m == l - 1) {
			rte = sqrt (e[l - 1]);
			NUMlapack_dlae2 (&d__[l], &rte, &d__[l - 1], &rt1, &rt2);
			d__[l] = rt1;
			d__[l - 1] = rt2;
			e[l - 1] = 0.;
			l += -2;
			if (l >= lend) {
				goto L100;
			}
			goto L150;
		}

		if (jtot == nmaxit) {
			goto L150;
		}
		++jtot;

		/* Form shift. */

		rte = sqrt (e[l - 1]);
		sigma = (d__[l - 1] - p) / (rte * 2.);
		r__ = NUMlapack_dlapy2 (&sigma, &c_b32);
		sigma = p - rte / (sigma + d_sign (&r__, &sigma));

		c__ = 1.;
		s = 0.;
		gamma = d__[m] - sigma;
		p = gamma * gamma;

		/* Inner loop */

		i__1 = l - 1;
		for (i__ = m; i__ <= i__1; ++i__) {
			bb = e[i__];
			r__ = p + bb;
			if (i__ != m) {
				e[i__ - 1] = s * r__;
			}
			oldc = c__;
			c__ = p / r__;
			s = bb / r__;
			oldgam = gamma;
			alpha = d__[i__ + 1];
			gamma = c__ * (alpha - sigma) - s * oldgam;
			d__[i__] = oldgam + (alpha - gamma);
			if (c__ != 0.) {
				p = gamma * gamma / c__;
			} else {
				p = oldc * bb;
			}
			/* L130: */
		}

		e[l - 1] = s * p;
		d__[l] = sigma + gamma;
		goto L100;

		/* Eigenvalue found. */

L140:
		d__[l] = p;

		--l;
		if (l >= lend) {
			goto L100;
		}
		goto L150;

	}

	/* Undo scaling if necessary */

L150:
	if (iscale == 1) {
		i__1 = lendsv - lsv + 1;
		NUMlapack_dlascl ("G", &c__0, &c__0, &ssfmax, &anorm, &i__1, &c__1, &d__[lsv], n, info);
	}
	if (iscale == 2) {
		i__1 = lendsv - lsv + 1;
		NUMlapack_dlascl ("G", &c__0, &c__0, &ssfmin, &anorm, &i__1, &c__1, &d__[lsv], n, info);
	}

	/* Check for no convergence to an eigenvalue after a total of N*MAXIT
	   iterations. */

	if (jtot < nmaxit) {
		goto L10;
	}
	i__1 = *n - 1;
	for (i__ = 1; i__ <= i__1; ++i__) {
		if (e[i__] != 0.) {
			++ (*info);
		}
		/* L160: */
	}
	goto L180;

	/* Sort eigenvalues in increasing order. */

L170:
	NUMlapack_dlasrt ("I", n, &d__[1], info);

L180:
	return 0;
}								/* NUMlapack_dsterf */

int NUMlapack_dsyev (const char *jobz, const char *uplo, integer *n, double *a, integer *lda, double *w, double *work,
                     integer *lwork, integer *info) {
	/* Table of constant values */
	static integer c__1 = 1;
	static integer c_n1 = -1;
	static integer c__0 = 0;
	static double c_b17 = 1.;

	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2;
	double d__1;

	/* Local variables */
	static integer inde;
	static double anrm;
	static integer imax;
	static double rmin, rmax;
	static integer lopt;
	static double sigma;
	static integer iinfo;
	static integer lower, wantz;
	static integer nb;
	static integer iscale;
	static double safmin;
	static double bignum;
	static integer indtau;
	static integer indwrk;
	static integer llwork;
	static double smlnum;
	static integer lwkopt;
	static integer lquery;
	static double eps;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--w;
	--work;

	/* Function Body */
	wantz = lsame_ (jobz, "V");
	lower = lsame_ (uplo, "L");
	lquery = *lwork == -1;

	*info = 0;
	if (! (wantz || lsame_ (jobz, "N"))) {
		*info = -1;
	} else if (! (lower || lsame_ (uplo, "U"))) {
		*info = -2;
	} else if (*n < 0) {
		*info = -3;
	} else if (*lda < MAX (1, *n)) {
		*info = -5;
	} else {					/* if(complicated condition) */
		/* Computing MAX */
		i__1 = 1, i__2 = *n * 3 - 1;
		if (*lwork < MAX (i__1, i__2) && !lquery) {
			*info = -8;
		}
	}

	if (*info == 0) {
		nb = NUMlapack_ilaenv (&c__1, "DSYTRD", uplo, n, &c_n1, &c_n1, &c_n1, 6, 1);
		/* Computing MAX */
		i__1 = 1, i__2 = (nb + 2) * *n;
		lwkopt = MAX (i__1, i__2);
		work[1] = (double) lwkopt;
	}

	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DSYEV ", &i__1);
		return 0;
	} else if (lquery) {
		return 0;
	}

	/* Quick return if possible */

	if (*n == 0) {
		work[1] = 1.;
		return 0;
	}

	if (*n == 1) {
		w[1] = a_ref (1, 1);
		work[1] = 3.;
		if (wantz) {
			a_ref (1, 1) = 1.;
		}
		return 0;
	}

	/* Get machine constants. */

	safmin = NUMblas_dlamch ("Safe minimum");
	eps = NUMblas_dlamch ("Precision");
	smlnum = safmin / eps;
	bignum = 1. / smlnum;
	rmin = sqrt (smlnum);
	rmax = sqrt (bignum);

	/* Scale matrix to allowable range, if necessary. */

	anrm = NUMlapack_dlansy ("M", uplo, n, &a[a_offset], lda, &work[1]);
	iscale = 0;
	if (anrm > 0. && anrm < rmin) {
		iscale = 1;
		sigma = rmin / anrm;
	} else if (anrm > rmax) {
		iscale = 1;
		sigma = rmax / anrm;
	}
	if (iscale == 1) {
		NUMlapack_dlascl (uplo, &c__0, &c__0, &c_b17, &sigma, n, n, &a[a_offset], lda, info);
	}

	/* Call DSYTRD to reduce symmetric matrix to tridiagonal form. */

	inde = 1;
	indtau = inde + *n;
	indwrk = indtau + *n;
	llwork = *lwork - indwrk + 1;
	NUMlapack_dsytrd (uplo, n, &a[a_offset], lda, &w[1], &work[inde], &work[indtau], &work[indwrk], &llwork,
	                  &iinfo);
	lopt = (integer) ( (*n << 1) + work[indwrk]);

	/* For eigenvalues only, call DSTERF.  For eigenvectors, first call
	   DORGTR to generate the orthogonal matrix, then call DSTEQR. */

	if (!wantz) {
		NUMlapack_dsterf (n, &w[1], &work[inde], info);
	} else {
		NUMlapack_dorgtr (uplo, n, &a[a_offset], lda, &work[indtau], &work[indwrk], &llwork, &iinfo);
		NUMlapack_dsteqr (jobz, n, &w[1], &work[inde], &a[a_offset], lda, &work[indtau], info);
	}

	/* If matrix was scaled, then rescale eigenvalues appropriately. */

	if (iscale == 1) {
		if (*info == 0) {
			imax = *n;
		} else {
			imax = *info - 1;
		}
		d__1 = 1. / sigma;
		NUMblas_dscal (&imax, &d__1, &w[1], &c__1);
	}

	/* Set WORK(1) to optimal workspace size. */

	work[1] = (double) lwkopt;

	return 0;
}								/* NUMlapack_dsyev */

int NUMlapack_dsytd2 (const char *uplo, integer *n, double *a, integer *lda, double *d__, double *e, double *tau,
                      integer *info) {
	/* Table of constant values */
	static integer c__1 = 1;
	static double c_b8 = 0.;
	static double c_b14 = -1.;

	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2, i__3;

	/* Local variables */
	static double taui;
	static integer i__;
	static double alpha;
	static integer upper;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--d__;
	--e;
	--tau;

	/* Function Body */
	*info = 0;
	upper = lsame_ (uplo, "U");
	if (!upper && !lsame_ (uplo, "L")) {
		*info = -1;
	} else if (*n < 0) {
		*info = -2;
	} else if (*lda < MAX (1, *n)) {
		*info = -4;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DSYTD2", &i__1);
		return 0;
	}

	/* Quick return if possible */

	if (*n <= 0) {
		return 0;
	}

	if (upper) {

		/* Reduce the upper triangle of A */

		for (i__ = *n - 1; i__ >= 1; --i__) {

			/* Generate elementary reflector H(i) = I - tau * v * v' to
			   annihilate A(1:i-1,i+1) */

			NUMlapack_dlarfg (&i__, &a_ref (i__, i__ + 1), &a_ref (1, i__ + 1), &c__1, &taui);
			e[i__] = a_ref (i__, i__ + 1);

			if (taui != 0.) {

				/* Apply H(i) from both sides to A(1:i,1:i) */

				a_ref (i__, i__ + 1) = 1.;

				/* Compute x := tau * A * v storing x in TAU(1:i) */

				NUMblas_dsymv (uplo, &i__, &taui, &a[a_offset], lda, &a_ref (1, i__ + 1), &c__1, &c_b8, &tau[1],
				               &c__1);

				/* Compute w := x - 1/2 * tau * (x'*v) * v */

				alpha = taui * -.5 * NUMblas_ddot (&i__, &tau[1], &c__1, &a_ref (1, i__ + 1), &c__1);
				NUMblas_daxpy (&i__, &alpha, &a_ref (1, i__ + 1), &c__1, &tau[1], &c__1);

				/* Apply the transformation as a rank-2 update: A := A - v *
				   w' - w * v' */

				NUMblas_dsyr2 (uplo, &i__, &c_b14, &a_ref (1, i__ + 1), &c__1, &tau[1], &c__1, &a[a_offset], lda);

				a_ref (i__, i__ + 1) = e[i__];
			}
			d__[i__ + 1] = a_ref (i__ + 1, i__ + 1);
			tau[i__] = taui;
			/* L10: */
		}
		d__[1] = a_ref (1, 1);
	} else {

		/* Reduce the lower triangle of A */

		i__1 = *n - 1;
		for (i__ = 1; i__ <= i__1; ++i__) {

			/* Generate elementary reflector H(i) = I - tau * v * v' to
			   annihilate A(i+2:n,i)

			   Computing MIN */
			i__2 = i__ + 2;
			i__3 = *n - i__;
			NUMlapack_dlarfg (&i__3, &a_ref (i__ + 1, i__), &a_ref (MIN (i__2, *n), i__), &c__1, &taui);
			e[i__] = a_ref (i__ + 1, i__);

			if (taui != 0.) {

				/* Apply H(i) from both sides to A(i+1:n,i+1:n) */

				a_ref (i__ + 1, i__) = 1.;

				/* Compute x := tau * A * v storing y in TAU(i:n-1) */

				i__2 = *n - i__;
				NUMblas_dsymv (uplo, &i__2, &taui, &a_ref (i__ + 1, i__ + 1), lda, &a_ref (i__ + 1, i__), &c__1,
				               &c_b8, &tau[i__], &c__1);

				/* Compute w := x - 1/2 * tau * (x'*v) * v */

				i__2 = *n - i__;
				alpha = taui * -.5 * NUMblas_ddot (&i__2, &tau[i__], &c__1, &a_ref (i__ + 1, i__), &c__1);
				i__2 = *n - i__;
				NUMblas_daxpy (&i__2, &alpha, &a_ref (i__ + 1, i__), &c__1, &tau[i__], &c__1);

				/* Apply the transformation as a rank-2 update: A := A - v *
				   w' - w * v' */

				i__2 = *n - i__;
				NUMblas_dsyr2 (uplo, &i__2, &c_b14, &a_ref (i__ + 1, i__), &c__1, &tau[i__], &c__1, &a_ref (i__ + 1,
				               i__ + 1), lda);

				a_ref (i__ + 1, i__) = e[i__];
			}
			d__[i__] = a_ref (i__, i__);
			tau[i__] = taui;
			/* L20: */
		}
		d__[*n] = a_ref (*n, *n);
	}

	return 0;
}								/* NUMlapack_dsytd2 */

int NUMlapack_dsytrd (const char *uplo, integer *n, double *a, integer *lda, double *d__, double *e, double *tau,
                      double *work, integer *lwork, integer *info) {
	/* Table of constant values */
	static integer c__1 = 1;
	static integer c_n1 = -1;
	static integer c__3 = 3;
	static integer c__2 = 2;
	static double c_b22 = -1.;
	static double c_b23 = 1.;

	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2, i__3;

	/* Local variables */
	static integer i__, j;
	static integer nbmin, iinfo;
	static integer upper;
	static integer nb, kk, nx;
	static integer ldwork, lwkopt;
	static integer lquery;
	static integer iws;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	--d__;
	--e;
	--tau;
	--work;

	/* Function Body */
	*info = 0;
	upper = lsame_ (uplo, "U");
	lquery = *lwork == -1;
	if (!upper && !lsame_ (uplo, "L")) {
		*info = -1;
	} else if (*n < 0) {
		*info = -2;
	} else if (*lda < MAX (1, *n)) {
		*info = -4;
	} else if (*lwork < 1 && !lquery) {
		*info = -9;
	}

	if (*info == 0) {

		/* Determine the block size. */

		nb = NUMlapack_ilaenv (&c__1, "DSYTRD", uplo, n, &c_n1, &c_n1, &c_n1, 6, 1);
		lwkopt = *n * nb;
		work[1] = (double) lwkopt;
	}

	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DSYTRD", &i__1);
		return 0;
	} else if (lquery) {
		return 0;
	}

	/* Quick return if possible */

	if (*n == 0) {
		work[1] = 1.;
		return 0;
	}

	nx = *n;
	iws = 1;
	if (nb > 1 && nb < *n) {

		/* Determine when to cross over from blocked to unblocked code (last
		   block is always handled by unblocked code).

		   Computing MAX */
		i__1 = nb, i__2 = NUMlapack_ilaenv (&c__3, "DSYTRD", uplo, n, &c_n1, &c_n1, &c_n1, 6, 1);
		nx = MAX (i__1, i__2);
		if (nx < *n) {

			/* Determine if workspace is large enough for blocked code. */

			ldwork = *n;
			iws = ldwork * nb;
			if (*lwork < iws) {

				/* Not enough workspace to use optimal NB: determine the
				   minimum value of NB, and reduce NB or force use of
				   unblocked code by setting NX = N.

				   Computing MAX */
				i__1 = *lwork / ldwork;
				nb = MAX (i__1, 1);
				nbmin = NUMlapack_ilaenv (&c__2, "DSYTRD", uplo, n, &c_n1, &c_n1, &c_n1, 6, 1);
				if (nb < nbmin) {
					nx = *n;
				}
			}
		} else {
			nx = *n;
		}
	} else {
		nb = 1;
	}

	if (upper) {

		/* Reduce the upper triangle of A. Columns 1:kk are handled by the
		   unblocked method. */

		kk = *n - (*n - nx + nb - 1) / nb * nb;
		i__1 = kk + 1;
		i__2 = -nb;
		for (i__ = *n - nb + 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {

			/* Reduce columns i:i+nb-1 to tridiagonal form and form the
			   matrix W which is needed to update the unreduced part of the
			   matrix */

			i__3 = i__ + nb - 1;
			NUMlapack_dlatrd (uplo, &i__3, &nb, &a[a_offset], lda, &e[1], &tau[1], &work[1], &ldwork);

			/* Update the unreduced submatrix A(1:i-1,1:i-1), using an update
			   of the form: A := A - V*W' - W*V' */

			i__3 = i__ - 1;
			NUMblas_dsyr2k (uplo, "No transpose", &i__3, &nb, &c_b22, &a_ref (1, i__), lda, &work[1], &ldwork,
			                &c_b23, &a[a_offset], lda);

			/* Copy superdiagonal elements back into A, and diagonal elements
			   into D */

			i__3 = i__ + nb - 1;
			for (j = i__; j <= i__3; ++j) {
				a_ref (j - 1, j) = e[j - 1];
				d__[j] = a_ref (j, j);
				/* L10: */
			}
			/* L20: */
		}

		/* Use unblocked code to reduce the last or only block */

		NUMlapack_dsytd2 (uplo, &kk, &a[a_offset], lda, &d__[1], &e[1], &tau[1], &iinfo);
	} else {

		/* Reduce the lower triangle of A */

		i__2 = *n - nx;
		i__1 = nb;
		for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__1) {

			/* Reduce columns i:i+nb-1 to tridiagonal form and form the
			   matrix W which is needed to update the unreduced part of the
			   matrix */

			i__3 = *n - i__ + 1;
			NUMlapack_dlatrd (uplo, &i__3, &nb, &a_ref (i__, i__), lda, &e[i__], &tau[i__], &work[1], &ldwork);

			/* Update the unreduced submatrix A(i+ib:n,i+ib:n), using an
			   update of the form: A := A - V*W' - W*V' */

			i__3 = *n - i__ - nb + 1;
			NUMblas_dsyr2k (uplo, "No transpose", &i__3, &nb, &c_b22, &a_ref (i__ + nb, i__), lda, &work[nb + 1],
			                &ldwork, &c_b23, &a_ref (i__ + nb, i__ + nb), lda);

			/* Copy subdiagonal elements back into A, and diagonal elements
			   into D */

			i__3 = i__ + nb - 1;
			for (j = i__; j <= i__3; ++j) {
				a_ref (j + 1, j) = e[j];
				d__[j] = a_ref (j, j);
				/* L30: */
			}
			/* L40: */
		}

		/* Use unblocked code to reduce the last or only block */

		i__1 = *n - i__ + 1;
		NUMlapack_dsytd2 (uplo, &i__1, &a_ref (i__, i__), lda, &d__[i__], &e[i__], &tau[i__], &iinfo);
	}

	work[1] = (double) lwkopt;
	return 0;
}								/* NUMlapack_dsytrd */

#define b_ref(a_1,a_2) b[(a_2)*b_dim1 + a_1]
#define q_ref(a_1,a_2) q[(a_2)*q_dim1 + a_1]
#define u_ref(a_1,a_2) u[(a_2)*u_dim1 + a_1]
#define v_ref(a_1,a_2) v[(a_2)*v_dim1 + a_1]

int NUMlapack_dtgsja (const char *jobu, const char *jobv, const char *jobq, integer *m, integer *p, integer *n, integer *k, integer *l,
                      double *a, integer *lda, double *b, integer *ldb, double *tola, double *tolb, double *alpha, double *beta,
                      double *u, integer *ldu, double *v, integer *ldv, double *q, integer *ldq, double *work, integer *ncycle, integer *info) {
	/* Table of constant values */
	static double c_b13 = 0.;
	static double c_b14 = 1.;
	static integer c__1 = 1;
	static double c_b43 = -1.;

	/* System generated locals */
	integer a_dim1, a_offset, b_dim1, b_offset, q_dim1, q_offset, u_dim1, u_offset, v_dim1, v_offset, i__1, i__2,
	     i__3, i__4;
	double d__1;

	/* Local variables */
	static integer i__, j;
	static double gamma;
	static double a1;
	static integer initq;
	static double a2, a3, b1;
	static integer initu, initv, wantq, upper;
	static double b2, b3;
	static integer wantu, wantv;
	static double error, ssmin;
	static integer kcycle;
	static double csq, csu, csv, snq, rwk, snu, snv;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;
	b_dim1 = *ldb;
	b_offset = 1 + b_dim1 * 1;
	b -= b_offset;
	--alpha;
	--beta;
	u_dim1 = *ldu;
	u_offset = 1 + u_dim1 * 1;
	u -= u_offset;
	v_dim1 = *ldv;
	v_offset = 1 + v_dim1 * 1;
	v -= v_offset;
	q_dim1 = *ldq;
	q_offset = 1 + q_dim1 * 1;
	q -= q_offset;
	--work;

	/* Function Body */
	initu = lsame_ (jobu, "I");
	wantu = initu || lsame_ (jobu, "U");

	initv = lsame_ (jobv, "I");
	wantv = initv || lsame_ (jobv, "V");

	initq = lsame_ (jobq, "I");
	wantq = initq || lsame_ (jobq, "Q");

	*info = 0;
	if (! (initu || wantu || lsame_ (jobu, "N"))) {
		*info = -1;
	} else if (! (initv || wantv || lsame_ (jobv, "N"))) {
		*info = -2;
	} else if (! (initq || wantq || lsame_ (jobq, "N"))) {
		*info = -3;
	} else if (*m < 0) {
		*info = -4;
	} else if (*p < 0) {
		*info = -5;
	} else if (*n < 0) {
		*info = -6;
	} else if (*lda < MAX (1, *m)) {
		*info = -10;
	} else if (*ldb < MAX (1, *p)) {
		*info = -12;
	} else if (*ldu < 1 || wantu && *ldu < *m) {
		*info = -18;
	} else if (*ldv < 1 || wantv && *ldv < *p) {
		*info = -20;
	} else if (*ldq < 1 || wantq && *ldq < *n) {
		*info = -22;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DTGSJA", &i__1);
		return 0;
	}

	/* Initialize U, V and Q, if necessary */

	if (initu) {
		NUMlapack_dlaset ("Full", m, m, &c_b13, &c_b14, &u[u_offset], ldu);
	}
	if (initv) {
		NUMlapack_dlaset ("Full", p, p, &c_b13, &c_b14, &v[v_offset], ldv);
	}
	if (initq) {
		NUMlapack_dlaset ("Full", n, n, &c_b13, &c_b14, &q[q_offset], ldq);
	}

	/* Loop until convergence */

	upper = FALSE;
	for (kcycle = 1; kcycle <= 40; ++kcycle) {

		upper = !upper;

		i__1 = *l - 1;
		for (i__ = 1; i__ <= i__1; ++i__) {
			i__2 = *l;
			for (j = i__ + 1; j <= i__2; ++j) {

				a1 = 0.;
				a2 = 0.;
				a3 = 0.;
				if (*k + i__ <= *m) {
					a1 = a_ref (*k + i__, *n - *l + i__);
				}
				if (*k + j <= *m) {
					a3 = a_ref (*k + j, *n - *l + j);
				}

				b1 = b_ref (i__, *n - *l + i__);
				b3 = b_ref (j, *n - *l + j);

				if (upper) {
					if (*k + i__ <= *m) {
						a2 = a_ref (*k + i__, *n - *l + j);
					}
					b2 = b_ref (i__, *n - *l + j);
				} else {
					if (*k + j <= *m) {
						a2 = a_ref (*k + j, *n - *l + i__);
					}
					b2 = b_ref (j, *n - *l + i__);
				}

				NUMlapack_dlags2 (&upper, &a1, &a2, &a3, &b1, &b2, &b3, &csu, &snu, &csv, &snv, &csq, &snq);

				/* Update (K+I)-th and (K+J)-th rows of matrix A: U'*A */

				if (*k + j <= *m) {
					NUMblas_drot (l, &a_ref (*k + j, *n - *l + 1), lda, &a_ref (*k + i__, *n - *l + 1), lda, &csu,
					              &snu);
				}

				/* Update I-th and J-th rows of matrix B: V'*B */

				NUMblas_drot (l, &b_ref (j, *n - *l + 1), ldb, &b_ref (i__, *n - *l + 1), ldb, &csv, &snv);

				/* Update (N-L+I)-th and (N-L+J)-th columns of matrices A and
				   B: A*Q and B*Q

				   Computing MIN */
				i__4 = *k + *l;
				i__3 = MIN (i__4, *m);
				NUMblas_drot (&i__3, &a_ref (1, *n - *l + j), &c__1, &a_ref (1, *n - *l + i__), &c__1, &csq, &snq);

				NUMblas_drot (l, &b_ref (1, *n - *l + j), &c__1, &b_ref (1, *n - *l + i__), &c__1, &csq, &snq);

				if (upper) {
					if (*k + i__ <= *m) {
						a_ref (*k + i__, *n - *l + j) = 0.;
					}
					b_ref (i__, *n - *l + j) = 0.;
				} else {
					if (*k + j <= *m) {
						a_ref (*k + j, *n - *l + i__) = 0.;
					}
					b_ref (j, *n - *l + i__) = 0.;
				}

				/* Update orthogonal matrices U, V, Q, if desired. */

				if (wantu && *k + j <= *m) {
					NUMblas_drot (m, &u_ref (1, *k + j), &c__1, &u_ref (1, *k + i__), &c__1, &csu, &snu);
				}

				if (wantv) {
					NUMblas_drot (p, &v_ref (1, j), &c__1, &v_ref (1, i__), &c__1, &csv, &snv);
				}

				if (wantq) {
					NUMblas_drot (n, &q_ref (1, *n - *l + j), &c__1, &q_ref (1, *n - *l + i__), &c__1, &csq, &snq);
				}

				/* L10: */
			}
			/* L20: */
		}

		if (!upper) {

			/* The matrices A13 and B13 were lower triangular at the start of
			   the cycle, and are now upper triangular.

			   Convergence test: test the parallelism of the corresponding
			   rows of A and B. */

			error = 0.;
			/* Computing MIN */
			i__2 = *l, i__3 = *m - *k;
			i__1 = MIN (i__2, i__3);
			for (i__ = 1; i__ <= i__1; ++i__) {
				i__2 = *l - i__ + 1;
				NUMblas_dcopy (&i__2, &a_ref (*k + i__, *n - *l + i__), lda, &work[1], &c__1);
				i__2 = *l - i__ + 1;
				NUMblas_dcopy (&i__2, &b_ref (i__, *n - *l + i__), ldb, &work[*l + 1], &c__1);
				i__2 = *l - i__ + 1;
				NUMlapack_dlapll (&i__2, &work[1], &c__1, &work[*l + 1], &c__1, &ssmin);
				error = MAX (error, ssmin);
				/* L30: */
			}

			if (fabs (error) <= MIN (*tola, *tolb)) {
				goto L50;
			}
		}

		/* End of cycle loop

		   L40: */
	}

	/* The algorithm has not converged after MAXIT cycles. */

	*info = 1;
	goto L100;

L50:

	/* If ERROR <= MIN(TOLA,TOLB), then the algorithm has converged. Compute
	   the generalized singular value pairs (ALPHA, BETA), and set the
	   triangular matrix R to array A. */

	i__1 = *k;
	for (i__ = 1; i__ <= i__1; ++i__) {
		alpha[i__] = 1.;
		beta[i__] = 0.;
		/* L60: */
	}

	/* Computing MIN */
	i__2 = *l, i__3 = *m - *k;
	i__1 = MIN (i__2, i__3);
	for (i__ = 1; i__ <= i__1; ++i__) {

		a1 = a_ref (*k + i__, *n - *l + i__);
		b1 = b_ref (i__, *n - *l + i__);

		if (a1 != 0.) {
			gamma = b1 / a1;

			/* change sign if necessary */

			if (gamma < 0.) {
				i__2 = *l - i__ + 1;
				NUMblas_dscal (&i__2, &c_b43, &b_ref (i__, *n - *l + i__), ldb);
				if (wantv) {
					NUMblas_dscal (p, &c_b43, &v_ref (1, i__), &c__1);
				}
			}

			d__1 = fabs (gamma);
			NUMlapack_dlartg (&d__1, &c_b14, &beta[*k + i__], &alpha[*k + i__], &rwk);

			if (alpha[*k + i__] >= beta[*k + i__]) {
				i__2 = *l - i__ + 1;
				d__1 = 1. / alpha[*k + i__];
				NUMblas_dscal (&i__2, &d__1, &a_ref (*k + i__, *n - *l + i__), lda);
			} else {
				i__2 = *l - i__ + 1;
				d__1 = 1. / beta[*k + i__];
				NUMblas_dscal (&i__2, &d__1, &b_ref (i__, *n - *l + i__), ldb);
				i__2 = *l - i__ + 1;
				NUMblas_dcopy (&i__2, &b_ref (i__, *n - *l + i__), ldb, &a_ref (*k + i__, *n - *l + i__), lda);
			}

		} else {

			alpha[*k + i__] = 0.;
			beta[*k + i__] = 1.;
			i__2 = *l - i__ + 1;
			NUMblas_dcopy (&i__2, &b_ref (i__, *n - *l + i__), ldb, &a_ref (*k + i__, *n - *l + i__), lda);

		}

		/* L70: */
	}

	/* Post-assignment */

	i__1 = *k + *l;
	for (i__ = *m + 1; i__ <= i__1; ++i__) {
		alpha[i__] = 0.;
		beta[i__] = 1.;
		/* L80: */
	}

	if (*k + *l < *n) {
		i__1 = *n;
		for (i__ = *k + *l + 1; i__ <= i__1; ++i__) {
			alpha[i__] = 0.;
			beta[i__] = 0.;
			/* L90: */
		}
	}

L100:
	*ncycle = kcycle;
	return 0;
}								/* NUMlapack_dtgsja */

#undef v_ref
#undef u_ref
#undef q_ref
#undef b_ref



int NUMlapack_dtrevc (const char *side, const char *howmny, int *select, integer *n, double *t, integer *ldt, double *vl,
                      integer *ldvl, double *vr, integer *ldvr, integer *mm, integer *m, double *work, integer *info) {
	/* Table of constant values */
	static int c_false = FALSE;
	static integer c__1 = 1;
	static double c_b22 = 1.;
	static double c_b25 = 0.;
	static integer c__2 = 2;
	static int c_true = TRUE;

	/* System generated locals */
	integer t_dim1, t_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1, i__2, i__3;
	double d__1, d__2, d__3, d__4, d__5, d__6;

	/* Local variables */
	static double beta, emax;
	static int pair;
	static int allv;
	static integer ierr;
	static double unfl, ovfl, smin;
	static int over;
	static double vmax;
	static integer jnxt, i__, j, k;
	static double scale, x[4] /* was [2][2] */ ;
	static double remax;
	static int leftv, bothv;
	static double vcrit;
	static int somev;
	static integer j1, j2, n2;
	static double xnorm;
	static integer ii, ki;
	static integer ip, is;
	static double wi;
	static double wr;
	static double bignum;
	static int rightv;
	static double smlnum, rec, ulp;

#define t_ref(a_1,a_2) t[(a_2)*t_dim1 + a_1]
#define x_ref(a_1,a_2) x[(a_2)*2 + a_1 - 3]
#define vl_ref(a_1,a_2) vl[(a_2)*vl_dim1 + a_1]
#define vr_ref(a_1,a_2) vr[(a_2)*vr_dim1 + a_1]

	--select;
	t_dim1 = *ldt;
	t_offset = 1 + t_dim1 * 1;
	t -= t_offset;
	vl_dim1 = *ldvl;
	vl_offset = 1 + vl_dim1 * 1;
	vl -= vl_offset;
	vr_dim1 = *ldvr;
	vr_offset = 1 + vr_dim1 * 1;
	vr -= vr_offset;
	--work;

	/* Function Body */
	bothv = lsame_ (side, "B");
	rightv = lsame_ (side, "R") || bothv;
	leftv = lsame_ (side, "L") || bothv;

	allv = lsame_ (howmny, "A");
	over = lsame_ (howmny, "B");
	somev = lsame_ (howmny, "S");

	*info = 0;
	if (!rightv && !leftv) {
		*info = -1;
	} else if (!allv && !over && !somev) {
		*info = -2;
	} else if (*n < 0) {
		*info = -4;
	} else if (*ldt < MAX (1, *n)) {
		*info = -6;
	} else if (*ldvl < 1 || leftv && *ldvl < *n) {
		*info = -8;
	} else if (*ldvr < 1 || rightv && *ldvr < *n) {
		*info = -10;
	} else {

		/* Set M to the number of columns required to store the selected
		   eigenvectors, standardize the array SELECT if necessary, and test
		   MM. */

		if (somev) {
			*m = 0;
			pair = FALSE;
			i__1 = *n;
			for (j = 1; j <= i__1; ++j) {
				if (pair) {
					pair = FALSE;
					select[j] = FALSE;
				} else {
					if (j < *n) {
						if (t_ref (j + 1, j) == 0.) {
							if (select[j]) {
								++ (*m);
							}
						} else {
							pair = TRUE;
							if (select[j] || select[j + 1]) {
								select[j] = TRUE;
								*m += 2;
							}
						}
					} else {
						if (select[*n]) {
							++ (*m);
						}
					}
				}
				/* L10: */
			}
		} else {
			*m = *n;
		}

		if (*mm < *m) {
			*info = -11;
		}
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("NUMlapack_dtrevc", &i__1);
		return 0;
	}

	/* Quick return if possible. */

	if (*n == 0) {
		return 0;
	}

	/* Set the constants to control overflow. */

	unfl = NUMblas_dlamch ("Safe minimum");
	ovfl = 1. / unfl;
	NUMlapack_dlabad (&unfl, &ovfl);
	ulp = NUMblas_dlamch ("Precision");
	smlnum = unfl * (*n / ulp);
	bignum = (1. - ulp) / smlnum;

	/* Compute 1-norm of each column of strictly upper triangular part of T
	   to control overflow in triangular solver. */

	work[1] = 0.;
	i__1 = *n;
	for (j = 2; j <= i__1; ++j) {
		work[j] = 0.;
		i__2 = j - 1;
		for (i__ = 1; i__ <= i__2; ++i__) {
			work[j] += (d__1 = t_ref (i__, j), fabs (d__1));
			/* L20: */
		}
		/* L30: */
	}

	/* Index IP is used to specify the real or complex eigenvalue: IP = 0,
	   real eigenvalue, 1, first of conjugate complex pair: (wr,wi) -1,
	   second of conjugate complex pair: (wr,wi) */

	n2 = *n << 1;

	if (rightv) {

		/* Compute right eigenvectors. */

		ip = 0;
		is = *m;
		for (ki = *n; ki >= 1; --ki) {

			if (ip == 1) {
				goto L130;
			}
			if (ki == 1) {
				goto L40;
			}
			if (t_ref (ki, ki - 1) == 0.) {
				goto L40;
			}
			ip = -1;

L40:
			if (somev) {
				if (ip == 0) {
					if (!select[ki]) {
						goto L130;
					}
				} else {
					if (!select[ki - 1]) {
						goto L130;
					}
				}
			}

			/* Compute the KI-th eigenvalue (WR,WI). */

			wr = t_ref (ki, ki);
			wi = 0.;
			if (ip != 0) {
				wi = sqrt ( (d__1 = t_ref (ki, ki - 1), fabs (d__1))) * sqrt ( (d__2 =
				            t_ref (ki - 1, ki), fabs (d__2)));
			}
			/* Computing MAX */
			d__1 = ulp * (fabs (wr) + fabs (wi));
			smin = MAX (d__1, smlnum);

			if (ip == 0) {

				/* Real right eigenvector */

				work[ki + *n] = 1.;

				/* Form right-hand side */

				i__1 = ki - 1;
				for (k = 1; k <= i__1; ++k) {
					work[k + *n] = -t_ref (k, ki);
					/* L50: */
				}

				/* Solve the upper quasi-triangular system: (T(1:KI-1,1:KI-1)
				   - WR)*X = SCALE*WORK. */

				jnxt = ki - 1;
				for (j = ki - 1; j >= 1; --j) {
					if (j > jnxt) {
						goto L60;
					}
					j1 = j;
					j2 = j;
					jnxt = j - 1;
					if (j > 1) {
						if (t_ref (j, j - 1) != 0.) {
							j1 = j - 1;
							jnxt = j - 2;
						}
					}

					if (j1 == j2) {

						/* 1-by-1 diagonal block */

						NUMlapack_dlaln2 (&c_false, &c__1, &c__1, &smin, &c_b22, &t_ref (j, j), ldt, &c_b22,
						                  &c_b22, &work[j + *n], n, &wr, &c_b25, x, &c__2, &scale, &xnorm, &ierr);

						/* Scale X(1,1) to avoid overflow when updating the
						   right-hand side. */

						if (xnorm > 1.) {
							if (work[j] > bignum / xnorm) {
								x_ref (1, 1) = x_ref (1, 1) / xnorm;
								scale /= xnorm;
							}
						}

						/* Scale if necessary */

						if (scale != 1.) {
							NUMblas_dscal (&ki, &scale, &work[*n + 1], &c__1);
						}
						work[j + *n] = x_ref (1, 1);

						/* Update right-hand side */

						i__1 = j - 1;
						d__1 = -x_ref (1, 1);
						NUMblas_daxpy (&i__1, &d__1, &t_ref (1, j), &c__1, &work[*n + 1], &c__1);

					} else {

						/* 2-by-2 diagonal block */

						NUMlapack_dlaln2 (&c_false, &c__2, &c__1, &smin, &c_b22, &t_ref (j - 1, j - 1), ldt,
						                  &c_b22, &c_b22, &work[j - 1 + *n], n, &wr, &c_b25, x, &c__2, &scale, &xnorm,
						                  &ierr);

						/* Scale X(1,1) and X(2,1) to avoid overflow when
						   updating the right-hand side. */

						if (xnorm > 1.) {
							/* Computing MAX */
							d__1 = work[j - 1], d__2 = work[j];
							beta = MAX (d__1, d__2);
							if (beta > bignum / xnorm) {
								x_ref (1, 1) = x_ref (1, 1) / xnorm;
								x_ref (2, 1) = x_ref (2, 1) / xnorm;
								scale /= xnorm;
							}
						}

						/* Scale if necessary */

						if (scale != 1.) {
							NUMblas_dscal (&ki, &scale, &work[*n + 1], &c__1);
						}
						work[j - 1 + *n] = x_ref (1, 1);
						work[j + *n] = x_ref (2, 1);

						/* Update right-hand side */

						i__1 = j - 2;
						d__1 = -x_ref (1, 1);
						NUMblas_daxpy (&i__1, &d__1, &t_ref (1, j - 1), &c__1, &work[*n + 1], &c__1);
						i__1 = j - 2;
						d__1 = -x_ref (2, 1);
						NUMblas_daxpy (&i__1, &d__1, &t_ref (1, j), &c__1, &work[*n + 1], &c__1);
					}
L60:
					;
				}

				/* Copy the vector x or Q*x to VR and normalize. */

				if (!over) {
					NUMblas_dcopy (&ki, &work[*n + 1], &c__1, &vr_ref (1, is), &c__1);

					ii = NUMblas_idamax (&ki, &vr_ref (1, is), &c__1);
					remax = 1. / (d__1 = vr_ref (ii, is), fabs (d__1));
					NUMblas_dscal (&ki, &remax, &vr_ref (1, is), &c__1);

					i__1 = *n;
					for (k = ki + 1; k <= i__1; ++k) {
						vr_ref (k, is) = 0.;
						/* L70: */
					}
				} else {
					if (ki > 1) {
						i__1 = ki - 1;
						NUMblas_dgemv ("N", n, &i__1, &c_b22, &vr[vr_offset], ldvr, &work[*n + 1], &c__1,
						               &work[ki + *n], &vr_ref (1, ki), &c__1);
					}

					ii = NUMblas_idamax (n, &vr_ref (1, ki), &c__1);
					remax = 1. / (d__1 = vr_ref (ii, ki), fabs (d__1));
					NUMblas_dscal (n, &remax, &vr_ref (1, ki), &c__1);
				}

			} else {

				/* Complex right eigenvector.

				   Initial solve [ (T(KI-1,KI-1) T(KI-1,KI) ) - (WR + I*
				   WI)]*X = 0. [ (T(KI,KI-1) T(KI,KI) ) ] */

				if ( (d__1 = t_ref (ki - 1, ki), fabs (d__1)) >= (d__2 = t_ref (ki, ki - 1), fabs (d__2))) {
					work[ki - 1 + *n] = 1.;
					work[ki + n2] = wi / t_ref (ki - 1, ki);
				} else {
					work[ki - 1 + *n] = -wi / t_ref (ki, ki - 1);
					work[ki + n2] = 1.;
				}
				work[ki + *n] = 0.;
				work[ki - 1 + n2] = 0.;

				/* Form right-hand side */

				i__1 = ki - 2;
				for (k = 1; k <= i__1; ++k) {
					work[k + *n] = -work[ki - 1 + *n] * t_ref (k, ki - 1);
					work[k + n2] = -work[ki + n2] * t_ref (k, ki);
					/* L80: */
				}

				/* Solve upper quasi-triangular system: (T(1:KI-2,1:KI-2) -
				   (WR+i*WI))*X = SCALE*(WORK+i*WORK2) */

				jnxt = ki - 2;
				for (j = ki - 2; j >= 1; --j) {
					if (j > jnxt) {
						goto L90;
					}
					j1 = j;
					j2 = j;
					jnxt = j - 1;
					if (j > 1) {
						if (t_ref (j, j - 1) != 0.) {
							j1 = j - 1;
							jnxt = j - 2;
						}
					}

					if (j1 == j2) {

						/* 1-by-1 diagonal block */

						NUMlapack_dlaln2 (&c_false, &c__1, &c__2, &smin, &c_b22, &t_ref (j, j), ldt, &c_b22,
						                  &c_b22, &work[j + *n], n, &wr, &wi, x, &c__2, &scale, &xnorm, &ierr);

						/* Scale X(1,1) and X(1,2) to avoid overflow when
						   updating the right-hand side. */

						if (xnorm > 1.) {
							if (work[j] > bignum / xnorm) {
								x_ref (1, 1) = x_ref (1, 1) / xnorm;
								x_ref (1, 2) = x_ref (1, 2) / xnorm;
								scale /= xnorm;
							}
						}

						/* Scale if necessary */

						if (scale != 1.) {
							NUMblas_dscal (&ki, &scale, &work[*n + 1], &c__1);
							NUMblas_dscal (&ki, &scale, &work[n2 + 1], &c__1);
						}
						work[j + *n] = x_ref (1, 1);
						work[j + n2] = x_ref (1, 2);

						/* Update the right-hand side */

						i__1 = j - 1;
						d__1 = -x_ref (1, 1);
						NUMblas_daxpy (&i__1, &d__1, &t_ref (1, j), &c__1, &work[*n + 1], &c__1);
						i__1 = j - 1;
						d__1 = -x_ref (1, 2);
						NUMblas_daxpy (&i__1, &d__1, &t_ref (1, j), &c__1, &work[n2 + 1], &c__1);

					} else {

						/* 2-by-2 diagonal block */

						NUMlapack_dlaln2 (&c_false, &c__2, &c__2, &smin, &c_b22, &t_ref (j - 1, j - 1), ldt,
						                  &c_b22, &c_b22, &work[j - 1 + *n], n, &wr, &wi, x, &c__2, &scale, &xnorm, &ierr);

						/* Scale X to avoid overflow when updating the
						   right-hand side. */

						if (xnorm > 1.) {
							/* Computing MAX */
							d__1 = work[j - 1], d__2 = work[j];
							beta = MAX (d__1, d__2);
							if (beta > bignum / xnorm) {
								rec = 1. / xnorm;
								x_ref (1, 1) = x_ref (1, 1) * rec;
								x_ref (1, 2) = x_ref (1, 2) * rec;
								x_ref (2, 1) = x_ref (2, 1) * rec;
								x_ref (2, 2) = x_ref (2, 2) * rec;
								scale *= rec;
							}
						}

						/* Scale if necessary */

						if (scale != 1.) {
							NUMblas_dscal (&ki, &scale, &work[*n + 1], &c__1);
							NUMblas_dscal (&ki, &scale, &work[n2 + 1], &c__1);
						}
						work[j - 1 + *n] = x_ref (1, 1);
						work[j + *n] = x_ref (2, 1);
						work[j - 1 + n2] = x_ref (1, 2);
						work[j + n2] = x_ref (2, 2);

						/* Update the right-hand side */

						i__1 = j - 2;
						d__1 = -x_ref (1, 1);
						NUMblas_daxpy (&i__1, &d__1, &t_ref (1, j - 1), &c__1, &work[*n + 1], &c__1);
						i__1 = j - 2;
						d__1 = -x_ref (2, 1);
						NUMblas_daxpy (&i__1, &d__1, &t_ref (1, j), &c__1, &work[*n + 1], &c__1);
						i__1 = j - 2;
						d__1 = -x_ref (1, 2);
						NUMblas_daxpy (&i__1, &d__1, &t_ref (1, j - 1), &c__1, &work[n2 + 1], &c__1);
						i__1 = j - 2;
						d__1 = -x_ref (2, 2);
						NUMblas_daxpy (&i__1, &d__1, &t_ref (1, j), &c__1, &work[n2 + 1], &c__1);
					}
L90:
					;
				}

				/* Copy the vector x or Q*x to VR and normalize. */

				if (!over) {
					NUMblas_dcopy (&ki, &work[*n + 1], &c__1, &vr_ref (1, is - 1), &c__1);
					NUMblas_dcopy (&ki, &work[n2 + 1], &c__1, &vr_ref (1, is), &c__1);

					emax = 0.;
					i__1 = ki;
					for (k = 1; k <= i__1; ++k) {
						/* Computing MAX */
						d__3 = emax, d__4 = (d__1 = vr_ref (k, is - 1), fabs (d__1)) + (d__2 =
						                        vr_ref (k, is), fabs (d__2));
						emax = MAX (d__3, d__4);
						/* L100: */
					}

					remax = 1. / emax;
					NUMblas_dscal (&ki, &remax, &vr_ref (1, is - 1), &c__1);
					NUMblas_dscal (&ki, &remax, &vr_ref (1, is), &c__1);

					i__1 = *n;
					for (k = ki + 1; k <= i__1; ++k) {
						vr_ref (k, is - 1) = 0.;
						vr_ref (k, is) = 0.;
						/* L110: */
					}

				} else {

					if (ki > 2) {
						i__1 = ki - 2;
						NUMblas_dgemv ("N", n, &i__1, &c_b22, &vr[vr_offset], ldvr, &work[*n + 1], &c__1,
						               &work[ki - 1 + *n], &vr_ref (1, ki - 1), &c__1);
						i__1 = ki - 2;
						NUMblas_dgemv ("N", n, &i__1, &c_b22, &vr[vr_offset], ldvr, &work[n2 + 1], &c__1,
						               &work[ki + n2], &vr_ref (1, ki), &c__1);
					} else {
						NUMblas_dscal (n, &work[ki - 1 + *n], &vr_ref (1, ki - 1), &c__1);
						NUMblas_dscal (n, &work[ki + n2], &vr_ref (1, ki), &c__1);
					}

					emax = 0.;
					i__1 = *n;
					for (k = 1; k <= i__1; ++k) {
						/* Computing MAX */
						d__3 = emax, d__4 = (d__1 = vr_ref (k, ki - 1), fabs (d__1)) + (d__2 =
						                        vr_ref (k, ki), fabs (d__2));
						emax = MAX (d__3, d__4);
						/* L120: */
					}
					remax = 1. / emax;
					NUMblas_dscal (n, &remax, &vr_ref (1, ki - 1), &c__1);
					NUMblas_dscal (n, &remax, &vr_ref (1, ki), &c__1);
				}
			}

			--is;
			if (ip != 0) {
				--is;
			}
L130:
			if (ip == 1) {
				ip = 0;
			}
			if (ip == -1) {
				ip = 1;
			}
			/* L140: */
		}
	}

	if (leftv) {

		/* Compute left eigenvectors. */

		ip = 0;
		is = 1;
		i__1 = *n;
		for (ki = 1; ki <= i__1; ++ki) {

			if (ip == -1) {
				goto L250;
			}
			if (ki == *n) {
				goto L150;
			}
			if (t_ref (ki + 1, ki) == 0.) {
				goto L150;
			}
			ip = 1;

L150:
			if (somev) {
				if (!select[ki]) {
					goto L250;
				}
			}

			/* Compute the KI-th eigenvalue (WR,WI). */

			wr = t_ref (ki, ki);
			wi = 0.;
			if (ip != 0) {
				wi = sqrt ( (d__1 = t_ref (ki, ki + 1), fabs (d__1))) * sqrt ( (d__2 =
				            t_ref (ki + 1, ki), fabs (d__2)));
			}
			/* Computing MAX */
			d__1 = ulp * (fabs (wr) + fabs (wi));
			smin = MAX (d__1, smlnum);

			if (ip == 0) {

				/* Real left eigenvector. */

				work[ki + *n] = 1.;

				/* Form right-hand side */

				i__2 = *n;
				for (k = ki + 1; k <= i__2; ++k) {
					work[k + *n] = -t_ref (ki, k);
					/* L160: */
				}

				/* Solve the quasi-triangular system: (T(KI+1:N,KI+1:N) -
				   WR)'*X = SCALE*WORK */

				vmax = 1.;
				vcrit = bignum;

				jnxt = ki + 1;
				i__2 = *n;
				for (j = ki + 1; j <= i__2; ++j) {
					if (j < jnxt) {
						goto L170;
					}
					j1 = j;
					j2 = j;
					jnxt = j + 1;
					if (j < *n) {
						if (t_ref (j + 1, j) != 0.) {
							j2 = j + 1;
							jnxt = j + 2;
						}
					}

					if (j1 == j2) {

						/* 1-by-1 diagonal block

						   Scale if necessary to avoid overflow when forming
						   the right-hand side. */

						if (work[j] > vcrit) {
							rec = 1. / vmax;
							i__3 = *n - ki + 1;
							NUMblas_dscal (&i__3, &rec, &work[ki + *n], &c__1);
							vmax = 1.;
							vcrit = bignum;
						}

						i__3 = j - ki - 1;
						work[j + *n] -=
						    NUMblas_ddot (&i__3, &t_ref (ki + 1, j), &c__1, &work[ki + 1 + *n], &c__1);

						/* Solve (T(J,J)-WR)'*X = WORK */

						NUMlapack_dlaln2 (&c_false, &c__1, &c__1, &smin, &c_b22, &t_ref (j, j), ldt, &c_b22,
						                  &c_b22, &work[j + *n], n, &wr, &c_b25, x, &c__2, &scale, &xnorm, &ierr);

						/* Scale if necessary */

						if (scale != 1.) {
							i__3 = *n - ki + 1;
							NUMblas_dscal (&i__3, &scale, &work[ki + *n], &c__1);
						}
						work[j + *n] = x_ref (1, 1);
						/* Computing MAX */
						d__2 = (d__1 = work[j + *n], fabs (d__1));
						vmax = MAX (d__2, vmax);
						vcrit = bignum / vmax;

					} else {

						/* 2-by-2 diagonal block

						   Scale if necessary to avoid overflow when forming
						   the right-hand side.

						   Computing MAX */
						d__1 = work[j], d__2 = work[j + 1];
						beta = MAX (d__1, d__2);
						if (beta > vcrit) {
							rec = 1. / vmax;
							i__3 = *n - ki + 1;
							NUMblas_dscal (&i__3, &rec, &work[ki + *n], &c__1);
							vmax = 1.;
							vcrit = bignum;
						}

						i__3 = j - ki - 1;
						work[j + *n] -=
						    NUMblas_ddot (&i__3, &t_ref (ki + 1, j), &c__1, &work[ki + 1 + *n], &c__1);

						i__3 = j - ki - 1;
						work[j + 1 + *n] -=
						    NUMblas_ddot (&i__3, &t_ref (ki + 1, j + 1), &c__1, &work[ki + 1 + *n], &c__1);

						/* Solve [T(J,J)-WR T(J,J+1) ]'* X = SCALE*( WORK1 )
						   [T(J+1,J) T(J+1,J+1)-WR] ( WORK2 ) */

						NUMlapack_dlaln2 (&c_true, &c__2, &c__1, &smin, &c_b22, &t_ref (j, j), ldt, &c_b22,
						                  &c_b22, &work[j + *n], n, &wr, &c_b25, x, &c__2, &scale, &xnorm, &ierr);

						/* Scale if necessary */

						if (scale != 1.) {
							i__3 = *n - ki + 1;
							NUMblas_dscal (&i__3, &scale, &work[ki + *n], &c__1);
						}
						work[j + *n] = x_ref (1, 1);
						work[j + 1 + *n] = x_ref (2, 1);

						/* Computing MAX */
						d__3 = (d__1 = work[j + *n], fabs (d__1)), d__4 = (d__2 =
						            work[j + 1 + *n], fabs (d__2)), d__3 = MAX (d__3, d__4);
						vmax = MAX (d__3, vmax);
						vcrit = bignum / vmax;

					}
L170:
					;
				}

				/* Copy the vector x or Q*x to VL and normalize. */

				if (!over) {
					i__2 = *n - ki + 1;
					NUMblas_dcopy (&i__2, &work[ki + *n], &c__1, &vl_ref (ki, is), &c__1);

					i__2 = *n - ki + 1;
					ii = NUMblas_idamax (&i__2, &vl_ref (ki, is), &c__1) + ki - 1;
					remax = 1. / (d__1 = vl_ref (ii, is), fabs (d__1));
					i__2 = *n - ki + 1;
					NUMblas_dscal (&i__2, &remax, &vl_ref (ki, is), &c__1);

					i__2 = ki - 1;
					for (k = 1; k <= i__2; ++k) {
						vl_ref (k, is) = 0.;
						/* L180: */
					}

				} else {

					if (ki < *n) {
						i__2 = *n - ki;
						NUMblas_dgemv ("N", n, &i__2, &c_b22, &vl_ref (1, ki + 1), ldvl, &work[ki + 1 + *n],
						               &c__1, &work[ki + *n], &vl_ref (1, ki), &c__1);
					}

					ii = NUMblas_idamax (n, &vl_ref (1, ki), &c__1);
					remax = 1. / (d__1 = vl_ref (ii, ki), fabs (d__1));
					NUMblas_dscal (n, &remax, &vl_ref (1, ki), &c__1);

				}

			} else {

				/* Complex left eigenvector.

				   Initial solve: ((T(KI,KI) T(KI,KI+1) )' - (WR - I* WI))*X
				   = 0. ((T(KI+1,KI) T(KI+1,KI+1)) ) */

				if ( (d__1 = t_ref (ki, ki + 1), fabs (d__1)) >= (d__2 = t_ref (ki + 1, ki), fabs (d__2))) {
					work[ki + *n] = wi / t_ref (ki, ki + 1);
					work[ki + 1 + n2] = 1.;
				} else {
					work[ki + *n] = 1.;
					work[ki + 1 + n2] = -wi / t_ref (ki + 1, ki);
				}
				work[ki + 1 + *n] = 0.;
				work[ki + n2] = 0.;

				/* Form right-hand side */

				i__2 = *n;
				for (k = ki + 2; k <= i__2; ++k) {
					work[k + *n] = -work[ki + *n] * t_ref (ki, k);
					work[k + n2] = -work[ki + 1 + n2] * t_ref (ki + 1, k);
					/* L190: */
				}

				/* Solve complex quasi-triangular system: ( T(KI+2,N:KI+2,N)
				   - (WR-i*WI) )*X = WORK1+i*WORK2 */

				vmax = 1.;
				vcrit = bignum;

				jnxt = ki + 2;
				i__2 = *n;
				for (j = ki + 2; j <= i__2; ++j) {
					if (j < jnxt) {
						goto L200;
					}
					j1 = j;
					j2 = j;
					jnxt = j + 1;
					if (j < *n) {
						if (t_ref (j + 1, j) != 0.) {
							j2 = j + 1;
							jnxt = j + 2;
						}
					}

					if (j1 == j2) {

						/* 1-by-1 diagonal block

						   Scale if necessary to avoid overflow when forming
						   the right-hand side elements. */

						if (work[j] > vcrit) {
							rec = 1. / vmax;
							i__3 = *n - ki + 1;
							NUMblas_dscal (&i__3, &rec, &work[ki + *n], &c__1);
							i__3 = *n - ki + 1;
							NUMblas_dscal (&i__3, &rec, &work[ki + n2], &c__1);
							vmax = 1.;
							vcrit = bignum;
						}

						i__3 = j - ki - 2;
						work[j + *n] -=
						    NUMblas_ddot (&i__3, &t_ref (ki + 2, j), &c__1, &work[ki + 2 + *n], &c__1);
						i__3 = j - ki - 2;
						work[j + n2] -=
						    NUMblas_ddot (&i__3, &t_ref (ki + 2, j), &c__1, &work[ki + 2 + n2], &c__1);

						/* Solve (T(J,J)-(WR-i*WI))*(X11+i*X12)= WK+I*WK2 */

						d__1 = -wi;
						NUMlapack_dlaln2 (&c_false, &c__1, &c__2, &smin, &c_b22, &t_ref (j, j), ldt, &c_b22,
						                  &c_b22, &work[j + *n], n, &wr, &d__1, x, &c__2, &scale, &xnorm, &ierr);

						/* Scale if necessary */

						if (scale != 1.) {
							i__3 = *n - ki + 1;
							NUMblas_dscal (&i__3, &scale, &work[ki + *n], &c__1);
							i__3 = *n - ki + 1;
							NUMblas_dscal (&i__3, &scale, &work[ki + n2], &c__1);
						}
						work[j + *n] = x_ref (1, 1);
						work[j + n2] = x_ref (1, 2);
						/* Computing MAX */
						d__3 = (d__1 = work[j + *n], fabs (d__1)), d__4 = (d__2 =
						            work[j + n2], fabs (d__2)), d__3 = MAX (d__3, d__4);
						vmax = MAX (d__3, vmax);
						vcrit = bignum / vmax;

					} else {

						/* 2-by-2 diagonal block

						   Scale if necessary to avoid overflow when forming
						   the right-hand side elements.

						   Computing MAX */
						d__1 = work[j], d__2 = work[j + 1];
						beta = MAX (d__1, d__2);
						if (beta > vcrit) {
							rec = 1. / vmax;
							i__3 = *n - ki + 1;
							NUMblas_dscal (&i__3, &rec, &work[ki + *n], &c__1);
							i__3 = *n - ki + 1;
							NUMblas_dscal (&i__3, &rec, &work[ki + n2], &c__1);
							vmax = 1.;
							vcrit = bignum;
						}

						i__3 = j - ki - 2;
						work[j + *n] -=
						    NUMblas_ddot (&i__3, &t_ref (ki + 2, j), &c__1, &work[ki + 2 + *n], &c__1);

						i__3 = j - ki - 2;
						work[j + n2] -=
						    NUMblas_ddot (&i__3, &t_ref (ki + 2, j), &c__1, &work[ki + 2 + n2], &c__1);

						i__3 = j - ki - 2;
						work[j + 1 + *n] -=
						    NUMblas_ddot (&i__3, &t_ref (ki + 2, j + 1), &c__1, &work[ki + 2 + *n], &c__1);

						i__3 = j - ki - 2;
						work[j + 1 + n2] -=
						    NUMblas_ddot (&i__3, &t_ref (ki + 2, j + 1), &c__1, &work[ki + 2 + n2], &c__1);

						/* Solve 2-by-2 complex linear equation ([T(j,j)
						   T(j,j+1) ]'-(wr-i*wi)*I)*X = SCALE*B ([T(j+1,j)
						   T(j+1,j+1)] ) */

						d__1 = -wi;
						NUMlapack_dlaln2 (&c_true, &c__2, &c__2, &smin, &c_b22, &t_ref (j, j), ldt, &c_b22,
						                  &c_b22, &work[j + *n], n, &wr, &d__1, x, &c__2, &scale, &xnorm, &ierr);

						/* Scale if necessary */

						if (scale != 1.) {
							i__3 = *n - ki + 1;
							NUMblas_dscal (&i__3, &scale, &work[ki + *n], &c__1);
							i__3 = *n - ki + 1;
							NUMblas_dscal (&i__3, &scale, &work[ki + n2], &c__1);
						}
						work[j + *n] = x_ref (1, 1);
						work[j + n2] = x_ref (1, 2);
						work[j + 1 + *n] = x_ref (2, 1);
						work[j + 1 + n2] = x_ref (2, 2);
						/* Computing MAX */
						d__5 = (d__1 = x_ref (1, 1), fabs (d__1)), d__6 = (d__2 =
						            x_ref (1, 2), fabs (d__2)), d__5 = MAX (d__5, d__6), d__6 = (d__3 =
						                        x_ref (2, 1), fabs (d__3)), d__5 = MAX (d__5, d__6), d__6 = (d__4 =
						                                    x_ref (2, 2), fabs (d__4)), d__5 = MAX (d__5, d__6);
						vmax = MAX (d__5, vmax);
						vcrit = bignum / vmax;

					}
L200:
					;
				}

				/* Copy the vector x or Q*x to VL and normalize.

				   L210: */
				if (!over) {
					i__2 = *n - ki + 1;
					NUMblas_dcopy (&i__2, &work[ki + *n], &c__1, &vl_ref (ki, is), &c__1);
					i__2 = *n - ki + 1;
					NUMblas_dcopy (&i__2, &work[ki + n2], &c__1, &vl_ref (ki, is + 1), &c__1);

					emax = 0.;
					i__2 = *n;
					for (k = ki; k <= i__2; ++k) {
						/* Computing MAX */
						d__3 = emax, d__4 = (d__1 = vl_ref (k, is), fabs (d__1)) + (d__2 =
						                        vl_ref (k, is + 1), fabs (d__2));
						emax = MAX (d__3, d__4);
						/* L220: */
					}
					remax = 1. / emax;
					i__2 = *n - ki + 1;
					NUMblas_dscal (&i__2, &remax, &vl_ref (ki, is), &c__1);
					i__2 = *n - ki + 1;
					NUMblas_dscal (&i__2, &remax, &vl_ref (ki, is + 1), &c__1);

					i__2 = ki - 1;
					for (k = 1; k <= i__2; ++k) {
						vl_ref (k, is) = 0.;
						vl_ref (k, is + 1) = 0.;
						/* L230: */
					}
				} else {
					if (ki < *n - 1) {
						i__2 = *n - ki - 1;
						NUMblas_dgemv ("N", n, &i__2, &c_b22, &vl_ref (1, ki + 2), ldvl, &work[ki + 2 + *n],
						               &c__1, &work[ki + *n], &vl_ref (1, ki), &c__1);
						i__2 = *n - ki - 1;
						NUMblas_dgemv ("N", n, &i__2, &c_b22, &vl_ref (1, ki + 2), ldvl, &work[ki + 2 + n2],
						               &c__1, &work[ki + 1 + n2], &vl_ref (1, ki + 1), &c__1);
					} else {
						NUMblas_dscal (n, &work[ki + *n], &vl_ref (1, ki), &c__1);
						NUMblas_dscal (n, &work[ki + 1 + n2], &vl_ref (1, ki + 1), &c__1);
					}

					emax = 0.;
					i__2 = *n;
					for (k = 1; k <= i__2; ++k) {
						/* Computing MAX */
						d__3 = emax, d__4 = (d__1 = vl_ref (k, ki), fabs (d__1)) + (d__2 =
						                        vl_ref (k, ki + 1), fabs (d__2));
						emax = MAX (d__3, d__4);
						/* L240: */
					}
					remax = 1. / emax;
					NUMblas_dscal (n, &remax, &vl_ref (1, ki), &c__1);
					NUMblas_dscal (n, &remax, &vl_ref (1, ki + 1), &c__1);
				}
			}

			++is;
			if (ip != 0) {
				++is;
			}
L250:
			if (ip == -1) {
				ip = 0;
			}
			if (ip == 1) {
				ip = -1;
			}

			/* L260: */
		}

	}

	return 0;
}								/* NUMlapack_dtrevc */

#undef vr_ref
#undef vl_ref
#undef x_ref
#undef t_ref

int NUMlapack_dtrti2 (const char *uplo, const char *diag, integer *n, double *a, integer *lda, integer *info) {
	/* Table of constant values */
	static integer c__1 = 1;

	/* System generated locals */
	integer a_dim1, a_offset, i__1, i__2;

	/* Local variables */
	static integer j;
	static integer upper;
	static integer nounit;
	static double ajj;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;

	/* Function Body */
	*info = 0;
	upper = lsame_ (uplo, "U");
	nounit = lsame_ (diag, "N");
	if (!upper && !lsame_ (uplo, "L")) {
		*info = -1;
	} else if (!nounit && !lsame_ (diag, "U")) {
		*info = -2;
	} else if (*n < 0) {
		*info = -3;
	} else if (*lda < MAX (1, *n)) {
		*info = -5;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DTRTI2", &i__1);
		return 0;
	}

	if (upper) {

		/* Compute inverse of upper triangular matrix. */

		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
			if (nounit) {
				a_ref (j, j) = 1. / a_ref (j, j);
				ajj = -a_ref (j, j);
			} else {
				ajj = -1.;
			}

			/* Compute elements 1:j-1 of j-th column. */

			i__2 = j - 1;
			NUMblas_dtrmv ("Upper", "No transpose", diag, &i__2, &a[a_offset], lda, &a_ref (1, j), &c__1);
			i__2 = j - 1;
			NUMblas_dscal (&i__2, &ajj, &a_ref (1, j), &c__1);
			/* L10: */
		}
	} else {

		/* Compute inverse of lower triangular matrix. */

		for (j = *n; j >= 1; --j) {
			if (nounit) {
				a_ref (j, j) = 1. / a_ref (j, j);
				ajj = -a_ref (j, j);
			} else {
				ajj = -1.;
			}
			if (j < *n) {

				/* Compute elements j+1:n of j-th column. */

				i__1 = *n - j;
				NUMblas_dtrmv ("Lower", "No transpose", diag, &i__1, &a_ref (j + 1, j + 1), lda, &a_ref (j + 1, j),
				               &c__1);
				i__1 = *n - j;
				NUMblas_dscal (&i__1, &ajj, &a_ref (j + 1, j), &c__1);
			}
			/* L20: */
		}
	}

	return 0;
}								/* NUMlapack_dtrti2 */

int NUMlapack_dtrtri (const char *uplo, const char *diag, integer *n, double *a, integer *lda, integer *info) {
	/* Table of constant values */
	static integer c__1 = 1;
	static integer c_n1 = -1;
	static integer c__2 = 2;
	static double c_b18 = 1.;
	static double c_b22 = -1.;

	/* System generated locals */
	char *a__1[2];
	integer a_dim1, a_offset, i__1, i__2[2], i__3, i__4, i__5;
	char ch__1[2];

	/* Local variables */
	static integer j;
	static integer upper;
	static integer jb, nb, nn;
	static integer nounit;

	a_dim1 = *lda;
	a_offset = 1 + a_dim1 * 1;
	a -= a_offset;

	/* Function Body */
	*info = 0;
	upper = lsame_ (uplo, "U");
	nounit = lsame_ (diag, "N");
	if (!upper && !lsame_ (uplo, "L")) {
		*info = -1;
	} else if (!nounit && !lsame_ (diag, "U")) {
		*info = -2;
	} else if (*n < 0) {
		*info = -3;
	} else if (*lda < MAX (1, *n)) {
		*info = -5;
	}
	if (*info != 0) {
		i__1 = - (*info);
		xerbla_ ("DTRTRI", &i__1);
		return 0;
	}

	/* Quick return if possible */

	if (*n == 0) {
		return 0;
	}

	/* Check for singularity if non-unit. */

	if (nounit) {
		i__1 = *n;
		for (*info = 1; *info <= i__1; ++ (*info)) {
			if (a_ref (*info, *info) == 0.) {
				return 0;
			}
			/* L10: */
		}
		*info = 0;
	}

	/* Determine the block size for this environment.

	   Writing concatenation */
	i__2[0] = 1, a__1[0] = (char *) uplo;
	i__2[1] = 1, a__1[1] = (char *) diag;
	s_cat (ch__1, (const char **) a__1, i__2, &c__2, 2);
	nb = NUMlapack_ilaenv (&c__1, "DTRTRI", ch__1, n, &c_n1, &c_n1, &c_n1, 6, 2);
	if (nb <= 1 || nb >= *n) {

		/* Use unblocked code */

		NUMlapack_dtrti2 (uplo, diag, n, &a[a_offset], lda, info);
	} else {

		/* Use blocked code */

		if (upper) {

			/* Compute inverse of upper triangular matrix */

			i__1 = *n;
			i__3 = nb;
			for (j = 1; i__3 < 0 ? j >= i__1 : j <= i__1; j += i__3) {
				/* Computing MIN */
				i__4 = nb, i__5 = *n - j + 1;
				jb = MIN (i__4, i__5);

				/* Compute rows 1:j-1 of current block column */

				i__4 = j - 1;
				NUMblas_dtrmm ("Left", "Upper", "No transpose", diag, &i__4, &jb, &c_b18, &a[a_offset], lda,
				               &a_ref (1, j), lda);
				i__4 = j - 1;
				NUMblas_dtrsm ("Right", "Upper", "No transpose", diag, &i__4, &jb, &c_b22, &a_ref (j, j), lda,
				               &a_ref (1, j), lda);

				/* Compute inverse of current diagonal block */

				NUMlapack_dtrti2 ("Upper", diag, &jb, &a_ref (j, j), lda, info);
				/* L20: */
			}
		} else {

			/* Compute inverse of lower triangular matrix */

			nn = (*n - 1) / nb * nb + 1;
			i__3 = -nb;
			for (j = nn; i__3 < 0 ? j >= 1 : j <= 1; j += i__3) {
				/* Computing MIN */
				i__1 = nb, i__4 = *n - j + 1;
				jb = MIN (i__1, i__4);
				if (j + jb <= *n) {

					/* Compute rows j+jb:n of current block column */

					i__1 = *n - j - jb + 1;
					NUMblas_dtrmm ("Left", "Lower", "No transpose", diag, &i__1, &jb, &c_b18, &a_ref (j + jb,
					               j + jb), lda, &a_ref (j + jb, j), lda);
					i__1 = *n - j - jb + 1;
					NUMblas_dtrsm ("Right", "Lower", "No transpose", diag, &i__1, &jb, &c_b22, &a_ref (j, j), lda,
					               &a_ref (j + jb, j), lda);
				}

				/* Compute inverse of current diagonal block */

				NUMlapack_dtrti2 ("Lower", diag, &jb, &a_ref (j, j), lda, info);
				/* L30: */
			}
		}
	}
	return 0;
}								/* NUMlapack_dtrtri */

integer NUMlapack_ieeeck (integer *ispec, float *zero, float *one) {
	/* System generated locals */
	integer ret_val;

	/* Local variables */
	static float neginf, posinf, negzro, newzro, nan1, nan2, nan3, nan4, nan5, nan6;

	ret_val = 1;

	posinf = *one / *zero;
	if (posinf <= *one) {
		ret_val = 0;
		return ret_val;
	}

	neginf = - (*one) / *zero;
	if (neginf >= *zero) {
		ret_val = 0;
		return ret_val;
	}

	negzro = *one / (neginf + *one);
	if (negzro != *zero) {
		ret_val = 0;
		return ret_val;
	}

	neginf = *one / negzro;
	if (neginf >= *zero) {
		ret_val = 0;
		return ret_val;
	}

	newzro = negzro + *zero;
	if (newzro != *zero) {
		ret_val = 0;
		return ret_val;
	}

	posinf = *one / newzro;
	if (posinf <= *one) {
		ret_val = 0;
		return ret_val;
	}

	neginf *= posinf;
	if (neginf >= *zero) {
		ret_val = 0;
		return ret_val;
	}

	posinf *= posinf;
	if (posinf <= *one) {
		ret_val = 0;
		return ret_val;
	}

	/* Return if we were only asked to check infinity arithmetic */

	if (*ispec == 0) {
		return ret_val;
	}

	nan1 = posinf + neginf;

	nan2 = posinf / neginf;

	nan3 = posinf / posinf;

	nan4 = posinf * *zero;

	nan5 = neginf * negzro;

	nan6 = nan5 * 0.f;

	if (nan1 == nan1) {
		ret_val = 0;
		return ret_val;
	}

	if (nan2 == nan2) {
		ret_val = 0;
		return ret_val;
	}

	if (nan3 == nan3) {
		ret_val = 0;
		return ret_val;
	}

	if (nan4 == nan4) {
		ret_val = 0;
		return ret_val;
	}

	if (nan5 == nan5) {
		ret_val = 0;
		return ret_val;
	}

	if (nan6 == nan6) {
		ret_val = 0;
		return ret_val;
	}

	return ret_val;
}								/* NUMlapack_ieeeck */

integer NUMlapack_ilaenv (integer *ispec, const char *name__, const char *opts, integer *n1, integer *n2, integer *n3, integer *n4,
                       integer name_len, integer opts_len) {
	/* Table of constant values */
	static integer c__0 = 0;
	static float c_b162 = 0.f;
	static float c_b163 = 1.f;
	static integer c__1 = 1;

	/* System generated locals */
	integer ret_val;

	/* Local variables */
	static integer i__;
	static integer cname, sname;
	static integer nbmin;
	static char c1[1], c2[2], c3[3], c4[2];
	static integer ic, nb;
	static integer iz, nx;
	static char subnam[6];

	(void) opts;
	(void) n3;
	(void) opts_len;
	switch (*ispec) {
		case 1:
			goto L100;
		case 2:
			goto L100;
		case 3:
			goto L100;
		case 4:
			goto L400;
		case 5:
			goto L500;
		case 6:
			goto L600;
		case 7:
			goto L700;
		case 8:
			goto L800;
		case 9:
			goto L900;
		case 10:
			goto L1000;
		case 11:
			goto L1100;
	}

	/* Invalid value for ISPEC */

	ret_val = -1;
	return ret_val;

L100:

	/* Convert NAME to upper case if the first character is lower case. */

	ret_val = 1;
	s_copy (subnam, (char *) name__, 6, name_len);
	ic = * (unsigned char *) subnam;
	iz = 'Z';
	if (iz == 90 || iz == 122) {

		/* ASCII character set */

		if (ic >= 97 && ic <= 122) {
			* (unsigned char *) subnam = (char) (ic - 32);
			for (i__ = 2; i__ <= 6; ++i__) {
				ic = * (unsigned char *) &subnam[i__ - 1];
				if (ic >= 97 && ic <= 122) {
					* (unsigned char *) &subnam[i__ - 1] = (char) (ic - 32);
				}
				/* L10: */
			}
		}

	} else if (iz == 233 || iz == 169) {

		/* EBCDIC character set */

		if (ic >= 129 && ic <= 137 || ic >= 145 && ic <= 153 || ic >= 162 && ic <= 169) {
			* (unsigned char *) subnam = (char) (ic + 64);
			for (i__ = 2; i__ <= 6; ++i__) {
				ic = * (unsigned char *) &subnam[i__ - 1];
				if (ic >= 129 && ic <= 137 || ic >= 145 && ic <= 153 || ic >= 162 && ic <= 169) {
					* (unsigned char *) &subnam[i__ - 1] = (char) (ic + 64);
				}
				/* L20: */
			}
		}

	} else if (iz == 218 || iz == 250) {

		/* Prime machines: ASCII+128 */

		if (ic >= 225 && ic <= 250) {
			* (unsigned char *) subnam = (char) (ic - 32);
			for (i__ = 2; i__ <= 6; ++i__) {
				ic = * (unsigned char *) &subnam[i__ - 1];
				if (ic >= 225 && ic <= 250) {
					* (unsigned char *) &subnam[i__ - 1] = (char) (ic - 32);
				}
				/* L30: */
			}
		}
	}

	* (unsigned char *) c1 = * (unsigned char *) subnam;
	sname = * (unsigned char *) c1 == 'S' || * (unsigned char *) c1 == 'D';
	cname = * (unsigned char *) c1 == 'C' || * (unsigned char *) c1 == 'Z';
	if (! (cname || sname)) {
		return ret_val;
	}
	s_copy (c2, subnam + 1, 2, 2);
	s_copy (c3, subnam + 3, 3, 3);
	s_copy (c4, c3 + 1, 2, 2);

	switch (*ispec) {
		case 1:
			goto L110;
		case 2:
			goto L200;
		case 3:
			goto L300;
	}

L110:

	/* ISPEC = 1: block size

	   In these examples, separate code is provided for setting NB for real
	   and complex.  We assume that NB will take the same value in single or
	   double precision. */

	nb = 1;

	if (s_cmp (c2, "GE", 2, 2) == 0) {
		if (s_cmp (c3, "TRF", 3, 3) == 0) {
			if (sname) {
				nb = 64;
			} else {
				nb = 64;
			}
		} else if (s_cmp (c3, "QRF", 3, 3) == 0 || s_cmp (c3, "RQF", 3, 3) == 0 || s_cmp (c3, "LQF", 3, 3) == 0
		           || s_cmp (c3, "QLF", 3, 3) == 0) {
			if (sname) {
				nb = 32;
			} else {
				nb = 32;
			}
		} else if (s_cmp (c3, "HRD", 3, 3) == 0) {
			if (sname) {
				nb = 32;
			} else {
				nb = 32;
			}
		} else if (s_cmp (c3, "BRD", 3, 3) == 0) {
			if (sname) {
				nb = 32;
			} else {
				nb = 32;
			}
		} else if (s_cmp (c3, "TRI", 3, 3) == 0) {
			if (sname) {
				nb = 64;
			} else {
				nb = 64;
			}
		}
	} else if (s_cmp (c2, "PO", 2, 2) == 0) {
		if (s_cmp (c3, "TRF", 3, 3) == 0) {
			if (sname) {
				nb = 64;
			} else {
				nb = 64;
			}
		}
	} else if (s_cmp (c2, "SY", 2, 2) == 0) {
		if (s_cmp (c3, "TRF", 3, 3) == 0) {
			if (sname) {
				nb = 64;
			} else {
				nb = 64;
			}
		} else if (sname && s_cmp (c3, "TRD", 3, 3) == 0) {
			nb = 32;
		} else if (sname && s_cmp (c3, "GST", 3, 3) == 0) {
			nb = 64;
		}
	} else if (cname && s_cmp (c2, "HE", 2, 2) == 0) {
		if (s_cmp (c3, "TRF", 3, 3) == 0) {
			nb = 64;
		} else if (s_cmp (c3, "TRD", 3, 3) == 0) {
			nb = 32;
		} else if (s_cmp (c3, "GST", 3, 3) == 0) {
			nb = 64;
		}
	} else if (sname && s_cmp (c2, "OR", 2, 2) == 0) {
		if (* (unsigned char *) c3 == 'G') {
			if (s_cmp (c4, "QR", 2, 2) == 0 || s_cmp (c4, "RQ", 2, 2) == 0 || s_cmp (c4, "LQ", 2, 2) == 0 ||
			        s_cmp (c4, "QL", 2, 2) == 0 || s_cmp (c4, "HR", 2, 2) == 0 || s_cmp (c4, "TR", 2, 2) == 0 ||
			        s_cmp (c4, "BR", 2, 2) == 0) {
				nb = 32;
			}
		} else if (* (unsigned char *) c3 == 'M') {
			if (s_cmp (c4, "QR", 2, 2) == 0 || s_cmp (c4, "RQ", 2, 2) == 0 || s_cmp (c4, "LQ", 2, 2) == 0 ||
			        s_cmp (c4, "QL", 2, 2) == 0 || s_cmp (c4, "HR", 2, 2) == 0 || s_cmp (c4, "TR", 2, 2) == 0 ||
			        s_cmp (c4, "BR", 2, 2) == 0) {
				nb = 32;
			}
		}
	} else if (cname && s_cmp (c2, "UN", 2, 2) == 0) {
		if (* (unsigned char *) c3 == 'G') {
			if (s_cmp (c4, "QR", 2, 2) == 0 || s_cmp (c4, "RQ", 2, 2) == 0 || s_cmp (c4, "LQ", 2, 2) == 0 ||
			        s_cmp (c4, "QL", 2, 2) == 0 || s_cmp (c4, "HR", 2, 2) == 0 || s_cmp (c4, "TR", 2, 2) == 0 ||
			        s_cmp (c4, "BR", 2, 2) == 0) {
				nb = 32;
			}
		} else if (* (unsigned char *) c3 == 'M') {
			if (s_cmp (c4, "QR", 2, 2) == 0 || s_cmp (c4, "RQ", 2, 2) == 0 || s_cmp (c4, "LQ", 2, 2) == 0 ||
			        s_cmp (c4, "QL", 2, 2) == 0 || s_cmp (c4, "HR", 2, 2) == 0 || s_cmp (c4, "TR", 2, 2) == 0 ||
			        s_cmp (c4, "BR", 2, 2) == 0) {
				nb = 32;
			}
		}
	} else if (s_cmp (c2, "GB", 2, 2) == 0) {
		if (s_cmp (c3, "TRF", 3, 3) == 0) {
			if (sname) {
				if (*n4 <= 64) {
					nb = 1;
				} else {
					nb = 32;
				}
			} else {
				if (*n4 <= 64) {
					nb = 1;
				} else {
					nb = 32;
				}
			}
		}
	} else if (s_cmp (c2, "PB", 2, 2) == 0) {
		if (s_cmp (c3, "TRF", 3, 3) == 0) {
			if (sname) {
				if (*n2 <= 64) {
					nb = 1;
				} else {
					nb = 32;
				}
			} else {
				if (*n2 <= 64) {
					nb = 1;
				} else {
					nb = 32;
				}
			}
		}
	} else if (s_cmp (c2, "TR", 2, 2) == 0) {
		if (s_cmp (c3, "TRI", 3, 3) == 0) {
			if (sname) {
				nb = 64;
			} else {
				nb = 64;
			}
		}
	} else if (s_cmp (c2, "LA", 2, 2) == 0) {
		if (s_cmp (c3, "UUM", 3, 3) == 0) {
			if (sname) {
				nb = 64;
			} else {
				nb = 64;
			}
		}
	} else if (sname && s_cmp (c2, "ST", 2, 2) == 0) {
		if (s_cmp (c3, "EBZ", 3, 3) == 0) {
			nb = 1;
		}
	}
	ret_val = nb;
	return ret_val;

L200:

	/* ISPEC = 2: minimum block size */

	nbmin = 2;
	if (s_cmp (c2, "GE", 2, 2) == 0) {
		if (s_cmp (c3, "QRF", 3, 3) == 0 || s_cmp (c3, "RQF", 3, 3) == 0 || s_cmp (c3, "LQF", 3, 3) == 0 ||
		        s_cmp (c3, "QLF", 3, 3) == 0) {
			if (sname) {
				nbmin = 2;
			} else {
				nbmin = 2;
			}
		} else if (s_cmp (c3, "HRD", 3, 3) == 0) {
			if (sname) {
				nbmin = 2;
			} else {
				nbmin = 2;
			}
		} else if (s_cmp (c3, "BRD", 3, 3) == 0) {
			if (sname) {
				nbmin = 2;
			} else {
				nbmin = 2;
			}
		} else if (s_cmp (c3, "TRI", 3, 3) == 0) {
			if (sname) {
				nbmin = 2;
			} else {
				nbmin = 2;
			}
		}
	} else if (s_cmp (c2, "SY", 2, 2) == 0) {
		if (s_cmp (c3, "TRF", 3, 3) == 0) {
			if (sname) {
				nbmin = 8;
			} else {
				nbmin = 8;
			}
		} else if (sname && s_cmp (c3, "TRD", 3, 3) == 0) {
			nbmin = 2;
		}
	} else if (cname && s_cmp (c2, "HE", 2, 2) == 0) {
		if (s_cmp (c3, "TRD", 3, 3) == 0) {
			nbmin = 2;
		}
	} else if (sname && s_cmp (c2, "OR", 2, 2) == 0) {
		if (* (unsigned char *) c3 == 'G') {
			if (s_cmp (c4, "QR", 2, 2) == 0 || s_cmp (c4, "RQ", 2, 2) == 0 || s_cmp (c4, "LQ", 2, 2) == 0 ||
			        s_cmp (c4, "QL", 2, 2) == 0 || s_cmp (c4, "HR", 2, 2) == 0 || s_cmp (c4, "TR", 2, 2) == 0 ||
			        s_cmp (c4, "BR", 2, 2) == 0) {
				nbmin = 2;
			}
		} else if (* (unsigned char *) c3 == 'M') {
			if (s_cmp (c4, "QR", 2, 2) == 0 || s_cmp (c4, "RQ", 2, 2) == 0 || s_cmp (c4, "LQ", 2, 2) == 0 ||
			        s_cmp (c4, "QL", 2, 2) == 0 || s_cmp (c4, "HR", 2, 2) == 0 || s_cmp (c4, "TR", 2, 2) == 0 ||
			        s_cmp (c4, "BR", 2, 2) == 0) {
				nbmin = 2;
			}
		}
	} else if (cname && s_cmp (c2, "UN", 2, 2) == 0) {
		if (* (unsigned char *) c3 == 'G') {
			if (s_cmp (c4, "QR", 2, 2) == 0 || s_cmp (c4, "RQ", 2, 2) == 0 || s_cmp (c4, "LQ", 2, 2) == 0 ||
			        s_cmp (c4, "QL", 2, 2) == 0 || s_cmp (c4, "HR", 2, 2) == 0 || s_cmp (c4, "TR", 2, 2) == 0 ||
			        s_cmp (c4, "BR", 2, 2) == 0) {
				nbmin = 2;
			}
		} else if (* (unsigned char *) c3 == 'M') {
			if (s_cmp (c4, "QR", 2, 2) == 0 || s_cmp (c4, "RQ", 2, 2) == 0 || s_cmp (c4, "LQ", 2, 2) == 0 ||
			        s_cmp (c4, "QL", 2, 2) == 0 || s_cmp (c4, "HR", 2, 2) == 0 || s_cmp (c4, "TR", 2, 2) == 0 ||
			        s_cmp (c4, "BR", 2, 2) == 0) {
				nbmin = 2;
			}
		}
	}
	ret_val = nbmin;
	return ret_val;

L300:

	/* ISPEC = 3: crossover point */

	nx = 0;
	if (s_cmp (c2, "GE", 2, 2) == 0) {
		if (s_cmp (c3, "QRF", 3, 3) == 0 || s_cmp (c3, "RQF", 3, 3) == 0 || s_cmp (c3, "LQF", 3, 3) == 0 ||
		        s_cmp (c3, "QLF", 3, 3) == 0) {
			if (sname) {
				nx = 128;
			} else {
				nx = 128;
			}
		} else if (s_cmp (c3, "HRD", 3, 3) == 0) {
			if (sname) {
				nx = 128;
			} else {
				nx = 128;
			}
		} else if (s_cmp (c3, "BRD", 3, 3) == 0) {
			if (sname) {
				nx = 128;
			} else {
				nx = 128;
			}
		}
	} else if (s_cmp (c2, "SY", 2, 2) == 0) {
		if (sname && s_cmp (c3, "TRD", 3, 3) == 0) {
			nx = 32;
		}
	} else if (cname && s_cmp (c2, "HE", 2, 2) == 0) {
		if (s_cmp (c3, "TRD", 3, 3) == 0) {
			nx = 32;
		}
	} else if (sname && s_cmp (c2, "OR", 2, 2) == 0) {
		if (* (unsigned char *) c3 == 'G') {
			if (s_cmp (c4, "QR", 2, 2) == 0 || s_cmp (c4, "RQ", 2, 2) == 0 || s_cmp (c4, "LQ", 2, 2) == 0 ||
			        s_cmp (c4, "QL", 2, 2) == 0 || s_cmp (c4, "HR", 2, 2) == 0 || s_cmp (c4, "TR", 2, 2) == 0 ||
			        s_cmp (c4, "BR", 2, 2) == 0) {
				nx = 128;
			}
		}
	} else if (cname && s_cmp (c2, "UN", 2, 2) == 0) {
		if (* (unsigned char *) c3 == 'G') {
			if (s_cmp (c4, "QR", 2, 2) == 0 || s_cmp (c4, "RQ", 2, 2) == 0 || s_cmp (c4, "LQ", 2, 2) == 0 ||
			        s_cmp (c4, "QL", 2, 2) == 0 || s_cmp (c4, "HR", 2, 2) == 0 || s_cmp (c4, "TR", 2, 2) == 0 ||
			        s_cmp (c4, "BR", 2, 2) == 0) {
				nx = 128;
			}
		}
	}
	ret_val = nx;
	return ret_val;

L400:

	/* ISPEC = 4: number of shifts (used by xHSEQR) */

	ret_val = 6;
	return ret_val;

L500:

	/* ISPEC = 5: minimum column dimension (not used) */

	ret_val = 2;
	return ret_val;

L600:

	/* ISPEC = 6: crossover point for SVD (used by xGELSS and xGESVD) */

	ret_val = (integer) ( (float) MIN (*n1, *n2) * 1.6f);
	return ret_val;

L700:

	/* ISPEC = 7: number of processors (not used) */

	ret_val = 1;
	return ret_val;

L800:

	/* ISPEC = 8: crossover point for multishift (used by xHSEQR) */

	ret_val = 50;
	return ret_val;

L900:

	/* ISPEC = 9: maximum size of the subproblems at the bottom of the
	   computation tree in the divide-and-conquer algorithm (used by xGELSD
	   and xGESDD) */

	ret_val = 25;
	return ret_val;

L1000:

	/* ISPEC = 10: ieee NaN arithmetic can be trusted not to trap

	   ILAENV = 0 */
	ret_val = 1;
	if (ret_val == 1) {
		ret_val = NUMlapack_ieeeck (&c__0, &c_b162, &c_b163);
	}
	return ret_val;

L1100:

	/* ISPEC = 11: infinity arithmetic can be trusted not to trap

	   ILAENV = 0 */
	ret_val = 1;
	if (ret_val == 1) {
		ret_val = NUMlapack_ieeeck (&c__1, &c_b162, &c_b163);
	}
	return ret_val;
}								/* NUMlapack_ilaenv */

#undef a_ref
#undef c___ref

#undef MAX
#undef MIN

/* End of file NUMclapack.c */