/* Generated code. Do not edit. See cherrypick_lapack.tcl */
/* This file contains a subset of LAPACK for use with Tcl/VecTcl */
/* available subroutines: dgesdd_ zgesdd_ dgemm_ zgemm_ dsyevr_ zheevr_ dgeev_ zgeev_ dgelss_ zgelss_ dgelsy_ zgelsy_ dgesv_ zgesv_ dgesvx_ zgesvx_ dgees_ zgees_  */
#include "clapack_cutdown.h"
#include "f2c_mathlib.h"
/* Declaring the Tcl replacement for xerbla */
  MODULE_SCOPE int vectcl_xerbla(Tcl_Interp *interp, char* func, integer *info);
#pragma clang diagnostic ignored "-Wshift-op-parentheses"
#pragma clang diagnostic ignored "-Wlogical-op-parentheses"
#pragma clang diagnostic ignored "-Wsometimes-uninitialized"
/* declared functions */
static logical lsame_ (char *ca, char *cb);
static /* Subroutine */ int dbdsdc_ (Tcl_Interp *interp, char *uplo, char *compq, integer *n, doublereal *	d__, doublereal *e, doublereal *u, integer *ldu, doublereal *vt, 	integer *ldvt, doublereal *q, integer *iq, doublereal *work, integer *	iwork, integer *info);
static /* Subroutine */ int dgebrd_ (Tcl_Interp *interp, integer *m, integer *n, doublereal *a, integer *	lda, doublereal *d__, doublereal *e, doublereal *tauq, doublereal *	taup, doublereal *work, integer *lwork, integer *info);
static doublereal dlange_ (char *norm, integer *m, integer *n, doublereal *a, integer 	*lda, doublereal *work);
static /* Subroutine */ int dgelqf_ (Tcl_Interp *interp, integer *m, integer *n, doublereal *a, integer *	lda, doublereal *tau, doublereal *work, integer *lwork, integer *info);
static /* Subroutine */ int dlascl_ (Tcl_Interp *interp, char *type__, integer *kl, integer *ku, 	doublereal *cfrom, doublereal *cto, integer *m, integer *n, 	doublereal *a, integer *lda, integer *info);
static /* Subroutine */ int dgeqrf_ (Tcl_Interp *interp, integer *m, integer *n, doublereal *a, integer *	lda, doublereal *tau, doublereal *work, integer *lwork, integer *info);
static /* Subroutine */ int dlacpy_ (Tcl_Interp *interp, char *uplo, integer *m, integer *n, doublereal *	a, integer *lda, doublereal *b, integer *ldb);
static /* Subroutine */ int dlaset_ (Tcl_Interp *interp, char *uplo, integer *m, integer *n, doublereal *	alpha, doublereal *beta, doublereal *a, integer *lda);
static /* Subroutine */ int dorgbr_ (Tcl_Interp *interp, char *vect, integer *m, integer *n, integer *k, 	doublereal *a, integer *lda, doublereal *tau, doublereal *work, 	integer *lwork, integer *info);
static integer ilaenv_ (integer *ispec, char *name__, char *opts, integer *n1, 	integer *n2, integer *n3, integer *n4);
static /* Subroutine */ int dormbr_ (Tcl_Interp *interp, char *vect, char *side, char *trans, integer *m, 	integer *n, integer *k, doublereal *a, integer *lda, doublereal *tau, 	doublereal *c__, integer *ldc, doublereal *work, integer *lwork, 	integer *info);
static /* Subroutine */ int dorglq_ (Tcl_Interp *interp, integer *m, integer *n, integer *k, doublereal *	a, integer *lda, doublereal *tau, doublereal *work, integer *lwork, 	integer *info);
static /* Subroutine */ int dorgqr_ (Tcl_Interp *interp, integer *m, integer *n, integer *k, doublereal *	a, integer *lda, doublereal *tau, doublereal *work, integer *lwork, 	integer *info);
static /* Subroutine */ int zlacp2_ (Tcl_Interp *interp, char *uplo, integer *m, integer *n, doublereal *	a, integer *lda, doublecomplex *b, integer *ldb);
static /* Subroutine */ int zgebrd_ (Tcl_Interp *interp, integer *m, integer *n, doublecomplex *a, 	integer *lda, doublereal *d__, doublereal *e, doublecomplex *tauq, 	doublecomplex *taup, doublecomplex *work, integer *lwork, integer *	info);
static doublereal zlange_ (char *norm, integer *m, integer *n, doublecomplex *a, 	integer *lda, doublereal *work);
static /* Subroutine */ int zgelqf_ (Tcl_Interp *interp, integer *m, integer *n, doublecomplex *a, 	integer *lda, doublecomplex *tau, doublecomplex *work, integer *lwork, 	 integer *info);
static /* Subroutine */ int zlacrm_ (Tcl_Interp *interp, integer *m, integer *n, doublecomplex *a, 	integer *lda, doublereal *b, integer *ldb, doublecomplex *c__, 	integer *ldc, doublereal *rwork);
static /* Subroutine */ int zlarcm_ (Tcl_Interp *interp, integer *m, integer *n, doublereal *a, integer *	lda, doublecomplex *b, integer *ldb, doublecomplex *c__, integer *ldc, 	 doublereal *rwork);
static /* Subroutine */ int zlascl_ (Tcl_Interp *interp, char *type__, integer *kl, integer *ku, 	doublereal *cfrom, doublereal *cto, integer *m, integer *n, 	doublecomplex *a, integer *lda, integer *info);
static /* Subroutine */ int zgeqrf_ (Tcl_Interp *interp, integer *m, integer *n, doublecomplex *a, 	integer *lda, doublecomplex *tau, doublecomplex *work, integer *lwork, 	 integer *info);
static /* Subroutine */ int zlacpy_ (Tcl_Interp *interp, char *uplo, integer *m, integer *n, 	doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb);
static /* Subroutine */ int zlaset_ (Tcl_Interp *interp, char *uplo, integer *m, integer *n, 	doublecomplex *alpha, doublecomplex *beta, doublecomplex *a, integer *	lda);
static /* Subroutine */ int zungbr_ (Tcl_Interp *interp, char *vect, integer *m, integer *n, integer *k, 	doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *	work, integer *lwork, integer *info);
static /* Subroutine */ int zunmbr_ (Tcl_Interp *interp, char *vect, char *side, char *trans, integer *m, 	integer *n, integer *k, doublecomplex *a, integer *lda, doublecomplex 	*tau, doublecomplex *c__, integer *ldc, doublecomplex *work, integer *	lwork, integer *info);
static /* Subroutine */ int zunglq_ (Tcl_Interp *interp, integer *m, integer *n, integer *k, 	doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *	work, integer *lwork, integer *info);
static /* Subroutine */ int zungqr_ (Tcl_Interp *interp, integer *m, integer *n, integer *k, 	doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *	work, integer *lwork, integer *info);
static /* Subroutine */ int dscal_ (Tcl_Interp *interp, integer *n, doublereal *da, doublereal *dx, 	integer *incx);
static /* Subroutine */ int dcopy_ (Tcl_Interp *interp, integer *n, doublereal *dx, integer *incx, 	doublereal *dy, integer *incy);
static /* Subroutine */ int dswap_ (Tcl_Interp *interp, integer *n, doublereal *dx, integer *incx, 	doublereal *dy, integer *incy);
static /* Subroutine */ int dstein_ (Tcl_Interp *interp, integer *n, doublereal *d__, doublereal *e, 	integer *m, doublereal *w, integer *iblock, integer *isplit, 	doublereal *z__, integer *ldz, doublereal *work, integer *iwork, 	integer *ifail, integer *info);
static /* Subroutine */ int dsterf_ (Tcl_Interp *interp, integer *n, doublereal *d__, doublereal *e, 	integer *info);
static doublereal dlansy_ (char *norm, char *uplo, integer *n, doublereal *a, integer 	*lda, doublereal *work);
static /* Subroutine */ int dstebz_ (Tcl_Interp *interp, char *range, char *order, integer *n, doublereal 	*vl, doublereal *vu, integer *il, integer *iu, doublereal *abstol, 	doublereal *d__, doublereal *e, integer *m, integer *nsplit, 	doublereal *w, integer *iblock, integer *isplit, doublereal *work, 	integer *iwork, integer *info);
static /* Subroutine */ int dstemr_ (Tcl_Interp *interp, char *jobz, char *range, integer *n, doublereal *	d__, doublereal *e, doublereal *vl, doublereal *vu, integer *il, 	integer *iu, integer *m, doublereal *w, doublereal *z__, integer *ldz, 	 integer *nzc, integer *isuppz, logical *tryrac, doublereal *work, 	integer *lwork, integer *iwork, integer *liwork, integer *info);
static /* Subroutine */ int dormtr_ (Tcl_Interp *interp, char *side, char *uplo, char *trans, integer *m, 	integer *n, doublereal *a, integer *lda, doublereal *tau, doublereal *	c__, integer *ldc, doublereal *work, integer *lwork, integer *info);
static /* Subroutine */ int dsytrd_ (Tcl_Interp *interp, char *uplo, integer *n, doublereal *a, integer *	lda, doublereal *d__, doublereal *e, doublereal *tau, doublereal *	work, integer *lwork, integer *info);
static /* Subroutine */ int zswap_ (Tcl_Interp *interp, integer *n, doublecomplex *zx, integer *incx, 	doublecomplex *zy, integer *incy);
static /* Subroutine */ int zdscal_ (Tcl_Interp *interp, integer *n, doublereal *da, doublecomplex *zx, 	integer *incx);
static /* Subroutine */ int zhetrd_ (Tcl_Interp *interp, char *uplo, integer *n, doublecomplex *a, 	integer *lda, doublereal *d__, doublereal *e, doublecomplex *tau, 	doublecomplex *work, integer *lwork, integer *info);
static /* Subroutine */ int zstein_ (Tcl_Interp *interp, integer *n, doublereal *d__, doublereal *e, 	integer *m, doublereal *w, integer *iblock, integer *isplit, 	doublecomplex *z__, integer *ldz, doublereal *work, integer *iwork, 	integer *ifail, integer *info);
static doublereal zlansy_ (char *norm, char *uplo, integer *n, doublecomplex *a, 	integer *lda, doublereal *work);
static /* Subroutine */ int zstemr_ (Tcl_Interp *interp, char *jobz, char *range, integer *n, doublereal *	d__, doublereal *e, doublereal *vl, doublereal *vu, integer *il, 	integer *iu, integer *m, doublereal *w, doublecomplex *z__, integer *	ldz, integer *nzc, integer *isuppz, logical *tryrac, doublereal *work, 	 integer *lwork, integer *iwork, integer *liwork, integer *info);
static /* Subroutine */ int zunmtr_ (Tcl_Interp *interp, char *side, char *uplo, char *trans, integer *m, 	integer *n, doublecomplex *a, integer *lda, doublecomplex *tau, 	doublecomplex *c__, integer *ldc, doublecomplex *work, integer *lwork, 	 integer *info);
static /* Subroutine */ int drot_ (Tcl_Interp *interp, integer *n, doublereal *dx, integer *incx, 	doublereal *dy, integer *incy, doublereal *c__, doublereal *s);
static doublereal dnrm2_ (integer *n, doublereal *x, integer *incx);
static doublereal dlapy2_ (doublereal *x, doublereal *y);
static /* Subroutine */ int dlabad_ (Tcl_Interp *interp, doublereal *small, doublereal *large);
static /* Subroutine */ int dgebak_ (Tcl_Interp *interp, char *job, char *side, integer *n, integer *ilo, 	integer *ihi, doublereal *scale, integer *m, doublereal *v, integer *	ldv, integer *info);
static /* Subroutine */ int dgebal_ (Tcl_Interp *interp, char *job, integer *n, doublereal *a, integer *	lda, integer *ilo, integer *ihi, doublereal *scale, integer *info);
static /* Subroutine */ int dgehrd_ (Tcl_Interp *interp, integer *n, integer *ilo, integer *ihi, 	doublereal *a, integer *lda, doublereal *tau, doublereal *work, 	integer *lwork, integer *info);
static integer idamax_ (integer *n, doublereal *dx, integer *incx);
static /* Subroutine */ int dlartg_ (Tcl_Interp *interp, doublereal *f, doublereal *g, doublereal *cs, 	doublereal *sn, doublereal *r__);
static /* Subroutine */ int dorghr_ (Tcl_Interp *interp, integer *n, integer *ilo, integer *ihi, 	doublereal *a, integer *lda, doublereal *tau, doublereal *work, 	integer *lwork, integer *info);
static /* Subroutine */ int dhseqr_ (Tcl_Interp *interp, char *job, char *compz, integer *n, integer *ilo, 	 integer *ihi, doublereal *h__, integer *ldh, doublereal *wr, 	doublereal *wi, doublereal *z__, integer *ldz, doublereal *work, 	integer *lwork, integer *info);
static /* Subroutine */ int dtrevc_ (Tcl_Interp *interp, char *side, char *howmny, logical *select, 	integer *n, doublereal *t, integer *ldt, doublereal *vl, integer *	ldvl, doublereal *vr, integer *ldvr, integer *mm, integer *m, 	doublereal *work, integer *info);
static /* Subroutine */ int zscal_ (Tcl_Interp *interp, integer *n, doublecomplex *za, doublecomplex *zx, 	integer *incx);
static doublereal dznrm2_ (integer *n, doublecomplex *x, integer *incx);
static /* Subroutine */ int zgebak_ (Tcl_Interp *interp, char *job, char *side, integer *n, integer *ilo, 	integer *ihi, doublereal *scale, integer *m, doublecomplex *v, 	integer *ldv, integer *info);
static /* Subroutine */ int zgebal_ (Tcl_Interp *interp, char *job, integer *n, doublecomplex *a, integer 	*lda, integer *ilo, integer *ihi, doublereal *scale, integer *info);
static /* Subroutine */ int zgehrd_ (Tcl_Interp *interp, integer *n, integer *ilo, integer *ihi, 	doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *	work, integer *lwork, integer *info);
static /* Subroutine */ int zhseqr_ (Tcl_Interp *interp, char *job, char *compz, integer *n, integer *ilo, 	 integer *ihi, doublecomplex *h__, integer *ldh, doublecomplex *w, 	doublecomplex *z__, integer *ldz, doublecomplex *work, integer *lwork, 	 integer *info);
static /* Subroutine */ int ztrevc_ (Tcl_Interp *interp, char *side, char *howmny, logical *select, 	integer *n, doublecomplex *t, integer *ldt, doublecomplex *vl, 	integer *ldvl, doublecomplex *vr, integer *ldvr, integer *mm, integer 	*m, doublecomplex *work, doublereal *rwork, integer *info);
static /* Subroutine */ int zunghr_ (Tcl_Interp *interp, integer *n, integer *ilo, integer *ihi, 	doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *	work, integer *lwork, integer *info);
static /* Subroutine */ int dgemv_ (Tcl_Interp *interp, char *trans, integer *m, integer *n, doublereal *	alpha, doublereal *a, integer *lda, doublereal *x, integer *incx, 	doublereal *beta, doublereal *y, integer *incy);
static /* Subroutine */ int drscl_ (Tcl_Interp *interp, integer *n, doublereal *sa, doublereal *sx, 	integer *incx);
static /* Subroutine */ int dbdsqr_ (Tcl_Interp *interp, char *uplo, integer *n, integer *ncvt, integer *	nru, integer *ncc, doublereal *d__, doublereal *e, doublereal *vt, 	integer *ldvt, doublereal *u, integer *ldu, doublereal *c__, integer *	ldc, doublereal *work, integer *info);
static /* Subroutine */ int dormlq_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *	c__, integer *ldc, doublereal *work, integer *lwork, integer *info);
static /* Subroutine */ int dormqr_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *	c__, integer *ldc, doublereal *work, integer *lwork, integer *info);
static /* Subroutine */ int zgemv_ (Tcl_Interp *interp, char *trans, integer *m, integer *n, 	doublecomplex *alpha, doublecomplex *a, integer *lda, doublecomplex *	x, integer *incx, doublecomplex *beta, doublecomplex *y, integer *	incy);
static /* Subroutine */ int zcopy_ (Tcl_Interp *interp, integer *n, doublecomplex *zx, integer *incx, 	doublecomplex *zy, integer *incy);
static /* Subroutine */ int zdrscl_ (Tcl_Interp *interp, integer *n, doublereal *sa, doublecomplex *sx, 	integer *incx);
static /* Subroutine */ int zbdsqr_ (Tcl_Interp *interp, char *uplo, integer *n, integer *ncvt, integer *	nru, integer *ncc, doublereal *d__, doublereal *e, doublecomplex *vt, 	integer *ldvt, doublecomplex *u, integer *ldu, doublecomplex *c__, 	integer *ldc, doublereal *rwork, integer *info);
static /* Subroutine */ int zunmlq_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *k, doublecomplex *a, integer *lda, doublecomplex *tau, 	doublecomplex *c__, integer *ldc, doublecomplex *work, integer *lwork, 	 integer *info);
static /* Subroutine */ int zunmqr_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *k, doublecomplex *a, integer *lda, doublecomplex *tau, 	doublecomplex *c__, integer *ldc, doublecomplex *work, integer *lwork, 	 integer *info);
static /* Subroutine */ int dtrsm_ (Tcl_Interp *interp, char *side, char *uplo, char *transa, char *diag, 	integer *m, integer *n, doublereal *alpha, doublereal *a, integer *	lda, doublereal *b, integer *ldb);
static /* Subroutine */ int dlaic1_ (Tcl_Interp *interp, integer *job, integer *j, doublereal *x, 	doublereal *sest, doublereal *w, doublereal *gamma, doublereal *	sestpr, doublereal *s, doublereal *c__);
static /* Subroutine */ int dgeqp3_ (Tcl_Interp *interp, integer *m, integer *n, doublereal *a, integer *	lda, integer *jpvt, doublereal *tau, doublereal *work, integer *lwork, 	 integer *info);
static /* Subroutine */ int dormrz_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *k, integer *l, doublereal *a, integer *lda, doublereal *tau, 	doublereal *c__, integer *ldc, doublereal *work, integer *lwork, 	integer *info);
static /* Subroutine */ int dtzrzf_ (Tcl_Interp *interp, integer *m, integer *n, doublereal *a, integer *	lda, doublereal *tau, doublereal *work, integer *lwork, integer *info);
static /* Subroutine */ int ztrsm_ (Tcl_Interp *interp, char *side, char *uplo, char *transa, char *diag, 	integer *m, integer *n, doublecomplex *alpha, doublecomplex *a, 	integer *lda, doublecomplex *b, integer *ldb);
static /* Subroutine */ int zlaic1_ (Tcl_Interp *interp, integer *job, integer *j, doublecomplex *x, 	doublereal *sest, doublecomplex *w, doublecomplex *gamma, doublereal *	sestpr, doublecomplex *s, doublecomplex *c__);
static /* Subroutine */ int zgeqp3_ (Tcl_Interp *interp, integer *m, integer *n, doublecomplex *a, 	integer *lda, integer *jpvt, doublecomplex *tau, doublecomplex *work, 	integer *lwork, doublereal *rwork, integer *info);
static /* Subroutine */ int zunmrz_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *k, integer *l, doublecomplex *a, integer *lda, doublecomplex 	*tau, doublecomplex *c__, integer *ldc, doublecomplex *work, integer *	lwork, integer *info);
static /* Subroutine */ int ztzrzf_ (Tcl_Interp *interp, integer *m, integer *n, doublecomplex *a, 	integer *lda, doublecomplex *tau, doublecomplex *work, integer *lwork, 	 integer *info);
static /* Subroutine */ int dgetrf_ (Tcl_Interp *interp, integer *m, integer *n, doublereal *a, integer *	lda, integer *ipiv, integer *info);
static /* Subroutine */ int dgetrs_ (Tcl_Interp *interp, char *trans, integer *n, integer *nrhs, 	doublereal *a, integer *lda, integer *ipiv, doublereal *b, integer *	ldb, integer *info);
static /* Subroutine */ int zgetrf_ (Tcl_Interp *interp, integer *m, integer *n, doublecomplex *a, 	integer *lda, integer *ipiv, integer *info);
static /* Subroutine */ int zgetrs_ (Tcl_Interp *interp, char *trans, integer *n, integer *nrhs, 	doublecomplex *a, integer *lda, integer *ipiv, doublecomplex *b, 	integer *ldb, integer *info);
static /* Subroutine */ int dlaqge_ (Tcl_Interp *interp, integer *m, integer *n, doublereal *a, integer *	lda, doublereal *r__, doublereal *c__, doublereal *rowcnd, doublereal 	*colcnd, doublereal *amax, char *equed);
static /* Subroutine */ int dgecon_ (Tcl_Interp *interp, char *norm, integer *n, doublereal *a, integer *	lda, doublereal *anorm, doublereal *rcond, doublereal *work, integer *	iwork, integer *info);
static /* Subroutine */ int dgeequ_ (Tcl_Interp *interp, integer *m, integer *n, doublereal *a, integer *	lda, doublereal *r__, doublereal *c__, doublereal *rowcnd, doublereal 	*colcnd, doublereal *amax, integer *info);
static /* Subroutine */ int dgerfs_ (Tcl_Interp *interp, char *trans, integer *n, integer *nrhs, 	doublereal *a, integer *lda, doublereal *af, integer *ldaf, integer *	ipiv, doublereal *b, integer *ldb, doublereal *x, integer *ldx, 	doublereal *ferr, doublereal *berr, doublereal *work, integer *iwork, 	integer *info);
static doublereal dlantr_ (char *norm, char *uplo, char *diag, integer *m, integer *n, 	 doublereal *a, integer *lda, doublereal *work);
static /* Subroutine */ int zlaqge_ (Tcl_Interp *interp, integer *m, integer *n, doublecomplex *a, 	integer *lda, doublereal *r__, doublereal *c__, doublereal *rowcnd, 	doublereal *colcnd, doublereal *amax, char *equed);
static /* Subroutine */ int zgecon_ (Tcl_Interp *interp, char *norm, integer *n, doublecomplex *a, 	integer *lda, doublereal *anorm, doublereal *rcond, doublecomplex *	work, doublereal *rwork, integer *info);
static /* Subroutine */ int zgeequ_ (Tcl_Interp *interp, integer *m, integer *n, doublecomplex *a, 	integer *lda, doublereal *r__, doublereal *c__, doublereal *rowcnd, 	doublereal *colcnd, doublereal *amax, integer *info);
static /* Subroutine */ int zgerfs_ (Tcl_Interp *interp, char *trans, integer *n, integer *nrhs, 	doublecomplex *a, integer *lda, doublecomplex *af, integer *ldaf, 	integer *ipiv, doublecomplex *b, integer *ldb, doublecomplex *x, 	integer *ldx, doublereal *ferr, doublereal *berr, doublecomplex *work, 	 doublereal *rwork, integer *info);
static doublereal zlantr_ (char *norm, char *uplo, char *diag, integer *m, integer *n, 	 doublecomplex *a, integer *lda, doublereal *work);
static /* Subroutine */ int dtrsen_ (Tcl_Interp *interp, char *job, char *compq, logical *select, integer 	*n, doublereal *t, integer *ldt, doublereal *q, integer *ldq, 	doublereal *wr, doublereal *wi, integer *m, doublereal *s, doublereal 	*sep, doublereal *work, integer *lwork, integer *iwork, integer *	liwork, integer *info);
static /* Subroutine */ int ztrsen_ (Tcl_Interp *interp, char *job, char *compq, logical *select, integer 	*n, doublecomplex *t, integer *ldt, doublecomplex *q, integer *ldq, 	doublecomplex *w, integer *m, doublereal *s, doublereal *sep, 	doublecomplex *work, integer *lwork, integer *info);
static /* Subroutine */ int dlasr_ (Tcl_Interp *interp, char *side, char *pivot, char *direct, integer *m, 	 integer *n, doublereal *c__, doublereal *s, doublereal *a, integer *	lda);
static /* Subroutine */ int dlasd0_ (Tcl_Interp *interp, integer *n, integer *sqre, doublereal *d__, 	doublereal *e, doublereal *u, integer *ldu, doublereal *vt, integer *	ldvt, integer *smlsiz, integer *iwork, doublereal *work, integer *	info);
static /* Subroutine */ int dlasda_ (Tcl_Interp *interp, integer *icompq, integer *smlsiz, integer *n, 	integer *sqre, doublereal *d__, doublereal *e, doublereal *u, integer 	*ldu, doublereal *vt, integer *k, doublereal *difl, doublereal *difr, 	doublereal *z__, doublereal *poles, integer *givptr, integer *givcol, 	integer *ldgcol, integer *perm, doublereal *givnum, doublereal *c__, 	doublereal *s, doublereal *work, integer *iwork, integer *info);
static /* Subroutine */ int dlasdq_ (Tcl_Interp *interp, char *uplo, integer *sqre, integer *n, integer *	ncvt, integer *nru, integer *ncc, doublereal *d__, doublereal *e, 	doublereal *vt, integer *ldvt, doublereal *u, integer *ldu, 	doublereal *c__, integer *ldc, doublereal *work, integer *info);
static doublereal dlanst_ (char *norm, integer *n, doublereal *d__, doublereal *e);
static /* Subroutine */ int dgebd2_ (Tcl_Interp *interp, integer *m, integer *n, doublereal *a, integer *	lda, doublereal *d__, doublereal *e, doublereal *tauq, doublereal *	taup, doublereal *work, integer *info);
static /* Subroutine */ int dlabrd_ (Tcl_Interp *interp, integer *m, integer *n, integer *nb, doublereal *	a, integer *lda, doublereal *d__, doublereal *e, doublereal *tauq, 	doublereal *taup, doublereal *x, integer *ldx, doublereal *y, integer 	*ldy);
static /* Subroutine */ int dlassq_ (Tcl_Interp *interp, integer *n, doublereal *x, integer *incx, 	doublereal *scale, doublereal *sumsq);
static /* Subroutine */ int dgelq2_ (Tcl_Interp *interp, integer *m, integer *n, doublereal *a, integer *	lda, doublereal *tau, doublereal *work, integer *info);
static /* Subroutine */ int dlarfb_ (Tcl_Interp *interp, char *side, char *trans, char *direct, char *	storev, integer *m, integer *n, integer *k, doublereal *v, integer *	ldv, doublereal *t, integer *ldt, doublereal *c__, integer *ldc, 	doublereal *work, integer *ldwork);
static /* Subroutine */ int dlarft_ (Tcl_Interp *interp, char *direct, char *storev, integer *n, integer *	k, doublereal *v, integer *ldv, doublereal *tau, doublereal *t, 	integer *ldt);
static logical disnan_ (doublereal *din);
static /* Subroutine */ int dgeqr2_ (Tcl_Interp *interp, integer *m, integer *n, doublereal *a, integer *	lda, doublereal *tau, doublereal *work, integer *info);
static integer ieeeck_ (integer *ispec, real *zero, real *one);
static integer iparmq_ (integer *ispec, char *name__, char *opts, integer *n, integer 	*ilo, integer *ihi, integer *lwork);
static /* Subroutine */ int dorgl2_ (Tcl_Interp *interp, integer *m, integer *n, integer *k, doublereal *	a, integer *lda, doublereal *tau, doublereal *work, integer *info);
static /* Subroutine */ int dorg2r_ (Tcl_Interp *interp, integer *m, integer *n, integer *k, doublereal *	a, integer *lda, doublereal *tau, doublereal *work, integer *info);
static /* Subroutine */ int zgebd2_ (Tcl_Interp *interp, integer *m, integer *n, doublecomplex *a, 	integer *lda, doublereal *d__, doublereal *e, doublecomplex *tauq, 	doublecomplex *taup, doublecomplex *work, integer *info);
static /* Subroutine */ int zlabrd_ (Tcl_Interp *interp, integer *m, integer *n, integer *nb, 	doublecomplex *a, integer *lda, doublereal *d__, doublereal *e, 	doublecomplex *tauq, doublecomplex *taup, doublecomplex *x, integer *	ldx, doublecomplex *y, integer *ldy);
static /* Subroutine */ int zlassq_ (Tcl_Interp *interp, integer *n, doublecomplex *x, integer *incx, 	doublereal *scale, doublereal *sumsq);
static /* Subroutine */ int zgelq2_ (Tcl_Interp *interp, integer *m, integer *n, doublecomplex *a, 	integer *lda, doublecomplex *tau, doublecomplex *work, integer *info);
static /* Subroutine */ int zlarfb_ (Tcl_Interp *interp, char *side, char *trans, char *direct, char *	storev, integer *m, integer *n, integer *k, doublecomplex *v, integer 	*ldv, doublecomplex *t, integer *ldt, doublecomplex *c__, integer *	ldc, doublecomplex *work, integer *ldwork);
static /* Subroutine */ int zlarft_ (Tcl_Interp *interp, char *direct, char *storev, integer *n, integer *	k, doublecomplex *v, integer *ldv, doublecomplex *tau, doublecomplex *	t, integer *ldt);
static /* Subroutine */ int zgeqr2_ (Tcl_Interp *interp, integer *m, integer *n, doublecomplex *a, 	integer *lda, doublecomplex *tau, doublecomplex *work, integer *info);
static /* Subroutine */ int zungl2_ (Tcl_Interp *interp, integer *m, integer *n, integer *k, 	doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *	work, integer *info);
static /* Subroutine */ int zung2r_ (Tcl_Interp *interp, integer *m, integer *n, integer *k, 	doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *	work, integer *info);
static doublereal ddot_ (integer *n, doublereal *dx, integer *incx, doublereal *dy, 	integer *incy);
static doublereal dasum_ (integer *n, doublereal *dx, integer *incx);
static /* Subroutine */ int daxpy_ (Tcl_Interp *interp, integer *n, doublereal *da, doublereal *dx, 	integer *incx, doublereal *dy, integer *incy);
static /* Subroutine */ int dlagtf_ (Tcl_Interp *interp, integer *n, doublereal *a, doublereal *lambda, 	doublereal *b, doublereal *c__, doublereal *tol, doublereal *d__, 	integer *in, integer *info);
static /* Subroutine */ int dlagts_ (Tcl_Interp *interp, integer *job, integer *n, doublereal *a, 	doublereal *b, doublereal *c__, doublereal *d__, integer *in, 	doublereal *y, doublereal *tol, integer *info);
static /* Subroutine */ int dlarnv_ (Tcl_Interp *interp, integer *idist, integer *iseed, integer *n, 	doublereal *x);
static /* Subroutine */ int dlae2_ (Tcl_Interp *interp, doublereal *a, doublereal *b, doublereal *c__, 	doublereal *rt1, doublereal *rt2);
static /* Subroutine */ int dlasrt_ (Tcl_Interp *interp, char *id, integer *n, doublereal *d__, integer *	info);
static /* Subroutine */ int dlaebz_ (Tcl_Interp *interp, integer *ijob, integer *nitmax, integer *n, 	integer *mmax, integer *minp, integer *nbmin, doublereal *abstol, 	doublereal *reltol, doublereal *pivmin, doublereal *d__, doublereal *	e, doublereal *e2, integer *nval, doublereal *ab, doublereal *c__, 	integer *mout, integer *nab, doublereal *work, integer *iwork, 	integer *info);
static /* Subroutine */ int dlaev2_ (Tcl_Interp *interp, doublereal *a, doublereal *b, doublereal *c__, 	doublereal *rt1, doublereal *rt2, doublereal *cs1, doublereal *sn1);
static /* Subroutine */ int dlarrc_ (Tcl_Interp *interp, char *jobt, integer *n, doublereal *vl, 	doublereal *vu, doublereal *d__, doublereal *e, doublereal *pivmin, 	integer *eigcnt, integer *lcnt, integer *rcnt, integer *info);
static /* Subroutine */ int dlarre_ (Tcl_Interp *interp, char *range, integer *n, doublereal *vl, 	doublereal *vu, integer *il, integer *iu, doublereal *d__, doublereal 	*e, doublereal *e2, doublereal *rtol1, doublereal *rtol2, doublereal *	spltol, integer *nsplit, integer *isplit, integer *m, doublereal *w, 	doublereal *werr, doublereal *wgap, integer *iblock, integer *indexw, 	doublereal *gers, doublereal *pivmin, doublereal *work, integer *	iwork, integer *info);
static /* Subroutine */ int dlarrj_ (Tcl_Interp *interp, integer *n, doublereal *d__, doublereal *e2, 	integer *ifirst, integer *ilast, doublereal *rtol, integer *offset, 	doublereal *w, doublereal *werr, doublereal *work, integer *iwork, 	doublereal *pivmin, doublereal *spdiam, integer *info);
static /* Subroutine */ int dlarrr_ (Tcl_Interp *interp, integer *n, doublereal *d__, doublereal *e, 	integer *info);
static /* Subroutine */ int dlarrv_ (Tcl_Interp *interp, integer *n, doublereal *vl, doublereal *vu, 	doublereal *d__, doublereal *l, doublereal *pivmin, integer *isplit, 	integer *m, integer *dol, integer *dou, doublereal *minrgp, 	doublereal *rtol1, doublereal *rtol2, doublereal *w, doublereal *werr, 	 doublereal *wgap, integer *iblock, integer *indexw, doublereal *gers, 	 doublereal *z__, integer *ldz, integer *isuppz, doublereal *work, 	integer *iwork, integer *info);
static /* Subroutine */ int dormql_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *	c__, integer *ldc, doublereal *work, integer *lwork, integer *info);
static /* Subroutine */ int dsytd2_ (Tcl_Interp *interp, char *uplo, integer *n, doublereal *a, integer *	lda, doublereal *d__, doublereal *e, doublereal *tau, integer *info);
static /* Subroutine */ int dsyr2k_ (Tcl_Interp *interp, char *uplo, char *trans, integer *n, integer *k, 	doublereal *alpha, doublereal *a, integer *lda, doublereal *b, 	integer *ldb, doublereal *beta, doublereal *c__, integer *ldc);
static /* Subroutine */ int dlatrd_ (Tcl_Interp *interp, char *uplo, integer *n, integer *nb, doublereal *	a, integer *lda, doublereal *e, doublereal *tau, doublereal *w, 	integer *ldw);
static /* Subroutine */ int zhetd2_ (Tcl_Interp *interp, char *uplo, integer *n, doublecomplex *a, 	integer *lda, doublereal *d__, doublereal *e, doublecomplex *tau, 	integer *info);
static /* Subroutine */ int zher2k_ (Tcl_Interp *interp, char *uplo, char *trans, integer *n, integer *k, 	doublecomplex *alpha, doublecomplex *a, integer *lda, doublecomplex *	b, integer *ldb, doublereal *beta, doublecomplex *c__, integer *ldc);
static /* Subroutine */ int zlatrd_ (Tcl_Interp *interp, char *uplo, integer *n, integer *nb, 	doublecomplex *a, integer *lda, doublereal *e, doublecomplex *tau, 	doublecomplex *w, integer *ldw);
static /* Subroutine */ int zlarrv_ (Tcl_Interp *interp, integer *n, doublereal *vl, doublereal *vu, 	doublereal *d__, doublereal *l, doublereal *pivmin, integer *isplit, 	integer *m, integer *dol, integer *dou, doublereal *minrgp, 	doublereal *rtol1, doublereal *rtol2, doublereal *w, doublereal *werr, 	 doublereal *wgap, integer *iblock, integer *indexw, doublereal *gers, 	 doublecomplex *z__, integer *ldz, integer *isuppz, doublereal *work, 	integer *iwork, integer *info);
static /* Subroutine */ int zunmql_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *k, doublecomplex *a, integer *lda, doublecomplex *tau, 	doublecomplex *c__, integer *ldc, doublecomplex *work, integer *lwork, 	 integer *info);
static /* Subroutine */ int dtrmm_ (Tcl_Interp *interp, char *side, char *uplo, char *transa, char *diag, 	integer *m, integer *n, doublereal *alpha, doublereal *a, integer *	lda, doublereal *b, integer *ldb);
static /* Subroutine */ int dgehd2_ (Tcl_Interp *interp, integer *n, integer *ilo, integer *ihi, 	doublereal *a, integer *lda, doublereal *tau, doublereal *work, 	integer *info);
static /* Subroutine */ int dlahr2_ (Tcl_Interp *interp, integer *n, integer *k, integer *nb, doublereal *	a, integer *lda, doublereal *tau, doublereal *t, integer *ldt, 	doublereal *y, integer *ldy);
static /* Subroutine */ int dlaqr0_ (Tcl_Interp *interp, logical *wantt, logical *wantz, integer *n, 	integer *ilo, integer *ihi, doublereal *h__, integer *ldh, doublereal 	*wr, doublereal *wi, integer *iloz, integer *ihiz, doublereal *z__, 	integer *ldz, doublereal *work, integer *lwork, integer *info);
static /* Subroutine */ int dlahqr_ (Tcl_Interp *interp, logical *wantt, logical *wantz, integer *n, 	integer *ilo, integer *ihi, doublereal *h__, integer *ldh, doublereal 	*wr, doublereal *wi, integer *iloz, integer *ihiz, doublereal *z__, 	integer *ldz, integer *info);
static /* Subroutine */ int dlaln2_ (Tcl_Interp *interp, logical *ltrans, integer *na, integer *nw, 	doublereal *smin, doublereal *ca, doublereal *a, integer *lda, 	doublereal *d1, doublereal *d2, doublereal *b, integer *ldb, 	doublereal *wr, doublereal *wi, doublereal *x, integer *ldx, 	doublereal *scale, doublereal *xnorm, integer *info);
static integer izamax_ (integer *n, doublecomplex *zx, integer *incx);
static /* Subroutine */ int ztrmm_ (Tcl_Interp *interp, char *side, char *uplo, char *transa, char *diag, 	integer *m, integer *n, doublecomplex *alpha, doublecomplex *a, 	integer *lda, doublecomplex *b, integer *ldb);
static /* Subroutine */ int zaxpy_ (Tcl_Interp *interp, integer *n, doublecomplex *za, doublecomplex *zx, 	integer *incx, doublecomplex *zy, integer *incy);
static /* Subroutine */ int zgehd2_ (Tcl_Interp *interp, integer *n, integer *ilo, integer *ihi, 	doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *	work, integer *info);
static /* Subroutine */ int zlahr2_ (Tcl_Interp *interp, integer *n, integer *k, integer *nb, 	doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *t, 	integer *ldt, doublecomplex *y, integer *ldy);
static /* Subroutine */ int zlaqr0_ (Tcl_Interp *interp, logical *wantt, logical *wantz, integer *n, 	integer *ilo, integer *ihi, doublecomplex *h__, integer *ldh, 	doublecomplex *w, integer *iloz, integer *ihiz, doublecomplex *z__, 	integer *ldz, doublecomplex *work, integer *lwork, integer *info);
static /* Subroutine */ int zlahqr_ (Tcl_Interp *interp, logical *wantt, logical *wantz, integer *n, 	integer *ilo, integer *ihi, doublecomplex *h__, integer *ldh, 	doublecomplex *w, integer *iloz, integer *ihiz, doublecomplex *z__, 	integer *ldz, integer *info);
static doublereal dzasum_ (integer *n, doublecomplex *zx, integer *incx);
static /* Subroutine */ int zlatrs_ (Tcl_Interp *interp, char *uplo, char *trans, char *diag, char *	normin, integer *n, doublecomplex *a, integer *lda, doublecomplex *x, 	doublereal *scale, doublereal *cnorm, integer *info);
static /* Subroutine */ int dlas2_ (Tcl_Interp *interp, doublereal *f, doublereal *g, doublereal *h__, 	doublereal *ssmin, doublereal *ssmax);
static /* Subroutine */ int dlasq1_ (Tcl_Interp *interp, integer *n, doublereal *d__, doublereal *e, 	doublereal *work, integer *info);
static /* Subroutine */ int dlasv2_ (Tcl_Interp *interp, doublereal *f, doublereal *g, doublereal *h__, 	doublereal *ssmin, doublereal *ssmax, doublereal *snr, doublereal *	csr, doublereal *snl, doublereal *csl);
static /* Subroutine */ int dorml2_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *	c__, integer *ldc, doublereal *work, integer *info);
static /* Subroutine */ int dorm2r_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *	c__, integer *ldc, doublereal *work, integer *info);
static /* Subroutine */ int zlasr_ (Tcl_Interp *interp, char *side, char *pivot, char *direct, integer *m, 	 integer *n, doublereal *c__, doublereal *s, doublecomplex *a, 	integer *lda);
static /* Subroutine */ int zdrot_ (Tcl_Interp *interp, integer *n, doublecomplex *cx, integer *incx, 	doublecomplex *cy, integer *incy, doublereal *c__, doublereal *s);
static /* Subroutine */ int zunml2_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *k, doublecomplex *a, integer *lda, doublecomplex *tau, 	doublecomplex *c__, integer *ldc, doublecomplex *work, integer *info);
static /* Subroutine */ int zunm2r_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *k, doublecomplex *a, integer *lda, doublecomplex *tau, 	doublecomplex *c__, integer *ldc, doublecomplex *work, integer *info);
static /* Subroutine */ int dlaqp2_ (Tcl_Interp *interp, integer *m, integer *n, integer *offset, 	doublereal *a, integer *lda, integer *jpvt, doublereal *tau, 	doublereal *vn1, doublereal *vn2, doublereal *work);
static /* Subroutine */ int dlaqps_ (Tcl_Interp *interp, integer *m, integer *n, integer *offset, integer 	*nb, integer *kb, doublereal *a, integer *lda, integer *jpvt, 	doublereal *tau, doublereal *vn1, doublereal *vn2, doublereal *auxv, 	doublereal *f, integer *ldf);
static /* Subroutine */ int dormr3_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *k, integer *l, doublereal *a, integer *lda, doublereal *tau, 	doublereal *c__, integer *ldc, doublereal *work, integer *info);
static /* Subroutine */ int dlarzb_ (Tcl_Interp *interp, char *side, char *trans, char *direct, char *	storev, integer *m, integer *n, integer *k, integer *l, doublereal *v, 	 integer *ldv, doublereal *t, integer *ldt, doublereal *c__, integer *	ldc, doublereal *work, integer *ldwork);
static /* Subroutine */ int dlarzt_ (Tcl_Interp *interp, char *direct, char *storev, integer *n, integer *	k, doublereal *v, integer *ldv, doublereal *tau, doublereal *t, 	integer *ldt);
static /* Subroutine */ int dlatrz_ (Tcl_Interp *interp, integer *m, integer *n, integer *l, doublereal *	a, integer *lda, doublereal *tau, doublereal *work);
static /* Double Complex */ VOID zdotc_ (doublecomplex * ret_val, integer *n, 	doublecomplex *zx, integer *incx, doublecomplex *zy, integer *incy);
static /* Subroutine */ int zlaqp2_ (Tcl_Interp *interp, integer *m, integer *n, integer *offset, 	doublecomplex *a, integer *lda, integer *jpvt, doublecomplex *tau, 	doublereal *vn1, doublereal *vn2, doublecomplex *work);
static /* Subroutine */ int zlaqps_ (Tcl_Interp *interp, integer *m, integer *n, integer *offset, integer 	*nb, integer *kb, doublecomplex *a, integer *lda, integer *jpvt, 	doublecomplex *tau, doublereal *vn1, doublereal *vn2, doublecomplex *	auxv, doublecomplex *f, integer *ldf);
static /* Subroutine */ int zunmr3_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *k, integer *l, doublecomplex *a, integer *lda, doublecomplex 	*tau, doublecomplex *c__, integer *ldc, doublecomplex *work, integer *	info);
static /* Subroutine */ int zlarzb_ (Tcl_Interp *interp, char *side, char *trans, char *direct, char *	storev, integer *m, integer *n, integer *k, integer *l, doublecomplex 	*v, integer *ldv, doublecomplex *t, integer *ldt, doublecomplex *c__, 	integer *ldc, doublecomplex *work, integer *ldwork);
static /* Subroutine */ int zlarzt_ (Tcl_Interp *interp, char *direct, char *storev, integer *n, integer *	k, doublecomplex *v, integer *ldv, doublecomplex *tau, doublecomplex *	t, integer *ldt);
static /* Subroutine */ int zlatrz_ (Tcl_Interp *interp, integer *m, integer *n, integer *l, 	doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *	work);
static /* Subroutine */ int dgetf2_ (Tcl_Interp *interp, integer *m, integer *n, doublereal *a, integer *	lda, integer *ipiv, integer *info);
static /* Subroutine */ int dlaswp_ (Tcl_Interp *interp, integer *n, doublereal *a, integer *lda, integer 	*k1, integer *k2, integer *ipiv, integer *incx);
static /* Subroutine */ int zgetf2_ (Tcl_Interp *interp, integer *m, integer *n, doublecomplex *a, 	integer *lda, integer *ipiv, integer *info);
static /* Subroutine */ int zlaswp_ (Tcl_Interp *interp, integer *n, doublecomplex *a, integer *lda, 	integer *k1, integer *k2, integer *ipiv, integer *incx);
static /* Subroutine */ int dlacn2_ (Tcl_Interp *interp, integer *n, doublereal *v, doublereal *x, 	integer *isgn, doublereal *est, integer *kase, integer *isave);
static /* Subroutine */ int dlatrs_ (Tcl_Interp *interp, char *uplo, char *trans, char *diag, char *	normin, integer *n, doublereal *a, integer *lda, doublereal *x, 	doublereal *scale, doublereal *cnorm, integer *info);
static /* Subroutine */ int zlacn2_ (Tcl_Interp *interp, integer *n, doublecomplex *v, doublecomplex *x, 	doublereal *est, integer *kase, integer *isave);
static /* Subroutine */ int dtrexc_ (Tcl_Interp *interp, char *compq, integer *n, doublereal *t, integer *	ldt, doublereal *q, integer *ldq, integer *ifst, integer *ilst, 	doublereal *work, integer *info);
static /* Subroutine */ int dtrsyl_ (Tcl_Interp *interp, char *trana, char *tranb, integer *isgn, integer 	*m, integer *n, doublereal *a, integer *lda, doublereal *b, integer *	ldb, doublereal *c__, integer *ldc, doublereal *scale, integer *info);
static /* Subroutine */ int ztrexc_ (Tcl_Interp *interp, char *compq, integer *n, doublecomplex *t, 	integer *ldt, doublecomplex *q, integer *ldq, integer *ifst, integer *	ilst, integer *info);
static /* Subroutine */ int ztrsyl_ (Tcl_Interp *interp, char *trana, char *tranb, integer *isgn, integer 	*m, integer *n, doublecomplex *a, integer *lda, doublecomplex *b, 	integer *ldb, doublecomplex *c__, integer *ldc, doublereal *scale, 	integer *info);
static /* Subroutine */ int dlasd1_ (Tcl_Interp *interp, integer *nl, integer *nr, integer *sqre, 	doublereal *d__, doublereal *alpha, doublereal *beta, doublereal *u, 	integer *ldu, doublereal *vt, integer *ldvt, integer *idxq, integer *	iwork, doublereal *work, integer *info);
static /* Subroutine */ int dlasdt_ (Tcl_Interp *interp, integer *n, integer *lvl, integer *nd, integer *	inode, integer *ndiml, integer *ndimr, integer *msub);
static /* Subroutine */ int dlasd6_ (Tcl_Interp *interp, integer *icompq, integer *nl, integer *nr, 	integer *sqre, doublereal *d__, doublereal *vf, doublereal *vl, 	doublereal *alpha, doublereal *beta, integer *idxq, integer *perm, 	integer *givptr, integer *givcol, integer *ldgcol, doublereal *givnum, 	 integer *ldgnum, doublereal *poles, doublereal *difl, doublereal *	difr, doublereal *z__, integer *k, doublereal *c__, doublereal *s, 	doublereal *work, integer *iwork, integer *info);
static /* Subroutine */ int dlarf_ (Tcl_Interp *interp, char *side, integer *m, integer *n, doublereal *v, 	 integer *incv, doublereal *tau, doublereal *c__, integer *ldc, 	doublereal *work);
static /* Subroutine */ int dlarfg_ (Tcl_Interp *interp, integer *n, doublereal *alpha, doublereal *x, 	integer *incx, doublereal *tau);
static /* Subroutine */ int dlarfp_ (Tcl_Interp *interp, integer *n, doublereal *alpha, doublereal *x, 	integer *incx, doublereal *tau);
static integer iladlc_ (integer *m, integer *n, doublereal *a, integer *lda);
static integer iladlr_ (integer *m, integer *n, doublereal *a, integer *lda);
static /* Subroutine */ int dtrmv_ (Tcl_Interp *interp, char *uplo, char *trans, char *diag, integer *n, 	doublereal *a, integer *lda, doublereal *x, integer *incx);
static logical dlaisnan_ (doublereal *din1, doublereal *din2);
static /* Subroutine */ int zlarf_ (Tcl_Interp *interp, char *side, integer *m, integer *n, doublecomplex 	*v, integer *incv, doublecomplex *tau, doublecomplex *c__, integer *	ldc, doublecomplex *work);
static /* Subroutine */ int zlarfg_ (Tcl_Interp *interp, integer *n, doublecomplex *alpha, doublecomplex *	x, integer *incx, doublecomplex *tau);
static /* Subroutine */ int zlacgv_ (Tcl_Interp *interp, integer *n, doublecomplex *x, integer *incx);
static /* Subroutine */ int zlarfp_ (Tcl_Interp *interp, integer *n, doublecomplex *alpha, doublecomplex *	x, integer *incx, doublecomplex *tau);
static integer ilazlc_ (integer *m, integer *n, doublecomplex *a, integer *lda);
static integer ilazlr_ (integer *m, integer *n, doublecomplex *a, integer *lda);
static /* Subroutine */ int ztrmv_ (Tcl_Interp *interp, char *uplo, char *trans, char *diag, integer *n, 	doublecomplex *a, integer *lda, doublecomplex *x, integer *incx);
static /* Subroutine */ int dlaruv_ (Tcl_Interp *interp, integer *iseed, integer *n, doublereal *x);
static /* Subroutine */ int dlasq2_ (Tcl_Interp *interp, integer *n, doublereal *z__, integer *info);
static /* Subroutine */ int dlarra_ (Tcl_Interp *interp, integer *n, doublereal *d__, doublereal *e, 	doublereal *e2, doublereal *spltol, doublereal *tnrm, integer *nsplit, 	 integer *isplit, integer *info);
static /* Subroutine */ int dlarrb_ (Tcl_Interp *interp, integer *n, doublereal *d__, doublereal *lld, 	integer *ifirst, integer *ilast, doublereal *rtol1, doublereal *rtol2, 	 integer *offset, doublereal *w, doublereal *wgap, doublereal *werr, 	doublereal *work, integer *iwork, doublereal *pivmin, doublereal *	spdiam, integer *twist, integer *info);
static /* Subroutine */ int dlarrd_ (Tcl_Interp *interp, char *range, char *order, integer *n, doublereal 	*vl, doublereal *vu, integer *il, integer *iu, doublereal *gers, 	doublereal *reltol, doublereal *d__, doublereal *e, doublereal *e2, 	doublereal *pivmin, integer *nsplit, integer *isplit, integer *m, 	doublereal *w, doublereal *werr, doublereal *wl, doublereal *wu, 	integer *iblock, integer *indexw, doublereal *work, integer *iwork, 	integer *info);
static /* Subroutine */ int dlarrk_ (Tcl_Interp *interp, integer *n, integer *iw, doublereal *gl, 	doublereal *gu, doublereal *d__, doublereal *e2, doublereal *pivmin, 	doublereal *reltol, doublereal *w, doublereal *werr, integer *info);
static /* Subroutine */ int dlar1v_ (Tcl_Interp *interp, integer *n, integer *b1, integer *bn, doublereal 	*lambda, doublereal *d__, doublereal *l, doublereal *ld, doublereal *	lld, doublereal *pivmin, doublereal *gaptol, doublereal *z__, logical 	*wantnc, integer *negcnt, doublereal *ztz, doublereal *mingma, 	integer *r__, integer *isuppz, doublereal *nrminv, doublereal *resid, 	doublereal *rqcorr, doublereal *work);
static /* Subroutine */ int dlarrf_ (Tcl_Interp *interp, integer *n, doublereal *d__, doublereal *l, 	doublereal *ld, integer *clstrt, integer *clend, doublereal *w, 	doublereal *wgap, doublereal *werr, doublereal *spdiam, doublereal *	clgapl, doublereal *clgapr, doublereal *pivmin, doublereal *sigma, 	doublereal *dplus, doublereal *lplus, doublereal *work, integer *info);
static /* Subroutine */ int dorm2l_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *	c__, integer *ldc, doublereal *work, integer *info);
static /* Subroutine */ int dsyr2_ (Tcl_Interp *interp, char *uplo, integer *n, doublereal *alpha, 	doublereal *x, integer *incx, doublereal *y, integer *incy, 	doublereal *a, integer *lda);
static /* Subroutine */ int dsymv_ (Tcl_Interp *interp, char *uplo, integer *n, doublereal *alpha, 	doublereal *a, integer *lda, doublereal *x, integer *incx, doublereal 	*beta, doublereal *y, integer *incy);
static /* Subroutine */ int zher2_ (Tcl_Interp *interp, char *uplo, integer *n, doublecomplex *alpha, 	doublecomplex *x, integer *incx, doublecomplex *y, integer *incy, 	doublecomplex *a, integer *lda);
static /* Subroutine */ int zhemv_ (Tcl_Interp *interp, char *uplo, integer *n, doublecomplex *alpha, 	doublecomplex *a, integer *lda, doublecomplex *x, integer *incx, 	doublecomplex *beta, doublecomplex *y, integer *incy);
static /* Subroutine */ int zlar1v_ (Tcl_Interp *interp, integer *n, integer *b1, integer *bn, doublereal 	*lambda, doublereal *d__, doublereal *l, doublereal *ld, doublereal *	lld, doublereal *pivmin, doublereal *gaptol, doublecomplex *z__, 	logical *wantnc, integer *negcnt, doublereal *ztz, doublereal *mingma, 	 integer *r__, integer *isuppz, doublereal *nrminv, doublereal *resid, 	 doublereal *rqcorr, doublereal *work);
static /* Subroutine */ int zunm2l_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *k, doublecomplex *a, integer *lda, doublecomplex *tau, 	doublecomplex *c__, integer *ldc, doublecomplex *work, integer *info);
static /* Subroutine */ int dlanv2_ (Tcl_Interp *interp, doublereal *a, doublereal *b, doublereal *c__, 	doublereal *d__, doublereal *rt1r, doublereal *rt1i, doublereal *rt2r, 	 doublereal *rt2i, doublereal *cs, doublereal *sn);
static /* Subroutine */ int dlaqr3_ (Tcl_Interp *interp, logical *wantt, logical *wantz, integer *n, 	integer *ktop, integer *kbot, integer *nw, doublereal *h__, integer *	ldh, integer *iloz, integer *ihiz, doublereal *z__, integer *ldz, 	integer *ns, integer *nd, doublereal *sr, doublereal *si, doublereal *	v, integer *ldv, integer *nh, doublereal *t, integer *ldt, integer *	nv, doublereal *wv, integer *ldwv, doublereal *work, integer *lwork);
static /* Subroutine */ int dlaqr4_ (Tcl_Interp *interp, logical *wantt, logical *wantz, integer *n, 	integer *ilo, integer *ihi, doublereal *h__, integer *ldh, doublereal 	*wr, doublereal *wi, integer *iloz, integer *ihiz, doublereal *z__, 	integer *ldz, doublereal *work, integer *lwork, integer *info);
static /* Subroutine */ int dlaqr5_ (Tcl_Interp *interp, logical *wantt, logical *wantz, integer *kacc22, 	integer *n, integer *ktop, integer *kbot, integer *nshfts, doublereal 	*sr, doublereal *si, doublereal *h__, integer *ldh, integer *iloz, 	integer *ihiz, doublereal *z__, integer *ldz, doublereal *v, integer *	ldv, doublereal *u, integer *ldu, integer *nv, doublereal *wv, 	integer *ldwv, integer *nh, doublereal *wh, integer *ldwh);
static /* Subroutine */ int dladiv_ (Tcl_Interp *interp, doublereal *a, doublereal *b, doublereal *c__, 	doublereal *d__, doublereal *p, doublereal *q);
static doublereal dcabs1_ (doublecomplex *z__);
static /* Subroutine */ int zlaqr3_ (Tcl_Interp *interp, logical *wantt, logical *wantz, integer *n, 	integer *ktop, integer *kbot, integer *nw, doublecomplex *h__, 	integer *ldh, integer *iloz, integer *ihiz, doublecomplex *z__, 	integer *ldz, integer *ns, integer *nd, doublecomplex *sh, 	doublecomplex *v, integer *ldv, integer *nh, doublecomplex *t, 	integer *ldt, integer *nv, doublecomplex *wv, integer *ldwv, 	doublecomplex *work, integer *lwork);
static /* Subroutine */ int zlaqr4_ (Tcl_Interp *interp, logical *wantt, logical *wantz, integer *n, 	integer *ilo, integer *ihi, doublecomplex *h__, integer *ldh, 	doublecomplex *w, integer *iloz, integer *ihiz, doublecomplex *z__, 	integer *ldz, doublecomplex *work, integer *lwork, integer *info);
static /* Subroutine */ int zlaqr5_ (Tcl_Interp *interp, logical *wantt, logical *wantz, integer *kacc22, 	integer *n, integer *ktop, integer *kbot, integer *nshfts, 	doublecomplex *s, doublecomplex *h__, integer *ldh, integer *iloz, 	integer *ihiz, doublecomplex *z__, integer *ldz, doublecomplex *v, 	integer *ldv, doublecomplex *u, integer *ldu, integer *nv, 	doublecomplex *wv, integer *ldwv, integer *nh, doublecomplex *wh, 	integer *ldwh);
static /* Double Complex */ VOID zladiv_ (doublecomplex * ret_val, doublecomplex *x, 	doublecomplex *y);
static /* Double Complex */ VOID zdotu_ (doublecomplex * ret_val, integer *n, 	doublecomplex *zx, integer *incx, doublecomplex *zy, integer *incy);
static /* Subroutine */ int ztrsv_ (Tcl_Interp *interp, char *uplo, char *trans, char *diag, integer *n, 	doublecomplex *a, integer *lda, doublecomplex *x, integer *incx);
static /* Subroutine */ int dlarz_ (Tcl_Interp *interp, char *side, integer *m, integer *n, integer *l, 	doublereal *v, integer *incv, doublereal *tau, doublereal *c__, 	integer *ldc, doublereal *work);
static /* Subroutine */ int zlarz_ (Tcl_Interp *interp, char *side, integer *m, integer *n, integer *l, 	doublecomplex *v, integer *incv, doublecomplex *tau, doublecomplex *	c__, integer *ldc, doublecomplex *work);
static /* Subroutine */ int dger_ (Tcl_Interp *interp, integer *m, integer *n, doublereal *alpha, 	doublereal *x, integer *incx, doublereal *y, integer *incy, 	doublereal *a, integer *lda);
static /* Subroutine */ int zgeru_ (Tcl_Interp *interp, integer *m, integer *n, doublecomplex *alpha, 	doublecomplex *x, integer *incx, doublecomplex *y, integer *incy, 	doublecomplex *a, integer *lda);
static /* Subroutine */ int dtrsv_ (Tcl_Interp *interp, char *uplo, char *trans, char *diag, integer *n, 	doublereal *a, integer *lda, doublereal *x, integer *incx);
static integer izmax1_ (integer *n, doublecomplex *cx, integer *incx);
static doublereal dzsum1_ (integer *n, doublecomplex *cx, integer *incx);
static /* Subroutine */ int dlaexc_ (Tcl_Interp *interp, logical *wantq, integer *n, doublereal *t, 	integer *ldt, doublereal *q, integer *ldq, integer *j1, integer *n1, 	integer *n2, doublereal *work, integer *info);
static /* Subroutine */ int dlasy2_ (Tcl_Interp *interp, logical *ltranl, logical *ltranr, integer *isgn, 	integer *n1, integer *n2, doublereal *tl, integer *ldtl, doublereal *	tr, integer *ldtr, doublereal *b, integer *ldb, doublereal *scale, 	doublereal *x, integer *ldx, doublereal *xnorm, integer *info);
static /* Subroutine */ int zrot_ (Tcl_Interp *interp, integer *n, doublecomplex *cx, integer *incx, 	doublecomplex *cy, integer *incy, doublereal *c__, doublecomplex *s);
static /* Subroutine */ int zlartg_ (Tcl_Interp *interp, doublecomplex *f, doublecomplex *g, doublereal *	cs, doublecomplex *sn, doublecomplex *r__);
static /* Subroutine */ int dlasd2_ (Tcl_Interp *interp, integer *nl, integer *nr, integer *sqre, integer 	*k, doublereal *d__, doublereal *z__, doublereal *alpha, doublereal *	beta, doublereal *u, integer *ldu, doublereal *vt, integer *ldvt, 	doublereal *dsigma, doublereal *u2, integer *ldu2, doublereal *vt2, 	integer *ldvt2, integer *idxp, integer *idx, integer *idxc, integer *	idxq, integer *coltyp, integer *info);
static /* Subroutine */ int dlasd3_ (Tcl_Interp *interp, integer *nl, integer *nr, integer *sqre, integer 	*k, doublereal *d__, doublereal *q, integer *ldq, doublereal *dsigma, 	doublereal *u, integer *ldu, doublereal *u2, integer *ldu2, 	doublereal *vt, integer *ldvt, doublereal *vt2, integer *ldvt2, 	integer *idxc, integer *ctot, doublereal *z__, integer *info);
static /* Subroutine */ int dlamrg_ (Tcl_Interp *interp, integer *n1, integer *n2, doublereal *a, integer 	*dtrd1, integer *dtrd2, integer *index);
static /* Subroutine */ int dlasd7_ (Tcl_Interp *interp, integer *icompq, integer *nl, integer *nr, 	integer *sqre, integer *k, doublereal *d__, doublereal *z__, 	doublereal *zw, doublereal *vf, doublereal *vfw, doublereal *vl, 	doublereal *vlw, doublereal *alpha, doublereal *beta, doublereal *	dsigma, integer *idx, integer *idxp, integer *idxq, integer *perm, 	integer *givptr, integer *givcol, integer *ldgcol, doublereal *givnum, 	 integer *ldgnum, doublereal *c__, doublereal *s, integer *info);
static /* Subroutine */ int dlasd8_ (Tcl_Interp *interp, integer *icompq, integer *k, doublereal *d__, 	doublereal *z__, doublereal *vf, doublereal *vl, doublereal *difl, 	doublereal *difr, integer *lddifr, doublereal *dsigma, doublereal *	work, integer *info);
static /* Subroutine */ int zgerc_ (Tcl_Interp *interp, integer *m, integer *n, doublecomplex *alpha, 	doublecomplex *x, integer *incx, doublecomplex *y, integer *incy, 	doublecomplex *a, integer *lda);
static doublereal dlapy3_ (doublereal *x, doublereal *y, doublereal *z__);
static /* Subroutine */ int dlasq3_ (Tcl_Interp *interp, integer *i0, integer *n0, doublereal *z__, 	integer *pp, doublereal *dmin__, doublereal *sigma, doublereal *desig, 	 doublereal *qmax, integer *nfail, integer *iter, integer *ndiv, 	logical *ieee, integer *ttype, doublereal *dmin1, doublereal *dmin2, 	doublereal *dn, doublereal *dn1, doublereal *dn2, doublereal *g, 	doublereal *tau);
static integer dlaneg_ (integer *n, doublereal *d__, doublereal *lld, doublereal *	sigma, doublereal *pivmin, integer *r__);
static /* Subroutine */ int dormhr_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *ilo, integer *ihi, doublereal *a, integer *lda, doublereal *	tau, doublereal *c__, integer *ldc, doublereal *work, integer *lwork, 	integer *info);
static /* Subroutine */ int dlaqr2_ (Tcl_Interp *interp, logical *wantt, logical *wantz, integer *n, 	integer *ktop, integer *kbot, integer *nw, doublereal *h__, integer *	ldh, integer *iloz, integer *ihiz, doublereal *z__, integer *ldz, 	integer *ns, integer *nd, doublereal *sr, doublereal *si, doublereal *	v, integer *ldv, integer *nh, doublereal *t, integer *ldt, integer *	nv, doublereal *wv, integer *ldwv, doublereal *work, integer *lwork);
static /* Subroutine */ int dlaqr1_ (Tcl_Interp *interp, integer *n, doublereal *h__, integer *ldh, 	doublereal *sr1, doublereal *si1, doublereal *sr2, doublereal *si2, 	doublereal *v);
static /* Subroutine */ int zunmhr_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *ilo, integer *ihi, doublecomplex *a, integer *lda, 	doublecomplex *tau, doublecomplex *c__, integer *ldc, doublecomplex *	work, integer *lwork, integer *info);
static /* Subroutine */ int zlaqr2_ (Tcl_Interp *interp, logical *wantt, logical *wantz, integer *n, 	integer *ktop, integer *kbot, integer *nw, doublecomplex *h__, 	integer *ldh, integer *iloz, integer *ihiz, doublecomplex *z__, 	integer *ldz, integer *ns, integer *nd, doublecomplex *sh, 	doublecomplex *v, integer *ldv, integer *nh, doublecomplex *t, 	integer *ldt, integer *nv, doublecomplex *wv, integer *ldwv, 	doublecomplex *work, integer *lwork);
static /* Subroutine */ int zlaqr1_ (Tcl_Interp *interp, integer *n, doublecomplex *h__, integer *ldh, 	doublecomplex *s1, doublecomplex *s2, doublecomplex *v);
static /* Subroutine */ int dlarfx_ (Tcl_Interp *interp, char *side, integer *m, integer *n, doublereal *	v, doublereal *tau, doublereal *c__, integer *ldc, doublereal *work);
static /* Subroutine */ int dlasd4_ (Tcl_Interp *interp, integer *n, integer *i__, doublereal *d__, 	doublereal *z__, doublereal *delta, doublereal *rho, doublereal *	sigma, doublereal *work, integer *info);
static /* Subroutine */ int dlasq4_ (Tcl_Interp *interp, integer *i0, integer *n0, doublereal *z__, 	integer *pp, integer *n0in, doublereal *dmin__, doublereal *dmin1, 	doublereal *dmin2, doublereal *dn, doublereal *dn1, doublereal *dn2, 	doublereal *tau, integer *ttype, doublereal *g);
static /* Subroutine */ int dlasq5_ (Tcl_Interp *interp, integer *i0, integer *n0, doublereal *z__, 	integer *pp, doublereal *tau, doublereal *dmin__, doublereal *dmin1, 	doublereal *dmin2, doublereal *dn, doublereal *dnm1, doublereal *dnm2, 	 logical *ieee);
static /* Subroutine */ int dlasq6_ (Tcl_Interp *interp, integer *i0, integer *n0, doublereal *z__, 	integer *pp, doublereal *dmin__, doublereal *dmin1, doublereal *dmin2, 	 doublereal *dn, doublereal *dnm1, doublereal *dnm2);
static /* Subroutine */ int dlaed6_ (Tcl_Interp *interp, integer *kniter, logical *orgati, doublereal *	rho, doublereal *d__, doublereal *z__, doublereal *finit, doublereal *	tau, integer *info);
static /* Subroutine */ int dlasd5_ (Tcl_Interp *interp, integer *i__, doublereal *d__, doublereal *z__, 	doublereal *delta, doublereal *rho, doublereal *dsigma, doublereal *	work);

/* defined constants */
static integer dgesdd_c__1 = 1;
static integer dgesdd_c_n1 = -1;
static integer dgesdd_c__0 = 0;
static doublereal dgesdd_c_b227 = 0.;
static doublereal dgesdd_c_b248 = 1.;
static doublecomplex zgesdd_c_b1 = {0.,0.};
static doublecomplex zgesdd_c_b2 = {1.,0.};
static integer zgesdd_c__1 = 1;
static integer zgesdd_c_n1 = -1;
static integer zgesdd_c__0 = 0;
static integer dsyevr_c__10 = 10;
static integer dsyevr_c__1 = 1;
static integer dsyevr_c__2 = 2;
static integer dsyevr_c__3 = 3;
static integer dsyevr_c__4 = 4;
static integer dsyevr_c_n1 = -1;
static integer zheevr_c__10 = 10;
static integer zheevr_c__1 = 1;
static integer zheevr_c__2 = 2;
static integer zheevr_c__3 = 3;
static integer zheevr_c__4 = 4;
static integer zheevr_c_n1 = -1;
static integer dgeev_c__1 = 1;
static integer dgeev_c__0 = 0;
static integer dgeev_c_n1 = -1;
static integer zgeev_c__1 = 1;
static integer zgeev_c__0 = 0;
static integer zgeev_c_n1 = -1;
static integer dgelss_c__6 = 6;
static integer dgelss_c_n1 = -1;
static integer dgelss_c__1 = 1;
static integer dgelss_c__0 = 0;
static doublereal dgelss_c_b74 = 0.;
static doublereal dgelss_c_b108 = 1.;
static doublecomplex zgelss_c_b1 = {0.,0.};
static doublecomplex zgelss_c_b2 = {1.,0.};
static integer zgelss_c__6 = 6;
static integer zgelss_c_n1 = -1;
static integer zgelss_c__1 = 1;
static integer zgelss_c__0 = 0;
static doublereal zgelss_c_b78 = 0.;
static integer dgelsy_c__1 = 1;
static integer dgelsy_c_n1 = -1;
static integer dgelsy_c__0 = 0;
static doublereal dgelsy_c_b31 = 0.;
static integer dgelsy_c__2 = 2;
static doublereal dgelsy_c_b54 = 1.;
static doublecomplex zgelsy_c_b1 = {0.,0.};
static doublecomplex zgelsy_c_b2 = {1.,0.};
static integer zgelsy_c__1 = 1;
static integer zgelsy_c_n1 = -1;
static integer zgelsy_c__0 = 0;
static integer zgelsy_c__2 = 2;
static integer dgees_c__1 = 1;
static integer dgees_c__0 = 0;
static integer dgees_c_n1 = -1;
static integer zgees_c__1 = 1;
static integer zgees_c__0 = 0;
static integer zgees_c_n1 = -1;
static integer dbdsdc_c__9 = 9;
static integer dbdsdc_c__0 = 0;
static doublereal dbdsdc_c_b15 = 1.;
static integer dbdsdc_c__1 = 1;
static doublereal dbdsdc_c_b29 = 0.;
static integer dgebrd_c__1 = 1;
static integer dgebrd_c_n1 = -1;
static integer dgebrd_c__3 = 3;
static integer dgebrd_c__2 = 2;
static doublereal dgebrd_c_b21 = -1.;
static doublereal dgebrd_c_b22 = 1.;
static integer dlange_c__1 = 1;
static integer dgelqf_c__1 = 1;
static integer dgelqf_c_n1 = -1;
static integer dgelqf_c__3 = 3;
static integer dgelqf_c__2 = 2;
static integer dgeqrf_c__1 = 1;
static integer dgeqrf_c_n1 = -1;
static integer dgeqrf_c__3 = 3;
static integer dgeqrf_c__2 = 2;
static integer dorgbr_c__1 = 1;
static integer dorgbr_c_n1 = -1;
static integer ilaenv_c__1 = 1;
static real ilaenv_c_b163 = 0.f;
static real ilaenv_c_b164 = 1.f;
static integer ilaenv_c__0 = 0;
static integer dormbr_c__1 = 1;
static integer dormbr_c_n1 = -1;
static integer dormbr_c__2 = 2;
static integer dorglq_c__1 = 1;
static integer dorglq_c_n1 = -1;
static integer dorglq_c__3 = 3;
static integer dorglq_c__2 = 2;
static integer dorgqr_c__1 = 1;
static integer dorgqr_c_n1 = -1;
static integer dorgqr_c__3 = 3;
static integer dorgqr_c__2 = 2;
static doublecomplex zgebrd_c_b1 = {1.,0.};
static integer zgebrd_c__1 = 1;
static integer zgebrd_c_n1 = -1;
static integer zgebrd_c__3 = 3;
static integer zgebrd_c__2 = 2;
static integer zlange_c__1 = 1;
static integer zgelqf_c__1 = 1;
static integer zgelqf_c_n1 = -1;
static integer zgelqf_c__3 = 3;
static integer zgelqf_c__2 = 2;
static doublereal zlacrm_c_b6 = 1.;
static doublereal zlacrm_c_b7 = 0.;
static doublereal zlarcm_c_b6 = 1.;
static doublereal zlarcm_c_b7 = 0.;
static integer zgeqrf_c__1 = 1;
static integer zgeqrf_c_n1 = -1;
static integer zgeqrf_c__3 = 3;
static integer zgeqrf_c__2 = 2;
static integer zungbr_c__1 = 1;
static integer zungbr_c_n1 = -1;
static integer zunmbr_c__1 = 1;
static integer zunmbr_c_n1 = -1;
static integer zunmbr_c__2 = 2;
static integer zunglq_c__1 = 1;
static integer zunglq_c_n1 = -1;
static integer zunglq_c__3 = 3;
static integer zunglq_c__2 = 2;
static integer zungqr_c__1 = 1;
static integer zungqr_c_n1 = -1;
static integer zungqr_c__3 = 3;
static integer zungqr_c__2 = 2;
static integer dstein_c__2 = 2;
static integer dstein_c__1 = 1;
static integer dstein_c_n1 = -1;
static integer dsterf_c__0 = 0;
static integer dsterf_c__1 = 1;
static doublereal dsterf_c_b32 = 1.;
static integer dlansy_c__1 = 1;
static integer dstebz_c__1 = 1;
static integer dstebz_c_n1 = -1;
static integer dstebz_c__3 = 3;
static integer dstebz_c__2 = 2;
static integer dstebz_c__0 = 0;
static integer dstemr_c__1 = 1;
static doublereal dstemr_c_b18 = .001;
static integer dormtr_c__1 = 1;
static integer dormtr_c_n1 = -1;
static integer dormtr_c__2 = 2;
static integer dsytrd_c__1 = 1;
static integer dsytrd_c_n1 = -1;
static integer dsytrd_c__3 = 3;
static integer dsytrd_c__2 = 2;
static doublereal dsytrd_c_b22 = -1.;
static doublereal dsytrd_c_b23 = 1.;
static integer zhetrd_c__1 = 1;
static integer zhetrd_c_n1 = -1;
static integer zhetrd_c__3 = 3;
static integer zhetrd_c__2 = 2;
static doublereal zhetrd_c_b23 = 1.;
static integer zstein_c__2 = 2;
static integer zstein_c__1 = 1;
static integer zstein_c_n1 = -1;
static integer zlansy_c__1 = 1;
static integer zstemr_c__1 = 1;
static doublereal zstemr_c_b18 = .001;
static integer zunmtr_c__1 = 1;
static integer zunmtr_c_n1 = -1;
static integer zunmtr_c__2 = 2;
static integer dgebal_c__1 = 1;
static integer dgehrd_c__1 = 1;
static integer dgehrd_c_n1 = -1;
static integer dgehrd_c__3 = 3;
static integer dgehrd_c__2 = 2;
static integer dgehrd_c__65 = 65;
static doublereal dgehrd_c_b25 = -1.;
static doublereal dgehrd_c_b26 = 1.;
static integer dorghr_c__1 = 1;
static integer dorghr_c_n1 = -1;
static doublereal dhseqr_c_b11 = 0.;
static doublereal dhseqr_c_b12 = 1.;
static integer dhseqr_c__12 = 12;
static integer dhseqr_c__2 = 2;
static integer dhseqr_c__49 = 49;
static logical dtrevc_c_false = FALSE_;
static integer dtrevc_c__1 = 1;
static doublereal dtrevc_c_b22 = 1.;
static doublereal dtrevc_c_b25 = 0.;
static integer dtrevc_c__2 = 2;
static logical dtrevc_c_true = TRUE_;
static integer zgebal_c__1 = 1;
static doublecomplex zgehrd_c_b2 = {1.,0.};
static integer zgehrd_c__1 = 1;
static integer zgehrd_c_n1 = -1;
static integer zgehrd_c__3 = 3;
static integer zgehrd_c__2 = 2;
static integer zgehrd_c__65 = 65;
static doublecomplex zhseqr_c_b1 = {0.,0.};
static doublecomplex zhseqr_c_b2 = {1.,0.};
static integer zhseqr_c__1 = 1;
static integer zhseqr_c__12 = 12;
static integer zhseqr_c__2 = 2;
static integer zhseqr_c__49 = 49;
static doublecomplex ztrevc_c_b2 = {1.,0.};
static integer ztrevc_c__1 = 1;
static integer zunghr_c__1 = 1;
static integer zunghr_c_n1 = -1;
static doublereal dbdsqr_c_b15 = -.125;
static integer dbdsqr_c__1 = 1;
static doublereal dbdsqr_c_b49 = 1.;
static doublereal dbdsqr_c_b72 = -1.;
static integer dormlq_c__1 = 1;
static integer dormlq_c_n1 = -1;
static integer dormlq_c__2 = 2;
static integer dormlq_c__65 = 65;
static integer dormqr_c__1 = 1;
static integer dormqr_c_n1 = -1;
static integer dormqr_c__2 = 2;
static integer dormqr_c__65 = 65;
static doublereal zbdsqr_c_b15 = -.125;
static integer zbdsqr_c__1 = 1;
static doublereal zbdsqr_c_b49 = 1.;
static doublereal zbdsqr_c_b72 = -1.;
static integer zunmlq_c__1 = 1;
static integer zunmlq_c_n1 = -1;
static integer zunmlq_c__2 = 2;
static integer zunmlq_c__65 = 65;
static integer zunmqr_c__1 = 1;
static integer zunmqr_c_n1 = -1;
static integer zunmqr_c__2 = 2;
static integer zunmqr_c__65 = 65;
static integer dlaic1_c__1 = 1;
static doublereal dlaic1_c_b5 = 1.;
static integer dgeqp3_c__1 = 1;
static integer dgeqp3_c_n1 = -1;
static integer dgeqp3_c__3 = 3;
static integer dgeqp3_c__2 = 2;
static integer dormrz_c__1 = 1;
static integer dormrz_c_n1 = -1;
static integer dormrz_c__2 = 2;
static integer dormrz_c__65 = 65;
static integer dtzrzf_c__1 = 1;
static integer dtzrzf_c_n1 = -1;
static integer dtzrzf_c__3 = 3;
static integer dtzrzf_c__2 = 2;
static doublecomplex ztrsm_c_b1 = {1.,0.};
static integer zlaic1_c__1 = 1;
static integer zgeqp3_c__1 = 1;
static integer zgeqp3_c_n1 = -1;
static integer zgeqp3_c__3 = 3;
static integer zgeqp3_c__2 = 2;
static integer zunmrz_c__1 = 1;
static integer zunmrz_c_n1 = -1;
static integer zunmrz_c__2 = 2;
static integer zunmrz_c__65 = 65;
static integer ztzrzf_c__1 = 1;
static integer ztzrzf_c_n1 = -1;
static integer ztzrzf_c__3 = 3;
static integer ztzrzf_c__2 = 2;
static integer dgetrf_c__1 = 1;
static integer dgetrf_c_n1 = -1;
static doublereal dgetrf_c_b16 = 1.;
static doublereal dgetrf_c_b19 = -1.;
static integer dgetrs_c__1 = 1;
static doublereal dgetrs_c_b12 = 1.;
static integer dgetrs_c_n1 = -1;
static doublecomplex zgetrf_c_b1 = {1.,0.};
static integer zgetrf_c__1 = 1;
static integer zgetrf_c_n1 = -1;
static doublecomplex zgetrs_c_b1 = {1.,0.};
static integer zgetrs_c__1 = 1;
static integer zgetrs_c_n1 = -1;
static integer dgecon_c__1 = 1;
static integer dgerfs_c__1 = 1;
static doublereal dgerfs_c_b15 = -1.;
static doublereal dgerfs_c_b17 = 1.;
static integer dlantr_c__1 = 1;
static integer zgecon_c__1 = 1;
static doublecomplex zgerfs_c_b1 = {1.,0.};
static integer zgerfs_c__1 = 1;
static integer zlantr_c__1 = 1;
static integer dtrsen_c_n1 = -1;
static integer ztrsen_c_n1 = -1;
static integer dlasd0_c__0 = 0;
static integer dlasd0_c__2 = 2;
static integer dlasda_c__0 = 0;
static doublereal dlasda_c_b11 = 0.;
static doublereal dlasda_c_b12 = 1.;
static integer dlasda_c__1 = 1;
static integer dlasda_c__2 = 2;
static integer dlasdq_c__1 = 1;
static integer dlanst_c__1 = 1;
static integer dgebd2_c__1 = 1;
static doublereal dlabrd_c_b4 = -1.;
static doublereal dlabrd_c_b5 = 1.;
static integer dlabrd_c__1 = 1;
static doublereal dlabrd_c_b16 = 0.;
static integer dlarfb_c__1 = 1;
static doublereal dlarfb_c_b14 = 1.;
static doublereal dlarfb_c_b25 = -1.;
static integer dlarft_c__1 = 1;
static doublereal dlarft_c_b8 = 0.;
static integer dgeqr2_c__1 = 1;
static integer dorg2r_c__1 = 1;
static integer zgebd2_c__1 = 1;
static doublecomplex zlabrd_c_b1 = {0.,0.};
static doublecomplex zlabrd_c_b2 = {1.,0.};
static integer zlabrd_c__1 = 1;
static doublecomplex zlarfb_c_b1 = {1.,0.};
static integer zlarfb_c__1 = 1;
static doublecomplex zlarft_c_b2 = {0.,0.};
static integer zlarft_c__1 = 1;
static integer zgeqr2_c__1 = 1;
static integer zung2r_c__1 = 1;
static integer dlarre_c__1 = 1;
static integer dlarre_c__2 = 2;
static doublereal dlarrv_c_b5 = 0.;
static integer dlarrv_c__1 = 1;
static integer dlarrv_c__2 = 2;
static integer dormql_c__1 = 1;
static integer dormql_c_n1 = -1;
static integer dormql_c__2 = 2;
static integer dormql_c__65 = 65;
static integer dsytd2_c__1 = 1;
static doublereal dsytd2_c_b8 = 0.;
static doublereal dsytd2_c_b14 = -1.;
static doublereal dlatrd_c_b5 = -1.;
static doublereal dlatrd_c_b6 = 1.;
static integer dlatrd_c__1 = 1;
static doublereal dlatrd_c_b16 = 0.;
static doublecomplex zhetd2_c_b2 = {0.,0.};
static integer zhetd2_c__1 = 1;
static doublecomplex zlatrd_c_b1 = {0.,0.};
static doublecomplex zlatrd_c_b2 = {1.,0.};
static integer zlatrd_c__1 = 1;
static doublecomplex zlarrv_c_b1 = {0.,0.};
static integer zlarrv_c__1 = 1;
static integer zlarrv_c__2 = 2;
static doublereal zlarrv_c_b28 = 0.;
static integer zunmql_c__1 = 1;
static integer zunmql_c_n1 = -1;
static integer zunmql_c__2 = 2;
static integer zunmql_c__65 = 65;
static integer dgehd2_c__1 = 1;
static doublereal dlahr2_c_b4 = -1.;
static doublereal dlahr2_c_b5 = 1.;
static integer dlahr2_c__1 = 1;
static doublereal dlahr2_c_b38 = 0.;
static integer dlaqr0_c__13 = 13;
static integer dlaqr0_c__15 = 15;
static integer dlaqr0_c_n1 = -1;
static integer dlaqr0_c__12 = 12;
static integer dlaqr0_c__14 = 14;
static integer dlaqr0_c__16 = 16;
static logical dlaqr0_c_false = FALSE_;
static integer dlaqr0_c__1 = 1;
static integer dlaqr0_c__3 = 3;
static integer dlahqr_c__1 = 1;
static integer zgehd2_c__1 = 1;
static doublecomplex zlahr2_c_b1 = {0.,0.};
static doublecomplex zlahr2_c_b2 = {1.,0.};
static integer zlahr2_c__1 = 1;
static integer zlaqr0_c__13 = 13;
static integer zlaqr0_c__15 = 15;
static integer zlaqr0_c_n1 = -1;
static integer zlaqr0_c__12 = 12;
static integer zlaqr0_c__14 = 14;
static integer zlaqr0_c__16 = 16;
static logical zlaqr0_c_false = FALSE_;
static integer zlaqr0_c__1 = 1;
static integer zlaqr0_c__3 = 3;
static integer zlahqr_c__1 = 1;
static integer zlahqr_c__2 = 2;
static integer zlatrs_c__1 = 1;
static doublereal zlatrs_c_b36 = .5;
static integer dlasq1_c__1 = 1;
static integer dlasq1_c__2 = 2;
static integer dlasq1_c__0 = 0;
static doublereal dlasv2_c_b3 = 2.;
static doublereal dlasv2_c_b4 = 1.;
static integer dorm2r_c__1 = 1;
static integer zunm2r_c__1 = 1;
static integer dlaqp2_c__1 = 1;
static integer dlaqps_c__1 = 1;
static doublereal dlaqps_c_b8 = -1.;
static doublereal dlaqps_c_b9 = 1.;
static doublereal dlaqps_c_b16 = 0.;
static integer dlarzb_c__1 = 1;
static doublereal dlarzb_c_b13 = 1.;
static doublereal dlarzb_c_b23 = -1.;
static doublereal dlarzt_c_b8 = 0.;
static integer dlarzt_c__1 = 1;
static integer zlaqp2_c__1 = 1;
static doublecomplex zlaqps_c_b1 = {0.,0.};
static doublecomplex zlaqps_c_b2 = {1.,0.};
static integer zlaqps_c__1 = 1;
static doublecomplex zlarzb_c_b1 = {1.,0.};
static integer zlarzb_c__1 = 1;
static doublecomplex zlarzt_c_b1 = {0.,0.};
static integer zlarzt_c__1 = 1;
static integer dgetf2_c__1 = 1;
static doublereal dgetf2_c_b8 = -1.;
static doublecomplex zgetf2_c_b1 = {1.,0.};
static integer zgetf2_c__1 = 1;
static integer dlacn2_c__1 = 1;
static doublereal dlacn2_c_b11 = 1.;
static integer dlatrs_c__1 = 1;
static doublereal dlatrs_c_b36 = .5;
static integer zlacn2_c__1 = 1;
static integer dtrexc_c__1 = 1;
static integer dtrexc_c__2 = 2;
static integer dtrsyl_c__1 = 1;
static logical dtrsyl_c_false = FALSE_;
static integer dtrsyl_c__2 = 2;
static doublereal dtrsyl_c_b26 = 1.;
static doublereal dtrsyl_c_b30 = 0.;
static logical dtrsyl_c_true = TRUE_;
static integer ztrexc_c__1 = 1;
static integer ztrsyl_c__1 = 1;
static integer dlasd1_c__0 = 0;
static doublereal dlasd1_c_b7 = 1.;
static integer dlasd1_c__1 = 1;
static integer dlasd1_c_n1 = -1;
static integer dlasd6_c__0 = 0;
static doublereal dlasd6_c_b7 = 1.;
static integer dlasd6_c__1 = 1;
static integer dlasd6_c_n1 = -1;
static doublereal dlarf_c_b4 = 1.;
static doublereal dlarf_c_b5 = 0.;
static integer dlarf_c__1 = 1;
static doublecomplex zlarf_c_b1 = {1.,0.};
static doublecomplex zlarf_c_b2 = {0.,0.};
static integer zlarf_c__1 = 1;
static doublecomplex zlarfg_c_b5 = {1.,0.};
static doublecomplex zlarfp_c_b5 = {1.,0.};
static integer dlasq2_c__1 = 1;
static integer dlasq2_c__2 = 2;
static integer dlasq2_c__10 = 10;
static integer dlasq2_c__3 = 3;
static integer dlasq2_c__4 = 4;
static integer dlasq2_c__11 = 11;
static integer dlarrd_c__1 = 1;
static integer dlarrd_c_n1 = -1;
static integer dlarrd_c__3 = 3;
static integer dlarrd_c__2 = 2;
static integer dlarrd_c__0 = 0;
static integer dlarrf_c__1 = 1;
static integer dorm2l_c__1 = 1;
static integer zunm2l_c__1 = 1;
static doublereal dlanv2_c_b4 = 1.;
static integer dlaqr3_c__1 = 1;
static integer dlaqr3_c_n1 = -1;
static logical dlaqr3_c_true = TRUE_;
static doublereal dlaqr3_c_b17 = 0.;
static doublereal dlaqr3_c_b18 = 1.;
static integer dlaqr3_c__12 = 12;
static integer dlaqr4_c__13 = 13;
static integer dlaqr4_c__15 = 15;
static integer dlaqr4_c_n1 = -1;
static integer dlaqr4_c__12 = 12;
static integer dlaqr4_c__14 = 14;
static integer dlaqr4_c__16 = 16;
static logical dlaqr4_c_false = FALSE_;
static integer dlaqr4_c__1 = 1;
static integer dlaqr4_c__3 = 3;
static doublereal dlaqr5_c_b7 = 0.;
static doublereal dlaqr5_c_b8 = 1.;
static integer dlaqr5_c__3 = 3;
static integer dlaqr5_c__1 = 1;
static integer dlaqr5_c__2 = 2;
static doublecomplex zlaqr3_c_b1 = {0.,0.};
static doublecomplex zlaqr3_c_b2 = {1.,0.};
static integer zlaqr3_c__1 = 1;
static integer zlaqr3_c_n1 = -1;
static logical zlaqr3_c_true = TRUE_;
static integer zlaqr3_c__12 = 12;
static integer zlaqr4_c__13 = 13;
static integer zlaqr4_c__15 = 15;
static integer zlaqr4_c_n1 = -1;
static integer zlaqr4_c__12 = 12;
static integer zlaqr4_c__14 = 14;
static integer zlaqr4_c__16 = 16;
static logical zlaqr4_c_false = FALSE_;
static integer zlaqr4_c__1 = 1;
static integer zlaqr4_c__3 = 3;
static doublecomplex zlaqr5_c_b1 = {0.,0.};
static doublecomplex zlaqr5_c_b2 = {1.,0.};
static integer zlaqr5_c__3 = 3;
static integer zlaqr5_c__1 = 1;
static integer zlaqr5_c__2 = 2;
static integer dlarz_c__1 = 1;
static doublereal dlarz_c_b5 = 1.;
static doublecomplex zlarz_c_b1 = {1.,0.};
static integer zlarz_c__1 = 1;
static integer dlaexc_c__1 = 1;
static integer dlaexc_c__4 = 4;
static logical dlaexc_c_false = FALSE_;
static integer dlaexc_c_n1 = -1;
static integer dlaexc_c__2 = 2;
static integer dlaexc_c__3 = 3;
static integer dlasy2_c__4 = 4;
static integer dlasy2_c__1 = 1;
static integer dlasy2_c__16 = 16;
static integer dlasy2_c__0 = 0;
static integer dlasd2_c__1 = 1;
static doublereal dlasd2_c_b30 = 0.;
static integer dlasd3_c__1 = 1;
static integer dlasd3_c__0 = 0;
static doublereal dlasd3_c_b13 = 1.;
static doublereal dlasd3_c_b26 = 0.;
static integer dlasd7_c__1 = 1;
static integer dlasd8_c__1 = 1;
static integer dlasd8_c__0 = 0;
static doublereal dlasd8_c_b8 = 1.;
static integer dormhr_c__1 = 1;
static integer dormhr_c_n1 = -1;
static integer dormhr_c__2 = 2;
static integer dlaqr2_c__1 = 1;
static integer dlaqr2_c_n1 = -1;
static doublereal dlaqr2_c_b12 = 0.;
static doublereal dlaqr2_c_b13 = 1.;
static logical dlaqr2_c_true = TRUE_;
static integer zunmhr_c__1 = 1;
static integer zunmhr_c_n1 = -1;
static integer zunmhr_c__2 = 2;
static doublecomplex zlaqr2_c_b1 = {0.,0.};
static doublecomplex zlaqr2_c_b2 = {1.,0.};
static integer zlaqr2_c__1 = 1;
static integer zlaqr2_c_n1 = -1;
static logical zlaqr2_c_true = TRUE_;
static integer dlarfx_c__1 = 1;
/* defined functions */
MODULE_SCOPE /* Subroutine */ int dgesdd_ (Tcl_Interp *interp, char *jobz, integer *m, integer *n, doublereal *	a, integer *lda, doublereal *s, doublereal *u, integer *ldu, 	doublereal *vt, integer *ldvt, doublereal *work, integer *lwork, 	integer *iwork, integer *info)
{
    integer a_dim1, a_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__1, 
	    i__2, i__3;

    double sqrt(doublereal);

    integer i__, ie, il, ir, iu, blk;
    doublereal dum[1], eps;
    integer ivt, iscl;
    doublereal anrm;
    integer idum[1], ierr, itau;
    integer chunk, minmn, wrkbl, itaup, itauq, mnthr;
    logical wntqa;
    integer nwork;
    logical wntqn, wntqo, wntqs;
    integer bdspac;
    doublereal bignum;
    integer ldwrkl, ldwrkr, minwrk, ldwrku, maxwrk, ldwkvt;
    doublereal smlnum;
    logical wntqas, lquery;































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

    *info = 0;
    minmn = min(*m,*n);
    wntqa = lsame_(jobz, "A");
    wntqs = lsame_(jobz, "S");
    wntqas = wntqa || wntqs;
    wntqo = lsame_(jobz, "O");
    wntqn = lsame_(jobz, "N");
    lquery = *lwork == -1;

    if (! (wntqa || wntqs || wntqo || wntqn)) {
	*info = -1;
    } else if (*m < 0) {
	*info = -2;
    } else if (*n < 0) {
	*info = -3;
    } else if (*lda < max(1,*m)) {
	*info = -5;
    } else if (*ldu < 1 || wntqas && *ldu < *m || wntqo && *m < *n && *ldu < *
	    m) {
	*info = -8;
    } else if (*ldvt < 1 || wntqa && *ldvt < *n || wntqs && *ldvt < minmn || 
	    wntqo && *m >= *n && *ldvt < *n) {
	*info = -10;
    }


    if (*info == 0) {
	minwrk = 1;
	maxwrk = 1;
	if (*m >= *n && minmn > 0) {


	    mnthr = (integer) (minmn * 11. / 6.);
	    if (wntqn) {
		bdspac = *n * 7;
	    } else {
		bdspac = *n * 3 * *n + (*n << 2);
	    }
	    if (*m >= mnthr) {
		if (wntqn) {


		    wrkbl = *n + *n * ilaenv_(&dgesdd_c__1, "DGEQRF", " ", m, n, &
			    dgesdd_c_n1, &dgesdd_c_n1);
		    i__1 = wrkbl, i__2 = *n * 3 + (*n << 1) * ilaenv_(&dgesdd_c__1, 
			    "DGEBRD", " ", n, n, &dgesdd_c_n1, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = bdspac + *n;
		    maxwrk = max(i__1,i__2);
		    minwrk = bdspac + *n;
		} else if (wntqo) {


		    wrkbl = *n + *n * ilaenv_(&dgesdd_c__1, "DGEQRF", " ", m, n, &
			    dgesdd_c_n1, &dgesdd_c_n1);
		    i__1 = wrkbl, i__2 = *n + *n * ilaenv_(&dgesdd_c__1, "DORGQR", 
			    " ", m, n, n, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = *n * 3 + (*n << 1) * ilaenv_(&dgesdd_c__1, 
			    "DGEBRD", " ", n, n, &dgesdd_c_n1, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = *n * 3 + *n * ilaenv_(&dgesdd_c__1, "DORMBR"
, "QLN", n, n, n, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = *n * 3 + *n * ilaenv_(&dgesdd_c__1, "DORMBR"
, "PRT", n, n, n, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = bdspac + *n * 3;
		    wrkbl = max(i__1,i__2);
		    maxwrk = wrkbl + (*n << 1) * *n;
		    minwrk = bdspac + (*n << 1) * *n + *n * 3;
		} else if (wntqs) {


		    wrkbl = *n + *n * ilaenv_(&dgesdd_c__1, "DGEQRF", " ", m, n, &
			    dgesdd_c_n1, &dgesdd_c_n1);
		    i__1 = wrkbl, i__2 = *n + *n * ilaenv_(&dgesdd_c__1, "DORGQR", 
			    " ", m, n, n, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = *n * 3 + (*n << 1) * ilaenv_(&dgesdd_c__1, 
			    "DGEBRD", " ", n, n, &dgesdd_c_n1, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = *n * 3 + *n * ilaenv_(&dgesdd_c__1, "DORMBR"
, "QLN", n, n, n, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = *n * 3 + *n * ilaenv_(&dgesdd_c__1, "DORMBR"
, "PRT", n, n, n, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = bdspac + *n * 3;
		    wrkbl = max(i__1,i__2);
		    maxwrk = wrkbl + *n * *n;
		    minwrk = bdspac + *n * *n + *n * 3;
		} else if (wntqa) {


		    wrkbl = *n + *n * ilaenv_(&dgesdd_c__1, "DGEQRF", " ", m, n, &
			    dgesdd_c_n1, &dgesdd_c_n1);
		    i__1 = wrkbl, i__2 = *n + *m * ilaenv_(&dgesdd_c__1, "DORGQR", 
			    " ", m, m, n, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = *n * 3 + (*n << 1) * ilaenv_(&dgesdd_c__1, 
			    "DGEBRD", " ", n, n, &dgesdd_c_n1, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = *n * 3 + *n * ilaenv_(&dgesdd_c__1, "DORMBR"
, "QLN", n, n, n, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = *n * 3 + *n * ilaenv_(&dgesdd_c__1, "DORMBR"
, "PRT", n, n, n, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = bdspac + *n * 3;
		    wrkbl = max(i__1,i__2);
		    maxwrk = wrkbl + *n * *n;
		    minwrk = bdspac + *n * *n + *n * 3;
		}
	    } else {


		wrkbl = *n * 3 + (*m + *n) * ilaenv_(&dgesdd_c__1, "DGEBRD", " ", m, 
			n, &dgesdd_c_n1, &dgesdd_c_n1);
		if (wntqn) {
		    i__1 = wrkbl, i__2 = bdspac + *n * 3;
		    maxwrk = max(i__1,i__2);
		    minwrk = *n * 3 + max(*m,bdspac);
		} else if (wntqo) {
		    i__1 = wrkbl, i__2 = *n * 3 + *n * ilaenv_(&dgesdd_c__1, "DORMBR"
, "QLN", m, n, n, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = *n * 3 + *n * ilaenv_(&dgesdd_c__1, "DORMBR"
, "PRT", n, n, n, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = bdspac + *n * 3;
		    wrkbl = max(i__1,i__2);
		    maxwrk = wrkbl + *m * *n;
		    i__1 = *m, i__2 = *n * *n + bdspac;
		    minwrk = *n * 3 + max(i__1,i__2);
		} else if (wntqs) {
		    i__1 = wrkbl, i__2 = *n * 3 + *n * ilaenv_(&dgesdd_c__1, "DORMBR"
, "QLN", m, n, n, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = *n * 3 + *n * ilaenv_(&dgesdd_c__1, "DORMBR"
, "PRT", n, n, n, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = bdspac + *n * 3;
		    maxwrk = max(i__1,i__2);
		    minwrk = *n * 3 + max(*m,bdspac);
		} else if (wntqa) {
		    i__1 = wrkbl, i__2 = *n * 3 + *m * ilaenv_(&dgesdd_c__1, "DORMBR"
, "QLN", m, m, n, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = *n * 3 + *n * ilaenv_(&dgesdd_c__1, "DORMBR"
, "PRT", n, n, n, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = maxwrk, i__2 = bdspac + *n * 3;
		    maxwrk = max(i__1,i__2);
		    minwrk = *n * 3 + max(*m,bdspac);
		}
	    }
	} else if (minmn > 0) {


	    mnthr = (integer) (minmn * 11. / 6.);
	    if (wntqn) {
		bdspac = *m * 7;
	    } else {
		bdspac = *m * 3 * *m + (*m << 2);
	    }
	    if (*n >= mnthr) {
		if (wntqn) {


		    wrkbl = *m + *m * ilaenv_(&dgesdd_c__1, "DGELQF", " ", m, n, &
			    dgesdd_c_n1, &dgesdd_c_n1);
		    i__1 = wrkbl, i__2 = *m * 3 + (*m << 1) * ilaenv_(&dgesdd_c__1, 
			    "DGEBRD", " ", m, m, &dgesdd_c_n1, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = bdspac + *m;
		    maxwrk = max(i__1,i__2);
		    minwrk = bdspac + *m;
		} else if (wntqo) {


		    wrkbl = *m + *m * ilaenv_(&dgesdd_c__1, "DGELQF", " ", m, n, &
			    dgesdd_c_n1, &dgesdd_c_n1);
		    i__1 = wrkbl, i__2 = *m + *m * ilaenv_(&dgesdd_c__1, "DORGLQ", 
			    " ", m, n, m, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = *m * 3 + (*m << 1) * ilaenv_(&dgesdd_c__1, 
			    "DGEBRD", " ", m, m, &dgesdd_c_n1, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = *m * 3 + *m * ilaenv_(&dgesdd_c__1, "DORMBR"
, "QLN", m, m, m, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = *m * 3 + *m * ilaenv_(&dgesdd_c__1, "DORMBR"
, "PRT", m, m, m, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = bdspac + *m * 3;
		    wrkbl = max(i__1,i__2);
		    maxwrk = wrkbl + (*m << 1) * *m;
		    minwrk = bdspac + (*m << 1) * *m + *m * 3;
		} else if (wntqs) {


		    wrkbl = *m + *m * ilaenv_(&dgesdd_c__1, "DGELQF", " ", m, n, &
			    dgesdd_c_n1, &dgesdd_c_n1);
		    i__1 = wrkbl, i__2 = *m + *m * ilaenv_(&dgesdd_c__1, "DORGLQ", 
			    " ", m, n, m, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = *m * 3 + (*m << 1) * ilaenv_(&dgesdd_c__1, 
			    "DGEBRD", " ", m, m, &dgesdd_c_n1, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = *m * 3 + *m * ilaenv_(&dgesdd_c__1, "DORMBR"
, "QLN", m, m, m, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = *m * 3 + *m * ilaenv_(&dgesdd_c__1, "DORMBR"
, "PRT", m, m, m, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = bdspac + *m * 3;
		    wrkbl = max(i__1,i__2);
		    maxwrk = wrkbl + *m * *m;
		    minwrk = bdspac + *m * *m + *m * 3;
		} else if (wntqa) {


		    wrkbl = *m + *m * ilaenv_(&dgesdd_c__1, "DGELQF", " ", m, n, &
			    dgesdd_c_n1, &dgesdd_c_n1);
		    i__1 = wrkbl, i__2 = *m + *n * ilaenv_(&dgesdd_c__1, "DORGLQ", 
			    " ", n, n, m, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = *m * 3 + (*m << 1) * ilaenv_(&dgesdd_c__1, 
			    "DGEBRD", " ", m, m, &dgesdd_c_n1, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = *m * 3 + *m * ilaenv_(&dgesdd_c__1, "DORMBR"
, "QLN", m, m, m, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = *m * 3 + *m * ilaenv_(&dgesdd_c__1, "DORMBR"
, "PRT", m, m, m, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = bdspac + *m * 3;
		    wrkbl = max(i__1,i__2);
		    maxwrk = wrkbl + *m * *m;
		    minwrk = bdspac + *m * *m + *m * 3;
		}
	    } else {


		wrkbl = *m * 3 + (*m + *n) * ilaenv_(&dgesdd_c__1, "DGEBRD", " ", m, 
			n, &dgesdd_c_n1, &dgesdd_c_n1);
		if (wntqn) {
		    i__1 = wrkbl, i__2 = bdspac + *m * 3;
		    maxwrk = max(i__1,i__2);
		    minwrk = *m * 3 + max(*n,bdspac);
		} else if (wntqo) {
		    i__1 = wrkbl, i__2 = *m * 3 + *m * ilaenv_(&dgesdd_c__1, "DORMBR"
, "QLN", m, m, n, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = *m * 3 + *m * ilaenv_(&dgesdd_c__1, "DORMBR"
, "PRT", m, n, m, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = bdspac + *m * 3;
		    wrkbl = max(i__1,i__2);
		    maxwrk = wrkbl + *m * *n;
		    i__1 = *n, i__2 = *m * *m + bdspac;
		    minwrk = *m * 3 + max(i__1,i__2);
		} else if (wntqs) {
		    i__1 = wrkbl, i__2 = *m * 3 + *m * ilaenv_(&dgesdd_c__1, "DORMBR"
, "QLN", m, m, n, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = *m * 3 + *m * ilaenv_(&dgesdd_c__1, "DORMBR"
, "PRT", m, n, m, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = bdspac + *m * 3;
		    maxwrk = max(i__1,i__2);
		    minwrk = *m * 3 + max(*n,bdspac);
		} else if (wntqa) {
		    i__1 = wrkbl, i__2 = *m * 3 + *m * ilaenv_(&dgesdd_c__1, "DORMBR"
, "QLN", m, m, n, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = *m * 3 + *m * ilaenv_(&dgesdd_c__1, "DORMBR"
, "PRT", n, n, m, &dgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = bdspac + *m * 3;
		    maxwrk = max(i__1,i__2);
		    minwrk = *m * 3 + max(*n,bdspac);
		}
	    }
	}
	maxwrk = max(maxwrk,minwrk);
	work[1] = (doublereal) maxwrk;

	if (*lwork < minwrk && ! lquery) {
	    *info = -12;
	}
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DGESDD", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


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


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


    anrm = dlange_("M", m, n, &a[a_offset], lda, dum);
    iscl = 0;
    if (anrm > 0. && anrm < smlnum) {
	iscl = 1;
	if (dlascl_(interp, "G", &dgesdd_c__0, &dgesdd_c__0, &anrm, &smlnum, m, n, &a[a_offset], lda, &		ierr)!=TCL_OK) { return TCL_ERROR; }


    } else if (anrm > bignum) {
	iscl = 1;
	if (dlascl_(interp, "G", &dgesdd_c__0, &dgesdd_c__0, &anrm, &bignum, m, n, &a[a_offset], lda, &		ierr)!=TCL_OK) { return TCL_ERROR; }


    }

    if (*m >= *n) {


	if (*m >= mnthr) {

	    if (wntqn) {


		itau = 1;
		nwork = itau + *n;


		i__1 = *lwork - nwork + 1;
		if (dgeqrf_(interp, m, n, &a[a_offset], lda, &work[itau], &work[nwork], &			i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }




		i__1 = *n - 1;
		i__2 = *n - 1;
		if (dlaset_(interp, "L", &i__1, &i__2, &dgesdd_c_b227, &dgesdd_c_b227, &a[a_dim1 + 2], 			lda)!=TCL_OK) { return TCL_ERROR; }


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


		i__1 = *lwork - nwork + 1;
		if (dgebrd_(interp, n, n, &a[a_offset], lda, &s[1], &work[ie], &work[			itauq], &work[itaup], &work[nwork], &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }


		nwork = ie + *n;


		if (dbdsdc_(interp, "U", "N", n, &s[1], &work[ie], dum, &dgesdd_c__1, dum, &dgesdd_c__1, 			 dum, idum, &work[nwork], &iwork[1], info)!=TCL_OK) { return TCL_ERROR; }



	    } else if (wntqo) {


		ir = 1;


		if (*lwork >= *lda * *n + *n * *n + *n * 3 + bdspac) {
		    ldwrkr = *lda;
		} else {
		    ldwrkr = (*lwork - *n * *n - *n * 3 - bdspac) / *n;
		}
		itau = ir + ldwrkr * *n;
		nwork = itau + *n;


		i__1 = *lwork - nwork + 1;
		if (dgeqrf_(interp, m, n, &a[a_offset], lda, &work[itau], &work[nwork], &			i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }




		if (dlacpy_(interp, "U", n, n, &a[a_offset], lda, &work[ir], &ldwrkr)!=TCL_OK) { return TCL_ERROR; }

		i__1 = *n - 1;
		i__2 = *n - 1;
		if (dlaset_(interp, "L", &i__1, &i__2, &dgesdd_c_b227, &dgesdd_c_b227, &work[ir + 1], &			ldwrkr)!=TCL_OK) { return TCL_ERROR; }




		i__1 = *lwork - nwork + 1;
		if (dorgqr_(interp, m, n, n, &a[a_offset], lda, &work[itau], &work[nwork], 			 &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }


		ie = itau;
		itauq = ie + *n;
		itaup = itauq + *n;
		nwork = itaup + *n;


		i__1 = *lwork - nwork + 1;
		if (dgebrd_(interp, n, n, &work[ir], &ldwrkr, &s[1], &work[ie], &work[			itauq], &work[itaup], &work[nwork], &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }




		iu = nwork;
		nwork = iu + *n * *n;


		if (dbdsdc_(interp, "U", "I", n, &s[1], &work[ie], &work[iu], n, &vt[			vt_offset], ldvt, dum, idum, &work[nwork], &iwork[1], 
			info)!=TCL_OK) { return TCL_ERROR; }




		i__1 = *lwork - nwork + 1;
		if (dormbr_(interp, "Q", "L", "N", n, n, n, &work[ir], &ldwrkr, &work[			itauq], &work[iu], n, &work[nwork], &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }


		i__1 = *lwork - nwork + 1;
		if (dormbr_(interp, "P", "R", "T", n, n, n, &work[ir], &ldwrkr, &work[			itaup], &vt[vt_offset], ldvt, &work[nwork], &i__1, &
			ierr)!=TCL_OK) { return TCL_ERROR; }




		i__1 = *m;
		i__2 = ldwrkr;
		for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += 
			i__2) {
		    i__3 = *m - i__ + 1;
		    chunk = min(i__3,ldwrkr);
		    if (dgemm_(interp, "N", "N", &chunk, n, n, &dgesdd_c_b248, &a[i__ + a_dim1], 			    lda, &work[iu], n, &dgesdd_c_b227, &work[ir], &ldwrkr)!=TCL_OK) { return TCL_ERROR; }


		    if (dlacpy_(interp, "F", &chunk, n, &work[ir], &ldwrkr, &a[i__ + 			    a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }


		}

	    } else if (wntqs) {


		ir = 1;


		ldwrkr = *n;
		itau = ir + ldwrkr * *n;
		nwork = itau + *n;


		i__2 = *lwork - nwork + 1;
		if (dgeqrf_(interp, m, n, &a[a_offset], lda, &work[itau], &work[nwork], &			i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }




		if (dlacpy_(interp, "U", n, n, &a[a_offset], lda, &work[ir], &ldwrkr)!=TCL_OK) { return TCL_ERROR; }

		i__2 = *n - 1;
		i__1 = *n - 1;
		if (dlaset_(interp, "L", &i__2, &i__1, &dgesdd_c_b227, &dgesdd_c_b227, &work[ir + 1], &			ldwrkr)!=TCL_OK) { return TCL_ERROR; }




		i__2 = *lwork - nwork + 1;
		if (dorgqr_(interp, m, n, n, &a[a_offset], lda, &work[itau], &work[nwork], 			 &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }


		ie = itau;
		itauq = ie + *n;
		itaup = itauq + *n;
		nwork = itaup + *n;


		i__2 = *lwork - nwork + 1;
		if (dgebrd_(interp, n, n, &work[ir], &ldwrkr, &s[1], &work[ie], &work[			itauq], &work[itaup], &work[nwork], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }




		if (dbdsdc_(interp, "U", "I", n, &s[1], &work[ie], &u[u_offset], ldu, &vt[			vt_offset], ldvt, dum, idum, &work[nwork], &iwork[1], 
			info)!=TCL_OK) { return TCL_ERROR; }




		i__2 = *lwork - nwork + 1;
		if (dormbr_(interp, "Q", "L", "N", n, n, n, &work[ir], &ldwrkr, &work[			itauq], &u[u_offset], ldu, &work[nwork], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }



		i__2 = *lwork - nwork + 1;
		if (dormbr_(interp, "P", "R", "T", n, n, n, &work[ir], &ldwrkr, &work[			itaup], &vt[vt_offset], ldvt, &work[nwork], &i__2, &
			ierr)!=TCL_OK) { return TCL_ERROR; }




		if (dlacpy_(interp, "F", n, n, &u[u_offset], ldu, &work[ir], &ldwrkr)!=TCL_OK) { return TCL_ERROR; }

		if (dgemm_(interp, "N", "N", m, n, n, &dgesdd_c_b248, &a[a_offset], lda, &work[			ir], &ldwrkr, &dgesdd_c_b227, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }



	    } else if (wntqa) {


		iu = 1;


		ldwrku = *n;
		itau = iu + ldwrku * *n;
		nwork = itau + *n;


		i__2 = *lwork - nwork + 1;
		if (dgeqrf_(interp, m, n, &a[a_offset], lda, &work[itau], &work[nwork], &			i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }


		if (dlacpy_(interp, "L", m, n, &a[a_offset], lda, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *lwork - nwork + 1;
		if (dorgqr_(interp, m, m, n, &u[u_offset], ldu, &work[itau], &work[nwork], 			 &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }




		i__2 = *n - 1;
		i__1 = *n - 1;
		if (dlaset_(interp, "L", &i__2, &i__1, &dgesdd_c_b227, &dgesdd_c_b227, &a[a_dim1 + 2], 			lda)!=TCL_OK) { return TCL_ERROR; }


		ie = itau;
		itauq = ie + *n;
		itaup = itauq + *n;
		nwork = itaup + *n;


		i__2 = *lwork - nwork + 1;
		if (dgebrd_(interp, n, n, &a[a_offset], lda, &s[1], &work[ie], &work[			itauq], &work[itaup], &work[nwork], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }




		if (dbdsdc_(interp, "U", "I", n, &s[1], &work[ie], &work[iu], n, &vt[			vt_offset], ldvt, dum, idum, &work[nwork], &iwork[1], 
			info)!=TCL_OK) { return TCL_ERROR; }




		i__2 = *lwork - nwork + 1;
		if (dormbr_(interp, "Q", "L", "N", n, n, n, &a[a_offset], lda, &work[			itauq], &work[iu], &ldwrku, &work[nwork], &i__2, &
			ierr)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *lwork - nwork + 1;
		if (dormbr_(interp, "P", "R", "T", n, n, n, &a[a_offset], lda, &work[			itaup], &vt[vt_offset], ldvt, &work[nwork], &i__2, &
			ierr)!=TCL_OK) { return TCL_ERROR; }




		if (dgemm_(interp, "N", "N", m, n, n, &dgesdd_c_b248, &u[u_offset], ldu, &work[			iu], &ldwrku, &dgesdd_c_b227, &a[a_offset], lda)!=TCL_OK) { return TCL_ERROR; }




		if (dlacpy_(interp, "F", m, n, &a[a_offset], lda, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }


	    }

	} else {



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


	    i__2 = *lwork - nwork + 1;
	    if (dgebrd_(interp, m, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &		    work[itaup], &work[nwork], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }


	    if (wntqn) {


		if (dbdsdc_(interp, "U", "N", n, &s[1], &work[ie], dum, &dgesdd_c__1, dum, &dgesdd_c__1, 			 dum, idum, &work[nwork], &iwork[1], info)!=TCL_OK) { return TCL_ERROR; }


	    } else if (wntqo) {
		iu = nwork;
		if (*lwork >= *m * *n + *n * 3 + bdspac) {


		    ldwrku = *m;
		    nwork = iu + ldwrku * *n;
		    if (dlaset_(interp, "F", m, n, &dgesdd_c_b227, &dgesdd_c_b227, &work[iu], &ldwrku)!=TCL_OK) { return TCL_ERROR; }

		} else {


		    ldwrku = *n;
		    nwork = iu + ldwrku * *n;


		    ir = nwork;
		    ldwrkr = (*lwork - *n * *n - *n * 3) / *n;
		}
		nwork = iu + ldwrku * *n;


		if (dbdsdc_(interp, "U", "I", n, &s[1], &work[ie], &work[iu], &ldwrku, &			vt[vt_offset], ldvt, dum, idum, &work[nwork], &iwork[
			1], info)!=TCL_OK) { return TCL_ERROR; }




		i__2 = *lwork - nwork + 1;
		if (dormbr_(interp, "P", "R", "T", n, n, n, &a[a_offset], lda, &work[			itaup], &vt[vt_offset], ldvt, &work[nwork], &i__2, &
			ierr)!=TCL_OK) { return TCL_ERROR; }



		if (*lwork >= *m * *n + *n * 3 + bdspac) {


		    i__2 = *lwork - nwork + 1;
		    if (dormbr_(interp, "Q", "L", "N", m, n, n, &a[a_offset], lda, &work[			    itauq], &work[iu], &ldwrku, &work[nwork], &i__2, &
			    ierr)!=TCL_OK) { return TCL_ERROR; }




		    if (dlacpy_(interp, "F", m, n, &work[iu], &ldwrku, &a[a_offset], lda)!=TCL_OK) { return TCL_ERROR; }

		} else {


		    i__2 = *lwork - nwork + 1;
		    if (dorgbr_(interp, "Q", m, n, n, &a[a_offset], lda, &work[itauq], &			    work[nwork], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }




		    i__2 = *m;
		    i__1 = ldwrkr;
		    for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ +=
			     i__1) {
			i__3 = *m - i__ + 1;
			chunk = min(i__3,ldwrkr);
			if (dgemm_(interp, "N", "N", &chunk, n, n, &dgesdd_c_b248, &a[i__ + 				a_dim1], lda, &work[iu], &ldwrku, &dgesdd_c_b227, &
				work[ir], &ldwrkr)!=TCL_OK) { return TCL_ERROR; }


			if (dlacpy_(interp, "F", &chunk, n, &work[ir], &ldwrkr, &a[i__ + 				a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }


		    }
		}

	    } else if (wntqs) {


		if (dlaset_(interp, "F", m, n, &dgesdd_c_b227, &dgesdd_c_b227, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }

		if (dbdsdc_(interp, "U", "I", n, &s[1], &work[ie], &u[u_offset], ldu, &vt[			vt_offset], ldvt, dum, idum, &work[nwork], &iwork[1], 
			info)!=TCL_OK) { return TCL_ERROR; }




		i__1 = *lwork - nwork + 1;
		if (dormbr_(interp, "Q", "L", "N", m, n, n, &a[a_offset], lda, &work[			itauq], &u[u_offset], ldu, &work[nwork], &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }


		i__1 = *lwork - nwork + 1;
		if (dormbr_(interp, "P", "R", "T", n, n, n, &a[a_offset], lda, &work[			itaup], &vt[vt_offset], ldvt, &work[nwork], &i__1, &
			ierr)!=TCL_OK) { return TCL_ERROR; }


	    } else if (wntqa) {


		if (dlaset_(interp, "F", m, m, &dgesdd_c_b227, &dgesdd_c_b227, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }

		if (dbdsdc_(interp, "U", "I", n, &s[1], &work[ie], &u[u_offset], ldu, &vt[			vt_offset], ldvt, dum, idum, &work[nwork], &iwork[1], 
			info)!=TCL_OK) { return TCL_ERROR; }




		if (*m > *n) {
		    i__1 = *m - *n;
		    i__2 = *m - *n;
		    if (dlaset_(interp, "F", &i__1, &i__2, &dgesdd_c_b227, &dgesdd_c_b248, &u[*n + 1 + (			    *n + 1) * u_dim1], ldu)!=TCL_OK) { return TCL_ERROR; }


		}


		i__1 = *lwork - nwork + 1;
		if (dormbr_(interp, "Q", "L", "N", m, m, n, &a[a_offset], lda, &work[			itauq], &u[u_offset], ldu, &work[nwork], &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }


		i__1 = *lwork - nwork + 1;
		if (dormbr_(interp, "P", "R", "T", n, n, m, &a[a_offset], lda, &work[			itaup], &vt[vt_offset], ldvt, &work[nwork], &i__1, &
			ierr)!=TCL_OK) { return TCL_ERROR; }


	    }

	}

    } else {


	if (*n >= mnthr) {

	    if (wntqn) {


		itau = 1;
		nwork = itau + *m;


		i__1 = *lwork - nwork + 1;
		if (dgelqf_(interp, m, n, &a[a_offset], lda, &work[itau], &work[nwork], &			i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }




		i__1 = *m - 1;
		i__2 = *m - 1;
		if (dlaset_(interp, "U", &i__1, &i__2, &dgesdd_c_b227, &dgesdd_c_b227, &a[(a_dim1 << 1) 			+ 1], lda)!=TCL_OK) { return TCL_ERROR; }


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


		i__1 = *lwork - nwork + 1;
		if (dgebrd_(interp, m, m, &a[a_offset], lda, &s[1], &work[ie], &work[			itauq], &work[itaup], &work[nwork], &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }


		nwork = ie + *m;


		if (dbdsdc_(interp, "U", "N", m, &s[1], &work[ie], dum, &dgesdd_c__1, dum, &dgesdd_c__1, 			 dum, idum, &work[nwork], &iwork[1], info)!=TCL_OK) { return TCL_ERROR; }



	    } else if (wntqo) {


		ivt = 1;


		il = ivt + *m * *m;
		if (*lwork >= *m * *n + *m * *m + *m * 3 + bdspac) {


		    ldwrkl = *m;
		    chunk = *n;
		} else {
		    ldwrkl = *m;
		    chunk = (*lwork - *m * *m) / *m;
		}
		itau = il + ldwrkl * *m;
		nwork = itau + *m;


		i__1 = *lwork - nwork + 1;
		if (dgelqf_(interp, m, n, &a[a_offset], lda, &work[itau], &work[nwork], &			i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }




		if (dlacpy_(interp, "L", m, m, &a[a_offset], lda, &work[il], &ldwrkl)!=TCL_OK) { return TCL_ERROR; }

		i__1 = *m - 1;
		i__2 = *m - 1;
		if (dlaset_(interp, "U", &i__1, &i__2, &dgesdd_c_b227, &dgesdd_c_b227, &work[il + 			ldwrkl], &ldwrkl)!=TCL_OK) { return TCL_ERROR; }




		i__1 = *lwork - nwork + 1;
		if (dorglq_(interp, m, n, m, &a[a_offset], lda, &work[itau], &work[nwork], 			 &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }


		ie = itau;
		itauq = ie + *m;
		itaup = itauq + *m;
		nwork = itaup + *m;


		i__1 = *lwork - nwork + 1;
		if (dgebrd_(interp, m, m, &work[il], &ldwrkl, &s[1], &work[ie], &work[			itauq], &work[itaup], &work[nwork], &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }




		if (dbdsdc_(interp, "U", "I", m, &s[1], &work[ie], &u[u_offset], ldu, &			work[ivt], m, dum, idum, &work[nwork], &iwork[1], 
			info)!=TCL_OK) { return TCL_ERROR; }




		i__1 = *lwork - nwork + 1;
		if (dormbr_(interp, "Q", "L", "N", m, m, m, &work[il], &ldwrkl, &work[			itauq], &u[u_offset], ldu, &work[nwork], &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }


		i__1 = *lwork - nwork + 1;
		if (dormbr_(interp, "P", "R", "T", m, m, m, &work[il], &ldwrkl, &work[			itaup], &work[ivt], m, &work[nwork], &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }




		i__1 = *n;
		i__2 = chunk;
		for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += 
			i__2) {
		    i__3 = *n - i__ + 1;
		    blk = min(i__3,chunk);
		    if (dgemm_(interp, "N", "N", m, &blk, m, &dgesdd_c_b248, &work[ivt], m, &a[			    i__ * a_dim1 + 1], lda, &dgesdd_c_b227, &work[il], &
			    ldwrkl)!=TCL_OK) { return TCL_ERROR; }


		    if (dlacpy_(interp, "F", m, &blk, &work[il], &ldwrkl, &a[i__ * a_dim1 			    + 1], lda)!=TCL_OK) { return TCL_ERROR; }


		}

	    } else if (wntqs) {


		il = 1;


		ldwrkl = *m;
		itau = il + ldwrkl * *m;
		nwork = itau + *m;


		i__2 = *lwork - nwork + 1;
		if (dgelqf_(interp, m, n, &a[a_offset], lda, &work[itau], &work[nwork], &			i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }




		if (dlacpy_(interp, "L", m, m, &a[a_offset], lda, &work[il], &ldwrkl)!=TCL_OK) { return TCL_ERROR; }

		i__2 = *m - 1;
		i__1 = *m - 1;
		if (dlaset_(interp, "U", &i__2, &i__1, &dgesdd_c_b227, &dgesdd_c_b227, &work[il + 			ldwrkl], &ldwrkl)!=TCL_OK) { return TCL_ERROR; }




		i__2 = *lwork - nwork + 1;
		if (dorglq_(interp, m, n, m, &a[a_offset], lda, &work[itau], &work[nwork], 			 &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }


		ie = itau;
		itauq = ie + *m;
		itaup = itauq + *m;
		nwork = itaup + *m;


		i__2 = *lwork - nwork + 1;
		if (dgebrd_(interp, m, m, &work[il], &ldwrkl, &s[1], &work[ie], &work[			itauq], &work[itaup], &work[nwork], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }




		if (dbdsdc_(interp, "U", "I", m, &s[1], &work[ie], &u[u_offset], ldu, &vt[			vt_offset], ldvt, dum, idum, &work[nwork], &iwork[1], 
			info)!=TCL_OK) { return TCL_ERROR; }




		i__2 = *lwork - nwork + 1;
		if (dormbr_(interp, "Q", "L", "N", m, m, m, &work[il], &ldwrkl, &work[			itauq], &u[u_offset], ldu, &work[nwork], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *lwork - nwork + 1;
		if (dormbr_(interp, "P", "R", "T", m, m, m, &work[il], &ldwrkl, &work[			itaup], &vt[vt_offset], ldvt, &work[nwork], &i__2, &
			ierr)!=TCL_OK) { return TCL_ERROR; }




		if (dlacpy_(interp, "F", m, m, &vt[vt_offset], ldvt, &work[il], &ldwrkl)!=TCL_OK) { return TCL_ERROR; }

		if (dgemm_(interp, "N", "N", m, n, m, &dgesdd_c_b248, &work[il], &ldwrkl, &a[			a_offset], lda, &dgesdd_c_b227, &vt[vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }



	    } else if (wntqa) {


		ivt = 1;


		ldwkvt = *m;
		itau = ivt + ldwkvt * *m;
		nwork = itau + *m;


		i__2 = *lwork - nwork + 1;
		if (dgelqf_(interp, m, n, &a[a_offset], lda, &work[itau], &work[nwork], &			i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }


		if (dlacpy_(interp, "U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }



		i__2 = *lwork - nwork + 1;
		if (dorglq_(interp, n, n, m, &vt[vt_offset], ldvt, &work[itau], &work[			nwork], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }




		i__2 = *m - 1;
		i__1 = *m - 1;
		if (dlaset_(interp, "U", &i__2, &i__1, &dgesdd_c_b227, &dgesdd_c_b227, &a[(a_dim1 << 1) 			+ 1], lda)!=TCL_OK) { return TCL_ERROR; }


		ie = itau;
		itauq = ie + *m;
		itaup = itauq + *m;
		nwork = itaup + *m;


		i__2 = *lwork - nwork + 1;
		if (dgebrd_(interp, m, m, &a[a_offset], lda, &s[1], &work[ie], &work[			itauq], &work[itaup], &work[nwork], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }




		if (dbdsdc_(interp, "U", "I", m, &s[1], &work[ie], &u[u_offset], ldu, &			work[ivt], &ldwkvt, dum, idum, &work[nwork], &iwork[1]
, info)!=TCL_OK) { return TCL_ERROR; }




		i__2 = *lwork - nwork + 1;
		if (dormbr_(interp, "Q", "L", "N", m, m, m, &a[a_offset], lda, &work[			itauq], &u[u_offset], ldu, &work[nwork], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *lwork - nwork + 1;
		if (dormbr_(interp, "P", "R", "T", m, m, m, &a[a_offset], lda, &work[			itaup], &work[ivt], &ldwkvt, &work[nwork], &i__2, &
			ierr)!=TCL_OK) { return TCL_ERROR; }




		if (dgemm_(interp, "N", "N", m, n, m, &dgesdd_c_b248, &work[ivt], &ldwkvt, &vt[			vt_offset], ldvt, &dgesdd_c_b227, &a[a_offset], lda)!=TCL_OK) { return TCL_ERROR; }




		if (dlacpy_(interp, "F", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }


	    }

	} else {



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


	    i__2 = *lwork - nwork + 1;
	    if (dgebrd_(interp, m, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &		    work[itaup], &work[nwork], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }


	    if (wntqn) {


		if (dbdsdc_(interp, "L", "N", m, &s[1], &work[ie], dum, &dgesdd_c__1, dum, &dgesdd_c__1, 			 dum, idum, &work[nwork], &iwork[1], info)!=TCL_OK) { return TCL_ERROR; }


	    } else if (wntqo) {
		ldwkvt = *m;
		ivt = nwork;
		if (*lwork >= *m * *n + *m * 3 + bdspac) {


		    if (dlaset_(interp, "F", m, n, &dgesdd_c_b227, &dgesdd_c_b227, &work[ivt], &ldwkvt)!=TCL_OK) { return TCL_ERROR; }

		    nwork = ivt + ldwkvt * *n;
		} else {


		    nwork = ivt + ldwkvt * *m;
		    il = nwork;


		    chunk = (*lwork - *m * *m - *m * 3) / *m;
		}


		if (dbdsdc_(interp, "L", "I", m, &s[1], &work[ie], &u[u_offset], ldu, &			work[ivt], &ldwkvt, dum, idum, &work[nwork], &iwork[1]
, info)!=TCL_OK) { return TCL_ERROR; }




		i__2 = *lwork - nwork + 1;
		if (dormbr_(interp, "Q", "L", "N", m, m, n, &a[a_offset], lda, &work[			itauq], &u[u_offset], ldu, &work[nwork], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }



		if (*lwork >= *m * *n + *m * 3 + bdspac) {


		    i__2 = *lwork - nwork + 1;
		    if (dormbr_(interp, "P", "R", "T", m, n, m, &a[a_offset], lda, &work[			    itaup], &work[ivt], &ldwkvt, &work[nwork], &i__2, 
			    &ierr)!=TCL_OK) { return TCL_ERROR; }




		    if (dlacpy_(interp, "F", m, n, &work[ivt], &ldwkvt, &a[a_offset], lda)!=TCL_OK) { return TCL_ERROR; }

		} else {


		    i__2 = *lwork - nwork + 1;
		    if (dorgbr_(interp, "P", m, n, m, &a[a_offset], lda, &work[itaup], &			    work[nwork], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }




		    i__2 = *n;
		    i__1 = chunk;
		    for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ +=
			     i__1) {
			i__3 = *n - i__ + 1;
			blk = min(i__3,chunk);
			if (dgemm_(interp, "N", "N", m, &blk, m, &dgesdd_c_b248, &work[ivt], &				ldwkvt, &a[i__ * a_dim1 + 1], lda, &dgesdd_c_b227, &
				work[il], m)!=TCL_OK) { return TCL_ERROR; }


			if (dlacpy_(interp, "F", m, &blk, &work[il], m, &a[i__ * a_dim1 + 				1], lda)!=TCL_OK) { return TCL_ERROR; }


		    }
		}
	    } else if (wntqs) {


		if (dlaset_(interp, "F", m, n, &dgesdd_c_b227, &dgesdd_c_b227, &vt[vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }

		if (dbdsdc_(interp, "L", "I", m, &s[1], &work[ie], &u[u_offset], ldu, &vt[			vt_offset], ldvt, dum, idum, &work[nwork], &iwork[1], 
			info)!=TCL_OK) { return TCL_ERROR; }




		i__1 = *lwork - nwork + 1;
		if (dormbr_(interp, "Q", "L", "N", m, m, n, &a[a_offset], lda, &work[			itauq], &u[u_offset], ldu, &work[nwork], &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }


		i__1 = *lwork - nwork + 1;
		if (dormbr_(interp, "P", "R", "T", m, n, m, &a[a_offset], lda, &work[			itaup], &vt[vt_offset], ldvt, &work[nwork], &i__1, &
			ierr)!=TCL_OK) { return TCL_ERROR; }


	    } else if (wntqa) {


		if (dlaset_(interp, "F", n, n, &dgesdd_c_b227, &dgesdd_c_b227, &vt[vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }

		if (dbdsdc_(interp, "L", "I", m, &s[1], &work[ie], &u[u_offset], ldu, &vt[			vt_offset], ldvt, dum, idum, &work[nwork], &iwork[1], 
			info)!=TCL_OK) { return TCL_ERROR; }




		if (*n > *m) {
		    i__1 = *n - *m;
		    i__2 = *n - *m;
		    if (dlaset_(interp, "F", &i__1, &i__2, &dgesdd_c_b227, &dgesdd_c_b248, &vt[*m + 1 + 			    (*m + 1) * vt_dim1], ldvt)!=TCL_OK) { return TCL_ERROR; }


		}


		i__1 = *lwork - nwork + 1;
		if (dormbr_(interp, "Q", "L", "N", m, m, n, &a[a_offset], lda, &work[			itauq], &u[u_offset], ldu, &work[nwork], &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }


		i__1 = *lwork - nwork + 1;
		if (dormbr_(interp, "P", "R", "T", n, n, m, &a[a_offset], lda, &work[			itaup], &vt[vt_offset], ldvt, &work[nwork], &i__1, &
			ierr)!=TCL_OK) { return TCL_ERROR; }


	    }

	}

    }


    if (iscl == 1) {
	if (anrm > bignum) {
	    if (dlascl_(interp, "G", &dgesdd_c__0, &dgesdd_c__0, &bignum, &anrm, &minmn, &dgesdd_c__1, &s[1], &		    minmn, &ierr)!=TCL_OK) { return TCL_ERROR; }


	}
	if (anrm < smlnum) {
	    if (dlascl_(interp, "G", &dgesdd_c__0, &dgesdd_c__0, &smlnum, &anrm, &minmn, &dgesdd_c__1, &s[1], &		    minmn, &ierr)!=TCL_OK) { return TCL_ERROR; }


	}
    }


    work[1] = (doublereal) maxwrk;

return TCL_OK;


} /* dgesdd_ */
MODULE_SCOPE /* Subroutine */ int zgesdd_ (Tcl_Interp *interp, char *jobz, integer *m, integer *n, 	doublecomplex *a, integer *lda, doublereal *s, doublecomplex *u, 	integer *ldu, doublecomplex *vt, integer *ldvt, doublecomplex *work, 	integer *lwork, doublereal *rwork, integer *iwork, integer *info)
{
    integer a_dim1, a_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__1, 
	    i__2, i__3;

    double sqrt(doublereal);

    integer i__, ie, il, ir, iu, blk;
    doublereal dum[1], eps;
    integer iru, ivt, iscl;
    doublereal anrm;
    integer idum[1], ierr, itau, irvt;
    integer chunk, minmn;
    integer wrkbl, itaup, itauq;
    logical wntqa;
    integer nwork;
    logical wntqn, wntqo, wntqs;
    integer mnthr1, mnthr2;
    doublereal bignum;
    integer ldwrkl;
    integer ldwrkr, minwrk, ldwrku, maxwrk;
    integer ldwkvt;
    doublereal smlnum;
    logical wntqas;
    integer nrwork;
































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

    *info = 0;
    minmn = min(*m,*n);
    mnthr1 = (integer) (minmn * 17. / 9.);
    mnthr2 = (integer) (minmn * 5. / 3.);
    wntqa = lsame_(jobz, "A");
    wntqs = lsame_(jobz, "S");
    wntqas = wntqa || wntqs;
    wntqo = lsame_(jobz, "O");
    wntqn = lsame_(jobz, "N");
    minwrk = 1;
    maxwrk = 1;

    if (! (wntqa || wntqs || wntqo || wntqn)) {
	*info = -1;
    } else if (*m < 0) {
	*info = -2;
    } else if (*n < 0) {
	*info = -3;
    } else if (*lda < max(1,*m)) {
	*info = -5;
    } else if (*ldu < 1 || wntqas && *ldu < *m || wntqo && *m < *n && *ldu < *
	    m) {
	*info = -8;
    } else if (*ldvt < 1 || wntqa && *ldvt < *n || wntqs && *ldvt < minmn || 
	    wntqo && *m >= *n && *ldvt < *n) {
	*info = -10;
    }


    if (*info == 0 && *m > 0 && *n > 0) {
	if (*m >= *n) {


	    if (*m >= mnthr1) {
		if (wntqn) {


		    maxwrk = *n + *n * ilaenv_(&zgesdd_c__1, "ZGEQRF", " ", m, n, &
			    zgesdd_c_n1, &zgesdd_c_n1);
		    i__1 = maxwrk, i__2 = (*n << 1) + (*n << 1) * ilaenv_(&
			    zgesdd_c__1, "ZGEBRD", " ", n, n, &zgesdd_c_n1, &zgesdd_c_n1);
		    maxwrk = max(i__1,i__2);
		    minwrk = *n * 3;
		} else if (wntqo) {


		    wrkbl = *n + *n * ilaenv_(&zgesdd_c__1, "ZGEQRF", " ", m, n, &
			    zgesdd_c_n1, &zgesdd_c_n1);
		    i__1 = wrkbl, i__2 = *n + *n * ilaenv_(&zgesdd_c__1, "ZUNGQR", 
			    " ", m, n, n, &zgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = (*n << 1) + (*n << 1) * ilaenv_(&
			    zgesdd_c__1, "ZGEBRD", " ", n, n, &zgesdd_c_n1, &zgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = (*n << 1) + *n * ilaenv_(&zgesdd_c__1, 
			    "ZUNMBR", "QLN", n, n, n, &zgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = (*n << 1) + *n * ilaenv_(&zgesdd_c__1, 
			    "ZUNMBR", "PRC", n, n, n, &zgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    maxwrk = *m * *n + *n * *n + wrkbl;
		    minwrk = (*n << 1) * *n + *n * 3;
		} else if (wntqs) {


		    wrkbl = *n + *n * ilaenv_(&zgesdd_c__1, "ZGEQRF", " ", m, n, &
			    zgesdd_c_n1, &zgesdd_c_n1);
		    i__1 = wrkbl, i__2 = *n + *n * ilaenv_(&zgesdd_c__1, "ZUNGQR", 
			    " ", m, n, n, &zgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = (*n << 1) + (*n << 1) * ilaenv_(&
			    zgesdd_c__1, "ZGEBRD", " ", n, n, &zgesdd_c_n1, &zgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = (*n << 1) + *n * ilaenv_(&zgesdd_c__1, 
			    "ZUNMBR", "QLN", n, n, n, &zgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = (*n << 1) + *n * ilaenv_(&zgesdd_c__1, 
			    "ZUNMBR", "PRC", n, n, n, &zgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    maxwrk = *n * *n + wrkbl;
		    minwrk = *n * *n + *n * 3;
		} else if (wntqa) {


		    wrkbl = *n + *n * ilaenv_(&zgesdd_c__1, "ZGEQRF", " ", m, n, &
			    zgesdd_c_n1, &zgesdd_c_n1);
		    i__1 = wrkbl, i__2 = *n + *m * ilaenv_(&zgesdd_c__1, "ZUNGQR", 
			    " ", m, m, n, &zgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = (*n << 1) + (*n << 1) * ilaenv_(&
			    zgesdd_c__1, "ZGEBRD", " ", n, n, &zgesdd_c_n1, &zgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = (*n << 1) + *n * ilaenv_(&zgesdd_c__1, 
			    "ZUNMBR", "QLN", n, n, n, &zgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = (*n << 1) + *n * ilaenv_(&zgesdd_c__1, 
			    "ZUNMBR", "PRC", n, n, n, &zgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    maxwrk = *n * *n + wrkbl;
		    minwrk = *n * *n + (*n << 1) + *m;
		}
	    } else if (*m >= mnthr2) {


		maxwrk = (*n << 1) + (*m + *n) * ilaenv_(&zgesdd_c__1, "ZGEBRD", 
			" ", m, n, &zgesdd_c_n1, &zgesdd_c_n1);
		minwrk = (*n << 1) + *m;
		if (wntqo) {
		    i__1 = maxwrk, i__2 = (*n << 1) + *n * ilaenv_(&zgesdd_c__1, 
			    "ZUNGBR", "P", n, n, n, &zgesdd_c_n1);
		    maxwrk = max(i__1,i__2);
		    i__1 = maxwrk, i__2 = (*n << 1) + *n * ilaenv_(&zgesdd_c__1, 
			    "ZUNGBR", "Q", m, n, n, &zgesdd_c_n1);
		    maxwrk = max(i__1,i__2);
		    maxwrk += *m * *n;
		    minwrk += *n * *n;
		} else if (wntqs) {
		    i__1 = maxwrk, i__2 = (*n << 1) + *n * ilaenv_(&zgesdd_c__1, 
			    "ZUNGBR", "P", n, n, n, &zgesdd_c_n1);
		    maxwrk = max(i__1,i__2);
		    i__1 = maxwrk, i__2 = (*n << 1) + *n * ilaenv_(&zgesdd_c__1, 
			    "ZUNGBR", "Q", m, n, n, &zgesdd_c_n1);
		    maxwrk = max(i__1,i__2);
		} else if (wntqa) {
		    i__1 = maxwrk, i__2 = (*n << 1) + *n * ilaenv_(&zgesdd_c__1, 
			    "ZUNGBR", "P", n, n, n, &zgesdd_c_n1);
		    maxwrk = max(i__1,i__2);
		    i__1 = maxwrk, i__2 = (*n << 1) + *m * ilaenv_(&zgesdd_c__1, 
			    "ZUNGBR", "Q", m, m, n, &zgesdd_c_n1);
		    maxwrk = max(i__1,i__2);
		}
	    } else {


		maxwrk = (*n << 1) + (*m + *n) * ilaenv_(&zgesdd_c__1, "ZGEBRD", 
			" ", m, n, &zgesdd_c_n1, &zgesdd_c_n1);
		minwrk = (*n << 1) + *m;
		if (wntqo) {
		    i__1 = maxwrk, i__2 = (*n << 1) + *n * ilaenv_(&zgesdd_c__1, 
			    "ZUNMBR", "PRC", n, n, n, &zgesdd_c_n1);
		    maxwrk = max(i__1,i__2);
		    i__1 = maxwrk, i__2 = (*n << 1) + *n * ilaenv_(&zgesdd_c__1, 
			    "ZUNMBR", "QLN", m, n, n, &zgesdd_c_n1);
		    maxwrk = max(i__1,i__2);
		    maxwrk += *m * *n;
		    minwrk += *n * *n;
		} else if (wntqs) {
		    i__1 = maxwrk, i__2 = (*n << 1) + *n * ilaenv_(&zgesdd_c__1, 
			    "ZUNMBR", "PRC", n, n, n, &zgesdd_c_n1);
		    maxwrk = max(i__1,i__2);
		    i__1 = maxwrk, i__2 = (*n << 1) + *n * ilaenv_(&zgesdd_c__1, 
			    "ZUNMBR", "QLN", m, n, n, &zgesdd_c_n1);
		    maxwrk = max(i__1,i__2);
		} else if (wntqa) {
		    i__1 = maxwrk, i__2 = (*n << 1) + *n * ilaenv_(&zgesdd_c__1, 
			    "ZUNGBR", "PRC", n, n, n, &zgesdd_c_n1);
		    maxwrk = max(i__1,i__2);
		    i__1 = maxwrk, i__2 = (*n << 1) + *m * ilaenv_(&zgesdd_c__1, 
			    "ZUNGBR", "QLN", m, m, n, &zgesdd_c_n1);
		    maxwrk = max(i__1,i__2);
		}
	    }
	} else {


	    if (*n >= mnthr1) {
		if (wntqn) {


		    maxwrk = *m + *m * ilaenv_(&zgesdd_c__1, "ZGELQF", " ", m, n, &
			    zgesdd_c_n1, &zgesdd_c_n1);
		    i__1 = maxwrk, i__2 = (*m << 1) + (*m << 1) * ilaenv_(&
			    zgesdd_c__1, "ZGEBRD", " ", m, m, &zgesdd_c_n1, &zgesdd_c_n1);
		    maxwrk = max(i__1,i__2);
		    minwrk = *m * 3;
		} else if (wntqo) {


		    wrkbl = *m + *m * ilaenv_(&zgesdd_c__1, "ZGELQF", " ", m, n, &
			    zgesdd_c_n1, &zgesdd_c_n1);
		    i__1 = wrkbl, i__2 = *m + *m * ilaenv_(&zgesdd_c__1, "ZUNGLQ", 
			    " ", m, n, m, &zgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = (*m << 1) + (*m << 1) * ilaenv_(&
			    zgesdd_c__1, "ZGEBRD", " ", m, m, &zgesdd_c_n1, &zgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = (*m << 1) + *m * ilaenv_(&zgesdd_c__1, 
			    "ZUNMBR", "PRC", m, m, m, &zgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = (*m << 1) + *m * ilaenv_(&zgesdd_c__1, 
			    "ZUNMBR", "QLN", m, m, m, &zgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    maxwrk = *m * *n + *m * *m + wrkbl;
		    minwrk = (*m << 1) * *m + *m * 3;
		} else if (wntqs) {


		    wrkbl = *m + *m * ilaenv_(&zgesdd_c__1, "ZGELQF", " ", m, n, &
			    zgesdd_c_n1, &zgesdd_c_n1);
		    i__1 = wrkbl, i__2 = *m + *m * ilaenv_(&zgesdd_c__1, "ZUNGLQ", 
			    " ", m, n, m, &zgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = (*m << 1) + (*m << 1) * ilaenv_(&
			    zgesdd_c__1, "ZGEBRD", " ", m, m, &zgesdd_c_n1, &zgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = (*m << 1) + *m * ilaenv_(&zgesdd_c__1, 
			    "ZUNMBR", "PRC", m, m, m, &zgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = (*m << 1) + *m * ilaenv_(&zgesdd_c__1, 
			    "ZUNMBR", "QLN", m, m, m, &zgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    maxwrk = *m * *m + wrkbl;
		    minwrk = *m * *m + *m * 3;
		} else if (wntqa) {


		    wrkbl = *m + *m * ilaenv_(&zgesdd_c__1, "ZGELQF", " ", m, n, &
			    zgesdd_c_n1, &zgesdd_c_n1);
		    i__1 = wrkbl, i__2 = *m + *n * ilaenv_(&zgesdd_c__1, "ZUNGLQ", 
			    " ", n, n, m, &zgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = (*m << 1) + (*m << 1) * ilaenv_(&
			    zgesdd_c__1, "ZGEBRD", " ", m, m, &zgesdd_c_n1, &zgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = (*m << 1) + *m * ilaenv_(&zgesdd_c__1, 
			    "ZUNMBR", "PRC", m, m, m, &zgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    i__1 = wrkbl, i__2 = (*m << 1) + *m * ilaenv_(&zgesdd_c__1, 
			    "ZUNMBR", "QLN", m, m, m, &zgesdd_c_n1);
		    wrkbl = max(i__1,i__2);
		    maxwrk = *m * *m + wrkbl;
		    minwrk = *m * *m + (*m << 1) + *n;
		}
	    } else if (*n >= mnthr2) {


		maxwrk = (*m << 1) + (*m + *n) * ilaenv_(&zgesdd_c__1, "ZGEBRD", 
			" ", m, n, &zgesdd_c_n1, &zgesdd_c_n1);
		minwrk = (*m << 1) + *n;
		if (wntqo) {
		    i__1 = maxwrk, i__2 = (*m << 1) + *m * ilaenv_(&zgesdd_c__1, 
			    "ZUNGBR", "P", m, n, m, &zgesdd_c_n1);
		    maxwrk = max(i__1,i__2);
		    i__1 = maxwrk, i__2 = (*m << 1) + *m * ilaenv_(&zgesdd_c__1, 
			    "ZUNGBR", "Q", m, m, n, &zgesdd_c_n1);
		    maxwrk = max(i__1,i__2);
		    maxwrk += *m * *n;
		    minwrk += *m * *m;
		} else if (wntqs) {
		    i__1 = maxwrk, i__2 = (*m << 1) + *m * ilaenv_(&zgesdd_c__1, 
			    "ZUNGBR", "P", m, n, m, &zgesdd_c_n1);
		    maxwrk = max(i__1,i__2);
		    i__1 = maxwrk, i__2 = (*m << 1) + *m * ilaenv_(&zgesdd_c__1, 
			    "ZUNGBR", "Q", m, m, n, &zgesdd_c_n1);
		    maxwrk = max(i__1,i__2);
		} else if (wntqa) {
		    i__1 = maxwrk, i__2 = (*m << 1) + *n * ilaenv_(&zgesdd_c__1, 
			    "ZUNGBR", "P", n, n, m, &zgesdd_c_n1);
		    maxwrk = max(i__1,i__2);
		    i__1 = maxwrk, i__2 = (*m << 1) + *m * ilaenv_(&zgesdd_c__1, 
			    "ZUNGBR", "Q", m, m, n, &zgesdd_c_n1);
		    maxwrk = max(i__1,i__2);
		}
	    } else {


		maxwrk = (*m << 1) + (*m + *n) * ilaenv_(&zgesdd_c__1, "ZGEBRD", 
			" ", m, n, &zgesdd_c_n1, &zgesdd_c_n1);
		minwrk = (*m << 1) + *n;
		if (wntqo) {
		    i__1 = maxwrk, i__2 = (*m << 1) + *m * ilaenv_(&zgesdd_c__1, 
			    "ZUNMBR", "PRC", m, n, m, &zgesdd_c_n1);
		    maxwrk = max(i__1,i__2);
		    i__1 = maxwrk, i__2 = (*m << 1) + *m * ilaenv_(&zgesdd_c__1, 
			    "ZUNMBR", "QLN", m, m, n, &zgesdd_c_n1);
		    maxwrk = max(i__1,i__2);
		    maxwrk += *m * *n;
		    minwrk += *m * *m;
		} else if (wntqs) {
		    i__1 = maxwrk, i__2 = (*m << 1) + *m * ilaenv_(&zgesdd_c__1, 
			    "ZUNGBR", "PRC", m, n, m, &zgesdd_c_n1);
		    maxwrk = max(i__1,i__2);
		    i__1 = maxwrk, i__2 = (*m << 1) + *m * ilaenv_(&zgesdd_c__1, 
			    "ZUNGBR", "QLN", m, m, n, &zgesdd_c_n1);
		    maxwrk = max(i__1,i__2);
		} else if (wntqa) {
		    i__1 = maxwrk, i__2 = (*m << 1) + *n * ilaenv_(&zgesdd_c__1, 
			    "ZUNGBR", "PRC", n, n, m, &zgesdd_c_n1);
		    maxwrk = max(i__1,i__2);
		    i__1 = maxwrk, i__2 = (*m << 1) + *m * ilaenv_(&zgesdd_c__1, 
			    "ZUNGBR", "QLN", m, m, n, &zgesdd_c_n1);
		    maxwrk = max(i__1,i__2);
		}
	    }
	}
	maxwrk = max(maxwrk,minwrk);
    }
    if (*info == 0) {
	work[1].r = (doublereal) maxwrk, work[1].i = 0.;
	if (*lwork < minwrk && *lwork != -1) {
	    *info = -13;
	}
    }


    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "ZGESDD", &i__1);
return TCL_ERROR;

return TCL_OK;
    }
    if (*lwork == -1) {
return TCL_OK;
    }
    if (*m == 0 || *n == 0) {
return TCL_OK;
    }


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


    anrm = zlange_("M", m, n, &a[a_offset], lda, dum);
    iscl = 0;
    if (anrm > 0. && anrm < smlnum) {
	iscl = 1;
	if (zlascl_(interp, "G", &zgesdd_c__0, &zgesdd_c__0, &anrm, &smlnum, m, n, &a[a_offset], lda, &		ierr)!=TCL_OK) { return TCL_ERROR; }


    } else if (anrm > bignum) {
	iscl = 1;
	if (zlascl_(interp, "G", &zgesdd_c__0, &zgesdd_c__0, &anrm, &bignum, m, n, &a[a_offset], lda, &		ierr)!=TCL_OK) { return TCL_ERROR; }


    }

    if (*m >= *n) {


	if (*m >= mnthr1) {

	    if (wntqn) {


		itau = 1;
		nwork = itau + *n;


		i__1 = *lwork - nwork + 1;
		if (zgeqrf_(interp, m, n, &a[a_offset], lda, &work[itau], &work[nwork], &			i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }




		i__1 = *n - 1;
		i__2 = *n - 1;
		if (zlaset_(interp, "L", &i__1, &i__2, &zgesdd_c_b1, &zgesdd_c_b1, &a[a_dim1 + 2], lda)!=TCL_OK) { return TCL_ERROR; }

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


		i__1 = *lwork - nwork + 1;
		if (zgebrd_(interp, n, n, &a[a_offset], lda, &s[1], &rwork[ie], &work[			itauq], &work[itaup], &work[nwork], &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }


		nrwork = ie + *n;


		if (dbdsdc_(interp, "U", "N", n, &s[1], &rwork[ie], dum, &zgesdd_c__1, dum, &			zgesdd_c__1, dum, idum, &rwork[nrwork], &iwork[1], info)!=TCL_OK) { return TCL_ERROR; }



	    } else if (wntqo) {


		iu = 1;


		ldwrku = *n;
		ir = iu + ldwrku * *n;
		if (*lwork >= *m * *n + *n * *n + *n * 3) {


		    ldwrkr = *m;
		} else {
		    ldwrkr = (*lwork - *n * *n - *n * 3) / *n;
		}
		itau = ir + ldwrkr * *n;
		nwork = itau + *n;


		i__1 = *lwork - nwork + 1;
		if (zgeqrf_(interp, m, n, &a[a_offset], lda, &work[itau], &work[nwork], &			i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }




		if (zlacpy_(interp, "U", n, n, &a[a_offset], lda, &work[ir], &ldwrkr)!=TCL_OK) { return TCL_ERROR; }

		i__1 = *n - 1;
		i__2 = *n - 1;
		if (zlaset_(interp, "L", &i__1, &i__2, &zgesdd_c_b1, &zgesdd_c_b1, &work[ir + 1], &			ldwrkr)!=TCL_OK) { return TCL_ERROR; }




		i__1 = *lwork - nwork + 1;
		if (zungqr_(interp, m, n, n, &a[a_offset], lda, &work[itau], &work[nwork], 			 &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }


		ie = 1;
		itauq = itau;
		itaup = itauq + *n;
		nwork = itaup + *n;


		i__1 = *lwork - nwork + 1;
		if (zgebrd_(interp, n, n, &work[ir], &ldwrkr, &s[1], &rwork[ie], &work[			itauq], &work[itaup], &work[nwork], &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }




		iru = ie + *n;
		irvt = iru + *n * *n;
		nrwork = irvt + *n * *n;
		if (dbdsdc_(interp, "U", "I", n, &s[1], &rwork[ie], &rwork[iru], n, &			rwork[irvt], n, dum, idum, &rwork[nrwork], &iwork[1], 
			info)!=TCL_OK) { return TCL_ERROR; }




		if (zlacp2_(interp, "F", n, n, &rwork[iru], n, &work[iu], &ldwrku)!=TCL_OK) { return TCL_ERROR; }

		i__1 = *lwork - nwork + 1;
		if (zunmbr_(interp, "Q", "L", "N", n, n, n, &work[ir], &ldwrkr, &work[			itauq], &work[iu], &ldwrku, &work[nwork], &i__1, &
			ierr)!=TCL_OK) { return TCL_ERROR; }




		if (zlacp2_(interp, "F", n, n, &rwork[irvt], n, &vt[vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }

		i__1 = *lwork - nwork + 1;
		if (zunmbr_(interp, "P", "R", "C", n, n, n, &work[ir], &ldwrkr, &work[			itaup], &vt[vt_offset], ldvt, &work[nwork], &i__1, &
			ierr)!=TCL_OK) { return TCL_ERROR; }




		i__1 = *m;
		i__2 = ldwrkr;
		for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += 
			i__2) {
		    i__3 = *m - i__ + 1;
		    chunk = min(i__3,ldwrkr);
		    if (zgemm_(interp, "N", "N", &chunk, n, n, &zgesdd_c_b2, &a[i__ + a_dim1], 			    lda, &work[iu], &ldwrku, &zgesdd_c_b1, &work[ir], &
			    ldwrkr)!=TCL_OK) { return TCL_ERROR; }


		    if (zlacpy_(interp, "F", &chunk, n, &work[ir], &ldwrkr, &a[i__ + 			    a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }


		}

	    } else if (wntqs) {


		ir = 1;


		ldwrkr = *n;
		itau = ir + ldwrkr * *n;
		nwork = itau + *n;


		i__2 = *lwork - nwork + 1;
		if (zgeqrf_(interp, m, n, &a[a_offset], lda, &work[itau], &work[nwork], &			i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }




		if (zlacpy_(interp, "U", n, n, &a[a_offset], lda, &work[ir], &ldwrkr)!=TCL_OK) { return TCL_ERROR; }

		i__2 = *n - 1;
		i__1 = *n - 1;
		if (zlaset_(interp, "L", &i__2, &i__1, &zgesdd_c_b1, &zgesdd_c_b1, &work[ir + 1], &			ldwrkr)!=TCL_OK) { return TCL_ERROR; }




		i__2 = *lwork - nwork + 1;
		if (zungqr_(interp, m, n, n, &a[a_offset], lda, &work[itau], &work[nwork], 			 &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }


		ie = 1;
		itauq = itau;
		itaup = itauq + *n;
		nwork = itaup + *n;


		i__2 = *lwork - nwork + 1;
		if (zgebrd_(interp, n, n, &work[ir], &ldwrkr, &s[1], &rwork[ie], &work[			itauq], &work[itaup], &work[nwork], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }




		iru = ie + *n;
		irvt = iru + *n * *n;
		nrwork = irvt + *n * *n;
		if (dbdsdc_(interp, "U", "I", n, &s[1], &rwork[ie], &rwork[iru], n, &			rwork[irvt], n, dum, idum, &rwork[nrwork], &iwork[1], 
			info)!=TCL_OK) { return TCL_ERROR; }




		if (zlacp2_(interp, "F", n, n, &rwork[iru], n, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }

		i__2 = *lwork - nwork + 1;
		if (zunmbr_(interp, "Q", "L", "N", n, n, n, &work[ir], &ldwrkr, &work[			itauq], &u[u_offset], ldu, &work[nwork], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }




		if (zlacp2_(interp, "F", n, n, &rwork[irvt], n, &vt[vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }

		i__2 = *lwork - nwork + 1;
		if (zunmbr_(interp, "P", "R", "C", n, n, n, &work[ir], &ldwrkr, &work[			itaup], &vt[vt_offset], ldvt, &work[nwork], &i__2, &
			ierr)!=TCL_OK) { return TCL_ERROR; }




		if (zlacpy_(interp, "F", n, n, &u[u_offset], ldu, &work[ir], &ldwrkr)!=TCL_OK) { return TCL_ERROR; }

		if (zgemm_(interp, "N", "N", m, n, n, &zgesdd_c_b2, &a[a_offset], lda, &work[ir], 			 &ldwrkr, &zgesdd_c_b1, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }



	    } else if (wntqa) {


		iu = 1;


		ldwrku = *n;
		itau = iu + ldwrku * *n;
		nwork = itau + *n;


		i__2 = *lwork - nwork + 1;
		if (zgeqrf_(interp, m, n, &a[a_offset], lda, &work[itau], &work[nwork], &			i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }


		if (zlacpy_(interp, "L", m, n, &a[a_offset], lda, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }



		i__2 = *lwork - nwork + 1;
		if (zungqr_(interp, m, m, n, &u[u_offset], ldu, &work[itau], &work[nwork], 			 &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }




		i__2 = *n - 1;
		i__1 = *n - 1;
		if (zlaset_(interp, "L", &i__2, &i__1, &zgesdd_c_b1, &zgesdd_c_b1, &a[a_dim1 + 2], lda)!=TCL_OK) { return TCL_ERROR; }

		ie = 1;
		itauq = itau;
		itaup = itauq + *n;
		nwork = itaup + *n;


		i__2 = *lwork - nwork + 1;
		if (zgebrd_(interp, n, n, &a[a_offset], lda, &s[1], &rwork[ie], &work[			itauq], &work[itaup], &work[nwork], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }


		iru = ie + *n;
		irvt = iru + *n * *n;
		nrwork = irvt + *n * *n;


		if (dbdsdc_(interp, "U", "I", n, &s[1], &rwork[ie], &rwork[iru], n, &			rwork[irvt], n, dum, idum, &rwork[nrwork], &iwork[1], 
			info)!=TCL_OK) { return TCL_ERROR; }




		if (zlacp2_(interp, "F", n, n, &rwork[iru], n, &work[iu], &ldwrku)!=TCL_OK) { return TCL_ERROR; }

		i__2 = *lwork - nwork + 1;
		if (zunmbr_(interp, "Q", "L", "N", n, n, n, &a[a_offset], lda, &work[			itauq], &work[iu], &ldwrku, &work[nwork], &i__2, &
			ierr)!=TCL_OK) { return TCL_ERROR; }




		if (zlacp2_(interp, "F", n, n, &rwork[irvt], n, &vt[vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }

		i__2 = *lwork - nwork + 1;
		if (zunmbr_(interp, "P", "R", "C", n, n, n, &a[a_offset], lda, &work[			itaup], &vt[vt_offset], ldvt, &work[nwork], &i__2, &
			ierr)!=TCL_OK) { return TCL_ERROR; }




		if (zgemm_(interp, "N", "N", m, n, n, &zgesdd_c_b2, &u[u_offset], ldu, &work[iu], 			 &ldwrku, &zgesdd_c_b1, &a[a_offset], lda)!=TCL_OK) { return TCL_ERROR; }




		if (zlacpy_(interp, "F", m, n, &a[a_offset], lda, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }


	    }

	} else if (*m >= mnthr2) {



	    ie = 1;
	    nrwork = ie + *n;
	    itauq = 1;
	    itaup = itauq + *n;
	    nwork = itaup + *n;


	    i__2 = *lwork - nwork + 1;
	    if (zgebrd_(interp, m, n, &a[a_offset], lda, &s[1], &rwork[ie], &work[itauq], 		    &work[itaup], &work[nwork], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }


	    if (wntqn) {


		if (dbdsdc_(interp, "U", "N", n, &s[1], &rwork[ie], dum, &zgesdd_c__1, dum, &			zgesdd_c__1, dum, idum, &rwork[nrwork], &iwork[1], info)!=TCL_OK) { return TCL_ERROR; }


	    } else if (wntqo) {
		iu = nwork;
		iru = nrwork;
		irvt = iru + *n * *n;
		nrwork = irvt + *n * *n;


		if (zlacpy_(interp, "U", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }

		i__2 = *lwork - nwork + 1;
		if (zungbr_(interp, "P", n, n, n, &vt[vt_offset], ldvt, &work[itaup], &			work[nwork], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }




		i__2 = *lwork - nwork + 1;
		if (zungbr_(interp, "Q", m, n, n, &a[a_offset], lda, &work[itauq], &work[			nwork], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }



		if (*lwork >= *m * *n + *n * 3) {


		    ldwrku = *m;
		} else {


		    ldwrku = (*lwork - *n * 3) / *n;
		}
		nwork = iu + ldwrku * *n;


		if (dbdsdc_(interp, "U", "I", n, &s[1], &rwork[ie], &rwork[iru], n, &			rwork[irvt], n, dum, idum, &rwork[nrwork], &iwork[1], 
			info)!=TCL_OK) { return TCL_ERROR; }




		if (zlarcm_(interp, n, n, &rwork[irvt], n, &vt[vt_offset], ldvt, &work[iu], &ldwrku, &rwork[nrwork])!=TCL_OK) { return TCL_ERROR; }


		if (zlacpy_(interp, "F", n, n, &work[iu], &ldwrku, &vt[vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }



		nrwork = irvt;
		i__2 = *m;
		i__1 = ldwrku;
		for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += 
			i__1) {
		    i__3 = *m - i__ + 1;
		    chunk = min(i__3,ldwrku);
		    if (zlacrm_(interp, &chunk, n, &a[i__ + a_dim1], lda, &rwork[iru], n, 			    &work[iu], &ldwrku, &rwork[nrwork])!=TCL_OK) { return TCL_ERROR; }


		    if (zlacpy_(interp, "F", &chunk, n, &work[iu], &ldwrku, &a[i__ + 			    a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }


		}

	    } else if (wntqs) {


		if (zlacpy_(interp, "U", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }

		i__1 = *lwork - nwork + 1;
		if (zungbr_(interp, "P", n, n, n, &vt[vt_offset], ldvt, &work[itaup], &			work[nwork], &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }




		if (zlacpy_(interp, "L", m, n, &a[a_offset], lda, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }

		i__1 = *lwork - nwork + 1;
		if (zungbr_(interp, "Q", m, n, n, &u[u_offset], ldu, &work[itauq], &work[			nwork], &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }




		iru = nrwork;
		irvt = iru + *n * *n;
		nrwork = irvt + *n * *n;
		if (dbdsdc_(interp, "U", "I", n, &s[1], &rwork[ie], &rwork[iru], n, &			rwork[irvt], n, dum, idum, &rwork[nrwork], &iwork[1], 
			info)!=TCL_OK) { return TCL_ERROR; }




		if (zlarcm_(interp, n, n, &rwork[irvt], n, &vt[vt_offset], ldvt, &a[			a_offset], lda, &rwork[nrwork])!=TCL_OK) { return TCL_ERROR; }


		if (zlacpy_(interp, "F", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }



		nrwork = irvt;
		if (zlacrm_(interp, m, n, &u[u_offset], ldu, &rwork[iru], n, &a[a_offset], 			 lda, &rwork[nrwork])!=TCL_OK) { return TCL_ERROR; }


		if (zlacpy_(interp, "F", m, n, &a[a_offset], lda, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }

	    } else {


		if (zlacpy_(interp, "U", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }

		i__1 = *lwork - nwork + 1;
		if (zungbr_(interp, "P", n, n, n, &vt[vt_offset], ldvt, &work[itaup], &			work[nwork], &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }




		if (zlacpy_(interp, "L", m, n, &a[a_offset], lda, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }

		i__1 = *lwork - nwork + 1;
		if (zungbr_(interp, "Q", m, m, n, &u[u_offset], ldu, &work[itauq], &work[			nwork], &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }




		iru = nrwork;
		irvt = iru + *n * *n;
		nrwork = irvt + *n * *n;
		if (dbdsdc_(interp, "U", "I", n, &s[1], &rwork[ie], &rwork[iru], n, &			rwork[irvt], n, dum, idum, &rwork[nrwork], &iwork[1], 
			info)!=TCL_OK) { return TCL_ERROR; }




		if (zlarcm_(interp, n, n, &rwork[irvt], n, &vt[vt_offset], ldvt, &a[			a_offset], lda, &rwork[nrwork])!=TCL_OK) { return TCL_ERROR; }


		if (zlacpy_(interp, "F", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }



		nrwork = irvt;
		if (zlacrm_(interp, m, n, &u[u_offset], ldu, &rwork[iru], n, &a[a_offset], 			 lda, &rwork[nrwork])!=TCL_OK) { return TCL_ERROR; }


		if (zlacpy_(interp, "F", m, n, &a[a_offset], lda, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }

	    }

	} else {



	    ie = 1;
	    nrwork = ie + *n;
	    itauq = 1;
	    itaup = itauq + *n;
	    nwork = itaup + *n;


	    i__1 = *lwork - nwork + 1;
	    if (zgebrd_(interp, m, n, &a[a_offset], lda, &s[1], &rwork[ie], &work[itauq], 		    &work[itaup], &work[nwork], &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }


	    if (wntqn) {


		if (dbdsdc_(interp, "U", "N", n, &s[1], &rwork[ie], dum, &zgesdd_c__1, dum, &			zgesdd_c__1, dum, idum, &rwork[nrwork], &iwork[1], info)!=TCL_OK) { return TCL_ERROR; }


	    } else if (wntqo) {
		iu = nwork;
		iru = nrwork;
		irvt = iru + *n * *n;
		nrwork = irvt + *n * *n;
		if (*lwork >= *m * *n + *n * 3) {


		    ldwrku = *m;
		} else {


		    ldwrku = (*lwork - *n * 3) / *n;
		}
		nwork = iu + ldwrku * *n;


		if (dbdsdc_(interp, "U", "I", n, &s[1], &rwork[ie], &rwork[iru], n, &			rwork[irvt], n, dum, idum, &rwork[nrwork], &iwork[1], 
			info)!=TCL_OK) { return TCL_ERROR; }




		if (zlacp2_(interp, "F", n, n, &rwork[irvt], n, &vt[vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }

		i__1 = *lwork - nwork + 1;
		if (zunmbr_(interp, "P", "R", "C", n, n, n, &a[a_offset], lda, &work[			itaup], &vt[vt_offset], ldvt, &work[nwork], &i__1, &
			ierr)!=TCL_OK) { return TCL_ERROR; }



		if (*lwork >= *m * *n + *n * 3) {


		    if (zlaset_(interp, "F", m, n, &zgesdd_c_b1, &zgesdd_c_b1, &work[iu], &ldwrku)!=TCL_OK) { return TCL_ERROR; }

		    if (zlacp2_(interp, "F", n, n, &rwork[iru], n, &work[iu], &ldwrku)!=TCL_OK) { return TCL_ERROR; }

		    i__1 = *lwork - nwork + 1;
		    if (zunmbr_(interp, "Q", "L", "N", m, n, n, &a[a_offset], lda, &work[			    itauq], &work[iu], &ldwrku, &work[nwork], &i__1, &
			    ierr)!=TCL_OK) { return TCL_ERROR; }


		    if (zlacpy_(interp, "F", m, n, &work[iu], &ldwrku, &a[a_offset], lda)!=TCL_OK) { return TCL_ERROR; }

		} else {


		    i__1 = *lwork - nwork + 1;
		    if (zungbr_(interp, "Q", m, n, n, &a[a_offset], lda, &work[itauq], &			    work[nwork], &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }




		    nrwork = irvt;
		    i__1 = *m;
		    i__2 = ldwrku;
		    for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ +=
			     i__2) {
			i__3 = *m - i__ + 1;
			chunk = min(i__3,ldwrku);
			if (zlacrm_(interp, &chunk, n, &a[i__ + a_dim1], lda, &rwork[iru], 				 n, &work[iu], &ldwrku, &rwork[nrwork])!=TCL_OK) { return TCL_ERROR; }


			if (zlacpy_(interp, "F", &chunk, n, &work[iu], &ldwrku, &a[i__ + 				a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }


		    }
		}

	    } else if (wntqs) {


		iru = nrwork;
		irvt = iru + *n * *n;
		nrwork = irvt + *n * *n;
		if (dbdsdc_(interp, "U", "I", n, &s[1], &rwork[ie], &rwork[iru], n, &			rwork[irvt], n, dum, idum, &rwork[nrwork], &iwork[1], 
			info)!=TCL_OK) { return TCL_ERROR; }




		if (zlaset_(interp, "F", m, n, &zgesdd_c_b1, &zgesdd_c_b1, &u[u_offset], ldu)			!=TCL_OK) { return TCL_ERROR; }


		if (zlacp2_(interp, "F", n, n, &rwork[iru], n, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }

		i__2 = *lwork - nwork + 1;
		if (zunmbr_(interp, "Q", "L", "N", m, n, n, &a[a_offset], lda, &work[			itauq], &u[u_offset], ldu, &work[nwork], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }




		if (zlacp2_(interp, "F", n, n, &rwork[irvt], n, &vt[vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }

		i__2 = *lwork - nwork + 1;
		if (zunmbr_(interp, "P", "R", "C", n, n, n, &a[a_offset], lda, &work[			itaup], &vt[vt_offset], ldvt, &work[nwork], &i__2, &
			ierr)!=TCL_OK) { return TCL_ERROR; }


	    } else {


		iru = nrwork;
		irvt = iru + *n * *n;
		nrwork = irvt + *n * *n;
		if (dbdsdc_(interp, "U", "I", n, &s[1], &rwork[ie], &rwork[iru], n, &			rwork[irvt], n, dum, idum, &rwork[nrwork], &iwork[1], 
			info)!=TCL_OK) { return TCL_ERROR; }




		if (zlaset_(interp, "F", m, m, &zgesdd_c_b1, &zgesdd_c_b1, &u[u_offset], ldu)			!=TCL_OK) { return TCL_ERROR; }


		if (*m > *n) {
		    i__2 = *m - *n;
		    i__1 = *m - *n;
		    if (zlaset_(interp, "F", &i__2, &i__1, &zgesdd_c_b1, &zgesdd_c_b2, &u[*n + 1 + (*n 			    + 1) * u_dim1], ldu)!=TCL_OK) { return TCL_ERROR; }


		}


		if (zlacp2_(interp, "F", n, n, &rwork[iru], n, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }

		i__2 = *lwork - nwork + 1;
		if (zunmbr_(interp, "Q", "L", "N", m, m, n, &a[a_offset], lda, &work[			itauq], &u[u_offset], ldu, &work[nwork], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }




		if (zlacp2_(interp, "F", n, n, &rwork[irvt], n, &vt[vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }

		i__2 = *lwork - nwork + 1;
		if (zunmbr_(interp, "P", "R", "C", n, n, n, &a[a_offset], lda, &work[			itaup], &vt[vt_offset], ldvt, &work[nwork], &i__2, &
			ierr)!=TCL_OK) { return TCL_ERROR; }


	    }

	}

    } else {


	if (*n >= mnthr1) {

	    if (wntqn) {


		itau = 1;
		nwork = itau + *m;


		i__2 = *lwork - nwork + 1;
		if (zgelqf_(interp, m, n, &a[a_offset], lda, &work[itau], &work[nwork], &			i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }




		i__2 = *m - 1;
		i__1 = *m - 1;
		if (zlaset_(interp, "U", &i__2, &i__1, &zgesdd_c_b1, &zgesdd_c_b1, &a[(a_dim1 << 1) + 1], lda)!=TCL_OK) { return TCL_ERROR; }


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


		i__2 = *lwork - nwork + 1;
		if (zgebrd_(interp, m, m, &a[a_offset], lda, &s[1], &rwork[ie], &work[			itauq], &work[itaup], &work[nwork], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }


		nrwork = ie + *m;


		if (dbdsdc_(interp, "U", "N", m, &s[1], &rwork[ie], dum, &zgesdd_c__1, dum, &			zgesdd_c__1, dum, idum, &rwork[nrwork], &iwork[1], info)!=TCL_OK) { return TCL_ERROR; }



	    } else if (wntqo) {


		ivt = 1;
		ldwkvt = *m;


		il = ivt + ldwkvt * *m;
		if (*lwork >= *m * *n + *m * *m + *m * 3) {


		    ldwrkl = *m;
		    chunk = *n;
		} else {


		    ldwrkl = *m;
		    chunk = (*lwork - *m * *m - *m * 3) / *m;
		}
		itau = il + ldwrkl * chunk;
		nwork = itau + *m;


		i__2 = *lwork - nwork + 1;
		if (zgelqf_(interp, m, n, &a[a_offset], lda, &work[itau], &work[nwork], &			i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }




		if (zlacpy_(interp, "L", m, m, &a[a_offset], lda, &work[il], &ldwrkl)!=TCL_OK) { return TCL_ERROR; }

		i__2 = *m - 1;
		i__1 = *m - 1;
		if (zlaset_(interp, "U", &i__2, &i__1, &zgesdd_c_b1, &zgesdd_c_b1, &work[il + ldwrkl], &			ldwrkl)!=TCL_OK) { return TCL_ERROR; }




		i__2 = *lwork - nwork + 1;
		if (zunglq_(interp, m, n, m, &a[a_offset], lda, &work[itau], &work[nwork], 			 &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }


		ie = 1;
		itauq = itau;
		itaup = itauq + *m;
		nwork = itaup + *m;


		i__2 = *lwork - nwork + 1;
		if (zgebrd_(interp, m, m, &work[il], &ldwrkl, &s[1], &rwork[ie], &work[			itauq], &work[itaup], &work[nwork], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }




		iru = ie + *m;
		irvt = iru + *m * *m;
		nrwork = irvt + *m * *m;
		if (dbdsdc_(interp, "U", "I", m, &s[1], &rwork[ie], &rwork[iru], m, &			rwork[irvt], m, dum, idum, &rwork[nrwork], &iwork[1], 
			info)!=TCL_OK) { return TCL_ERROR; }




		if (zlacp2_(interp, "F", m, m, &rwork[iru], m, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }

		i__2 = *lwork - nwork + 1;
		if (zunmbr_(interp, "Q", "L", "N", m, m, m, &work[il], &ldwrkl, &work[			itauq], &u[u_offset], ldu, &work[nwork], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }




		if (zlacp2_(interp, "F", m, m, &rwork[irvt], m, &work[ivt], &ldwkvt)!=TCL_OK) { return TCL_ERROR; }

		i__2 = *lwork - nwork + 1;
		if (zunmbr_(interp, "P", "R", "C", m, m, m, &work[il], &ldwrkl, &work[			itaup], &work[ivt], &ldwkvt, &work[nwork], &i__2, &
			ierr)!=TCL_OK) { return TCL_ERROR; }




		i__2 = *n;
		i__1 = chunk;
		for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += 
			i__1) {
		    i__3 = *n - i__ + 1;
		    blk = min(i__3,chunk);
		    if (zgemm_(interp, "N", "N", m, &blk, m, &zgesdd_c_b2, &work[ivt], m, &a[i__ 			    * a_dim1 + 1], lda, &zgesdd_c_b1, &work[il], &ldwrkl)!=TCL_OK) { return TCL_ERROR; }


		    if (zlacpy_(interp, "F", m, &blk, &work[il], &ldwrkl, &a[i__ * a_dim1 			    + 1], lda)!=TCL_OK) { return TCL_ERROR; }


		}

	    } else if (wntqs) {


		il = 1;


		ldwrkl = *m;
		itau = il + ldwrkl * *m;
		nwork = itau + *m;


		i__1 = *lwork - nwork + 1;
		if (zgelqf_(interp, m, n, &a[a_offset], lda, &work[itau], &work[nwork], &			i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }




		if (zlacpy_(interp, "L", m, m, &a[a_offset], lda, &work[il], &ldwrkl)!=TCL_OK) { return TCL_ERROR; }

		i__1 = *m - 1;
		i__2 = *m - 1;
		if (zlaset_(interp, "U", &i__1, &i__2, &zgesdd_c_b1, &zgesdd_c_b1, &work[il + ldwrkl], &			ldwrkl)!=TCL_OK) { return TCL_ERROR; }




		i__1 = *lwork - nwork + 1;
		if (zunglq_(interp, m, n, m, &a[a_offset], lda, &work[itau], &work[nwork], 			 &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }


		ie = 1;
		itauq = itau;
		itaup = itauq + *m;
		nwork = itaup + *m;


		i__1 = *lwork - nwork + 1;
		if (zgebrd_(interp, m, m, &work[il], &ldwrkl, &s[1], &rwork[ie], &work[			itauq], &work[itaup], &work[nwork], &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }




		iru = ie + *m;
		irvt = iru + *m * *m;
		nrwork = irvt + *m * *m;
		if (dbdsdc_(interp, "U", "I", m, &s[1], &rwork[ie], &rwork[iru], m, &			rwork[irvt], m, dum, idum, &rwork[nrwork], &iwork[1], 
			info)!=TCL_OK) { return TCL_ERROR; }




		if (zlacp2_(interp, "F", m, m, &rwork[iru], m, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }

		i__1 = *lwork - nwork + 1;
		if (zunmbr_(interp, "Q", "L", "N", m, m, m, &work[il], &ldwrkl, &work[			itauq], &u[u_offset], ldu, &work[nwork], &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }




		if (zlacp2_(interp, "F", m, m, &rwork[irvt], m, &vt[vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }

		i__1 = *lwork - nwork + 1;
		if (zunmbr_(interp, "P", "R", "C", m, m, m, &work[il], &ldwrkl, &work[			itaup], &vt[vt_offset], ldvt, &work[nwork], &i__1, &
			ierr)!=TCL_OK) { return TCL_ERROR; }




		if (zlacpy_(interp, "F", m, m, &vt[vt_offset], ldvt, &work[il], &ldwrkl)!=TCL_OK) { return TCL_ERROR; }

		if (zgemm_(interp, "N", "N", m, n, m, &zgesdd_c_b2, &work[il], &ldwrkl, &a[			a_offset], lda, &zgesdd_c_b1, &vt[vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }



	    } else if (wntqa) {


		ivt = 1;


		ldwkvt = *m;
		itau = ivt + ldwkvt * *m;
		nwork = itau + *m;


		i__1 = *lwork - nwork + 1;
		if (zgelqf_(interp, m, n, &a[a_offset], lda, &work[itau], &work[nwork], &			i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }


		if (zlacpy_(interp, "U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }



		i__1 = *lwork - nwork + 1;
		if (zunglq_(interp, n, n, m, &vt[vt_offset], ldvt, &work[itau], &work[			nwork], &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }




		i__1 = *m - 1;
		i__2 = *m - 1;
		if (zlaset_(interp, "U", &i__1, &i__2, &zgesdd_c_b1, &zgesdd_c_b1, &a[(a_dim1 << 1) + 1], lda)!=TCL_OK) { return TCL_ERROR; }


		ie = 1;
		itauq = itau;
		itaup = itauq + *m;
		nwork = itaup + *m;


		i__1 = *lwork - nwork + 1;
		if (zgebrd_(interp, m, m, &a[a_offset], lda, &s[1], &rwork[ie], &work[			itauq], &work[itaup], &work[nwork], &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }




		iru = ie + *m;
		irvt = iru + *m * *m;
		nrwork = irvt + *m * *m;
		if (dbdsdc_(interp, "U", "I", m, &s[1], &rwork[ie], &rwork[iru], m, &			rwork[irvt], m, dum, idum, &rwork[nrwork], &iwork[1], 
			info)!=TCL_OK) { return TCL_ERROR; }




		if (zlacp2_(interp, "F", m, m, &rwork[iru], m, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }

		i__1 = *lwork - nwork + 1;
		if (zunmbr_(interp, "Q", "L", "N", m, m, m, &a[a_offset], lda, &work[			itauq], &u[u_offset], ldu, &work[nwork], &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }




		if (zlacp2_(interp, "F", m, m, &rwork[irvt], m, &work[ivt], &ldwkvt)!=TCL_OK) { return TCL_ERROR; }

		i__1 = *lwork - nwork + 1;
		if (zunmbr_(interp, "P", "R", "C", m, m, m, &a[a_offset], lda, &work[			itaup], &work[ivt], &ldwkvt, &work[nwork], &i__1, &
			ierr)!=TCL_OK) { return TCL_ERROR; }




		if (zgemm_(interp, "N", "N", m, n, m, &zgesdd_c_b2, &work[ivt], &ldwkvt, &vt[			vt_offset], ldvt, &zgesdd_c_b1, &a[a_offset], lda)!=TCL_OK) { return TCL_ERROR; }




		if (zlacpy_(interp, "F", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }


	    }

	} else if (*n >= mnthr2) {




	    ie = 1;
	    nrwork = ie + *m;
	    itauq = 1;
	    itaup = itauq + *m;
	    nwork = itaup + *m;


	    i__1 = *lwork - nwork + 1;
	    if (zgebrd_(interp, m, n, &a[a_offset], lda, &s[1], &rwork[ie], &work[itauq], 		    &work[itaup], &work[nwork], &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }



	    if (wntqn) {


		if (dbdsdc_(interp, "L", "N", m, &s[1], &rwork[ie], dum, &zgesdd_c__1, dum, &			zgesdd_c__1, dum, idum, &rwork[nrwork], &iwork[1], info)!=TCL_OK) { return TCL_ERROR; }


	    } else if (wntqo) {
		irvt = nrwork;
		iru = irvt + *m * *m;
		nrwork = iru + *m * *m;
		ivt = nwork;


		if (zlacpy_(interp, "L", m, m, &a[a_offset], lda, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }

		i__1 = *lwork - nwork + 1;
		if (zungbr_(interp, "Q", m, m, n, &u[u_offset], ldu, &work[itauq], &work[			nwork], &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }




		i__1 = *lwork - nwork + 1;
		if (zungbr_(interp, "P", m, n, m, &a[a_offset], lda, &work[itaup], &work[			nwork], &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }



		ldwkvt = *m;
		if (*lwork >= *m * *n + *m * 3) {


		    nwork = ivt + ldwkvt * *n;
		    chunk = *n;
		} else {


		    chunk = (*lwork - *m * 3) / *m;
		    nwork = ivt + ldwkvt * chunk;
		}


		if (dbdsdc_(interp, "L", "I", m, &s[1], &rwork[ie], &rwork[iru], m, &			rwork[irvt], m, dum, idum, &rwork[nrwork], &iwork[1], 
			info)!=TCL_OK) { return TCL_ERROR; }




		if (zlacrm_(interp, m, m, &u[u_offset], ldu, &rwork[iru], m, &work[ivt], &			ldwkvt, &rwork[nrwork])!=TCL_OK) { return TCL_ERROR; }


		if (zlacpy_(interp, "F", m, m, &work[ivt], &ldwkvt, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }



		nrwork = iru;
		i__1 = *n;
		i__2 = chunk;
		for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += 
			i__2) {
		    i__3 = *n - i__ + 1;
		    blk = min(i__3,chunk);
		    if (zlarcm_(interp, m, &blk, &rwork[irvt], m, &a[i__ * a_dim1 + 1], 			    lda, &work[ivt], &ldwkvt, &rwork[nrwork])!=TCL_OK) { return TCL_ERROR; }


		    if (zlacpy_(interp, "F", m, &blk, &work[ivt], &ldwkvt, &a[i__ * 			    a_dim1 + 1], lda)!=TCL_OK) { return TCL_ERROR; }


		}
	    } else if (wntqs) {


		if (zlacpy_(interp, "L", m, m, &a[a_offset], lda, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }

		i__2 = *lwork - nwork + 1;
		if (zungbr_(interp, "Q", m, m, n, &u[u_offset], ldu, &work[itauq], &work[			nwork], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }




		if (zlacpy_(interp, "U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }

		i__2 = *lwork - nwork + 1;
		if (zungbr_(interp, "P", m, n, m, &vt[vt_offset], ldvt, &work[itaup], &			work[nwork], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }




		irvt = nrwork;
		iru = irvt + *m * *m;
		nrwork = iru + *m * *m;
		if (dbdsdc_(interp, "L", "I", m, &s[1], &rwork[ie], &rwork[iru], m, &			rwork[irvt], m, dum, idum, &rwork[nrwork], &iwork[1], 
			info)!=TCL_OK) { return TCL_ERROR; }




		if (zlacrm_(interp, m, m, &u[u_offset], ldu, &rwork[iru], m, &a[a_offset], 			 lda, &rwork[nrwork])!=TCL_OK) { return TCL_ERROR; }


		if (zlacpy_(interp, "F", m, m, &a[a_offset], lda, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }



		nrwork = iru;
		if (zlarcm_(interp, m, n, &rwork[irvt], m, &vt[vt_offset], ldvt, &a[			a_offset], lda, &rwork[nrwork])!=TCL_OK) { return TCL_ERROR; }


		if (zlacpy_(interp, "F", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }

	    } else {


		if (zlacpy_(interp, "L", m, m, &a[a_offset], lda, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }

		i__2 = *lwork - nwork + 1;
		if (zungbr_(interp, "Q", m, m, n, &u[u_offset], ldu, &work[itauq], &work[			nwork], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }




		if (zlacpy_(interp, "U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }

		i__2 = *lwork - nwork + 1;
		if (zungbr_(interp, "P", n, n, m, &vt[vt_offset], ldvt, &work[itaup], &			work[nwork], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }




		irvt = nrwork;
		iru = irvt + *m * *m;
		nrwork = iru + *m * *m;
		if (dbdsdc_(interp, "L", "I", m, &s[1], &rwork[ie], &rwork[iru], m, &			rwork[irvt], m, dum, idum, &rwork[nrwork], &iwork[1], 
			info)!=TCL_OK) { return TCL_ERROR; }




		if (zlacrm_(interp, m, m, &u[u_offset], ldu, &rwork[iru], m, &a[a_offset], 			 lda, &rwork[nrwork])!=TCL_OK) { return TCL_ERROR; }


		if (zlacpy_(interp, "F", m, m, &a[a_offset], lda, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }



		if (zlarcm_(interp, m, n, &rwork[irvt], m, &vt[vt_offset], ldvt, &a[			a_offset], lda, &rwork[nrwork])!=TCL_OK) { return TCL_ERROR; }


		if (zlacpy_(interp, "F", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }

	    }

	} else {



	    ie = 1;
	    nrwork = ie + *m;
	    itauq = 1;
	    itaup = itauq + *m;
	    nwork = itaup + *m;


	    i__2 = *lwork - nwork + 1;
	    if (zgebrd_(interp, m, n, &a[a_offset], lda, &s[1], &rwork[ie], &work[itauq], 		    &work[itaup], &work[nwork], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }


	    if (wntqn) {


		if (dbdsdc_(interp, "L", "N", m, &s[1], &rwork[ie], dum, &zgesdd_c__1, dum, &			zgesdd_c__1, dum, idum, &rwork[nrwork], &iwork[1], info)!=TCL_OK) { return TCL_ERROR; }


	    } else if (wntqo) {
		ldwkvt = *m;
		ivt = nwork;
		if (*lwork >= *m * *n + *m * 3) {


		    if (zlaset_(interp, "F", m, n, &zgesdd_c_b1, &zgesdd_c_b1, &work[ivt], &ldwkvt)!=TCL_OK) { return TCL_ERROR; }

		    nwork = ivt + ldwkvt * *n;
		} else {


		    chunk = (*lwork - *m * 3) / *m;
		    nwork = ivt + ldwkvt * chunk;
		}


		irvt = nrwork;
		iru = irvt + *m * *m;
		nrwork = iru + *m * *m;
		if (dbdsdc_(interp, "L", "I", m, &s[1], &rwork[ie], &rwork[iru], m, &			rwork[irvt], m, dum, idum, &rwork[nrwork], &iwork[1], 
			info)!=TCL_OK) { return TCL_ERROR; }




		if (zlacp2_(interp, "F", m, m, &rwork[iru], m, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }

		i__2 = *lwork - nwork + 1;
		if (zunmbr_(interp, "Q", "L", "N", m, m, n, &a[a_offset], lda, &work[			itauq], &u[u_offset], ldu, &work[nwork], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }



		if (*lwork >= *m * *n + *m * 3) {


		    if (zlacp2_(interp, "F", m, m, &rwork[irvt], m, &work[ivt], &ldwkvt)!=TCL_OK) { return TCL_ERROR; }

		    i__2 = *lwork - nwork + 1;
		    if (zunmbr_(interp, "P", "R", "C", m, n, m, &a[a_offset], lda, &work[			    itaup], &work[ivt], &ldwkvt, &work[nwork], &i__2, 
			    &ierr)!=TCL_OK) { return TCL_ERROR; }


		    if (zlacpy_(interp, "F", m, n, &work[ivt], &ldwkvt, &a[a_offset], lda)!=TCL_OK) { return TCL_ERROR; }

		} else {


		    i__2 = *lwork - nwork + 1;
		    if (zungbr_(interp, "P", m, n, m, &a[a_offset], lda, &work[itaup], &			    work[nwork], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }




		    nrwork = iru;
		    i__2 = *n;
		    i__1 = chunk;
		    for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ +=
			     i__1) {
			i__3 = *n - i__ + 1;
			blk = min(i__3,chunk);
			if (zlarcm_(interp, m, &blk, &rwork[irvt], m, &a[i__ * a_dim1 + 1], lda, &work[ivt], &ldwkvt, &rwork[nrwork])!=TCL_OK) { return TCL_ERROR; }


			if (zlacpy_(interp, "F", m, &blk, &work[ivt], &ldwkvt, &a[i__ * 				a_dim1 + 1], lda)!=TCL_OK) { return TCL_ERROR; }


		    }
		}
	    } else if (wntqs) {


		irvt = nrwork;
		iru = irvt + *m * *m;
		nrwork = iru + *m * *m;
		if (dbdsdc_(interp, "L", "I", m, &s[1], &rwork[ie], &rwork[iru], m, &			rwork[irvt], m, dum, idum, &rwork[nrwork], &iwork[1], 
			info)!=TCL_OK) { return TCL_ERROR; }




		if (zlacp2_(interp, "F", m, m, &rwork[iru], m, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }

		i__1 = *lwork - nwork + 1;
		if (zunmbr_(interp, "Q", "L", "N", m, m, n, &a[a_offset], lda, &work[			itauq], &u[u_offset], ldu, &work[nwork], &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }




		if (zlaset_(interp, "F", m, n, &zgesdd_c_b1, &zgesdd_c_b1, &vt[vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }

		if (zlacp2_(interp, "F", m, m, &rwork[irvt], m, &vt[vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }

		i__1 = *lwork - nwork + 1;
		if (zunmbr_(interp, "P", "R", "C", m, n, m, &a[a_offset], lda, &work[			itaup], &vt[vt_offset], ldvt, &work[nwork], &i__1, &
			ierr)!=TCL_OK) { return TCL_ERROR; }


	    } else {


		irvt = nrwork;
		iru = irvt + *m * *m;
		nrwork = iru + *m * *m;

		if (dbdsdc_(interp, "L", "I", m, &s[1], &rwork[ie], &rwork[iru], m, &			rwork[irvt], m, dum, idum, &rwork[nrwork], &iwork[1], 
			info)!=TCL_OK) { return TCL_ERROR; }




		if (zlacp2_(interp, "F", m, m, &rwork[iru], m, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }

		i__1 = *lwork - nwork + 1;
		if (zunmbr_(interp, "Q", "L", "N", m, m, n, &a[a_offset], lda, &work[			itauq], &u[u_offset], ldu, &work[nwork], &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }




		if (zlaset_(interp, "F", n, n, &zgesdd_c_b1, &zgesdd_c_b2, &vt[vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }



		if (zlacp2_(interp, "F", m, m, &rwork[irvt], m, &vt[vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }

		i__1 = *lwork - nwork + 1;
		if (zunmbr_(interp, "P", "R", "C", n, n, m, &a[a_offset], lda, &work[			itaup], &vt[vt_offset], ldvt, &work[nwork], &i__1, &
			ierr)!=TCL_OK) { return TCL_ERROR; }


	    }

	}

    }


    if (iscl == 1) {
	if (anrm > bignum) {
	    if (dlascl_(interp, "G", &zgesdd_c__0, &zgesdd_c__0, &bignum, &anrm, &minmn, &zgesdd_c__1, &s[1], &		    minmn, &ierr)!=TCL_OK) { return TCL_ERROR; }


	}
	if (*info != 0 && anrm > bignum) {
	    i__1 = minmn - 1;
	    if (dlascl_(interp, "G", &zgesdd_c__0, &zgesdd_c__0, &bignum, &anrm, &i__1, &zgesdd_c__1, &rwork[		    ie], &minmn, &ierr)!=TCL_OK) { return TCL_ERROR; }


	}
	if (anrm < smlnum) {
	    if (dlascl_(interp, "G", &zgesdd_c__0, &zgesdd_c__0, &smlnum, &anrm, &minmn, &zgesdd_c__1, &s[1], &		    minmn, &ierr)!=TCL_OK) { return TCL_ERROR; }


	}
	if (*info != 0 && anrm < smlnum) {
	    i__1 = minmn - 1;
	    if (dlascl_(interp, "G", &zgesdd_c__0, &zgesdd_c__0, &smlnum, &anrm, &i__1, &zgesdd_c__1, &rwork[		    ie], &minmn, &ierr)!=TCL_OK) { return TCL_ERROR; }


	}
    }


    work[1].r = (doublereal) maxwrk, work[1].i = 0.;

return TCL_OK;


} /* zgesdd_ */
MODULE_SCOPE /* Subroutine */ int dgemm_ (Tcl_Interp *interp, char *transa, char *transb, integer *m, integer *	n, integer *k, doublereal *alpha, doublereal *a, integer *lda, 	doublereal *b, integer *ldb, doublereal *beta, doublereal *c__, 	integer *ldc)
{
    integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, 
	    i__3;

    integer i__, j, l, info;
    logical nota, notb;
    doublereal temp;
    integer ncola;
    integer nrowa, nrowb;




































    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    b_dim1 = *ldb;
    b_offset = 1 + b_dim1;
    b -= b_offset;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;

    nota = lsame_(transa, "N");
    notb = lsame_(transb, "N");
    if (nota) {
	nrowa = *m;
	ncola = *k;
    } else {
	nrowa = *k;
	ncola = *m;
    }
    if (notb) {
	nrowb = *k;
    } else {
	nrowb = *n;
    }


    info = 0;
    if (! nota && ! lsame_(transa, "C") && ! lsame_(
	    transa, "T")) {
	info = 1;
    } else if (! notb && ! lsame_(transb, "C") && ! 
	    lsame_(transb, "T")) {
	info = 2;
    } else if (*m < 0) {
	info = 3;
    } else if (*n < 0) {
	info = 4;
    } else if (*k < 0) {
	info = 5;
    } else if (*lda < max(1,nrowa)) {
	info = 8;
    } else if (*ldb < max(1,nrowb)) {
	info = 10;
    } else if (*ldc < max(1,*m)) {
	info = 13;
    }
    if (info != 0) {
	vectcl_xerbla(interp, "DGEMM ", &info);
return TCL_ERROR;

return TCL_OK;
    }


    if (*m == 0 || *n == 0 || (*alpha == 0. || *k == 0) && *beta == 1.) {
return TCL_OK;
    }


    if (*alpha == 0.) {
	if (*beta == 0.) {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = *m;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    c__[i__ + j * c_dim1] = 0.;
		}
	    }
	} else {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = *m;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
		}
	    }
	}
return TCL_OK;
    }


    if (notb) {
	if (nota) {


	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		if (*beta == 0.) {
		    i__2 = *m;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			c__[i__ + j * c_dim1] = 0.;
		    }
		} else if (*beta != 1.) {
		    i__2 = *m;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
		    }
		}
		i__2 = *k;
		for (l = 1; l <= i__2; ++l) {
		    if (b[l + j * b_dim1] != 0.) {
			temp = *alpha * b[l + j * b_dim1];
			i__3 = *m;
			for (i__ = 1; i__ <= i__3; ++i__) {
			    c__[i__ + j * c_dim1] += temp * a[i__ + l * 
				    a_dim1];
			}
		    }
		}
	    }
	} else {


	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = *m;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    temp = 0.;
		    i__3 = *k;
		    for (l = 1; l <= i__3; ++l) {
			temp += a[l + i__ * a_dim1] * b[l + j * b_dim1];
		    }
		    if (*beta == 0.) {
			c__[i__ + j * c_dim1] = *alpha * temp;
		    } else {
			c__[i__ + j * c_dim1] = *alpha * temp + *beta * c__[
				i__ + j * c_dim1];
		    }
		}
	    }
	}
    } else {
	if (nota) {


	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		if (*beta == 0.) {
		    i__2 = *m;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			c__[i__ + j * c_dim1] = 0.;
		    }
		} else if (*beta != 1.) {
		    i__2 = *m;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
		    }
		}
		i__2 = *k;
		for (l = 1; l <= i__2; ++l) {
		    if (b[j + l * b_dim1] != 0.) {
			temp = *alpha * b[j + l * b_dim1];
			i__3 = *m;
			for (i__ = 1; i__ <= i__3; ++i__) {
			    c__[i__ + j * c_dim1] += temp * a[i__ + l * 
				    a_dim1];
			}
		    }
		}
	    }
	} else {


	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = *m;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    temp = 0.;
		    i__3 = *k;
		    for (l = 1; l <= i__3; ++l) {
			temp += a[l + i__ * a_dim1] * b[j + l * b_dim1];
		    }
		    if (*beta == 0.) {
			c__[i__ + j * c_dim1] = *alpha * temp;
		    } else {
			c__[i__ + j * c_dim1] = *alpha * temp + *beta * c__[
				i__ + j * c_dim1];
		    }
		}
	    }
	}
    }

return TCL_OK;


} /* dgemm_ */
MODULE_SCOPE /* Subroutine */ int zgemm_ (Tcl_Interp *interp, char *transa, char *transb, integer *m, integer *	n, integer *k, doublecomplex *alpha, doublecomplex *a, integer *lda, 	doublecomplex *b, integer *ldb, doublecomplex *beta, doublecomplex *	c__, integer *ldc)
{
    integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, 
	    i__3, i__4, i__5, i__6;
    doublecomplex z__1, z__2, z__3, z__4;

    void d_cnjg(doublecomplex *, doublecomplex *);

    integer i__, j, l, info;
    logical nota, notb;
    doublecomplex temp;
    logical conja, conjb;
    integer ncola;
    integer nrowa, nrowb;




































    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    b_dim1 = *ldb;
    b_offset = 1 + b_dim1;
    b -= b_offset;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;

    nota = lsame_(transa, "N");
    notb = lsame_(transb, "N");
    conja = lsame_(transa, "C");
    conjb = lsame_(transb, "C");
    if (nota) {
	nrowa = *m;
	ncola = *k;
    } else {
	nrowa = *k;
	ncola = *m;
    }
    if (notb) {
	nrowb = *k;
    } else {
	nrowb = *n;
    }


    info = 0;
    if (! nota && ! conja && ! lsame_(transa, "T")) {
	info = 1;
    } else if (! notb && ! conjb && ! lsame_(transb, "T")) {
	info = 2;
    } else if (*m < 0) {
	info = 3;
    } else if (*n < 0) {
	info = 4;
    } else if (*k < 0) {
	info = 5;
    } else if (*lda < max(1,nrowa)) {
	info = 8;
    } else if (*ldb < max(1,nrowb)) {
	info = 10;
    } else if (*ldc < max(1,*m)) {
	info = 13;
    }
    if (info != 0) {
	vectcl_xerbla(interp, "ZGEMM ", &info);
return TCL_ERROR;

return TCL_OK;
    }


    if (*m == 0 || *n == 0 || (alpha->r == 0. && alpha->i == 0. || *k == 0) &&
	     (beta->r == 1. && beta->i == 0.)) {
return TCL_OK;
    }


    if (alpha->r == 0. && alpha->i == 0.) {
	if (beta->r == 0. && beta->i == 0.) {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = *m;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    i__3 = i__ + j * c_dim1;
		    c__[i__3].r = 0., c__[i__3].i = 0.;
		}
	    }
	} else {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = *m;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    i__3 = i__ + j * c_dim1;
		    i__4 = i__ + j * c_dim1;
		    z__1.r = beta->r * c__[i__4].r - beta->i * c__[i__4].i, 
			    z__1.i = beta->r * c__[i__4].i + beta->i * c__[
			    i__4].r;
		    c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
		}
	    }
	}
return TCL_OK;
    }


    if (notb) {
	if (nota) {


	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		if (beta->r == 0. && beta->i == 0.) {
		    i__2 = *m;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			i__3 = i__ + j * c_dim1;
			c__[i__3].r = 0., c__[i__3].i = 0.;
		    }
		} else if (beta->r != 1. || beta->i != 0.) {
		    i__2 = *m;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			i__3 = i__ + j * c_dim1;
			i__4 = i__ + j * c_dim1;
			z__1.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
				.i, z__1.i = beta->r * c__[i__4].i + beta->i *
				 c__[i__4].r;
			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
		    }
		}
		i__2 = *k;
		for (l = 1; l <= i__2; ++l) {
		    i__3 = l + j * b_dim1;
		    if (b[i__3].r != 0. || b[i__3].i != 0.) {
			i__3 = l + j * b_dim1;
			z__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3].i, 
				z__1.i = alpha->r * b[i__3].i + alpha->i * b[
				i__3].r;
			temp.r = z__1.r, temp.i = z__1.i;
			i__3 = *m;
			for (i__ = 1; i__ <= i__3; ++i__) {
			    i__4 = i__ + j * c_dim1;
			    i__5 = i__ + j * c_dim1;
			    i__6 = i__ + l * a_dim1;
			    z__2.r = temp.r * a[i__6].r - temp.i * a[i__6].i, 
				    z__2.i = temp.r * a[i__6].i + temp.i * a[
				    i__6].r;
			    z__1.r = c__[i__5].r + z__2.r, z__1.i = c__[i__5]
				    .i + z__2.i;
			    c__[i__4].r = z__1.r, c__[i__4].i = z__1.i;
			}
		    }
		}
	    }
	} else if (conja) {


	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = *m;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    temp.r = 0., temp.i = 0.;
		    i__3 = *k;
		    for (l = 1; l <= i__3; ++l) {
			d_cnjg(&z__3, &a[l + i__ * a_dim1]);
			i__4 = l + j * b_dim1;
			z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4].i, 
				z__2.i = z__3.r * b[i__4].i + z__3.i * b[i__4]
				.r;
			z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
			temp.r = z__1.r, temp.i = z__1.i;
		    }
		    if (beta->r == 0. && beta->i == 0.) {
			i__3 = i__ + j * c_dim1;
			z__1.r = alpha->r * temp.r - alpha->i * temp.i, 
				z__1.i = alpha->r * temp.i + alpha->i * 
				temp.r;
			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
		    } else {
			i__3 = i__ + j * c_dim1;
			z__2.r = alpha->r * temp.r - alpha->i * temp.i, 
				z__2.i = alpha->r * temp.i + alpha->i * 
				temp.r;
			i__4 = i__ + j * c_dim1;
			z__3.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
				.i, z__3.i = beta->r * c__[i__4].i + beta->i *
				 c__[i__4].r;
			z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
		    }
		}
	    }
	} else {


	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = *m;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    temp.r = 0., temp.i = 0.;
		    i__3 = *k;
		    for (l = 1; l <= i__3; ++l) {
			i__4 = l + i__ * a_dim1;
			i__5 = l + j * b_dim1;
			z__2.r = a[i__4].r * b[i__5].r - a[i__4].i * b[i__5]
				.i, z__2.i = a[i__4].r * b[i__5].i + a[i__4]
				.i * b[i__5].r;
			z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
			temp.r = z__1.r, temp.i = z__1.i;
		    }
		    if (beta->r == 0. && beta->i == 0.) {
			i__3 = i__ + j * c_dim1;
			z__1.r = alpha->r * temp.r - alpha->i * temp.i, 
				z__1.i = alpha->r * temp.i + alpha->i * 
				temp.r;
			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
		    } else {
			i__3 = i__ + j * c_dim1;
			z__2.r = alpha->r * temp.r - alpha->i * temp.i, 
				z__2.i = alpha->r * temp.i + alpha->i * 
				temp.r;
			i__4 = i__ + j * c_dim1;
			z__3.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
				.i, z__3.i = beta->r * c__[i__4].i + beta->i *
				 c__[i__4].r;
			z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
		    }
		}
	    }
	}
    } else if (nota) {
	if (conjb) {


	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		if (beta->r == 0. && beta->i == 0.) {
		    i__2 = *m;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			i__3 = i__ + j * c_dim1;
			c__[i__3].r = 0., c__[i__3].i = 0.;
		    }
		} else if (beta->r != 1. || beta->i != 0.) {
		    i__2 = *m;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			i__3 = i__ + j * c_dim1;
			i__4 = i__ + j * c_dim1;
			z__1.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
				.i, z__1.i = beta->r * c__[i__4].i + beta->i *
				 c__[i__4].r;
			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
		    }
		}
		i__2 = *k;
		for (l = 1; l <= i__2; ++l) {
		    i__3 = j + l * b_dim1;
		    if (b[i__3].r != 0. || b[i__3].i != 0.) {
			d_cnjg(&z__2, &b[j + l * b_dim1]);
			z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, 
				z__1.i = alpha->r * z__2.i + alpha->i * 
				z__2.r;
			temp.r = z__1.r, temp.i = z__1.i;
			i__3 = *m;
			for (i__ = 1; i__ <= i__3; ++i__) {
			    i__4 = i__ + j * c_dim1;
			    i__5 = i__ + j * c_dim1;
			    i__6 = i__ + l * a_dim1;
			    z__2.r = temp.r * a[i__6].r - temp.i * a[i__6].i, 
				    z__2.i = temp.r * a[i__6].i + temp.i * a[
				    i__6].r;
			    z__1.r = c__[i__5].r + z__2.r, z__1.i = c__[i__5]
				    .i + z__2.i;
			    c__[i__4].r = z__1.r, c__[i__4].i = z__1.i;
			}
		    }
		}
	    }
	} else {


	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		if (beta->r == 0. && beta->i == 0.) {
		    i__2 = *m;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			i__3 = i__ + j * c_dim1;
			c__[i__3].r = 0., c__[i__3].i = 0.;
		    }
		} else if (beta->r != 1. || beta->i != 0.) {
		    i__2 = *m;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			i__3 = i__ + j * c_dim1;
			i__4 = i__ + j * c_dim1;
			z__1.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
				.i, z__1.i = beta->r * c__[i__4].i + beta->i *
				 c__[i__4].r;
			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
		    }
		}
		i__2 = *k;
		for (l = 1; l <= i__2; ++l) {
		    i__3 = j + l * b_dim1;
		    if (b[i__3].r != 0. || b[i__3].i != 0.) {
			i__3 = j + l * b_dim1;
			z__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3].i, 
				z__1.i = alpha->r * b[i__3].i + alpha->i * b[
				i__3].r;
			temp.r = z__1.r, temp.i = z__1.i;
			i__3 = *m;
			for (i__ = 1; i__ <= i__3; ++i__) {
			    i__4 = i__ + j * c_dim1;
			    i__5 = i__ + j * c_dim1;
			    i__6 = i__ + l * a_dim1;
			    z__2.r = temp.r * a[i__6].r - temp.i * a[i__6].i, 
				    z__2.i = temp.r * a[i__6].i + temp.i * a[
				    i__6].r;
			    z__1.r = c__[i__5].r + z__2.r, z__1.i = c__[i__5]
				    .i + z__2.i;
			    c__[i__4].r = z__1.r, c__[i__4].i = z__1.i;
			}
		    }
		}
	    }
	}
    } else if (conja) {
	if (conjb) {


	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = *m;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    temp.r = 0., temp.i = 0.;
		    i__3 = *k;
		    for (l = 1; l <= i__3; ++l) {
			d_cnjg(&z__3, &a[l + i__ * a_dim1]);
			d_cnjg(&z__4, &b[j + l * b_dim1]);
			z__2.r = z__3.r * z__4.r - z__3.i * z__4.i, z__2.i = 
				z__3.r * z__4.i + z__3.i * z__4.r;
			z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
			temp.r = z__1.r, temp.i = z__1.i;
		    }
		    if (beta->r == 0. && beta->i == 0.) {
			i__3 = i__ + j * c_dim1;
			z__1.r = alpha->r * temp.r - alpha->i * temp.i, 
				z__1.i = alpha->r * temp.i + alpha->i * 
				temp.r;
			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
		    } else {
			i__3 = i__ + j * c_dim1;
			z__2.r = alpha->r * temp.r - alpha->i * temp.i, 
				z__2.i = alpha->r * temp.i + alpha->i * 
				temp.r;
			i__4 = i__ + j * c_dim1;
			z__3.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
				.i, z__3.i = beta->r * c__[i__4].i + beta->i *
				 c__[i__4].r;
			z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
		    }
		}
	    }
	} else {


	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = *m;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    temp.r = 0., temp.i = 0.;
		    i__3 = *k;
		    for (l = 1; l <= i__3; ++l) {
			d_cnjg(&z__3, &a[l + i__ * a_dim1]);
			i__4 = j + l * b_dim1;
			z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4].i, 
				z__2.i = z__3.r * b[i__4].i + z__3.i * b[i__4]
				.r;
			z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
			temp.r = z__1.r, temp.i = z__1.i;
		    }
		    if (beta->r == 0. && beta->i == 0.) {
			i__3 = i__ + j * c_dim1;
			z__1.r = alpha->r * temp.r - alpha->i * temp.i, 
				z__1.i = alpha->r * temp.i + alpha->i * 
				temp.r;
			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
		    } else {
			i__3 = i__ + j * c_dim1;
			z__2.r = alpha->r * temp.r - alpha->i * temp.i, 
				z__2.i = alpha->r * temp.i + alpha->i * 
				temp.r;
			i__4 = i__ + j * c_dim1;
			z__3.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
				.i, z__3.i = beta->r * c__[i__4].i + beta->i *
				 c__[i__4].r;
			z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
		    }
		}
	    }
	}
    } else {
	if (conjb) {


	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = *m;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    temp.r = 0., temp.i = 0.;
		    i__3 = *k;
		    for (l = 1; l <= i__3; ++l) {
			i__4 = l + i__ * a_dim1;
			d_cnjg(&z__3, &b[j + l * b_dim1]);
			z__2.r = a[i__4].r * z__3.r - a[i__4].i * z__3.i, 
				z__2.i = a[i__4].r * z__3.i + a[i__4].i * 
				z__3.r;
			z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
			temp.r = z__1.r, temp.i = z__1.i;
		    }
		    if (beta->r == 0. && beta->i == 0.) {
			i__3 = i__ + j * c_dim1;
			z__1.r = alpha->r * temp.r - alpha->i * temp.i, 
				z__1.i = alpha->r * temp.i + alpha->i * 
				temp.r;
			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
		    } else {
			i__3 = i__ + j * c_dim1;
			z__2.r = alpha->r * temp.r - alpha->i * temp.i, 
				z__2.i = alpha->r * temp.i + alpha->i * 
				temp.r;
			i__4 = i__ + j * c_dim1;
			z__3.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
				.i, z__3.i = beta->r * c__[i__4].i + beta->i *
				 c__[i__4].r;
			z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
		    }
		}
	    }
	} else {


	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = *m;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    temp.r = 0., temp.i = 0.;
		    i__3 = *k;
		    for (l = 1; l <= i__3; ++l) {
			i__4 = l + i__ * a_dim1;
			i__5 = j + l * b_dim1;
			z__2.r = a[i__4].r * b[i__5].r - a[i__4].i * b[i__5]
				.i, z__2.i = a[i__4].r * b[i__5].i + a[i__4]
				.i * b[i__5].r;
			z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
			temp.r = z__1.r, temp.i = z__1.i;
		    }
		    if (beta->r == 0. && beta->i == 0.) {
			i__3 = i__ + j * c_dim1;
			z__1.r = alpha->r * temp.r - alpha->i * temp.i, 
				z__1.i = alpha->r * temp.i + alpha->i * 
				temp.r;
			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
		    } else {
			i__3 = i__ + j * c_dim1;
			z__2.r = alpha->r * temp.r - alpha->i * temp.i, 
				z__2.i = alpha->r * temp.i + alpha->i * 
				temp.r;
			i__4 = i__ + j * c_dim1;
			z__3.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
				.i, z__3.i = beta->r * c__[i__4].i + beta->i *
				 c__[i__4].r;
			z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
		    }
		}
	    }
	}
    }

return TCL_OK;


} /* zgemm_ */
MODULE_SCOPE /* Subroutine */ int dsyevr_ (Tcl_Interp *interp, char *jobz, char *range, char *uplo, integer *n, 	doublereal *a, integer *lda, doublereal *vl, doublereal *vu, integer *	il, integer *iu, doublereal *abstol, integer *m, doublereal *w, 	doublereal *z__, integer *ldz, integer *isuppz, doublereal *work, 	integer *lwork, integer *iwork, integer *liwork, integer *info)
{
    integer a_dim1, a_offset, z_dim1, z_offset, i__1, i__2;
    doublereal d__1, d__2;

    double sqrt(doublereal);

    integer i__, j, nb, jj;
    doublereal eps, vll, vuu, tmp1;
    integer indd, inde;
    doublereal anrm;
    integer imax;
    doublereal rmin, rmax;
    integer inddd, indee;
    doublereal sigma;
    integer iinfo;
    char order[1];
    integer indwk;
    integer lwmin;
    logical lower, wantz;
    logical alleig, indeig;
    integer iscale, ieeeok, indibl, indifl;
    logical valeig;
    doublereal safmin;
    doublereal abstll, bignum;
    integer indtau, indisp;
    integer indiwo, indwkn;
    integer liwmin;
    logical tryrac;
    integer llwrkn, llwork, nsplit;
    doublereal smlnum;
    integer lwkopt;
    logical lquery;












































    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --w;
    z_dim1 = *ldz;
    z_offset = 1 + z_dim1;
    z__ -= z_offset;
    --isuppz;
    --work;
    --iwork;

    ieeeok = ilaenv_(&dsyevr_c__10, "DSYEVR", "N", &dsyevr_c__1, &dsyevr_c__2, &dsyevr_c__3, &dsyevr_c__4);

    lower = lsame_(uplo, "L");
    wantz = lsame_(jobz, "V");
    alleig = lsame_(range, "A");
    valeig = lsame_(range, "V");
    indeig = lsame_(range, "I");

    lquery = *lwork == -1 || *liwork == -1;

    i__1 = 1, i__2 = *n * 26;
    lwmin = max(i__1,i__2);
    i__1 = 1, i__2 = *n * 10;
    liwmin = max(i__1,i__2);

    *info = 0;
    if (! (wantz || lsame_(jobz, "N"))) {
	*info = -1;
    } else if (! (alleig || valeig || indeig)) {
	*info = -2;
    } else if (! (lower || lsame_(uplo, "U"))) {
	*info = -3;
    } else if (*n < 0) {
	*info = -4;
    } else if (*lda < max(1,*n)) {
	*info = -6;
    } else {
	if (valeig) {
	    if (*n > 0 && *vu <= *vl) {
		*info = -8;
	    }
	} else if (indeig) {
	    if (*il < 1 || *il > max(1,*n)) {
		*info = -9;
	    } else if (*iu < min(*n,*il) || *iu > *n) {
		*info = -10;
	    }
	}
    }
    if (*info == 0) {
	if (*ldz < 1 || wantz && *ldz < *n) {
	    *info = -15;
	} else if (*lwork < lwmin && ! lquery) {
	    *info = -18;
	} else if (*liwork < liwmin && ! lquery) {
	    *info = -20;
	}
    }

    if (*info == 0) {
	nb = ilaenv_(&dsyevr_c__1, "DSYTRD", uplo, n, &dsyevr_c_n1, &dsyevr_c_n1, &dsyevr_c_n1);
	i__1 = nb, i__2 = ilaenv_(&dsyevr_c__1, "DORMTR", uplo, n, &dsyevr_c_n1, &dsyevr_c_n1, &
		dsyevr_c_n1);
	nb = max(i__1,i__2);
	i__1 = (nb + 1) * *n;
	lwkopt = max(i__1,lwmin);
	work[1] = (doublereal) lwkopt;
	iwork[1] = liwmin;
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DSYEVR", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


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

    if (*n == 1) {
	work[1] = 7.;
	if (alleig || indeig) {
	    *m = 1;
	    w[1] = a[a_dim1 + 1];
	} else {
	    if (*vl < a[a_dim1 + 1] && *vu >= a[a_dim1 + 1]) {
		*m = 1;
		w[1] = a[a_dim1 + 1];
	    }
	}
	if (wantz) {
	    z__[z_dim1 + 1] = 1.;
	}
return TCL_OK;
    }


    safmin = dlamch_("Safe minimum");
    eps = dlamch_("Precision");
    smlnum = safmin / eps;
    bignum = 1. / smlnum;
    rmin = sqrt(smlnum);
    d__1 = sqrt(bignum), d__2 = 1. / sqrt(sqrt(safmin));
    rmax = min(d__1,d__2);


    iscale = 0;
    abstll = *abstol;
    vll = *vl;
    vuu = *vu;
    anrm = dlansy_("M", uplo, n, &a[a_offset], lda, &work[1]);
    if (anrm > 0. && anrm < rmin) {
	iscale = 1;
	sigma = rmin / anrm;
    } else if (anrm > rmax) {
	iscale = 1;
	sigma = rmax / anrm;
    }
    if (iscale == 1) {
	if (lower) {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = *n - j + 1;
		if (dscal_(interp, &i__2, &sigma, &a[j + j * a_dim1], &dsyevr_c__1)!=TCL_OK) { return TCL_ERROR; }

	    }
	} else {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		if (dscal_(interp, &j, &sigma, &a[j * a_dim1 + 1], &dsyevr_c__1)!=TCL_OK) { return TCL_ERROR; }

	    }
	}
	if (*abstol > 0.) {
	    abstll = *abstol * sigma;
	}
	if (valeig) {
	    vll = *vl * sigma;
	    vuu = *vu * sigma;
	}
    }
    indtau = 1;
    indd = indtau + *n;
    inde = indd + *n;
    inddd = inde + *n;
    indee = inddd + *n;
    indwk = indee + *n;
    llwork = *lwork - indwk + 1;
    indibl = 1;
    indisp = indibl + *n;
    indifl = indisp + *n;
    indiwo = indisp + *n;


    if (dsytrd_(interp, uplo, n, &a[a_offset], lda, &work[indd], &work[inde], &work[	    indtau], &work[indwk], &llwork, &iinfo)!=TCL_OK) { return TCL_ERROR; }




    if ((alleig || indeig && *il == 1 && *iu == *n) && ieeeok == 1) {
	if (! wantz) {
	    if (dcopy_(interp, n, &work[indd], &dsyevr_c__1, &w[1], &dsyevr_c__1)!=TCL_OK) { return TCL_ERROR; }

	    i__1 = *n - 1;
	    if (dcopy_(interp, &i__1, &work[inde], &dsyevr_c__1, &work[indee], &dsyevr_c__1)!=TCL_OK) { return TCL_ERROR; }

	    if (dsterf_(interp, n, &w[1], &work[indee], info)!=TCL_OK) { return TCL_ERROR; }

	} else {
	    i__1 = *n - 1;
	    if (dcopy_(interp, &i__1, &work[inde], &dsyevr_c__1, &work[indee], &dsyevr_c__1)!=TCL_OK) { return TCL_ERROR; }

	    if (dcopy_(interp, n, &work[indd], &dsyevr_c__1, &work[inddd], &dsyevr_c__1)!=TCL_OK) { return TCL_ERROR; }


	    if (*abstol <= *n * 2. * eps) {
		tryrac = TRUE_;
	    } else {
		tryrac = FALSE_;
	    }
	    if (dstemr_(interp, jobz, "A", n, &work[inddd], &work[indee], vl, vu, il, iu, 		    m, &w[1], &z__[z_offset], ldz, n, &isuppz[1], &tryrac, &
		    work[indwk], lwork, &iwork[1], liwork, info)!=TCL_OK) { return TCL_ERROR; }






	    if (wantz && *info == 0) {
		indwkn = inde;
		llwrkn = *lwork - indwkn + 1;
		if (dormtr_(interp, "L", uplo, "N", n, m, &a[a_offset], lda, &work[indtau], &z__[z_offset], ldz, &work[indwkn], &llwrkn, &iinfo)!=TCL_OK) { return TCL_ERROR; }


	    }
	}


	if (*info == 0) {
	    *m = *n;
	    goto L30;
	}
	*info = 0;
    }


    if (wantz) {
	*(unsigned char *)order = 'B';
    } else {
	*(unsigned char *)order = 'E';
    }
    if (dstebz_(interp, range, order, n, &vll, &vuu, il, iu, &abstll, &work[indd], &work[	    inde], m, &nsplit, &w[1], &iwork[indibl], &iwork[indisp], &work[
	    indwk], &iwork[indiwo], info)!=TCL_OK) { return TCL_ERROR; }



    if (wantz) {
	if (dstein_(interp, n, &work[indd], &work[inde], m, &w[1], &iwork[indibl], &iwork[		indisp], &z__[z_offset], ldz, &work[indwk], &iwork[indiwo], &
		iwork[indifl], info)!=TCL_OK) { return TCL_ERROR; }




	indwkn = inde;
	llwrkn = *lwork - indwkn + 1;
	if (dormtr_(interp, "L", uplo, "N", n, m, &a[a_offset], lda, &work[indtau], &z__[		z_offset], ldz, &work[indwkn], &llwrkn, &iinfo)!=TCL_OK) { return TCL_ERROR; }


    }


L30:
    if (iscale == 1) {
	if (*info == 0) {
	    imax = *m;
	} else {
	    imax = *info - 1;
	}
	d__1 = 1. / sigma;
	if (dscal_(interp, &imax, &d__1, &w[1], &dsyevr_c__1)!=TCL_OK) { return TCL_ERROR; }

    }


    if (wantz) {
	i__1 = *m - 1;
	for (j = 1; j <= i__1; ++j) {
	    i__ = 0;
	    tmp1 = w[j];
	    i__2 = *m;
	    for (jj = j + 1; jj <= i__2; ++jj) {
		if (w[jj] < tmp1) {
		    i__ = jj;
		    tmp1 = w[jj];
		}
	    }

	    if (i__ != 0) {
		w[i__] = w[j];
		w[j] = tmp1;
		if (dswap_(interp, n, &z__[i__ * z_dim1 + 1], &dsyevr_c__1, &z__[j * z_dim1 + 1], 			 &dsyevr_c__1)!=TCL_OK) { return TCL_ERROR; }


	    }
	}
    }


    work[1] = (doublereal) lwkopt;
    iwork[1] = liwmin;

return TCL_OK;


} /* dsyevr_ */
MODULE_SCOPE /* Subroutine */ int zheevr_ (Tcl_Interp *interp, char *jobz, char *range, char *uplo, integer *n, 	doublecomplex *a, integer *lda, doublereal *vl, doublereal *vu, 	integer *il, integer *iu, doublereal *abstol, integer *m, doublereal *	w, doublecomplex *z__, integer *ldz, integer *isuppz, doublecomplex *	work, integer *lwork, doublereal *rwork, integer *lrwork, integer *	iwork, integer *liwork, integer *info)
{
    integer a_dim1, a_offset, z_dim1, z_offset, i__1, i__2;
    doublereal d__1, d__2;

    double sqrt(doublereal);

    integer i__, j, nb, jj;
    doublereal eps, vll, vuu, tmp1, anrm;
    integer imax;
    doublereal rmin, rmax;
    logical test;
    integer itmp1;
    integer indrd, indre;
    doublereal sigma;
    integer iinfo;
    char order[1];
    integer indwk;
    integer lwmin;
    logical lower, wantz;
    logical alleig, indeig;
    integer iscale, ieeeok, indibl, indrdd, indifl, indree;
    logical valeig;
    doublereal safmin;
    doublereal abstll, bignum;
    integer indtau, indisp;
    integer indiwo, indwkn;
    integer indrwk, liwmin;
    logical tryrac;
    integer lrwmin, llwrkn, llwork, nsplit;
    doublereal smlnum;
    logical lquery;
    integer lwkopt;
    integer llrwork;















































    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --w;
    z_dim1 = *ldz;
    z_offset = 1 + z_dim1;
    z__ -= z_offset;
    --isuppz;
    --work;
    --rwork;
    --iwork;

    ieeeok = ilaenv_(&zheevr_c__10, "ZHEEVR", "N", &zheevr_c__1, &zheevr_c__2, &zheevr_c__3, &zheevr_c__4);

    lower = lsame_(uplo, "L");
    wantz = lsame_(jobz, "V");
    alleig = lsame_(range, "A");
    valeig = lsame_(range, "V");
    indeig = lsame_(range, "I");

    lquery = *lwork == -1 || *lrwork == -1 || *liwork == -1;

    i__1 = 1, i__2 = *n * 24;
    lrwmin = max(i__1,i__2);
    i__1 = 1, i__2 = *n * 10;
    liwmin = max(i__1,i__2);
    i__1 = 1, i__2 = *n << 1;
    lwmin = max(i__1,i__2);

    *info = 0;
    if (! (wantz || lsame_(jobz, "N"))) {
	*info = -1;
    } else if (! (alleig || valeig || indeig)) {
	*info = -2;
    } else if (! (lower || lsame_(uplo, "U"))) {
	*info = -3;
    } else if (*n < 0) {
	*info = -4;
    } else if (*lda < max(1,*n)) {
	*info = -6;
    } else {
	if (valeig) {
	    if (*n > 0 && *vu <= *vl) {
		*info = -8;
	    }
	} else if (indeig) {
	    if (*il < 1 || *il > max(1,*n)) {
		*info = -9;
	    } else if (*iu < min(*n,*il) || *iu > *n) {
		*info = -10;
	    }
	}
    }
    if (*info == 0) {
	if (*ldz < 1 || wantz && *ldz < *n) {
	    *info = -15;
	}
    }

    if (*info == 0) {
	nb = ilaenv_(&zheevr_c__1, "ZHETRD", uplo, n, &zheevr_c_n1, &zheevr_c_n1, &zheevr_c_n1);
	i__1 = nb, i__2 = ilaenv_(&zheevr_c__1, "ZUNMTR", uplo, n, &zheevr_c_n1, &zheevr_c_n1, &
		zheevr_c_n1);
	nb = max(i__1,i__2);
	i__1 = (nb + 1) * *n;
	lwkopt = max(i__1,lwmin);
	work[1].r = (doublereal) lwkopt, work[1].i = 0.;
	rwork[1] = (doublereal) lrwmin;
	iwork[1] = liwmin;

	if (*lwork < lwmin && ! lquery) {
	    *info = -18;
	} else if (*lrwork < lrwmin && ! lquery) {
	    *info = -20;
	} else if (*liwork < liwmin && ! lquery) {
	    *info = -22;
	}
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "ZHEEVR", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


    *m = 0;
    if (*n == 0) {
	work[1].r = 1., work[1].i = 0.;
return TCL_OK;
    }

    if (*n == 1) {
	work[1].r = 2., work[1].i = 0.;
	if (alleig || indeig) {
	    *m = 1;
	    i__1 = a_dim1 + 1;
	    w[1] = a[i__1].r;
	} else {
	    i__1 = a_dim1 + 1;
	    i__2 = a_dim1 + 1;
	    if (*vl < a[i__1].r && *vu >= a[i__2].r) {
		*m = 1;
		i__1 = a_dim1 + 1;
		w[1] = a[i__1].r;
	    }
	}
	if (wantz) {
	    i__1 = z_dim1 + 1;
	    z__[i__1].r = 1., z__[i__1].i = 0.;
	}
return TCL_OK;
    }


    safmin = dlamch_("Safe minimum");
    eps = dlamch_("Precision");
    smlnum = safmin / eps;
    bignum = 1. / smlnum;
    rmin = sqrt(smlnum);
    d__1 = sqrt(bignum), d__2 = 1. / sqrt(sqrt(safmin));
    rmax = min(d__1,d__2);


    iscale = 0;
    abstll = *abstol;
    if (valeig) {
	vll = *vl;
	vuu = *vu;
    }
    anrm = zlansy_("M", uplo, n, &a[a_offset], lda, &rwork[1]);
    if (anrm > 0. && anrm < rmin) {
	iscale = 1;
	sigma = rmin / anrm;
    } else if (anrm > rmax) {
	iscale = 1;
	sigma = rmax / anrm;
    }
    if (iscale == 1) {
	if (lower) {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = *n - j + 1;
		if (zdscal_(interp, &i__2, &sigma, &a[j + j * a_dim1], &zheevr_c__1)!=TCL_OK) { return TCL_ERROR; }

	    }
	} else {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		if (zdscal_(interp, &j, &sigma, &a[j * a_dim1 + 1], &zheevr_c__1)!=TCL_OK) { return TCL_ERROR; }

	    }
	}
	if (*abstol > 0.) {
	    abstll = *abstol * sigma;
	}
	if (valeig) {
	    vll = *vl * sigma;
	    vuu = *vu * sigma;
	}
    }
    indtau = 1;
    indwk = indtau + *n;
    llwork = *lwork - indwk + 1;
    indrd = 1;
    indre = indrd + *n;
    indrdd = indre + *n;
    indree = indrdd + *n;
    indrwk = indree + *n;
    llrwork = *lrwork - indrwk + 1;
    indibl = 1;
    indisp = indibl + *n;
    indifl = indisp + *n;
    indiwo = indisp + *n;


    if (zhetrd_(interp, uplo, n, &a[a_offset], lda, &rwork[indrd], &rwork[indre], &work[	    indtau], &work[indwk], &llwork, &iinfo)!=TCL_OK) { return TCL_ERROR; }




    test = FALSE_;
    if (indeig) {
	if (*il == 1 && *iu == *n) {
	    test = TRUE_;
	}
    }
    if ((alleig || test) && ieeeok == 1) {
	if (! wantz) {
	    if (dcopy_(interp, n, &rwork[indrd], &zheevr_c__1, &w[1], &zheevr_c__1)!=TCL_OK) { return TCL_ERROR; }

	    i__1 = *n - 1;
	    if (dcopy_(interp, &i__1, &rwork[indre], &zheevr_c__1, &rwork[indree], &zheevr_c__1)!=TCL_OK) { return TCL_ERROR; }

	    if (dsterf_(interp, n, &w[1], &rwork[indree], info)!=TCL_OK) { return TCL_ERROR; }

	} else {
	    i__1 = *n - 1;
	    if (dcopy_(interp, &i__1, &rwork[indre], &zheevr_c__1, &rwork[indree], &zheevr_c__1)!=TCL_OK) { return TCL_ERROR; }

	    if (dcopy_(interp, n, &rwork[indrd], &zheevr_c__1, &rwork[indrdd], &zheevr_c__1)!=TCL_OK) { return TCL_ERROR; }


	    if (*abstol <= *n * 2. * eps) {
		tryrac = TRUE_;
	    } else {
		tryrac = FALSE_;
	    }
	    if (zstemr_(interp, jobz, "A", n, &rwork[indrdd], &rwork[indree], vl, vu, il, 		    iu, m, &w[1], &z__[z_offset], ldz, n, &isuppz[1], &tryrac, 
		     &rwork[indrwk], &llrwork, &iwork[1], liwork, info)!=TCL_OK) { return TCL_ERROR; }




	    if (wantz && *info == 0) {
		indwkn = indwk;
		llwrkn = *lwork - indwkn + 1;
		if (zunmtr_(interp, "L", uplo, "N", n, m, &a[a_offset], lda, &work[indtau], &z__[z_offset], ldz, &work[indwkn], &llwrkn, &iinfo)!=TCL_OK) { return TCL_ERROR; }


	    }
	}


	if (*info == 0) {
	    *m = *n;
	    goto L30;
	}
	*info = 0;
    }


    if (wantz) {
	*(unsigned char *)order = 'B';
    } else {
	*(unsigned char *)order = 'E';
    }
    if (dstebz_(interp, range, order, n, &vll, &vuu, il, iu, &abstll, &rwork[indrd], &	    rwork[indre], m, &nsplit, &w[1], &iwork[indibl], &iwork[indisp], &
	    rwork[indrwk], &iwork[indiwo], info)!=TCL_OK) { return TCL_ERROR; }



    if (wantz) {
	if (zstein_(interp, n, &rwork[indrd], &rwork[indre], m, &w[1], &iwork[indibl], &		iwork[indisp], &z__[z_offset], ldz, &rwork[indrwk], &iwork[
		indiwo], &iwork[indifl], info)!=TCL_OK) { return TCL_ERROR; }




	indwkn = indwk;
	llwrkn = *lwork - indwkn + 1;
	if (zunmtr_(interp, "L", uplo, "N", n, m, &a[a_offset], lda, &work[indtau], &z__[		z_offset], ldz, &work[indwkn], &llwrkn, &iinfo)!=TCL_OK) { return TCL_ERROR; }


    }


L30:
    if (iscale == 1) {
	if (*info == 0) {
	    imax = *m;
	} else {
	    imax = *info - 1;
	}
	d__1 = 1. / sigma;
	if (dscal_(interp, &imax, &d__1, &w[1], &zheevr_c__1)!=TCL_OK) { return TCL_ERROR; }

    }


    if (wantz) {
	i__1 = *m - 1;
	for (j = 1; j <= i__1; ++j) {
	    i__ = 0;
	    tmp1 = w[j];
	    i__2 = *m;
	    for (jj = j + 1; jj <= i__2; ++jj) {
		if (w[jj] < tmp1) {
		    i__ = jj;
		    tmp1 = w[jj];
		}
	    }

	    if (i__ != 0) {
		itmp1 = iwork[indibl + i__ - 1];
		w[i__] = w[j];
		iwork[indibl + i__ - 1] = iwork[indibl + j - 1];
		w[j] = tmp1;
		iwork[indibl + j - 1] = itmp1;
		if (zswap_(interp, n, &z__[i__ * z_dim1 + 1], &zheevr_c__1, &z__[j * z_dim1 + 1], 			 &zheevr_c__1)!=TCL_OK) { return TCL_ERROR; }


	    }
	}
    }


    work[1].r = (doublereal) lwkopt, work[1].i = 0.;
    rwork[1] = (doublereal) lrwmin;
    iwork[1] = liwmin;

return TCL_OK;


} /* zheevr_ */
MODULE_SCOPE /* Subroutine */ int dgeev_ (Tcl_Interp *interp, char *jobvl, char *jobvr, integer *n, doublereal *	a, integer *lda, doublereal *wr, doublereal *wi, doublereal *vl, 	integer *ldvl, doublereal *vr, integer *ldvr, doublereal *work, 	integer *lwork, integer *info)
{
    integer a_dim1, a_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1, 
	    i__2, i__3;
    doublereal d__1, d__2;

    double sqrt(doublereal);

    integer i__, k;
    doublereal r__, cs, sn;
    integer ihi;
    doublereal scl;
    integer ilo;
    doublereal dum[1], eps;
    integer ibal;
    char side[1];
    doublereal anrm;
    integer ierr, itau;
    integer iwrk, nout;
    logical scalea;
    doublereal cscale;
    logical select[1];
    doublereal bignum;
    integer minwrk, maxwrk;
    logical wantvl;
    doublereal smlnum;
    integer hswork;
    logical lquery, wantvr;


























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

    *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;
    }


    if (*info == 0) {
	if (*n == 0) {
	    minwrk = 1;
	    maxwrk = 1;
	} else {
	    maxwrk = (*n << 1) + *n * ilaenv_(&dgeev_c__1, "DGEHRD", " ", n, &dgeev_c__1, 
		    n, &dgeev_c__0);
	    if (wantvl) {
		minwrk = *n << 2;
		i__1 = maxwrk, i__2 = (*n << 1) + (*n - 1) * ilaenv_(&dgeev_c__1, 
			"DORGHR", " ", n, &dgeev_c__1, n, &dgeev_c_n1);
		maxwrk = max(i__1,i__2);
		if (dhseqr_(interp, "S", "V", n, &dgeev_c__1, n, &a[a_offset], lda, &wr[1], &wi[			1], &vl[vl_offset], ldvl, &work[1], &dgeev_c_n1, info)!=TCL_OK) { return TCL_ERROR; }


		hswork = (integer) work[1];
		i__1 = maxwrk, i__2 = *n + 1, i__1 = max(i__1,i__2), i__2 = *
			n + hswork;
		maxwrk = max(i__1,i__2);
		i__1 = maxwrk, i__2 = *n << 2;
		maxwrk = max(i__1,i__2);
	    } else if (wantvr) {
		minwrk = *n << 2;
		i__1 = maxwrk, i__2 = (*n << 1) + (*n - 1) * ilaenv_(&dgeev_c__1, 
			"DORGHR", " ", n, &dgeev_c__1, n, &dgeev_c_n1);
		maxwrk = max(i__1,i__2);
		if (dhseqr_(interp, "S", "V", n, &dgeev_c__1, n, &a[a_offset], lda, &wr[1], &wi[			1], &vr[vr_offset], ldvr, &work[1], &dgeev_c_n1, info)!=TCL_OK) { return TCL_ERROR; }


		hswork = (integer) work[1];
		i__1 = maxwrk, i__2 = *n + 1, i__1 = max(i__1,i__2), i__2 = *
			n + hswork;
		maxwrk = max(i__1,i__2);
		i__1 = maxwrk, i__2 = *n << 2;
		maxwrk = max(i__1,i__2);
	    } else {
		minwrk = *n * 3;
		if (dhseqr_(interp, "E", "N", n, &dgeev_c__1, n, &a[a_offset], lda, &wr[1], &wi[			1], &vr[vr_offset], ldvr, &work[1], &dgeev_c_n1, info)!=TCL_OK) { return TCL_ERROR; }


		hswork = (integer) work[1];
		i__1 = maxwrk, i__2 = *n + 1, i__1 = max(i__1,i__2), i__2 = *
			n + hswork;
		maxwrk = max(i__1,i__2);
	    }
	    maxwrk = max(maxwrk,minwrk);
	}
	work[1] = (doublereal) maxwrk;

	if (*lwork < minwrk && ! lquery) {
	    *info = -13;
	}
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DGEEV ", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


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


    eps = dlamch_("P");
    smlnum = dlamch_("S");
    bignum = 1. / smlnum;
    if (dlabad_(interp, &smlnum, &bignum)!=TCL_OK) { return TCL_ERROR; }

    smlnum = sqrt(smlnum) / eps;
    bignum = 1. / smlnum;


    anrm = 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) {
	if (dlascl_(interp, "G", &dgeev_c__0, &dgeev_c__0, &anrm, &cscale, n, n, &a[a_offset], lda, &		ierr)!=TCL_OK) { return TCL_ERROR; }


    }


    ibal = 1;
    if (dgebal_(interp, "B", n, &a[a_offset], lda, &ilo, &ihi, &work[ibal], &ierr)!=TCL_OK) { return TCL_ERROR; }



    itau = ibal + *n;
    iwrk = itau + *n;
    i__1 = *lwork - iwrk + 1;
    if (dgehrd_(interp, n, &ilo, &ihi, &a[a_offset], lda, &work[itau], &work[iwrk], &i__1, 	     &ierr)!=TCL_OK) { return TCL_ERROR; }



    if (wantvl) {


	*(unsigned char *)side = 'L';
	if (dlacpy_(interp, "L", n, n, &a[a_offset], lda, &vl[vl_offset], ldvl)		!=TCL_OK) { return TCL_ERROR; }




	i__1 = *lwork - iwrk + 1;
	if (dorghr_(interp, n, &ilo, &ihi, &vl[vl_offset], ldvl, &work[itau], &work[iwrk], 		 &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }




	iwrk = itau;
	i__1 = *lwork - iwrk + 1;
	if (dhseqr_(interp, "S", "V", n, &ilo, &ihi, &a[a_offset], lda, &wr[1], &wi[1], &		vl[vl_offset], ldvl, &work[iwrk], &i__1, info)!=TCL_OK) { return TCL_ERROR; }



	if (wantvr) {


	    *(unsigned char *)side = 'B';
	    if (dlacpy_(interp, "F", n, n, &vl[vl_offset], ldvl, &vr[vr_offset], ldvr)!=TCL_OK) { return TCL_ERROR; }

	}

    } else if (wantvr) {


	*(unsigned char *)side = 'R';
	if (dlacpy_(interp, "L", n, n, &a[a_offset], lda, &vr[vr_offset], ldvr)		!=TCL_OK) { return TCL_ERROR; }




	i__1 = *lwork - iwrk + 1;
	if (dorghr_(interp, n, &ilo, &ihi, &vr[vr_offset], ldvr, &work[itau], &work[iwrk], 		 &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }




	iwrk = itau;
	i__1 = *lwork - iwrk + 1;
	if (dhseqr_(interp, "S", "V", n, &ilo, &ihi, &a[a_offset], lda, &wr[1], &wi[1], &		vr[vr_offset], ldvr, &work[iwrk], &i__1, info)!=TCL_OK) { return TCL_ERROR; }



    } else {


	iwrk = itau;
	i__1 = *lwork - iwrk + 1;
	if (dhseqr_(interp, "E", "N", n, &ilo, &ihi, &a[a_offset], lda, &wr[1], &wi[1], &		vr[vr_offset], ldvr, &work[iwrk], &i__1, info)!=TCL_OK) { return TCL_ERROR; }


    }


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

    if (wantvl || wantvr) {


	if (dtrevc_(interp, side, "B", select, n, &a[a_offset], lda, &vl[vl_offset], ldvl, 		 &vr[vr_offset], ldvr, n, &nout, &work[iwrk], &ierr)!=TCL_OK) { return TCL_ERROR; }


    }

    if (wantvl) {


	if (dgebak_(interp, "B", "L", n, &ilo, &ihi, &work[ibal], n, &vl[vl_offset], ldvl, 		 &ierr)!=TCL_OK) { return TCL_ERROR; }




	i__1 = *n;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    if (wi[i__] == 0.) {
		scl = 1. / dnrm2_(n, &vl[i__ * vl_dim1 + 1], &dgeev_c__1);
		if (dscal_(interp, n, &scl, &vl[i__ * vl_dim1 + 1], &dgeev_c__1)!=TCL_OK) { return TCL_ERROR; }

	    } else if (wi[i__] > 0.) {
		d__1 = dnrm2_(n, &vl[i__ * vl_dim1 + 1], &dgeev_c__1);
		d__2 = dnrm2_(n, &vl[(i__ + 1) * vl_dim1 + 1], &dgeev_c__1);
		scl = 1. / dlapy2_(&d__1, &d__2);
		if (dscal_(interp, n, &scl, &vl[i__ * vl_dim1 + 1], &dgeev_c__1)!=TCL_OK) { return TCL_ERROR; }

		if (dscal_(interp, n, &scl, &vl[(i__ + 1) * vl_dim1 + 1], &dgeev_c__1)!=TCL_OK) { return TCL_ERROR; }

		i__2 = *n;
		for (k = 1; k <= i__2; ++k) {
		    d__1 = vl[k + i__ * vl_dim1];
		    d__2 = vl[k + (i__ + 1) * vl_dim1];
		    work[iwrk + k - 1] = d__1 * d__1 + d__2 * d__2;
		}
		k = idamax_(n, &work[iwrk], &dgeev_c__1);
		if (dlartg_(interp, &vl[k + i__ * vl_dim1], &vl[k + (i__ + 1) * vl_dim1], 			&cs, &sn, &r__)!=TCL_OK) { return TCL_ERROR; }


		if (drot_(interp, n, &vl[i__ * vl_dim1 + 1], &dgeev_c__1, &vl[(i__ + 1) * 			vl_dim1 + 1], &dgeev_c__1, &cs, &sn)!=TCL_OK) { return TCL_ERROR; }


		vl[k + (i__ + 1) * vl_dim1] = 0.;
	    }
	}
    }

    if (wantvr) {


	if (dgebak_(interp, "B", "R", n, &ilo, &ihi, &work[ibal], n, &vr[vr_offset], ldvr, 		 &ierr)!=TCL_OK) { return TCL_ERROR; }




	i__1 = *n;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    if (wi[i__] == 0.) {
		scl = 1. / dnrm2_(n, &vr[i__ * vr_dim1 + 1], &dgeev_c__1);
		if (dscal_(interp, n, &scl, &vr[i__ * vr_dim1 + 1], &dgeev_c__1)!=TCL_OK) { return TCL_ERROR; }

	    } else if (wi[i__] > 0.) {
		d__1 = dnrm2_(n, &vr[i__ * vr_dim1 + 1], &dgeev_c__1);
		d__2 = dnrm2_(n, &vr[(i__ + 1) * vr_dim1 + 1], &dgeev_c__1);
		scl = 1. / dlapy2_(&d__1, &d__2);
		if (dscal_(interp, n, &scl, &vr[i__ * vr_dim1 + 1], &dgeev_c__1)!=TCL_OK) { return TCL_ERROR; }

		if (dscal_(interp, n, &scl, &vr[(i__ + 1) * vr_dim1 + 1], &dgeev_c__1)!=TCL_OK) { return TCL_ERROR; }

		i__2 = *n;
		for (k = 1; k <= i__2; ++k) {
		    d__1 = vr[k + i__ * vr_dim1];
		    d__2 = vr[k + (i__ + 1) * vr_dim1];
		    work[iwrk + k - 1] = d__1 * d__1 + d__2 * d__2;
		}
		k = idamax_(n, &work[iwrk], &dgeev_c__1);
		if (dlartg_(interp, &vr[k + i__ * vr_dim1], &vr[k + (i__ + 1) * vr_dim1], 			&cs, &sn, &r__)!=TCL_OK) { return TCL_ERROR; }


		if (drot_(interp, n, &vr[i__ * vr_dim1 + 1], &dgeev_c__1, &vr[(i__ + 1) * 			vr_dim1 + 1], &dgeev_c__1, &cs, &sn)!=TCL_OK) { return TCL_ERROR; }


		vr[k + (i__ + 1) * vr_dim1] = 0.;
	    }
	}
    }


L50:
    if (scalea) {
	i__1 = *n - *info;
	i__3 = *n - *info;
	i__2 = max(i__3,1);
	if (dlascl_(interp, "G", &dgeev_c__0, &dgeev_c__0, &cscale, &anrm, &i__1, &dgeev_c__1, &wr[*info + 		1], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }


	i__1 = *n - *info;
	i__3 = *n - *info;
	i__2 = max(i__3,1);
	if (dlascl_(interp, "G", &dgeev_c__0, &dgeev_c__0, &cscale, &anrm, &i__1, &dgeev_c__1, &wi[*info + 		1], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }


	if (*info > 0) {
	    i__1 = ilo - 1;
	    if (dlascl_(interp, "G", &dgeev_c__0, &dgeev_c__0, &cscale, &anrm, &i__1, &dgeev_c__1, &wr[1], 		    n, &ierr)!=TCL_OK) { return TCL_ERROR; }


	    i__1 = ilo - 1;
	    if (dlascl_(interp, "G", &dgeev_c__0, &dgeev_c__0, &cscale, &anrm, &i__1, &dgeev_c__1, &wi[1], 		    n, &ierr)!=TCL_OK) { return TCL_ERROR; }


	}
    }

    work[1] = (doublereal) maxwrk;
return TCL_OK;


} /* dgeev_ */
MODULE_SCOPE /* Subroutine */ int zgeev_ (Tcl_Interp *interp, char *jobvl, char *jobvr, integer *n, 	doublecomplex *a, integer *lda, doublecomplex *w, doublecomplex *vl, 	integer *ldvl, doublecomplex *vr, integer *ldvr, doublecomplex *work, 	integer *lwork, doublereal *rwork, integer *info)
{
    integer a_dim1, a_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1, 
	    i__2, i__3;
    doublereal d__1, d__2;
    doublecomplex z__1, z__2;

    double sqrt(doublereal), d_imag(doublecomplex *);
    void d_cnjg(doublecomplex *, doublecomplex *);

    integer i__, k, ihi;
    doublereal scl;
    integer ilo;
    doublereal dum[1], eps;
    doublecomplex tmp;
    integer ibal;
    char side[1];
    doublereal anrm;
    integer ierr, itau, iwrk, nout;
    logical scalea;
    doublereal cscale;
    logical select[1];
    doublereal bignum;
    integer minwrk, maxwrk;
    logical wantvl;
    doublereal smlnum;
    integer hswork, irwork;
    logical lquery, wantvr;



























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

    *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 = -8;
    } else if (*ldvr < 1 || wantvr && *ldvr < *n) {
	*info = -10;
    }


    if (*info == 0) {
	if (*n == 0) {
	    minwrk = 1;
	    maxwrk = 1;
	} else {
	    maxwrk = *n + *n * ilaenv_(&zgeev_c__1, "ZGEHRD", " ", n, &zgeev_c__1, n, &
		    zgeev_c__0);
	    minwrk = *n << 1;
	    if (wantvl) {
		i__1 = maxwrk, i__2 = *n + (*n - 1) * ilaenv_(&zgeev_c__1, "ZUNGHR", 
			 " ", n, &zgeev_c__1, n, &zgeev_c_n1);
		maxwrk = max(i__1,i__2);
		if (zhseqr_(interp, "S", "V", n, &zgeev_c__1, n, &a[a_offset], lda, &w[1], &vl[			vl_offset], ldvl, &work[1], &zgeev_c_n1, info)!=TCL_OK) { return TCL_ERROR; }


	    } else if (wantvr) {
		i__1 = maxwrk, i__2 = *n + (*n - 1) * ilaenv_(&zgeev_c__1, "ZUNGHR", 
			 " ", n, &zgeev_c__1, n, &zgeev_c_n1);
		maxwrk = max(i__1,i__2);
		if (zhseqr_(interp, "S", "V", n, &zgeev_c__1, n, &a[a_offset], lda, &w[1], &vr[			vr_offset], ldvr, &work[1], &zgeev_c_n1, info)!=TCL_OK) { return TCL_ERROR; }


	    } else {
		if (zhseqr_(interp, "E", "N", n, &zgeev_c__1, n, &a[a_offset], lda, &w[1], &vr[			vr_offset], ldvr, &work[1], &zgeev_c_n1, info)!=TCL_OK) { return TCL_ERROR; }


	    }
	    hswork = (integer) work[1].r;
	    i__1 = max(maxwrk,hswork);
	    maxwrk = max(i__1,minwrk);
	}
	work[1].r = (doublereal) maxwrk, work[1].i = 0.;

	if (*lwork < minwrk && ! lquery) {
	    *info = -12;
	}
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "ZGEEV ", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


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


    eps = dlamch_("P");
    smlnum = dlamch_("S");
    bignum = 1. / smlnum;
    if (dlabad_(interp, &smlnum, &bignum)!=TCL_OK) { return TCL_ERROR; }

    smlnum = sqrt(smlnum) / eps;
    bignum = 1. / smlnum;


    anrm = zlange_("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) {
	if (zlascl_(interp, "G", &zgeev_c__0, &zgeev_c__0, &anrm, &cscale, n, n, &a[a_offset], lda, &		ierr)!=TCL_OK) { return TCL_ERROR; }


    }


    ibal = 1;
    if (zgebal_(interp, "B", n, &a[a_offset], lda, &ilo, &ihi, &rwork[ibal], &ierr)!=TCL_OK) { return TCL_ERROR; }



    itau = 1;
    iwrk = itau + *n;
    i__1 = *lwork - iwrk + 1;
    if (zgehrd_(interp, n, &ilo, &ihi, &a[a_offset], lda, &work[itau], &work[iwrk], &i__1, 	     &ierr)!=TCL_OK) { return TCL_ERROR; }



    if (wantvl) {


	*(unsigned char *)side = 'L';
	if (zlacpy_(interp, "L", n, n, &a[a_offset], lda, &vl[vl_offset], ldvl)		!=TCL_OK) { return TCL_ERROR; }




	i__1 = *lwork - iwrk + 1;
	if (zunghr_(interp, n, &ilo, &ihi, &vl[vl_offset], ldvl, &work[itau], &work[iwrk], 		 &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }




	iwrk = itau;
	i__1 = *lwork - iwrk + 1;
	if (zhseqr_(interp, "S", "V", n, &ilo, &ihi, &a[a_offset], lda, &w[1], &vl[		vl_offset], ldvl, &work[iwrk], &i__1, info)!=TCL_OK) { return TCL_ERROR; }



	if (wantvr) {


	    *(unsigned char *)side = 'B';
	    if (zlacpy_(interp, "F", n, n, &vl[vl_offset], ldvl, &vr[vr_offset], ldvr)!=TCL_OK) { return TCL_ERROR; }

	}

    } else if (wantvr) {


	*(unsigned char *)side = 'R';
	if (zlacpy_(interp, "L", n, n, &a[a_offset], lda, &vr[vr_offset], ldvr)		!=TCL_OK) { return TCL_ERROR; }




	i__1 = *lwork - iwrk + 1;
	if (zunghr_(interp, n, &ilo, &ihi, &vr[vr_offset], ldvr, &work[itau], &work[iwrk], 		 &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }




	iwrk = itau;
	i__1 = *lwork - iwrk + 1;
	if (zhseqr_(interp, "S", "V", n, &ilo, &ihi, &a[a_offset], lda, &w[1], &vr[		vr_offset], ldvr, &work[iwrk], &i__1, info)!=TCL_OK) { return TCL_ERROR; }



    } else {


	iwrk = itau;
	i__1 = *lwork - iwrk + 1;
	if (zhseqr_(interp, "E", "N", n, &ilo, &ihi, &a[a_offset], lda, &w[1], &vr[		vr_offset], ldvr, &work[iwrk], &i__1, info)!=TCL_OK) { return TCL_ERROR; }


    }


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

    if (wantvl || wantvr) {


	irwork = ibal + *n;
	if (ztrevc_(interp, side, "B", select, n, &a[a_offset], lda, &vl[vl_offset], ldvl, 		 &vr[vr_offset], ldvr, n, &nout, &work[iwrk], &rwork[irwork], 
		&ierr)!=TCL_OK) { return TCL_ERROR; }


    }

    if (wantvl) {


	if (zgebak_(interp, "B", "L", n, &ilo, &ihi, &rwork[ibal], n, &vl[vl_offset], 		ldvl, &ierr)!=TCL_OK) { return TCL_ERROR; }




	i__1 = *n;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    scl = 1. / dznrm2_(n, &vl[i__ * vl_dim1 + 1], &zgeev_c__1);
	    if (zdscal_(interp, n, &scl, &vl[i__ * vl_dim1 + 1], &zgeev_c__1)!=TCL_OK) { return TCL_ERROR; }

	    i__2 = *n;
	    for (k = 1; k <= i__2; ++k) {
		i__3 = k + i__ * vl_dim1;
		d__1 = vl[i__3].r;
		d__2 = d_imag(&vl[k + i__ * vl_dim1]);
		rwork[irwork + k - 1] = d__1 * d__1 + d__2 * d__2;
	    }
	    k = idamax_(n, &rwork[irwork], &zgeev_c__1);
	    d_cnjg(&z__2, &vl[k + i__ * vl_dim1]);
	    d__1 = sqrt(rwork[irwork + k - 1]);
	    z__1.r = z__2.r / d__1, z__1.i = z__2.i / d__1;
	    tmp.r = z__1.r, tmp.i = z__1.i;
	    if (zscal_(interp, n, &tmp, &vl[i__ * vl_dim1 + 1], &zgeev_c__1)!=TCL_OK) { return TCL_ERROR; }

	    i__2 = k + i__ * vl_dim1;
	    i__3 = k + i__ * vl_dim1;
	    d__1 = vl[i__3].r;
	    z__1.r = d__1, z__1.i = 0.;
	    vl[i__2].r = z__1.r, vl[i__2].i = z__1.i;
	}
    }

    if (wantvr) {


	if (zgebak_(interp, "B", "R", n, &ilo, &ihi, &rwork[ibal], n, &vr[vr_offset], 		ldvr, &ierr)!=TCL_OK) { return TCL_ERROR; }




	i__1 = *n;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    scl = 1. / dznrm2_(n, &vr[i__ * vr_dim1 + 1], &zgeev_c__1);
	    if (zdscal_(interp, n, &scl, &vr[i__ * vr_dim1 + 1], &zgeev_c__1)!=TCL_OK) { return TCL_ERROR; }

	    i__2 = *n;
	    for (k = 1; k <= i__2; ++k) {
		i__3 = k + i__ * vr_dim1;
		d__1 = vr[i__3].r;
		d__2 = d_imag(&vr[k + i__ * vr_dim1]);
		rwork[irwork + k - 1] = d__1 * d__1 + d__2 * d__2;
	    }
	    k = idamax_(n, &rwork[irwork], &zgeev_c__1);
	    d_cnjg(&z__2, &vr[k + i__ * vr_dim1]);
	    d__1 = sqrt(rwork[irwork + k - 1]);
	    z__1.r = z__2.r / d__1, z__1.i = z__2.i / d__1;
	    tmp.r = z__1.r, tmp.i = z__1.i;
	    if (zscal_(interp, n, &tmp, &vr[i__ * vr_dim1 + 1], &zgeev_c__1)!=TCL_OK) { return TCL_ERROR; }

	    i__2 = k + i__ * vr_dim1;
	    i__3 = k + i__ * vr_dim1;
	    d__1 = vr[i__3].r;
	    z__1.r = d__1, z__1.i = 0.;
	    vr[i__2].r = z__1.r, vr[i__2].i = z__1.i;
	}
    }


L50:
    if (scalea) {
	i__1 = *n - *info;
	i__3 = *n - *info;
	i__2 = max(i__3,1);
	if (zlascl_(interp, "G", &zgeev_c__0, &zgeev_c__0, &cscale, &anrm, &i__1, &zgeev_c__1, &w[*info + 1], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }


	if (*info > 0) {
	    i__1 = ilo - 1;
	    if (zlascl_(interp, "G", &zgeev_c__0, &zgeev_c__0, &cscale, &anrm, &i__1, &zgeev_c__1, &w[1], n, 		     &ierr)!=TCL_OK) { return TCL_ERROR; }


	}
    }

    work[1].r = (doublereal) maxwrk, work[1].i = 0.;
return TCL_OK;


} /* zgeev_ */
MODULE_SCOPE /* Subroutine */ int dgelss_ (Tcl_Interp *interp, integer *m, integer *n, integer *nrhs, 	doublereal *a, integer *lda, doublereal *b, integer *ldb, doublereal *	s, doublereal *rcond, integer *rank, doublereal *work, integer *lwork, 	 integer *info)
{
    integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4;
    doublereal d__1;

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




























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

    *info = 0;
    minmn = min(*m,*n);
    maxmn = max(*m,*n);
    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;
    }


    if (*info == 0) {
	minwrk = 1;
	maxwrk = 1;
	if (minmn > 0) {
	    mm = *m;
	    mnthr = ilaenv_(&dgelss_c__6, "DGELSS", " ", m, n, nrhs, &dgelss_c_n1);
	    if (*m >= *n && *m >= mnthr) {


		mm = *n;
		i__1 = maxwrk, i__2 = *n + *n * ilaenv_(&dgelss_c__1, "DGEQRF", 
			" ", m, n, &dgelss_c_n1, &dgelss_c_n1);
		maxwrk = max(i__1,i__2);
		i__1 = maxwrk, i__2 = *n + *nrhs * ilaenv_(&dgelss_c__1, "DORMQR", 
			"LT", m, nrhs, n, &dgelss_c_n1);
		maxwrk = max(i__1,i__2);
	    }
	    if (*m >= *n) {



		i__1 = 1, i__2 = *n * 5;
		bdspac = max(i__1,i__2);
		i__1 = maxwrk, i__2 = *n * 3 + (mm + *n) * ilaenv_(&dgelss_c__1, 
			"DGEBRD", " ", &mm, n, &dgelss_c_n1, &dgelss_c_n1);
		maxwrk = max(i__1,i__2);
		i__1 = maxwrk, i__2 = *n * 3 + *nrhs * ilaenv_(&dgelss_c__1, "DORMBR"
, "QLT", &mm, nrhs, n, &dgelss_c_n1);
		maxwrk = max(i__1,i__2);
		i__1 = maxwrk, i__2 = *n * 3 + (*n - 1) * ilaenv_(&dgelss_c__1, 
			"DORGBR", "P", n, n, n, &dgelss_c_n1);
		maxwrk = max(i__1,i__2);
		maxwrk = max(maxwrk,bdspac);
		i__1 = maxwrk, i__2 = *n * *nrhs;
		maxwrk = max(i__1,i__2);
		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) {


		i__1 = 1, i__2 = *m * 5;
		bdspac = max(i__1,i__2);
		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) {


		    maxwrk = *m + *m * ilaenv_(&dgelss_c__1, "DGELQF", " ", m, n, &
			    dgelss_c_n1, &dgelss_c_n1);
		    i__1 = maxwrk, i__2 = *m * *m + (*m << 2) + (*m << 1) * 
			    ilaenv_(&dgelss_c__1, "DGEBRD", " ", m, m, &dgelss_c_n1, &dgelss_c_n1);
		    maxwrk = max(i__1,i__2);
		    i__1 = maxwrk, i__2 = *m * *m + (*m << 2) + *nrhs * 
			    ilaenv_(&dgelss_c__1, "DORMBR", "QLT", m, nrhs, m, &dgelss_c_n1);
		    maxwrk = max(i__1,i__2);
		    i__1 = maxwrk, i__2 = *m * *m + (*m << 2) + (*m - 1) * 
			    ilaenv_(&dgelss_c__1, "DORGBR", "P", m, m, m, &dgelss_c_n1);
		    maxwrk = max(i__1,i__2);
		    i__1 = maxwrk, i__2 = *m * *m + *m + bdspac;
		    maxwrk = max(i__1,i__2);
		    if (*nrhs > 1) {
			i__1 = maxwrk, i__2 = *m * *m + *m + *m * *nrhs;
			maxwrk = max(i__1,i__2);
		    } else {
			i__1 = maxwrk, i__2 = *m * *m + (*m << 1);
			maxwrk = max(i__1,i__2);
		    }
		    i__1 = maxwrk, i__2 = *m + *nrhs * ilaenv_(&dgelss_c__1, "DORMLQ"
, "LT", n, nrhs, m, &dgelss_c_n1);
		    maxwrk = max(i__1,i__2);
		} else {


		    maxwrk = *m * 3 + (*n + *m) * ilaenv_(&dgelss_c__1, "DGEBRD", 
			    " ", m, n, &dgelss_c_n1, &dgelss_c_n1);
		    i__1 = maxwrk, i__2 = *m * 3 + *nrhs * ilaenv_(&dgelss_c__1, 
			    "DORMBR", "QLT", m, nrhs, m, &dgelss_c_n1);
		    maxwrk = max(i__1,i__2);
		    i__1 = maxwrk, i__2 = *m * 3 + *m * ilaenv_(&dgelss_c__1, "DORG"
			    "BR", "P", m, n, m, &dgelss_c_n1);
		    maxwrk = max(i__1,i__2);
		    maxwrk = max(maxwrk,bdspac);
		    i__1 = maxwrk, i__2 = *n * *nrhs;
		    maxwrk = max(i__1,i__2);
		}
	    }
	    maxwrk = max(minwrk,maxwrk);
	}
	work[1] = (doublereal) maxwrk;

	if (*lwork < minwrk && ! lquery) {
	    *info = -12;
	}
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DGELSS", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


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


    eps = dlamch_("P");
    sfmin = dlamch_("S");
    smlnum = sfmin / eps;
    bignum = 1. / smlnum;
    if (dlabad_(interp, &smlnum, &bignum)!=TCL_OK) { return TCL_ERROR; }



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


	if (dlascl_(interp, "G", &dgelss_c__0, &dgelss_c__0, &anrm, &smlnum, m, n, &a[a_offset], lda, 		info)!=TCL_OK) { return TCL_ERROR; }


	iascl = 1;
    } else if (anrm > bignum) {


	if (dlascl_(interp, "G", &dgelss_c__0, &dgelss_c__0, &anrm, &bignum, m, n, &a[a_offset], lda, 		info)!=TCL_OK) { return TCL_ERROR; }


	iascl = 2;
    } else if (anrm == 0.) {


	i__1 = max(*m,*n);
	if (dlaset_(interp, "F", &i__1, nrhs, &dgelss_c_b74, &dgelss_c_b74, &b[b_offset], ldb)!=TCL_OK) { return TCL_ERROR; }

	if (dlaset_(interp, "F", &minmn, &dgelss_c__1, &dgelss_c_b74, &dgelss_c_b74, &s[1], &dgelss_c__1)!=TCL_OK) { return TCL_ERROR; }

	*rank = 0;
	goto L70;
    }


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


	if (dlascl_(interp, "G", &dgelss_c__0, &dgelss_c__0, &bnrm, &smlnum, m, nrhs, &b[b_offset], ldb, 		 info)!=TCL_OK) { return TCL_ERROR; }


	ibscl = 1;
    } else if (bnrm > bignum) {


	if (dlascl_(interp, "G", &dgelss_c__0, &dgelss_c__0, &bnrm, &bignum, m, nrhs, &b[b_offset], ldb, 		 info)!=TCL_OK) { return TCL_ERROR; }


	ibscl = 2;
    }


    if (*m >= *n) {


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


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


	    i__1 = *lwork - iwork + 1;
	    if (dgeqrf_(interp, m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__1, 		     info)!=TCL_OK) { return TCL_ERROR; }




	    i__1 = *lwork - iwork + 1;
	    if (dormqr_(interp, "L", "T", m, nrhs, n, &a[a_offset], lda, &work[itau], &b[		    b_offset], ldb, &work[iwork], &i__1, info)!=TCL_OK) { return TCL_ERROR; }




	    if (*n > 1) {
		i__1 = *n - 1;
		i__2 = *n - 1;
		if (dlaset_(interp, "L", &i__1, &i__2, &dgelss_c_b74, &dgelss_c_b74, &a[a_dim1 + 2], 			lda)!=TCL_OK) { return TCL_ERROR; }


	    }
	}

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


	i__1 = *lwork - iwork + 1;
	if (dgebrd_(interp, &mm, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &		work[itaup], &work[iwork], &i__1, info)!=TCL_OK) { return TCL_ERROR; }




	i__1 = *lwork - iwork + 1;
	if (dormbr_(interp, "Q", "L", "T", &mm, nrhs, n, &a[a_offset], lda, &work[itauq], 		&b[b_offset], ldb, &work[iwork], &i__1, info)!=TCL_OK) { return TCL_ERROR; }




	i__1 = *lwork - iwork + 1;
	if (dorgbr_(interp, "P", n, n, n, &a[a_offset], lda, &work[itaup], &work[iwork], &		i__1, info)!=TCL_OK) { return TCL_ERROR; }


	iwork = ie + *n;


	if (dbdsqr_(interp, "U", n, n, &dgelss_c__0, nrhs, &s[1], &work[ie], &a[a_offset], lda, 		vdum, &dgelss_c__1, &b[b_offset], ldb, &work[iwork], info)
		!=TCL_OK) { return TCL_ERROR; }


	if (*info != 0) {
	    goto L70;
	}


	d__1 = *rcond * s[1];
	thr = max(d__1,sfmin);
	if (*rcond < 0.) {
	    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) {
		if (drscl_(interp, nrhs, &s[i__], &b[i__ + b_dim1], ldb)!=TCL_OK) { return TCL_ERROR; }

		++(*rank);
	    } else {
		if (dlaset_(interp, "F", &dgelss_c__1, nrhs, &dgelss_c_b74, &dgelss_c_b74, &b[i__ + b_dim1], 			ldb)!=TCL_OK) { return TCL_ERROR; }


	    }
	}


	if (*lwork >= *ldb * *nrhs && *nrhs > 1) {
	    if (dgemm_(interp, "T", "N", n, nrhs, n, &dgelss_c_b108, &a[a_offset], lda, &b[		    b_offset], ldb, &dgelss_c_b74, &work[1], ldb)!=TCL_OK) { return TCL_ERROR; }


	    if (dlacpy_(interp, "G", n, nrhs, &work[1], ldb, &b[b_offset], ldb)		    !=TCL_OK) { return TCL_ERROR; }


	} 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) {
		i__3 = *nrhs - i__ + 1;
		bl = min(i__3,chunk);
		if (dgemm_(interp, "T", "N", n, &bl, n, &dgelss_c_b108, &a[a_offset], lda, &b[			i__ * b_dim1 + 1], ldb, &dgelss_c_b74, &work[1], n)!=TCL_OK) { return TCL_ERROR; }


		if (dlacpy_(interp, "G", n, &bl, &work[1], n, &b[i__ * b_dim1 + 1], ldb)!=TCL_OK) { return TCL_ERROR; }

	    }
	} else {
	    if (dgemv_(interp, "T", n, n, &dgelss_c_b108, &a[a_offset], lda, &b[b_offset], &dgelss_c__1, 		     &dgelss_c_b74, &work[1], &dgelss_c__1)!=TCL_OK) { return TCL_ERROR; }


	    if (dcopy_(interp, n, &work[1], &dgelss_c__1, &b[b_offset], &dgelss_c__1)!=TCL_OK) { return TCL_ERROR; }

	}

    } else /* if(complicated condition) */ {
	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)) {


	    ldwork = *m;
	    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;


	    i__2 = *lwork - iwork + 1;
	    if (dgelqf_(interp, m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, 		     info)!=TCL_OK) { return TCL_ERROR; }


	    il = iwork;


	    if (dlacpy_(interp, "L", m, m, &a[a_offset], lda, &work[il], &ldwork)!=TCL_OK) { return TCL_ERROR; }

	    i__2 = *m - 1;
	    i__1 = *m - 1;
	    if (dlaset_(interp, "U", &i__2, &i__1, &dgelss_c_b74, &dgelss_c_b74, &work[il + ldwork], &		    ldwork)!=TCL_OK) { return TCL_ERROR; }


	    ie = il + ldwork * *m;
	    itauq = ie + *m;
	    itaup = itauq + *m;
	    iwork = itaup + *m;


	    i__2 = *lwork - iwork + 1;
	    if (dgebrd_(interp, m, m, &work[il], &ldwork, &s[1], &work[ie], &work[itauq], 		    &work[itaup], &work[iwork], &i__2, info)!=TCL_OK) { return TCL_ERROR; }




	    i__2 = *lwork - iwork + 1;
	    if (dormbr_(interp, "Q", "L", "T", m, nrhs, m, &work[il], &ldwork, &work[		    itauq], &b[b_offset], ldb, &work[iwork], &i__2, info)!=TCL_OK) { return TCL_ERROR; }




	    i__2 = *lwork - iwork + 1;
	    if (dorgbr_(interp, "P", m, m, m, &work[il], &ldwork, &work[itaup], &work[		    iwork], &i__2, info)!=TCL_OK) { return TCL_ERROR; }


	    iwork = ie + *m;


	    if (dbdsqr_(interp, "U", m, m, &dgelss_c__0, nrhs, &s[1], &work[ie], &work[il], &		    ldwork, &a[a_offset], lda, &b[b_offset], ldb, &work[iwork]
, info)!=TCL_OK) { return TCL_ERROR; }


	    if (*info != 0) {
		goto L70;
	    }


	    d__1 = *rcond * s[1];
	    thr = max(d__1,sfmin);
	    if (*rcond < 0.) {
		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) {
		    if (drscl_(interp, nrhs, &s[i__], &b[i__ + b_dim1], ldb)!=TCL_OK) { return TCL_ERROR; }

		    ++(*rank);
		} else {
		    if (dlaset_(interp, "F", &dgelss_c__1, nrhs, &dgelss_c_b74, &dgelss_c_b74, &b[i__ + b_dim1], ldb)!=TCL_OK) { return TCL_ERROR; }


		}
	    }
	    iwork = ie;


	    if (*lwork >= *ldb * *nrhs + iwork - 1 && *nrhs > 1) {
		if (dgemm_(interp, "T", "N", m, nrhs, m, &dgelss_c_b108, &work[il], &ldwork, &b[			b_offset], ldb, &dgelss_c_b74, &work[iwork], ldb)!=TCL_OK) { return TCL_ERROR; }


		if (dlacpy_(interp, "G", m, nrhs, &work[iwork], ldb, &b[b_offset], ldb)!=TCL_OK) { return TCL_ERROR; }

	    } 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) {
		    i__3 = *nrhs - i__ + 1;
		    bl = min(i__3,chunk);
		    if (dgemm_(interp, "T", "N", m, &bl, m, &dgelss_c_b108, &work[il], &ldwork, &			    b[i__ * b_dim1 + 1], ldb, &dgelss_c_b74, &work[iwork], m)!=TCL_OK) { return TCL_ERROR; }


		    if (dlacpy_(interp, "G", m, &bl, &work[iwork], m, &b[i__ * b_dim1 + 1], ldb)!=TCL_OK) { return TCL_ERROR; }


		}
	    } else {
		if (dgemv_(interp, "T", m, m, &dgelss_c_b108, &work[il], &ldwork, &b[b_dim1 + 1], 			 &dgelss_c__1, &dgelss_c_b74, &work[iwork], &dgelss_c__1)!=TCL_OK) { return TCL_ERROR; }


		if (dcopy_(interp, m, &work[iwork], &dgelss_c__1, &b[b_dim1 + 1], &dgelss_c__1)!=TCL_OK) { return TCL_ERROR; }

	    }


	    i__1 = *n - *m;
	    if (dlaset_(interp, "F", &i__1, nrhs, &dgelss_c_b74, &dgelss_c_b74, &b[*m + 1 + b_dim1], 		    ldb)!=TCL_OK) { return TCL_ERROR; }


	    iwork = itau + *m;


	    i__1 = *lwork - iwork + 1;
	    if (dormlq_(interp, "L", "T", n, nrhs, m, &a[a_offset], lda, &work[itau], &b[		    b_offset], ldb, &work[iwork], &i__1, info)!=TCL_OK) { return TCL_ERROR; }



	} else {


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


	    i__1 = *lwork - iwork + 1;
	    if (dgebrd_(interp, m, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &		    work[itaup], &work[iwork], &i__1, info)!=TCL_OK) { return TCL_ERROR; }




	    i__1 = *lwork - iwork + 1;
	    if (dormbr_(interp, "Q", "L", "T", m, nrhs, n, &a[a_offset], lda, &work[itauq], &b[b_offset], ldb, &work[iwork], &i__1, info)!=TCL_OK) { return TCL_ERROR; }




	    i__1 = *lwork - iwork + 1;
	    if (dorgbr_(interp, "P", m, n, m, &a[a_offset], lda, &work[itaup], &work[		    iwork], &i__1, info)!=TCL_OK) { return TCL_ERROR; }


	    iwork = ie + *m;


	    if (dbdsqr_(interp, "L", m, n, &dgelss_c__0, nrhs, &s[1], &work[ie], &a[a_offset], 		    lda, vdum, &dgelss_c__1, &b[b_offset], ldb, &work[iwork], info)!=TCL_OK) { return TCL_ERROR; }


	    if (*info != 0) {
		goto L70;
	    }


	    d__1 = *rcond * s[1];
	    thr = max(d__1,sfmin);
	    if (*rcond < 0.) {
		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) {
		    if (drscl_(interp, nrhs, &s[i__], &b[i__ + b_dim1], ldb)!=TCL_OK) { return TCL_ERROR; }

		    ++(*rank);
		} else {
		    if (dlaset_(interp, "F", &dgelss_c__1, nrhs, &dgelss_c_b74, &dgelss_c_b74, &b[i__ + b_dim1], ldb)!=TCL_OK) { return TCL_ERROR; }


		}
	    }


	    if (*lwork >= *ldb * *nrhs && *nrhs > 1) {
		if (dgemm_(interp, "T", "N", n, nrhs, m, &dgelss_c_b108, &a[a_offset], lda, &b[			b_offset], ldb, &dgelss_c_b74, &work[1], ldb)!=TCL_OK) { return TCL_ERROR; }


		if (dlacpy_(interp, "F", n, nrhs, &work[1], ldb, &b[b_offset], ldb)!=TCL_OK) { return TCL_ERROR; }

	    } 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) {
		    i__3 = *nrhs - i__ + 1;
		    bl = min(i__3,chunk);
		    if (dgemm_(interp, "T", "N", n, &bl, m, &dgelss_c_b108, &a[a_offset], lda, &			    b[i__ * b_dim1 + 1], ldb, &dgelss_c_b74, &work[1], n)!=TCL_OK) { return TCL_ERROR; }


		    if (dlacpy_(interp, "F", n, &bl, &work[1], n, &b[i__ * b_dim1 + 1], 			    ldb)!=TCL_OK) { return TCL_ERROR; }


		}
	    } else {
		if (dgemv_(interp, "T", m, n, &dgelss_c_b108, &a[a_offset], lda, &b[b_offset], &			dgelss_c__1, &dgelss_c_b74, &work[1], &dgelss_c__1)!=TCL_OK) { return TCL_ERROR; }


		if (dcopy_(interp, n, &work[1], &dgelss_c__1, &b[b_offset], &dgelss_c__1)!=TCL_OK) { return TCL_ERROR; }

	    }
	}
    }


    if (iascl == 1) {
	if (dlascl_(interp, "G", &dgelss_c__0, &dgelss_c__0, &anrm, &smlnum, n, nrhs, &b[b_offset], ldb, 		 info)!=TCL_OK) { return TCL_ERROR; }


	if (dlascl_(interp, "G", &dgelss_c__0, &dgelss_c__0, &smlnum, &anrm, &minmn, &dgelss_c__1, &s[1], &		minmn, info)!=TCL_OK) { return TCL_ERROR; }


    } else if (iascl == 2) {
	if (dlascl_(interp, "G", &dgelss_c__0, &dgelss_c__0, &anrm, &bignum, n, nrhs, &b[b_offset], ldb, 		 info)!=TCL_OK) { return TCL_ERROR; }


	if (dlascl_(interp, "G", &dgelss_c__0, &dgelss_c__0, &bignum, &anrm, &minmn, &dgelss_c__1, &s[1], &		minmn, info)!=TCL_OK) { return TCL_ERROR; }


    }
    if (ibscl == 1) {
	if (dlascl_(interp, "G", &dgelss_c__0, &dgelss_c__0, &smlnum, &bnrm, n, nrhs, &b[b_offset], ldb, 		 info)!=TCL_OK) { return TCL_ERROR; }


    } else if (ibscl == 2) {
	if (dlascl_(interp, "G", &dgelss_c__0, &dgelss_c__0, &bignum, &bnrm, n, nrhs, &b[b_offset], ldb, 		 info)!=TCL_OK) { return TCL_ERROR; }


    }

L70:
    work[1] = (doublereal) maxwrk;
return TCL_OK;


} /* dgelss_ */
MODULE_SCOPE /* Subroutine */ int zgelss_ (Tcl_Interp *interp, integer *m, integer *n, integer *nrhs, 	doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, 	doublereal *s, doublereal *rcond, integer *rank, doublecomplex *work, 	integer *lwork, doublereal *rwork, integer *info)
{
    integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3;
    doublereal d__1;

    integer i__, bl, ie, il, mm;
    doublereal eps, thr, anrm, bnrm;
    integer itau;
    doublecomplex vdum[1];
    integer iascl, ibscl, chunk;
    doublereal sfmin;
    integer minmn;
    integer maxmn, itaup, itauq, mnthr;
    integer iwork;
    doublereal bignum;
    integer ldwork;
    integer minwrk, maxwrk;
    doublereal smlnum;
    integer irwork;
    logical lquery;





























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

    *info = 0;
    minmn = min(*m,*n);
    maxmn = max(*m,*n);
    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;
    }


    if (*info == 0) {
	minwrk = 1;
	maxwrk = 1;
	if (minmn > 0) {
	    mm = *m;
	    mnthr = ilaenv_(&zgelss_c__6, "ZGELSS", " ", m, n, nrhs, &zgelss_c_n1);
	    if (*m >= *n && *m >= mnthr) {


		mm = *n;
		i__1 = maxwrk, i__2 = *n + *n * ilaenv_(&zgelss_c__1, "ZGEQRF", 
			" ", m, n, &zgelss_c_n1, &zgelss_c_n1);
		maxwrk = max(i__1,i__2);
		i__1 = maxwrk, i__2 = *n + *nrhs * ilaenv_(&zgelss_c__1, "ZUNMQR", 
			"LC", m, nrhs, n, &zgelss_c_n1);
		maxwrk = max(i__1,i__2);
	    }
	    if (*m >= *n) {


		i__1 = maxwrk, i__2 = (*n << 1) + (mm + *n) * ilaenv_(&zgelss_c__1, 
			"ZGEBRD", " ", &mm, n, &zgelss_c_n1, &zgelss_c_n1);
		maxwrk = max(i__1,i__2);
		i__1 = maxwrk, i__2 = (*n << 1) + *nrhs * ilaenv_(&zgelss_c__1, 
			"ZUNMBR", "QLC", &mm, nrhs, n, &zgelss_c_n1);
		maxwrk = max(i__1,i__2);
		i__1 = maxwrk, i__2 = (*n << 1) + (*n - 1) * ilaenv_(&zgelss_c__1, 
			"ZUNGBR", "P", n, n, n, &zgelss_c_n1);
		maxwrk = max(i__1,i__2);
		i__1 = maxwrk, i__2 = *n * *nrhs;
		maxwrk = max(i__1,i__2);
		minwrk = (*n << 1) + max(*nrhs,*m);
	    }
	    if (*n > *m) {
		minwrk = (*m << 1) + max(*nrhs,*n);
		if (*n >= mnthr) {


		    maxwrk = *m + *m * ilaenv_(&zgelss_c__1, "ZGELQF", " ", m, n, &
			    zgelss_c_n1, &zgelss_c_n1);
		    i__1 = maxwrk, i__2 = *m * 3 + *m * *m + (*m << 1) * 
			    ilaenv_(&zgelss_c__1, "ZGEBRD", " ", m, m, &zgelss_c_n1, &zgelss_c_n1);
		    maxwrk = max(i__1,i__2);
		    i__1 = maxwrk, i__2 = *m * 3 + *m * *m + *nrhs * ilaenv_(&
			    zgelss_c__1, "ZUNMBR", "QLC", m, nrhs, m, &zgelss_c_n1);
		    maxwrk = max(i__1,i__2);
		    i__1 = maxwrk, i__2 = *m * 3 + *m * *m + (*m - 1) * 
			    ilaenv_(&zgelss_c__1, "ZUNGBR", "P", m, m, m, &zgelss_c_n1);
		    maxwrk = max(i__1,i__2);
		    if (*nrhs > 1) {
			i__1 = maxwrk, i__2 = *m * *m + *m + *m * *nrhs;
			maxwrk = max(i__1,i__2);
		    } else {
			i__1 = maxwrk, i__2 = *m * *m + (*m << 1);
			maxwrk = max(i__1,i__2);
		    }
		    i__1 = maxwrk, i__2 = *m + *nrhs * ilaenv_(&zgelss_c__1, "ZUNMLQ"
, "LC", n, nrhs, m, &zgelss_c_n1);
		    maxwrk = max(i__1,i__2);
		} else {


		    maxwrk = (*m << 1) + (*n + *m) * ilaenv_(&zgelss_c__1, "ZGEBRD", 
			    " ", m, n, &zgelss_c_n1, &zgelss_c_n1);
		    i__1 = maxwrk, i__2 = (*m << 1) + *nrhs * ilaenv_(&zgelss_c__1, 
			    "ZUNMBR", "QLC", m, nrhs, m, &zgelss_c_n1);
		    maxwrk = max(i__1,i__2);
		    i__1 = maxwrk, i__2 = (*m << 1) + *m * ilaenv_(&zgelss_c__1, 
			    "ZUNGBR", "P", m, n, m, &zgelss_c_n1);
		    maxwrk = max(i__1,i__2);
		    i__1 = maxwrk, i__2 = *n * *nrhs;
		    maxwrk = max(i__1,i__2);
		}
	    }
	    maxwrk = max(minwrk,maxwrk);
	}
	work[1].r = (doublereal) maxwrk, work[1].i = 0.;

	if (*lwork < minwrk && ! lquery) {
	    *info = -12;
	}
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "ZGELSS", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


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


    eps = dlamch_("P");
    sfmin = dlamch_("S");
    smlnum = sfmin / eps;
    bignum = 1. / smlnum;
    if (dlabad_(interp, &smlnum, &bignum)!=TCL_OK) { return TCL_ERROR; }



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


	if (zlascl_(interp, "G", &zgelss_c__0, &zgelss_c__0, &anrm, &smlnum, m, n, &a[a_offset], lda, 		info)!=TCL_OK) { return TCL_ERROR; }


	iascl = 1;
    } else if (anrm > bignum) {


	if (zlascl_(interp, "G", &zgelss_c__0, &zgelss_c__0, &anrm, &bignum, m, n, &a[a_offset], lda, 		info)!=TCL_OK) { return TCL_ERROR; }


	iascl = 2;
    } else if (anrm == 0.) {


	i__1 = max(*m,*n);
	if (zlaset_(interp, "F", &i__1, nrhs, &zgelss_c_b1, &zgelss_c_b1, &b[b_offset], ldb)!=TCL_OK) { return TCL_ERROR; }

	if (dlaset_(interp, "F", &minmn, &zgelss_c__1, &zgelss_c_b78, &zgelss_c_b78, &s[1], &minmn)!=TCL_OK) { return TCL_ERROR; }

	*rank = 0;
	goto L70;
    }


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


	if (zlascl_(interp, "G", &zgelss_c__0, &zgelss_c__0, &bnrm, &smlnum, m, nrhs, &b[b_offset], ldb, 		 info)!=TCL_OK) { return TCL_ERROR; }


	ibscl = 1;
    } else if (bnrm > bignum) {


	if (zlascl_(interp, "G", &zgelss_c__0, &zgelss_c__0, &bnrm, &bignum, m, nrhs, &b[b_offset], ldb, 		 info)!=TCL_OK) { return TCL_ERROR; }


	ibscl = 2;
    }


    if (*m >= *n) {


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


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


	    i__1 = *lwork - iwork + 1;
	    if (zgeqrf_(interp, m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__1, 		     info)!=TCL_OK) { return TCL_ERROR; }




	    i__1 = *lwork - iwork + 1;
	    if (zunmqr_(interp, "L", "C", m, nrhs, n, &a[a_offset], lda, &work[itau], &b[		    b_offset], ldb, &work[iwork], &i__1, info)!=TCL_OK) { return TCL_ERROR; }




	    if (*n > 1) {
		i__1 = *n - 1;
		i__2 = *n - 1;
		if (zlaset_(interp, "L", &i__1, &i__2, &zgelss_c_b1, &zgelss_c_b1, &a[a_dim1 + 2], lda)!=TCL_OK) { return TCL_ERROR; }

	    }
	}

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


	i__1 = *lwork - iwork + 1;
	if (zgebrd_(interp, &mm, n, &a[a_offset], lda, &s[1], &rwork[ie], &work[itauq], &		work[itaup], &work[iwork], &i__1, info)!=TCL_OK) { return TCL_ERROR; }




	i__1 = *lwork - iwork + 1;
	if (zunmbr_(interp, "Q", "L", "C", &mm, nrhs, n, &a[a_offset], lda, &work[itauq], 		&b[b_offset], ldb, &work[iwork], &i__1, info)!=TCL_OK) { return TCL_ERROR; }




	i__1 = *lwork - iwork + 1;
	if (zungbr_(interp, "P", n, n, n, &a[a_offset], lda, &work[itaup], &work[iwork], &		i__1, info)!=TCL_OK) { return TCL_ERROR; }


	irwork = ie + *n;


	if (zbdsqr_(interp, "U", n, n, &zgelss_c__0, nrhs, &s[1], &rwork[ie], &a[a_offset], lda, 		vdum, &zgelss_c__1, &b[b_offset], ldb, &rwork[irwork], info)!=TCL_OK) { return TCL_ERROR; }


	if (*info != 0) {
	    goto L70;
	}


	d__1 = *rcond * s[1];
	thr = max(d__1,sfmin);
	if (*rcond < 0.) {
	    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) {
		if (zdrscl_(interp, nrhs, &s[i__], &b[i__ + b_dim1], ldb)!=TCL_OK) { return TCL_ERROR; }

		++(*rank);
	    } else {
		if (zlaset_(interp, "F", &zgelss_c__1, nrhs, &zgelss_c_b1, &zgelss_c_b1, &b[i__ + b_dim1], ldb)!=TCL_OK) { return TCL_ERROR; }

	    }
	}


	if (*lwork >= *ldb * *nrhs && *nrhs > 1) {
	    if (zgemm_(interp, "C", "N", n, nrhs, n, &zgelss_c_b2, &a[a_offset], lda, &b[		    b_offset], ldb, &zgelss_c_b1, &work[1], ldb)!=TCL_OK) { return TCL_ERROR; }


	    if (zlacpy_(interp, "G", n, nrhs, &work[1], ldb, &b[b_offset], ldb)		    !=TCL_OK) { return TCL_ERROR; }


	} 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) {
		i__3 = *nrhs - i__ + 1;
		bl = min(i__3,chunk);
		if (zgemm_(interp, "C", "N", n, &bl, n, &zgelss_c_b2, &a[a_offset], lda, &b[i__ *			 b_dim1 + 1], ldb, &zgelss_c_b1, &work[1], n)!=TCL_OK) { return TCL_ERROR; }


		if (zlacpy_(interp, "G", n, &bl, &work[1], n, &b[i__ * b_dim1 + 1], ldb)!=TCL_OK) { return TCL_ERROR; }

	    }
	} else {
	    if (zgemv_(interp, "C", n, n, &zgelss_c_b2, &a[a_offset], lda, &b[b_offset], &zgelss_c__1, &		    zgelss_c_b1, &work[1], &zgelss_c__1)!=TCL_OK) { return TCL_ERROR; }


	    if (zcopy_(interp, n, &work[1], &zgelss_c__1, &b[b_offset], &zgelss_c__1)!=TCL_OK) { return TCL_ERROR; }

	}

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



	    ldwork = *m;
	    i__2 = max(*m,*nrhs), i__1 = *n - (*m << 1);
	    if (*lwork >= *m * 3 + *m * *lda + max(i__2,i__1)) {
		ldwork = *lda;
	    }
	    itau = 1;
	    iwork = *m + 1;


	    i__2 = *lwork - iwork + 1;
	    if (zgelqf_(interp, m, n, &a[a_offset], lda, &work[itau], &work[iwork], &i__2, 		     info)!=TCL_OK) { return TCL_ERROR; }


	    il = iwork;


	    if (zlacpy_(interp, "L", m, m, &a[a_offset], lda, &work[il], &ldwork)!=TCL_OK) { return TCL_ERROR; }

	    i__2 = *m - 1;
	    i__1 = *m - 1;
	    if (zlaset_(interp, "U", &i__2, &i__1, &zgelss_c_b1, &zgelss_c_b1, &work[il + ldwork], &		    ldwork)!=TCL_OK) { return TCL_ERROR; }


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


	    i__2 = *lwork - iwork + 1;
	    if (zgebrd_(interp, m, m, &work[il], &ldwork, &s[1], &rwork[ie], &work[itauq], 		     &work[itaup], &work[iwork], &i__2, info)!=TCL_OK) { return TCL_ERROR; }




	    i__2 = *lwork - iwork + 1;
	    if (zunmbr_(interp, "Q", "L", "C", m, nrhs, m, &work[il], &ldwork, &work[		    itauq], &b[b_offset], ldb, &work[iwork], &i__2, info)!=TCL_OK) { return TCL_ERROR; }




	    i__2 = *lwork - iwork + 1;
	    if (zungbr_(interp, "P", m, m, m, &work[il], &ldwork, &work[itaup], &work[		    iwork], &i__2, info)!=TCL_OK) { return TCL_ERROR; }


	    irwork = ie + *m;


	    if (zbdsqr_(interp, "U", m, m, &zgelss_c__0, nrhs, &s[1], &rwork[ie], &work[il], &		    ldwork, &a[a_offset], lda, &b[b_offset], ldb, &rwork[
		    irwork], info)!=TCL_OK) { return TCL_ERROR; }


	    if (*info != 0) {
		goto L70;
	    }


	    d__1 = *rcond * s[1];
	    thr = max(d__1,sfmin);
	    if (*rcond < 0.) {
		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) {
		    if (zdrscl_(interp, nrhs, &s[i__], &b[i__ + b_dim1], ldb)!=TCL_OK) { return TCL_ERROR; }

		    ++(*rank);
		} else {
		    if (zlaset_(interp, "F", &zgelss_c__1, nrhs, &zgelss_c_b1, &zgelss_c_b1, &b[i__ + b_dim1], 			    ldb)!=TCL_OK) { return TCL_ERROR; }


		}
	    }
	    iwork = il + *m * ldwork;


	    if (*lwork >= *ldb * *nrhs + iwork - 1 && *nrhs > 1) {
		if (zgemm_(interp, "C", "N", m, nrhs, m, &zgelss_c_b2, &work[il], &ldwork, &b[			b_offset], ldb, &zgelss_c_b1, &work[iwork], ldb)!=TCL_OK) { return TCL_ERROR; }


		if (zlacpy_(interp, "G", m, nrhs, &work[iwork], ldb, &b[b_offset], ldb)!=TCL_OK) { return TCL_ERROR; }

	    } 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) {
		    i__3 = *nrhs - i__ + 1;
		    bl = min(i__3,chunk);
		    if (zgemm_(interp, "C", "N", m, &bl, m, &zgelss_c_b2, &work[il], &ldwork, &b[			    i__ * b_dim1 + 1], ldb, &zgelss_c_b1, &work[iwork], m)!=TCL_OK) { return TCL_ERROR; }


		    if (zlacpy_(interp, "G", m, &bl, &work[iwork], m, &b[i__ * b_dim1 + 1], ldb)!=TCL_OK) { return TCL_ERROR; }


		}
	    } else {
		if (zgemv_(interp, "C", m, m, &zgelss_c_b2, &work[il], &ldwork, &b[b_dim1 + 1], &			zgelss_c__1, &zgelss_c_b1, &work[iwork], &zgelss_c__1)!=TCL_OK) { return TCL_ERROR; }


		if (zcopy_(interp, m, &work[iwork], &zgelss_c__1, &b[b_dim1 + 1], &zgelss_c__1)!=TCL_OK) { return TCL_ERROR; }

	    }


	    i__1 = *n - *m;
	    if (zlaset_(interp, "F", &i__1, nrhs, &zgelss_c_b1, &zgelss_c_b1, &b[*m + 1 + b_dim1], ldb)!=TCL_OK) { return TCL_ERROR; }

	    iwork = itau + *m;


	    i__1 = *lwork - iwork + 1;
	    if (zunmlq_(interp, "L", "C", n, nrhs, m, &a[a_offset], lda, &work[itau], &b[		    b_offset], ldb, &work[iwork], &i__1, info)!=TCL_OK) { return TCL_ERROR; }



	} else {


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


	    i__1 = *lwork - iwork + 1;
	    if (zgebrd_(interp, m, n, &a[a_offset], lda, &s[1], &rwork[ie], &work[itauq], 		    &work[itaup], &work[iwork], &i__1, info)!=TCL_OK) { return TCL_ERROR; }




	    i__1 = *lwork - iwork + 1;
	    if (zunmbr_(interp, "Q", "L", "C", m, nrhs, n, &a[a_offset], lda, &work[itauq], &b[b_offset], ldb, &work[iwork], &i__1, info)!=TCL_OK) { return TCL_ERROR; }




	    i__1 = *lwork - iwork + 1;
	    if (zungbr_(interp, "P", m, n, m, &a[a_offset], lda, &work[itaup], &work[		    iwork], &i__1, info)!=TCL_OK) { return TCL_ERROR; }


	    irwork = ie + *m;


	    if (zbdsqr_(interp, "L", m, n, &zgelss_c__0, nrhs, &s[1], &rwork[ie], &a[a_offset], 		    lda, vdum, &zgelss_c__1, &b[b_offset], ldb, &rwork[irwork], info)!=TCL_OK) { return TCL_ERROR; }


	    if (*info != 0) {
		goto L70;
	    }


	    d__1 = *rcond * s[1];
	    thr = max(d__1,sfmin);
	    if (*rcond < 0.) {
		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) {
		    if (zdrscl_(interp, nrhs, &s[i__], &b[i__ + b_dim1], ldb)!=TCL_OK) { return TCL_ERROR; }

		    ++(*rank);
		} else {
		    if (zlaset_(interp, "F", &zgelss_c__1, nrhs, &zgelss_c_b1, &zgelss_c_b1, &b[i__ + b_dim1], 			    ldb)!=TCL_OK) { return TCL_ERROR; }


		}
	    }


	    if (*lwork >= *ldb * *nrhs && *nrhs > 1) {
		if (zgemm_(interp, "C", "N", n, nrhs, m, &zgelss_c_b2, &a[a_offset], lda, &b[			b_offset], ldb, &zgelss_c_b1, &work[1], ldb)!=TCL_OK) { return TCL_ERROR; }


		if (zlacpy_(interp, "G", n, nrhs, &work[1], ldb, &b[b_offset], ldb)!=TCL_OK) { return TCL_ERROR; }

	    } 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) {
		    i__3 = *nrhs - i__ + 1;
		    bl = min(i__3,chunk);
		    if (zgemm_(interp, "C", "N", n, &bl, m, &zgelss_c_b2, &a[a_offset], lda, &b[			    i__ * b_dim1 + 1], ldb, &zgelss_c_b1, &work[1], n)!=TCL_OK) { return TCL_ERROR; }


		    if (zlacpy_(interp, "F", n, &bl, &work[1], n, &b[i__ * b_dim1 + 1], 			    ldb)!=TCL_OK) { return TCL_ERROR; }


		}
	    } else {
		if (zgemv_(interp, "C", m, n, &zgelss_c_b2, &a[a_offset], lda, &b[b_offset], &			zgelss_c__1, &zgelss_c_b1, &work[1], &zgelss_c__1)!=TCL_OK) { return TCL_ERROR; }


		if (zcopy_(interp, n, &work[1], &zgelss_c__1, &b[b_offset], &zgelss_c__1)!=TCL_OK) { return TCL_ERROR; }

	    }
	}
    }


    if (iascl == 1) {
	if (zlascl_(interp, "G", &zgelss_c__0, &zgelss_c__0, &anrm, &smlnum, n, nrhs, &b[b_offset], ldb, 		 info)!=TCL_OK) { return TCL_ERROR; }


	if (dlascl_(interp, "G", &zgelss_c__0, &zgelss_c__0, &smlnum, &anrm, &minmn, &zgelss_c__1, &s[1], &		minmn, info)!=TCL_OK) { return TCL_ERROR; }


    } else if (iascl == 2) {
	if (zlascl_(interp, "G", &zgelss_c__0, &zgelss_c__0, &anrm, &bignum, n, nrhs, &b[b_offset], ldb, 		 info)!=TCL_OK) { return TCL_ERROR; }


	if (dlascl_(interp, "G", &zgelss_c__0, &zgelss_c__0, &bignum, &anrm, &minmn, &zgelss_c__1, &s[1], &		minmn, info)!=TCL_OK) { return TCL_ERROR; }


    }
    if (ibscl == 1) {
	if (zlascl_(interp, "G", &zgelss_c__0, &zgelss_c__0, &smlnum, &bnrm, n, nrhs, &b[b_offset], ldb, 		 info)!=TCL_OK) { return TCL_ERROR; }


    } else if (ibscl == 2) {
	if (zlascl_(interp, "G", &zgelss_c__0, &zgelss_c__0, &bignum, &bnrm, n, nrhs, &b[b_offset], ldb, 		 info)!=TCL_OK) { return TCL_ERROR; }


    }
L70:
    work[1].r = (doublereal) maxwrk, work[1].i = 0.;
return TCL_OK;


} /* zgelss_ */
MODULE_SCOPE /* Subroutine */ int dgelsy_ (Tcl_Interp *interp, integer *m, integer *n, integer *nrhs, 	doublereal *a, integer *lda, doublereal *b, integer *ldb, integer *	jpvt, doublereal *rcond, integer *rank, doublereal *work, integer *	lwork, integer *info)
{
    integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2;
    doublereal d__1, d__2;

    integer i__, j;
    doublereal c1, c2, s1, s2;
    integer nb, mn, nb1, nb2, nb3, nb4;
    doublereal anrm, bnrm, smin, smax;
    integer iascl, ibscl;
    integer ismin, ismax;
    doublereal wsize;
    doublereal bignum;
    integer lwkmin;
    doublereal sminpr, smaxpr, smlnum;
    integer lwkopt;
    logical lquery;





























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

    mn = min(*m,*n);
    ismin = mn + 1;
    ismax = (mn << 1) + 1;


    *info = 0;
    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(complicated condition) */ {
	i__1 = max(1,*m);
	if (*ldb < max(i__1,*n)) {
	    *info = -7;
	}
    }


    if (*info == 0) {
	if (mn == 0 || *nrhs == 0) {
	    lwkmin = 1;
	    lwkopt = 1;
	} else {
	    nb1 = ilaenv_(&dgelsy_c__1, "DGEQRF", " ", m, n, &dgelsy_c_n1, &dgelsy_c_n1);
	    nb2 = ilaenv_(&dgelsy_c__1, "DGERQF", " ", m, n, &dgelsy_c_n1, &dgelsy_c_n1);
	    nb3 = ilaenv_(&dgelsy_c__1, "DORMQR", " ", m, n, nrhs, &dgelsy_c_n1);
	    nb4 = ilaenv_(&dgelsy_c__1, "DORMRQ", " ", m, n, nrhs, &dgelsy_c_n1);
	    i__1 = max(nb1,nb2), i__1 = max(i__1,nb3);
	    nb = max(i__1,nb4);
	    i__1 = mn << 1, i__2 = *n + 1, i__1 = max(i__1,i__2), i__2 = mn + 
		    *nrhs;
	    lwkmin = mn + max(i__1,i__2);
	    i__1 = lwkmin, i__2 = mn + (*n << 1) + nb * (*n + 1), i__1 = max(
		    i__1,i__2), i__2 = (mn << 1) + nb * *nrhs;
	    lwkopt = max(i__1,i__2);
	}
	work[1] = (doublereal) lwkopt;

	if (*lwork < lwkmin && ! lquery) {
	    *info = -12;
	}
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DGELSY", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


    if (mn == 0 || *nrhs == 0) {
	*rank = 0;
return TCL_OK;
    }


    smlnum = dlamch_("S") / dlamch_("P");
    bignum = 1. / smlnum;
    if (dlabad_(interp, &smlnum, &bignum)!=TCL_OK) { return TCL_ERROR; }



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


	if (dlascl_(interp, "G", &dgelsy_c__0, &dgelsy_c__0, &anrm, &smlnum, m, n, &a[a_offset], lda, 		info)!=TCL_OK) { return TCL_ERROR; }


	iascl = 1;
    } else if (anrm > bignum) {


	if (dlascl_(interp, "G", &dgelsy_c__0, &dgelsy_c__0, &anrm, &bignum, m, n, &a[a_offset], lda, 		info)!=TCL_OK) { return TCL_ERROR; }


	iascl = 2;
    } else if (anrm == 0.) {


	i__1 = max(*m,*n);
	if (dlaset_(interp, "F", &i__1, nrhs, &dgelsy_c_b31, &dgelsy_c_b31, &b[b_offset], ldb)!=TCL_OK) { return TCL_ERROR; }

	*rank = 0;
	goto L70;
    }

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


	if (dlascl_(interp, "G", &dgelsy_c__0, &dgelsy_c__0, &bnrm, &smlnum, m, nrhs, &b[b_offset], ldb, 		 info)!=TCL_OK) { return TCL_ERROR; }


	ibscl = 1;
    } else if (bnrm > bignum) {


	if (dlascl_(interp, "G", &dgelsy_c__0, &dgelsy_c__0, &bnrm, &bignum, m, nrhs, &b[b_offset], ldb, 		 info)!=TCL_OK) { return TCL_ERROR; }


	ibscl = 2;
    }


    i__1 = *lwork - mn;
    if (dgeqp3_(interp, m, n, &a[a_offset], lda, &jpvt[1], &work[1], &work[mn + 1], &i__1, 	     info)!=TCL_OK) { return TCL_ERROR; }


    wsize = mn + work[mn + 1];



    work[ismin] = 1.;
    work[ismax] = 1.;
    smax = (d__1 = a[a_dim1 + 1], abs(d__1));
    smin = smax;
    if ((d__1 = a[a_dim1 + 1], abs(d__1)) == 0.) {
	*rank = 0;
	i__1 = max(*m,*n);
	if (dlaset_(interp, "F", &i__1, nrhs, &dgelsy_c_b31, &dgelsy_c_b31, &b[b_offset], ldb)!=TCL_OK) { return TCL_ERROR; }

	goto L70;
    } else {
	*rank = 1;
    }

L10:
    if (*rank < mn) {
	i__ = *rank + 1;
	if (dlaic1_(interp, &dgelsy_c__2, rank, &work[ismin], &smin, &a[i__ * a_dim1 + 1], &a[		i__ + i__ * a_dim1], &sminpr, &s1, &c1)!=TCL_OK) { return TCL_ERROR; }


	if (dlaic1_(interp, &dgelsy_c__1, rank, &work[ismax], &smax, &a[i__ * a_dim1 + 1], &a[		i__ + i__ * a_dim1], &smaxpr, &s2, &c2)!=TCL_OK) { return TCL_ERROR; }



	if (smaxpr * *rcond <= sminpr) {
	    i__1 = *rank;
	    for (i__ = 1; i__ <= i__1; ++i__) {
		work[ismin + i__ - 1] = s1 * work[ismin + i__ - 1];
		work[ismax + i__ - 1] = s2 * work[ismax + i__ - 1];
	    }
	    work[ismin + *rank] = c1;
	    work[ismax + *rank] = c2;
	    smin = sminpr;
	    smax = smaxpr;
	    ++(*rank);
	    goto L10;
	}
    }




    if (*rank < *n) {
	i__1 = *lwork - (mn << 1);
	if (dtzrzf_(interp, rank, n, &a[a_offset], lda, &work[mn + 1], &work[(mn << 1) + 		1], &i__1, info)!=TCL_OK) { return TCL_ERROR; }


    }



    i__1 = *lwork - (mn << 1);
    if (dormqr_(interp, "Left", "Transpose", m, nrhs, &mn, &a[a_offset], lda, &work[1], &	    b[b_offset], ldb, &work[(mn << 1) + 1], &i__1, info)!=TCL_OK) { return TCL_ERROR; }


    d__1 = wsize, d__2 = (mn << 1) + work[(mn << 1) + 1];
    wsize = max(d__1,d__2);



    if (dtrsm_(interp, "Left", "Upper", "No transpose", "Non-unit", rank, nrhs, &dgelsy_c_b54, &	    a[a_offset], lda, &b[b_offset], ldb)!=TCL_OK) { return TCL_ERROR; }



    i__1 = *nrhs;
    for (j = 1; j <= i__1; ++j) {
	i__2 = *n;
	for (i__ = *rank + 1; i__ <= i__2; ++i__) {
	    b[i__ + j * b_dim1] = 0.;
	}
    }


    if (*rank < *n) {
	i__1 = *n - *rank;
	i__2 = *lwork - (mn << 1);
	if (dormrz_(interp, "Left", "Transpose", n, nrhs, rank, &i__1, &a[a_offset], lda, 		&work[mn + 1], &b[b_offset], ldb, &work[(mn << 1) + 1], &i__2, 
		 info)!=TCL_OK) { return TCL_ERROR; }


    }



    i__1 = *nrhs;
    for (j = 1; j <= i__1; ++j) {
	i__2 = *n;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    work[jpvt[i__]] = b[i__ + j * b_dim1];
	}
	if (dcopy_(interp, n, &work[1], &dgelsy_c__1, &b[j * b_dim1 + 1], &dgelsy_c__1)!=TCL_OK) { return TCL_ERROR; }

    }



    if (iascl == 1) {
	if (dlascl_(interp, "G", &dgelsy_c__0, &dgelsy_c__0, &anrm, &smlnum, n, nrhs, &b[b_offset], ldb, 		 info)!=TCL_OK) { return TCL_ERROR; }


	if (dlascl_(interp, "U", &dgelsy_c__0, &dgelsy_c__0, &smlnum, &anrm, rank, rank, &a[a_offset], 		lda, info)!=TCL_OK) { return TCL_ERROR; }


    } else if (iascl == 2) {
	if (dlascl_(interp, "G", &dgelsy_c__0, &dgelsy_c__0, &anrm, &bignum, n, nrhs, &b[b_offset], ldb, 		 info)!=TCL_OK) { return TCL_ERROR; }


	if (dlascl_(interp, "U", &dgelsy_c__0, &dgelsy_c__0, &bignum, &anrm, rank, rank, &a[a_offset], 		lda, info)!=TCL_OK) { return TCL_ERROR; }


    }
    if (ibscl == 1) {
	if (dlascl_(interp, "G", &dgelsy_c__0, &dgelsy_c__0, &smlnum, &bnrm, n, nrhs, &b[b_offset], ldb, 		 info)!=TCL_OK) { return TCL_ERROR; }


    } else if (ibscl == 2) {
	if (dlascl_(interp, "G", &dgelsy_c__0, &dgelsy_c__0, &bignum, &bnrm, n, nrhs, &b[b_offset], ldb, 		 info)!=TCL_OK) { return TCL_ERROR; }


    }

L70:
    work[1] = (doublereal) lwkopt;

return TCL_OK;


} /* dgelsy_ */
MODULE_SCOPE /* Subroutine */ int zgelsy_ (Tcl_Interp *interp, integer *m, integer *n, integer *nrhs, 	doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, 	integer *jpvt, doublereal *rcond, integer *rank, doublecomplex *work, 	integer *lwork, doublereal *rwork, integer *info)
{
    integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4;
    doublereal d__1, d__2;
    doublecomplex z__1;

    double z_abs(doublecomplex *);

    integer i__, j;
    doublecomplex c1, c2, s1, s2;
    integer nb, mn, nb1, nb2, nb3, nb4;
    doublereal anrm, bnrm, smin, smax;
    integer iascl, ibscl, ismin, ismax;
    doublereal wsize;
    doublereal bignum;
    doublereal sminpr, smaxpr, smlnum;
    integer lwkopt;
    logical lquery;






























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

    mn = min(*m,*n);
    ismin = mn + 1;
    ismax = (mn << 1) + 1;


    *info = 0;
    nb1 = ilaenv_(&zgelsy_c__1, "ZGEQRF", " ", m, n, &zgelsy_c_n1, &zgelsy_c_n1);
    nb2 = ilaenv_(&zgelsy_c__1, "ZGERQF", " ", m, n, &zgelsy_c_n1, &zgelsy_c_n1);
    nb3 = ilaenv_(&zgelsy_c__1, "ZUNMQR", " ", m, n, nrhs, &zgelsy_c_n1);
    nb4 = ilaenv_(&zgelsy_c__1, "ZUNMRQ", " ", m, n, nrhs, &zgelsy_c_n1);
    i__1 = max(nb1,nb2), i__1 = max(i__1,nb3);
    nb = max(i__1,nb4);
    i__1 = 1, i__2 = mn + (*n << 1) + nb * (*n + 1), i__1 = max(i__1,i__2), 
	    i__2 = (mn << 1) + nb * *nrhs;
    lwkopt = max(i__1,i__2);
    z__1.r = (doublereal) lwkopt, z__1.i = 0.;
    work[1].r = z__1.r, work[1].i = z__1.i;
    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(complicated condition) */ {
	i__1 = max(1,*m);
	if (*ldb < max(i__1,*n)) {
	    *info = -7;
	} else /* if(complicated condition) */ {
	    i__1 = mn << 1, i__2 = *n + 1, i__1 = max(i__1,i__2), i__2 = mn + 
		    *nrhs;
	    if (*lwork < mn + max(i__1,i__2) && ! lquery) {
		*info = -12;
	    }
	}
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "ZGELSY", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


    i__1 = min(*m,*n);
    if (min(i__1,*nrhs) == 0) {
	*rank = 0;
return TCL_OK;
    }


    smlnum = dlamch_("S") / dlamch_("P");
    bignum = 1. / smlnum;
    if (dlabad_(interp, &smlnum, &bignum)!=TCL_OK) { return TCL_ERROR; }



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


	if (zlascl_(interp, "G", &zgelsy_c__0, &zgelsy_c__0, &anrm, &smlnum, m, n, &a[a_offset], lda, 		info)!=TCL_OK) { return TCL_ERROR; }


	iascl = 1;
    } else if (anrm > bignum) {


	if (zlascl_(interp, "G", &zgelsy_c__0, &zgelsy_c__0, &anrm, &bignum, m, n, &a[a_offset], lda, 		info)!=TCL_OK) { return TCL_ERROR; }


	iascl = 2;
    } else if (anrm == 0.) {


	i__1 = max(*m,*n);
	if (zlaset_(interp, "F", &i__1, nrhs, &zgelsy_c_b1, &zgelsy_c_b1, &b[b_offset], ldb)!=TCL_OK) { return TCL_ERROR; }

	*rank = 0;
	goto L70;
    }

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


	if (zlascl_(interp, "G", &zgelsy_c__0, &zgelsy_c__0, &bnrm, &smlnum, m, nrhs, &b[b_offset], ldb, 		 info)!=TCL_OK) { return TCL_ERROR; }


	ibscl = 1;
    } else if (bnrm > bignum) {


	if (zlascl_(interp, "G", &zgelsy_c__0, &zgelsy_c__0, &bnrm, &bignum, m, nrhs, &b[b_offset], ldb, 		 info)!=TCL_OK) { return TCL_ERROR; }


	ibscl = 2;
    }


    i__1 = *lwork - mn;
    if (zgeqp3_(interp, m, n, &a[a_offset], lda, &jpvt[1], &work[1], &work[mn + 1], &i__1, 	     &rwork[1], info)!=TCL_OK) { return TCL_ERROR; }


    i__1 = mn + 1;
    wsize = mn + work[i__1].r;



    i__1 = ismin;
    work[i__1].r = 1., work[i__1].i = 0.;
    i__1 = ismax;
    work[i__1].r = 1., work[i__1].i = 0.;
    smax = z_abs(&a[a_dim1 + 1]);
    smin = smax;
    if (z_abs(&a[a_dim1 + 1]) == 0.) {
	*rank = 0;
	i__1 = max(*m,*n);
	if (zlaset_(interp, "F", &i__1, nrhs, &zgelsy_c_b1, &zgelsy_c_b1, &b[b_offset], ldb)!=TCL_OK) { return TCL_ERROR; }

	goto L70;
    } else {
	*rank = 1;
    }

L10:
    if (*rank < mn) {
	i__ = *rank + 1;
	if (zlaic1_(interp, &zgelsy_c__2, rank, &work[ismin], &smin, &a[i__ * a_dim1 + 1], &a[		i__ + i__ * a_dim1], &sminpr, &s1, &c1)!=TCL_OK) { return TCL_ERROR; }


	if (zlaic1_(interp, &zgelsy_c__1, rank, &work[ismax], &smax, &a[i__ * a_dim1 + 1], &a[		i__ + i__ * a_dim1], &smaxpr, &s2, &c2)!=TCL_OK) { return TCL_ERROR; }



	if (smaxpr * *rcond <= sminpr) {
	    i__1 = *rank;
	    for (i__ = 1; i__ <= i__1; ++i__) {
		i__2 = ismin + i__ - 1;
		i__3 = ismin + i__ - 1;
		z__1.r = s1.r * work[i__3].r - s1.i * work[i__3].i, z__1.i = 
			s1.r * work[i__3].i + s1.i * work[i__3].r;
		work[i__2].r = z__1.r, work[i__2].i = z__1.i;
		i__2 = ismax + i__ - 1;
		i__3 = ismax + i__ - 1;
		z__1.r = s2.r * work[i__3].r - s2.i * work[i__3].i, z__1.i = 
			s2.r * work[i__3].i + s2.i * work[i__3].r;
		work[i__2].r = z__1.r, work[i__2].i = z__1.i;
	    }
	    i__1 = ismin + *rank;
	    work[i__1].r = c1.r, work[i__1].i = c1.i;
	    i__1 = ismax + *rank;
	    work[i__1].r = c2.r, work[i__1].i = c2.i;
	    smin = sminpr;
	    smax = smaxpr;
	    ++(*rank);
	    goto L10;
	}
    }




    if (*rank < *n) {
	i__1 = *lwork - (mn << 1);
	if (ztzrzf_(interp, rank, n, &a[a_offset], lda, &work[mn + 1], &work[(mn << 1) + 		1], &i__1, info)!=TCL_OK) { return TCL_ERROR; }


    }



    i__1 = *lwork - (mn << 1);
    if (zunmqr_(interp, "Left", "Conjugate transpose", m, nrhs, &mn, &a[a_offset], lda, &	    work[1], &b[b_offset], ldb, &work[(mn << 1) + 1], &i__1, info)!=TCL_OK) { return TCL_ERROR; }


    i__1 = (mn << 1) + 1;
    d__1 = wsize, d__2 = (mn << 1) + work[i__1].r;
    wsize = max(d__1,d__2);



    if (ztrsm_(interp, "Left", "Upper", "No transpose", "Non-unit", rank, nrhs, &zgelsy_c_b2, &a[	    a_offset], lda, &b[b_offset], ldb)!=TCL_OK) { return TCL_ERROR; }



    i__1 = *nrhs;
    for (j = 1; j <= i__1; ++j) {
	i__2 = *n;
	for (i__ = *rank + 1; i__ <= i__2; ++i__) {
	    i__3 = i__ + j * b_dim1;
	    b[i__3].r = 0., b[i__3].i = 0.;
	}
    }


    if (*rank < *n) {
	i__1 = *n - *rank;
	i__2 = *lwork - (mn << 1);
	if (zunmrz_(interp, "Left", "Conjugate transpose", n, nrhs, rank, &i__1, &a[		a_offset], lda, &work[mn + 1], &b[b_offset], ldb, &work[(mn <<
		 1) + 1], &i__2, info)!=TCL_OK) { return TCL_ERROR; }


    }



    i__1 = *nrhs;
    for (j = 1; j <= i__1; ++j) {
	i__2 = *n;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    i__3 = jpvt[i__];
	    i__4 = i__ + j * b_dim1;
	    work[i__3].r = b[i__4].r, work[i__3].i = b[i__4].i;
	}
	if (zcopy_(interp, n, &work[1], &zgelsy_c__1, &b[j * b_dim1 + 1], &zgelsy_c__1)!=TCL_OK) { return TCL_ERROR; }

    }



    if (iascl == 1) {
	if (zlascl_(interp, "G", &zgelsy_c__0, &zgelsy_c__0, &anrm, &smlnum, n, nrhs, &b[b_offset], ldb, 		 info)!=TCL_OK) { return TCL_ERROR; }


	if (zlascl_(interp, "U", &zgelsy_c__0, &zgelsy_c__0, &smlnum, &anrm, rank, rank, &a[a_offset], 		lda, info)!=TCL_OK) { return TCL_ERROR; }


    } else if (iascl == 2) {
	if (zlascl_(interp, "G", &zgelsy_c__0, &zgelsy_c__0, &anrm, &bignum, n, nrhs, &b[b_offset], ldb, 		 info)!=TCL_OK) { return TCL_ERROR; }


	if (zlascl_(interp, "U", &zgelsy_c__0, &zgelsy_c__0, &bignum, &anrm, rank, rank, &a[a_offset], 		lda, info)!=TCL_OK) { return TCL_ERROR; }


    }
    if (ibscl == 1) {
	if (zlascl_(interp, "G", &zgelsy_c__0, &zgelsy_c__0, &smlnum, &bnrm, n, nrhs, &b[b_offset], ldb, 		 info)!=TCL_OK) { return TCL_ERROR; }


    } else if (ibscl == 2) {
	if (zlascl_(interp, "G", &zgelsy_c__0, &zgelsy_c__0, &bignum, &bnrm, n, nrhs, &b[b_offset], ldb, 		 info)!=TCL_OK) { return TCL_ERROR; }


    }

L70:
    z__1.r = (doublereal) lwkopt, z__1.i = 0.;
    work[1].r = z__1.r, work[1].i = z__1.i;

return TCL_OK;


} /* zgelsy_ */
MODULE_SCOPE /* Subroutine */ int dgesv_ (Tcl_Interp *interp, integer *n, integer *nrhs, doublereal *a, integer 	*lda, integer *ipiv, doublereal *b, integer *ldb, integer *info)
{
    integer a_dim1, a_offset, b_dim1, b_offset, i__1;




















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

    *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);
	vectcl_xerbla(interp, "DGESV ", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


    if (dgetrf_(interp, n, n, &a[a_offset], lda, &ipiv[1], info)!=TCL_OK) { return TCL_ERROR; }

    if (*info == 0) {


	if (dgetrs_(interp, "No transpose", n, nrhs, &a[a_offset], lda, &ipiv[1], &b[		b_offset], ldb, info)!=TCL_OK) { return TCL_ERROR; }


    }
return TCL_OK;


} /* dgesv_ */
MODULE_SCOPE /* Subroutine */ int zgesv_ (Tcl_Interp *interp, integer *n, integer *nrhs, doublecomplex *a, 	integer *lda, integer *ipiv, doublecomplex *b, integer *ldb, integer *	info)
{
    integer a_dim1, a_offset, b_dim1, b_offset, i__1;




















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

    *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);
	vectcl_xerbla(interp, "ZGESV ", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


    if (zgetrf_(interp, n, n, &a[a_offset], lda, &ipiv[1], info)!=TCL_OK) { return TCL_ERROR; }

    if (*info == 0) {


	if (zgetrs_(interp, "No transpose", n, nrhs, &a[a_offset], lda, &ipiv[1], &b[		b_offset], ldb, info)!=TCL_OK) { return TCL_ERROR; }


    }
return TCL_OK;


} /* zgesv_ */
MODULE_SCOPE /* Subroutine */ int dgesvx_ (Tcl_Interp *interp, char *fact, char *trans, integer *n, integer *	nrhs, doublereal *a, integer *lda, doublereal *af, integer *ldaf, 	integer *ipiv, char *equed, doublereal *r__, doublereal *c__, 	doublereal *b, integer *ldb, doublereal *x, integer *ldx, doublereal *	rcond, doublereal *ferr, doublereal *berr, doublereal *work, integer *	iwork, integer *info)
{
    integer a_dim1, a_offset, af_dim1, af_offset, b_dim1, b_offset, x_dim1, 
	    x_offset, i__1, i__2;
    doublereal d__1, d__2;

    integer i__, j;
    doublereal amax;
    char norm[1];
    doublereal rcmin, rcmax, anorm;
    logical equil;
    doublereal colcnd;
    logical nofact;
    doublereal bignum;
    integer infequ;
    logical colequ;
    doublereal rowcnd;
    logical notran;
    doublereal smlnum;
    logical rowequ;
    doublereal rpvgrw;













































    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    af_dim1 = *ldaf;
    af_offset = 1 + af_dim1;
    af -= af_offset;
    --ipiv;
    --r__;
    --c__;
    b_dim1 = *ldb;
    b_offset = 1 + b_dim1;
    b -= b_offset;
    x_dim1 = *ldx;
    x_offset = 1 + x_dim1;
    x -= x_offset;
    --ferr;
    --berr;
    --work;
    --iwork;

    *info = 0;
    nofact = lsame_(fact, "N");
    equil = lsame_(fact, "E");
    notran = lsame_(trans, "N");
    if (nofact || equil) {
	*(unsigned char *)equed = 'N';
	rowequ = FALSE_;
	colequ = FALSE_;
    } else {
	rowequ = lsame_(equed, "R") || lsame_(equed, 
		"B");
	colequ = lsame_(equed, "C") || lsame_(equed, 
		"B");
	smlnum = dlamch_("Safe minimum");
	bignum = 1. / smlnum;
    }


    if (! nofact && ! equil && ! lsame_(fact, "F")) {
	*info = -1;
    } else if (! notran && ! lsame_(trans, "T") && ! 
	    lsame_(trans, "C")) {
	*info = -2;
    } else if (*n < 0) {
	*info = -3;
    } else if (*nrhs < 0) {
	*info = -4;
    } else if (*lda < max(1,*n)) {
	*info = -6;
    } else if (*ldaf < max(1,*n)) {
	*info = -8;
    } else if (lsame_(fact, "F") && ! (rowequ || colequ 
	    || lsame_(equed, "N"))) {
	*info = -10;
    } else {
	if (rowequ) {
	    rcmin = bignum;
	    rcmax = 0.;
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		d__1 = rcmin, d__2 = r__[j];
		rcmin = min(d__1,d__2);
		d__1 = rcmax, d__2 = r__[j];
		rcmax = max(d__1,d__2);
	    }
	    if (rcmin <= 0.) {
		*info = -11;
	    } else if (*n > 0) {
		rowcnd = max(rcmin,smlnum) / min(rcmax,bignum);
	    } else {
		rowcnd = 1.;
	    }
	}
	if (colequ && *info == 0) {
	    rcmin = bignum;
	    rcmax = 0.;
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		d__1 = rcmin, d__2 = c__[j];
		rcmin = min(d__1,d__2);
		d__1 = rcmax, d__2 = c__[j];
		rcmax = max(d__1,d__2);
	    }
	    if (rcmin <= 0.) {
		*info = -12;
	    } else if (*n > 0) {
		colcnd = max(rcmin,smlnum) / min(rcmax,bignum);
	    } else {
		colcnd = 1.;
	    }
	}
	if (*info == 0) {
	    if (*ldb < max(1,*n)) {
		*info = -14;
	    } else if (*ldx < max(1,*n)) {
		*info = -16;
	    }
	}
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DGESVX", &i__1);
return TCL_ERROR;

return TCL_OK;
    }

    if (equil) {


	if (dgeequ_(interp, n, n, &a[a_offset], lda, &r__[1], &c__[1], &rowcnd, &colcnd, &		amax, &infequ)!=TCL_OK) { return TCL_ERROR; }


	if (infequ == 0) {


	    if (dlaqge_(interp, n, n, &a[a_offset], lda, &r__[1], &c__[1], &rowcnd, &		    colcnd, &amax, equed)!=TCL_OK) { return TCL_ERROR; }


	    rowequ = lsame_(equed, "R") || lsame_(equed, 
		     "B");
	    colequ = lsame_(equed, "C") || lsame_(equed, 
		     "B");
	}
    }


    if (notran) {
	if (rowequ) {
	    i__1 = *nrhs;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = *n;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    b[i__ + j * b_dim1] = r__[i__] * b[i__ + j * b_dim1];
		}
	    }
	}
    } else if (colequ) {
	i__1 = *nrhs;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *n;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		b[i__ + j * b_dim1] = c__[i__] * b[i__ + j * b_dim1];
	    }
	}
    }

    if (nofact || equil) {


	if (dlacpy_(interp, "Full", n, n, &a[a_offset], lda, &af[af_offset], ldaf)!=TCL_OK) { return TCL_ERROR; }

	if (dgetrf_(interp, n, n, &af[af_offset], ldaf, &ipiv[1], info)!=TCL_OK) { return TCL_ERROR; }



	if (*info > 0) {


	    rpvgrw = dlantr_("M", "U", "N", info, info, &af[af_offset], ldaf, 
		    &work[1]);
	    if (rpvgrw == 0.) {
		rpvgrw = 1.;
	    } else {
		rpvgrw = dlange_("M", n, info, &a[a_offset], lda, &work[1]) / rpvgrw;
	    }
	    work[1] = rpvgrw;
	    *rcond = 0.;
return TCL_OK;
	}
    }


    if (notran) {
	*(unsigned char *)norm = '1';
    } else {
	*(unsigned char *)norm = 'I';
    }
    anorm = dlange_(norm, n, n, &a[a_offset], lda, &work[1]);
    rpvgrw = dlantr_("M", "U", "N", n, n, &af[af_offset], ldaf, &work[1]);
    if (rpvgrw == 0.) {
	rpvgrw = 1.;
    } else {
	rpvgrw = dlange_("M", n, n, &a[a_offset], lda, &work[1]) / 
		rpvgrw;
    }


    if (dgecon_(interp, norm, n, &af[af_offset], ldaf, &anorm, rcond, &work[1], &iwork[1], 	     info)!=TCL_OK) { return TCL_ERROR; }




    if (dlacpy_(interp, "Full", n, nrhs, &b[b_offset], ldb, &x[x_offset], ldx)!=TCL_OK) { return TCL_ERROR; }

    if (dgetrs_(interp, trans, n, nrhs, &af[af_offset], ldaf, &ipiv[1], &x[x_offset], ldx, 	     info)!=TCL_OK) { return TCL_ERROR; }




    if (dgerfs_(interp, trans, n, nrhs, &a[a_offset], lda, &af[af_offset], ldaf, &ipiv[1], 	     &b[b_offset], ldb, &x[x_offset], ldx, &ferr[1], &berr[1], &work[
	    1], &iwork[1], info)!=TCL_OK) { return TCL_ERROR; }




    if (notran) {
	if (colequ) {
	    i__1 = *nrhs;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = *n;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    x[i__ + j * x_dim1] = c__[i__] * x[i__ + j * x_dim1];
		}
	    }
	    i__1 = *nrhs;
	    for (j = 1; j <= i__1; ++j) {
		ferr[j] /= colcnd;
	    }
	}
    } else if (rowequ) {
	i__1 = *nrhs;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *n;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		x[i__ + j * x_dim1] = r__[i__] * x[i__ + j * x_dim1];
	    }
	}
	i__1 = *nrhs;
	for (j = 1; j <= i__1; ++j) {
	    ferr[j] /= rowcnd;
	}
    }

    work[1] = rpvgrw;


    if (*rcond < dlamch_("Epsilon")) {
	*info = *n + 1;
    }
return TCL_OK;


} /* dgesvx_ */
MODULE_SCOPE /* Subroutine */ int zgesvx_ (Tcl_Interp *interp, char *fact, char *trans, integer *n, integer *	nrhs, doublecomplex *a, integer *lda, doublecomplex *af, integer *	ldaf, integer *ipiv, char *equed, doublereal *r__, doublereal *c__, 	doublecomplex *b, integer *ldb, doublecomplex *x, integer *ldx, 	doublereal *rcond, doublereal *ferr, doublereal *berr, doublecomplex *	work, doublereal *rwork, integer *info)
{
    integer a_dim1, a_offset, af_dim1, af_offset, b_dim1, b_offset, x_dim1, 
	    x_offset, i__1, i__2, i__3, i__4, i__5;
    doublereal d__1, d__2;
    doublecomplex z__1;

    integer i__, j;
    doublereal amax;
    char norm[1];
    doublereal rcmin, rcmax, anorm;
    logical equil;
    doublereal colcnd;
    logical nofact;
    doublereal bignum;
    integer infequ;
    logical colequ;
    doublereal rowcnd;
    logical notran;
    doublereal smlnum;
    logical rowequ;
    doublereal rpvgrw;













































    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    af_dim1 = *ldaf;
    af_offset = 1 + af_dim1;
    af -= af_offset;
    --ipiv;
    --r__;
    --c__;
    b_dim1 = *ldb;
    b_offset = 1 + b_dim1;
    b -= b_offset;
    x_dim1 = *ldx;
    x_offset = 1 + x_dim1;
    x -= x_offset;
    --ferr;
    --berr;
    --work;
    --rwork;

    *info = 0;
    nofact = lsame_(fact, "N");
    equil = lsame_(fact, "E");
    notran = lsame_(trans, "N");
    if (nofact || equil) {
	*(unsigned char *)equed = 'N';
	rowequ = FALSE_;
	colequ = FALSE_;
    } else {
	rowequ = lsame_(equed, "R") || lsame_(equed, 
		"B");
	colequ = lsame_(equed, "C") || lsame_(equed, 
		"B");
	smlnum = dlamch_("Safe minimum");
	bignum = 1. / smlnum;
    }


    if (! nofact && ! equil && ! lsame_(fact, "F")) {
	*info = -1;
    } else if (! notran && ! lsame_(trans, "T") && ! 
	    lsame_(trans, "C")) {
	*info = -2;
    } else if (*n < 0) {
	*info = -3;
    } else if (*nrhs < 0) {
	*info = -4;
    } else if (*lda < max(1,*n)) {
	*info = -6;
    } else if (*ldaf < max(1,*n)) {
	*info = -8;
    } else if (lsame_(fact, "F") && ! (rowequ || colequ 
	    || lsame_(equed, "N"))) {
	*info = -10;
    } else {
	if (rowequ) {
	    rcmin = bignum;
	    rcmax = 0.;
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		d__1 = rcmin, d__2 = r__[j];
		rcmin = min(d__1,d__2);
		d__1 = rcmax, d__2 = r__[j];
		rcmax = max(d__1,d__2);
	    }
	    if (rcmin <= 0.) {
		*info = -11;
	    } else if (*n > 0) {
		rowcnd = max(rcmin,smlnum) / min(rcmax,bignum);
	    } else {
		rowcnd = 1.;
	    }
	}
	if (colequ && *info == 0) {
	    rcmin = bignum;
	    rcmax = 0.;
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		d__1 = rcmin, d__2 = c__[j];
		rcmin = min(d__1,d__2);
		d__1 = rcmax, d__2 = c__[j];
		rcmax = max(d__1,d__2);
	    }
	    if (rcmin <= 0.) {
		*info = -12;
	    } else if (*n > 0) {
		colcnd = max(rcmin,smlnum) / min(rcmax,bignum);
	    } else {
		colcnd = 1.;
	    }
	}
	if (*info == 0) {
	    if (*ldb < max(1,*n)) {
		*info = -14;
	    } else if (*ldx < max(1,*n)) {
		*info = -16;
	    }
	}
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "ZGESVX", &i__1);
return TCL_ERROR;

return TCL_OK;
    }

    if (equil) {


	if (zgeequ_(interp, n, n, &a[a_offset], lda, &r__[1], &c__[1], &rowcnd, &colcnd, &		amax, &infequ)!=TCL_OK) { return TCL_ERROR; }


	if (infequ == 0) {


	    if (zlaqge_(interp, n, n, &a[a_offset], lda, &r__[1], &c__[1], &rowcnd, &		    colcnd, &amax, equed)!=TCL_OK) { return TCL_ERROR; }


	    rowequ = lsame_(equed, "R") || lsame_(equed, 
		     "B");
	    colequ = lsame_(equed, "C") || lsame_(equed, 
		     "B");
	}
    }


    if (notran) {
	if (rowequ) {
	    i__1 = *nrhs;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = *n;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    i__3 = i__ + j * b_dim1;
		    i__4 = i__;
		    i__5 = i__ + j * b_dim1;
		    z__1.r = r__[i__4] * b[i__5].r, z__1.i = r__[i__4] * b[
			    i__5].i;
		    b[i__3].r = z__1.r, b[i__3].i = z__1.i;
		}
	    }
	}
    } else if (colequ) {
	i__1 = *nrhs;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *n;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		i__3 = i__ + j * b_dim1;
		i__4 = i__;
		i__5 = i__ + j * b_dim1;
		z__1.r = c__[i__4] * b[i__5].r, z__1.i = c__[i__4] * b[i__5]
			.i;
		b[i__3].r = z__1.r, b[i__3].i = z__1.i;
	    }
	}
    }

    if (nofact || equil) {


	if (zlacpy_(interp, "Full", n, n, &a[a_offset], lda, &af[af_offset], ldaf)!=TCL_OK) { return TCL_ERROR; }

	if (zgetrf_(interp, n, n, &af[af_offset], ldaf, &ipiv[1], info)!=TCL_OK) { return TCL_ERROR; }



	if (*info > 0) {


	    rpvgrw = zlantr_("M", "U", "N", info, info, &af[af_offset], ldaf, 
		    &rwork[1]);
	    if (rpvgrw == 0.) {
		rpvgrw = 1.;
	    } else {
		rpvgrw = zlange_("M", n, info, &a[a_offset], lda, &rwork[1]) / rpvgrw;
	    }
	    rwork[1] = rpvgrw;
	    *rcond = 0.;
return TCL_OK;
	}
    }


    if (notran) {
	*(unsigned char *)norm = '1';
    } else {
	*(unsigned char *)norm = 'I';
    }
    anorm = zlange_(norm, n, n, &a[a_offset], lda, &rwork[1]);
    rpvgrw = zlantr_("M", "U", "N", n, n, &af[af_offset], ldaf, &rwork[1]);
    if (rpvgrw == 0.) {
	rpvgrw = 1.;
    } else {
	rpvgrw = zlange_("M", n, n, &a[a_offset], lda, &rwork[1]) /
		 rpvgrw;
    }


    if (zgecon_(interp, norm, n, &af[af_offset], ldaf, &anorm, rcond, &work[1], &rwork[1], 	     info)!=TCL_OK) { return TCL_ERROR; }




    if (zlacpy_(interp, "Full", n, nrhs, &b[b_offset], ldb, &x[x_offset], ldx)!=TCL_OK) { return TCL_ERROR; }

    if (zgetrs_(interp, trans, n, nrhs, &af[af_offset], ldaf, &ipiv[1], &x[x_offset], ldx, 	     info)!=TCL_OK) { return TCL_ERROR; }




    if (zgerfs_(interp, trans, n, nrhs, &a[a_offset], lda, &af[af_offset], ldaf, &ipiv[1], 	     &b[b_offset], ldb, &x[x_offset], ldx, &ferr[1], &berr[1], &work[
	    1], &rwork[1], info)!=TCL_OK) { return TCL_ERROR; }




    if (notran) {
	if (colequ) {
	    i__1 = *nrhs;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = *n;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    i__3 = i__ + j * x_dim1;
		    i__4 = i__;
		    i__5 = i__ + j * x_dim1;
		    z__1.r = c__[i__4] * x[i__5].r, z__1.i = c__[i__4] * x[
			    i__5].i;
		    x[i__3].r = z__1.r, x[i__3].i = z__1.i;
		}
	    }
	    i__1 = *nrhs;
	    for (j = 1; j <= i__1; ++j) {
		ferr[j] /= colcnd;
	    }
	}
    } else if (rowequ) {
	i__1 = *nrhs;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *n;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		i__3 = i__ + j * x_dim1;
		i__4 = i__;
		i__5 = i__ + j * x_dim1;
		z__1.r = r__[i__4] * x[i__5].r, z__1.i = r__[i__4] * x[i__5]
			.i;
		x[i__3].r = z__1.r, x[i__3].i = z__1.i;
	    }
	}
	i__1 = *nrhs;
	for (j = 1; j <= i__1; ++j) {
	    ferr[j] /= rowcnd;
	}
    }


    if (*rcond < dlamch_("Epsilon")) {
	*info = *n + 1;
    }

    rwork[1] = rpvgrw;
return TCL_OK;


} /* zgesvx_ */
MODULE_SCOPE /* Subroutine */ int dgees_ (Tcl_Interp *interp, char *jobvs, char *sort, L_fp select, integer *n, 	doublereal *a, integer *lda, integer *sdim, doublereal *wr, 	doublereal *wi, doublereal *vs, integer *ldvs, doublereal *work, 	integer *lwork, logical *bwork, integer *info)
{
    integer a_dim1, a_offset, vs_dim1, vs_offset, i__1, i__2, i__3;

    double sqrt(doublereal);

    integer i__;
    doublereal s;
    integer i1, i2, ip, ihi, ilo;
    doublereal dum[1], eps, sep;
    integer ibal;
    doublereal anrm;
    integer idum[1], ierr, itau, iwrk, inxt, icond, ieval;
    logical cursl;
    logical lst2sl, scalea;
    doublereal cscale;
    doublereal bignum;
    logical lastsl;
    integer minwrk, maxwrk;
    doublereal smlnum;
    integer hswork;
    logical wantst, lquery, wantvs;




























    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --wr;
    --wi;
    vs_dim1 = *ldvs;
    vs_offset = 1 + vs_dim1;
    vs -= vs_offset;
    --work;
    --bwork;

    *info = 0;
    lquery = *lwork == -1;
    wantvs = lsame_(jobvs, "V");
    wantst = lsame_(sort, "S");
    if (! wantvs && ! lsame_(jobvs, "N")) {
	*info = -1;
    } else if (! wantst && ! lsame_(sort, "N")) {
	*info = -2;
    } else if (*n < 0) {
	*info = -4;
    } else if (*lda < max(1,*n)) {
	*info = -6;
    } else if (*ldvs < 1 || wantvs && *ldvs < *n) {
	*info = -11;
    }


    if (*info == 0) {
	if (*n == 0) {
	    minwrk = 1;
	    maxwrk = 1;
	} else {
	    maxwrk = (*n << 1) + *n * ilaenv_(&dgees_c__1, "DGEHRD", " ", n, &dgees_c__1, 
		    n, &dgees_c__0);
	    minwrk = *n * 3;

	    if (dhseqr_(interp, "S", jobvs, n, &dgees_c__1, n, &a[a_offset], lda, &wr[1], &wi[1], &vs[vs_offset], ldvs, &work[1], &dgees_c_n1, &ieval)!=TCL_OK) { return TCL_ERROR; }


	    hswork = (integer) work[1];

	    if (! wantvs) {
		i__1 = maxwrk, i__2 = *n + hswork;
		maxwrk = max(i__1,i__2);
	    } else {
		i__1 = maxwrk, i__2 = (*n << 1) + (*n - 1) * ilaenv_(&dgees_c__1, 
			"DORGHR", " ", n, &dgees_c__1, n, &dgees_c_n1);
		maxwrk = max(i__1,i__2);
		i__1 = maxwrk, i__2 = *n + hswork;
		maxwrk = max(i__1,i__2);
	    }
	}
	work[1] = (doublereal) maxwrk;

	if (*lwork < minwrk && ! lquery) {
	    *info = -13;
	}
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DGEES ", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


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


    eps = dlamch_("P");
    smlnum = dlamch_("S");
    bignum = 1. / smlnum;
    if (dlabad_(interp, &smlnum, &bignum)!=TCL_OK) { return TCL_ERROR; }

    smlnum = sqrt(smlnum) / eps;
    bignum = 1. / smlnum;


    anrm = 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) {
	if (dlascl_(interp, "G", &dgees_c__0, &dgees_c__0, &anrm, &cscale, n, n, &a[a_offset], lda, &		ierr)!=TCL_OK) { return TCL_ERROR; }


    }


    ibal = 1;
    if (dgebal_(interp, "P", n, &a[a_offset], lda, &ilo, &ihi, &work[ibal], &ierr)!=TCL_OK) { return TCL_ERROR; }



    itau = *n + ibal;
    iwrk = *n + itau;
    i__1 = *lwork - iwrk + 1;
    if (dgehrd_(interp, n, &ilo, &ihi, &a[a_offset], lda, &work[itau], &work[iwrk], &i__1, 	     &ierr)!=TCL_OK) { return TCL_ERROR; }



    if (wantvs) {


	if (dlacpy_(interp, "L", n, n, &a[a_offset], lda, &vs[vs_offset], ldvs)		!=TCL_OK) { return TCL_ERROR; }




	i__1 = *lwork - iwrk + 1;
	if (dorghr_(interp, n, &ilo, &ihi, &vs[vs_offset], ldvs, &work[itau], &work[iwrk], 		 &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }


    }

    *sdim = 0;


    iwrk = itau;
    i__1 = *lwork - iwrk + 1;
    if (dhseqr_(interp, "S", jobvs, n, &ilo, &ihi, &a[a_offset], lda, &wr[1], &wi[1], &vs[	    vs_offset], ldvs, &work[iwrk], &i__1, &ieval)!=TCL_OK) { return TCL_ERROR; }


    if (ieval > 0) {
	*info = ieval;
    }


    if (wantst && *info == 0) {
	if (scalea) {
	    if (dlascl_(interp, "G", &dgees_c__0, &dgees_c__0, &cscale, &anrm, n, &dgees_c__1, &wr[1], n, &		    ierr)!=TCL_OK) { return TCL_ERROR; }


	    if (dlascl_(interp, "G", &dgees_c__0, &dgees_c__0, &cscale, &anrm, n, &dgees_c__1, &wi[1], n, &		    ierr)!=TCL_OK) { return TCL_ERROR; }


	}
	i__1 = *n;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    bwork[i__] = (*select)(&wr[i__], &wi[i__]);
	}


	i__1 = *lwork - iwrk + 1;
	if (dtrsen_(interp, "N", jobvs, &bwork[1], n, &a[a_offset], lda, &vs[vs_offset], 		ldvs, &wr[1], &wi[1], sdim, &s, &sep, &work[iwrk], &i__1, 
		idum, &dgees_c__1, &icond)!=TCL_OK) { return TCL_ERROR; }


	if (icond > 0) {
	    *info = *n + icond;
	}
    }

    if (wantvs) {


	if (dgebak_(interp, "P", "R", n, &ilo, &ihi, &work[ibal], n, &vs[vs_offset], ldvs, 		 &ierr)!=TCL_OK) { return TCL_ERROR; }


    }

    if (scalea) {


	if (dlascl_(interp, "H", &dgees_c__0, &dgees_c__0, &cscale, &anrm, n, n, &a[a_offset], lda, &		ierr)!=TCL_OK) { return TCL_ERROR; }


	i__1 = *lda + 1;
	if (dcopy_(interp, n, &a[a_offset], &i__1, &wr[1], &dgees_c__1)!=TCL_OK) { return TCL_ERROR; }

	if (cscale == smlnum) {


	    if (ieval > 0) {
		i1 = ieval + 1;
		i2 = ihi - 1;
		i__1 = ilo - 1;
		i__3 = ilo - 1;
		i__2 = max(i__3,1);
		if (dlascl_(interp, "G", &dgees_c__0, &dgees_c__0, &cscale, &anrm, &i__1, &dgees_c__1, &wi[			1], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }


	    } else if (wantst) {
		i1 = 1;
		i2 = *n - 1;
	    } else {
		i1 = ilo;
		i2 = ihi - 1;
	    }
	    inxt = i1 - 1;
	    i__1 = i2;
	    for (i__ = i1; i__ <= i__1; ++i__) {
		if (i__ < inxt) {
		    goto L20;
		}
		if (wi[i__] == 0.) {
		    inxt = i__ + 1;
		} else {
		    if (a[i__ + 1 + i__ * a_dim1] == 0.) {
			wi[i__] = 0.;
			wi[i__ + 1] = 0.;
		    } else if (a[i__ + 1 + i__ * a_dim1] != 0. && a[i__ + (
			    i__ + 1) * a_dim1] == 0.) {
			wi[i__] = 0.;
			wi[i__ + 1] = 0.;
			if (i__ > 1) {
			    i__2 = i__ - 1;
			    if (dswap_(interp, &i__2, &a[i__ * a_dim1 + 1], &dgees_c__1, &a[(				    i__ + 1) * a_dim1 + 1], &dgees_c__1)!=TCL_OK) { return TCL_ERROR; }


			}
			if (*n > i__ + 1) {
			    i__2 = *n - i__ - 1;
			    if (dswap_(interp, &i__2, &a[i__ + (i__ + 2) * a_dim1], lda, &				    a[i__ + 1 + (i__ + 2) * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }


			}
			if (wantvs) {
			    if (dswap_(interp, n, &vs[i__ * vs_dim1 + 1], &dgees_c__1, &vs[(i__ 				    + 1) * vs_dim1 + 1], &dgees_c__1)!=TCL_OK) { return TCL_ERROR; }


			}
			a[i__ + (i__ + 1) * a_dim1] = a[i__ + 1 + i__ * 
				a_dim1];
			a[i__ + 1 + i__ * a_dim1] = 0.;
		    }
		    inxt = i__ + 2;
		}
L20:
		;
	    }
	}


	i__1 = *n - ieval;
	i__3 = *n - ieval;
	i__2 = max(i__3,1);
	if (dlascl_(interp, "G", &dgees_c__0, &dgees_c__0, &cscale, &anrm, &i__1, &dgees_c__1, &wi[ieval + 		1], &i__2, &ierr)!=TCL_OK) { return TCL_ERROR; }


    }

    if (wantst && *info == 0) {


	lastsl = TRUE_;
	lst2sl = TRUE_;
	*sdim = 0;
	ip = 0;
	i__1 = *n;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    cursl = (*select)(&wr[i__], &wi[i__]);
	    if (wi[i__] == 0.) {
		if (cursl) {
		    ++(*sdim);
		}
		ip = 0;
		if (cursl && ! lastsl) {
		    *info = *n + 2;
		}
	    } else {
		if (ip == 1) {


		    cursl = cursl || lastsl;
		    lastsl = cursl;
		    if (cursl) {
			*sdim += 2;
		    }
		    ip = -1;
		    if (cursl && ! lst2sl) {
			*info = *n + 2;
		    }
		} else {


		    ip = 1;
		}
	    }
	    lst2sl = lastsl;
	    lastsl = cursl;
	}
    }

    work[1] = (doublereal) maxwrk;
return TCL_OK;


} /* dgees_ */
MODULE_SCOPE /* Subroutine */ int zgees_ (Tcl_Interp *interp, char *jobvs, char *sort, L_fp select, integer *n, 	doublecomplex *a, integer *lda, integer *sdim, doublecomplex *w, 	doublecomplex *vs, integer *ldvs, doublecomplex *work, integer *lwork, 	 doublereal *rwork, logical *bwork, integer *info)
{
    integer a_dim1, a_offset, vs_dim1, vs_offset, i__1, i__2;

    double sqrt(doublereal);

    integer i__;
    doublereal s;
    integer ihi, ilo;
    doublereal dum[1], eps, sep;
    integer ibal;
    doublereal anrm;
    integer ierr, itau, iwrk, icond, ieval;
    logical scalea;
    doublereal cscale;
    doublereal bignum;
    integer minwrk, maxwrk;
    doublereal smlnum;
    integer hswork;
    logical wantst, lquery, wantvs;




























    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --w;
    vs_dim1 = *ldvs;
    vs_offset = 1 + vs_dim1;
    vs -= vs_offset;
    --work;
    --rwork;
    --bwork;

    *info = 0;
    lquery = *lwork == -1;
    wantvs = lsame_(jobvs, "V");
    wantst = lsame_(sort, "S");
    if (! wantvs && ! lsame_(jobvs, "N")) {
	*info = -1;
    } else if (! wantst && ! lsame_(sort, "N")) {
	*info = -2;
    } else if (*n < 0) {
	*info = -4;
    } else if (*lda < max(1,*n)) {
	*info = -6;
    } else if (*ldvs < 1 || wantvs && *ldvs < *n) {
	*info = -10;
    }


    if (*info == 0) {
	if (*n == 0) {
	    minwrk = 1;
	    maxwrk = 1;
	} else {
	    maxwrk = *n + *n * ilaenv_(&zgees_c__1, "ZGEHRD", " ", n, &zgees_c__1, n, &
		    zgees_c__0);
	    minwrk = *n << 1;

	    if (zhseqr_(interp, "S", jobvs, n, &zgees_c__1, n, &a[a_offset], lda, &w[1], &vs[		    vs_offset], ldvs, &work[1], &zgees_c_n1, &ieval)!=TCL_OK) { return TCL_ERROR; }


	    hswork = (integer) work[1].r;

	    if (! wantvs) {
		maxwrk = max(maxwrk,hswork);
	    } else {
		i__1 = maxwrk, i__2 = *n + (*n - 1) * ilaenv_(&zgees_c__1, "ZUNGHR", 
			 " ", n, &zgees_c__1, n, &zgees_c_n1);
		maxwrk = max(i__1,i__2);
		maxwrk = max(maxwrk,hswork);
	    }
	}
	work[1].r = (doublereal) maxwrk, work[1].i = 0.;

	if (*lwork < minwrk && ! lquery) {
	    *info = -12;
	}
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "ZGEES ", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


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


    eps = dlamch_("P");
    smlnum = dlamch_("S");
    bignum = 1. / smlnum;
    if (dlabad_(interp, &smlnum, &bignum)!=TCL_OK) { return TCL_ERROR; }

    smlnum = sqrt(smlnum) / eps;
    bignum = 1. / smlnum;


    anrm = zlange_("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) {
	if (zlascl_(interp, "G", &zgees_c__0, &zgees_c__0, &anrm, &cscale, n, n, &a[a_offset], lda, &		ierr)!=TCL_OK) { return TCL_ERROR; }


    }


    ibal = 1;
    if (zgebal_(interp, "P", n, &a[a_offset], lda, &ilo, &ihi, &rwork[ibal], &ierr)!=TCL_OK) { return TCL_ERROR; }



    itau = 1;
    iwrk = *n + itau;
    i__1 = *lwork - iwrk + 1;
    if (zgehrd_(interp, n, &ilo, &ihi, &a[a_offset], lda, &work[itau], &work[iwrk], &i__1, 	     &ierr)!=TCL_OK) { return TCL_ERROR; }



    if (wantvs) {


	if (zlacpy_(interp, "L", n, n, &a[a_offset], lda, &vs[vs_offset], ldvs)		!=TCL_OK) { return TCL_ERROR; }




	i__1 = *lwork - iwrk + 1;
	if (zunghr_(interp, n, &ilo, &ihi, &vs[vs_offset], ldvs, &work[itau], &work[iwrk], 		 &i__1, &ierr)!=TCL_OK) { return TCL_ERROR; }


    }

    *sdim = 0;


    iwrk = itau;
    i__1 = *lwork - iwrk + 1;
    if (zhseqr_(interp, "S", jobvs, n, &ilo, &ihi, &a[a_offset], lda, &w[1], &vs[	    vs_offset], ldvs, &work[iwrk], &i__1, &ieval)!=TCL_OK) { return TCL_ERROR; }


    if (ieval > 0) {
	*info = ieval;
    }


    if (wantst && *info == 0) {
	if (scalea) {
	    if (zlascl_(interp, "G", &zgees_c__0, &zgees_c__0, &cscale, &anrm, n, &zgees_c__1, &w[1], n, &		    ierr)!=TCL_OK) { return TCL_ERROR; }


	}
	i__1 = *n;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    bwork[i__] = (*select)(&w[i__]);
	}


	i__1 = *lwork - iwrk + 1;
	if (ztrsen_(interp, "N", jobvs, &bwork[1], n, &a[a_offset], lda, &vs[vs_offset], 		ldvs, &w[1], sdim, &s, &sep, &work[iwrk], &i__1, &icond)!=TCL_OK) { return TCL_ERROR; }


    }

    if (wantvs) {


	if (zgebak_(interp, "P", "R", n, &ilo, &ihi, &rwork[ibal], n, &vs[vs_offset], 		ldvs, &ierr)!=TCL_OK) { return TCL_ERROR; }


    }

    if (scalea) {


	if (zlascl_(interp, "U", &zgees_c__0, &zgees_c__0, &cscale, &anrm, n, n, &a[a_offset], lda, &		ierr)!=TCL_OK) { return TCL_ERROR; }


	i__1 = *lda + 1;
	if (zcopy_(interp, n, &a[a_offset], &i__1, &w[1], &zgees_c__1)!=TCL_OK) { return TCL_ERROR; }

    }

    work[1].r = (doublereal) maxwrk, work[1].i = 0.;
return TCL_OK;


} /* zgees_ */
static logical lsame_ (char *ca, char *cb)
{
    logical ret_val;

    integer inta, intb, zcode;












    ret_val = *(unsigned char *)ca == *(unsigned char *)cb;
    if (ret_val) {
	return ret_val;
    }


    zcode = 'Z';


    inta = *(unsigned char *)ca;
    intb = *(unsigned char *)cb;

    if (zcode == 90 || zcode == 122) {


	if (inta >= 97 && inta <= 122) {
	    inta += -32;
	}
	if (intb >= 97 && intb <= 122) {
	    intb += -32;
	}

    } else if (zcode == 233 || zcode == 169) {


	if (inta >= 129 && inta <= 137 || inta >= 145 && inta <= 153 || inta 
		>= 162 && inta <= 169) {
	    inta += 64;
	}
	if (intb >= 129 && intb <= 137 || intb >= 145 && intb <= 153 || intb 
		>= 162 && intb <= 169) {
	    intb += 64;
	}

    } else if (zcode == 218 || zcode == 250) {


	if (inta >= 225 && inta <= 250) {
	    inta += -32;
	}
	if (intb >= 225 && intb <= 250) {
	    intb += -32;
	}
    }
    ret_val = inta == intb;



    return ret_val;
} /* lsame_ */
static /* Subroutine */ int dbdsdc_ (Tcl_Interp *interp, char *uplo, char *compq, integer *n, doublereal *	d__, doublereal *e, doublereal *u, integer *ldu, doublereal *vt, 	integer *ldvt, doublereal *q, integer *iq, doublereal *work, integer *	iwork, integer *info)
{
    integer u_dim1, u_offset, vt_dim1, vt_offset, i__1, i__2;
    doublereal d__1;

    double d_sign(doublereal *, doublereal *), log(doublereal);

    integer i__, j, k;
    doublereal p, r__;
    integer z__, ic, ii, kk;
    doublereal cs;
    integer is, iu;
    doublereal sn;
    integer nm1;
    doublereal eps;
    integer ivt, difl, difr, ierr, perm, mlvl, sqre;
    integer poles, iuplo, nsize, start;
    integer givcol;
    integer icompq;
    doublereal orgnrm;
    integer givnum, givptr, qstart, smlsiz, wstart, smlszp;




























    --d__;
    --e;
    u_dim1 = *ldu;
    u_offset = 1 + u_dim1;
    u -= u_offset;
    vt_dim1 = *ldvt;
    vt_offset = 1 + vt_dim1;
    vt -= vt_offset;
    --q;
    --iq;
    --work;
    --iwork;

    *info = 0;

    iuplo = 0;
    if (lsame_(uplo, "U")) {
	iuplo = 1;
    }
    if (lsame_(uplo, "L")) {
	iuplo = 2;
    }
    if (lsame_(compq, "N")) {
	icompq = 0;
    } else if (lsame_(compq, "P")) {
	icompq = 1;
    } else if (lsame_(compq, "I")) {
	icompq = 2;
    } else {
	icompq = -1;
    }
    if (iuplo == 0) {
	*info = -1;
    } else if (icompq < 0) {
	*info = -2;
    } else if (*n < 0) {
	*info = -3;
    } else if (*ldu < 1 || icompq == 2 && *ldu < *n) {
	*info = -7;
    } else if (*ldvt < 1 || icompq == 2 && *ldvt < *n) {
	*info = -9;
    }
    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DBDSDC", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


    if (*n == 0) {
return TCL_OK;
    }
    smlsiz = ilaenv_(&dbdsdc_c__9, "DBDSDC", " ", &dbdsdc_c__0, &dbdsdc_c__0, &dbdsdc_c__0, &dbdsdc_c__0);
    if (*n == 1) {
	if (icompq == 1) {
	    q[1] = d_sign(&dbdsdc_c_b15, &d__[1]);
	    q[smlsiz * *n + 1] = 1.;
	} else if (icompq == 2) {
	    u[u_dim1 + 1] = d_sign(&dbdsdc_c_b15, &d__[1]);
	    vt[vt_dim1 + 1] = 1.;
	}
	d__[1] = abs(d__[1]);
return TCL_OK;
    }
    nm1 = *n - 1;


    wstart = 1;
    qstart = 3;
    if (icompq == 1) {
	if (dcopy_(interp, n, &d__[1], &dbdsdc_c__1, &q[1], &dbdsdc_c__1)!=TCL_OK) { return TCL_ERROR; }

	i__1 = *n - 1;
	if (dcopy_(interp, &i__1, &e[1], &dbdsdc_c__1, &q[*n + 1], &dbdsdc_c__1)!=TCL_OK) { return TCL_ERROR; }

    }
    if (iuplo == 2) {
	qstart = 5;
	wstart = (*n << 1) - 1;
	i__1 = *n - 1;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    if (dlartg_(interp, &d__[i__], &e[i__], &cs, &sn, &r__)!=TCL_OK) { return TCL_ERROR; }

	    d__[i__] = r__;
	    e[i__] = sn * d__[i__ + 1];
	    d__[i__ + 1] = cs * d__[i__ + 1];
	    if (icompq == 1) {
		q[i__ + (*n << 1)] = cs;
		q[i__ + *n * 3] = sn;
	    } else if (icompq == 2) {
		work[i__] = cs;
		work[nm1 + i__] = -sn;
	    }
	}
    }


    if (icompq == 0) {
	if (dlasdq_(interp, "U", &dbdsdc_c__0, n, &dbdsdc_c__0, &dbdsdc_c__0, &dbdsdc_c__0, &d__[1], &e[1], &vt[		vt_offset], ldvt, &u[u_offset], ldu, &u[u_offset], ldu, &work[
		wstart], info)!=TCL_OK) { return TCL_ERROR; }


	goto L40;
    }


    if (*n <= smlsiz) {
	if (icompq == 2) {
	    if (dlaset_(interp, "A", n, n, &dbdsdc_c_b29, &dbdsdc_c_b15, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }

	    if (dlaset_(interp, "A", n, n, &dbdsdc_c_b29, &dbdsdc_c_b15, &vt[vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }

	    if (dlasdq_(interp, "U", &dbdsdc_c__0, n, n, n, &dbdsdc_c__0, &d__[1], &e[1], &vt[vt_offset], ldvt, &u[u_offset], ldu, &u[u_offset], ldu, &work[
		    wstart], info)!=TCL_OK) { return TCL_ERROR; }


	} else if (icompq == 1) {
	    iu = 1;
	    ivt = iu + *n;
	    if (dlaset_(interp, "A", n, n, &dbdsdc_c_b29, &dbdsdc_c_b15, &q[iu + (qstart - 1) * *n], n)!=TCL_OK) { return TCL_ERROR; }

	    if (dlaset_(interp, "A", n, n, &dbdsdc_c_b29, &dbdsdc_c_b15, &q[ivt + (qstart - 1) * *n], n)!=TCL_OK) { return TCL_ERROR; }

	    if (dlasdq_(interp, "U", &dbdsdc_c__0, n, n, n, &dbdsdc_c__0, &d__[1], &e[1], &q[ivt + (		    qstart - 1) * *n], n, &q[iu + (qstart - 1) * *n], n, &q[
		    iu + (qstart - 1) * *n], n, &work[wstart], info)!=TCL_OK) { return TCL_ERROR; }


	}
	goto L40;
    }

    if (icompq == 2) {
	if (dlaset_(interp, "A", n, n, &dbdsdc_c_b29, &dbdsdc_c_b15, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }

	if (dlaset_(interp, "A", n, n, &dbdsdc_c_b29, &dbdsdc_c_b15, &vt[vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }

    }


    orgnrm = dlanst_("M", n, &d__[1], &e[1]);
    if (orgnrm == 0.) {
return TCL_OK;
    }
    if (dlascl_(interp, "G", &dbdsdc_c__0, &dbdsdc_c__0, &orgnrm, &dbdsdc_c_b15, n, &dbdsdc_c__1, &d__[1], n, &ierr)!=TCL_OK) { return TCL_ERROR; }

    if (dlascl_(interp, "G", &dbdsdc_c__0, &dbdsdc_c__0, &orgnrm, &dbdsdc_c_b15, &nm1, &dbdsdc_c__1, &e[1], &nm1, &	    ierr)!=TCL_OK) { return TCL_ERROR; }



    eps = dlamch_("Epsilon");

    mlvl = (integer) (log((doublereal) (*n) / (doublereal) (smlsiz + 1)) / 
	    log(2.)) + 1;
    smlszp = smlsiz + 1;

    if (icompq == 1) {
	iu = 1;
	ivt = smlsiz + 1;
	difl = ivt + smlszp;
	difr = difl + mlvl;
	z__ = difr + (mlvl << 1);
	ic = z__ + mlvl;
	is = ic + 1;
	poles = is + 1;
	givnum = poles + (mlvl << 1);

	k = 1;
	givptr = 2;
	perm = 3;
	givcol = perm + mlvl;
    }

    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	if ((d__1 = d__[i__], abs(d__1)) < eps) {
	    d__[i__] = d_sign(&eps, &d__[i__]);
	}
    }

    start = 1;
    sqre = 0;

    i__1 = nm1;
    for (i__ = 1; i__ <= i__1; ++i__) {
	if ((d__1 = e[i__], abs(d__1)) < eps || i__ == nm1) {


	    if (i__ < nm1) {


		nsize = i__ - start + 1;
	    } else if ((d__1 = e[i__], abs(d__1)) >= eps) {


		nsize = *n - start + 1;
	    } else {


		nsize = i__ - start + 1;
		if (icompq == 2) {
		    u[*n + *n * u_dim1] = d_sign(&dbdsdc_c_b15, &d__[*n]);
		    vt[*n + *n * vt_dim1] = 1.;
		} else if (icompq == 1) {
		    q[*n + (qstart - 1) * *n] = d_sign(&dbdsdc_c_b15, &d__[*n]);
		    q[*n + (smlsiz + qstart - 1) * *n] = 1.;
		}
		d__[*n] = (d__1 = d__[*n], abs(d__1));
	    }
	    if (icompq == 2) {
		if (dlasd0_(interp, &nsize, &sqre, &d__[start], &e[start], &u[start + 			start * u_dim1], ldu, &vt[start + start * vt_dim1], 
			ldvt, &smlsiz, &iwork[1], &work[wstart], info)!=TCL_OK) { return TCL_ERROR; }


	    } else {
		if (dlasda_(interp, &icompq, &smlsiz, &nsize, &sqre, &d__[start], &e[			start], &q[start + (iu + qstart - 2) * *n], n, &q[
			start + (ivt + qstart - 2) * *n], &iq[start + k * *n], 
			 &q[start + (difl + qstart - 2) * *n], &q[start + (
			difr + qstart - 2) * *n], &q[start + (z__ + qstart - 
			2) * *n], &q[start + (poles + qstart - 2) * *n], &iq[
			start + givptr * *n], &iq[start + givcol * *n], n, &
			iq[start + perm * *n], &q[start + (givnum + qstart - 
			2) * *n], &q[start + (ic + qstart - 2) * *n], &q[
			start + (is + qstart - 2) * *n], &work[wstart], &
			iwork[1], info)!=TCL_OK) { return TCL_ERROR; }


		if (*info != 0) {
return TCL_OK;
		}
	    }
	    start = i__ + 1;
	}
    }


    if (dlascl_(interp, "G", &dbdsdc_c__0, &dbdsdc_c__0, &dbdsdc_c_b15, &orgnrm, n, &dbdsdc_c__1, &d__[1], n, &ierr)!=TCL_OK) { return TCL_ERROR; }

L40:


    i__1 = *n;
    for (ii = 2; ii <= i__1; ++ii) {
	i__ = ii - 1;
	kk = i__;
	p = d__[i__];
	i__2 = *n;
	for (j = ii; j <= i__2; ++j) {
	    if (d__[j] > p) {
		kk = j;
		p = d__[j];
	    }
	}
	if (kk != i__) {
	    d__[kk] = d__[i__];
	    d__[i__] = p;
	    if (icompq == 1) {
		iq[i__] = kk;
	    } else if (icompq == 2) {
		if (dswap_(interp, n, &u[i__ * u_dim1 + 1], &dbdsdc_c__1, &u[kk * u_dim1 + 1], &			dbdsdc_c__1)!=TCL_OK) { return TCL_ERROR; }


		if (dswap_(interp, n, &vt[i__ + vt_dim1], ldvt, &vt[kk + vt_dim1], ldvt)!=TCL_OK) { return TCL_ERROR; }

	    }
	} else if (icompq == 1) {
	    iq[i__] = i__;
	}
    }


    if (icompq == 1) {
	if (iuplo == 1) {
	    iq[*n] = 1;
	} else {
	    iq[*n] = 0;
	}
    }


    if (iuplo == 2 && icompq == 2) {
	if (dlasr_(interp, "L", "V", "B", n, n, &work[1], &work[*n], &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }

    }

return TCL_OK;


} /* dbdsdc_ */
static /* Subroutine */ int dgebrd_ (Tcl_Interp *interp, integer *m, integer *n, doublereal *a, integer *	lda, doublereal *d__, doublereal *e, doublereal *tauq, doublereal *	taup, doublereal *work, integer *lwork, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4;

    integer i__, j, nb, nx;
    doublereal ws;
    integer nbmin, iinfo, minmn;
    integer ldwrkx, ldwrky, lwkopt;
    logical lquery;







































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

    *info = 0;
    i__1 = 1, i__2 = ilaenv_(&dgebrd_c__1, "DGEBRD", " ", m, n, &dgebrd_c_n1, &dgebrd_c_n1);
    nb = max(i__1,i__2);
    lwkopt = (*m + *n) * nb;
    work[1] = (doublereal) 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) */ {
	i__1 = max(1,*m);
	if (*lwork < max(i__1,*n) && ! lquery) {
	    *info = -10;
	}
    }
    if (*info < 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DGEBRD", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


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

    ws = (doublereal) max(*m,*n);
    ldwrkx = *m;
    ldwrky = *n;

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


	i__1 = nb, i__2 = ilaenv_(&dgebrd_c__3, "DGEBRD", " ", m, n, &dgebrd_c_n1, &dgebrd_c_n1);
	nx = max(i__1,i__2);


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


		nbmin = ilaenv_(&dgebrd_c__2, "DGEBRD", " ", m, n, &dgebrd_c_n1, &dgebrd_c_n1);
		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) {


	i__3 = *m - i__ + 1;
	i__4 = *n - i__ + 1;
	if (dlabrd_(interp, &i__3, &i__4, &nb, &a[i__ + i__ * a_dim1], lda, &d__[i__], &e[		i__], &tauq[i__], &taup[i__], &work[1], &ldwrkx, &work[ldwrkx 
		* nb + 1], &ldwrky)!=TCL_OK) { return TCL_ERROR; }




	i__3 = *m - i__ - nb + 1;
	i__4 = *n - i__ - nb + 1;
	if (dgemm_(interp, "No transpose", "Transpose", &i__3, &i__4, &nb, &dgebrd_c_b21, &a[i__ 		+ nb + i__ * a_dim1], lda, &work[ldwrkx * nb + nb + 1], &
		ldwrky, &dgebrd_c_b22, &a[i__ + nb + (i__ + nb) * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }


	i__3 = *m - i__ - nb + 1;
	i__4 = *n - i__ - nb + 1;
	if (dgemm_(interp, "No transpose", "No transpose", &i__3, &i__4, &nb, &dgebrd_c_b21, &		work[nb + 1], &ldwrkx, &a[i__ + (i__ + nb) * a_dim1], lda, &
		dgebrd_c_b22, &a[i__ + nb + (i__ + nb) * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }




	if (*m >= *n) {
	    i__3 = i__ + nb - 1;
	    for (j = i__; j <= i__3; ++j) {
		a[j + j * a_dim1] = d__[j];
		a[j + (j + 1) * a_dim1] = e[j];
	    }
	} else {
	    i__3 = i__ + nb - 1;
	    for (j = i__; j <= i__3; ++j) {
		a[j + j * a_dim1] = d__[j];
		a[j + 1 + j * a_dim1] = e[j];
	    }
	}
    }


    i__2 = *m - i__ + 1;
    i__1 = *n - i__ + 1;
    if (dgebd2_(interp, &i__2, &i__1, &a[i__ + i__ * a_dim1], lda, &d__[i__], &e[i__], &	    tauq[i__], &taup[i__], &work[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }


    work[1] = ws;
return TCL_OK;


} /* dgebrd_ */
static doublereal dlange_ (char *norm, integer *m, integer *n, doublereal *a, integer 	*lda, doublereal *work)
{
    integer a_dim1, a_offset, i__1, i__2;
    doublereal ret_val, d__1, d__2, d__3;

    double sqrt(doublereal);

    integer i__, j;
    doublereal sum, scale;
    doublereal value;



















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

    if (min(*m,*n) == 0) {
	value = 0.;
    } else if (lsame_(norm, "M")) {


	value = 0.;
	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *m;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		d__2 = value, d__3 = (d__1 = a[i__ + j * a_dim1], abs(d__1));
		value = max(d__2,d__3);
	    }
	}
    } else if (lsame_(norm, "O") || *(unsigned char *)
	    norm == '1') {


	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[i__ + j * a_dim1], abs(d__1));
	    }
	    value = max(value,sum);
	}
    } else if (lsame_(norm, "I")) {


	i__1 = *m;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    work[i__] = 0.;
	}
	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[i__ + j * a_dim1], abs(d__1));
	    }
	}
	value = 0.;
	i__1 = *m;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    d__1 = value, d__2 = work[i__];
	    value = max(d__1,d__2);
	}
    } else if (lsame_(norm, "F") || lsame_(norm, "E")) {


	scale = 0.;
	sum = 1.;
	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    dlassq_(NULL, m, &a[j * a_dim1 + 1], &dlange_c__1, &scale, &sum);
	}
	value = scale * sqrt(sum);
    }

    ret_val = value;
    return ret_val;


} /* dlange_ */
static /* Subroutine */ int dgelqf_ (Tcl_Interp *interp, integer *m, integer *n, doublereal *a, integer *	lda, doublereal *tau, doublereal *work, integer *lwork, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4;

    integer i__, k, ib, nb, nx, iws, nbmin, iinfo;
    integer ldwork, lwkopt;
    logical lquery;

























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

    *info = 0;
    nb = ilaenv_(&dgelqf_c__1, "DGELQF", " ", m, n, &dgelqf_c_n1, &dgelqf_c_n1);
    lwkopt = *m * nb;
    work[1] = (doublereal) 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);
	vectcl_xerbla(interp, "DGELQF", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


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

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


	i__1 = 0, i__2 = ilaenv_(&dgelqf_c__3, "DGELQF", " ", m, n, &dgelqf_c_n1, &dgelqf_c_n1);
	nx = max(i__1,i__2);
	if (nx < k) {


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


		nb = *lwork / ldwork;
		i__1 = 2, i__2 = ilaenv_(&dgelqf_c__2, "DGELQF", " ", m, n, &dgelqf_c_n1, &
			dgelqf_c_n1);
		nbmin = max(i__1,i__2);
	    }
	}
    }

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


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


	    i__3 = *n - i__ + 1;
	    if (dgelq2_(interp, &ib, &i__3, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[		    1], &iinfo)!=TCL_OK) { return TCL_ERROR; }


	    if (i__ + ib <= *m) {


		i__3 = *n - i__ + 1;
		if (dlarft_(interp, "Forward", "Rowwise", &i__3, &ib, &a[i__ + i__ * 			a_dim1], lda, &tau[i__], &work[1], &ldwork)!=TCL_OK) { return TCL_ERROR; }




		i__3 = *m - i__ - ib + 1;
		i__4 = *n - i__ + 1;
		if (dlarfb_(interp, "Right", "No transpose", "Forward", "Rowwise", &i__3, 			&i__4, &ib, &a[i__ + i__ * a_dim1], lda, &work[1], &
			ldwork, &a[i__ + ib + i__ * a_dim1], lda, &work[ib + 
			1], &ldwork)!=TCL_OK) { return TCL_ERROR; }


	    }
	}
    } else {
	i__ = 1;
    }


    if (i__ <= k) {
	i__2 = *m - i__ + 1;
	i__1 = *n - i__ + 1;
	if (dgelq2_(interp, &i__2, &i__1, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }


    }

    work[1] = (doublereal) iws;
return TCL_OK;


} /* dgelqf_ */
static /* Subroutine */ int dlascl_ (Tcl_Interp *interp, char *type__, integer *kl, integer *ku, 	doublereal *cfrom, doublereal *cto, integer *m, integer *n, 	doublereal *a, integer *lda, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;

    integer i__, j, k1, k2, k3, k4;
    doublereal mul, cto1;
    logical done;
    doublereal ctoc;
    integer itype;
    doublereal cfrom1;
    doublereal cfromc;
    doublereal bignum, smlnum;



















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

    *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. || disnan_(cfrom)) {
	*info = -4;
    } else if (disnan_(cto)) {
	*info = -5;
    } 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) {
	i__1 = *m - 1;
	if (*kl < 0 || *kl > max(i__1,0)) {
	    *info = -2;
	} else /* if(complicated condition) */ {
	    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);
	vectcl_xerbla(interp, "DLASCL", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


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


    smlnum = dlamch_("S");
    bignum = 1. / smlnum;

    cfromc = *cfrom;
    ctoc = *cto;

L10:
    cfrom1 = cfromc * smlnum;
    if (cfrom1 == cfromc) {
	mul = ctoc / cfromc;
	done = TRUE_;
	cto1 = ctoc;
    } else {
	cto1 = ctoc / bignum;
	if (cto1 == ctoc) {
	    mul = ctoc;
	    done = TRUE_;
	    cfromc = 1.;
	} else if (abs(cfrom1) > abs(ctoc) && ctoc != 0.) {
	    mul = smlnum;
	    done = FALSE_;
	    cfromc = cfrom1;
	} else if (abs(cto1) > abs(cfromc)) {
	    mul = bignum;
	    done = FALSE_;
	    ctoc = cto1;
	} else {
	    mul = ctoc / cfromc;
	    done = TRUE_;
	}
    }

    if (itype == 0) {


	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *m;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		a[i__ + j * a_dim1] *= mul;
	    }
	}

    } else if (itype == 1) {


	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *m;
	    for (i__ = j; i__ <= i__2; ++i__) {
		a[i__ + j * a_dim1] *= mul;
	    }
	}

    } else if (itype == 2) {


	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = min(j,*m);
	    for (i__ = 1; i__ <= i__2; ++i__) {
		a[i__ + j * a_dim1] *= mul;
	    }
	}

    } else if (itype == 3) {


	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__3 = j + 1;
	    i__2 = min(i__3,*m);
	    for (i__ = 1; i__ <= i__2; ++i__) {
		a[i__ + j * a_dim1] *= mul;
	    }
	}

    } else if (itype == 4) {


	k3 = *kl + 1;
	k4 = *n + 1;
	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__3 = k3, i__4 = k4 - j;
	    i__2 = min(i__3,i__4);
	    for (i__ = 1; i__ <= i__2; ++i__) {
		a[i__ + j * a_dim1] *= mul;
	    }
	}

    } else if (itype == 5) {


	k1 = *ku + 2;
	k3 = *ku + 1;
	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = k1 - j;
	    i__3 = k3;
	    for (i__ = max(i__2,1); i__ <= i__3; ++i__) {
		a[i__ + j * a_dim1] *= mul;
	    }
	}

    } else if (itype == 6) {


	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) {
	    i__3 = k1 - j;
	    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[i__ + j * a_dim1] *= mul;
	    }
	}

    }

    if (! done) {
	goto L10;
    }

return TCL_OK;


} /* dlascl_ */
static /* Subroutine */ int dgeqrf_ (Tcl_Interp *interp, integer *m, integer *n, doublereal *a, integer *	lda, doublereal *tau, doublereal *work, integer *lwork, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4;

    integer i__, k, ib, nb, nx, iws, nbmin, iinfo;
    integer ldwork, lwkopt;
    logical lquery;

























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

    *info = 0;
    nb = ilaenv_(&dgeqrf_c__1, "DGEQRF", " ", m, n, &dgeqrf_c_n1, &dgeqrf_c_n1);
    lwkopt = *n * nb;
    work[1] = (doublereal) 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);
	vectcl_xerbla(interp, "DGEQRF", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


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

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


	i__1 = 0, i__2 = ilaenv_(&dgeqrf_c__3, "DGEQRF", " ", m, n, &dgeqrf_c_n1, &dgeqrf_c_n1);
	nx = max(i__1,i__2);
	if (nx < k) {


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


		nb = *lwork / ldwork;
		i__1 = 2, i__2 = ilaenv_(&dgeqrf_c__2, "DGEQRF", " ", m, n, &dgeqrf_c_n1, &
			dgeqrf_c_n1);
		nbmin = max(i__1,i__2);
	    }
	}
    }

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


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


	    i__3 = *m - i__ + 1;
	    if (dgeqr2_(interp, &i__3, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[		    1], &iinfo)!=TCL_OK) { return TCL_ERROR; }


	    if (i__ + ib <= *n) {


		i__3 = *m - i__ + 1;
		if (dlarft_(interp, "Forward", "Columnwise", &i__3, &ib, &a[i__ + i__ * 			a_dim1], lda, &tau[i__], &work[1], &ldwork)!=TCL_OK) { return TCL_ERROR; }




		i__3 = *m - i__ + 1;
		i__4 = *n - i__ - ib + 1;
		if (dlarfb_(interp, "Left", "Transpose", "Forward", "Columnwise", &i__3, &			i__4, &ib, &a[i__ + i__ * a_dim1], lda, &work[1], &
			ldwork, &a[i__ + (i__ + ib) * a_dim1], lda, &work[ib 
			+ 1], &ldwork)!=TCL_OK) { return TCL_ERROR; }


	    }
	}
    } else {
	i__ = 1;
    }


    if (i__ <= k) {
	i__2 = *m - i__ + 1;
	i__1 = *n - i__ + 1;
	if (dgeqr2_(interp, &i__2, &i__1, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }


    }

    work[1] = (doublereal) iws;
return TCL_OK;


} /* dgeqrf_ */
static /* Subroutine */ int dlacpy_ (Tcl_Interp *interp, char *uplo, integer *m, integer *n, doublereal *	a, integer *lda, doublereal *b, integer *ldb)
{
    integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2;

    integer i__, j;
















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

    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[i__ + j * b_dim1] = a[i__ + j * a_dim1];
	    }
	}
    } 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[i__ + j * b_dim1] = a[i__ + j * a_dim1];
	    }
	}
    } else {
	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *m;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		b[i__ + j * b_dim1] = a[i__ + j * a_dim1];
	    }
	}
    }
return TCL_OK;


} /* dlacpy_ */
static /* Subroutine */ int dlaset_ (Tcl_Interp *interp, char *uplo, integer *m, integer *n, doublereal *	alpha, doublereal *beta, doublereal *a, integer *lda)
{
    integer a_dim1, a_offset, i__1, i__2, i__3;

    integer i__, j;


















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

    if (lsame_(uplo, "U")) {


	i__1 = *n;
	for (j = 2; j <= i__1; ++j) {
	    i__3 = j - 1;
	    i__2 = min(i__3,*m);
	    for (i__ = 1; i__ <= i__2; ++i__) {
		a[i__ + j * a_dim1] = *alpha;
	    }
	}

    } else if (lsame_(uplo, "L")) {


	i__1 = min(*m,*n);
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *m;
	    for (i__ = j + 1; i__ <= i__2; ++i__) {
		a[i__ + j * a_dim1] = *alpha;
	    }
	}

    } else {


	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *m;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		a[i__ + j * a_dim1] = *alpha;
	    }
	}
    }


    i__1 = min(*m,*n);
    for (i__ = 1; i__ <= i__1; ++i__) {
	a[i__ + i__ * a_dim1] = *beta;
    }

return TCL_OK;


} /* dlaset_ */
static /* Subroutine */ int dorgbr_ (Tcl_Interp *interp, char *vect, integer *m, integer *n, integer *k, 	doublereal *a, integer *lda, doublereal *tau, doublereal *work, 	integer *lwork, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3;

    integer i__, j, nb, mn;
    integer iinfo;
    logical wantq;
    integer lwkopt;
    logical lquery;























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

    *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 = ilaenv_(&dorgbr_c__1, "DORGQR", " ", m, n, k, &dorgbr_c_n1);
	} else {
	    nb = ilaenv_(&dorgbr_c__1, "DORGLQ", " ", m, n, k, &dorgbr_c_n1);
	}
	lwkopt = max(1,mn) * nb;
	work[1] = (doublereal) lwkopt;
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DORGBR", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


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

    if (wantq) {


	if (*m >= *k) {


	    if (dorgqr_(interp, m, n, k, &a[a_offset], lda, &tau[1], &work[1], lwork, &		    iinfo)!=TCL_OK) { return TCL_ERROR; }



	} else {



	    for (j = *m; j >= 2; --j) {
		a[j * a_dim1 + 1] = 0.;
		i__1 = *m;
		for (i__ = j + 1; i__ <= i__1; ++i__) {
		    a[i__ + j * a_dim1] = a[i__ + (j - 1) * a_dim1];
		}
	    }
	    a[a_dim1 + 1] = 1.;
	    i__1 = *m;
	    for (i__ = 2; i__ <= i__1; ++i__) {
		a[i__ + a_dim1] = 0.;
	    }
	    if (*m > 1) {


		i__1 = *m - 1;
		i__2 = *m - 1;
		i__3 = *m - 1;
		if (dorgqr_(interp, &i__1, &i__2, &i__3, &a[(a_dim1 << 1) + 2], lda, &tau[			1], &work[1], lwork, &iinfo)!=TCL_OK) { return TCL_ERROR; }


	    }
	}
    } else {


	if (*k < *n) {


	    if (dorglq_(interp, m, n, k, &a[a_offset], lda, &tau[1], &work[1], lwork, &		    iinfo)!=TCL_OK) { return TCL_ERROR; }



	} else {



	    a[a_dim1 + 1] = 1.;
	    i__1 = *n;
	    for (i__ = 2; i__ <= i__1; ++i__) {
		a[i__ + a_dim1] = 0.;
	    }
	    i__1 = *n;
	    for (j = 2; j <= i__1; ++j) {
		for (i__ = j - 1; i__ >= 2; --i__) {
		    a[i__ + j * a_dim1] = a[i__ - 1 + j * a_dim1];
		}
		a[j * a_dim1 + 1] = 0.;
	    }
	    if (*n > 1) {


		i__1 = *n - 1;
		i__2 = *n - 1;
		i__3 = *n - 1;
		if (dorglq_(interp, &i__1, &i__2, &i__3, &a[(a_dim1 << 1) + 2], lda, &tau[			1], &work[1], lwork, &iinfo)!=TCL_OK) { return TCL_ERROR; }


	    }
	}
    }
    work[1] = (doublereal) lwkopt;
return TCL_OK;


} /* dorgbr_ */
static integer ilaenv_ (integer *ispec, char *name__, char *opts, integer *n1, 	integer *n2, integer *n3, integer *n4)
{
    integer ret_val;

    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
    integer s_cmp(char *, char *, ftnlen, ftnlen);

    integer i__;
    char c1[1], c2[1], c3[1], c4[1];
    integer ic, nb, iz, nx;
    logical cname;
    integer nbmin;
    logical sname;
    char subnam[1];

    ftnlen name_len, opts_len;

    name_len = strlen (name__);
    opts_len = strlen (opts);


















    switch (*ispec) {
	case 1:  goto L10;
	case 2:  goto L10;
	case 3:  goto L10;
	case 4:  goto L80;
	case 5:  goto L90;
	case 6:  goto L100;
	case 7:  goto L110;
	case 8:  goto L120;
	case 9:  goto L130;
	case 10:  goto L140;
	case 11:  goto L150;
	case 12:  goto L160;
	case 13:  goto L160;
	case 14:  goto L160;
	case 15:  goto L160;
	case 16:  goto L160;
    }


    ret_val = -1;
    return ret_val;

L10:


    ret_val = 1;
    s_copy(subnam, name__, (ftnlen)1, name_len);
    ic = *(unsigned char *)subnam;
    iz = 'Z';
    if (iz == 90 || iz == 122) {


	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);
		}
	    }
	}

    } else if (iz == 233 || iz == 169) {


	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);
		}
	    }
	}

    } else if (iz == 218 || iz == 250) {


	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);
		}
	    }
	}
    }

    *(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, (ftnlen)1, (ftnlen)2);
    s_copy(c3, subnam + 3, (ftnlen)1, (ftnlen)3);
    s_copy(c4, c3 + 1, (ftnlen)1, (ftnlen)2);

    switch (*ispec) {
	case 1:  goto L50;
	case 2:  goto L60;
	case 3:  goto L70;
    }

L50:



    nb = 1;

    if (s_cmp(c2, "GE", (ftnlen)1, (ftnlen)2) == 0) {
	if (s_cmp(c3, "TRF", (ftnlen)1, (ftnlen)3) == 0) {
	    if (sname) {
		nb = 64;
	    } else {
		nb = 64;
	    }
	} else if (s_cmp(c3, "QRF", (ftnlen)1, (ftnlen)3) == 0 || s_cmp(c3, 
		"RQF", (ftnlen)1, (ftnlen)3) == 0 || s_cmp(c3, "LQF", (ftnlen)
		1, (ftnlen)3) == 0 || s_cmp(c3, "QLF", (ftnlen)1, (ftnlen)3) 
		== 0) {
	    if (sname) {
		nb = 32;
	    } else {
		nb = 32;
	    }
	} else if (s_cmp(c3, "HRD", (ftnlen)1, (ftnlen)3) == 0) {
	    if (sname) {
		nb = 32;
	    } else {
		nb = 32;
	    }
	} else if (s_cmp(c3, "BRD", (ftnlen)1, (ftnlen)3) == 0) {
	    if (sname) {
		nb = 32;
	    } else {
		nb = 32;
	    }
	} else if (s_cmp(c3, "TRI", (ftnlen)1, (ftnlen)3) == 0) {
	    if (sname) {
		nb = 64;
	    } else {
		nb = 64;
	    }
	}
    } else if (s_cmp(c2, "PO", (ftnlen)1, (ftnlen)2) == 0) {
	if (s_cmp(c3, "TRF", (ftnlen)1, (ftnlen)3) == 0) {
	    if (sname) {
		nb = 64;
	    } else {
		nb = 64;
	    }
	}
    } else if (s_cmp(c2, "SY", (ftnlen)1, (ftnlen)2) == 0) {
	if (s_cmp(c3, "TRF", (ftnlen)1, (ftnlen)3) == 0) {
	    if (sname) {
		nb = 64;
	    } else {
		nb = 64;
	    }
	} else if (sname && s_cmp(c3, "TRD", (ftnlen)1, (ftnlen)3) == 0) {
	    nb = 32;
	} else if (sname && s_cmp(c3, "GST", (ftnlen)1, (ftnlen)3) == 0) {
	    nb = 64;
	}
    } else if (cname && s_cmp(c2, "HE", (ftnlen)1, (ftnlen)2) == 0) {
	if (s_cmp(c3, "TRF", (ftnlen)1, (ftnlen)3) == 0) {
	    nb = 64;
	} else if (s_cmp(c3, "TRD", (ftnlen)1, (ftnlen)3) == 0) {
	    nb = 32;
	} else if (s_cmp(c3, "GST", (ftnlen)1, (ftnlen)3) == 0) {
	    nb = 64;
	}
    } else if (sname && s_cmp(c2, "OR", (ftnlen)1, (ftnlen)2) == 0) {
	if (*(unsigned char *)c3 == 'G') {
	    if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ", 
		    (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
		    ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
		     0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
		    c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
		    ftnlen)1, (ftnlen)2) == 0) {
		nb = 32;
	    }
	} else if (*(unsigned char *)c3 == 'M') {
	    if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ", 
		    (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
		    ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
		     0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
		    c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
		    ftnlen)1, (ftnlen)2) == 0) {
		nb = 32;
	    }
	}
    } else if (cname && s_cmp(c2, "UN", (ftnlen)1, (ftnlen)2) == 0) {
	if (*(unsigned char *)c3 == 'G') {
	    if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ", 
		    (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
		    ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
		     0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
		    c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
		    ftnlen)1, (ftnlen)2) == 0) {
		nb = 32;
	    }
	} else if (*(unsigned char *)c3 == 'M') {
	    if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ", 
		    (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
		    ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
		     0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
		    c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
		    ftnlen)1, (ftnlen)2) == 0) {
		nb = 32;
	    }
	}
    } else if (s_cmp(c2, "GB", (ftnlen)1, (ftnlen)2) == 0) {
	if (s_cmp(c3, "TRF", (ftnlen)1, (ftnlen)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", (ftnlen)1, (ftnlen)2) == 0) {
	if (s_cmp(c3, "TRF", (ftnlen)1, (ftnlen)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", (ftnlen)1, (ftnlen)2) == 0) {
	if (s_cmp(c3, "TRI", (ftnlen)1, (ftnlen)3) == 0) {
	    if (sname) {
		nb = 64;
	    } else {
		nb = 64;
	    }
	}
    } else if (s_cmp(c2, "LA", (ftnlen)1, (ftnlen)2) == 0) {
	if (s_cmp(c3, "UUM", (ftnlen)1, (ftnlen)3) == 0) {
	    if (sname) {
		nb = 64;
	    } else {
		nb = 64;
	    }
	}
    } else if (sname && s_cmp(c2, "ST", (ftnlen)1, (ftnlen)2) == 0) {
	if (s_cmp(c3, "EBZ", (ftnlen)1, (ftnlen)3) == 0) {
	    nb = 1;
	}
    }
    ret_val = nb;
    return ret_val;

L60:


    nbmin = 2;
    if (s_cmp(c2, "GE", (ftnlen)1, (ftnlen)2) == 0) {
	if (s_cmp(c3, "QRF", (ftnlen)1, (ftnlen)3) == 0 || s_cmp(c3, "RQF", (
		ftnlen)1, (ftnlen)3) == 0 || s_cmp(c3, "LQF", (ftnlen)1, (
		ftnlen)3) == 0 || s_cmp(c3, "QLF", (ftnlen)1, (ftnlen)3) == 0)
		 {
	    if (sname) {
		nbmin = 2;
	    } else {
		nbmin = 2;
	    }
	} else if (s_cmp(c3, "HRD", (ftnlen)1, (ftnlen)3) == 0) {
	    if (sname) {
		nbmin = 2;
	    } else {
		nbmin = 2;
	    }
	} else if (s_cmp(c3, "BRD", (ftnlen)1, (ftnlen)3) == 0) {
	    if (sname) {
		nbmin = 2;
	    } else {
		nbmin = 2;
	    }
	} else if (s_cmp(c3, "TRI", (ftnlen)1, (ftnlen)3) == 0) {
	    if (sname) {
		nbmin = 2;
	    } else {
		nbmin = 2;
	    }
	}
    } else if (s_cmp(c2, "SY", (ftnlen)1, (ftnlen)2) == 0) {
	if (s_cmp(c3, "TRF", (ftnlen)1, (ftnlen)3) == 0) {
	    if (sname) {
		nbmin = 8;
	    } else {
		nbmin = 8;
	    }
	} else if (sname && s_cmp(c3, "TRD", (ftnlen)1, (ftnlen)3) == 0) {
	    nbmin = 2;
	}
    } else if (cname && s_cmp(c2, "HE", (ftnlen)1, (ftnlen)2) == 0) {
	if (s_cmp(c3, "TRD", (ftnlen)1, (ftnlen)3) == 0) {
	    nbmin = 2;
	}
    } else if (sname && s_cmp(c2, "OR", (ftnlen)1, (ftnlen)2) == 0) {
	if (*(unsigned char *)c3 == 'G') {
	    if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ", 
		    (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
		    ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
		     0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
		    c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
		    ftnlen)1, (ftnlen)2) == 0) {
		nbmin = 2;
	    }
	} else if (*(unsigned char *)c3 == 'M') {
	    if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ", 
		    (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
		    ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
		     0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
		    c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
		    ftnlen)1, (ftnlen)2) == 0) {
		nbmin = 2;
	    }
	}
    } else if (cname && s_cmp(c2, "UN", (ftnlen)1, (ftnlen)2) == 0) {
	if (*(unsigned char *)c3 == 'G') {
	    if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ", 
		    (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
		    ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
		     0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
		    c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
		    ftnlen)1, (ftnlen)2) == 0) {
		nbmin = 2;
	    }
	} else if (*(unsigned char *)c3 == 'M') {
	    if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ", 
		    (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
		    ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
		     0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
		    c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
		    ftnlen)1, (ftnlen)2) == 0) {
		nbmin = 2;
	    }
	}
    }
    ret_val = nbmin;
    return ret_val;

L70:


    nx = 0;
    if (s_cmp(c2, "GE", (ftnlen)1, (ftnlen)2) == 0) {
	if (s_cmp(c3, "QRF", (ftnlen)1, (ftnlen)3) == 0 || s_cmp(c3, "RQF", (
		ftnlen)1, (ftnlen)3) == 0 || s_cmp(c3, "LQF", (ftnlen)1, (
		ftnlen)3) == 0 || s_cmp(c3, "QLF", (ftnlen)1, (ftnlen)3) == 0)
		 {
	    if (sname) {
		nx = 128;
	    } else {
		nx = 128;
	    }
	} else if (s_cmp(c3, "HRD", (ftnlen)1, (ftnlen)3) == 0) {
	    if (sname) {
		nx = 128;
	    } else {
		nx = 128;
	    }
	} else if (s_cmp(c3, "BRD", (ftnlen)1, (ftnlen)3) == 0) {
	    if (sname) {
		nx = 128;
	    } else {
		nx = 128;
	    }
	}
    } else if (s_cmp(c2, "SY", (ftnlen)1, (ftnlen)2) == 0) {
	if (sname && s_cmp(c3, "TRD", (ftnlen)1, (ftnlen)3) == 0) {
	    nx = 32;
	}
    } else if (cname && s_cmp(c2, "HE", (ftnlen)1, (ftnlen)2) == 0) {
	if (s_cmp(c3, "TRD", (ftnlen)1, (ftnlen)3) == 0) {
	    nx = 32;
	}
    } else if (sname && s_cmp(c2, "OR", (ftnlen)1, (ftnlen)2) == 0) {
	if (*(unsigned char *)c3 == 'G') {
	    if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ", 
		    (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
		    ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
		     0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
		    c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
		    ftnlen)1, (ftnlen)2) == 0) {
		nx = 128;
	    }
	}
    } else if (cname && s_cmp(c2, "UN", (ftnlen)1, (ftnlen)2) == 0) {
	if (*(unsigned char *)c3 == 'G') {
	    if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ", 
		    (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
		    ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
		     0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
		    c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
		    ftnlen)1, (ftnlen)2) == 0) {
		nx = 128;
	    }
	}
    }
    ret_val = nx;
    return ret_val;

L80:


    ret_val = 6;
    return ret_val;

L90:


    ret_val = 2;
    return ret_val;

L100:


    ret_val = (integer) ((real) min(*n1,*n2) * 1.6f);
    return ret_val;

L110:


    ret_val = 1;
    return ret_val;

L120:


    ret_val = 50;
    return ret_val;

L130:


    ret_val = 25;
    return ret_val;

L140:


    ret_val = 1;
    if (ret_val == 1) {
	ret_val = ieeeck_(&ilaenv_c__1, &ilaenv_c_b163, &ilaenv_c_b164);
    }
    return ret_val;

L150:


    ret_val = 1;
    if (ret_val == 1) {
	ret_val = ieeeck_(&ilaenv_c__0, &ilaenv_c_b163, &ilaenv_c_b164);
    }
    return ret_val;

L160:


    ret_val = iparmq_(ispec, name__, opts, n1, n2, n3, n4)
	    ;
    return ret_val;


} /* ilaenv_ */
static /* Subroutine */ int dormbr_ (Tcl_Interp *interp, char *vect, char *side, char *trans, integer *m, 	integer *n, integer *k, doublereal *a, integer *lda, doublereal *tau, 	doublereal *c__, integer *ldc, doublereal *work, integer *lwork, 	integer *info)
{
    address a__1[2];
    integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2];
    char ch__1[2];

    /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);

    integer i1, i2, nb, mi, ni, nq, nw;
    logical left;
    integer iinfo;
    logical notran;
    logical applyq;
    char transt[1];
    integer lwkopt;
    logical lquery;






























    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --tau;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;
    --work;

    *info = 0;
    applyq = lsame_(vect, "Q");
    left = lsame_(side, "L");
    notran = lsame_(trans, "N");
    lquery = *lwork == -1;


    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) */ {
	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) {
		i__3[0] = 1, a__1[0] = side;
		i__3[1] = 1, a__1[1] = trans;
		s_cat(ch__1, a__1, i__3, &dormbr_c__2, (ftnlen)2);
		i__1 = *m - 1;
		i__2 = *m - 1;
		nb = ilaenv_(&dormbr_c__1, "DORMQR", ch__1, &i__1, n, &i__2, &dormbr_c_n1);
	    } else {
		i__3[0] = 1, a__1[0] = side;
		i__3[1] = 1, a__1[1] = trans;
		s_cat(ch__1, a__1, i__3, &dormbr_c__2, (ftnlen)2);
		i__1 = *n - 1;
		i__2 = *n - 1;
		nb = ilaenv_(&dormbr_c__1, "DORMQR", ch__1, m, &i__1, &i__2, &dormbr_c_n1);
	    }
	} else {
	    if (left) {
		i__3[0] = 1, a__1[0] = side;
		i__3[1] = 1, a__1[1] = trans;
		s_cat(ch__1, a__1, i__3, &dormbr_c__2, (ftnlen)2);
		i__1 = *m - 1;
		i__2 = *m - 1;
		nb = ilaenv_(&dormbr_c__1, "DORMLQ", ch__1, &i__1, n, &i__2, &dormbr_c_n1);
	    } else {
		i__3[0] = 1, a__1[0] = side;
		i__3[1] = 1, a__1[1] = trans;
		s_cat(ch__1, a__1, i__3, &dormbr_c__2, (ftnlen)2);
		i__1 = *n - 1;
		i__2 = *n - 1;
		nb = ilaenv_(&dormbr_c__1, "DORMLQ", ch__1, m, &i__1, &i__2, &dormbr_c_n1);
	    }
	}
	lwkopt = max(1,nw) * nb;
	work[1] = (doublereal) lwkopt;
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DORMBR", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


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

    if (applyq) {


	if (nq >= *k) {


	    if (dormqr_(interp, side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[		    c_offset], ldc, &work[1], lwork, &iinfo)!=TCL_OK) { return TCL_ERROR; }


	} else if (nq > 1) {


	    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;
	    if (dormqr_(interp, side, trans, &mi, &ni, &i__1, &a[a_dim1 + 2], lda, &tau[1], &c__[i1 + i2 * c_dim1], ldc, &work[1], lwork, &iinfo)!=TCL_OK) { return TCL_ERROR; }


	}
    } else {


	if (notran) {
	    *(unsigned char *)transt = 'T';
	} else {
	    *(unsigned char *)transt = 'N';
	}
	if (nq > *k) {


	    if (dormlq_(interp, side, transt, m, n, k, &a[a_offset], lda, &tau[1], &c__[		    c_offset], ldc, &work[1], lwork, &iinfo)!=TCL_OK) { return TCL_ERROR; }


	} else if (nq > 1) {


	    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;
	    if (dormlq_(interp, side, transt, &mi, &ni, &i__1, &a[(a_dim1 << 1) + 1], lda, 		     &tau[1], &c__[i1 + i2 * c_dim1], ldc, &work[1], lwork, &
		    iinfo)!=TCL_OK) { return TCL_ERROR; }


	}
    }
    work[1] = (doublereal) lwkopt;
return TCL_OK;


} /* dormbr_ */
static /* Subroutine */ int dorglq_ (Tcl_Interp *interp, integer *m, integer *n, integer *k, doublereal *	a, integer *lda, doublereal *tau, doublereal *work, integer *lwork, 	integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3;

    integer i__, j, l, ib, nb, ki, kk, nx, iws, nbmin, iinfo;
    integer ldwork, lwkopt;
    logical lquery;






















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

    *info = 0;
    nb = ilaenv_(&dorglq_c__1, "DORGLQ", " ", m, n, k, &dorglq_c_n1);
    lwkopt = max(1,*m) * nb;
    work[1] = (doublereal) 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);
	vectcl_xerbla(interp, "DORGLQ", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


    if (*m <= 0) {
	work[1] = 1.;
return TCL_OK;
    }

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


	i__1 = 0, i__2 = ilaenv_(&dorglq_c__3, "DORGLQ", " ", m, n, k, &dorglq_c_n1);
	nx = max(i__1,i__2);
	if (nx < *k) {


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


		nb = *lwork / ldwork;
		i__1 = 2, i__2 = ilaenv_(&dorglq_c__2, "DORGLQ", " ", m, n, k, &dorglq_c_n1);
		nbmin = max(i__1,i__2);
	    }
	}
    }

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


	ki = (*k - nx - 1) / nb * nb;
	i__1 = *k, i__2 = ki + nb;
	kk = min(i__1,i__2);


	i__1 = kk;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *m;
	    for (i__ = kk + 1; i__ <= i__2; ++i__) {
		a[i__ + j * a_dim1] = 0.;
	    }
	}
    } else {
	kk = 0;
    }


    if (kk < *m) {
	i__1 = *m - kk;
	i__2 = *n - kk;
	i__3 = *k - kk;
	if (dorgl2_(interp, &i__1, &i__2, &i__3, &a[kk + 1 + (kk + 1) * a_dim1], lda, &		tau[kk + 1], &work[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }


    }

    if (kk > 0) {


	i__1 = -nb;
	for (i__ = ki + 1; i__1 < 0 ? i__ >= 1 : i__ <= 1; i__ += i__1) {
	    i__2 = nb, i__3 = *k - i__ + 1;
	    ib = min(i__2,i__3);
	    if (i__ + ib <= *m) {


		i__2 = *n - i__ + 1;
		if (dlarft_(interp, "Forward", "Rowwise", &i__2, &ib, &a[i__ + i__ * 			a_dim1], lda, &tau[i__], &work[1], &ldwork)!=TCL_OK) { return TCL_ERROR; }




		i__2 = *m - i__ - ib + 1;
		i__3 = *n - i__ + 1;
		if (dlarfb_(interp, "Right", "Transpose", "Forward", "Rowwise", &i__2, &			i__3, &ib, &a[i__ + i__ * a_dim1], lda, &work[1], &
			ldwork, &a[i__ + ib + i__ * a_dim1], lda, &work[ib + 
			1], &ldwork)!=TCL_OK) { return TCL_ERROR; }


	    }


	    i__2 = *n - i__ + 1;
	    if (dorgl2_(interp, &ib, &i__2, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &		    work[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }




	    i__2 = i__ - 1;
	    for (j = 1; j <= i__2; ++j) {
		i__3 = i__ + ib - 1;
		for (l = i__; l <= i__3; ++l) {
		    a[l + j * a_dim1] = 0.;
		}
	    }
	}
    }

    work[1] = (doublereal) iws;
return TCL_OK;


} /* dorglq_ */
static /* Subroutine */ int dorgqr_ (Tcl_Interp *interp, integer *m, integer *n, integer *k, doublereal *	a, integer *lda, doublereal *tau, doublereal *work, integer *lwork, 	integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3;

    integer i__, j, l, ib, nb, ki, kk, nx, iws, nbmin, iinfo;
    integer ldwork, lwkopt;
    logical lquery;






















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

    *info = 0;
    nb = ilaenv_(&dorgqr_c__1, "DORGQR", " ", m, n, k, &dorgqr_c_n1);
    lwkopt = max(1,*n) * nb;
    work[1] = (doublereal) 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);
	vectcl_xerbla(interp, "DORGQR", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


    if (*n <= 0) {
	work[1] = 1.;
return TCL_OK;
    }

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


	i__1 = 0, i__2 = ilaenv_(&dorgqr_c__3, "DORGQR", " ", m, n, k, &dorgqr_c_n1);
	nx = max(i__1,i__2);
	if (nx < *k) {


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


		nb = *lwork / ldwork;
		i__1 = 2, i__2 = ilaenv_(&dorgqr_c__2, "DORGQR", " ", m, n, k, &dorgqr_c_n1);
		nbmin = max(i__1,i__2);
	    }
	}
    }

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


	ki = (*k - nx - 1) / nb * nb;
	i__1 = *k, i__2 = ki + nb;
	kk = min(i__1,i__2);


	i__1 = *n;
	for (j = kk + 1; j <= i__1; ++j) {
	    i__2 = kk;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		a[i__ + j * a_dim1] = 0.;
	    }
	}
    } else {
	kk = 0;
    }


    if (kk < *n) {
	i__1 = *m - kk;
	i__2 = *n - kk;
	i__3 = *k - kk;
	if (dorg2r_(interp, &i__1, &i__2, &i__3, &a[kk + 1 + (kk + 1) * a_dim1], lda, &		tau[kk + 1], &work[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }


    }

    if (kk > 0) {


	i__1 = -nb;
	for (i__ = ki + 1; i__1 < 0 ? i__ >= 1 : i__ <= 1; i__ += i__1) {
	    i__2 = nb, i__3 = *k - i__ + 1;
	    ib = min(i__2,i__3);
	    if (i__ + ib <= *n) {


		i__2 = *m - i__ + 1;
		if (dlarft_(interp, "Forward", "Columnwise", &i__2, &ib, &a[i__ + i__ * 			a_dim1], lda, &tau[i__], &work[1], &ldwork)!=TCL_OK) { return TCL_ERROR; }




		i__2 = *m - i__ + 1;
		i__3 = *n - i__ - ib + 1;
		if (dlarfb_(interp, "Left", "No transpose", "Forward", "Columnwise", &			i__2, &i__3, &ib, &a[i__ + i__ * a_dim1], lda, &work[
			1], &ldwork, &a[i__ + (i__ + ib) * a_dim1], lda, &
			work[ib + 1], &ldwork)!=TCL_OK) { return TCL_ERROR; }


	    }


	    i__2 = *m - i__ + 1;
	    if (dorg2r_(interp, &i__2, &ib, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &		    work[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }




	    i__2 = i__ + ib - 1;
	    for (j = i__; j <= i__2; ++j) {
		i__3 = i__ - 1;
		for (l = 1; l <= i__3; ++l) {
		    a[l + j * a_dim1] = 0.;
		}
	    }
	}
    }

    work[1] = (doublereal) iws;
return TCL_OK;


} /* dorgqr_ */
static /* Subroutine */ int zlacp2_ (Tcl_Interp *interp, char *uplo, integer *m, integer *n, doublereal *	a, integer *lda, doublecomplex *b, integer *ldb)
{
    integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4;

    integer i__, j;
















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

    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__) {
		i__3 = i__ + j * b_dim1;
		i__4 = i__ + j * a_dim1;
		b[i__3].r = a[i__4], b[i__3].i = 0.;
	    }
	}

    } 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__) {
		i__3 = i__ + j * b_dim1;
		i__4 = i__ + j * a_dim1;
		b[i__3].r = a[i__4], b[i__3].i = 0.;
	    }
	}

    } else {
	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *m;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		i__3 = i__ + j * b_dim1;
		i__4 = i__ + j * a_dim1;
		b[i__3].r = a[i__4], b[i__3].i = 0.;
	    }
	}
    }

return TCL_OK;


} /* zlacp2_ */
static /* Subroutine */ int zgebrd_ (Tcl_Interp *interp, integer *m, integer *n, doublecomplex *a, 	integer *lda, doublereal *d__, doublereal *e, doublecomplex *tauq, 	doublecomplex *taup, doublecomplex *work, integer *lwork, integer *	info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
    doublereal d__1;
    doublecomplex z__1;

    integer i__, j, nb, nx;
    doublereal ws;
    integer nbmin, iinfo, minmn;
    integer ldwrkx, ldwrky, lwkopt;
    logical lquery;







































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

    *info = 0;
    i__1 = 1, i__2 = ilaenv_(&zgebrd_c__1, "ZGEBRD", " ", m, n, &zgebrd_c_n1, &zgebrd_c_n1);
    nb = max(i__1,i__2);
    lwkopt = (*m + *n) * nb;
    d__1 = (doublereal) lwkopt;
    work[1].r = d__1, work[1].i = 0.;
    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) */ {
	i__1 = max(1,*m);
	if (*lwork < max(i__1,*n) && ! lquery) {
	    *info = -10;
	}
    }
    if (*info < 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "ZGEBRD", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


    minmn = min(*m,*n);
    if (minmn == 0) {
	work[1].r = 1., work[1].i = 0.;
return TCL_OK;
    }

    ws = (doublereal) max(*m,*n);
    ldwrkx = *m;
    ldwrky = *n;

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


	i__1 = nb, i__2 = ilaenv_(&zgebrd_c__3, "ZGEBRD", " ", m, n, &zgebrd_c_n1, &zgebrd_c_n1);
	nx = max(i__1,i__2);


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


		nbmin = ilaenv_(&zgebrd_c__2, "ZGEBRD", " ", m, n, &zgebrd_c_n1, &zgebrd_c_n1);
		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) {


	i__3 = *m - i__ + 1;
	i__4 = *n - i__ + 1;
	if (zlabrd_(interp, &i__3, &i__4, &nb, &a[i__ + i__ * a_dim1], lda, &d__[i__], &e[		i__], &tauq[i__], &taup[i__], &work[1], &ldwrkx, &work[ldwrkx 
		* nb + 1], &ldwrky)!=TCL_OK) { return TCL_ERROR; }




	i__3 = *m - i__ - nb + 1;
	i__4 = *n - i__ - nb + 1;
	z__1.r = -1., z__1.i = -0.;
	if (zgemm_(interp, "No transpose", "Conjugate transpose", &i__3, &i__4, &nb, &		z__1, &a[i__ + nb + i__ * a_dim1], lda, &work[ldwrkx * nb + 
		nb + 1], &ldwrky, &zgebrd_c_b1, &a[i__ + nb + (i__ + nb) * a_dim1], 
		lda)!=TCL_OK) { return TCL_ERROR; }


	i__3 = *m - i__ - nb + 1;
	i__4 = *n - i__ - nb + 1;
	z__1.r = -1., z__1.i = -0.;
	if (zgemm_(interp, "No transpose", "No transpose", &i__3, &i__4, &nb, &z__1, &		work[nb + 1], &ldwrkx, &a[i__ + (i__ + nb) * a_dim1], lda, &
		zgebrd_c_b1, &a[i__ + nb + (i__ + nb) * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }




	if (*m >= *n) {
	    i__3 = i__ + nb - 1;
	    for (j = i__; j <= i__3; ++j) {
		i__4 = j + j * a_dim1;
		i__5 = j;
		a[i__4].r = d__[i__5], a[i__4].i = 0.;
		i__4 = j + (j + 1) * a_dim1;
		i__5 = j;
		a[i__4].r = e[i__5], a[i__4].i = 0.;
	    }
	} else {
	    i__3 = i__ + nb - 1;
	    for (j = i__; j <= i__3; ++j) {
		i__4 = j + j * a_dim1;
		i__5 = j;
		a[i__4].r = d__[i__5], a[i__4].i = 0.;
		i__4 = j + 1 + j * a_dim1;
		i__5 = j;
		a[i__4].r = e[i__5], a[i__4].i = 0.;
	    }
	}
    }


    i__2 = *m - i__ + 1;
    i__1 = *n - i__ + 1;
    if (zgebd2_(interp, &i__2, &i__1, &a[i__ + i__ * a_dim1], lda, &d__[i__], &e[i__], &	    tauq[i__], &taup[i__], &work[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }


    work[1].r = ws, work[1].i = 0.;
return TCL_OK;


} /* zgebrd_ */
static doublereal zlange_ (char *norm, integer *m, integer *n, doublecomplex *a, 	integer *lda, doublereal *work)
{
    integer a_dim1, a_offset, i__1, i__2;
    doublereal ret_val, d__1, d__2;

    double z_abs(doublecomplex *), sqrt(doublereal);

    integer i__, j;
    doublereal sum, scale;
    doublereal value;



















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

    if (min(*m,*n) == 0) {
	value = 0.;
    } else if (lsame_(norm, "M")) {


	value = 0.;
	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *m;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		d__1 = value, d__2 = z_abs(&a[i__ + j * a_dim1]);
		value = max(d__1,d__2);
	    }
	}
    } else if (lsame_(norm, "O") || *(unsigned char *)
	    norm == '1') {


	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 += z_abs(&a[i__ + j * a_dim1]);
	    }
	    value = max(value,sum);
	}
    } else if (lsame_(norm, "I")) {


	i__1 = *m;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    work[i__] = 0.;
	}
	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *m;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		work[i__] += z_abs(&a[i__ + j * a_dim1]);
	    }
	}
	value = 0.;
	i__1 = *m;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    d__1 = value, d__2 = work[i__];
	    value = max(d__1,d__2);
	}
    } else if (lsame_(norm, "F") || lsame_(norm, "E")) {


	scale = 0.;
	sum = 1.;
	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    zlassq_(NULL, m, &a[j * a_dim1 + 1], &zlange_c__1, &scale, &sum);
	}
	value = scale * sqrt(sum);
    }

    ret_val = value;
    return ret_val;


} /* zlange_ */
static /* Subroutine */ int zgelqf_ (Tcl_Interp *interp, integer *m, integer *n, doublecomplex *a, 	integer *lda, doublecomplex *tau, doublecomplex *work, integer *lwork, 	 integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4;

    integer i__, k, ib, nb, nx, iws, nbmin, iinfo;
    integer ldwork;
    integer lwkopt;
    logical lquery;

























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

    *info = 0;
    nb = ilaenv_(&zgelqf_c__1, "ZGELQF", " ", m, n, &zgelqf_c_n1, &zgelqf_c_n1);
    lwkopt = *m * nb;
    work[1].r = (doublereal) lwkopt, work[1].i = 0.;
    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);
	vectcl_xerbla(interp, "ZGELQF", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


    k = min(*m,*n);
    if (k == 0) {
	work[1].r = 1., work[1].i = 0.;
return TCL_OK;
    }

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


	i__1 = 0, i__2 = ilaenv_(&zgelqf_c__3, "ZGELQF", " ", m, n, &zgelqf_c_n1, &zgelqf_c_n1);
	nx = max(i__1,i__2);
	if (nx < k) {


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


		nb = *lwork / ldwork;
		i__1 = 2, i__2 = ilaenv_(&zgelqf_c__2, "ZGELQF", " ", m, n, &zgelqf_c_n1, &
			zgelqf_c_n1);
		nbmin = max(i__1,i__2);
	    }
	}
    }

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


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


	    i__3 = *n - i__ + 1;
	    if (zgelq2_(interp, &ib, &i__3, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[		    1], &iinfo)!=TCL_OK) { return TCL_ERROR; }


	    if (i__ + ib <= *m) {


		i__3 = *n - i__ + 1;
		if (zlarft_(interp, "Forward", "Rowwise", &i__3, &ib, &a[i__ + i__ * 			a_dim1], lda, &tau[i__], &work[1], &ldwork)!=TCL_OK) { return TCL_ERROR; }




		i__3 = *m - i__ - ib + 1;
		i__4 = *n - i__ + 1;
		if (zlarfb_(interp, "Right", "No transpose", "Forward", "Rowwise", &i__3, 			&i__4, &ib, &a[i__ + i__ * a_dim1], lda, &work[1], &
			ldwork, &a[i__ + ib + i__ * a_dim1], lda, &work[ib + 
			1], &ldwork)!=TCL_OK) { return TCL_ERROR; }


	    }
	}
    } else {
	i__ = 1;
    }


    if (i__ <= k) {
	i__2 = *m - i__ + 1;
	i__1 = *n - i__ + 1;
	if (zgelq2_(interp, &i__2, &i__1, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }


    }

    work[1].r = (doublereal) iws, work[1].i = 0.;
return TCL_OK;


} /* zgelqf_ */
static /* Subroutine */ int zlacrm_ (Tcl_Interp *interp, integer *m, integer *n, doublecomplex *a, 	integer *lda, doublereal *b, integer *ldb, doublecomplex *c__, 	integer *ldc, doublereal *rwork)
{
    integer b_dim1, b_offset, a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, 
	    i__3, i__4, i__5;
    doublereal d__1;
    doublecomplex z__1;

    double d_imag(doublecomplex *);

    integer i__, j, l;



















    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    b_dim1 = *ldb;
    b_offset = 1 + b_dim1;
    b -= b_offset;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;
    --rwork;

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

    i__1 = *n;
    for (j = 1; j <= i__1; ++j) {
	i__2 = *m;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    i__3 = i__ + j * a_dim1;
	    rwork[(j - 1) * *m + i__] = a[i__3].r;
	}
    }

    l = *m * *n + 1;
    if (dgemm_(interp, "N", "N", m, n, n, &zlacrm_c_b6, &rwork[1], m, &b[b_offset], ldb, &zlacrm_c_b7, &	    rwork[l], m)!=TCL_OK) { return TCL_ERROR; }


    i__1 = *n;
    for (j = 1; j <= i__1; ++j) {
	i__2 = *m;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    i__3 = i__ + j * c_dim1;
	    i__4 = l + (j - 1) * *m + i__ - 1;
	    c__[i__3].r = rwork[i__4], c__[i__3].i = 0.;
	}
    }

    i__1 = *n;
    for (j = 1; j <= i__1; ++j) {
	i__2 = *m;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    rwork[(j - 1) * *m + i__] = d_imag(&a[i__ + j * a_dim1]);
	}
    }
    if (dgemm_(interp, "N", "N", m, n, n, &zlacrm_c_b6, &rwork[1], m, &b[b_offset], ldb, &zlacrm_c_b7, &	    rwork[l], m)!=TCL_OK) { return TCL_ERROR; }


    i__1 = *n;
    for (j = 1; j <= i__1; ++j) {
	i__2 = *m;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    i__3 = i__ + j * c_dim1;
	    i__4 = i__ + j * c_dim1;
	    d__1 = c__[i__4].r;
	    i__5 = l + (j - 1) * *m + i__ - 1;
	    z__1.r = d__1, z__1.i = rwork[i__5];
	    c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
	}
    }

return TCL_OK;


} /* zlacrm_ */
static /* Subroutine */ int zlarcm_ (Tcl_Interp *interp, integer *m, integer *n, doublereal *a, integer *	lda, doublecomplex *b, integer *ldb, doublecomplex *c__, integer *ldc, 	 doublereal *rwork)
{
    integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, 
	    i__3, i__4, i__5;
    doublereal d__1;
    doublecomplex z__1;

    double d_imag(doublecomplex *);

    integer i__, j, l;



















    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    b_dim1 = *ldb;
    b_offset = 1 + b_dim1;
    b -= b_offset;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;
    --rwork;

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

    i__1 = *n;
    for (j = 1; j <= i__1; ++j) {
	i__2 = *m;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    i__3 = i__ + j * b_dim1;
	    rwork[(j - 1) * *m + i__] = b[i__3].r;
	}
    }

    l = *m * *n + 1;
    if (dgemm_(interp, "N", "N", m, n, m, &zlarcm_c_b6, &a[a_offset], lda, &rwork[1], m, &zlarcm_c_b7, &	    rwork[l], m)!=TCL_OK) { return TCL_ERROR; }


    i__1 = *n;
    for (j = 1; j <= i__1; ++j) {
	i__2 = *m;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    i__3 = i__ + j * c_dim1;
	    i__4 = l + (j - 1) * *m + i__ - 1;
	    c__[i__3].r = rwork[i__4], c__[i__3].i = 0.;
	}
    }

    i__1 = *n;
    for (j = 1; j <= i__1; ++j) {
	i__2 = *m;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    rwork[(j - 1) * *m + i__] = d_imag(&b[i__ + j * b_dim1]);
	}
    }
    if (dgemm_(interp, "N", "N", m, n, m, &zlarcm_c_b6, &a[a_offset], lda, &rwork[1], m, &zlarcm_c_b7, &	    rwork[l], m)!=TCL_OK) { return TCL_ERROR; }


    i__1 = *n;
    for (j = 1; j <= i__1; ++j) {
	i__2 = *m;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    i__3 = i__ + j * c_dim1;
	    i__4 = i__ + j * c_dim1;
	    d__1 = c__[i__4].r;
	    i__5 = l + (j - 1) * *m + i__ - 1;
	    z__1.r = d__1, z__1.i = rwork[i__5];
	    c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
	}
    }

return TCL_OK;


} /* zlarcm_ */
static /* Subroutine */ int zlascl_ (Tcl_Interp *interp, char *type__, integer *kl, integer *ku, 	doublereal *cfrom, doublereal *cto, integer *m, integer *n, 	doublecomplex *a, integer *lda, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
    doublecomplex z__1;

    integer i__, j, k1, k2, k3, k4;
    doublereal mul, cto1;
    logical done;
    doublereal ctoc;
    integer itype;
    doublereal cfrom1;
    doublereal cfromc;
    doublereal bignum, smlnum;



















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

    *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. || disnan_(cfrom)) {
	*info = -4;
    } else if (disnan_(cto)) {
	*info = -5;
    } 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) {
	i__1 = *m - 1;
	if (*kl < 0 || *kl > max(i__1,0)) {
	    *info = -2;
	} else /* if(complicated condition) */ {
	    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);
	vectcl_xerbla(interp, "ZLASCL", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


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


    smlnum = dlamch_("S");
    bignum = 1. / smlnum;

    cfromc = *cfrom;
    ctoc = *cto;

L10:
    cfrom1 = cfromc * smlnum;
    if (cfrom1 == cfromc) {
	mul = ctoc / cfromc;
	done = TRUE_;
	cto1 = ctoc;
    } else {
	cto1 = ctoc / bignum;
	if (cto1 == ctoc) {
	    mul = ctoc;
	    done = TRUE_;
	    cfromc = 1.;
	} else if (abs(cfrom1) > abs(ctoc) && ctoc != 0.) {
	    mul = smlnum;
	    done = FALSE_;
	    cfromc = cfrom1;
	} else if (abs(cto1) > abs(cfromc)) {
	    mul = bignum;
	    done = FALSE_;
	    ctoc = cto1;
	} else {
	    mul = ctoc / cfromc;
	    done = TRUE_;
	}
    }

    if (itype == 0) {


	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *m;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		i__3 = i__ + j * a_dim1;
		i__4 = i__ + j * a_dim1;
		z__1.r = mul * a[i__4].r, z__1.i = mul * a[i__4].i;
		a[i__3].r = z__1.r, a[i__3].i = z__1.i;
	    }
	}

    } else if (itype == 1) {


	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *m;
	    for (i__ = j; i__ <= i__2; ++i__) {
		i__3 = i__ + j * a_dim1;
		i__4 = i__ + j * a_dim1;
		z__1.r = mul * a[i__4].r, z__1.i = mul * a[i__4].i;
		a[i__3].r = z__1.r, a[i__3].i = z__1.i;
	    }
	}

    } else if (itype == 2) {


	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = min(j,*m);
	    for (i__ = 1; i__ <= i__2; ++i__) {
		i__3 = i__ + j * a_dim1;
		i__4 = i__ + j * a_dim1;
		z__1.r = mul * a[i__4].r, z__1.i = mul * a[i__4].i;
		a[i__3].r = z__1.r, a[i__3].i = z__1.i;
	    }
	}

    } else if (itype == 3) {


	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__3 = j + 1;
	    i__2 = min(i__3,*m);
	    for (i__ = 1; i__ <= i__2; ++i__) {
		i__3 = i__ + j * a_dim1;
		i__4 = i__ + j * a_dim1;
		z__1.r = mul * a[i__4].r, z__1.i = mul * a[i__4].i;
		a[i__3].r = z__1.r, a[i__3].i = z__1.i;
	    }
	}

    } else if (itype == 4) {


	k3 = *kl + 1;
	k4 = *n + 1;
	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__3 = k3, i__4 = k4 - j;
	    i__2 = min(i__3,i__4);
	    for (i__ = 1; i__ <= i__2; ++i__) {
		i__3 = i__ + j * a_dim1;
		i__4 = i__ + j * a_dim1;
		z__1.r = mul * a[i__4].r, z__1.i = mul * a[i__4].i;
		a[i__3].r = z__1.r, a[i__3].i = z__1.i;
	    }
	}

    } else if (itype == 5) {


	k1 = *ku + 2;
	k3 = *ku + 1;
	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = k1 - j;
	    i__3 = k3;
	    for (i__ = max(i__2,1); i__ <= i__3; ++i__) {
		i__2 = i__ + j * a_dim1;
		i__4 = i__ + j * a_dim1;
		z__1.r = mul * a[i__4].r, z__1.i = mul * a[i__4].i;
		a[i__2].r = z__1.r, a[i__2].i = z__1.i;
	    }
	}

    } else if (itype == 6) {


	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) {
	    i__3 = k1 - j;
	    i__4 = k3, i__5 = k4 - j;
	    i__2 = min(i__4,i__5);
	    for (i__ = max(i__3,k2); i__ <= i__2; ++i__) {
		i__3 = i__ + j * a_dim1;
		i__4 = i__ + j * a_dim1;
		z__1.r = mul * a[i__4].r, z__1.i = mul * a[i__4].i;
		a[i__3].r = z__1.r, a[i__3].i = z__1.i;
	    }
	}

    }

    if (! done) {
	goto L10;
    }

return TCL_OK;


} /* zlascl_ */
static /* Subroutine */ int zgeqrf_ (Tcl_Interp *interp, integer *m, integer *n, doublecomplex *a, 	integer *lda, doublecomplex *tau, doublecomplex *work, integer *lwork, 	 integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4;

    integer i__, k, ib, nb, nx, iws, nbmin, iinfo;
    integer ldwork;
    integer lwkopt;
    logical lquery;

























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

    *info = 0;
    nb = ilaenv_(&zgeqrf_c__1, "ZGEQRF", " ", m, n, &zgeqrf_c_n1, &zgeqrf_c_n1);
    lwkopt = *n * nb;
    work[1].r = (doublereal) lwkopt, work[1].i = 0.;
    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);
	vectcl_xerbla(interp, "ZGEQRF", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


    k = min(*m,*n);
    if (k == 0) {
	work[1].r = 1., work[1].i = 0.;
return TCL_OK;
    }

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


	i__1 = 0, i__2 = ilaenv_(&zgeqrf_c__3, "ZGEQRF", " ", m, n, &zgeqrf_c_n1, &zgeqrf_c_n1);
	nx = max(i__1,i__2);
	if (nx < k) {


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


		nb = *lwork / ldwork;
		i__1 = 2, i__2 = ilaenv_(&zgeqrf_c__2, "ZGEQRF", " ", m, n, &zgeqrf_c_n1, &
			zgeqrf_c_n1);
		nbmin = max(i__1,i__2);
	    }
	}
    }

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


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


	    i__3 = *m - i__ + 1;
	    if (zgeqr2_(interp, &i__3, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[		    1], &iinfo)!=TCL_OK) { return TCL_ERROR; }


	    if (i__ + ib <= *n) {


		i__3 = *m - i__ + 1;
		if (zlarft_(interp, "Forward", "Columnwise", &i__3, &ib, &a[i__ + i__ * 			a_dim1], lda, &tau[i__], &work[1], &ldwork)!=TCL_OK) { return TCL_ERROR; }




		i__3 = *m - i__ + 1;
		i__4 = *n - i__ - ib + 1;
		if (zlarfb_(interp, "Left", "Conjugate transpose", "Forward", "Columnwise", &i__3, &i__4, &ib, &a[i__ + i__ * a_dim1], lda, &
			work[1], &ldwork, &a[i__ + (i__ + ib) * a_dim1], lda, 
			&work[ib + 1], &ldwork)!=TCL_OK) { return TCL_ERROR; }


	    }
	}
    } else {
	i__ = 1;
    }


    if (i__ <= k) {
	i__2 = *m - i__ + 1;
	i__1 = *n - i__ + 1;
	if (zgeqr2_(interp, &i__2, &i__1, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }


    }

    work[1].r = (doublereal) iws, work[1].i = 0.;
return TCL_OK;


} /* zgeqrf_ */
static /* Subroutine */ int zlacpy_ (Tcl_Interp *interp, char *uplo, integer *m, integer *n, 	doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb)
{
    integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4;

    integer i__, j;
















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

    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__) {
		i__3 = i__ + j * b_dim1;
		i__4 = i__ + j * a_dim1;
		b[i__3].r = a[i__4].r, b[i__3].i = a[i__4].i;
	    }
	}

    } 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__) {
		i__3 = i__ + j * b_dim1;
		i__4 = i__ + j * a_dim1;
		b[i__3].r = a[i__4].r, b[i__3].i = a[i__4].i;
	    }
	}

    } else {
	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *m;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		i__3 = i__ + j * b_dim1;
		i__4 = i__ + j * a_dim1;
		b[i__3].r = a[i__4].r, b[i__3].i = a[i__4].i;
	    }
	}
    }

return TCL_OK;


} /* zlacpy_ */
static /* Subroutine */ int zlaset_ (Tcl_Interp *interp, char *uplo, integer *m, integer *n, 	doublecomplex *alpha, doublecomplex *beta, doublecomplex *a, integer *	lda)
{
    integer a_dim1, a_offset, i__1, i__2, i__3;

    integer i__, j;
















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

    if (lsame_(uplo, "U")) {


	i__1 = *n;
	for (j = 2; j <= i__1; ++j) {
	    i__3 = j - 1;
	    i__2 = min(i__3,*m);
	    for (i__ = 1; i__ <= i__2; ++i__) {
		i__3 = i__ + j * a_dim1;
		a[i__3].r = alpha->r, a[i__3].i = alpha->i;
	    }
	}
	i__1 = min(*n,*m);
	for (i__ = 1; i__ <= i__1; ++i__) {
	    i__2 = i__ + i__ * a_dim1;
	    a[i__2].r = beta->r, a[i__2].i = beta->i;
	}

    } else if (lsame_(uplo, "L")) {


	i__1 = min(*m,*n);
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *m;
	    for (i__ = j + 1; i__ <= i__2; ++i__) {
		i__3 = i__ + j * a_dim1;
		a[i__3].r = alpha->r, a[i__3].i = alpha->i;
	    }
	}
	i__1 = min(*n,*m);
	for (i__ = 1; i__ <= i__1; ++i__) {
	    i__2 = i__ + i__ * a_dim1;
	    a[i__2].r = beta->r, a[i__2].i = beta->i;
	}

    } else {


	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *m;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		i__3 = i__ + j * a_dim1;
		a[i__3].r = alpha->r, a[i__3].i = alpha->i;
	    }
	}
	i__1 = min(*m,*n);
	for (i__ = 1; i__ <= i__1; ++i__) {
	    i__2 = i__ + i__ * a_dim1;
	    a[i__2].r = beta->r, a[i__2].i = beta->i;
	}
    }

return TCL_OK;


} /* zlaset_ */
static /* Subroutine */ int zungbr_ (Tcl_Interp *interp, char *vect, integer *m, integer *n, integer *k, 	doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *	work, integer *lwork, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3;

    integer i__, j, nb, mn;
    integer iinfo;
    logical wantq;
    integer lwkopt;
    logical lquery;























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

    *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 = ilaenv_(&zungbr_c__1, "ZUNGQR", " ", m, n, k, &zungbr_c_n1);
	} else {
	    nb = ilaenv_(&zungbr_c__1, "ZUNGLQ", " ", m, n, k, &zungbr_c_n1);
	}
	lwkopt = max(1,mn) * nb;
	work[1].r = (doublereal) lwkopt, work[1].i = 0.;
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "ZUNGBR", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


    if (*m == 0 || *n == 0) {
	work[1].r = 1., work[1].i = 0.;
return TCL_OK;
    }

    if (wantq) {


	if (*m >= *k) {


	    if (zungqr_(interp, m, n, k, &a[a_offset], lda, &tau[1], &work[1], lwork, &		    iinfo)!=TCL_OK) { return TCL_ERROR; }



	} else {



	    for (j = *m; j >= 2; --j) {
		i__1 = j * a_dim1 + 1;
		a[i__1].r = 0., a[i__1].i = 0.;
		i__1 = *m;
		for (i__ = j + 1; i__ <= i__1; ++i__) {
		    i__2 = i__ + j * a_dim1;
		    i__3 = i__ + (j - 1) * a_dim1;
		    a[i__2].r = a[i__3].r, a[i__2].i = a[i__3].i;
		}
	    }
	    i__1 = a_dim1 + 1;
	    a[i__1].r = 1., a[i__1].i = 0.;
	    i__1 = *m;
	    for (i__ = 2; i__ <= i__1; ++i__) {
		i__2 = i__ + a_dim1;
		a[i__2].r = 0., a[i__2].i = 0.;
	    }
	    if (*m > 1) {


		i__1 = *m - 1;
		i__2 = *m - 1;
		i__3 = *m - 1;
		if (zungqr_(interp, &i__1, &i__2, &i__3, &a[(a_dim1 << 1) + 2], lda, &tau[			1], &work[1], lwork, &iinfo)!=TCL_OK) { return TCL_ERROR; }


	    }
	}
    } else {


	if (*k < *n) {


	    if (zunglq_(interp, m, n, k, &a[a_offset], lda, &tau[1], &work[1], lwork, &		    iinfo)!=TCL_OK) { return TCL_ERROR; }



	} else {



	    i__1 = a_dim1 + 1;
	    a[i__1].r = 1., a[i__1].i = 0.;
	    i__1 = *n;
	    for (i__ = 2; i__ <= i__1; ++i__) {
		i__2 = i__ + a_dim1;
		a[i__2].r = 0., a[i__2].i = 0.;
	    }
	    i__1 = *n;
	    for (j = 2; j <= i__1; ++j) {
		for (i__ = j - 1; i__ >= 2; --i__) {
		    i__2 = i__ + j * a_dim1;
		    i__3 = i__ - 1 + j * a_dim1;
		    a[i__2].r = a[i__3].r, a[i__2].i = a[i__3].i;
		}
		i__2 = j * a_dim1 + 1;
		a[i__2].r = 0., a[i__2].i = 0.;
	    }
	    if (*n > 1) {


		i__1 = *n - 1;
		i__2 = *n - 1;
		i__3 = *n - 1;
		if (zunglq_(interp, &i__1, &i__2, &i__3, &a[(a_dim1 << 1) + 2], lda, &tau[			1], &work[1], lwork, &iinfo)!=TCL_OK) { return TCL_ERROR; }


	    }
	}
    }
    work[1].r = (doublereal) lwkopt, work[1].i = 0.;
return TCL_OK;


} /* zungbr_ */
static /* Subroutine */ int zunmbr_ (Tcl_Interp *interp, char *vect, char *side, char *trans, integer *m, 	integer *n, integer *k, doublecomplex *a, integer *lda, doublecomplex 	*tau, doublecomplex *c__, integer *ldc, doublecomplex *work, integer *	lwork, integer *info)
{
    address a__1[2];
    integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2];
    char ch__1[2];

    /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);

    integer i1, i2, nb, mi, ni, nq, nw;
    logical left;
    integer iinfo;
    logical notran, applyq;
    char transt[1];
    integer lwkopt;
    logical lquery;






























    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --tau;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;
    --work;

    *info = 0;
    applyq = lsame_(vect, "Q");
    left = lsame_(side, "L");
    notran = lsame_(trans, "N");
    lquery = *lwork == -1;


    if (left) {
	nq = *m;
	nw = *n;
    } else {
	nq = *n;
	nw = *m;
    }
    if (*m == 0 || *n == 0) {
	nw = 0;
    }
    if (! applyq && ! lsame_(vect, "P")) {
	*info = -1;
    } else if (! left && ! lsame_(side, "R")) {
	*info = -2;
    } else if (! notran && ! lsame_(trans, "C")) {
	*info = -3;
    } else if (*m < 0) {
	*info = -4;
    } else if (*n < 0) {
	*info = -5;
    } else if (*k < 0) {
	*info = -6;
    } else /* if(complicated condition) */ {
	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 (nw > 0) {
	    if (applyq) {
		if (left) {
		    i__3[0] = 1, a__1[0] = side;
		    i__3[1] = 1, a__1[1] = trans;
		    s_cat(ch__1, a__1, i__3, &zunmbr_c__2, (ftnlen)2);
		    i__1 = *m - 1;
		    i__2 = *m - 1;
		    nb = ilaenv_(&zunmbr_c__1, "ZUNMQR", ch__1, &i__1, n, &i__2, &
			    zunmbr_c_n1);
		} else {
		    i__3[0] = 1, a__1[0] = side;
		    i__3[1] = 1, a__1[1] = trans;
		    s_cat(ch__1, a__1, i__3, &zunmbr_c__2, (ftnlen)2);
		    i__1 = *n - 1;
		    i__2 = *n - 1;
		    nb = ilaenv_(&zunmbr_c__1, "ZUNMQR", ch__1, m, &i__1, &i__2, &
			    zunmbr_c_n1);
		}
	    } else {
		if (left) {
		    i__3[0] = 1, a__1[0] = side;
		    i__3[1] = 1, a__1[1] = trans;
		    s_cat(ch__1, a__1, i__3, &zunmbr_c__2, (ftnlen)2);
		    i__1 = *m - 1;
		    i__2 = *m - 1;
		    nb = ilaenv_(&zunmbr_c__1, "ZUNMLQ", ch__1, &i__1, n, &i__2, &
			    zunmbr_c_n1);
		} else {
		    i__3[0] = 1, a__1[0] = side;
		    i__3[1] = 1, a__1[1] = trans;
		    s_cat(ch__1, a__1, i__3, &zunmbr_c__2, (ftnlen)2);
		    i__1 = *n - 1;
		    i__2 = *n - 1;
		    nb = ilaenv_(&zunmbr_c__1, "ZUNMLQ", ch__1, m, &i__1, &i__2, &
			    zunmbr_c_n1);
		}
	    }
	    i__1 = 1, i__2 = nw * nb;
	    lwkopt = max(i__1,i__2);
	} else {
	    lwkopt = 1;
	}
	work[1].r = (doublereal) lwkopt, work[1].i = 0.;
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "ZUNMBR", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


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

    if (applyq) {


	if (nq >= *k) {


	    if (zunmqr_(interp, side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[		    c_offset], ldc, &work[1], lwork, &iinfo)!=TCL_OK) { return TCL_ERROR; }


	} else if (nq > 1) {


	    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;
	    if (zunmqr_(interp, side, trans, &mi, &ni, &i__1, &a[a_dim1 + 2], lda, &tau[1], &c__[i1 + i2 * c_dim1], ldc, &work[1], lwork, &iinfo)!=TCL_OK) { return TCL_ERROR; }


	}
    } else {


	if (notran) {
	    *(unsigned char *)transt = 'C';
	} else {
	    *(unsigned char *)transt = 'N';
	}
	if (nq > *k) {


	    if (zunmlq_(interp, side, transt, m, n, k, &a[a_offset], lda, &tau[1], &c__[		    c_offset], ldc, &work[1], lwork, &iinfo)!=TCL_OK) { return TCL_ERROR; }


	} else if (nq > 1) {


	    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;
	    if (zunmlq_(interp, side, transt, &mi, &ni, &i__1, &a[(a_dim1 << 1) + 1], lda, 		     &tau[1], &c__[i1 + i2 * c_dim1], ldc, &work[1], lwork, &
		    iinfo)!=TCL_OK) { return TCL_ERROR; }


	}
    }
    work[1].r = (doublereal) lwkopt, work[1].i = 0.;
return TCL_OK;


} /* zunmbr_ */
static /* Subroutine */ int zunglq_ (Tcl_Interp *interp, integer *m, integer *n, integer *k, 	doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *	work, integer *lwork, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4;

    integer i__, j, l, ib, nb, ki, kk, nx, iws, nbmin, iinfo;
    integer ldwork;
    logical lquery;
    integer lwkopt;






















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

    *info = 0;
    nb = ilaenv_(&zunglq_c__1, "ZUNGLQ", " ", m, n, k, &zunglq_c_n1);
    lwkopt = max(1,*m) * nb;
    work[1].r = (doublereal) lwkopt, work[1].i = 0.;
    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);
	vectcl_xerbla(interp, "ZUNGLQ", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


    if (*m <= 0) {
	work[1].r = 1., work[1].i = 0.;
return TCL_OK;
    }

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


	i__1 = 0, i__2 = ilaenv_(&zunglq_c__3, "ZUNGLQ", " ", m, n, k, &zunglq_c_n1);
	nx = max(i__1,i__2);
	if (nx < *k) {


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


		nb = *lwork / ldwork;
		i__1 = 2, i__2 = ilaenv_(&zunglq_c__2, "ZUNGLQ", " ", m, n, k, &zunglq_c_n1);
		nbmin = max(i__1,i__2);
	    }
	}
    }

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


	ki = (*k - nx - 1) / nb * nb;
	i__1 = *k, i__2 = ki + nb;
	kk = min(i__1,i__2);


	i__1 = kk;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *m;
	    for (i__ = kk + 1; i__ <= i__2; ++i__) {
		i__3 = i__ + j * a_dim1;
		a[i__3].r = 0., a[i__3].i = 0.;
	    }
	}
    } else {
	kk = 0;
    }


    if (kk < *m) {
	i__1 = *m - kk;
	i__2 = *n - kk;
	i__3 = *k - kk;
	if (zungl2_(interp, &i__1, &i__2, &i__3, &a[kk + 1 + (kk + 1) * a_dim1], lda, &		tau[kk + 1], &work[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }


    }

    if (kk > 0) {


	i__1 = -nb;
	for (i__ = ki + 1; i__1 < 0 ? i__ >= 1 : i__ <= 1; i__ += i__1) {
	    i__2 = nb, i__3 = *k - i__ + 1;
	    ib = min(i__2,i__3);
	    if (i__ + ib <= *m) {


		i__2 = *n - i__ + 1;
		if (zlarft_(interp, "Forward", "Rowwise", &i__2, &ib, &a[i__ + i__ * 			a_dim1], lda, &tau[i__], &work[1], &ldwork)!=TCL_OK) { return TCL_ERROR; }




		i__2 = *m - i__ - ib + 1;
		i__3 = *n - i__ + 1;
		if (zlarfb_(interp, "Right", "Conjugate transpose", "Forward", "Rowwise", 			&i__2, &i__3, &ib, &a[i__ + i__ * a_dim1], lda, &work[
			1], &ldwork, &a[i__ + ib + i__ * a_dim1], lda, &work[
			ib + 1], &ldwork)!=TCL_OK) { return TCL_ERROR; }


	    }


	    i__2 = *n - i__ + 1;
	    if (zungl2_(interp, &ib, &i__2, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &		    work[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }




	    i__2 = i__ - 1;
	    for (j = 1; j <= i__2; ++j) {
		i__3 = i__ + ib - 1;
		for (l = i__; l <= i__3; ++l) {
		    i__4 = l + j * a_dim1;
		    a[i__4].r = 0., a[i__4].i = 0.;
		}
	    }
	}
    }

    work[1].r = (doublereal) iws, work[1].i = 0.;
return TCL_OK;


} /* zunglq_ */
static /* Subroutine */ int zungqr_ (Tcl_Interp *interp, integer *m, integer *n, integer *k, 	doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *	work, integer *lwork, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4;

    integer i__, j, l, ib, nb, ki, kk, nx, iws, nbmin, iinfo;
    integer ldwork;
    integer lwkopt;
    logical lquery;






















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

    *info = 0;
    nb = ilaenv_(&zungqr_c__1, "ZUNGQR", " ", m, n, k, &zungqr_c_n1);
    lwkopt = max(1,*n) * nb;
    work[1].r = (doublereal) lwkopt, work[1].i = 0.;
    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);
	vectcl_xerbla(interp, "ZUNGQR", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


    if (*n <= 0) {
	work[1].r = 1., work[1].i = 0.;
return TCL_OK;
    }

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


	i__1 = 0, i__2 = ilaenv_(&zungqr_c__3, "ZUNGQR", " ", m, n, k, &zungqr_c_n1);
	nx = max(i__1,i__2);
	if (nx < *k) {


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


		nb = *lwork / ldwork;
		i__1 = 2, i__2 = ilaenv_(&zungqr_c__2, "ZUNGQR", " ", m, n, k, &zungqr_c_n1);
		nbmin = max(i__1,i__2);
	    }
	}
    }

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


	ki = (*k - nx - 1) / nb * nb;
	i__1 = *k, i__2 = ki + nb;
	kk = min(i__1,i__2);


	i__1 = *n;
	for (j = kk + 1; j <= i__1; ++j) {
	    i__2 = kk;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		i__3 = i__ + j * a_dim1;
		a[i__3].r = 0., a[i__3].i = 0.;
	    }
	}
    } else {
	kk = 0;
    }


    if (kk < *n) {
	i__1 = *m - kk;
	i__2 = *n - kk;
	i__3 = *k - kk;
	if (zung2r_(interp, &i__1, &i__2, &i__3, &a[kk + 1 + (kk + 1) * a_dim1], lda, &		tau[kk + 1], &work[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }


    }

    if (kk > 0) {


	i__1 = -nb;
	for (i__ = ki + 1; i__1 < 0 ? i__ >= 1 : i__ <= 1; i__ += i__1) {
	    i__2 = nb, i__3 = *k - i__ + 1;
	    ib = min(i__2,i__3);
	    if (i__ + ib <= *n) {


		i__2 = *m - i__ + 1;
		if (zlarft_(interp, "Forward", "Columnwise", &i__2, &ib, &a[i__ + i__ * 			a_dim1], lda, &tau[i__], &work[1], &ldwork)!=TCL_OK) { return TCL_ERROR; }




		i__2 = *m - i__ + 1;
		i__3 = *n - i__ - ib + 1;
		if (zlarfb_(interp, "Left", "No transpose", "Forward", "Columnwise", &			i__2, &i__3, &ib, &a[i__ + i__ * a_dim1], lda, &work[
			1], &ldwork, &a[i__ + (i__ + ib) * a_dim1], lda, &
			work[ib + 1], &ldwork)!=TCL_OK) { return TCL_ERROR; }


	    }


	    i__2 = *m - i__ + 1;
	    if (zung2r_(interp, &i__2, &ib, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &		    work[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }




	    i__2 = i__ + ib - 1;
	    for (j = i__; j <= i__2; ++j) {
		i__3 = i__ - 1;
		for (l = 1; l <= i__3; ++l) {
		    i__4 = l + j * a_dim1;
		    a[i__4].r = 0., a[i__4].i = 0.;
		}
	    }
	}
    }

    work[1].r = (doublereal) iws, work[1].i = 0.;
return TCL_OK;


} /* zungqr_ */
static /* Subroutine */ int dscal_ (Tcl_Interp *interp, integer *n, doublereal *da, doublereal *dx, 	integer *incx)
{
    integer i__1, i__2;

    integer i__, m, mp1, nincx;




    --dx;

    if (*n <= 0 || *incx <= 0) {
return TCL_OK;
    }
    if (*incx == 1) {
	goto L20;
    }


    nincx = *n * *incx;
    i__1 = nincx;
    i__2 = *incx;
    for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
	dx[i__] = *da * dx[i__];
    }
return TCL_OK;




L20:
    m = *n % 5;
    if (m == 0) {
	goto L40;
    }
    i__2 = m;
    for (i__ = 1; i__ <= i__2; ++i__) {
	dx[i__] = *da * dx[i__];
    }
    if (*n < 5) {
return TCL_OK;
    }
L40:
    mp1 = m + 1;
    i__2 = *n;
    for (i__ = mp1; i__ <= i__2; i__ += 5) {
	dx[i__] = *da * dx[i__];
	dx[i__ + 1] = *da * dx[i__ + 1];
	dx[i__ + 2] = *da * dx[i__ + 2];
	dx[i__ + 3] = *da * dx[i__ + 3];
	dx[i__ + 4] = *da * dx[i__ + 4];
    }
return TCL_OK;
} /* dscal_ */
static /* Subroutine */ int dcopy_ (Tcl_Interp *interp, integer *n, doublereal *dx, integer *incx, 	doublereal *dy, integer *incy)
{
    integer i__1;

    integer i__, m, ix, iy, mp1;





    --dy;
    --dx;

    if (*n <= 0) {
return TCL_OK;
    }
    if (*incx == 1 && *incy == 1) {
	goto L20;
    }


    ix = 1;
    iy = 1;
    if (*incx < 0) {
	ix = (-(*n) + 1) * *incx + 1;
    }
    if (*incy < 0) {
	iy = (-(*n) + 1) * *incy + 1;
    }
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	dy[iy] = dx[ix];
	ix += *incx;
	iy += *incy;
    }
return TCL_OK;




L20:
    m = *n % 7;
    if (m == 0) {
	goto L40;
    }
    i__1 = m;
    for (i__ = 1; i__ <= i__1; ++i__) {
	dy[i__] = dx[i__];
    }
    if (*n < 7) {
return TCL_OK;
    }
L40:
    mp1 = m + 1;
    i__1 = *n;
    for (i__ = mp1; i__ <= i__1; i__ += 7) {
	dy[i__] = dx[i__];
	dy[i__ + 1] = dx[i__ + 1];
	dy[i__ + 2] = dx[i__ + 2];
	dy[i__ + 3] = dx[i__ + 3];
	dy[i__ + 4] = dx[i__ + 4];
	dy[i__ + 5] = dx[i__ + 5];
	dy[i__ + 6] = dx[i__ + 6];
    }
return TCL_OK;
} /* dcopy_ */
static /* Subroutine */ int dswap_ (Tcl_Interp *interp, integer *n, doublereal *dx, integer *incx, 	doublereal *dy, integer *incy)
{
    integer i__1;

    integer i__, m, ix, iy, mp1;
    doublereal dtemp;





    --dy;
    --dx;

    if (*n <= 0) {
return TCL_OK;
    }
    if (*incx == 1 && *incy == 1) {
	goto L20;
    }


    ix = 1;
    iy = 1;
    if (*incx < 0) {
	ix = (-(*n) + 1) * *incx + 1;
    }
    if (*incy < 0) {
	iy = (-(*n) + 1) * *incy + 1;
    }
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	dtemp = dx[ix];
	dx[ix] = dy[iy];
	dy[iy] = dtemp;
	ix += *incx;
	iy += *incy;
    }
return TCL_OK;




L20:
    m = *n % 3;
    if (m == 0) {
	goto L40;
    }
    i__1 = m;
    for (i__ = 1; i__ <= i__1; ++i__) {
	dtemp = dx[i__];
	dx[i__] = dy[i__];
	dy[i__] = dtemp;
    }
    if (*n < 3) {
return TCL_OK;
    }
L40:
    mp1 = m + 1;
    i__1 = *n;
    for (i__ = mp1; i__ <= i__1; i__ += 3) {
	dtemp = dx[i__];
	dx[i__] = dy[i__];
	dy[i__] = dtemp;
	dtemp = dx[i__ + 1];
	dx[i__ + 1] = dy[i__ + 1];
	dy[i__ + 1] = dtemp;
	dtemp = dx[i__ + 2];
	dx[i__ + 2] = dy[i__ + 2];
	dy[i__ + 2] = dtemp;
    }
return TCL_OK;
} /* dswap_ */
static /* Subroutine */ int dstein_ (Tcl_Interp *interp, integer *n, doublereal *d__, doublereal *e, 	integer *m, doublereal *w, integer *iblock, integer *isplit, 	doublereal *z__, integer *ldz, doublereal *work, integer *iwork, 	integer *ifail, integer *info)
{
    integer z_dim1, z_offset, i__1, i__2, i__3;
    doublereal d__1, d__2, d__3, d__4, d__5;

    double sqrt(doublereal);

    integer i__, j, b1, j1, bn;
    doublereal xj, scl, eps, sep, nrm, tol;
    integer its;
    doublereal xjm, ztr, eps1;
    integer jblk, nblk;
    integer jmax;
    integer iseed[4], gpind, iinfo;
    doublereal ortol;
    integer indrv1, indrv2, indrv3, indrv4, indrv5;
    integer nrmchk;
    integer blksiz;
    doublereal onenrm, dtpcrt, pertol;



























    --d__;
    --e;
    --w;
    --iblock;
    --isplit;
    z_dim1 = *ldz;
    z_offset = 1 + z_dim1;
    z__ -= z_offset;
    --work;
    --iwork;
    --ifail;

    *info = 0;
    i__1 = *m;
    for (i__ = 1; i__ <= i__1; ++i__) {
	ifail[i__] = 0;
    }

    if (*n < 0) {
	*info = -1;
    } else if (*m < 0 || *m > *n) {
	*info = -4;
    } else if (*ldz < max(1,*n)) {
	*info = -9;
    } else {
	i__1 = *m;
	for (j = 2; j <= i__1; ++j) {
	    if (iblock[j] < iblock[j - 1]) {
		*info = -6;
		goto L30;
	    }
	    if (iblock[j] == iblock[j - 1] && w[j] < w[j - 1]) {
		*info = -5;
		goto L30;
	    }
	}
L30:
	;
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DSTEIN", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


    if (*n == 0 || *m == 0) {
return TCL_OK;
    } else if (*n == 1) {
	z__[z_dim1 + 1] = 1.;
return TCL_OK;
    }


    eps = dlamch_("Precision");


    for (i__ = 1; i__ <= 4; ++i__) {
	iseed[i__ - 1] = 1;
    }


    indrv1 = 0;
    indrv2 = indrv1 + *n;
    indrv3 = indrv2 + *n;
    indrv4 = indrv3 + *n;
    indrv5 = indrv4 + *n;


    j1 = 1;
    i__1 = iblock[*m];
    for (nblk = 1; nblk <= i__1; ++nblk) {


	if (nblk == 1) {
	    b1 = 1;
	} else {
	    b1 = isplit[nblk - 1] + 1;
	}
	bn = isplit[nblk];
	blksiz = bn - b1 + 1;
	if (blksiz == 1) {
	    goto L60;
	}
	gpind = b1;


	onenrm = (d__1 = d__[b1], abs(d__1)) + (d__2 = e[b1], abs(d__2));
	d__3 = onenrm, d__4 = (d__1 = d__[bn], abs(d__1)) + (d__2 = e[bn - 1],
		 abs(d__2));
	onenrm = max(d__3,d__4);
	i__2 = bn - 1;
	for (i__ = b1 + 1; i__ <= i__2; ++i__) {
	    d__4 = onenrm, d__5 = (d__1 = d__[i__], abs(d__1)) + (d__2 = e[
		    i__ - 1], abs(d__2)) + (d__3 = e[i__], abs(d__3));
	    onenrm = max(d__4,d__5);
	}
	ortol = onenrm * .001;

	dtpcrt = sqrt(.1 / blksiz);


L60:
	jblk = 0;
	i__2 = *m;
	for (j = j1; j <= i__2; ++j) {
	    if (iblock[j] != nblk) {
		j1 = j;
		goto L160;
	    }
	    ++jblk;
	    xj = w[j];


	    if (blksiz == 1) {
		work[indrv1 + 1] = 1.;
		goto L120;
	    }


	    if (jblk > 1) {
		eps1 = (d__1 = eps * xj, abs(d__1));
		pertol = eps1 * 10.;
		sep = xj - xjm;
		if (sep < pertol) {
		    xj = xjm + pertol;
		}
	    }

	    its = 0;
	    nrmchk = 0;


	    if (dlarnv_(interp, &dstein_c__2, iseed, &blksiz, &work[indrv1 + 1])!=TCL_OK) { return TCL_ERROR; }



	    if (dcopy_(interp, &blksiz, &d__[b1], &dstein_c__1, &work[indrv4 + 1], &dstein_c__1)!=TCL_OK) { return TCL_ERROR; }

	    i__3 = blksiz - 1;
	    if (dcopy_(interp, &i__3, &e[b1], &dstein_c__1, &work[indrv2 + 2], &dstein_c__1)!=TCL_OK) { return TCL_ERROR; }

	    i__3 = blksiz - 1;
	    if (dcopy_(interp, &i__3, &e[b1], &dstein_c__1, &work[indrv3 + 1], &dstein_c__1)!=TCL_OK) { return TCL_ERROR; }



	    tol = 0.;
	    if (dlagtf_(interp, &blksiz, &work[indrv4 + 1], &xj, &work[indrv2 + 2], &work[		    indrv3 + 1], &tol, &work[indrv5 + 1], &iwork[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }




L70:
	    ++its;
	    if (its > 5) {
		goto L100;
	    }


	    d__2 = eps, d__3 = (d__1 = work[indrv4 + blksiz], abs(d__1));
	    scl = blksiz * onenrm * max(d__2,d__3) / dasum_(&blksiz, &work[
		    indrv1 + 1], &dstein_c__1);
	    if (dscal_(interp, &blksiz, &scl, &work[indrv1 + 1], &dstein_c__1)!=TCL_OK) { return TCL_ERROR; }



	    if (dlagts_(interp, &dstein_c_n1, &blksiz, &work[indrv4 + 1], &work[indrv2 + 2], &		    work[indrv3 + 1], &work[indrv5 + 1], &iwork[1], &work[
		    indrv1 + 1], &tol, &iinfo)!=TCL_OK) { return TCL_ERROR; }




	    if (jblk == 1) {
		goto L90;
	    }
	    if ((d__1 = xj - xjm, abs(d__1)) > ortol) {
		gpind = j;
	    }
	    if (gpind != j) {
		i__3 = j - 1;
		for (i__ = gpind; i__ <= i__3; ++i__) {
		    ztr = -ddot_(&blksiz, &work[indrv1 + 1], &dstein_c__1, &z__[b1 + 
			    i__ * z_dim1], &dstein_c__1);
		    if (daxpy_(interp, &blksiz, &ztr, &z__[b1 + i__ * z_dim1], &dstein_c__1, &			    work[indrv1 + 1], &dstein_c__1)!=TCL_OK) { return TCL_ERROR; }


		}
	    }


L90:
	    jmax = idamax_(&blksiz, &work[indrv1 + 1], &dstein_c__1);
	    nrm = (d__1 = work[indrv1 + jmax], abs(d__1));


	    if (nrm < dtpcrt) {
		goto L70;
	    }
	    ++nrmchk;
	    if (nrmchk < 3) {
		goto L70;
	    }

	    goto L110;


L100:
	    ++(*info);
	    ifail[*info] = j;


L110:
	    scl = 1. / dnrm2_(&blksiz, &work[indrv1 + 1], &dstein_c__1);
	    jmax = idamax_(&blksiz, &work[indrv1 + 1], &dstein_c__1);
	    if (work[indrv1 + jmax] < 0.) {
		scl = -scl;
	    }
	    if (dscal_(interp, &blksiz, &scl, &work[indrv1 + 1], &dstein_c__1)!=TCL_OK) { return TCL_ERROR; }

L120:
	    i__3 = *n;
	    for (i__ = 1; i__ <= i__3; ++i__) {
		z__[i__ + j * z_dim1] = 0.;
	    }
	    i__3 = blksiz;
	    for (i__ = 1; i__ <= i__3; ++i__) {
		z__[b1 + i__ - 1 + j * z_dim1] = work[indrv1 + i__];
	    }


	    xjm = xj;

	}
L160:
	;
    }

return TCL_OK;


} /* dstein_ */
static /* Subroutine */ int dsterf_ (Tcl_Interp *interp, integer *n, doublereal *d__, doublereal *e, 	integer *info)
{
    integer i__1;
    doublereal d__1, d__2, d__3;

    double sqrt(doublereal), d_sign(doublereal *, doublereal *);

    doublereal c__;
    integer i__, l, m;
    doublereal p, r__, s;
    integer l1;
    doublereal bb, rt1, rt2, eps, rte;
    integer lsv;
    doublereal eps2, oldc;
    integer lend, jtot;
    doublereal gamma, alpha, sigma, anorm;
    integer iscale;
    doublereal oldgam, safmin;
    doublereal safmax;
    integer lendsv;
    doublereal ssfmin;
    integer nmaxit;
    doublereal ssfmax;














    --e;
    --d__;

    *info = 0;


    if (*n < 0) {
	*info = -1;
	i__1 = -(*info);
	vectcl_xerbla(interp, "DSTERF", &i__1);
return TCL_ERROR;

return TCL_OK;
    }
    if (*n <= 1) {
return TCL_OK;
    }


    eps = dlamch_("E");
    d__1 = eps;
    eps2 = d__1 * d__1;
    safmin = dlamch_("S");
    safmax = 1. / safmin;
    ssfmax = sqrt(safmax) / 3.;
    ssfmin = sqrt(safmin) / eps2;


    nmaxit = *n * 30;
    sigma = 0.;
    jtot = 0;


    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], abs(d__3)) <= sqrt((d__1 = d__[m], abs(d__1))) * 
		sqrt((d__2 = d__[m + 1], abs(d__2))) * eps) {
	    e[m] = 0.;
	    goto L30;
	}
    }
    m = *n;

L30:
    l = l1;
    lsv = l;
    lend = m;
    lendsv = lend;
    l1 = m + 1;
    if (lend == l) {
	goto L10;
    }


    i__1 = lend - l + 1;
    anorm = dlanst_("I", &i__1, &d__[l], &e[l]);
    iscale = 0;
    if (anorm > ssfmax) {
	iscale = 1;
	i__1 = lend - l + 1;
	if (dlascl_(interp, "G", &dsterf_c__0, &dsterf_c__0, &anorm, &ssfmax, &i__1, &dsterf_c__1, &d__[l], n, 		info)!=TCL_OK) { return TCL_ERROR; }


	i__1 = lend - l;
	if (dlascl_(interp, "G", &dsterf_c__0, &dsterf_c__0, &anorm, &ssfmax, &i__1, &dsterf_c__1, &e[l], n, 		info)!=TCL_OK) { return TCL_ERROR; }


    } else if (anorm < ssfmin) {
	iscale = 2;
	i__1 = lend - l + 1;
	if (dlascl_(interp, "G", &dsterf_c__0, &dsterf_c__0, &anorm, &ssfmin, &i__1, &dsterf_c__1, &d__[l], n, 		info)!=TCL_OK) { return TCL_ERROR; }


	i__1 = lend - l;
	if (dlascl_(interp, "G", &dsterf_c__0, &dsterf_c__0, &anorm, &ssfmin, &i__1, &dsterf_c__1, &e[l], n, 		info)!=TCL_OK) { return TCL_ERROR; }


    }

    i__1 = lend - 1;
    for (i__ = l; i__ <= i__1; ++i__) {
	d__1 = e[i__];
	e[i__] = d__1 * d__1;
    }


    if ((d__1 = d__[lend], abs(d__1)) < (d__2 = d__[l], abs(d__2))) {
	lend = lsv;
	l = lendsv;
    }

    if (lend >= l) {



L50:
	if (l != lend) {
	    i__1 = lend - 1;
	    for (m = l; m <= i__1; ++m) {
		if ((d__2 = e[m], abs(d__2)) <= eps2 * (d__1 = d__[m] * d__[m 
			+ 1], abs(d__1))) {
		    goto L70;
		}
	    }
	}
	m = lend;

L70:
	if (m < lend) {
	    e[m] = 0.;
	}
	p = d__[l];
	if (m == l) {
	    goto L90;
	}


	if (m == l + 1) {
	    rte = sqrt(e[l]);
	    if (dlae2_(interp, &d__[l], &rte, &d__[l + 1], &rt1, &rt2)!=TCL_OK) { return TCL_ERROR; }

	    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;


	rte = sqrt(e[l]);
	sigma = (d__[l + 1] - p) / (rte * 2.);
	r__ = dlapy2_(&sigma, &dsterf_c_b32);
	sigma = p - rte / (sigma + d_sign(&r__, &sigma));

	c__ = 1.;
	s = 0.;
	gamma = d__[m] - sigma;
	p = gamma * gamma;


	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;
	    }
	}

	e[l] = s * p;
	d__[l] = sigma + gamma;
	goto L50;


L90:
	d__[l] = p;

	++l;
	if (l <= lend) {
	    goto L50;
	}
	goto L150;

    } else {



L100:
	i__1 = lend + 1;
	for (m = l; m >= i__1; --m) {
	    if ((d__2 = e[m - 1], abs(d__2)) <= eps2 * (d__1 = d__[m] * d__[m 
		    - 1], abs(d__1))) {
		goto L120;
	    }
	}
	m = lend;

L120:
	if (m > lend) {
	    e[m - 1] = 0.;
	}
	p = d__[l];
	if (m == l) {
	    goto L140;
	}


	if (m == l - 1) {
	    rte = sqrt(e[l - 1]);
	    if (dlae2_(interp, &d__[l], &rte, &d__[l - 1], &rt1, &rt2)!=TCL_OK) { return TCL_ERROR; }

	    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;


	rte = sqrt(e[l - 1]);
	sigma = (d__[l - 1] - p) / (rte * 2.);
	r__ = dlapy2_(&sigma, &dsterf_c_b32);
	sigma = p - rte / (sigma + d_sign(&r__, &sigma));

	c__ = 1.;
	s = 0.;
	gamma = d__[m] - sigma;
	p = gamma * gamma;


	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;
	    }
	}

	e[l - 1] = s * p;
	d__[l] = sigma + gamma;
	goto L100;


L140:
	d__[l] = p;

	--l;
	if (l >= lend) {
	    goto L100;
	}
	goto L150;

    }


L150:
    if (iscale == 1) {
	i__1 = lendsv - lsv + 1;
	if (dlascl_(interp, "G", &dsterf_c__0, &dsterf_c__0, &ssfmax, &anorm, &i__1, &dsterf_c__1, &d__[lsv], 		n, info)!=TCL_OK) { return TCL_ERROR; }


    }
    if (iscale == 2) {
	i__1 = lendsv - lsv + 1;
	if (dlascl_(interp, "G", &dsterf_c__0, &dsterf_c__0, &ssfmin, &anorm, &i__1, &dsterf_c__1, &d__[lsv], 		n, info)!=TCL_OK) { return TCL_ERROR; }


    }


    if (jtot < nmaxit) {
	goto L10;
    }
    i__1 = *n - 1;
    for (i__ = 1; i__ <= i__1; ++i__) {
	if (e[i__] != 0.) {
	    ++(*info);
	}
    }
    goto L180;


L170:
    if (dlasrt_(interp, "I", n, &d__[1], info)!=TCL_OK) { return TCL_ERROR; }


L180:
return TCL_OK;


} /* dsterf_ */
static doublereal dlansy_ (char *norm, char *uplo, integer *n, doublereal *a, integer 	*lda, doublereal *work)
{
    integer a_dim1, a_offset, i__1, i__2;
    doublereal ret_val, d__1, d__2, d__3;

    double sqrt(doublereal);

    integer i__, j;
    doublereal sum, absa, scale;
    doublereal value;



















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

    if (*n == 0) {
	value = 0.;
    } else if (lsame_(norm, "M")) {


	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__) {
		    d__2 = value, d__3 = (d__1 = a[i__ + j * a_dim1], abs(
			    d__1));
		    value = max(d__2,d__3);
		}
	    }
	} else {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = *n;
		for (i__ = j; i__ <= i__2; ++i__) {
		    d__2 = value, d__3 = (d__1 = a[i__ + j * a_dim1], abs(
			    d__1));
		    value = max(d__2,d__3);
		}
	    }
	}
    } else if (lsame_(norm, "I") || lsame_(norm, "O") || *(unsigned char *)norm == '1') {


	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[i__ + j * a_dim1], abs(d__1));
		    sum += absa;
		    work[i__] += absa;
		}
		work[j] = sum + (d__1 = a[j + j * a_dim1], abs(d__1));
	    }
	    i__1 = *n;
	    for (i__ = 1; i__ <= i__1; ++i__) {
		d__1 = value, d__2 = work[i__];
		value = max(d__1,d__2);
	    }
	} else {
	    i__1 = *n;
	    for (i__ = 1; i__ <= i__1; ++i__) {
		work[i__] = 0.;
	    }
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		sum = work[j] + (d__1 = a[j + j * a_dim1], abs(d__1));
		i__2 = *n;
		for (i__ = j + 1; i__ <= i__2; ++i__) {
		    absa = (d__1 = a[i__ + j * a_dim1], abs(d__1));
		    sum += absa;
		    work[i__] += absa;
		}
		value = max(value,sum);
	    }
	}
    } else if (lsame_(norm, "F") || lsame_(norm, "E")) {


	scale = 0.;
	sum = 1.;
	if (lsame_(uplo, "U")) {
	    i__1 = *n;
	    for (j = 2; j <= i__1; ++j) {
		i__2 = j - 1;
		dlassq_(NULL, &i__2, &a[j * a_dim1 + 1], &dlansy_c__1, &scale, &sum);
	    }
	} else {
	    i__1 = *n - 1;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = *n - j;
		dlassq_(NULL, &i__2, &a[j + 1 + j * a_dim1], &dlansy_c__1, &scale, &sum);
	    }
	}
	sum *= 2;
	i__1 = *lda + 1;
	dlassq_(NULL, n, &a[a_offset], &i__1, &scale, &sum);
	value = scale * sqrt(sum);
    }

    ret_val = value;
    return ret_val;


} /* dlansy_ */
static /* Subroutine */ int dstebz_ (Tcl_Interp *interp, char *range, char *order, integer *n, doublereal 	*vl, doublereal *vu, integer *il, integer *iu, doublereal *abstol, 	doublereal *d__, doublereal *e, integer *m, integer *nsplit, 	doublereal *w, integer *iblock, integer *isplit, doublereal *work, 	integer *iwork, integer *info)
{
    integer i__1, i__2, i__3;
    doublereal d__1, d__2, d__3, d__4, d__5;

    double sqrt(doublereal), log(doublereal);

    integer j, ib, jb, ie, je, nb;
    doublereal gl;
    integer im, in;
    doublereal gu;
    integer iw;
    doublereal wl, wu;
    integer nwl;
    doublereal ulp, wlu, wul;
    integer nwu;
    doublereal tmp1, tmp2;
    integer iend, ioff, iout, itmp1, jdisc;
    integer iinfo;
    doublereal atoli;
    integer iwoff;
    doublereal bnorm;
    integer itmax;
    doublereal wkill, rtoli, tnorm;
    integer ibegin;
    integer irange, idiscl;
    doublereal safemn;
    integer idumma[1];
    integer idiscu, iorder;
    logical ncnvrg;
    doublereal pivmin;
    logical toofew;































    --iwork;
    --work;
    --isplit;
    --iblock;
    --w;
    --e;
    --d__;

    *info = 0;


    if (lsame_(range, "A")) {
	irange = 1;
    } else if (lsame_(range, "V")) {
	irange = 2;
    } else if (lsame_(range, "I")) {
	irange = 3;
    } else {
	irange = 0;
    }


    if (lsame_(order, "B")) {
	iorder = 2;
    } else if (lsame_(order, "E")) {
	iorder = 1;
    } else {
	iorder = 0;
    }


    if (irange <= 0) {
	*info = -1;
    } else if (iorder <= 0) {
	*info = -2;
    } else if (*n < 0) {
	*info = -3;
    } else if (irange == 2) {
	if (*vl >= *vu) {
	    *info = -5;
	}
    } else if (irange == 3 && (*il < 1 || *il > max(1,*n))) {
	*info = -6;
    } else if (irange == 3 && (*iu < min(*n,*il) || *iu > *n)) {
	*info = -7;
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DSTEBZ", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


    *info = 0;
    ncnvrg = FALSE_;
    toofew = FALSE_;


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


    if (irange == 3 && *il == 1 && *iu == *n) {
	irange = 1;
    }


    safemn = dlamch_("S");
    ulp = dlamch_("P");
    rtoli = ulp * 2.;
    nb = ilaenv_(&dstebz_c__1, "DSTEBZ", " ", n, &dstebz_c_n1, &dstebz_c_n1, &dstebz_c_n1);
    if (nb <= 1) {
	nb = 0;
    }


    if (*n == 1) {
	*nsplit = 1;
	isplit[1] = 1;
	if (irange == 2 && (*vl >= d__[1] || *vu < d__[1])) {
	    *m = 0;
	} else {
	    w[1] = d__[1];
	    iblock[1] = 1;
	    *m = 1;
	}
return TCL_OK;
    }


    *nsplit = 1;
    work[*n] = 0.;
    pivmin = 1.;

    i__1 = *n;
    for (j = 2; j <= i__1; ++j) {
	d__1 = e[j - 1];
	tmp1 = d__1 * d__1;
	d__2 = ulp;
	if ((d__1 = d__[j] * d__[j - 1], abs(d__1)) * (d__2 * d__2) + safemn 
		> tmp1) {
	    isplit[*nsplit] = j - 1;
	    ++(*nsplit);
	    work[j - 1] = 0.;
	} else {
	    work[j - 1] = tmp1;
	    pivmin = max(pivmin,tmp1);
	}
    }
    isplit[*nsplit] = *n;
    pivmin *= safemn;


    if (irange == 3) {



	gu = d__[1];
	gl = d__[1];
	tmp1 = 0.;

	i__1 = *n - 1;
	for (j = 1; j <= i__1; ++j) {
	    tmp2 = sqrt(work[j]);
	    d__1 = gu, d__2 = d__[j] + tmp1 + tmp2;
	    gu = max(d__1,d__2);
	    d__1 = gl, d__2 = d__[j] - tmp1 - tmp2;
	    gl = min(d__1,d__2);
	    tmp1 = tmp2;
	}

	d__1 = gu, d__2 = d__[*n] + tmp1;
	gu = max(d__1,d__2);
	d__1 = gl, d__2 = d__[*n] - tmp1;
	gl = min(d__1,d__2);
	d__1 = abs(gl), d__2 = abs(gu);
	tnorm = max(d__1,d__2);
	gl = gl - tnorm * 2.1 * ulp * *n - pivmin * 4.2000000000000002;
	gu = gu + tnorm * 2.1 * ulp * *n + pivmin * 2.1;


	itmax = (integer) ((log(tnorm + pivmin) - log(pivmin)) / log(2.)) + 2;
	if (*abstol <= 0.) {
	    atoli = ulp * tnorm;
	} else {
	    atoli = *abstol;
	}

	work[*n + 1] = gl;
	work[*n + 2] = gl;
	work[*n + 3] = gu;
	work[*n + 4] = gu;
	work[*n + 5] = gl;
	work[*n + 6] = gu;
	iwork[1] = -1;
	iwork[2] = -1;
	iwork[3] = *n + 1;
	iwork[4] = *n + 1;
	iwork[5] = *il - 1;
	iwork[6] = *iu;

	if (dlaebz_(interp, &dstebz_c__3, &itmax, n, &dstebz_c__2, &dstebz_c__2, &nb, &atoli, &rtoli, &pivmin, 		&d__[1], &e[1], &work[1], &iwork[5], &work[*n + 1], &work[*n 
		+ 5], &iout, &iwork[1], &w[1], &iblock[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }



	if (iwork[6] == *iu) {
	    wl = work[*n + 1];
	    wlu = work[*n + 3];
	    nwl = iwork[1];
	    wu = work[*n + 4];
	    wul = work[*n + 2];
	    nwu = iwork[4];
	} else {
	    wl = work[*n + 2];
	    wlu = work[*n + 4];
	    nwl = iwork[2];
	    wu = work[*n + 3];
	    wul = work[*n + 1];
	    nwu = iwork[3];
	}

	if (nwl < 0 || nwl >= *n || nwu < 1 || nwu > *n) {
	    *info = 4;
return TCL_OK;
	}
    } else {


	d__3 = abs(d__[1]) + abs(e[1]), d__4 = (d__1 = d__[*n], abs(d__1)) + (
		d__2 = e[*n - 1], abs(d__2));
	tnorm = max(d__3,d__4);

	i__1 = *n - 1;
	for (j = 2; j <= i__1; ++j) {
	    d__4 = tnorm, d__5 = (d__1 = d__[j], abs(d__1)) + (d__2 = e[j - 1]
		    , abs(d__2)) + (d__3 = e[j], abs(d__3));
	    tnorm = max(d__4,d__5);
	}

	if (*abstol <= 0.) {
	    atoli = ulp * tnorm;
	} else {
	    atoli = *abstol;
	}

	if (irange == 2) {
	    wl = *vl;
	    wu = *vu;
	} else {
	    wl = 0.;
	    wu = 0.;
	}
    }


    *m = 0;
    iend = 0;
    *info = 0;
    nwl = 0;
    nwu = 0;

    i__1 = *nsplit;
    for (jb = 1; jb <= i__1; ++jb) {
	ioff = iend;
	ibegin = ioff + 1;
	iend = isplit[jb];
	in = iend - ioff;

	if (in == 1) {


	    if (irange == 1 || wl >= d__[ibegin] - pivmin) {
		++nwl;
	    }
	    if (irange == 1 || wu >= d__[ibegin] - pivmin) {
		++nwu;
	    }
	    if (irange == 1 || wl < d__[ibegin] - pivmin && wu >= d__[ibegin] 
		    - pivmin) {
		++(*m);
		w[*m] = d__[ibegin];
		iblock[*m] = jb;
	    }
	} else {



	    gu = d__[ibegin];
	    gl = d__[ibegin];
	    tmp1 = 0.;

	    i__2 = iend - 1;
	    for (j = ibegin; j <= i__2; ++j) {
		tmp2 = (d__1 = e[j], abs(d__1));
		d__1 = gu, d__2 = d__[j] + tmp1 + tmp2;
		gu = max(d__1,d__2);
		d__1 = gl, d__2 = d__[j] - tmp1 - tmp2;
		gl = min(d__1,d__2);
		tmp1 = tmp2;
	    }

	    d__1 = gu, d__2 = d__[iend] + tmp1;
	    gu = max(d__1,d__2);
	    d__1 = gl, d__2 = d__[iend] - tmp1;
	    gl = min(d__1,d__2);
	    d__1 = abs(gl), d__2 = abs(gu);
	    bnorm = max(d__1,d__2);
	    gl = gl - bnorm * 2.1 * ulp * in - pivmin * 2.1;
	    gu = gu + bnorm * 2.1 * ulp * in + pivmin * 2.1;


	    if (*abstol <= 0.) {
		d__1 = abs(gl), d__2 = abs(gu);
		atoli = ulp * max(d__1,d__2);
	    } else {
		atoli = *abstol;
	    }

	    if (irange > 1) {
		if (gu < wl) {
		    nwl += in;
		    nwu += in;
		    goto L70;
		}
		gl = max(gl,wl);
		gu = min(gu,wu);
		if (gl >= gu) {
		    goto L70;
		}
	    }


	    work[*n + 1] = gl;
	    work[*n + in + 1] = gu;
	    if (dlaebz_(interp, &dstebz_c__1, &dstebz_c__0, &in, &in, &dstebz_c__1, &nb, &atoli, &rtoli, &		    pivmin, &d__[ibegin], &e[ibegin], &work[ibegin], idumma, &
		    work[*n + 1], &work[*n + (in << 1) + 1], &im, &iwork[1], &
		    w[*m + 1], &iblock[*m + 1], &iinfo)!=TCL_OK) { return TCL_ERROR; }



	    nwl += iwork[1];
	    nwu += iwork[in + 1];
	    iwoff = *m - iwork[1];


	    itmax = (integer) ((log(gu - gl + pivmin) - log(pivmin)) / log(2.)
		    ) + 2;
	    if (dlaebz_(interp, &dstebz_c__2, &itmax, &in, &in, &dstebz_c__1, &nb, &atoli, &rtoli, &		    pivmin, &d__[ibegin], &e[ibegin], &work[ibegin], idumma, &
		    work[*n + 1], &work[*n + (in << 1) + 1], &iout, &iwork[1], 
		     &w[*m + 1], &iblock[*m + 1], &iinfo)!=TCL_OK) { return TCL_ERROR; }




	    i__2 = iout;
	    for (j = 1; j <= i__2; ++j) {
		tmp1 = (work[j + *n] + work[j + in + *n]) * .5;


		if (j > iout - iinfo) {
		    ncnvrg = TRUE_;
		    ib = -jb;
		} else {
		    ib = jb;
		}
		i__3 = iwork[j + in] + iwoff;
		for (je = iwork[j] + 1 + iwoff; je <= i__3; ++je) {
		    w[je] = tmp1;
		    iblock[je] = ib;
		}
	    }

	    *m += im;
	}
L70:
	;
    }


    if (irange == 3) {
	im = 0;
	idiscl = *il - 1 - nwl;
	idiscu = nwu - *iu;

	if (idiscl > 0 || idiscu > 0) {
	    i__1 = *m;
	    for (je = 1; je <= i__1; ++je) {
		if (w[je] <= wlu && idiscl > 0) {
		    --idiscl;
		} else if (w[je] >= wul && idiscu > 0) {
		    --idiscu;
		} else {
		    ++im;
		    w[im] = w[je];
		    iblock[im] = iblock[je];
		}
	    }
	    *m = im;
	}
	if (idiscl > 0 || idiscu > 0) {



	    if (idiscl > 0) {
		wkill = wu;
		i__1 = idiscl;
		for (jdisc = 1; jdisc <= i__1; ++jdisc) {
		    iw = 0;
		    i__2 = *m;
		    for (je = 1; je <= i__2; ++je) {
			if (iblock[je] != 0 && (w[je] < wkill || iw == 0)) {
			    iw = je;
			    wkill = w[je];
			}
		    }
		    iblock[iw] = 0;
		}
	    }
	    if (idiscu > 0) {

		wkill = wl;
		i__1 = idiscu;
		for (jdisc = 1; jdisc <= i__1; ++jdisc) {
		    iw = 0;
		    i__2 = *m;
		    for (je = 1; je <= i__2; ++je) {
			if (iblock[je] != 0 && (w[je] > wkill || iw == 0)) {
			    iw = je;
			    wkill = w[je];
			}
		    }
		    iblock[iw] = 0;
		}
	    }
	    im = 0;
	    i__1 = *m;
	    for (je = 1; je <= i__1; ++je) {
		if (iblock[je] != 0) {
		    ++im;
		    w[im] = w[je];
		    iblock[im] = iblock[je];
		}
	    }
	    *m = im;
	}
	if (idiscl < 0 || idiscu < 0) {
	    toofew = TRUE_;
	}
    }


    if (iorder == 1 && *nsplit > 1) {
	i__1 = *m - 1;
	for (je = 1; je <= i__1; ++je) {
	    ie = 0;
	    tmp1 = w[je];
	    i__2 = *m;
	    for (j = je + 1; j <= i__2; ++j) {
		if (w[j] < tmp1) {
		    ie = j;
		    tmp1 = w[j];
		}
	    }

	    if (ie != 0) {
		itmp1 = iblock[ie];
		w[ie] = w[je];
		iblock[ie] = iblock[je];
		w[je] = tmp1;
		iblock[je] = itmp1;
	    }
	}
    }

    *info = 0;
    if (ncnvrg) {
	++(*info);
    }
    if (toofew) {
	*info += 2;
    }
return TCL_OK;


} /* dstebz_ */
static /* Subroutine */ int dstemr_ (Tcl_Interp *interp, char *jobz, char *range, integer *n, doublereal *	d__, doublereal *e, doublereal *vl, doublereal *vu, integer *il, 	integer *iu, integer *m, doublereal *w, doublereal *z__, integer *ldz, 	 integer *nzc, integer *isuppz, logical *tryrac, doublereal *work, 	integer *lwork, integer *iwork, integer *liwork, integer *info)
{
    integer z_dim1, z_offset, i__1, i__2;
    doublereal d__1, d__2;

    double sqrt(doublereal);

    integer i__, j;
    doublereal r1, r2;
    integer jj;
    doublereal cs;
    integer in;
    doublereal sn, wl, wu;
    integer iil, iiu;
    doublereal eps, tmp;
    integer indd, iend, jblk, wend;
    doublereal rmin, rmax;
    integer itmp;
    doublereal tnrm;
    integer inde2, itmp2;
    doublereal rtol1, rtol2;
    doublereal scale;
    integer indgp;
    integer iinfo, iindw, ilast;
    integer lwmin;
    logical wantz;
    logical alleig;
    integer ibegin;
    logical indeig;
    integer iindbl;
    logical valeig;
    integer wbegin;
    doublereal safmin;
    doublereal bignum;
    integer inderr, iindwk, indgrs, offset;
    doublereal thresh;
    integer iinspl, ifirst, indwrk, liwmin, nzcmin;
    doublereal pivmin;
    integer nsplit;
    doublereal smlnum;
    logical lquery, zquery;





































    --d__;
    --e;
    --w;
    z_dim1 = *ldz;
    z_offset = 1 + z_dim1;
    z__ -= z_offset;
    --isuppz;
    --work;
    --iwork;

    wantz = lsame_(jobz, "V");
    alleig = lsame_(range, "A");
    valeig = lsame_(range, "V");
    indeig = lsame_(range, "I");

    lquery = *lwork == -1 || *liwork == -1;
    zquery = *nzc == -1;
    if (wantz) {
	lwmin = *n * 18;
	liwmin = *n * 10;
    } else {
	lwmin = *n * 12;
	liwmin = *n << 3;
    }
    wl = 0.;
    wu = 0.;
    iil = 0;
    iiu = 0;
    if (valeig) {
	wl = *vl;
	wu = *vu;
    } else if (indeig) {
	iil = *il;
	iiu = *iu;
    }

    *info = 0;
    if (! (wantz || lsame_(jobz, "N"))) {
	*info = -1;
    } else if (! (alleig || valeig || indeig)) {
	*info = -2;
    } else if (*n < 0) {
	*info = -3;
    } else if (valeig && *n > 0 && wu <= wl) {
	*info = -7;
    } else if (indeig && (iil < 1 || iil > *n)) {
	*info = -8;
    } else if (indeig && (iiu < iil || iiu > *n)) {
	*info = -9;
    } else if (*ldz < 1 || wantz && *ldz < *n) {
	*info = -13;
    } else if (*lwork < lwmin && ! lquery) {
	*info = -17;
    } else if (*liwork < liwmin && ! lquery) {
	*info = -19;
    }


    safmin = dlamch_("Safe minimum");
    eps = dlamch_("Precision");
    smlnum = safmin / eps;
    bignum = 1. / smlnum;
    rmin = sqrt(smlnum);
    d__1 = sqrt(bignum), d__2 = 1. / sqrt(sqrt(safmin));
    rmax = min(d__1,d__2);

    if (*info == 0) {
	work[1] = (doublereal) lwmin;
	iwork[1] = liwmin;

	if (wantz && alleig) {
	    nzcmin = *n;
	} else if (wantz && valeig) {
	    if (dlarrc_(interp, "T", n, vl, vu, &d__[1], &e[1], &safmin, &nzcmin, &itmp, &		    itmp2, info)!=TCL_OK) { return TCL_ERROR; }


	} else if (wantz && indeig) {
	    nzcmin = iiu - iil + 1;
	} else {
	    nzcmin = 0;
	}
	if (zquery && *info == 0) {
	    z__[z_dim1 + 1] = (doublereal) nzcmin;
	} else if (*nzc < nzcmin && ! zquery) {
	    *info = -14;
	}
    }
    if (*info != 0) {

	i__1 = -(*info);
	vectcl_xerbla(interp, "DSTEMR", &i__1);
return TCL_ERROR;


return TCL_OK;
    } else if (lquery || zquery) {
return TCL_OK;
    }


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

    if (*n == 1) {
	if (alleig || indeig) {
	    *m = 1;
	    w[1] = d__[1];
	} else {
	    if (wl < d__[1] && wu >= d__[1]) {
		*m = 1;
		w[1] = d__[1];
	    }
	}
	if (wantz && ! zquery) {
	    z__[z_dim1 + 1] = 1.;
	    isuppz[1] = 1;
	    isuppz[2] = 1;
	}
return TCL_OK;
    }

    if (*n == 2) {
	if (! wantz) {
	    if (dlae2_(interp, &d__[1], &e[1], &d__[2], &r1, &r2)!=TCL_OK) { return TCL_ERROR; }

	} else if (wantz && ! zquery) {
	    if (dlaev2_(interp, &d__[1], &e[1], &d__[2], &r1, &r2, &cs, &sn)!=TCL_OK) { return TCL_ERROR; }

	}
	if (alleig || valeig && r2 > wl && r2 <= wu || indeig && iil == 1) {
	    ++(*m);
	    w[*m] = r2;
	    if (wantz && ! zquery) {
		z__[*m * z_dim1 + 1] = -sn;
		z__[*m * z_dim1 + 2] = cs;
		if (sn != 0.) {
		    if (cs != 0.) {
			isuppz[(*m << 1) - 1] = 1;
			isuppz[(*m << 1) - 1] = 2;
		    } else {
			isuppz[(*m << 1) - 1] = 1;
			isuppz[(*m << 1) - 1] = 1;
		    }
		} else {
		    isuppz[(*m << 1) - 1] = 2;
		    isuppz[*m * 2] = 2;
		}
	    }
	}
	if (alleig || valeig && r1 > wl && r1 <= wu || indeig && iiu == 2) {
	    ++(*m);
	    w[*m] = r1;
	    if (wantz && ! zquery) {
		z__[*m * z_dim1 + 1] = cs;
		z__[*m * z_dim1 + 2] = sn;
		if (sn != 0.) {
		    if (cs != 0.) {
			isuppz[(*m << 1) - 1] = 1;
			isuppz[(*m << 1) - 1] = 2;
		    } else {
			isuppz[(*m << 1) - 1] = 1;
			isuppz[(*m << 1) - 1] = 1;
		    }
		} else {
		    isuppz[(*m << 1) - 1] = 2;
		    isuppz[*m * 2] = 2;
		}
	    }
	}
return TCL_OK;
    }
    indgrs = 1;
    inderr = (*n << 1) + 1;
    indgp = *n * 3 + 1;
    indd = (*n << 2) + 1;
    inde2 = *n * 5 + 1;
    indwrk = *n * 6 + 1;

    iinspl = 1;
    iindbl = *n + 1;
    iindw = (*n << 1) + 1;
    iindwk = *n * 3 + 1;


    scale = 1.;
    tnrm = dlanst_("M", n, &d__[1], &e[1]);
    if (tnrm > 0. && tnrm < rmin) {
	scale = rmin / tnrm;
    } else if (tnrm > rmax) {
	scale = rmax / tnrm;
    }
    if (scale != 1.) {
	if (dscal_(interp, n, &scale, &d__[1], &dstemr_c__1)!=TCL_OK) { return TCL_ERROR; }

	i__1 = *n - 1;
	if (dscal_(interp, &i__1, &scale, &e[1], &dstemr_c__1)!=TCL_OK) { return TCL_ERROR; }

	tnrm *= scale;
	if (valeig) {
	    wl *= scale;
	    wu *= scale;
	}
    }


    if (*tryrac) {
	if (dlarrr_(interp, n, &d__[1], &e[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }

    } else {
	iinfo = -1;
    }
    if (iinfo == 0) {
	thresh = eps;
    } else {
	thresh = -eps;
	*tryrac = FALSE_;
    }

    if (*tryrac) {
	if (dcopy_(interp, n, &d__[1], &dstemr_c__1, &work[indd], &dstemr_c__1)!=TCL_OK) { return TCL_ERROR; }

    }
    i__1 = *n - 1;
    for (j = 1; j <= i__1; ++j) {
	d__1 = e[j];
	work[inde2 + j - 1] = d__1 * d__1;
    }
    if (! wantz) {
	rtol1 = eps * 4.;
	rtol2 = eps * 4.;
    } else {
	rtol1 = sqrt(eps);
	d__1 = sqrt(eps) * .005, d__2 = eps * 4.;
	rtol2 = max(d__1,d__2);
    }
    if (dlarre_(interp, range, n, &wl, &wu, &iil, &iiu, &d__[1], &e[1], &work[inde2], &	    rtol1, &rtol2, &thresh, &nsplit, &iwork[iinspl], m, &w[1], &work[
	    inderr], &work[indgp], &iwork[iindbl], &iwork[iindw], &work[
	    indgrs], &pivmin, &work[indwrk], &iwork[iindwk], &iinfo)!=TCL_OK) { return TCL_ERROR; }


    if (iinfo != 0) {
	*info = abs(iinfo) + 10;
return TCL_OK;
    }
    if (wantz) {


	if (dlarrv_(interp, n, &wl, &wu, &d__[1], &e[1], &pivmin, &iwork[iinspl], m, &		dstemr_c__1, m, &dstemr_c_b18, &rtol1, &rtol2, &w[1], &work[inderr], &work[
		indgp], &iwork[iindbl], &iwork[iindw], &work[indgrs], &z__[
		z_offset], ldz, &isuppz[1], &work[indwrk], &iwork[iindwk], &
		iinfo)!=TCL_OK) { return TCL_ERROR; }


	if (iinfo != 0) {
	    *info = abs(iinfo) + 20;
return TCL_OK;
	}
    } else {
	i__1 = *m;
	for (j = 1; j <= i__1; ++j) {
	    itmp = iwork[iindbl + j - 1];
	    w[j] += e[iwork[iinspl + itmp - 1]];
	}
    }

    if (*tryrac) {
	ibegin = 1;
	wbegin = 1;
	i__1 = iwork[iindbl + *m - 1];
	for (jblk = 1; jblk <= i__1; ++jblk) {
	    iend = iwork[iinspl + jblk - 1];
	    in = iend - ibegin + 1;
	    wend = wbegin - 1;
L36:
	    if (wend < *m) {
		if (iwork[iindbl + wend] == jblk) {
		    ++wend;
		    goto L36;
		}
	    }
	    if (wend < wbegin) {
		ibegin = iend + 1;
		goto L39;
	    }
	    offset = iwork[iindw + wbegin - 1] - 1;
	    ifirst = iwork[iindw + wbegin - 1];
	    ilast = iwork[iindw + wend - 1];
	    rtol2 = eps * 4.;
	    if (dlarrj_(interp, &in, &work[indd + ibegin - 1], &work[inde2 + ibegin - 1], 		    &ifirst, &ilast, &rtol2, &offset, &w[wbegin], &work[
		    inderr + wbegin - 1], &work[indwrk], &iwork[iindwk], &
		    pivmin, &tnrm, &iinfo)!=TCL_OK) { return TCL_ERROR; }


	    ibegin = iend + 1;
	    wbegin = wend + 1;
L39:
	    ;
	}
    }


    if (scale != 1.) {
	d__1 = 1. / scale;
	if (dscal_(interp, m, &d__1, &w[1], &dstemr_c__1)!=TCL_OK) { return TCL_ERROR; }

    }


    if (nsplit > 1) {
	if (! wantz) {
	    if (dlasrt_(interp, "I", m, &w[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }

	    if (iinfo != 0) {
		*info = 3;
return TCL_OK;
	    }
	} else {
	    i__1 = *m - 1;
	    for (j = 1; j <= i__1; ++j) {
		i__ = 0;
		tmp = w[j];
		i__2 = *m;
		for (jj = j + 1; jj <= i__2; ++jj) {
		    if (w[jj] < tmp) {
			i__ = jj;
			tmp = w[jj];
		    }
		}
		if (i__ != 0) {
		    w[i__] = w[j];
		    w[j] = tmp;
		    if (wantz) {
			if (dswap_(interp, n, &z__[i__ * z_dim1 + 1], &dstemr_c__1, &z__[j * 				z_dim1 + 1], &dstemr_c__1)!=TCL_OK) { return TCL_ERROR; }


			itmp = isuppz[(i__ << 1) - 1];
			isuppz[(i__ << 1) - 1] = isuppz[(j << 1) - 1];
			isuppz[(j << 1) - 1] = itmp;
			itmp = isuppz[i__ * 2];
			isuppz[i__ * 2] = isuppz[j * 2];
			isuppz[j * 2] = itmp;
		    }
		}
	    }
	}
    }


    work[1] = (doublereal) lwmin;
    iwork[1] = liwmin;
return TCL_OK;


} /* dstemr_ */
static /* Subroutine */ int dormtr_ (Tcl_Interp *interp, char *side, char *uplo, char *trans, integer *m, 	integer *n, doublereal *a, integer *lda, doublereal *tau, doublereal *	c__, integer *ldc, doublereal *work, integer *lwork, integer *info)
{
    address a__1[2];
    integer a_dim1, a_offset, c_dim1, c_offset, i__1[2], i__2, i__3;
    char ch__1[2];

    /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);

    integer i1, i2, nb, mi, ni, nq, nw;
    logical left;
    integer iinfo;
    logical upper;
    integer lwkopt;
    logical lquery;




























    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --tau;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;
    --work;

    *info = 0;
    left = lsame_(side, "L");
    upper = lsame_(uplo, "U");
    lquery = *lwork == -1;


    if (left) {
	nq = *m;
	nw = *n;
    } else {
	nq = *n;
	nw = *m;
    }
    if (! left && ! lsame_(side, "R")) {
	*info = -1;
    } else if (! upper && ! lsame_(uplo, "L")) {
	*info = -2;
    } else if (! lsame_(trans, "N") && ! lsame_(trans, 
	    "T")) {
	*info = -3;
    } else if (*m < 0) {
	*info = -4;
    } else if (*n < 0) {
	*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) {
	if (upper) {
	    if (left) {
		i__1[0] = 1, a__1[0] = side;
		i__1[1] = 1, a__1[1] = trans;
		s_cat(ch__1, a__1, i__1, &dormtr_c__2, (ftnlen)2);
		i__2 = *m - 1;
		i__3 = *m - 1;
		nb = ilaenv_(&dormtr_c__1, "DORMQL", ch__1, &i__2, n, &i__3, &dormtr_c_n1);
	    } else {
		i__1[0] = 1, a__1[0] = side;
		i__1[1] = 1, a__1[1] = trans;
		s_cat(ch__1, a__1, i__1, &dormtr_c__2, (ftnlen)2);
		i__2 = *n - 1;
		i__3 = *n - 1;
		nb = ilaenv_(&dormtr_c__1, "DORMQL", ch__1, m, &i__2, &i__3, &dormtr_c_n1);
	    }
	} else {
	    if (left) {
		i__1[0] = 1, a__1[0] = side;
		i__1[1] = 1, a__1[1] = trans;
		s_cat(ch__1, a__1, i__1, &dormtr_c__2, (ftnlen)2);
		i__2 = *m - 1;
		i__3 = *m - 1;
		nb = ilaenv_(&dormtr_c__1, "DORMQR", ch__1, &i__2, n, &i__3, &dormtr_c_n1);
	    } else {
		i__1[0] = 1, a__1[0] = side;
		i__1[1] = 1, a__1[1] = trans;
		s_cat(ch__1, a__1, i__1, &dormtr_c__2, (ftnlen)2);
		i__2 = *n - 1;
		i__3 = *n - 1;
		nb = ilaenv_(&dormtr_c__1, "DORMQR", ch__1, m, &i__2, &i__3, &dormtr_c_n1);
	    }
	}
	lwkopt = max(1,nw) * nb;
	work[1] = (doublereal) lwkopt;
    }

    if (*info != 0) {
	i__2 = -(*info);
	vectcl_xerbla(interp, "DORMTR", &i__2);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


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

    if (left) {
	mi = *m - 1;
	ni = *n;
    } else {
	mi = *m;
	ni = *n - 1;
    }

    if (upper) {


	i__2 = nq - 1;
	if (dormql_(interp, side, trans, &mi, &ni, &i__2, &a[(a_dim1 << 1) + 1], lda, &		tau[1], &c__[c_offset], ldc, &work[1], lwork, &iinfo)!=TCL_OK) { return TCL_ERROR; }


    } else {


	if (left) {
	    i1 = 2;
	    i2 = 1;
	} else {
	    i1 = 1;
	    i2 = 2;
	}
	i__2 = nq - 1;
	if (dormqr_(interp, side, trans, &mi, &ni, &i__2, &a[a_dim1 + 2], lda, &tau[1], &		c__[i1 + i2 * c_dim1], ldc, &work[1], lwork, &iinfo)!=TCL_OK) { return TCL_ERROR; }


    }
    work[1] = (doublereal) lwkopt;
return TCL_OK;


} /* dormtr_ */
static /* Subroutine */ int dsytrd_ (Tcl_Interp *interp, char *uplo, integer *n, doublereal *a, integer *	lda, doublereal *d__, doublereal *e, doublereal *tau, doublereal *	work, integer *lwork, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3;

    integer i__, j, nb, kk, nx, iws;
    integer nbmin, iinfo;
    logical upper;
    integer ldwork, lwkopt;
    logical lquery;




































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

    *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) {


	nb = ilaenv_(&dsytrd_c__1, "DSYTRD", uplo, n, &dsytrd_c_n1, &dsytrd_c_n1, &dsytrd_c_n1);
	lwkopt = *n * nb;
	work[1] = (doublereal) lwkopt;
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DSYTRD", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


    if (*n == 0) {
	work[1] = 1.;
return TCL_OK;
    }

    nx = *n;
    iws = 1;
    if (nb > 1 && nb < *n) {


	i__1 = nb, i__2 = ilaenv_(&dsytrd_c__3, "DSYTRD", uplo, n, &dsytrd_c_n1, &dsytrd_c_n1, &
		dsytrd_c_n1);
	nx = max(i__1,i__2);
	if (nx < *n) {


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


		i__1 = *lwork / ldwork;
		nb = max(i__1,1);
		nbmin = ilaenv_(&dsytrd_c__2, "DSYTRD", uplo, n, &dsytrd_c_n1, &dsytrd_c_n1, &dsytrd_c_n1);
		if (nb < nbmin) {
		    nx = *n;
		}
	    }
	} else {
	    nx = *n;
	}
    } else {
	nb = 1;
    }

    if (upper) {


	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) {


	    i__3 = i__ + nb - 1;
	    if (dlatrd_(interp, uplo, &i__3, &nb, &a[a_offset], lda, &e[1], &tau[1], &		    work[1], &ldwork)!=TCL_OK) { return TCL_ERROR; }




	    i__3 = i__ - 1;
	    if (dsyr2k_(interp, uplo, "No transpose", &i__3, &nb, &dsytrd_c_b22, &a[i__ * a_dim1 		    + 1], lda, &work[1], &ldwork, &dsytrd_c_b23, &a[a_offset], lda)!=TCL_OK) { return TCL_ERROR; }




	    i__3 = i__ + nb - 1;
	    for (j = i__; j <= i__3; ++j) {
		a[j - 1 + j * a_dim1] = e[j - 1];
		d__[j] = a[j + j * a_dim1];
	    }
	}


	if (dsytd2_(interp, uplo, &kk, &a[a_offset], lda, &d__[1], &e[1], &tau[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }

    } else {


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


	    i__3 = *n - i__ + 1;
	    if (dlatrd_(interp, uplo, &i__3, &nb, &a[i__ + i__ * a_dim1], lda, &e[i__], &		    tau[i__], &work[1], &ldwork)!=TCL_OK) { return TCL_ERROR; }




	    i__3 = *n - i__ - nb + 1;
	    if (dsyr2k_(interp, uplo, "No transpose", &i__3, &nb, &dsytrd_c_b22, &a[i__ + nb + 		    i__ * a_dim1], lda, &work[nb + 1], &ldwork, &dsytrd_c_b23, &a[
		    i__ + nb + (i__ + nb) * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }




	    i__3 = i__ + nb - 1;
	    for (j = i__; j <= i__3; ++j) {
		a[j + 1 + j * a_dim1] = e[j];
		d__[j] = a[j + j * a_dim1];
	    }
	}


	i__1 = *n - i__ + 1;
	if (dsytd2_(interp, uplo, &i__1, &a[i__ + i__ * a_dim1], lda, &d__[i__], &e[i__], 		&tau[i__], &iinfo)!=TCL_OK) { return TCL_ERROR; }


    }

    work[1] = (doublereal) lwkopt;
return TCL_OK;


} /* dsytrd_ */
static /* Subroutine */ int zswap_ (Tcl_Interp *interp, integer *n, doublecomplex *zx, integer *incx, 	doublecomplex *zy, integer *incy)
{
    integer i__1, i__2, i__3;

    integer i__, ix, iy;
    doublecomplex ztemp;





    --zy;
    --zx;

    if (*n <= 0) {
return TCL_OK;
    }
    if (*incx == 1 && *incy == 1) {
	goto L20;
    }


    ix = 1;
    iy = 1;
    if (*incx < 0) {
	ix = (-(*n) + 1) * *incx + 1;
    }
    if (*incy < 0) {
	iy = (-(*n) + 1) * *incy + 1;
    }
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	i__2 = ix;
	ztemp.r = zx[i__2].r, ztemp.i = zx[i__2].i;
	i__2 = ix;
	i__3 = iy;
	zx[i__2].r = zy[i__3].r, zx[i__2].i = zy[i__3].i;
	i__2 = iy;
	zy[i__2].r = ztemp.r, zy[i__2].i = ztemp.i;
	ix += *incx;
	iy += *incy;
    }
return TCL_OK;

L20:
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	i__2 = i__;
	ztemp.r = zx[i__2].r, ztemp.i = zx[i__2].i;
	i__2 = i__;
	i__3 = i__;
	zx[i__2].r = zy[i__3].r, zx[i__2].i = zy[i__3].i;
	i__2 = i__;
	zy[i__2].r = ztemp.r, zy[i__2].i = ztemp.i;
    }
return TCL_OK;
} /* zswap_ */
static /* Subroutine */ int zdscal_ (Tcl_Interp *interp, integer *n, doublereal *da, doublecomplex *zx, 	integer *incx)
{
    integer i__1, i__2, i__3;
    doublecomplex z__1, z__2;

    integer i__, ix;





    --zx;

    if (*n <= 0 || *incx <= 0) {
return TCL_OK;
    }
    if (*incx == 1) {
	goto L20;
    }


    ix = 1;
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	i__2 = ix;
	z__2.r = *da, z__2.i = 0.;
	i__3 = ix;
	z__1.r = z__2.r * zx[i__3].r - z__2.i * zx[i__3].i, z__1.i = z__2.r * 
		zx[i__3].i + z__2.i * zx[i__3].r;
	zx[i__2].r = z__1.r, zx[i__2].i = z__1.i;
	ix += *incx;
    }
return TCL_OK;


L20:
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	i__2 = i__;
	z__2.r = *da, z__2.i = 0.;
	i__3 = i__;
	z__1.r = z__2.r * zx[i__3].r - z__2.i * zx[i__3].i, z__1.i = z__2.r * 
		zx[i__3].i + z__2.i * zx[i__3].r;
	zx[i__2].r = z__1.r, zx[i__2].i = z__1.i;
    }
return TCL_OK;
} /* zdscal_ */
static /* Subroutine */ int zhetrd_ (Tcl_Interp *interp, char *uplo, integer *n, doublecomplex *a, 	integer *lda, doublereal *d__, doublereal *e, doublecomplex *tau, 	doublecomplex *work, integer *lwork, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
    doublecomplex z__1;

    integer i__, j, nb, kk, nx, iws;
    integer nbmin, iinfo;
    logical upper;
    integer ldwork, lwkopt;
    logical lquery;




































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

    *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) {


	nb = ilaenv_(&zhetrd_c__1, "ZHETRD", uplo, n, &zhetrd_c_n1, &zhetrd_c_n1, &zhetrd_c_n1);
	lwkopt = *n * nb;
	work[1].r = (doublereal) lwkopt, work[1].i = 0.;
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "ZHETRD", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


    if (*n == 0) {
	work[1].r = 1., work[1].i = 0.;
return TCL_OK;
    }

    nx = *n;
    iws = 1;
    if (nb > 1 && nb < *n) {


	i__1 = nb, i__2 = ilaenv_(&zhetrd_c__3, "ZHETRD", uplo, n, &zhetrd_c_n1, &zhetrd_c_n1, &
		zhetrd_c_n1);
	nx = max(i__1,i__2);
	if (nx < *n) {


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


		i__1 = *lwork / ldwork;
		nb = max(i__1,1);
		nbmin = ilaenv_(&zhetrd_c__2, "ZHETRD", uplo, n, &zhetrd_c_n1, &zhetrd_c_n1, &zhetrd_c_n1);
		if (nb < nbmin) {
		    nx = *n;
		}
	    }
	} else {
	    nx = *n;
	}
    } else {
	nb = 1;
    }

    if (upper) {


	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) {


	    i__3 = i__ + nb - 1;
	    if (zlatrd_(interp, uplo, &i__3, &nb, &a[a_offset], lda, &e[1], &tau[1], &		    work[1], &ldwork)!=TCL_OK) { return TCL_ERROR; }




	    i__3 = i__ - 1;
	    z__1.r = -1., z__1.i = -0.;
	    if (zher2k_(interp, uplo, "No transpose", &i__3, &nb, &z__1, &a[i__ * a_dim1 		    + 1], lda, &work[1], &ldwork, &zhetrd_c_b23, &a[a_offset], lda)!=TCL_OK) { return TCL_ERROR; }




	    i__3 = i__ + nb - 1;
	    for (j = i__; j <= i__3; ++j) {
		i__4 = j - 1 + j * a_dim1;
		i__5 = j - 1;
		a[i__4].r = e[i__5], a[i__4].i = 0.;
		i__4 = j;
		i__5 = j + j * a_dim1;
		d__[i__4] = a[i__5].r;
	    }
	}


	if (zhetd2_(interp, uplo, &kk, &a[a_offset], lda, &d__[1], &e[1], &tau[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }

    } else {


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


	    i__3 = *n - i__ + 1;
	    if (zlatrd_(interp, uplo, &i__3, &nb, &a[i__ + i__ * a_dim1], lda, &e[i__], &		    tau[i__], &work[1], &ldwork)!=TCL_OK) { return TCL_ERROR; }




	    i__3 = *n - i__ - nb + 1;
	    z__1.r = -1., z__1.i = -0.;
	    if (zher2k_(interp, uplo, "No transpose", &i__3, &nb, &z__1, &a[i__ + nb + 		    i__ * a_dim1], lda, &work[nb + 1], &ldwork, &zhetrd_c_b23, &a[
		    i__ + nb + (i__ + nb) * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }




	    i__3 = i__ + nb - 1;
	    for (j = i__; j <= i__3; ++j) {
		i__4 = j + 1 + j * a_dim1;
		i__5 = j;
		a[i__4].r = e[i__5], a[i__4].i = 0.;
		i__4 = j;
		i__5 = j + j * a_dim1;
		d__[i__4] = a[i__5].r;
	    }
	}


	i__1 = *n - i__ + 1;
	if (zhetd2_(interp, uplo, &i__1, &a[i__ + i__ * a_dim1], lda, &d__[i__], &e[i__], 		&tau[i__], &iinfo)!=TCL_OK) { return TCL_ERROR; }


    }

    work[1].r = (doublereal) lwkopt, work[1].i = 0.;
return TCL_OK;


} /* zhetrd_ */
static /* Subroutine */ int zstein_ (Tcl_Interp *interp, integer *n, doublereal *d__, doublereal *e, 	integer *m, doublereal *w, integer *iblock, integer *isplit, 	doublecomplex *z__, integer *ldz, doublereal *work, integer *iwork, 	integer *ifail, integer *info)
{
    integer z_dim1, z_offset, i__1, i__2, i__3, i__4, i__5;
    doublereal d__1, d__2, d__3, d__4, d__5;
    doublecomplex z__1;

    double sqrt(doublereal);

    integer i__, j, b1, j1, bn, jr;
    doublereal xj, scl, eps, sep, nrm, tol;
    integer its;
    doublereal xjm, ztr, eps1;
    integer jblk, nblk, jmax;
    integer iseed[4], gpind, iinfo;
    doublereal ortol;
    integer indrv1, indrv2, indrv3, indrv4, indrv5;
    integer nrmchk;
    integer blksiz;
    doublereal onenrm, dtpcrt, pertol;





























    --d__;
    --e;
    --w;
    --iblock;
    --isplit;
    z_dim1 = *ldz;
    z_offset = 1 + z_dim1;
    z__ -= z_offset;
    --work;
    --iwork;
    --ifail;

    *info = 0;
    i__1 = *m;
    for (i__ = 1; i__ <= i__1; ++i__) {
	ifail[i__] = 0;
    }

    if (*n < 0) {
	*info = -1;
    } else if (*m < 0 || *m > *n) {
	*info = -4;
    } else if (*ldz < max(1,*n)) {
	*info = -9;
    } else {
	i__1 = *m;
	for (j = 2; j <= i__1; ++j) {
	    if (iblock[j] < iblock[j - 1]) {
		*info = -6;
		goto L30;
	    }
	    if (iblock[j] == iblock[j - 1] && w[j] < w[j - 1]) {
		*info = -5;
		goto L30;
	    }
	}
L30:
	;
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "ZSTEIN", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


    if (*n == 0 || *m == 0) {
return TCL_OK;
    } else if (*n == 1) {
	i__1 = z_dim1 + 1;
	z__[i__1].r = 1., z__[i__1].i = 0.;
return TCL_OK;
    }


    eps = dlamch_("Precision");


    for (i__ = 1; i__ <= 4; ++i__) {
	iseed[i__ - 1] = 1;
    }


    indrv1 = 0;
    indrv2 = indrv1 + *n;
    indrv3 = indrv2 + *n;
    indrv4 = indrv3 + *n;
    indrv5 = indrv4 + *n;


    j1 = 1;
    i__1 = iblock[*m];
    for (nblk = 1; nblk <= i__1; ++nblk) {


	if (nblk == 1) {
	    b1 = 1;
	} else {
	    b1 = isplit[nblk - 1] + 1;
	}
	bn = isplit[nblk];
	blksiz = bn - b1 + 1;
	if (blksiz == 1) {
	    goto L60;
	}
	gpind = b1;


	onenrm = (d__1 = d__[b1], abs(d__1)) + (d__2 = e[b1], abs(d__2));
	d__3 = onenrm, d__4 = (d__1 = d__[bn], abs(d__1)) + (d__2 = e[bn - 1],
		 abs(d__2));
	onenrm = max(d__3,d__4);
	i__2 = bn - 1;
	for (i__ = b1 + 1; i__ <= i__2; ++i__) {
	    d__4 = onenrm, d__5 = (d__1 = d__[i__], abs(d__1)) + (d__2 = e[
		    i__ - 1], abs(d__2)) + (d__3 = e[i__], abs(d__3));
	    onenrm = max(d__4,d__5);
	}
	ortol = onenrm * .001;

	dtpcrt = sqrt(.1 / blksiz);


L60:
	jblk = 0;
	i__2 = *m;
	for (j = j1; j <= i__2; ++j) {
	    if (iblock[j] != nblk) {
		j1 = j;
		goto L180;
	    }
	    ++jblk;
	    xj = w[j];


	    if (blksiz == 1) {
		work[indrv1 + 1] = 1.;
		goto L140;
	    }


	    if (jblk > 1) {
		eps1 = (d__1 = eps * xj, abs(d__1));
		pertol = eps1 * 10.;
		sep = xj - xjm;
		if (sep < pertol) {
		    xj = xjm + pertol;
		}
	    }

	    its = 0;
	    nrmchk = 0;


	    if (dlarnv_(interp, &zstein_c__2, iseed, &blksiz, &work[indrv1 + 1])!=TCL_OK) { return TCL_ERROR; }



	    if (dcopy_(interp, &blksiz, &d__[b1], &zstein_c__1, &work[indrv4 + 1], &zstein_c__1)!=TCL_OK) { return TCL_ERROR; }

	    i__3 = blksiz - 1;
	    if (dcopy_(interp, &i__3, &e[b1], &zstein_c__1, &work[indrv2 + 2], &zstein_c__1)!=TCL_OK) { return TCL_ERROR; }

	    i__3 = blksiz - 1;
	    if (dcopy_(interp, &i__3, &e[b1], &zstein_c__1, &work[indrv3 + 1], &zstein_c__1)!=TCL_OK) { return TCL_ERROR; }



	    tol = 0.;
	    if (dlagtf_(interp, &blksiz, &work[indrv4 + 1], &xj, &work[indrv2 + 2], &work[		    indrv3 + 1], &tol, &work[indrv5 + 1], &iwork[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }




L70:
	    ++its;
	    if (its > 5) {
		goto L120;
	    }


	    d__2 = eps, d__3 = (d__1 = work[indrv4 + blksiz], abs(d__1));
	    scl = blksiz * onenrm * max(d__2,d__3) / dasum_(&blksiz, &work[
		    indrv1 + 1], &zstein_c__1);
	    if (dscal_(interp, &blksiz, &scl, &work[indrv1 + 1], &zstein_c__1)!=TCL_OK) { return TCL_ERROR; }



	    if (dlagts_(interp, &zstein_c_n1, &blksiz, &work[indrv4 + 1], &work[indrv2 + 2], &		    work[indrv3 + 1], &work[indrv5 + 1], &iwork[1], &work[
		    indrv1 + 1], &tol, &iinfo)!=TCL_OK) { return TCL_ERROR; }




	    if (jblk == 1) {
		goto L110;
	    }
	    if ((d__1 = xj - xjm, abs(d__1)) > ortol) {
		gpind = j;
	    }
	    if (gpind != j) {
		i__3 = j - 1;
		for (i__ = gpind; i__ <= i__3; ++i__) {
		    ztr = 0.;
		    i__4 = blksiz;
		    for (jr = 1; jr <= i__4; ++jr) {
			i__5 = b1 - 1 + jr + i__ * z_dim1;
			ztr += work[indrv1 + jr] * z__[i__5].r;
		    }
		    i__4 = blksiz;
		    for (jr = 1; jr <= i__4; ++jr) {
			i__5 = b1 - 1 + jr + i__ * z_dim1;
			work[indrv1 + jr] -= ztr * z__[i__5].r;
		    }
		}
	    }


L110:
	    jmax = idamax_(&blksiz, &work[indrv1 + 1], &zstein_c__1);
	    nrm = (d__1 = work[indrv1 + jmax], abs(d__1));


	    if (nrm < dtpcrt) {
		goto L70;
	    }
	    ++nrmchk;
	    if (nrmchk < 3) {
		goto L70;
	    }

	    goto L130;


L120:
	    ++(*info);
	    ifail[*info] = j;


L130:
	    scl = 1. / dnrm2_(&blksiz, &work[indrv1 + 1], &zstein_c__1);
	    jmax = idamax_(&blksiz, &work[indrv1 + 1], &zstein_c__1);
	    if (work[indrv1 + jmax] < 0.) {
		scl = -scl;
	    }
	    if (dscal_(interp, &blksiz, &scl, &work[indrv1 + 1], &zstein_c__1)!=TCL_OK) { return TCL_ERROR; }

L140:
	    i__3 = *n;
	    for (i__ = 1; i__ <= i__3; ++i__) {
		i__4 = i__ + j * z_dim1;
		z__[i__4].r = 0., z__[i__4].i = 0.;
	    }
	    i__3 = blksiz;
	    for (i__ = 1; i__ <= i__3; ++i__) {
		i__4 = b1 + i__ - 1 + j * z_dim1;
		i__5 = indrv1 + i__;
		z__1.r = work[i__5], z__1.i = 0.;
		z__[i__4].r = z__1.r, z__[i__4].i = z__1.i;
	    }


	    xjm = xj;

	}
L180:
	;
    }

return TCL_OK;


} /* zstein_ */
static doublereal zlansy_ (char *norm, char *uplo, integer *n, doublecomplex *a, 	integer *lda, doublereal *work)
{
    integer a_dim1, a_offset, i__1, i__2;
    doublereal ret_val, d__1, d__2;

    double z_abs(doublecomplex *), sqrt(doublereal);

    integer i__, j;
    doublereal sum, absa, scale;
    doublereal value;



















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

    if (*n == 0) {
	value = 0.;
    } else if (lsame_(norm, "M")) {


	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__) {
		    d__1 = value, d__2 = z_abs(&a[i__ + j * a_dim1]);
		    value = max(d__1,d__2);
		}
	    }
	} else {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = *n;
		for (i__ = j; i__ <= i__2; ++i__) {
		    d__1 = value, d__2 = z_abs(&a[i__ + j * a_dim1]);
		    value = max(d__1,d__2);
		}
	    }
	}
    } else if (lsame_(norm, "I") || lsame_(norm, "O") || *(unsigned char *)norm == '1') {


	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 = z_abs(&a[i__ + j * a_dim1]);
		    sum += absa;
		    work[i__] += absa;
		}
		work[j] = sum + z_abs(&a[j + j * a_dim1]);
	    }
	    i__1 = *n;
	    for (i__ = 1; i__ <= i__1; ++i__) {
		d__1 = value, d__2 = work[i__];
		value = max(d__1,d__2);
	    }
	} else {
	    i__1 = *n;
	    for (i__ = 1; i__ <= i__1; ++i__) {
		work[i__] = 0.;
	    }
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		sum = work[j] + z_abs(&a[j + j * a_dim1]);
		i__2 = *n;
		for (i__ = j + 1; i__ <= i__2; ++i__) {
		    absa = z_abs(&a[i__ + j * a_dim1]);
		    sum += absa;
		    work[i__] += absa;
		}
		value = max(value,sum);
	    }
	}
    } else if (lsame_(norm, "F") || lsame_(norm, "E")) {


	scale = 0.;
	sum = 1.;
	if (lsame_(uplo, "U")) {
	    i__1 = *n;
	    for (j = 2; j <= i__1; ++j) {
		i__2 = j - 1;
		zlassq_(NULL, &i__2, &a[j * a_dim1 + 1], &zlansy_c__1, &scale, &sum);
	    }
	} else {
	    i__1 = *n - 1;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = *n - j;
		zlassq_(NULL, &i__2, &a[j + 1 + j * a_dim1], &zlansy_c__1, &scale, &sum);
	    }
	}
	sum *= 2;
	i__1 = *lda + 1;
	zlassq_(NULL, n, &a[a_offset], &i__1, &scale, &sum);
	value = scale * sqrt(sum);
    }

    ret_val = value;
    return ret_val;


} /* zlansy_ */
static /* Subroutine */ int zstemr_ (Tcl_Interp *interp, char *jobz, char *range, integer *n, doublereal *	d__, doublereal *e, doublereal *vl, doublereal *vu, integer *il, 	integer *iu, integer *m, doublereal *w, doublecomplex *z__, integer *	ldz, integer *nzc, integer *isuppz, logical *tryrac, doublereal *work, 	 integer *lwork, integer *iwork, integer *liwork, integer *info)
{
    integer z_dim1, z_offset, i__1, i__2;
    doublereal d__1, d__2;

    double sqrt(doublereal);

    integer i__, j;
    doublereal r1, r2;
    integer jj;
    doublereal cs;
    integer in;
    doublereal sn, wl, wu;
    integer iil, iiu;
    doublereal eps, tmp;
    integer indd, iend, jblk, wend;
    doublereal rmin, rmax;
    integer itmp;
    doublereal tnrm;
    integer inde2, itmp2;
    doublereal rtol1, rtol2;
    doublereal scale;
    integer indgp;
    integer iinfo, iindw, ilast;
    integer lwmin;
    logical wantz;
    logical alleig;
    integer ibegin;
    logical indeig;
    integer iindbl;
    logical valeig;
    integer wbegin;
    doublereal safmin;
    doublereal bignum;
    integer inderr, iindwk, indgrs, offset;
    doublereal thresh;
    integer iinspl, indwrk, ifirst, liwmin, nzcmin;
    doublereal pivmin;
    integer nsplit;
    doublereal smlnum;
    logical lquery, zquery;








































    --d__;
    --e;
    --w;
    z_dim1 = *ldz;
    z_offset = 1 + z_dim1;
    z__ -= z_offset;
    --isuppz;
    --work;
    --iwork;

    wantz = lsame_(jobz, "V");
    alleig = lsame_(range, "A");
    valeig = lsame_(range, "V");
    indeig = lsame_(range, "I");

    lquery = *lwork == -1 || *liwork == -1;
    zquery = *nzc == -1;
    if (wantz) {
	lwmin = *n * 18;
	liwmin = *n * 10;
    } else {
	lwmin = *n * 12;
	liwmin = *n << 3;
    }
    wl = 0.;
    wu = 0.;
    iil = 0;
    iiu = 0;
    if (valeig) {
	wl = *vl;
	wu = *vu;
    } else if (indeig) {
	iil = *il;
	iiu = *iu;
    }

    *info = 0;
    if (! (wantz || lsame_(jobz, "N"))) {
	*info = -1;
    } else if (! (alleig || valeig || indeig)) {
	*info = -2;
    } else if (*n < 0) {
	*info = -3;
    } else if (valeig && *n > 0 && wu <= wl) {
	*info = -7;
    } else if (indeig && (iil < 1 || iil > *n)) {
	*info = -8;
    } else if (indeig && (iiu < iil || iiu > *n)) {
	*info = -9;
    } else if (*ldz < 1 || wantz && *ldz < *n) {
	*info = -13;
    } else if (*lwork < lwmin && ! lquery) {
	*info = -17;
    } else if (*liwork < liwmin && ! lquery) {
	*info = -19;
    }


    safmin = dlamch_("Safe minimum");
    eps = dlamch_("Precision");
    smlnum = safmin / eps;
    bignum = 1. / smlnum;
    rmin = sqrt(smlnum);
    d__1 = sqrt(bignum), d__2 = 1. / sqrt(sqrt(safmin));
    rmax = min(d__1,d__2);

    if (*info == 0) {
	work[1] = (doublereal) lwmin;
	iwork[1] = liwmin;

	if (wantz && alleig) {
	    nzcmin = *n;
	} else if (wantz && valeig) {
	    if (dlarrc_(interp, "T", n, vl, vu, &d__[1], &e[1], &safmin, &nzcmin, &itmp, &		    itmp2, info)!=TCL_OK) { return TCL_ERROR; }


	} else if (wantz && indeig) {
	    nzcmin = iiu - iil + 1;
	} else {
	    nzcmin = 0;
	}
	if (zquery && *info == 0) {
	    i__1 = z_dim1 + 1;
	    z__[i__1].r = (doublereal) nzcmin, z__[i__1].i = 0.;
	} else if (*nzc < nzcmin && ! zquery) {
	    *info = -14;
	}
    }
    if (*info != 0) {

	i__1 = -(*info);
	vectcl_xerbla(interp, "ZSTEMR", &i__1);
return TCL_ERROR;


return TCL_OK;
    } else if (lquery || zquery) {
return TCL_OK;
    }


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

    if (*n == 1) {
	if (alleig || indeig) {
	    *m = 1;
	    w[1] = d__[1];
	} else {
	    if (wl < d__[1] && wu >= d__[1]) {
		*m = 1;
		w[1] = d__[1];
	    }
	}
	if (wantz && ! zquery) {
	    i__1 = z_dim1 + 1;
	    z__[i__1].r = 1., z__[i__1].i = 0.;
	    isuppz[1] = 1;
	    isuppz[2] = 1;
	}
return TCL_OK;
    }

    if (*n == 2) {
	if (! wantz) {
	    if (dlae2_(interp, &d__[1], &e[1], &d__[2], &r1, &r2)!=TCL_OK) { return TCL_ERROR; }

	} else if (wantz && ! zquery) {
	    if (dlaev2_(interp, &d__[1], &e[1], &d__[2], &r1, &r2, &cs, &sn)!=TCL_OK) { return TCL_ERROR; }

	}
	if (alleig || valeig && r2 > wl && r2 <= wu || indeig && iil == 1) {
	    ++(*m);
	    w[*m] = r2;
	    if (wantz && ! zquery) {
		i__1 = *m * z_dim1 + 1;
		d__1 = -sn;
		z__[i__1].r = d__1, z__[i__1].i = 0.;
		i__1 = *m * z_dim1 + 2;
		z__[i__1].r = cs, z__[i__1].i = 0.;
		if (sn != 0.) {
		    if (cs != 0.) {
			isuppz[(*m << 1) - 1] = 1;
			isuppz[(*m << 1) - 1] = 2;
		    } else {
			isuppz[(*m << 1) - 1] = 1;
			isuppz[(*m << 1) - 1] = 1;
		    }
		} else {
		    isuppz[(*m << 1) - 1] = 2;
		    isuppz[*m * 2] = 2;
		}
	    }
	}
	if (alleig || valeig && r1 > wl && r1 <= wu || indeig && iiu == 2) {
	    ++(*m);
	    w[*m] = r1;
	    if (wantz && ! zquery) {
		i__1 = *m * z_dim1 + 1;
		z__[i__1].r = cs, z__[i__1].i = 0.;
		i__1 = *m * z_dim1 + 2;
		z__[i__1].r = sn, z__[i__1].i = 0.;
		if (sn != 0.) {
		    if (cs != 0.) {
			isuppz[(*m << 1) - 1] = 1;
			isuppz[(*m << 1) - 1] = 2;
		    } else {
			isuppz[(*m << 1) - 1] = 1;
			isuppz[(*m << 1) - 1] = 1;
		    }
		} else {
		    isuppz[(*m << 1) - 1] = 2;
		    isuppz[*m * 2] = 2;
		}
	    }
	}
return TCL_OK;
    }
    indgrs = 1;
    inderr = (*n << 1) + 1;
    indgp = *n * 3 + 1;
    indd = (*n << 2) + 1;
    inde2 = *n * 5 + 1;
    indwrk = *n * 6 + 1;

    iinspl = 1;
    iindbl = *n + 1;
    iindw = (*n << 1) + 1;
    iindwk = *n * 3 + 1;


    scale = 1.;
    tnrm = dlanst_("M", n, &d__[1], &e[1]);
    if (tnrm > 0. && tnrm < rmin) {
	scale = rmin / tnrm;
    } else if (tnrm > rmax) {
	scale = rmax / tnrm;
    }
    if (scale != 1.) {
	if (dscal_(interp, n, &scale, &d__[1], &zstemr_c__1)!=TCL_OK) { return TCL_ERROR; }

	i__1 = *n - 1;
	if (dscal_(interp, &i__1, &scale, &e[1], &zstemr_c__1)!=TCL_OK) { return TCL_ERROR; }

	tnrm *= scale;
	if (valeig) {
	    wl *= scale;
	    wu *= scale;
	}
    }


    if (*tryrac) {
	if (dlarrr_(interp, n, &d__[1], &e[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }

    } else {
	iinfo = -1;
    }
    if (iinfo == 0) {
	thresh = eps;
    } else {
	thresh = -eps;
	*tryrac = FALSE_;
    }

    if (*tryrac) {
	if (dcopy_(interp, n, &d__[1], &zstemr_c__1, &work[indd], &zstemr_c__1)!=TCL_OK) { return TCL_ERROR; }

    }
    i__1 = *n - 1;
    for (j = 1; j <= i__1; ++j) {
	d__1 = e[j];
	work[inde2 + j - 1] = d__1 * d__1;
    }
    if (! wantz) {
	rtol1 = eps * 4.;
	rtol2 = eps * 4.;
    } else {
	rtol1 = sqrt(eps);
	d__1 = sqrt(eps) * .005, d__2 = eps * 4.;
	rtol2 = max(d__1,d__2);
    }
    if (dlarre_(interp, range, n, &wl, &wu, &iil, &iiu, &d__[1], &e[1], &work[inde2], &	    rtol1, &rtol2, &thresh, &nsplit, &iwork[iinspl], m, &w[1], &work[
	    inderr], &work[indgp], &iwork[iindbl], &iwork[iindw], &work[
	    indgrs], &pivmin, &work[indwrk], &iwork[iindwk], &iinfo)!=TCL_OK) { return TCL_ERROR; }


    if (iinfo != 0) {
	*info = abs(iinfo) + 10;
return TCL_OK;
    }
    if (wantz) {


	if (zlarrv_(interp, n, &wl, &wu, &d__[1], &e[1], &pivmin, &iwork[iinspl], m, &		zstemr_c__1, m, &zstemr_c_b18, &rtol1, &rtol2, &w[1], &work[inderr], &work[
		indgp], &iwork[iindbl], &iwork[iindw], &work[indgrs], &z__[
		z_offset], ldz, &isuppz[1], &work[indwrk], &iwork[iindwk], &
		iinfo)!=TCL_OK) { return TCL_ERROR; }


	if (iinfo != 0) {
	    *info = abs(iinfo) + 20;
return TCL_OK;
	}
    } else {
	i__1 = *m;
	for (j = 1; j <= i__1; ++j) {
	    itmp = iwork[iindbl + j - 1];
	    w[j] += e[iwork[iinspl + itmp - 1]];
	}
    }

    if (*tryrac) {
	ibegin = 1;
	wbegin = 1;
	i__1 = iwork[iindbl + *m - 1];
	for (jblk = 1; jblk <= i__1; ++jblk) {
	    iend = iwork[iinspl + jblk - 1];
	    in = iend - ibegin + 1;
	    wend = wbegin - 1;
L36:
	    if (wend < *m) {
		if (iwork[iindbl + wend] == jblk) {
		    ++wend;
		    goto L36;
		}
	    }
	    if (wend < wbegin) {
		ibegin = iend + 1;
		goto L39;
	    }
	    offset = iwork[iindw + wbegin - 1] - 1;
	    ifirst = iwork[iindw + wbegin - 1];
	    ilast = iwork[iindw + wend - 1];
	    rtol2 = eps * 4.;
	    if (dlarrj_(interp, &in, &work[indd + ibegin - 1], &work[inde2 + ibegin - 1], 		    &ifirst, &ilast, &rtol2, &offset, &w[wbegin], &work[
		    inderr + wbegin - 1], &work[indwrk], &iwork[iindwk], &
		    pivmin, &tnrm, &iinfo)!=TCL_OK) { return TCL_ERROR; }


	    ibegin = iend + 1;
	    wbegin = wend + 1;
L39:
	    ;
	}
    }


    if (scale != 1.) {
	d__1 = 1. / scale;
	if (dscal_(interp, m, &d__1, &w[1], &zstemr_c__1)!=TCL_OK) { return TCL_ERROR; }

    }


    if (nsplit > 1) {
	if (! wantz) {
	    if (dlasrt_(interp, "I", m, &w[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }

	    if (iinfo != 0) {
		*info = 3;
return TCL_OK;
	    }
	} else {
	    i__1 = *m - 1;
	    for (j = 1; j <= i__1; ++j) {
		i__ = 0;
		tmp = w[j];
		i__2 = *m;
		for (jj = j + 1; jj <= i__2; ++jj) {
		    if (w[jj] < tmp) {
			i__ = jj;
			tmp = w[jj];
		    }
		}
		if (i__ != 0) {
		    w[i__] = w[j];
		    w[j] = tmp;
		    if (wantz) {
			if (zswap_(interp, n, &z__[i__ * z_dim1 + 1], &zstemr_c__1, &z__[j * 				z_dim1 + 1], &zstemr_c__1)!=TCL_OK) { return TCL_ERROR; }


			itmp = isuppz[(i__ << 1) - 1];
			isuppz[(i__ << 1) - 1] = isuppz[(j << 1) - 1];
			isuppz[(j << 1) - 1] = itmp;
			itmp = isuppz[i__ * 2];
			isuppz[i__ * 2] = isuppz[j * 2];
			isuppz[j * 2] = itmp;
		    }
		}
	    }
	}
    }


    work[1] = (doublereal) lwmin;
    iwork[1] = liwmin;
return TCL_OK;


} /* zstemr_ */
static /* Subroutine */ int zunmtr_ (Tcl_Interp *interp, char *side, char *uplo, char *trans, integer *m, 	integer *n, doublecomplex *a, integer *lda, doublecomplex *tau, 	doublecomplex *c__, integer *ldc, doublecomplex *work, integer *lwork, 	 integer *info)
{
    address a__1[2];
    integer a_dim1, a_offset, c_dim1, c_offset, i__1[2], i__2, i__3;
    char ch__1[2];

    /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);

    integer i1, i2, nb, mi, ni, nq, nw;
    logical left;
    integer iinfo;
    logical upper;
    integer lwkopt;
    logical lquery;




























    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --tau;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;
    --work;

    *info = 0;
    left = lsame_(side, "L");
    upper = lsame_(uplo, "U");
    lquery = *lwork == -1;


    if (left) {
	nq = *m;
	nw = *n;
    } else {
	nq = *n;
	nw = *m;
    }
    if (! left && ! lsame_(side, "R")) {
	*info = -1;
    } else if (! upper && ! lsame_(uplo, "L")) {
	*info = -2;
    } else if (! lsame_(trans, "N") && ! lsame_(trans, 
	    "C")) {
	*info = -3;
    } else if (*m < 0) {
	*info = -4;
    } else if (*n < 0) {
	*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) {
	if (upper) {
	    if (left) {
		i__1[0] = 1, a__1[0] = side;
		i__1[1] = 1, a__1[1] = trans;
		s_cat(ch__1, a__1, i__1, &zunmtr_c__2, (ftnlen)2);
		i__2 = *m - 1;
		i__3 = *m - 1;
		nb = ilaenv_(&zunmtr_c__1, "ZUNMQL", ch__1, &i__2, n, &i__3, &zunmtr_c_n1);
	    } else {
		i__1[0] = 1, a__1[0] = side;
		i__1[1] = 1, a__1[1] = trans;
		s_cat(ch__1, a__1, i__1, &zunmtr_c__2, (ftnlen)2);
		i__2 = *n - 1;
		i__3 = *n - 1;
		nb = ilaenv_(&zunmtr_c__1, "ZUNMQL", ch__1, m, &i__2, &i__3, &zunmtr_c_n1);
	    }
	} else {
	    if (left) {
		i__1[0] = 1, a__1[0] = side;
		i__1[1] = 1, a__1[1] = trans;
		s_cat(ch__1, a__1, i__1, &zunmtr_c__2, (ftnlen)2);
		i__2 = *m - 1;
		i__3 = *m - 1;
		nb = ilaenv_(&zunmtr_c__1, "ZUNMQR", ch__1, &i__2, n, &i__3, &zunmtr_c_n1);
	    } else {
		i__1[0] = 1, a__1[0] = side;
		i__1[1] = 1, a__1[1] = trans;
		s_cat(ch__1, a__1, i__1, &zunmtr_c__2, (ftnlen)2);
		i__2 = *n - 1;
		i__3 = *n - 1;
		nb = ilaenv_(&zunmtr_c__1, "ZUNMQR", ch__1, m, &i__2, &i__3, &zunmtr_c_n1);
	    }
	}
	lwkopt = max(1,nw) * nb;
	work[1].r = (doublereal) lwkopt, work[1].i = 0.;
    }

    if (*info != 0) {
	i__2 = -(*info);
	vectcl_xerbla(interp, "ZUNMTR", &i__2);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


    if (*m == 0 || *n == 0 || nq == 1) {
	work[1].r = 1., work[1].i = 0.;
return TCL_OK;
    }

    if (left) {
	mi = *m - 1;
	ni = *n;
    } else {
	mi = *m;
	ni = *n - 1;
    }

    if (upper) {


	i__2 = nq - 1;
	if (zunmql_(interp, side, trans, &mi, &ni, &i__2, &a[(a_dim1 << 1) + 1], lda, &		tau[1], &c__[c_offset], ldc, &work[1], lwork, &iinfo)!=TCL_OK) { return TCL_ERROR; }


    } else {


	if (left) {
	    i1 = 2;
	    i2 = 1;
	} else {
	    i1 = 1;
	    i2 = 2;
	}
	i__2 = nq - 1;
	if (zunmqr_(interp, side, trans, &mi, &ni, &i__2, &a[a_dim1 + 2], lda, &tau[1], &		c__[i1 + i2 * c_dim1], ldc, &work[1], lwork, &iinfo)!=TCL_OK) { return TCL_ERROR; }


    }
    work[1].r = (doublereal) lwkopt, work[1].i = 0.;
return TCL_OK;


} /* zunmtr_ */
static /* Subroutine */ int drot_ (Tcl_Interp *interp, integer *n, doublereal *dx, integer *incx, 	doublereal *dy, integer *incy, doublereal *c__, doublereal *s)
{
    integer i__1;

    integer i__, ix, iy;
    doublereal dtemp;





    --dy;
    --dx;

    if (*n <= 0) {
return TCL_OK;
    }
    if (*incx == 1 && *incy == 1) {
	goto L20;
    }


    ix = 1;
    iy = 1;
    if (*incx < 0) {
	ix = (-(*n) + 1) * *incx + 1;
    }
    if (*incy < 0) {
	iy = (-(*n) + 1) * *incy + 1;
    }
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	dtemp = *c__ * dx[ix] + *s * dy[iy];
	dy[iy] = *c__ * dy[iy] - *s * dx[ix];
	dx[ix] = dtemp;
	ix += *incx;
	iy += *incy;
    }
return TCL_OK;


L20:
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	dtemp = *c__ * dx[i__] + *s * dy[i__];
	dy[i__] = *c__ * dy[i__] - *s * dx[i__];
	dx[i__] = dtemp;
    }
return TCL_OK;
} /* drot_ */
static doublereal dnrm2_ (integer *n, doublereal *x, integer *incx)
{
    integer i__1, i__2;
    doublereal ret_val, d__1;

    double sqrt(doublereal);

    integer ix;
    doublereal ssq, norm, scale, absxi;








    --x;

    if (*n < 1 || *incx < 1) {
	norm = 0.;
    } else if (*n == 1) {
	norm = abs(x[1]);
    } else {
	scale = 0.;
	ssq = 1.;

	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], abs(d__1));
		if (scale < absxi) {
		    d__1 = scale / absxi;
		    ssq = ssq * (d__1 * d__1) + 1.;
		    scale = absxi;
		} else {
		    d__1 = absxi / scale;
		    ssq += d__1 * d__1;
		}
	    }
	}
	norm = scale * sqrt(ssq);
    }

    ret_val = norm;
    return ret_val;


} /* dnrm2_ */
static doublereal dlapy2_ (doublereal *x, doublereal *y)
{
    doublereal ret_val, d__1;

    double sqrt(doublereal);

    doublereal w, z__, xabs, yabs;










    xabs = abs(*x);
    yabs = abs(*y);
    w = max(xabs,yabs);
    z__ = min(xabs,yabs);
    if (z__ == 0.) {
	ret_val = w;
    } else {
	d__1 = z__ / w;
	ret_val = w * sqrt(d__1 * d__1 + 1.);
    }
    return ret_val;


} /* dlapy2_ */
static /* Subroutine */ int dlabad_ (Tcl_Interp *interp, doublereal *small, doublereal *large)
{
    double d_lg10(doublereal *), sqrt(doublereal);












    if (d_lg10(large) > 2e3) {
	*small = sqrt(*small);
	*large = sqrt(*large);
    }

return TCL_OK;


} /* dlabad_ */
static /* Subroutine */ int dgebak_ (Tcl_Interp *interp, char *job, char *side, integer *n, integer *ilo, 	integer *ihi, doublereal *scale, integer *m, doublereal *v, integer *	ldv, integer *info)
{
    integer v_dim1, v_offset, i__1;

    integer i__, k;
    doublereal s;
    integer ii;
    logical leftv;
    logical rightv;



















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

    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);
	vectcl_xerbla(interp, "DGEBAK", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


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

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


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

	if (rightv) {
	    i__1 = *ihi;
	    for (i__ = *ilo; i__ <= i__1; ++i__) {
		s = scale[i__];
		if (dscal_(interp, m, &s, &v[i__ + v_dim1], ldv)!=TCL_OK) { return TCL_ERROR; }

	    }
	}

	if (leftv) {
	    i__1 = *ihi;
	    for (i__ = *ilo; i__ <= i__1; ++i__) {
		s = 1. / scale[i__];
		if (dscal_(interp, m, &s, &v[i__ + v_dim1], ldv)!=TCL_OK) { return TCL_ERROR; }

	    }
	}

    }



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;
		}
		if (dswap_(interp, m, &v[i__ + v_dim1], ldv, &v[k + v_dim1], ldv)!=TCL_OK) { return TCL_ERROR; }

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;
		}
		if (dswap_(interp, m, &v[i__ + v_dim1], ldv, &v[k + v_dim1], ldv)!=TCL_OK) { return TCL_ERROR; }

L50:
		;
	    }
	}
    }

return TCL_OK;


} /* dgebak_ */
static /* Subroutine */ int dgebal_ (Tcl_Interp *interp, char *job, integer *n, doublereal *a, integer *	lda, integer *ilo, integer *ihi, doublereal *scale, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2;
    doublereal d__1, d__2;

    doublereal c__, f, g;
    integer i__, j, k, l, m;
    doublereal r__, s, ca, ra;
    integer ica, ira, iexc;
    doublereal sfmin1, sfmin2, sfmax1, sfmax2;
    logical noconv;


























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

    *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);
	vectcl_xerbla(interp, "DGEBAL", &i__1);
return TCL_ERROR;

return TCL_OK;
    }

    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.;
	}
	goto L210;
    }

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


    goto L50;


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

    if (dswap_(interp, &l, &a[j * a_dim1 + 1], &dgebal_c__1, &a[m * a_dim1 + 1], &dgebal_c__1)!=TCL_OK) { return TCL_ERROR; }

    i__1 = *n - k + 1;
    if (dswap_(interp, &i__1, &a[j + k * a_dim1], lda, &a[m + k * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }


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


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[j + i__ * a_dim1] != 0.) {
		goto L70;
	    }
L60:
	    ;
	}

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

    goto L90;


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[i__ + j * a_dim1] != 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.;
    }

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



    sfmin1 = dlamch_("S") / dlamch_("P");
    sfmax1 = 1. / sfmin1;
    sfmin2 = sfmin1 * 2.;
    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[j + i__ * a_dim1], abs(d__1));
	    r__ += (d__1 = a[i__ + j * a_dim1], abs(d__1));
L150:
	    ;
	}
	ica = idamax_(&l, &a[i__ * a_dim1 + 1], &dgebal_c__1);
	ca = (d__1 = a[ica + i__ * a_dim1], abs(d__1));
	i__2 = *n - k + 1;
	ira = idamax_(&i__2, &a[i__ + k * a_dim1], lda);
	ra = (d__1 = a[i__ + (ira + k - 1) * a_dim1], abs(d__1));


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

L170:
	g = c__ / 2.;
L180:
	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 /= 2.;
	c__ /= 2.;
	g /= 2.;
	ca /= 2.;
	r__ *= 2.;
	ra *= 2.;
	goto L180;


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;
	if (dscal_(interp, &i__2, &g, &a[i__ + k * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }

	if (dscal_(interp, &l, &f, &a[i__ * a_dim1 + 1], &dgebal_c__1)!=TCL_OK) { return TCL_ERROR; }


L200:
	;
    }

    if (noconv) {
	goto L140;
    }

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

return TCL_OK;


} /* dgebal_ */
static /* Subroutine */ int dgehrd_ (Tcl_Interp *interp, integer *n, integer *ilo, integer *ihi, 	doublereal *a, integer *lda, doublereal *tau, doublereal *work, 	integer *lwork, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4;

    integer i__, j;
    doublereal t[4160]	/* was [65][64] */;
    integer ib;
    doublereal ei;
    integer nb, nh, nx, iws;
    integer nbmin, iinfo;
    integer ldwork, lwkopt;
    logical lquery;






























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

    *info = 0;
    i__1 = 64, i__2 = ilaenv_(&dgehrd_c__1, "DGEHRD", " ", n, ilo, ihi, &dgehrd_c_n1);
    nb = min(i__1,i__2);
    lwkopt = *n * nb;
    work[1] = (doublereal) 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);
	vectcl_xerbla(interp, "DGEHRD", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


    i__1 = *ilo - 1;
    for (i__ = 1; i__ <= i__1; ++i__) {
	tau[i__] = 0.;
    }
    i__1 = *n - 1;
    for (i__ = max(1,*ihi); i__ <= i__1; ++i__) {
	tau[i__] = 0.;
    }


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


    i__1 = 64, i__2 = ilaenv_(&dgehrd_c__1, "DGEHRD", " ", n, ilo, ihi, &dgehrd_c_n1);
    nb = min(i__1,i__2);
    nbmin = 2;
    iws = 1;
    if (nb > 1 && nb < nh) {


	i__1 = nb, i__2 = ilaenv_(&dgehrd_c__3, "DGEHRD", " ", n, ilo, ihi, &dgehrd_c_n1);
	nx = max(i__1,i__2);
	if (nx < nh) {


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


		i__1 = 2, i__2 = ilaenv_(&dgehrd_c__2, "DGEHRD", " ", n, ilo, ihi, &
			dgehrd_c_n1);
		nbmin = max(i__1,i__2);
		if (*lwork >= *n * nbmin) {
		    nb = *lwork / *n;
		} else {
		    nb = 1;
		}
	    }
	}
    }
    ldwork = *n;

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


	i__ = *ilo;

    } else {


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


	    if (dlahr2_(interp, ihi, &i__, &ib, &a[i__ * a_dim1 + 1], lda, &tau[i__], t, &		    dgehrd_c__65, &work[1], &ldwork)!=TCL_OK) { return TCL_ERROR; }




	    ei = a[i__ + ib + (i__ + ib - 1) * a_dim1];
	    a[i__ + ib + (i__ + ib - 1) * a_dim1] = 1.;
	    i__3 = *ihi - i__ - ib + 1;
	    if (dgemm_(interp, "No transpose", "Transpose", ihi, &i__3, &ib, &dgehrd_c_b25, &		    work[1], &ldwork, &a[i__ + ib + i__ * a_dim1], lda, &
		    dgehrd_c_b26, &a[(i__ + ib) * a_dim1 + 1], lda)!=TCL_OK) { return TCL_ERROR; }


	    a[i__ + ib + (i__ + ib - 1) * a_dim1] = ei;


	    i__3 = ib - 1;
	    if (dtrmm_(interp, "Right", "Lower", "Transpose", "Unit", &i__, &i__3, &dgehrd_c_b26, 		     &a[i__ + 1 + i__ * a_dim1], lda, &work[1], &ldwork)!=TCL_OK) { return TCL_ERROR; }


	    i__3 = ib - 2;
	    for (j = 0; j <= i__3; ++j) {
		if (daxpy_(interp, &i__, &dgehrd_c_b25, &work[ldwork * j + 1], &dgehrd_c__1, &a[(i__ + 			j + 1) * a_dim1 + 1], &dgehrd_c__1)!=TCL_OK) { return TCL_ERROR; }


	    }


	    i__3 = *ihi - i__;
	    i__4 = *n - i__ - ib + 1;
	    if (dlarfb_(interp, "Left", "Transpose", "Forward", "Columnwise", &i__3, &		    i__4, &ib, &a[i__ + 1 + i__ * a_dim1], lda, t, &dgehrd_c__65, &a[
		    i__ + 1 + (i__ + ib) * a_dim1], lda, &work[1], &ldwork)!=TCL_OK) { return TCL_ERROR; }


	}
    }


    if (dgehd2_(interp, n, &i__, ihi, &a[a_offset], lda, &tau[1], &work[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }

    work[1] = (doublereal) iws;

return TCL_OK;


} /* dgehrd_ */
static integer idamax_ (integer *n, doublereal *dx, integer *incx)
{
    integer ret_val, i__1;
    doublereal d__1;

    integer i__, ix;
    doublereal dmax__;





    --dx;

    ret_val = 0;
    if (*n < 1 || *incx <= 0) {
	return ret_val;
    }
    ret_val = 1;
    if (*n == 1) {
	return ret_val;
    }
    if (*incx == 1) {
	goto L20;
    }


    ix = 1;
    dmax__ = abs(dx[1]);
    ix += *incx;
    i__1 = *n;
    for (i__ = 2; i__ <= i__1; ++i__) {
	if ((d__1 = dx[ix], abs(d__1)) <= dmax__) {
	    goto L5;
	}
	ret_val = i__;
	dmax__ = (d__1 = dx[ix], abs(d__1));
L5:
	ix += *incx;
    }
    return ret_val;


L20:
    dmax__ = abs(dx[1]);
    i__1 = *n;
    for (i__ = 2; i__ <= i__1; ++i__) {
	if ((d__1 = dx[i__], abs(d__1)) <= dmax__) {
	    goto L30;
	}
	ret_val = i__;
	dmax__ = (d__1 = dx[i__], abs(d__1));
L30:
	;
    }
    return ret_val;
} /* idamax_ */
static /* Subroutine */ int dlartg_ (Tcl_Interp *interp, doublereal *f, doublereal *g, doublereal *cs, 	doublereal *sn, doublereal *r__)
{
    integer i__1;
    doublereal d__1, d__2;

    double log(doublereal), pow_di(doublereal *, integer *), sqrt(doublereal);

    integer i__;
    doublereal f1, g1, eps, scale;
    integer count;
    doublereal safmn2, safmx2;
    doublereal safmin;


















    safmin = dlamch_("S");
    eps = dlamch_("E");
    d__1 = dlamch_("B");
    i__1 = (integer) (log(safmin / eps) / log(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;
	d__1 = abs(f1), d__2 = abs(g1);
	scale = max(d__1,d__2);
	if (scale >= safmx2) {
	    count = 0;
L10:
	    ++count;
	    f1 *= safmn2;
	    g1 *= safmn2;
	    d__1 = abs(f1), d__2 = abs(g1);
	    scale = max(d__1,d__2);
	    if (scale >= safmx2) {
		goto L10;
	    }
	    d__1 = f1;
	    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;
	    }
	} else if (scale <= safmn2) {
	    count = 0;
L30:
	    ++count;
	    f1 *= safmx2;
	    g1 *= safmx2;
	    d__1 = abs(f1), d__2 = abs(g1);
	    scale = max(d__1,d__2);
	    if (scale <= safmn2) {
		goto L30;
	    }
	    d__1 = f1;
	    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;
	    }
	} else {
	    d__1 = f1;
	    d__2 = g1;
	    *r__ = sqrt(d__1 * d__1 + d__2 * d__2);
	    *cs = f1 / *r__;
	    *sn = g1 / *r__;
	}
	if (abs(*f) > abs(*g) && *cs < 0.) {
	    *cs = -(*cs);
	    *sn = -(*sn);
	    *r__ = -(*r__);
	}
    }
return TCL_OK;


} /* dlartg_ */
static /* Subroutine */ int dorghr_ (Tcl_Interp *interp, integer *n, integer *ilo, integer *ihi, 	doublereal *a, integer *lda, doublereal *tau, doublereal *work, 	integer *lwork, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2;

    integer i__, j, nb, nh, iinfo;
    integer lwkopt;
    logical lquery;




















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

    *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 = ilaenv_(&dorghr_c__1, "DORGQR", " ", &nh, &nh, &nh, &dorghr_c_n1);
	lwkopt = max(1,nh) * nb;
	work[1] = (doublereal) lwkopt;
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DORGHR", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


    if (*n == 0) {
	work[1] = 1.;
return TCL_OK;
    }


    i__1 = *ilo + 1;
    for (j = *ihi; j >= i__1; --j) {
	i__2 = j - 1;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    a[i__ + j * a_dim1] = 0.;
	}
	i__2 = *ihi;
	for (i__ = j + 1; i__ <= i__2; ++i__) {
	    a[i__ + j * a_dim1] = a[i__ + (j - 1) * a_dim1];
	}
	i__2 = *n;
	for (i__ = *ihi + 1; i__ <= i__2; ++i__) {
	    a[i__ + j * a_dim1] = 0.;
	}
    }
    i__1 = *ilo;
    for (j = 1; j <= i__1; ++j) {
	i__2 = *n;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    a[i__ + j * a_dim1] = 0.;
	}
	a[j + j * a_dim1] = 1.;
    }
    i__1 = *n;
    for (j = *ihi + 1; j <= i__1; ++j) {
	i__2 = *n;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    a[i__ + j * a_dim1] = 0.;
	}
	a[j + j * a_dim1] = 1.;
    }

    if (nh > 0) {


	if (dorgqr_(interp, &nh, &nh, &nh, &a[*ilo + 1 + (*ilo + 1) * a_dim1], lda, &tau[*		ilo], &work[1], lwork, &iinfo)!=TCL_OK) { return TCL_ERROR; }


    }
    work[1] = (doublereal) lwkopt;
return TCL_OK;


} /* dorghr_ */
static /* Subroutine */ int dhseqr_ (Tcl_Interp *interp, char *job, char *compz, integer *n, integer *ilo, 	 integer *ihi, doublereal *h__, integer *ldh, doublereal *wr, 	doublereal *wi, doublereal *z__, integer *ldz, doublereal *work, 	integer *lwork, integer *info)
{
    address a__1[2];
    integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2[2], i__3;
    doublereal d__1;
    char ch__1[2];

    /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);

    integer i__;
    doublereal hl[2401]	/* was [49][49] */;
    integer kbot, nmin;
    logical initz;
    doublereal workl[49];
    logical wantt, wantz;
    logical lquery;

















































    h_dim1 = *ldh;
    h_offset = 1 + h_dim1;
    h__ -= h_offset;
    --wr;
    --wi;
    z_dim1 = *ldz;
    z_offset = 1 + z_dim1;
    z__ -= z_offset;
    --work;

    wantt = lsame_(job, "S");
    initz = lsame_(compz, "I");
    wantz = initz || lsame_(compz, "V");
    work[1] = (doublereal) max(1,*n);
    lquery = *lwork == -1;

    *info = 0;
    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);
	vectcl_xerbla(interp, "DHSEQR", &i__1);
return TCL_ERROR;

return TCL_OK;

    } else if (*n == 0) {


return TCL_OK;

    } else if (lquery) {


	if (dlaqr0_(interp, &wantt, &wantz, n, ilo, ihi, &h__[h_offset], ldh, &wr[1], &wi[		1], ilo, ihi, &z__[z_offset], ldz, &work[1], lwork, info)!=TCL_OK) { return TCL_ERROR; }


	d__1 = (doublereal) max(1,*n);
	work[1] = max(d__1,work[1]);
return TCL_OK;

    } else {


	i__1 = *ilo - 1;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    wr[i__] = h__[i__ + i__ * h_dim1];
	    wi[i__] = 0.;
	}
	i__1 = *n;
	for (i__ = *ihi + 1; i__ <= i__1; ++i__) {
	    wr[i__] = h__[i__ + i__ * h_dim1];
	    wi[i__] = 0.;
	}


	if (initz) {
	    if (dlaset_(interp, "A", n, n, &dhseqr_c_b11, &dhseqr_c_b12, &z__[z_offset], ldz)		    !=TCL_OK) { return TCL_ERROR; }


	}


	if (*ilo == *ihi) {
	    wr[*ilo] = h__[*ilo + *ilo * h_dim1];
	    wi[*ilo] = 0.;
return TCL_OK;
	}


	i__2[0] = 1, a__1[0] = job;
	i__2[1] = 1, a__1[1] = compz;
	s_cat(ch__1, a__1, i__2, &dhseqr_c__2, (ftnlen)2);
	nmin = ilaenv_(&dhseqr_c__12, "DHSEQR", ch__1, n, ilo, ihi, lwork);
	nmin = max(11,nmin);


	if (*n > nmin) {
	    if (dlaqr0_(interp, &wantt, &wantz, n, ilo, ihi, &h__[h_offset], ldh, &wr[1], 		    &wi[1], ilo, ihi, &z__[z_offset], ldz, &work[1], lwork, 
		    info)!=TCL_OK) { return TCL_ERROR; }


	} else {


	    if (dlahqr_(interp, &wantt, &wantz, n, ilo, ihi, &h__[h_offset], ldh, &wr[1], 		    &wi[1], ilo, ihi, &z__[z_offset], ldz, info)!=TCL_OK) { return TCL_ERROR; }



	    if (*info > 0) {


		kbot = *info;

		if (*n >= 49) {


		    if (dlaqr0_(interp, &wantt, &wantz, n, ilo, &kbot, &h__[h_offset], 			    ldh, &wr[1], &wi[1], ilo, ihi, &z__[z_offset], 
			    ldz, &work[1], lwork, info)!=TCL_OK) { return TCL_ERROR; }



		} else {


		    if (dlacpy_(interp, "A", n, n, &h__[h_offset], ldh, hl, &dhseqr_c__49)!=TCL_OK) { return TCL_ERROR; }

		    hl[*n + 1 + *n * 49 - 50] = 0.;
		    i__1 = 49 - *n;
		    if (dlaset_(interp, "A", &dhseqr_c__49, &i__1, &dhseqr_c_b11, &dhseqr_c_b11, &hl[(*n + 1) *			     49 - 49], &dhseqr_c__49)!=TCL_OK) { return TCL_ERROR; }


		    if (dlaqr0_(interp, &wantt, &wantz, &dhseqr_c__49, ilo, &kbot, hl, &dhseqr_c__49, &			    wr[1], &wi[1], ilo, ihi, &z__[z_offset], ldz, 
			    workl, &dhseqr_c__49, info)!=TCL_OK) { return TCL_ERROR; }


		    if (wantt || *info != 0) {
			if (dlacpy_(interp, "A", n, n, hl, &dhseqr_c__49, &h__[h_offset], ldh)!=TCL_OK) { return TCL_ERROR; }

		    }
		}
	    }
	}


	if ((wantt || *info != 0) && *n > 2) {
	    i__1 = *n - 2;
	    i__3 = *n - 2;
	    if (dlaset_(interp, "L", &i__1, &i__3, &dhseqr_c_b11, &dhseqr_c_b11, &h__[h_dim1 + 3], ldh)!=TCL_OK) { return TCL_ERROR; }

	}


	d__1 = (doublereal) max(1,*n);
	work[1] = max(d__1,work[1]);
    }


return TCL_OK;
} /* dhseqr_ */
static /* Subroutine */ int dtrevc_ (Tcl_Interp *interp, char *side, char *howmny, logical *select, 	integer *n, doublereal *t, integer *ldt, doublereal *vl, integer *	ldvl, doublereal *vr, integer *ldvr, integer *mm, integer *m, 	doublereal *work, integer *info)
{
    integer t_dim1, t_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1, 
	    i__2, i__3;
    doublereal d__1, d__2, d__3, d__4;

    double sqrt(doublereal);

    integer i__, j, k;
    doublereal x[4]	/* was [2][2] */;
    integer j1, j2, n2, ii, ki, ip, is;
    doublereal wi, wr, rec, ulp, beta, emax;
    logical pair;
    logical allv;
    integer ierr;
    doublereal unfl, ovfl, smin;
    logical over;
    doublereal vmax;
    integer jnxt;
    doublereal scale;
    doublereal remax;
    logical leftv, bothv;
    doublereal vcrit;
    logical somev;
    doublereal xnorm;
    doublereal bignum;
    logical rightv;
    doublereal smlnum;































    --select;
    t_dim1 = *ldt;
    t_offset = 1 + t_dim1;
    t -= t_offset;
    vl_dim1 = *ldvl;
    vl_offset = 1 + vl_dim1;
    vl -= vl_offset;
    vr_dim1 = *ldvr;
    vr_offset = 1 + vr_dim1;
    vr -= vr_offset;
    --work;

    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 {


	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[j + 1 + j * t_dim1] == 0.) {
			    if (select[j]) {
				++(*m);
			    }
			} else {
			    pair = TRUE_;
			    if (select[j] || select[j + 1]) {
				select[j] = TRUE_;
				*m += 2;
			    }
			}
		    } else {
			if (select[*n]) {
			    ++(*m);
			}
		    }
		}
	    }
	} else {
	    *m = *n;
	}

	if (*mm < *m) {
	    *info = -11;
	}
    }
    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DTREVC", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


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


    unfl = dlamch_("Safe minimum");
    ovfl = 1. / unfl;
    if (dlabad_(interp, &unfl, &ovfl)!=TCL_OK) { return TCL_ERROR; }

    ulp = dlamch_("Precision");
    smlnum = unfl * (*n / ulp);
    bignum = (1. - ulp) / smlnum;


    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[i__ + j * t_dim1], abs(d__1));
	}
    }


    n2 = *n << 1;

    if (rightv) {


	ip = 0;
	is = *m;
	for (ki = *n; ki >= 1; --ki) {

	    if (ip == 1) {
		goto L130;
	    }
	    if (ki == 1) {
		goto L40;
	    }
	    if (t[ki + (ki - 1) * t_dim1] == 0.) {
		goto L40;
	    }
	    ip = -1;

L40:
	    if (somev) {
		if (ip == 0) {
		    if (! select[ki]) {
			goto L130;
		    }
		} else {
		    if (! select[ki - 1]) {
			goto L130;
		    }
		}
	    }


	    wr = t[ki + ki * t_dim1];
	    wi = 0.;
	    if (ip != 0) {
		wi = sqrt((d__1 = t[ki + (ki - 1) * t_dim1], abs(d__1))) * 
			sqrt((d__2 = t[ki - 1 + ki * t_dim1], abs(d__2)));
	    }
	    d__1 = ulp * (abs(wr) + abs(wi));
	    smin = max(d__1,smlnum);

	    if (ip == 0) {


		work[ki + *n] = 1.;


		i__1 = ki - 1;
		for (k = 1; k <= i__1; ++k) {
		    work[k + *n] = -t[k + ki * t_dim1];
		}


		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[j + (j - 1) * t_dim1] != 0.) {
			    j1 = j - 1;
			    jnxt = j - 2;
			}
		    }

		    if (j1 == j2) {


			if (dlaln2_(interp, &dtrevc_c_false, &dtrevc_c__1, &dtrevc_c__1, &smin, &dtrevc_c_b22, &t[j + 				j * t_dim1], ldt, &dtrevc_c_b22, &dtrevc_c_b22, &work[j + *
				n], n, &wr, &dtrevc_c_b25, x, &dtrevc_c__2, &scale, &xnorm, 
				&ierr)!=TCL_OK) { return TCL_ERROR; }




			if (xnorm > 1.) {
			    if (work[j] > bignum / xnorm) {
				x[0] /= xnorm;
				scale /= xnorm;
			    }
			}


			if (scale != 1.) {
			    if (dscal_(interp, &ki, &scale, &work[*n + 1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }

			}
			work[j + *n] = x[0];


			i__1 = j - 1;
			d__1 = -x[0];
			if (daxpy_(interp, &i__1, &d__1, &t[j * t_dim1 + 1], &dtrevc_c__1, &work[				*n + 1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }



		    } else {


			if (dlaln2_(interp, &dtrevc_c_false, &dtrevc_c__2, &dtrevc_c__1, &smin, &dtrevc_c_b22, &t[j - 				1 + (j - 1) * t_dim1], ldt, &dtrevc_c_b22, &dtrevc_c_b22, &
				work[j - 1 + *n], n, &wr, &dtrevc_c_b25, x, &dtrevc_c__2, &
				scale, &xnorm, &ierr)!=TCL_OK) { return TCL_ERROR; }




			if (xnorm > 1.) {
			    d__1 = work[j - 1], d__2 = work[j];
			    beta = max(d__1,d__2);
			    if (beta > bignum / xnorm) {
				x[0] /= xnorm;
				x[1] /= xnorm;
				scale /= xnorm;
			    }
			}


			if (scale != 1.) {
			    if (dscal_(interp, &ki, &scale, &work[*n + 1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }

			}
			work[j - 1 + *n] = x[0];
			work[j + *n] = x[1];


			i__1 = j - 2;
			d__1 = -x[0];
			if (daxpy_(interp, &i__1, &d__1, &t[(j - 1) * t_dim1 + 1], &dtrevc_c__1, 				&work[*n + 1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }


			i__1 = j - 2;
			d__1 = -x[1];
			if (daxpy_(interp, &i__1, &d__1, &t[j * t_dim1 + 1], &dtrevc_c__1, &work[				*n + 1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }


		    }
L60:
		    ;
		}


		if (! over) {
		    if (dcopy_(interp, &ki, &work[*n + 1], &dtrevc_c__1, &vr[is * vr_dim1 + 1], &			    dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }



		    ii = idamax_(&ki, &vr[is * vr_dim1 + 1], &dtrevc_c__1);
		    remax = 1. / (d__1 = vr[ii + is * vr_dim1], abs(d__1));
		    if (dscal_(interp, &ki, &remax, &vr[is * vr_dim1 + 1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }


		    i__1 = *n;
		    for (k = ki + 1; k <= i__1; ++k) {
			vr[k + is * vr_dim1] = 0.;
		    }
		} else {
		    if (ki > 1) {
			i__1 = ki - 1;
			if (dgemv_(interp, "N", n, &i__1, &dtrevc_c_b22, &vr[vr_offset], ldvr, &				work[*n + 1], &dtrevc_c__1, &work[ki + *n], &vr[ki * 
				vr_dim1 + 1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }


		    }

		    ii = idamax_(n, &vr[ki * vr_dim1 + 1], &dtrevc_c__1);
		    remax = 1. / (d__1 = vr[ii + ki * vr_dim1], abs(d__1));
		    if (dscal_(interp, n, &remax, &vr[ki * vr_dim1 + 1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }

		}

	    } else {



		if ((d__1 = t[ki - 1 + ki * t_dim1], abs(d__1)) >= (d__2 = t[
			ki + (ki - 1) * t_dim1], abs(d__2))) {
		    work[ki - 1 + *n] = 1.;
		    work[ki + n2] = wi / t[ki - 1 + ki * t_dim1];
		} else {
		    work[ki - 1 + *n] = -wi / t[ki + (ki - 1) * t_dim1];
		    work[ki + n2] = 1.;
		}
		work[ki + *n] = 0.;
		work[ki - 1 + n2] = 0.;


		i__1 = ki - 2;
		for (k = 1; k <= i__1; ++k) {
		    work[k + *n] = -work[ki - 1 + *n] * t[k + (ki - 1) * 
			    t_dim1];
		    work[k + n2] = -work[ki + n2] * t[k + ki * t_dim1];
		}


		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[j + (j - 1) * t_dim1] != 0.) {
			    j1 = j - 1;
			    jnxt = j - 2;
			}
		    }

		    if (j1 == j2) {


			if (dlaln2_(interp, &dtrevc_c_false, &dtrevc_c__1, &dtrevc_c__2, &smin, &dtrevc_c_b22, &t[j + 				j * t_dim1], ldt, &dtrevc_c_b22, &dtrevc_c_b22, &work[j + *
				n], n, &wr, &wi, x, &dtrevc_c__2, &scale, &xnorm, &
				ierr)!=TCL_OK) { return TCL_ERROR; }




			if (xnorm > 1.) {
			    if (work[j] > bignum / xnorm) {
				x[0] /= xnorm;
				x[2] /= xnorm;
				scale /= xnorm;
			    }
			}


			if (scale != 1.) {
			    if (dscal_(interp, &ki, &scale, &work[*n + 1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }

			    if (dscal_(interp, &ki, &scale, &work[n2 + 1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }

			}
			work[j + *n] = x[0];
			work[j + n2] = x[2];


			i__1 = j - 1;
			d__1 = -x[0];
			if (daxpy_(interp, &i__1, &d__1, &t[j * t_dim1 + 1], &dtrevc_c__1, &work[				*n + 1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }


			i__1 = j - 1;
			d__1 = -x[2];
			if (daxpy_(interp, &i__1, &d__1, &t[j * t_dim1 + 1], &dtrevc_c__1, &work[				n2 + 1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }



		    } else {


			if (dlaln2_(interp, &dtrevc_c_false, &dtrevc_c__2, &dtrevc_c__2, &smin, &dtrevc_c_b22, &t[j - 				1 + (j - 1) * t_dim1], ldt, &dtrevc_c_b22, &dtrevc_c_b22, &
				work[j - 1 + *n], n, &wr, &wi, x, &dtrevc_c__2, &
				scale, &xnorm, &ierr)!=TCL_OK) { return TCL_ERROR; }




			if (xnorm > 1.) {
			    d__1 = work[j - 1], d__2 = work[j];
			    beta = max(d__1,d__2);
			    if (beta > bignum / xnorm) {
				rec = 1. / xnorm;
				x[0] *= rec;
				x[2] *= rec;
				x[1] *= rec;
				x[3] *= rec;
				scale *= rec;
			    }
			}


			if (scale != 1.) {
			    if (dscal_(interp, &ki, &scale, &work[*n + 1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }

			    if (dscal_(interp, &ki, &scale, &work[n2 + 1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }

			}
			work[j - 1 + *n] = x[0];
			work[j + *n] = x[1];
			work[j - 1 + n2] = x[2];
			work[j + n2] = x[3];


			i__1 = j - 2;
			d__1 = -x[0];
			if (daxpy_(interp, &i__1, &d__1, &t[(j - 1) * t_dim1 + 1], &dtrevc_c__1, 				&work[*n + 1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }


			i__1 = j - 2;
			d__1 = -x[1];
			if (daxpy_(interp, &i__1, &d__1, &t[j * t_dim1 + 1], &dtrevc_c__1, &work[				*n + 1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }


			i__1 = j - 2;
			d__1 = -x[2];
			if (daxpy_(interp, &i__1, &d__1, &t[(j - 1) * t_dim1 + 1], &dtrevc_c__1, 				&work[n2 + 1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }


			i__1 = j - 2;
			d__1 = -x[3];
			if (daxpy_(interp, &i__1, &d__1, &t[j * t_dim1 + 1], &dtrevc_c__1, &work[				n2 + 1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }


		    }
L90:
		    ;
		}


		if (! over) {
		    if (dcopy_(interp, &ki, &work[*n + 1], &dtrevc_c__1, &vr[(is - 1) * vr_dim1 			    + 1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }


		    if (dcopy_(interp, &ki, &work[n2 + 1], &dtrevc_c__1, &vr[is * vr_dim1 + 1], &			    dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }



		    emax = 0.;
		    i__1 = ki;
		    for (k = 1; k <= i__1; ++k) {
			d__3 = emax, d__4 = (d__1 = vr[k + (is - 1) * vr_dim1]
				, abs(d__1)) + (d__2 = vr[k + is * vr_dim1], 
				abs(d__2));
			emax = max(d__3,d__4);
		    }

		    remax = 1. / emax;
		    if (dscal_(interp, &ki, &remax, &vr[(is - 1) * vr_dim1 + 1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }

		    if (dscal_(interp, &ki, &remax, &vr[is * vr_dim1 + 1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }


		    i__1 = *n;
		    for (k = ki + 1; k <= i__1; ++k) {
			vr[k + (is - 1) * vr_dim1] = 0.;
			vr[k + is * vr_dim1] = 0.;
		    }

		} else {

		    if (ki > 2) {
			i__1 = ki - 2;
			if (dgemv_(interp, "N", n, &i__1, &dtrevc_c_b22, &vr[vr_offset], ldvr, &				work[*n + 1], &dtrevc_c__1, &work[ki - 1 + *n], &vr[(
				ki - 1) * vr_dim1 + 1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }


			i__1 = ki - 2;
			if (dgemv_(interp, "N", n, &i__1, &dtrevc_c_b22, &vr[vr_offset], ldvr, &				work[n2 + 1], &dtrevc_c__1, &work[ki + n2], &vr[ki * 
				vr_dim1 + 1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }


		    } else {
			if (dscal_(interp, n, &work[ki - 1 + *n], &vr[(ki - 1) * vr_dim1 				+ 1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }


			if (dscal_(interp, n, &work[ki + n2], &vr[ki * vr_dim1 + 1], &				dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }


		    }

		    emax = 0.;
		    i__1 = *n;
		    for (k = 1; k <= i__1; ++k) {
			d__3 = emax, d__4 = (d__1 = vr[k + (ki - 1) * vr_dim1]
				, abs(d__1)) + (d__2 = vr[k + ki * vr_dim1], 
				abs(d__2));
			emax = max(d__3,d__4);
		    }
		    remax = 1. / emax;
		    if (dscal_(interp, n, &remax, &vr[(ki - 1) * vr_dim1 + 1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }

		    if (dscal_(interp, n, &remax, &vr[ki * vr_dim1 + 1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }

		}
	    }

	    --is;
	    if (ip != 0) {
		--is;
	    }
L130:
	    if (ip == 1) {
		ip = 0;
	    }
	    if (ip == -1) {
		ip = 1;
	    }
	}
    }

    if (leftv) {


	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[ki + 1 + ki * t_dim1] == 0.) {
		goto L150;
	    }
	    ip = 1;

L150:
	    if (somev) {
		if (! select[ki]) {
		    goto L250;
		}
	    }


	    wr = t[ki + ki * t_dim1];
	    wi = 0.;
	    if (ip != 0) {
		wi = sqrt((d__1 = t[ki + (ki + 1) * t_dim1], abs(d__1))) * 
			sqrt((d__2 = t[ki + 1 + ki * t_dim1], abs(d__2)));
	    }
	    d__1 = ulp * (abs(wr) + abs(wi));
	    smin = max(d__1,smlnum);

	    if (ip == 0) {


		work[ki + *n] = 1.;


		i__2 = *n;
		for (k = ki + 1; k <= i__2; ++k) {
		    work[k + *n] = -t[ki + k * t_dim1];
		}


		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[j + 1 + j * t_dim1] != 0.) {
			    j2 = j + 1;
			    jnxt = j + 2;
			}
		    }

		    if (j1 == j2) {



			if (work[j] > vcrit) {
			    rec = 1. / vmax;
			    i__3 = *n - ki + 1;
			    if (dscal_(interp, &i__3, &rec, &work[ki + *n], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }

			    vmax = 1.;
			    vcrit = bignum;
			}

			i__3 = j - ki - 1;
			work[j + *n] -= ddot_(&i__3, &t[ki + 1 + j * t_dim1], 
				&dtrevc_c__1, &work[ki + 1 + *n], &dtrevc_c__1);


			if (dlaln2_(interp, &dtrevc_c_false, &dtrevc_c__1, &dtrevc_c__1, &smin, &dtrevc_c_b22, &t[j + 				j * t_dim1], ldt, &dtrevc_c_b22, &dtrevc_c_b22, &work[j + *
				n], n, &wr, &dtrevc_c_b25, x, &dtrevc_c__2, &scale, &xnorm, 
				&ierr)!=TCL_OK) { return TCL_ERROR; }




			if (scale != 1.) {
			    i__3 = *n - ki + 1;
			    if (dscal_(interp, &i__3, &scale, &work[ki + *n], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }

			}
			work[j + *n] = x[0];
			d__2 = (d__1 = work[j + *n], abs(d__1));
			vmax = max(d__2,vmax);
			vcrit = bignum / vmax;

		    } else {



			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;
			    if (dscal_(interp, &i__3, &rec, &work[ki + *n], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }

			    vmax = 1.;
			    vcrit = bignum;
			}

			i__3 = j - ki - 1;
			work[j + *n] -= ddot_(&i__3, &t[ki + 1 + j * t_dim1], 
				&dtrevc_c__1, &work[ki + 1 + *n], &dtrevc_c__1);

			i__3 = j - ki - 1;
			work[j + 1 + *n] -= ddot_(&i__3, &t[ki + 1 + (j + 1) *
				 t_dim1], &dtrevc_c__1, &work[ki + 1 + *n], &dtrevc_c__1);


			if (dlaln2_(interp, &dtrevc_c_true, &dtrevc_c__2, &dtrevc_c__1, &smin, &dtrevc_c_b22, &t[j + 				j * t_dim1], ldt, &dtrevc_c_b22, &dtrevc_c_b22, &work[j + *
				n], n, &wr, &dtrevc_c_b25, x, &dtrevc_c__2, &scale, &xnorm, 
				&ierr)!=TCL_OK) { return TCL_ERROR; }




			if (scale != 1.) {
			    i__3 = *n - ki + 1;
			    if (dscal_(interp, &i__3, &scale, &work[ki + *n], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }

			}
			work[j + *n] = x[0];
			work[j + 1 + *n] = x[1];

			d__3 = (d__1 = work[j + *n], abs(d__1)), d__4 = (d__2 
				= work[j + 1 + *n], abs(d__2)), d__3 = max(
				d__3,d__4);
			vmax = max(d__3,vmax);
			vcrit = bignum / vmax;

		    }
L170:
		    ;
		}


		if (! over) {
		    i__2 = *n - ki + 1;
		    if (dcopy_(interp, &i__2, &work[ki + *n], &dtrevc_c__1, &vl[ki + is * 			    vl_dim1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }



		    i__2 = *n - ki + 1;
		    ii = idamax_(&i__2, &vl[ki + is * vl_dim1], &dtrevc_c__1) + ki - 
			    1;
		    remax = 1. / (d__1 = vl[ii + is * vl_dim1], abs(d__1));
		    i__2 = *n - ki + 1;
		    if (dscal_(interp, &i__2, &remax, &vl[ki + is * vl_dim1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }


		    i__2 = ki - 1;
		    for (k = 1; k <= i__2; ++k) {
			vl[k + is * vl_dim1] = 0.;
		    }

		} else {

		    if (ki < *n) {
			i__2 = *n - ki;
			if (dgemv_(interp, "N", n, &i__2, &dtrevc_c_b22, &vl[(ki + 1) * vl_dim1 				+ 1], ldvl, &work[ki + 1 + *n], &dtrevc_c__1, &work[
				ki + *n], &vl[ki * vl_dim1 + 1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }


		    }

		    ii = idamax_(n, &vl[ki * vl_dim1 + 1], &dtrevc_c__1);
		    remax = 1. / (d__1 = vl[ii + ki * vl_dim1], abs(d__1));
		    if (dscal_(interp, n, &remax, &vl[ki * vl_dim1 + 1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }


		}

	    } else {



		if ((d__1 = t[ki + (ki + 1) * t_dim1], abs(d__1)) >= (d__2 = 
			t[ki + 1 + ki * t_dim1], abs(d__2))) {
		    work[ki + *n] = wi / t[ki + (ki + 1) * t_dim1];
		    work[ki + 1 + n2] = 1.;
		} else {
		    work[ki + *n] = 1.;
		    work[ki + 1 + n2] = -wi / t[ki + 1 + ki * t_dim1];
		}
		work[ki + 1 + *n] = 0.;
		work[ki + n2] = 0.;


		i__2 = *n;
		for (k = ki + 2; k <= i__2; ++k) {
		    work[k + *n] = -work[ki + *n] * t[ki + k * t_dim1];
		    work[k + n2] = -work[ki + 1 + n2] * t[ki + 1 + k * t_dim1]
			    ;
		}


		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[j + 1 + j * t_dim1] != 0.) {
			    j2 = j + 1;
			    jnxt = j + 2;
			}
		    }

		    if (j1 == j2) {



			if (work[j] > vcrit) {
			    rec = 1. / vmax;
			    i__3 = *n - ki + 1;
			    if (dscal_(interp, &i__3, &rec, &work[ki + *n], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }

			    i__3 = *n - ki + 1;
			    if (dscal_(interp, &i__3, &rec, &work[ki + n2], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }

			    vmax = 1.;
			    vcrit = bignum;
			}

			i__3 = j - ki - 2;
			work[j + *n] -= ddot_(&i__3, &t[ki + 2 + j * t_dim1], 
				&dtrevc_c__1, &work[ki + 2 + *n], &dtrevc_c__1);
			i__3 = j - ki - 2;
			work[j + n2] -= ddot_(&i__3, &t[ki + 2 + j * t_dim1], 
				&dtrevc_c__1, &work[ki + 2 + n2], &dtrevc_c__1);


			d__1 = -wi;
			if (dlaln2_(interp, &dtrevc_c_false, &dtrevc_c__1, &dtrevc_c__2, &smin, &dtrevc_c_b22, &t[j + 				j * t_dim1], ldt, &dtrevc_c_b22, &dtrevc_c_b22, &work[j + *
				n], n, &wr, &d__1, x, &dtrevc_c__2, &scale, &xnorm, &
				ierr)!=TCL_OK) { return TCL_ERROR; }




			if (scale != 1.) {
			    i__3 = *n - ki + 1;
			    if (dscal_(interp, &i__3, &scale, &work[ki + *n], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }

			    i__3 = *n - ki + 1;
			    if (dscal_(interp, &i__3, &scale, &work[ki + n2], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }

			}
			work[j + *n] = x[0];
			work[j + n2] = x[2];
			d__3 = (d__1 = work[j + *n], abs(d__1)), d__4 = (d__2 
				= work[j + n2], abs(d__2)), d__3 = max(d__3,
				d__4);
			vmax = max(d__3,vmax);
			vcrit = bignum / vmax;

		    } else {



			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;
			    if (dscal_(interp, &i__3, &rec, &work[ki + *n], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }

			    i__3 = *n - ki + 1;
			    if (dscal_(interp, &i__3, &rec, &work[ki + n2], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }

			    vmax = 1.;
			    vcrit = bignum;
			}

			i__3 = j - ki - 2;
			work[j + *n] -= ddot_(&i__3, &t[ki + 2 + j * t_dim1], 
				&dtrevc_c__1, &work[ki + 2 + *n], &dtrevc_c__1);

			i__3 = j - ki - 2;
			work[j + n2] -= ddot_(&i__3, &t[ki + 2 + j * t_dim1], 
				&dtrevc_c__1, &work[ki + 2 + n2], &dtrevc_c__1);

			i__3 = j - ki - 2;
			work[j + 1 + *n] -= ddot_(&i__3, &t[ki + 2 + (j + 1) *
				 t_dim1], &dtrevc_c__1, &work[ki + 2 + *n], &dtrevc_c__1);

			i__3 = j - ki - 2;
			work[j + 1 + n2] -= ddot_(&i__3, &t[ki + 2 + (j + 1) *
				 t_dim1], &dtrevc_c__1, &work[ki + 2 + n2], &dtrevc_c__1);


			d__1 = -wi;
			if (dlaln2_(interp, &dtrevc_c_true, &dtrevc_c__2, &dtrevc_c__2, &smin, &dtrevc_c_b22, &t[j + 				j * t_dim1], ldt, &dtrevc_c_b22, &dtrevc_c_b22, &work[j + *
				n], n, &wr, &d__1, x, &dtrevc_c__2, &scale, &xnorm, &
				ierr)!=TCL_OK) { return TCL_ERROR; }




			if (scale != 1.) {
			    i__3 = *n - ki + 1;
			    if (dscal_(interp, &i__3, &scale, &work[ki + *n], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }

			    i__3 = *n - ki + 1;
			    if (dscal_(interp, &i__3, &scale, &work[ki + n2], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }

			}
			work[j + *n] = x[0];
			work[j + n2] = x[2];
			work[j + 1 + *n] = x[1];
			work[j + 1 + n2] = x[3];
			d__1 = abs(x[0]), d__2 = abs(x[2]), d__1 = max(d__1,
				d__2), d__2 = abs(x[1]), d__1 = max(d__1,d__2)
				, d__2 = abs(x[3]), d__1 = max(d__1,d__2);
			vmax = max(d__1,vmax);
			vcrit = bignum / vmax;

		    }
L200:
		    ;
		}


		if (! over) {
		    i__2 = *n - ki + 1;
		    if (dcopy_(interp, &i__2, &work[ki + *n], &dtrevc_c__1, &vl[ki + is * 			    vl_dim1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }


		    i__2 = *n - ki + 1;
		    if (dcopy_(interp, &i__2, &work[ki + n2], &dtrevc_c__1, &vl[ki + (is + 1) * 			    vl_dim1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }



		    emax = 0.;
		    i__2 = *n;
		    for (k = ki; k <= i__2; ++k) {
			d__3 = emax, d__4 = (d__1 = vl[k + is * vl_dim1], abs(
				d__1)) + (d__2 = vl[k + (is + 1) * vl_dim1], 
				abs(d__2));
			emax = max(d__3,d__4);
		    }
		    remax = 1. / emax;
		    i__2 = *n - ki + 1;
		    if (dscal_(interp, &i__2, &remax, &vl[ki + is * vl_dim1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }

		    i__2 = *n - ki + 1;
		    if (dscal_(interp, &i__2, &remax, &vl[ki + (is + 1) * vl_dim1], &dtrevc_c__1)			    !=TCL_OK) { return TCL_ERROR; }



		    i__2 = ki - 1;
		    for (k = 1; k <= i__2; ++k) {
			vl[k + is * vl_dim1] = 0.;
			vl[k + (is + 1) * vl_dim1] = 0.;
		    }
		} else {
		    if (ki < *n - 1) {
			i__2 = *n - ki - 1;
			if (dgemv_(interp, "N", n, &i__2, &dtrevc_c_b22, &vl[(ki + 2) * vl_dim1 				+ 1], ldvl, &work[ki + 2 + *n], &dtrevc_c__1, &work[
				ki + *n], &vl[ki * vl_dim1 + 1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }


			i__2 = *n - ki - 1;
			if (dgemv_(interp, "N", n, &i__2, &dtrevc_c_b22, &vl[(ki + 2) * vl_dim1 				+ 1], ldvl, &work[ki + 2 + n2], &dtrevc_c__1, &work[
				ki + 1 + n2], &vl[(ki + 1) * vl_dim1 + 1], &
				dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }


		    } else {
			if (dscal_(interp, n, &work[ki + *n], &vl[ki * vl_dim1 + 1], &				dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }


			if (dscal_(interp, n, &work[ki + 1 + n2], &vl[(ki + 1) * vl_dim1 				+ 1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }


		    }

		    emax = 0.;
		    i__2 = *n;
		    for (k = 1; k <= i__2; ++k) {
			d__3 = emax, d__4 = (d__1 = vl[k + ki * vl_dim1], abs(
				d__1)) + (d__2 = vl[k + (ki + 1) * vl_dim1], 
				abs(d__2));
			emax = max(d__3,d__4);
		    }
		    remax = 1. / emax;
		    if (dscal_(interp, n, &remax, &vl[ki * vl_dim1 + 1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }

		    if (dscal_(interp, n, &remax, &vl[(ki + 1) * vl_dim1 + 1], &dtrevc_c__1)!=TCL_OK) { return TCL_ERROR; }


		}

	    }

	    ++is;
	    if (ip != 0) {
		++is;
	    }
L250:
	    if (ip == -1) {
		ip = 0;
	    }
	    if (ip == 1) {
		ip = -1;
	    }

	}

    }

return TCL_OK;


} /* dtrevc_ */
static /* Subroutine */ int zscal_ (Tcl_Interp *interp, integer *n, doublecomplex *za, doublecomplex *zx, 	integer *incx)
{
    integer i__1, i__2, i__3;
    doublecomplex z__1;

    integer i__, ix;





    --zx;

    if (*n <= 0 || *incx <= 0) {
return TCL_OK;
    }
    if (*incx == 1) {
	goto L20;
    }


    ix = 1;
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	i__2 = ix;
	i__3 = ix;
	z__1.r = za->r * zx[i__3].r - za->i * zx[i__3].i, z__1.i = za->r * zx[
		i__3].i + za->i * zx[i__3].r;
	zx[i__2].r = z__1.r, zx[i__2].i = z__1.i;
	ix += *incx;
    }
return TCL_OK;


L20:
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	i__2 = i__;
	i__3 = i__;
	z__1.r = za->r * zx[i__3].r - za->i * zx[i__3].i, z__1.i = za->r * zx[
		i__3].i + za->i * zx[i__3].r;
	zx[i__2].r = z__1.r, zx[i__2].i = z__1.i;
    }
return TCL_OK;
} /* zscal_ */
static doublereal dznrm2_ (integer *n, doublecomplex *x, integer *incx)
{
    integer i__1, i__2, i__3;
    doublereal ret_val, d__1;

    double d_imag(doublecomplex *), sqrt(doublereal);

    integer ix;
    doublereal ssq, temp, norm, scale;








    --x;

    if (*n < 1 || *incx < 1) {
	norm = 0.;
    } else {
	scale = 0.;
	ssq = 1.;

	i__1 = (*n - 1) * *incx + 1;
	i__2 = *incx;
	for (ix = 1; i__2 < 0 ? ix >= i__1 : ix <= i__1; ix += i__2) {
	    i__3 = ix;
	    if (x[i__3].r != 0.) {
		i__3 = ix;
		temp = (d__1 = x[i__3].r, abs(d__1));
		if (scale < temp) {
		    d__1 = scale / temp;
		    ssq = ssq * (d__1 * d__1) + 1.;
		    scale = temp;
		} else {
		    d__1 = temp / scale;
		    ssq += d__1 * d__1;
		}
	    }
	    if (d_imag(&x[ix]) != 0.) {
		temp = (d__1 = d_imag(&x[ix]), abs(d__1));
		if (scale < temp) {
		    d__1 = scale / temp;
		    ssq = ssq * (d__1 * d__1) + 1.;
		    scale = temp;
		} else {
		    d__1 = temp / scale;
		    ssq += d__1 * d__1;
		}
	    }
	}
	norm = scale * sqrt(ssq);
    }

    ret_val = norm;
    return ret_val;


} /* dznrm2_ */
static /* Subroutine */ int zgebak_ (Tcl_Interp *interp, char *job, char *side, integer *n, integer *ilo, 	integer *ihi, doublereal *scale, integer *m, doublecomplex *v, 	integer *ldv, integer *info)
{
    integer v_dim1, v_offset, i__1;

    integer i__, k;
    doublereal s;
    integer ii;
    logical leftv;
    logical rightv;



















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

    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);
	vectcl_xerbla(interp, "ZGEBAK", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


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

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


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

	if (rightv) {
	    i__1 = *ihi;
	    for (i__ = *ilo; i__ <= i__1; ++i__) {
		s = scale[i__];
		if (zdscal_(interp, m, &s, &v[i__ + v_dim1], ldv)!=TCL_OK) { return TCL_ERROR; }

	    }
	}

	if (leftv) {
	    i__1 = *ihi;
	    for (i__ = *ilo; i__ <= i__1; ++i__) {
		s = 1. / scale[i__];
		if (zdscal_(interp, m, &s, &v[i__ + v_dim1], ldv)!=TCL_OK) { return TCL_ERROR; }

	    }
	}

    }



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;
		}
		if (zswap_(interp, m, &v[i__ + v_dim1], ldv, &v[k + v_dim1], ldv)!=TCL_OK) { return TCL_ERROR; }

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;
		}
		if (zswap_(interp, m, &v[i__ + v_dim1], ldv, &v[k + v_dim1], ldv)!=TCL_OK) { return TCL_ERROR; }

L50:
		;
	    }
	}
    }

return TCL_OK;


} /* zgebak_ */
static /* Subroutine */ int zgebal_ (Tcl_Interp *interp, char *job, integer *n, doublecomplex *a, integer 	*lda, integer *ilo, integer *ihi, doublereal *scale, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3;
    doublereal d__1, d__2;

    double d_imag(doublecomplex *), z_abs(doublecomplex *);

    doublereal c__, f, g;
    integer i__, j, k, l, m;
    doublereal r__, s, ca, ra;
    integer ica, ira, iexc;
    doublereal sfmin1, sfmin2, sfmax1, sfmax2;
    logical noconv;


























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

    *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);
	vectcl_xerbla(interp, "ZGEBAL", &i__1);
return TCL_ERROR;

return TCL_OK;
    }

    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.;
	}
	goto L210;
    }

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


    goto L50;


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

    if (zswap_(interp, &l, &a[j * a_dim1 + 1], &zgebal_c__1, &a[m * a_dim1 + 1], &zgebal_c__1)!=TCL_OK) { return TCL_ERROR; }

    i__1 = *n - k + 1;
    if (zswap_(interp, &i__1, &a[j + k * a_dim1], lda, &a[m + k * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }


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


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;
	    }
	    i__2 = j + i__ * a_dim1;
	    if (a[i__2].r != 0. || d_imag(&a[j + i__ * a_dim1]) != 0.) {
		goto L70;
	    }
L60:
	    ;
	}

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

    goto L90;


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;
	    }
	    i__3 = i__ + j * a_dim1;
	    if (a[i__3].r != 0. || d_imag(&a[i__ + j * a_dim1]) != 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.;
    }

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



    sfmin1 = dlamch_("S") / dlamch_("P");
    sfmax1 = 1. / sfmin1;
    sfmin2 = sfmin1 * 2.;
    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;
	    }
	    i__3 = j + i__ * a_dim1;
	    c__ += (d__1 = a[i__3].r, abs(d__1)) + (d__2 = d_imag(&a[j + i__ *
		     a_dim1]), abs(d__2));
	    i__3 = i__ + j * a_dim1;
	    r__ += (d__1 = a[i__3].r, abs(d__1)) + (d__2 = d_imag(&a[i__ + j *
		     a_dim1]), abs(d__2));
L150:
	    ;
	}
	ica = izamax_(&l, &a[i__ * a_dim1 + 1], &zgebal_c__1);
	ca = z_abs(&a[ica + i__ * a_dim1]);
	i__2 = *n - k + 1;
	ira = izamax_(&i__2, &a[i__ + k * a_dim1], lda);
	ra = z_abs(&a[i__ + (ira + k - 1) * a_dim1]);


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

L170:
	g = c__ / 2.;
L180:
	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 /= 2.;
	c__ /= 2.;
	g /= 2.;
	ca /= 2.;
	r__ *= 2.;
	ra *= 2.;
	goto L180;


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;
	if (zdscal_(interp, &i__2, &g, &a[i__ + k * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }

	if (zdscal_(interp, &l, &f, &a[i__ * a_dim1 + 1], &zgebal_c__1)!=TCL_OK) { return TCL_ERROR; }


L200:
	;
    }

    if (noconv) {
	goto L140;
    }

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

return TCL_OK;


} /* zgebal_ */
static /* Subroutine */ int zgehrd_ (Tcl_Interp *interp, integer *n, integer *ilo, integer *ihi, 	doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *	work, integer *lwork, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
    doublecomplex z__1;

    integer i__, j;
    doublecomplex t[4160]	/* was [65][64] */;
    integer ib;
    doublecomplex ei;
    integer nb, nh, nx, iws, nbmin, iinfo;
    integer ldwork, lwkopt;
    logical lquery;






























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

    *info = 0;
    i__1 = 64, i__2 = ilaenv_(&zgehrd_c__1, "ZGEHRD", " ", n, ilo, ihi, &zgehrd_c_n1);
    nb = min(i__1,i__2);
    lwkopt = *n * nb;
    work[1].r = (doublereal) lwkopt, work[1].i = 0.;
    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);
	vectcl_xerbla(interp, "ZGEHRD", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


    i__1 = *ilo - 1;
    for (i__ = 1; i__ <= i__1; ++i__) {
	i__2 = i__;
	tau[i__2].r = 0., tau[i__2].i = 0.;
    }
    i__1 = *n - 1;
    for (i__ = max(1,*ihi); i__ <= i__1; ++i__) {
	i__2 = i__;
	tau[i__2].r = 0., tau[i__2].i = 0.;
    }


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


    i__1 = 64, i__2 = ilaenv_(&zgehrd_c__1, "ZGEHRD", " ", n, ilo, ihi, &zgehrd_c_n1);
    nb = min(i__1,i__2);
    nbmin = 2;
    iws = 1;
    if (nb > 1 && nb < nh) {


	i__1 = nb, i__2 = ilaenv_(&zgehrd_c__3, "ZGEHRD", " ", n, ilo, ihi, &zgehrd_c_n1);
	nx = max(i__1,i__2);
	if (nx < nh) {


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


		i__1 = 2, i__2 = ilaenv_(&zgehrd_c__2, "ZGEHRD", " ", n, ilo, ihi, &
			zgehrd_c_n1);
		nbmin = max(i__1,i__2);
		if (*lwork >= *n * nbmin) {
		    nb = *lwork / *n;
		} else {
		    nb = 1;
		}
	    }
	}
    }
    ldwork = *n;

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


	i__ = *ilo;

    } else {


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


	    if (zlahr2_(interp, ihi, &i__, &ib, &a[i__ * a_dim1 + 1], lda, &tau[i__], t, &		    zgehrd_c__65, &work[1], &ldwork)!=TCL_OK) { return TCL_ERROR; }




	    i__3 = i__ + ib + (i__ + ib - 1) * a_dim1;
	    ei.r = a[i__3].r, ei.i = a[i__3].i;
	    i__3 = i__ + ib + (i__ + ib - 1) * a_dim1;
	    a[i__3].r = 1., a[i__3].i = 0.;
	    i__3 = *ihi - i__ - ib + 1;
	    z__1.r = -1., z__1.i = -0.;
	    if (zgemm_(interp, "No transpose", "Conjugate transpose", ihi, &i__3, &ib, &		    z__1, &work[1], &ldwork, &a[i__ + ib + i__ * a_dim1], lda, 
		     &zgehrd_c_b2, &a[(i__ + ib) * a_dim1 + 1], lda)!=TCL_OK) { return TCL_ERROR; }


	    i__3 = i__ + ib + (i__ + ib - 1) * a_dim1;
	    a[i__3].r = ei.r, a[i__3].i = ei.i;


	    i__3 = ib - 1;
	    if (ztrmm_(interp, "Right", "Lower", "Conjugate transpose", "Unit", &i__, &		    i__3, &zgehrd_c_b2, &a[i__ + 1 + i__ * a_dim1], lda, &work[1], &
		    ldwork)!=TCL_OK) { return TCL_ERROR; }


	    i__3 = ib - 2;
	    for (j = 0; j <= i__3; ++j) {
		z__1.r = -1., z__1.i = -0.;
		if (zaxpy_(interp, &i__, &z__1, &work[ldwork * j + 1], &zgehrd_c__1, &a[(i__ + j 			+ 1) * a_dim1 + 1], &zgehrd_c__1)!=TCL_OK) { return TCL_ERROR; }


	    }


	    i__3 = *ihi - i__;
	    i__4 = *n - i__ - ib + 1;
	    if (zlarfb_(interp, "Left", "Conjugate transpose", "Forward", "Columnwise", &		    i__3, &i__4, &ib, &a[i__ + 1 + i__ * a_dim1], lda, t, &
		    zgehrd_c__65, &a[i__ + 1 + (i__ + ib) * a_dim1], lda, &work[1], &
		    ldwork)!=TCL_OK) { return TCL_ERROR; }


	}
    }


    if (zgehd2_(interp, n, &i__, ihi, &a[a_offset], lda, &tau[1], &work[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }

    work[1].r = (doublereal) iws, work[1].i = 0.;

return TCL_OK;


} /* zgehrd_ */
static /* Subroutine */ int zhseqr_ (Tcl_Interp *interp, char *job, char *compz, integer *n, integer *ilo, 	 integer *ihi, doublecomplex *h__, integer *ldh, doublecomplex *w, 	doublecomplex *z__, integer *ldz, doublecomplex *work, integer *lwork, 	 integer *info)
{
    address a__1[2];
    integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2, i__3[2];
    doublereal d__1, d__2, d__3;
    doublecomplex z__1;
    char ch__1[2];

    /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);

    doublecomplex hl[2401]	/* was [49][49] */;
    integer kbot, nmin;
    logical initz;
    doublecomplex workl[49];
    logical wantt, wantz;
    logical lquery;

















































    h_dim1 = *ldh;
    h_offset = 1 + h_dim1;
    h__ -= h_offset;
    --w;
    z_dim1 = *ldz;
    z_offset = 1 + z_dim1;
    z__ -= z_offset;
    --work;

    wantt = lsame_(job, "S");
    initz = lsame_(compz, "I");
    wantz = initz || lsame_(compz, "V");
    d__1 = (doublereal) max(1,*n);
    z__1.r = d__1, z__1.i = 0.;
    work[1].r = z__1.r, work[1].i = z__1.i;
    lquery = *lwork == -1;

    *info = 0;
    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 = -10;
    } else if (*lwork < max(1,*n) && ! lquery) {
	*info = -12;
    }

    if (*info != 0) {


	i__1 = -(*info);
	vectcl_xerbla(interp, "ZHSEQR", &i__1);
return TCL_ERROR;

return TCL_OK;

    } else if (*n == 0) {


return TCL_OK;

    } else if (lquery) {


	if (zlaqr0_(interp, &wantt, &wantz, n, ilo, ihi, &h__[h_offset], ldh, &w[1], ilo, 		ihi, &z__[z_offset], ldz, &work[1], lwork, info)!=TCL_OK) { return TCL_ERROR; }


	d__2 = work[1].r, d__3 = (doublereal) max(1,*n);
	d__1 = max(d__2,d__3);
	z__1.r = d__1, z__1.i = 0.;
	work[1].r = z__1.r, work[1].i = z__1.i;
return TCL_OK;

    } else {


	if (*ilo > 1) {
	    i__1 = *ilo - 1;
	    i__2 = *ldh + 1;
	    if (zcopy_(interp, &i__1, &h__[h_offset], &i__2, &w[1], &zhseqr_c__1)!=TCL_OK) { return TCL_ERROR; }

	}
	if (*ihi < *n) {
	    i__1 = *n - *ihi;
	    i__2 = *ldh + 1;
	    if (zcopy_(interp, &i__1, &h__[*ihi + 1 + (*ihi + 1) * h_dim1], &i__2, &w[*		    ihi + 1], &zhseqr_c__1)!=TCL_OK) { return TCL_ERROR; }


	}


	if (initz) {
	    if (zlaset_(interp, "A", n, n, &zhseqr_c_b1, &zhseqr_c_b2, &z__[z_offset], ldz)!=TCL_OK) { return TCL_ERROR; }

	}


	if (*ilo == *ihi) {
	    i__1 = *ilo;
	    i__2 = *ilo + *ilo * h_dim1;
	    w[i__1].r = h__[i__2].r, w[i__1].i = h__[i__2].i;
return TCL_OK;
	}


	i__3[0] = 1, a__1[0] = job;
	i__3[1] = 1, a__1[1] = compz;
	s_cat(ch__1, a__1, i__3, &zhseqr_c__2, (ftnlen)2);
	nmin = ilaenv_(&zhseqr_c__12, "ZHSEQR", ch__1, n, ilo, ihi, lwork);
	nmin = max(11,nmin);


	if (*n > nmin) {
	    if (zlaqr0_(interp, &wantt, &wantz, n, ilo, ihi, &h__[h_offset], ldh, &w[1], 		    ilo, ihi, &z__[z_offset], ldz, &work[1], lwork, info)!=TCL_OK) { return TCL_ERROR; }


	} else {


	    if (zlahqr_(interp, &wantt, &wantz, n, ilo, ihi, &h__[h_offset], ldh, &w[1], 		    ilo, ihi, &z__[z_offset], ldz, info)!=TCL_OK) { return TCL_ERROR; }



	    if (*info > 0) {


		kbot = *info;

		if (*n >= 49) {


		    if (zlaqr0_(interp, &wantt, &wantz, n, ilo, &kbot, &h__[h_offset], 			    ldh, &w[1], ilo, ihi, &z__[z_offset], ldz, &work[
			    1], lwork, info)!=TCL_OK) { return TCL_ERROR; }



		} else {


		    if (zlacpy_(interp, "A", n, n, &h__[h_offset], ldh, hl, &zhseqr_c__49)!=TCL_OK) { return TCL_ERROR; }

		    i__1 = *n + 1 + *n * 49 - 50;
		    hl[i__1].r = 0., hl[i__1].i = 0.;
		    i__1 = 49 - *n;
		    if (zlaset_(interp, "A", &zhseqr_c__49, &i__1, &zhseqr_c_b1, &zhseqr_c_b1, &hl[(*n + 1) * 			    49 - 49], &zhseqr_c__49)!=TCL_OK) { return TCL_ERROR; }


		    if (zlaqr0_(interp, &wantt, &wantz, &zhseqr_c__49, ilo, &kbot, hl, &zhseqr_c__49, &			    w[1], ilo, ihi, &z__[z_offset], ldz, workl, &
			    zhseqr_c__49, info)!=TCL_OK) { return TCL_ERROR; }


		    if (wantt || *info != 0) {
			if (zlacpy_(interp, "A", n, n, hl, &zhseqr_c__49, &h__[h_offset], ldh)!=TCL_OK) { return TCL_ERROR; }

		    }
		}
	    }
	}


	if ((wantt || *info != 0) && *n > 2) {
	    i__1 = *n - 2;
	    i__2 = *n - 2;
	    if (zlaset_(interp, "L", &i__1, &i__2, &zhseqr_c_b1, &zhseqr_c_b1, &h__[h_dim1 + 3], ldh)!=TCL_OK) { return TCL_ERROR; }

	}


	d__2 = (doublereal) max(1,*n), d__3 = work[1].r;
	d__1 = max(d__2,d__3);
	z__1.r = d__1, z__1.i = 0.;
	work[1].r = z__1.r, work[1].i = z__1.i;
    }


return TCL_OK;
} /* zhseqr_ */
static /* Subroutine */ int ztrevc_ (Tcl_Interp *interp, char *side, char *howmny, logical *select, 	integer *n, doublecomplex *t, integer *ldt, doublecomplex *vl, 	integer *ldvl, doublecomplex *vr, integer *ldvr, integer *mm, integer 	*m, doublecomplex *work, doublereal *rwork, integer *info)
{
    integer t_dim1, t_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1, 
	    i__2, i__3, i__4, i__5;
    doublereal d__1, d__2, d__3;
    doublecomplex z__1, z__2;

    double d_imag(doublecomplex *);
    void d_cnjg(doublecomplex *, doublecomplex *);

    integer i__, j, k, ii, ki, is;
    doublereal ulp;
    logical allv;
    doublereal unfl, ovfl, smin;
    logical over;
    doublereal scale;
    doublereal remax;
    logical leftv, bothv;
    logical somev;
    logical rightv;
    doublereal smlnum;
































    --select;
    t_dim1 = *ldt;
    t_offset = 1 + t_dim1;
    t -= t_offset;
    vl_dim1 = *ldvl;
    vl_offset = 1 + vl_dim1;
    vl -= vl_offset;
    vr_dim1 = *ldvr;
    vr_offset = 1 + vr_dim1;
    vr -= vr_offset;
    --work;
    --rwork;

    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");


    if (somev) {
	*m = 0;
	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    if (select[j]) {
		++(*m);
	    }
	}
    } else {
	*m = *n;
    }

    *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 if (*mm < *m) {
	*info = -11;
    }
    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "ZTREVC", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


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


    unfl = dlamch_("Safe minimum");
    ovfl = 1. / unfl;
    if (dlabad_(interp, &unfl, &ovfl)!=TCL_OK) { return TCL_ERROR; }

    ulp = dlamch_("Precision");
    smlnum = unfl * (*n / ulp);


    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	i__2 = i__ + *n;
	i__3 = i__ + i__ * t_dim1;
	work[i__2].r = t[i__3].r, work[i__2].i = t[i__3].i;
    }


    rwork[1] = 0.;
    i__1 = *n;
    for (j = 2; j <= i__1; ++j) {
	i__2 = j - 1;
	rwork[j] = dzasum_(&i__2, &t[j * t_dim1 + 1], &ztrevc_c__1);
    }

    if (rightv) {


	is = *m;
	for (ki = *n; ki >= 1; --ki) {

	    if (somev) {
		if (! select[ki]) {
		    goto L80;
		}
	    }
	    i__1 = ki + ki * t_dim1;
	    d__3 = ulp * ((d__1 = t[i__1].r, abs(d__1)) + (d__2 = d_imag(&t[
		    ki + ki * t_dim1]), abs(d__2)));
	    smin = max(d__3,smlnum);

	    work[1].r = 1., work[1].i = 0.;


	    i__1 = ki - 1;
	    for (k = 1; k <= i__1; ++k) {
		i__2 = k;
		i__3 = k + ki * t_dim1;
		z__1.r = -t[i__3].r, z__1.i = -t[i__3].i;
		work[i__2].r = z__1.r, work[i__2].i = z__1.i;
	    }


	    i__1 = ki - 1;
	    for (k = 1; k <= i__1; ++k) {
		i__2 = k + k * t_dim1;
		i__3 = k + k * t_dim1;
		i__4 = ki + ki * t_dim1;
		z__1.r = t[i__3].r - t[i__4].r, z__1.i = t[i__3].i - t[i__4]
			.i;
		t[i__2].r = z__1.r, t[i__2].i = z__1.i;
		i__2 = k + k * t_dim1;
		if ((d__1 = t[i__2].r, abs(d__1)) + (d__2 = d_imag(&t[k + k * 
			t_dim1]), abs(d__2)) < smin) {
		    i__3 = k + k * t_dim1;
		    t[i__3].r = smin, t[i__3].i = 0.;
		}
	    }

	    if (ki > 1) {
		i__1 = ki - 1;
		if (zlatrs_(interp, "Upper", "No transpose", "Non-unit", "Y", &i__1, &t[			t_offset], ldt, &work[1], &scale, &rwork[1], info)!=TCL_OK) { return TCL_ERROR; }


		i__1 = ki;
		work[i__1].r = scale, work[i__1].i = 0.;
	    }


	    if (! over) {
		if (zcopy_(interp, &ki, &work[1], &ztrevc_c__1, &vr[is * vr_dim1 + 1], &ztrevc_c__1)!=TCL_OK) { return TCL_ERROR; }


		ii = izamax_(&ki, &vr[is * vr_dim1 + 1], &ztrevc_c__1);
		i__1 = ii + is * vr_dim1;
		remax = 1. / ((d__1 = vr[i__1].r, abs(d__1)) + (d__2 = d_imag(
			&vr[ii + is * vr_dim1]), abs(d__2)));
		if (zdscal_(interp, &ki, &remax, &vr[is * vr_dim1 + 1], &ztrevc_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__1 = *n;
		for (k = ki + 1; k <= i__1; ++k) {
		    i__2 = k + is * vr_dim1;
		    vr[i__2].r = 0., vr[i__2].i = 0.;
		}
	    } else {
		if (ki > 1) {
		    i__1 = ki - 1;
		    z__1.r = scale, z__1.i = 0.;
		    if (zgemv_(interp, "N", n, &i__1, &ztrevc_c_b2, &vr[vr_offset], ldvr, &work[			    1], &ztrevc_c__1, &z__1, &vr[ki * vr_dim1 + 1], &ztrevc_c__1)!=TCL_OK) { return TCL_ERROR; }


		}

		ii = izamax_(n, &vr[ki * vr_dim1 + 1], &ztrevc_c__1);
		i__1 = ii + ki * vr_dim1;
		remax = 1. / ((d__1 = vr[i__1].r, abs(d__1)) + (d__2 = d_imag(
			&vr[ii + ki * vr_dim1]), abs(d__2)));
		if (zdscal_(interp, n, &remax, &vr[ki * vr_dim1 + 1], &ztrevc_c__1)!=TCL_OK) { return TCL_ERROR; }

	    }


	    i__1 = ki - 1;
	    for (k = 1; k <= i__1; ++k) {
		i__2 = k + k * t_dim1;
		i__3 = k + *n;
		t[i__2].r = work[i__3].r, t[i__2].i = work[i__3].i;
	    }

	    --is;
L80:
	    ;
	}
    }

    if (leftv) {


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

	    if (somev) {
		if (! select[ki]) {
		    goto L130;
		}
	    }
	    i__2 = ki + ki * t_dim1;
	    d__3 = ulp * ((d__1 = t[i__2].r, abs(d__1)) + (d__2 = d_imag(&t[
		    ki + ki * t_dim1]), abs(d__2)));
	    smin = max(d__3,smlnum);

	    i__2 = *n;
	    work[i__2].r = 1., work[i__2].i = 0.;


	    i__2 = *n;
	    for (k = ki + 1; k <= i__2; ++k) {
		i__3 = k;
		d_cnjg(&z__2, &t[ki + k * t_dim1]);
		z__1.r = -z__2.r, z__1.i = -z__2.i;
		work[i__3].r = z__1.r, work[i__3].i = z__1.i;
	    }


	    i__2 = *n;
	    for (k = ki + 1; k <= i__2; ++k) {
		i__3 = k + k * t_dim1;
		i__4 = k + k * t_dim1;
		i__5 = ki + ki * t_dim1;
		z__1.r = t[i__4].r - t[i__5].r, z__1.i = t[i__4].i - t[i__5]
			.i;
		t[i__3].r = z__1.r, t[i__3].i = z__1.i;
		i__3 = k + k * t_dim1;
		if ((d__1 = t[i__3].r, abs(d__1)) + (d__2 = d_imag(&t[k + k * 
			t_dim1]), abs(d__2)) < smin) {
		    i__4 = k + k * t_dim1;
		    t[i__4].r = smin, t[i__4].i = 0.;
		}
	    }

	    if (ki < *n) {
		i__2 = *n - ki;
		if (zlatrs_(interp, "Upper", "Conjugate transpose", "Non-unit", "Y", &			i__2, &t[ki + 1 + (ki + 1) * t_dim1], ldt, &work[ki + 
			1], &scale, &rwork[1], info)!=TCL_OK) { return TCL_ERROR; }


		i__2 = ki;
		work[i__2].r = scale, work[i__2].i = 0.;
	    }


	    if (! over) {
		i__2 = *n - ki + 1;
		if (zcopy_(interp, &i__2, &work[ki], &ztrevc_c__1, &vl[ki + is * vl_dim1], &ztrevc_c__1)			!=TCL_OK) { return TCL_ERROR; }



		i__2 = *n - ki + 1;
		ii = izamax_(&i__2, &vl[ki + is * vl_dim1], &ztrevc_c__1) + ki - 1;
		i__2 = ii + is * vl_dim1;
		remax = 1. / ((d__1 = vl[i__2].r, abs(d__1)) + (d__2 = d_imag(
			&vl[ii + is * vl_dim1]), abs(d__2)));
		i__2 = *n - ki + 1;
		if (zdscal_(interp, &i__2, &remax, &vl[ki + is * vl_dim1], &ztrevc_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = ki - 1;
		for (k = 1; k <= i__2; ++k) {
		    i__3 = k + is * vl_dim1;
		    vl[i__3].r = 0., vl[i__3].i = 0.;
		}
	    } else {
		if (ki < *n) {
		    i__2 = *n - ki;
		    z__1.r = scale, z__1.i = 0.;
		    if (zgemv_(interp, "N", n, &i__2, &ztrevc_c_b2, &vl[(ki + 1) * vl_dim1 + 1], 			    ldvl, &work[ki + 1], &ztrevc_c__1, &z__1, &vl[ki * 
			    vl_dim1 + 1], &ztrevc_c__1)!=TCL_OK) { return TCL_ERROR; }


		}

		ii = izamax_(n, &vl[ki * vl_dim1 + 1], &ztrevc_c__1);
		i__2 = ii + ki * vl_dim1;
		remax = 1. / ((d__1 = vl[i__2].r, abs(d__1)) + (d__2 = d_imag(
			&vl[ii + ki * vl_dim1]), abs(d__2)));
		if (zdscal_(interp, n, &remax, &vl[ki * vl_dim1 + 1], &ztrevc_c__1)!=TCL_OK) { return TCL_ERROR; }

	    }


	    i__2 = *n;
	    for (k = ki + 1; k <= i__2; ++k) {
		i__3 = k + k * t_dim1;
		i__4 = k + *n;
		t[i__3].r = work[i__4].r, t[i__3].i = work[i__4].i;
	    }

	    ++is;
L130:
	    ;
	}
    }

return TCL_OK;


} /* ztrevc_ */
static /* Subroutine */ int zunghr_ (Tcl_Interp *interp, integer *n, integer *ilo, integer *ihi, 	doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *	work, integer *lwork, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4;

    integer i__, j, nb, nh, iinfo;
    integer lwkopt;
    logical lquery;




















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

    *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 = ilaenv_(&zunghr_c__1, "ZUNGQR", " ", &nh, &nh, &nh, &zunghr_c_n1);
	lwkopt = max(1,nh) * nb;
	work[1].r = (doublereal) lwkopt, work[1].i = 0.;
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "ZUNGHR", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


    if (*n == 0) {
	work[1].r = 1., work[1].i = 0.;
return TCL_OK;
    }


    i__1 = *ilo + 1;
    for (j = *ihi; j >= i__1; --j) {
	i__2 = j - 1;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    i__3 = i__ + j * a_dim1;
	    a[i__3].r = 0., a[i__3].i = 0.;
	}
	i__2 = *ihi;
	for (i__ = j + 1; i__ <= i__2; ++i__) {
	    i__3 = i__ + j * a_dim1;
	    i__4 = i__ + (j - 1) * a_dim1;
	    a[i__3].r = a[i__4].r, a[i__3].i = a[i__4].i;
	}
	i__2 = *n;
	for (i__ = *ihi + 1; i__ <= i__2; ++i__) {
	    i__3 = i__ + j * a_dim1;
	    a[i__3].r = 0., a[i__3].i = 0.;
	}
    }
    i__1 = *ilo;
    for (j = 1; j <= i__1; ++j) {
	i__2 = *n;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    i__3 = i__ + j * a_dim1;
	    a[i__3].r = 0., a[i__3].i = 0.;
	}
	i__2 = j + j * a_dim1;
	a[i__2].r = 1., a[i__2].i = 0.;
    }
    i__1 = *n;
    for (j = *ihi + 1; j <= i__1; ++j) {
	i__2 = *n;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    i__3 = i__ + j * a_dim1;
	    a[i__3].r = 0., a[i__3].i = 0.;
	}
	i__2 = j + j * a_dim1;
	a[i__2].r = 1., a[i__2].i = 0.;
    }

    if (nh > 0) {


	if (zungqr_(interp, &nh, &nh, &nh, &a[*ilo + 1 + (*ilo + 1) * a_dim1], lda, &tau[*		ilo], &work[1], lwork, &iinfo)!=TCL_OK) { return TCL_ERROR; }


    }
    work[1].r = (doublereal) lwkopt, work[1].i = 0.;
return TCL_OK;


} /* zunghr_ */
static /* Subroutine */ int dgemv_ (Tcl_Interp *interp, char *trans, integer *m, integer *n, doublereal *	alpha, doublereal *a, integer *lda, doublereal *x, integer *incx, 	doublereal *beta, doublereal *y, integer *incy)
{
    integer a_dim1, a_offset, i__1, i__2;

    integer i__, j, ix, iy, jx, jy, kx, ky, info;
    doublereal temp;
    integer lenx, leny;




























    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --x;
    --y;

    info = 0;
    if (! lsame_(trans, "N") && ! lsame_(trans, "T") && ! lsame_(trans, "C")
	    ) {
	info = 1;
    } else if (*m < 0) {
	info = 2;
    } else if (*n < 0) {
	info = 3;
    } else if (*lda < max(1,*m)) {
	info = 6;
    } else if (*incx == 0) {
	info = 8;
    } else if (*incy == 0) {
	info = 11;
    }
    if (info != 0) {
	vectcl_xerbla(interp, "DGEMV ", &info);
return TCL_ERROR;

return TCL_OK;
    }


    if (*m == 0 || *n == 0 || *alpha == 0. && *beta == 1.) {
return TCL_OK;
    }


    if (lsame_(trans, "N")) {
	lenx = *n;
	leny = *m;
    } else {
	lenx = *m;
	leny = *n;
    }
    if (*incx > 0) {
	kx = 1;
    } else {
	kx = 1 - (lenx - 1) * *incx;
    }
    if (*incy > 0) {
	ky = 1;
    } else {
	ky = 1 - (leny - 1) * *incy;
    }



    if (*beta != 1.) {
	if (*incy == 1) {
	    if (*beta == 0.) {
		i__1 = leny;
		for (i__ = 1; i__ <= i__1; ++i__) {
		    y[i__] = 0.;
		}
	    } else {
		i__1 = leny;
		for (i__ = 1; i__ <= i__1; ++i__) {
		    y[i__] = *beta * y[i__];
		}
	    }
	} else {
	    iy = ky;
	    if (*beta == 0.) {
		i__1 = leny;
		for (i__ = 1; i__ <= i__1; ++i__) {
		    y[iy] = 0.;
		    iy += *incy;
		}
	    } else {
		i__1 = leny;
		for (i__ = 1; i__ <= i__1; ++i__) {
		    y[iy] = *beta * y[iy];
		    iy += *incy;
		}
	    }
	}
    }
    if (*alpha == 0.) {
return TCL_OK;
    }
    if (lsame_(trans, "N")) {


	jx = kx;
	if (*incy == 1) {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		if (x[jx] != 0.) {
		    temp = *alpha * x[jx];
		    i__2 = *m;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			y[i__] += temp * a[i__ + j * a_dim1];
		    }
		}
		jx += *incx;
	    }
	} else {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		if (x[jx] != 0.) {
		    temp = *alpha * x[jx];
		    iy = ky;
		    i__2 = *m;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			y[iy] += temp * a[i__ + j * a_dim1];
			iy += *incy;
		    }
		}
		jx += *incx;
	    }
	}
    } else {


	jy = ky;
	if (*incx == 1) {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		temp = 0.;
		i__2 = *m;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    temp += a[i__ + j * a_dim1] * x[i__];
		}
		y[jy] += *alpha * temp;
		jy += *incy;
	    }
	} else {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		temp = 0.;
		ix = kx;
		i__2 = *m;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    temp += a[i__ + j * a_dim1] * x[ix];
		    ix += *incx;
		}
		y[jy] += *alpha * temp;
		jy += *incy;
	    }
	}
    }

return TCL_OK;


} /* dgemv_ */
static /* Subroutine */ int drscl_ (Tcl_Interp *interp, integer *n, doublereal *sa, doublereal *sx, 	integer *incx)
{
    doublereal mul, cden;
    logical done;
    doublereal cnum, cden1, cnum1;
    doublereal bignum, smlnum;














    --sx;

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


    smlnum = dlamch_("S");
    bignum = 1. / smlnum;
    if (dlabad_(interp, &smlnum, &bignum)!=TCL_OK) { return TCL_ERROR; }



    cden = *sa;
    cnum = 1.;

L10:
    cden1 = cden * smlnum;
    cnum1 = cnum / bignum;
    if (abs(cden1) > abs(cnum) && cnum != 0.) {


	mul = smlnum;
	done = FALSE_;
	cden = cden1;
    } else if (abs(cnum1) > abs(cden)) {


	mul = bignum;
	done = FALSE_;
	cnum = cnum1;
    } else {


	mul = cnum / cden;
	done = TRUE_;
    }


    if (dscal_(interp, n, &mul, &sx[1], incx)!=TCL_OK) { return TCL_ERROR; }


    if (! done) {
	goto L10;
    }

return TCL_OK;


} /* drscl_ */
static /* Subroutine */ int dbdsqr_ (Tcl_Interp *interp, char *uplo, integer *n, integer *ncvt, integer *	nru, integer *ncc, doublereal *d__, doublereal *e, doublereal *vt, 	integer *ldvt, doublereal *u, integer *ldu, doublereal *c__, integer *	ldc, doublereal *work, integer *info)
{
    integer c_dim1, c_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__1, 
	    i__2;
    doublereal d__1, d__2, d__3, d__4;

    double pow_dd(doublereal *, doublereal *), sqrt(doublereal), d_sign(
	    doublereal *, doublereal *);

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

































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

    *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);
	vectcl_xerbla(interp, "DBDSQR", &i__1);
return TCL_ERROR;

return TCL_OK;
    }
    if (*n == 0) {
return TCL_OK;
    }
    if (*n == 1) {
	goto L160;
    }


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


    if (! rotate) {
	if (dlasq1_(interp, n, &d__[1], &e[1], &work[1], info)!=TCL_OK) { return TCL_ERROR; }

return TCL_OK;
    }

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


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


    if (lower) {
	i__1 = *n - 1;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    if (dlartg_(interp, &d__[i__], &e[i__], &cs, &sn, &r__)!=TCL_OK) { return TCL_ERROR; }

	    d__[i__] = r__;
	    e[i__] = sn * d__[i__ + 1];
	    d__[i__ + 1] = cs * d__[i__ + 1];
	    work[i__] = cs;
	    work[nm1 + i__] = sn;
	}


	if (*nru > 0) {
	    if (dlasr_(interp, "R", "V", "F", nru, n, &work[1], &work[*n], &u[u_offset], 		    ldu)!=TCL_OK) { return TCL_ERROR; }


	}
	if (*ncc > 0) {
	    if (dlasr_(interp, "L", "V", "F", n, ncc, &work[1], &work[*n], &c__[c_offset], 		     ldc)!=TCL_OK) { return TCL_ERROR; }


	}
    }


    d__3 = 100., d__4 = pow_dd(&eps, &dbdsqr_c_b15);
    d__1 = 10., d__2 = min(d__3,d__4);
    tolmul = max(d__1,d__2);
    tol = tolmul * eps;


    smax = 0.;
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	d__2 = smax, d__3 = (d__1 = d__[i__], abs(d__1));
	smax = max(d__2,d__3);
    }
    i__1 = *n - 1;
    for (i__ = 1; i__ <= i__1; ++i__) {
	d__2 = smax, d__3 = (d__1 = e[i__], abs(d__1));
	smax = max(d__2,d__3);
    }
    sminl = 0.;
    if (tol >= 0.) {


	sminoa = abs(d__[1]);
	if (sminoa == 0.) {
	    goto L50;
	}
	mu = sminoa;
	i__1 = *n;
	for (i__ = 2; i__ <= i__1; ++i__) {
	    mu = (d__2 = d__[i__], abs(d__2)) * (mu / (mu + (d__1 = e[i__ - 1]
		    , abs(d__1))));
	    sminoa = min(sminoa,mu);
	    if (sminoa == 0.) {
		goto L50;
	    }
	}
L50:
	sminoa /= sqrt((doublereal) (*n));
	d__1 = tol * sminoa, d__2 = *n * 6 * *n * unfl;
	thresh = max(d__1,d__2);
    } else {


	d__1 = abs(tol) * smax, d__2 = *n * 6 * *n * unfl;
	thresh = max(d__1,d__2);
    }


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


    m = *n;


L60:


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


    if (tol < 0. && (d__1 = d__[m], abs(d__1)) <= thresh) {
	d__[m] = 0.;
    }
    smax = (d__1 = d__[m], abs(d__1));
    smin = smax;
    i__1 = m - 1;
    for (lll = 1; lll <= i__1; ++lll) {
	ll = m - lll;
	abss = (d__1 = d__[ll], abs(d__1));
	abse = (d__1 = e[ll], abs(d__1));
	if (tol < 0. && abss <= thresh) {
	    d__[ll] = 0.;
	}
	if (abse <= thresh) {
	    goto L80;
	}
	smin = min(smin,abss);
	d__1 = max(smax,abss);
	smax = max(d__1,abse);
    }
    ll = 0;
    goto L90;
L80:
    e[ll] = 0.;


    if (ll == m - 1) {


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


    if (ll == m - 1) {


	if (dlasv2_(interp, &d__[m - 1], &e[m - 1], &d__[m], &sigmn, &sigmx, &sinr, &cosr, 		 &sinl, &cosl)!=TCL_OK) { return TCL_ERROR; }


	d__[m - 1] = sigmx;
	e[m - 1] = 0.;
	d__[m] = sigmn;


	if (*ncvt > 0) {
	    if (drot_(interp, ncvt, &vt[m - 1 + vt_dim1], ldvt, &vt[m + vt_dim1], ldvt, &		    cosr, &sinr)!=TCL_OK) { return TCL_ERROR; }


	}
	if (*nru > 0) {
	    if (drot_(interp, nru, &u[(m - 1) * u_dim1 + 1], &dbdsqr_c__1, &u[m * u_dim1 + 1], &		    dbdsqr_c__1, &cosl, &sinl)!=TCL_OK) { return TCL_ERROR; }


	}
	if (*ncc > 0) {
	    if (drot_(interp, ncc, &c__[m - 1 + c_dim1], ldc, &c__[m + c_dim1], ldc, &		    cosl, &sinl)!=TCL_OK) { return TCL_ERROR; }


	}
	m += -2;
	goto L60;
    }


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


	    idir = 1;
	} else {


	    idir = 2;
	}
    }


    if (idir == 1) {


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

	if (tol >= 0.) {


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

    } else {


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

	if (tol >= 0.) {


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


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


	shift = 0.;
    } else {


	if (idir == 1) {
	    sll = (d__1 = d__[ll], abs(d__1));
	    if (dlas2_(interp, &d__[m - 1], &e[m - 1], &d__[m], &shift, &r__)!=TCL_OK) { return TCL_ERROR; }

	} else {
	    sll = (d__1 = d__[m], abs(d__1));
	    if (dlas2_(interp, &d__[ll], &e[ll], &d__[ll + 1], &shift, &r__)!=TCL_OK) { return TCL_ERROR; }

	}


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


    iter = iter + m - ll;


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


	    cs = 1.;
	    oldcs = 1.;
	    i__1 = m - 1;
	    for (i__ = ll; i__ <= i__1; ++i__) {
		d__1 = d__[i__] * cs;
		if (dlartg_(interp, &d__1, &e[i__], &cs, &sn, &r__)!=TCL_OK) { return TCL_ERROR; }

		if (i__ > ll) {
		    e[i__ - 1] = oldsn * r__;
		}
		d__1 = oldcs * r__;
		d__2 = d__[i__ + 1] * sn;
		if (dlartg_(interp, &d__1, &d__2, &oldcs, &oldsn, &d__[i__])!=TCL_OK) { return TCL_ERROR; }

		work[i__ - ll + 1] = cs;
		work[i__ - ll + 1 + nm1] = sn;
		work[i__ - ll + 1 + nm12] = oldcs;
		work[i__ - ll + 1 + nm13] = oldsn;
	    }
	    h__ = d__[m] * cs;
	    d__[m] = h__ * oldcs;
	    e[m - 1] = h__ * oldsn;


	    if (*ncvt > 0) {
		i__1 = m - ll + 1;
		if (dlasr_(interp, "L", "V", "F", &i__1, ncvt, &work[1], &work[*n], &vt[			ll + vt_dim1], ldvt)!=TCL_OK) { return TCL_ERROR; }


	    }
	    if (*nru > 0) {
		i__1 = m - ll + 1;
		if (dlasr_(interp, "R", "V", "F", nru, &i__1, &work[nm12 + 1], &work[nm13 			+ 1], &u[ll * u_dim1 + 1], ldu)!=TCL_OK) { return TCL_ERROR; }


	    }
	    if (*ncc > 0) {
		i__1 = m - ll + 1;
		if (dlasr_(interp, "L", "V", "F", &i__1, ncc, &work[nm12 + 1], &work[nm13 			+ 1], &c__[ll + c_dim1], ldc)!=TCL_OK) { return TCL_ERROR; }


	    }


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

	} else {


	    cs = 1.;
	    oldcs = 1.;
	    i__1 = ll + 1;
	    for (i__ = m; i__ >= i__1; --i__) {
		d__1 = d__[i__] * cs;
		if (dlartg_(interp, &d__1, &e[i__ - 1], &cs, &sn, &r__)!=TCL_OK) { return TCL_ERROR; }

		if (i__ < m) {
		    e[i__] = oldsn * r__;
		}
		d__1 = oldcs * r__;
		d__2 = d__[i__ - 1] * sn;
		if (dlartg_(interp, &d__1, &d__2, &oldcs, &oldsn, &d__[i__])!=TCL_OK) { return TCL_ERROR; }

		work[i__ - ll] = cs;
		work[i__ - ll + nm1] = -sn;
		work[i__ - ll + nm12] = oldcs;
		work[i__ - ll + nm13] = -oldsn;
	    }
	    h__ = d__[ll] * cs;
	    d__[ll] = h__ * oldcs;
	    e[ll] = h__ * oldsn;


	    if (*ncvt > 0) {
		i__1 = m - ll + 1;
		if (dlasr_(interp, "L", "V", "B", &i__1, ncvt, &work[nm12 + 1], &work[			nm13 + 1], &vt[ll + vt_dim1], ldvt)!=TCL_OK) { return TCL_ERROR; }


	    }
	    if (*nru > 0) {
		i__1 = m - ll + 1;
		if (dlasr_(interp, "R", "V", "B", nru, &i__1, &work[1], &work[*n], &u[ll *			 u_dim1 + 1], ldu)!=TCL_OK) { return TCL_ERROR; }


	    }
	    if (*ncc > 0) {
		i__1 = m - ll + 1;
		if (dlasr_(interp, "L", "V", "B", &i__1, ncc, &work[1], &work[*n], &c__[			ll + c_dim1], ldc)!=TCL_OK) { return TCL_ERROR; }


	    }


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


	if (idir == 1) {


	    f = ((d__1 = d__[ll], abs(d__1)) - shift) * (d_sign(&dbdsqr_c_b49, &d__[
		    ll]) + shift / d__[ll]);
	    g = e[ll];
	    i__1 = m - 1;
	    for (i__ = ll; i__ <= i__1; ++i__) {
		if (dlartg_(interp, &f, &g, &cosr, &sinr, &r__)!=TCL_OK) { return TCL_ERROR; }

		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];
		if (dlartg_(interp, &f, &g, &cosl, &sinl, &r__)!=TCL_OK) { return TCL_ERROR; }

		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;
	    }
	    e[m - 1] = f;


	    if (*ncvt > 0) {
		i__1 = m - ll + 1;
		if (dlasr_(interp, "L", "V", "F", &i__1, ncvt, &work[1], &work[*n], &vt[			ll + vt_dim1], ldvt)!=TCL_OK) { return TCL_ERROR; }


	    }
	    if (*nru > 0) {
		i__1 = m - ll + 1;
		if (dlasr_(interp, "R", "V", "F", nru, &i__1, &work[nm12 + 1], &work[nm13 			+ 1], &u[ll * u_dim1 + 1], ldu)!=TCL_OK) { return TCL_ERROR; }


	    }
	    if (*ncc > 0) {
		i__1 = m - ll + 1;
		if (dlasr_(interp, "L", "V", "F", &i__1, ncc, &work[nm12 + 1], &work[nm13 			+ 1], &c__[ll + c_dim1], ldc)!=TCL_OK) { return TCL_ERROR; }


	    }


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

	} else {


	    f = ((d__1 = d__[m], abs(d__1)) - shift) * (d_sign(&dbdsqr_c_b49, &d__[m]
		    ) + shift / d__[m]);
	    g = e[m - 1];
	    i__1 = ll + 1;
	    for (i__ = m; i__ >= i__1; --i__) {
		if (dlartg_(interp, &f, &g, &cosr, &sinr, &r__)!=TCL_OK) { return TCL_ERROR; }

		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];
		if (dlartg_(interp, &f, &g, &cosl, &sinl, &r__)!=TCL_OK) { return TCL_ERROR; }

		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;
	    }
	    e[ll] = f;


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


	    if (*ncvt > 0) {
		i__1 = m - ll + 1;
		if (dlasr_(interp, "L", "V", "B", &i__1, ncvt, &work[nm12 + 1], &work[			nm13 + 1], &vt[ll + vt_dim1], ldvt)!=TCL_OK) { return TCL_ERROR; }


	    }
	    if (*nru > 0) {
		i__1 = m - ll + 1;
		if (dlasr_(interp, "R", "V", "B", nru, &i__1, &work[1], &work[*n], &u[ll *			 u_dim1 + 1], ldu)!=TCL_OK) { return TCL_ERROR; }


	    }
	    if (*ncc > 0) {
		i__1 = m - ll + 1;
		if (dlasr_(interp, "L", "V", "B", &i__1, ncc, &work[1], &work[*n], &c__[			ll + c_dim1], ldc)!=TCL_OK) { return TCL_ERROR; }


	    }
	}
    }


    goto L60;


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


	    if (*ncvt > 0) {
		if (dscal_(interp, ncvt, &dbdsqr_c_b72, &vt[i__ + vt_dim1], ldvt)!=TCL_OK) { return TCL_ERROR; }

	    }
	}
    }


    i__1 = *n - 1;
    for (i__ = 1; i__ <= i__1; ++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];
	    }
	}
	if (isub != *n + 1 - i__) {


	    d__[isub] = d__[*n + 1 - i__];
	    d__[*n + 1 - i__] = smin;
	    if (*ncvt > 0) {
		if (dswap_(interp, ncvt, &vt[isub + vt_dim1], ldvt, &vt[*n + 1 - i__ + 			vt_dim1], ldvt)!=TCL_OK) { return TCL_ERROR; }


	    }
	    if (*nru > 0) {
		if (dswap_(interp, nru, &u[isub * u_dim1 + 1], &dbdsqr_c__1, &u[(*n + 1 - i__) * 			u_dim1 + 1], &dbdsqr_c__1)!=TCL_OK) { return TCL_ERROR; }


	    }
	    if (*ncc > 0) {
		if (dswap_(interp, ncc, &c__[isub + c_dim1], ldc, &c__[*n + 1 - i__ + 			c_dim1], ldc)!=TCL_OK) { return TCL_ERROR; }


	    }
	}
    }
    goto L220;


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


} /* dbdsqr_ */
static /* Subroutine */ int dormlq_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *	c__, integer *ldc, doublereal *work, integer *lwork, integer *info)
{
    address 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];

    /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);

    integer i__;
    doublereal t[4160]	/* was [65][64] */;
    integer i1, i2, i3, ib, ic, jc, nb, mi, ni, nq, nw, iws;
    logical left;
    integer nbmin, iinfo;
    logical notran;
    integer ldwork;
    char transt[1];
    integer lwkopt;
    logical lquery;




























    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --tau;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;
    --work;

    *info = 0;
    left = lsame_(side, "L");
    notran = lsame_(trans, "N");
    lquery = *lwork == -1;


    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) {


	i__3[0] = 1, a__1[0] = side;
	i__3[1] = 1, a__1[1] = trans;
	s_cat(ch__1, a__1, i__3, &dormlq_c__2, (ftnlen)2);
	i__1 = 64, i__2 = ilaenv_(&dormlq_c__1, "DORMLQ", ch__1, m, n, k, &dormlq_c_n1);
	nb = min(i__1,i__2);
	lwkopt = max(1,nw) * nb;
	work[1] = (doublereal) lwkopt;
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DORMLQ", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


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

    nbmin = 2;
    ldwork = nw;
    if (nb > 1 && nb < *k) {
	iws = nw * nb;
	if (*lwork < iws) {
	    nb = *lwork / ldwork;
	    i__3[0] = 1, a__1[0] = side;
	    i__3[1] = 1, a__1[1] = trans;
	    s_cat(ch__1, a__1, i__3, &dormlq_c__2, (ftnlen)2);
	    i__1 = 2, i__2 = ilaenv_(&dormlq_c__2, "DORMLQ", ch__1, m, n, k, &dormlq_c_n1);
	    nbmin = max(i__1,i__2);
	}
    } else {
	iws = nw;
    }

    if (nb < nbmin || nb >= *k) {


	if (dorml2_(interp, side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[		c_offset], ldc, &work[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }


    } else {


	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) {
	    i__4 = nb, i__5 = *k - i__ + 1;
	    ib = min(i__4,i__5);


	    i__4 = nq - i__ + 1;
	    if (dlarft_(interp, "Forward", "Rowwise", &i__4, &ib, &a[i__ + i__ * a_dim1], 		    lda, &tau[i__], t, &dormlq_c__65)!=TCL_OK) { return TCL_ERROR; }


	    if (left) {


		mi = *m - i__ + 1;
		ic = i__;
	    } else {


		ni = *n - i__ + 1;
		jc = i__;
	    }


	    if (dlarfb_(interp, side, transt, "Forward", "Rowwise", &mi, &ni, &ib, &a[i__ 		    + i__ * a_dim1], lda, t, &dormlq_c__65, &c__[ic + jc * c_dim1], 
		    ldc, &work[1], &ldwork)!=TCL_OK) { return TCL_ERROR; }


	}
    }
    work[1] = (doublereal) lwkopt;
return TCL_OK;


} /* dormlq_ */
static /* Subroutine */ int dormqr_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *	c__, integer *ldc, doublereal *work, integer *lwork, integer *info)
{
    address 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];

    /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);

    integer i__;
    doublereal t[4160]	/* was [65][64] */;
    integer i1, i2, i3, ib, ic, jc, nb, mi, ni, nq, nw, iws;
    logical left;
    integer nbmin, iinfo;
    logical notran;
    integer ldwork, lwkopt;
    logical lquery;




























    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --tau;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;
    --work;

    *info = 0;
    left = lsame_(side, "L");
    notran = lsame_(trans, "N");
    lquery = *lwork == -1;


    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) {


	i__3[0] = 1, a__1[0] = side;
	i__3[1] = 1, a__1[1] = trans;
	s_cat(ch__1, a__1, i__3, &dormqr_c__2, (ftnlen)2);
	i__1 = 64, i__2 = ilaenv_(&dormqr_c__1, "DORMQR", ch__1, m, n, k, &dormqr_c_n1);
	nb = min(i__1,i__2);
	lwkopt = max(1,nw) * nb;
	work[1] = (doublereal) lwkopt;
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DORMQR", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


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

    nbmin = 2;
    ldwork = nw;
    if (nb > 1 && nb < *k) {
	iws = nw * nb;
	if (*lwork < iws) {
	    nb = *lwork / ldwork;
	    i__3[0] = 1, a__1[0] = side;
	    i__3[1] = 1, a__1[1] = trans;
	    s_cat(ch__1, a__1, i__3, &dormqr_c__2, (ftnlen)2);
	    i__1 = 2, i__2 = ilaenv_(&dormqr_c__2, "DORMQR", ch__1, m, n, k, &dormqr_c_n1);
	    nbmin = max(i__1,i__2);
	}
    } else {
	iws = nw;
    }

    if (nb < nbmin || nb >= *k) {


	if (dorm2r_(interp, side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[		c_offset], ldc, &work[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }


    } else {


	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) {
	    i__4 = nb, i__5 = *k - i__ + 1;
	    ib = min(i__4,i__5);


	    i__4 = nq - i__ + 1;
	    if (dlarft_(interp, "Forward", "Columnwise", &i__4, &ib, &a[i__ + i__ * 		    a_dim1], lda, &tau[i__], t, &dormqr_c__65)
		    !=TCL_OK) { return TCL_ERROR; }


	    if (left) {


		mi = *m - i__ + 1;
		ic = i__;
	    } else {


		ni = *n - i__ + 1;
		jc = i__;
	    }


	    if (dlarfb_(interp, side, trans, "Forward", "Columnwise", &mi, &ni, &ib, &a[		    i__ + i__ * a_dim1], lda, t, &dormqr_c__65, &c__[ic + jc * 
		    c_dim1], ldc, &work[1], &ldwork)!=TCL_OK) { return TCL_ERROR; }


	}
    }
    work[1] = (doublereal) lwkopt;
return TCL_OK;


} /* dormqr_ */
static /* Subroutine */ int zgemv_ (Tcl_Interp *interp, char *trans, integer *m, integer *n, 	doublecomplex *alpha, doublecomplex *a, integer *lda, doublecomplex *	x, integer *incx, doublecomplex *beta, doublecomplex *y, integer *	incy)
{
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
    doublecomplex z__1, z__2, z__3;

    void d_cnjg(doublecomplex *, doublecomplex *);

    integer i__, j, ix, iy, jx, jy, kx, ky, info;
    doublecomplex temp;
    integer lenx, leny;
    logical noconj;





























    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --x;
    --y;

    info = 0;
    if (! lsame_(trans, "N") && ! lsame_(trans, "T") && ! lsame_(trans, "C")
	    ) {
	info = 1;
    } else if (*m < 0) {
	info = 2;
    } else if (*n < 0) {
	info = 3;
    } else if (*lda < max(1,*m)) {
	info = 6;
    } else if (*incx == 0) {
	info = 8;
    } else if (*incy == 0) {
	info = 11;
    }
    if (info != 0) {
	vectcl_xerbla(interp, "ZGEMV ", &info);
return TCL_ERROR;

return TCL_OK;
    }


    if (*m == 0 || *n == 0 || alpha->r == 0. && alpha->i == 0. && (beta->r == 
	    1. && beta->i == 0.)) {
return TCL_OK;
    }

    noconj = lsame_(trans, "T");


    if (lsame_(trans, "N")) {
	lenx = *n;
	leny = *m;
    } else {
	lenx = *m;
	leny = *n;
    }
    if (*incx > 0) {
	kx = 1;
    } else {
	kx = 1 - (lenx - 1) * *incx;
    }
    if (*incy > 0) {
	ky = 1;
    } else {
	ky = 1 - (leny - 1) * *incy;
    }



    if (beta->r != 1. || beta->i != 0.) {
	if (*incy == 1) {
	    if (beta->r == 0. && beta->i == 0.) {
		i__1 = leny;
		for (i__ = 1; i__ <= i__1; ++i__) {
		    i__2 = i__;
		    y[i__2].r = 0., y[i__2].i = 0.;
		}
	    } else {
		i__1 = leny;
		for (i__ = 1; i__ <= i__1; ++i__) {
		    i__2 = i__;
		    i__3 = i__;
		    z__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i, 
			    z__1.i = beta->r * y[i__3].i + beta->i * y[i__3]
			    .r;
		    y[i__2].r = z__1.r, y[i__2].i = z__1.i;
		}
	    }
	} else {
	    iy = ky;
	    if (beta->r == 0. && beta->i == 0.) {
		i__1 = leny;
		for (i__ = 1; i__ <= i__1; ++i__) {
		    i__2 = iy;
		    y[i__2].r = 0., y[i__2].i = 0.;
		    iy += *incy;
		}
	    } else {
		i__1 = leny;
		for (i__ = 1; i__ <= i__1; ++i__) {
		    i__2 = iy;
		    i__3 = iy;
		    z__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i, 
			    z__1.i = beta->r * y[i__3].i + beta->i * y[i__3]
			    .r;
		    y[i__2].r = z__1.r, y[i__2].i = z__1.i;
		    iy += *incy;
		}
	    }
	}
    }
    if (alpha->r == 0. && alpha->i == 0.) {
return TCL_OK;
    }
    if (lsame_(trans, "N")) {


	jx = kx;
	if (*incy == 1) {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = jx;
		if (x[i__2].r != 0. || x[i__2].i != 0.) {
		    i__2 = jx;
		    z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, 
			    z__1.i = alpha->r * x[i__2].i + alpha->i * x[i__2]
			    .r;
		    temp.r = z__1.r, temp.i = z__1.i;
		    i__2 = *m;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			i__3 = i__;
			i__4 = i__;
			i__5 = i__ + j * a_dim1;
			z__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i, 
				z__2.i = temp.r * a[i__5].i + temp.i * a[i__5]
				.r;
			z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + 
				z__2.i;
			y[i__3].r = z__1.r, y[i__3].i = z__1.i;
		    }
		}
		jx += *incx;
	    }
	} else {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = jx;
		if (x[i__2].r != 0. || x[i__2].i != 0.) {
		    i__2 = jx;
		    z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, 
			    z__1.i = alpha->r * x[i__2].i + alpha->i * x[i__2]
			    .r;
		    temp.r = z__1.r, temp.i = z__1.i;
		    iy = ky;
		    i__2 = *m;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			i__3 = iy;
			i__4 = iy;
			i__5 = i__ + j * a_dim1;
			z__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i, 
				z__2.i = temp.r * a[i__5].i + temp.i * a[i__5]
				.r;
			z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + 
				z__2.i;
			y[i__3].r = z__1.r, y[i__3].i = z__1.i;
			iy += *incy;
		    }
		}
		jx += *incx;
	    }
	}
    } else {


	jy = ky;
	if (*incx == 1) {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		temp.r = 0., temp.i = 0.;
		if (noconj) {
		    i__2 = *m;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			i__3 = i__ + j * a_dim1;
			i__4 = i__;
			z__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[i__4]
				.i, z__2.i = a[i__3].r * x[i__4].i + a[i__3]
				.i * x[i__4].r;
			z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
			temp.r = z__1.r, temp.i = z__1.i;
		    }
		} else {
		    i__2 = *m;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			d_cnjg(&z__3, &a[i__ + j * a_dim1]);
			i__3 = i__;
			z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, 
				z__2.i = z__3.r * x[i__3].i + z__3.i * x[i__3]
				.r;
			z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
			temp.r = z__1.r, temp.i = z__1.i;
		    }
		}
		i__2 = jy;
		i__3 = jy;
		z__2.r = alpha->r * temp.r - alpha->i * temp.i, z__2.i = 
			alpha->r * temp.i + alpha->i * temp.r;
		z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;
		y[i__2].r = z__1.r, y[i__2].i = z__1.i;
		jy += *incy;
	    }
	} else {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		temp.r = 0., temp.i = 0.;
		ix = kx;
		if (noconj) {
		    i__2 = *m;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			i__3 = i__ + j * a_dim1;
			i__4 = ix;
			z__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[i__4]
				.i, z__2.i = a[i__3].r * x[i__4].i + a[i__3]
				.i * x[i__4].r;
			z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
			temp.r = z__1.r, temp.i = z__1.i;
			ix += *incx;
		    }
		} else {
		    i__2 = *m;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			d_cnjg(&z__3, &a[i__ + j * a_dim1]);
			i__3 = ix;
			z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, 
				z__2.i = z__3.r * x[i__3].i + z__3.i * x[i__3]
				.r;
			z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
			temp.r = z__1.r, temp.i = z__1.i;
			ix += *incx;
		    }
		}
		i__2 = jy;
		i__3 = jy;
		z__2.r = alpha->r * temp.r - alpha->i * temp.i, z__2.i = 
			alpha->r * temp.i + alpha->i * temp.r;
		z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;
		y[i__2].r = z__1.r, y[i__2].i = z__1.i;
		jy += *incy;
	    }
	}
    }

return TCL_OK;


} /* zgemv_ */
static /* Subroutine */ int zcopy_ (Tcl_Interp *interp, integer *n, doublecomplex *zx, integer *incx, 	doublecomplex *zy, integer *incy)
{
    integer i__1, i__2, i__3;

    integer i__, ix, iy;





    --zy;
    --zx;

    if (*n <= 0) {
return TCL_OK;
    }
    if (*incx == 1 && *incy == 1) {
	goto L20;
    }


    ix = 1;
    iy = 1;
    if (*incx < 0) {
	ix = (-(*n) + 1) * *incx + 1;
    }
    if (*incy < 0) {
	iy = (-(*n) + 1) * *incy + 1;
    }
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	i__2 = iy;
	i__3 = ix;
	zy[i__2].r = zx[i__3].r, zy[i__2].i = zx[i__3].i;
	ix += *incx;
	iy += *incy;
    }
return TCL_OK;


L20:
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	i__2 = i__;
	i__3 = i__;
	zy[i__2].r = zx[i__3].r, zy[i__2].i = zx[i__3].i;
    }
return TCL_OK;
} /* zcopy_ */
static /* Subroutine */ int zdrscl_ (Tcl_Interp *interp, integer *n, doublereal *sa, doublecomplex *sx, 	integer *incx)
{
    doublereal mul, cden;
    logical done;
    doublereal cnum, cden1, cnum1;
    doublereal bignum, smlnum;














    --sx;

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


    smlnum = dlamch_("S");
    bignum = 1. / smlnum;
    if (dlabad_(interp, &smlnum, &bignum)!=TCL_OK) { return TCL_ERROR; }



    cden = *sa;
    cnum = 1.;

L10:
    cden1 = cden * smlnum;
    cnum1 = cnum / bignum;
    if (abs(cden1) > abs(cnum) && cnum != 0.) {


	mul = smlnum;
	done = FALSE_;
	cden = cden1;
    } else if (abs(cnum1) > abs(cden)) {


	mul = bignum;
	done = FALSE_;
	cnum = cnum1;
    } else {


	mul = cnum / cden;
	done = TRUE_;
    }


    if (zdscal_(interp, n, &mul, &sx[1], incx)!=TCL_OK) { return TCL_ERROR; }


    if (! done) {
	goto L10;
    }

return TCL_OK;


} /* zdrscl_ */
static /* Subroutine */ int zbdsqr_ (Tcl_Interp *interp, char *uplo, integer *n, integer *ncvt, integer *	nru, integer *ncc, doublereal *d__, doublereal *e, doublecomplex *vt, 	integer *ldvt, doublecomplex *u, integer *ldu, doublecomplex *c__, 	integer *ldc, doublereal *rwork, integer *info)
{
    integer c_dim1, c_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__1, 
	    i__2;
    doublereal d__1, d__2, d__3, d__4;

    double pow_dd(doublereal *, doublereal *), sqrt(doublereal), d_sign(
	    doublereal *, doublereal *);

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

































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

    *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);
	vectcl_xerbla(interp, "ZBDSQR", &i__1);
return TCL_ERROR;

return TCL_OK;
    }
    if (*n == 0) {
return TCL_OK;
    }
    if (*n == 1) {
	goto L160;
    }


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


    if (! rotate) {
	if (dlasq1_(interp, n, &d__[1], &e[1], &rwork[1], info)!=TCL_OK) { return TCL_ERROR; }

return TCL_OK;
    }

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


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


    if (lower) {
	i__1 = *n - 1;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    if (dlartg_(interp, &d__[i__], &e[i__], &cs, &sn, &r__)!=TCL_OK) { return TCL_ERROR; }

	    d__[i__] = r__;
	    e[i__] = sn * d__[i__ + 1];
	    d__[i__ + 1] = cs * d__[i__ + 1];
	    rwork[i__] = cs;
	    rwork[nm1 + i__] = sn;
	}


	if (*nru > 0) {
	    if (zlasr_(interp, "R", "V", "F", nru, n, &rwork[1], &rwork[*n], &u[u_offset], 		     ldu)!=TCL_OK) { return TCL_ERROR; }


	}
	if (*ncc > 0) {
	    if (zlasr_(interp, "L", "V", "F", n, ncc, &rwork[1], &rwork[*n], &c__[		    c_offset], ldc)!=TCL_OK) { return TCL_ERROR; }


	}
    }


    d__3 = 100., d__4 = pow_dd(&eps, &zbdsqr_c_b15);
    d__1 = 10., d__2 = min(d__3,d__4);
    tolmul = max(d__1,d__2);
    tol = tolmul * eps;


    smax = 0.;
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	d__2 = smax, d__3 = (d__1 = d__[i__], abs(d__1));
	smax = max(d__2,d__3);
    }
    i__1 = *n - 1;
    for (i__ = 1; i__ <= i__1; ++i__) {
	d__2 = smax, d__3 = (d__1 = e[i__], abs(d__1));
	smax = max(d__2,d__3);
    }
    sminl = 0.;
    if (tol >= 0.) {


	sminoa = abs(d__[1]);
	if (sminoa == 0.) {
	    goto L50;
	}
	mu = sminoa;
	i__1 = *n;
	for (i__ = 2; i__ <= i__1; ++i__) {
	    mu = (d__2 = d__[i__], abs(d__2)) * (mu / (mu + (d__1 = e[i__ - 1]
		    , abs(d__1))));
	    sminoa = min(sminoa,mu);
	    if (sminoa == 0.) {
		goto L50;
	    }
	}
L50:
	sminoa /= sqrt((doublereal) (*n));
	d__1 = tol * sminoa, d__2 = *n * 6 * *n * unfl;
	thresh = max(d__1,d__2);
    } else {


	d__1 = abs(tol) * smax, d__2 = *n * 6 * *n * unfl;
	thresh = max(d__1,d__2);
    }


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


    m = *n;


L60:


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


    if (tol < 0. && (d__1 = d__[m], abs(d__1)) <= thresh) {
	d__[m] = 0.;
    }
    smax = (d__1 = d__[m], abs(d__1));
    smin = smax;
    i__1 = m - 1;
    for (lll = 1; lll <= i__1; ++lll) {
	ll = m - lll;
	abss = (d__1 = d__[ll], abs(d__1));
	abse = (d__1 = e[ll], abs(d__1));
	if (tol < 0. && abss <= thresh) {
	    d__[ll] = 0.;
	}
	if (abse <= thresh) {
	    goto L80;
	}
	smin = min(smin,abss);
	d__1 = max(smax,abss);
	smax = max(d__1,abse);
    }
    ll = 0;
    goto L90;
L80:
    e[ll] = 0.;


    if (ll == m - 1) {


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


    if (ll == m - 1) {


	if (dlasv2_(interp, &d__[m - 1], &e[m - 1], &d__[m], &sigmn, &sigmx, &sinr, &cosr, 		 &sinl, &cosl)!=TCL_OK) { return TCL_ERROR; }


	d__[m - 1] = sigmx;
	e[m - 1] = 0.;
	d__[m] = sigmn;


	if (*ncvt > 0) {
	    if (zdrot_(interp, ncvt, &vt[m - 1 + vt_dim1], ldvt, &vt[m + vt_dim1], ldvt, &		    cosr, &sinr)!=TCL_OK) { return TCL_ERROR; }


	}
	if (*nru > 0) {
	    if (zdrot_(interp, nru, &u[(m - 1) * u_dim1 + 1], &zbdsqr_c__1, &u[m * u_dim1 + 1], &		    zbdsqr_c__1, &cosl, &sinl)!=TCL_OK) { return TCL_ERROR; }


	}
	if (*ncc > 0) {
	    if (zdrot_(interp, ncc, &c__[m - 1 + c_dim1], ldc, &c__[m + c_dim1], ldc, &		    cosl, &sinl)!=TCL_OK) { return TCL_ERROR; }


	}
	m += -2;
	goto L60;
    }


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


	    idir = 1;
	} else {


	    idir = 2;
	}
    }


    if (idir == 1) {


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

	if (tol >= 0.) {


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

    } else {


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

	if (tol >= 0.) {


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


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


	shift = 0.;
    } else {


	if (idir == 1) {
	    sll = (d__1 = d__[ll], abs(d__1));
	    if (dlas2_(interp, &d__[m - 1], &e[m - 1], &d__[m], &shift, &r__)!=TCL_OK) { return TCL_ERROR; }

	} else {
	    sll = (d__1 = d__[m], abs(d__1));
	    if (dlas2_(interp, &d__[ll], &e[ll], &d__[ll + 1], &shift, &r__)!=TCL_OK) { return TCL_ERROR; }

	}


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


    iter = iter + m - ll;


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


	    cs = 1.;
	    oldcs = 1.;
	    i__1 = m - 1;
	    for (i__ = ll; i__ <= i__1; ++i__) {
		d__1 = d__[i__] * cs;
		if (dlartg_(interp, &d__1, &e[i__], &cs, &sn, &r__)!=TCL_OK) { return TCL_ERROR; }

		if (i__ > ll) {
		    e[i__ - 1] = oldsn * r__;
		}
		d__1 = oldcs * r__;
		d__2 = d__[i__ + 1] * sn;
		if (dlartg_(interp, &d__1, &d__2, &oldcs, &oldsn, &d__[i__])!=TCL_OK) { return TCL_ERROR; }

		rwork[i__ - ll + 1] = cs;
		rwork[i__ - ll + 1 + nm1] = sn;
		rwork[i__ - ll + 1 + nm12] = oldcs;
		rwork[i__ - ll + 1 + nm13] = oldsn;
	    }
	    h__ = d__[m] * cs;
	    d__[m] = h__ * oldcs;
	    e[m - 1] = h__ * oldsn;


	    if (*ncvt > 0) {
		i__1 = m - ll + 1;
		if (zlasr_(interp, "L", "V", "F", &i__1, ncvt, &rwork[1], &rwork[*n], &vt[			ll + vt_dim1], ldvt)!=TCL_OK) { return TCL_ERROR; }


	    }
	    if (*nru > 0) {
		i__1 = m - ll + 1;
		if (zlasr_(interp, "R", "V", "F", nru, &i__1, &rwork[nm12 + 1], &rwork[			nm13 + 1], &u[ll * u_dim1 + 1], ldu)!=TCL_OK) { return TCL_ERROR; }


	    }
	    if (*ncc > 0) {
		i__1 = m - ll + 1;
		if (zlasr_(interp, "L", "V", "F", &i__1, ncc, &rwork[nm12 + 1], &rwork[			nm13 + 1], &c__[ll + c_dim1], ldc)!=TCL_OK) { return TCL_ERROR; }


	    }


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

	} else {


	    cs = 1.;
	    oldcs = 1.;
	    i__1 = ll + 1;
	    for (i__ = m; i__ >= i__1; --i__) {
		d__1 = d__[i__] * cs;
		if (dlartg_(interp, &d__1, &e[i__ - 1], &cs, &sn, &r__)!=TCL_OK) { return TCL_ERROR; }

		if (i__ < m) {
		    e[i__] = oldsn * r__;
		}
		d__1 = oldcs * r__;
		d__2 = d__[i__ - 1] * sn;
		if (dlartg_(interp, &d__1, &d__2, &oldcs, &oldsn, &d__[i__])!=TCL_OK) { return TCL_ERROR; }

		rwork[i__ - ll] = cs;
		rwork[i__ - ll + nm1] = -sn;
		rwork[i__ - ll + nm12] = oldcs;
		rwork[i__ - ll + nm13] = -oldsn;
	    }
	    h__ = d__[ll] * cs;
	    d__[ll] = h__ * oldcs;
	    e[ll] = h__ * oldsn;


	    if (*ncvt > 0) {
		i__1 = m - ll + 1;
		if (zlasr_(interp, "L", "V", "B", &i__1, ncvt, &rwork[nm12 + 1], &rwork[			nm13 + 1], &vt[ll + vt_dim1], ldvt)!=TCL_OK) { return TCL_ERROR; }


	    }
	    if (*nru > 0) {
		i__1 = m - ll + 1;
		if (zlasr_(interp, "R", "V", "B", nru, &i__1, &rwork[1], &rwork[*n], &u[			ll * u_dim1 + 1], ldu)!=TCL_OK) { return TCL_ERROR; }


	    }
	    if (*ncc > 0) {
		i__1 = m - ll + 1;
		if (zlasr_(interp, "L", "V", "B", &i__1, ncc, &rwork[1], &rwork[*n], &c__[			ll + c_dim1], ldc)!=TCL_OK) { return TCL_ERROR; }


	    }


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


	if (idir == 1) {


	    f = ((d__1 = d__[ll], abs(d__1)) - shift) * (d_sign(&zbdsqr_c_b49, &d__[
		    ll]) + shift / d__[ll]);
	    g = e[ll];
	    i__1 = m - 1;
	    for (i__ = ll; i__ <= i__1; ++i__) {
		if (dlartg_(interp, &f, &g, &cosr, &sinr, &r__)!=TCL_OK) { return TCL_ERROR; }

		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];
		if (dlartg_(interp, &f, &g, &cosl, &sinl, &r__)!=TCL_OK) { return TCL_ERROR; }

		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];
		}
		rwork[i__ - ll + 1] = cosr;
		rwork[i__ - ll + 1 + nm1] = sinr;
		rwork[i__ - ll + 1 + nm12] = cosl;
		rwork[i__ - ll + 1 + nm13] = sinl;
	    }
	    e[m - 1] = f;


	    if (*ncvt > 0) {
		i__1 = m - ll + 1;
		if (zlasr_(interp, "L", "V", "F", &i__1, ncvt, &rwork[1], &rwork[*n], &vt[			ll + vt_dim1], ldvt)!=TCL_OK) { return TCL_ERROR; }


	    }
	    if (*nru > 0) {
		i__1 = m - ll + 1;
		if (zlasr_(interp, "R", "V", "F", nru, &i__1, &rwork[nm12 + 1], &rwork[			nm13 + 1], &u[ll * u_dim1 + 1], ldu)!=TCL_OK) { return TCL_ERROR; }


	    }
	    if (*ncc > 0) {
		i__1 = m - ll + 1;
		if (zlasr_(interp, "L", "V", "F", &i__1, ncc, &rwork[nm12 + 1], &rwork[			nm13 + 1], &c__[ll + c_dim1], ldc)!=TCL_OK) { return TCL_ERROR; }


	    }


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

	} else {


	    f = ((d__1 = d__[m], abs(d__1)) - shift) * (d_sign(&zbdsqr_c_b49, &d__[m]
		    ) + shift / d__[m]);
	    g = e[m - 1];
	    i__1 = ll + 1;
	    for (i__ = m; i__ >= i__1; --i__) {
		if (dlartg_(interp, &f, &g, &cosr, &sinr, &r__)!=TCL_OK) { return TCL_ERROR; }

		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];
		if (dlartg_(interp, &f, &g, &cosl, &sinl, &r__)!=TCL_OK) { return TCL_ERROR; }

		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];
		}
		rwork[i__ - ll] = cosr;
		rwork[i__ - ll + nm1] = -sinr;
		rwork[i__ - ll + nm12] = cosl;
		rwork[i__ - ll + nm13] = -sinl;
	    }
	    e[ll] = f;


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


	    if (*ncvt > 0) {
		i__1 = m - ll + 1;
		if (zlasr_(interp, "L", "V", "B", &i__1, ncvt, &rwork[nm12 + 1], &rwork[			nm13 + 1], &vt[ll + vt_dim1], ldvt)!=TCL_OK) { return TCL_ERROR; }


	    }
	    if (*nru > 0) {
		i__1 = m - ll + 1;
		if (zlasr_(interp, "R", "V", "B", nru, &i__1, &rwork[1], &rwork[*n], &u[			ll * u_dim1 + 1], ldu)!=TCL_OK) { return TCL_ERROR; }


	    }
	    if (*ncc > 0) {
		i__1 = m - ll + 1;
		if (zlasr_(interp, "L", "V", "B", &i__1, ncc, &rwork[1], &rwork[*n], &c__[			ll + c_dim1], ldc)!=TCL_OK) { return TCL_ERROR; }


	    }
	}
    }


    goto L60;


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


	    if (*ncvt > 0) {
		if (zdscal_(interp, ncvt, &zbdsqr_c_b72, &vt[i__ + vt_dim1], ldvt)!=TCL_OK) { return TCL_ERROR; }

	    }
	}
    }


    i__1 = *n - 1;
    for (i__ = 1; i__ <= i__1; ++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];
	    }
	}
	if (isub != *n + 1 - i__) {


	    d__[isub] = d__[*n + 1 - i__];
	    d__[*n + 1 - i__] = smin;
	    if (*ncvt > 0) {
		if (zswap_(interp, ncvt, &vt[isub + vt_dim1], ldvt, &vt[*n + 1 - i__ + 			vt_dim1], ldvt)!=TCL_OK) { return TCL_ERROR; }


	    }
	    if (*nru > 0) {
		if (zswap_(interp, nru, &u[isub * u_dim1 + 1], &zbdsqr_c__1, &u[(*n + 1 - i__) * 			u_dim1 + 1], &zbdsqr_c__1)!=TCL_OK) { return TCL_ERROR; }


	    }
	    if (*ncc > 0) {
		if (zswap_(interp, ncc, &c__[isub + c_dim1], ldc, &c__[*n + 1 - i__ + 			c_dim1], ldc)!=TCL_OK) { return TCL_ERROR; }


	    }
	}
    }
    goto L220;


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


} /* zbdsqr_ */
static /* Subroutine */ int zunmlq_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *k, doublecomplex *a, integer *lda, doublecomplex *tau, 	doublecomplex *c__, integer *ldc, doublecomplex *work, integer *lwork, 	 integer *info)
{
    address 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];

    /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);

    integer i__;
    doublecomplex t[4160]	/* was [65][64] */;
    integer i1, i2, i3, ib, ic, jc, nb, mi, ni, nq, nw, iws;
    logical left;
    integer nbmin, iinfo;
    logical notran;
    integer ldwork;
    char transt[1];
    integer lwkopt;
    logical lquery;




























    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --tau;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;
    --work;

    *info = 0;
    left = lsame_(side, "L");
    notran = lsame_(trans, "N");
    lquery = *lwork == -1;


    if (left) {
	nq = *m;
	nw = *n;
    } else {
	nq = *n;
	nw = *m;
    }
    if (! left && ! lsame_(side, "R")) {
	*info = -1;
    } else if (! notran && ! lsame_(trans, "C")) {
	*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) {


	i__3[0] = 1, a__1[0] = side;
	i__3[1] = 1, a__1[1] = trans;
	s_cat(ch__1, a__1, i__3, &zunmlq_c__2, (ftnlen)2);
	i__1 = 64, i__2 = ilaenv_(&zunmlq_c__1, "ZUNMLQ", ch__1, m, n, k, &zunmlq_c_n1);
	nb = min(i__1,i__2);
	lwkopt = max(1,nw) * nb;
	work[1].r = (doublereal) lwkopt, work[1].i = 0.;
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "ZUNMLQ", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


    if (*m == 0 || *n == 0 || *k == 0) {
	work[1].r = 1., work[1].i = 0.;
return TCL_OK;
    }

    nbmin = 2;
    ldwork = nw;
    if (nb > 1 && nb < *k) {
	iws = nw * nb;
	if (*lwork < iws) {
	    nb = *lwork / ldwork;
	    i__3[0] = 1, a__1[0] = side;
	    i__3[1] = 1, a__1[1] = trans;
	    s_cat(ch__1, a__1, i__3, &zunmlq_c__2, (ftnlen)2);
	    i__1 = 2, i__2 = ilaenv_(&zunmlq_c__2, "ZUNMLQ", ch__1, m, n, k, &zunmlq_c_n1);
	    nbmin = max(i__1,i__2);
	}
    } else {
	iws = nw;
    }

    if (nb < nbmin || nb >= *k) {


	if (zunml2_(interp, side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[		c_offset], ldc, &work[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }


    } else {


	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 = 'C';
	} 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) {
	    i__4 = nb, i__5 = *k - i__ + 1;
	    ib = min(i__4,i__5);


	    i__4 = nq - i__ + 1;
	    if (zlarft_(interp, "Forward", "Rowwise", &i__4, &ib, &a[i__ + i__ * a_dim1], 		    lda, &tau[i__], t, &zunmlq_c__65)!=TCL_OK) { return TCL_ERROR; }


	    if (left) {


		mi = *m - i__ + 1;
		ic = i__;
	    } else {


		ni = *n - i__ + 1;
		jc = i__;
	    }


	    if (zlarfb_(interp, side, transt, "Forward", "Rowwise", &mi, &ni, &ib, &a[i__ 		    + i__ * a_dim1], lda, t, &zunmlq_c__65, &c__[ic + jc * c_dim1], 
		    ldc, &work[1], &ldwork)!=TCL_OK) { return TCL_ERROR; }


	}
    }
    work[1].r = (doublereal) lwkopt, work[1].i = 0.;
return TCL_OK;


} /* zunmlq_ */
static /* Subroutine */ int zunmqr_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *k, doublecomplex *a, integer *lda, doublecomplex *tau, 	doublecomplex *c__, integer *ldc, doublecomplex *work, integer *lwork, 	 integer *info)
{
    address 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];

    /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);

    integer i__;
    doublecomplex t[4160]	/* was [65][64] */;
    integer i1, i2, i3, ib, ic, jc, nb, mi, ni, nq, nw, iws;
    logical left;
    integer nbmin, iinfo;
    logical notran;
    integer ldwork;
    integer lwkopt;
    logical lquery;




























    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --tau;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;
    --work;

    *info = 0;
    left = lsame_(side, "L");
    notran = lsame_(trans, "N");
    lquery = *lwork == -1;


    if (left) {
	nq = *m;
	nw = *n;
    } else {
	nq = *n;
	nw = *m;
    }
    if (! left && ! lsame_(side, "R")) {
	*info = -1;
    } else if (! notran && ! lsame_(trans, "C")) {
	*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) {


	i__3[0] = 1, a__1[0] = side;
	i__3[1] = 1, a__1[1] = trans;
	s_cat(ch__1, a__1, i__3, &zunmqr_c__2, (ftnlen)2);
	i__1 = 64, i__2 = ilaenv_(&zunmqr_c__1, "ZUNMQR", ch__1, m, n, k, &zunmqr_c_n1);
	nb = min(i__1,i__2);
	lwkopt = max(1,nw) * nb;
	work[1].r = (doublereal) lwkopt, work[1].i = 0.;
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "ZUNMQR", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


    if (*m == 0 || *n == 0 || *k == 0) {
	work[1].r = 1., work[1].i = 0.;
return TCL_OK;
    }

    nbmin = 2;
    ldwork = nw;
    if (nb > 1 && nb < *k) {
	iws = nw * nb;
	if (*lwork < iws) {
	    nb = *lwork / ldwork;
	    i__3[0] = 1, a__1[0] = side;
	    i__3[1] = 1, a__1[1] = trans;
	    s_cat(ch__1, a__1, i__3, &zunmqr_c__2, (ftnlen)2);
	    i__1 = 2, i__2 = ilaenv_(&zunmqr_c__2, "ZUNMQR", ch__1, m, n, k, &zunmqr_c_n1);
	    nbmin = max(i__1,i__2);
	}
    } else {
	iws = nw;
    }

    if (nb < nbmin || nb >= *k) {


	if (zunm2r_(interp, side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[		c_offset], ldc, &work[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }


    } else {


	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) {
	    i__4 = nb, i__5 = *k - i__ + 1;
	    ib = min(i__4,i__5);


	    i__4 = nq - i__ + 1;
	    if (zlarft_(interp, "Forward", "Columnwise", &i__4, &ib, &a[i__ + i__ * 		    a_dim1], lda, &tau[i__], t, &zunmqr_c__65)
		    !=TCL_OK) { return TCL_ERROR; }


	    if (left) {


		mi = *m - i__ + 1;
		ic = i__;
	    } else {


		ni = *n - i__ + 1;
		jc = i__;
	    }


	    if (zlarfb_(interp, side, trans, "Forward", "Columnwise", &mi, &ni, &ib, &a[		    i__ + i__ * a_dim1], lda, t, &zunmqr_c__65, &c__[ic + jc * 
		    c_dim1], ldc, &work[1], &ldwork)!=TCL_OK) { return TCL_ERROR; }


	}
    }
    work[1].r = (doublereal) lwkopt, work[1].i = 0.;
return TCL_OK;


} /* zunmqr_ */
static /* Subroutine */ int dtrsm_ (Tcl_Interp *interp, char *side, char *uplo, char *transa, char *diag, 	integer *m, integer *n, doublereal *alpha, doublereal *a, integer *	lda, doublereal *b, integer *ldb)
{
    integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3;

    integer i__, j, k, info;
    doublereal temp;
    logical lside;
    integer nrowa;
    logical upper;
    logical nounit;








































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

    lside = lsame_(side, "L");
    if (lside) {
	nrowa = *m;
    } else {
	nrowa = *n;
    }
    nounit = lsame_(diag, "N");
    upper = lsame_(uplo, "U");

    info = 0;
    if (! lside && ! lsame_(side, "R")) {
	info = 1;
    } else if (! upper && ! lsame_(uplo, "L")) {
	info = 2;
    } else if (! lsame_(transa, "N") && ! lsame_(transa, 
	     "T") && ! lsame_(transa, "C")) {
	info = 3;
    } else if (! lsame_(diag, "U") && ! lsame_(diag, 
	    "N")) {
	info = 4;
    } else if (*m < 0) {
	info = 5;
    } else if (*n < 0) {
	info = 6;
    } else if (*lda < max(1,nrowa)) {
	info = 9;
    } else if (*ldb < max(1,*m)) {
	info = 11;
    }
    if (info != 0) {
	vectcl_xerbla(interp, "DTRSM ", &info);
return TCL_ERROR;

return TCL_OK;
    }


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


    if (*alpha == 0.) {
	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *m;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		b[i__ + j * b_dim1] = 0.;
	    }
	}
return TCL_OK;
    }


    if (lside) {
	if (lsame_(transa, "N")) {


	    if (upper) {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    if (*alpha != 1.) {
			i__2 = *m;
			for (i__ = 1; i__ <= i__2; ++i__) {
			    b[i__ + j * b_dim1] = *alpha * b[i__ + j * b_dim1]
				    ;
			}
		    }
		    for (k = *m; k >= 1; --k) {
			if (b[k + j * b_dim1] != 0.) {
			    if (nounit) {
				b[k + j * b_dim1] /= a[k + k * a_dim1];
			    }
			    i__2 = k - 1;
			    for (i__ = 1; i__ <= i__2; ++i__) {
				b[i__ + j * b_dim1] -= b[k + j * b_dim1] * a[
					i__ + k * a_dim1];
			    }
			}
		    }
		}
	    } else {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    if (*alpha != 1.) {
			i__2 = *m;
			for (i__ = 1; i__ <= i__2; ++i__) {
			    b[i__ + j * b_dim1] = *alpha * b[i__ + j * b_dim1]
				    ;
			}
		    }
		    i__2 = *m;
		    for (k = 1; k <= i__2; ++k) {
			if (b[k + j * b_dim1] != 0.) {
			    if (nounit) {
				b[k + j * b_dim1] /= a[k + k * a_dim1];
			    }
			    i__3 = *m;
			    for (i__ = k + 1; i__ <= i__3; ++i__) {
				b[i__ + j * b_dim1] -= b[k + j * b_dim1] * a[
					i__ + k * a_dim1];
			    }
			}
		    }
		}
	    }
	} else {


	    if (upper) {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = *m;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			temp = *alpha * b[i__ + j * b_dim1];
			i__3 = i__ - 1;
			for (k = 1; k <= i__3; ++k) {
			    temp -= a[k + i__ * a_dim1] * b[k + j * b_dim1];
			}
			if (nounit) {
			    temp /= a[i__ + i__ * a_dim1];
			}
			b[i__ + j * b_dim1] = temp;
		    }
		}
	    } else {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    for (i__ = *m; i__ >= 1; --i__) {
			temp = *alpha * b[i__ + j * b_dim1];
			i__2 = *m;
			for (k = i__ + 1; k <= i__2; ++k) {
			    temp -= a[k + i__ * a_dim1] * b[k + j * b_dim1];
			}
			if (nounit) {
			    temp /= a[i__ + i__ * a_dim1];
			}
			b[i__ + j * b_dim1] = temp;
		    }
		}
	    }
	}
    } else {
	if (lsame_(transa, "N")) {


	    if (upper) {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    if (*alpha != 1.) {
			i__2 = *m;
			for (i__ = 1; i__ <= i__2; ++i__) {
			    b[i__ + j * b_dim1] = *alpha * b[i__ + j * b_dim1]
				    ;
			}
		    }
		    i__2 = j - 1;
		    for (k = 1; k <= i__2; ++k) {
			if (a[k + j * a_dim1] != 0.) {
			    i__3 = *m;
			    for (i__ = 1; i__ <= i__3; ++i__) {
				b[i__ + j * b_dim1] -= a[k + j * a_dim1] * b[
					i__ + k * b_dim1];
			    }
			}
		    }
		    if (nounit) {
			temp = 1. / a[j + j * a_dim1];
			i__2 = *m;
			for (i__ = 1; i__ <= i__2; ++i__) {
			    b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1];
			}
		    }
		}
	    } else {
		for (j = *n; j >= 1; --j) {
		    if (*alpha != 1.) {
			i__1 = *m;
			for (i__ = 1; i__ <= i__1; ++i__) {
			    b[i__ + j * b_dim1] = *alpha * b[i__ + j * b_dim1]
				    ;
			}
		    }
		    i__1 = *n;
		    for (k = j + 1; k <= i__1; ++k) {
			if (a[k + j * a_dim1] != 0.) {
			    i__2 = *m;
			    for (i__ = 1; i__ <= i__2; ++i__) {
				b[i__ + j * b_dim1] -= a[k + j * a_dim1] * b[
					i__ + k * b_dim1];
			    }
			}
		    }
		    if (nounit) {
			temp = 1. / a[j + j * a_dim1];
			i__1 = *m;
			for (i__ = 1; i__ <= i__1; ++i__) {
			    b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1];
			}
		    }
		}
	    }
	} else {


	    if (upper) {
		for (k = *n; k >= 1; --k) {
		    if (nounit) {
			temp = 1. / a[k + k * a_dim1];
			i__1 = *m;
			for (i__ = 1; i__ <= i__1; ++i__) {
			    b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1];
			}
		    }
		    i__1 = k - 1;
		    for (j = 1; j <= i__1; ++j) {
			if (a[j + k * a_dim1] != 0.) {
			    temp = a[j + k * a_dim1];
			    i__2 = *m;
			    for (i__ = 1; i__ <= i__2; ++i__) {
				b[i__ + j * b_dim1] -= temp * b[i__ + k * 
					b_dim1];
			    }
			}
		    }
		    if (*alpha != 1.) {
			i__1 = *m;
			for (i__ = 1; i__ <= i__1; ++i__) {
			    b[i__ + k * b_dim1] = *alpha * b[i__ + k * b_dim1]
				    ;
			}
		    }
		}
	    } else {
		i__1 = *n;
		for (k = 1; k <= i__1; ++k) {
		    if (nounit) {
			temp = 1. / a[k + k * a_dim1];
			i__2 = *m;
			for (i__ = 1; i__ <= i__2; ++i__) {
			    b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1];
			}
		    }
		    i__2 = *n;
		    for (j = k + 1; j <= i__2; ++j) {
			if (a[j + k * a_dim1] != 0.) {
			    temp = a[j + k * a_dim1];
			    i__3 = *m;
			    for (i__ = 1; i__ <= i__3; ++i__) {
				b[i__ + j * b_dim1] -= temp * b[i__ + k * 
					b_dim1];
			    }
			}
		    }
		    if (*alpha != 1.) {
			i__2 = *m;
			for (i__ = 1; i__ <= i__2; ++i__) {
			    b[i__ + k * b_dim1] = *alpha * b[i__ + k * b_dim1]
				    ;
			}
		    }
		}
	    }
	}
    }

return TCL_OK;


} /* dtrsm_ */
static /* Subroutine */ int dlaic1_ (Tcl_Interp *interp, integer *job, integer *j, doublereal *x, 	doublereal *sest, doublereal *w, doublereal *gamma, doublereal *	sestpr, doublereal *s, doublereal *c__)
{
    doublereal d__1, d__2, d__3, d__4;

    double sqrt(doublereal), d_sign(doublereal *, doublereal *);

    doublereal b, t, s1, s2, eps, tmp;
    doublereal sine, test, zeta1, zeta2, alpha, norma;
    doublereal absgam, absalp, cosine, absest;























    --w;
    --x;

    eps = dlamch_("Epsilon");
    alpha = ddot_(j, &x[1], &dlaic1_c__1, &w[1], &dlaic1_c__1);

    absalp = abs(alpha);
    absgam = abs(*gamma);
    absest = abs(*sest);

    if (*job == 1) {



	if (*sest == 0.) {
	    s1 = max(absgam,absalp);
	    if (s1 == 0.) {
		*s = 0.;
		*c__ = 1.;
		*sestpr = 0.;
	    } else {
		*s = alpha / s1;
		*c__ = *gamma / s1;
		tmp = sqrt(*s * *s + *c__ * *c__);
		*s /= tmp;
		*c__ /= tmp;
		*sestpr = s1 * tmp;
	    }
return TCL_OK;
	} else if (absgam <= eps * absest) {
	    *s = 1.;
	    *c__ = 0.;
	    tmp = max(absest,absalp);
	    s1 = absest / tmp;
	    s2 = absalp / tmp;
	    *sestpr = tmp * sqrt(s1 * s1 + s2 * s2);
return TCL_OK;
	} else if (absalp <= eps * absest) {
	    s1 = absgam;
	    s2 = absest;
	    if (s1 <= s2) {
		*s = 1.;
		*c__ = 0.;
		*sestpr = s2;
	    } else {
		*s = 0.;
		*c__ = 1.;
		*sestpr = s1;
	    }
return TCL_OK;
	} else if (absest <= eps * absalp || absest <= eps * absgam) {
	    s1 = absgam;
	    s2 = absalp;
	    if (s1 <= s2) {
		tmp = s1 / s2;
		*s = sqrt(tmp * tmp + 1.);
		*sestpr = s2 * *s;
		*c__ = *gamma / s2 / *s;
		*s = d_sign(&dlaic1_c_b5, &alpha) / *s;
	    } else {
		tmp = s2 / s1;
		*c__ = sqrt(tmp * tmp + 1.);
		*sestpr = s1 * *c__;
		*s = alpha / s1 / *c__;
		*c__ = d_sign(&dlaic1_c_b5, gamma) / *c__;
	    }
return TCL_OK;
	} else {


	    zeta1 = alpha / absest;
	    zeta2 = *gamma / absest;

	    b = (1. - zeta1 * zeta1 - zeta2 * zeta2) * .5;
	    *c__ = zeta1 * zeta1;
	    if (b > 0.) {
		t = *c__ / (b + sqrt(b * b + *c__));
	    } else {
		t = sqrt(b * b + *c__) - b;
	    }

	    sine = -zeta1 / t;
	    cosine = -zeta2 / (t + 1.);
	    tmp = sqrt(sine * sine + cosine * cosine);
	    *s = sine / tmp;
	    *c__ = cosine / tmp;
	    *sestpr = sqrt(t + 1.) * absest;
return TCL_OK;
	}

    } else if (*job == 2) {



	if (*sest == 0.) {
	    *sestpr = 0.;
	    if (max(absgam,absalp) == 0.) {
		sine = 1.;
		cosine = 0.;
	    } else {
		sine = -(*gamma);
		cosine = alpha;
	    }
	    d__1 = abs(sine), d__2 = abs(cosine);
	    s1 = max(d__1,d__2);
	    *s = sine / s1;
	    *c__ = cosine / s1;
	    tmp = sqrt(*s * *s + *c__ * *c__);
	    *s /= tmp;
	    *c__ /= tmp;
return TCL_OK;
	} else if (absgam <= eps * absest) {
	    *s = 0.;
	    *c__ = 1.;
	    *sestpr = absgam;
return TCL_OK;
	} else if (absalp <= eps * absest) {
	    s1 = absgam;
	    s2 = absest;
	    if (s1 <= s2) {
		*s = 0.;
		*c__ = 1.;
		*sestpr = s1;
	    } else {
		*s = 1.;
		*c__ = 0.;
		*sestpr = s2;
	    }
return TCL_OK;
	} else if (absest <= eps * absalp || absest <= eps * absgam) {
	    s1 = absgam;
	    s2 = absalp;
	    if (s1 <= s2) {
		tmp = s1 / s2;
		*c__ = sqrt(tmp * tmp + 1.);
		*sestpr = absest * (tmp / *c__);
		*s = -(*gamma / s2) / *c__;
		*c__ = d_sign(&dlaic1_c_b5, &alpha) / *c__;
	    } else {
		tmp = s2 / s1;
		*s = sqrt(tmp * tmp + 1.);
		*sestpr = absest / *s;
		*c__ = alpha / s1 / *s;
		*s = -d_sign(&dlaic1_c_b5, gamma) / *s;
	    }
return TCL_OK;
	} else {


	    zeta1 = alpha / absest;
	    zeta2 = *gamma / absest;

	    d__3 = zeta1 * zeta1 + 1. + (d__1 = zeta1 * zeta2, abs(d__1)), 
		    d__4 = (d__2 = zeta1 * zeta2, abs(d__2)) + zeta2 * zeta2;
	    norma = max(d__3,d__4);


	    test = (zeta1 - zeta2) * 2. * (zeta1 + zeta2) + 1.;
	    if (test >= 0.) {


		b = (zeta1 * zeta1 + zeta2 * zeta2 + 1.) * .5;
		*c__ = zeta2 * zeta2;
		t = *c__ / (b + sqrt((d__1 = b * b - *c__, abs(d__1))));
		sine = zeta1 / (1. - t);
		cosine = -zeta2 / t;
		*sestpr = sqrt(t + eps * 4. * eps * norma) * absest;
	    } else {


		b = (zeta2 * zeta2 + zeta1 * zeta1 - 1.) * .5;
		*c__ = zeta1 * zeta1;
		if (b >= 0.) {
		    t = -(*c__) / (b + sqrt(b * b + *c__));
		} else {
		    t = b - sqrt(b * b + *c__);
		}
		sine = -zeta1 / t;
		cosine = -zeta2 / (t + 1.);
		*sestpr = sqrt(t + 1. + eps * 4. * eps * norma) * absest;
	    }
	    tmp = sqrt(sine * sine + cosine * cosine);
	    *s = sine / tmp;
	    *c__ = cosine / tmp;
return TCL_OK;

	}
    }
return TCL_OK;


} /* dlaic1_ */
static /* Subroutine */ int dgeqp3_ (Tcl_Interp *interp, integer *m, integer *n, doublereal *a, integer *	lda, integer *jpvt, doublereal *tau, doublereal *work, integer *lwork, 	 integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3;

    integer j, jb, na, nb, sm, sn, nx, fjb, iws, nfxd;
    integer nbmin, minmn;
    integer minws;
    integer topbmn, sminmn;
    integer lwkopt;
    logical lquery;



























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

    *info = 0;
    lquery = *lwork == -1;
    if (*m < 0) {
	*info = -1;
    } else if (*n < 0) {
	*info = -2;
    } else if (*lda < max(1,*m)) {
	*info = -4;
    }

    if (*info == 0) {
	minmn = min(*m,*n);
	if (minmn == 0) {
	    iws = 1;
	    lwkopt = 1;
	} else {
	    iws = *n * 3 + 1;
	    nb = ilaenv_(&dgeqp3_c__1, "DGEQRF", " ", m, n, &dgeqp3_c_n1, &dgeqp3_c_n1);
	    lwkopt = (*n << 1) + (*n + 1) * nb;
	}
	work[1] = (doublereal) lwkopt;

	if (*lwork < iws && ! lquery) {
	    *info = -8;
	}
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DGEQP3", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


    if (minmn == 0) {
return TCL_OK;
    }


    nfxd = 1;
    i__1 = *n;
    for (j = 1; j <= i__1; ++j) {
	if (jpvt[j] != 0) {
	    if (j != nfxd) {
		if (dswap_(interp, m, &a[j * a_dim1 + 1], &dgeqp3_c__1, &a[nfxd * a_dim1 + 1], &			dgeqp3_c__1)!=TCL_OK) { return TCL_ERROR; }


		jpvt[j] = jpvt[nfxd];
		jpvt[nfxd] = j;
	    } else {
		jpvt[j] = j;
	    }
	    ++nfxd;
	} else {
	    jpvt[j] = j;
	}
    }
    --nfxd;



    if (nfxd > 0) {
	na = min(*m,nfxd);
	if (dgeqrf_(interp, m, &na, &a[a_offset], lda, &tau[1], &work[1], lwork, info)!=TCL_OK) { return TCL_ERROR; }

	i__1 = iws, i__2 = (integer) work[1];
	iws = max(i__1,i__2);
	if (na < *n) {
	    i__1 = *n - na;
	    if (dormqr_(interp, "Left", "Transpose", m, &i__1, &na, &a[a_offset], lda, &		    tau[1], &a[(na + 1) * a_dim1 + 1], lda, &work[1], lwork, 
		    info)!=TCL_OK) { return TCL_ERROR; }


	    i__1 = iws, i__2 = (integer) work[1];
	    iws = max(i__1,i__2);
	}
    }


    if (nfxd < minmn) {

	sm = *m - nfxd;
	sn = *n - nfxd;
	sminmn = minmn - nfxd;


	nb = ilaenv_(&dgeqp3_c__1, "DGEQRF", " ", &sm, &sn, &dgeqp3_c_n1, &dgeqp3_c_n1);
	nbmin = 2;
	nx = 0;

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


	    i__1 = 0, i__2 = ilaenv_(&dgeqp3_c__3, "DGEQRF", " ", &sm, &sn, &dgeqp3_c_n1, &
		    dgeqp3_c_n1);
	    nx = max(i__1,i__2);


	    if (nx < sminmn) {


		minws = (sn << 1) + (sn + 1) * nb;
		iws = max(iws,minws);
		if (*lwork < minws) {


		    nb = (*lwork - (sn << 1)) / (sn + 1);
		    i__1 = 2, i__2 = ilaenv_(&dgeqp3_c__2, "DGEQRF", " ", &sm, &sn, &
			    dgeqp3_c_n1, &dgeqp3_c_n1);
		    nbmin = max(i__1,i__2);


		}
	    }
	}


	i__1 = *n;
	for (j = nfxd + 1; j <= i__1; ++j) {
	    work[j] = dnrm2_(&sm, &a[nfxd + 1 + j * a_dim1], &dgeqp3_c__1);
	    work[*n + j] = work[j];
	}

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


	    j = nfxd + 1;



	    topbmn = minmn - nx;
L30:
	    if (j <= topbmn) {
		i__1 = nb, i__2 = topbmn - j + 1;
		jb = min(i__1,i__2);


		i__1 = *n - j + 1;
		i__2 = j - 1;
		i__3 = *n - j + 1;
		if (dlaqps_(interp, m, &i__1, &i__2, &jb, &fjb, &a[j * a_dim1 + 1], lda, &			jpvt[j], &tau[j], &work[j], &work[*n + j], &work[(*n 
			<< 1) + 1], &work[(*n << 1) + jb + 1], &i__3)!=TCL_OK) { return TCL_ERROR; }



		j += fjb;
		goto L30;
	    }
	} else {
	    j = nfxd + 1;
	}



	if (j <= minmn) {
	    i__1 = *n - j + 1;
	    i__2 = j - 1;
	    if (dlaqp2_(interp, m, &i__1, &i__2, &a[j * a_dim1 + 1], lda, &jpvt[j], &tau[		    j], &work[j], &work[*n + j], &work[(*n << 1) + 1])!=TCL_OK) { return TCL_ERROR; }


	}

    }

    work[1] = (doublereal) iws;
return TCL_OK;


} /* dgeqp3_ */
static /* Subroutine */ int dormrz_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *k, integer *l, doublereal *a, integer *lda, doublereal *tau, 	doublereal *c__, integer *ldc, doublereal *work, integer *lwork, 	integer *info)
{
    address 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];

    /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);

    integer i__;
    doublereal t[4160]	/* was [65][64] */;
    integer i1, i2, i3, ib, ic, ja, jc, nb, mi, ni, nq, nw, iws;
    logical left;
    integer nbmin, iinfo;
    logical notran;
    integer ldwork;
    char transt[1];
    integer lwkopt;
    logical lquery;































    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --tau;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;
    --work;

    *info = 0;
    left = lsame_(side, "L");
    notran = lsame_(trans, "N");
    lquery = *lwork == -1;


    if (left) {
	nq = *m;
	nw = max(1,*n);
    } else {
	nq = *n;
	nw = max(1,*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 (*l < 0 || left && *l > *m || ! left && *l > *n) {
	*info = -6;
    } else if (*lda < max(1,*k)) {
	*info = -8;
    } else if (*ldc < max(1,*m)) {
	*info = -11;
    }

    if (*info == 0) {
	if (*m == 0 || *n == 0) {
	    lwkopt = 1;
	} else {


	    i__3[0] = 1, a__1[0] = side;
	    i__3[1] = 1, a__1[1] = trans;
	    s_cat(ch__1, a__1, i__3, &dormrz_c__2, (ftnlen)2);
	    i__1 = 64, i__2 = ilaenv_(&dormrz_c__1, "DORMRQ", ch__1, m, n, k, &dormrz_c_n1);
	    nb = min(i__1,i__2);
	    lwkopt = nw * nb;
	}
	work[1] = (doublereal) lwkopt;

	if (*lwork < max(1,nw) && ! lquery) {
	    *info = -13;
	}
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DORMRZ", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


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

    nbmin = 2;
    ldwork = nw;
    if (nb > 1 && nb < *k) {
	iws = nw * nb;
	if (*lwork < iws) {
	    nb = *lwork / ldwork;
	    i__3[0] = 1, a__1[0] = side;
	    i__3[1] = 1, a__1[1] = trans;
	    s_cat(ch__1, a__1, i__3, &dormrz_c__2, (ftnlen)2);
	    i__1 = 2, i__2 = ilaenv_(&dormrz_c__2, "DORMRQ", ch__1, m, n, k, &dormrz_c_n1);
	    nbmin = max(i__1,i__2);
	}
    } else {
	iws = nw;
    }

    if (nb < nbmin || nb >= *k) {


	if (dormr3_(interp, side, trans, m, n, k, l, &a[a_offset], lda, &tau[1], &c__[		c_offset], ldc, &work[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }


    } else {


	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;
	    ja = *m - *l + 1;
	} else {
	    mi = *m;
	    ic = 1;
	    ja = *n - *l + 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) {
	    i__4 = nb, i__5 = *k - i__ + 1;
	    ib = min(i__4,i__5);


	    if (dlarzt_(interp, "Backward", "Rowwise", l, &ib, &a[i__ + ja * a_dim1], lda, 		     &tau[i__], t, &dormrz_c__65)!=TCL_OK) { return TCL_ERROR; }



	    if (left) {


		mi = *m - i__ + 1;
		ic = i__;
	    } else {


		ni = *n - i__ + 1;
		jc = i__;
	    }


	    if (dlarzb_(interp, side, transt, "Backward", "Rowwise", &mi, &ni, &ib, l, &a[		    i__ + ja * a_dim1], lda, t, &dormrz_c__65, &c__[ic + jc * c_dim1]
, ldc, &work[1], &ldwork)!=TCL_OK) { return TCL_ERROR; }


	}

    }

    work[1] = (doublereal) lwkopt;

return TCL_OK;


} /* dormrz_ */
static /* Subroutine */ int dtzrzf_ (Tcl_Interp *interp, integer *m, integer *n, doublereal *a, integer *	lda, doublereal *tau, doublereal *work, integer *lwork, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;

    integer i__, m1, ib, nb, ki, kk, mu, nx, iws, nbmin;
    integer ldwork, lwkopt;
    logical lquery;
































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

    *info = 0;
    lquery = *lwork == -1;
    if (*m < 0) {
	*info = -1;
    } else if (*n < *m) {
	*info = -2;
    } else if (*lda < max(1,*m)) {
	*info = -4;
    }

    if (*info == 0) {
	if (*m == 0 || *m == *n) {
	    lwkopt = 1;
	} else {


	    nb = ilaenv_(&dtzrzf_c__1, "DGERQF", " ", m, n, &dtzrzf_c_n1, &dtzrzf_c_n1);
	    lwkopt = *m * nb;
	}
	work[1] = (doublereal) lwkopt;

	if (*lwork < max(1,*m) && ! lquery) {
	    *info = -7;
	}
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DTZRZF", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


    if (*m == 0) {
return TCL_OK;
    } else if (*m == *n) {
	i__1 = *n;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    tau[i__] = 0.;
	}
return TCL_OK;
    }

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


	i__1 = 0, i__2 = ilaenv_(&dtzrzf_c__3, "DGERQF", " ", m, n, &dtzrzf_c_n1, &dtzrzf_c_n1);
	nx = max(i__1,i__2);
	if (nx < *m) {


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


		nb = *lwork / ldwork;
		i__1 = 2, i__2 = ilaenv_(&dtzrzf_c__2, "DGERQF", " ", m, n, &dtzrzf_c_n1, &
			dtzrzf_c_n1);
		nbmin = max(i__1,i__2);
	    }
	}
    }

    if (nb >= nbmin && nb < *m && nx < *m) {


	i__1 = *m + 1;
	m1 = min(i__1,*n);
	ki = (*m - nx - 1) / nb * nb;
	i__1 = *m, i__2 = ki + nb;
	kk = min(i__1,i__2);

	i__1 = *m - kk + 1;
	i__2 = -nb;
	for (i__ = *m - kk + ki + 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; 
		i__ += i__2) {
	    i__3 = *m - i__ + 1;
	    ib = min(i__3,nb);


	    i__3 = *n - i__ + 1;
	    i__4 = *n - *m;
	    if (dlatrz_(interp, &ib, &i__3, &i__4, &a[i__ + i__ * a_dim1], lda, &tau[i__], 		     &work[1])!=TCL_OK) { return TCL_ERROR; }


	    if (i__ > 1) {


		i__3 = *n - *m;
		if (dlarzt_(interp, "Backward", "Rowwise", &i__3, &ib, &a[i__ + m1 * 			a_dim1], lda, &tau[i__], &work[1], &ldwork)!=TCL_OK) { return TCL_ERROR; }




		i__3 = i__ - 1;
		i__4 = *n - i__ + 1;
		i__5 = *n - *m;
		if (dlarzb_(interp, "Right", "No transpose", "Backward", "Rowwise", &i__3, 			 &i__4, &ib, &i__5, &a[i__ + m1 * a_dim1], lda, &work[
			1], &ldwork, &a[i__ * a_dim1 + 1], lda, &work[ib + 1], 
			 &ldwork)
			!=TCL_OK) { return TCL_ERROR; }


	    }
	}
	mu = i__ + nb - 1;
    } else {
	mu = *m;
    }


    if (mu > 0) {
	i__2 = *n - *m;
	if (dlatrz_(interp, &mu, n, &i__2, &a[a_offset], lda, &tau[1], &work[1])!=TCL_OK) { return TCL_ERROR; }

    }

    work[1] = (doublereal) lwkopt;

return TCL_OK;


} /* dtzrzf_ */
static /* Subroutine */ int ztrsm_ (Tcl_Interp *interp, char *side, char *uplo, char *transa, char *diag, 	integer *m, integer *n, doublecomplex *alpha, doublecomplex *a, 	integer *lda, doublecomplex *b, integer *ldb)
{
    integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4, i__5, 
	    i__6, i__7;
    doublecomplex z__1, z__2, z__3;

    void z_div(doublecomplex *, doublecomplex *, doublecomplex *), d_cnjg(
	    doublecomplex *, doublecomplex *);

    integer i__, j, k, info;
    doublecomplex temp;
    logical lside;
    integer nrowa;
    logical upper;
    logical noconj, nounit;







































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

    lside = lsame_(side, "L");
    if (lside) {
	nrowa = *m;
    } else {
	nrowa = *n;
    }
    noconj = lsame_(transa, "T");
    nounit = lsame_(diag, "N");
    upper = lsame_(uplo, "U");

    info = 0;
    if (! lside && ! lsame_(side, "R")) {
	info = 1;
    } else if (! upper && ! lsame_(uplo, "L")) {
	info = 2;
    } else if (! lsame_(transa, "N") && ! lsame_(transa, 
	     "T") && ! lsame_(transa, "C")) {
	info = 3;
    } else if (! lsame_(diag, "U") && ! lsame_(diag, 
	    "N")) {
	info = 4;
    } else if (*m < 0) {
	info = 5;
    } else if (*n < 0) {
	info = 6;
    } else if (*lda < max(1,nrowa)) {
	info = 9;
    } else if (*ldb < max(1,*m)) {
	info = 11;
    }
    if (info != 0) {
	vectcl_xerbla(interp, "ZTRSM ", &info);
return TCL_ERROR;

return TCL_OK;
    }


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


    if (alpha->r == 0. && alpha->i == 0.) {
	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *m;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		i__3 = i__ + j * b_dim1;
		b[i__3].r = 0., b[i__3].i = 0.;
	    }
	}
return TCL_OK;
    }


    if (lside) {
	if (lsame_(transa, "N")) {


	    if (upper) {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    if (alpha->r != 1. || alpha->i != 0.) {
			i__2 = *m;
			for (i__ = 1; i__ <= i__2; ++i__) {
			    i__3 = i__ + j * b_dim1;
			    i__4 = i__ + j * b_dim1;
			    z__1.r = alpha->r * b[i__4].r - alpha->i * b[i__4]
				    .i, z__1.i = alpha->r * b[i__4].i + 
				    alpha->i * b[i__4].r;
			    b[i__3].r = z__1.r, b[i__3].i = z__1.i;
			}
		    }
		    for (k = *m; k >= 1; --k) {
			i__2 = k + j * b_dim1;
			if (b[i__2].r != 0. || b[i__2].i != 0.) {
			    if (nounit) {
				i__2 = k + j * b_dim1;
				z_div(&z__1, &b[k + j * b_dim1], &a[k + k * 
					a_dim1]);
				b[i__2].r = z__1.r, b[i__2].i = z__1.i;
			    }
			    i__2 = k - 1;
			    for (i__ = 1; i__ <= i__2; ++i__) {
				i__3 = i__ + j * b_dim1;
				i__4 = i__ + j * b_dim1;
				i__5 = k + j * b_dim1;
				i__6 = i__ + k * a_dim1;
				z__2.r = b[i__5].r * a[i__6].r - b[i__5].i * 
					a[i__6].i, z__2.i = b[i__5].r * a[
					i__6].i + b[i__5].i * a[i__6].r;
				z__1.r = b[i__4].r - z__2.r, z__1.i = b[i__4]
					.i - z__2.i;
				b[i__3].r = z__1.r, b[i__3].i = z__1.i;
			    }
			}
		    }
		}
	    } else {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    if (alpha->r != 1. || alpha->i != 0.) {
			i__2 = *m;
			for (i__ = 1; i__ <= i__2; ++i__) {
			    i__3 = i__ + j * b_dim1;
			    i__4 = i__ + j * b_dim1;
			    z__1.r = alpha->r * b[i__4].r - alpha->i * b[i__4]
				    .i, z__1.i = alpha->r * b[i__4].i + 
				    alpha->i * b[i__4].r;
			    b[i__3].r = z__1.r, b[i__3].i = z__1.i;
			}
		    }
		    i__2 = *m;
		    for (k = 1; k <= i__2; ++k) {
			i__3 = k + j * b_dim1;
			if (b[i__3].r != 0. || b[i__3].i != 0.) {
			    if (nounit) {
				i__3 = k + j * b_dim1;
				z_div(&z__1, &b[k + j * b_dim1], &a[k + k * 
					a_dim1]);
				b[i__3].r = z__1.r, b[i__3].i = z__1.i;
			    }
			    i__3 = *m;
			    for (i__ = k + 1; i__ <= i__3; ++i__) {
				i__4 = i__ + j * b_dim1;
				i__5 = i__ + j * b_dim1;
				i__6 = k + j * b_dim1;
				i__7 = i__ + k * a_dim1;
				z__2.r = b[i__6].r * a[i__7].r - b[i__6].i * 
					a[i__7].i, z__2.i = b[i__6].r * a[
					i__7].i + b[i__6].i * a[i__7].r;
				z__1.r = b[i__5].r - z__2.r, z__1.i = b[i__5]
					.i - z__2.i;
				b[i__4].r = z__1.r, b[i__4].i = z__1.i;
			    }
			}
		    }
		}
	    }
	} else {


	    if (upper) {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = *m;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			i__3 = i__ + j * b_dim1;
			z__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3].i, 
				z__1.i = alpha->r * b[i__3].i + alpha->i * b[
				i__3].r;
			temp.r = z__1.r, temp.i = z__1.i;
			if (noconj) {
			    i__3 = i__ - 1;
			    for (k = 1; k <= i__3; ++k) {
				i__4 = k + i__ * a_dim1;
				i__5 = k + j * b_dim1;
				z__2.r = a[i__4].r * b[i__5].r - a[i__4].i * 
					b[i__5].i, z__2.i = a[i__4].r * b[
					i__5].i + a[i__4].i * b[i__5].r;
				z__1.r = temp.r - z__2.r, z__1.i = temp.i - 
					z__2.i;
				temp.r = z__1.r, temp.i = z__1.i;
			    }
			    if (nounit) {
				z_div(&z__1, &temp, &a[i__ + i__ * a_dim1]);
				temp.r = z__1.r, temp.i = z__1.i;
			    }
			} else {
			    i__3 = i__ - 1;
			    for (k = 1; k <= i__3; ++k) {
				d_cnjg(&z__3, &a[k + i__ * a_dim1]);
				i__4 = k + j * b_dim1;
				z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4]
					.i, z__2.i = z__3.r * b[i__4].i + 
					z__3.i * b[i__4].r;
				z__1.r = temp.r - z__2.r, z__1.i = temp.i - 
					z__2.i;
				temp.r = z__1.r, temp.i = z__1.i;
			    }
			    if (nounit) {
				d_cnjg(&z__2, &a[i__ + i__ * a_dim1]);
				z_div(&z__1, &temp, &z__2);
				temp.r = z__1.r, temp.i = z__1.i;
			    }
			}
			i__3 = i__ + j * b_dim1;
			b[i__3].r = temp.r, b[i__3].i = temp.i;
		    }
		}
	    } else {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    for (i__ = *m; i__ >= 1; --i__) {
			i__2 = i__ + j * b_dim1;
			z__1.r = alpha->r * b[i__2].r - alpha->i * b[i__2].i, 
				z__1.i = alpha->r * b[i__2].i + alpha->i * b[
				i__2].r;
			temp.r = z__1.r, temp.i = z__1.i;
			if (noconj) {
			    i__2 = *m;
			    for (k = i__ + 1; k <= i__2; ++k) {
				i__3 = k + i__ * a_dim1;
				i__4 = k + j * b_dim1;
				z__2.r = a[i__3].r * b[i__4].r - a[i__3].i * 
					b[i__4].i, z__2.i = a[i__3].r * b[
					i__4].i + a[i__3].i * b[i__4].r;
				z__1.r = temp.r - z__2.r, z__1.i = temp.i - 
					z__2.i;
				temp.r = z__1.r, temp.i = z__1.i;
			    }
			    if (nounit) {
				z_div(&z__1, &temp, &a[i__ + i__ * a_dim1]);
				temp.r = z__1.r, temp.i = z__1.i;
			    }
			} else {
			    i__2 = *m;
			    for (k = i__ + 1; k <= i__2; ++k) {
				d_cnjg(&z__3, &a[k + i__ * a_dim1]);
				i__3 = k + j * b_dim1;
				z__2.r = z__3.r * b[i__3].r - z__3.i * b[i__3]
					.i, z__2.i = z__3.r * b[i__3].i + 
					z__3.i * b[i__3].r;
				z__1.r = temp.r - z__2.r, z__1.i = temp.i - 
					z__2.i;
				temp.r = z__1.r, temp.i = z__1.i;
			    }
			    if (nounit) {
				d_cnjg(&z__2, &a[i__ + i__ * a_dim1]);
				z_div(&z__1, &temp, &z__2);
				temp.r = z__1.r, temp.i = z__1.i;
			    }
			}
			i__2 = i__ + j * b_dim1;
			b[i__2].r = temp.r, b[i__2].i = temp.i;
		    }
		}
	    }
	}
    } else {
	if (lsame_(transa, "N")) {


	    if (upper) {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    if (alpha->r != 1. || alpha->i != 0.) {
			i__2 = *m;
			for (i__ = 1; i__ <= i__2; ++i__) {
			    i__3 = i__ + j * b_dim1;
			    i__4 = i__ + j * b_dim1;
			    z__1.r = alpha->r * b[i__4].r - alpha->i * b[i__4]
				    .i, z__1.i = alpha->r * b[i__4].i + 
				    alpha->i * b[i__4].r;
			    b[i__3].r = z__1.r, b[i__3].i = z__1.i;
			}
		    }
		    i__2 = j - 1;
		    for (k = 1; k <= i__2; ++k) {
			i__3 = k + j * a_dim1;
			if (a[i__3].r != 0. || a[i__3].i != 0.) {
			    i__3 = *m;
			    for (i__ = 1; i__ <= i__3; ++i__) {
				i__4 = i__ + j * b_dim1;
				i__5 = i__ + j * b_dim1;
				i__6 = k + j * a_dim1;
				i__7 = i__ + k * b_dim1;
				z__2.r = a[i__6].r * b[i__7].r - a[i__6].i * 
					b[i__7].i, z__2.i = a[i__6].r * b[
					i__7].i + a[i__6].i * b[i__7].r;
				z__1.r = b[i__5].r - z__2.r, z__1.i = b[i__5]
					.i - z__2.i;
				b[i__4].r = z__1.r, b[i__4].i = z__1.i;
			    }
			}
		    }
		    if (nounit) {
			z_div(&z__1, &ztrsm_c_b1, &a[j + j * a_dim1]);
			temp.r = z__1.r, temp.i = z__1.i;
			i__2 = *m;
			for (i__ = 1; i__ <= i__2; ++i__) {
			    i__3 = i__ + j * b_dim1;
			    i__4 = i__ + j * b_dim1;
			    z__1.r = temp.r * b[i__4].r - temp.i * b[i__4].i, 
				    z__1.i = temp.r * b[i__4].i + temp.i * b[
				    i__4].r;
			    b[i__3].r = z__1.r, b[i__3].i = z__1.i;
			}
		    }
		}
	    } else {
		for (j = *n; j >= 1; --j) {
		    if (alpha->r != 1. || alpha->i != 0.) {
			i__1 = *m;
			for (i__ = 1; i__ <= i__1; ++i__) {
			    i__2 = i__ + j * b_dim1;
			    i__3 = i__ + j * b_dim1;
			    z__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3]
				    .i, z__1.i = alpha->r * b[i__3].i + 
				    alpha->i * b[i__3].r;
			    b[i__2].r = z__1.r, b[i__2].i = z__1.i;
			}
		    }
		    i__1 = *n;
		    for (k = j + 1; k <= i__1; ++k) {
			i__2 = k + j * a_dim1;
			if (a[i__2].r != 0. || a[i__2].i != 0.) {
			    i__2 = *m;
			    for (i__ = 1; i__ <= i__2; ++i__) {
				i__3 = i__ + j * b_dim1;
				i__4 = i__ + j * b_dim1;
				i__5 = k + j * a_dim1;
				i__6 = i__ + k * b_dim1;
				z__2.r = a[i__5].r * b[i__6].r - a[i__5].i * 
					b[i__6].i, z__2.i = a[i__5].r * b[
					i__6].i + a[i__5].i * b[i__6].r;
				z__1.r = b[i__4].r - z__2.r, z__1.i = b[i__4]
					.i - z__2.i;
				b[i__3].r = z__1.r, b[i__3].i = z__1.i;
			    }
			}
		    }
		    if (nounit) {
			z_div(&z__1, &ztrsm_c_b1, &a[j + j * a_dim1]);
			temp.r = z__1.r, temp.i = z__1.i;
			i__1 = *m;
			for (i__ = 1; i__ <= i__1; ++i__) {
			    i__2 = i__ + j * b_dim1;
			    i__3 = i__ + j * b_dim1;
			    z__1.r = temp.r * b[i__3].r - temp.i * b[i__3].i, 
				    z__1.i = temp.r * b[i__3].i + temp.i * b[
				    i__3].r;
			    b[i__2].r = z__1.r, b[i__2].i = z__1.i;
			}
		    }
		}
	    }
	} else {


	    if (upper) {
		for (k = *n; k >= 1; --k) {
		    if (nounit) {
			if (noconj) {
			    z_div(&z__1, &ztrsm_c_b1, &a[k + k * a_dim1]);
			    temp.r = z__1.r, temp.i = z__1.i;
			} else {
			    d_cnjg(&z__2, &a[k + k * a_dim1]);
			    z_div(&z__1, &ztrsm_c_b1, &z__2);
			    temp.r = z__1.r, temp.i = z__1.i;
			}
			i__1 = *m;
			for (i__ = 1; i__ <= i__1; ++i__) {
			    i__2 = i__ + k * b_dim1;
			    i__3 = i__ + k * b_dim1;
			    z__1.r = temp.r * b[i__3].r - temp.i * b[i__3].i, 
				    z__1.i = temp.r * b[i__3].i + temp.i * b[
				    i__3].r;
			    b[i__2].r = z__1.r, b[i__2].i = z__1.i;
			}
		    }
		    i__1 = k - 1;
		    for (j = 1; j <= i__1; ++j) {
			i__2 = j + k * a_dim1;
			if (a[i__2].r != 0. || a[i__2].i != 0.) {
			    if (noconj) {
				i__2 = j + k * a_dim1;
				temp.r = a[i__2].r, temp.i = a[i__2].i;
			    } else {
				d_cnjg(&z__1, &a[j + k * a_dim1]);
				temp.r = z__1.r, temp.i = z__1.i;
			    }
			    i__2 = *m;
			    for (i__ = 1; i__ <= i__2; ++i__) {
				i__3 = i__ + j * b_dim1;
				i__4 = i__ + j * b_dim1;
				i__5 = i__ + k * b_dim1;
				z__2.r = temp.r * b[i__5].r - temp.i * b[i__5]
					.i, z__2.i = temp.r * b[i__5].i + 
					temp.i * b[i__5].r;
				z__1.r = b[i__4].r - z__2.r, z__1.i = b[i__4]
					.i - z__2.i;
				b[i__3].r = z__1.r, b[i__3].i = z__1.i;
			    }
			}
		    }
		    if (alpha->r != 1. || alpha->i != 0.) {
			i__1 = *m;
			for (i__ = 1; i__ <= i__1; ++i__) {
			    i__2 = i__ + k * b_dim1;
			    i__3 = i__ + k * b_dim1;
			    z__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3]
				    .i, z__1.i = alpha->r * b[i__3].i + 
				    alpha->i * b[i__3].r;
			    b[i__2].r = z__1.r, b[i__2].i = z__1.i;
			}
		    }
		}
	    } else {
		i__1 = *n;
		for (k = 1; k <= i__1; ++k) {
		    if (nounit) {
			if (noconj) {
			    z_div(&z__1, &ztrsm_c_b1, &a[k + k * a_dim1]);
			    temp.r = z__1.r, temp.i = z__1.i;
			} else {
			    d_cnjg(&z__2, &a[k + k * a_dim1]);
			    z_div(&z__1, &ztrsm_c_b1, &z__2);
			    temp.r = z__1.r, temp.i = z__1.i;
			}
			i__2 = *m;
			for (i__ = 1; i__ <= i__2; ++i__) {
			    i__3 = i__ + k * b_dim1;
			    i__4 = i__ + k * b_dim1;
			    z__1.r = temp.r * b[i__4].r - temp.i * b[i__4].i, 
				    z__1.i = temp.r * b[i__4].i + temp.i * b[
				    i__4].r;
			    b[i__3].r = z__1.r, b[i__3].i = z__1.i;
			}
		    }
		    i__2 = *n;
		    for (j = k + 1; j <= i__2; ++j) {
			i__3 = j + k * a_dim1;
			if (a[i__3].r != 0. || a[i__3].i != 0.) {
			    if (noconj) {
				i__3 = j + k * a_dim1;
				temp.r = a[i__3].r, temp.i = a[i__3].i;
			    } else {
				d_cnjg(&z__1, &a[j + k * a_dim1]);
				temp.r = z__1.r, temp.i = z__1.i;
			    }
			    i__3 = *m;
			    for (i__ = 1; i__ <= i__3; ++i__) {
				i__4 = i__ + j * b_dim1;
				i__5 = i__ + j * b_dim1;
				i__6 = i__ + k * b_dim1;
				z__2.r = temp.r * b[i__6].r - temp.i * b[i__6]
					.i, z__2.i = temp.r * b[i__6].i + 
					temp.i * b[i__6].r;
				z__1.r = b[i__5].r - z__2.r, z__1.i = b[i__5]
					.i - z__2.i;
				b[i__4].r = z__1.r, b[i__4].i = z__1.i;
			    }
			}
		    }
		    if (alpha->r != 1. || alpha->i != 0.) {
			i__2 = *m;
			for (i__ = 1; i__ <= i__2; ++i__) {
			    i__3 = i__ + k * b_dim1;
			    i__4 = i__ + k * b_dim1;
			    z__1.r = alpha->r * b[i__4].r - alpha->i * b[i__4]
				    .i, z__1.i = alpha->r * b[i__4].i + 
				    alpha->i * b[i__4].r;
			    b[i__3].r = z__1.r, b[i__3].i = z__1.i;
			}
		    }
		}
	    }
	}
    }

return TCL_OK;


} /* ztrsm_ */
static /* Subroutine */ int zlaic1_ (Tcl_Interp *interp, integer *job, integer *j, doublecomplex *x, 	doublereal *sest, doublecomplex *w, doublecomplex *gamma, doublereal *	sestpr, doublecomplex *s, doublecomplex *c__)
{
    doublereal d__1, d__2;
    doublecomplex z__1, z__2, z__3, z__4, z__5, z__6;

    double z_abs(doublecomplex *);
    void d_cnjg(doublecomplex *, doublecomplex *), z_sqrt(doublecomplex *, 
	    doublecomplex *);
    double sqrt(doublereal);
    void z_div(doublecomplex *, doublecomplex *, doublecomplex *);

    doublereal b, t, s1, s2, scl, eps, tmp;
    doublecomplex sine;
    doublereal test, zeta1, zeta2;
    doublecomplex alpha;
    doublereal norma;
    doublereal absgam, absalp;
    doublecomplex cosine;
    doublereal absest;























    --w;
    --x;

    eps = dlamch_("Epsilon");
    zdotc_(&z__1, j, &x[1], &zlaic1_c__1, &w[1], &zlaic1_c__1);
    alpha.r = z__1.r, alpha.i = z__1.i;

    absalp = z_abs(&alpha);
    absgam = z_abs(gamma);
    absest = abs(*sest);

    if (*job == 1) {



	if (*sest == 0.) {
	    s1 = max(absgam,absalp);
	    if (s1 == 0.) {
		s->r = 0., s->i = 0.;
		c__->r = 1., c__->i = 0.;
		*sestpr = 0.;
	    } else {
		z__1.r = alpha.r / s1, z__1.i = alpha.i / s1;
		s->r = z__1.r, s->i = z__1.i;
		z__1.r = gamma->r / s1, z__1.i = gamma->i / s1;
		c__->r = z__1.r, c__->i = z__1.i;
		d_cnjg(&z__4, s);
		z__3.r = s->r * z__4.r - s->i * z__4.i, z__3.i = s->r * 
			z__4.i + s->i * z__4.r;
		d_cnjg(&z__6, c__);
		z__5.r = c__->r * z__6.r - c__->i * z__6.i, z__5.i = c__->r * 
			z__6.i + c__->i * z__6.r;
		z__2.r = z__3.r + z__5.r, z__2.i = z__3.i + z__5.i;
		z_sqrt(&z__1, &z__2);
		tmp = z__1.r;
		z__1.r = s->r / tmp, z__1.i = s->i / tmp;
		s->r = z__1.r, s->i = z__1.i;
		z__1.r = c__->r / tmp, z__1.i = c__->i / tmp;
		c__->r = z__1.r, c__->i = z__1.i;
		*sestpr = s1 * tmp;
	    }
return TCL_OK;
	} else if (absgam <= eps * absest) {
	    s->r = 1., s->i = 0.;
	    c__->r = 0., c__->i = 0.;
	    tmp = max(absest,absalp);
	    s1 = absest / tmp;
	    s2 = absalp / tmp;
	    *sestpr = tmp * sqrt(s1 * s1 + s2 * s2);
return TCL_OK;
	} else if (absalp <= eps * absest) {
	    s1 = absgam;
	    s2 = absest;
	    if (s1 <= s2) {
		s->r = 1., s->i = 0.;
		c__->r = 0., c__->i = 0.;
		*sestpr = s2;
	    } else {
		s->r = 0., s->i = 0.;
		c__->r = 1., c__->i = 0.;
		*sestpr = s1;
	    }
return TCL_OK;
	} else if (absest <= eps * absalp || absest <= eps * absgam) {
	    s1 = absgam;
	    s2 = absalp;
	    if (s1 <= s2) {
		tmp = s1 / s2;
		scl = sqrt(tmp * tmp + 1.);
		*sestpr = s2 * scl;
		z__2.r = alpha.r / s2, z__2.i = alpha.i / s2;
		z__1.r = z__2.r / scl, z__1.i = z__2.i / scl;
		s->r = z__1.r, s->i = z__1.i;
		z__2.r = gamma->r / s2, z__2.i = gamma->i / s2;
		z__1.r = z__2.r / scl, z__1.i = z__2.i / scl;
		c__->r = z__1.r, c__->i = z__1.i;
	    } else {
		tmp = s2 / s1;
		scl = sqrt(tmp * tmp + 1.);
		*sestpr = s1 * scl;
		z__2.r = alpha.r / s1, z__2.i = alpha.i / s1;
		z__1.r = z__2.r / scl, z__1.i = z__2.i / scl;
		s->r = z__1.r, s->i = z__1.i;
		z__2.r = gamma->r / s1, z__2.i = gamma->i / s1;
		z__1.r = z__2.r / scl, z__1.i = z__2.i / scl;
		c__->r = z__1.r, c__->i = z__1.i;
	    }
return TCL_OK;
	} else {


	    zeta1 = absalp / absest;
	    zeta2 = absgam / absest;

	    b = (1. - zeta1 * zeta1 - zeta2 * zeta2) * .5;
	    d__1 = zeta1 * zeta1;
	    c__->r = d__1, c__->i = 0.;
	    if (b > 0.) {
		d__1 = b * b;
		z__4.r = d__1 + c__->r, z__4.i = c__->i;
		z_sqrt(&z__3, &z__4);
		z__2.r = b + z__3.r, z__2.i = z__3.i;
		z_div(&z__1, c__, &z__2);
		t = z__1.r;
	    } else {
		d__1 = b * b;
		z__3.r = d__1 + c__->r, z__3.i = c__->i;
		z_sqrt(&z__2, &z__3);
		z__1.r = z__2.r - b, z__1.i = z__2.i;
		t = z__1.r;
	    }

	    z__3.r = alpha.r / absest, z__3.i = alpha.i / absest;
	    z__2.r = -z__3.r, z__2.i = -z__3.i;
	    z__1.r = z__2.r / t, z__1.i = z__2.i / t;
	    sine.r = z__1.r, sine.i = z__1.i;
	    z__3.r = gamma->r / absest, z__3.i = gamma->i / absest;
	    z__2.r = -z__3.r, z__2.i = -z__3.i;
	    d__1 = t + 1.;
	    z__1.r = z__2.r / d__1, z__1.i = z__2.i / d__1;
	    cosine.r = z__1.r, cosine.i = z__1.i;
	    d_cnjg(&z__4, &sine);
	    z__3.r = sine.r * z__4.r - sine.i * z__4.i, z__3.i = sine.r * 
		    z__4.i + sine.i * z__4.r;
	    d_cnjg(&z__6, &cosine);
	    z__5.r = cosine.r * z__6.r - cosine.i * z__6.i, z__5.i = cosine.r 
		    * z__6.i + cosine.i * z__6.r;
	    z__2.r = z__3.r + z__5.r, z__2.i = z__3.i + z__5.i;
	    z_sqrt(&z__1, &z__2);
	    tmp = z__1.r;
	    z__1.r = sine.r / tmp, z__1.i = sine.i / tmp;
	    s->r = z__1.r, s->i = z__1.i;
	    z__1.r = cosine.r / tmp, z__1.i = cosine.i / tmp;
	    c__->r = z__1.r, c__->i = z__1.i;
	    *sestpr = sqrt(t + 1.) * absest;
return TCL_OK;
	}

    } else if (*job == 2) {



	if (*sest == 0.) {
	    *sestpr = 0.;
	    if (max(absgam,absalp) == 0.) {
		sine.r = 1., sine.i = 0.;
		cosine.r = 0., cosine.i = 0.;
	    } else {
		d_cnjg(&z__2, gamma);
		z__1.r = -z__2.r, z__1.i = -z__2.i;
		sine.r = z__1.r, sine.i = z__1.i;
		d_cnjg(&z__1, &alpha);
		cosine.r = z__1.r, cosine.i = z__1.i;
	    }
	    d__1 = z_abs(&sine), d__2 = z_abs(&cosine);
	    s1 = max(d__1,d__2);
	    z__1.r = sine.r / s1, z__1.i = sine.i / s1;
	    s->r = z__1.r, s->i = z__1.i;
	    z__1.r = cosine.r / s1, z__1.i = cosine.i / s1;
	    c__->r = z__1.r, c__->i = z__1.i;
	    d_cnjg(&z__4, s);
	    z__3.r = s->r * z__4.r - s->i * z__4.i, z__3.i = s->r * z__4.i + 
		    s->i * z__4.r;
	    d_cnjg(&z__6, c__);
	    z__5.r = c__->r * z__6.r - c__->i * z__6.i, z__5.i = c__->r * 
		    z__6.i + c__->i * z__6.r;
	    z__2.r = z__3.r + z__5.r, z__2.i = z__3.i + z__5.i;
	    z_sqrt(&z__1, &z__2);
	    tmp = z__1.r;
	    z__1.r = s->r / tmp, z__1.i = s->i / tmp;
	    s->r = z__1.r, s->i = z__1.i;
	    z__1.r = c__->r / tmp, z__1.i = c__->i / tmp;
	    c__->r = z__1.r, c__->i = z__1.i;
return TCL_OK;
	} else if (absgam <= eps * absest) {
	    s->r = 0., s->i = 0.;
	    c__->r = 1., c__->i = 0.;
	    *sestpr = absgam;
return TCL_OK;
	} else if (absalp <= eps * absest) {
	    s1 = absgam;
	    s2 = absest;
	    if (s1 <= s2) {
		s->r = 0., s->i = 0.;
		c__->r = 1., c__->i = 0.;
		*sestpr = s1;
	    } else {
		s->r = 1., s->i = 0.;
		c__->r = 0., c__->i = 0.;
		*sestpr = s2;
	    }
return TCL_OK;
	} else if (absest <= eps * absalp || absest <= eps * absgam) {
	    s1 = absgam;
	    s2 = absalp;
	    if (s1 <= s2) {
		tmp = s1 / s2;
		scl = sqrt(tmp * tmp + 1.);
		*sestpr = absest * (tmp / scl);
		d_cnjg(&z__4, gamma);
		z__3.r = z__4.r / s2, z__3.i = z__4.i / s2;
		z__2.r = -z__3.r, z__2.i = -z__3.i;
		z__1.r = z__2.r / scl, z__1.i = z__2.i / scl;
		s->r = z__1.r, s->i = z__1.i;
		d_cnjg(&z__3, &alpha);
		z__2.r = z__3.r / s2, z__2.i = z__3.i / s2;
		z__1.r = z__2.r / scl, z__1.i = z__2.i / scl;
		c__->r = z__1.r, c__->i = z__1.i;
	    } else {
		tmp = s2 / s1;
		scl = sqrt(tmp * tmp + 1.);
		*sestpr = absest / scl;
		d_cnjg(&z__4, gamma);
		z__3.r = z__4.r / s1, z__3.i = z__4.i / s1;
		z__2.r = -z__3.r, z__2.i = -z__3.i;
		z__1.r = z__2.r / scl, z__1.i = z__2.i / scl;
		s->r = z__1.r, s->i = z__1.i;
		d_cnjg(&z__3, &alpha);
		z__2.r = z__3.r / s1, z__2.i = z__3.i / s1;
		z__1.r = z__2.r / scl, z__1.i = z__2.i / scl;
		c__->r = z__1.r, c__->i = z__1.i;
	    }
return TCL_OK;
	} else {


	    zeta1 = absalp / absest;
	    zeta2 = absgam / absest;

	    d__1 = zeta1 * zeta1 + 1. + zeta1 * zeta2, d__2 = zeta1 * zeta2 + 
		    zeta2 * zeta2;
	    norma = max(d__1,d__2);


	    test = (zeta1 - zeta2) * 2. * (zeta1 + zeta2) + 1.;
	    if (test >= 0.) {


		b = (zeta1 * zeta1 + zeta2 * zeta2 + 1.) * .5;
		d__1 = zeta2 * zeta2;
		c__->r = d__1, c__->i = 0.;
		d__2 = b * b;
		z__2.r = d__2 - c__->r, z__2.i = -c__->i;
		d__1 = b + sqrt(z_abs(&z__2));
		z__1.r = c__->r / d__1, z__1.i = c__->i / d__1;
		t = z__1.r;
		z__2.r = alpha.r / absest, z__2.i = alpha.i / absest;
		d__1 = 1. - t;
		z__1.r = z__2.r / d__1, z__1.i = z__2.i / d__1;
		sine.r = z__1.r, sine.i = z__1.i;
		z__3.r = gamma->r / absest, z__3.i = gamma->i / absest;
		z__2.r = -z__3.r, z__2.i = -z__3.i;
		z__1.r = z__2.r / t, z__1.i = z__2.i / t;
		cosine.r = z__1.r, cosine.i = z__1.i;
		*sestpr = sqrt(t + eps * 4. * eps * norma) * absest;
	    } else {


		b = (zeta2 * zeta2 + zeta1 * zeta1 - 1.) * .5;
		d__1 = zeta1 * zeta1;
		c__->r = d__1, c__->i = 0.;
		if (b >= 0.) {
		    z__2.r = -c__->r, z__2.i = -c__->i;
		    d__1 = b * b;
		    z__5.r = d__1 + c__->r, z__5.i = c__->i;
		    z_sqrt(&z__4, &z__5);
		    z__3.r = b + z__4.r, z__3.i = z__4.i;
		    z_div(&z__1, &z__2, &z__3);
		    t = z__1.r;
		} else {
		    d__1 = b * b;
		    z__3.r = d__1 + c__->r, z__3.i = c__->i;
		    z_sqrt(&z__2, &z__3);
		    z__1.r = b - z__2.r, z__1.i = -z__2.i;
		    t = z__1.r;
		}
		z__3.r = alpha.r / absest, z__3.i = alpha.i / absest;
		z__2.r = -z__3.r, z__2.i = -z__3.i;
		z__1.r = z__2.r / t, z__1.i = z__2.i / t;
		sine.r = z__1.r, sine.i = z__1.i;
		z__3.r = gamma->r / absest, z__3.i = gamma->i / absest;
		z__2.r = -z__3.r, z__2.i = -z__3.i;
		d__1 = t + 1.;
		z__1.r = z__2.r / d__1, z__1.i = z__2.i / d__1;
		cosine.r = z__1.r, cosine.i = z__1.i;
		*sestpr = sqrt(t + 1. + eps * 4. * eps * norma) * absest;
	    }
	    d_cnjg(&z__4, &sine);
	    z__3.r = sine.r * z__4.r - sine.i * z__4.i, z__3.i = sine.r * 
		    z__4.i + sine.i * z__4.r;
	    d_cnjg(&z__6, &cosine);
	    z__5.r = cosine.r * z__6.r - cosine.i * z__6.i, z__5.i = cosine.r 
		    * z__6.i + cosine.i * z__6.r;
	    z__2.r = z__3.r + z__5.r, z__2.i = z__3.i + z__5.i;
	    z_sqrt(&z__1, &z__2);
	    tmp = z__1.r;
	    z__1.r = sine.r / tmp, z__1.i = sine.i / tmp;
	    s->r = z__1.r, s->i = z__1.i;
	    z__1.r = cosine.r / tmp, z__1.i = cosine.i / tmp;
	    c__->r = z__1.r, c__->i = z__1.i;
return TCL_OK;

	}
    }
return TCL_OK;


} /* zlaic1_ */
static /* Subroutine */ int zgeqp3_ (Tcl_Interp *interp, integer *m, integer *n, doublecomplex *a, 	integer *lda, integer *jpvt, doublecomplex *tau, doublecomplex *work, 	integer *lwork, doublereal *rwork, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3;

    integer j, jb, na, nb, sm, sn, nx, fjb, iws, nfxd, nbmin, minmn, minws;
    integer topbmn, sminmn;
    integer lwkopt;
    logical lquery;




























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

    *info = 0;
    lquery = *lwork == -1;
    if (*m < 0) {
	*info = -1;
    } else if (*n < 0) {
	*info = -2;
    } else if (*lda < max(1,*m)) {
	*info = -4;
    }

    if (*info == 0) {
	minmn = min(*m,*n);
	if (minmn == 0) {
	    iws = 1;
	    lwkopt = 1;
	} else {
	    iws = *n + 1;
	    nb = ilaenv_(&zgeqp3_c__1, "ZGEQRF", " ", m, n, &zgeqp3_c_n1, &zgeqp3_c_n1);
	    lwkopt = (*n + 1) * nb;
	}
	work[1].r = (doublereal) lwkopt, work[1].i = 0.;

	if (*lwork < iws && ! lquery) {
	    *info = -8;
	}
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "ZGEQP3", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


    if (minmn == 0) {
return TCL_OK;
    }


    nfxd = 1;
    i__1 = *n;
    for (j = 1; j <= i__1; ++j) {
	if (jpvt[j] != 0) {
	    if (j != nfxd) {
		if (zswap_(interp, m, &a[j * a_dim1 + 1], &zgeqp3_c__1, &a[nfxd * a_dim1 + 1], &			zgeqp3_c__1)!=TCL_OK) { return TCL_ERROR; }


		jpvt[j] = jpvt[nfxd];
		jpvt[nfxd] = j;
	    } else {
		jpvt[j] = j;
	    }
	    ++nfxd;
	} else {
	    jpvt[j] = j;
	}
    }
    --nfxd;



    if (nfxd > 0) {
	na = min(*m,nfxd);
	if (zgeqrf_(interp, m, &na, &a[a_offset], lda, &tau[1], &work[1], lwork, info)!=TCL_OK) { return TCL_ERROR; }

	i__1 = iws, i__2 = (integer) work[1].r;
	iws = max(i__1,i__2);
	if (na < *n) {
	    i__1 = *n - na;
	    if (zunmqr_(interp, "Left", "Conjugate Transpose", m, &i__1, &na, &a[a_offset], lda, &tau[1], &a[(na + 1) * a_dim1 + 1], lda, &work[1], 
		    lwork, info)!=TCL_OK) { return TCL_ERROR; }


	    i__1 = iws, i__2 = (integer) work[1].r;
	    iws = max(i__1,i__2);
	}
    }


    if (nfxd < minmn) {

	sm = *m - nfxd;
	sn = *n - nfxd;
	sminmn = minmn - nfxd;


	nb = ilaenv_(&zgeqp3_c__1, "ZGEQRF", " ", &sm, &sn, &zgeqp3_c_n1, &zgeqp3_c_n1);
	nbmin = 2;
	nx = 0;

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


	    i__1 = 0, i__2 = ilaenv_(&zgeqp3_c__3, "ZGEQRF", " ", &sm, &sn, &zgeqp3_c_n1, &
		    zgeqp3_c_n1);
	    nx = max(i__1,i__2);


	    if (nx < sminmn) {


		minws = (sn + 1) * nb;
		iws = max(iws,minws);
		if (*lwork < minws) {


		    nb = *lwork / (sn + 1);
		    i__1 = 2, i__2 = ilaenv_(&zgeqp3_c__2, "ZGEQRF", " ", &sm, &sn, &
			    zgeqp3_c_n1, &zgeqp3_c_n1);
		    nbmin = max(i__1,i__2);


		}
	    }
	}


	i__1 = *n;
	for (j = nfxd + 1; j <= i__1; ++j) {
	    rwork[j] = dznrm2_(&sm, &a[nfxd + 1 + j * a_dim1], &zgeqp3_c__1);
	    rwork[*n + j] = rwork[j];
	}

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


	    j = nfxd + 1;



	    topbmn = minmn - nx;
L30:
	    if (j <= topbmn) {
		i__1 = nb, i__2 = topbmn - j + 1;
		jb = min(i__1,i__2);


		i__1 = *n - j + 1;
		i__2 = j - 1;
		i__3 = *n - j + 1;
		if (zlaqps_(interp, m, &i__1, &i__2, &jb, &fjb, &a[j * a_dim1 + 1], lda, &			jpvt[j], &tau[j], &rwork[j], &rwork[*n + j], &work[1], 
			 &work[jb + 1], &i__3)!=TCL_OK) { return TCL_ERROR; }



		j += fjb;
		goto L30;
	    }
	} else {
	    j = nfxd + 1;
	}



	if (j <= minmn) {
	    i__1 = *n - j + 1;
	    i__2 = j - 1;
	    if (zlaqp2_(interp, m, &i__1, &i__2, &a[j * a_dim1 + 1], lda, &jpvt[j], &tau[		    j], &rwork[j], &rwork[*n + j], &work[1])!=TCL_OK) { return TCL_ERROR; }


	}

    }

    work[1].r = (doublereal) iws, work[1].i = 0.;
return TCL_OK;


} /* zgeqp3_ */
static /* Subroutine */ int zunmrz_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *k, integer *l, doublecomplex *a, integer *lda, doublecomplex 	*tau, doublecomplex *c__, integer *ldc, doublecomplex *work, integer *	lwork, integer *info)
{
    address 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];

    /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);

    integer i__;
    doublecomplex t[4160]	/* was [65][64] */;
    integer i1, i2, i3, ib, ic, ja, jc, nb, mi, ni, nq, nw, iws;
    logical left;
    integer nbmin, iinfo;
    logical notran;
    integer ldwork;
    char transt[1];
    integer lwkopt;
    logical lquery;































    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --tau;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;
    --work;

    *info = 0;
    left = lsame_(side, "L");
    notran = lsame_(trans, "N");
    lquery = *lwork == -1;


    if (left) {
	nq = *m;
	nw = max(1,*n);
    } else {
	nq = *n;
	nw = max(1,*m);
    }
    if (! left && ! lsame_(side, "R")) {
	*info = -1;
    } else if (! notran && ! lsame_(trans, "C")) {
	*info = -2;
    } else if (*m < 0) {
	*info = -3;
    } else if (*n < 0) {
	*info = -4;
    } else if (*k < 0 || *k > nq) {
	*info = -5;
    } else if (*l < 0 || left && *l > *m || ! left && *l > *n) {
	*info = -6;
    } else if (*lda < max(1,*k)) {
	*info = -8;
    } else if (*ldc < max(1,*m)) {
	*info = -11;
    }

    if (*info == 0) {
	if (*m == 0 || *n == 0) {
	    lwkopt = 1;
	} else {


	    i__3[0] = 1, a__1[0] = side;
	    i__3[1] = 1, a__1[1] = trans;
	    s_cat(ch__1, a__1, i__3, &zunmrz_c__2, (ftnlen)2);
	    i__1 = 64, i__2 = ilaenv_(&zunmrz_c__1, "ZUNMRQ", ch__1, m, n, k, &zunmrz_c_n1);
	    nb = min(i__1,i__2);
	    lwkopt = nw * nb;
	}
	work[1].r = (doublereal) lwkopt, work[1].i = 0.;

	if (*lwork < max(1,nw) && ! lquery) {
	    *info = -13;
	}
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "ZUNMRZ", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


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


    i__3[0] = 1, a__1[0] = side;
    i__3[1] = 1, a__1[1] = trans;
    s_cat(ch__1, a__1, i__3, &zunmrz_c__2, (ftnlen)2);
    i__1 = 64, i__2 = ilaenv_(&zunmrz_c__1, "ZUNMRQ", ch__1, m, n, k, &zunmrz_c_n1);
    nb = min(i__1,i__2);
    nbmin = 2;
    ldwork = nw;
    if (nb > 1 && nb < *k) {
	iws = nw * nb;
	if (*lwork < iws) {
	    nb = *lwork / ldwork;
	    i__3[0] = 1, a__1[0] = side;
	    i__3[1] = 1, a__1[1] = trans;
	    s_cat(ch__1, a__1, i__3, &zunmrz_c__2, (ftnlen)2);
	    i__1 = 2, i__2 = ilaenv_(&zunmrz_c__2, "ZUNMRQ", ch__1, m, n, k, &zunmrz_c_n1);
	    nbmin = max(i__1,i__2);
	}
    } else {
	iws = nw;
    }

    if (nb < nbmin || nb >= *k) {


	if (zunmr3_(interp, side, trans, m, n, k, l, &a[a_offset], lda, &tau[1], &c__[		c_offset], ldc, &work[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }


    } else {


	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;
	    ja = *m - *l + 1;
	} else {
	    mi = *m;
	    ic = 1;
	    ja = *n - *l + 1;
	}

	if (notran) {
	    *(unsigned char *)transt = 'C';
	} 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) {
	    i__4 = nb, i__5 = *k - i__ + 1;
	    ib = min(i__4,i__5);


	    if (zlarzt_(interp, "Backward", "Rowwise", l, &ib, &a[i__ + ja * a_dim1], lda, 		     &tau[i__], t, &zunmrz_c__65)!=TCL_OK) { return TCL_ERROR; }



	    if (left) {


		mi = *m - i__ + 1;
		ic = i__;
	    } else {


		ni = *n - i__ + 1;
		jc = i__;
	    }


	    if (zlarzb_(interp, side, transt, "Backward", "Rowwise", &mi, &ni, &ib, l, &a[		    i__ + ja * a_dim1], lda, t, &zunmrz_c__65, &c__[ic + jc * c_dim1]
, ldc, &work[1], &ldwork)!=TCL_OK) { return TCL_ERROR; }


	}

    }

    work[1].r = (doublereal) lwkopt, work[1].i = 0.;

return TCL_OK;


} /* zunmrz_ */
static /* Subroutine */ int ztzrzf_ (Tcl_Interp *interp, integer *m, integer *n, doublecomplex *a, 	integer *lda, doublecomplex *tau, doublecomplex *work, integer *lwork, 	 integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;

    integer i__, m1, ib, nb, ki, kk, mu, nx, iws, nbmin;
    integer ldwork;
    integer lwkopt;
    logical lquery;
































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

    *info = 0;
    lquery = *lwork == -1;
    if (*m < 0) {
	*info = -1;
    } else if (*n < *m) {
	*info = -2;
    } else if (*lda < max(1,*m)) {
	*info = -4;
    }

    if (*info == 0) {
	if (*m == 0 || *m == *n) {
	    lwkopt = 1;
	} else {


	    nb = ilaenv_(&ztzrzf_c__1, "ZGERQF", " ", m, n, &ztzrzf_c_n1, &ztzrzf_c_n1);
	    lwkopt = *m * nb;
	}
	work[1].r = (doublereal) lwkopt, work[1].i = 0.;

	if (*lwork < max(1,*m) && ! lquery) {
	    *info = -7;
	}
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "ZTZRZF", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


    if (*m == 0) {
return TCL_OK;
    } else if (*m == *n) {
	i__1 = *n;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    i__2 = i__;
	    tau[i__2].r = 0., tau[i__2].i = 0.;
	}
return TCL_OK;
    }

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


	i__1 = 0, i__2 = ilaenv_(&ztzrzf_c__3, "ZGERQF", " ", m, n, &ztzrzf_c_n1, &ztzrzf_c_n1);
	nx = max(i__1,i__2);
	if (nx < *m) {


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


		nb = *lwork / ldwork;
		i__1 = 2, i__2 = ilaenv_(&ztzrzf_c__2, "ZGERQF", " ", m, n, &ztzrzf_c_n1, &
			ztzrzf_c_n1);
		nbmin = max(i__1,i__2);
	    }
	}
    }

    if (nb >= nbmin && nb < *m && nx < *m) {


	i__1 = *m + 1;
	m1 = min(i__1,*n);
	ki = (*m - nx - 1) / nb * nb;
	i__1 = *m, i__2 = ki + nb;
	kk = min(i__1,i__2);

	i__1 = *m - kk + 1;
	i__2 = -nb;
	for (i__ = *m - kk + ki + 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; 
		i__ += i__2) {
	    i__3 = *m - i__ + 1;
	    ib = min(i__3,nb);


	    i__3 = *n - i__ + 1;
	    i__4 = *n - *m;
	    if (zlatrz_(interp, &ib, &i__3, &i__4, &a[i__ + i__ * a_dim1], lda, &tau[i__], 		     &work[1])!=TCL_OK) { return TCL_ERROR; }


	    if (i__ > 1) {


		i__3 = *n - *m;
		if (zlarzt_(interp, "Backward", "Rowwise", &i__3, &ib, &a[i__ + m1 * 			a_dim1], lda, &tau[i__], &work[1], &ldwork)!=TCL_OK) { return TCL_ERROR; }




		i__3 = i__ - 1;
		i__4 = *n - i__ + 1;
		i__5 = *n - *m;
		if (zlarzb_(interp, "Right", "No transpose", "Backward", "Rowwise", &i__3, 			 &i__4, &ib, &i__5, &a[i__ + m1 * a_dim1], lda, &work[
			1], &ldwork, &a[i__ * a_dim1 + 1], lda, &work[ib + 1], 
			 &ldwork)
			!=TCL_OK) { return TCL_ERROR; }


	    }
	}
	mu = i__ + nb - 1;
    } else {
	mu = *m;
    }


    if (mu > 0) {
	i__2 = *n - *m;
	if (zlatrz_(interp, &mu, n, &i__2, &a[a_offset], lda, &tau[1], &work[1])!=TCL_OK) { return TCL_ERROR; }

    }

    work[1].r = (doublereal) lwkopt, work[1].i = 0.;

return TCL_OK;


} /* ztzrzf_ */
static /* Subroutine */ int dgetrf_ (Tcl_Interp *interp, integer *m, integer *n, doublereal *a, integer *	lda, integer *ipiv, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;

    integer i__, j, jb, nb;
    integer iinfo;


















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

    *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);
	vectcl_xerbla(interp, "DGETRF", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


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


    nb = ilaenv_(&dgetrf_c__1, "DGETRF", " ", m, n, &dgetrf_c_n1, &dgetrf_c_n1);
    if (nb <= 1 || nb >= min(*m,*n)) {


	if (dgetf2_(interp, m, n, &a[a_offset], lda, &ipiv[1], info)!=TCL_OK) { return TCL_ERROR; }

    } else {


	i__1 = min(*m,*n);
	i__2 = nb;
	for (j = 1; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) {
	    i__3 = min(*m,*n) - j + 1;
	    jb = min(i__3,nb);


	    i__3 = *m - j + 1;
	    if (dgetf2_(interp, &i__3, &jb, &a[j + j * a_dim1], lda, &ipiv[j], &iinfo)!=TCL_OK) { return TCL_ERROR; }



	    if (*info == 0 && iinfo > 0) {
		*info = iinfo + j - 1;
	    }
	    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__];
	    }


	    i__3 = j - 1;
	    i__4 = j + jb - 1;
	    if (dlaswp_(interp, &i__3, &a[a_offset], lda, &j, &i__4, &ipiv[1], &dgetrf_c__1)!=TCL_OK) { return TCL_ERROR; }


	    if (j + jb <= *n) {


		i__3 = *n - j - jb + 1;
		i__4 = j + jb - 1;
		if (dlaswp_(interp, &i__3, &a[(j + jb) * a_dim1 + 1], lda, &j, &i__4, &			ipiv[1], &dgetrf_c__1)!=TCL_OK) { return TCL_ERROR; }




		i__3 = *n - j - jb + 1;
		if (dtrsm_(interp, "Left", "Lower", "No transpose", "Unit", &jb, &i__3, &			dgetrf_c_b16, &a[j + j * a_dim1], lda, &a[j + (j + jb) * 
			a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }


		if (j + jb <= *m) {


		    i__3 = *m - j - jb + 1;
		    i__4 = *n - j - jb + 1;
		    if (dgemm_(interp, "No transpose", "No transpose", &i__3, &i__4, &jb, 			    &dgetrf_c_b19, &a[j + jb + j * a_dim1], lda, &a[j + (j + 
			    jb) * a_dim1], lda, &dgetrf_c_b16, &a[j + jb + (j + jb) *
			     a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }


		}
	    }
	}
    }
return TCL_OK;


} /* dgetrf_ */
static /* Subroutine */ int dgetrs_ (Tcl_Interp *interp, char *trans, integer *n, integer *nrhs, 	doublereal *a, integer *lda, integer *ipiv, doublereal *b, integer *	ldb, integer *info)
{
    integer a_dim1, a_offset, b_dim1, b_offset, i__1;

    logical notran;



















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

    *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);
	vectcl_xerbla(interp, "DGETRS", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


    if (*n == 0 || *nrhs == 0) {
return TCL_OK;
    }

    if (notran) {



	if (dlaswp_(interp, nrhs, &b[b_offset], ldb, &dgetrs_c__1, n, &ipiv[1], &dgetrs_c__1)!=TCL_OK) { return TCL_ERROR; }



	if (dtrsm_(interp, "Left", "Lower", "No transpose", "Unit", n, nrhs, &dgetrs_c_b12, &a[		a_offset], lda, &b[b_offset], ldb)!=TCL_OK) { return TCL_ERROR; }




	if (dtrsm_(interp, "Left", "Upper", "No transpose", "Non-unit", n, nrhs, &dgetrs_c_b12, &		a[a_offset], lda, &b[b_offset], ldb)!=TCL_OK) { return TCL_ERROR; }


    } else {



	if (dtrsm_(interp, "Left", "Upper", "Transpose", "Non-unit", n, nrhs, &dgetrs_c_b12, &a[		a_offset], lda, &b[b_offset], ldb)!=TCL_OK) { return TCL_ERROR; }




	if (dtrsm_(interp, "Left", "Lower", "Transpose", "Unit", n, nrhs, &dgetrs_c_b12, &a[		a_offset], lda, &b[b_offset], ldb)!=TCL_OK) { return TCL_ERROR; }




	if (dlaswp_(interp, nrhs, &b[b_offset], ldb, &dgetrs_c__1, n, &ipiv[1], &dgetrs_c_n1)!=TCL_OK) { return TCL_ERROR; }

    }

return TCL_OK;


} /* dgetrs_ */
static /* Subroutine */ int zgetrf_ (Tcl_Interp *interp, integer *m, integer *n, doublecomplex *a, 	integer *lda, integer *ipiv, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
    doublecomplex z__1;

    integer i__, j, jb, nb, iinfo;


















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

    *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);
	vectcl_xerbla(interp, "ZGETRF", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


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


    nb = ilaenv_(&zgetrf_c__1, "ZGETRF", " ", m, n, &zgetrf_c_n1, &zgetrf_c_n1);
    if (nb <= 1 || nb >= min(*m,*n)) {


	if (zgetf2_(interp, m, n, &a[a_offset], lda, &ipiv[1], info)!=TCL_OK) { return TCL_ERROR; }

    } else {


	i__1 = min(*m,*n);
	i__2 = nb;
	for (j = 1; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) {
	    i__3 = min(*m,*n) - j + 1;
	    jb = min(i__3,nb);


	    i__3 = *m - j + 1;
	    if (zgetf2_(interp, &i__3, &jb, &a[j + j * a_dim1], lda, &ipiv[j], &iinfo)!=TCL_OK) { return TCL_ERROR; }



	    if (*info == 0 && iinfo > 0) {
		*info = iinfo + j - 1;
	    }
	    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__];
	    }


	    i__3 = j - 1;
	    i__4 = j + jb - 1;
	    if (zlaswp_(interp, &i__3, &a[a_offset], lda, &j, &i__4, &ipiv[1], &zgetrf_c__1)!=TCL_OK) { return TCL_ERROR; }


	    if (j + jb <= *n) {


		i__3 = *n - j - jb + 1;
		i__4 = j + jb - 1;
		if (zlaswp_(interp, &i__3, &a[(j + jb) * a_dim1 + 1], lda, &j, &i__4, &			ipiv[1], &zgetrf_c__1)!=TCL_OK) { return TCL_ERROR; }




		i__3 = *n - j - jb + 1;
		if (ztrsm_(interp, "Left", "Lower", "No transpose", "Unit", &jb, &i__3, &			zgetrf_c_b1, &a[j + j * a_dim1], lda, &a[j + (j + jb) * 
			a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }


		if (j + jb <= *m) {


		    i__3 = *m - j - jb + 1;
		    i__4 = *n - j - jb + 1;
		    z__1.r = -1., z__1.i = -0.;
		    if (zgemm_(interp, "No transpose", "No transpose", &i__3, &i__4, &jb, 			    &z__1, &a[j + jb + j * a_dim1], lda, &a[j + (j + 
			    jb) * a_dim1], lda, &zgetrf_c_b1, &a[j + jb + (j + jb) * 
			    a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }


		}
	    }
	}
    }
return TCL_OK;


} /* zgetrf_ */
static /* Subroutine */ int zgetrs_ (Tcl_Interp *interp, char *trans, integer *n, integer *nrhs, 	doublecomplex *a, integer *lda, integer *ipiv, doublecomplex *b, 	integer *ldb, integer *info)
{
    integer a_dim1, a_offset, b_dim1, b_offset, i__1;

    logical notran;



















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

    *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);
	vectcl_xerbla(interp, "ZGETRS", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


    if (*n == 0 || *nrhs == 0) {
return TCL_OK;
    }

    if (notran) {



	if (zlaswp_(interp, nrhs, &b[b_offset], ldb, &zgetrs_c__1, n, &ipiv[1], &zgetrs_c__1)!=TCL_OK) { return TCL_ERROR; }



	if (ztrsm_(interp, "Left", "Lower", "No transpose", "Unit", n, nrhs, &zgetrs_c_b1, &a[		a_offset], lda, &b[b_offset], ldb)!=TCL_OK) { return TCL_ERROR; }




	if (ztrsm_(interp, "Left", "Upper", "No transpose", "Non-unit", n, nrhs, &zgetrs_c_b1, &		a[a_offset], lda, &b[b_offset], ldb)!=TCL_OK) { return TCL_ERROR; }


    } else {



	if (ztrsm_(interp, "Left", "Upper", trans, "Non-unit", n, nrhs, &zgetrs_c_b1, &a[		a_offset], lda, &b[b_offset], ldb)!=TCL_OK) { return TCL_ERROR; }




	if (ztrsm_(interp, "Left", "Lower", trans, "Unit", n, nrhs, &zgetrs_c_b1, &a[a_offset], 		lda, &b[b_offset], ldb)!=TCL_OK) { return TCL_ERROR; }




	if (zlaswp_(interp, nrhs, &b[b_offset], ldb, &zgetrs_c__1, n, &ipiv[1], &zgetrs_c_n1)!=TCL_OK) { return TCL_ERROR; }

    }

return TCL_OK;


} /* zgetrs_ */
static /* Subroutine */ int dlaqge_ (Tcl_Interp *interp, integer *m, integer *n, doublereal *a, integer *	lda, doublereal *r__, doublereal *c__, doublereal *rowcnd, doublereal 	*colcnd, doublereal *amax, char *equed)
{
    integer a_dim1, a_offset, i__1, i__2;

    integer i__, j;
    doublereal cj, large, small;























    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --r__;
    --c__;

    if (*m <= 0 || *n <= 0) {
	*(unsigned char *)equed = 'N';
return TCL_OK;
    }


    small = dlamch_("Safe minimum") / dlamch_("Precision");
    large = 1. / small;

    if (*rowcnd >= .1 && *amax >= small && *amax <= large) {


	if (*colcnd >= .1) {


	    *(unsigned char *)equed = 'N';
	} else {


	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		cj = c__[j];
		i__2 = *m;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    a[i__ + j * a_dim1] = cj * a[i__ + j * a_dim1];
		}
	    }
	    *(unsigned char *)equed = 'C';
	}
    } else if (*colcnd >= .1) {


	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *m;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		a[i__ + j * a_dim1] = r__[i__] * a[i__ + j * a_dim1];
	    }
	}
	*(unsigned char *)equed = 'R';
    } else {


	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    cj = c__[j];
	    i__2 = *m;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		a[i__ + j * a_dim1] = cj * r__[i__] * a[i__ + j * a_dim1];
	    }
	}
	*(unsigned char *)equed = 'B';
    }

return TCL_OK;


} /* dlaqge_ */
static /* Subroutine */ int dgecon_ (Tcl_Interp *interp, char *norm, integer *n, doublereal *a, integer *	lda, doublereal *anorm, doublereal *rcond, doublereal *work, integer *	iwork, integer *info)
{
    integer a_dim1, a_offset, i__1;
    doublereal d__1;

    doublereal sl;
    integer ix;
    doublereal su;
    integer kase, kase1;
    doublereal scale;
    integer isave[3];
    doublereal ainvnm;
    logical onenrm;
    char normin[1];
    doublereal smlnum;





















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

    *info = 0;
    onenrm = *(unsigned char *)norm == '1' || lsame_(norm, "O");
    if (! onenrm && ! lsame_(norm, "I")) {
	*info = -1;
    } else if (*n < 0) {
	*info = -2;
    } else if (*lda < max(1,*n)) {
	*info = -4;
    } else if (*anorm < 0.) {
	*info = -5;
    }
    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DGECON", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


    *rcond = 0.;
    if (*n == 0) {
	*rcond = 1.;
return TCL_OK;
    } else if (*anorm == 0.) {
return TCL_OK;
    }

    smlnum = dlamch_("Safe minimum");


    ainvnm = 0.;
    *(unsigned char *)normin = 'N';
    if (onenrm) {
	kase1 = 1;
    } else {
	kase1 = 2;
    }
    kase = 0;
L10:
    if (dlacn2_(interp, n, &work[*n + 1], &work[1], &iwork[1], &ainvnm, &kase, isave)!=TCL_OK) { return TCL_ERROR; }

    if (kase != 0) {
	if (kase == kase1) {


	    if (dlatrs_(interp, "Lower", "No transpose", "Unit", normin, n, &a[a_offset], 		    lda, &work[1], &sl, &work[(*n << 1) + 1], info)!=TCL_OK) { return TCL_ERROR; }




	    if (dlatrs_(interp, "Upper", "No transpose", "Non-unit", normin, n, &a[		    a_offset], lda, &work[1], &su, &work[*n * 3 + 1], info)!=TCL_OK) { return TCL_ERROR; }


	} else {


	    if (dlatrs_(interp, "Upper", "Transpose", "Non-unit", normin, n, &a[a_offset], 		     lda, &work[1], &su, &work[*n * 3 + 1], info)!=TCL_OK) { return TCL_ERROR; }




	    if (dlatrs_(interp, "Lower", "Transpose", "Unit", normin, n, &a[a_offset], 		    lda, &work[1], &sl, &work[(*n << 1) + 1], info)!=TCL_OK) { return TCL_ERROR; }


	}


	scale = sl * su;
	*(unsigned char *)normin = 'Y';
	if (scale != 1.) {
	    ix = idamax_(n, &work[1], &dgecon_c__1);
	    if (scale < (d__1 = work[ix], abs(d__1)) * smlnum || scale == 0.) 
		    {
		goto L20;
	    }
	    if (drscl_(interp, n, &scale, &work[1], &dgecon_c__1)!=TCL_OK) { return TCL_ERROR; }

	}
	goto L10;
    }


    if (ainvnm != 0.) {
	*rcond = 1. / ainvnm / *anorm;
    }

L20:
return TCL_OK;


} /* dgecon_ */
static /* Subroutine */ int dgeequ_ (Tcl_Interp *interp, integer *m, integer *n, doublereal *a, integer *	lda, doublereal *r__, doublereal *c__, doublereal *rowcnd, doublereal 	*colcnd, doublereal *amax, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2;
    doublereal d__1, d__2, d__3;

    integer i__, j;
    doublereal rcmin, rcmax;
    doublereal bignum, smlnum;





















    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --r__;
    --c__;

    *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);
	vectcl_xerbla(interp, "DGEEQU", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


    if (*m == 0 || *n == 0) {
	*rowcnd = 1.;
	*colcnd = 1.;
	*amax = 0.;
return TCL_OK;
    }


    smlnum = dlamch_("S");
    bignum = 1. / smlnum;


    i__1 = *m;
    for (i__ = 1; i__ <= i__1; ++i__) {
	r__[i__] = 0.;
    }


    i__1 = *n;
    for (j = 1; j <= i__1; ++j) {
	i__2 = *m;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    d__2 = r__[i__], d__3 = (d__1 = a[i__ + j * a_dim1], abs(d__1));
	    r__[i__] = max(d__2,d__3);
	}
    }


    rcmin = bignum;
    rcmax = 0.;
    i__1 = *m;
    for (i__ = 1; i__ <= i__1; ++i__) {
	d__1 = rcmax, d__2 = r__[i__];
	rcmax = max(d__1,d__2);
	d__1 = rcmin, d__2 = r__[i__];
	rcmin = min(d__1,d__2);
    }
    *amax = rcmax;

    if (rcmin == 0.) {


	i__1 = *m;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    if (r__[i__] == 0.) {
		*info = i__;
return TCL_OK;
	    }
	}
    } else {


	i__1 = *m;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    d__2 = r__[i__];
	    d__1 = max(d__2,smlnum);
	    r__[i__] = 1. / min(d__1,bignum);
	}


	*rowcnd = max(rcmin,smlnum) / min(rcmax,bignum);
    }


    i__1 = *n;
    for (j = 1; j <= i__1; ++j) {
	c__[j] = 0.;
    }


    i__1 = *n;
    for (j = 1; j <= i__1; ++j) {
	i__2 = *m;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    d__2 = c__[j], d__3 = (d__1 = a[i__ + j * a_dim1], abs(d__1)) * 
		    r__[i__];
	    c__[j] = max(d__2,d__3);
	}
    }


    rcmin = bignum;
    rcmax = 0.;
    i__1 = *n;
    for (j = 1; j <= i__1; ++j) {
	d__1 = rcmin, d__2 = c__[j];
	rcmin = min(d__1,d__2);
	d__1 = rcmax, d__2 = c__[j];
	rcmax = max(d__1,d__2);
    }

    if (rcmin == 0.) {


	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    if (c__[j] == 0.) {
		*info = *m + j;
return TCL_OK;
	    }
	}
    } else {


	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    d__2 = c__[j];
	    d__1 = max(d__2,smlnum);
	    c__[j] = 1. / min(d__1,bignum);
	}


	*colcnd = max(rcmin,smlnum) / min(rcmax,bignum);
    }

return TCL_OK;


} /* dgeequ_ */
static /* Subroutine */ int dgerfs_ (Tcl_Interp *interp, char *trans, integer *n, integer *nrhs, 	doublereal *a, integer *lda, doublereal *af, integer *ldaf, integer *	ipiv, doublereal *b, integer *ldb, doublereal *x, integer *ldx, 	doublereal *ferr, doublereal *berr, doublereal *work, integer *iwork, 	integer *info)
{
    integer a_dim1, a_offset, af_dim1, af_offset, b_dim1, b_offset, x_dim1, 
	    x_offset, i__1, i__2, i__3;
    doublereal d__1, d__2, d__3;

    integer i__, j, k;
    doublereal s, xk;
    integer nz;
    doublereal eps;
    integer kase;
    doublereal safe1, safe2;
    integer isave[3];
    integer count;
    doublereal safmin;
    logical notran;
    char transt[1];
    doublereal lstres;






























    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    af_dim1 = *ldaf;
    af_offset = 1 + af_dim1;
    af -= af_offset;
    --ipiv;
    b_dim1 = *ldb;
    b_offset = 1 + b_dim1;
    b -= b_offset;
    x_dim1 = *ldx;
    x_offset = 1 + x_dim1;
    x -= x_offset;
    --ferr;
    --berr;
    --work;
    --iwork;

    *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 (*ldaf < max(1,*n)) {
	*info = -7;
    } else if (*ldb < max(1,*n)) {
	*info = -10;
    } else if (*ldx < max(1,*n)) {
	*info = -12;
    }
    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DGERFS", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


    if (*n == 0 || *nrhs == 0) {
	i__1 = *nrhs;
	for (j = 1; j <= i__1; ++j) {
	    ferr[j] = 0.;
	    berr[j] = 0.;
	}
return TCL_OK;
    }

    if (notran) {
	*(unsigned char *)transt = 'T';
    } else {
	*(unsigned char *)transt = 'N';
    }


    nz = *n + 1;
    eps = dlamch_("Epsilon");
    safmin = dlamch_("Safe minimum");
    safe1 = nz * safmin;
    safe2 = safe1 / eps;


    i__1 = *nrhs;
    for (j = 1; j <= i__1; ++j) {

	count = 1;
	lstres = 3.;
L20:



	if (dcopy_(interp, n, &b[j * b_dim1 + 1], &dgerfs_c__1, &work[*n + 1], &dgerfs_c__1)!=TCL_OK) { return TCL_ERROR; }

	if (dgemv_(interp, trans, n, n, &dgerfs_c_b15, &a[a_offset], lda, &x[j * x_dim1 + 1], &		dgerfs_c__1, &dgerfs_c_b17, &work[*n + 1], &dgerfs_c__1)!=TCL_OK) { return TCL_ERROR; }






	i__2 = *n;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    work[i__] = (d__1 = b[i__ + j * b_dim1], abs(d__1));
	}


	if (notran) {
	    i__2 = *n;
	    for (k = 1; k <= i__2; ++k) {
		xk = (d__1 = x[k + j * x_dim1], abs(d__1));
		i__3 = *n;
		for (i__ = 1; i__ <= i__3; ++i__) {
		    work[i__] += (d__1 = a[i__ + k * a_dim1], abs(d__1)) * xk;
		}
	    }
	} else {
	    i__2 = *n;
	    for (k = 1; k <= i__2; ++k) {
		s = 0.;
		i__3 = *n;
		for (i__ = 1; i__ <= i__3; ++i__) {
		    s += (d__1 = a[i__ + k * a_dim1], abs(d__1)) * (d__2 = x[
			    i__ + j * x_dim1], abs(d__2));
		}
		work[k] += s;
	    }
	}
	s = 0.;
	i__2 = *n;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    if (work[i__] > safe2) {
		d__2 = s, d__3 = (d__1 = work[*n + i__], abs(d__1)) / work[
			i__];
		s = max(d__2,d__3);
	    } else {
		d__2 = s, d__3 = ((d__1 = work[*n + i__], abs(d__1)) + safe1) 
			/ (work[i__] + safe1);
		s = max(d__2,d__3);
	    }
	}
	berr[j] = s;


	if (berr[j] > eps && berr[j] * 2. <= lstres && count <= 5) {


	    if (dgetrs_(interp, trans, n, &dgerfs_c__1, &af[af_offset], ldaf, &ipiv[1], &work[*n 		    + 1], n, info)!=TCL_OK) { return TCL_ERROR; }


	    if (daxpy_(interp, n, &dgerfs_c_b17, &work[*n + 1], &dgerfs_c__1, &x[j * x_dim1 + 1], &dgerfs_c__1)		    !=TCL_OK) { return TCL_ERROR; }


	    lstres = berr[j];
	    ++count;
	    goto L20;
	}






	i__2 = *n;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    if (work[i__] > safe2) {
		work[i__] = (d__1 = work[*n + i__], abs(d__1)) + nz * eps * 
			work[i__];
	    } else {
		work[i__] = (d__1 = work[*n + i__], abs(d__1)) + nz * eps * 
			work[i__] + safe1;
	    }
	}

	kase = 0;
L100:
	if (dlacn2_(interp, n, &work[(*n << 1) + 1], &work[*n + 1], &iwork[1], &ferr[j], &		kase, isave)!=TCL_OK) { return TCL_ERROR; }


	if (kase != 0) {
	    if (kase == 1) {


		if (dgetrs_(interp, transt, n, &dgerfs_c__1, &af[af_offset], ldaf, &ipiv[1], &			work[*n + 1], n, info)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *n;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    work[*n + i__] = work[i__] * work[*n + i__];
		}
	    } else {


		i__2 = *n;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    work[*n + i__] = work[i__] * work[*n + i__];
		}
		if (dgetrs_(interp, trans, n, &dgerfs_c__1, &af[af_offset], ldaf, &ipiv[1], &			work[*n + 1], n, info)!=TCL_OK) { return TCL_ERROR; }


	    }
	    goto L100;
	}


	lstres = 0.;
	i__2 = *n;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    d__2 = lstres, d__3 = (d__1 = x[i__ + j * x_dim1], abs(d__1));
	    lstres = max(d__2,d__3);
	}
	if (lstres != 0.) {
	    ferr[j] /= lstres;
	}

    }

return TCL_OK;


} /* dgerfs_ */
static doublereal dlantr_ (char *norm, char *uplo, char *diag, integer *m, integer *n, 	 doublereal *a, integer *lda, doublereal *work)
{
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
    doublereal ret_val, d__1, d__2, d__3;

    double sqrt(doublereal);

    integer i__, j;
    doublereal sum, scale;
    logical udiag;
    doublereal value;





















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

    if (min(*m,*n) == 0) {
	value = 0.;
    } else if (lsame_(norm, "M")) {


	if (lsame_(diag, "U")) {
	    value = 1.;
	    if (lsame_(uplo, "U")) {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__3 = *m, i__4 = j - 1;
		    i__2 = min(i__3,i__4);
		    for (i__ = 1; i__ <= i__2; ++i__) {
			d__2 = value, d__3 = (d__1 = a[i__ + j * a_dim1], abs(
				d__1));
			value = max(d__2,d__3);
		    }
		}
	    } else {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = *m;
		    for (i__ = j + 1; i__ <= i__2; ++i__) {
			d__2 = value, d__3 = (d__1 = a[i__ + j * a_dim1], abs(
				d__1));
			value = max(d__2,d__3);
		    }
		}
	    }
	} else {
	    value = 0.;
	    if (lsame_(uplo, "U")) {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = min(*m,j);
		    for (i__ = 1; i__ <= i__2; ++i__) {
			d__2 = value, d__3 = (d__1 = a[i__ + j * a_dim1], abs(
				d__1));
			value = max(d__2,d__3);
		    }
		}
	    } else {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = *m;
		    for (i__ = j; i__ <= i__2; ++i__) {
			d__2 = value, d__3 = (d__1 = a[i__ + j * a_dim1], abs(
				d__1));
			value = max(d__2,d__3);
		    }
		}
	    }
	}
    } else if (lsame_(norm, "O") || *(unsigned char *)
	    norm == '1') {


	value = 0.;
	udiag = lsame_(diag, "U");
	if (lsame_(uplo, "U")) {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		if (udiag && j <= *m) {
		    sum = 1.;
		    i__2 = j - 1;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			sum += (d__1 = a[i__ + j * a_dim1], abs(d__1));
		    }
		} else {
		    sum = 0.;
		    i__2 = min(*m,j);
		    for (i__ = 1; i__ <= i__2; ++i__) {
			sum += (d__1 = a[i__ + j * a_dim1], abs(d__1));
		    }
		}
		value = max(value,sum);
	    }
	} else {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		if (udiag) {
		    sum = 1.;
		    i__2 = *m;
		    for (i__ = j + 1; i__ <= i__2; ++i__) {
			sum += (d__1 = a[i__ + j * a_dim1], abs(d__1));
		    }
		} else {
		    sum = 0.;
		    i__2 = *m;
		    for (i__ = j; i__ <= i__2; ++i__) {
			sum += (d__1 = a[i__ + j * a_dim1], abs(d__1));
		    }
		}
		value = max(value,sum);
	    }
	}
    } else if (lsame_(norm, "I")) {


	if (lsame_(uplo, "U")) {
	    if (lsame_(diag, "U")) {
		i__1 = *m;
		for (i__ = 1; i__ <= i__1; ++i__) {
		    work[i__] = 1.;
		}
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__3 = *m, i__4 = j - 1;
		    i__2 = min(i__3,i__4);
		    for (i__ = 1; i__ <= i__2; ++i__) {
			work[i__] += (d__1 = a[i__ + j * a_dim1], abs(d__1));
		    }
		}
	    } else {
		i__1 = *m;
		for (i__ = 1; i__ <= i__1; ++i__) {
		    work[i__] = 0.;
		}
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = min(*m,j);
		    for (i__ = 1; i__ <= i__2; ++i__) {
			work[i__] += (d__1 = a[i__ + j * a_dim1], abs(d__1));
		    }
		}
	    }
	} else {
	    if (lsame_(diag, "U")) {
		i__1 = *n;
		for (i__ = 1; i__ <= i__1; ++i__) {
		    work[i__] = 1.;
		}
		i__1 = *m;
		for (i__ = *n + 1; i__ <= i__1; ++i__) {
		    work[i__] = 0.;
		}
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = *m;
		    for (i__ = j + 1; i__ <= i__2; ++i__) {
			work[i__] += (d__1 = a[i__ + j * a_dim1], abs(d__1));
		    }
		}
	    } else {
		i__1 = *m;
		for (i__ = 1; i__ <= i__1; ++i__) {
		    work[i__] = 0.;
		}
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = *m;
		    for (i__ = j; i__ <= i__2; ++i__) {
			work[i__] += (d__1 = a[i__ + j * a_dim1], abs(d__1));
		    }
		}
	    }
	}
	value = 0.;
	i__1 = *m;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    d__1 = value, d__2 = work[i__];
	    value = max(d__1,d__2);
	}
    } else if (lsame_(norm, "F") || lsame_(norm, "E")) {


	if (lsame_(uplo, "U")) {
	    if (lsame_(diag, "U")) {
		scale = 1.;
		sum = (doublereal) min(*m,*n);
		i__1 = *n;
		for (j = 2; j <= i__1; ++j) {
		    i__3 = *m, i__4 = j - 1;
		    i__2 = min(i__3,i__4);
		    dlassq_(NULL, &i__2, &a[j * a_dim1 + 1], &dlantr_c__1, &scale, &sum);
		}
	    } else {
		scale = 0.;
		sum = 1.;
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = min(*m,j);
		    dlassq_(NULL, &i__2, &a[j * a_dim1 + 1], &dlantr_c__1, &scale, &sum);
		}
	    }
	} else {
	    if (lsame_(diag, "U")) {
		scale = 1.;
		sum = (doublereal) min(*m,*n);
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = *m - j;
		    i__3 = *m, i__4 = j + 1;
		    dlassq_(NULL, &i__2, &a[min(i__3, i__4)+ j * a_dim1], &dlantr_c__1, &			    scale, &sum);

		}
	    } else {
		scale = 0.;
		sum = 1.;
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = *m - j + 1;
		    dlassq_(NULL, &i__2, &a[j + j * a_dim1], &dlantr_c__1, &scale, &sum);
		}
	    }
	}
	value = scale * sqrt(sum);
    }

    ret_val = value;
    return ret_val;


} /* dlantr_ */
static /* Subroutine */ int zlaqge_ (Tcl_Interp *interp, integer *m, integer *n, doublecomplex *a, 	integer *lda, doublereal *r__, doublereal *c__, doublereal *rowcnd, 	doublereal *colcnd, doublereal *amax, char *equed)
{
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
    doublereal d__1;
    doublecomplex z__1;

    integer i__, j;
    doublereal cj, large, small;























    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --r__;
    --c__;

    if (*m <= 0 || *n <= 0) {
	*(unsigned char *)equed = 'N';
return TCL_OK;
    }


    small = dlamch_("Safe minimum") / dlamch_("Precision");
    large = 1. / small;

    if (*rowcnd >= .1 && *amax >= small && *amax <= large) {


	if (*colcnd >= .1) {


	    *(unsigned char *)equed = 'N';
	} else {


	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		cj = c__[j];
		i__2 = *m;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    i__3 = i__ + j * a_dim1;
		    i__4 = i__ + j * a_dim1;
		    z__1.r = cj * a[i__4].r, z__1.i = cj * a[i__4].i;
		    a[i__3].r = z__1.r, a[i__3].i = z__1.i;
		}
	    }
	    *(unsigned char *)equed = 'C';
	}
    } else if (*colcnd >= .1) {


	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *m;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		i__3 = i__ + j * a_dim1;
		i__4 = i__;
		i__5 = i__ + j * a_dim1;
		z__1.r = r__[i__4] * a[i__5].r, z__1.i = r__[i__4] * a[i__5]
			.i;
		a[i__3].r = z__1.r, a[i__3].i = z__1.i;
	    }
	}
	*(unsigned char *)equed = 'R';
    } else {


	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    cj = c__[j];
	    i__2 = *m;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		i__3 = i__ + j * a_dim1;
		d__1 = cj * r__[i__];
		i__4 = i__ + j * a_dim1;
		z__1.r = d__1 * a[i__4].r, z__1.i = d__1 * a[i__4].i;
		a[i__3].r = z__1.r, a[i__3].i = z__1.i;
	    }
	}
	*(unsigned char *)equed = 'B';
    }

return TCL_OK;


} /* zlaqge_ */
static /* Subroutine */ int zgecon_ (Tcl_Interp *interp, char *norm, integer *n, doublecomplex *a, 	integer *lda, doublereal *anorm, doublereal *rcond, doublecomplex *	work, doublereal *rwork, integer *info)
{
    integer a_dim1, a_offset, i__1;
    doublereal d__1, d__2;

    double d_imag(doublecomplex *);

    doublereal sl;
    integer ix;
    doublereal su;
    integer kase, kase1;
    doublereal scale;
    integer isave[3];
    doublereal ainvnm;
    logical onenrm;
    char normin[1];
    doublereal smlnum;





















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

    *info = 0;
    onenrm = *(unsigned char *)norm == '1' || lsame_(norm, "O");
    if (! onenrm && ! lsame_(norm, "I")) {
	*info = -1;
    } else if (*n < 0) {
	*info = -2;
    } else if (*lda < max(1,*n)) {
	*info = -4;
    } else if (*anorm < 0.) {
	*info = -5;
    }
    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "ZGECON", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


    *rcond = 0.;
    if (*n == 0) {
	*rcond = 1.;
return TCL_OK;
    } else if (*anorm == 0.) {
return TCL_OK;
    }

    smlnum = dlamch_("Safe minimum");


    ainvnm = 0.;
    *(unsigned char *)normin = 'N';
    if (onenrm) {
	kase1 = 1;
    } else {
	kase1 = 2;
    }
    kase = 0;
L10:
    if (zlacn2_(interp, n, &work[*n + 1], &work[1], &ainvnm, &kase, isave)!=TCL_OK) { return TCL_ERROR; }

    if (kase != 0) {
	if (kase == kase1) {


	    if (zlatrs_(interp, "Lower", "No transpose", "Unit", normin, n, &a[a_offset], 		    lda, &work[1], &sl, &rwork[1], info)!=TCL_OK) { return TCL_ERROR; }




	    if (zlatrs_(interp, "Upper", "No transpose", "Non-unit", normin, n, &a[		    a_offset], lda, &work[1], &su, &rwork[*n + 1], info)!=TCL_OK) { return TCL_ERROR; }


	} else {


	    if (zlatrs_(interp, "Upper", "Conjugate transpose", "Non-unit", normin, n, &a[		    a_offset], lda, &work[1], &su, &rwork[*n + 1], info)!=TCL_OK) { return TCL_ERROR; }




	    if (zlatrs_(interp, "Lower", "Conjugate transpose", "Unit", normin, n, &a[		    a_offset], lda, &work[1], &sl, &rwork[1], info)!=TCL_OK) { return TCL_ERROR; }


	}


	scale = sl * su;
	*(unsigned char *)normin = 'Y';
	if (scale != 1.) {
	    ix = izamax_(n, &work[1], &zgecon_c__1);
	    i__1 = ix;
	    if (scale < ((d__1 = work[i__1].r, abs(d__1)) + (d__2 = d_imag(&
		    work[ix]), abs(d__2))) * smlnum || scale == 0.) {
		goto L20;
	    }
	    if (zdrscl_(interp, n, &scale, &work[1], &zgecon_c__1)!=TCL_OK) { return TCL_ERROR; }

	}
	goto L10;
    }


    if (ainvnm != 0.) {
	*rcond = 1. / ainvnm / *anorm;
    }

L20:
return TCL_OK;


} /* zgecon_ */
static /* Subroutine */ int zgeequ_ (Tcl_Interp *interp, integer *m, integer *n, doublecomplex *a, 	integer *lda, doublereal *r__, doublereal *c__, doublereal *rowcnd, 	doublereal *colcnd, doublereal *amax, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3;
    doublereal d__1, d__2, d__3, d__4;

    double d_imag(doublecomplex *);

    integer i__, j;
    doublereal rcmin, rcmax;
    doublereal bignum, smlnum;





















    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --r__;
    --c__;

    *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);
	vectcl_xerbla(interp, "ZGEEQU", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


    if (*m == 0 || *n == 0) {
	*rowcnd = 1.;
	*colcnd = 1.;
	*amax = 0.;
return TCL_OK;
    }


    smlnum = dlamch_("S");
    bignum = 1. / smlnum;


    i__1 = *m;
    for (i__ = 1; i__ <= i__1; ++i__) {
	r__[i__] = 0.;
    }


    i__1 = *n;
    for (j = 1; j <= i__1; ++j) {
	i__2 = *m;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    i__3 = i__ + j * a_dim1;
	    d__3 = r__[i__], d__4 = (d__1 = a[i__3].r, abs(d__1)) + (d__2 = 
		    d_imag(&a[i__ + j * a_dim1]), abs(d__2));
	    r__[i__] = max(d__3,d__4);
	}
    }


    rcmin = bignum;
    rcmax = 0.;
    i__1 = *m;
    for (i__ = 1; i__ <= i__1; ++i__) {
	d__1 = rcmax, d__2 = r__[i__];
	rcmax = max(d__1,d__2);
	d__1 = rcmin, d__2 = r__[i__];
	rcmin = min(d__1,d__2);
    }
    *amax = rcmax;

    if (rcmin == 0.) {


	i__1 = *m;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    if (r__[i__] == 0.) {
		*info = i__;
return TCL_OK;
	    }
	}
    } else {


	i__1 = *m;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    d__2 = r__[i__];
	    d__1 = max(d__2,smlnum);
	    r__[i__] = 1. / min(d__1,bignum);
	}


	*rowcnd = max(rcmin,smlnum) / min(rcmax,bignum);
    }


    i__1 = *n;
    for (j = 1; j <= i__1; ++j) {
	c__[j] = 0.;
    }


    i__1 = *n;
    for (j = 1; j <= i__1; ++j) {
	i__2 = *m;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    i__3 = i__ + j * a_dim1;
	    d__3 = c__[j], d__4 = ((d__1 = a[i__3].r, abs(d__1)) + (d__2 = 
		    d_imag(&a[i__ + j * a_dim1]), abs(d__2))) * r__[i__];
	    c__[j] = max(d__3,d__4);
	}
    }


    rcmin = bignum;
    rcmax = 0.;
    i__1 = *n;
    for (j = 1; j <= i__1; ++j) {
	d__1 = rcmin, d__2 = c__[j];
	rcmin = min(d__1,d__2);
	d__1 = rcmax, d__2 = c__[j];
	rcmax = max(d__1,d__2);
    }

    if (rcmin == 0.) {


	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    if (c__[j] == 0.) {
		*info = *m + j;
return TCL_OK;
	    }
	}
    } else {


	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    d__2 = c__[j];
	    d__1 = max(d__2,smlnum);
	    c__[j] = 1. / min(d__1,bignum);
	}


	*colcnd = max(rcmin,smlnum) / min(rcmax,bignum);
    }

return TCL_OK;


} /* zgeequ_ */
static /* Subroutine */ int zgerfs_ (Tcl_Interp *interp, char *trans, integer *n, integer *nrhs, 	doublecomplex *a, integer *lda, doublecomplex *af, integer *ldaf, 	integer *ipiv, doublecomplex *b, integer *ldb, doublecomplex *x, 	integer *ldx, doublereal *ferr, doublereal *berr, doublecomplex *work, 	 doublereal *rwork, integer *info)
{
    integer a_dim1, a_offset, af_dim1, af_offset, b_dim1, b_offset, x_dim1, 
	    x_offset, i__1, i__2, i__3, i__4, i__5;
    doublereal d__1, d__2, d__3, d__4;
    doublecomplex z__1;

    double d_imag(doublecomplex *);

    integer i__, j, k;
    doublereal s, xk;
    integer nz;
    doublereal eps;
    integer kase;
    doublereal safe1, safe2;
    integer isave[3], count;
    doublereal safmin;
    logical notran;
    char transn[1], transt[1];
    doublereal lstres;






























    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    af_dim1 = *ldaf;
    af_offset = 1 + af_dim1;
    af -= af_offset;
    --ipiv;
    b_dim1 = *ldb;
    b_offset = 1 + b_dim1;
    b -= b_offset;
    x_dim1 = *ldx;
    x_offset = 1 + x_dim1;
    x -= x_offset;
    --ferr;
    --berr;
    --work;
    --rwork;

    *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 (*ldaf < max(1,*n)) {
	*info = -7;
    } else if (*ldb < max(1,*n)) {
	*info = -10;
    } else if (*ldx < max(1,*n)) {
	*info = -12;
    }
    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "ZGERFS", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


    if (*n == 0 || *nrhs == 0) {
	i__1 = *nrhs;
	for (j = 1; j <= i__1; ++j) {
	    ferr[j] = 0.;
	    berr[j] = 0.;
	}
return TCL_OK;
    }

    if (notran) {
	*(unsigned char *)transn = 'N';
	*(unsigned char *)transt = 'C';
    } else {
	*(unsigned char *)transn = 'C';
	*(unsigned char *)transt = 'N';
    }


    nz = *n + 1;
    eps = dlamch_("Epsilon");
    safmin = dlamch_("Safe minimum");
    safe1 = nz * safmin;
    safe2 = safe1 / eps;


    i__1 = *nrhs;
    for (j = 1; j <= i__1; ++j) {

	count = 1;
	lstres = 3.;
L20:



	if (zcopy_(interp, n, &b[j * b_dim1 + 1], &zgerfs_c__1, &work[1], &zgerfs_c__1)!=TCL_OK) { return TCL_ERROR; }

	z__1.r = -1., z__1.i = -0.;
	if (zgemv_(interp, trans, n, n, &z__1, &a[a_offset], lda, &x[j * x_dim1 + 1], &		zgerfs_c__1, &zgerfs_c_b1, &work[1], &zgerfs_c__1)!=TCL_OK) { return TCL_ERROR; }






	i__2 = *n;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    i__3 = i__ + j * b_dim1;
	    rwork[i__] = (d__1 = b[i__3].r, abs(d__1)) + (d__2 = d_imag(&b[
		    i__ + j * b_dim1]), abs(d__2));
	}


	if (notran) {
	    i__2 = *n;
	    for (k = 1; k <= i__2; ++k) {
		i__3 = k + j * x_dim1;
		xk = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = d_imag(&x[k + j *
			 x_dim1]), abs(d__2));
		i__3 = *n;
		for (i__ = 1; i__ <= i__3; ++i__) {
		    i__4 = i__ + k * a_dim1;
		    rwork[i__] += ((d__1 = a[i__4].r, abs(d__1)) + (d__2 = 
			    d_imag(&a[i__ + k * a_dim1]), abs(d__2))) * xk;
		}
	    }
	} else {
	    i__2 = *n;
	    for (k = 1; k <= i__2; ++k) {
		s = 0.;
		i__3 = *n;
		for (i__ = 1; i__ <= i__3; ++i__) {
		    i__4 = i__ + k * a_dim1;
		    i__5 = i__ + j * x_dim1;
		    s += ((d__1 = a[i__4].r, abs(d__1)) + (d__2 = d_imag(&a[
			    i__ + k * a_dim1]), abs(d__2))) * ((d__3 = x[i__5]
			    .r, abs(d__3)) + (d__4 = d_imag(&x[i__ + j * 
			    x_dim1]), abs(d__4)));
		}
		rwork[k] += s;
	    }
	}
	s = 0.;
	i__2 = *n;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    if (rwork[i__] > safe2) {
		i__3 = i__;
		d__3 = s, d__4 = ((d__1 = work[i__3].r, abs(d__1)) + (d__2 = 
			d_imag(&work[i__]), abs(d__2))) / rwork[i__];
		s = max(d__3,d__4);
	    } else {
		i__3 = i__;
		d__3 = s, d__4 = ((d__1 = work[i__3].r, abs(d__1)) + (d__2 = 
			d_imag(&work[i__]), abs(d__2)) + safe1) / (rwork[i__] 
			+ safe1);
		s = max(d__3,d__4);
	    }
	}
	berr[j] = s;


	if (berr[j] > eps && berr[j] * 2. <= lstres && count <= 5) {


	    if (zgetrs_(interp, trans, n, &zgerfs_c__1, &af[af_offset], ldaf, &ipiv[1], &work[1], 		     n, info)!=TCL_OK) { return TCL_ERROR; }


	    if (zaxpy_(interp, n, &zgerfs_c_b1, &work[1], &zgerfs_c__1, &x[j * x_dim1 + 1], &zgerfs_c__1)!=TCL_OK) { return TCL_ERROR; }

	    lstres = berr[j];
	    ++count;
	    goto L20;
	}






	i__2 = *n;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    if (rwork[i__] > safe2) {
		i__3 = i__;
		rwork[i__] = (d__1 = work[i__3].r, abs(d__1)) + (d__2 = 
			d_imag(&work[i__]), abs(d__2)) + nz * eps * rwork[i__]
			;
	    } else {
		i__3 = i__;
		rwork[i__] = (d__1 = work[i__3].r, abs(d__1)) + (d__2 = 
			d_imag(&work[i__]), abs(d__2)) + nz * eps * rwork[i__]
			 + safe1;
	    }
	}

	kase = 0;
L100:
	if (zlacn2_(interp, n, &work[*n + 1], &work[1], &ferr[j], &kase, isave)!=TCL_OK) { return TCL_ERROR; }

	if (kase != 0) {
	    if (kase == 1) {


		if (zgetrs_(interp, transt, n, &zgerfs_c__1, &af[af_offset], ldaf, &ipiv[1], &			work[1], n, info)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *n;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    i__3 = i__;
		    i__4 = i__;
		    i__5 = i__;
		    z__1.r = rwork[i__4] * work[i__5].r, z__1.i = rwork[i__4] 
			    * work[i__5].i;
		    work[i__3].r = z__1.r, work[i__3].i = z__1.i;
		}
	    } else {


		i__2 = *n;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    i__3 = i__;
		    i__4 = i__;
		    i__5 = i__;
		    z__1.r = rwork[i__4] * work[i__5].r, z__1.i = rwork[i__4] 
			    * work[i__5].i;
		    work[i__3].r = z__1.r, work[i__3].i = z__1.i;
		}
		if (zgetrs_(interp, transn, n, &zgerfs_c__1, &af[af_offset], ldaf, &ipiv[1], &			work[1], n, info)!=TCL_OK) { return TCL_ERROR; }


	    }
	    goto L100;
	}


	lstres = 0.;
	i__2 = *n;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    i__3 = i__ + j * x_dim1;
	    d__3 = lstres, d__4 = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = 
		    d_imag(&x[i__ + j * x_dim1]), abs(d__2));
	    lstres = max(d__3,d__4);
	}
	if (lstres != 0.) {
	    ferr[j] /= lstres;
	}

    }

return TCL_OK;


} /* zgerfs_ */
static doublereal zlantr_ (char *norm, char *uplo, char *diag, integer *m, integer *n, 	 doublecomplex *a, integer *lda, doublereal *work)
{
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
    doublereal ret_val, d__1, d__2;

    double z_abs(doublecomplex *), sqrt(doublereal);

    integer i__, j;
    doublereal sum, scale;
    logical udiag;
    doublereal value;





















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

    if (min(*m,*n) == 0) {
	value = 0.;
    } else if (lsame_(norm, "M")) {


	if (lsame_(diag, "U")) {
	    value = 1.;
	    if (lsame_(uplo, "U")) {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__3 = *m, i__4 = j - 1;
		    i__2 = min(i__3,i__4);
		    for (i__ = 1; i__ <= i__2; ++i__) {
			d__1 = value, d__2 = z_abs(&a[i__ + j * a_dim1]);
			value = max(d__1,d__2);
		    }
		}
	    } else {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = *m;
		    for (i__ = j + 1; i__ <= i__2; ++i__) {
			d__1 = value, d__2 = z_abs(&a[i__ + j * a_dim1]);
			value = max(d__1,d__2);
		    }
		}
	    }
	} else {
	    value = 0.;
	    if (lsame_(uplo, "U")) {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = min(*m,j);
		    for (i__ = 1; i__ <= i__2; ++i__) {
			d__1 = value, d__2 = z_abs(&a[i__ + j * a_dim1]);
			value = max(d__1,d__2);
		    }
		}
	    } else {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = *m;
		    for (i__ = j; i__ <= i__2; ++i__) {
			d__1 = value, d__2 = z_abs(&a[i__ + j * a_dim1]);
			value = max(d__1,d__2);
		    }
		}
	    }
	}
    } else if (lsame_(norm, "O") || *(unsigned char *)
	    norm == '1') {


	value = 0.;
	udiag = lsame_(diag, "U");
	if (lsame_(uplo, "U")) {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		if (udiag && j <= *m) {
		    sum = 1.;
		    i__2 = j - 1;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			sum += z_abs(&a[i__ + j * a_dim1]);
		    }
		} else {
		    sum = 0.;
		    i__2 = min(*m,j);
		    for (i__ = 1; i__ <= i__2; ++i__) {
			sum += z_abs(&a[i__ + j * a_dim1]);
		    }
		}
		value = max(value,sum);
	    }
	} else {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		if (udiag) {
		    sum = 1.;
		    i__2 = *m;
		    for (i__ = j + 1; i__ <= i__2; ++i__) {
			sum += z_abs(&a[i__ + j * a_dim1]);
		    }
		} else {
		    sum = 0.;
		    i__2 = *m;
		    for (i__ = j; i__ <= i__2; ++i__) {
			sum += z_abs(&a[i__ + j * a_dim1]);
		    }
		}
		value = max(value,sum);
	    }
	}
    } else if (lsame_(norm, "I")) {


	if (lsame_(uplo, "U")) {
	    if (lsame_(diag, "U")) {
		i__1 = *m;
		for (i__ = 1; i__ <= i__1; ++i__) {
		    work[i__] = 1.;
		}
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__3 = *m, i__4 = j - 1;
		    i__2 = min(i__3,i__4);
		    for (i__ = 1; i__ <= i__2; ++i__) {
			work[i__] += z_abs(&a[i__ + j * a_dim1]);
		    }
		}
	    } else {
		i__1 = *m;
		for (i__ = 1; i__ <= i__1; ++i__) {
		    work[i__] = 0.;
		}
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = min(*m,j);
		    for (i__ = 1; i__ <= i__2; ++i__) {
			work[i__] += z_abs(&a[i__ + j * a_dim1]);
		    }
		}
	    }
	} else {
	    if (lsame_(diag, "U")) {
		i__1 = *n;
		for (i__ = 1; i__ <= i__1; ++i__) {
		    work[i__] = 1.;
		}
		i__1 = *m;
		for (i__ = *n + 1; i__ <= i__1; ++i__) {
		    work[i__] = 0.;
		}
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = *m;
		    for (i__ = j + 1; i__ <= i__2; ++i__) {
			work[i__] += z_abs(&a[i__ + j * a_dim1]);
		    }
		}
	    } else {
		i__1 = *m;
		for (i__ = 1; i__ <= i__1; ++i__) {
		    work[i__] = 0.;
		}
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = *m;
		    for (i__ = j; i__ <= i__2; ++i__) {
			work[i__] += z_abs(&a[i__ + j * a_dim1]);
		    }
		}
	    }
	}
	value = 0.;
	i__1 = *m;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    d__1 = value, d__2 = work[i__];
	    value = max(d__1,d__2);
	}
    } else if (lsame_(norm, "F") || lsame_(norm, "E")) {


	if (lsame_(uplo, "U")) {
	    if (lsame_(diag, "U")) {
		scale = 1.;
		sum = (doublereal) min(*m,*n);
		i__1 = *n;
		for (j = 2; j <= i__1; ++j) {
		    i__3 = *m, i__4 = j - 1;
		    i__2 = min(i__3,i__4);
		    zlassq_(NULL, &i__2, &a[j * a_dim1 + 1], &zlantr_c__1, &scale, &sum);
		}
	    } else {
		scale = 0.;
		sum = 1.;
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = min(*m,j);
		    zlassq_(NULL, &i__2, &a[j * a_dim1 + 1], &zlantr_c__1, &scale, &sum);
		}
	    }
	} else {
	    if (lsame_(diag, "U")) {
		scale = 1.;
		sum = (doublereal) min(*m,*n);
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = *m - j;
		    i__3 = *m, i__4 = j + 1;
		    zlassq_(NULL, &i__2, &a[min(i__3, i__4)+ j * a_dim1], &zlantr_c__1, &			    scale, &sum);

		}
	    } else {
		scale = 0.;
		sum = 1.;
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = *m - j + 1;
		    zlassq_(NULL, &i__2, &a[j + j * a_dim1], &zlantr_c__1, &scale, &sum);
		}
	    }
	}
	value = scale * sqrt(sum);
    }

    ret_val = value;
    return ret_val;


} /* zlantr_ */
static /* Subroutine */ int dtrsen_ (Tcl_Interp *interp, char *job, char *compq, logical *select, integer 	*n, doublereal *t, integer *ldt, doublereal *q, integer *ldq, 	doublereal *wr, doublereal *wi, integer *m, doublereal *s, doublereal 	*sep, doublereal *work, integer *lwork, integer *iwork, integer *	liwork, integer *info)
{
    integer q_dim1, q_offset, t_dim1, t_offset, i__1, i__2;
    doublereal d__1, d__2;

    double sqrt(doublereal);

    integer k, n1, n2, kk, nn, ks;
    doublereal est;
    integer kase;
    logical pair;
    integer ierr;
    logical swap;
    doublereal scale;
    integer isave[3], lwmin;
    logical wantq, wants;
    doublereal rnorm;
    logical wantbh;
    integer liwmin;
    logical wantsp, lquery;





















































    --select;
    t_dim1 = *ldt;
    t_offset = 1 + t_dim1;
    t -= t_offset;
    q_dim1 = *ldq;
    q_offset = 1 + q_dim1;
    q -= q_offset;
    --wr;
    --wi;
    --work;
    --iwork;

    wantbh = lsame_(job, "B");
    wants = lsame_(job, "E") || wantbh;
    wantsp = lsame_(job, "V") || wantbh;
    wantq = lsame_(compq, "V");

    *info = 0;
    lquery = *lwork == -1;
    if (! lsame_(job, "N") && ! wants && ! wantsp) {
	*info = -1;
    } else if (! lsame_(compq, "N") && ! wantq) {
	*info = -2;
    } else if (*n < 0) {
	*info = -4;
    } else if (*ldt < max(1,*n)) {
	*info = -6;
    } else if (*ldq < 1 || wantq && *ldq < *n) {
	*info = -8;
    } else {


	*m = 0;
	pair = FALSE_;
	i__1 = *n;
	for (k = 1; k <= i__1; ++k) {
	    if (pair) {
		pair = FALSE_;
	    } else {
		if (k < *n) {
		    if (t[k + 1 + k * t_dim1] == 0.) {
			if (select[k]) {
			    ++(*m);
			}
		    } else {
			pair = TRUE_;
			if (select[k] || select[k + 1]) {
			    *m += 2;
			}
		    }
		} else {
		    if (select[*n]) {
			++(*m);
		    }
		}
	    }
	}

	n1 = *m;
	n2 = *n - *m;
	nn = n1 * n2;

	if (wantsp) {
	    i__1 = 1, i__2 = nn << 1;
	    lwmin = max(i__1,i__2);
	    liwmin = max(1,nn);
	} else if (lsame_(job, "N")) {
	    lwmin = max(1,*n);
	    liwmin = 1;
	} else if (lsame_(job, "E")) {
	    lwmin = max(1,nn);
	    liwmin = 1;
	}

	if (*lwork < lwmin && ! lquery) {
	    *info = -15;
	} else if (*liwork < liwmin && ! lquery) {
	    *info = -17;
	}
    }

    if (*info == 0) {
	work[1] = (doublereal) lwmin;
	iwork[1] = liwmin;
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DTRSEN", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


    if (*m == *n || *m == 0) {
	if (wants) {
	    *s = 1.;
	}
	if (wantsp) {
	    *sep = dlange_("1", n, n, &t[t_offset], ldt, &work[1]);
	}
	goto L40;
    }


    ks = 0;
    pair = FALSE_;
    i__1 = *n;
    for (k = 1; k <= i__1; ++k) {
	if (pair) {
	    pair = FALSE_;
	} else {
	    swap = select[k];
	    if (k < *n) {
		if (t[k + 1 + k * t_dim1] != 0.) {
		    pair = TRUE_;
		    swap = swap || select[k + 1];
		}
	    }
	    if (swap) {
		++ks;


		ierr = 0;
		kk = k;
		if (k != ks) {
		    if (dtrexc_(interp, compq, n, &t[t_offset], ldt, &q[q_offset], ldq, &			    kk, &ks, &work[1], &ierr)!=TCL_OK) { return TCL_ERROR; }


		}
		if (ierr == 1 || ierr == 2) {


		    *info = 1;
		    if (wants) {
			*s = 0.;
		    }
		    if (wantsp) {
			*sep = 0.;
		    }
		    goto L40;
		}
		if (pair) {
		    ++ks;
		}
	    }
	}
    }

    if (wants) {



	if (dlacpy_(interp, "F", &n1, &n2, &t[(n1 + 1) * t_dim1 + 1], ldt, &work[1], &n1)!=TCL_OK) { return TCL_ERROR; }

	if (dtrsyl_(interp, "N", "N", &dtrsen_c_n1, &n1, &n2, &t[t_offset], ldt, &t[n1 + 1 + (n1 		+ 1) * t_dim1], ldt, &work[1], &n1, &scale, &ierr)!=TCL_OK) { return TCL_ERROR; }




	rnorm = dlange_("F", &n1, &n2, &work[1], &n1, &work[1]);
	if (rnorm == 0.) {
	    *s = 1.;
	} else {
	    *s = scale / (sqrt(scale * scale / rnorm + rnorm) * sqrt(rnorm));
	}
    }

    if (wantsp) {


	est = 0.;
	kase = 0;
L30:
	if (dlacn2_(interp, &nn, &work[nn + 1], &work[1], &iwork[1], &est, &kase, isave)!=TCL_OK) { return TCL_ERROR; }

	if (kase != 0) {
	    if (kase == 1) {


		if (dtrsyl_(interp, "N", "N", &dtrsen_c_n1, &n1, &n2, &t[t_offset], ldt, &t[n1 + 			1 + (n1 + 1) * t_dim1], ldt, &work[1], &n1, &scale, &
			ierr)!=TCL_OK) { return TCL_ERROR; }


	    } else {


		if (dtrsyl_(interp, "T", "T", &dtrsen_c_n1, &n1, &n2, &t[t_offset], ldt, &t[n1 + 			1 + (n1 + 1) * t_dim1], ldt, &work[1], &n1, &scale, &
			ierr)!=TCL_OK) { return TCL_ERROR; }


	    }
	    goto L30;
	}

	*sep = scale / est;
    }

L40:


    i__1 = *n;
    for (k = 1; k <= i__1; ++k) {
	wr[k] = t[k + k * t_dim1];
	wi[k] = 0.;
    }
    i__1 = *n - 1;
    for (k = 1; k <= i__1; ++k) {
	if (t[k + 1 + k * t_dim1] != 0.) {
	    wi[k] = sqrt((d__1 = t[k + (k + 1) * t_dim1], abs(d__1))) * sqrt((
		    d__2 = t[k + 1 + k * t_dim1], abs(d__2)));
	    wi[k + 1] = -wi[k];
	}
    }

    work[1] = (doublereal) lwmin;
    iwork[1] = liwmin;

return TCL_OK;


} /* dtrsen_ */
static /* Subroutine */ int ztrsen_ (Tcl_Interp *interp, char *job, char *compq, logical *select, integer 	*n, doublecomplex *t, integer *ldt, doublecomplex *q, integer *ldq, 	doublecomplex *w, integer *m, doublereal *s, doublereal *sep, 	doublecomplex *work, integer *lwork, integer *info)
{
    integer q_dim1, q_offset, t_dim1, t_offset, i__1, i__2, i__3;

    double sqrt(doublereal);

    integer k, n1, n2, nn, ks;
    doublereal est;
    integer kase, ierr;
    doublereal scale;
    integer isave[3], lwmin;
    logical wantq, wants;
    doublereal rnorm, rwork[1];
    logical wantbh;
    logical wantsp;
    logical lquery;


















































    --select;
    t_dim1 = *ldt;
    t_offset = 1 + t_dim1;
    t -= t_offset;
    q_dim1 = *ldq;
    q_offset = 1 + q_dim1;
    q -= q_offset;
    --w;
    --work;

    wantbh = lsame_(job, "B");
    wants = lsame_(job, "E") || wantbh;
    wantsp = lsame_(job, "V") || wantbh;
    wantq = lsame_(compq, "V");


    *m = 0;
    i__1 = *n;
    for (k = 1; k <= i__1; ++k) {
	if (select[k]) {
	    ++(*m);
	}
    }

    n1 = *m;
    n2 = *n - *m;
    nn = n1 * n2;

    *info = 0;
    lquery = *lwork == -1;

    if (wantsp) {
	i__1 = 1, i__2 = nn << 1;
	lwmin = max(i__1,i__2);
    } else if (lsame_(job, "N")) {
	lwmin = 1;
    } else if (lsame_(job, "E")) {
	lwmin = max(1,nn);
    }

    if (! lsame_(job, "N") && ! wants && ! wantsp) {
	*info = -1;
    } else if (! lsame_(compq, "N") && ! wantq) {
	*info = -2;
    } else if (*n < 0) {
	*info = -4;
    } else if (*ldt < max(1,*n)) {
	*info = -6;
    } else if (*ldq < 1 || wantq && *ldq < *n) {
	*info = -8;
    } else if (*lwork < lwmin && ! lquery) {
	*info = -14;
    }

    if (*info == 0) {
	work[1].r = (doublereal) lwmin, work[1].i = 0.;
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "ZTRSEN", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


    if (*m == *n || *m == 0) {
	if (wants) {
	    *s = 1.;
	}
	if (wantsp) {
	    *sep = zlange_("1", n, n, &t[t_offset], ldt, rwork);
	}
	goto L40;
    }


    ks = 0;
    i__1 = *n;
    for (k = 1; k <= i__1; ++k) {
	if (select[k]) {
	    ++ks;


	    if (k != ks) {
		if (ztrexc_(interp, compq, n, &t[t_offset], ldt, &q[q_offset], ldq, &k, &			ks, &ierr)!=TCL_OK) { return TCL_ERROR; }


	    }
	}
    }

    if (wants) {



	if (zlacpy_(interp, "F", &n1, &n2, &t[(n1 + 1) * t_dim1 + 1], ldt, &work[1], &n1)!=TCL_OK) { return TCL_ERROR; }

	if (ztrsyl_(interp, "N", "N", &ztrsen_c_n1, &n1, &n2, &t[t_offset], ldt, &t[n1 + 1 + (n1 		+ 1) * t_dim1], ldt, &work[1], &n1, &scale, &ierr)!=TCL_OK) { return TCL_ERROR; }




	rnorm = zlange_("F", &n1, &n2, &work[1], &n1, rwork);
	if (rnorm == 0.) {
	    *s = 1.;
	} else {
	    *s = scale / (sqrt(scale * scale / rnorm + rnorm) * sqrt(rnorm));
	}
    }

    if (wantsp) {


	est = 0.;
	kase = 0;
L30:
	if (zlacn2_(interp, &nn, &work[nn + 1], &work[1], &est, &kase, isave)!=TCL_OK) { return TCL_ERROR; }

	if (kase != 0) {
	    if (kase == 1) {


		if (ztrsyl_(interp, "N", "N", &ztrsen_c_n1, &n1, &n2, &t[t_offset], ldt, &t[n1 + 			1 + (n1 + 1) * t_dim1], ldt, &work[1], &n1, &scale, &
			ierr)!=TCL_OK) { return TCL_ERROR; }


	    } else {


		if (ztrsyl_(interp, "C", "C", &ztrsen_c_n1, &n1, &n2, &t[t_offset], ldt, &t[n1 + 			1 + (n1 + 1) * t_dim1], ldt, &work[1], &n1, &scale, &
			ierr)!=TCL_OK) { return TCL_ERROR; }


	    }
	    goto L30;
	}

	*sep = scale / est;
    }

L40:


    i__1 = *n;
    for (k = 1; k <= i__1; ++k) {
	i__2 = k;
	i__3 = k + k * t_dim1;
	w[i__2].r = t[i__3].r, w[i__2].i = t[i__3].i;
    }

    work[1].r = (doublereal) lwmin, work[1].i = 0.;

return TCL_OK;


} /* ztrsen_ */
static /* Subroutine */ int dlasr_ (Tcl_Interp *interp, char *side, char *pivot, char *direct, integer *m, 	 integer *n, doublereal *c__, doublereal *s, doublereal *a, integer *	lda)
{
    integer a_dim1, a_offset, i__1, i__2;

    integer i__, j, info;
    doublereal temp;
    doublereal ctemp, stemp;







































    --c__;
    --s;
    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;

    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) {
	vectcl_xerbla(interp, "DLASR ", &info);
return TCL_ERROR;

return TCL_OK;
    }


    if (*m == 0 || *n == 0) {
return TCL_OK;
    }
    if (lsame_(side, "L")) {


	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[j + 1 + i__ * a_dim1];
			    a[j + 1 + i__ * a_dim1] = ctemp * temp - stemp * 
				    a[j + i__ * a_dim1];
			    a[j + i__ * a_dim1] = stemp * temp + ctemp * a[j 
				    + i__ * a_dim1];
			}
		    }
		}
	    } 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[j + 1 + i__ * a_dim1];
			    a[j + 1 + i__ * a_dim1] = ctemp * temp - stemp * 
				    a[j + i__ * a_dim1];
			    a[j + i__ * a_dim1] = stemp * temp + ctemp * a[j 
				    + i__ * a_dim1];
			}
		    }
		}
	    }
	} 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[j + i__ * a_dim1];
			    a[j + i__ * a_dim1] = ctemp * temp - stemp * a[
				    i__ * a_dim1 + 1];
			    a[i__ * a_dim1 + 1] = stemp * temp + ctemp * a[
				    i__ * a_dim1 + 1];
			}
		    }
		}
	    } 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[j + i__ * a_dim1];
			    a[j + i__ * a_dim1] = ctemp * temp - stemp * a[
				    i__ * a_dim1 + 1];
			    a[i__ * a_dim1 + 1] = stemp * temp + ctemp * a[
				    i__ * a_dim1 + 1];
			}
		    }
		}
	    }
	} 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[j + i__ * a_dim1];
			    a[j + i__ * a_dim1] = stemp * a[*m + i__ * a_dim1]
				     + ctemp * temp;
			    a[*m + i__ * a_dim1] = ctemp * a[*m + i__ * 
				    a_dim1] - stemp * temp;
			}
		    }
		}
	    } 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[j + i__ * a_dim1];
			    a[j + i__ * a_dim1] = stemp * a[*m + i__ * a_dim1]
				     + ctemp * temp;
			    a[*m + i__ * a_dim1] = ctemp * a[*m + i__ * 
				    a_dim1] - stemp * temp;
			}
		    }
		}
	    }
	}
    } else if (lsame_(side, "R")) {


	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[i__ + (j + 1) * a_dim1];
			    a[i__ + (j + 1) * a_dim1] = ctemp * temp - stemp *
				     a[i__ + j * a_dim1];
			    a[i__ + j * a_dim1] = stemp * temp + ctemp * a[
				    i__ + j * a_dim1];
			}
		    }
		}
	    } 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[i__ + (j + 1) * a_dim1];
			    a[i__ + (j + 1) * a_dim1] = ctemp * temp - stemp *
				     a[i__ + j * a_dim1];
			    a[i__ + j * a_dim1] = stemp * temp + ctemp * a[
				    i__ + j * a_dim1];
			}
		    }
		}
	    }
	} 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[i__ + j * a_dim1];
			    a[i__ + j * a_dim1] = ctemp * temp - stemp * a[
				    i__ + a_dim1];
			    a[i__ + a_dim1] = stemp * temp + ctemp * a[i__ + 
				    a_dim1];
			}
		    }
		}
	    } 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[i__ + j * a_dim1];
			    a[i__ + j * a_dim1] = ctemp * temp - stemp * a[
				    i__ + a_dim1];
			    a[i__ + a_dim1] = stemp * temp + ctemp * a[i__ + 
				    a_dim1];
			}
		    }
		}
	    }
	} 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[i__ + j * a_dim1];
			    a[i__ + j * a_dim1] = stemp * a[i__ + *n * a_dim1]
				     + ctemp * temp;
			    a[i__ + *n * a_dim1] = ctemp * a[i__ + *n * 
				    a_dim1] - stemp * temp;
			}
		    }
		}
	    } 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[i__ + j * a_dim1];
			    a[i__ + j * a_dim1] = stemp * a[i__ + *n * a_dim1]
				     + ctemp * temp;
			    a[i__ + *n * a_dim1] = ctemp * a[i__ + *n * 
				    a_dim1] - stemp * temp;
			}
		    }
		}
	    }
	}
    }

return TCL_OK;


} /* dlasr_ */
static /* Subroutine */ int dlasd0_ (Tcl_Interp *interp, integer *n, integer *sqre, doublereal *d__, 	doublereal *e, doublereal *u, integer *ldu, doublereal *vt, integer *	ldvt, integer *smlsiz, integer *iwork, doublereal *work, integer *	info)
{
    integer u_dim1, u_offset, vt_dim1, vt_offset, i__1, i__2;

    integer pow_ii(integer *, integer *);

    integer i__, j, m, i1, ic, lf, nd, ll, nl, nr, im1, ncc, nlf, nrf, iwk, 
	    lvl, ndb1, nlp1, nrp1;
    doublereal beta;
    integer idxq, nlvl;
    doublereal alpha;
    integer inode, ndiml, idxqc, ndimr, itemp, sqrei;

























    --d__;
    --e;
    u_dim1 = *ldu;
    u_offset = 1 + u_dim1;
    u -= u_offset;
    vt_dim1 = *ldvt;
    vt_offset = 1 + vt_dim1;
    vt -= vt_offset;
    --iwork;
    --work;

    *info = 0;

    if (*n < 0) {
	*info = -1;
    } else if (*sqre < 0 || *sqre > 1) {
	*info = -2;
    }

    m = *n + *sqre;

    if (*ldu < *n) {
	*info = -6;
    } else if (*ldvt < m) {
	*info = -8;
    } else if (*smlsiz < 3) {
	*info = -9;
    }
    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DLASD0", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


    if (*n <= *smlsiz) {
	if (dlasdq_(interp, "U", sqre, n, &m, n, &dlasd0_c__0, &d__[1], &e[1], &vt[vt_offset], 		ldvt, &u[u_offset], ldu, &u[u_offset], ldu, &work[1], info)!=TCL_OK) { return TCL_ERROR; }


return TCL_OK;
    }


    inode = 1;
    ndiml = inode + *n;
    ndimr = ndiml + *n;
    idxq = ndimr + *n;
    iwk = idxq + *n;
    if (dlasdt_(interp, n, &nlvl, &nd, &iwork[inode], &iwork[ndiml], &iwork[ndimr], 	    smlsiz)!=TCL_OK) { return TCL_ERROR; }




    ndb1 = (nd + 1) / 2;
    ncc = 0;
    i__1 = nd;
    for (i__ = ndb1; i__ <= i__1; ++i__) {


	i1 = i__ - 1;
	ic = iwork[inode + i1];
	nl = iwork[ndiml + i1];
	nlp1 = nl + 1;
	nr = iwork[ndimr + i1];
	nrp1 = nr + 1;
	nlf = ic - nl;
	nrf = ic + 1;
	sqrei = 1;
	if (dlasdq_(interp, "U", &sqrei, &nl, &nlp1, &nl, &ncc, &d__[nlf], &e[nlf], &vt[		nlf + nlf * vt_dim1], ldvt, &u[nlf + nlf * u_dim1], ldu, &u[
		nlf + nlf * u_dim1], ldu, &work[1], info)!=TCL_OK) { return TCL_ERROR; }


	if (*info != 0) {
return TCL_OK;
	}
	itemp = idxq + nlf - 2;
	i__2 = nl;
	for (j = 1; j <= i__2; ++j) {
	    iwork[itemp + j] = j;
	}
	if (i__ == nd) {
	    sqrei = *sqre;
	} else {
	    sqrei = 1;
	}
	nrp1 = nr + sqrei;
	if (dlasdq_(interp, "U", &sqrei, &nr, &nrp1, &nr, &ncc, &d__[nrf], &e[nrf], &vt[		nrf + nrf * vt_dim1], ldvt, &u[nrf + nrf * u_dim1], ldu, &u[
		nrf + nrf * u_dim1], ldu, &work[1], info)!=TCL_OK) { return TCL_ERROR; }


	if (*info != 0) {
return TCL_OK;
	}
	itemp = idxq + ic;
	i__2 = nr;
	for (j = 1; j <= i__2; ++j) {
	    iwork[itemp + j - 1] = j;
	}
    }


    for (lvl = nlvl; lvl >= 1; --lvl) {


	if (lvl == 1) {
	    lf = 1;
	    ll = 1;
	} else {
	    i__1 = lvl - 1;
	    lf = pow_ii(&dlasd0_c__2, &i__1);
	    ll = (lf << 1) - 1;
	}
	i__1 = ll;
	for (i__ = lf; i__ <= i__1; ++i__) {
	    im1 = i__ - 1;
	    ic = iwork[inode + im1];
	    nl = iwork[ndiml + im1];
	    nr = iwork[ndimr + im1];
	    nlf = ic - nl;
	    if (*sqre == 0 && i__ == ll) {
		sqrei = *sqre;
	    } else {
		sqrei = 1;
	    }
	    idxqc = idxq + nlf - 1;
	    alpha = d__[ic];
	    beta = e[ic];
	    if (dlasd1_(interp, &nl, &nr, &sqrei, &d__[nlf], &alpha, &beta, &u[nlf + nlf *		     u_dim1], ldu, &vt[nlf + nlf * vt_dim1], ldvt, &iwork[
		    idxqc], &iwork[iwk], &work[1], info)!=TCL_OK) { return TCL_ERROR; }


	    if (*info != 0) {
return TCL_OK;
	    }
	}
    }

return TCL_OK;


} /* dlasd0_ */
static /* Subroutine */ int dlasda_ (Tcl_Interp *interp, integer *icompq, integer *smlsiz, integer *n, 	integer *sqre, doublereal *d__, doublereal *e, doublereal *u, integer 	*ldu, doublereal *vt, integer *k, doublereal *difl, doublereal *difr, 	doublereal *z__, doublereal *poles, integer *givptr, integer *givcol, 	integer *ldgcol, integer *perm, doublereal *givnum, doublereal *c__, 	doublereal *s, doublereal *work, integer *iwork, integer *info)
{
    integer givcol_dim1, givcol_offset, perm_dim1, perm_offset, difl_dim1, 
	    difl_offset, difr_dim1, difr_offset, givnum_dim1, givnum_offset, 
	    poles_dim1, poles_offset, u_dim1, u_offset, vt_dim1, vt_offset, 
	    z_dim1, z_offset, i__1, i__2;

    integer pow_ii(integer *, integer *);

    integer i__, j, m, i1, ic, lf, nd, ll, nl, vf, nr, vl, im1, ncc, nlf, nrf,
	     vfi, iwk, vli, lvl, nru, ndb1, nlp1, lvl2, nrp1;
    doublereal beta;
    integer idxq, nlvl;
    doublereal alpha;
    integer inode, ndiml, ndimr, idxqi, itemp;
    integer sqrei;
    integer nwork1, nwork2;
    integer smlszp;





































    --d__;
    --e;
    givnum_dim1 = *ldu;
    givnum_offset = 1 + givnum_dim1;
    givnum -= givnum_offset;
    poles_dim1 = *ldu;
    poles_offset = 1 + poles_dim1;
    poles -= poles_offset;
    z_dim1 = *ldu;
    z_offset = 1 + z_dim1;
    z__ -= z_offset;
    difr_dim1 = *ldu;
    difr_offset = 1 + difr_dim1;
    difr -= difr_offset;
    difl_dim1 = *ldu;
    difl_offset = 1 + difl_dim1;
    difl -= difl_offset;
    vt_dim1 = *ldu;
    vt_offset = 1 + vt_dim1;
    vt -= vt_offset;
    u_dim1 = *ldu;
    u_offset = 1 + u_dim1;
    u -= u_offset;
    --k;
    --givptr;
    perm_dim1 = *ldgcol;
    perm_offset = 1 + perm_dim1;
    perm -= perm_offset;
    givcol_dim1 = *ldgcol;
    givcol_offset = 1 + givcol_dim1;
    givcol -= givcol_offset;
    --c__;
    --s;
    --work;
    --iwork;

    *info = 0;

    if (*icompq < 0 || *icompq > 1) {
	*info = -1;
    } else if (*smlsiz < 3) {
	*info = -2;
    } else if (*n < 0) {
	*info = -3;
    } else if (*sqre < 0 || *sqre > 1) {
	*info = -4;
    } else if (*ldu < *n + *sqre) {
	*info = -8;
    } else if (*ldgcol < *n) {
	*info = -17;
    }
    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DLASDA", &i__1);
return TCL_ERROR;

return TCL_OK;
    }

    m = *n + *sqre;


    if (*n <= *smlsiz) {
	if (*icompq == 0) {
	    if (dlasdq_(interp, "U", sqre, n, &dlasda_c__0, &dlasda_c__0, &dlasda_c__0, &d__[1], &e[1], &vt[		    vt_offset], ldu, &u[u_offset], ldu, &u[u_offset], ldu, &
		    work[1], info)!=TCL_OK) { return TCL_ERROR; }


	} else {
	    if (dlasdq_(interp, "U", sqre, n, &m, n, &dlasda_c__0, &d__[1], &e[1], &vt[vt_offset], ldu, &u[u_offset], ldu, &u[u_offset], ldu, &work[1], 
		    info)!=TCL_OK) { return TCL_ERROR; }


	}
return TCL_OK;
    }


    inode = 1;
    ndiml = inode + *n;
    ndimr = ndiml + *n;
    idxq = ndimr + *n;
    iwk = idxq + *n;

    ncc = 0;
    nru = 0;

    smlszp = *smlsiz + 1;
    vf = 1;
    vl = vf + m;
    nwork1 = vl + m;
    nwork2 = nwork1 + smlszp * smlszp;

    if (dlasdt_(interp, n, &nlvl, &nd, &iwork[inode], &iwork[ndiml], &iwork[ndimr], 	    smlsiz)!=TCL_OK) { return TCL_ERROR; }




    ndb1 = (nd + 1) / 2;
    i__1 = nd;
    for (i__ = ndb1; i__ <= i__1; ++i__) {


	i1 = i__ - 1;
	ic = iwork[inode + i1];
	nl = iwork[ndiml + i1];
	nlp1 = nl + 1;
	nr = iwork[ndimr + i1];
	nlf = ic - nl;
	nrf = ic + 1;
	idxqi = idxq + nlf - 2;
	vfi = vf + nlf - 1;
	vli = vl + nlf - 1;
	sqrei = 1;
	if (*icompq == 0) {
	    if (dlaset_(interp, "A", &nlp1, &nlp1, &dlasda_c_b11, &dlasda_c_b12, &work[nwork1], &smlszp)!=TCL_OK) { return TCL_ERROR; }

	    if (dlasdq_(interp, "U", &sqrei, &nl, &nlp1, &nru, &ncc, &d__[nlf], &e[nlf], &		    work[nwork1], &smlszp, &work[nwork2], &nl, &work[nwork2], 
		    &nl, &work[nwork2], info)!=TCL_OK) { return TCL_ERROR; }


	    itemp = nwork1 + nl * smlszp;
	    if (dcopy_(interp, &nlp1, &work[nwork1], &dlasda_c__1, &work[vfi], &dlasda_c__1)!=TCL_OK) { return TCL_ERROR; }

	    if (dcopy_(interp, &nlp1, &work[itemp], &dlasda_c__1, &work[vli], &dlasda_c__1)!=TCL_OK) { return TCL_ERROR; }

	} else {
	    if (dlaset_(interp, "A", &nl, &nl, &dlasda_c_b11, &dlasda_c_b12, &u[nlf + u_dim1], ldu)!=TCL_OK) { return TCL_ERROR; }

	    if (dlaset_(interp, "A", &nlp1, &nlp1, &dlasda_c_b11, &dlasda_c_b12, &vt[nlf + vt_dim1], 		    ldu)!=TCL_OK) { return TCL_ERROR; }


	    if (dlasdq_(interp, "U", &sqrei, &nl, &nlp1, &nl, &ncc, &d__[nlf], &e[nlf], &		    vt[nlf + vt_dim1], ldu, &u[nlf + u_dim1], ldu, &u[nlf + 
		    u_dim1], ldu, &work[nwork1], info)!=TCL_OK) { return TCL_ERROR; }


	    if (dcopy_(interp, &nlp1, &vt[nlf + vt_dim1], &dlasda_c__1, &work[vfi], &dlasda_c__1)!=TCL_OK) { return TCL_ERROR; }

	    if (dcopy_(interp, &nlp1, &vt[nlf + nlp1 * vt_dim1], &dlasda_c__1, &work[vli], &dlasda_c__1)		    !=TCL_OK) { return TCL_ERROR; }


	}
	if (*info != 0) {
return TCL_OK;
	}
	i__2 = nl;
	for (j = 1; j <= i__2; ++j) {
	    iwork[idxqi + j] = j;
	}
	if (i__ == nd && *sqre == 0) {
	    sqrei = 0;
	} else {
	    sqrei = 1;
	}
	idxqi += nlp1;
	vfi += nlp1;
	vli += nlp1;
	nrp1 = nr + sqrei;
	if (*icompq == 0) {
	    if (dlaset_(interp, "A", &nrp1, &nrp1, &dlasda_c_b11, &dlasda_c_b12, &work[nwork1], &smlszp)!=TCL_OK) { return TCL_ERROR; }

	    if (dlasdq_(interp, "U", &sqrei, &nr, &nrp1, &nru, &ncc, &d__[nrf], &e[nrf], &		    work[nwork1], &smlszp, &work[nwork2], &nr, &work[nwork2], 
		    &nr, &work[nwork2], info)!=TCL_OK) { return TCL_ERROR; }


	    itemp = nwork1 + (nrp1 - 1) * smlszp;
	    if (dcopy_(interp, &nrp1, &work[nwork1], &dlasda_c__1, &work[vfi], &dlasda_c__1)!=TCL_OK) { return TCL_ERROR; }

	    if (dcopy_(interp, &nrp1, &work[itemp], &dlasda_c__1, &work[vli], &dlasda_c__1)!=TCL_OK) { return TCL_ERROR; }

	} else {
	    if (dlaset_(interp, "A", &nr, &nr, &dlasda_c_b11, &dlasda_c_b12, &u[nrf + u_dim1], ldu)!=TCL_OK) { return TCL_ERROR; }

	    if (dlaset_(interp, "A", &nrp1, &nrp1, &dlasda_c_b11, &dlasda_c_b12, &vt[nrf + vt_dim1], 		    ldu)!=TCL_OK) { return TCL_ERROR; }


	    if (dlasdq_(interp, "U", &sqrei, &nr, &nrp1, &nr, &ncc, &d__[nrf], &e[nrf], &		    vt[nrf + vt_dim1], ldu, &u[nrf + u_dim1], ldu, &u[nrf + 
		    u_dim1], ldu, &work[nwork1], info)!=TCL_OK) { return TCL_ERROR; }


	    if (dcopy_(interp, &nrp1, &vt[nrf + vt_dim1], &dlasda_c__1, &work[vfi], &dlasda_c__1)!=TCL_OK) { return TCL_ERROR; }

	    if (dcopy_(interp, &nrp1, &vt[nrf + nrp1 * vt_dim1], &dlasda_c__1, &work[vli], &dlasda_c__1)		    !=TCL_OK) { return TCL_ERROR; }


	}
	if (*info != 0) {
return TCL_OK;
	}
	i__2 = nr;
	for (j = 1; j <= i__2; ++j) {
	    iwork[idxqi + j] = j;
	}
    }


    j = pow_ii(&dlasda_c__2, &nlvl);
    for (lvl = nlvl; lvl >= 1; --lvl) {
	lvl2 = (lvl << 1) - 1;


	if (lvl == 1) {
	    lf = 1;
	    ll = 1;
	} else {
	    i__1 = lvl - 1;
	    lf = pow_ii(&dlasda_c__2, &i__1);
	    ll = (lf << 1) - 1;
	}
	i__1 = ll;
	for (i__ = lf; i__ <= i__1; ++i__) {
	    im1 = i__ - 1;
	    ic = iwork[inode + im1];
	    nl = iwork[ndiml + im1];
	    nr = iwork[ndimr + im1];
	    nlf = ic - nl;
	    nrf = ic + 1;
	    if (i__ == ll) {
		sqrei = *sqre;
	    } else {
		sqrei = 1;
	    }
	    vfi = vf + nlf - 1;
	    vli = vl + nlf - 1;
	    idxqi = idxq + nlf - 1;
	    alpha = d__[ic];
	    beta = e[ic];
	    if (*icompq == 0) {
		if (dlasd6_(interp, icompq, &nl, &nr, &sqrei, &d__[nlf], &work[vfi], &			work[vli], &alpha, &beta, &iwork[idxqi], &perm[
			perm_offset], &givptr[1], &givcol[givcol_offset], 
			ldgcol, &givnum[givnum_offset], ldu, &poles[
			poles_offset], &difl[difl_offset], &difr[difr_offset], 
			 &z__[z_offset], &k[1], &c__[1], &s[1], &work[nwork1], 
			 &iwork[iwk], info)!=TCL_OK) { return TCL_ERROR; }


	    } else {
		--j;
		if (dlasd6_(interp, icompq, &nl, &nr, &sqrei, &d__[nlf], &work[vfi], &			work[vli], &alpha, &beta, &iwork[idxqi], &perm[nlf + 
			lvl * perm_dim1], &givptr[j], &givcol[nlf + lvl2 * 
			givcol_dim1], ldgcol, &givnum[nlf + lvl2 * 
			givnum_dim1], ldu, &poles[nlf + lvl2 * poles_dim1], &
			difl[nlf + lvl * difl_dim1], &difr[nlf + lvl2 * 
			difr_dim1], &z__[nlf + lvl * z_dim1], &k[j], &c__[j], 
			&s[j], &work[nwork1], &iwork[iwk], info)!=TCL_OK) { return TCL_ERROR; }


	    }
	    if (*info != 0) {
return TCL_OK;
	    }
	}
    }

return TCL_OK;


} /* dlasda_ */
static /* Subroutine */ int dlasdq_ (Tcl_Interp *interp, char *uplo, integer *sqre, integer *n, integer *	ncvt, integer *nru, integer *ncc, doublereal *d__, doublereal *e, 	doublereal *vt, integer *ldvt, doublereal *u, integer *ldu, 	doublereal *c__, integer *ldc, doublereal *work, integer *info)
{
    integer c_dim1, c_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__1, 
	    i__2;

    integer i__, j;
    doublereal r__, cs, sn;
    integer np1, isub;
    doublereal smin;
    integer sqre1;
    integer iuplo;
    logical rotate;































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

    *info = 0;
    iuplo = 0;
    if (lsame_(uplo, "U")) {
	iuplo = 1;
    }
    if (lsame_(uplo, "L")) {
	iuplo = 2;
    }
    if (iuplo == 0) {
	*info = -1;
    } else if (*sqre < 0 || *sqre > 1) {
	*info = -2;
    } else if (*n < 0) {
	*info = -3;
    } else if (*ncvt < 0) {
	*info = -4;
    } else if (*nru < 0) {
	*info = -5;
    } else if (*ncc < 0) {
	*info = -6;
    } else if (*ncvt == 0 && *ldvt < 1 || *ncvt > 0 && *ldvt < max(1,*n)) {
	*info = -10;
    } else if (*ldu < max(1,*nru)) {
	*info = -12;
    } else if (*ncc == 0 && *ldc < 1 || *ncc > 0 && *ldc < max(1,*n)) {
	*info = -14;
    }
    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DLASDQ", &i__1);
return TCL_ERROR;

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


    rotate = *ncvt > 0 || *nru > 0 || *ncc > 0;
    np1 = *n + 1;
    sqre1 = *sqre;


    if (iuplo == 1 && sqre1 == 1) {
	i__1 = *n - 1;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    if (dlartg_(interp, &d__[i__], &e[i__], &cs, &sn, &r__)!=TCL_OK) { return TCL_ERROR; }

	    d__[i__] = r__;
	    e[i__] = sn * d__[i__ + 1];
	    d__[i__ + 1] = cs * d__[i__ + 1];
	    if (rotate) {
		work[i__] = cs;
		work[*n + i__] = sn;
	    }
	}
	if (dlartg_(interp, &d__[*n], &e[*n], &cs, &sn, &r__)!=TCL_OK) { return TCL_ERROR; }

	d__[*n] = r__;
	e[*n] = 0.;
	if (rotate) {
	    work[*n] = cs;
	    work[*n + *n] = sn;
	}
	iuplo = 2;
	sqre1 = 0;


	if (*ncvt > 0) {
	    if (dlasr_(interp, "L", "V", "F", &np1, ncvt, &work[1], &work[np1], &vt[		    vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }


	}
    }


    if (iuplo == 2) {
	i__1 = *n - 1;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    if (dlartg_(interp, &d__[i__], &e[i__], &cs, &sn, &r__)!=TCL_OK) { return TCL_ERROR; }

	    d__[i__] = r__;
	    e[i__] = sn * d__[i__ + 1];
	    d__[i__ + 1] = cs * d__[i__ + 1];
	    if (rotate) {
		work[i__] = cs;
		work[*n + i__] = sn;
	    }
	}


	if (sqre1 == 1) {
	    if (dlartg_(interp, &d__[*n], &e[*n], &cs, &sn, &r__)!=TCL_OK) { return TCL_ERROR; }

	    d__[*n] = r__;
	    if (rotate) {
		work[*n] = cs;
		work[*n + *n] = sn;
	    }
	}


	if (*nru > 0) {
	    if (sqre1 == 0) {
		if (dlasr_(interp, "R", "V", "F", nru, n, &work[1], &work[np1], &u[			u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }


	    } else {
		if (dlasr_(interp, "R", "V", "F", nru, &np1, &work[1], &work[np1], &u[			u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }


	    }
	}
	if (*ncc > 0) {
	    if (sqre1 == 0) {
		if (dlasr_(interp, "L", "V", "F", n, ncc, &work[1], &work[np1], &c__[			c_offset], ldc)!=TCL_OK) { return TCL_ERROR; }


	    } else {
		if (dlasr_(interp, "L", "V", "F", &np1, ncc, &work[1], &work[np1], &c__[			c_offset], ldc)!=TCL_OK) { return TCL_ERROR; }


	    }
	}
    }


    if (dbdsqr_(interp, "U", n, ncvt, nru, ncc, &d__[1], &e[1], &vt[vt_offset], ldvt, &u[	    u_offset], ldu, &c__[c_offset], ldc, &work[1], info)!=TCL_OK) { return TCL_ERROR; }




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


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


	    d__[isub] = d__[i__];
	    d__[i__] = smin;
	    if (*ncvt > 0) {
		if (dswap_(interp, ncvt, &vt[isub + vt_dim1], ldvt, &vt[i__ + vt_dim1], 			ldvt)!=TCL_OK) { return TCL_ERROR; }


	    }
	    if (*nru > 0) {
		if (dswap_(interp, nru, &u[isub * u_dim1 + 1], &dlasdq_c__1, &u[i__ * u_dim1 + 1], &dlasdq_c__1)!=TCL_OK) { return TCL_ERROR; }


	    }
	    if (*ncc > 0) {
		if (dswap_(interp, ncc, &c__[isub + c_dim1], ldc, &c__[i__ + c_dim1], ldc)			!=TCL_OK) { return TCL_ERROR; }


	    }
	}
    }

return TCL_OK;


} /* dlasdq_ */
static doublereal dlanst_ (char *norm, integer *n, doublereal *d__, doublereal *e)
{
    integer i__1;
    doublereal ret_val, d__1, d__2, d__3, d__4, d__5;

    double sqrt(doublereal);

    integer i__;
    doublereal sum, scale;
    doublereal anorm;

















    --e;
    --d__;

    if (*n <= 0) {
	anorm = 0.;
    } else if (lsame_(norm, "M")) {


	anorm = (d__1 = d__[*n], abs(d__1));
	i__1 = *n - 1;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    d__2 = anorm, d__3 = (d__1 = d__[i__], abs(d__1));
	    anorm = max(d__2,d__3);
	    d__2 = anorm, d__3 = (d__1 = e[i__], abs(d__1));
	    anorm = max(d__2,d__3);
	}
    } else if (lsame_(norm, "O") || *(unsigned char *)
	    norm == '1' || lsame_(norm, "I")) {


	if (*n == 1) {
	    anorm = abs(d__[1]);
	} else {
	    d__3 = abs(d__[1]) + abs(e[1]), d__4 = (d__1 = e[*n - 1], abs(
		    d__1)) + (d__2 = d__[*n], abs(d__2));
	    anorm = max(d__3,d__4);
	    i__1 = *n - 1;
	    for (i__ = 2; i__ <= i__1; ++i__) {
		d__4 = anorm, d__5 = (d__1 = d__[i__], abs(d__1)) + (d__2 = e[
			i__], abs(d__2)) + (d__3 = e[i__ - 1], abs(d__3));
		anorm = max(d__4,d__5);
	    }
	}
    } else if (lsame_(norm, "F") || lsame_(norm, "E")) {


	scale = 0.;
	sum = 1.;
	if (*n > 1) {
	    i__1 = *n - 1;
	    dlassq_(NULL, &i__1, &e[1], &dlanst_c__1, &scale, &sum);
	    sum *= 2;
	}
	dlassq_(NULL, n, &d__[1], &dlanst_c__1, &scale, &sum);
	anorm = scale * sqrt(sum);
    }

    ret_val = anorm;
    return ret_val;


} /* dlanst_ */
static /* Subroutine */ int dgebd2_ (Tcl_Interp *interp, integer *m, integer *n, doublereal *a, integer *	lda, doublereal *d__, doublereal *e, doublereal *tauq, doublereal *	taup, doublereal *work, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3;

    integer i__;





































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

    *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);
	vectcl_xerbla(interp, "DGEBD2", &i__1);
return TCL_ERROR;

return TCL_OK;
    }

    if (*m >= *n) {


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


	    i__2 = *m - i__ + 1;
	    i__3 = i__ + 1;
	    if (dlarfg_(interp, &i__2, &a[i__ + i__ * a_dim1], &a[min(i__3, *m)+ i__ * 		    a_dim1], &dgebd2_c__1, &tauq[i__])!=TCL_OK) { return TCL_ERROR; }


	    d__[i__] = a[i__ + i__ * a_dim1];
	    a[i__ + i__ * a_dim1] = 1.;


	    if (i__ < *n) {
		i__2 = *m - i__ + 1;
		i__3 = *n - i__;
		if (dlarf_(interp, "Left", &i__2, &i__3, &a[i__ + i__ * a_dim1], &dgebd2_c__1, &			tauq[i__], &a[i__ + (i__ + 1) * a_dim1], lda, &work[1]
)!=TCL_OK) { return TCL_ERROR; }


	    }
	    a[i__ + i__ * a_dim1] = d__[i__];

	    if (i__ < *n) {


		i__2 = *n - i__;
		i__3 = i__ + 2;
		if (dlarfg_(interp, &i__2, &a[i__ + (i__ + 1) * a_dim1], &a[i__ + min(			i__3, *n)* a_dim1], lda, &taup[i__])!=TCL_OK) { return TCL_ERROR; }


		e[i__] = a[i__ + (i__ + 1) * a_dim1];
		a[i__ + (i__ + 1) * a_dim1] = 1.;


		i__2 = *m - i__;
		i__3 = *n - i__;
		if (dlarf_(interp, "Right", &i__2, &i__3, &a[i__ + (i__ + 1) * a_dim1], 			lda, &taup[i__], &a[i__ + 1 + (i__ + 1) * a_dim1], 
			lda, &work[1])!=TCL_OK) { return TCL_ERROR; }


		a[i__ + (i__ + 1) * a_dim1] = e[i__];
	    } else {
		taup[i__] = 0.;
	    }
	}
    } else {


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


	    i__2 = *n - i__ + 1;
	    i__3 = i__ + 1;
	    if (dlarfg_(interp, &i__2, &a[i__ + i__ * a_dim1], &a[i__ + min(i__3, *n)* 		    a_dim1], lda, &taup[i__])!=TCL_OK) { return TCL_ERROR; }


	    d__[i__] = a[i__ + i__ * a_dim1];
	    a[i__ + i__ * a_dim1] = 1.;


	    if (i__ < *m) {
		i__2 = *m - i__;
		i__3 = *n - i__ + 1;
		if (dlarf_(interp, "Right", &i__2, &i__3, &a[i__ + i__ * a_dim1], lda, &			taup[i__], &a[i__ + 1 + i__ * a_dim1], lda, &work[1])!=TCL_OK) { return TCL_ERROR; }


	    }
	    a[i__ + i__ * a_dim1] = d__[i__];

	    if (i__ < *m) {


		i__2 = *m - i__;
		i__3 = i__ + 2;
		if (dlarfg_(interp, &i__2, &a[i__ + 1 + i__ * a_dim1], &a[min(i__3, *m)+ 			i__ * a_dim1], &dgebd2_c__1, &tauq[i__])!=TCL_OK) { return TCL_ERROR; }


		e[i__] = a[i__ + 1 + i__ * a_dim1];
		a[i__ + 1 + i__ * a_dim1] = 1.;


		i__2 = *m - i__;
		i__3 = *n - i__;
		if (dlarf_(interp, "Left", &i__2, &i__3, &a[i__ + 1 + i__ * a_dim1], &			dgebd2_c__1, &tauq[i__], &a[i__ + 1 + (i__ + 1) * a_dim1], 
			lda, &work[1])!=TCL_OK) { return TCL_ERROR; }


		a[i__ + 1 + i__ * a_dim1] = e[i__];
	    } else {
		tauq[i__] = 0.;
	    }
	}
    }
return TCL_OK;


} /* dgebd2_ */
static /* Subroutine */ int dlabrd_ (Tcl_Interp *interp, integer *m, integer *n, integer *nb, doublereal *	a, integer *lda, doublereal *d__, doublereal *e, doublereal *tauq, 	doublereal *taup, doublereal *x, integer *ldx, doublereal *y, integer 	*ldy)
{
    integer a_dim1, a_offset, x_dim1, x_offset, y_dim1, y_offset, i__1, i__2, 
	    i__3;

    integer i__;






































    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --d__;
    --e;
    --tauq;
    --taup;
    x_dim1 = *ldx;
    x_offset = 1 + x_dim1;
    x -= x_offset;
    y_dim1 = *ldy;
    y_offset = 1 + y_dim1;
    y -= y_offset;

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

    if (*m >= *n) {


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


	    i__2 = *m - i__ + 1;
	    i__3 = i__ - 1;
	    if (dgemv_(interp, "No transpose", &i__2, &i__3, &dlabrd_c_b4, &a[i__ + a_dim1], lda, 		     &y[i__ + y_dim1], ldy, &dlabrd_c_b5, &a[i__ + i__ * a_dim1], &
		    dlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


	    i__2 = *m - i__ + 1;
	    i__3 = i__ - 1;
	    if (dgemv_(interp, "No transpose", &i__2, &i__3, &dlabrd_c_b4, &x[i__ + x_dim1], ldx, 		     &a[i__ * a_dim1 + 1], &dlabrd_c__1, &dlabrd_c_b5, &a[i__ + i__ * 
		    a_dim1], &dlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }




	    i__2 = *m - i__ + 1;
	    i__3 = i__ + 1;
	    if (dlarfg_(interp, &i__2, &a[i__ + i__ * a_dim1], &a[min(i__3, *m)+ i__ * 		    a_dim1], &dlabrd_c__1, &tauq[i__])!=TCL_OK) { return TCL_ERROR; }


	    d__[i__] = a[i__ + i__ * a_dim1];
	    if (i__ < *n) {
		a[i__ + i__ * a_dim1] = 1.;


		i__2 = *m - i__ + 1;
		i__3 = *n - i__;
		if (dgemv_(interp, "Transpose", &i__2, &i__3, &dlabrd_c_b5, &a[i__ + (i__ + 1) * 			a_dim1], lda, &a[i__ + i__ * a_dim1], &dlabrd_c__1, &dlabrd_c_b16, &
			y[i__ + 1 + i__ * y_dim1], &dlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *m - i__ + 1;
		i__3 = i__ - 1;
		if (dgemv_(interp, "Transpose", &i__2, &i__3, &dlabrd_c_b5, &a[i__ + a_dim1], 			lda, &a[i__ + i__ * a_dim1], &dlabrd_c__1, &dlabrd_c_b16, &y[i__ * 
			y_dim1 + 1], &dlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *n - i__;
		i__3 = i__ - 1;
		if (dgemv_(interp, "No transpose", &i__2, &i__3, &dlabrd_c_b4, &y[i__ + 1 + 			y_dim1], ldy, &y[i__ * y_dim1 + 1], &dlabrd_c__1, &dlabrd_c_b5, &y[
			i__ + 1 + i__ * y_dim1], &dlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *m - i__ + 1;
		i__3 = i__ - 1;
		if (dgemv_(interp, "Transpose", &i__2, &i__3, &dlabrd_c_b5, &x[i__ + x_dim1], 			ldx, &a[i__ + i__ * a_dim1], &dlabrd_c__1, &dlabrd_c_b16, &y[i__ * 
			y_dim1 + 1], &dlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = i__ - 1;
		i__3 = *n - i__;
		if (dgemv_(interp, "Transpose", &i__2, &i__3, &dlabrd_c_b4, &a[(i__ + 1) * 			a_dim1 + 1], lda, &y[i__ * y_dim1 + 1], &dlabrd_c__1, &dlabrd_c_b5, 
			&y[i__ + 1 + i__ * y_dim1], &dlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *n - i__;
		if (dscal_(interp, &i__2, &tauq[i__], &y[i__ + 1 + i__ * y_dim1], &dlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }



		i__2 = *n - i__;
		if (dgemv_(interp, "No transpose", &i__2, &i__, &dlabrd_c_b4, &y[i__ + 1 + 			y_dim1], ldy, &a[i__ + a_dim1], lda, &dlabrd_c_b5, &a[i__ + (
			i__ + 1) * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }


		i__2 = i__ - 1;
		i__3 = *n - i__;
		if (dgemv_(interp, "Transpose", &i__2, &i__3, &dlabrd_c_b4, &a[(i__ + 1) * 			a_dim1 + 1], lda, &x[i__ + x_dim1], ldx, &dlabrd_c_b5, &a[
			i__ + (i__ + 1) * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }




		i__2 = *n - i__;
		i__3 = i__ + 2;
		if (dlarfg_(interp, &i__2, &a[i__ + (i__ + 1) * a_dim1], &a[i__ + min(			i__3, *n)* a_dim1], lda, &taup[i__])!=TCL_OK) { return TCL_ERROR; }


		e[i__] = a[i__ + (i__ + 1) * a_dim1];
		a[i__ + (i__ + 1) * a_dim1] = 1.;


		i__2 = *m - i__;
		i__3 = *n - i__;
		if (dgemv_(interp, "No transpose", &i__2, &i__3, &dlabrd_c_b5, &a[i__ + 1 + (i__ 			+ 1) * a_dim1], lda, &a[i__ + (i__ + 1) * a_dim1], 
			lda, &dlabrd_c_b16, &x[i__ + 1 + i__ * x_dim1], &dlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *n - i__;
		if (dgemv_(interp, "Transpose", &i__2, &i__, &dlabrd_c_b5, &y[i__ + 1 + y_dim1], 			ldy, &a[i__ + (i__ + 1) * a_dim1], lda, &dlabrd_c_b16, &x[
			i__ * x_dim1 + 1], &dlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *m - i__;
		if (dgemv_(interp, "No transpose", &i__2, &i__, &dlabrd_c_b4, &a[i__ + 1 + 			a_dim1], lda, &x[i__ * x_dim1 + 1], &dlabrd_c__1, &dlabrd_c_b5, &x[
			i__ + 1 + i__ * x_dim1], &dlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = i__ - 1;
		i__3 = *n - i__;
		if (dgemv_(interp, "No transpose", &i__2, &i__3, &dlabrd_c_b5, &a[(i__ + 1) * 			a_dim1 + 1], lda, &a[i__ + (i__ + 1) * a_dim1], lda, &
			dlabrd_c_b16, &x[i__ * x_dim1 + 1], &dlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *m - i__;
		i__3 = i__ - 1;
		if (dgemv_(interp, "No transpose", &i__2, &i__3, &dlabrd_c_b4, &x[i__ + 1 + 			x_dim1], ldx, &x[i__ * x_dim1 + 1], &dlabrd_c__1, &dlabrd_c_b5, &x[
			i__ + 1 + i__ * x_dim1], &dlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *m - i__;
		if (dscal_(interp, &i__2, &taup[i__], &x[i__ + 1 + i__ * x_dim1], &dlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }

	    }
	}
    } else {


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


	    i__2 = *n - i__ + 1;
	    i__3 = i__ - 1;
	    if (dgemv_(interp, "No transpose", &i__2, &i__3, &dlabrd_c_b4, &y[i__ + y_dim1], ldy, 		     &a[i__ + a_dim1], lda, &dlabrd_c_b5, &a[i__ + i__ * a_dim1], 
		    lda)!=TCL_OK) { return TCL_ERROR; }


	    i__2 = i__ - 1;
	    i__3 = *n - i__ + 1;
	    if (dgemv_(interp, "Transpose", &i__2, &i__3, &dlabrd_c_b4, &a[i__ * a_dim1 + 1], 		    lda, &x[i__ + x_dim1], ldx, &dlabrd_c_b5, &a[i__ + i__ * a_dim1], 
		     lda)!=TCL_OK) { return TCL_ERROR; }




	    i__2 = *n - i__ + 1;
	    i__3 = i__ + 1;
	    if (dlarfg_(interp, &i__2, &a[i__ + i__ * a_dim1], &a[i__ + min(i__3, *n)* 		    a_dim1], lda, &taup[i__])!=TCL_OK) { return TCL_ERROR; }


	    d__[i__] = a[i__ + i__ * a_dim1];
	    if (i__ < *m) {
		a[i__ + i__ * a_dim1] = 1.;


		i__2 = *m - i__;
		i__3 = *n - i__ + 1;
		if (dgemv_(interp, "No transpose", &i__2, &i__3, &dlabrd_c_b5, &a[i__ + 1 + i__ *			 a_dim1], lda, &a[i__ + i__ * a_dim1], lda, &dlabrd_c_b16, &
			x[i__ + 1 + i__ * x_dim1], &dlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *n - i__ + 1;
		i__3 = i__ - 1;
		if (dgemv_(interp, "Transpose", &i__2, &i__3, &dlabrd_c_b5, &y[i__ + y_dim1], 			ldy, &a[i__ + i__ * a_dim1], lda, &dlabrd_c_b16, &x[i__ * 
			x_dim1 + 1], &dlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *m - i__;
		i__3 = i__ - 1;
		if (dgemv_(interp, "No transpose", &i__2, &i__3, &dlabrd_c_b4, &a[i__ + 1 + 			a_dim1], lda, &x[i__ * x_dim1 + 1], &dlabrd_c__1, &dlabrd_c_b5, &x[
			i__ + 1 + i__ * x_dim1], &dlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = i__ - 1;
		i__3 = *n - i__ + 1;
		if (dgemv_(interp, "No transpose", &i__2, &i__3, &dlabrd_c_b5, &a[i__ * a_dim1 + 			1], lda, &a[i__ + i__ * a_dim1], lda, &dlabrd_c_b16, &x[i__ *
			 x_dim1 + 1], &dlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *m - i__;
		i__3 = i__ - 1;
		if (dgemv_(interp, "No transpose", &i__2, &i__3, &dlabrd_c_b4, &x[i__ + 1 + 			x_dim1], ldx, &x[i__ * x_dim1 + 1], &dlabrd_c__1, &dlabrd_c_b5, &x[
			i__ + 1 + i__ * x_dim1], &dlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *m - i__;
		if (dscal_(interp, &i__2, &taup[i__], &x[i__ + 1 + i__ * x_dim1], &dlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }



		i__2 = *m - i__;
		i__3 = i__ - 1;
		if (dgemv_(interp, "No transpose", &i__2, &i__3, &dlabrd_c_b4, &a[i__ + 1 + 			a_dim1], lda, &y[i__ + y_dim1], ldy, &dlabrd_c_b5, &a[i__ + 
			1 + i__ * a_dim1], &dlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *m - i__;
		if (dgemv_(interp, "No transpose", &i__2, &i__, &dlabrd_c_b4, &x[i__ + 1 + 			x_dim1], ldx, &a[i__ * a_dim1 + 1], &dlabrd_c__1, &dlabrd_c_b5, &a[
			i__ + 1 + i__ * a_dim1], &dlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }




		i__2 = *m - i__;
		i__3 = i__ + 2;
		if (dlarfg_(interp, &i__2, &a[i__ + 1 + i__ * a_dim1], &a[min(i__3, *m)+ 			i__ * a_dim1], &dlabrd_c__1, &tauq[i__])!=TCL_OK) { return TCL_ERROR; }


		e[i__] = a[i__ + 1 + i__ * a_dim1];
		a[i__ + 1 + i__ * a_dim1] = 1.;


		i__2 = *m - i__;
		i__3 = *n - i__;
		if (dgemv_(interp, "Transpose", &i__2, &i__3, &dlabrd_c_b5, &a[i__ + 1 + (i__ + 			1) * a_dim1], lda, &a[i__ + 1 + i__ * a_dim1], &dlabrd_c__1, 
			&dlabrd_c_b16, &y[i__ + 1 + i__ * y_dim1], &dlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *m - i__;
		i__3 = i__ - 1;
		if (dgemv_(interp, "Transpose", &i__2, &i__3, &dlabrd_c_b5, &a[i__ + 1 + a_dim1], 			 lda, &a[i__ + 1 + i__ * a_dim1], &dlabrd_c__1, &dlabrd_c_b16, &y[
			i__ * y_dim1 + 1], &dlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *n - i__;
		i__3 = i__ - 1;
		if (dgemv_(interp, "No transpose", &i__2, &i__3, &dlabrd_c_b4, &y[i__ + 1 + 			y_dim1], ldy, &y[i__ * y_dim1 + 1], &dlabrd_c__1, &dlabrd_c_b5, &y[
			i__ + 1 + i__ * y_dim1], &dlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *m - i__;
		if (dgemv_(interp, "Transpose", &i__2, &i__, &dlabrd_c_b5, &x[i__ + 1 + x_dim1], 			ldx, &a[i__ + 1 + i__ * a_dim1], &dlabrd_c__1, &dlabrd_c_b16, &y[
			i__ * y_dim1 + 1], &dlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *n - i__;
		if (dgemv_(interp, "Transpose", &i__, &i__2, &dlabrd_c_b4, &a[(i__ + 1) * a_dim1 			+ 1], lda, &y[i__ * y_dim1 + 1], &dlabrd_c__1, &dlabrd_c_b5, &y[i__ 
			+ 1 + i__ * y_dim1], &dlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *n - i__;
		if (dscal_(interp, &i__2, &tauq[i__], &y[i__ + 1 + i__ * y_dim1], &dlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }

	    }
	}
    }
return TCL_OK;


} /* dlabrd_ */
static /* Subroutine */ int dlassq_ (Tcl_Interp *interp, integer *n, doublereal *x, integer *incx, 	doublereal *scale, doublereal *sumsq)
{
    integer i__1, i__2;
    doublereal d__1;

    integer ix;
    doublereal absxi;



















    --x;

    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], abs(d__1));
		if (*scale < absxi) {
		    d__1 = *scale / absxi;
		    *sumsq = *sumsq * (d__1 * d__1) + 1;
		    *scale = absxi;
		} else {
		    d__1 = absxi / *scale;
		    *sumsq += d__1 * d__1;
		}
	    }
	}
    }
return TCL_OK;


} /* dlassq_ */
static /* Subroutine */ int dgelq2_ (Tcl_Interp *interp, integer *m, integer *n, doublereal *a, integer *	lda, doublereal *tau, doublereal *work, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3;

    integer i__, k;
    doublereal aii;























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

    *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);
	vectcl_xerbla(interp, "DGELQ2", &i__1);
return TCL_ERROR;

return TCL_OK;
    }

    k = min(*m,*n);

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


	i__2 = *n - i__ + 1;
	i__3 = i__ + 1;
	if (dlarfp_(interp, &i__2, &a[i__ + i__ * a_dim1], &a[i__ + min(i__3, *n)* a_dim1], lda, &tau[i__])!=TCL_OK) { return TCL_ERROR; }


	if (i__ < *m) {


	    aii = a[i__ + i__ * a_dim1];
	    a[i__ + i__ * a_dim1] = 1.;
	    i__2 = *m - i__;
	    i__3 = *n - i__ + 1;
	    if (dlarf_(interp, "Right", &i__2, &i__3, &a[i__ + i__ * a_dim1], lda, &tau[		    i__], &a[i__ + 1 + i__ * a_dim1], lda, &work[1])!=TCL_OK) { return TCL_ERROR; }


	    a[i__ + i__ * a_dim1] = aii;
	}
    }
return TCL_OK;


} /* dgelq2_ */
static /* Subroutine */ int dlarfb_ (Tcl_Interp *interp, char *side, char *trans, char *direct, char *	storev, integer *m, integer *n, integer *k, doublereal *v, integer *	ldv, doublereal *t, integer *ldt, doublereal *c__, integer *ldc, 	doublereal *work, integer *ldwork)
{
    integer c_dim1, c_offset, t_dim1, t_offset, v_dim1, v_offset, work_dim1, 
	    work_offset, i__1, i__2;

    integer i__, j;
    integer lastc;
    integer lastv;
    char transt[1];

























    v_dim1 = *ldv;
    v_offset = 1 + v_dim1;
    v -= v_offset;
    t_dim1 = *ldt;
    t_offset = 1 + t_dim1;
    t -= t_offset;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;
    work_dim1 = *ldwork;
    work_offset = 1 + work_dim1;
    work -= work_offset;

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

    if (lsame_(trans, "N")) {
	*(unsigned char *)transt = 'T';
    } else {
	*(unsigned char *)transt = 'N';
    }

    if (lsame_(storev, "C")) {

	if (lsame_(direct, "F")) {


	    if (lsame_(side, "L")) {


		i__1 = *k, i__2 = iladlr_(m, k, &v[v_offset], ldv);
		lastv = max(i__1,i__2);
		lastc = iladlc_(&lastv, n, &c__[c_offset], ldc);



		i__1 = *k;
		for (j = 1; j <= i__1; ++j) {
		    if (dcopy_(interp, &lastc, &c__[j + c_dim1], ldc, &work[j * work_dim1 			    + 1], &dlarfb_c__1)!=TCL_OK) { return TCL_ERROR; }


		}


		if (dtrmm_(interp, "Right", "Lower", "No transpose", "Unit", &lastc, k, &			dlarfb_c_b14, &v[v_offset], ldv, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }


		if (lastv > *k) {


		    i__1 = lastv - *k;
		    if (dgemm_(interp, "Transpose", "No transpose", &lastc, k, &i__1, &			    dlarfb_c_b14, &c__[*k + 1 + c_dim1], ldc, &v[*k + 1 + 
			    v_dim1], ldv, &dlarfb_c_b14, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }


		}


		if (dtrmm_(interp, "Right", "Upper", transt, "Non-unit", &lastc, k, &			dlarfb_c_b14, &t[t_offset], ldt, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




		if (lastv > *k) {


		    i__1 = lastv - *k;
		    if (dgemm_(interp, "No transpose", "Transpose", &i__1, &lastc, k, &			    dlarfb_c_b25, &v[*k + 1 + v_dim1], ldv, &work[
			    work_offset], ldwork, &dlarfb_c_b14, &c__[*k + 1 + 
			    c_dim1], ldc)!=TCL_OK) { return TCL_ERROR; }


		}


		if (dtrmm_(interp, "Right", "Lower", "Transpose", "Unit", &lastc, k, &			dlarfb_c_b14, &v[v_offset], ldv, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




		i__1 = *k;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = lastc;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			c__[j + i__ * c_dim1] -= work[i__ + j * work_dim1];
		    }
		}

	    } else if (lsame_(side, "R")) {


		i__1 = *k, i__2 = iladlr_(n, k, &v[v_offset], ldv);
		lastv = max(i__1,i__2);
		lastc = iladlr_(m, &lastv, &c__[c_offset], ldc);



		i__1 = *k;
		for (j = 1; j <= i__1; ++j) {
		    if (dcopy_(interp, &lastc, &c__[j * c_dim1 + 1], &dlarfb_c__1, &work[j * 			    work_dim1 + 1], &dlarfb_c__1)!=TCL_OK) { return TCL_ERROR; }


		}


		if (dtrmm_(interp, "Right", "Lower", "No transpose", "Unit", &lastc, k, &			dlarfb_c_b14, &v[v_offset], ldv, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }


		if (lastv > *k) {


		    i__1 = lastv - *k;
		    if (dgemm_(interp, "No transpose", "No transpose", &lastc, k, &i__1, &			    dlarfb_c_b14, &c__[(*k + 1) * c_dim1 + 1], ldc, &v[*k + 
			    1 + v_dim1], ldv, &dlarfb_c_b14, &work[work_offset], 
			    ldwork)!=TCL_OK) { return TCL_ERROR; }


		}


		if (dtrmm_(interp, "Right", "Upper", trans, "Non-unit", &lastc, k, &dlarfb_c_b14, 			 &t[t_offset], ldt, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




		if (lastv > *k) {


		    i__1 = lastv - *k;
		    if (dgemm_(interp, "No transpose", "Transpose", &lastc, &i__1, k, &			    dlarfb_c_b25, &work[work_offset], ldwork, &v[*k + 1 + 
			    v_dim1], ldv, &dlarfb_c_b14, &c__[(*k + 1) * c_dim1 + 1], 
			     ldc)!=TCL_OK) { return TCL_ERROR; }


		}


		if (dtrmm_(interp, "Right", "Lower", "Transpose", "Unit", &lastc, k, &			dlarfb_c_b14, &v[v_offset], ldv, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




		i__1 = *k;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = lastc;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			c__[i__ + j * c_dim1] -= work[i__ + j * work_dim1];
		    }
		}
	    }

	} else {


	    if (lsame_(side, "L")) {


		i__1 = *k, i__2 = iladlr_(m, k, &v[v_offset], ldv);
		lastv = max(i__1,i__2);
		lastc = iladlc_(&lastv, n, &c__[c_offset], ldc);



		i__1 = *k;
		for (j = 1; j <= i__1; ++j) {
		    if (dcopy_(interp, &lastc, &c__[lastv - *k + j + c_dim1], ldc, &work[			    j * work_dim1 + 1], &dlarfb_c__1)!=TCL_OK) { return TCL_ERROR; }


		}


		if (dtrmm_(interp, "Right", "Upper", "No transpose", "Unit", &lastc, k, &			dlarfb_c_b14, &v[lastv - *k + 1 + v_dim1], ldv, &work[
			work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }


		if (lastv > *k) {


		    i__1 = lastv - *k;
		    if (dgemm_(interp, "Transpose", "No transpose", &lastc, k, &i__1, &			    dlarfb_c_b14, &c__[c_offset], ldc, &v[v_offset], ldv, &
			    dlarfb_c_b14, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }


		}


		if (dtrmm_(interp, "Right", "Lower", transt, "Non-unit", &lastc, k, &			dlarfb_c_b14, &t[t_offset], ldt, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




		if (lastv > *k) {


		    i__1 = lastv - *k;
		    if (dgemm_(interp, "No transpose", "Transpose", &i__1, &lastc, k, &			    dlarfb_c_b25, &v[v_offset], ldv, &work[work_offset], 
			    ldwork, &dlarfb_c_b14, &c__[c_offset], ldc)!=TCL_OK) { return TCL_ERROR; }


		}


		if (dtrmm_(interp, "Right", "Upper", "Transpose", "Unit", &lastc, k, &			dlarfb_c_b14, &v[lastv - *k + 1 + v_dim1], ldv, &work[
			work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




		i__1 = *k;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = lastc;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			c__[lastv - *k + j + i__ * c_dim1] -= work[i__ + j * 
				work_dim1];
		    }
		}

	    } else if (lsame_(side, "R")) {


		i__1 = *k, i__2 = iladlr_(n, k, &v[v_offset], ldv);
		lastv = max(i__1,i__2);
		lastc = iladlr_(m, &lastv, &c__[c_offset], ldc);



		i__1 = *k;
		for (j = 1; j <= i__1; ++j) {
		    if (dcopy_(interp, &lastc, &c__[(*n - *k + j) * c_dim1 + 1], &dlarfb_c__1, &			    work[j * work_dim1 + 1], &dlarfb_c__1)!=TCL_OK) { return TCL_ERROR; }


		}


		if (dtrmm_(interp, "Right", "Upper", "No transpose", "Unit", &lastc, k, &			dlarfb_c_b14, &v[lastv - *k + 1 + v_dim1], ldv, &work[
			work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }


		if (lastv > *k) {


		    i__1 = lastv - *k;
		    if (dgemm_(interp, "No transpose", "No transpose", &lastc, k, &i__1, &			    dlarfb_c_b14, &c__[c_offset], ldc, &v[v_offset], ldv, &
			    dlarfb_c_b14, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }


		}


		if (dtrmm_(interp, "Right", "Lower", trans, "Non-unit", &lastc, k, &dlarfb_c_b14, 			 &t[t_offset], ldt, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




		if (lastv > *k) {


		    i__1 = lastv - *k;
		    if (dgemm_(interp, "No transpose", "Transpose", &lastc, &i__1, k, &			    dlarfb_c_b25, &work[work_offset], ldwork, &v[v_offset], 
			    ldv, &dlarfb_c_b14, &c__[c_offset], ldc)!=TCL_OK) { return TCL_ERROR; }


		}


		if (dtrmm_(interp, "Right", "Upper", "Transpose", "Unit", &lastc, k, &			dlarfb_c_b14, &v[lastv - *k + 1 + v_dim1], ldv, &work[
			work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




		i__1 = *k;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = lastc;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			c__[i__ + (lastv - *k + j) * c_dim1] -= work[i__ + j *
				 work_dim1];
		    }
		}
	    }
	}

    } else if (lsame_(storev, "R")) {

	if (lsame_(direct, "F")) {


	    if (lsame_(side, "L")) {


		i__1 = *k, i__2 = iladlc_(k, m, &v[v_offset], ldv);
		lastv = max(i__1,i__2);
		lastc = iladlc_(&lastv, n, &c__[c_offset], ldc);



		i__1 = *k;
		for (j = 1; j <= i__1; ++j) {
		    if (dcopy_(interp, &lastc, &c__[j + c_dim1], ldc, &work[j * work_dim1 			    + 1], &dlarfb_c__1)!=TCL_OK) { return TCL_ERROR; }


		}


		if (dtrmm_(interp, "Right", "Upper", "Transpose", "Unit", &lastc, k, &			dlarfb_c_b14, &v[v_offset], ldv, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }


		if (lastv > *k) {


		    i__1 = lastv - *k;
		    if (dgemm_(interp, "Transpose", "Transpose", &lastc, k, &i__1, &dlarfb_c_b14, 			     &c__[*k + 1 + c_dim1], ldc, &v[(*k + 1) * v_dim1 
			    + 1], ldv, &dlarfb_c_b14, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }


		}


		if (dtrmm_(interp, "Right", "Upper", transt, "Non-unit", &lastc, k, &			dlarfb_c_b14, &t[t_offset], ldt, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




		if (lastv > *k) {


		    i__1 = lastv - *k;
		    if (dgemm_(interp, "Transpose", "Transpose", &i__1, &lastc, k, &dlarfb_c_b25, 			     &v[(*k + 1) * v_dim1 + 1], ldv, &work[
			    work_offset], ldwork, &dlarfb_c_b14, &c__[*k + 1 + 
			    c_dim1], ldc)!=TCL_OK) { return TCL_ERROR; }


		}


		if (dtrmm_(interp, "Right", "Upper", "No transpose", "Unit", &lastc, k, &			dlarfb_c_b14, &v[v_offset], ldv, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




		i__1 = *k;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = lastc;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			c__[j + i__ * c_dim1] -= work[i__ + j * work_dim1];
		    }
		}

	    } else if (lsame_(side, "R")) {


		i__1 = *k, i__2 = iladlc_(k, n, &v[v_offset], ldv);
		lastv = max(i__1,i__2);
		lastc = iladlr_(m, &lastv, &c__[c_offset], ldc);



		i__1 = *k;
		for (j = 1; j <= i__1; ++j) {
		    if (dcopy_(interp, &lastc, &c__[j * c_dim1 + 1], &dlarfb_c__1, &work[j * 			    work_dim1 + 1], &dlarfb_c__1)!=TCL_OK) { return TCL_ERROR; }


		}


		if (dtrmm_(interp, "Right", "Upper", "Transpose", "Unit", &lastc, k, &			dlarfb_c_b14, &v[v_offset], ldv, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }


		if (lastv > *k) {


		    i__1 = lastv - *k;
		    if (dgemm_(interp, "No transpose", "Transpose", &lastc, k, &i__1, &			    dlarfb_c_b14, &c__[(*k + 1) * c_dim1 + 1], ldc, &v[(*k + 
			    1) * v_dim1 + 1], ldv, &dlarfb_c_b14, &work[work_offset], 
			     ldwork)!=TCL_OK) { return TCL_ERROR; }


		}


		if (dtrmm_(interp, "Right", "Upper", trans, "Non-unit", &lastc, k, &dlarfb_c_b14, 			 &t[t_offset], ldt, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




		if (lastv > *k) {


		    i__1 = lastv - *k;
		    if (dgemm_(interp, "No transpose", "No transpose", &lastc, &i__1, k, &			    dlarfb_c_b25, &work[work_offset], ldwork, &v[(*k + 1) * 
			    v_dim1 + 1], ldv, &dlarfb_c_b14, &c__[(*k + 1) * c_dim1 
			    + 1], ldc)!=TCL_OK) { return TCL_ERROR; }


		}


		if (dtrmm_(interp, "Right", "Upper", "No transpose", "Unit", &lastc, k, &			dlarfb_c_b14, &v[v_offset], ldv, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




		i__1 = *k;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = lastc;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			c__[i__ + j * c_dim1] -= work[i__ + j * work_dim1];
		    }
		}

	    }

	} else {


	    if (lsame_(side, "L")) {


		i__1 = *k, i__2 = iladlc_(k, m, &v[v_offset], ldv);
		lastv = max(i__1,i__2);
		lastc = iladlc_(&lastv, n, &c__[c_offset], ldc);



		i__1 = *k;
		for (j = 1; j <= i__1; ++j) {
		    if (dcopy_(interp, &lastc, &c__[lastv - *k + j + c_dim1], ldc, &work[			    j * work_dim1 + 1], &dlarfb_c__1)!=TCL_OK) { return TCL_ERROR; }


		}


		if (dtrmm_(interp, "Right", "Lower", "Transpose", "Unit", &lastc, k, &			dlarfb_c_b14, &v[(lastv - *k + 1) * v_dim1 + 1], ldv, &work[
			work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }


		if (lastv > *k) {


		    i__1 = lastv - *k;
		    if (dgemm_(interp, "Transpose", "Transpose", &lastc, k, &i__1, &dlarfb_c_b14, 			     &c__[c_offset], ldc, &v[v_offset], ldv, &dlarfb_c_b14, &
			    work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }


		}


		if (dtrmm_(interp, "Right", "Lower", transt, "Non-unit", &lastc, k, &			dlarfb_c_b14, &t[t_offset], ldt, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




		if (lastv > *k) {


		    i__1 = lastv - *k;
		    if (dgemm_(interp, "Transpose", "Transpose", &i__1, &lastc, k, &dlarfb_c_b25, 			     &v[v_offset], ldv, &work[work_offset], ldwork, &
			    dlarfb_c_b14, &c__[c_offset], ldc)!=TCL_OK) { return TCL_ERROR; }


		}


		if (dtrmm_(interp, "Right", "Lower", "No transpose", "Unit", &lastc, k, &			dlarfb_c_b14, &v[(lastv - *k + 1) * v_dim1 + 1], ldv, &work[
			work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




		i__1 = *k;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = lastc;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			c__[lastv - *k + j + i__ * c_dim1] -= work[i__ + j * 
				work_dim1];
		    }
		}

	    } else if (lsame_(side, "R")) {


		i__1 = *k, i__2 = iladlc_(k, n, &v[v_offset], ldv);
		lastv = max(i__1,i__2);
		lastc = iladlr_(m, &lastv, &c__[c_offset], ldc);



		i__1 = *k;
		for (j = 1; j <= i__1; ++j) {
		    if (dcopy_(interp, &lastc, &c__[(lastv - *k + j) * c_dim1 + 1], &dlarfb_c__1, 			     &work[j * work_dim1 + 1], &dlarfb_c__1)!=TCL_OK) { return TCL_ERROR; }


		}


		if (dtrmm_(interp, "Right", "Lower", "Transpose", "Unit", &lastc, k, &			dlarfb_c_b14, &v[(lastv - *k + 1) * v_dim1 + 1], ldv, &work[
			work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }


		if (lastv > *k) {


		    i__1 = lastv - *k;
		    if (dgemm_(interp, "No transpose", "Transpose", &lastc, k, &i__1, &			    dlarfb_c_b14, &c__[c_offset], ldc, &v[v_offset], ldv, &
			    dlarfb_c_b14, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }


		}


		if (dtrmm_(interp, "Right", "Lower", trans, "Non-unit", &lastc, k, &dlarfb_c_b14, 			 &t[t_offset], ldt, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




		if (lastv > *k) {


		    i__1 = lastv - *k;
		    if (dgemm_(interp, "No transpose", "No transpose", &lastc, &i__1, k, &			    dlarfb_c_b25, &work[work_offset], ldwork, &v[v_offset], 
			    ldv, &dlarfb_c_b14, &c__[c_offset], ldc)!=TCL_OK) { return TCL_ERROR; }


		}


		if (dtrmm_(interp, "Right", "Lower", "No transpose", "Unit", &lastc, k, &			dlarfb_c_b14, &v[(lastv - *k + 1) * v_dim1 + 1], ldv, &work[
			work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




		i__1 = *k;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = lastc;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			c__[i__ + (lastv - *k + j) * c_dim1] -= work[i__ + j *
				 work_dim1];
		    }
		}

	    }

	}
    }

return TCL_OK;


} /* dlarfb_ */
static /* Subroutine */ int dlarft_ (Tcl_Interp *interp, char *direct, char *storev, integer *n, integer *	k, doublereal *v, integer *ldv, doublereal *tau, doublereal *t, 	integer *ldt)
{
    integer t_dim1, t_offset, v_dim1, v_offset, i__1, i__2, i__3;
    doublereal d__1;

    integer i__, j, prevlastv;
    doublereal vii;
    integer lastv;































    v_dim1 = *ldv;
    v_offset = 1 + v_dim1;
    v -= v_offset;
    --tau;
    t_dim1 = *ldt;
    t_offset = 1 + t_dim1;
    t -= t_offset;

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

    if (lsame_(direct, "F")) {
	prevlastv = *n;
	i__1 = *k;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    prevlastv = max(i__,prevlastv);
	    if (tau[i__] == 0.) {


		i__2 = i__;
		for (j = 1; j <= i__2; ++j) {
		    t[j + i__ * t_dim1] = 0.;
		}
	    } else {


		vii = v[i__ + i__ * v_dim1];
		v[i__ + i__ * v_dim1] = 1.;
		if (lsame_(storev, "C")) {
		    i__2 = i__ + 1;
		    for (lastv = *n; lastv >= i__2; --lastv) {
			if (v[lastv + i__ * v_dim1] != 0.) {
			    break;
			}
		    }
		    j = min(lastv,prevlastv);


		    i__2 = j - i__ + 1;
		    i__3 = i__ - 1;
		    d__1 = -tau[i__];
		    if (dgemv_(interp, "Transpose", &i__2, &i__3, &d__1, &v[i__ + v_dim1], 			     ldv, &v[i__ + i__ * v_dim1], &dlarft_c__1, &dlarft_c_b8, &t[
			    i__ * t_dim1 + 1], &dlarft_c__1)!=TCL_OK) { return TCL_ERROR; }


		} else {
		    i__2 = i__ + 1;
		    for (lastv = *n; lastv >= i__2; --lastv) {
			if (v[i__ + lastv * v_dim1] != 0.) {
			    break;
			}
		    }
		    j = min(lastv,prevlastv);


		    i__2 = i__ - 1;
		    i__3 = j - i__ + 1;
		    d__1 = -tau[i__];
		    if (dgemv_(interp, "No transpose", &i__2, &i__3, &d__1, &v[i__ * 			    v_dim1 + 1], ldv, &v[i__ + i__ * v_dim1], ldv, &
			    dlarft_c_b8, &t[i__ * t_dim1 + 1], &dlarft_c__1)!=TCL_OK) { return TCL_ERROR; }


		}
		v[i__ + i__ * v_dim1] = vii;


		i__2 = i__ - 1;
		if (dtrmv_(interp, "Upper", "No transpose", "Non-unit", &i__2, &t[			t_offset], ldt, &t[i__ * t_dim1 + 1], &dlarft_c__1)!=TCL_OK) { return TCL_ERROR; }


		t[i__ + i__ * t_dim1] = tau[i__];
		if (i__ > 1) {
		    prevlastv = max(prevlastv,lastv);
		} else {
		    prevlastv = lastv;
		}
	    }
	}
    } else {
	prevlastv = 1;
	for (i__ = *k; i__ >= 1; --i__) {
	    if (tau[i__] == 0.) {


		i__1 = *k;
		for (j = i__; j <= i__1; ++j) {
		    t[j + i__ * t_dim1] = 0.;
		}
	    } else {


		if (i__ < *k) {
		    if (lsame_(storev, "C")) {
			vii = v[*n - *k + i__ + i__ * v_dim1];
			v[*n - *k + i__ + i__ * v_dim1] = 1.;
			i__1 = i__ - 1;
			for (lastv = 1; lastv <= i__1; ++lastv) {
			    if (v[lastv + i__ * v_dim1] != 0.) {
				break;
			    }
			}
			j = max(lastv,prevlastv);


			i__1 = *n - *k + i__ - j + 1;
			i__2 = *k - i__;
			d__1 = -tau[i__];
			if (dgemv_(interp, "Transpose", &i__1, &i__2, &d__1, &v[j + (i__ 				+ 1) * v_dim1], ldv, &v[j + i__ * v_dim1], &
				dlarft_c__1, &dlarft_c_b8, &t[i__ + 1 + i__ * t_dim1], &
				dlarft_c__1)!=TCL_OK) { return TCL_ERROR; }


			v[*n - *k + i__ + i__ * v_dim1] = vii;
		    } else {
			vii = v[i__ + (*n - *k + i__) * v_dim1];
			v[i__ + (*n - *k + i__) * v_dim1] = 1.;
			i__1 = i__ - 1;
			for (lastv = 1; lastv <= i__1; ++lastv) {
			    if (v[i__ + lastv * v_dim1] != 0.) {
				break;
			    }
			}
			j = max(lastv,prevlastv);


			i__1 = *k - i__;
			i__2 = *n - *k + i__ - j + 1;
			d__1 = -tau[i__];
			if (dgemv_(interp, "No transpose", &i__1, &i__2, &d__1, &v[i__ + 				1 + j * v_dim1], ldv, &v[i__ + j * v_dim1], 
				ldv, &dlarft_c_b8, &t[i__ + 1 + i__ * t_dim1], &dlarft_c__1)!=TCL_OK) { return TCL_ERROR; }


			v[i__ + (*n - *k + i__) * v_dim1] = vii;
		    }


		    i__1 = *k - i__;
		    if (dtrmv_(interp, "Lower", "No transpose", "Non-unit", &i__1, &t[i__ 			    + 1 + (i__ + 1) * t_dim1], ldt, &t[i__ + 1 + i__ *
			     t_dim1], &dlarft_c__1)
			    !=TCL_OK) { return TCL_ERROR; }


		    if (i__ > 1) {
			prevlastv = min(prevlastv,lastv);
		    } else {
			prevlastv = lastv;
		    }
		}
		t[i__ + i__ * t_dim1] = tau[i__];
	    }
	}
    }
return TCL_OK;


} /* dlarft_ */
static logical disnan_ (doublereal *din)
{
    logical ret_val;










    ret_val = dlaisnan_(din, din);
    return ret_val;
} /* disnan_ */
static /* Subroutine */ int dgeqr2_ (Tcl_Interp *interp, integer *m, integer *n, doublereal *a, integer *	lda, doublereal *tau, doublereal *work, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3;

    integer i__, k;
    doublereal aii;























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

    *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);
	vectcl_xerbla(interp, "DGEQR2", &i__1);
return TCL_ERROR;

return TCL_OK;
    }

    k = min(*m,*n);

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


	i__2 = *m - i__ + 1;
	i__3 = i__ + 1;
	if (dlarfp_(interp, &i__2, &a[i__ + i__ * a_dim1], &a[min(i__3, *m)+ i__ * a_dim1], &dgeqr2_c__1, &tau[i__])!=TCL_OK) { return TCL_ERROR; }


	if (i__ < *n) {


	    aii = a[i__ + i__ * a_dim1];
	    a[i__ + i__ * a_dim1] = 1.;
	    i__2 = *m - i__ + 1;
	    i__3 = *n - i__;
	    if (dlarf_(interp, "Left", &i__2, &i__3, &a[i__ + i__ * a_dim1], &dgeqr2_c__1, &tau[		    i__], &a[i__ + (i__ + 1) * a_dim1], lda, &work[1])!=TCL_OK) { return TCL_ERROR; }


	    a[i__ + i__ * a_dim1] = aii;
	}
    }
return TCL_OK;


} /* dgeqr2_ */
static integer ieeeck_ (integer *ispec, real *zero, real *one)
{
    integer ret_val;

    real nan1, nan2, nan3, nan4, nan5, nan6, neginf, posinf, negzro, newzro;











    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;
    }





    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;
} /* ieeeck_ */
static integer iparmq_ (integer *ispec, char *name__, char *opts, integer *n, integer 	*ilo, integer *ihi, integer *lwork)
{
    integer ret_val, i__1, i__2;
    real r__1;

    double log(doublereal);
    integer i_nint(real *);

    integer nh, ns;


































    if (*ispec == 15 || *ispec == 13 || *ispec == 16) {


	nh = *ihi - *ilo + 1;
	ns = 2;
	if (nh >= 30) {
	    ns = 4;
	}
	if (nh >= 60) {
	    ns = 10;
	}
	if (nh >= 150) {
	    r__1 = log((real) nh) / log(2.f);
	    i__1 = 10, i__2 = nh / i_nint(&r__1);
	    ns = max(i__1,i__2);
	}
	if (nh >= 590) {
	    ns = 64;
	}
	if (nh >= 3000) {
	    ns = 128;
	}
	if (nh >= 6000) {
	    ns = 256;
	}
	i__1 = 2, i__2 = ns - ns % 2;
	ns = max(i__1,i__2);
    }

    if (*ispec == 12) {



	ret_val = 75;

    } else if (*ispec == 14) {


	ret_val = 14;

    } else if (*ispec == 15) {


	ret_val = ns;

    } else if (*ispec == 13) {


	if (nh <= 500) {
	    ret_val = ns;
	} else {
	    ret_val = ns * 3 / 2;
	}

    } else if (*ispec == 16) {


	ret_val = 0;
	if (ns >= 14) {
	    ret_val = 1;
	}
	if (ns >= 14) {
	    ret_val = 2;
	}

    } else {
	ret_val = -1;

    }


    return ret_val;
} /* iparmq_ */
static /* Subroutine */ int dorgl2_ (Tcl_Interp *interp, integer *m, integer *n, integer *k, doublereal *	a, integer *lda, doublereal *tau, doublereal *work, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2;
    doublereal d__1;

    integer i__, j, l;




















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

    *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);
	vectcl_xerbla(interp, "DORGL2", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


    if (*m <= 0) {
return TCL_OK;
    }

    if (*k < *m) {


	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *m;
	    for (l = *k + 1; l <= i__2; ++l) {
		a[l + j * a_dim1] = 0.;
	    }
	    if (j > *k && j <= *m) {
		a[j + j * a_dim1] = 1.;
	    }
	}
    }

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


	if (i__ < *n) {
	    if (i__ < *m) {
		a[i__ + i__ * a_dim1] = 1.;
		i__1 = *m - i__;
		i__2 = *n - i__ + 1;
		if (dlarf_(interp, "Right", &i__1, &i__2, &a[i__ + i__ * a_dim1], lda, &			tau[i__], &a[i__ + 1 + i__ * a_dim1], lda, &work[1])!=TCL_OK) { return TCL_ERROR; }


	    }
	    i__1 = *n - i__;
	    d__1 = -tau[i__];
	    if (dscal_(interp, &i__1, &d__1, &a[i__ + (i__ + 1) * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }

	}
	a[i__ + i__ * a_dim1] = 1. - tau[i__];


	i__1 = i__ - 1;
	for (l = 1; l <= i__1; ++l) {
	    a[i__ + l * a_dim1] = 0.;
	}
    }
return TCL_OK;


} /* dorgl2_ */
static /* Subroutine */ int dorg2r_ (Tcl_Interp *interp, integer *m, integer *n, integer *k, doublereal *	a, integer *lda, doublereal *tau, doublereal *work, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2;
    doublereal d__1;

    integer i__, j, l;




















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

    *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);
	vectcl_xerbla(interp, "DORG2R", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


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


    i__1 = *n;
    for (j = *k + 1; j <= i__1; ++j) {
	i__2 = *m;
	for (l = 1; l <= i__2; ++l) {
	    a[l + j * a_dim1] = 0.;
	}
	a[j + j * a_dim1] = 1.;
    }

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


	if (i__ < *n) {
	    a[i__ + i__ * a_dim1] = 1.;
	    i__1 = *m - i__ + 1;
	    i__2 = *n - i__;
	    if (dlarf_(interp, "Left", &i__1, &i__2, &a[i__ + i__ * a_dim1], &dorg2r_c__1, &tau[		    i__], &a[i__ + (i__ + 1) * a_dim1], lda, &work[1])!=TCL_OK) { return TCL_ERROR; }


	}
	if (i__ < *m) {
	    i__1 = *m - i__;
	    d__1 = -tau[i__];
	    if (dscal_(interp, &i__1, &d__1, &a[i__ + 1 + i__ * a_dim1], &dorg2r_c__1)!=TCL_OK) { return TCL_ERROR; }

	}
	a[i__ + i__ * a_dim1] = 1. - tau[i__];


	i__1 = i__ - 1;
	for (l = 1; l <= i__1; ++l) {
	    a[l + i__ * a_dim1] = 0.;
	}
    }
return TCL_OK;


} /* dorg2r_ */
static /* Subroutine */ int zgebd2_ (Tcl_Interp *interp, integer *m, integer *n, doublecomplex *a, 	integer *lda, doublereal *d__, doublereal *e, doublecomplex *tauq, 	doublecomplex *taup, doublecomplex *work, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3;
    doublecomplex z__1;

    void d_cnjg(doublecomplex *, doublecomplex *);

    integer i__;
    doublecomplex alpha;





































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

    *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);
	vectcl_xerbla(interp, "ZGEBD2", &i__1);
return TCL_ERROR;

return TCL_OK;
    }

    if (*m >= *n) {


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


	    i__2 = i__ + i__ * a_dim1;
	    alpha.r = a[i__2].r, alpha.i = a[i__2].i;
	    i__2 = *m - i__ + 1;
	    i__3 = i__ + 1;
	    if (zlarfg_(interp, &i__2, &alpha, &a[min(i__3, *m)+ i__ * a_dim1], &zgebd2_c__1, &		    tauq[i__])!=TCL_OK) { return TCL_ERROR; }


	    i__2 = i__;
	    d__[i__2] = alpha.r;
	    i__2 = i__ + i__ * a_dim1;
	    a[i__2].r = 1., a[i__2].i = 0.;


	    if (i__ < *n) {
		i__2 = *m - i__ + 1;
		i__3 = *n - i__;
		d_cnjg(&z__1, &tauq[i__]);
		if (zlarf_(interp, "Left", &i__2, &i__3, &a[i__ + i__ * a_dim1], &zgebd2_c__1, &			z__1, &a[i__ + (i__ + 1) * a_dim1], lda, &work[1])!=TCL_OK) { return TCL_ERROR; }


	    }
	    i__2 = i__ + i__ * a_dim1;
	    i__3 = i__;
	    a[i__2].r = d__[i__3], a[i__2].i = 0.;

	    if (i__ < *n) {


		i__2 = *n - i__;
		if (zlacgv_(interp, &i__2, &a[i__ + (i__ + 1) * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }

		i__2 = i__ + (i__ + 1) * a_dim1;
		alpha.r = a[i__2].r, alpha.i = a[i__2].i;
		i__2 = *n - i__;
		i__3 = i__ + 2;
		if (zlarfg_(interp, &i__2, &alpha, &a[i__ + min(i__3, *n)* a_dim1], lda, &			taup[i__])!=TCL_OK) { return TCL_ERROR; }


		i__2 = i__;
		e[i__2] = alpha.r;
		i__2 = i__ + (i__ + 1) * a_dim1;
		a[i__2].r = 1., a[i__2].i = 0.;


		i__2 = *m - i__;
		i__3 = *n - i__;
		if (zlarf_(interp, "Right", &i__2, &i__3, &a[i__ + (i__ + 1) * a_dim1], 			lda, &taup[i__], &a[i__ + 1 + (i__ + 1) * a_dim1], 
			lda, &work[1])!=TCL_OK) { return TCL_ERROR; }


		i__2 = *n - i__;
		if (zlacgv_(interp, &i__2, &a[i__ + (i__ + 1) * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }

		i__2 = i__ + (i__ + 1) * a_dim1;
		i__3 = i__;
		a[i__2].r = e[i__3], a[i__2].i = 0.;
	    } else {
		i__2 = i__;
		taup[i__2].r = 0., taup[i__2].i = 0.;
	    }
	}
    } else {


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


	    i__2 = *n - i__ + 1;
	    if (zlacgv_(interp, &i__2, &a[i__ + i__ * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }

	    i__2 = i__ + i__ * a_dim1;
	    alpha.r = a[i__2].r, alpha.i = a[i__2].i;
	    i__2 = *n - i__ + 1;
	    i__3 = i__ + 1;
	    if (zlarfg_(interp, &i__2, &alpha, &a[i__ + min(i__3, *n)* a_dim1], lda, &		    taup[i__])!=TCL_OK) { return TCL_ERROR; }


	    i__2 = i__;
	    d__[i__2] = alpha.r;
	    i__2 = i__ + i__ * a_dim1;
	    a[i__2].r = 1., a[i__2].i = 0.;


	    if (i__ < *m) {
		i__2 = *m - i__;
		i__3 = *n - i__ + 1;
		if (zlarf_(interp, "Right", &i__2, &i__3, &a[i__ + i__ * a_dim1], lda, &			taup[i__], &a[i__ + 1 + i__ * a_dim1], lda, &work[1])!=TCL_OK) { return TCL_ERROR; }


	    }
	    i__2 = *n - i__ + 1;
	    if (zlacgv_(interp, &i__2, &a[i__ + i__ * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }

	    i__2 = i__ + i__ * a_dim1;
	    i__3 = i__;
	    a[i__2].r = d__[i__3], a[i__2].i = 0.;

	    if (i__ < *m) {


		i__2 = i__ + 1 + i__ * a_dim1;
		alpha.r = a[i__2].r, alpha.i = a[i__2].i;
		i__2 = *m - i__;
		i__3 = i__ + 2;
		if (zlarfg_(interp, &i__2, &alpha, &a[min(i__3, *m)+ i__ * a_dim1], &zgebd2_c__1, 			 &tauq[i__])!=TCL_OK) { return TCL_ERROR; }


		i__2 = i__;
		e[i__2] = alpha.r;
		i__2 = i__ + 1 + i__ * a_dim1;
		a[i__2].r = 1., a[i__2].i = 0.;


		i__2 = *m - i__;
		i__3 = *n - i__;
		d_cnjg(&z__1, &tauq[i__]);
		if (zlarf_(interp, "Left", &i__2, &i__3, &a[i__ + 1 + i__ * a_dim1], &			zgebd2_c__1, &z__1, &a[i__ + 1 + (i__ + 1) * a_dim1], lda, &
			work[1])!=TCL_OK) { return TCL_ERROR; }


		i__2 = i__ + 1 + i__ * a_dim1;
		i__3 = i__;
		a[i__2].r = e[i__3], a[i__2].i = 0.;
	    } else {
		i__2 = i__;
		tauq[i__2].r = 0., tauq[i__2].i = 0.;
	    }
	}
    }
return TCL_OK;


} /* zgebd2_ */
static /* Subroutine */ int zlabrd_ (Tcl_Interp *interp, integer *m, integer *n, integer *nb, 	doublecomplex *a, integer *lda, doublereal *d__, doublereal *e, 	doublecomplex *tauq, doublecomplex *taup, doublecomplex *x, integer *	ldx, doublecomplex *y, integer *ldy)
{
    integer a_dim1, a_offset, x_dim1, x_offset, y_dim1, y_offset, i__1, i__2, 
	    i__3;
    doublecomplex z__1;

    integer i__;
    doublecomplex alpha;






































    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --d__;
    --e;
    --tauq;
    --taup;
    x_dim1 = *ldx;
    x_offset = 1 + x_dim1;
    x -= x_offset;
    y_dim1 = *ldy;
    y_offset = 1 + y_dim1;
    y -= y_offset;

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

    if (*m >= *n) {


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


	    i__2 = i__ - 1;
	    if (zlacgv_(interp, &i__2, &y[i__ + y_dim1], ldy)!=TCL_OK) { return TCL_ERROR; }

	    i__2 = *m - i__ + 1;
	    i__3 = i__ - 1;
	    z__1.r = -1., z__1.i = -0.;
	    if (zgemv_(interp, "No transpose", &i__2, &i__3, &z__1, &a[i__ + a_dim1], lda, 		     &y[i__ + y_dim1], ldy, &zlabrd_c_b2, &a[i__ + i__ * a_dim1], &
		    zlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


	    i__2 = i__ - 1;
	    if (zlacgv_(interp, &i__2, &y[i__ + y_dim1], ldy)!=TCL_OK) { return TCL_ERROR; }

	    i__2 = *m - i__ + 1;
	    i__3 = i__ - 1;
	    z__1.r = -1., z__1.i = -0.;
	    if (zgemv_(interp, "No transpose", &i__2, &i__3, &z__1, &x[i__ + x_dim1], ldx, 		     &a[i__ * a_dim1 + 1], &zlabrd_c__1, &zlabrd_c_b2, &a[i__ + i__ * 
		    a_dim1], &zlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }




	    i__2 = i__ + i__ * a_dim1;
	    alpha.r = a[i__2].r, alpha.i = a[i__2].i;
	    i__2 = *m - i__ + 1;
	    i__3 = i__ + 1;
	    if (zlarfg_(interp, &i__2, &alpha, &a[min(i__3, *m)+ i__ * a_dim1], &zlabrd_c__1, &		    tauq[i__])!=TCL_OK) { return TCL_ERROR; }


	    i__2 = i__;
	    d__[i__2] = alpha.r;
	    if (i__ < *n) {
		i__2 = i__ + i__ * a_dim1;
		a[i__2].r = 1., a[i__2].i = 0.;


		i__2 = *m - i__ + 1;
		i__3 = *n - i__;
		if (zgemv_(interp, "Conjugate transpose", &i__2, &i__3, &zlabrd_c_b2, &a[i__ + (			i__ + 1) * a_dim1], lda, &a[i__ + i__ * a_dim1], &
			zlabrd_c__1, &zlabrd_c_b1, &y[i__ + 1 + i__ * y_dim1], &zlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *m - i__ + 1;
		i__3 = i__ - 1;
		if (zgemv_(interp, "Conjugate transpose", &i__2, &i__3, &zlabrd_c_b2, &a[i__ + 			a_dim1], lda, &a[i__ + i__ * a_dim1], &zlabrd_c__1, &zlabrd_c_b1, &
			y[i__ * y_dim1 + 1], &zlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *n - i__;
		i__3 = i__ - 1;
		z__1.r = -1., z__1.i = -0.;
		if (zgemv_(interp, "No transpose", &i__2, &i__3, &z__1, &y[i__ + 1 + 			y_dim1], ldy, &y[i__ * y_dim1 + 1], &zlabrd_c__1, &zlabrd_c_b2, &y[
			i__ + 1 + i__ * y_dim1], &zlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *m - i__ + 1;
		i__3 = i__ - 1;
		if (zgemv_(interp, "Conjugate transpose", &i__2, &i__3, &zlabrd_c_b2, &x[i__ + 			x_dim1], ldx, &a[i__ + i__ * a_dim1], &zlabrd_c__1, &zlabrd_c_b1, &
			y[i__ * y_dim1 + 1], &zlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = i__ - 1;
		i__3 = *n - i__;
		z__1.r = -1., z__1.i = -0.;
		if (zgemv_(interp, "Conjugate transpose", &i__2, &i__3, &z__1, &a[(i__ + 			1) * a_dim1 + 1], lda, &y[i__ * y_dim1 + 1], &zlabrd_c__1, &
			zlabrd_c_b2, &y[i__ + 1 + i__ * y_dim1], &zlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *n - i__;
		if (zscal_(interp, &i__2, &tauq[i__], &y[i__ + 1 + i__ * y_dim1], &zlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }



		i__2 = *n - i__;
		if (zlacgv_(interp, &i__2, &a[i__ + (i__ + 1) * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }

		if (zlacgv_(interp, &i__, &a[i__ + a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }

		i__2 = *n - i__;
		z__1.r = -1., z__1.i = -0.;
		if (zgemv_(interp, "No transpose", &i__2, &i__, &z__1, &y[i__ + 1 + 			y_dim1], ldy, &a[i__ + a_dim1], lda, &zlabrd_c_b2, &a[i__ + (
			i__ + 1) * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }


		if (zlacgv_(interp, &i__, &a[i__ + a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }

		i__2 = i__ - 1;
		if (zlacgv_(interp, &i__2, &x[i__ + x_dim1], ldx)!=TCL_OK) { return TCL_ERROR; }

		i__2 = i__ - 1;
		i__3 = *n - i__;
		z__1.r = -1., z__1.i = -0.;
		if (zgemv_(interp, "Conjugate transpose", &i__2, &i__3, &z__1, &a[(i__ + 			1) * a_dim1 + 1], lda, &x[i__ + x_dim1], ldx, &zlabrd_c_b2, &
			a[i__ + (i__ + 1) * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }


		i__2 = i__ - 1;
		if (zlacgv_(interp, &i__2, &x[i__ + x_dim1], ldx)!=TCL_OK) { return TCL_ERROR; }



		i__2 = i__ + (i__ + 1) * a_dim1;
		alpha.r = a[i__2].r, alpha.i = a[i__2].i;
		i__2 = *n - i__;
		i__3 = i__ + 2;
		if (zlarfg_(interp, &i__2, &alpha, &a[i__ + min(i__3, *n)* a_dim1], lda, &			taup[i__])!=TCL_OK) { return TCL_ERROR; }


		i__2 = i__;
		e[i__2] = alpha.r;
		i__2 = i__ + (i__ + 1) * a_dim1;
		a[i__2].r = 1., a[i__2].i = 0.;


		i__2 = *m - i__;
		i__3 = *n - i__;
		if (zgemv_(interp, "No transpose", &i__2, &i__3, &zlabrd_c_b2, &a[i__ + 1 + (i__ 			+ 1) * a_dim1], lda, &a[i__ + (i__ + 1) * a_dim1], 
			lda, &zlabrd_c_b1, &x[i__ + 1 + i__ * x_dim1], &zlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *n - i__;
		if (zgemv_(interp, "Conjugate transpose", &i__2, &i__, &zlabrd_c_b2, &y[i__ + 1 			+ y_dim1], ldy, &a[i__ + (i__ + 1) * a_dim1], lda, &
			zlabrd_c_b1, &x[i__ * x_dim1 + 1], &zlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *m - i__;
		z__1.r = -1., z__1.i = -0.;
		if (zgemv_(interp, "No transpose", &i__2, &i__, &z__1, &a[i__ + 1 + 			a_dim1], lda, &x[i__ * x_dim1 + 1], &zlabrd_c__1, &zlabrd_c_b2, &x[
			i__ + 1 + i__ * x_dim1], &zlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = i__ - 1;
		i__3 = *n - i__;
		if (zgemv_(interp, "No transpose", &i__2, &i__3, &zlabrd_c_b2, &a[(i__ + 1) * 			a_dim1 + 1], lda, &a[i__ + (i__ + 1) * a_dim1], lda, &
			zlabrd_c_b1, &x[i__ * x_dim1 + 1], &zlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *m - i__;
		i__3 = i__ - 1;
		z__1.r = -1., z__1.i = -0.;
		if (zgemv_(interp, "No transpose", &i__2, &i__3, &z__1, &x[i__ + 1 + 			x_dim1], ldx, &x[i__ * x_dim1 + 1], &zlabrd_c__1, &zlabrd_c_b2, &x[
			i__ + 1 + i__ * x_dim1], &zlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *m - i__;
		if (zscal_(interp, &i__2, &taup[i__], &x[i__ + 1 + i__ * x_dim1], &zlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }

		i__2 = *n - i__;
		if (zlacgv_(interp, &i__2, &a[i__ + (i__ + 1) * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }

	    }
	}
    } else {


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


	    i__2 = *n - i__ + 1;
	    if (zlacgv_(interp, &i__2, &a[i__ + i__ * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }

	    i__2 = i__ - 1;
	    if (zlacgv_(interp, &i__2, &a[i__ + a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }

	    i__2 = *n - i__ + 1;
	    i__3 = i__ - 1;
	    z__1.r = -1., z__1.i = -0.;
	    if (zgemv_(interp, "No transpose", &i__2, &i__3, &z__1, &y[i__ + y_dim1], ldy, 		     &a[i__ + a_dim1], lda, &zlabrd_c_b2, &a[i__ + i__ * a_dim1], 
		    lda)!=TCL_OK) { return TCL_ERROR; }


	    i__2 = i__ - 1;
	    if (zlacgv_(interp, &i__2, &a[i__ + a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }

	    i__2 = i__ - 1;
	    if (zlacgv_(interp, &i__2, &x[i__ + x_dim1], ldx)!=TCL_OK) { return TCL_ERROR; }

	    i__2 = i__ - 1;
	    i__3 = *n - i__ + 1;
	    z__1.r = -1., z__1.i = -0.;
	    if (zgemv_(interp, "Conjugate transpose", &i__2, &i__3, &z__1, &a[i__ * 		    a_dim1 + 1], lda, &x[i__ + x_dim1], ldx, &zlabrd_c_b2, &a[i__ + 
		    i__ * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }


	    i__2 = i__ - 1;
	    if (zlacgv_(interp, &i__2, &x[i__ + x_dim1], ldx)!=TCL_OK) { return TCL_ERROR; }



	    i__2 = i__ + i__ * a_dim1;
	    alpha.r = a[i__2].r, alpha.i = a[i__2].i;
	    i__2 = *n - i__ + 1;
	    i__3 = i__ + 1;
	    if (zlarfg_(interp, &i__2, &alpha, &a[i__ + min(i__3, *n)* a_dim1], lda, &		    taup[i__])!=TCL_OK) { return TCL_ERROR; }


	    i__2 = i__;
	    d__[i__2] = alpha.r;
	    if (i__ < *m) {
		i__2 = i__ + i__ * a_dim1;
		a[i__2].r = 1., a[i__2].i = 0.;


		i__2 = *m - i__;
		i__3 = *n - i__ + 1;
		if (zgemv_(interp, "No transpose", &i__2, &i__3, &zlabrd_c_b2, &a[i__ + 1 + i__ *			 a_dim1], lda, &a[i__ + i__ * a_dim1], lda, &zlabrd_c_b1, &x[
			i__ + 1 + i__ * x_dim1], &zlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *n - i__ + 1;
		i__3 = i__ - 1;
		if (zgemv_(interp, "Conjugate transpose", &i__2, &i__3, &zlabrd_c_b2, &y[i__ + 			y_dim1], ldy, &a[i__ + i__ * a_dim1], lda, &zlabrd_c_b1, &x[
			i__ * x_dim1 + 1], &zlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *m - i__;
		i__3 = i__ - 1;
		z__1.r = -1., z__1.i = -0.;
		if (zgemv_(interp, "No transpose", &i__2, &i__3, &z__1, &a[i__ + 1 + 			a_dim1], lda, &x[i__ * x_dim1 + 1], &zlabrd_c__1, &zlabrd_c_b2, &x[
			i__ + 1 + i__ * x_dim1], &zlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = i__ - 1;
		i__3 = *n - i__ + 1;
		if (zgemv_(interp, "No transpose", &i__2, &i__3, &zlabrd_c_b2, &a[i__ * a_dim1 + 			1], lda, &a[i__ + i__ * a_dim1], lda, &zlabrd_c_b1, &x[i__ * 
			x_dim1 + 1], &zlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *m - i__;
		i__3 = i__ - 1;
		z__1.r = -1., z__1.i = -0.;
		if (zgemv_(interp, "No transpose", &i__2, &i__3, &z__1, &x[i__ + 1 + 			x_dim1], ldx, &x[i__ * x_dim1 + 1], &zlabrd_c__1, &zlabrd_c_b2, &x[
			i__ + 1 + i__ * x_dim1], &zlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *m - i__;
		if (zscal_(interp, &i__2, &taup[i__], &x[i__ + 1 + i__ * x_dim1], &zlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }

		i__2 = *n - i__ + 1;
		if (zlacgv_(interp, &i__2, &a[i__ + i__ * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }



		i__2 = i__ - 1;
		if (zlacgv_(interp, &i__2, &y[i__ + y_dim1], ldy)!=TCL_OK) { return TCL_ERROR; }

		i__2 = *m - i__;
		i__3 = i__ - 1;
		z__1.r = -1., z__1.i = -0.;
		if (zgemv_(interp, "No transpose", &i__2, &i__3, &z__1, &a[i__ + 1 + 			a_dim1], lda, &y[i__ + y_dim1], ldy, &zlabrd_c_b2, &a[i__ + 
			1 + i__ * a_dim1], &zlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = i__ - 1;
		if (zlacgv_(interp, &i__2, &y[i__ + y_dim1], ldy)!=TCL_OK) { return TCL_ERROR; }

		i__2 = *m - i__;
		z__1.r = -1., z__1.i = -0.;
		if (zgemv_(interp, "No transpose", &i__2, &i__, &z__1, &x[i__ + 1 + 			x_dim1], ldx, &a[i__ * a_dim1 + 1], &zlabrd_c__1, &zlabrd_c_b2, &a[
			i__ + 1 + i__ * a_dim1], &zlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }




		i__2 = i__ + 1 + i__ * a_dim1;
		alpha.r = a[i__2].r, alpha.i = a[i__2].i;
		i__2 = *m - i__;
		i__3 = i__ + 2;
		if (zlarfg_(interp, &i__2, &alpha, &a[min(i__3, *m)+ i__ * a_dim1], &zlabrd_c__1, 			 &tauq[i__])!=TCL_OK) { return TCL_ERROR; }


		i__2 = i__;
		e[i__2] = alpha.r;
		i__2 = i__ + 1 + i__ * a_dim1;
		a[i__2].r = 1., a[i__2].i = 0.;


		i__2 = *m - i__;
		i__3 = *n - i__;
		if (zgemv_(interp, "Conjugate transpose", &i__2, &i__3, &zlabrd_c_b2, &a[i__ + 1 			+ (i__ + 1) * a_dim1], lda, &a[i__ + 1 + i__ * a_dim1]
, &zlabrd_c__1, &zlabrd_c_b1, &y[i__ + 1 + i__ * y_dim1], &zlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *m - i__;
		i__3 = i__ - 1;
		if (zgemv_(interp, "Conjugate transpose", &i__2, &i__3, &zlabrd_c_b2, &a[i__ + 1 			+ a_dim1], lda, &a[i__ + 1 + i__ * a_dim1], &zlabrd_c__1, &
			zlabrd_c_b1, &y[i__ * y_dim1 + 1], &zlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *n - i__;
		i__3 = i__ - 1;
		z__1.r = -1., z__1.i = -0.;
		if (zgemv_(interp, "No transpose", &i__2, &i__3, &z__1, &y[i__ + 1 + 			y_dim1], ldy, &y[i__ * y_dim1 + 1], &zlabrd_c__1, &zlabrd_c_b2, &y[
			i__ + 1 + i__ * y_dim1], &zlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *m - i__;
		if (zgemv_(interp, "Conjugate transpose", &i__2, &i__, &zlabrd_c_b2, &x[i__ + 1 			+ x_dim1], ldx, &a[i__ + 1 + i__ * a_dim1], &zlabrd_c__1, &
			zlabrd_c_b1, &y[i__ * y_dim1 + 1], &zlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *n - i__;
		z__1.r = -1., z__1.i = -0.;
		if (zgemv_(interp, "Conjugate transpose", &i__, &i__2, &z__1, &a[(i__ + 1)			 * a_dim1 + 1], lda, &y[i__ * y_dim1 + 1], &zlabrd_c__1, &
			zlabrd_c_b2, &y[i__ + 1 + i__ * y_dim1], &zlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *n - i__;
		if (zscal_(interp, &i__2, &tauq[i__], &y[i__ + 1 + i__ * y_dim1], &zlabrd_c__1)!=TCL_OK) { return TCL_ERROR; }

	    } else {
		i__2 = *n - i__ + 1;
		if (zlacgv_(interp, &i__2, &a[i__ + i__ * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }

	    }
	}
    }
return TCL_OK;


} /* zlabrd_ */
static /* Subroutine */ int zlassq_ (Tcl_Interp *interp, integer *n, doublecomplex *x, integer *incx, 	doublereal *scale, doublereal *sumsq)
{
    integer i__1, i__2, i__3;
    doublereal d__1;

    double d_imag(doublecomplex *);

    integer ix;
    doublereal temp1;





















    --x;

    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) {
	    i__3 = ix;
	    if (x[i__3].r != 0.) {
		i__3 = ix;
		temp1 = (d__1 = x[i__3].r, abs(d__1));
		if (*scale < temp1) {
		    d__1 = *scale / temp1;
		    *sumsq = *sumsq * (d__1 * d__1) + 1;
		    *scale = temp1;
		} else {
		    d__1 = temp1 / *scale;
		    *sumsq += d__1 * d__1;
		}
	    }
	    if (d_imag(&x[ix]) != 0.) {
		temp1 = (d__1 = d_imag(&x[ix]), abs(d__1));
		if (*scale < temp1) {
		    d__1 = *scale / temp1;
		    *sumsq = *sumsq * (d__1 * d__1) + 1;
		    *scale = temp1;
		} else {
		    d__1 = temp1 / *scale;
		    *sumsq += d__1 * d__1;
		}
	    }
	}
    }

return TCL_OK;


} /* zlassq_ */
static /* Subroutine */ int zgelq2_ (Tcl_Interp *interp, integer *m, integer *n, doublecomplex *a, 	integer *lda, doublecomplex *tau, doublecomplex *work, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3;

    integer i__, k;
    doublecomplex alpha;























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

    *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);
	vectcl_xerbla(interp, "ZGELQ2", &i__1);
return TCL_ERROR;

return TCL_OK;
    }

    k = min(*m,*n);

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


	i__2 = *n - i__ + 1;
	if (zlacgv_(interp, &i__2, &a[i__ + i__ * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }

	i__2 = i__ + i__ * a_dim1;
	alpha.r = a[i__2].r, alpha.i = a[i__2].i;
	i__2 = *n - i__ + 1;
	i__3 = i__ + 1;
	if (zlarfp_(interp, &i__2, &alpha, &a[i__ + min(i__3, *n)* a_dim1], lda, &tau[i__])!=TCL_OK) { return TCL_ERROR; }


	if (i__ < *m) {


	    i__2 = i__ + i__ * a_dim1;
	    a[i__2].r = 1., a[i__2].i = 0.;
	    i__2 = *m - i__;
	    i__3 = *n - i__ + 1;
	    if (zlarf_(interp, "Right", &i__2, &i__3, &a[i__ + i__ * a_dim1], lda, &tau[		    i__], &a[i__ + 1 + i__ * a_dim1], lda, &work[1])!=TCL_OK) { return TCL_ERROR; }


	}
	i__2 = i__ + i__ * a_dim1;
	a[i__2].r = alpha.r, a[i__2].i = alpha.i;
	i__2 = *n - i__ + 1;
	if (zlacgv_(interp, &i__2, &a[i__ + i__ * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }

    }
return TCL_OK;


} /* zgelq2_ */
static /* Subroutine */ int zlarfb_ (Tcl_Interp *interp, char *side, char *trans, char *direct, char *	storev, integer *m, integer *n, integer *k, doublecomplex *v, integer 	*ldv, doublecomplex *t, integer *ldt, doublecomplex *c__, integer *	ldc, doublecomplex *work, integer *ldwork)
{
    integer c_dim1, c_offset, t_dim1, t_offset, v_dim1, v_offset, work_dim1, 
	    work_offset, i__1, i__2, i__3, i__4, i__5;
    doublecomplex z__1, z__2;

    void d_cnjg(doublecomplex *, doublecomplex *);

    integer i__, j;
    integer lastc;
    integer lastv;
    char transt[1];

























    v_dim1 = *ldv;
    v_offset = 1 + v_dim1;
    v -= v_offset;
    t_dim1 = *ldt;
    t_offset = 1 + t_dim1;
    t -= t_offset;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;
    work_dim1 = *ldwork;
    work_offset = 1 + work_dim1;
    work -= work_offset;

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

    if (lsame_(trans, "N")) {
	*(unsigned char *)transt = 'C';
    } else {
	*(unsigned char *)transt = 'N';
    }

    if (lsame_(storev, "C")) {

	if (lsame_(direct, "F")) {


	    if (lsame_(side, "L")) {


		i__1 = *k, i__2 = ilazlr_(m, k, &v[v_offset], ldv);
		lastv = max(i__1,i__2);
		lastc = ilazlc_(&lastv, n, &c__[c_offset], ldc);



		i__1 = *k;
		for (j = 1; j <= i__1; ++j) {
		    if (zcopy_(interp, &lastc, &c__[j + c_dim1], ldc, &work[j * work_dim1 			    + 1], &zlarfb_c__1)!=TCL_OK) { return TCL_ERROR; }


		    if (zlacgv_(interp, &lastc, &work[j * work_dim1 + 1], &zlarfb_c__1)!=TCL_OK) { return TCL_ERROR; }

		}


		if (ztrmm_(interp, "Right", "Lower", "No transpose", "Unit", &lastc, k, &			zlarfb_c_b1, &v[v_offset], ldv, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }


		if (lastv > *k) {


		    i__1 = lastv - *k;
		    if (zgemm_(interp, "Conjugate transpose", "No transpose", &lastc, k, &			    i__1, &zlarfb_c_b1, &c__[*k + 1 + c_dim1], ldc, &v[*k + 
			    1 + v_dim1], ldv, &zlarfb_c_b1, &work[work_offset], 
			    ldwork)!=TCL_OK) { return TCL_ERROR; }


		}


		if (ztrmm_(interp, "Right", "Upper", transt, "Non-unit", &lastc, k, &zlarfb_c_b1, 			 &t[t_offset], ldt, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




		if (*m > *k) {


		    i__1 = lastv - *k;
		    z__1.r = -1., z__1.i = -0.;
		    if (zgemm_(interp, "No transpose", "Conjugate transpose", &i__1, &			    lastc, k, &z__1, &v[*k + 1 + v_dim1], ldv, &work[
			    work_offset], ldwork, &zlarfb_c_b1, &c__[*k + 1 + c_dim1]
, ldc)!=TCL_OK) { return TCL_ERROR; }


		}


		if (ztrmm_(interp, "Right", "Lower", "Conjugate transpose", "Unit", &			lastc, k, &zlarfb_c_b1, &v[v_offset], ldv, &work[work_offset]
, ldwork)
			!=TCL_OK) { return TCL_ERROR; }




		i__1 = *k;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = lastc;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			i__3 = j + i__ * c_dim1;
			i__4 = j + i__ * c_dim1;
			d_cnjg(&z__2, &work[i__ + j * work_dim1]);
			z__1.r = c__[i__4].r - z__2.r, z__1.i = c__[i__4].i - 
				z__2.i;
			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
		    }
		}

	    } else if (lsame_(side, "R")) {


		i__1 = *k, i__2 = ilazlr_(n, k, &v[v_offset], ldv);
		lastv = max(i__1,i__2);
		lastc = ilazlr_(m, &lastv, &c__[c_offset], ldc);



		i__1 = *k;
		for (j = 1; j <= i__1; ++j) {
		    if (zcopy_(interp, &lastc, &c__[j * c_dim1 + 1], &zlarfb_c__1, &work[j * 			    work_dim1 + 1], &zlarfb_c__1)!=TCL_OK) { return TCL_ERROR; }


		}


		if (ztrmm_(interp, "Right", "Lower", "No transpose", "Unit", &lastc, k, &			zlarfb_c_b1, &v[v_offset], ldv, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }


		if (lastv > *k) {


		    i__1 = lastv - *k;
		    if (zgemm_(interp, "No transpose", "No transpose", &lastc, k, &i__1, &			    zlarfb_c_b1, &c__[(*k + 1) * c_dim1 + 1], ldc, &v[*k + 1 
			    + v_dim1], ldv, &zlarfb_c_b1, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }


		}


		if (ztrmm_(interp, "Right", "Upper", trans, "Non-unit", &lastc, k, &zlarfb_c_b1, 			&t[t_offset], ldt, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




		if (lastv > *k) {


		    i__1 = lastv - *k;
		    z__1.r = -1., z__1.i = -0.;
		    if (zgemm_(interp, "No transpose", "Conjugate transpose", &lastc, &			    i__1, k, &z__1, &work[work_offset], ldwork, &v[*k 
			    + 1 + v_dim1], ldv, &zlarfb_c_b1, &c__[(*k + 1) * c_dim1 
			    + 1], ldc)!=TCL_OK) { return TCL_ERROR; }


		}


		if (ztrmm_(interp, "Right", "Lower", "Conjugate transpose", "Unit", &			lastc, k, &zlarfb_c_b1, &v[v_offset], ldv, &work[work_offset]
, ldwork)
			!=TCL_OK) { return TCL_ERROR; }




		i__1 = *k;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = lastc;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			i__3 = i__ + j * c_dim1;
			i__4 = i__ + j * c_dim1;
			i__5 = i__ + j * work_dim1;
			z__1.r = c__[i__4].r - work[i__5].r, z__1.i = c__[
				i__4].i - work[i__5].i;
			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
		    }
		}
	    }

	} else {


	    if (lsame_(side, "L")) {


		i__1 = *k, i__2 = ilazlr_(m, k, &v[v_offset], ldv);
		lastv = max(i__1,i__2);
		lastc = ilazlc_(&lastv, n, &c__[c_offset], ldc);



		i__1 = *k;
		for (j = 1; j <= i__1; ++j) {
		    if (zcopy_(interp, &lastc, &c__[lastv - *k + j + c_dim1], ldc, &work[			    j * work_dim1 + 1], &zlarfb_c__1)!=TCL_OK) { return TCL_ERROR; }


		    if (zlacgv_(interp, &lastc, &work[j * work_dim1 + 1], &zlarfb_c__1)!=TCL_OK) { return TCL_ERROR; }

		}


		if (ztrmm_(interp, "Right", "Upper", "No transpose", "Unit", &lastc, k, &			zlarfb_c_b1, &v[lastv - *k + 1 + v_dim1], ldv, &work[
			work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }


		if (lastv > *k) {


		    i__1 = lastv - *k;
		    if (zgemm_(interp, "Conjugate transpose", "No transpose", &lastc, k, &			    i__1, &zlarfb_c_b1, &c__[c_offset], ldc, &v[v_offset], 
			    ldv, &zlarfb_c_b1, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }


		}


		if (ztrmm_(interp, "Right", "Lower", transt, "Non-unit", &lastc, k, &zlarfb_c_b1, 			 &t[t_offset], ldt, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




		if (lastv > *k) {


		    i__1 = lastv - *k;
		    z__1.r = -1., z__1.i = -0.;
		    if (zgemm_(interp, "No transpose", "Conjugate transpose", &i__1, &			    lastc, k, &z__1, &v[v_offset], ldv, &work[
			    work_offset], ldwork, &zlarfb_c_b1, &c__[c_offset], ldc)!=TCL_OK) { return TCL_ERROR; }


		}


		if (ztrmm_(interp, "Right", "Upper", "Conjugate transpose", "Unit", &			lastc, k, &zlarfb_c_b1, &v[lastv - *k + 1 + v_dim1], ldv, &
			work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




		i__1 = *k;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = lastc;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			i__3 = lastv - *k + j + i__ * c_dim1;
			i__4 = lastv - *k + j + i__ * c_dim1;
			d_cnjg(&z__2, &work[i__ + j * work_dim1]);
			z__1.r = c__[i__4].r - z__2.r, z__1.i = c__[i__4].i - 
				z__2.i;
			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
		    }
		}

	    } else if (lsame_(side, "R")) {


		i__1 = *k, i__2 = ilazlr_(n, k, &v[v_offset], ldv);
		lastv = max(i__1,i__2);
		lastc = ilazlr_(m, &lastv, &c__[c_offset], ldc);



		i__1 = *k;
		for (j = 1; j <= i__1; ++j) {
		    if (zcopy_(interp, &lastc, &c__[(lastv - *k + j) * c_dim1 + 1], &zlarfb_c__1, 			     &work[j * work_dim1 + 1], &zlarfb_c__1)!=TCL_OK) { return TCL_ERROR; }


		}


		if (ztrmm_(interp, "Right", "Upper", "No transpose", "Unit", &lastc, k, &			zlarfb_c_b1, &v[lastv - *k + 1 + v_dim1], ldv, &work[
			work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }


		if (lastv > *k) {


		    i__1 = lastv - *k;
		    if (zgemm_(interp, "No transpose", "No transpose", &lastc, k, &i__1, &			    zlarfb_c_b1, &c__[c_offset], ldc, &v[v_offset], ldv, &
			    zlarfb_c_b1, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }


		}


		if (ztrmm_(interp, "Right", "Lower", trans, "Non-unit", &lastc, k, &zlarfb_c_b1, 			&t[t_offset], ldt, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




		if (lastv > *k) {


		    i__1 = lastv - *k;
		    z__1.r = -1., z__1.i = -0.;
		    if (zgemm_(interp, "No transpose", "Conjugate transpose", &lastc, &			    i__1, k, &z__1, &work[work_offset], ldwork, &v[
			    v_offset], ldv, &zlarfb_c_b1, &c__[c_offset], ldc)!=TCL_OK) { return TCL_ERROR; }


		}


		if (ztrmm_(interp, "Right", "Upper", "Conjugate transpose", "Unit", &			lastc, k, &zlarfb_c_b1, &v[lastv - *k + 1 + v_dim1], ldv, &
			work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




		i__1 = *k;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = lastc;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			i__3 = i__ + (lastv - *k + j) * c_dim1;
			i__4 = i__ + (lastv - *k + j) * c_dim1;
			i__5 = i__ + j * work_dim1;
			z__1.r = c__[i__4].r - work[i__5].r, z__1.i = c__[
				i__4].i - work[i__5].i;
			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
		    }
		}
	    }
	}

    } else if (lsame_(storev, "R")) {

	if (lsame_(direct, "F")) {


	    if (lsame_(side, "L")) {


		i__1 = *k, i__2 = ilazlc_(k, m, &v[v_offset], ldv);
		lastv = max(i__1,i__2);
		lastc = ilazlc_(&lastv, n, &c__[c_offset], ldc);



		i__1 = *k;
		for (j = 1; j <= i__1; ++j) {
		    if (zcopy_(interp, &lastc, &c__[j + c_dim1], ldc, &work[j * work_dim1 			    + 1], &zlarfb_c__1)!=TCL_OK) { return TCL_ERROR; }


		    if (zlacgv_(interp, &lastc, &work[j * work_dim1 + 1], &zlarfb_c__1)!=TCL_OK) { return TCL_ERROR; }

		}


		if (ztrmm_(interp, "Right", "Upper", "Conjugate transpose", "Unit", &			lastc, k, &zlarfb_c_b1, &v[v_offset], ldv, &work[work_offset]
, ldwork)
			!=TCL_OK) { return TCL_ERROR; }


		if (lastv > *k) {


		    i__1 = lastv - *k;
		    if (zgemm_(interp, "Conjugate transpose", "Conjugate transpose", &			    lastc, k, &i__1, &zlarfb_c_b1, &c__[*k + 1 + c_dim1], 
			    ldc, &v[(*k + 1) * v_dim1 + 1], ldv, &zlarfb_c_b1, &work[
			    work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }


		}


		if (ztrmm_(interp, "Right", "Upper", transt, "Non-unit", &lastc, k, &zlarfb_c_b1, 			 &t[t_offset], ldt, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




		if (lastv > *k) {


		    i__1 = lastv - *k;
		    z__1.r = -1., z__1.i = -0.;
		    if (zgemm_(interp, "Conjugate transpose", "Conjugate transpose", &			    i__1, &lastc, k, &z__1, &v[(*k + 1) * v_dim1 + 1], 
			     ldv, &work[work_offset], ldwork, &zlarfb_c_b1, &c__[*k 
			    + 1 + c_dim1], ldc)!=TCL_OK) { return TCL_ERROR; }


		}


		if (ztrmm_(interp, "Right", "Upper", "No transpose", "Unit", &lastc, k, &			zlarfb_c_b1, &v[v_offset], ldv, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




		i__1 = *k;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = lastc;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			i__3 = j + i__ * c_dim1;
			i__4 = j + i__ * c_dim1;
			d_cnjg(&z__2, &work[i__ + j * work_dim1]);
			z__1.r = c__[i__4].r - z__2.r, z__1.i = c__[i__4].i - 
				z__2.i;
			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
		    }
		}

	    } else if (lsame_(side, "R")) {


		i__1 = *k, i__2 = ilazlc_(k, n, &v[v_offset], ldv);
		lastv = max(i__1,i__2);
		lastc = ilazlr_(m, &lastv, &c__[c_offset], ldc);



		i__1 = *k;
		for (j = 1; j <= i__1; ++j) {
		    if (zcopy_(interp, &lastc, &c__[j * c_dim1 + 1], &zlarfb_c__1, &work[j * 			    work_dim1 + 1], &zlarfb_c__1)!=TCL_OK) { return TCL_ERROR; }


		}


		if (ztrmm_(interp, "Right", "Upper", "Conjugate transpose", "Unit", &			lastc, k, &zlarfb_c_b1, &v[v_offset], ldv, &work[work_offset]
, ldwork)
			!=TCL_OK) { return TCL_ERROR; }


		if (lastv > *k) {


		    i__1 = lastv - *k;
		    if (zgemm_(interp, "No transpose", "Conjugate transpose", &lastc, k, &			    i__1, &zlarfb_c_b1, &c__[(*k + 1) * c_dim1 + 1], ldc, &v[
			    (*k + 1) * v_dim1 + 1], ldv, &zlarfb_c_b1, &work[
			    work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }


		}


		if (ztrmm_(interp, "Right", "Upper", trans, "Non-unit", &lastc, k, &zlarfb_c_b1, 			&t[t_offset], ldt, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




		if (lastv > *k) {


		    i__1 = lastv - *k;
		    z__1.r = -1., z__1.i = -0.;
		    if (zgemm_(interp, "No transpose", "No transpose", &lastc, &i__1, k, &			    z__1, &work[work_offset], ldwork, &v[(*k + 1) * 
			    v_dim1 + 1], ldv, &zlarfb_c_b1, &c__[(*k + 1) * c_dim1 + 
			    1], ldc)!=TCL_OK) { return TCL_ERROR; }


		}


		if (ztrmm_(interp, "Right", "Upper", "No transpose", "Unit", &lastc, k, &			zlarfb_c_b1, &v[v_offset], ldv, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




		i__1 = *k;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = lastc;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			i__3 = i__ + j * c_dim1;
			i__4 = i__ + j * c_dim1;
			i__5 = i__ + j * work_dim1;
			z__1.r = c__[i__4].r - work[i__5].r, z__1.i = c__[
				i__4].i - work[i__5].i;
			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
		    }
		}

	    }

	} else {


	    if (lsame_(side, "L")) {


		i__1 = *k, i__2 = ilazlc_(k, m, &v[v_offset], ldv);
		lastv = max(i__1,i__2);
		lastc = ilazlc_(&lastv, n, &c__[c_offset], ldc);



		i__1 = *k;
		for (j = 1; j <= i__1; ++j) {
		    if (zcopy_(interp, &lastc, &c__[lastv - *k + j + c_dim1], ldc, &work[			    j * work_dim1 + 1], &zlarfb_c__1)!=TCL_OK) { return TCL_ERROR; }


		    if (zlacgv_(interp, &lastc, &work[j * work_dim1 + 1], &zlarfb_c__1)!=TCL_OK) { return TCL_ERROR; }

		}


		if (ztrmm_(interp, "Right", "Lower", "Conjugate transpose", "Unit", &			lastc, k, &zlarfb_c_b1, &v[(lastv - *k + 1) * v_dim1 + 1], 
			ldv, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }


		if (lastv > *k) {


		    i__1 = lastv - *k;
		    if (zgemm_(interp, "Conjugate transpose", "Conjugate transpose", &			    lastc, k, &i__1, &zlarfb_c_b1, &c__[c_offset], ldc, &v[
			    v_offset], ldv, &zlarfb_c_b1, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }


		}


		if (ztrmm_(interp, "Right", "Lower", transt, "Non-unit", &lastc, k, &zlarfb_c_b1, 			 &t[t_offset], ldt, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




		if (lastv > *k) {


		    i__1 = lastv - *k;
		    z__1.r = -1., z__1.i = -0.;
		    if (zgemm_(interp, "Conjugate transpose", "Conjugate transpose", &			    i__1, &lastc, k, &z__1, &v[v_offset], ldv, &work[
			    work_offset], ldwork, &zlarfb_c_b1, &c__[c_offset], ldc)!=TCL_OK) { return TCL_ERROR; }


		}


		if (ztrmm_(interp, "Right", "Lower", "No transpose", "Unit", &lastc, k, &			zlarfb_c_b1, &v[(lastv - *k + 1) * v_dim1 + 1], ldv, &work[
			work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




		i__1 = *k;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = lastc;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			i__3 = lastv - *k + j + i__ * c_dim1;
			i__4 = lastv - *k + j + i__ * c_dim1;
			d_cnjg(&z__2, &work[i__ + j * work_dim1]);
			z__1.r = c__[i__4].r - z__2.r, z__1.i = c__[i__4].i - 
				z__2.i;
			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
		    }
		}

	    } else if (lsame_(side, "R")) {


		i__1 = *k, i__2 = ilazlc_(k, n, &v[v_offset], ldv);
		lastv = max(i__1,i__2);
		lastc = ilazlr_(m, &lastv, &c__[c_offset], ldc);



		i__1 = *k;
		for (j = 1; j <= i__1; ++j) {
		    if (zcopy_(interp, &lastc, &c__[(lastv - *k + j) * c_dim1 + 1], &zlarfb_c__1, 			     &work[j * work_dim1 + 1], &zlarfb_c__1)!=TCL_OK) { return TCL_ERROR; }


		}


		if (ztrmm_(interp, "Right", "Lower", "Conjugate transpose", "Unit", &			lastc, k, &zlarfb_c_b1, &v[(lastv - *k + 1) * v_dim1 + 1], 
			ldv, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }


		if (lastv > *k) {


		    i__1 = lastv - *k;
		    if (zgemm_(interp, "No transpose", "Conjugate transpose", &lastc, k, &			    i__1, &zlarfb_c_b1, &c__[c_offset], ldc, &v[v_offset], 
			    ldv, &zlarfb_c_b1, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }


		}


		if (ztrmm_(interp, "Right", "Lower", trans, "Non-unit", &lastc, k, &zlarfb_c_b1, 			&t[t_offset], ldt, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




		if (lastv > *k) {


		    i__1 = lastv - *k;
		    z__1.r = -1., z__1.i = -0.;
		    if (zgemm_(interp, "No transpose", "No transpose", &lastc, &i__1, k, &			    z__1, &work[work_offset], ldwork, &v[v_offset], 
			    ldv, &zlarfb_c_b1, &c__[c_offset], ldc)!=TCL_OK) { return TCL_ERROR; }


		}


		if (ztrmm_(interp, "Right", "Lower", "No transpose", "Unit", &lastc, k, &			zlarfb_c_b1, &v[(lastv - *k + 1) * v_dim1 + 1], ldv, &work[
			work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




		i__1 = *k;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = lastc;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			i__3 = i__ + (lastv - *k + j) * c_dim1;
			i__4 = i__ + (lastv - *k + j) * c_dim1;
			i__5 = i__ + j * work_dim1;
			z__1.r = c__[i__4].r - work[i__5].r, z__1.i = c__[
				i__4].i - work[i__5].i;
			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
		    }
		}

	    }

	}
    }

return TCL_OK;


} /* zlarfb_ */
static /* Subroutine */ int zlarft_ (Tcl_Interp *interp, char *direct, char *storev, integer *n, integer *	k, doublecomplex *v, integer *ldv, doublecomplex *tau, doublecomplex *	t, integer *ldt)
{
    integer t_dim1, t_offset, v_dim1, v_offset, i__1, i__2, i__3, i__4;
    doublecomplex z__1;

    integer i__, j, prevlastv;
    doublecomplex vii;
    integer lastv;































    v_dim1 = *ldv;
    v_offset = 1 + v_dim1;
    v -= v_offset;
    --tau;
    t_dim1 = *ldt;
    t_offset = 1 + t_dim1;
    t -= t_offset;

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

    if (lsame_(direct, "F")) {
	prevlastv = *n;
	i__1 = *k;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    prevlastv = max(prevlastv,i__);
	    i__2 = i__;
	    if (tau[i__2].r == 0. && tau[i__2].i == 0.) {


		i__2 = i__;
		for (j = 1; j <= i__2; ++j) {
		    i__3 = j + i__ * t_dim1;
		    t[i__3].r = 0., t[i__3].i = 0.;
		}
	    } else {


		i__2 = i__ + i__ * v_dim1;
		vii.r = v[i__2].r, vii.i = v[i__2].i;
		i__2 = i__ + i__ * v_dim1;
		v[i__2].r = 1., v[i__2].i = 0.;
		if (lsame_(storev, "C")) {
		    i__2 = i__ + 1;
		    for (lastv = *n; lastv >= i__2; --lastv) {
			i__3 = lastv + i__ * v_dim1;
			if (v[i__3].r != 0. || v[i__3].i != 0.) {
			    break;
			}
		    }
		    j = min(lastv,prevlastv);


		    i__2 = j - i__ + 1;
		    i__3 = i__ - 1;
		    i__4 = i__;
		    z__1.r = -tau[i__4].r, z__1.i = -tau[i__4].i;
		    if (zgemv_(interp, "Conjugate transpose", &i__2, &i__3, &z__1, &v[i__ 			    + v_dim1], ldv, &v[i__ + i__ * v_dim1], &zlarft_c__1, &
			    zlarft_c_b2, &t[i__ * t_dim1 + 1], &zlarft_c__1)!=TCL_OK) { return TCL_ERROR; }


		} else {
		    i__2 = i__ + 1;
		    for (lastv = *n; lastv >= i__2; --lastv) {
			i__3 = i__ + lastv * v_dim1;
			if (v[i__3].r != 0. || v[i__3].i != 0.) {
			    break;
			}
		    }
		    j = min(lastv,prevlastv);


		    if (i__ < j) {
			i__2 = j - i__;
			if (zlacgv_(interp, &i__2, &v[i__ + (i__ + 1) * v_dim1], ldv)!=TCL_OK) { return TCL_ERROR; }

		    }
		    i__2 = i__ - 1;
		    i__3 = j - i__ + 1;
		    i__4 = i__;
		    z__1.r = -tau[i__4].r, z__1.i = -tau[i__4].i;
		    if (zgemv_(interp, "No transpose", &i__2, &i__3, &z__1, &v[i__ * 			    v_dim1 + 1], ldv, &v[i__ + i__ * v_dim1], ldv, &
			    zlarft_c_b2, &t[i__ * t_dim1 + 1], &zlarft_c__1)!=TCL_OK) { return TCL_ERROR; }


		    if (i__ < j) {
			i__2 = j - i__;
			if (zlacgv_(interp, &i__2, &v[i__ + (i__ + 1) * v_dim1], ldv)!=TCL_OK) { return TCL_ERROR; }

		    }
		}
		i__2 = i__ + i__ * v_dim1;
		v[i__2].r = vii.r, v[i__2].i = vii.i;


		i__2 = i__ - 1;
		if (ztrmv_(interp, "Upper", "No transpose", "Non-unit", &i__2, &t[			t_offset], ldt, &t[i__ * t_dim1 + 1], &zlarft_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = i__ + i__ * t_dim1;
		i__3 = i__;
		t[i__2].r = tau[i__3].r, t[i__2].i = tau[i__3].i;
		if (i__ > 1) {
		    prevlastv = max(prevlastv,lastv);
		} else {
		    prevlastv = lastv;
		}
	    }
	}
    } else {
	prevlastv = 1;
	for (i__ = *k; i__ >= 1; --i__) {
	    i__1 = i__;
	    if (tau[i__1].r == 0. && tau[i__1].i == 0.) {


		i__1 = *k;
		for (j = i__; j <= i__1; ++j) {
		    i__2 = j + i__ * t_dim1;
		    t[i__2].r = 0., t[i__2].i = 0.;
		}
	    } else {


		if (i__ < *k) {
		    if (lsame_(storev, "C")) {
			i__1 = *n - *k + i__ + i__ * v_dim1;
			vii.r = v[i__1].r, vii.i = v[i__1].i;
			i__1 = *n - *k + i__ + i__ * v_dim1;
			v[i__1].r = 1., v[i__1].i = 0.;
			i__1 = i__ - 1;
			for (lastv = 1; lastv <= i__1; ++lastv) {
			    i__2 = lastv + i__ * v_dim1;
			    if (v[i__2].r != 0. || v[i__2].i != 0.) {
				break;
			    }
			}
			j = max(lastv,prevlastv);


			i__1 = *n - *k + i__ - j + 1;
			i__2 = *k - i__;
			i__3 = i__;
			z__1.r = -tau[i__3].r, z__1.i = -tau[i__3].i;
			if (zgemv_(interp, "Conjugate transpose", &i__1, &i__2, &z__1, &v[				j + (i__ + 1) * v_dim1], ldv, &v[j + i__ * 
				v_dim1], &zlarft_c__1, &zlarft_c_b2, &t[i__ + 1 + i__ * 
				t_dim1], &zlarft_c__1)!=TCL_OK) { return TCL_ERROR; }


			i__1 = *n - *k + i__ + i__ * v_dim1;
			v[i__1].r = vii.r, v[i__1].i = vii.i;
		    } else {
			i__1 = i__ + (*n - *k + i__) * v_dim1;
			vii.r = v[i__1].r, vii.i = v[i__1].i;
			i__1 = i__ + (*n - *k + i__) * v_dim1;
			v[i__1].r = 1., v[i__1].i = 0.;
			i__1 = i__ - 1;
			for (lastv = 1; lastv <= i__1; ++lastv) {
			    i__2 = i__ + lastv * v_dim1;
			    if (v[i__2].r != 0. || v[i__2].i != 0.) {
				break;
			    }
			}
			j = max(lastv,prevlastv);


			i__1 = *n - *k + i__ - 1 - j + 1;
			if (zlacgv_(interp, &i__1, &v[i__ + j * v_dim1], ldv)!=TCL_OK) { return TCL_ERROR; }

			i__1 = *k - i__;
			i__2 = *n - *k + i__ - j + 1;
			i__3 = i__;
			z__1.r = -tau[i__3].r, z__1.i = -tau[i__3].i;
			if (zgemv_(interp, "No transpose", &i__1, &i__2, &z__1, &v[i__ + 				1 + j * v_dim1], ldv, &v[i__ + j * v_dim1], 
				ldv, &zlarft_c_b2, &t[i__ + 1 + i__ * t_dim1], &zlarft_c__1)!=TCL_OK) { return TCL_ERROR; }


			i__1 = *n - *k + i__ - 1 - j + 1;
			if (zlacgv_(interp, &i__1, &v[i__ + j * v_dim1], ldv)!=TCL_OK) { return TCL_ERROR; }

			i__1 = i__ + (*n - *k + i__) * v_dim1;
			v[i__1].r = vii.r, v[i__1].i = vii.i;
		    }


		    i__1 = *k - i__;
		    if (ztrmv_(interp, "Lower", "No transpose", "Non-unit", &i__1, &t[i__ 			    + 1 + (i__ + 1) * t_dim1], ldt, &t[i__ + 1 + i__ *
			     t_dim1], &zlarft_c__1)
			    !=TCL_OK) { return TCL_ERROR; }


		    if (i__ > 1) {
			prevlastv = min(prevlastv,lastv);
		    } else {
			prevlastv = lastv;
		    }
		}
		i__1 = i__ + i__ * t_dim1;
		i__2 = i__;
		t[i__1].r = tau[i__2].r, t[i__1].i = tau[i__2].i;
	    }
	}
    }
return TCL_OK;


} /* zlarft_ */
static /* Subroutine */ int zgeqr2_ (Tcl_Interp *interp, integer *m, integer *n, doublecomplex *a, 	integer *lda, doublecomplex *tau, doublecomplex *work, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3;
    doublecomplex z__1;

    void d_cnjg(doublecomplex *, doublecomplex *);

    integer i__, k;
    doublecomplex alpha;























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

    *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);
	vectcl_xerbla(interp, "ZGEQR2", &i__1);
return TCL_ERROR;

return TCL_OK;
    }

    k = min(*m,*n);

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


	i__2 = *m - i__ + 1;
	i__3 = i__ + 1;
	if (zlarfp_(interp, &i__2, &a[i__ + i__ * a_dim1], &a[min(i__3, *m)+ i__ * a_dim1], &zgeqr2_c__1, &tau[i__])!=TCL_OK) { return TCL_ERROR; }


	if (i__ < *n) {


	    i__2 = i__ + i__ * a_dim1;
	    alpha.r = a[i__2].r, alpha.i = a[i__2].i;
	    i__2 = i__ + i__ * a_dim1;
	    a[i__2].r = 1., a[i__2].i = 0.;
	    i__2 = *m - i__ + 1;
	    i__3 = *n - i__;
	    d_cnjg(&z__1, &tau[i__]);
	    if (zlarf_(interp, "Left", &i__2, &i__3, &a[i__ + i__ * a_dim1], &zgeqr2_c__1, &z__1, 		     &a[i__ + (i__ + 1) * a_dim1], lda, &work[1])!=TCL_OK) { return TCL_ERROR; }


	    i__2 = i__ + i__ * a_dim1;
	    a[i__2].r = alpha.r, a[i__2].i = alpha.i;
	}
    }
return TCL_OK;


} /* zgeqr2_ */
static /* Subroutine */ int zungl2_ (Tcl_Interp *interp, integer *m, integer *n, integer *k, 	doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *	work, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3;
    doublecomplex z__1, z__2;

    void d_cnjg(doublecomplex *, doublecomplex *);

    integer i__, j, l;




















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

    *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);
	vectcl_xerbla(interp, "ZUNGL2", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


    if (*m <= 0) {
return TCL_OK;
    }

    if (*k < *m) {


	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *m;
	    for (l = *k + 1; l <= i__2; ++l) {
		i__3 = l + j * a_dim1;
		a[i__3].r = 0., a[i__3].i = 0.;
	    }
	    if (j > *k && j <= *m) {
		i__2 = j + j * a_dim1;
		a[i__2].r = 1., a[i__2].i = 0.;
	    }
	}
    }

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


	if (i__ < *n) {
	    i__1 = *n - i__;
	    if (zlacgv_(interp, &i__1, &a[i__ + (i__ + 1) * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }

	    if (i__ < *m) {
		i__1 = i__ + i__ * a_dim1;
		a[i__1].r = 1., a[i__1].i = 0.;
		i__1 = *m - i__;
		i__2 = *n - i__ + 1;
		d_cnjg(&z__1, &tau[i__]);
		if (zlarf_(interp, "Right", &i__1, &i__2, &a[i__ + i__ * a_dim1], lda, &			z__1, &a[i__ + 1 + i__ * a_dim1], lda, &work[1])!=TCL_OK) { return TCL_ERROR; }


	    }
	    i__1 = *n - i__;
	    i__2 = i__;
	    z__1.r = -tau[i__2].r, z__1.i = -tau[i__2].i;
	    if (zscal_(interp, &i__1, &z__1, &a[i__ + (i__ + 1) * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }

	    i__1 = *n - i__;
	    if (zlacgv_(interp, &i__1, &a[i__ + (i__ + 1) * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }

	}
	i__1 = i__ + i__ * a_dim1;
	d_cnjg(&z__2, &tau[i__]);
	z__1.r = 1. - z__2.r, z__1.i = 0. - z__2.i;
	a[i__1].r = z__1.r, a[i__1].i = z__1.i;


	i__1 = i__ - 1;
	for (l = 1; l <= i__1; ++l) {
	    i__2 = i__ + l * a_dim1;
	    a[i__2].r = 0., a[i__2].i = 0.;
	}
    }
return TCL_OK;


} /* zungl2_ */
static /* Subroutine */ int zung2r_ (Tcl_Interp *interp, integer *m, integer *n, integer *k, 	doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *	work, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3;
    doublecomplex z__1;

    integer i__, j, l;




















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

    *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);
	vectcl_xerbla(interp, "ZUNG2R", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


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


    i__1 = *n;
    for (j = *k + 1; j <= i__1; ++j) {
	i__2 = *m;
	for (l = 1; l <= i__2; ++l) {
	    i__3 = l + j * a_dim1;
	    a[i__3].r = 0., a[i__3].i = 0.;
	}
	i__2 = j + j * a_dim1;
	a[i__2].r = 1., a[i__2].i = 0.;
    }

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


	if (i__ < *n) {
	    i__1 = i__ + i__ * a_dim1;
	    a[i__1].r = 1., a[i__1].i = 0.;
	    i__1 = *m - i__ + 1;
	    i__2 = *n - i__;
	    if (zlarf_(interp, "Left", &i__1, &i__2, &a[i__ + i__ * a_dim1], &zung2r_c__1, &tau[		    i__], &a[i__ + (i__ + 1) * a_dim1], lda, &work[1])!=TCL_OK) { return TCL_ERROR; }


	}
	if (i__ < *m) {
	    i__1 = *m - i__;
	    i__2 = i__;
	    z__1.r = -tau[i__2].r, z__1.i = -tau[i__2].i;
	    if (zscal_(interp, &i__1, &z__1, &a[i__ + 1 + i__ * a_dim1], &zung2r_c__1)!=TCL_OK) { return TCL_ERROR; }

	}
	i__1 = i__ + i__ * a_dim1;
	i__2 = i__;
	z__1.r = 1. - tau[i__2].r, z__1.i = 0. - tau[i__2].i;
	a[i__1].r = z__1.r, a[i__1].i = z__1.i;


	i__1 = i__ - 1;
	for (l = 1; l <= i__1; ++l) {
	    i__2 = l + i__ * a_dim1;
	    a[i__2].r = 0., a[i__2].i = 0.;
	}
    }
return TCL_OK;


} /* zung2r_ */
static doublereal ddot_ (integer *n, doublereal *dx, integer *incx, doublereal *dy, 	integer *incy)
{
    integer i__1;
    doublereal ret_val;

    integer i__, m, ix, iy, mp1;
    doublereal dtemp;





    --dy;
    --dx;

    ret_val = 0.;
    dtemp = 0.;
    if (*n <= 0) {
	return ret_val;
    }
    if (*incx == 1 && *incy == 1) {
	goto L20;
    }


    ix = 1;
    iy = 1;
    if (*incx < 0) {
	ix = (-(*n) + 1) * *incx + 1;
    }
    if (*incy < 0) {
	iy = (-(*n) + 1) * *incy + 1;
    }
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	dtemp += dx[ix] * dy[iy];
	ix += *incx;
	iy += *incy;
    }
    ret_val = dtemp;
    return ret_val;




L20:
    m = *n % 5;
    if (m == 0) {
	goto L40;
    }
    i__1 = m;
    for (i__ = 1; i__ <= i__1; ++i__) {
	dtemp += dx[i__] * dy[i__];
    }
    if (*n < 5) {
	goto L60;
    }
L40:
    mp1 = m + 1;
    i__1 = *n;
    for (i__ = mp1; i__ <= i__1; i__ += 5) {
	dtemp = dtemp + dx[i__] * dy[i__] + dx[i__ + 1] * dy[i__ + 1] + dx[
		i__ + 2] * dy[i__ + 2] + dx[i__ + 3] * dy[i__ + 3] + dx[i__ + 
		4] * dy[i__ + 4];
    }
L60:
    ret_val = dtemp;
    return ret_val;
} /* ddot_ */
static doublereal dasum_ (integer *n, doublereal *dx, integer *incx)
{
    integer i__1, i__2;
    doublereal ret_val, d__1, d__2, d__3, d__4, d__5, d__6;

    integer i__, m, mp1;
    doublereal dtemp;
    integer nincx;





    --dx;

    ret_val = 0.;
    dtemp = 0.;
    if (*n <= 0 || *incx <= 0) {
	return ret_val;
    }
    if (*incx == 1) {
	goto L20;
    }


    nincx = *n * *incx;
    i__1 = nincx;
    i__2 = *incx;
    for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
	dtemp += (d__1 = dx[i__], abs(d__1));
    }
    ret_val = dtemp;
    return ret_val;




L20:
    m = *n % 6;
    if (m == 0) {
	goto L40;
    }
    i__2 = m;
    for (i__ = 1; i__ <= i__2; ++i__) {
	dtemp += (d__1 = dx[i__], abs(d__1));
    }
    if (*n < 6) {
	goto L60;
    }
L40:
    mp1 = m + 1;
    i__2 = *n;
    for (i__ = mp1; i__ <= i__2; i__ += 6) {
	dtemp = dtemp + (d__1 = dx[i__], abs(d__1)) + (d__2 = dx[i__ + 1], 
		abs(d__2)) + (d__3 = dx[i__ + 2], abs(d__3)) + (d__4 = dx[i__ 
		+ 3], abs(d__4)) + (d__5 = dx[i__ + 4], abs(d__5)) + (d__6 = 
		dx[i__ + 5], abs(d__6));
    }
L60:
    ret_val = dtemp;
    return ret_val;
} /* dasum_ */
static /* Subroutine */ int daxpy_ (Tcl_Interp *interp, integer *n, doublereal *da, doublereal *dx, 	integer *incx, doublereal *dy, integer *incy)
{
    integer i__1;

    integer i__, m, ix, iy, mp1;





    --dy;
    --dx;

    if (*n <= 0) {
return TCL_OK;
    }
    if (*da == 0.) {
return TCL_OK;
    }
    if (*incx == 1 && *incy == 1) {
	goto L20;
    }


    ix = 1;
    iy = 1;
    if (*incx < 0) {
	ix = (-(*n) + 1) * *incx + 1;
    }
    if (*incy < 0) {
	iy = (-(*n) + 1) * *incy + 1;
    }
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	dy[iy] += *da * dx[ix];
	ix += *incx;
	iy += *incy;
    }
return TCL_OK;




L20:
    m = *n % 4;
    if (m == 0) {
	goto L40;
    }
    i__1 = m;
    for (i__ = 1; i__ <= i__1; ++i__) {
	dy[i__] += *da * dx[i__];
    }
    if (*n < 4) {
return TCL_OK;
    }
L40:
    mp1 = m + 1;
    i__1 = *n;
    for (i__ = mp1; i__ <= i__1; i__ += 4) {
	dy[i__] += *da * dx[i__];
	dy[i__ + 1] += *da * dx[i__ + 1];
	dy[i__ + 2] += *da * dx[i__ + 2];
	dy[i__ + 3] += *da * dx[i__ + 3];
    }
return TCL_OK;
} /* daxpy_ */
static /* Subroutine */ int dlagtf_ (Tcl_Interp *interp, integer *n, doublereal *a, doublereal *lambda, 	doublereal *b, doublereal *c__, doublereal *tol, doublereal *d__, 	integer *in, integer *info)
{
    integer i__1;
    doublereal d__1, d__2;

    integer k;
    doublereal tl, eps, piv1, piv2, temp, mult, scale1, scale2;



























    --in;
    --d__;
    --c__;
    --b;
    --a;

    *info = 0;
    if (*n < 0) {
	*info = -1;
	i__1 = -(*info);
	vectcl_xerbla(interp, "DLAGTF", &i__1);
return TCL_ERROR;

return TCL_OK;
    }

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

    a[1] -= *lambda;
    in[*n] = 0;
    if (*n == 1) {
	if (a[1] == 0.) {
	    in[1] = 1;
	}
return TCL_OK;
    }

    eps = dlamch_("Epsilon");

    tl = max(*tol,eps);
    scale1 = abs(a[1]) + abs(b[1]);
    i__1 = *n - 1;
    for (k = 1; k <= i__1; ++k) {
	a[k + 1] -= *lambda;
	scale2 = (d__1 = c__[k], abs(d__1)) + (d__2 = a[k + 1], abs(d__2));
	if (k < *n - 1) {
	    scale2 += (d__1 = b[k + 1], abs(d__1));
	}
	if (a[k] == 0.) {
	    piv1 = 0.;
	} else {
	    piv1 = (d__1 = a[k], abs(d__1)) / scale1;
	}
	if (c__[k] == 0.) {
	    in[k] = 0;
	    piv2 = 0.;
	    scale1 = scale2;
	    if (k < *n - 1) {
		d__[k] = 0.;
	    }
	} else {
	    piv2 = (d__1 = c__[k], abs(d__1)) / scale2;
	    if (piv2 <= piv1) {
		in[k] = 0;
		scale1 = scale2;
		c__[k] /= a[k];
		a[k + 1] -= c__[k] * b[k];
		if (k < *n - 1) {
		    d__[k] = 0.;
		}
	    } else {
		in[k] = 1;
		mult = a[k] / c__[k];
		a[k] = c__[k];
		temp = a[k + 1];
		a[k + 1] = b[k] - mult * temp;
		if (k < *n - 1) {
		    d__[k] = b[k + 1];
		    b[k + 1] = -mult * d__[k];
		}
		b[k] = temp;
		c__[k] = mult;
	    }
	}
	if (max(piv1,piv2) <= tl && in[*n] == 0) {
	    in[*n] = k;
	}
    }
    if ((d__1 = a[*n], abs(d__1)) <= scale1 * tl && in[*n] == 0) {
	in[*n] = *n;
    }

return TCL_OK;


} /* dlagtf_ */
static /* Subroutine */ int dlagts_ (Tcl_Interp *interp, integer *job, integer *n, doublereal *a, 	doublereal *b, doublereal *c__, doublereal *d__, integer *in, 	doublereal *y, doublereal *tol, integer *info)
{
    integer i__1;
    doublereal d__1, d__2, d__3, d__4, d__5;

    double d_sign(doublereal *, doublereal *);

    integer k;
    doublereal ak, eps, temp, pert, absak, sfmin;
    doublereal bignum;
























    --y;
    --in;
    --d__;
    --c__;
    --b;
    --a;

    *info = 0;
    if (abs(*job) > 2 || *job == 0) {
	*info = -1;
    } else if (*n < 0) {
	*info = -2;
    }
    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DLAGTS", &i__1);
return TCL_ERROR;

return TCL_OK;
    }

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

    eps = dlamch_("Epsilon");
    sfmin = dlamch_("Safe minimum");
    bignum = 1. / sfmin;

    if (*job < 0) {
	if (*tol <= 0.) {
	    *tol = abs(a[1]);
	    if (*n > 1) {
		d__1 = *tol, d__2 = abs(a[2]), d__1 = max(d__1,d__2), d__2 = 
			abs(b[1]);
		*tol = max(d__1,d__2);
	    }
	    i__1 = *n;
	    for (k = 3; k <= i__1; ++k) {
		d__4 = *tol, d__5 = (d__1 = a[k], abs(d__1)), d__4 = max(d__4,
			d__5), d__5 = (d__2 = b[k - 1], abs(d__2)), d__4 = 
			max(d__4,d__5), d__5 = (d__3 = d__[k - 2], abs(d__3));
		*tol = max(d__4,d__5);
	    }
	    *tol *= eps;
	    if (*tol == 0.) {
		*tol = eps;
	    }
	}
    }

    if (abs(*job) == 1) {
	i__1 = *n;
	for (k = 2; k <= i__1; ++k) {
	    if (in[k - 1] == 0) {
		y[k] -= c__[k - 1] * y[k - 1];
	    } else {
		temp = y[k - 1];
		y[k - 1] = y[k];
		y[k] = temp - c__[k - 1] * y[k];
	    }
	}
	if (*job == 1) {
	    for (k = *n; k >= 1; --k) {
		if (k <= *n - 2) {
		    temp = y[k] - b[k] * y[k + 1] - d__[k] * y[k + 2];
		} else if (k == *n - 1) {
		    temp = y[k] - b[k] * y[k + 1];
		} else {
		    temp = y[k];
		}
		ak = a[k];
		absak = abs(ak);
		if (absak < 1.) {
		    if (absak < sfmin) {
			if (absak == 0. || abs(temp) * sfmin > absak) {
			    *info = k;
return TCL_OK;
			} else {
			    temp *= bignum;
			    ak *= bignum;
			}
		    } else if (abs(temp) > absak * bignum) {
			*info = k;
return TCL_OK;
		    }
		}
		y[k] = temp / ak;
	    }
	} else {
	    for (k = *n; k >= 1; --k) {
		if (k <= *n - 2) {
		    temp = y[k] - b[k] * y[k + 1] - d__[k] * y[k + 2];
		} else if (k == *n - 1) {
		    temp = y[k] - b[k] * y[k + 1];
		} else {
		    temp = y[k];
		}
		ak = a[k];
		pert = d_sign(tol, &ak);
L40:
		absak = abs(ak);
		if (absak < 1.) {
		    if (absak < sfmin) {
			if (absak == 0. || abs(temp) * sfmin > absak) {
			    ak += pert;
			    pert *= 2;
			    goto L40;
			} else {
			    temp *= bignum;
			    ak *= bignum;
			}
		    } else if (abs(temp) > absak * bignum) {
			ak += pert;
			pert *= 2;
			goto L40;
		    }
		}
		y[k] = temp / ak;
	    }
	}
    } else {


	if (*job == 2) {
	    i__1 = *n;
	    for (k = 1; k <= i__1; ++k) {
		if (k >= 3) {
		    temp = y[k] - b[k - 1] * y[k - 1] - d__[k - 2] * y[k - 2];
		} else if (k == 2) {
		    temp = y[k] - b[k - 1] * y[k - 1];
		} else {
		    temp = y[k];
		}
		ak = a[k];
		absak = abs(ak);
		if (absak < 1.) {
		    if (absak < sfmin) {
			if (absak == 0. || abs(temp) * sfmin > absak) {
			    *info = k;
return TCL_OK;
			} else {
			    temp *= bignum;
			    ak *= bignum;
			}
		    } else if (abs(temp) > absak * bignum) {
			*info = k;
return TCL_OK;
		    }
		}
		y[k] = temp / ak;
	    }
	} else {
	    i__1 = *n;
	    for (k = 1; k <= i__1; ++k) {
		if (k >= 3) {
		    temp = y[k] - b[k - 1] * y[k - 1] - d__[k - 2] * y[k - 2];
		} else if (k == 2) {
		    temp = y[k] - b[k - 1] * y[k - 1];
		} else {
		    temp = y[k];
		}
		ak = a[k];
		pert = d_sign(tol, &ak);
L70:
		absak = abs(ak);
		if (absak < 1.) {
		    if (absak < sfmin) {
			if (absak == 0. || abs(temp) * sfmin > absak) {
			    ak += pert;
			    pert *= 2;
			    goto L70;
			} else {
			    temp *= bignum;
			    ak *= bignum;
			}
		    } else if (abs(temp) > absak * bignum) {
			ak += pert;
			pert *= 2;
			goto L70;
		    }
		}
		y[k] = temp / ak;
	    }
	}

	for (k = *n; k >= 2; --k) {
	    if (in[k - 1] == 0) {
		y[k - 1] -= c__[k - 1] * y[k];
	    } else {
		temp = y[k - 1];
		y[k - 1] = y[k];
		y[k] = temp - c__[k - 1] * y[k];
	    }
	}
    }


return TCL_OK;
} /* dlagts_ */
static /* Subroutine */ int dlarnv_ (Tcl_Interp *interp, integer *idist, integer *iseed, integer *n, 	doublereal *x)
{
    integer i__1, i__2, i__3;

    double log(doublereal), sqrt(doublereal), cos(doublereal);

    integer i__;
    doublereal u[128];
    integer il, iv, il2;















    --x;
    --iseed;

    i__1 = *n;
    for (iv = 1; iv <= i__1; iv += 64) {
	i__2 = 64, i__3 = *n - iv + 1;
	il = min(i__2,i__3);
	if (*idist == 3) {
	    il2 = il << 1;
	} else {
	    il2 = il;
	}


	if (dlaruv_(interp, &iseed[1], &il2, u)!=TCL_OK) { return TCL_ERROR; }


	if (*idist == 1) {


	    i__2 = il;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		x[iv + i__ - 1] = u[i__ - 1];
	    }
	} else if (*idist == 2) {


	    i__2 = il;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		x[iv + i__ - 1] = u[i__ - 1] * 2. - 1.;
	    }
	} else if (*idist == 3) {


	    i__2 = il;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		x[iv + i__ - 1] = sqrt(log(u[(i__ << 1) - 2]) * -2.) * cos(u[(
			i__ << 1) - 1] * 6.2831853071795864769252867663);
	    }
	}
    }
return TCL_OK;


} /* dlarnv_ */
static /* Subroutine */ int dlae2_ (Tcl_Interp *interp, doublereal *a, doublereal *b, doublereal *c__, 	doublereal *rt1, doublereal *rt2)
{
    doublereal d__1;

    double sqrt(doublereal);

    doublereal ab, df, tb, sm, rt, adf, acmn, acmx;



















    sm = *a + *c__;
    df = *a - *c__;
    adf = abs(df);
    tb = *b + *b;
    ab = abs(tb);
    if (abs(*a) > abs(*c__)) {
	acmx = *a;
	acmn = *c__;
    } else {
	acmx = *c__;
	acmn = *a;
    }
    if (adf > ab) {
	d__1 = ab / adf;
	rt = adf * sqrt(d__1 * d__1 + 1.);
    } else if (adf < ab) {
	d__1 = adf / ab;
	rt = ab * sqrt(d__1 * d__1 + 1.);
    } else {


	rt = ab * sqrt(2.);
    }
    if (sm < 0.) {
	*rt1 = (sm - rt) * .5;


	*rt2 = acmx / *rt1 * acmn - *b / *rt1 * *b;
    } else if (sm > 0.) {
	*rt1 = (sm + rt) * .5;


	*rt2 = acmx / *rt1 * acmn - *b / *rt1 * *b;
    } else {


	*rt1 = rt * .5;
	*rt2 = rt * -.5;
    }
return TCL_OK;


} /* dlae2_ */
static /* Subroutine */ int dlasrt_ (Tcl_Interp *interp, char *id, integer *n, doublereal *d__, integer *	info)
{
    integer i__1, i__2;

    integer i__, j;
    doublereal d1, d2, d3;
    integer dir;
    doublereal tmp;
    integer endd;
    integer stack[64]	/* was [2][32] */;
    doublereal dmnmx;
    integer start;
    integer stkpnt;















    --d__;

    *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);
	vectcl_xerbla(interp, "DLASRT", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


    if (*n <= 1) {
return TCL_OK;
    }

    stkpnt = 1;
    stack[0] = 1;
    stack[1] = *n;
L10:
    start = stack[(stkpnt << 1) - 2];
    endd = stack[(stkpnt << 1) - 1];
    --stkpnt;
    if (endd - start <= 20 && endd - start > 0) {


	if (dir == 0) {


	    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;
		    }
		}
L30:
		;
	    }

	} else {


	    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;
		    }
		}
L50:
		;
	    }

	}

    } else if (endd - start > 20) {



	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) {


	    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[(stkpnt << 1) - 2] = start;
		stack[(stkpnt << 1) - 1] = j;
		++stkpnt;
		stack[(stkpnt << 1) - 2] = j + 1;
		stack[(stkpnt << 1) - 1] = endd;
	    } else {
		++stkpnt;
		stack[(stkpnt << 1) - 2] = j + 1;
		stack[(stkpnt << 1) - 1] = endd;
		++stkpnt;
		stack[(stkpnt << 1) - 2] = start;
		stack[(stkpnt << 1) - 1] = j;
	    }
	} else {


	    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[(stkpnt << 1) - 2] = start;
		stack[(stkpnt << 1) - 1] = j;
		++stkpnt;
		stack[(stkpnt << 1) - 2] = j + 1;
		stack[(stkpnt << 1) - 1] = endd;
	    } else {
		++stkpnt;
		stack[(stkpnt << 1) - 2] = j + 1;
		stack[(stkpnt << 1) - 1] = endd;
		++stkpnt;
		stack[(stkpnt << 1) - 2] = start;
		stack[(stkpnt << 1) - 1] = j;
	    }
	}
    }
    if (stkpnt > 0) {
	goto L10;
    }
return TCL_OK;


} /* dlasrt_ */
static /* Subroutine */ int dlaebz_ (Tcl_Interp *interp, integer *ijob, integer *nitmax, integer *n, 	integer *mmax, integer *minp, integer *nbmin, doublereal *abstol, 	doublereal *reltol, doublereal *pivmin, doublereal *d__, doublereal *	e, doublereal *e2, integer *nval, doublereal *ab, doublereal *c__, 	integer *mout, integer *nab, doublereal *work, integer *iwork, 	integer *info)
{
    integer nab_dim1, nab_offset, ab_dim1, ab_offset, i__1, i__2, i__3, i__4, 
	    i__5, i__6;
    doublereal d__1, d__2, d__3, d__4;

    integer j, kf, ji, kl, jp, jit;
    doublereal tmp1, tmp2;
    integer itmp1, itmp2, kfnew, klnew;








































    nab_dim1 = *mmax;
    nab_offset = 1 + nab_dim1;
    nab -= nab_offset;
    ab_dim1 = *mmax;
    ab_offset = 1 + ab_dim1;
    ab -= ab_offset;
    --d__;
    --e;
    --e2;
    --nval;
    --c__;
    --work;
    --iwork;

    *info = 0;
    if (*ijob < 1 || *ijob > 3) {
	*info = -1;
return TCL_OK;
    }


    if (*ijob == 1) {


	*mout = 0;
	i__1 = *minp;
	for (ji = 1; ji <= i__1; ++ji) {
	    for (jp = 1; jp <= 2; ++jp) {
		tmp1 = d__[1] - ab[ji + jp * ab_dim1];
		if (abs(tmp1) < *pivmin) {
		    tmp1 = -(*pivmin);
		}
		nab[ji + jp * nab_dim1] = 0;
		if (tmp1 <= 0.) {
		    nab[ji + jp * nab_dim1] = 1;
		}

		i__2 = *n;
		for (j = 2; j <= i__2; ++j) {
		    tmp1 = d__[j] - e2[j - 1] / tmp1 - ab[ji + jp * ab_dim1];
		    if (abs(tmp1) < *pivmin) {
			tmp1 = -(*pivmin);
		    }
		    if (tmp1 <= 0.) {
			++nab[ji + jp * nab_dim1];
		    }
		}
	    }
	    *mout = *mout + nab[ji + (nab_dim1 << 1)] - nab[ji + nab_dim1];
	}
return TCL_OK;
    }



    kf = 1;
    kl = *minp;


    if (*ijob == 2) {
	i__1 = *minp;
	for (ji = 1; ji <= i__1; ++ji) {
	    c__[ji] = (ab[ji + ab_dim1] + ab[ji + (ab_dim1 << 1)]) * .5;
	}
    }


    i__1 = *nitmax;
    for (jit = 1; jit <= i__1; ++jit) {


	if (kl - kf + 1 >= *nbmin && *nbmin > 0) {


	    i__2 = kl;
	    for (ji = kf; ji <= i__2; ++ji) {


		work[ji] = d__[1] - c__[ji];
		iwork[ji] = 0;
		if (work[ji] <= *pivmin) {
		    iwork[ji] = 1;
		    d__1 = work[ji], d__2 = -(*pivmin);
		    work[ji] = min(d__1,d__2);
		}

		i__3 = *n;
		for (j = 2; j <= i__3; ++j) {
		    work[ji] = d__[j] - e2[j - 1] / work[ji] - c__[ji];
		    if (work[ji] <= *pivmin) {
			++iwork[ji];
			d__1 = work[ji], d__2 = -(*pivmin);
			work[ji] = min(d__1,d__2);
		    }
		}
	    }

	    if (*ijob <= 2) {


		klnew = kl;
		i__2 = kl;
		for (ji = kf; ji <= i__2; ++ji) {


		    i__5 = nab[ji + nab_dim1], i__6 = iwork[ji];
		    i__3 = nab[ji + (nab_dim1 << 1)], i__4 = max(i__5,i__6);
		    iwork[ji] = min(i__3,i__4);


		    if (iwork[ji] == nab[ji + (nab_dim1 << 1)]) {


			ab[ji + (ab_dim1 << 1)] = c__[ji];

		    } else if (iwork[ji] == nab[ji + nab_dim1]) {


			ab[ji + ab_dim1] = c__[ji];
		    } else {
			++klnew;
			if (klnew <= *mmax) {


			    ab[klnew + (ab_dim1 << 1)] = ab[ji + (ab_dim1 << 
				    1)];
			    nab[klnew + (nab_dim1 << 1)] = nab[ji + (nab_dim1 
				    << 1)];
			    ab[klnew + ab_dim1] = c__[ji];
			    nab[klnew + nab_dim1] = iwork[ji];
			    ab[ji + (ab_dim1 << 1)] = c__[ji];
			    nab[ji + (nab_dim1 << 1)] = iwork[ji];
			} else {
			    *info = *mmax + 1;
			}
		    }
		}
		if (*info != 0) {
return TCL_OK;
		}
		kl = klnew;
	    } else {


		i__2 = kl;
		for (ji = kf; ji <= i__2; ++ji) {
		    if (iwork[ji] <= nval[ji]) {
			ab[ji + ab_dim1] = c__[ji];
			nab[ji + nab_dim1] = iwork[ji];
		    }
		    if (iwork[ji] >= nval[ji]) {
			ab[ji + (ab_dim1 << 1)] = c__[ji];
			nab[ji + (nab_dim1 << 1)] = iwork[ji];
		    }
		}
	    }

	} else {



	    klnew = kl;
	    i__2 = kl;
	    for (ji = kf; ji <= i__2; ++ji) {


		tmp1 = c__[ji];
		tmp2 = d__[1] - tmp1;
		itmp1 = 0;
		if (tmp2 <= *pivmin) {
		    itmp1 = 1;
		    d__1 = tmp2, d__2 = -(*pivmin);
		    tmp2 = min(d__1,d__2);
		}



		i__3 = *n;
		for (j = 2; j <= i__3; ++j) {
		    tmp2 = d__[j] - e2[j - 1] / tmp2 - tmp1;
		    if (tmp2 <= *pivmin) {
			++itmp1;
			d__1 = tmp2, d__2 = -(*pivmin);
			tmp2 = min(d__1,d__2);
		    }
		}

		if (*ijob <= 2) {



		    i__5 = nab[ji + nab_dim1];
		    i__3 = nab[ji + (nab_dim1 << 1)], i__4 = max(i__5,itmp1);
		    itmp1 = min(i__3,i__4);


		    if (itmp1 == nab[ji + (nab_dim1 << 1)]) {


			ab[ji + (ab_dim1 << 1)] = tmp1;

		    } else if (itmp1 == nab[ji + nab_dim1]) {


			ab[ji + ab_dim1] = tmp1;
		    } else if (klnew < *mmax) {


			++klnew;
			ab[klnew + (ab_dim1 << 1)] = ab[ji + (ab_dim1 << 1)];
			nab[klnew + (nab_dim1 << 1)] = nab[ji + (nab_dim1 << 
				1)];
			ab[klnew + ab_dim1] = tmp1;
			nab[klnew + nab_dim1] = itmp1;
			ab[ji + (ab_dim1 << 1)] = tmp1;
			nab[ji + (nab_dim1 << 1)] = itmp1;
		    } else {
			*info = *mmax + 1;
return TCL_OK;
		    }
		} else {


		    if (itmp1 <= nval[ji]) {
			ab[ji + ab_dim1] = tmp1;
			nab[ji + nab_dim1] = itmp1;
		    }
		    if (itmp1 >= nval[ji]) {
			ab[ji + (ab_dim1 << 1)] = tmp1;
			nab[ji + (nab_dim1 << 1)] = itmp1;
		    }
		}
	    }
	    kl = klnew;


	}


	kfnew = kf;
	i__2 = kl;
	for (ji = kf; ji <= i__2; ++ji) {
	    tmp1 = (d__1 = ab[ji + (ab_dim1 << 1)] - ab[ji + ab_dim1], abs(
		    d__1));
	    d__3 = (d__1 = ab[ji + (ab_dim1 << 1)], abs(d__1)), d__4 = (d__2 =
		     ab[ji + ab_dim1], abs(d__2));
	    tmp2 = max(d__3,d__4);
	    d__1 = max(*abstol,*pivmin), d__2 = *reltol * tmp2;
	    if (tmp1 < max(d__1,d__2) || nab[ji + nab_dim1] >= nab[ji + (
		    nab_dim1 << 1)]) {


		if (ji > kfnew) {
		    tmp1 = ab[ji + ab_dim1];
		    tmp2 = ab[ji + (ab_dim1 << 1)];
		    itmp1 = nab[ji + nab_dim1];
		    itmp2 = nab[ji + (nab_dim1 << 1)];
		    ab[ji + ab_dim1] = ab[kfnew + ab_dim1];
		    ab[ji + (ab_dim1 << 1)] = ab[kfnew + (ab_dim1 << 1)];
		    nab[ji + nab_dim1] = nab[kfnew + nab_dim1];
		    nab[ji + (nab_dim1 << 1)] = nab[kfnew + (nab_dim1 << 1)];
		    ab[kfnew + ab_dim1] = tmp1;
		    ab[kfnew + (ab_dim1 << 1)] = tmp2;
		    nab[kfnew + nab_dim1] = itmp1;
		    nab[kfnew + (nab_dim1 << 1)] = itmp2;
		    if (*ijob == 3) {
			itmp1 = nval[ji];
			nval[ji] = nval[kfnew];
			nval[kfnew] = itmp1;
		    }
		}
		++kfnew;
	    }
	}
	kf = kfnew;


	i__2 = kl;
	for (ji = kf; ji <= i__2; ++ji) {
	    c__[ji] = (ab[ji + ab_dim1] + ab[ji + (ab_dim1 << 1)]) * .5;
	}


	if (kf > kl) {
	    goto L140;
	}
    }


L140:
    i__1 = kl + 1 - kf;
    *info = max(i__1,0);
    *mout = kl;

return TCL_OK;


} /* dlaebz_ */
static /* Subroutine */ int dlaev2_ (Tcl_Interp *interp, doublereal *a, doublereal *b, doublereal *c__, 	doublereal *rt1, doublereal *rt2, doublereal *cs1, doublereal *sn1)
{
    doublereal d__1;

    double sqrt(doublereal);

    doublereal ab, df, cs, ct, tb, sm, tn, rt, adf, acs;
    integer sgn1, sgn2;
    doublereal acmn, acmx;






















    sm = *a + *c__;
    df = *a - *c__;
    adf = abs(df);
    tb = *b + *b;
    ab = abs(tb);
    if (abs(*a) > abs(*c__)) {
	acmx = *a;
	acmn = *c__;
    } else {
	acmx = *c__;
	acmn = *a;
    }
    if (adf > ab) {
	d__1 = ab / adf;
	rt = adf * sqrt(d__1 * d__1 + 1.);
    } else if (adf < ab) {
	d__1 = adf / ab;
	rt = ab * sqrt(d__1 * d__1 + 1.);
    } else {


	rt = ab * sqrt(2.);
    }
    if (sm < 0.) {
	*rt1 = (sm - rt) * .5;
	sgn1 = -1;


	*rt2 = acmx / *rt1 * acmn - *b / *rt1 * *b;
    } else if (sm > 0.) {
	*rt1 = (sm + rt) * .5;
	sgn1 = 1;


	*rt2 = acmx / *rt1 * acmn - *b / *rt1 * *b;
    } else {


	*rt1 = rt * .5;
	*rt2 = rt * -.5;
	sgn1 = 1;
    }


    if (df >= 0.) {
	cs = df + rt;
	sgn2 = 1;
    } else {
	cs = df - rt;
	sgn2 = -1;
    }
    acs = abs(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 TCL_OK;


} /* dlaev2_ */
static /* Subroutine */ int dlarrc_ (Tcl_Interp *interp, char *jobt, integer *n, doublereal *vl, 	doublereal *vu, doublereal *d__, doublereal *e, doublereal *pivmin, 	integer *eigcnt, integer *lcnt, integer *rcnt, integer *info)
{
    integer i__1;
    doublereal d__1;

    integer i__;
    doublereal sl, su, tmp, tmp2;
    logical matt;
    doublereal lpivot, rpivot;




















    --e;
    --d__;

    *info = 0;
    *lcnt = 0;
    *rcnt = 0;
    *eigcnt = 0;
    matt = lsame_(jobt, "T");
    if (matt) {
	lpivot = d__[1] - *vl;
	rpivot = d__[1] - *vu;
	if (lpivot <= 0.) {
	    ++(*lcnt);
	}
	if (rpivot <= 0.) {
	    ++(*rcnt);
	}
	i__1 = *n - 1;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    d__1 = e[i__];
	    tmp = d__1 * d__1;
	    lpivot = d__[i__ + 1] - *vl - tmp / lpivot;
	    rpivot = d__[i__ + 1] - *vu - tmp / rpivot;
	    if (lpivot <= 0.) {
		++(*lcnt);
	    }
	    if (rpivot <= 0.) {
		++(*rcnt);
	    }
	}
    } else {
	sl = -(*vl);
	su = -(*vu);
	i__1 = *n - 1;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    lpivot = d__[i__] + sl;
	    rpivot = d__[i__] + su;
	    if (lpivot <= 0.) {
		++(*lcnt);
	    }
	    if (rpivot <= 0.) {
		++(*rcnt);
	    }
	    tmp = e[i__] * d__[i__] * e[i__];

	    tmp2 = tmp / lpivot;
	    if (tmp2 == 0.) {
		sl = tmp - *vl;
	    } else {
		sl = sl * tmp2 - *vl;
	    }

	    tmp2 = tmp / rpivot;
	    if (tmp2 == 0.) {
		su = tmp - *vu;
	    } else {
		su = su * tmp2 - *vu;
	    }
	}
	lpivot = d__[*n] + sl;
	rpivot = d__[*n] + su;
	if (lpivot <= 0.) {
	    ++(*lcnt);
	}
	if (rpivot <= 0.) {
	    ++(*rcnt);
	}
    }
    *eigcnt = *rcnt - *lcnt;
return TCL_OK;


} /* dlarrc_ */
static /* Subroutine */ int dlarre_ (Tcl_Interp *interp, char *range, integer *n, doublereal *vl, 	doublereal *vu, integer *il, integer *iu, doublereal *d__, doublereal 	*e, doublereal *e2, doublereal *rtol1, doublereal *rtol2, doublereal *	spltol, integer *nsplit, integer *isplit, integer *m, doublereal *w, 	doublereal *werr, doublereal *wgap, integer *iblock, integer *indexw, 	doublereal *gers, doublereal *pivmin, doublereal *work, integer *	iwork, integer *info)
{
    integer i__1, i__2;
    doublereal d__1, d__2, d__3;

    double sqrt(doublereal), log(doublereal);

    integer i__, j;
    doublereal s1, s2;
    integer mb;
    doublereal gl;
    integer in, mm;
    doublereal gu;
    integer cnt;
    doublereal eps, tau, tmp, rtl;
    integer cnt1, cnt2;
    doublereal tmp1, eabs;
    integer iend, jblk;
    doublereal eold;
    integer indl;
    doublereal dmax__, emax;
    integer wend, idum, indu;
    doublereal rtol;
    integer iseed[4];
    doublereal avgap, sigma;
    integer iinfo;
    logical norep;
    integer ibegin;
    logical forceb;
    integer irange;
    doublereal sgndef;
    integer wbegin;
    doublereal safmin, spdiam;
    logical usedqd;
    doublereal clwdth, isleft;
    doublereal isrght, bsrtol, dpivot;


































    --iwork;
    --work;
    --gers;
    --indexw;
    --iblock;
    --wgap;
    --werr;
    --w;
    --isplit;
    --e2;
    --e;
    --d__;

    *info = 0;


    if (lsame_(range, "A")) {
	irange = 1;
    } else if (lsame_(range, "V")) {
	irange = 3;
    } else if (lsame_(range, "I")) {
	irange = 2;
    }
    *m = 0;
    safmin = dlamch_("S");
    eps = dlamch_("P");
    rtl = sqrt(eps);
    bsrtol = sqrt(eps);
    if (*n == 1) {
	if (irange == 1 || irange == 3 && d__[1] > *vl && d__[1] <= *vu || 
		irange == 2 && *il == 1 && *iu == 1) {
	    *m = 1;
	    w[1] = d__[1];
	    werr[1] = 0.;
	    wgap[1] = 0.;
	    iblock[1] = 1;
	    indexw[1] = 1;
	    gers[1] = d__[1];
	    gers[2] = d__[1];
	}
	e[1] = 0.;
return TCL_OK;
    }

    gl = d__[1];
    gu = d__[1];
    eold = 0.;
    emax = 0.;
    e[*n] = 0.;
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	werr[i__] = 0.;
	wgap[i__] = 0.;
	eabs = (d__1 = e[i__], abs(d__1));
	if (eabs >= emax) {
	    emax = eabs;
	}
	tmp1 = eabs + eold;
	gers[(i__ << 1) - 1] = d__[i__] - tmp1;
	d__1 = gl, d__2 = gers[(i__ << 1) - 1];
	gl = min(d__1,d__2);
	gers[i__ * 2] = d__[i__] + tmp1;
	d__1 = gu, d__2 = gers[i__ * 2];
	gu = max(d__1,d__2);
	eold = eabs;
    }
    d__3 = emax;
    d__1 = 1., d__2 = d__3 * d__3;
    *pivmin = safmin * max(d__1,d__2);
    spdiam = gu - gl;
    if (dlarra_(interp, n, &d__[1], &e[1], &e2[1], spltol, &spdiam, nsplit, &isplit[1], &	    iinfo)!=TCL_OK) { return TCL_ERROR; }


    forceb = FALSE_;
    usedqd = irange == 1 && ! forceb;
    if (irange == 1 && ! forceb) {
	*vl = gl;
	*vu = gu;
    } else {
	if (dlarrd_(interp, range, "B", n, vl, vu, il, iu, &gers[1], &bsrtol, &d__[1], &e[		1], &e2[1], pivmin, nsplit, &isplit[1], &mm, &w[1], &werr[1], 
		vl, vu, &iblock[1], &indexw[1], &work[1], &iwork[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }


	if (iinfo != 0) {
	    *info = -1;
return TCL_OK;
	}
	i__1 = *n;
	for (i__ = mm + 1; i__ <= i__1; ++i__) {
	    w[i__] = 0.;
	    werr[i__] = 0.;
	    iblock[i__] = 0;
	    indexw[i__] = 0;
	}
    }
    ibegin = 1;
    wbegin = 1;
    i__1 = *nsplit;
    for (jblk = 1; jblk <= i__1; ++jblk) {
	iend = isplit[jblk];
	in = iend - ibegin + 1;
	if (in == 1) {
	    if (irange == 1 || irange == 3 && d__[ibegin] > *vl && d__[ibegin]
		     <= *vu || irange == 2 && iblock[wbegin] == jblk) {
		++(*m);
		w[*m] = d__[ibegin];
		werr[*m] = 0.;
		wgap[*m] = 0.;
		iblock[*m] = jblk;
		indexw[*m] = 1;
		++wbegin;
	    }
	    e[iend] = 0.;
	    ibegin = iend + 1;
	    goto L170;
	}


	e[iend] = 0.;

	gl = d__[ibegin];
	gu = d__[ibegin];
	i__2 = iend;
	for (i__ = ibegin; i__ <= i__2; ++i__) {
	    d__1 = gers[(i__ << 1) - 1];
	    gl = min(d__1,gl);
	    d__1 = gers[i__ * 2];
	    gu = max(d__1,gu);
	}
	spdiam = gu - gl;
	if (! (irange == 1 && ! forceb)) {
	    mb = 0;
	    i__2 = mm;
	    for (i__ = wbegin; i__ <= i__2; ++i__) {
		if (iblock[i__] == jblk) {
		    ++mb;
		} else {
		    goto L21;
		}
	    }
L21:
	    if (mb == 0) {
		e[iend] = 0.;
		ibegin = iend + 1;
		goto L170;
	    } else {
		usedqd = (doublereal) mb > in * .5 && ! forceb;
		wend = wbegin + mb - 1;
		sigma = 0.;
		i__2 = wend - 1;
		for (i__ = wbegin; i__ <= i__2; ++i__) {
		    d__1 = 0., d__2 = w[i__ + 1] - werr[i__ + 1] - (w[i__] + 
			    werr[i__]);
		    wgap[i__] = max(d__1,d__2);
		}
		d__1 = 0., d__2 = *vu - sigma - (w[wend] + werr[wend]);
		wgap[wend] = max(d__1,d__2);
		indl = indexw[wbegin];
		indu = indexw[wend];
	    }
	}
	if (irange == 1 && ! forceb || usedqd) {
	    if (dlarrk_(interp, &in, &dlarre_c__1, &gl, &gu, &d__[ibegin], &e2[ibegin], pivmin, &		    rtl, &tmp, &tmp1, &iinfo)!=TCL_OK) { return TCL_ERROR; }


	    if (iinfo != 0) {
		*info = -1;
return TCL_OK;
	    }
	    d__2 = gl, d__3 = tmp - tmp1 - eps * 100. * (d__1 = tmp - tmp1, 
		    abs(d__1));
	    isleft = max(d__2,d__3);
	    if (dlarrk_(interp, &in, &in, &gl, &gu, &d__[ibegin], &e2[ibegin], pivmin, &		    rtl, &tmp, &tmp1, &iinfo)!=TCL_OK) { return TCL_ERROR; }


	    if (iinfo != 0) {
		*info = -1;
return TCL_OK;
	    }
	    d__2 = gu, d__3 = tmp + tmp1 + eps * 100. * (d__1 = tmp + tmp1, 
		    abs(d__1));
	    isrght = min(d__2,d__3);
	    spdiam = isrght - isleft;
	} else {
	    d__2 = gl, d__3 = w[wbegin] - werr[wbegin] - eps * 100. * (d__1 = 
		    w[wbegin] - werr[wbegin], abs(d__1));
	    isleft = max(d__2,d__3);
	    d__2 = gu, d__3 = w[wend] + werr[wend] + eps * 100. * (d__1 = w[
		    wend] + werr[wend], abs(d__1));
	    isrght = min(d__2,d__3);
	}
	if (irange == 1 && ! forceb) {
	    usedqd = TRUE_;
	    indl = 1;
	    indu = in;
	    mb = in;
	    wend = wbegin + mb - 1;
	    s1 = isleft + spdiam * .25;
	    s2 = isrght - spdiam * .25;
	} else {
	    if (usedqd) {
		s1 = isleft + spdiam * .25;
		s2 = isrght - spdiam * .25;
	    } else {
		tmp = min(isrght,*vu) - max(isleft,*vl);
		s1 = max(isleft,*vl) + tmp * .25;
		s2 = min(isrght,*vu) - tmp * .25;
	    }
	}
	if (mb > 1) {
	    if (dlarrc_(interp, "T", &in, &s1, &s2, &d__[ibegin], &e[ibegin], pivmin, &		    cnt, &cnt1, &cnt2, &iinfo)!=TCL_OK) { return TCL_ERROR; }


	}
	if (mb == 1) {
	    sigma = gl;
	    sgndef = 1.;
	} else if (cnt1 - indl >= indu - cnt2) {
	    if (irange == 1 && ! forceb) {
		sigma = max(isleft,gl);
	    } else if (usedqd) {
		sigma = isleft;
	    } else {
		sigma = max(isleft,*vl);
	    }
	    sgndef = 1.;
	} else {
	    if (irange == 1 && ! forceb) {
		sigma = min(isrght,gu);
	    } else if (usedqd) {
		sigma = isrght;
	    } else {
		sigma = min(isrght,*vu);
	    }
	    sgndef = -1.;
	}
	if (usedqd) {
	    tau = spdiam * eps * *n + *pivmin * 2.;
	} else {
	    if (mb > 1) {
		clwdth = w[wend] + werr[wend] - w[wbegin] - werr[wbegin];
		avgap = (d__1 = clwdth / (doublereal) (wend - wbegin), abs(
			d__1));
		if (sgndef == 1.) {
		    d__1 = wgap[wbegin];
		    tau = max(d__1,avgap) * .5;
		    d__1 = tau, d__2 = werr[wbegin];
		    tau = max(d__1,d__2);
		} else {
		    d__1 = wgap[wend - 1];
		    tau = max(d__1,avgap) * .5;
		    d__1 = tau, d__2 = werr[wend];
		    tau = max(d__1,d__2);
		}
	    } else {
		tau = werr[wbegin];
	    }
	}

	for (idum = 1; idum <= 6; ++idum) {
	    dpivot = d__[ibegin] - sigma;
	    work[1] = dpivot;
	    dmax__ = abs(work[1]);
	    j = ibegin;
	    i__2 = in - 1;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		work[(in << 1) + i__] = 1. / work[i__];
		tmp = e[j] * work[(in << 1) + i__];
		work[in + i__] = tmp;
		dpivot = d__[j + 1] - sigma - tmp * e[j];
		work[i__ + 1] = dpivot;
		d__1 = dmax__, d__2 = abs(dpivot);
		dmax__ = max(d__1,d__2);
		++j;
	    }
	    if (dmax__ > spdiam * 64.) {
		norep = TRUE_;
	    } else {
		norep = FALSE_;
	    }
	    if (usedqd && ! norep) {
		i__2 = in;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    tmp = sgndef * work[i__];
		    if (tmp < 0.) {
			norep = TRUE_;
		    }
		}
	    }
	    if (norep) {
		if (idum == 5) {
		    if (sgndef == 1.) {
			sigma = gl - spdiam * 2. * eps * *n - *pivmin * 4.;
		    } else {
			sigma = gu + spdiam * 2. * eps * *n + *pivmin * 4.;
		    }
		} else {
		    sigma -= sgndef * tau;
		    tau *= 2.;
		}
	    } else {
		goto L83;
	    }
	}
	*info = 2;
return TCL_OK;
L83:
	e[iend] = sigma;
	if (dcopy_(interp, &in, &work[1], &dlarre_c__1, &d__[ibegin], &dlarre_c__1)!=TCL_OK) { return TCL_ERROR; }

	i__2 = in - 1;
	if (dcopy_(interp, &i__2, &work[in + 1], &dlarre_c__1, &e[ibegin], &dlarre_c__1)!=TCL_OK) { return TCL_ERROR; }

	if (mb > 1) {


	    for (i__ = 1; i__ <= 4; ++i__) {
		iseed[i__ - 1] = 1;
	    }
	    i__2 = (in << 1) - 1;
	    if (dlarnv_(interp, &dlarre_c__2, iseed, &i__2, &work[1])!=TCL_OK) { return TCL_ERROR; }

	    i__2 = in - 1;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		d__[ibegin + i__ - 1] *= eps * 8. * work[i__] + 1.;
		e[ibegin + i__ - 1] *= eps * 8. * work[in + i__] + 1.;
	    }
	    d__[iend] *= eps * 4. * work[in] + 1.;

	}

	if (! usedqd) {
	    i__2 = wend;
	    for (j = wbegin; j <= i__2; ++j) {
		w[j] -= sigma;
		werr[j] += (d__1 = w[j], abs(d__1)) * eps;
	    }
	    i__2 = iend - 1;
	    for (i__ = ibegin; i__ <= i__2; ++i__) {
		d__1 = e[i__];
		work[i__] = d__[i__] * (d__1 * d__1);
	    }
	    i__2 = indl - 1;
	    if (dlarrb_(interp, &in, &d__[ibegin], &work[ibegin], &indl, &indu, rtol1, 		    rtol2, &i__2, &w[wbegin], &wgap[wbegin], &werr[wbegin], &
		    work[(*n << 1) + 1], &iwork[1], pivmin, &spdiam, &in, &
		    iinfo)!=TCL_OK) { return TCL_ERROR; }


	    if (iinfo != 0) {
		*info = -4;
return TCL_OK;
	    }
	    d__1 = 0., d__2 = *vu - sigma - (w[wend] + werr[wend]);
	    wgap[wend] = max(d__1,d__2);
	    i__2 = indu;
	    for (i__ = indl; i__ <= i__2; ++i__) {
		++(*m);
		iblock[*m] = jblk;
		indexw[*m] = i__;
	    }
	} else {
	    rtol = log((doublereal) in) * 4. * eps;
	    j = ibegin;
	    i__2 = in - 1;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		work[(i__ << 1) - 1] = (d__1 = d__[j], abs(d__1));
		work[i__ * 2] = e[j] * e[j] * work[(i__ << 1) - 1];
		++j;
	    }
	    work[(in << 1) - 1] = (d__1 = d__[iend], abs(d__1));
	    work[in * 2] = 0.;
	    if (dlasq2_(interp, &in, &work[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }

	    if (iinfo != 0) {
		*info = -5;
return TCL_OK;
	    } else {
		i__2 = in;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    if (work[i__] < 0.) {
			*info = -6;
return TCL_OK;
		    }
		}
	    }
	    if (sgndef > 0.) {
		i__2 = indu;
		for (i__ = indl; i__ <= i__2; ++i__) {
		    ++(*m);
		    w[*m] = work[in - i__ + 1];
		    iblock[*m] = jblk;
		    indexw[*m] = i__;
		}
	    } else {
		i__2 = indu;
		for (i__ = indl; i__ <= i__2; ++i__) {
		    ++(*m);
		    w[*m] = -work[i__];
		    iblock[*m] = jblk;
		    indexw[*m] = i__;
		}
	    }
	    i__2 = *m;
	    for (i__ = *m - mb + 1; i__ <= i__2; ++i__) {
		werr[i__] = rtol * (d__1 = w[i__], abs(d__1));
	    }
	    i__2 = *m - 1;
	    for (i__ = *m - mb + 1; i__ <= i__2; ++i__) {
		d__1 = 0., d__2 = w[i__ + 1] - werr[i__ + 1] - (w[i__] + werr[
			i__]);
		wgap[i__] = max(d__1,d__2);
	    }
	    d__1 = 0., d__2 = *vu - sigma - (w[*m] + werr[*m]);
	    wgap[*m] = max(d__1,d__2);
	}
	ibegin = iend + 1;
	wbegin = wend + 1;
L170:
	;
    }

return TCL_OK;


} /* dlarre_ */
static /* Subroutine */ int dlarrj_ (Tcl_Interp *interp, integer *n, doublereal *d__, doublereal *e2, 	integer *ifirst, integer *ilast, doublereal *rtol, integer *offset, 	doublereal *w, doublereal *werr, doublereal *work, integer *iwork, 	doublereal *pivmin, doublereal *spdiam, integer *info)
{
    integer i__1, i__2;
    doublereal d__1, d__2;

    double log(doublereal);

    integer i__, j, k, p;
    doublereal s;
    integer i1, i2, ii;
    doublereal fac, mid;
    integer cnt;
    doublereal tmp, left;
    integer iter, nint, prev, next, savi1;
    doublereal right, width, dplus;
    integer olnint, maxitr;


























    --iwork;
    --work;
    --werr;
    --w;
    --e2;
    --d__;

    *info = 0;

    maxitr = (integer) ((log(*spdiam + *pivmin) - log(*pivmin)) / log(2.)) + 
	    2;


    i1 = *ifirst;
    i2 = *ilast;
    nint = 0;
    prev = 0;
    i__1 = i2;
    for (i__ = i1; i__ <= i__1; ++i__) {
	k = i__ << 1;
	ii = i__ - *offset;
	left = w[ii] - werr[ii];
	mid = w[ii];
	right = w[ii] + werr[ii];
	width = right - mid;
	d__1 = abs(left), d__2 = abs(right);
	tmp = max(d__1,d__2);
	if (width < *rtol * tmp) {
	    iwork[k - 1] = -1;
	    if (i__ == i1 && i__ < i2) {
		i1 = i__ + 1;
	    }
	    if (prev >= i1 && i__ <= i2) {
		iwork[(prev << 1) - 1] = i__ + 1;
	    }
	} else {
	    prev = i__;


	    fac = 1.;
L20:
	    cnt = 0;
	    s = left;
	    dplus = d__[1] - s;
	    if (dplus < 0.) {
		++cnt;
	    }
	    i__2 = *n;
	    for (j = 2; j <= i__2; ++j) {
		dplus = d__[j] - s - e2[j - 1] / dplus;
		if (dplus < 0.) {
		    ++cnt;
		}
	    }
	    if (cnt > i__ - 1) {
		left -= werr[ii] * fac;
		fac *= 2.;
		goto L20;
	    }


	    fac = 1.;
L50:
	    cnt = 0;
	    s = right;
	    dplus = d__[1] - s;
	    if (dplus < 0.) {
		++cnt;
	    }
	    i__2 = *n;
	    for (j = 2; j <= i__2; ++j) {
		dplus = d__[j] - s - e2[j - 1] / dplus;
		if (dplus < 0.) {
		    ++cnt;
		}
	    }
	    if (cnt < i__) {
		right += werr[ii] * fac;
		fac *= 2.;
		goto L50;
	    }
	    ++nint;
	    iwork[k - 1] = i__ + 1;
	    iwork[k] = cnt;
	}
	work[k - 1] = left;
	work[k] = right;
    }
    savi1 = i1;


    iter = 0;
L80:
    prev = i1 - 1;
    i__ = i1;
    olnint = nint;
    i__1 = olnint;
    for (p = 1; p <= i__1; ++p) {
	k = i__ << 1;
	ii = i__ - *offset;
	next = iwork[k - 1];
	left = work[k - 1];
	right = work[k];
	mid = (left + right) * .5;
	width = right - mid;
	d__1 = abs(left), d__2 = abs(right);
	tmp = max(d__1,d__2);
	if (width < *rtol * tmp || iter == maxitr) {
	    --nint;
	    iwork[k - 1] = 0;
	    if (i1 == i__) {
		i1 = next;
	    } else {
		if (prev >= i1) {
		    iwork[(prev << 1) - 1] = next;
		}
	    }
	    i__ = next;
	    goto L100;
	}
	prev = i__;


	cnt = 0;
	s = mid;
	dplus = d__[1] - s;
	if (dplus < 0.) {
	    ++cnt;
	}
	i__2 = *n;
	for (j = 2; j <= i__2; ++j) {
	    dplus = d__[j] - s - e2[j - 1] / dplus;
	    if (dplus < 0.) {
		++cnt;
	    }
	}
	if (cnt <= i__ - 1) {
	    work[k - 1] = mid;
	} else {
	    work[k] = mid;
	}
	i__ = next;
L100:
	;
    }
    ++iter;
    if (nint > 0 && iter <= maxitr) {
	goto L80;
    }


    i__1 = *ilast;
    for (i__ = savi1; i__ <= i__1; ++i__) {
	k = i__ << 1;
	ii = i__ - *offset;
	if (iwork[k - 1] == 0) {
	    w[ii] = (work[k - 1] + work[k]) * .5;
	    werr[ii] = work[k] - w[ii];
	}
    }

return TCL_OK;


} /* dlarrj_ */
static /* Subroutine */ int dlarrr_ (Tcl_Interp *interp, integer *n, doublereal *d__, doublereal *e, 	integer *info)
{
    integer i__1;
    doublereal d__1;

    double sqrt(doublereal);

    integer i__;
    doublereal eps, tmp, tmp2, rmin;
    doublereal offdig, safmin;
    logical yesrel;
    doublereal smlnum, offdig2;
















    --e;
    --d__;

    *info = 1;
    safmin = dlamch_("Safe minimum");
    eps = dlamch_("Precision");
    smlnum = safmin / eps;
    rmin = sqrt(smlnum);



    yesrel = TRUE_;
    offdig = 0.;
    tmp = sqrt((abs(d__[1])));
    if (tmp < rmin) {
	yesrel = FALSE_;
    }
    if (! yesrel) {
	goto L11;
    }
    i__1 = *n;
    for (i__ = 2; i__ <= i__1; ++i__) {
	tmp2 = sqrt((d__1 = d__[i__], abs(d__1)));
	if (tmp2 < rmin) {
	    yesrel = FALSE_;
	}
	if (! yesrel) {
	    goto L11;
	}
	offdig2 = (d__1 = e[i__ - 1], abs(d__1)) / (tmp * tmp2);
	if (offdig + offdig2 >= .999) {
	    yesrel = FALSE_;
	}
	if (! yesrel) {
	    goto L11;
	}
	tmp = tmp2;
	offdig = offdig2;
    }
L11:
    if (yesrel) {
	*info = 0;
return TCL_OK;
    } else {
    }








return TCL_OK;


} /* dlarrr_ */
static /* Subroutine */ int dlarrv_ (Tcl_Interp *interp, integer *n, doublereal *vl, doublereal *vu, 	doublereal *d__, doublereal *l, doublereal *pivmin, integer *isplit, 	integer *m, integer *dol, integer *dou, doublereal *minrgp, 	doublereal *rtol1, doublereal *rtol2, doublereal *w, doublereal *werr, 	 doublereal *wgap, integer *iblock, integer *indexw, doublereal *gers, 	 doublereal *z__, integer *ldz, integer *isuppz, doublereal *work, 	integer *iwork, integer *info)
{
    integer z_dim1, z_offset, i__1, i__2, i__3, i__4, i__5;
    doublereal d__1, d__2;
    logical L__1;

    double log(doublereal);

    integer minwsize, i__, j, k, p, q, miniwsize, ii;
    doublereal gl;
    integer im, in;
    doublereal gu, gap, eps, tau, tol, tmp;
    integer zto;
    doublereal ztz;
    integer iend, jblk;
    doublereal lgap;
    integer done;
    doublereal rgap, left;
    integer wend, iter;
    doublereal bstw;
    integer itmp1;
    integer indld;
    doublereal fudge;
    integer idone;
    doublereal sigma;
    integer iinfo, iindr;
    doublereal resid;
    logical eskip;
    doublereal right;
    integer nclus, zfrom;
    doublereal rqtol;
    integer iindc1, iindc2;
    logical stp2ii;
    doublereal lambda;
    integer ibegin, indeig;
    logical needbs;
    integer indlld;
    doublereal sgndef, mingma;
    integer oldien, oldncl, wbegin;
    doublereal spdiam;
    integer negcnt;
    integer oldcls;
    doublereal savgap;
    integer ndepth;
    doublereal ssigma;
    logical usedbs;
    integer iindwk, offset;
    doublereal gaptol;
    integer newcls, oldfst, indwrk, windex, oldlst;
    logical usedrq;
    integer newfst, newftt, parity, windmn, windpl, isupmn, newlst, zusedl;
    doublereal bstres;
    integer newsiz, zusedu, zusedw;
    doublereal nrminv, rqcorr;
    logical tryrqc;
    integer isupmx;


































    --d__;
    --l;
    --isplit;
    --w;
    --werr;
    --wgap;
    --iblock;
    --indexw;
    --gers;
    z_dim1 = *ldz;
    z_offset = 1 + z_dim1;
    z__ -= z_offset;
    --isuppz;
    --work;
    --iwork;

    indld = *n + 1;
    indlld = (*n << 1) + 1;
    indwrk = *n * 3 + 1;
    minwsize = *n * 12;
    i__1 = minwsize;
    for (i__ = 1; i__ <= i__1; ++i__) {
	work[i__] = 0.;
    }
    iindr = 0;
    iindc1 = *n;
    iindc2 = *n << 1;
    iindwk = *n * 3 + 1;
    miniwsize = *n * 7;
    i__1 = miniwsize;
    for (i__ = 1; i__ <= i__1; ++i__) {
	iwork[i__] = 0;
    }
    zusedl = 1;
    if (*dol > 1) {
	zusedl = *dol - 1;
    }
    zusedu = *m;
    if (*dou < *m) {
	zusedu = *dou + 1;
    }
    zusedw = zusedu - zusedl + 1;
    if (dlaset_(interp, "Full", n, &zusedw, &dlarrv_c_b5, &dlarrv_c_b5, &z__[zusedl * z_dim1 + 1], ldz)!=TCL_OK) { return TCL_ERROR; }

    eps = dlamch_("Precision");
    rqtol = eps * 2.;

    tryrqc = TRUE_;
    if (*dol == 1 && *dou == *m) {
    } else {
	*rtol1 = eps * 4.;
	*rtol2 = eps * 4.;
    }
    done = 0;
    ibegin = 1;
    wbegin = 1;
    i__1 = iblock[*m];
    for (jblk = 1; jblk <= i__1; ++jblk) {
	iend = isplit[jblk];
	sigma = l[iend];
	wend = wbegin - 1;
L15:
	if (wend < *m) {
	    if (iblock[wend + 1] == jblk) {
		++wend;
		goto L15;
	    }
	}
	if (wend < wbegin) {
	    ibegin = iend + 1;
	    goto L170;
	} else if (wend < *dol || wbegin > *dou) {
	    ibegin = iend + 1;
	    wbegin = wend + 1;
	    goto L170;
	}
	gl = gers[(ibegin << 1) - 1];
	gu = gers[ibegin * 2];
	i__2 = iend;
	for (i__ = ibegin + 1; i__ <= i__2; ++i__) {
	    d__1 = gers[(i__ << 1) - 1];
	    gl = min(d__1,gl);
	    d__1 = gers[i__ * 2];
	    gu = max(d__1,gu);
	}
	spdiam = gu - gl;
	oldien = ibegin - 1;
	in = iend - ibegin + 1;
	im = wend - wbegin + 1;
	if (ibegin == iend) {
	    ++done;
	    z__[ibegin + wbegin * z_dim1] = 1.;
	    isuppz[(wbegin << 1) - 1] = ibegin;
	    isuppz[wbegin * 2] = ibegin;
	    w[wbegin] += sigma;
	    work[wbegin] = w[wbegin];
	    ibegin = iend + 1;
	    ++wbegin;
	    goto L170;
	}
	if (dcopy_(interp, &im, &w[wbegin], &dlarrv_c__1, &work[wbegin], &dlarrv_c__1)!=TCL_OK) { return TCL_ERROR; }

	i__2 = im;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    w[wbegin + i__ - 1] += sigma;
	}
	ndepth = 0;
	parity = 1;
	nclus = 1;
	iwork[iindc1 + 1] = 1;
	iwork[iindc1 + 2] = im;
	idone = 0;
L40:
	if (idone < im) {
	    if (ndepth > *m) {
		*info = -2;
return TCL_OK;
	    }
	    oldncl = nclus;
	    nclus = 0;

	    parity = 1 - parity;
	    if (parity == 0) {
		oldcls = iindc1;
		newcls = iindc2;
	    } else {
		oldcls = iindc2;
		newcls = iindc1;
	    }
	    i__2 = oldncl;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		j = oldcls + (i__ << 1);
		oldfst = iwork[j - 1];
		oldlst = iwork[j];
		if (ndepth > 0) {
		    if (*dol == 1 && *dou == *m) {
			j = wbegin + oldfst - 1;
		    } else {
			if (wbegin + oldfst - 1 < *dol) {
			    j = *dol - 1;
			} else if (wbegin + oldfst - 1 > *dou) {
			    j = *dou;
			} else {
			    j = wbegin + oldfst - 1;
			}
		    }
		    if (dcopy_(interp, &in, &z__[ibegin + j * z_dim1], &dlarrv_c__1, &d__[ibegin], &dlarrv_c__1)!=TCL_OK) { return TCL_ERROR; }


		    i__3 = in - 1;
		    if (dcopy_(interp, &i__3, &z__[ibegin + (j + 1) * z_dim1], &dlarrv_c__1, &l[			    ibegin], &dlarrv_c__1)!=TCL_OK) { return TCL_ERROR; }


		    sigma = z__[iend + (j + 1) * z_dim1];
		    if (dlaset_(interp, "Full", &in, &dlarrv_c__2, &dlarrv_c_b5, &dlarrv_c_b5, &z__[ibegin + j 			    * z_dim1], ldz)!=TCL_OK) { return TCL_ERROR; }


		}
		i__3 = iend - 1;
		for (j = ibegin; j <= i__3; ++j) {
		    tmp = d__[j] * l[j];
		    work[indld - 1 + j] = tmp;
		    work[indlld - 1 + j] = tmp * l[j];
		}
		if (ndepth > 0) {
		    p = indexw[wbegin - 1 + oldfst];
		    q = indexw[wbegin - 1 + oldlst];
		    offset = indexw[wbegin] - 1;
		    if (dlarrb_(interp, &in, &d__[ibegin], &work[indlld + ibegin - 1], &p, 			     &q, rtol1, rtol2, &offset, &work[wbegin], &wgap[
			    wbegin], &werr[wbegin], &work[indwrk], &iwork[
			    iindwk], pivmin, &spdiam, &in, &iinfo)!=TCL_OK) { return TCL_ERROR; }


		    if (iinfo != 0) {
			*info = -1;
return TCL_OK;
		    }
		    if (oldfst > 1) {
			d__1 = wgap[wbegin + oldfst - 2], d__2 = w[wbegin + 
				oldfst - 1] - werr[wbegin + oldfst - 1] - w[
				wbegin + oldfst - 2] - werr[wbegin + oldfst - 
				2];
			wgap[wbegin + oldfst - 2] = max(d__1,d__2);
		    }
		    if (wbegin + oldlst - 1 < wend) {
			d__1 = wgap[wbegin + oldlst - 1], d__2 = w[wbegin + 
				oldlst] - werr[wbegin + oldlst] - w[wbegin + 
				oldlst - 1] - werr[wbegin + oldlst - 1];
			wgap[wbegin + oldlst - 1] = max(d__1,d__2);
		    }
		    i__3 = oldlst;
		    for (j = oldfst; j <= i__3; ++j) {
			w[wbegin + j - 1] = work[wbegin + j - 1] + sigma;
		    }
		}
		newfst = oldfst;
		i__3 = oldlst;
		for (j = oldfst; j <= i__3; ++j) {
		    if (j == oldlst) {
			newlst = j;
		    } else if (wgap[wbegin + j - 1] >= *minrgp * (d__1 = work[
			    wbegin + j - 1], abs(d__1))) {
			newlst = j;
		    } else {
			goto L140;
		    }
		    newsiz = newlst - newfst + 1;
		    if (*dol == 1 && *dou == *m) {
			newftt = wbegin + newfst - 1;
		    } else {
			if (wbegin + newfst - 1 < *dol) {
			    newftt = *dol - 1;
			} else if (wbegin + newfst - 1 > *dou) {
			    newftt = *dou;
			} else {
			    newftt = wbegin + newfst - 1;
			}
		    }
		    if (newsiz > 1) {




			if (newfst == 1) {
			    d__1 = 0., d__2 = w[wbegin] - werr[wbegin] - *vl;
			    lgap = max(d__1,d__2);
			} else {
			    lgap = wgap[wbegin + newfst - 2];
			}
			rgap = wgap[wbegin + newlst - 1];


			for (k = 1; k <= 2; ++k) {
			    if (k == 1) {
				p = indexw[wbegin - 1 + newfst];
			    } else {
				p = indexw[wbegin - 1 + newlst];
			    }
			    offset = indexw[wbegin] - 1;
			    if (dlarrb_(interp, &in, &d__[ibegin], &work[indlld + ibegin 				    - 1], &p, &p, &rqtol, &rqtol, &offset, &
				    work[wbegin], &wgap[wbegin], &werr[wbegin]
, &work[indwrk], &iwork[iindwk], pivmin, &
				    spdiam, &in, &iinfo)!=TCL_OK) { return TCL_ERROR; }


			}

			if (wbegin + newlst - 1 < *dol || wbegin + newfst - 1 
				> *dou) {

			    idone = idone + newlst - newfst + 1;
			    goto L139;
			}


			if (dlarrf_(interp, &in, &d__[ibegin], &l[ibegin], &work[indld + 				ibegin - 1], &newfst, &newlst, &work[wbegin], 
				&wgap[wbegin], &werr[wbegin], &spdiam, &lgap, 
				&rgap, pivmin, &tau, &z__[ibegin + newftt * 
				z_dim1], &z__[ibegin + (newftt + 1) * z_dim1], 
				 &work[indwrk], &iinfo)!=TCL_OK) { return TCL_ERROR; }


			if (iinfo == 0) {
			    ssigma = sigma + tau;
			    z__[iend + (newftt + 1) * z_dim1] = ssigma;
			    i__4 = newlst;
			    for (k = newfst; k <= i__4; ++k) {
				fudge = eps * 3. * (d__1 = work[wbegin + k - 
					1], abs(d__1));
				work[wbegin + k - 1] -= tau;
				fudge += eps * 4. * (d__1 = work[wbegin + k - 
					1], abs(d__1));
				werr[wbegin + k - 1] += fudge;
			    }
			    ++nclus;
			    k = newcls + (nclus << 1);
			    iwork[k - 1] = newfst;
			    iwork[k] = newlst;
			} else {
			    *info = -2;
return TCL_OK;
			}
		    } else {


			iter = 0;

			tol = log((doublereal) in) * 4. * eps;

			k = newfst;
			windex = wbegin + k - 1;
			i__4 = windex - 1;
			windmn = max(i__4,1);
			i__4 = windex + 1;
			windpl = min(i__4,*m);
			lambda = work[windex];
			++done;
			if (windex < *dol || windex > *dou) {
			    eskip = TRUE_;
			    goto L125;
			} else {
			    eskip = FALSE_;
			}
			left = work[windex] - werr[windex];
			right = work[windex] + werr[windex];
			indeig = indexw[windex];
			if (k == 1) {
			    d__1 = abs(left), d__2 = abs(right);
			    lgap = eps * max(d__1,d__2);
			} else {
			    lgap = wgap[windmn];
			}
			if (k == im) {
			    d__1 = abs(left), d__2 = abs(right);
			    rgap = eps * max(d__1,d__2);
			} else {
			    rgap = wgap[windex];
			}
			gap = min(lgap,rgap);
			if (k == 1 || k == im) {
			    gaptol = 0.;
			} else {
			    gaptol = gap * eps;
			}
			isupmn = in;
			isupmx = 1;
			savgap = wgap[windex];
			wgap[windex] = gap;
			usedbs = FALSE_;
			usedrq = FALSE_;
			needbs = ! tryrqc;
L120:
			if (needbs) {
			    usedbs = TRUE_;
			    itmp1 = iwork[iindr + windex];
			    offset = indexw[wbegin] - 1;
			    d__1 = eps * 2.;
			    if (dlarrb_(interp, &in, &d__[ibegin], &work[indlld + ibegin 				    - 1], &indeig, &indeig, &dlarrv_c_b5, &d__1, &
				    offset, &work[wbegin], &wgap[wbegin], &
				    werr[wbegin], &work[indwrk], &iwork[
				    iindwk], pivmin, &spdiam, &itmp1, &iinfo)!=TCL_OK) { return TCL_ERROR; }


			    if (iinfo != 0) {
				*info = -3;
return TCL_OK;
			    }
			    lambda = work[windex];
			    iwork[iindr + windex] = 0;
			}
			L__1 = ! usedbs;
			if (dlar1v_(interp, &in, &dlarrv_c__1, &in, &lambda, &d__[ibegin], &l[				ibegin], &work[indld + ibegin - 1], &work[
				indlld + ibegin - 1], pivmin, &gaptol, &z__[
				ibegin + windex * z_dim1], &L__1, &negcnt, &
				ztz, &mingma, &iwork[iindr + windex], &isuppz[
				(windex << 1) - 1], &nrminv, &resid, &rqcorr, 
				&work[indwrk])!=TCL_OK) { return TCL_ERROR; }


			if (iter == 0) {
			    bstres = resid;
			    bstw = lambda;
			} else if (resid < bstres) {
			    bstres = resid;
			    bstw = lambda;
			}
			i__4 = isupmn, i__5 = isuppz[(windex << 1) - 1];
			isupmn = min(i__4,i__5);
			i__4 = isupmx, i__5 = isuppz[windex * 2];
			isupmx = max(i__4,i__5);
			++iter;


			if (resid > tol * gap && abs(rqcorr) > rqtol * abs(
				lambda) && ! usedbs) {
			    if (indeig <= negcnt) {
				sgndef = -1.;
			    } else {
				sgndef = 1.;
			    }
			    if (rqcorr * sgndef >= 0. && lambda + rqcorr <= 
				    right && lambda + rqcorr >= left) {
				usedrq = TRUE_;
				if (sgndef == 1.) {
				    left = lambda;
				} else {
				    right = lambda;
				}
				work[windex] = (right + left) * .5;
				lambda += rqcorr;
				werr[windex] = (right - left) * .5;
			    } else {
				needbs = TRUE_;
			    }
			    if (right - left < rqtol * abs(lambda)) {
				usedbs = TRUE_;
				goto L120;
			    } else if (iter < 10) {
				goto L120;
			    } else if (iter == 10) {
				needbs = TRUE_;
				goto L120;
			    } else {
				*info = 5;
return TCL_OK;
			    }
			} else {
			    stp2ii = FALSE_;
			    if (usedrq && usedbs && bstres <= resid) {
				lambda = bstw;
				stp2ii = TRUE_;
			    }
			    if (stp2ii) {
				L__1 = ! usedbs;
				if (dlar1v_(interp, &in, &dlarrv_c__1, &in, &lambda, &d__[ibegin], &l[ibegin], &work[indld + ibegin - 
					1], &work[indlld + ibegin - 1], 
					pivmin, &gaptol, &z__[ibegin + windex 
					* z_dim1], &L__1, &negcnt, &ztz, &
					mingma, &iwork[iindr + windex], &
					isuppz[(windex << 1) - 1], &nrminv, &
					resid, &rqcorr, &work[indwrk])!=TCL_OK) { return TCL_ERROR; }


			    }
			    work[windex] = lambda;
			}


			isuppz[(windex << 1) - 1] += oldien;
			isuppz[windex * 2] += oldien;
			zfrom = isuppz[(windex << 1) - 1];
			zto = isuppz[windex * 2];
			isupmn += oldien;
			isupmx += oldien;
			if (isupmn < zfrom) {
			    i__4 = zfrom - 1;
			    for (ii = isupmn; ii <= i__4; ++ii) {
				z__[ii + windex * z_dim1] = 0.;
			    }
			}
			if (isupmx > zto) {
			    i__4 = isupmx;
			    for (ii = zto + 1; ii <= i__4; ++ii) {
				z__[ii + windex * z_dim1] = 0.;
			    }
			}
			i__4 = zto - zfrom + 1;
			if (dscal_(interp, &i__4, &nrminv, &z__[zfrom + windex * z_dim1], 				&dlarrv_c__1)!=TCL_OK) { return TCL_ERROR; }


L125:
			w[windex] = lambda + sigma;
			if (! eskip) {
			    if (k > 1) {
				d__1 = wgap[windmn], d__2 = w[windex] - werr[
					windex] - w[windmn] - werr[windmn];
				wgap[windmn] = max(d__1,d__2);
			    }
			    if (windex < wend) {
				d__1 = savgap, d__2 = w[windpl] - werr[windpl]
					 - w[windex] - werr[windex];
				wgap[windex] = max(d__1,d__2);
			    }
			}
			++idone;
		    }

L139:
		    newfst = j + 1;
L140:
		    ;
		}
	    }
	    ++ndepth;
	    goto L40;
	}
	ibegin = iend + 1;
	wbegin = wend + 1;
L170:
	;
    }

return TCL_OK;


} /* dlarrv_ */
static /* Subroutine */ int dormql_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *	c__, integer *ldc, doublereal *work, integer *lwork, integer *info)
{
    address 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];

    /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);

    integer i__;
    doublereal t[4160]	/* was [65][64] */;
    integer i1, i2, i3, ib, nb, mi, ni, nq, nw, iws;
    logical left;
    integer nbmin, iinfo;
    logical notran;
    integer ldwork, lwkopt;
    logical lquery;




























    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --tau;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;
    --work;

    *info = 0;
    left = lsame_(side, "L");
    notran = lsame_(trans, "N");
    lquery = *lwork == -1;


    if (left) {
	nq = *m;
	nw = max(1,*n);
    } else {
	nq = *n;
	nw = max(1,*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;
    }

    if (*info == 0) {
	if (*m == 0 || *n == 0) {
	    lwkopt = 1;
	} else {


	    i__3[0] = 1, a__1[0] = side;
	    i__3[1] = 1, a__1[1] = trans;
	    s_cat(ch__1, a__1, i__3, &dormql_c__2, (ftnlen)2);
	    i__1 = 64, i__2 = ilaenv_(&dormql_c__1, "DORMQL", ch__1, m, n, k, &dormql_c_n1);
	    nb = min(i__1,i__2);
	    lwkopt = nw * nb;
	}
	work[1] = (doublereal) lwkopt;

	if (*lwork < nw && ! lquery) {
	    *info = -12;
	}
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DORMQL", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


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

    nbmin = 2;
    ldwork = nw;
    if (nb > 1 && nb < *k) {
	iws = nw * nb;
	if (*lwork < iws) {
	    nb = *lwork / ldwork;
	    i__3[0] = 1, a__1[0] = side;
	    i__3[1] = 1, a__1[1] = trans;
	    s_cat(ch__1, a__1, i__3, &dormql_c__2, (ftnlen)2);
	    i__1 = 2, i__2 = ilaenv_(&dormql_c__2, "DORMQL", ch__1, m, n, k, &dormql_c_n1);
	    nbmin = max(i__1,i__2);
	}
    } else {
	iws = nw;
    }

    if (nb < nbmin || nb >= *k) {


	if (dorm2l_(interp, side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[		c_offset], ldc, &work[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }


    } else {


	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;
	} else {
	    mi = *m;
	}

	i__1 = i2;
	i__2 = i3;
	for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
	    i__4 = nb, i__5 = *k - i__ + 1;
	    ib = min(i__4,i__5);


	    i__4 = nq - *k + i__ + ib - 1;
	    if (dlarft_(interp, "Backward", "Columnwise", &i__4, &ib, &a[i__ * a_dim1 + 1], lda, &tau[i__], t, &dormql_c__65)!=TCL_OK) { return TCL_ERROR; }


	    if (left) {


		mi = *m - *k + i__ + ib - 1;
	    } else {


		ni = *n - *k + i__ + ib - 1;
	    }


	    if (dlarfb_(interp, side, trans, "Backward", "Columnwise", &mi, &ni, &ib, &a[		    i__ * a_dim1 + 1], lda, t, &dormql_c__65, &c__[c_offset], ldc, &
		    work[1], &ldwork)!=TCL_OK) { return TCL_ERROR; }


	}
    }
    work[1] = (doublereal) lwkopt;
return TCL_OK;


} /* dormql_ */
static /* Subroutine */ int dsytd2_ (Tcl_Interp *interp, char *uplo, integer *n, doublereal *a, integer *	lda, doublereal *d__, doublereal *e, doublereal *tau, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3;

    integer i__;
    doublereal taui;
    doublereal alpha;
    logical upper;

































    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --d__;
    --e;
    --tau;

    *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);
	vectcl_xerbla(interp, "DSYTD2", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


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

    if (upper) {


	for (i__ = *n - 1; i__ >= 1; --i__) {


	    if (dlarfg_(interp, &i__, &a[i__ + (i__ + 1) * a_dim1], &a[(i__ + 1) * a_dim1 		    + 1], &dsytd2_c__1, &taui)!=TCL_OK) { return TCL_ERROR; }


	    e[i__] = a[i__ + (i__ + 1) * a_dim1];

	    if (taui != 0.) {


		a[i__ + (i__ + 1) * a_dim1] = 1.;


		if (dsymv_(interp, uplo, &i__, &taui, &a[a_offset], lda, &a[(i__ + 1) * 			a_dim1 + 1], &dsytd2_c__1, &dsytd2_c_b8, &tau[1], &dsytd2_c__1)!=TCL_OK) { return TCL_ERROR; }




		alpha = taui * -.5 * ddot_(&i__, &tau[1], &dsytd2_c__1, &a[(i__ + 1) 
			* a_dim1 + 1], &dsytd2_c__1);
		if (daxpy_(interp, &i__, &alpha, &a[(i__ + 1) * a_dim1 + 1], &dsytd2_c__1, &tau[			1], &dsytd2_c__1)!=TCL_OK) { return TCL_ERROR; }




		if (dsyr2_(interp, uplo, &i__, &dsytd2_c_b14, &a[(i__ + 1) * a_dim1 + 1], &dsytd2_c__1, 			&tau[1], &dsytd2_c__1, &a[a_offset], lda)!=TCL_OK) { return TCL_ERROR; }



		a[i__ + (i__ + 1) * a_dim1] = e[i__];
	    }
	    d__[i__ + 1] = a[i__ + 1 + (i__ + 1) * a_dim1];
	    tau[i__] = taui;
	}
	d__[1] = a[a_dim1 + 1];
    } else {


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


	    i__2 = *n - i__;
	    i__3 = i__ + 2;
	    if (dlarfg_(interp, &i__2, &a[i__ + 1 + i__ * a_dim1], &a[min(i__3, *n)+ i__ *		     a_dim1], &dsytd2_c__1, &taui)!=TCL_OK) { return TCL_ERROR; }


	    e[i__] = a[i__ + 1 + i__ * a_dim1];

	    if (taui != 0.) {


		a[i__ + 1 + i__ * a_dim1] = 1.;


		i__2 = *n - i__;
		if (dsymv_(interp, uplo, &i__2, &taui, &a[i__ + 1 + (i__ + 1) * a_dim1], 			lda, &a[i__ + 1 + i__ * a_dim1], &dsytd2_c__1, &dsytd2_c_b8, &tau[
			i__], &dsytd2_c__1)!=TCL_OK) { return TCL_ERROR; }




		i__2 = *n - i__;
		alpha = taui * -.5 * ddot_(&i__2, &tau[i__], &dsytd2_c__1, &a[i__ + 
			1 + i__ * a_dim1], &dsytd2_c__1);
		i__2 = *n - i__;
		if (daxpy_(interp, &i__2, &alpha, &a[i__ + 1 + i__ * a_dim1], &dsytd2_c__1, &tau[			i__], &dsytd2_c__1)!=TCL_OK) { return TCL_ERROR; }




		i__2 = *n - i__;
		if (dsyr2_(interp, uplo, &i__2, &dsytd2_c_b14, &a[i__ + 1 + i__ * a_dim1], &dsytd2_c__1, 			 &tau[i__], &dsytd2_c__1, &a[i__ + 1 + (i__ + 1) * a_dim1], 
			lda)!=TCL_OK) { return TCL_ERROR; }



		a[i__ + 1 + i__ * a_dim1] = e[i__];
	    }
	    d__[i__] = a[i__ + i__ * a_dim1];
	    tau[i__] = taui;
	}
	d__[*n] = a[*n + *n * a_dim1];
    }

return TCL_OK;


} /* dsytd2_ */
static /* Subroutine */ int dsyr2k_ (Tcl_Interp *interp, char *uplo, char *trans, integer *n, integer *k, 	doublereal *alpha, doublereal *a, integer *lda, doublereal *b, 	integer *ldb, doublereal *beta, doublereal *c__, integer *ldc)
{
    integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, 
	    i__3;

    integer i__, j, l, info;
    doublereal temp1, temp2;
    integer nrowa;
    logical upper;



































    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    b_dim1 = *ldb;
    b_offset = 1 + b_dim1;
    b -= b_offset;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;

    if (lsame_(trans, "N")) {
	nrowa = *n;
    } else {
	nrowa = *k;
    }
    upper = lsame_(uplo, "U");

    info = 0;
    if (! upper && ! lsame_(uplo, "L")) {
	info = 1;
    } else if (! lsame_(trans, "N") && ! lsame_(trans, 
	    "T") && ! lsame_(trans, "C")) {
	info = 2;
    } else if (*n < 0) {
	info = 3;
    } else if (*k < 0) {
	info = 4;
    } else if (*lda < max(1,nrowa)) {
	info = 7;
    } else if (*ldb < max(1,nrowa)) {
	info = 9;
    } else if (*ldc < max(1,*n)) {
	info = 12;
    }
    if (info != 0) {
	vectcl_xerbla(interp, "DSYR2K", &info);
return TCL_ERROR;

return TCL_OK;
    }


    if (*n == 0 || (*alpha == 0. || *k == 0) && *beta == 1.) {
return TCL_OK;
    }


    if (*alpha == 0.) {
	if (upper) {
	    if (*beta == 0.) {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = j;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			c__[i__ + j * c_dim1] = 0.;
		    }
		}
	    } else {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = j;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
		    }
		}
	    }
	} else {
	    if (*beta == 0.) {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = *n;
		    for (i__ = j; i__ <= i__2; ++i__) {
			c__[i__ + j * c_dim1] = 0.;
		    }
		}
	    } else {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = *n;
		    for (i__ = j; i__ <= i__2; ++i__) {
			c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
		    }
		}
	    }
	}
return TCL_OK;
    }


    if (lsame_(trans, "N")) {


	if (upper) {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		if (*beta == 0.) {
		    i__2 = j;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			c__[i__ + j * c_dim1] = 0.;
		    }
		} else if (*beta != 1.) {
		    i__2 = j;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
		    }
		}
		i__2 = *k;
		for (l = 1; l <= i__2; ++l) {
		    if (a[j + l * a_dim1] != 0. || b[j + l * b_dim1] != 0.) {
			temp1 = *alpha * b[j + l * b_dim1];
			temp2 = *alpha * a[j + l * a_dim1];
			i__3 = j;
			for (i__ = 1; i__ <= i__3; ++i__) {
			    c__[i__ + j * c_dim1] = c__[i__ + j * c_dim1] + a[
				    i__ + l * a_dim1] * temp1 + b[i__ + l * 
				    b_dim1] * temp2;
			}
		    }
		}
	    }
	} else {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		if (*beta == 0.) {
		    i__2 = *n;
		    for (i__ = j; i__ <= i__2; ++i__) {
			c__[i__ + j * c_dim1] = 0.;
		    }
		} else if (*beta != 1.) {
		    i__2 = *n;
		    for (i__ = j; i__ <= i__2; ++i__) {
			c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
		    }
		}
		i__2 = *k;
		for (l = 1; l <= i__2; ++l) {
		    if (a[j + l * a_dim1] != 0. || b[j + l * b_dim1] != 0.) {
			temp1 = *alpha * b[j + l * b_dim1];
			temp2 = *alpha * a[j + l * a_dim1];
			i__3 = *n;
			for (i__ = j; i__ <= i__3; ++i__) {
			    c__[i__ + j * c_dim1] = c__[i__ + j * c_dim1] + a[
				    i__ + l * a_dim1] * temp1 + b[i__ + l * 
				    b_dim1] * temp2;
			}
		    }
		}
	    }
	}
    } else {


	if (upper) {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = j;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    temp1 = 0.;
		    temp2 = 0.;
		    i__3 = *k;
		    for (l = 1; l <= i__3; ++l) {
			temp1 += a[l + i__ * a_dim1] * b[l + j * b_dim1];
			temp2 += b[l + i__ * b_dim1] * a[l + j * a_dim1];
		    }
		    if (*beta == 0.) {
			c__[i__ + j * c_dim1] = *alpha * temp1 + *alpha * 
				temp2;
		    } else {
			c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1] 
				+ *alpha * temp1 + *alpha * temp2;
		    }
		}
	    }
	} else {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = *n;
		for (i__ = j; i__ <= i__2; ++i__) {
		    temp1 = 0.;
		    temp2 = 0.;
		    i__3 = *k;
		    for (l = 1; l <= i__3; ++l) {
			temp1 += a[l + i__ * a_dim1] * b[l + j * b_dim1];
			temp2 += b[l + i__ * b_dim1] * a[l + j * a_dim1];
		    }
		    if (*beta == 0.) {
			c__[i__ + j * c_dim1] = *alpha * temp1 + *alpha * 
				temp2;
		    } else {
			c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1] 
				+ *alpha * temp1 + *alpha * temp2;
		    }
		}
	    }
	}
    }

return TCL_OK;


} /* dsyr2k_ */
static /* Subroutine */ int dlatrd_ (Tcl_Interp *interp, char *uplo, integer *n, integer *nb, doublereal *	a, integer *lda, doublereal *e, doublereal *tau, doublereal *w, 	integer *ldw)
{
    integer a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3;

    integer i__, iw;
    doublereal alpha;





































    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --e;
    --tau;
    w_dim1 = *ldw;
    w_offset = 1 + w_dim1;
    w -= w_offset;

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

    if (lsame_(uplo, "U")) {


	i__1 = *n - *nb + 1;
	for (i__ = *n; i__ >= i__1; --i__) {
	    iw = i__ - *n + *nb;
	    if (i__ < *n) {


		i__2 = *n - i__;
		if (dgemv_(interp, "No transpose", &i__, &i__2, &dlatrd_c_b5, &a[(i__ + 1) * 			a_dim1 + 1], lda, &w[i__ + (iw + 1) * w_dim1], ldw, &
			dlatrd_c_b6, &a[i__ * a_dim1 + 1], &dlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *n - i__;
		if (dgemv_(interp, "No transpose", &i__, &i__2, &dlatrd_c_b5, &w[(iw + 1) * 			w_dim1 + 1], ldw, &a[i__ + (i__ + 1) * a_dim1], lda, &
			dlatrd_c_b6, &a[i__ * a_dim1 + 1], &dlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }


	    }
	    if (i__ > 1) {


		i__2 = i__ - 1;
		if (dlarfg_(interp, &i__2, &a[i__ - 1 + i__ * a_dim1], &a[i__ * a_dim1 + 			1], &dlatrd_c__1, &tau[i__ - 1])!=TCL_OK) { return TCL_ERROR; }


		e[i__ - 1] = a[i__ - 1 + i__ * a_dim1];
		a[i__ - 1 + i__ * a_dim1] = 1.;


		i__2 = i__ - 1;
		if (dsymv_(interp, "Upper", &i__2, &dlatrd_c_b6, &a[a_offset], lda, &a[i__ * 			a_dim1 + 1], &dlatrd_c__1, &dlatrd_c_b16, &w[iw * w_dim1 + 1], &
			dlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		if (i__ < *n) {
		    i__2 = i__ - 1;
		    i__3 = *n - i__;
		    if (dgemv_(interp, "Transpose", &i__2, &i__3, &dlatrd_c_b6, &w[(iw + 1) * 			    w_dim1 + 1], ldw, &a[i__ * a_dim1 + 1], &dlatrd_c__1, &
			    dlatrd_c_b16, &w[i__ + 1 + iw * w_dim1], &dlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		    i__2 = i__ - 1;
		    i__3 = *n - i__;
		    if (dgemv_(interp, "No transpose", &i__2, &i__3, &dlatrd_c_b5, &a[(i__ + 1) *			     a_dim1 + 1], lda, &w[i__ + 1 + iw * w_dim1], &
			    dlatrd_c__1, &dlatrd_c_b6, &w[iw * w_dim1 + 1], &dlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		    i__2 = i__ - 1;
		    i__3 = *n - i__;
		    if (dgemv_(interp, "Transpose", &i__2, &i__3, &dlatrd_c_b6, &a[(i__ + 1) * 			    a_dim1 + 1], lda, &a[i__ * a_dim1 + 1], &dlatrd_c__1, &
			    dlatrd_c_b16, &w[i__ + 1 + iw * w_dim1], &dlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		    i__2 = i__ - 1;
		    i__3 = *n - i__;
		    if (dgemv_(interp, "No transpose", &i__2, &i__3, &dlatrd_c_b5, &w[(iw + 1) * 			    w_dim1 + 1], ldw, &w[i__ + 1 + iw * w_dim1], &
			    dlatrd_c__1, &dlatrd_c_b6, &w[iw * w_dim1 + 1], &dlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		}
		i__2 = i__ - 1;
		if (dscal_(interp, &i__2, &tau[i__ - 1], &w[iw * w_dim1 + 1], &dlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }

		i__2 = i__ - 1;
		alpha = tau[i__ - 1] * -.5 * ddot_(&i__2, &w[iw * w_dim1 + 1], 
			 &dlatrd_c__1, &a[i__ * a_dim1 + 1], &dlatrd_c__1);
		i__2 = i__ - 1;
		if (daxpy_(interp, &i__2, &alpha, &a[i__ * a_dim1 + 1], &dlatrd_c__1, &w[iw * 			w_dim1 + 1], &dlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }


	    }

	}
    } else {


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


	    i__2 = *n - i__ + 1;
	    i__3 = i__ - 1;
	    if (dgemv_(interp, "No transpose", &i__2, &i__3, &dlatrd_c_b5, &a[i__ + a_dim1], lda, 		     &w[i__ + w_dim1], ldw, &dlatrd_c_b6, &a[i__ + i__ * a_dim1], &
		    dlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }


	    i__2 = *n - i__ + 1;
	    i__3 = i__ - 1;
	    if (dgemv_(interp, "No transpose", &i__2, &i__3, &dlatrd_c_b5, &w[i__ + w_dim1], ldw, 		     &a[i__ + a_dim1], lda, &dlatrd_c_b6, &a[i__ + i__ * a_dim1], &
		    dlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }


	    if (i__ < *n) {


		i__2 = *n - i__;
		i__3 = i__ + 2;
		if (dlarfg_(interp, &i__2, &a[i__ + 1 + i__ * a_dim1], &a[min(i__3, *n)+ 			i__ * a_dim1], &dlatrd_c__1, &tau[i__])!=TCL_OK) { return TCL_ERROR; }


		e[i__] = a[i__ + 1 + i__ * a_dim1];
		a[i__ + 1 + i__ * a_dim1] = 1.;


		i__2 = *n - i__;
		if (dsymv_(interp, "Lower", &i__2, &dlatrd_c_b6, &a[i__ + 1 + (i__ + 1) * a_dim1], lda, &a[i__ + 1 + i__ * a_dim1], &dlatrd_c__1, &dlatrd_c_b16, &w[
			i__ + 1 + i__ * w_dim1], &dlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *n - i__;
		i__3 = i__ - 1;
		if (dgemv_(interp, "Transpose", &i__2, &i__3, &dlatrd_c_b6, &w[i__ + 1 + w_dim1], 			 ldw, &a[i__ + 1 + i__ * a_dim1], &dlatrd_c__1, &dlatrd_c_b16, &w[
			i__ * w_dim1 + 1], &dlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *n - i__;
		i__3 = i__ - 1;
		if (dgemv_(interp, "No transpose", &i__2, &i__3, &dlatrd_c_b5, &a[i__ + 1 + 			a_dim1], lda, &w[i__ * w_dim1 + 1], &dlatrd_c__1, &dlatrd_c_b6, &w[
			i__ + 1 + i__ * w_dim1], &dlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *n - i__;
		i__3 = i__ - 1;
		if (dgemv_(interp, "Transpose", &i__2, &i__3, &dlatrd_c_b6, &a[i__ + 1 + a_dim1], 			 lda, &a[i__ + 1 + i__ * a_dim1], &dlatrd_c__1, &dlatrd_c_b16, &w[
			i__ * w_dim1 + 1], &dlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *n - i__;
		i__3 = i__ - 1;
		if (dgemv_(interp, "No transpose", &i__2, &i__3, &dlatrd_c_b5, &w[i__ + 1 + 			w_dim1], ldw, &w[i__ * w_dim1 + 1], &dlatrd_c__1, &dlatrd_c_b6, &w[
			i__ + 1 + i__ * w_dim1], &dlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *n - i__;
		if (dscal_(interp, &i__2, &tau[i__], &w[i__ + 1 + i__ * w_dim1], &dlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }

		i__2 = *n - i__;
		alpha = tau[i__] * -.5 * ddot_(&i__2, &w[i__ + 1 + i__ * 
			w_dim1], &dlatrd_c__1, &a[i__ + 1 + i__ * a_dim1], &dlatrd_c__1);
		i__2 = *n - i__;
		if (daxpy_(interp, &i__2, &alpha, &a[i__ + 1 + i__ * a_dim1], &dlatrd_c__1, &w[			i__ + 1 + i__ * w_dim1], &dlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }


	    }

	}
    }

return TCL_OK;


} /* dlatrd_ */
static /* Subroutine */ int zhetd2_ (Tcl_Interp *interp, char *uplo, integer *n, doublecomplex *a, 	integer *lda, doublereal *d__, doublereal *e, doublecomplex *tau, 	integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3;
    doublereal d__1;
    doublecomplex z__1, z__2, z__3, z__4;

    integer i__;
    doublecomplex taui;
    doublecomplex alpha;
    logical upper;

































    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --d__;
    --e;
    --tau;

    *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);
	vectcl_xerbla(interp, "ZHETD2", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


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

    if (upper) {


	i__1 = *n + *n * a_dim1;
	i__2 = *n + *n * a_dim1;
	d__1 = a[i__2].r;
	a[i__1].r = d__1, a[i__1].i = 0.;
	for (i__ = *n - 1; i__ >= 1; --i__) {


	    i__1 = i__ + (i__ + 1) * a_dim1;
	    alpha.r = a[i__1].r, alpha.i = a[i__1].i;
	    if (zlarfg_(interp, &i__, &alpha, &a[(i__ + 1) * a_dim1 + 1], &zhetd2_c__1, &taui)!=TCL_OK) { return TCL_ERROR; }

	    i__1 = i__;
	    e[i__1] = alpha.r;

	    if (taui.r != 0. || taui.i != 0.) {


		i__1 = i__ + (i__ + 1) * a_dim1;
		a[i__1].r = 1., a[i__1].i = 0.;


		if (zhemv_(interp, uplo, &i__, &taui, &a[a_offset], lda, &a[(i__ + 1) * 			a_dim1 + 1], &zhetd2_c__1, &zhetd2_c_b2, &tau[1], &zhetd2_c__1)!=TCL_OK) { return TCL_ERROR; }




		z__3.r = -.5, z__3.i = -0.;
		z__2.r = z__3.r * taui.r - z__3.i * taui.i, z__2.i = z__3.r * 
			taui.i + z__3.i * taui.r;
		zdotc_(&z__4, &i__, &tau[1], &zhetd2_c__1, &a[(i__ + 1) * a_dim1 + 1]
, &zhetd2_c__1);
		z__1.r = z__2.r * z__4.r - z__2.i * z__4.i, z__1.i = z__2.r * 
			z__4.i + z__2.i * z__4.r;
		alpha.r = z__1.r, alpha.i = z__1.i;
		if (zaxpy_(interp, &i__, &alpha, &a[(i__ + 1) * a_dim1 + 1], &zhetd2_c__1, &tau[			1], &zhetd2_c__1)!=TCL_OK) { return TCL_ERROR; }




		z__1.r = -1., z__1.i = -0.;
		if (zher2_(interp, uplo, &i__, &z__1, &a[(i__ + 1) * a_dim1 + 1], &zhetd2_c__1, &			tau[1], &zhetd2_c__1, &a[a_offset], lda)!=TCL_OK) { return TCL_ERROR; }



	    } else {
		i__1 = i__ + i__ * a_dim1;
		i__2 = i__ + i__ * a_dim1;
		d__1 = a[i__2].r;
		a[i__1].r = d__1, a[i__1].i = 0.;
	    }
	    i__1 = i__ + (i__ + 1) * a_dim1;
	    i__2 = i__;
	    a[i__1].r = e[i__2], a[i__1].i = 0.;
	    i__1 = i__ + 1;
	    i__2 = i__ + 1 + (i__ + 1) * a_dim1;
	    d__[i__1] = a[i__2].r;
	    i__1 = i__;
	    tau[i__1].r = taui.r, tau[i__1].i = taui.i;
	}
	i__1 = a_dim1 + 1;
	d__[1] = a[i__1].r;
    } else {


	i__1 = a_dim1 + 1;
	i__2 = a_dim1 + 1;
	d__1 = a[i__2].r;
	a[i__1].r = d__1, a[i__1].i = 0.;
	i__1 = *n - 1;
	for (i__ = 1; i__ <= i__1; ++i__) {


	    i__2 = i__ + 1 + i__ * a_dim1;
	    alpha.r = a[i__2].r, alpha.i = a[i__2].i;
	    i__2 = *n - i__;
	    i__3 = i__ + 2;
	    if (zlarfg_(interp, &i__2, &alpha, &a[min(i__3, *n)+ i__ * a_dim1], &zhetd2_c__1, &		    taui)!=TCL_OK) { return TCL_ERROR; }


	    i__2 = i__;
	    e[i__2] = alpha.r;

	    if (taui.r != 0. || taui.i != 0.) {


		i__2 = i__ + 1 + i__ * a_dim1;
		a[i__2].r = 1., a[i__2].i = 0.;


		i__2 = *n - i__;
		if (zhemv_(interp, uplo, &i__2, &taui, &a[i__ + 1 + (i__ + 1) * a_dim1], 			lda, &a[i__ + 1 + i__ * a_dim1], &zhetd2_c__1, &zhetd2_c_b2, &tau[
			i__], &zhetd2_c__1)!=TCL_OK) { return TCL_ERROR; }




		z__3.r = -.5, z__3.i = -0.;
		z__2.r = z__3.r * taui.r - z__3.i * taui.i, z__2.i = z__3.r * 
			taui.i + z__3.i * taui.r;
		i__2 = *n - i__;
		zdotc_(&z__4, &i__2, &tau[i__], &zhetd2_c__1, &a[i__ + 1 + i__ * 
			a_dim1], &zhetd2_c__1);
		z__1.r = z__2.r * z__4.r - z__2.i * z__4.i, z__1.i = z__2.r * 
			z__4.i + z__2.i * z__4.r;
		alpha.r = z__1.r, alpha.i = z__1.i;
		i__2 = *n - i__;
		if (zaxpy_(interp, &i__2, &alpha, &a[i__ + 1 + i__ * a_dim1], &zhetd2_c__1, &tau[			i__], &zhetd2_c__1)!=TCL_OK) { return TCL_ERROR; }




		i__2 = *n - i__;
		z__1.r = -1., z__1.i = -0.;
		if (zher2_(interp, uplo, &i__2, &z__1, &a[i__ + 1 + i__ * a_dim1], &zhetd2_c__1, 			&tau[i__], &zhetd2_c__1, &a[i__ + 1 + (i__ + 1) * a_dim1], 
			lda)!=TCL_OK) { return TCL_ERROR; }



	    } else {
		i__2 = i__ + 1 + (i__ + 1) * a_dim1;
		i__3 = i__ + 1 + (i__ + 1) * a_dim1;
		d__1 = a[i__3].r;
		a[i__2].r = d__1, a[i__2].i = 0.;
	    }
	    i__2 = i__ + 1 + i__ * a_dim1;
	    i__3 = i__;
	    a[i__2].r = e[i__3], a[i__2].i = 0.;
	    i__2 = i__;
	    i__3 = i__ + i__ * a_dim1;
	    d__[i__2] = a[i__3].r;
	    i__2 = i__;
	    tau[i__2].r = taui.r, tau[i__2].i = taui.i;
	}
	i__1 = *n;
	i__2 = *n + *n * a_dim1;
	d__[i__1] = a[i__2].r;
    }

return TCL_OK;


} /* zhetd2_ */
static /* Subroutine */ int zher2k_ (Tcl_Interp *interp, char *uplo, char *trans, integer *n, integer *k, 	doublecomplex *alpha, doublecomplex *a, integer *lda, doublecomplex *	b, integer *ldb, doublereal *beta, doublecomplex *c__, integer *ldc)
{
    integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, 
	    i__3, i__4, i__5, i__6, i__7;
    doublereal d__1;
    doublecomplex z__1, z__2, z__3, z__4, z__5, z__6;

    void d_cnjg(doublecomplex *, doublecomplex *);

    integer i__, j, l, info;
    doublecomplex temp1, temp2;
    integer nrowa;
    logical upper;


































    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    b_dim1 = *ldb;
    b_offset = 1 + b_dim1;
    b -= b_offset;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;

    if (lsame_(trans, "N")) {
	nrowa = *n;
    } else {
	nrowa = *k;
    }
    upper = lsame_(uplo, "U");

    info = 0;
    if (! upper && ! lsame_(uplo, "L")) {
	info = 1;
    } else if (! lsame_(trans, "N") && ! lsame_(trans, 
	    "C")) {
	info = 2;
    } else if (*n < 0) {
	info = 3;
    } else if (*k < 0) {
	info = 4;
    } else if (*lda < max(1,nrowa)) {
	info = 7;
    } else if (*ldb < max(1,nrowa)) {
	info = 9;
    } else if (*ldc < max(1,*n)) {
	info = 12;
    }
    if (info != 0) {
	vectcl_xerbla(interp, "ZHER2K", &info);
return TCL_ERROR;

return TCL_OK;
    }


    if (*n == 0 || (alpha->r == 0. && alpha->i == 0. || *k == 0) && *beta == 
	    1.) {
return TCL_OK;
    }


    if (alpha->r == 0. && alpha->i == 0.) {
	if (upper) {
	    if (*beta == 0.) {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = j;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			i__3 = i__ + j * c_dim1;
			c__[i__3].r = 0., c__[i__3].i = 0.;
		    }
		}
	    } else {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = j - 1;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			i__3 = i__ + j * c_dim1;
			i__4 = i__ + j * c_dim1;
			z__1.r = *beta * c__[i__4].r, z__1.i = *beta * c__[
				i__4].i;
			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
		    }
		    i__2 = j + j * c_dim1;
		    i__3 = j + j * c_dim1;
		    d__1 = *beta * c__[i__3].r;
		    c__[i__2].r = d__1, c__[i__2].i = 0.;
		}
	    }
	} else {
	    if (*beta == 0.) {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = *n;
		    for (i__ = j; i__ <= i__2; ++i__) {
			i__3 = i__ + j * c_dim1;
			c__[i__3].r = 0., c__[i__3].i = 0.;
		    }
		}
	    } else {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = j + j * c_dim1;
		    i__3 = j + j * c_dim1;
		    d__1 = *beta * c__[i__3].r;
		    c__[i__2].r = d__1, c__[i__2].i = 0.;
		    i__2 = *n;
		    for (i__ = j + 1; i__ <= i__2; ++i__) {
			i__3 = i__ + j * c_dim1;
			i__4 = i__ + j * c_dim1;
			z__1.r = *beta * c__[i__4].r, z__1.i = *beta * c__[
				i__4].i;
			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
		    }
		}
	    }
	}
return TCL_OK;
    }


    if (lsame_(trans, "N")) {


	if (upper) {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		if (*beta == 0.) {
		    i__2 = j;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			i__3 = i__ + j * c_dim1;
			c__[i__3].r = 0., c__[i__3].i = 0.;
		    }
		} else if (*beta != 1.) {
		    i__2 = j - 1;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			i__3 = i__ + j * c_dim1;
			i__4 = i__ + j * c_dim1;
			z__1.r = *beta * c__[i__4].r, z__1.i = *beta * c__[
				i__4].i;
			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
		    }
		    i__2 = j + j * c_dim1;
		    i__3 = j + j * c_dim1;
		    d__1 = *beta * c__[i__3].r;
		    c__[i__2].r = d__1, c__[i__2].i = 0.;
		} else {
		    i__2 = j + j * c_dim1;
		    i__3 = j + j * c_dim1;
		    d__1 = c__[i__3].r;
		    c__[i__2].r = d__1, c__[i__2].i = 0.;
		}
		i__2 = *k;
		for (l = 1; l <= i__2; ++l) {
		    i__3 = j + l * a_dim1;
		    i__4 = j + l * b_dim1;
		    if (a[i__3].r != 0. || a[i__3].i != 0. || (b[i__4].r != 
			    0. || b[i__4].i != 0.)) {
			d_cnjg(&z__2, &b[j + l * b_dim1]);
			z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, 
				z__1.i = alpha->r * z__2.i + alpha->i * 
				z__2.r;
			temp1.r = z__1.r, temp1.i = z__1.i;
			i__3 = j + l * a_dim1;
			z__2.r = alpha->r * a[i__3].r - alpha->i * a[i__3].i, 
				z__2.i = alpha->r * a[i__3].i + alpha->i * a[
				i__3].r;
			d_cnjg(&z__1, &z__2);
			temp2.r = z__1.r, temp2.i = z__1.i;
			i__3 = j - 1;
			for (i__ = 1; i__ <= i__3; ++i__) {
			    i__4 = i__ + j * c_dim1;
			    i__5 = i__ + j * c_dim1;
			    i__6 = i__ + l * a_dim1;
			    z__3.r = a[i__6].r * temp1.r - a[i__6].i * 
				    temp1.i, z__3.i = a[i__6].r * temp1.i + a[
				    i__6].i * temp1.r;
			    z__2.r = c__[i__5].r + z__3.r, z__2.i = c__[i__5]
				    .i + z__3.i;
			    i__7 = i__ + l * b_dim1;
			    z__4.r = b[i__7].r * temp2.r - b[i__7].i * 
				    temp2.i, z__4.i = b[i__7].r * temp2.i + b[
				    i__7].i * temp2.r;
			    z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + 
				    z__4.i;
			    c__[i__4].r = z__1.r, c__[i__4].i = z__1.i;
			}
			i__3 = j + j * c_dim1;
			i__4 = j + j * c_dim1;
			i__5 = j + l * a_dim1;
			z__2.r = a[i__5].r * temp1.r - a[i__5].i * temp1.i, 
				z__2.i = a[i__5].r * temp1.i + a[i__5].i * 
				temp1.r;
			i__6 = j + l * b_dim1;
			z__3.r = b[i__6].r * temp2.r - b[i__6].i * temp2.i, 
				z__3.i = b[i__6].r * temp2.i + b[i__6].i * 
				temp2.r;
			z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
			d__1 = c__[i__4].r + z__1.r;
			c__[i__3].r = d__1, c__[i__3].i = 0.;
		    }
		}
	    }
	} else {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		if (*beta == 0.) {
		    i__2 = *n;
		    for (i__ = j; i__ <= i__2; ++i__) {
			i__3 = i__ + j * c_dim1;
			c__[i__3].r = 0., c__[i__3].i = 0.;
		    }
		} else if (*beta != 1.) {
		    i__2 = *n;
		    for (i__ = j + 1; i__ <= i__2; ++i__) {
			i__3 = i__ + j * c_dim1;
			i__4 = i__ + j * c_dim1;
			z__1.r = *beta * c__[i__4].r, z__1.i = *beta * c__[
				i__4].i;
			c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
		    }
		    i__2 = j + j * c_dim1;
		    i__3 = j + j * c_dim1;
		    d__1 = *beta * c__[i__3].r;
		    c__[i__2].r = d__1, c__[i__2].i = 0.;
		} else {
		    i__2 = j + j * c_dim1;
		    i__3 = j + j * c_dim1;
		    d__1 = c__[i__3].r;
		    c__[i__2].r = d__1, c__[i__2].i = 0.;
		}
		i__2 = *k;
		for (l = 1; l <= i__2; ++l) {
		    i__3 = j + l * a_dim1;
		    i__4 = j + l * b_dim1;
		    if (a[i__3].r != 0. || a[i__3].i != 0. || (b[i__4].r != 
			    0. || b[i__4].i != 0.)) {
			d_cnjg(&z__2, &b[j + l * b_dim1]);
			z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, 
				z__1.i = alpha->r * z__2.i + alpha->i * 
				z__2.r;
			temp1.r = z__1.r, temp1.i = z__1.i;
			i__3 = j + l * a_dim1;
			z__2.r = alpha->r * a[i__3].r - alpha->i * a[i__3].i, 
				z__2.i = alpha->r * a[i__3].i + alpha->i * a[
				i__3].r;
			d_cnjg(&z__1, &z__2);
			temp2.r = z__1.r, temp2.i = z__1.i;
			i__3 = *n;
			for (i__ = j + 1; i__ <= i__3; ++i__) {
			    i__4 = i__ + j * c_dim1;
			    i__5 = i__ + j * c_dim1;
			    i__6 = i__ + l * a_dim1;
			    z__3.r = a[i__6].r * temp1.r - a[i__6].i * 
				    temp1.i, z__3.i = a[i__6].r * temp1.i + a[
				    i__6].i * temp1.r;
			    z__2.r = c__[i__5].r + z__3.r, z__2.i = c__[i__5]
				    .i + z__3.i;
			    i__7 = i__ + l * b_dim1;
			    z__4.r = b[i__7].r * temp2.r - b[i__7].i * 
				    temp2.i, z__4.i = b[i__7].r * temp2.i + b[
				    i__7].i * temp2.r;
			    z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + 
				    z__4.i;
			    c__[i__4].r = z__1.r, c__[i__4].i = z__1.i;
			}
			i__3 = j + j * c_dim1;
			i__4 = j + j * c_dim1;
			i__5 = j + l * a_dim1;
			z__2.r = a[i__5].r * temp1.r - a[i__5].i * temp1.i, 
				z__2.i = a[i__5].r * temp1.i + a[i__5].i * 
				temp1.r;
			i__6 = j + l * b_dim1;
			z__3.r = b[i__6].r * temp2.r - b[i__6].i * temp2.i, 
				z__3.i = b[i__6].r * temp2.i + b[i__6].i * 
				temp2.r;
			z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
			d__1 = c__[i__4].r + z__1.r;
			c__[i__3].r = d__1, c__[i__3].i = 0.;
		    }
		}
	    }
	}
    } else {


	if (upper) {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = j;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    temp1.r = 0., temp1.i = 0.;
		    temp2.r = 0., temp2.i = 0.;
		    i__3 = *k;
		    for (l = 1; l <= i__3; ++l) {
			d_cnjg(&z__3, &a[l + i__ * a_dim1]);
			i__4 = l + j * b_dim1;
			z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4].i, 
				z__2.i = z__3.r * b[i__4].i + z__3.i * b[i__4]
				.r;
			z__1.r = temp1.r + z__2.r, z__1.i = temp1.i + z__2.i;
			temp1.r = z__1.r, temp1.i = z__1.i;
			d_cnjg(&z__3, &b[l + i__ * b_dim1]);
			i__4 = l + j * a_dim1;
			z__2.r = z__3.r * a[i__4].r - z__3.i * a[i__4].i, 
				z__2.i = z__3.r * a[i__4].i + z__3.i * a[i__4]
				.r;
			z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
			temp2.r = z__1.r, temp2.i = z__1.i;
		    }
		    if (i__ == j) {
			if (*beta == 0.) {
			    i__3 = j + j * c_dim1;
			    z__2.r = alpha->r * temp1.r - alpha->i * temp1.i, 
				    z__2.i = alpha->r * temp1.i + alpha->i * 
				    temp1.r;
			    d_cnjg(&z__4, alpha);
			    z__3.r = z__4.r * temp2.r - z__4.i * temp2.i, 
				    z__3.i = z__4.r * temp2.i + z__4.i * 
				    temp2.r;
			    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + 
				    z__3.i;
			    d__1 = z__1.r;
			    c__[i__3].r = d__1, c__[i__3].i = 0.;
			} else {
			    i__3 = j + j * c_dim1;
			    i__4 = j + j * c_dim1;
			    z__2.r = alpha->r * temp1.r - alpha->i * temp1.i, 
				    z__2.i = alpha->r * temp1.i + alpha->i * 
				    temp1.r;
			    d_cnjg(&z__4, alpha);
			    z__3.r = z__4.r * temp2.r - z__4.i * temp2.i, 
				    z__3.i = z__4.r * temp2.i + z__4.i * 
				    temp2.r;
			    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + 
				    z__3.i;
			    d__1 = *beta * c__[i__4].r + z__1.r;
			    c__[i__3].r = d__1, c__[i__3].i = 0.;
			}
		    } else {
			if (*beta == 0.) {
			    i__3 = i__ + j * c_dim1;
			    z__2.r = alpha->r * temp1.r - alpha->i * temp1.i, 
				    z__2.i = alpha->r * temp1.i + alpha->i * 
				    temp1.r;
			    d_cnjg(&z__4, alpha);
			    z__3.r = z__4.r * temp2.r - z__4.i * temp2.i, 
				    z__3.i = z__4.r * temp2.i + z__4.i * 
				    temp2.r;
			    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + 
				    z__3.i;
			    c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
			} else {
			    i__3 = i__ + j * c_dim1;
			    i__4 = i__ + j * c_dim1;
			    z__3.r = *beta * c__[i__4].r, z__3.i = *beta * 
				    c__[i__4].i;
			    z__4.r = alpha->r * temp1.r - alpha->i * temp1.i, 
				    z__4.i = alpha->r * temp1.i + alpha->i * 
				    temp1.r;
			    z__2.r = z__3.r + z__4.r, z__2.i = z__3.i + 
				    z__4.i;
			    d_cnjg(&z__6, alpha);
			    z__5.r = z__6.r * temp2.r - z__6.i * temp2.i, 
				    z__5.i = z__6.r * temp2.i + z__6.i * 
				    temp2.r;
			    z__1.r = z__2.r + z__5.r, z__1.i = z__2.i + 
				    z__5.i;
			    c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
			}
		    }
		}
	    }
	} else {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = *n;
		for (i__ = j; i__ <= i__2; ++i__) {
		    temp1.r = 0., temp1.i = 0.;
		    temp2.r = 0., temp2.i = 0.;
		    i__3 = *k;
		    for (l = 1; l <= i__3; ++l) {
			d_cnjg(&z__3, &a[l + i__ * a_dim1]);
			i__4 = l + j * b_dim1;
			z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4].i, 
				z__2.i = z__3.r * b[i__4].i + z__3.i * b[i__4]
				.r;
			z__1.r = temp1.r + z__2.r, z__1.i = temp1.i + z__2.i;
			temp1.r = z__1.r, temp1.i = z__1.i;
			d_cnjg(&z__3, &b[l + i__ * b_dim1]);
			i__4 = l + j * a_dim1;
			z__2.r = z__3.r * a[i__4].r - z__3.i * a[i__4].i, 
				z__2.i = z__3.r * a[i__4].i + z__3.i * a[i__4]
				.r;
			z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
			temp2.r = z__1.r, temp2.i = z__1.i;
		    }
		    if (i__ == j) {
			if (*beta == 0.) {
			    i__3 = j + j * c_dim1;
			    z__2.r = alpha->r * temp1.r - alpha->i * temp1.i, 
				    z__2.i = alpha->r * temp1.i + alpha->i * 
				    temp1.r;
			    d_cnjg(&z__4, alpha);
			    z__3.r = z__4.r * temp2.r - z__4.i * temp2.i, 
				    z__3.i = z__4.r * temp2.i + z__4.i * 
				    temp2.r;
			    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + 
				    z__3.i;
			    d__1 = z__1.r;
			    c__[i__3].r = d__1, c__[i__3].i = 0.;
			} else {
			    i__3 = j + j * c_dim1;
			    i__4 = j + j * c_dim1;
			    z__2.r = alpha->r * temp1.r - alpha->i * temp1.i, 
				    z__2.i = alpha->r * temp1.i + alpha->i * 
				    temp1.r;
			    d_cnjg(&z__4, alpha);
			    z__3.r = z__4.r * temp2.r - z__4.i * temp2.i, 
				    z__3.i = z__4.r * temp2.i + z__4.i * 
				    temp2.r;
			    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + 
				    z__3.i;
			    d__1 = *beta * c__[i__4].r + z__1.r;
			    c__[i__3].r = d__1, c__[i__3].i = 0.;
			}
		    } else {
			if (*beta == 0.) {
			    i__3 = i__ + j * c_dim1;
			    z__2.r = alpha->r * temp1.r - alpha->i * temp1.i, 
				    z__2.i = alpha->r * temp1.i + alpha->i * 
				    temp1.r;
			    d_cnjg(&z__4, alpha);
			    z__3.r = z__4.r * temp2.r - z__4.i * temp2.i, 
				    z__3.i = z__4.r * temp2.i + z__4.i * 
				    temp2.r;
			    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + 
				    z__3.i;
			    c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
			} else {
			    i__3 = i__ + j * c_dim1;
			    i__4 = i__ + j * c_dim1;
			    z__3.r = *beta * c__[i__4].r, z__3.i = *beta * 
				    c__[i__4].i;
			    z__4.r = alpha->r * temp1.r - alpha->i * temp1.i, 
				    z__4.i = alpha->r * temp1.i + alpha->i * 
				    temp1.r;
			    z__2.r = z__3.r + z__4.r, z__2.i = z__3.i + 
				    z__4.i;
			    d_cnjg(&z__6, alpha);
			    z__5.r = z__6.r * temp2.r - z__6.i * temp2.i, 
				    z__5.i = z__6.r * temp2.i + z__6.i * 
				    temp2.r;
			    z__1.r = z__2.r + z__5.r, z__1.i = z__2.i + 
				    z__5.i;
			    c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
			}
		    }
		}
	    }
	}
    }

return TCL_OK;


} /* zher2k_ */
static /* Subroutine */ int zlatrd_ (Tcl_Interp *interp, char *uplo, integer *n, integer *nb, 	doublecomplex *a, integer *lda, doublereal *e, doublecomplex *tau, 	doublecomplex *w, integer *ldw)
{
    integer a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3;
    doublereal d__1;
    doublecomplex z__1, z__2, z__3, z__4;

    integer i__, iw;
    doublecomplex alpha;





































    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --e;
    --tau;
    w_dim1 = *ldw;
    w_offset = 1 + w_dim1;
    w -= w_offset;

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

    if (lsame_(uplo, "U")) {


	i__1 = *n - *nb + 1;
	for (i__ = *n; i__ >= i__1; --i__) {
	    iw = i__ - *n + *nb;
	    if (i__ < *n) {


		i__2 = i__ + i__ * a_dim1;
		i__3 = i__ + i__ * a_dim1;
		d__1 = a[i__3].r;
		a[i__2].r = d__1, a[i__2].i = 0.;
		i__2 = *n - i__;
		if (zlacgv_(interp, &i__2, &w[i__ + (iw + 1) * w_dim1], ldw)!=TCL_OK) { return TCL_ERROR; }

		i__2 = *n - i__;
		z__1.r = -1., z__1.i = -0.;
		if (zgemv_(interp, "No transpose", &i__, &i__2, &z__1, &a[(i__ + 1) * 			a_dim1 + 1], lda, &w[i__ + (iw + 1) * w_dim1], ldw, &
			zlatrd_c_b2, &a[i__ * a_dim1 + 1], &zlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *n - i__;
		if (zlacgv_(interp, &i__2, &w[i__ + (iw + 1) * w_dim1], ldw)!=TCL_OK) { return TCL_ERROR; }

		i__2 = *n - i__;
		if (zlacgv_(interp, &i__2, &a[i__ + (i__ + 1) * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }

		i__2 = *n - i__;
		z__1.r = -1., z__1.i = -0.;
		if (zgemv_(interp, "No transpose", &i__, &i__2, &z__1, &w[(iw + 1) * 			w_dim1 + 1], ldw, &a[i__ + (i__ + 1) * a_dim1], lda, &
			zlatrd_c_b2, &a[i__ * a_dim1 + 1], &zlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *n - i__;
		if (zlacgv_(interp, &i__2, &a[i__ + (i__ + 1) * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }

		i__2 = i__ + i__ * a_dim1;
		i__3 = i__ + i__ * a_dim1;
		d__1 = a[i__3].r;
		a[i__2].r = d__1, a[i__2].i = 0.;
	    }
	    if (i__ > 1) {


		i__2 = i__ - 1 + i__ * a_dim1;
		alpha.r = a[i__2].r, alpha.i = a[i__2].i;
		i__2 = i__ - 1;
		if (zlarfg_(interp, &i__2, &alpha, &a[i__ * a_dim1 + 1], &zlatrd_c__1, &tau[i__ 			- 1])!=TCL_OK) { return TCL_ERROR; }


		i__2 = i__ - 1;
		e[i__2] = alpha.r;
		i__2 = i__ - 1 + i__ * a_dim1;
		a[i__2].r = 1., a[i__2].i = 0.;


		i__2 = i__ - 1;
		if (zhemv_(interp, "Upper", &i__2, &zlatrd_c_b2, &a[a_offset], lda, &a[i__ * 			a_dim1 + 1], &zlatrd_c__1, &zlatrd_c_b1, &w[iw * w_dim1 + 1], &zlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		if (i__ < *n) {
		    i__2 = i__ - 1;
		    i__3 = *n - i__;
		    if (zgemv_(interp, "Conjugate transpose", &i__2, &i__3, &zlatrd_c_b2, &w[(iw 			    + 1) * w_dim1 + 1], ldw, &a[i__ * a_dim1 + 1], &
			    zlatrd_c__1, &zlatrd_c_b1, &w[i__ + 1 + iw * w_dim1], &zlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		    i__2 = i__ - 1;
		    i__3 = *n - i__;
		    z__1.r = -1., z__1.i = -0.;
		    if (zgemv_(interp, "No transpose", &i__2, &i__3, &z__1, &a[(i__ + 1) *			     a_dim1 + 1], lda, &w[i__ + 1 + iw * w_dim1], &
			    zlatrd_c__1, &zlatrd_c_b2, &w[iw * w_dim1 + 1], &zlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		    i__2 = i__ - 1;
		    i__3 = *n - i__;
		    if (zgemv_(interp, "Conjugate transpose", &i__2, &i__3, &zlatrd_c_b2, &a[(			    i__ + 1) * a_dim1 + 1], lda, &a[i__ * a_dim1 + 1], 
			     &zlatrd_c__1, &zlatrd_c_b1, &w[i__ + 1 + iw * w_dim1], &zlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		    i__2 = i__ - 1;
		    i__3 = *n - i__;
		    z__1.r = -1., z__1.i = -0.;
		    if (zgemv_(interp, "No transpose", &i__2, &i__3, &z__1, &w[(iw + 1) * 			    w_dim1 + 1], ldw, &w[i__ + 1 + iw * w_dim1], &
			    zlatrd_c__1, &zlatrd_c_b2, &w[iw * w_dim1 + 1], &zlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		}
		i__2 = i__ - 1;
		if (zscal_(interp, &i__2, &tau[i__ - 1], &w[iw * w_dim1 + 1], &zlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }

		z__3.r = -.5, z__3.i = -0.;
		i__2 = i__ - 1;
		z__2.r = z__3.r * tau[i__2].r - z__3.i * tau[i__2].i, z__2.i =
			 z__3.r * tau[i__2].i + z__3.i * tau[i__2].r;
		i__3 = i__ - 1;
		zdotc_(&z__4, &i__3, &w[iw * w_dim1 + 1], &zlatrd_c__1, &a[i__ * 
			a_dim1 + 1], &zlatrd_c__1);
		z__1.r = z__2.r * z__4.r - z__2.i * z__4.i, z__1.i = z__2.r * 
			z__4.i + z__2.i * z__4.r;
		alpha.r = z__1.r, alpha.i = z__1.i;
		i__2 = i__ - 1;
		if (zaxpy_(interp, &i__2, &alpha, &a[i__ * a_dim1 + 1], &zlatrd_c__1, &w[iw * 			w_dim1 + 1], &zlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }


	    }

	}
    } else {


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


	    i__2 = i__ + i__ * a_dim1;
	    i__3 = i__ + i__ * a_dim1;
	    d__1 = a[i__3].r;
	    a[i__2].r = d__1, a[i__2].i = 0.;
	    i__2 = i__ - 1;
	    if (zlacgv_(interp, &i__2, &w[i__ + w_dim1], ldw)!=TCL_OK) { return TCL_ERROR; }

	    i__2 = *n - i__ + 1;
	    i__3 = i__ - 1;
	    z__1.r = -1., z__1.i = -0.;
	    if (zgemv_(interp, "No transpose", &i__2, &i__3, &z__1, &a[i__ + a_dim1], lda, 		     &w[i__ + w_dim1], ldw, &zlatrd_c_b2, &a[i__ + i__ * a_dim1], &
		    zlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }


	    i__2 = i__ - 1;
	    if (zlacgv_(interp, &i__2, &w[i__ + w_dim1], ldw)!=TCL_OK) { return TCL_ERROR; }

	    i__2 = i__ - 1;
	    if (zlacgv_(interp, &i__2, &a[i__ + a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }

	    i__2 = *n - i__ + 1;
	    i__3 = i__ - 1;
	    z__1.r = -1., z__1.i = -0.;
	    if (zgemv_(interp, "No transpose", &i__2, &i__3, &z__1, &w[i__ + w_dim1], ldw, 		     &a[i__ + a_dim1], lda, &zlatrd_c_b2, &a[i__ + i__ * a_dim1], &
		    zlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }


	    i__2 = i__ - 1;
	    if (zlacgv_(interp, &i__2, &a[i__ + a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }

	    i__2 = i__ + i__ * a_dim1;
	    i__3 = i__ + i__ * a_dim1;
	    d__1 = a[i__3].r;
	    a[i__2].r = d__1, a[i__2].i = 0.;
	    if (i__ < *n) {


		i__2 = i__ + 1 + i__ * a_dim1;
		alpha.r = a[i__2].r, alpha.i = a[i__2].i;
		i__2 = *n - i__;
		i__3 = i__ + 2;
		if (zlarfg_(interp, &i__2, &alpha, &a[min(i__3, *n)+ i__ * a_dim1], &zlatrd_c__1, 			 &tau[i__])!=TCL_OK) { return TCL_ERROR; }


		i__2 = i__;
		e[i__2] = alpha.r;
		i__2 = i__ + 1 + i__ * a_dim1;
		a[i__2].r = 1., a[i__2].i = 0.;


		i__2 = *n - i__;
		if (zhemv_(interp, "Lower", &i__2, &zlatrd_c_b2, &a[i__ + 1 + (i__ + 1) * a_dim1], lda, &a[i__ + 1 + i__ * a_dim1], &zlatrd_c__1, &zlatrd_c_b1, &w[
			i__ + 1 + i__ * w_dim1], &zlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *n - i__;
		i__3 = i__ - 1;
		if (zgemv_(interp, "Conjugate transpose", &i__2, &i__3, &zlatrd_c_b2, &w[i__ + 1 			+ w_dim1], ldw, &a[i__ + 1 + i__ * a_dim1], &zlatrd_c__1, &
			zlatrd_c_b1, &w[i__ * w_dim1 + 1], &zlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *n - i__;
		i__3 = i__ - 1;
		z__1.r = -1., z__1.i = -0.;
		if (zgemv_(interp, "No transpose", &i__2, &i__3, &z__1, &a[i__ + 1 + 			a_dim1], lda, &w[i__ * w_dim1 + 1], &zlatrd_c__1, &zlatrd_c_b2, &w[
			i__ + 1 + i__ * w_dim1], &zlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *n - i__;
		i__3 = i__ - 1;
		if (zgemv_(interp, "Conjugate transpose", &i__2, &i__3, &zlatrd_c_b2, &a[i__ + 1 			+ a_dim1], lda, &a[i__ + 1 + i__ * a_dim1], &zlatrd_c__1, &
			zlatrd_c_b1, &w[i__ * w_dim1 + 1], &zlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *n - i__;
		i__3 = i__ - 1;
		z__1.r = -1., z__1.i = -0.;
		if (zgemv_(interp, "No transpose", &i__2, &i__3, &z__1, &w[i__ + 1 + 			w_dim1], ldw, &w[i__ * w_dim1 + 1], &zlatrd_c__1, &zlatrd_c_b2, &w[
			i__ + 1 + i__ * w_dim1], &zlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }


		i__2 = *n - i__;
		if (zscal_(interp, &i__2, &tau[i__], &w[i__ + 1 + i__ * w_dim1], &zlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }

		z__3.r = -.5, z__3.i = -0.;
		i__2 = i__;
		z__2.r = z__3.r * tau[i__2].r - z__3.i * tau[i__2].i, z__2.i =
			 z__3.r * tau[i__2].i + z__3.i * tau[i__2].r;
		i__3 = *n - i__;
		zdotc_(&z__4, &i__3, &w[i__ + 1 + i__ * w_dim1], &zlatrd_c__1, &a[
			i__ + 1 + i__ * a_dim1], &zlatrd_c__1);
		z__1.r = z__2.r * z__4.r - z__2.i * z__4.i, z__1.i = z__2.r * 
			z__4.i + z__2.i * z__4.r;
		alpha.r = z__1.r, alpha.i = z__1.i;
		i__2 = *n - i__;
		if (zaxpy_(interp, &i__2, &alpha, &a[i__ + 1 + i__ * a_dim1], &zlatrd_c__1, &w[			i__ + 1 + i__ * w_dim1], &zlatrd_c__1)!=TCL_OK) { return TCL_ERROR; }


	    }

	}
    }

return TCL_OK;


} /* zlatrd_ */
static /* Subroutine */ int zlarrv_ (Tcl_Interp *interp, integer *n, doublereal *vl, doublereal *vu, 	doublereal *d__, doublereal *l, doublereal *pivmin, integer *isplit, 	integer *m, integer *dol, integer *dou, doublereal *minrgp, 	doublereal *rtol1, doublereal *rtol2, doublereal *w, doublereal *werr, 	 doublereal *wgap, integer *iblock, integer *indexw, doublereal *gers, 	 doublecomplex *z__, integer *ldz, integer *isuppz, doublereal *work, 	integer *iwork, integer *info)
{
    integer z_dim1, z_offset, i__1, i__2, i__3, i__4, i__5, i__6;
    doublereal d__1, d__2;
    doublecomplex z__1;
    logical L__1;

    double log(doublereal);

    integer minwsize, i__, j, k, p, q, miniwsize, ii;
    doublereal gl;
    integer im, in;
    doublereal gu, gap, eps, tau, tol, tmp;
    integer zto;
    doublereal ztz;
    integer iend, jblk;
    doublereal lgap;
    integer done;
    doublereal rgap, left;
    integer wend, iter;
    doublereal bstw;
    integer itmp1, indld;
    doublereal fudge;
    integer idone;
    doublereal sigma;
    integer iinfo, iindr;
    doublereal resid;
    logical eskip;
    doublereal right;
    integer nclus, zfrom;
    doublereal rqtol;
    integer iindc1, iindc2, indin1, indin2;
    logical stp2ii;
    doublereal lambda;
    integer ibegin, indeig;
    logical needbs;
    integer indlld;
    doublereal sgndef, mingma;
    integer oldien, oldncl, wbegin;
    doublereal spdiam;
    integer negcnt;
    integer oldcls;
    doublereal savgap;
    integer ndepth;
    doublereal ssigma;
    logical usedbs;
    integer iindwk, offset;
    doublereal gaptol;
    integer newcls, oldfst, indwrk, windex, oldlst;
    logical usedrq;
    integer newfst, newftt, parity, windmn, windpl, isupmn, newlst, zusedl;
    doublereal bstres;
    integer newsiz, zusedu, zusedw;
    doublereal nrminv;
    logical tryrqc;
    integer isupmx;
    doublereal rqcorr;


































    --d__;
    --l;
    --isplit;
    --w;
    --werr;
    --wgap;
    --iblock;
    --indexw;
    --gers;
    z_dim1 = *ldz;
    z_offset = 1 + z_dim1;
    z__ -= z_offset;
    --isuppz;
    --work;
    --iwork;

    indld = *n + 1;
    indlld = (*n << 1) + 1;
    indin1 = *n * 3 + 1;
    indin2 = (*n << 2) + 1;
    indwrk = *n * 5 + 1;
    minwsize = *n * 12;
    i__1 = minwsize;
    for (i__ = 1; i__ <= i__1; ++i__) {
	work[i__] = 0.;
    }
    iindr = 0;
    iindc1 = *n;
    iindc2 = *n << 1;
    iindwk = *n * 3 + 1;
    miniwsize = *n * 7;
    i__1 = miniwsize;
    for (i__ = 1; i__ <= i__1; ++i__) {
	iwork[i__] = 0;
    }
    zusedl = 1;
    if (*dol > 1) {
	zusedl = *dol - 1;
    }
    zusedu = *m;
    if (*dou < *m) {
	zusedu = *dou + 1;
    }
    zusedw = zusedu - zusedl + 1;
    if (zlaset_(interp, "Full", n, &zusedw, &zlarrv_c_b1, &zlarrv_c_b1, &z__[zusedl * z_dim1 + 1], ldz)!=TCL_OK) { return TCL_ERROR; }

    eps = dlamch_("Precision");
    rqtol = eps * 2.;

    tryrqc = TRUE_;
    if (*dol == 1 && *dou == *m) {
    } else {
	*rtol1 = eps * 4.;
	*rtol2 = eps * 4.;
    }
    done = 0;
    ibegin = 1;
    wbegin = 1;
    i__1 = iblock[*m];
    for (jblk = 1; jblk <= i__1; ++jblk) {
	iend = isplit[jblk];
	sigma = l[iend];
	wend = wbegin - 1;
L15:
	if (wend < *m) {
	    if (iblock[wend + 1] == jblk) {
		++wend;
		goto L15;
	    }
	}
	if (wend < wbegin) {
	    ibegin = iend + 1;
	    goto L170;
	} else if (wend < *dol || wbegin > *dou) {
	    ibegin = iend + 1;
	    wbegin = wend + 1;
	    goto L170;
	}
	gl = gers[(ibegin << 1) - 1];
	gu = gers[ibegin * 2];
	i__2 = iend;
	for (i__ = ibegin + 1; i__ <= i__2; ++i__) {
	    d__1 = gers[(i__ << 1) - 1];
	    gl = min(d__1,gl);
	    d__1 = gers[i__ * 2];
	    gu = max(d__1,gu);
	}
	spdiam = gu - gl;
	oldien = ibegin - 1;
	in = iend - ibegin + 1;
	im = wend - wbegin + 1;
	if (ibegin == iend) {
	    ++done;
	    i__2 = ibegin + wbegin * z_dim1;
	    z__[i__2].r = 1., z__[i__2].i = 0.;
	    isuppz[(wbegin << 1) - 1] = ibegin;
	    isuppz[wbegin * 2] = ibegin;
	    w[wbegin] += sigma;
	    work[wbegin] = w[wbegin];
	    ibegin = iend + 1;
	    ++wbegin;
	    goto L170;
	}
	if (dcopy_(interp, &im, &w[wbegin], &zlarrv_c__1, &work[wbegin], &zlarrv_c__1)!=TCL_OK) { return TCL_ERROR; }

	i__2 = im;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    w[wbegin + i__ - 1] += sigma;
	}
	ndepth = 0;
	parity = 1;
	nclus = 1;
	iwork[iindc1 + 1] = 1;
	iwork[iindc1 + 2] = im;
	idone = 0;
L40:
	if (idone < im) {
	    if (ndepth > *m) {
		*info = -2;
return TCL_OK;
	    }
	    oldncl = nclus;
	    nclus = 0;

	    parity = 1 - parity;
	    if (parity == 0) {
		oldcls = iindc1;
		newcls = iindc2;
	    } else {
		oldcls = iindc2;
		newcls = iindc1;
	    }
	    i__2 = oldncl;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		j = oldcls + (i__ << 1);
		oldfst = iwork[j - 1];
		oldlst = iwork[j];
		if (ndepth > 0) {
		    if (*dol == 1 && *dou == *m) {
			j = wbegin + oldfst - 1;
		    } else {
			if (wbegin + oldfst - 1 < *dol) {
			    j = *dol - 1;
			} else if (wbegin + oldfst - 1 > *dou) {
			    j = *dou;
			} else {
			    j = wbegin + oldfst - 1;
			}
		    }
		    i__3 = in - 1;
		    for (k = 1; k <= i__3; ++k) {
			i__4 = ibegin + k - 1 + j * z_dim1;
			d__[ibegin + k - 1] = z__[i__4].r;
			i__4 = ibegin + k - 1 + (j + 1) * z_dim1;
			l[ibegin + k - 1] = z__[i__4].r;
		    }
		    i__3 = iend + j * z_dim1;
		    d__[iend] = z__[i__3].r;
		    i__3 = iend + (j + 1) * z_dim1;
		    sigma = z__[i__3].r;
		    if (zlaset_(interp, "Full", &in, &zlarrv_c__2, &zlarrv_c_b1, &zlarrv_c_b1, &z__[ibegin + j 			    * z_dim1], ldz)!=TCL_OK) { return TCL_ERROR; }


		}
		i__3 = iend - 1;
		for (j = ibegin; j <= i__3; ++j) {
		    tmp = d__[j] * l[j];
		    work[indld - 1 + j] = tmp;
		    work[indlld - 1 + j] = tmp * l[j];
		}
		if (ndepth > 0) {
		    p = indexw[wbegin - 1 + oldfst];
		    q = indexw[wbegin - 1 + oldlst];
		    offset = indexw[wbegin] - 1;
		    if (dlarrb_(interp, &in, &d__[ibegin], &work[indlld + ibegin - 1], &p, 			     &q, rtol1, rtol2, &offset, &work[wbegin], &wgap[
			    wbegin], &werr[wbegin], &work[indwrk], &iwork[
			    iindwk], pivmin, &spdiam, &in, &iinfo)!=TCL_OK) { return TCL_ERROR; }


		    if (iinfo != 0) {
			*info = -1;
return TCL_OK;
		    }
		    if (oldfst > 1) {
			d__1 = wgap[wbegin + oldfst - 2], d__2 = w[wbegin + 
				oldfst - 1] - werr[wbegin + oldfst - 1] - w[
				wbegin + oldfst - 2] - werr[wbegin + oldfst - 
				2];
			wgap[wbegin + oldfst - 2] = max(d__1,d__2);
		    }
		    if (wbegin + oldlst - 1 < wend) {
			d__1 = wgap[wbegin + oldlst - 1], d__2 = w[wbegin + 
				oldlst] - werr[wbegin + oldlst] - w[wbegin + 
				oldlst - 1] - werr[wbegin + oldlst - 1];
			wgap[wbegin + oldlst - 1] = max(d__1,d__2);
		    }
		    i__3 = oldlst;
		    for (j = oldfst; j <= i__3; ++j) {
			w[wbegin + j - 1] = work[wbegin + j - 1] + sigma;
		    }
		}
		newfst = oldfst;
		i__3 = oldlst;
		for (j = oldfst; j <= i__3; ++j) {
		    if (j == oldlst) {
			newlst = j;
		    } else if (wgap[wbegin + j - 1] >= *minrgp * (d__1 = work[
			    wbegin + j - 1], abs(d__1))) {
			newlst = j;
		    } else {
			goto L140;
		    }
		    newsiz = newlst - newfst + 1;
		    if (*dol == 1 && *dou == *m) {
			newftt = wbegin + newfst - 1;
		    } else {
			if (wbegin + newfst - 1 < *dol) {
			    newftt = *dol - 1;
			} else if (wbegin + newfst - 1 > *dou) {
			    newftt = *dou;
			} else {
			    newftt = wbegin + newfst - 1;
			}
		    }
		    if (newsiz > 1) {




			if (newfst == 1) {
			    d__1 = 0., d__2 = w[wbegin] - werr[wbegin] - *vl;
			    lgap = max(d__1,d__2);
			} else {
			    lgap = wgap[wbegin + newfst - 2];
			}
			rgap = wgap[wbegin + newlst - 1];


			for (k = 1; k <= 2; ++k) {
			    if (k == 1) {
				p = indexw[wbegin - 1 + newfst];
			    } else {
				p = indexw[wbegin - 1 + newlst];
			    }
			    offset = indexw[wbegin] - 1;
			    if (dlarrb_(interp, &in, &d__[ibegin], &work[indlld + ibegin 				    - 1], &p, &p, &rqtol, &rqtol, &offset, &
				    work[wbegin], &wgap[wbegin], &werr[wbegin]
, &work[indwrk], &iwork[iindwk], pivmin, &
				    spdiam, &in, &iinfo)!=TCL_OK) { return TCL_ERROR; }


			}

			if (wbegin + newlst - 1 < *dol || wbegin + newfst - 1 
				> *dou) {

			    idone = idone + newlst - newfst + 1;
			    goto L139;
			}


			if (dlarrf_(interp, &in, &d__[ibegin], &l[ibegin], &work[indld + 				ibegin - 1], &newfst, &newlst, &work[wbegin], 
				&wgap[wbegin], &werr[wbegin], &spdiam, &lgap, 
				&rgap, pivmin, &tau, &work[indin1], &work[
				indin2], &work[indwrk], &iinfo)!=TCL_OK) { return TCL_ERROR; }


			i__4 = in - 1;
			for (k = 1; k <= i__4; ++k) {
			    i__5 = ibegin + k - 1 + newftt * z_dim1;
			    i__6 = indin1 + k - 1;
			    z__1.r = work[i__6], z__1.i = 0.;
			    z__[i__5].r = z__1.r, z__[i__5].i = z__1.i;
			    i__5 = ibegin + k - 1 + (newftt + 1) * z_dim1;
			    i__6 = indin2 + k - 1;
			    z__1.r = work[i__6], z__1.i = 0.;
			    z__[i__5].r = z__1.r, z__[i__5].i = z__1.i;
			}
			i__4 = iend + newftt * z_dim1;
			i__5 = indin1 + in - 1;
			z__1.r = work[i__5], z__1.i = 0.;
			z__[i__4].r = z__1.r, z__[i__4].i = z__1.i;
			if (iinfo == 0) {
			    ssigma = sigma + tau;
			    i__4 = iend + (newftt + 1) * z_dim1;
			    z__1.r = ssigma, z__1.i = 0.;
			    z__[i__4].r = z__1.r, z__[i__4].i = z__1.i;
			    i__4 = newlst;
			    for (k = newfst; k <= i__4; ++k) {
				fudge = eps * 3. * (d__1 = work[wbegin + k - 
					1], abs(d__1));
				work[wbegin + k - 1] -= tau;
				fudge += eps * 4. * (d__1 = work[wbegin + k - 
					1], abs(d__1));
				werr[wbegin + k - 1] += fudge;
			    }
			    ++nclus;
			    k = newcls + (nclus << 1);
			    iwork[k - 1] = newfst;
			    iwork[k] = newlst;
			} else {
			    *info = -2;
return TCL_OK;
			}
		    } else {


			iter = 0;

			tol = log((doublereal) in) * 4. * eps;

			k = newfst;
			windex = wbegin + k - 1;
			i__4 = windex - 1;
			windmn = max(i__4,1);
			i__4 = windex + 1;
			windpl = min(i__4,*m);
			lambda = work[windex];
			++done;
			if (windex < *dol || windex > *dou) {
			    eskip = TRUE_;
			    goto L125;
			} else {
			    eskip = FALSE_;
			}
			left = work[windex] - werr[windex];
			right = work[windex] + werr[windex];
			indeig = indexw[windex];
			if (k == 1) {
			    d__1 = abs(left), d__2 = abs(right);
			    lgap = eps * max(d__1,d__2);
			} else {
			    lgap = wgap[windmn];
			}
			if (k == im) {
			    d__1 = abs(left), d__2 = abs(right);
			    rgap = eps * max(d__1,d__2);
			} else {
			    rgap = wgap[windex];
			}
			gap = min(lgap,rgap);
			if (k == 1 || k == im) {
			    gaptol = 0.;
			} else {
			    gaptol = gap * eps;
			}
			isupmn = in;
			isupmx = 1;
			savgap = wgap[windex];
			wgap[windex] = gap;
			usedbs = FALSE_;
			usedrq = FALSE_;
			needbs = ! tryrqc;
L120:
			if (needbs) {
			    usedbs = TRUE_;
			    itmp1 = iwork[iindr + windex];
			    offset = indexw[wbegin] - 1;
			    d__1 = eps * 2.;
			    if (dlarrb_(interp, &in, &d__[ibegin], &work[indlld + ibegin 				    - 1], &indeig, &indeig, &zlarrv_c_b28, &d__1, &
				    offset, &work[wbegin], &wgap[wbegin], &
				    werr[wbegin], &work[indwrk], &iwork[
				    iindwk], pivmin, &spdiam, &itmp1, &iinfo)!=TCL_OK) { return TCL_ERROR; }


			    if (iinfo != 0) {
				*info = -3;
return TCL_OK;
			    }
			    lambda = work[windex];
			    iwork[iindr + windex] = 0;
			}
			L__1 = ! usedbs;
			if (zlar1v_(interp, &in, &zlarrv_c__1, &in, &lambda, &d__[ibegin], &l[				ibegin], &work[indld + ibegin - 1], &work[
				indlld + ibegin - 1], pivmin, &gaptol, &z__[
				ibegin + windex * z_dim1], &L__1, &negcnt, &
				ztz, &mingma, &iwork[iindr + windex], &isuppz[
				(windex << 1) - 1], &nrminv, &resid, &rqcorr, 
				&work[indwrk])!=TCL_OK) { return TCL_ERROR; }


			if (iter == 0) {
			    bstres = resid;
			    bstw = lambda;
			} else if (resid < bstres) {
			    bstres = resid;
			    bstw = lambda;
			}
			i__4 = isupmn, i__5 = isuppz[(windex << 1) - 1];
			isupmn = min(i__4,i__5);
			i__4 = isupmx, i__5 = isuppz[windex * 2];
			isupmx = max(i__4,i__5);
			++iter;


			if (resid > tol * gap && abs(rqcorr) > rqtol * abs(
				lambda) && ! usedbs) {
			    if (indeig <= negcnt) {
				sgndef = -1.;
			    } else {
				sgndef = 1.;
			    }
			    if (rqcorr * sgndef >= 0. && lambda + rqcorr <= 
				    right && lambda + rqcorr >= left) {
				usedrq = TRUE_;
				if (sgndef == 1.) {
				    left = lambda;
				} else {
				    right = lambda;
				}
				work[windex] = (right + left) * .5;
				lambda += rqcorr;
				werr[windex] = (right - left) * .5;
			    } else {
				needbs = TRUE_;
			    }
			    if (right - left < rqtol * abs(lambda)) {
				usedbs = TRUE_;
				goto L120;
			    } else if (iter < 10) {
				goto L120;
			    } else if (iter == 10) {
				needbs = TRUE_;
				goto L120;
			    } else {
				*info = 5;
return TCL_OK;
			    }
			} else {
			    stp2ii = FALSE_;
			    if (usedrq && usedbs && bstres <= resid) {
				lambda = bstw;
				stp2ii = TRUE_;
			    }
			    if (stp2ii) {
				L__1 = ! usedbs;
				if (zlar1v_(interp, &in, &zlarrv_c__1, &in, &lambda, &d__[ibegin], &l[ibegin], &work[indld + ibegin - 
					1], &work[indlld + ibegin - 1], 
					pivmin, &gaptol, &z__[ibegin + windex 
					* z_dim1], &L__1, &negcnt, &ztz, &
					mingma, &iwork[iindr + windex], &
					isuppz[(windex << 1) - 1], &nrminv, &
					resid, &rqcorr, &work[indwrk])!=TCL_OK) { return TCL_ERROR; }


			    }
			    work[windex] = lambda;
			}


			isuppz[(windex << 1) - 1] += oldien;
			isuppz[windex * 2] += oldien;
			zfrom = isuppz[(windex << 1) - 1];
			zto = isuppz[windex * 2];
			isupmn += oldien;
			isupmx += oldien;
			if (isupmn < zfrom) {
			    i__4 = zfrom - 1;
			    for (ii = isupmn; ii <= i__4; ++ii) {
				i__5 = ii + windex * z_dim1;
				z__[i__5].r = 0., z__[i__5].i = 0.;
			    }
			}
			if (isupmx > zto) {
			    i__4 = isupmx;
			    for (ii = zto + 1; ii <= i__4; ++ii) {
				i__5 = ii + windex * z_dim1;
				z__[i__5].r = 0., z__[i__5].i = 0.;
			    }
			}
			i__4 = zto - zfrom + 1;
			if (zdscal_(interp, &i__4, &nrminv, &z__[zfrom + windex * z_dim1], 				 &zlarrv_c__1)!=TCL_OK) { return TCL_ERROR; }


L125:
			w[windex] = lambda + sigma;
			if (! eskip) {
			    if (k > 1) {
				d__1 = wgap[windmn], d__2 = w[windex] - werr[
					windex] - w[windmn] - werr[windmn];
				wgap[windmn] = max(d__1,d__2);
			    }
			    if (windex < wend) {
				d__1 = savgap, d__2 = w[windpl] - werr[windpl]
					 - w[windex] - werr[windex];
				wgap[windex] = max(d__1,d__2);
			    }
			}
			++idone;
		    }

L139:
		    newfst = j + 1;
L140:
		    ;
		}
	    }
	    ++ndepth;
	    goto L40;
	}
	ibegin = iend + 1;
	wbegin = wend + 1;
L170:
	;
    }

return TCL_OK;


} /* zlarrv_ */
static /* Subroutine */ int zunmql_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *k, doublecomplex *a, integer *lda, doublecomplex *tau, 	doublecomplex *c__, integer *ldc, doublecomplex *work, integer *lwork, 	 integer *info)
{
    address 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];

    /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);

    integer i__;
    doublecomplex t[4160]	/* was [65][64] */;
    integer i1, i2, i3, ib, nb, mi, ni, nq, nw, iws;
    logical left;
    integer nbmin, iinfo;
    logical notran;
    integer ldwork;
    integer lwkopt;
    logical lquery;




























    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --tau;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;
    --work;

    *info = 0;
    left = lsame_(side, "L");
    notran = lsame_(trans, "N");
    lquery = *lwork == -1;


    if (left) {
	nq = *m;
	nw = max(1,*n);
    } else {
	nq = *n;
	nw = max(1,*m);
    }
    if (! left && ! lsame_(side, "R")) {
	*info = -1;
    } else if (! notran && ! lsame_(trans, "C")) {
	*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) {
	if (*m == 0 || *n == 0) {
	    lwkopt = 1;
	} else {


	    i__3[0] = 1, a__1[0] = side;
	    i__3[1] = 1, a__1[1] = trans;
	    s_cat(ch__1, a__1, i__3, &zunmql_c__2, (ftnlen)2);
	    i__1 = 64, i__2 = ilaenv_(&zunmql_c__1, "ZUNMQL", ch__1, m, n, k, &zunmql_c_n1);
	    nb = min(i__1,i__2);
	    lwkopt = nw * nb;
	}
	work[1].r = (doublereal) lwkopt, work[1].i = 0.;

	if (*lwork < nw && ! lquery) {
	    *info = -12;
	}
    }

    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "ZUNMQL", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


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

    nbmin = 2;
    ldwork = nw;
    if (nb > 1 && nb < *k) {
	iws = nw * nb;
	if (*lwork < iws) {
	    nb = *lwork / ldwork;
	    i__3[0] = 1, a__1[0] = side;
	    i__3[1] = 1, a__1[1] = trans;
	    s_cat(ch__1, a__1, i__3, &zunmql_c__2, (ftnlen)2);
	    i__1 = 2, i__2 = ilaenv_(&zunmql_c__2, "ZUNMQL", ch__1, m, n, k, &zunmql_c_n1);
	    nbmin = max(i__1,i__2);
	}
    } else {
	iws = nw;
    }

    if (nb < nbmin || nb >= *k) {


	if (zunm2l_(interp, side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[		c_offset], ldc, &work[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }


    } else {


	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;
	} else {
	    mi = *m;
	}

	i__1 = i2;
	i__2 = i3;
	for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
	    i__4 = nb, i__5 = *k - i__ + 1;
	    ib = min(i__4,i__5);


	    i__4 = nq - *k + i__ + ib - 1;
	    if (zlarft_(interp, "Backward", "Columnwise", &i__4, &ib, &a[i__ * a_dim1 + 1], lda, &tau[i__], t, &zunmql_c__65)!=TCL_OK) { return TCL_ERROR; }


	    if (left) {


		mi = *m - *k + i__ + ib - 1;
	    } else {


		ni = *n - *k + i__ + ib - 1;
	    }


	    if (zlarfb_(interp, side, trans, "Backward", "Columnwise", &mi, &ni, &ib, &a[		    i__ * a_dim1 + 1], lda, t, &zunmql_c__65, &c__[c_offset], ldc, &
		    work[1], &ldwork)!=TCL_OK) { return TCL_ERROR; }


	}
    }
    work[1].r = (doublereal) lwkopt, work[1].i = 0.;
return TCL_OK;


} /* zunmql_ */
static /* Subroutine */ int dtrmm_ (Tcl_Interp *interp, char *side, char *uplo, char *transa, char *diag, 	integer *m, integer *n, doublereal *alpha, doublereal *a, integer *	lda, doublereal *b, integer *ldb)
{
    integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3;

    integer i__, j, k, info;
    doublereal temp;
    logical lside;
    integer nrowa;
    logical upper;
    logical nounit;






































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

    lside = lsame_(side, "L");
    if (lside) {
	nrowa = *m;
    } else {
	nrowa = *n;
    }
    nounit = lsame_(diag, "N");
    upper = lsame_(uplo, "U");

    info = 0;
    if (! lside && ! lsame_(side, "R")) {
	info = 1;
    } else if (! upper && ! lsame_(uplo, "L")) {
	info = 2;
    } else if (! lsame_(transa, "N") && ! lsame_(transa, 
	     "T") && ! lsame_(transa, "C")) {
	info = 3;
    } else if (! lsame_(diag, "U") && ! lsame_(diag, 
	    "N")) {
	info = 4;
    } else if (*m < 0) {
	info = 5;
    } else if (*n < 0) {
	info = 6;
    } else if (*lda < max(1,nrowa)) {
	info = 9;
    } else if (*ldb < max(1,*m)) {
	info = 11;
    }
    if (info != 0) {
	vectcl_xerbla(interp, "DTRMM ", &info);
return TCL_ERROR;

return TCL_OK;
    }


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


    if (*alpha == 0.) {
	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *m;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		b[i__ + j * b_dim1] = 0.;
	    }
	}
return TCL_OK;
    }


    if (lside) {
	if (lsame_(transa, "N")) {


	    if (upper) {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = *m;
		    for (k = 1; k <= i__2; ++k) {
			if (b[k + j * b_dim1] != 0.) {
			    temp = *alpha * b[k + j * b_dim1];
			    i__3 = k - 1;
			    for (i__ = 1; i__ <= i__3; ++i__) {
				b[i__ + j * b_dim1] += temp * a[i__ + k * 
					a_dim1];
			    }
			    if (nounit) {
				temp *= a[k + k * a_dim1];
			    }
			    b[k + j * b_dim1] = temp;
			}
		    }
		}
	    } else {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    for (k = *m; k >= 1; --k) {
			if (b[k + j * b_dim1] != 0.) {
			    temp = *alpha * b[k + j * b_dim1];
			    b[k + j * b_dim1] = temp;
			    if (nounit) {
				b[k + j * b_dim1] *= a[k + k * a_dim1];
			    }
			    i__2 = *m;
			    for (i__ = k + 1; i__ <= i__2; ++i__) {
				b[i__ + j * b_dim1] += temp * a[i__ + k * 
					a_dim1];
			    }
			}
		    }
		}
	    }
	} else {


	    if (upper) {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    for (i__ = *m; i__ >= 1; --i__) {
			temp = b[i__ + j * b_dim1];
			if (nounit) {
			    temp *= a[i__ + i__ * a_dim1];
			}
			i__2 = i__ - 1;
			for (k = 1; k <= i__2; ++k) {
			    temp += a[k + i__ * a_dim1] * b[k + j * b_dim1];
			}
			b[i__ + j * b_dim1] = *alpha * temp;
		    }
		}
	    } else {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = *m;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			temp = b[i__ + j * b_dim1];
			if (nounit) {
			    temp *= a[i__ + i__ * a_dim1];
			}
			i__3 = *m;
			for (k = i__ + 1; k <= i__3; ++k) {
			    temp += a[k + i__ * a_dim1] * b[k + j * b_dim1];
			}
			b[i__ + j * b_dim1] = *alpha * temp;
		    }
		}
	    }
	}
    } else {
	if (lsame_(transa, "N")) {


	    if (upper) {
		for (j = *n; j >= 1; --j) {
		    temp = *alpha;
		    if (nounit) {
			temp *= a[j + j * a_dim1];
		    }
		    i__1 = *m;
		    for (i__ = 1; i__ <= i__1; ++i__) {
			b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1];
		    }
		    i__1 = j - 1;
		    for (k = 1; k <= i__1; ++k) {
			if (a[k + j * a_dim1] != 0.) {
			    temp = *alpha * a[k + j * a_dim1];
			    i__2 = *m;
			    for (i__ = 1; i__ <= i__2; ++i__) {
				b[i__ + j * b_dim1] += temp * b[i__ + k * 
					b_dim1];
			    }
			}
		    }
		}
	    } else {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    temp = *alpha;
		    if (nounit) {
			temp *= a[j + j * a_dim1];
		    }
		    i__2 = *m;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1];
		    }
		    i__2 = *n;
		    for (k = j + 1; k <= i__2; ++k) {
			if (a[k + j * a_dim1] != 0.) {
			    temp = *alpha * a[k + j * a_dim1];
			    i__3 = *m;
			    for (i__ = 1; i__ <= i__3; ++i__) {
				b[i__ + j * b_dim1] += temp * b[i__ + k * 
					b_dim1];
			    }
			}
		    }
		}
	    }
	} else {


	    if (upper) {
		i__1 = *n;
		for (k = 1; k <= i__1; ++k) {
		    i__2 = k - 1;
		    for (j = 1; j <= i__2; ++j) {
			if (a[j + k * a_dim1] != 0.) {
			    temp = *alpha * a[j + k * a_dim1];
			    i__3 = *m;
			    for (i__ = 1; i__ <= i__3; ++i__) {
				b[i__ + j * b_dim1] += temp * b[i__ + k * 
					b_dim1];
			    }
			}
		    }
		    temp = *alpha;
		    if (nounit) {
			temp *= a[k + k * a_dim1];
		    }
		    if (temp != 1.) {
			i__2 = *m;
			for (i__ = 1; i__ <= i__2; ++i__) {
			    b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1];
			}
		    }
		}
	    } else {
		for (k = *n; k >= 1; --k) {
		    i__1 = *n;
		    for (j = k + 1; j <= i__1; ++j) {
			if (a[j + k * a_dim1] != 0.) {
			    temp = *alpha * a[j + k * a_dim1];
			    i__2 = *m;
			    for (i__ = 1; i__ <= i__2; ++i__) {
				b[i__ + j * b_dim1] += temp * b[i__ + k * 
					b_dim1];
			    }
			}
		    }
		    temp = *alpha;
		    if (nounit) {
			temp *= a[k + k * a_dim1];
		    }
		    if (temp != 1.) {
			i__1 = *m;
			for (i__ = 1; i__ <= i__1; ++i__) {
			    b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1];
			}
		    }
		}
	    }
	}
    }

return TCL_OK;


} /* dtrmm_ */
static /* Subroutine */ int dgehd2_ (Tcl_Interp *interp, integer *n, integer *ilo, integer *ihi, 	doublereal *a, integer *lda, doublereal *tau, doublereal *work, 	integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3;

    integer i__;
    doublereal aii;



























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

    *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);
	vectcl_xerbla(interp, "DGEHD2", &i__1);
return TCL_ERROR;

return TCL_OK;
    }

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


	i__2 = *ihi - i__;
	i__3 = i__ + 2;
	if (dlarfg_(interp, &i__2, &a[i__ + 1 + i__ * a_dim1], &a[min(i__3, *n)+ i__ * 		a_dim1], &dgehd2_c__1, &tau[i__])!=TCL_OK) { return TCL_ERROR; }


	aii = a[i__ + 1 + i__ * a_dim1];
	a[i__ + 1 + i__ * a_dim1] = 1.;


	i__2 = *ihi - i__;
	if (dlarf_(interp, "Right", ihi, &i__2, &a[i__ + 1 + i__ * a_dim1], &dgehd2_c__1, &tau[		i__], &a[(i__ + 1) * a_dim1 + 1], lda, &work[1])!=TCL_OK) { return TCL_ERROR; }




	i__2 = *ihi - i__;
	i__3 = *n - i__;
	if (dlarf_(interp, "Left", &i__2, &i__3, &a[i__ + 1 + i__ * a_dim1], &dgehd2_c__1, &tau[		i__], &a[i__ + 1 + (i__ + 1) * a_dim1], lda, &work[1])!=TCL_OK) { return TCL_ERROR; }



	a[i__ + 1 + i__ * a_dim1] = aii;
    }

return TCL_OK;


} /* dgehd2_ */
static /* Subroutine */ int dlahr2_ (Tcl_Interp *interp, integer *n, integer *k, integer *nb, doublereal *	a, integer *lda, doublereal *tau, doublereal *t, integer *ldt, 	doublereal *y, integer *ldy)
{
    integer a_dim1, a_offset, t_dim1, t_offset, y_dim1, y_offset, i__1, i__2, 
	    i__3;
    doublereal d__1;

    integer i__;
    doublereal ei;
































    --tau;
    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    t_dim1 = *ldt;
    t_offset = 1 + t_dim1;
    t -= t_offset;
    y_dim1 = *ldy;
    y_offset = 1 + y_dim1;
    y -= y_offset;

    if (*n <= 1) {
return TCL_OK;
    }

    i__1 = *nb;
    for (i__ = 1; i__ <= i__1; ++i__) {
	if (i__ > 1) {



	    i__2 = *n - *k;
	    i__3 = i__ - 1;
	    if (dgemv_(interp, "NO TRANSPOSE", &i__2, &i__3, &dlahr2_c_b4, &y[*k + 1 + y_dim1], 		    ldy, &a[*k + i__ - 1 + a_dim1], lda, &dlahr2_c_b5, &a[*k + 1 + 
		    i__ * a_dim1], &dlahr2_c__1)!=TCL_OK) { return TCL_ERROR; }







	    i__2 = i__ - 1;
	    if (dcopy_(interp, &i__2, &a[*k + 1 + i__ * a_dim1], &dlahr2_c__1, &t[*nb * t_dim1 + 		    1], &dlahr2_c__1)!=TCL_OK) { return TCL_ERROR; }


	    i__2 = i__ - 1;
	    if (dtrmv_(interp, "Lower", "Transpose", "UNIT", &i__2, &a[*k + 1 + a_dim1], 		    lda, &t[*nb * t_dim1 + 1], &dlahr2_c__1)!=TCL_OK) { return TCL_ERROR; }




	    i__2 = *n - *k - i__ + 1;
	    i__3 = i__ - 1;
	    if (dgemv_(interp, "Transpose", &i__2, &i__3, &dlahr2_c_b5, &a[*k + i__ + a_dim1], 		    lda, &a[*k + i__ + i__ * a_dim1], &dlahr2_c__1, &dlahr2_c_b5, &t[*nb * 
		    t_dim1 + 1], &dlahr2_c__1)!=TCL_OK) { return TCL_ERROR; }




	    i__2 = i__ - 1;
	    if (dtrmv_(interp, "Upper", "Transpose", "NON-UNIT", &i__2, &t[t_offset], ldt, 		     &t[*nb * t_dim1 + 1], &dlahr2_c__1)!=TCL_OK) { return TCL_ERROR; }




	    i__2 = *n - *k - i__ + 1;
	    i__3 = i__ - 1;
	    if (dgemv_(interp, "NO TRANSPOSE", &i__2, &i__3, &dlahr2_c_b4, &a[*k + i__ + a_dim1], 		     lda, &t[*nb * t_dim1 + 1], &dlahr2_c__1, &dlahr2_c_b5, &a[*k + i__ + 
		    i__ * a_dim1], &dlahr2_c__1)!=TCL_OK) { return TCL_ERROR; }




	    i__2 = i__ - 1;
	    if (dtrmv_(interp, "Lower", "NO TRANSPOSE", "UNIT", &i__2, &a[*k + 1 + a_dim1], lda, &t[*nb * t_dim1 + 1], &dlahr2_c__1)!=TCL_OK) { return TCL_ERROR; }


	    i__2 = i__ - 1;
	    if (daxpy_(interp, &i__2, &dlahr2_c_b4, &t[*nb * t_dim1 + 1], &dlahr2_c__1, &a[*k + 1 + i__ 		    * a_dim1], &dlahr2_c__1)!=TCL_OK) { return TCL_ERROR; }



	    a[*k + i__ - 1 + (i__ - 1) * a_dim1] = ei;
	}


	i__2 = *n - *k - i__ + 1;
	i__3 = *k + i__ + 1;
	if (dlarfg_(interp, &i__2, &a[*k + i__ + i__ * a_dim1], &a[min(i__3, *n)+ i__ * 		a_dim1], &dlahr2_c__1, &tau[i__])!=TCL_OK) { return TCL_ERROR; }


	ei = a[*k + i__ + i__ * a_dim1];
	a[*k + i__ + i__ * a_dim1] = 1.;


	i__2 = *n - *k;
	i__3 = *n - *k - i__ + 1;
	if (dgemv_(interp, "NO TRANSPOSE", &i__2, &i__3, &dlahr2_c_b5, &a[*k + 1 + (i__ + 1) * 		a_dim1], lda, &a[*k + i__ + i__ * a_dim1], &dlahr2_c__1, &dlahr2_c_b38, &y[*
		k + 1 + i__ * y_dim1], &dlahr2_c__1)!=TCL_OK) { return TCL_ERROR; }


	i__2 = *n - *k - i__ + 1;
	i__3 = i__ - 1;
	if (dgemv_(interp, "Transpose", &i__2, &i__3, &dlahr2_c_b5, &a[*k + i__ + a_dim1], lda, &		a[*k + i__ + i__ * a_dim1], &dlahr2_c__1, &dlahr2_c_b38, &t[i__ * t_dim1 + 
		1], &dlahr2_c__1)!=TCL_OK) { return TCL_ERROR; }


	i__2 = *n - *k;
	i__3 = i__ - 1;
	if (dgemv_(interp, "NO TRANSPOSE", &i__2, &i__3, &dlahr2_c_b4, &y[*k + 1 + y_dim1], ldy, 		&t[i__ * t_dim1 + 1], &dlahr2_c__1, &dlahr2_c_b5, &y[*k + 1 + i__ * y_dim1], 
		 &dlahr2_c__1)!=TCL_OK) { return TCL_ERROR; }


	i__2 = *n - *k;
	if (dscal_(interp, &i__2, &tau[i__], &y[*k + 1 + i__ * y_dim1], &dlahr2_c__1)!=TCL_OK) { return TCL_ERROR; }



	i__2 = i__ - 1;
	d__1 = -tau[i__];
	if (dscal_(interp, &i__2, &d__1, &t[i__ * t_dim1 + 1], &dlahr2_c__1)!=TCL_OK) { return TCL_ERROR; }

	i__2 = i__ - 1;
	if (dtrmv_(interp, "Upper", "No Transpose", "NON-UNIT", &i__2, &t[t_offset], ldt, 		&t[i__ * t_dim1 + 1], &dlahr2_c__1)
		!=TCL_OK) { return TCL_ERROR; }


	t[i__ + i__ * t_dim1] = tau[i__];

    }
    a[*k + *nb + *nb * a_dim1] = ei;


    if (dlacpy_(interp, "ALL", k, nb, &a[(a_dim1 << 1) + 1], lda, &y[y_offset], ldy)!=TCL_OK) { return TCL_ERROR; }

    if (dtrmm_(interp, "RIGHT", "Lower", "NO TRANSPOSE", "UNIT", k, nb, &dlahr2_c_b5, &a[*k + 1 	    + a_dim1], lda, &y[y_offset], ldy)!=TCL_OK) { return TCL_ERROR; }


    if (*n > *k + *nb) {
	i__1 = *n - *k - *nb;
	if (dgemm_(interp, "NO TRANSPOSE", "NO TRANSPOSE", k, nb, &i__1, &dlahr2_c_b5, &a[(*nb + 		2) * a_dim1 + 1], lda, &a[*k + 1 + *nb + a_dim1], lda, &dlahr2_c_b5, 
		&y[y_offset], ldy)!=TCL_OK) { return TCL_ERROR; }


    }
    if (dtrmm_(interp, "RIGHT", "Upper", "NO TRANSPOSE", "NON-UNIT", k, nb, &dlahr2_c_b5, &t[	    t_offset], ldt, &y[y_offset], ldy)!=TCL_OK) { return TCL_ERROR; }



return TCL_OK;


} /* dlahr2_ */
static /* Subroutine */ int dlaqr0_ (Tcl_Interp *interp, logical *wantt, logical *wantz, integer *n, 	integer *ilo, integer *ihi, doublereal *h__, integer *ldh, doublereal 	*wr, doublereal *wi, integer *iloz, integer *ihiz, doublereal *z__, 	integer *ldz, doublereal *work, integer *lwork, integer *info)
{
    integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4, i__5;
    doublereal d__1, d__2, d__3, d__4;

    integer i__, k;
    doublereal aa, bb, cc, dd;
    integer ld;
    doublereal cs;
    integer nh, it, ks, kt;
    doublereal sn;
    integer ku, kv, ls, ns;
    doublereal ss;
    integer nw, inf, kdu, nho, nve, kwh, nsr, nwr, kwv, ndec, ndfl, kbot, 
	    nmin;
    doublereal swap;
    integer ktop;
    doublereal zdum[1]	/* was [1][1] */;
    integer kacc22, itmax, nsmax, nwmax, kwtop;
    integer nibble;
    char jbcmpz[1];
    integer nwupbd;
    logical sorted;
    integer lwkopt;







































    h_dim1 = *ldh;
    h_offset = 1 + h_dim1;
    h__ -= h_offset;
    --wr;
    --wi;
    z_dim1 = *ldz;
    z_offset = 1 + z_dim1;
    z__ -= z_offset;
    --work;

    *info = 0;


    if (*n == 0) {
	work[1] = 1.;
return TCL_OK;
    }

    if (*n <= 11) {


	lwkopt = 1;
	if (*lwork != -1) {
	    if (dlahqr_(interp, wantt, wantz, n, ilo, ihi, &h__[h_offset], ldh, &wr[1], &		    wi[1], iloz, ihiz, &z__[z_offset], ldz, info)!=TCL_OK) { return TCL_ERROR; }


	}
    } else {



	*info = 0;


	if (*wantt) {
	    *(unsigned char *)jbcmpz = 'S';
	} else {
	    *(unsigned char *)jbcmpz = 'E';
	}
	if (*wantz) {
	    *(unsigned char *)&jbcmpz[1] = 'V';
	} else {
	    *(unsigned char *)&jbcmpz[1] = 'N';
	}


	nwr = ilaenv_(&dlaqr0_c__13, "DLAQR0", jbcmpz, n, ilo, ihi, lwork);
	nwr = max(2,nwr);
	i__1 = *ihi - *ilo + 1, i__2 = (*n - 1) / 3, i__1 = min(i__1,i__2);
	nwr = min(i__1,nwr);


	nsr = ilaenv_(&dlaqr0_c__15, "DLAQR0", jbcmpz, n, ilo, ihi, lwork);
	i__1 = nsr, i__2 = (*n + 6) / 9, i__1 = min(i__1,i__2), i__2 = *ihi - 
		*ilo;
	nsr = min(i__1,i__2);
	i__1 = 2, i__2 = nsr - nsr % 2;
	nsr = max(i__1,i__2);



	i__1 = nwr + 1;
	if (dlaqr3_(interp, wantt, wantz, n, ilo, ihi, &i__1, &h__[h_offset], ldh, iloz, 		ihiz, &z__[z_offset], ldz, &ls, &ld, &wr[1], &wi[1], &h__[
		h_offset], ldh, n, &h__[h_offset], ldh, n, &h__[h_offset], 
		ldh, &work[1], &dlaqr0_c_n1)!=TCL_OK) { return TCL_ERROR; }




	i__1 = nsr * 3 / 2, i__2 = (integer) work[1];
	lwkopt = max(i__1,i__2);


	if (*lwork == -1) {
	    work[1] = (doublereal) lwkopt;
return TCL_OK;
	}


	nmin = ilaenv_(&dlaqr0_c__12, "DLAQR0", jbcmpz, n, ilo, ihi, lwork);
	nmin = max(11,nmin);


	nibble = ilaenv_(&dlaqr0_c__14, "DLAQR0", jbcmpz, n, ilo, ihi, lwork);
	nibble = max(0,nibble);


	kacc22 = ilaenv_(&dlaqr0_c__16, "DLAQR0", jbcmpz, n, ilo, ihi, lwork);
	kacc22 = max(0,kacc22);
	kacc22 = min(2,kacc22);


	i__1 = (*n - 1) / 3, i__2 = *lwork / 2;
	nwmax = min(i__1,i__2);
	nw = nwmax;


	i__1 = (*n + 6) / 9, i__2 = (*lwork << 1) / 3;
	nsmax = min(i__1,i__2);
	nsmax -= nsmax % 2;


	ndfl = 1;


	i__1 = 10, i__2 = *ihi - *ilo + 1;
	itmax = max(i__1,i__2) * 30;


	kbot = *ihi;


	i__1 = itmax;
	for (it = 1; it <= i__1; ++it) {


	    if (kbot < *ilo) {
		goto L90;
	    }


	    i__2 = *ilo + 1;
	    for (k = kbot; k >= i__2; --k) {
		if (h__[k + (k - 1) * h_dim1] == 0.) {
		    goto L20;
		}
	    }
	    k = *ilo;
L20:
	    ktop = k;


	    nh = kbot - ktop + 1;
	    nwupbd = min(nh,nwmax);
	    if (ndfl < 5) {
		nw = min(nwupbd,nwr);
	    } else {
		i__2 = nwupbd, i__3 = nw << 1;
		nw = min(i__2,i__3);
	    }
	    if (nw < nwmax) {
		if (nw >= nh - 1) {
		    nw = nh;
		} else {
		    kwtop = kbot - nw + 1;
		    if ((d__1 = h__[kwtop + (kwtop - 1) * h_dim1], abs(d__1)) 
			    > (d__2 = h__[kwtop - 1 + (kwtop - 2) * h_dim1], 
			    abs(d__2))) {
			++nw;
		    }
		}
	    }
	    if (ndfl < 5) {
		ndec = -1;
	    } else if (ndec >= 0 || nw >= nwupbd) {
		++ndec;
		if (nw - ndec < 2) {
		    ndec = 0;
		}
		nw -= ndec;
	    }


	    kv = *n - nw + 1;
	    kt = nw + 1;
	    nho = *n - nw - 1 - kt + 1;
	    kwv = nw + 2;
	    nve = *n - nw - kwv + 1;


	    if (dlaqr3_(interp, wantt, wantz, n, &ktop, &kbot, &nw, &h__[h_offset], ldh, 		    iloz, ihiz, &z__[z_offset], ldz, &ls, &ld, &wr[1], &wi[1], 
		     &h__[kv + h_dim1], ldh, &nho, &h__[kv + kt * h_dim1], 
		    ldh, &nve, &h__[kwv + h_dim1], ldh, &work[1], lwork)!=TCL_OK) { return TCL_ERROR; }




	    kbot -= ld;


	    ks = kbot - ls + 1;


	    if (ld == 0 || ld * 100 <= nw * nibble && kbot - ktop + 1 > min(
		    nmin,nwmax)) {


		i__4 = 2, i__5 = kbot - ktop;
		i__2 = min(nsmax,nsr), i__3 = max(i__4,i__5);
		ns = min(i__2,i__3);
		ns -= ns % 2;


		if (ndfl % 6 == 0) {
		    ks = kbot - ns + 1;
		    i__3 = ks + 1, i__4 = ktop + 2;
		    i__2 = max(i__3,i__4);
		    for (i__ = kbot; i__ >= i__2; i__ += -2) {
			ss = (d__1 = h__[i__ + (i__ - 1) * h_dim1], abs(d__1))
				 + (d__2 = h__[i__ - 1 + (i__ - 2) * h_dim1], 
				abs(d__2));
			aa = ss * .75 + h__[i__ + i__ * h_dim1];
			bb = ss;
			cc = ss * -.4375;
			dd = aa;
			if (dlanv2_(interp, &aa, &bb, &cc, &dd, &wr[i__ - 1], &wi[i__ - 1], &wr[i__], &wi[i__], &cs, &sn)!=TCL_OK) { return TCL_ERROR; }


		    }
		    if (ks == ktop) {
			wr[ks + 1] = h__[ks + 1 + (ks + 1) * h_dim1];
			wi[ks + 1] = 0.;
			wr[ks] = wr[ks + 1];
			wi[ks] = wi[ks + 1];
		    }
		} else {


		    if (kbot - ks + 1 <= ns / 2) {
			ks = kbot - ns + 1;
			kt = *n - ns + 1;
			if (dlacpy_(interp, "A", &ns, &ns, &h__[ks + ks * h_dim1], ldh, &				h__[kt + h_dim1], ldh)!=TCL_OK) { return TCL_ERROR; }


			if (ns > nmin) {
			    if (dlaqr4_(interp, &dlaqr0_c_false, &dlaqr0_c_false, &ns, &dlaqr0_c__1, &ns, &h__[				    kt + h_dim1], ldh, &wr[ks], &wi[ks], &
				    dlaqr0_c__1, &dlaqr0_c__1, zdum, &dlaqr0_c__1, &work[1], lwork, 
				     &inf)!=TCL_OK) { return TCL_ERROR; }


			} else {
			    if (dlahqr_(interp, &dlaqr0_c_false, &dlaqr0_c_false, &ns, &dlaqr0_c__1, &ns, &h__[				    kt + h_dim1], ldh, &wr[ks], &wi[ks], &
				    dlaqr0_c__1, &dlaqr0_c__1, zdum, &dlaqr0_c__1, &inf)!=TCL_OK) { return TCL_ERROR; }


			}
			ks += inf;


			if (ks >= kbot) {
			    aa = h__[kbot - 1 + (kbot - 1) * h_dim1];
			    cc = h__[kbot + (kbot - 1) * h_dim1];
			    bb = h__[kbot - 1 + kbot * h_dim1];
			    dd = h__[kbot + kbot * h_dim1];
			    if (dlanv2_(interp, &aa, &bb, &cc, &dd, &wr[kbot - 1], &wi[				    kbot - 1], &wr[kbot], &wi[kbot], &cs, &sn)
				    !=TCL_OK) { return TCL_ERROR; }


			    ks = kbot - 1;
			}
		    }

		    if (kbot - ks + 1 > ns) {


			sorted = FALSE_;
			i__2 = ks + 1;
			for (k = kbot; k >= i__2; --k) {
			    if (sorted) {
				goto L60;
			    }
			    sorted = TRUE_;
			    i__3 = k - 1;
			    for (i__ = ks; i__ <= i__3; ++i__) {
				if ((d__1 = wr[i__], abs(d__1)) + (d__2 = wi[
					i__], abs(d__2)) < (d__3 = wr[i__ + 1]
					, abs(d__3)) + (d__4 = wi[i__ + 1], 
					abs(d__4))) {
				    sorted = FALSE_;

				    swap = wr[i__];
				    wr[i__] = wr[i__ + 1];
				    wr[i__ + 1] = swap;

				    swap = wi[i__];
				    wi[i__] = wi[i__ + 1];
				    wi[i__ + 1] = swap;
				}
			    }
			}
L60:
			;
		    }


		    i__2 = ks + 2;
		    for (i__ = kbot; i__ >= i__2; i__ += -2) {
			if (wi[i__] != -wi[i__ - 1]) {

			    swap = wr[i__];
			    wr[i__] = wr[i__ - 1];
			    wr[i__ - 1] = wr[i__ - 2];
			    wr[i__ - 2] = swap;

			    swap = wi[i__];
			    wi[i__] = wi[i__ - 1];
			    wi[i__ - 1] = wi[i__ - 2];
			    wi[i__ - 2] = swap;
			}
		    }
		}


		if (kbot - ks + 1 == 2) {
		    if (wi[kbot] == 0.) {
			if ((d__1 = wr[kbot] - h__[kbot + kbot * h_dim1], abs(
				d__1)) < (d__2 = wr[kbot - 1] - h__[kbot + 
				kbot * h_dim1], abs(d__2))) {
			    wr[kbot - 1] = wr[kbot];
			} else {
			    wr[kbot] = wr[kbot - 1];
			}
		    }
		}


		i__2 = ns, i__3 = kbot - ks + 1;
		ns = min(i__2,i__3);
		ns -= ns % 2;
		ks = kbot - ns + 1;


		kdu = ns * 3 - 3;
		ku = *n - kdu + 1;
		kwh = kdu + 1;
		nho = *n - kdu - 3 - (kdu + 1) + 1;
		kwv = kdu + 4;
		nve = *n - kdu - kwv + 1;


		if (dlaqr5_(interp, wantt, wantz, &kacc22, n, &ktop, &kbot, &ns, &wr[ks], 			&wi[ks], &h__[h_offset], ldh, iloz, ihiz, &z__[
			z_offset], ldz, &work[1], &dlaqr0_c__3, &h__[ku + h_dim1], 
			ldh, &nve, &h__[kwv + h_dim1], ldh, &nho, &h__[ku + 
			kwh * h_dim1], ldh)!=TCL_OK) { return TCL_ERROR; }


	    }


	    if (ld > 0) {
		ndfl = 1;
	    } else {
		++ndfl;
	    }

	}


	*info = kbot;
L90:
	;
    }


    work[1] = (doublereal) lwkopt;


return TCL_OK;
} /* dlaqr0_ */
static /* Subroutine */ int dlahqr_ (Tcl_Interp *interp, logical *wantt, logical *wantz, integer *n, 	integer *ilo, integer *ihi, doublereal *h__, integer *ldh, doublereal 	*wr, doublereal *wi, integer *iloz, integer *ihiz, doublereal *z__, 	integer *ldz, integer *info)
{
    integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2, i__3;
    doublereal d__1, d__2, d__3, d__4;

    double sqrt(doublereal);

    integer i__, j, k, l, m;
    doublereal s, v[3];
    integer i1, i2;
    doublereal t1, t2, t3, v2, v3, aa, ab, ba, bb, h11, h12, h21, h22, cs;
    integer nh;
    doublereal sn;
    integer nr;
    doublereal tr;
    integer nz;
    doublereal det, h21s;
    integer its;
    doublereal ulp, sum, tst, rt1i, rt2i, rt1r, rt2r;
    doublereal safmin, safmax, rtdisc, smlnum;


























    h_dim1 = *ldh;
    h_offset = 1 + h_dim1;
    h__ -= h_offset;
    --wr;
    --wi;
    z_dim1 = *ldz;
    z_offset = 1 + z_dim1;
    z__ -= z_offset;

    *info = 0;


    if (*n == 0) {
return TCL_OK;
    }
    if (*ilo == *ihi) {
	wr[*ilo] = h__[*ilo + *ilo * h_dim1];
	wi[*ilo] = 0.;
return TCL_OK;
    }

    i__1 = *ihi - 3;
    for (j = *ilo; j <= i__1; ++j) {
	h__[j + 2 + j * h_dim1] = 0.;
	h__[j + 3 + j * h_dim1] = 0.;
    }
    if (*ilo <= *ihi - 2) {
	h__[*ihi + (*ihi - 2) * h_dim1] = 0.;
    }

    nh = *ihi - *ilo + 1;
    nz = *ihiz - *iloz + 1;


    safmin = dlamch_("SAFE MINIMUM");
    safmax = 1. / safmin;
    if (dlabad_(interp, &safmin, &safmax)!=TCL_OK) { return TCL_ERROR; }

    ulp = dlamch_("PRECISION");
    smlnum = safmin * ((doublereal) nh / ulp);


    if (*wantt) {
	i1 = 1;
	i2 = *n;
    }


    i__ = *ihi;
L20:
    l = *ilo;
    if (i__ < *ilo) {
	goto L160;
    }


    for (its = 0; its <= 30; ++its) {


	i__1 = l + 1;
	for (k = i__; k >= i__1; --k) {
	    if ((d__1 = h__[k + (k - 1) * h_dim1], abs(d__1)) <= smlnum) {
		goto L40;
	    }
	    tst = (d__1 = h__[k - 1 + (k - 1) * h_dim1], abs(d__1)) + (d__2 = 
		    h__[k + k * h_dim1], abs(d__2));
	    if (tst == 0.) {
		if (k - 2 >= *ilo) {
		    tst += (d__1 = h__[k - 1 + (k - 2) * h_dim1], abs(d__1));
		}
		if (k + 1 <= *ihi) {
		    tst += (d__1 = h__[k + 1 + k * h_dim1], abs(d__1));
		}
	    }
	    if ((d__1 = h__[k + (k - 1) * h_dim1], abs(d__1)) <= ulp * tst) {
		d__3 = (d__1 = h__[k + (k - 1) * h_dim1], abs(d__1)), d__4 = (
			d__2 = h__[k - 1 + k * h_dim1], abs(d__2));
		ab = max(d__3,d__4);
		d__3 = (d__1 = h__[k + (k - 1) * h_dim1], abs(d__1)), d__4 = (
			d__2 = h__[k - 1 + k * h_dim1], abs(d__2));
		ba = min(d__3,d__4);
		d__3 = (d__1 = h__[k + k * h_dim1], abs(d__1)), d__4 = (d__2 =
			 h__[k - 1 + (k - 1) * h_dim1] - h__[k + k * h_dim1], 
			abs(d__2));
		aa = max(d__3,d__4);
		d__3 = (d__1 = h__[k + k * h_dim1], abs(d__1)), d__4 = (d__2 =
			 h__[k - 1 + (k - 1) * h_dim1] - h__[k + k * h_dim1], 
			abs(d__2));
		bb = min(d__3,d__4);
		s = aa + ab;
		d__1 = smlnum, d__2 = ulp * (bb * (aa / s));
		if (ba * (ab / s) <= max(d__1,d__2)) {
		    goto L40;
		}
	    }
	}
L40:
	l = k;
	if (l > *ilo) {


	    h__[l + (l - 1) * h_dim1] = 0.;
	}


	if (l >= i__ - 1) {
	    goto L150;
	}


	if (! (*wantt)) {
	    i1 = l;
	    i2 = i__;
	}

	if (its == 10) {


	    s = (d__1 = h__[l + 1 + l * h_dim1], abs(d__1)) + (d__2 = h__[l + 
		    2 + (l + 1) * h_dim1], abs(d__2));
	    h11 = s * .75 + h__[l + l * h_dim1];
	    h12 = s * -.4375;
	    h21 = s;
	    h22 = h11;
	} else if (its == 20) {


	    s = (d__1 = h__[i__ + (i__ - 1) * h_dim1], abs(d__1)) + (d__2 = 
		    h__[i__ - 1 + (i__ - 2) * h_dim1], abs(d__2));
	    h11 = s * .75 + h__[i__ + i__ * h_dim1];
	    h12 = s * -.4375;
	    h21 = s;
	    h22 = h11;
	} else {


	    h11 = h__[i__ - 1 + (i__ - 1) * h_dim1];
	    h21 = h__[i__ + (i__ - 1) * h_dim1];
	    h12 = h__[i__ - 1 + i__ * h_dim1];
	    h22 = h__[i__ + i__ * h_dim1];
	}
	s = abs(h11) + abs(h12) + abs(h21) + abs(h22);
	if (s == 0.) {
	    rt1r = 0.;
	    rt1i = 0.;
	    rt2r = 0.;
	    rt2i = 0.;
	} else {
	    h11 /= s;
	    h21 /= s;
	    h12 /= s;
	    h22 /= s;
	    tr = (h11 + h22) / 2.;
	    det = (h11 - tr) * (h22 - tr) - h12 * h21;
	    rtdisc = sqrt((abs(det)));
	    if (det >= 0.) {


		rt1r = tr * s;
		rt2r = rt1r;
		rt1i = rtdisc * s;
		rt2i = -rt1i;
	    } else {


		rt1r = tr + rtdisc;
		rt2r = tr - rtdisc;
		if ((d__1 = rt1r - h22, abs(d__1)) <= (d__2 = rt2r - h22, abs(
			d__2))) {
		    rt1r *= s;
		    rt2r = rt1r;
		} else {
		    rt2r *= s;
		    rt1r = rt2r;
		}
		rt1i = 0.;
		rt2i = 0.;
	    }
	}


	i__1 = l;
	for (m = i__ - 2; m >= i__1; --m) {

	    h21s = h__[m + 1 + m * h_dim1];
	    s = (d__1 = h__[m + m * h_dim1] - rt2r, abs(d__1)) + abs(rt2i) + 
		    abs(h21s);
	    h21s = h__[m + 1 + m * h_dim1] / s;
	    v[0] = h21s * h__[m + (m + 1) * h_dim1] + (h__[m + m * h_dim1] - 
		    rt1r) * ((h__[m + m * h_dim1] - rt2r) / s) - rt1i * (rt2i 
		    / s);
	    v[1] = h21s * (h__[m + m * h_dim1] + h__[m + 1 + (m + 1) * h_dim1]
		     - rt1r - rt2r);
	    v[2] = h21s * h__[m + 2 + (m + 1) * h_dim1];
	    s = abs(v[0]) + abs(v[1]) + abs(v[2]);
	    v[0] /= s;
	    v[1] /= s;
	    v[2] /= s;
	    if (m == l) {
		goto L60;
	    }
	    if ((d__1 = h__[m + (m - 1) * h_dim1], abs(d__1)) * (abs(v[1]) + 
		    abs(v[2])) <= ulp * abs(v[0]) * ((d__2 = h__[m - 1 + (m - 
		    1) * h_dim1], abs(d__2)) + (d__3 = h__[m + m * h_dim1], 
		    abs(d__3)) + (d__4 = h__[m + 1 + (m + 1) * h_dim1], abs(
		    d__4)))) {
		goto L60;
	    }
	}
L60:


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



	    i__2 = 3, i__3 = i__ - k + 1;
	    nr = min(i__2,i__3);
	    if (k > m) {
		if (dcopy_(interp, &nr, &h__[k + (k - 1) * h_dim1], &dlahqr_c__1, v, &dlahqr_c__1)!=TCL_OK) { return TCL_ERROR; }

	    }
	    if (dlarfg_(interp, &nr, v, &v[1], &dlahqr_c__1, &t1)!=TCL_OK) { return TCL_ERROR; }

	    if (k > m) {
		h__[k + (k - 1) * h_dim1] = v[0];
		h__[k + 1 + (k - 1) * h_dim1] = 0.;
		if (k < i__ - 1) {
		    h__[k + 2 + (k - 1) * h_dim1] = 0.;
		}
	    } else if (m > l) {
		h__[k + (k - 1) * h_dim1] *= 1. - t1;
	    }
	    v2 = v[1];
	    t2 = t1 * v2;
	    if (nr == 3) {
		v3 = v[2];
		t3 = t1 * v3;


		i__2 = i2;
		for (j = k; j <= i__2; ++j) {
		    sum = h__[k + j * h_dim1] + v2 * h__[k + 1 + j * h_dim1] 
			    + v3 * h__[k + 2 + j * h_dim1];
		    h__[k + j * h_dim1] -= sum * t1;
		    h__[k + 1 + j * h_dim1] -= sum * t2;
		    h__[k + 2 + j * h_dim1] -= sum * t3;
		}


		i__3 = k + 3;
		i__2 = min(i__3,i__);
		for (j = i1; j <= i__2; ++j) {
		    sum = h__[j + k * h_dim1] + v2 * h__[j + (k + 1) * h_dim1]
			     + v3 * h__[j + (k + 2) * h_dim1];
		    h__[j + k * h_dim1] -= sum * t1;
		    h__[j + (k + 1) * h_dim1] -= sum * t2;
		    h__[j + (k + 2) * h_dim1] -= sum * t3;
		}

		if (*wantz) {


		    i__2 = *ihiz;
		    for (j = *iloz; j <= i__2; ++j) {
			sum = z__[j + k * z_dim1] + v2 * z__[j + (k + 1) * 
				z_dim1] + v3 * z__[j + (k + 2) * z_dim1];
			z__[j + k * z_dim1] -= sum * t1;
			z__[j + (k + 1) * z_dim1] -= sum * t2;
			z__[j + (k + 2) * z_dim1] -= sum * t3;
		    }
		}
	    } else if (nr == 2) {


		i__2 = i2;
		for (j = k; j <= i__2; ++j) {
		    sum = h__[k + j * h_dim1] + v2 * h__[k + 1 + j * h_dim1];
		    h__[k + j * h_dim1] -= sum * t1;
		    h__[k + 1 + j * h_dim1] -= sum * t2;
		}


		i__2 = i__;
		for (j = i1; j <= i__2; ++j) {
		    sum = h__[j + k * h_dim1] + v2 * h__[j + (k + 1) * h_dim1]
			    ;
		    h__[j + k * h_dim1] -= sum * t1;
		    h__[j + (k + 1) * h_dim1] -= sum * t2;
		}

		if (*wantz) {


		    i__2 = *ihiz;
		    for (j = *iloz; j <= i__2; ++j) {
			sum = z__[j + k * z_dim1] + v2 * z__[j + (k + 1) * 
				z_dim1];
			z__[j + k * z_dim1] -= sum * t1;
			z__[j + (k + 1) * z_dim1] -= sum * t2;
		    }
		}
	    }
	}

    }


    *info = i__;
return TCL_OK;

L150:

    if (l == i__) {


	wr[i__] = h__[i__ + i__ * h_dim1];
	wi[i__] = 0.;
    } else if (l == i__ - 1) {



	if (dlanv2_(interp, &h__[i__ - 1 + (i__ - 1) * h_dim1], &h__[i__ - 1 + i__ * 		h_dim1], &h__[i__ + (i__ - 1) * h_dim1], &h__[i__ + i__ * 
		h_dim1], &wr[i__ - 1], &wi[i__ - 1], &wr[i__], &wi[i__], &cs, 
		&sn)!=TCL_OK) { return TCL_ERROR; }



	if (*wantt) {


	    if (i2 > i__) {
		i__1 = i2 - i__;
		if (drot_(interp, &i__1, &h__[i__ - 1 + (i__ + 1) * h_dim1], ldh, &h__[			i__ + (i__ + 1) * h_dim1], ldh, &cs, &sn)!=TCL_OK) { return TCL_ERROR; }


	    }
	    i__1 = i__ - i1 - 1;
	    if (drot_(interp, &i__1, &h__[i1 + (i__ - 1) * h_dim1], &dlahqr_c__1, &h__[i1 + i__ *		     h_dim1], &dlahqr_c__1, &cs, &sn)!=TCL_OK) { return TCL_ERROR; }


	}
	if (*wantz) {


	    if (drot_(interp, &nz, &z__[*iloz + (i__ - 1) * z_dim1], &dlahqr_c__1, &z__[*iloz + 		    i__ * z_dim1], &dlahqr_c__1, &cs, &sn)!=TCL_OK) { return TCL_ERROR; }


	}
    }


    i__ = l - 1;
    goto L20;

L160:
return TCL_OK;


} /* dlahqr_ */
static /* Subroutine */ int dlaln2_ (Tcl_Interp *interp, logical *ltrans, integer *na, integer *nw, 	doublereal *smin, doublereal *ca, doublereal *a, integer *lda, 	doublereal *d1, doublereal *d2, doublereal *b, integer *ldb, 	doublereal *wr, doublereal *wi, doublereal *x, integer *ldx, 	doublereal *scale, doublereal *xnorm, integer *info)
{

    static logical zswap[4] = { FALSE_,FALSE_,TRUE_,TRUE_ };
    static logical 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 };

    integer a_dim1, a_offset, b_dim1, b_offset, x_dim1, x_offset;
    doublereal d__1, d__2, d__3, d__4, d__5, d__6;
    static doublereal equiv_0[4], equiv_1[4];

    integer j;
#define ci (equiv_0)
#define cr (equiv_1)
    doublereal bi1, bi2, br1, br2, xi1, xi2, xr1, xr2, ci21, ci22, cr21, cr22,
	     li21, csi, ui11, lr21, ui12, ui22;
#define civ (equiv_0)
    doublereal csr, ur11, ur12, ur22;
#define crv (equiv_1)
    doublereal bbnd, cmax, ui11r, ui12s, temp, ur11r, ur12s, u22abs;
    integer icmax;
    doublereal bnorm, cnorm, smini;
    doublereal bignum, smlnum;































    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    b_dim1 = *ldb;
    b_offset = 1 + b_dim1;
    b -= b_offset;
    x_dim1 = *ldx;
    x_offset = 1 + x_dim1;
    x -= x_offset;



    smlnum = 2. * dlamch_("Safe minimum");
    bignum = 1. / smlnum;
    smini = max(*smin,smlnum);


    *info = 0;


    *scale = 1.;

    if (*na == 1) {


	if (*nw == 1) {



	    csr = *ca * a[a_dim1 + 1] - *wr * *d1;
	    cnorm = abs(csr);


	    if (cnorm < smini) {
		csr = smini;
		cnorm = smini;
		*info = 1;
	    }


	    bnorm = (d__1 = b[b_dim1 + 1], abs(d__1));
	    if (cnorm < 1. && bnorm > 1.) {
		if (bnorm > bignum * cnorm) {
		    *scale = 1. / bnorm;
		}
	    }


	    x[x_dim1 + 1] = b[b_dim1 + 1] * *scale / csr;
	    *xnorm = (d__1 = x[x_dim1 + 1], abs(d__1));
	} else {



	    csr = *ca * a[a_dim1 + 1] - *wr * *d1;
	    csi = -(*wi) * *d1;
	    cnorm = abs(csr) + abs(csi);


	    if (cnorm < smini) {
		csr = smini;
		csi = 0.;
		cnorm = smini;
		*info = 1;
	    }


	    bnorm = (d__1 = b[b_dim1 + 1], abs(d__1)) + (d__2 = b[(b_dim1 << 
		    1) + 1], abs(d__2));
	    if (cnorm < 1. && bnorm > 1.) {
		if (bnorm > bignum * cnorm) {
		    *scale = 1. / bnorm;
		}
	    }


	    d__1 = *scale * b[b_dim1 + 1];
	    d__2 = *scale * b[(b_dim1 << 1) + 1];
	    if (dladiv_(interp, &d__1, &d__2, &csr, &csi, &x[x_dim1 + 1], &x[(x_dim1 << 1)		     + 1])!=TCL_OK) { return TCL_ERROR; }


	    *xnorm = (d__1 = x[x_dim1 + 1], abs(d__1)) + (d__2 = x[(x_dim1 << 
		    1) + 1], abs(d__2));
	}

    } else {



	cr[0] = *ca * a[a_dim1 + 1] - *wr * *d1;
	cr[3] = *ca * a[(a_dim1 << 1) + 2] - *wr * *d2;
	if (*ltrans) {
	    cr[2] = *ca * a[a_dim1 + 2];
	    cr[1] = *ca * a[(a_dim1 << 1) + 1];
	} else {
	    cr[1] = *ca * a[a_dim1 + 2];
	    cr[2] = *ca * a[(a_dim1 << 1) + 1];
	}

	if (*nw == 1) {



	    cmax = 0.;
	    icmax = 0;

	    for (j = 1; j <= 4; ++j) {
		if ((d__1 = crv[j - 1], abs(d__1)) > cmax) {
		    cmax = (d__1 = crv[j - 1], abs(d__1));
		    icmax = j;
		}
	    }


	    if (cmax < smini) {
		d__3 = (d__1 = b[b_dim1 + 1], abs(d__1)), d__4 = (d__2 = b[
			b_dim1 + 2], abs(d__2));
		bnorm = max(d__3,d__4);
		if (smini < 1. && bnorm > 1.) {
		    if (bnorm > bignum * smini) {
			*scale = 1. / bnorm;
		    }
		}
		temp = *scale / smini;
		x[x_dim1 + 1] = temp * b[b_dim1 + 1];
		x[x_dim1 + 2] = temp * b[b_dim1 + 2];
		*xnorm = temp * bnorm;
		*info = 1;
return TCL_OK;
	    }


	    ur11 = crv[icmax - 1];
	    cr21 = crv[ipivot[(icmax << 2) - 3] - 1];
	    ur12 = crv[ipivot[(icmax << 2) - 2] - 1];
	    cr22 = crv[ipivot[(icmax << 2) - 1] - 1];
	    ur11r = 1. / ur11;
	    lr21 = ur11r * cr21;
	    ur22 = cr22 - ur12 * lr21;


	    if (abs(ur22) < smini) {
		ur22 = smini;
		*info = 1;
	    }
	    if (rswap[icmax - 1]) {
		br1 = b[b_dim1 + 2];
		br2 = b[b_dim1 + 1];
	    } else {
		br1 = b[b_dim1 + 1];
		br2 = b[b_dim1 + 2];
	    }
	    br2 -= lr21 * br1;
	    d__2 = (d__1 = br1 * (ur22 * ur11r), abs(d__1)), d__3 = abs(br2);
	    bbnd = max(d__2,d__3);
	    if (bbnd > 1. && abs(ur22) < 1.) {
		if (bbnd >= bignum * abs(ur22)) {
		    *scale = 1. / bbnd;
		}
	    }

	    xr2 = br2 * *scale / ur22;
	    xr1 = *scale * br1 * ur11r - xr2 * (ur11r * ur12);
	    if (zswap[icmax - 1]) {
		x[x_dim1 + 1] = xr2;
		x[x_dim1 + 2] = xr1;
	    } else {
		x[x_dim1 + 1] = xr1;
		x[x_dim1 + 2] = xr2;
	    }
	    d__1 = abs(xr1), d__2 = abs(xr2);
	    *xnorm = max(d__1,d__2);


	    if (*xnorm > 1. && cmax > 1.) {
		if (*xnorm > bignum / cmax) {
		    temp = cmax / bignum;
		    x[x_dim1 + 1] = temp * x[x_dim1 + 1];
		    x[x_dim1 + 2] = temp * x[x_dim1 + 2];
		    *xnorm = temp * *xnorm;
		    *scale = temp * *scale;
		}
	    }
	} else {



	    ci[0] = -(*wi) * *d1;
	    ci[1] = 0.;
	    ci[2] = 0.;
	    ci[3] = -(*wi) * *d2;
	    cmax = 0.;
	    icmax = 0;

	    for (j = 1; j <= 4; ++j) {
		if ((d__1 = crv[j - 1], abs(d__1)) + (d__2 = civ[j - 1], abs(
			d__2)) > cmax) {
		    cmax = (d__1 = crv[j - 1], abs(d__1)) + (d__2 = civ[j - 1]
			    , abs(d__2));
		    icmax = j;
		}
	    }


	    if (cmax < smini) {
		d__5 = (d__1 = b[b_dim1 + 1], abs(d__1)) + (d__2 = b[(b_dim1 
			<< 1) + 1], abs(d__2)), d__6 = (d__3 = b[b_dim1 + 2], 
			abs(d__3)) + (d__4 = b[(b_dim1 << 1) + 2], abs(d__4));
		bnorm = max(d__5,d__6);
		if (smini < 1. && bnorm > 1.) {
		    if (bnorm > bignum * smini) {
			*scale = 1. / bnorm;
		    }
		}
		temp = *scale / smini;
		x[x_dim1 + 1] = temp * b[b_dim1 + 1];
		x[x_dim1 + 2] = temp * b[b_dim1 + 2];
		x[(x_dim1 << 1) + 1] = temp * b[(b_dim1 << 1) + 1];
		x[(x_dim1 << 1) + 2] = temp * b[(b_dim1 << 1) + 2];
		*xnorm = temp * bnorm;
		*info = 1;
return TCL_OK;
	    }


	    ur11 = crv[icmax - 1];
	    ui11 = civ[icmax - 1];
	    cr21 = crv[ipivot[(icmax << 2) - 3] - 1];
	    ci21 = civ[ipivot[(icmax << 2) - 3] - 1];
	    ur12 = crv[ipivot[(icmax << 2) - 2] - 1];
	    ui12 = civ[ipivot[(icmax << 2) - 2] - 1];
	    cr22 = crv[ipivot[(icmax << 2) - 1] - 1];
	    ci22 = civ[ipivot[(icmax << 2) - 1] - 1];
	    if (icmax == 1 || icmax == 4) {


		if (abs(ur11) > abs(ui11)) {
		    temp = ui11 / ur11;
		    d__1 = temp;
		    ur11r = 1. / (ur11 * (d__1 * d__1 + 1.));
		    ui11r = -temp * ur11r;
		} else {
		    temp = ur11 / ui11;
		    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 {


		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 = abs(ur22) + abs(ui22);


	    if (u22abs < smini) {
		ur22 = smini;
		ui22 = 0.;
		*info = 1;
	    }
	    if (rswap[icmax - 1]) {
		br2 = b[b_dim1 + 1];
		br1 = b[b_dim1 + 2];
		bi2 = b[(b_dim1 << 1) + 1];
		bi1 = b[(b_dim1 << 1) + 2];
	    } else {
		br1 = b[b_dim1 + 1];
		br2 = b[b_dim1 + 2];
		bi1 = b[(b_dim1 << 1) + 1];
		bi2 = b[(b_dim1 << 1) + 2];
	    }
	    br2 = br2 - lr21 * br1 + li21 * bi1;
	    bi2 = bi2 - li21 * br1 - lr21 * bi1;
	    d__1 = (abs(br1) + abs(bi1)) * (u22abs * (abs(ur11r) + abs(ui11r))
		    ), d__2 = abs(br2) + abs(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;
		}
	    }

	    if (dladiv_(interp, &br2, &bi2, &ur22, &ui22, &xr2, &xi2)!=TCL_OK) { return TCL_ERROR; }

	    xr1 = ur11r * br1 - ui11r * bi1 - ur12s * xr2 + ui12s * xi2;
	    xi1 = ui11r * br1 + ur11r * bi1 - ui12s * xr2 - ur12s * xi2;
	    if (zswap[icmax - 1]) {
		x[x_dim1 + 1] = xr2;
		x[x_dim1 + 2] = xr1;
		x[(x_dim1 << 1) + 1] = xi2;
		x[(x_dim1 << 1) + 2] = xi1;
	    } else {
		x[x_dim1 + 1] = xr1;
		x[x_dim1 + 2] = xr2;
		x[(x_dim1 << 1) + 1] = xi1;
		x[(x_dim1 << 1) + 2] = xi2;
	    }
	    d__1 = abs(xr1) + abs(xi1), d__2 = abs(xr2) + abs(xi2);
	    *xnorm = max(d__1,d__2);


	    if (*xnorm > 1. && cmax > 1.) {
		if (*xnorm > bignum / cmax) {
		    temp = cmax / bignum;
		    x[x_dim1 + 1] = temp * x[x_dim1 + 1];
		    x[x_dim1 + 2] = temp * x[x_dim1 + 2];
		    x[(x_dim1 << 1) + 1] = temp * x[(x_dim1 << 1) + 1];
		    x[(x_dim1 << 1) + 2] = temp * x[(x_dim1 << 1) + 2];
		    *xnorm = temp * *xnorm;
		    *scale = temp * *scale;
		}
	    }
	}
    }

return TCL_OK;


} /* dlaln2_ */
static integer izamax_ (integer *n, doublecomplex *zx, integer *incx)
{
    integer ret_val, i__1;

    integer i__, ix;
    doublereal smax;





    --zx;

    ret_val = 0;
    if (*n < 1 || *incx <= 0) {
	return ret_val;
    }
    ret_val = 1;
    if (*n == 1) {
	return ret_val;
    }
    if (*incx == 1) {
	goto L20;
    }


    ix = 1;
    smax = dcabs1_(&zx[1]);
    ix += *incx;
    i__1 = *n;
    for (i__ = 2; i__ <= i__1; ++i__) {
	if (dcabs1_(&zx[ix]) <= smax) {
	    goto L5;
	}
	ret_val = i__;
	smax = dcabs1_(&zx[ix]);
L5:
	ix += *incx;
    }
    return ret_val;


L20:
    smax = dcabs1_(&zx[1]);
    i__1 = *n;
    for (i__ = 2; i__ <= i__1; ++i__) {
	if (dcabs1_(&zx[i__]) <= smax) {
	    goto L30;
	}
	ret_val = i__;
	smax = dcabs1_(&zx[i__]);
L30:
	;
    }
    return ret_val;
} /* izamax_ */
static /* Subroutine */ int ztrmm_ (Tcl_Interp *interp, char *side, char *uplo, char *transa, char *diag, 	integer *m, integer *n, doublecomplex *alpha, doublecomplex *a, 	integer *lda, doublecomplex *b, integer *ldb)
{
    integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4, i__5, 
	    i__6;
    doublecomplex z__1, z__2, z__3;

    void d_cnjg(doublecomplex *, doublecomplex *);

    integer i__, j, k, info;
    doublecomplex temp;
    logical lside;
    integer nrowa;
    logical upper;
    logical noconj, nounit;






































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

    lside = lsame_(side, "L");
    if (lside) {
	nrowa = *m;
    } else {
	nrowa = *n;
    }
    noconj = lsame_(transa, "T");
    nounit = lsame_(diag, "N");
    upper = lsame_(uplo, "U");

    info = 0;
    if (! lside && ! lsame_(side, "R")) {
	info = 1;
    } else if (! upper && ! lsame_(uplo, "L")) {
	info = 2;
    } else if (! lsame_(transa, "N") && ! lsame_(transa, 
	     "T") && ! lsame_(transa, "C")) {
	info = 3;
    } else if (! lsame_(diag, "U") && ! lsame_(diag, 
	    "N")) {
	info = 4;
    } else if (*m < 0) {
	info = 5;
    } else if (*n < 0) {
	info = 6;
    } else if (*lda < max(1,nrowa)) {
	info = 9;
    } else if (*ldb < max(1,*m)) {
	info = 11;
    }
    if (info != 0) {
	vectcl_xerbla(interp, "ZTRMM ", &info);
return TCL_ERROR;

return TCL_OK;
    }


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


    if (alpha->r == 0. && alpha->i == 0.) {
	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *m;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		i__3 = i__ + j * b_dim1;
		b[i__3].r = 0., b[i__3].i = 0.;
	    }
	}
return TCL_OK;
    }


    if (lside) {
	if (lsame_(transa, "N")) {


	    if (upper) {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = *m;
		    for (k = 1; k <= i__2; ++k) {
			i__3 = k + j * b_dim1;
			if (b[i__3].r != 0. || b[i__3].i != 0.) {
			    i__3 = k + j * b_dim1;
			    z__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3]
				    .i, z__1.i = alpha->r * b[i__3].i + 
				    alpha->i * b[i__3].r;
			    temp.r = z__1.r, temp.i = z__1.i;
			    i__3 = k - 1;
			    for (i__ = 1; i__ <= i__3; ++i__) {
				i__4 = i__ + j * b_dim1;
				i__5 = i__ + j * b_dim1;
				i__6 = i__ + k * a_dim1;
				z__2.r = temp.r * a[i__6].r - temp.i * a[i__6]
					.i, z__2.i = temp.r * a[i__6].i + 
					temp.i * a[i__6].r;
				z__1.r = b[i__5].r + z__2.r, z__1.i = b[i__5]
					.i + z__2.i;
				b[i__4].r = z__1.r, b[i__4].i = z__1.i;
			    }
			    if (nounit) {
				i__3 = k + k * a_dim1;
				z__1.r = temp.r * a[i__3].r - temp.i * a[i__3]
					.i, z__1.i = temp.r * a[i__3].i + 
					temp.i * a[i__3].r;
				temp.r = z__1.r, temp.i = z__1.i;
			    }
			    i__3 = k + j * b_dim1;
			    b[i__3].r = temp.r, b[i__3].i = temp.i;
			}
		    }
		}
	    } else {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    for (k = *m; k >= 1; --k) {
			i__2 = k + j * b_dim1;
			if (b[i__2].r != 0. || b[i__2].i != 0.) {
			    i__2 = k + j * b_dim1;
			    z__1.r = alpha->r * b[i__2].r - alpha->i * b[i__2]
				    .i, z__1.i = alpha->r * b[i__2].i + 
				    alpha->i * b[i__2].r;
			    temp.r = z__1.r, temp.i = z__1.i;
			    i__2 = k + j * b_dim1;
			    b[i__2].r = temp.r, b[i__2].i = temp.i;
			    if (nounit) {
				i__2 = k + j * b_dim1;
				i__3 = k + j * b_dim1;
				i__4 = k + k * a_dim1;
				z__1.r = b[i__3].r * a[i__4].r - b[i__3].i * 
					a[i__4].i, z__1.i = b[i__3].r * a[
					i__4].i + b[i__3].i * a[i__4].r;
				b[i__2].r = z__1.r, b[i__2].i = z__1.i;
			    }
			    i__2 = *m;
			    for (i__ = k + 1; i__ <= i__2; ++i__) {
				i__3 = i__ + j * b_dim1;
				i__4 = i__ + j * b_dim1;
				i__5 = i__ + k * a_dim1;
				z__2.r = temp.r * a[i__5].r - temp.i * a[i__5]
					.i, z__2.i = temp.r * a[i__5].i + 
					temp.i * a[i__5].r;
				z__1.r = b[i__4].r + z__2.r, z__1.i = b[i__4]
					.i + z__2.i;
				b[i__3].r = z__1.r, b[i__3].i = z__1.i;
			    }
			}
		    }
		}
	    }
	} else {


	    if (upper) {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    for (i__ = *m; i__ >= 1; --i__) {
			i__2 = i__ + j * b_dim1;
			temp.r = b[i__2].r, temp.i = b[i__2].i;
			if (noconj) {
			    if (nounit) {
				i__2 = i__ + i__ * a_dim1;
				z__1.r = temp.r * a[i__2].r - temp.i * a[i__2]
					.i, z__1.i = temp.r * a[i__2].i + 
					temp.i * a[i__2].r;
				temp.r = z__1.r, temp.i = z__1.i;
			    }
			    i__2 = i__ - 1;
			    for (k = 1; k <= i__2; ++k) {
				i__3 = k + i__ * a_dim1;
				i__4 = k + j * b_dim1;
				z__2.r = a[i__3].r * b[i__4].r - a[i__3].i * 
					b[i__4].i, z__2.i = a[i__3].r * b[
					i__4].i + a[i__3].i * b[i__4].r;
				z__1.r = temp.r + z__2.r, z__1.i = temp.i + 
					z__2.i;
				temp.r = z__1.r, temp.i = z__1.i;
			    }
			} else {
			    if (nounit) {
				d_cnjg(&z__2, &a[i__ + i__ * a_dim1]);
				z__1.r = temp.r * z__2.r - temp.i * z__2.i, 
					z__1.i = temp.r * z__2.i + temp.i * 
					z__2.r;
				temp.r = z__1.r, temp.i = z__1.i;
			    }
			    i__2 = i__ - 1;
			    for (k = 1; k <= i__2; ++k) {
				d_cnjg(&z__3, &a[k + i__ * a_dim1]);
				i__3 = k + j * b_dim1;
				z__2.r = z__3.r * b[i__3].r - z__3.i * b[i__3]
					.i, z__2.i = z__3.r * b[i__3].i + 
					z__3.i * b[i__3].r;
				z__1.r = temp.r + z__2.r, z__1.i = temp.i + 
					z__2.i;
				temp.r = z__1.r, temp.i = z__1.i;
			    }
			}
			i__2 = i__ + j * b_dim1;
			z__1.r = alpha->r * temp.r - alpha->i * temp.i, 
				z__1.i = alpha->r * temp.i + alpha->i * 
				temp.r;
			b[i__2].r = z__1.r, b[i__2].i = z__1.i;
		    }
		}
	    } else {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = *m;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			i__3 = i__ + j * b_dim1;
			temp.r = b[i__3].r, temp.i = b[i__3].i;
			if (noconj) {
			    if (nounit) {
				i__3 = i__ + i__ * a_dim1;
				z__1.r = temp.r * a[i__3].r - temp.i * a[i__3]
					.i, z__1.i = temp.r * a[i__3].i + 
					temp.i * a[i__3].r;
				temp.r = z__1.r, temp.i = z__1.i;
			    }
			    i__3 = *m;
			    for (k = i__ + 1; k <= i__3; ++k) {
				i__4 = k + i__ * a_dim1;
				i__5 = k + j * b_dim1;
				z__2.r = a[i__4].r * b[i__5].r - a[i__4].i * 
					b[i__5].i, z__2.i = a[i__4].r * b[
					i__5].i + a[i__4].i * b[i__5].r;
				z__1.r = temp.r + z__2.r, z__1.i = temp.i + 
					z__2.i;
				temp.r = z__1.r, temp.i = z__1.i;
			    }
			} else {
			    if (nounit) {
				d_cnjg(&z__2, &a[i__ + i__ * a_dim1]);
				z__1.r = temp.r * z__2.r - temp.i * z__2.i, 
					z__1.i = temp.r * z__2.i + temp.i * 
					z__2.r;
				temp.r = z__1.r, temp.i = z__1.i;
			    }
			    i__3 = *m;
			    for (k = i__ + 1; k <= i__3; ++k) {
				d_cnjg(&z__3, &a[k + i__ * a_dim1]);
				i__4 = k + j * b_dim1;
				z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4]
					.i, z__2.i = z__3.r * b[i__4].i + 
					z__3.i * b[i__4].r;
				z__1.r = temp.r + z__2.r, z__1.i = temp.i + 
					z__2.i;
				temp.r = z__1.r, temp.i = z__1.i;
			    }
			}
			i__3 = i__ + j * b_dim1;
			z__1.r = alpha->r * temp.r - alpha->i * temp.i, 
				z__1.i = alpha->r * temp.i + alpha->i * 
				temp.r;
			b[i__3].r = z__1.r, b[i__3].i = z__1.i;
		    }
		}
	    }
	}
    } else {
	if (lsame_(transa, "N")) {


	    if (upper) {
		for (j = *n; j >= 1; --j) {
		    temp.r = alpha->r, temp.i = alpha->i;
		    if (nounit) {
			i__1 = j + j * a_dim1;
			z__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i, 
				z__1.i = temp.r * a[i__1].i + temp.i * a[i__1]
				.r;
			temp.r = z__1.r, temp.i = z__1.i;
		    }
		    i__1 = *m;
		    for (i__ = 1; i__ <= i__1; ++i__) {
			i__2 = i__ + j * b_dim1;
			i__3 = i__ + j * b_dim1;
			z__1.r = temp.r * b[i__3].r - temp.i * b[i__3].i, 
				z__1.i = temp.r * b[i__3].i + temp.i * b[i__3]
				.r;
			b[i__2].r = z__1.r, b[i__2].i = z__1.i;
		    }
		    i__1 = j - 1;
		    for (k = 1; k <= i__1; ++k) {
			i__2 = k + j * a_dim1;
			if (a[i__2].r != 0. || a[i__2].i != 0.) {
			    i__2 = k + j * a_dim1;
			    z__1.r = alpha->r * a[i__2].r - alpha->i * a[i__2]
				    .i, z__1.i = alpha->r * a[i__2].i + 
				    alpha->i * a[i__2].r;
			    temp.r = z__1.r, temp.i = z__1.i;
			    i__2 = *m;
			    for (i__ = 1; i__ <= i__2; ++i__) {
				i__3 = i__ + j * b_dim1;
				i__4 = i__ + j * b_dim1;
				i__5 = i__ + k * b_dim1;
				z__2.r = temp.r * b[i__5].r - temp.i * b[i__5]
					.i, z__2.i = temp.r * b[i__5].i + 
					temp.i * b[i__5].r;
				z__1.r = b[i__4].r + z__2.r, z__1.i = b[i__4]
					.i + z__2.i;
				b[i__3].r = z__1.r, b[i__3].i = z__1.i;
			    }
			}
		    }
		}
	    } else {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    temp.r = alpha->r, temp.i = alpha->i;
		    if (nounit) {
			i__2 = j + j * a_dim1;
			z__1.r = temp.r * a[i__2].r - temp.i * a[i__2].i, 
				z__1.i = temp.r * a[i__2].i + temp.i * a[i__2]
				.r;
			temp.r = z__1.r, temp.i = z__1.i;
		    }
		    i__2 = *m;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			i__3 = i__ + j * b_dim1;
			i__4 = i__ + j * b_dim1;
			z__1.r = temp.r * b[i__4].r - temp.i * b[i__4].i, 
				z__1.i = temp.r * b[i__4].i + temp.i * b[i__4]
				.r;
			b[i__3].r = z__1.r, b[i__3].i = z__1.i;
		    }
		    i__2 = *n;
		    for (k = j + 1; k <= i__2; ++k) {
			i__3 = k + j * a_dim1;
			if (a[i__3].r != 0. || a[i__3].i != 0.) {
			    i__3 = k + j * a_dim1;
			    z__1.r = alpha->r * a[i__3].r - alpha->i * a[i__3]
				    .i, z__1.i = alpha->r * a[i__3].i + 
				    alpha->i * a[i__3].r;
			    temp.r = z__1.r, temp.i = z__1.i;
			    i__3 = *m;
			    for (i__ = 1; i__ <= i__3; ++i__) {
				i__4 = i__ + j * b_dim1;
				i__5 = i__ + j * b_dim1;
				i__6 = i__ + k * b_dim1;
				z__2.r = temp.r * b[i__6].r - temp.i * b[i__6]
					.i, z__2.i = temp.r * b[i__6].i + 
					temp.i * b[i__6].r;
				z__1.r = b[i__5].r + z__2.r, z__1.i = b[i__5]
					.i + z__2.i;
				b[i__4].r = z__1.r, b[i__4].i = z__1.i;
			    }
			}
		    }
		}
	    }
	} else {


	    if (upper) {
		i__1 = *n;
		for (k = 1; k <= i__1; ++k) {
		    i__2 = k - 1;
		    for (j = 1; j <= i__2; ++j) {
			i__3 = j + k * a_dim1;
			if (a[i__3].r != 0. || a[i__3].i != 0.) {
			    if (noconj) {
				i__3 = j + k * a_dim1;
				z__1.r = alpha->r * a[i__3].r - alpha->i * a[
					i__3].i, z__1.i = alpha->r * a[i__3]
					.i + alpha->i * a[i__3].r;
				temp.r = z__1.r, temp.i = z__1.i;
			    } else {
				d_cnjg(&z__2, &a[j + k * a_dim1]);
				z__1.r = alpha->r * z__2.r - alpha->i * 
					z__2.i, z__1.i = alpha->r * z__2.i + 
					alpha->i * z__2.r;
				temp.r = z__1.r, temp.i = z__1.i;
			    }
			    i__3 = *m;
			    for (i__ = 1; i__ <= i__3; ++i__) {
				i__4 = i__ + j * b_dim1;
				i__5 = i__ + j * b_dim1;
				i__6 = i__ + k * b_dim1;
				z__2.r = temp.r * b[i__6].r - temp.i * b[i__6]
					.i, z__2.i = temp.r * b[i__6].i + 
					temp.i * b[i__6].r;
				z__1.r = b[i__5].r + z__2.r, z__1.i = b[i__5]
					.i + z__2.i;
				b[i__4].r = z__1.r, b[i__4].i = z__1.i;
			    }
			}
		    }
		    temp.r = alpha->r, temp.i = alpha->i;
		    if (nounit) {
			if (noconj) {
			    i__2 = k + k * a_dim1;
			    z__1.r = temp.r * a[i__2].r - temp.i * a[i__2].i, 
				    z__1.i = temp.r * a[i__2].i + temp.i * a[
				    i__2].r;
			    temp.r = z__1.r, temp.i = z__1.i;
			} else {
			    d_cnjg(&z__2, &a[k + k * a_dim1]);
			    z__1.r = temp.r * z__2.r - temp.i * z__2.i, 
				    z__1.i = temp.r * z__2.i + temp.i * 
				    z__2.r;
			    temp.r = z__1.r, temp.i = z__1.i;
			}
		    }
		    if (temp.r != 1. || temp.i != 0.) {
			i__2 = *m;
			for (i__ = 1; i__ <= i__2; ++i__) {
			    i__3 = i__ + k * b_dim1;
			    i__4 = i__ + k * b_dim1;
			    z__1.r = temp.r * b[i__4].r - temp.i * b[i__4].i, 
				    z__1.i = temp.r * b[i__4].i + temp.i * b[
				    i__4].r;
			    b[i__3].r = z__1.r, b[i__3].i = z__1.i;
			}
		    }
		}
	    } else {
		for (k = *n; k >= 1; --k) {
		    i__1 = *n;
		    for (j = k + 1; j <= i__1; ++j) {
			i__2 = j + k * a_dim1;
			if (a[i__2].r != 0. || a[i__2].i != 0.) {
			    if (noconj) {
				i__2 = j + k * a_dim1;
				z__1.r = alpha->r * a[i__2].r - alpha->i * a[
					i__2].i, z__1.i = alpha->r * a[i__2]
					.i + alpha->i * a[i__2].r;
				temp.r = z__1.r, temp.i = z__1.i;
			    } else {
				d_cnjg(&z__2, &a[j + k * a_dim1]);
				z__1.r = alpha->r * z__2.r - alpha->i * 
					z__2.i, z__1.i = alpha->r * z__2.i + 
					alpha->i * z__2.r;
				temp.r = z__1.r, temp.i = z__1.i;
			    }
			    i__2 = *m;
			    for (i__ = 1; i__ <= i__2; ++i__) {
				i__3 = i__ + j * b_dim1;
				i__4 = i__ + j * b_dim1;
				i__5 = i__ + k * b_dim1;
				z__2.r = temp.r * b[i__5].r - temp.i * b[i__5]
					.i, z__2.i = temp.r * b[i__5].i + 
					temp.i * b[i__5].r;
				z__1.r = b[i__4].r + z__2.r, z__1.i = b[i__4]
					.i + z__2.i;
				b[i__3].r = z__1.r, b[i__3].i = z__1.i;
			    }
			}
		    }
		    temp.r = alpha->r, temp.i = alpha->i;
		    if (nounit) {
			if (noconj) {
			    i__1 = k + k * a_dim1;
			    z__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i, 
				    z__1.i = temp.r * a[i__1].i + temp.i * a[
				    i__1].r;
			    temp.r = z__1.r, temp.i = z__1.i;
			} else {
			    d_cnjg(&z__2, &a[k + k * a_dim1]);
			    z__1.r = temp.r * z__2.r - temp.i * z__2.i, 
				    z__1.i = temp.r * z__2.i + temp.i * 
				    z__2.r;
			    temp.r = z__1.r, temp.i = z__1.i;
			}
		    }
		    if (temp.r != 1. || temp.i != 0.) {
			i__1 = *m;
			for (i__ = 1; i__ <= i__1; ++i__) {
			    i__2 = i__ + k * b_dim1;
			    i__3 = i__ + k * b_dim1;
			    z__1.r = temp.r * b[i__3].r - temp.i * b[i__3].i, 
				    z__1.i = temp.r * b[i__3].i + temp.i * b[
				    i__3].r;
			    b[i__2].r = z__1.r, b[i__2].i = z__1.i;
			}
		    }
		}
	    }
	}
    }

return TCL_OK;


} /* ztrmm_ */
static /* Subroutine */ int zaxpy_ (Tcl_Interp *interp, integer *n, doublecomplex *za, doublecomplex *zx, 	integer *incx, doublecomplex *zy, integer *incy)
{
    integer i__1, i__2, i__3, i__4;
    doublecomplex z__1, z__2;

    integer i__, ix, iy;




    --zy;
    --zx;

    if (*n <= 0) {
return TCL_OK;
    }
    if (dcabs1_(za) == 0.) {
return TCL_OK;
    }
    if (*incx == 1 && *incy == 1) {
	goto L20;
    }


    ix = 1;
    iy = 1;
    if (*incx < 0) {
	ix = (-(*n) + 1) * *incx + 1;
    }
    if (*incy < 0) {
	iy = (-(*n) + 1) * *incy + 1;
    }
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	i__2 = iy;
	i__3 = iy;
	i__4 = ix;
	z__2.r = za->r * zx[i__4].r - za->i * zx[i__4].i, z__2.i = za->r * zx[
		i__4].i + za->i * zx[i__4].r;
	z__1.r = zy[i__3].r + z__2.r, z__1.i = zy[i__3].i + z__2.i;
	zy[i__2].r = z__1.r, zy[i__2].i = z__1.i;
	ix += *incx;
	iy += *incy;
    }
return TCL_OK;


L20:
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	i__2 = i__;
	i__3 = i__;
	i__4 = i__;
	z__2.r = za->r * zx[i__4].r - za->i * zx[i__4].i, z__2.i = za->r * zx[
		i__4].i + za->i * zx[i__4].r;
	z__1.r = zy[i__3].r + z__2.r, z__1.i = zy[i__3].i + z__2.i;
	zy[i__2].r = z__1.r, zy[i__2].i = z__1.i;
    }
return TCL_OK;
} /* zaxpy_ */
static /* Subroutine */ int zgehd2_ (Tcl_Interp *interp, integer *n, integer *ilo, integer *ihi, 	doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *	work, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3;
    doublecomplex z__1;

    void d_cnjg(doublecomplex *, doublecomplex *);

    integer i__;
    doublecomplex alpha;



























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

    *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);
	vectcl_xerbla(interp, "ZGEHD2", &i__1);
return TCL_ERROR;

return TCL_OK;
    }

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


	i__2 = i__ + 1 + i__ * a_dim1;
	alpha.r = a[i__2].r, alpha.i = a[i__2].i;
	i__2 = *ihi - i__;
	i__3 = i__ + 2;
	if (zlarfg_(interp, &i__2, &alpha, &a[min(i__3, *n)+ i__ * a_dim1], &zgehd2_c__1, &tau[		i__])!=TCL_OK) { return TCL_ERROR; }


	i__2 = i__ + 1 + i__ * a_dim1;
	a[i__2].r = 1., a[i__2].i = 0.;


	i__2 = *ihi - i__;
	if (zlarf_(interp, "Right", ihi, &i__2, &a[i__ + 1 + i__ * a_dim1], &zgehd2_c__1, &tau[		i__], &a[(i__ + 1) * a_dim1 + 1], lda, &work[1])!=TCL_OK) { return TCL_ERROR; }




	i__2 = *ihi - i__;
	i__3 = *n - i__;
	d_cnjg(&z__1, &tau[i__]);
	if (zlarf_(interp, "Left", &i__2, &i__3, &a[i__ + 1 + i__ * a_dim1], &zgehd2_c__1, &z__1, 		 &a[i__ + 1 + (i__ + 1) * a_dim1], lda, &work[1])!=TCL_OK) { return TCL_ERROR; }



	i__2 = i__ + 1 + i__ * a_dim1;
	a[i__2].r = alpha.r, a[i__2].i = alpha.i;
    }

return TCL_OK;


} /* zgehd2_ */
static /* Subroutine */ int zlahr2_ (Tcl_Interp *interp, integer *n, integer *k, integer *nb, 	doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *t, 	integer *ldt, doublecomplex *y, integer *ldy)
{
    integer a_dim1, a_offset, t_dim1, t_offset, y_dim1, y_offset, i__1, i__2, 
	    i__3;
    doublecomplex z__1;

    integer i__;
    doublecomplex ei;
































    --tau;
    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    t_dim1 = *ldt;
    t_offset = 1 + t_dim1;
    t -= t_offset;
    y_dim1 = *ldy;
    y_offset = 1 + y_dim1;
    y -= y_offset;

    if (*n <= 1) {
return TCL_OK;
    }

    i__1 = *nb;
    for (i__ = 1; i__ <= i__1; ++i__) {
	if (i__ > 1) {



	    i__2 = i__ - 1;
	    if (zlacgv_(interp, &i__2, &a[*k + i__ - 1 + a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }

	    i__2 = *n - *k;
	    i__3 = i__ - 1;
	    z__1.r = -1., z__1.i = -0.;
	    if (zgemv_(interp, "NO TRANSPOSE", &i__2, &i__3, &z__1, &y[*k + 1 + y_dim1], 		    ldy, &a[*k + i__ - 1 + a_dim1], lda, &zlahr2_c_b2, &a[*k + 1 + 
		    i__ * a_dim1], &zlahr2_c__1)!=TCL_OK) { return TCL_ERROR; }


	    i__2 = i__ - 1;
	    if (zlacgv_(interp, &i__2, &a[*k + i__ - 1 + a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }






	    i__2 = i__ - 1;
	    if (zcopy_(interp, &i__2, &a[*k + 1 + i__ * a_dim1], &zlahr2_c__1, &t[*nb * t_dim1 + 		    1], &zlahr2_c__1)!=TCL_OK) { return TCL_ERROR; }


	    i__2 = i__ - 1;
	    if (ztrmv_(interp, "Lower", "Conjugate transpose", "UNIT", &i__2, &a[*k + 1 + 		    a_dim1], lda, &t[*nb * t_dim1 + 1], &zlahr2_c__1)!=TCL_OK) { return TCL_ERROR; }




	    i__2 = *n - *k - i__ + 1;
	    i__3 = i__ - 1;
	    if (zgemv_(interp, "Conjugate transpose", &i__2, &i__3, &zlahr2_c_b2, &a[*k + i__ + 		    a_dim1], lda, &a[*k + i__ + i__ * a_dim1], &zlahr2_c__1, &zlahr2_c_b2, &
		    t[*nb * t_dim1 + 1], &zlahr2_c__1)!=TCL_OK) { return TCL_ERROR; }




	    i__2 = i__ - 1;
	    if (ztrmv_(interp, "Upper", "Conjugate transpose", "NON-UNIT", &i__2, &t[		    t_offset], ldt, &t[*nb * t_dim1 + 1], &zlahr2_c__1)!=TCL_OK) { return TCL_ERROR; }




	    i__2 = *n - *k - i__ + 1;
	    i__3 = i__ - 1;
	    z__1.r = -1., z__1.i = -0.;
	    if (zgemv_(interp, "NO TRANSPOSE", &i__2, &i__3, &z__1, &a[*k + i__ + a_dim1], 		     lda, &t[*nb * t_dim1 + 1], &zlahr2_c__1, &zlahr2_c_b2, &a[*k + i__ + 
		    i__ * a_dim1], &zlahr2_c__1)!=TCL_OK) { return TCL_ERROR; }




	    i__2 = i__ - 1;
	    if (ztrmv_(interp, "Lower", "NO TRANSPOSE", "UNIT", &i__2, &a[*k + 1 + a_dim1], lda, &t[*nb * t_dim1 + 1], &zlahr2_c__1)!=TCL_OK) { return TCL_ERROR; }


	    i__2 = i__ - 1;
	    z__1.r = -1., z__1.i = -0.;
	    if (zaxpy_(interp, &i__2, &z__1, &t[*nb * t_dim1 + 1], &zlahr2_c__1, &a[*k + 1 + i__ 		    * a_dim1], &zlahr2_c__1)!=TCL_OK) { return TCL_ERROR; }



	    i__2 = *k + i__ - 1 + (i__ - 1) * a_dim1;
	    a[i__2].r = ei.r, a[i__2].i = ei.i;
	}


	i__2 = *n - *k - i__ + 1;
	i__3 = *k + i__ + 1;
	if (zlarfg_(interp, &i__2, &a[*k + i__ + i__ * a_dim1], &a[min(i__3, *n)+ i__ * 		a_dim1], &zlahr2_c__1, &tau[i__])!=TCL_OK) { return TCL_ERROR; }


	i__2 = *k + i__ + i__ * a_dim1;
	ei.r = a[i__2].r, ei.i = a[i__2].i;
	i__2 = *k + i__ + i__ * a_dim1;
	a[i__2].r = 1., a[i__2].i = 0.;


	i__2 = *n - *k;
	i__3 = *n - *k - i__ + 1;
	if (zgemv_(interp, "NO TRANSPOSE", &i__2, &i__3, &zlahr2_c_b2, &a[*k + 1 + (i__ + 1) * 		a_dim1], lda, &a[*k + i__ + i__ * a_dim1], &zlahr2_c__1, &zlahr2_c_b1, &y[*
		k + 1 + i__ * y_dim1], &zlahr2_c__1)!=TCL_OK) { return TCL_ERROR; }


	i__2 = *n - *k - i__ + 1;
	i__3 = i__ - 1;
	if (zgemv_(interp, "Conjugate transpose", &i__2, &i__3, &zlahr2_c_b2, &a[*k + i__ + 		a_dim1], lda, &a[*k + i__ + i__ * a_dim1], &zlahr2_c__1, &zlahr2_c_b1, &t[
		i__ * t_dim1 + 1], &zlahr2_c__1)!=TCL_OK) { return TCL_ERROR; }


	i__2 = *n - *k;
	i__3 = i__ - 1;
	z__1.r = -1., z__1.i = -0.;
	if (zgemv_(interp, "NO TRANSPOSE", &i__2, &i__3, &z__1, &y[*k + 1 + y_dim1], ldy, 		&t[i__ * t_dim1 + 1], &zlahr2_c__1, &zlahr2_c_b2, &y[*k + 1 + i__ * y_dim1], 
		 &zlahr2_c__1)!=TCL_OK) { return TCL_ERROR; }


	i__2 = *n - *k;
	if (zscal_(interp, &i__2, &tau[i__], &y[*k + 1 + i__ * y_dim1], &zlahr2_c__1)!=TCL_OK) { return TCL_ERROR; }



	i__2 = i__ - 1;
	i__3 = i__;
	z__1.r = -tau[i__3].r, z__1.i = -tau[i__3].i;
	if (zscal_(interp, &i__2, &z__1, &t[i__ * t_dim1 + 1], &zlahr2_c__1)!=TCL_OK) { return TCL_ERROR; }

	i__2 = i__ - 1;
	if (ztrmv_(interp, "Upper", "No Transpose", "NON-UNIT", &i__2, &t[t_offset], ldt, 		&t[i__ * t_dim1 + 1], &zlahr2_c__1)
		!=TCL_OK) { return TCL_ERROR; }


	i__2 = i__ + i__ * t_dim1;
	i__3 = i__;
	t[i__2].r = tau[i__3].r, t[i__2].i = tau[i__3].i;

    }
    i__1 = *k + *nb + *nb * a_dim1;
    a[i__1].r = ei.r, a[i__1].i = ei.i;


    if (zlacpy_(interp, "ALL", k, nb, &a[(a_dim1 << 1) + 1], lda, &y[y_offset], ldy)!=TCL_OK) { return TCL_ERROR; }

    if (ztrmm_(interp, "RIGHT", "Lower", "NO TRANSPOSE", "UNIT", k, nb, &zlahr2_c_b2, &a[*k + 1 	    + a_dim1], lda, &y[y_offset], ldy)!=TCL_OK) { return TCL_ERROR; }


    if (*n > *k + *nb) {
	i__1 = *n - *k - *nb;
	if (zgemm_(interp, "NO TRANSPOSE", "NO TRANSPOSE", k, nb, &i__1, &zlahr2_c_b2, &a[(*nb + 		2) * a_dim1 + 1], lda, &a[*k + 1 + *nb + a_dim1], lda, &zlahr2_c_b2, 
		&y[y_offset], ldy)!=TCL_OK) { return TCL_ERROR; }


    }
    if (ztrmm_(interp, "RIGHT", "Upper", "NO TRANSPOSE", "NON-UNIT", k, nb, &zlahr2_c_b2, &t[	    t_offset], ldt, &y[y_offset], ldy)!=TCL_OK) { return TCL_ERROR; }



return TCL_OK;


} /* zlahr2_ */
static /* Subroutine */ int zlaqr0_ (Tcl_Interp *interp, logical *wantt, logical *wantz, integer *n, 	integer *ilo, integer *ihi, doublecomplex *h__, integer *ldh, 	doublecomplex *w, integer *iloz, integer *ihiz, doublecomplex *z__, 	integer *ldz, doublecomplex *work, integer *lwork, integer *info)
{
    integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4, i__5;
    doublereal d__1, d__2, d__3, d__4, d__5, d__6, d__7, d__8;
    doublecomplex z__1, z__2, z__3, z__4, z__5;

    double d_imag(doublecomplex *);
    void z_sqrt(doublecomplex *, doublecomplex *);

    integer i__, k;
    doublereal s;
    doublecomplex aa, bb, cc, dd;
    integer ld, nh, it, ks, kt, ku, kv, ls, ns, nw;
    doublecomplex tr2, det;
    integer inf, kdu, nho, nve, kwh, nsr, nwr, kwv, ndec, ndfl, kbot, nmin;
    doublecomplex swap;
    integer ktop;
    doublecomplex zdum[1]	/* was [1][1] */;
    integer kacc22, itmax, nsmax, nwmax, kwtop;
    integer nibble;
    char jbcmpz[1];
    doublecomplex rtdisc;
    integer nwupbd;
    logical sorted;
    integer lwkopt;






































    h_dim1 = *ldh;
    h_offset = 1 + h_dim1;
    h__ -= h_offset;
    --w;
    z_dim1 = *ldz;
    z_offset = 1 + z_dim1;
    z__ -= z_offset;
    --work;

    *info = 0;


    if (*n == 0) {
	work[1].r = 1., work[1].i = 0.;
return TCL_OK;
    }

    if (*n <= 11) {


	lwkopt = 1;
	if (*lwork != -1) {
	    if (zlahqr_(interp, wantt, wantz, n, ilo, ihi, &h__[h_offset], ldh, &w[1], 		    iloz, ihiz, &z__[z_offset], ldz, info)!=TCL_OK) { return TCL_ERROR; }


	}
    } else {



	*info = 0;


	if (*wantt) {
	    *(unsigned char *)jbcmpz = 'S';
	} else {
	    *(unsigned char *)jbcmpz = 'E';
	}
	if (*wantz) {
	    *(unsigned char *)&jbcmpz[1] = 'V';
	} else {
	    *(unsigned char *)&jbcmpz[1] = 'N';
	}


	nwr = ilaenv_(&zlaqr0_c__13, "ZLAQR0", jbcmpz, n, ilo, ihi, lwork);
	nwr = max(2,nwr);
	i__1 = *ihi - *ilo + 1, i__2 = (*n - 1) / 3, i__1 = min(i__1,i__2);
	nwr = min(i__1,nwr);


	nsr = ilaenv_(&zlaqr0_c__15, "ZLAQR0", jbcmpz, n, ilo, ihi, lwork);
	i__1 = nsr, i__2 = (*n + 6) / 9, i__1 = min(i__1,i__2), i__2 = *ihi - 
		*ilo;
	nsr = min(i__1,i__2);
	i__1 = 2, i__2 = nsr - nsr % 2;
	nsr = max(i__1,i__2);



	i__1 = nwr + 1;
	if (zlaqr3_(interp, wantt, wantz, n, ilo, ihi, &i__1, &h__[h_offset], ldh, iloz, 		ihiz, &z__[z_offset], ldz, &ls, &ld, &w[1], &h__[h_offset], 
		ldh, n, &h__[h_offset], ldh, n, &h__[h_offset], ldh, &work[1], 
		 &zlaqr0_c_n1)!=TCL_OK) { return TCL_ERROR; }




	i__1 = nsr * 3 / 2, i__2 = (integer) work[1].r;
	lwkopt = max(i__1,i__2);


	if (*lwork == -1) {
	    d__1 = (doublereal) lwkopt;
	    z__1.r = d__1, z__1.i = 0.;
	    work[1].r = z__1.r, work[1].i = z__1.i;
return TCL_OK;
	}


	nmin = ilaenv_(&zlaqr0_c__12, "ZLAQR0", jbcmpz, n, ilo, ihi, lwork);
	nmin = max(11,nmin);


	nibble = ilaenv_(&zlaqr0_c__14, "ZLAQR0", jbcmpz, n, ilo, ihi, lwork);
	nibble = max(0,nibble);


	kacc22 = ilaenv_(&zlaqr0_c__16, "ZLAQR0", jbcmpz, n, ilo, ihi, lwork);
	kacc22 = max(0,kacc22);
	kacc22 = min(2,kacc22);


	i__1 = (*n - 1) / 3, i__2 = *lwork / 2;
	nwmax = min(i__1,i__2);
	nw = nwmax;


	i__1 = (*n + 6) / 9, i__2 = (*lwork << 1) / 3;
	nsmax = min(i__1,i__2);
	nsmax -= nsmax % 2;


	ndfl = 1;


	i__1 = 10, i__2 = *ihi - *ilo + 1;
	itmax = max(i__1,i__2) * 30;


	kbot = *ihi;


	i__1 = itmax;
	for (it = 1; it <= i__1; ++it) {


	    if (kbot < *ilo) {
		goto L80;
	    }


	    i__2 = *ilo + 1;
	    for (k = kbot; k >= i__2; --k) {
		i__3 = k + (k - 1) * h_dim1;
		if (h__[i__3].r == 0. && h__[i__3].i == 0.) {
		    goto L20;
		}
	    }
	    k = *ilo;
L20:
	    ktop = k;


	    nh = kbot - ktop + 1;
	    nwupbd = min(nh,nwmax);
	    if (ndfl < 5) {
		nw = min(nwupbd,nwr);
	    } else {
		i__2 = nwupbd, i__3 = nw << 1;
		nw = min(i__2,i__3);
	    }
	    if (nw < nwmax) {
		if (nw >= nh - 1) {
		    nw = nh;
		} else {
		    kwtop = kbot - nw + 1;
		    i__2 = kwtop + (kwtop - 1) * h_dim1;
		    i__3 = kwtop - 1 + (kwtop - 2) * h_dim1;
		    if ((d__1 = h__[i__2].r, abs(d__1)) + (d__2 = d_imag(&h__[
			    kwtop + (kwtop - 1) * h_dim1]), abs(d__2)) > (
			    d__3 = h__[i__3].r, abs(d__3)) + (d__4 = d_imag(&
			    h__[kwtop - 1 + (kwtop - 2) * h_dim1]), abs(d__4))
			    ) {
			++nw;
		    }
		}
	    }
	    if (ndfl < 5) {
		ndec = -1;
	    } else if (ndec >= 0 || nw >= nwupbd) {
		++ndec;
		if (nw - ndec < 2) {
		    ndec = 0;
		}
		nw -= ndec;
	    }


	    kv = *n - nw + 1;
	    kt = nw + 1;
	    nho = *n - nw - 1 - kt + 1;
	    kwv = nw + 2;
	    nve = *n - nw - kwv + 1;


	    if (zlaqr3_(interp, wantt, wantz, n, &ktop, &kbot, &nw, &h__[h_offset], ldh, 		    iloz, ihiz, &z__[z_offset], ldz, &ls, &ld, &w[1], &h__[kv 
		    + h_dim1], ldh, &nho, &h__[kv + kt * h_dim1], ldh, &nve, &
		    h__[kwv + h_dim1], ldh, &work[1], lwork)!=TCL_OK) { return TCL_ERROR; }




	    kbot -= ld;


	    ks = kbot - ls + 1;


	    if (ld == 0 || ld * 100 <= nw * nibble && kbot - ktop + 1 > min(
		    nmin,nwmax)) {


		i__4 = 2, i__5 = kbot - ktop;
		i__2 = min(nsmax,nsr), i__3 = max(i__4,i__5);
		ns = min(i__2,i__3);
		ns -= ns % 2;


		if (ndfl % 6 == 0) {
		    ks = kbot - ns + 1;
		    i__2 = ks + 1;
		    for (i__ = kbot; i__ >= i__2; i__ += -2) {
			i__3 = i__;
			i__4 = i__ + i__ * h_dim1;
			i__5 = i__ + (i__ - 1) * h_dim1;
			d__3 = ((d__1 = h__[i__5].r, abs(d__1)) + (d__2 = 
				d_imag(&h__[i__ + (i__ - 1) * h_dim1]), abs(
				d__2))) * .75;
			z__1.r = h__[i__4].r + d__3, z__1.i = h__[i__4].i;
			w[i__3].r = z__1.r, w[i__3].i = z__1.i;
			i__3 = i__ - 1;
			i__4 = i__;
			w[i__3].r = w[i__4].r, w[i__3].i = w[i__4].i;
		    }
		} else {


		    if (kbot - ks + 1 <= ns / 2) {
			ks = kbot - ns + 1;
			kt = *n - ns + 1;
			if (zlacpy_(interp, "A", &ns, &ns, &h__[ks + ks * h_dim1], ldh, &				h__[kt + h_dim1], ldh)!=TCL_OK) { return TCL_ERROR; }


			if (ns > nmin) {
			    if (zlaqr4_(interp, &zlaqr0_c_false, &zlaqr0_c_false, &ns, &zlaqr0_c__1, &ns, &h__[				    kt + h_dim1], ldh, &w[ks], &zlaqr0_c__1, &zlaqr0_c__1, 
				    zdum, &zlaqr0_c__1, &work[1], lwork, &inf)!=TCL_OK) { return TCL_ERROR; }


			} else {
			    if (zlahqr_(interp, &zlaqr0_c_false, &zlaqr0_c_false, &ns, &zlaqr0_c__1, &ns, &h__[				    kt + h_dim1], ldh, &w[ks], &zlaqr0_c__1, &zlaqr0_c__1, 
				    zdum, &zlaqr0_c__1, &inf)!=TCL_OK) { return TCL_ERROR; }


			}
			ks += inf;


			if (ks >= kbot) {
			    i__2 = kbot - 1 + (kbot - 1) * h_dim1;
			    i__3 = kbot + (kbot - 1) * h_dim1;
			    i__4 = kbot - 1 + kbot * h_dim1;
			    i__5 = kbot + kbot * h_dim1;
			    s = (d__1 = h__[i__2].r, abs(d__1)) + (d__2 = 
				    d_imag(&h__[kbot - 1 + (kbot - 1) * 
				    h_dim1]), abs(d__2)) + ((d__3 = h__[i__3]
				    .r, abs(d__3)) + (d__4 = d_imag(&h__[kbot 
				    + (kbot - 1) * h_dim1]), abs(d__4))) + ((
				    d__5 = h__[i__4].r, abs(d__5)) + (d__6 = 
				    d_imag(&h__[kbot - 1 + kbot * h_dim1]), 
				    abs(d__6))) + ((d__7 = h__[i__5].r, abs(
				    d__7)) + (d__8 = d_imag(&h__[kbot + kbot *
				     h_dim1]), abs(d__8)));
			    i__2 = kbot - 1 + (kbot - 1) * h_dim1;
			    z__1.r = h__[i__2].r / s, z__1.i = h__[i__2].i / 
				    s;
			    aa.r = z__1.r, aa.i = z__1.i;
			    i__2 = kbot + (kbot - 1) * h_dim1;
			    z__1.r = h__[i__2].r / s, z__1.i = h__[i__2].i / 
				    s;
			    cc.r = z__1.r, cc.i = z__1.i;
			    i__2 = kbot - 1 + kbot * h_dim1;
			    z__1.r = h__[i__2].r / s, z__1.i = h__[i__2].i / 
				    s;
			    bb.r = z__1.r, bb.i = z__1.i;
			    i__2 = kbot + kbot * h_dim1;
			    z__1.r = h__[i__2].r / s, z__1.i = h__[i__2].i / 
				    s;
			    dd.r = z__1.r, dd.i = z__1.i;
			    z__2.r = aa.r + dd.r, z__2.i = aa.i + dd.i;
			    z__1.r = z__2.r / 2., z__1.i = z__2.i / 2.;
			    tr2.r = z__1.r, tr2.i = z__1.i;
			    z__3.r = aa.r - tr2.r, z__3.i = aa.i - tr2.i;
			    z__4.r = dd.r - tr2.r, z__4.i = dd.i - tr2.i;
			    z__2.r = z__3.r * z__4.r - z__3.i * z__4.i, 
				    z__2.i = z__3.r * z__4.i + z__3.i * 
				    z__4.r;
			    z__5.r = bb.r * cc.r - bb.i * cc.i, z__5.i = bb.r 
				    * cc.i + bb.i * cc.r;
			    z__1.r = z__2.r - z__5.r, z__1.i = z__2.i - 
				    z__5.i;
			    det.r = z__1.r, det.i = z__1.i;
			    z__2.r = -det.r, z__2.i = -det.i;
			    z_sqrt(&z__1, &z__2);
			    rtdisc.r = z__1.r, rtdisc.i = z__1.i;
			    i__2 = kbot - 1;
			    z__2.r = tr2.r + rtdisc.r, z__2.i = tr2.i + 
				    rtdisc.i;
			    z__1.r = s * z__2.r, z__1.i = s * z__2.i;
			    w[i__2].r = z__1.r, w[i__2].i = z__1.i;
			    i__2 = kbot;
			    z__2.r = tr2.r - rtdisc.r, z__2.i = tr2.i - 
				    rtdisc.i;
			    z__1.r = s * z__2.r, z__1.i = s * z__2.i;
			    w[i__2].r = z__1.r, w[i__2].i = z__1.i;

			    ks = kbot - 1;
			}
		    }

		    if (kbot - ks + 1 > ns) {


			sorted = FALSE_;
			i__2 = ks + 1;
			for (k = kbot; k >= i__2; --k) {
			    if (sorted) {
				goto L60;
			    }
			    sorted = TRUE_;
			    i__3 = k - 1;
			    for (i__ = ks; i__ <= i__3; ++i__) {
				i__4 = i__;
				i__5 = i__ + 1;
				if ((d__1 = w[i__4].r, abs(d__1)) + (d__2 = 
					d_imag(&w[i__]), abs(d__2)) < (d__3 = 
					w[i__5].r, abs(d__3)) + (d__4 = 
					d_imag(&w[i__ + 1]), abs(d__4))) {
				    sorted = FALSE_;
				    i__4 = i__;
				    swap.r = w[i__4].r, swap.i = w[i__4].i;
				    i__4 = i__;
				    i__5 = i__ + 1;
				    w[i__4].r = w[i__5].r, w[i__4].i = w[i__5]
					    .i;
				    i__4 = i__ + 1;
				    w[i__4].r = swap.r, w[i__4].i = swap.i;
				}
			    }
			}
L60:
			;
		    }
		}


		if (kbot - ks + 1 == 2) {
		    i__2 = kbot;
		    i__3 = kbot + kbot * h_dim1;
		    z__2.r = w[i__2].r - h__[i__3].r, z__2.i = w[i__2].i - 
			    h__[i__3].i;
		    z__1.r = z__2.r, z__1.i = z__2.i;
		    i__4 = kbot - 1;
		    i__5 = kbot + kbot * h_dim1;
		    z__4.r = w[i__4].r - h__[i__5].r, z__4.i = w[i__4].i - 
			    h__[i__5].i;
		    z__3.r = z__4.r, z__3.i = z__4.i;
		    if ((d__1 = z__1.r, abs(d__1)) + (d__2 = d_imag(&z__1), 
			    abs(d__2)) < (d__3 = z__3.r, abs(d__3)) + (d__4 = 
			    d_imag(&z__3), abs(d__4))) {
			i__2 = kbot - 1;
			i__3 = kbot;
			w[i__2].r = w[i__3].r, w[i__2].i = w[i__3].i;
		    } else {
			i__2 = kbot;
			i__3 = kbot - 1;
			w[i__2].r = w[i__3].r, w[i__2].i = w[i__3].i;
		    }
		}


		i__2 = ns, i__3 = kbot - ks + 1;
		ns = min(i__2,i__3);
		ns -= ns % 2;
		ks = kbot - ns + 1;


		kdu = ns * 3 - 3;
		ku = *n - kdu + 1;
		kwh = kdu + 1;
		nho = *n - kdu - 3 - (kdu + 1) + 1;
		kwv = kdu + 4;
		nve = *n - kdu - kwv + 1;


		if (zlaqr5_(interp, wantt, wantz, &kacc22, n, &ktop, &kbot, &ns, &w[ks], &			h__[h_offset], ldh, iloz, ihiz, &z__[z_offset], ldz, &
			work[1], &zlaqr0_c__3, &h__[ku + h_dim1], ldh, &nve, &h__[
			kwv + h_dim1], ldh, &nho, &h__[ku + kwh * h_dim1], 
			ldh)!=TCL_OK) { return TCL_ERROR; }


	    }


	    if (ld > 0) {
		ndfl = 1;
	    } else {
		++ndfl;
	    }

	}


	*info = kbot;
L80:
	;
    }


    d__1 = (doublereal) lwkopt;
    z__1.r = d__1, z__1.i = 0.;
    work[1].r = z__1.r, work[1].i = z__1.i;


return TCL_OK;
} /* zlaqr0_ */
static /* Subroutine */ int zlahqr_ (Tcl_Interp *interp, logical *wantt, logical *wantz, integer *n, 	integer *ilo, integer *ihi, doublecomplex *h__, integer *ldh, 	doublecomplex *w, integer *iloz, integer *ihiz, doublecomplex *z__, 	integer *ldz, integer *info)
{
    integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4;
    doublereal d__1, d__2, d__3, d__4, d__5, d__6;
    doublecomplex z__1, z__2, z__3, z__4, z__5, z__6, z__7;

    double d_imag(doublecomplex *);
    void d_cnjg(doublecomplex *, doublecomplex *);
    double z_abs(doublecomplex *);
    void z_sqrt(doublecomplex *, doublecomplex *), pow_zi(doublecomplex *, 
	    doublecomplex *, integer *);

    integer i__, j, k, l, m;
    doublereal s;
    doublecomplex t, u, v[2], x, y;
    integer i1, i2;
    doublecomplex t1;
    doublereal t2;
    doublecomplex v2;
    doublereal aa, ab, ba, bb, h10;
    doublecomplex h11;
    doublereal h21;
    doublecomplex h22, sc;
    integer nh, nz;
    doublereal sx;
    integer jhi;
    doublecomplex h11s;
    integer jlo, its;
    doublereal ulp;
    doublecomplex sum;
    doublereal tst;
    doublecomplex temp;
    doublereal rtemp;
    doublereal safmin, safmax;
    doublereal smlnum;


























    h_dim1 = *ldh;
    h_offset = 1 + h_dim1;
    h__ -= h_offset;
    --w;
    z_dim1 = *ldz;
    z_offset = 1 + z_dim1;
    z__ -= z_offset;

    *info = 0;


    if (*n == 0) {
return TCL_OK;
    }
    if (*ilo == *ihi) {
	i__1 = *ilo;
	i__2 = *ilo + *ilo * h_dim1;
	w[i__1].r = h__[i__2].r, w[i__1].i = h__[i__2].i;
return TCL_OK;
    }

    i__1 = *ihi - 3;
    for (j = *ilo; j <= i__1; ++j) {
	i__2 = j + 2 + j * h_dim1;
	h__[i__2].r = 0., h__[i__2].i = 0.;
	i__2 = j + 3 + j * h_dim1;
	h__[i__2].r = 0., h__[i__2].i = 0.;
    }
    if (*ilo <= *ihi - 2) {
	i__1 = *ihi + (*ihi - 2) * h_dim1;
	h__[i__1].r = 0., h__[i__1].i = 0.;
    }
    if (*wantt) {
	jlo = 1;
	jhi = *n;
    } else {
	jlo = *ilo;
	jhi = *ihi;
    }
    i__1 = *ihi;
    for (i__ = *ilo + 1; i__ <= i__1; ++i__) {
	if (d_imag(&h__[i__ + (i__ - 1) * h_dim1]) != 0.) {
	    i__2 = i__ + (i__ - 1) * h_dim1;
	    i__3 = i__ + (i__ - 1) * h_dim1;
	    d__3 = (d__1 = h__[i__3].r, abs(d__1)) + (d__2 = d_imag(&h__[i__ 
		    + (i__ - 1) * h_dim1]), abs(d__2));
	    z__1.r = h__[i__2].r / d__3, z__1.i = h__[i__2].i / d__3;
	    sc.r = z__1.r, sc.i = z__1.i;
	    d_cnjg(&z__2, &sc);
	    d__1 = z_abs(&sc);
	    z__1.r = z__2.r / d__1, z__1.i = z__2.i / d__1;
	    sc.r = z__1.r, sc.i = z__1.i;
	    i__2 = i__ + (i__ - 1) * h_dim1;
	    d__1 = z_abs(&h__[i__ + (i__ - 1) * h_dim1]);
	    h__[i__2].r = d__1, h__[i__2].i = 0.;
	    i__2 = jhi - i__ + 1;
	    if (zscal_(interp, &i__2, &sc, &h__[i__ + i__ * h_dim1], ldh)!=TCL_OK) { return TCL_ERROR; }

	    i__3 = jhi, i__4 = i__ + 1;
	    i__2 = min(i__3,i__4) - jlo + 1;
	    d_cnjg(&z__1, &sc);
	    if (zscal_(interp, &i__2, &z__1, &h__[jlo + i__ * h_dim1], &zlahqr_c__1)!=TCL_OK) { return TCL_ERROR; }

	    if (*wantz) {
		i__2 = *ihiz - *iloz + 1;
		d_cnjg(&z__1, &sc);
		if (zscal_(interp, &i__2, &z__1, &z__[*iloz + i__ * z_dim1], &zlahqr_c__1)!=TCL_OK) { return TCL_ERROR; }

	    }
	}
    }

    nh = *ihi - *ilo + 1;
    nz = *ihiz - *iloz + 1;


    safmin = dlamch_("SAFE MINIMUM");
    safmax = 1. / safmin;
    if (dlabad_(interp, &safmin, &safmax)!=TCL_OK) { return TCL_ERROR; }

    ulp = dlamch_("PRECISION");
    smlnum = safmin * ((doublereal) nh / ulp);


    if (*wantt) {
	i1 = 1;
	i2 = *n;
    }


    i__ = *ihi;
L30:
    if (i__ < *ilo) {
	goto L150;
    }


    l = *ilo;
    for (its = 0; its <= 30; ++its) {


	i__1 = l + 1;
	for (k = i__; k >= i__1; --k) {
	    i__2 = k + (k - 1) * h_dim1;
	    if ((d__1 = h__[i__2].r, abs(d__1)) + (d__2 = d_imag(&h__[k + (k 
		    - 1) * h_dim1]), abs(d__2)) <= smlnum) {
		goto L50;
	    }
	    i__2 = k - 1 + (k - 1) * h_dim1;
	    i__3 = k + k * h_dim1;
	    tst = (d__1 = h__[i__2].r, abs(d__1)) + (d__2 = d_imag(&h__[k - 1 
		    + (k - 1) * h_dim1]), abs(d__2)) + ((d__3 = h__[i__3].r, 
		    abs(d__3)) + (d__4 = d_imag(&h__[k + k * h_dim1]), abs(
		    d__4)));
	    if (tst == 0.) {
		if (k - 2 >= *ilo) {
		    i__2 = k - 1 + (k - 2) * h_dim1;
		    tst += (d__1 = h__[i__2].r, abs(d__1));
		}
		if (k + 1 <= *ihi) {
		    i__2 = k + 1 + k * h_dim1;
		    tst += (d__1 = h__[i__2].r, abs(d__1));
		}
	    }
	    i__2 = k + (k - 1) * h_dim1;
	    if ((d__1 = h__[i__2].r, abs(d__1)) <= ulp * tst) {
		i__2 = k + (k - 1) * h_dim1;
		i__3 = k - 1 + k * h_dim1;
		d__5 = (d__1 = h__[i__2].r, abs(d__1)) + (d__2 = d_imag(&h__[
			k + (k - 1) * h_dim1]), abs(d__2)), d__6 = (d__3 = 
			h__[i__3].r, abs(d__3)) + (d__4 = d_imag(&h__[k - 1 + 
			k * h_dim1]), abs(d__4));
		ab = max(d__5,d__6);
		i__2 = k + (k - 1) * h_dim1;
		i__3 = k - 1 + k * h_dim1;
		d__5 = (d__1 = h__[i__2].r, abs(d__1)) + (d__2 = d_imag(&h__[
			k + (k - 1) * h_dim1]), abs(d__2)), d__6 = (d__3 = 
			h__[i__3].r, abs(d__3)) + (d__4 = d_imag(&h__[k - 1 + 
			k * h_dim1]), abs(d__4));
		ba = min(d__5,d__6);
		i__2 = k - 1 + (k - 1) * h_dim1;
		i__3 = k + k * h_dim1;
		z__2.r = h__[i__2].r - h__[i__3].r, z__2.i = h__[i__2].i - 
			h__[i__3].i;
		z__1.r = z__2.r, z__1.i = z__2.i;
		i__4 = k + k * h_dim1;
		d__5 = (d__1 = h__[i__4].r, abs(d__1)) + (d__2 = d_imag(&h__[
			k + k * h_dim1]), abs(d__2)), d__6 = (d__3 = z__1.r, 
			abs(d__3)) + (d__4 = d_imag(&z__1), abs(d__4));
		aa = max(d__5,d__6);
		i__2 = k - 1 + (k - 1) * h_dim1;
		i__3 = k + k * h_dim1;
		z__2.r = h__[i__2].r - h__[i__3].r, z__2.i = h__[i__2].i - 
			h__[i__3].i;
		z__1.r = z__2.r, z__1.i = z__2.i;
		i__4 = k + k * h_dim1;
		d__5 = (d__1 = h__[i__4].r, abs(d__1)) + (d__2 = d_imag(&h__[
			k + k * h_dim1]), abs(d__2)), d__6 = (d__3 = z__1.r, 
			abs(d__3)) + (d__4 = d_imag(&z__1), abs(d__4));
		bb = min(d__5,d__6);
		s = aa + ab;
		d__1 = smlnum, d__2 = ulp * (bb * (aa / s));
		if (ba * (ab / s) <= max(d__1,d__2)) {
		    goto L50;
		}
	    }
	}
L50:
	l = k;
	if (l > *ilo) {


	    i__1 = l + (l - 1) * h_dim1;
	    h__[i__1].r = 0., h__[i__1].i = 0.;
	}


	if (l >= i__) {
	    goto L140;
	}


	if (! (*wantt)) {
	    i1 = l;
	    i2 = i__;
	}

	if (its == 10) {


	    i__1 = l + 1 + l * h_dim1;
	    s = (d__1 = h__[i__1].r, abs(d__1)) * .75;
	    i__1 = l + l * h_dim1;
	    z__1.r = s + h__[i__1].r, z__1.i = h__[i__1].i;
	    t.r = z__1.r, t.i = z__1.i;
	} else if (its == 20) {


	    i__1 = i__ + (i__ - 1) * h_dim1;
	    s = (d__1 = h__[i__1].r, abs(d__1)) * .75;
	    i__1 = i__ + i__ * h_dim1;
	    z__1.r = s + h__[i__1].r, z__1.i = h__[i__1].i;
	    t.r = z__1.r, t.i = z__1.i;
	} else {


	    i__1 = i__ + i__ * h_dim1;
	    t.r = h__[i__1].r, t.i = h__[i__1].i;
	    z_sqrt(&z__2, &h__[i__ - 1 + i__ * h_dim1]);
	    z_sqrt(&z__3, &h__[i__ + (i__ - 1) * h_dim1]);
	    z__1.r = z__2.r * z__3.r - z__2.i * z__3.i, z__1.i = z__2.r * 
		    z__3.i + z__2.i * z__3.r;
	    u.r = z__1.r, u.i = z__1.i;
	    s = (d__1 = u.r, abs(d__1)) + (d__2 = d_imag(&u), abs(d__2));
	    if (s != 0.) {
		i__1 = i__ - 1 + (i__ - 1) * h_dim1;
		z__2.r = h__[i__1].r - t.r, z__2.i = h__[i__1].i - t.i;
		z__1.r = z__2.r * .5, z__1.i = z__2.i * .5;
		x.r = z__1.r, x.i = z__1.i;
		sx = (d__1 = x.r, abs(d__1)) + (d__2 = d_imag(&x), abs(d__2));
		d__3 = s, d__4 = (d__1 = x.r, abs(d__1)) + (d__2 = d_imag(&x),
			 abs(d__2));
		s = max(d__3,d__4);
		z__5.r = x.r / s, z__5.i = x.i / s;
		pow_zi(&z__4, &z__5, &zlahqr_c__2);
		z__7.r = u.r / s, z__7.i = u.i / s;
		pow_zi(&z__6, &z__7, &zlahqr_c__2);
		z__3.r = z__4.r + z__6.r, z__3.i = z__4.i + z__6.i;
		z_sqrt(&z__2, &z__3);
		z__1.r = s * z__2.r, z__1.i = s * z__2.i;
		y.r = z__1.r, y.i = z__1.i;
		if (sx > 0.) {
		    z__1.r = x.r / sx, z__1.i = x.i / sx;
		    z__2.r = x.r / sx, z__2.i = x.i / sx;
		    if (z__1.r * y.r + d_imag(&z__2) * d_imag(&y) < 0.) {
			z__3.r = -y.r, z__3.i = -y.i;
			y.r = z__3.r, y.i = z__3.i;
		    }
		}
		z__4.r = x.r + y.r, z__4.i = x.i + y.i;
		zladiv_(&z__3, &u, &z__4);
		z__2.r = u.r * z__3.r - u.i * z__3.i, z__2.i = u.r * z__3.i + 
			u.i * z__3.r;
		z__1.r = t.r - z__2.r, z__1.i = t.i - z__2.i;
		t.r = z__1.r, t.i = z__1.i;
	    }
	}


	i__1 = l + 1;
	for (m = i__ - 1; m >= i__1; --m) {


	    i__2 = m + m * h_dim1;
	    h11.r = h__[i__2].r, h11.i = h__[i__2].i;
	    i__2 = m + 1 + (m + 1) * h_dim1;
	    h22.r = h__[i__2].r, h22.i = h__[i__2].i;
	    z__1.r = h11.r - t.r, z__1.i = h11.i - t.i;
	    h11s.r = z__1.r, h11s.i = z__1.i;
	    i__2 = m + 1 + m * h_dim1;
	    h21 = h__[i__2].r;
	    s = (d__1 = h11s.r, abs(d__1)) + (d__2 = d_imag(&h11s), abs(d__2))
		     + abs(h21);
	    z__1.r = h11s.r / s, z__1.i = h11s.i / s;
	    h11s.r = z__1.r, h11s.i = z__1.i;
	    h21 /= s;
	    v[0].r = h11s.r, v[0].i = h11s.i;
	    v[1].r = h21, v[1].i = 0.;
	    i__2 = m + (m - 1) * h_dim1;
	    h10 = h__[i__2].r;
	    if (abs(h10) * abs(h21) <= ulp * (((d__1 = h11s.r, abs(d__1)) + (
		    d__2 = d_imag(&h11s), abs(d__2))) * ((d__3 = h11.r, abs(
		    d__3)) + (d__4 = d_imag(&h11), abs(d__4)) + ((d__5 = 
		    h22.r, abs(d__5)) + (d__6 = d_imag(&h22), abs(d__6)))))) {
		goto L70;
	    }
	}
	i__1 = l + l * h_dim1;
	h11.r = h__[i__1].r, h11.i = h__[i__1].i;
	i__1 = l + 1 + (l + 1) * h_dim1;
	h22.r = h__[i__1].r, h22.i = h__[i__1].i;
	z__1.r = h11.r - t.r, z__1.i = h11.i - t.i;
	h11s.r = z__1.r, h11s.i = z__1.i;
	i__1 = l + 1 + l * h_dim1;
	h21 = h__[i__1].r;
	s = (d__1 = h11s.r, abs(d__1)) + (d__2 = d_imag(&h11s), abs(d__2)) + 
		abs(h21);
	z__1.r = h11s.r / s, z__1.i = h11s.i / s;
	h11s.r = z__1.r, h11s.i = z__1.i;
	h21 /= s;
	v[0].r = h11s.r, v[0].i = h11s.i;
	v[1].r = h21, v[1].i = 0.;
L70:


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




	    if (k > m) {
		if (zcopy_(interp, &zlahqr_c__2, &h__[k + (k - 1) * h_dim1], &zlahqr_c__1, v, &zlahqr_c__1)!=TCL_OK) { return TCL_ERROR; }

	    }
	    if (zlarfg_(interp, &zlahqr_c__2, v, &v[1], &zlahqr_c__1, &t1)!=TCL_OK) { return TCL_ERROR; }

	    if (k > m) {
		i__2 = k + (k - 1) * h_dim1;
		h__[i__2].r = v[0].r, h__[i__2].i = v[0].i;
		i__2 = k + 1 + (k - 1) * h_dim1;
		h__[i__2].r = 0., h__[i__2].i = 0.;
	    }
	    v2.r = v[1].r, v2.i = v[1].i;
	    z__1.r = t1.r * v2.r - t1.i * v2.i, z__1.i = t1.r * v2.i + t1.i * 
		    v2.r;
	    t2 = z__1.r;


	    i__2 = i2;
	    for (j = k; j <= i__2; ++j) {
		d_cnjg(&z__3, &t1);
		i__3 = k + j * h_dim1;
		z__2.r = z__3.r * h__[i__3].r - z__3.i * h__[i__3].i, z__2.i =
			 z__3.r * h__[i__3].i + z__3.i * h__[i__3].r;
		i__4 = k + 1 + j * h_dim1;
		z__4.r = t2 * h__[i__4].r, z__4.i = t2 * h__[i__4].i;
		z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;
		sum.r = z__1.r, sum.i = z__1.i;
		i__3 = k + j * h_dim1;
		i__4 = k + j * h_dim1;
		z__1.r = h__[i__4].r - sum.r, z__1.i = h__[i__4].i - sum.i;
		h__[i__3].r = z__1.r, h__[i__3].i = z__1.i;
		i__3 = k + 1 + j * h_dim1;
		i__4 = k + 1 + j * h_dim1;
		z__2.r = sum.r * v2.r - sum.i * v2.i, z__2.i = sum.r * v2.i + 
			sum.i * v2.r;
		z__1.r = h__[i__4].r - z__2.r, z__1.i = h__[i__4].i - z__2.i;
		h__[i__3].r = z__1.r, h__[i__3].i = z__1.i;
	    }


	    i__3 = k + 2;
	    i__2 = min(i__3,i__);
	    for (j = i1; j <= i__2; ++j) {
		i__3 = j + k * h_dim1;
		z__2.r = t1.r * h__[i__3].r - t1.i * h__[i__3].i, z__2.i = 
			t1.r * h__[i__3].i + t1.i * h__[i__3].r;
		i__4 = j + (k + 1) * h_dim1;
		z__3.r = t2 * h__[i__4].r, z__3.i = t2 * h__[i__4].i;
		z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
		sum.r = z__1.r, sum.i = z__1.i;
		i__3 = j + k * h_dim1;
		i__4 = j + k * h_dim1;
		z__1.r = h__[i__4].r - sum.r, z__1.i = h__[i__4].i - sum.i;
		h__[i__3].r = z__1.r, h__[i__3].i = z__1.i;
		i__3 = j + (k + 1) * h_dim1;
		i__4 = j + (k + 1) * h_dim1;
		d_cnjg(&z__3, &v2);
		z__2.r = sum.r * z__3.r - sum.i * z__3.i, z__2.i = sum.r * 
			z__3.i + sum.i * z__3.r;
		z__1.r = h__[i__4].r - z__2.r, z__1.i = h__[i__4].i - z__2.i;
		h__[i__3].r = z__1.r, h__[i__3].i = z__1.i;
	    }

	    if (*wantz) {


		i__2 = *ihiz;
		for (j = *iloz; j <= i__2; ++j) {
		    i__3 = j + k * z_dim1;
		    z__2.r = t1.r * z__[i__3].r - t1.i * z__[i__3].i, z__2.i =
			     t1.r * z__[i__3].i + t1.i * z__[i__3].r;
		    i__4 = j + (k + 1) * z_dim1;
		    z__3.r = t2 * z__[i__4].r, z__3.i = t2 * z__[i__4].i;
		    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
		    sum.r = z__1.r, sum.i = z__1.i;
		    i__3 = j + k * z_dim1;
		    i__4 = j + k * z_dim1;
		    z__1.r = z__[i__4].r - sum.r, z__1.i = z__[i__4].i - 
			    sum.i;
		    z__[i__3].r = z__1.r, z__[i__3].i = z__1.i;
		    i__3 = j + (k + 1) * z_dim1;
		    i__4 = j + (k + 1) * z_dim1;
		    d_cnjg(&z__3, &v2);
		    z__2.r = sum.r * z__3.r - sum.i * z__3.i, z__2.i = sum.r *
			     z__3.i + sum.i * z__3.r;
		    z__1.r = z__[i__4].r - z__2.r, z__1.i = z__[i__4].i - 
			    z__2.i;
		    z__[i__3].r = z__1.r, z__[i__3].i = z__1.i;
		}
	    }

	    if (k == m && m > l) {


		z__1.r = 1. - t1.r, z__1.i = 0. - t1.i;
		temp.r = z__1.r, temp.i = z__1.i;
		d__1 = z_abs(&temp);
		z__1.r = temp.r / d__1, z__1.i = temp.i / d__1;
		temp.r = z__1.r, temp.i = z__1.i;
		i__2 = m + 1 + m * h_dim1;
		i__3 = m + 1 + m * h_dim1;
		d_cnjg(&z__2, &temp);
		z__1.r = h__[i__3].r * z__2.r - h__[i__3].i * z__2.i, z__1.i =
			 h__[i__3].r * z__2.i + h__[i__3].i * z__2.r;
		h__[i__2].r = z__1.r, h__[i__2].i = z__1.i;
		if (m + 2 <= i__) {
		    i__2 = m + 2 + (m + 1) * h_dim1;
		    i__3 = m + 2 + (m + 1) * h_dim1;
		    z__1.r = h__[i__3].r * temp.r - h__[i__3].i * temp.i, 
			    z__1.i = h__[i__3].r * temp.i + h__[i__3].i * 
			    temp.r;
		    h__[i__2].r = z__1.r, h__[i__2].i = z__1.i;
		}
		i__2 = i__;
		for (j = m; j <= i__2; ++j) {
		    if (j != m + 1) {
			if (i2 > j) {
			    i__3 = i2 - j;
			    if (zscal_(interp, &i__3, &temp, &h__[j + (j + 1) * h_dim1], 				    ldh)!=TCL_OK) { return TCL_ERROR; }


			}
			i__3 = j - i1;
			d_cnjg(&z__1, &temp);
			if (zscal_(interp, &i__3, &z__1, &h__[i1 + j * h_dim1], &zlahqr_c__1)!=TCL_OK) { return TCL_ERROR; }

			if (*wantz) {
			    d_cnjg(&z__1, &temp);
			    if (zscal_(interp, &nz, &z__1, &z__[*iloz + j * z_dim1], &				    zlahqr_c__1)!=TCL_OK) { return TCL_ERROR; }


			}
		    }
		}
	    }
	}


	i__1 = i__ + (i__ - 1) * h_dim1;
	temp.r = h__[i__1].r, temp.i = h__[i__1].i;
	if (d_imag(&temp) != 0.) {
	    rtemp = z_abs(&temp);
	    i__1 = i__ + (i__ - 1) * h_dim1;
	    h__[i__1].r = rtemp, h__[i__1].i = 0.;
	    z__1.r = temp.r / rtemp, z__1.i = temp.i / rtemp;
	    temp.r = z__1.r, temp.i = z__1.i;
	    if (i2 > i__) {
		i__1 = i2 - i__;
		d_cnjg(&z__1, &temp);
		if (zscal_(interp, &i__1, &z__1, &h__[i__ + (i__ + 1) * h_dim1], ldh)!=TCL_OK) { return TCL_ERROR; }

	    }
	    i__1 = i__ - i1;
	    if (zscal_(interp, &i__1, &temp, &h__[i1 + i__ * h_dim1], &zlahqr_c__1)!=TCL_OK) { return TCL_ERROR; }

	    if (*wantz) {
		if (zscal_(interp, &nz, &temp, &z__[*iloz + i__ * z_dim1], &zlahqr_c__1)!=TCL_OK) { return TCL_ERROR; }

	    }
	}

    }


    *info = i__;
return TCL_OK;

L140:


    i__1 = i__;
    i__2 = i__ + i__ * h_dim1;
    w[i__1].r = h__[i__2].r, w[i__1].i = h__[i__2].i;


    i__ = l - 1;
    goto L30;

L150:
return TCL_OK;


} /* zlahqr_ */
static doublereal dzasum_ (integer *n, doublecomplex *zx, integer *incx)
{
    integer i__1;
    doublereal ret_val;

    integer i__, ix;
    doublereal stemp;





    --zx;

    ret_val = 0.;
    stemp = 0.;
    if (*n <= 0 || *incx <= 0) {
	return ret_val;
    }
    if (*incx == 1) {
	goto L20;
    }


    ix = 1;
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	stemp += dcabs1_(&zx[ix]);
	ix += *incx;
    }
    ret_val = stemp;
    return ret_val;


L20:
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	stemp += dcabs1_(&zx[i__]);
    }
    ret_val = stemp;
    return ret_val;
} /* dzasum_ */
static /* Subroutine */ int zlatrs_ (Tcl_Interp *interp, char *uplo, char *trans, char *diag, char *	normin, integer *n, doublecomplex *a, integer *lda, doublecomplex *x, 	doublereal *scale, doublereal *cnorm, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
    doublereal d__1, d__2, d__3, d__4;
    doublecomplex z__1, z__2, z__3, z__4;

    double d_imag(doublecomplex *);
    void d_cnjg(doublecomplex *, doublecomplex *);

    integer i__, j;
    doublereal xj, rec, tjj;
    integer jinc;
    doublereal xbnd;
    integer imax;
    doublereal tmax;
    doublecomplex tjjs;
    doublereal xmax, grow;
    doublereal tscal;
    doublecomplex uscal;
    integer jlast;
    doublecomplex csumj;
    logical upper;
    doublereal bignum;
    logical notran;
    integer jfirst;
    doublereal smlnum;
    logical nounit;










































    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --x;
    --cnorm;

    *info = 0;
    upper = lsame_(uplo, "U");
    notran = lsame_(trans, "N");
    nounit = lsame_(diag, "N");


    if (! upper && ! lsame_(uplo, "L")) {
	*info = -1;
    } else if (! notran && ! lsame_(trans, "T") && ! 
	    lsame_(trans, "C")) {
	*info = -2;
    } else if (! nounit && ! lsame_(diag, "U")) {
	*info = -3;
    } else if (! lsame_(normin, "Y") && ! lsame_(normin, 
	     "N")) {
	*info = -4;
    } else if (*n < 0) {
	*info = -5;
    } else if (*lda < max(1,*n)) {
	*info = -7;
    }
    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "ZLATRS", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


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


    smlnum = dlamch_("Safe minimum");
    bignum = 1. / smlnum;
    if (dlabad_(interp, &smlnum, &bignum)!=TCL_OK) { return TCL_ERROR; }

    smlnum /= dlamch_("Precision");
    bignum = 1. / smlnum;
    *scale = 1.;

    if (lsame_(normin, "N")) {


	if (upper) {


	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = j - 1;
		cnorm[j] = dzasum_(&i__2, &a[j * a_dim1 + 1], &zlatrs_c__1);
	    }
	} else {


	    i__1 = *n - 1;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = *n - j;
		cnorm[j] = dzasum_(&i__2, &a[j + 1 + j * a_dim1], &zlatrs_c__1);
	    }
	    cnorm[*n] = 0.;
	}
    }


    imax = idamax_(n, &cnorm[1], &zlatrs_c__1);
    tmax = cnorm[imax];
    if (tmax <= bignum * .5) {
	tscal = 1.;
    } else {
	tscal = .5 / (smlnum * tmax);
	if (dscal_(interp, n, &tscal, &cnorm[1], &zlatrs_c__1)!=TCL_OK) { return TCL_ERROR; }

    }


    xmax = 0.;
    i__1 = *n;
    for (j = 1; j <= i__1; ++j) {
	i__2 = j;
	d__3 = xmax, d__4 = (d__1 = x[i__2].r / 2., abs(d__1)) + (d__2 = 
		d_imag(&x[j]) / 2., abs(d__2));
	xmax = max(d__3,d__4);
    }
    xbnd = xmax;

    if (notran) {


	if (upper) {
	    jfirst = *n;
	    jlast = 1;
	    jinc = -1;
	} else {
	    jfirst = 1;
	    jlast = *n;
	    jinc = 1;
	}

	if (tscal != 1.) {
	    grow = 0.;
	    goto L60;
	}

	if (nounit) {



	    grow = .5 / max(xbnd,smlnum);
	    xbnd = grow;
	    i__1 = jlast;
	    i__2 = jinc;
	    for (j = jfirst; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) {


		if (grow <= smlnum) {
		    goto L60;
		}

		i__3 = j + j * a_dim1;
		tjjs.r = a[i__3].r, tjjs.i = a[i__3].i;
		tjj = (d__1 = tjjs.r, abs(d__1)) + (d__2 = d_imag(&tjjs), abs(
			d__2));

		if (tjj >= smlnum) {


		    d__1 = xbnd, d__2 = min(1.,tjj) * grow;
		    xbnd = min(d__1,d__2);
		} else {


		    xbnd = 0.;
		}

		if (tjj + cnorm[j] >= smlnum) {


		    grow *= tjj / (tjj + cnorm[j]);
		} else {


		    grow = 0.;
		}
	    }
	    grow = xbnd;
	} else {



	    d__1 = 1., d__2 = .5 / max(xbnd,smlnum);
	    grow = min(d__1,d__2);
	    i__2 = jlast;
	    i__1 = jinc;
	    for (j = jfirst; i__1 < 0 ? j >= i__2 : j <= i__2; j += i__1) {


		if (grow <= smlnum) {
		    goto L60;
		}


		grow *= 1. / (cnorm[j] + 1.);
	    }
	}
L60:

	;
    } else {


	if (upper) {
	    jfirst = 1;
	    jlast = *n;
	    jinc = 1;
	} else {
	    jfirst = *n;
	    jlast = 1;
	    jinc = -1;
	}

	if (tscal != 1.) {
	    grow = 0.;
	    goto L90;
	}

	if (nounit) {



	    grow = .5 / max(xbnd,smlnum);
	    xbnd = grow;
	    i__1 = jlast;
	    i__2 = jinc;
	    for (j = jfirst; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) {


		if (grow <= smlnum) {
		    goto L90;
		}


		xj = cnorm[j] + 1.;
		d__1 = grow, d__2 = xbnd / xj;
		grow = min(d__1,d__2);

		i__3 = j + j * a_dim1;
		tjjs.r = a[i__3].r, tjjs.i = a[i__3].i;
		tjj = (d__1 = tjjs.r, abs(d__1)) + (d__2 = d_imag(&tjjs), abs(
			d__2));

		if (tjj >= smlnum) {


		    if (xj > tjj) {
			xbnd *= tjj / xj;
		    }
		} else {


		    xbnd = 0.;
		}
	    }
	    grow = min(grow,xbnd);
	} else {



	    d__1 = 1., d__2 = .5 / max(xbnd,smlnum);
	    grow = min(d__1,d__2);
	    i__2 = jlast;
	    i__1 = jinc;
	    for (j = jfirst; i__1 < 0 ? j >= i__2 : j <= i__2; j += i__1) {


		if (grow <= smlnum) {
		    goto L90;
		}


		xj = cnorm[j] + 1.;
		grow /= xj;
	    }
	}
L90:
	;
    }

    if (grow * tscal > smlnum) {


	if (ztrsv_(interp, uplo, trans, diag, n, &a[a_offset], lda, &x[1], &zlatrs_c__1)!=TCL_OK) { return TCL_ERROR; }

    } else {


	if (xmax > bignum * .5) {


	    *scale = bignum * .5 / xmax;
	    if (zdscal_(interp, n, scale, &x[1], &zlatrs_c__1)!=TCL_OK) { return TCL_ERROR; }

	    xmax = bignum;
	} else {
	    xmax *= 2.;
	}

	if (notran) {


	    i__1 = jlast;
	    i__2 = jinc;
	    for (j = jfirst; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) {


		i__3 = j;
		xj = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = d_imag(&x[j]), 
			abs(d__2));
		if (nounit) {
		    i__3 = j + j * a_dim1;
		    z__1.r = tscal * a[i__3].r, z__1.i = tscal * a[i__3].i;
		    tjjs.r = z__1.r, tjjs.i = z__1.i;
		} else {
		    tjjs.r = tscal, tjjs.i = 0.;
		    if (tscal == 1.) {
			goto L110;
		    }
		}
		tjj = (d__1 = tjjs.r, abs(d__1)) + (d__2 = d_imag(&tjjs), abs(
			d__2));
		if (tjj > smlnum) {


		    if (tjj < 1.) {
			if (xj > tjj * bignum) {


			    rec = 1. / xj;
			    if (zdscal_(interp, n, &rec, &x[1], &zlatrs_c__1)!=TCL_OK) { return TCL_ERROR; }

			    *scale *= rec;
			    xmax *= rec;
			}
		    }
		    i__3 = j;
		    zladiv_(&z__1, &x[j], &tjjs);
		    x[i__3].r = z__1.r, x[i__3].i = z__1.i;
		    i__3 = j;
		    xj = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = d_imag(&x[j])
			    , abs(d__2));
		} else if (tjj > 0.) {


		    if (xj > tjj * bignum) {


			rec = tjj * bignum / xj;
			if (cnorm[j] > 1.) {


			    rec /= cnorm[j];
			}
			if (zdscal_(interp, n, &rec, &x[1], &zlatrs_c__1)!=TCL_OK) { return TCL_ERROR; }

			*scale *= rec;
			xmax *= rec;
		    }
		    i__3 = j;
		    zladiv_(&z__1, &x[j], &tjjs);
		    x[i__3].r = z__1.r, x[i__3].i = z__1.i;
		    i__3 = j;
		    xj = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = d_imag(&x[j])
			    , abs(d__2));
		} else {


		    i__3 = *n;
		    for (i__ = 1; i__ <= i__3; ++i__) {
			i__4 = i__;
			x[i__4].r = 0., x[i__4].i = 0.;
		    }
		    i__3 = j;
		    x[i__3].r = 1., x[i__3].i = 0.;
		    xj = 1.;
		    *scale = 0.;
		    xmax = 0.;
		}
L110:


		if (xj > 1.) {
		    rec = 1. / xj;
		    if (cnorm[j] > (bignum - xmax) * rec) {


			rec *= .5;
			if (zdscal_(interp, n, &rec, &x[1], &zlatrs_c__1)!=TCL_OK) { return TCL_ERROR; }

			*scale *= rec;
		    }
		} else if (xj * cnorm[j] > bignum - xmax) {


		    if (zdscal_(interp, n, &zlatrs_c_b36, &x[1], &zlatrs_c__1)!=TCL_OK) { return TCL_ERROR; }

		    *scale *= .5;
		}

		if (upper) {
		    if (j > 1) {


			i__3 = j - 1;
			i__4 = j;
			z__2.r = -x[i__4].r, z__2.i = -x[i__4].i;
			z__1.r = tscal * z__2.r, z__1.i = tscal * z__2.i;
			if (zaxpy_(interp, &i__3, &z__1, &a[j * a_dim1 + 1], &zlatrs_c__1, &x[1], 				 &zlatrs_c__1)!=TCL_OK) { return TCL_ERROR; }


			i__3 = j - 1;
			i__ = izamax_(&i__3, &x[1], &zlatrs_c__1);
			i__3 = i__;
			xmax = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = d_imag(
				&x[i__]), abs(d__2));
		    }
		} else {
		    if (j < *n) {


			i__3 = *n - j;
			i__4 = j;
			z__2.r = -x[i__4].r, z__2.i = -x[i__4].i;
			z__1.r = tscal * z__2.r, z__1.i = tscal * z__2.i;
			if (zaxpy_(interp, &i__3, &z__1, &a[j + 1 + j * a_dim1], &zlatrs_c__1, &				x[j + 1], &zlatrs_c__1)!=TCL_OK) { return TCL_ERROR; }


			i__3 = *n - j;
			i__ = j + izamax_(&i__3, &x[j + 1], &zlatrs_c__1);
			i__3 = i__;
			xmax = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = d_imag(
				&x[i__]), abs(d__2));
		    }
		}
	    }

	} else if (lsame_(trans, "T")) {


	    i__2 = jlast;
	    i__1 = jinc;
	    for (j = jfirst; i__1 < 0 ? j >= i__2 : j <= i__2; j += i__1) {


		i__3 = j;
		xj = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = d_imag(&x[j]), 
			abs(d__2));
		uscal.r = tscal, uscal.i = 0.;
		rec = 1. / max(xmax,1.);
		if (cnorm[j] > (bignum - xj) * rec) {


		    rec *= .5;
		    if (nounit) {
			i__3 = j + j * a_dim1;
			z__1.r = tscal * a[i__3].r, z__1.i = tscal * a[i__3]
				.i;
			tjjs.r = z__1.r, tjjs.i = z__1.i;
		    } else {
			tjjs.r = tscal, tjjs.i = 0.;
		    }
		    tjj = (d__1 = tjjs.r, abs(d__1)) + (d__2 = d_imag(&tjjs), 
			    abs(d__2));
		    if (tjj > 1.) {


			d__1 = 1., d__2 = rec * tjj;
			rec = min(d__1,d__2);
			zladiv_(&z__1, &uscal, &tjjs);
			uscal.r = z__1.r, uscal.i = z__1.i;
		    }
		    if (rec < 1.) {
			if (zdscal_(interp, n, &rec, &x[1], &zlatrs_c__1)!=TCL_OK) { return TCL_ERROR; }

			*scale *= rec;
			xmax *= rec;
		    }
		}

		csumj.r = 0., csumj.i = 0.;
		if (uscal.r == 1. && uscal.i == 0.) {


		    if (upper) {
			i__3 = j - 1;
			zdotu_(&z__1, &i__3, &a[j * a_dim1 + 1], &zlatrs_c__1, &x[1], 
				 &zlatrs_c__1);
			csumj.r = z__1.r, csumj.i = z__1.i;
		    } else if (j < *n) {
			i__3 = *n - j;
			zdotu_(&z__1, &i__3, &a[j + 1 + j * a_dim1], &zlatrs_c__1, &
				x[j + 1], &zlatrs_c__1);
			csumj.r = z__1.r, csumj.i = z__1.i;
		    }
		} else {


		    if (upper) {
			i__3 = j - 1;
			for (i__ = 1; i__ <= i__3; ++i__) {
			    i__4 = i__ + j * a_dim1;
			    z__3.r = a[i__4].r * uscal.r - a[i__4].i * 
				    uscal.i, z__3.i = a[i__4].r * uscal.i + a[
				    i__4].i * uscal.r;
			    i__5 = i__;
			    z__2.r = z__3.r * x[i__5].r - z__3.i * x[i__5].i, 
				    z__2.i = z__3.r * x[i__5].i + z__3.i * x[
				    i__5].r;
			    z__1.r = csumj.r + z__2.r, z__1.i = csumj.i + 
				    z__2.i;
			    csumj.r = z__1.r, csumj.i = z__1.i;
			}
		    } else if (j < *n) {
			i__3 = *n;
			for (i__ = j + 1; i__ <= i__3; ++i__) {
			    i__4 = i__ + j * a_dim1;
			    z__3.r = a[i__4].r * uscal.r - a[i__4].i * 
				    uscal.i, z__3.i = a[i__4].r * uscal.i + a[
				    i__4].i * uscal.r;
			    i__5 = i__;
			    z__2.r = z__3.r * x[i__5].r - z__3.i * x[i__5].i, 
				    z__2.i = z__3.r * x[i__5].i + z__3.i * x[
				    i__5].r;
			    z__1.r = csumj.r + z__2.r, z__1.i = csumj.i + 
				    z__2.i;
			    csumj.r = z__1.r, csumj.i = z__1.i;
			}
		    }
		}

		z__1.r = tscal, z__1.i = 0.;
		if (uscal.r == z__1.r && uscal.i == z__1.i) {


		    i__3 = j;
		    i__4 = j;
		    z__1.r = x[i__4].r - csumj.r, z__1.i = x[i__4].i - 
			    csumj.i;
		    x[i__3].r = z__1.r, x[i__3].i = z__1.i;
		    i__3 = j;
		    xj = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = d_imag(&x[j])
			    , abs(d__2));
		    if (nounit) {
			i__3 = j + j * a_dim1;
			z__1.r = tscal * a[i__3].r, z__1.i = tscal * a[i__3]
				.i;
			tjjs.r = z__1.r, tjjs.i = z__1.i;
		    } else {
			tjjs.r = tscal, tjjs.i = 0.;
			if (tscal == 1.) {
			    goto L160;
			}
		    }


		    tjj = (d__1 = tjjs.r, abs(d__1)) + (d__2 = d_imag(&tjjs), 
			    abs(d__2));
		    if (tjj > smlnum) {


			if (tjj < 1.) {
			    if (xj > tjj * bignum) {


				rec = 1. / xj;
				if (zdscal_(interp, n, &rec, &x[1], &zlatrs_c__1)!=TCL_OK) { return TCL_ERROR; }

				*scale *= rec;
				xmax *= rec;
			    }
			}
			i__3 = j;
			zladiv_(&z__1, &x[j], &tjjs);
			x[i__3].r = z__1.r, x[i__3].i = z__1.i;
		    } else if (tjj > 0.) {


			if (xj > tjj * bignum) {


			    rec = tjj * bignum / xj;
			    if (zdscal_(interp, n, &rec, &x[1], &zlatrs_c__1)!=TCL_OK) { return TCL_ERROR; }

			    *scale *= rec;
			    xmax *= rec;
			}
			i__3 = j;
			zladiv_(&z__1, &x[j], &tjjs);
			x[i__3].r = z__1.r, x[i__3].i = z__1.i;
		    } else {


			i__3 = *n;
			for (i__ = 1; i__ <= i__3; ++i__) {
			    i__4 = i__;
			    x[i__4].r = 0., x[i__4].i = 0.;
			}
			i__3 = j;
			x[i__3].r = 1., x[i__3].i = 0.;
			*scale = 0.;
			xmax = 0.;
		    }
L160:
		    ;
		} else {


		    i__3 = j;
		    zladiv_(&z__2, &x[j], &tjjs);
		    z__1.r = z__2.r - csumj.r, z__1.i = z__2.i - csumj.i;
		    x[i__3].r = z__1.r, x[i__3].i = z__1.i;
		}
		i__3 = j;
		d__3 = xmax, d__4 = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = 
			d_imag(&x[j]), abs(d__2));
		xmax = max(d__3,d__4);
	    }

	} else {


	    i__1 = jlast;
	    i__2 = jinc;
	    for (j = jfirst; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) {


		i__3 = j;
		xj = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = d_imag(&x[j]), 
			abs(d__2));
		uscal.r = tscal, uscal.i = 0.;
		rec = 1. / max(xmax,1.);
		if (cnorm[j] > (bignum - xj) * rec) {


		    rec *= .5;
		    if (nounit) {
			d_cnjg(&z__2, &a[j + j * a_dim1]);
			z__1.r = tscal * z__2.r, z__1.i = tscal * z__2.i;
			tjjs.r = z__1.r, tjjs.i = z__1.i;
		    } else {
			tjjs.r = tscal, tjjs.i = 0.;
		    }
		    tjj = (d__1 = tjjs.r, abs(d__1)) + (d__2 = d_imag(&tjjs), 
			    abs(d__2));
		    if (tjj > 1.) {


			d__1 = 1., d__2 = rec * tjj;
			rec = min(d__1,d__2);
			zladiv_(&z__1, &uscal, &tjjs);
			uscal.r = z__1.r, uscal.i = z__1.i;
		    }
		    if (rec < 1.) {
			if (zdscal_(interp, n, &rec, &x[1], &zlatrs_c__1)!=TCL_OK) { return TCL_ERROR; }

			*scale *= rec;
			xmax *= rec;
		    }
		}

		csumj.r = 0., csumj.i = 0.;
		if (uscal.r == 1. && uscal.i == 0.) {


		    if (upper) {
			i__3 = j - 1;
			zdotc_(&z__1, &i__3, &a[j * a_dim1 + 1], &zlatrs_c__1, &x[1], 
				 &zlatrs_c__1);
			csumj.r = z__1.r, csumj.i = z__1.i;
		    } else if (j < *n) {
			i__3 = *n - j;
			zdotc_(&z__1, &i__3, &a[j + 1 + j * a_dim1], &zlatrs_c__1, &
				x[j + 1], &zlatrs_c__1);
			csumj.r = z__1.r, csumj.i = z__1.i;
		    }
		} else {


		    if (upper) {
			i__3 = j - 1;
			for (i__ = 1; i__ <= i__3; ++i__) {
			    d_cnjg(&z__4, &a[i__ + j * a_dim1]);
			    z__3.r = z__4.r * uscal.r - z__4.i * uscal.i, 
				    z__3.i = z__4.r * uscal.i + z__4.i * 
				    uscal.r;
			    i__4 = i__;
			    z__2.r = z__3.r * x[i__4].r - z__3.i * x[i__4].i, 
				    z__2.i = z__3.r * x[i__4].i + z__3.i * x[
				    i__4].r;
			    z__1.r = csumj.r + z__2.r, z__1.i = csumj.i + 
				    z__2.i;
			    csumj.r = z__1.r, csumj.i = z__1.i;
			}
		    } else if (j < *n) {
			i__3 = *n;
			for (i__ = j + 1; i__ <= i__3; ++i__) {
			    d_cnjg(&z__4, &a[i__ + j * a_dim1]);
			    z__3.r = z__4.r * uscal.r - z__4.i * uscal.i, 
				    z__3.i = z__4.r * uscal.i + z__4.i * 
				    uscal.r;
			    i__4 = i__;
			    z__2.r = z__3.r * x[i__4].r - z__3.i * x[i__4].i, 
				    z__2.i = z__3.r * x[i__4].i + z__3.i * x[
				    i__4].r;
			    z__1.r = csumj.r + z__2.r, z__1.i = csumj.i + 
				    z__2.i;
			    csumj.r = z__1.r, csumj.i = z__1.i;
			}
		    }
		}

		z__1.r = tscal, z__1.i = 0.;
		if (uscal.r == z__1.r && uscal.i == z__1.i) {


		    i__3 = j;
		    i__4 = j;
		    z__1.r = x[i__4].r - csumj.r, z__1.i = x[i__4].i - 
			    csumj.i;
		    x[i__3].r = z__1.r, x[i__3].i = z__1.i;
		    i__3 = j;
		    xj = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = d_imag(&x[j])
			    , abs(d__2));
		    if (nounit) {
			d_cnjg(&z__2, &a[j + j * a_dim1]);
			z__1.r = tscal * z__2.r, z__1.i = tscal * z__2.i;
			tjjs.r = z__1.r, tjjs.i = z__1.i;
		    } else {
			tjjs.r = tscal, tjjs.i = 0.;
			if (tscal == 1.) {
			    goto L210;
			}
		    }


		    tjj = (d__1 = tjjs.r, abs(d__1)) + (d__2 = d_imag(&tjjs), 
			    abs(d__2));
		    if (tjj > smlnum) {


			if (tjj < 1.) {
			    if (xj > tjj * bignum) {


				rec = 1. / xj;
				if (zdscal_(interp, n, &rec, &x[1], &zlatrs_c__1)!=TCL_OK) { return TCL_ERROR; }

				*scale *= rec;
				xmax *= rec;
			    }
			}
			i__3 = j;
			zladiv_(&z__1, &x[j], &tjjs);
			x[i__3].r = z__1.r, x[i__3].i = z__1.i;
		    } else if (tjj > 0.) {


			if (xj > tjj * bignum) {


			    rec = tjj * bignum / xj;
			    if (zdscal_(interp, n, &rec, &x[1], &zlatrs_c__1)!=TCL_OK) { return TCL_ERROR; }

			    *scale *= rec;
			    xmax *= rec;
			}
			i__3 = j;
			zladiv_(&z__1, &x[j], &tjjs);
			x[i__3].r = z__1.r, x[i__3].i = z__1.i;
		    } else {


			i__3 = *n;
			for (i__ = 1; i__ <= i__3; ++i__) {
			    i__4 = i__;
			    x[i__4].r = 0., x[i__4].i = 0.;
			}
			i__3 = j;
			x[i__3].r = 1., x[i__3].i = 0.;
			*scale = 0.;
			xmax = 0.;
		    }
L210:
		    ;
		} else {


		    i__3 = j;
		    zladiv_(&z__2, &x[j], &tjjs);
		    z__1.r = z__2.r - csumj.r, z__1.i = z__2.i - csumj.i;
		    x[i__3].r = z__1.r, x[i__3].i = z__1.i;
		}
		i__3 = j;
		d__3 = xmax, d__4 = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = 
			d_imag(&x[j]), abs(d__2));
		xmax = max(d__3,d__4);
	    }
	}
	*scale /= tscal;
    }


    if (tscal != 1.) {
	d__1 = 1. / tscal;
	if (dscal_(interp, n, &d__1, &cnorm[1], &zlatrs_c__1)!=TCL_OK) { return TCL_ERROR; }

    }

return TCL_OK;


} /* zlatrs_ */
static /* Subroutine */ int dlas2_ (Tcl_Interp *interp, doublereal *f, doublereal *g, doublereal *h__, 	doublereal *ssmin, doublereal *ssmax)
{
    doublereal d__1, d__2;

    double sqrt(doublereal);

    doublereal c__, fa, ga, ha, as, at, au, fhmn, fhmx;



















    fa = abs(*f);
    ga = abs(*g);
    ha = abs(*h__);
    fhmn = min(fa,ha);
    fhmx = max(fa,ha);
    if (fhmn == 0.) {
	*ssmin = 0.;
	if (fhmx == 0.) {
	    *ssmax = ga;
	} else {
	    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;
	    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.) {


		*ssmin = fhmn * fhmx / ga;
		*ssmax = ga;
	    } else {
		as = fhmn / fhmx + 1.;
		at = (fhmx - fhmn) / fhmx;
		d__1 = as * au;
		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 TCL_OK;


} /* dlas2_ */
static /* Subroutine */ int dlasq1_ (Tcl_Interp *interp, integer *n, doublereal *d__, doublereal *e, 	doublereal *work, integer *info)
{
    integer i__1, i__2;
    doublereal d__1, d__2, d__3;

    double sqrt(doublereal);

    integer i__;
    doublereal eps;
    doublereal scale;
    integer iinfo;
    doublereal sigmn;
    doublereal sigmx;
    doublereal safmin;


















    --work;
    --e;
    --d__;

    *info = 0;
    if (*n < 0) {
	*info = -2;
	i__1 = -(*info);
	vectcl_xerbla(interp, "DLASQ1", &i__1);
return TCL_ERROR;

return TCL_OK;
    } else if (*n == 0) {
return TCL_OK;
    } else if (*n == 1) {
	d__[1] = abs(d__[1]);
return TCL_OK;
    } else if (*n == 2) {
	if (dlas2_(interp, &d__[1], &e[1], &d__[2], &sigmn, &sigmx)!=TCL_OK) { return TCL_ERROR; }

	d__[1] = sigmx;
	d__[2] = sigmn;
return TCL_OK;
    }


    sigmx = 0.;
    i__1 = *n - 1;
    for (i__ = 1; i__ <= i__1; ++i__) {
	d__[i__] = (d__1 = d__[i__], abs(d__1));
	d__2 = sigmx, d__3 = (d__1 = e[i__], abs(d__1));
	sigmx = max(d__2,d__3);
    }
    d__[*n] = (d__1 = d__[*n], abs(d__1));


    if (sigmx == 0.) {
	if (dlasrt_(interp, "D", n, &d__[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }

return TCL_OK;
    }

    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	d__1 = sigmx, d__2 = d__[i__];
	sigmx = max(d__1,d__2);
    }


    eps = dlamch_("Precision");
    safmin = dlamch_("Safe minimum");
    scale = sqrt(eps / safmin);
    if (dcopy_(interp, n, &d__[1], &dlasq1_c__1, &work[1], &dlasq1_c__2)!=TCL_OK) { return TCL_ERROR; }

    i__1 = *n - 1;
    if (dcopy_(interp, &i__1, &e[1], &dlasq1_c__1, &work[2], &dlasq1_c__2)!=TCL_OK) { return TCL_ERROR; }

    i__1 = (*n << 1) - 1;
    i__2 = (*n << 1) - 1;
    if (dlascl_(interp, "G", &dlasq1_c__0, &dlasq1_c__0, &sigmx, &scale, &i__1, &dlasq1_c__1, &work[1], &i__2, 	    &iinfo)!=TCL_OK) { return TCL_ERROR; }




    i__1 = (*n << 1) - 1;
    for (i__ = 1; i__ <= i__1; ++i__) {
	d__1 = work[i__];
	work[i__] = d__1 * d__1;
    }
    work[*n * 2] = 0.;

    if (dlasq2_(interp, n, &work[1], info)!=TCL_OK) { return TCL_ERROR; }


    if (*info == 0) {
	i__1 = *n;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    d__[i__] = sqrt(work[i__]);
	}
	if (dlascl_(interp, "G", &dlasq1_c__0, &dlasq1_c__0, &scale, &sigmx, n, &dlasq1_c__1, &d__[1], n, &		iinfo)!=TCL_OK) { return TCL_ERROR; }


    }

return TCL_OK;


} /* dlasq1_ */
static /* Subroutine */ int dlasv2_ (Tcl_Interp *interp, doublereal *f, doublereal *g, doublereal *h__, 	doublereal *ssmin, doublereal *ssmax, doublereal *snr, doublereal *	csr, doublereal *snl, doublereal *csl)
{
    doublereal d__1;

    double sqrt(doublereal), d_sign(doublereal *, doublereal *);

    doublereal a, d__, l, m, r__, s, t, fa, ga, ha, ft, gt, ht, mm, tt, clt, 
	    crt, slt, srt;
    integer pmax;
    doublereal temp;
    logical swap;
    doublereal tsign;
    logical gasmal;























    ft = *f;
    fa = abs(ft);
    ht = *h__;
    ha = abs(*h__);


    pmax = 1;
    swap = ha > fa;
    if (swap) {
	pmax = 3;
	temp = ft;
	ft = ht;
	ht = temp;
	temp = fa;
	fa = ha;
	ha = temp;


    }
    gt = *g;
    ga = abs(gt);
    if (ga == 0.) {


	*ssmin = ha;
	*ssmax = fa;
	clt = 1.;
	crt = 1.;
	slt = 0.;
	srt = 0.;
    } else {
	gasmal = TRUE_;
	if (ga > fa) {
	    pmax = 2;
	    if (fa / ga < dlamch_("EPS")) {


		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) {


	    d__ = fa - ha;
	    if (d__ == fa) {


		l = 1.;
	    } else {
		l = d__ / fa;
	    }


	    m = gt / ft;


	    t = 2. - l;


	    mm = m * m;
	    tt = t * t;
	    s = sqrt(tt + mm);


	    if (l == 0.) {
		r__ = abs(m);
	    } else {
		r__ = sqrt(l * l + mm);
	    }


	    a = (s + r__) * .5;


	    *ssmin = ha / a;
	    *ssmax = fa * a;
	    if (mm == 0.) {


		if (l == 0.) {
		    t = d_sign(&dlasv2_c_b3, &ft) * d_sign(&dlasv2_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;
    }


    if (pmax == 1) {
	tsign = d_sign(&dlasv2_c_b4, csr) * d_sign(&dlasv2_c_b4, csl) * d_sign(&dlasv2_c_b4, f);
    }
    if (pmax == 2) {
	tsign = d_sign(&dlasv2_c_b4, snr) * d_sign(&dlasv2_c_b4, csl) * d_sign(&dlasv2_c_b4, g);
    }
    if (pmax == 3) {
	tsign = d_sign(&dlasv2_c_b4, snr) * d_sign(&dlasv2_c_b4, snl) * d_sign(&dlasv2_c_b4, h__);
    }
    *ssmax = d_sign(ssmax, &tsign);
    d__1 = tsign * d_sign(&dlasv2_c_b4, f) * d_sign(&dlasv2_c_b4, h__);
    *ssmin = d_sign(ssmin, &d__1);
return TCL_OK;


} /* dlasv2_ */
static /* Subroutine */ int dorml2_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *	c__, integer *ldc, doublereal *work, integer *info)
{
    integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2;

    integer i__, i1, i2, i3, ic, jc, mi, ni, nq;
    doublereal aii;
    logical left;
    logical notran;





























    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --tau;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;
    --work;

    *info = 0;
    left = lsame_(side, "L");
    notran = lsame_(trans, "N");


    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);
	vectcl_xerbla(interp, "DORML2", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


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

    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) {


	    mi = *m - i__ + 1;
	    ic = i__;
	} else {


	    ni = *n - i__ + 1;
	    jc = i__;
	}


	aii = a[i__ + i__ * a_dim1];
	a[i__ + i__ * a_dim1] = 1.;
	if (dlarf_(interp, side, &mi, &ni, &a[i__ + i__ * a_dim1], lda, &tau[i__], &c__[		ic + jc * c_dim1], ldc, &work[1])!=TCL_OK) { return TCL_ERROR; }


	a[i__ + i__ * a_dim1] = aii;
    }
return TCL_OK;


} /* dorml2_ */
static /* Subroutine */ int dorm2r_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *	c__, integer *ldc, doublereal *work, integer *info)
{
    integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2;

    integer i__, i1, i2, i3, ic, jc, mi, ni, nq;
    doublereal aii;
    logical left;
    logical notran;





























    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --tau;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;
    --work;

    *info = 0;
    left = lsame_(side, "L");
    notran = lsame_(trans, "N");


    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);
	vectcl_xerbla(interp, "DORM2R", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


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

    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) {


	    mi = *m - i__ + 1;
	    ic = i__;
	} else {


	    ni = *n - i__ + 1;
	    jc = i__;
	}


	aii = a[i__ + i__ * a_dim1];
	a[i__ + i__ * a_dim1] = 1.;
	if (dlarf_(interp, side, &mi, &ni, &a[i__ + i__ * a_dim1], &dorm2r_c__1, &tau[i__], &c__[		ic + jc * c_dim1], ldc, &work[1])!=TCL_OK) { return TCL_ERROR; }


	a[i__ + i__ * a_dim1] = aii;
    }
return TCL_OK;


} /* dorm2r_ */
static /* Subroutine */ int zlasr_ (Tcl_Interp *interp, char *side, char *pivot, char *direct, integer *m, 	 integer *n, doublereal *c__, doublereal *s, doublecomplex *a, 	integer *lda)
{
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
    doublecomplex z__1, z__2, z__3;

    integer i__, j, info;
    doublecomplex temp;
    doublereal ctemp, stemp;







































    --c__;
    --s;
    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;

    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) {
	vectcl_xerbla(interp, "ZLASR ", &info);
return TCL_ERROR;

return TCL_OK;
    }


    if (*m == 0 || *n == 0) {
return TCL_OK;
    }
    if (lsame_(side, "L")) {


	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__) {
			    i__3 = j + 1 + i__ * a_dim1;
			    temp.r = a[i__3].r, temp.i = a[i__3].i;
			    i__3 = j + 1 + i__ * a_dim1;
			    z__2.r = ctemp * temp.r, z__2.i = ctemp * temp.i;
			    i__4 = j + i__ * a_dim1;
			    z__3.r = stemp * a[i__4].r, z__3.i = stemp * a[
				    i__4].i;
			    z__1.r = z__2.r - z__3.r, z__1.i = z__2.i - 
				    z__3.i;
			    a[i__3].r = z__1.r, a[i__3].i = z__1.i;
			    i__3 = j + i__ * a_dim1;
			    z__2.r = stemp * temp.r, z__2.i = stemp * temp.i;
			    i__4 = j + i__ * a_dim1;
			    z__3.r = ctemp * a[i__4].r, z__3.i = ctemp * a[
				    i__4].i;
			    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + 
				    z__3.i;
			    a[i__3].r = z__1.r, a[i__3].i = z__1.i;
			}
		    }
		}
	    } 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__) {
			    i__2 = j + 1 + i__ * a_dim1;
			    temp.r = a[i__2].r, temp.i = a[i__2].i;
			    i__2 = j + 1 + i__ * a_dim1;
			    z__2.r = ctemp * temp.r, z__2.i = ctemp * temp.i;
			    i__3 = j + i__ * a_dim1;
			    z__3.r = stemp * a[i__3].r, z__3.i = stemp * a[
				    i__3].i;
			    z__1.r = z__2.r - z__3.r, z__1.i = z__2.i - 
				    z__3.i;
			    a[i__2].r = z__1.r, a[i__2].i = z__1.i;
			    i__2 = j + i__ * a_dim1;
			    z__2.r = stemp * temp.r, z__2.i = stemp * temp.i;
			    i__3 = j + i__ * a_dim1;
			    z__3.r = ctemp * a[i__3].r, z__3.i = ctemp * a[
				    i__3].i;
			    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + 
				    z__3.i;
			    a[i__2].r = z__1.r, a[i__2].i = z__1.i;
			}
		    }
		}
	    }
	} 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__) {
			    i__3 = j + i__ * a_dim1;
			    temp.r = a[i__3].r, temp.i = a[i__3].i;
			    i__3 = j + i__ * a_dim1;
			    z__2.r = ctemp * temp.r, z__2.i = ctemp * temp.i;
			    i__4 = i__ * a_dim1 + 1;
			    z__3.r = stemp * a[i__4].r, z__3.i = stemp * a[
				    i__4].i;
			    z__1.r = z__2.r - z__3.r, z__1.i = z__2.i - 
				    z__3.i;
			    a[i__3].r = z__1.r, a[i__3].i = z__1.i;
			    i__3 = i__ * a_dim1 + 1;
			    z__2.r = stemp * temp.r, z__2.i = stemp * temp.i;
			    i__4 = i__ * a_dim1 + 1;
			    z__3.r = ctemp * a[i__4].r, z__3.i = ctemp * a[
				    i__4].i;
			    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + 
				    z__3.i;
			    a[i__3].r = z__1.r, a[i__3].i = z__1.i;
			}
		    }
		}
	    } 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__) {
			    i__2 = j + i__ * a_dim1;
			    temp.r = a[i__2].r, temp.i = a[i__2].i;
			    i__2 = j + i__ * a_dim1;
			    z__2.r = ctemp * temp.r, z__2.i = ctemp * temp.i;
			    i__3 = i__ * a_dim1 + 1;
			    z__3.r = stemp * a[i__3].r, z__3.i = stemp * a[
				    i__3].i;
			    z__1.r = z__2.r - z__3.r, z__1.i = z__2.i - 
				    z__3.i;
			    a[i__2].r = z__1.r, a[i__2].i = z__1.i;
			    i__2 = i__ * a_dim1 + 1;
			    z__2.r = stemp * temp.r, z__2.i = stemp * temp.i;
			    i__3 = i__ * a_dim1 + 1;
			    z__3.r = ctemp * a[i__3].r, z__3.i = ctemp * a[
				    i__3].i;
			    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + 
				    z__3.i;
			    a[i__2].r = z__1.r, a[i__2].i = z__1.i;
			}
		    }
		}
	    }
	} 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__) {
			    i__3 = j + i__ * a_dim1;
			    temp.r = a[i__3].r, temp.i = a[i__3].i;
			    i__3 = j + i__ * a_dim1;
			    i__4 = *m + i__ * a_dim1;
			    z__2.r = stemp * a[i__4].r, z__2.i = stemp * a[
				    i__4].i;
			    z__3.r = ctemp * temp.r, z__3.i = ctemp * temp.i;
			    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + 
				    z__3.i;
			    a[i__3].r = z__1.r, a[i__3].i = z__1.i;
			    i__3 = *m + i__ * a_dim1;
			    i__4 = *m + i__ * a_dim1;
			    z__2.r = ctemp * a[i__4].r, z__2.i = ctemp * a[
				    i__4].i;
			    z__3.r = stemp * temp.r, z__3.i = stemp * temp.i;
			    z__1.r = z__2.r - z__3.r, z__1.i = z__2.i - 
				    z__3.i;
			    a[i__3].r = z__1.r, a[i__3].i = z__1.i;
			}
		    }
		}
	    } 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__) {
			    i__2 = j + i__ * a_dim1;
			    temp.r = a[i__2].r, temp.i = a[i__2].i;
			    i__2 = j + i__ * a_dim1;
			    i__3 = *m + i__ * a_dim1;
			    z__2.r = stemp * a[i__3].r, z__2.i = stemp * a[
				    i__3].i;
			    z__3.r = ctemp * temp.r, z__3.i = ctemp * temp.i;
			    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + 
				    z__3.i;
			    a[i__2].r = z__1.r, a[i__2].i = z__1.i;
			    i__2 = *m + i__ * a_dim1;
			    i__3 = *m + i__ * a_dim1;
			    z__2.r = ctemp * a[i__3].r, z__2.i = ctemp * a[
				    i__3].i;
			    z__3.r = stemp * temp.r, z__3.i = stemp * temp.i;
			    z__1.r = z__2.r - z__3.r, z__1.i = z__2.i - 
				    z__3.i;
			    a[i__2].r = z__1.r, a[i__2].i = z__1.i;
			}
		    }
		}
	    }
	}
    } else if (lsame_(side, "R")) {


	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__) {
			    i__3 = i__ + (j + 1) * a_dim1;
			    temp.r = a[i__3].r, temp.i = a[i__3].i;
			    i__3 = i__ + (j + 1) * a_dim1;
			    z__2.r = ctemp * temp.r, z__2.i = ctemp * temp.i;
			    i__4 = i__ + j * a_dim1;
			    z__3.r = stemp * a[i__4].r, z__3.i = stemp * a[
				    i__4].i;
			    z__1.r = z__2.r - z__3.r, z__1.i = z__2.i - 
				    z__3.i;
			    a[i__3].r = z__1.r, a[i__3].i = z__1.i;
			    i__3 = i__ + j * a_dim1;
			    z__2.r = stemp * temp.r, z__2.i = stemp * temp.i;
			    i__4 = i__ + j * a_dim1;
			    z__3.r = ctemp * a[i__4].r, z__3.i = ctemp * a[
				    i__4].i;
			    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + 
				    z__3.i;
			    a[i__3].r = z__1.r, a[i__3].i = z__1.i;
			}
		    }
		}
	    } 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__) {
			    i__2 = i__ + (j + 1) * a_dim1;
			    temp.r = a[i__2].r, temp.i = a[i__2].i;
			    i__2 = i__ + (j + 1) * a_dim1;
			    z__2.r = ctemp * temp.r, z__2.i = ctemp * temp.i;
			    i__3 = i__ + j * a_dim1;
			    z__3.r = stemp * a[i__3].r, z__3.i = stemp * a[
				    i__3].i;
			    z__1.r = z__2.r - z__3.r, z__1.i = z__2.i - 
				    z__3.i;
			    a[i__2].r = z__1.r, a[i__2].i = z__1.i;
			    i__2 = i__ + j * a_dim1;
			    z__2.r = stemp * temp.r, z__2.i = stemp * temp.i;
			    i__3 = i__ + j * a_dim1;
			    z__3.r = ctemp * a[i__3].r, z__3.i = ctemp * a[
				    i__3].i;
			    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + 
				    z__3.i;
			    a[i__2].r = z__1.r, a[i__2].i = z__1.i;
			}
		    }
		}
	    }
	} 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__) {
			    i__3 = i__ + j * a_dim1;
			    temp.r = a[i__3].r, temp.i = a[i__3].i;
			    i__3 = i__ + j * a_dim1;
			    z__2.r = ctemp * temp.r, z__2.i = ctemp * temp.i;
			    i__4 = i__ + a_dim1;
			    z__3.r = stemp * a[i__4].r, z__3.i = stemp * a[
				    i__4].i;
			    z__1.r = z__2.r - z__3.r, z__1.i = z__2.i - 
				    z__3.i;
			    a[i__3].r = z__1.r, a[i__3].i = z__1.i;
			    i__3 = i__ + a_dim1;
			    z__2.r = stemp * temp.r, z__2.i = stemp * temp.i;
			    i__4 = i__ + a_dim1;
			    z__3.r = ctemp * a[i__4].r, z__3.i = ctemp * a[
				    i__4].i;
			    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + 
				    z__3.i;
			    a[i__3].r = z__1.r, a[i__3].i = z__1.i;
			}
		    }
		}
	    } 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__) {
			    i__2 = i__ + j * a_dim1;
			    temp.r = a[i__2].r, temp.i = a[i__2].i;
			    i__2 = i__ + j * a_dim1;
			    z__2.r = ctemp * temp.r, z__2.i = ctemp * temp.i;
			    i__3 = i__ + a_dim1;
			    z__3.r = stemp * a[i__3].r, z__3.i = stemp * a[
				    i__3].i;
			    z__1.r = z__2.r - z__3.r, z__1.i = z__2.i - 
				    z__3.i;
			    a[i__2].r = z__1.r, a[i__2].i = z__1.i;
			    i__2 = i__ + a_dim1;
			    z__2.r = stemp * temp.r, z__2.i = stemp * temp.i;
			    i__3 = i__ + a_dim1;
			    z__3.r = ctemp * a[i__3].r, z__3.i = ctemp * a[
				    i__3].i;
			    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + 
				    z__3.i;
			    a[i__2].r = z__1.r, a[i__2].i = z__1.i;
			}
		    }
		}
	    }
	} 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__) {
			    i__3 = i__ + j * a_dim1;
			    temp.r = a[i__3].r, temp.i = a[i__3].i;
			    i__3 = i__ + j * a_dim1;
			    i__4 = i__ + *n * a_dim1;
			    z__2.r = stemp * a[i__4].r, z__2.i = stemp * a[
				    i__4].i;
			    z__3.r = ctemp * temp.r, z__3.i = ctemp * temp.i;
			    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + 
				    z__3.i;
			    a[i__3].r = z__1.r, a[i__3].i = z__1.i;
			    i__3 = i__ + *n * a_dim1;
			    i__4 = i__ + *n * a_dim1;
			    z__2.r = ctemp * a[i__4].r, z__2.i = ctemp * a[
				    i__4].i;
			    z__3.r = stemp * temp.r, z__3.i = stemp * temp.i;
			    z__1.r = z__2.r - z__3.r, z__1.i = z__2.i - 
				    z__3.i;
			    a[i__3].r = z__1.r, a[i__3].i = z__1.i;
			}
		    }
		}
	    } 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__) {
			    i__2 = i__ + j * a_dim1;
			    temp.r = a[i__2].r, temp.i = a[i__2].i;
			    i__2 = i__ + j * a_dim1;
			    i__3 = i__ + *n * a_dim1;
			    z__2.r = stemp * a[i__3].r, z__2.i = stemp * a[
				    i__3].i;
			    z__3.r = ctemp * temp.r, z__3.i = ctemp * temp.i;
			    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + 
				    z__3.i;
			    a[i__2].r = z__1.r, a[i__2].i = z__1.i;
			    i__2 = i__ + *n * a_dim1;
			    i__3 = i__ + *n * a_dim1;
			    z__2.r = ctemp * a[i__3].r, z__2.i = ctemp * a[
				    i__3].i;
			    z__3.r = stemp * temp.r, z__3.i = stemp * temp.i;
			    z__1.r = z__2.r - z__3.r, z__1.i = z__2.i - 
				    z__3.i;
			    a[i__2].r = z__1.r, a[i__2].i = z__1.i;
			}
		    }
		}
	    }
	}
    }

return TCL_OK;


} /* zlasr_ */
static /* Subroutine */ int zdrot_ (Tcl_Interp *interp, integer *n, doublecomplex *cx, integer *incx, 	doublecomplex *cy, integer *incy, doublereal *c__, doublereal *s)
{
    integer i__1, i__2, i__3, i__4;
    doublecomplex z__1, z__2, z__3;

    integer i__, ix, iy;
    doublecomplex ctemp;















    --cy;
    --cx;

    if (*n <= 0) {
return TCL_OK;
    }
    if (*incx == 1 && *incy == 1) {
	goto L20;
    }


    ix = 1;
    iy = 1;
    if (*incx < 0) {
	ix = (-(*n) + 1) * *incx + 1;
    }
    if (*incy < 0) {
	iy = (-(*n) + 1) * *incy + 1;
    }
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	i__2 = ix;
	z__2.r = *c__ * cx[i__2].r, z__2.i = *c__ * cx[i__2].i;
	i__3 = iy;
	z__3.r = *s * cy[i__3].r, z__3.i = *s * cy[i__3].i;
	z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
	ctemp.r = z__1.r, ctemp.i = z__1.i;
	i__2 = iy;
	i__3 = iy;
	z__2.r = *c__ * cy[i__3].r, z__2.i = *c__ * cy[i__3].i;
	i__4 = ix;
	z__3.r = *s * cx[i__4].r, z__3.i = *s * cx[i__4].i;
	z__1.r = z__2.r - z__3.r, z__1.i = z__2.i - z__3.i;
	cy[i__2].r = z__1.r, cy[i__2].i = z__1.i;
	i__2 = ix;
	cx[i__2].r = ctemp.r, cx[i__2].i = ctemp.i;
	ix += *incx;
	iy += *incy;
    }
return TCL_OK;


L20:
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	i__2 = i__;
	z__2.r = *c__ * cx[i__2].r, z__2.i = *c__ * cx[i__2].i;
	i__3 = i__;
	z__3.r = *s * cy[i__3].r, z__3.i = *s * cy[i__3].i;
	z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
	ctemp.r = z__1.r, ctemp.i = z__1.i;
	i__2 = i__;
	i__3 = i__;
	z__2.r = *c__ * cy[i__3].r, z__2.i = *c__ * cy[i__3].i;
	i__4 = i__;
	z__3.r = *s * cx[i__4].r, z__3.i = *s * cx[i__4].i;
	z__1.r = z__2.r - z__3.r, z__1.i = z__2.i - z__3.i;
	cy[i__2].r = z__1.r, cy[i__2].i = z__1.i;
	i__2 = i__;
	cx[i__2].r = ctemp.r, cx[i__2].i = ctemp.i;
    }
return TCL_OK;
} /* zdrot_ */
static /* Subroutine */ int zunml2_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *k, doublecomplex *a, integer *lda, doublecomplex *tau, 	doublecomplex *c__, integer *ldc, doublecomplex *work, integer *info)
{
    integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3;
    doublecomplex z__1;

    void d_cnjg(doublecomplex *, doublecomplex *);

    integer i__, i1, i2, i3, ic, jc, mi, ni, nq;
    doublecomplex aii;
    logical left;
    doublecomplex taui;
    logical notran;





























    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --tau;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;
    --work;

    *info = 0;
    left = lsame_(side, "L");
    notran = lsame_(trans, "N");


    if (left) {
	nq = *m;
    } else {
	nq = *n;
    }
    if (! left && ! lsame_(side, "R")) {
	*info = -1;
    } else if (! notran && ! lsame_(trans, "C")) {
	*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);
	vectcl_xerbla(interp, "ZUNML2", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


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

    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) {


	    mi = *m - i__ + 1;
	    ic = i__;
	} else {


	    ni = *n - i__ + 1;
	    jc = i__;
	}


	if (notran) {
	    d_cnjg(&z__1, &tau[i__]);
	    taui.r = z__1.r, taui.i = z__1.i;
	} else {
	    i__3 = i__;
	    taui.r = tau[i__3].r, taui.i = tau[i__3].i;
	}
	if (i__ < nq) {
	    i__3 = nq - i__;
	    if (zlacgv_(interp, &i__3, &a[i__ + (i__ + 1) * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }

	}
	i__3 = i__ + i__ * a_dim1;
	aii.r = a[i__3].r, aii.i = a[i__3].i;
	i__3 = i__ + i__ * a_dim1;
	a[i__3].r = 1., a[i__3].i = 0.;
	if (zlarf_(interp, side, &mi, &ni, &a[i__ + i__ * a_dim1], lda, &taui, &c__[ic + 		jc * c_dim1], ldc, &work[1])!=TCL_OK) { return TCL_ERROR; }


	i__3 = i__ + i__ * a_dim1;
	a[i__3].r = aii.r, a[i__3].i = aii.i;
	if (i__ < nq) {
	    i__3 = nq - i__;
	    if (zlacgv_(interp, &i__3, &a[i__ + (i__ + 1) * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }

	}
    }
return TCL_OK;


} /* zunml2_ */
static /* Subroutine */ int zunm2r_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *k, doublecomplex *a, integer *lda, doublecomplex *tau, 	doublecomplex *c__, integer *ldc, doublecomplex *work, integer *info)
{
    integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3;
    doublecomplex z__1;

    void d_cnjg(doublecomplex *, doublecomplex *);

    integer i__, i1, i2, i3, ic, jc, mi, ni, nq;
    doublecomplex aii;
    logical left;
    doublecomplex taui;
    logical notran;





























    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --tau;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;
    --work;

    *info = 0;
    left = lsame_(side, "L");
    notran = lsame_(trans, "N");


    if (left) {
	nq = *m;
    } else {
	nq = *n;
    }
    if (! left && ! lsame_(side, "R")) {
	*info = -1;
    } else if (! notran && ! lsame_(trans, "C")) {
	*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);
	vectcl_xerbla(interp, "ZUNM2R", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


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

    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) {


	    mi = *m - i__ + 1;
	    ic = i__;
	} else {


	    ni = *n - i__ + 1;
	    jc = i__;
	}


	if (notran) {
	    i__3 = i__;
	    taui.r = tau[i__3].r, taui.i = tau[i__3].i;
	} else {
	    d_cnjg(&z__1, &tau[i__]);
	    taui.r = z__1.r, taui.i = z__1.i;
	}
	i__3 = i__ + i__ * a_dim1;
	aii.r = a[i__3].r, aii.i = a[i__3].i;
	i__3 = i__ + i__ * a_dim1;
	a[i__3].r = 1., a[i__3].i = 0.;
	if (zlarf_(interp, side, &mi, &ni, &a[i__ + i__ * a_dim1], &zunm2r_c__1, &taui, &c__[ic 		+ jc * c_dim1], ldc, &work[1])!=TCL_OK) { return TCL_ERROR; }


	i__3 = i__ + i__ * a_dim1;
	a[i__3].r = aii.r, a[i__3].i = aii.i;
    }
return TCL_OK;


} /* zunm2r_ */
static /* Subroutine */ int dlaqp2_ (Tcl_Interp *interp, integer *m, integer *n, integer *offset, 	doublereal *a, integer *lda, integer *jpvt, doublereal *tau, 	doublereal *vn1, doublereal *vn2, doublereal *work)
{
    integer a_dim1, a_offset, i__1, i__2, i__3;
    doublereal d__1, d__2;

    double sqrt(doublereal);

    integer i__, j, mn;
    doublereal aii;
    integer pvt;
    doublereal temp;
    doublereal temp2, tol3z;
    integer offpi, itemp;





















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

    i__1 = *m - *offset;
    mn = min(i__1,*n);
    tol3z = sqrt(dlamch_("Epsilon"));


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

	offpi = *offset + i__;


	i__2 = *n - i__ + 1;
	pvt = i__ - 1 + idamax_(&i__2, &vn1[i__], &dlaqp2_c__1);

	if (pvt != i__) {
	    if (dswap_(interp, m, &a[pvt * a_dim1 + 1], &dlaqp2_c__1, &a[i__ * a_dim1 + 1], &		    dlaqp2_c__1)!=TCL_OK) { return TCL_ERROR; }


	    itemp = jpvt[pvt];
	    jpvt[pvt] = jpvt[i__];
	    jpvt[i__] = itemp;
	    vn1[pvt] = vn1[i__];
	    vn2[pvt] = vn2[i__];
	}


	if (offpi < *m) {
	    i__2 = *m - offpi + 1;
	    if (dlarfp_(interp, &i__2, &a[offpi + i__ * a_dim1], &a[offpi + 1 + i__ * 		    a_dim1], &dlaqp2_c__1, &tau[i__])!=TCL_OK) { return TCL_ERROR; }


	} else {
	    if (dlarfp_(interp, &dlaqp2_c__1, &a[*m + i__ * a_dim1], &a[*m + i__ * a_dim1], &		    dlaqp2_c__1, &tau[i__])!=TCL_OK) { return TCL_ERROR; }


	}

	if (i__ <= *n) {


	    aii = a[offpi + i__ * a_dim1];
	    a[offpi + i__ * a_dim1] = 1.;
	    i__2 = *m - offpi + 1;
	    i__3 = *n - i__;
	    if (dlarf_(interp, "Left", &i__2, &i__3, &a[offpi + i__ * a_dim1], &dlaqp2_c__1, &		    tau[i__], &a[offpi + (i__ + 1) * a_dim1], lda, &work[1])!=TCL_OK) { return TCL_ERROR; }


	    a[offpi + i__ * a_dim1] = aii;
	}


	i__2 = *n;
	for (j = i__ + 1; j <= i__2; ++j) {
	    if (vn1[j] != 0.) {


		d__2 = (d__1 = a[offpi + j * a_dim1], abs(d__1)) / vn1[j];
		temp = 1. - d__2 * d__2;
		temp = max(temp,0.);
		d__1 = vn1[j] / vn2[j];
		temp2 = temp * (d__1 * d__1);
		if (temp2 <= tol3z) {
		    if (offpi < *m) {
			i__3 = *m - offpi;
			vn1[j] = dnrm2_(&i__3, &a[offpi + 1 + j * a_dim1], &
				dlaqp2_c__1);
			vn2[j] = vn1[j];
		    } else {
			vn1[j] = 0.;
			vn2[j] = 0.;
		    }
		} else {
		    vn1[j] *= sqrt(temp);
		}
	    }
	}

    }

return TCL_OK;


} /* dlaqp2_ */
static /* Subroutine */ int dlaqps_ (Tcl_Interp *interp, integer *m, integer *n, integer *offset, integer 	*nb, integer *kb, doublereal *a, integer *lda, integer *jpvt, 	doublereal *tau, doublereal *vn1, doublereal *vn2, doublereal *auxv, 	doublereal *f, integer *ldf)
{
    integer a_dim1, a_offset, f_dim1, f_offset, i__1, i__2;
    doublereal d__1, d__2;

    double sqrt(doublereal);
    integer i_dnnt(doublereal *);

    integer j, k, rk;
    doublereal akk;
    integer pvt;
    doublereal temp;
    doublereal temp2, tol3z;
    integer itemp;
    integer lsticc, lastrk;



























    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --jpvt;
    --tau;
    --vn1;
    --vn2;
    --auxv;
    f_dim1 = *ldf;
    f_offset = 1 + f_dim1;
    f -= f_offset;

    i__1 = *m, i__2 = *n + *offset;
    lastrk = min(i__1,i__2);
    lsticc = 0;
    k = 0;
    tol3z = sqrt(dlamch_("Epsilon"));


L10:
    if (k < *nb && lsticc == 0) {
	++k;
	rk = *offset + k;


	i__1 = *n - k + 1;
	pvt = k - 1 + idamax_(&i__1, &vn1[k], &dlaqps_c__1);
	if (pvt != k) {
	    if (dswap_(interp, m, &a[pvt * a_dim1 + 1], &dlaqps_c__1, &a[k * a_dim1 + 1], &dlaqps_c__1)!=TCL_OK) { return TCL_ERROR; }

	    i__1 = k - 1;
	    if (dswap_(interp, &i__1, &f[pvt + f_dim1], ldf, &f[k + f_dim1], ldf)!=TCL_OK) { return TCL_ERROR; }

	    itemp = jpvt[pvt];
	    jpvt[pvt] = jpvt[k];
	    jpvt[k] = itemp;
	    vn1[pvt] = vn1[k];
	    vn2[pvt] = vn2[k];
	}


	if (k > 1) {
	    i__1 = *m - rk + 1;
	    i__2 = k - 1;
	    if (dgemv_(interp, "No transpose", &i__1, &i__2, &dlaqps_c_b8, &a[rk + a_dim1], lda, 		    &f[k + f_dim1], ldf, &dlaqps_c_b9, &a[rk + k * a_dim1], &dlaqps_c__1)!=TCL_OK) { return TCL_ERROR; }


	}


	if (rk < *m) {
	    i__1 = *m - rk + 1;
	    if (dlarfp_(interp, &i__1, &a[rk + k * a_dim1], &a[rk + 1 + k * a_dim1], &		    dlaqps_c__1, &tau[k])!=TCL_OK) { return TCL_ERROR; }


	} else {
	    if (dlarfp_(interp, &dlaqps_c__1, &a[rk + k * a_dim1], &a[rk + k * a_dim1], &dlaqps_c__1, &		    tau[k])!=TCL_OK) { return TCL_ERROR; }


	}

	akk = a[rk + k * a_dim1];
	a[rk + k * a_dim1] = 1.;



	if (k < *n) {
	    i__1 = *m - rk + 1;
	    i__2 = *n - k;
	    if (dgemv_(interp, "Transpose", &i__1, &i__2, &tau[k], &a[rk + (k + 1) * 		    a_dim1], lda, &a[rk + k * a_dim1], &dlaqps_c__1, &dlaqps_c_b16, &f[k + 
		    1 + k * f_dim1], &dlaqps_c__1)!=TCL_OK) { return TCL_ERROR; }


	}


	i__1 = k;
	for (j = 1; j <= i__1; ++j) {
	    f[j + k * f_dim1] = 0.;
	}


	if (k > 1) {
	    i__1 = *m - rk + 1;
	    i__2 = k - 1;
	    d__1 = -tau[k];
	    if (dgemv_(interp, "Transpose", &i__1, &i__2, &d__1, &a[rk + a_dim1], lda, &a[		    rk + k * a_dim1], &dlaqps_c__1, &dlaqps_c_b16, &auxv[1], &dlaqps_c__1)!=TCL_OK) { return TCL_ERROR; }



	    i__1 = k - 1;
	    if (dgemv_(interp, "No transpose", n, &i__1, &dlaqps_c_b9, &f[f_dim1 + 1], ldf, &		    auxv[1], &dlaqps_c__1, &dlaqps_c_b9, &f[k * f_dim1 + 1], &dlaqps_c__1)!=TCL_OK) { return TCL_ERROR; }


	}


	if (k < *n) {
	    i__1 = *n - k;
	    if (dgemv_(interp, "No transpose", &i__1, &k, &dlaqps_c_b8, &f[k + 1 + f_dim1], ldf, 		    &a[rk + a_dim1], lda, &dlaqps_c_b9, &a[rk + (k + 1) * a_dim1], 
		    lda)!=TCL_OK) { return TCL_ERROR; }


	}


	if (rk < lastrk) {
	    i__1 = *n;
	    for (j = k + 1; j <= i__1; ++j) {
		if (vn1[j] != 0.) {


		    temp = (d__1 = a[rk + j * a_dim1], abs(d__1)) / vn1[j];
		    d__1 = 0., d__2 = (temp + 1.) * (1. - temp);
		    temp = max(d__1,d__2);
		    d__1 = vn1[j] / vn2[j];
		    temp2 = temp * (d__1 * d__1);
		    if (temp2 <= tol3z) {
			vn2[j] = (doublereal) lsticc;
			lsticc = j;
		    } else {
			vn1[j] *= sqrt(temp);
		    }
		}
	    }
	}

	a[rk + k * a_dim1] = akk;


	goto L10;
    }
    *kb = k;
    rk = *offset + *kb;


    i__1 = *n, i__2 = *m - *offset;
    if (*kb < min(i__1,i__2)) {
	i__1 = *m - rk;
	i__2 = *n - *kb;
	if (dgemm_(interp, "No transpose", "Transpose", &i__1, &i__2, kb, &dlaqps_c_b8, &a[rk + 		1 + a_dim1], lda, &f[*kb + 1 + f_dim1], ldf, &dlaqps_c_b9, &a[rk + 1 
		+ (*kb + 1) * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }


    }


L40:
    if (lsticc > 0) {
	itemp = i_dnnt(&vn2[lsticc]);
	i__1 = *m - rk;
	vn1[lsticc] = dnrm2_(&i__1, &a[rk + 1 + lsticc * a_dim1], &dlaqps_c__1);


	vn2[lsticc] = vn1[lsticc];
	lsticc = itemp;
	goto L40;
    }

return TCL_OK;


} /* dlaqps_ */
static /* Subroutine */ int dormr3_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *k, integer *l, doublereal *a, integer *lda, doublereal *tau, 	doublereal *c__, integer *ldc, doublereal *work, integer *info)
{
    integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2;

    integer i__, i1, i2, i3, ja, ic, jc, mi, ni, nq;
    logical left;
    logical notran;
































    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --tau;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;
    --work;

    *info = 0;
    left = lsame_(side, "L");
    notran = lsame_(trans, "N");


    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 (*l < 0 || left && *l > *m || ! left && *l > *n) {
	*info = -6;
    } else if (*lda < max(1,*k)) {
	*info = -8;
    } else if (*ldc < max(1,*m)) {
	*info = -11;
    }
    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DORMR3", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


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

    if (left && ! notran || ! left && notran) {
	i1 = 1;
	i2 = *k;
	i3 = 1;
    } else {
	i1 = *k;
	i2 = 1;
	i3 = -1;
    }

    if (left) {
	ni = *n;
	ja = *m - *l + 1;
	jc = 1;
    } else {
	mi = *m;
	ja = *n - *l + 1;
	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) {


	    mi = *m - i__ + 1;
	    ic = i__;
	} else {


	    ni = *n - i__ + 1;
	    jc = i__;
	}


	if (dlarz_(interp, side, &mi, &ni, l, &a[i__ + ja * a_dim1], lda, &tau[i__], &c__[		ic + jc * c_dim1], ldc, &work[1])!=TCL_OK) { return TCL_ERROR; }



    }

return TCL_OK;


} /* dormr3_ */
static /* Subroutine */ int dlarzb_ (Tcl_Interp *interp, char *side, char *trans, char *direct, char *	storev, integer *m, integer *n, integer *k, integer *l, doublereal *v, 	 integer *ldv, doublereal *t, integer *ldt, doublereal *c__, integer *	ldc, doublereal *work, integer *ldwork)
{
    integer c_dim1, c_offset, t_dim1, t_offset, v_dim1, v_offset, work_dim1, 
	    work_offset, i__1, i__2;

    integer i__, j, info;
    char transt[1];





























    v_dim1 = *ldv;
    v_offset = 1 + v_dim1;
    v -= v_offset;
    t_dim1 = *ldt;
    t_offset = 1 + t_dim1;
    t -= t_offset;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;
    work_dim1 = *ldwork;
    work_offset = 1 + work_dim1;
    work -= work_offset;

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


    info = 0;
    if (! lsame_(direct, "B")) {
	info = -3;
    } else if (! lsame_(storev, "R")) {
	info = -4;
    }
    if (info != 0) {
	i__1 = -info;
	vectcl_xerbla(interp, "DLARZB", &i__1);
return TCL_ERROR;

return TCL_OK;
    }

    if (lsame_(trans, "N")) {
	*(unsigned char *)transt = 'T';
    } else {
	*(unsigned char *)transt = 'N';
    }

    if (lsame_(side, "L")) {



	i__1 = *k;
	for (j = 1; j <= i__1; ++j) {
	    if (dcopy_(interp, n, &c__[j + c_dim1], ldc, &work[j * work_dim1 + 1], &dlarzb_c__1)!=TCL_OK) { return TCL_ERROR; }

	}


	if (*l > 0) {
	    if (dgemm_(interp, "Transpose", "Transpose", n, k, l, &dlarzb_c_b13, &c__[*m - *l + 		    1 + c_dim1], ldc, &v[v_offset], ldv, &dlarzb_c_b13, &work[
		    work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }


	}


	if (dtrmm_(interp, "Right", "Lower", transt, "Non-unit", n, k, &dlarzb_c_b13, &t[		t_offset], ldt, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *k;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		c__[i__ + j * c_dim1] -= work[j + i__ * work_dim1];
	    }
	}


	if (*l > 0) {
	    if (dgemm_(interp, "Transpose", "Transpose", l, n, k, &dlarzb_c_b23, &v[v_offset], 		    ldv, &work[work_offset], ldwork, &dlarzb_c_b13, &c__[*m - *l + 1 
		    + c_dim1], ldc)!=TCL_OK) { return TCL_ERROR; }


	}

    } else if (lsame_(side, "R")) {



	i__1 = *k;
	for (j = 1; j <= i__1; ++j) {
	    if (dcopy_(interp, m, &c__[j * c_dim1 + 1], &dlarzb_c__1, &work[j * work_dim1 + 1], &		    dlarzb_c__1)!=TCL_OK) { return TCL_ERROR; }


	}


	if (*l > 0) {
	    if (dgemm_(interp, "No transpose", "Transpose", m, k, l, &dlarzb_c_b13, &c__[(*n - *		    l + 1) * c_dim1 + 1], ldc, &v[v_offset], ldv, &dlarzb_c_b13, &
		    work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }


	}


	if (dtrmm_(interp, "Right", "Lower", trans, "Non-unit", m, k, &dlarzb_c_b13, &t[t_offset], ldt, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




	i__1 = *k;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *m;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		c__[i__ + j * c_dim1] -= work[i__ + j * work_dim1];
	    }
	}


	if (*l > 0) {
	    if (dgemm_(interp, "No transpose", "No transpose", m, l, k, &dlarzb_c_b23, &work[		    work_offset], ldwork, &v[v_offset], ldv, &dlarzb_c_b13, &c__[(*n 
		    - *l + 1) * c_dim1 + 1], ldc)!=TCL_OK) { return TCL_ERROR; }


	}

    }

return TCL_OK;


} /* dlarzb_ */
static /* Subroutine */ int dlarzt_ (Tcl_Interp *interp, char *direct, char *storev, integer *n, integer *	k, doublereal *v, integer *ldv, doublereal *tau, doublereal *t, 	integer *ldt)
{
    integer t_dim1, t_offset, v_dim1, v_offset, i__1;
    doublereal d__1;

    integer i__, j, info;

































    v_dim1 = *ldv;
    v_offset = 1 + v_dim1;
    v -= v_offset;
    --tau;
    t_dim1 = *ldt;
    t_offset = 1 + t_dim1;
    t -= t_offset;

    info = 0;
    if (! lsame_(direct, "B")) {
	info = -1;
    } else if (! lsame_(storev, "R")) {
	info = -2;
    }
    if (info != 0) {
	i__1 = -info;
	vectcl_xerbla(interp, "DLARZT", &i__1);
return TCL_ERROR;

return TCL_OK;
    }

    for (i__ = *k; i__ >= 1; --i__) {
	if (tau[i__] == 0.) {


	    i__1 = *k;
	    for (j = i__; j <= i__1; ++j) {
		t[j + i__ * t_dim1] = 0.;
	    }
	} else {


	    if (i__ < *k) {


		i__1 = *k - i__;
		d__1 = -tau[i__];
		if (dgemv_(interp, "No transpose", &i__1, n, &d__1, &v[i__ + 1 + v_dim1], 			ldv, &v[i__ + v_dim1], ldv, &dlarzt_c_b8, &t[i__ + 1 + i__ * 
			t_dim1], &dlarzt_c__1)!=TCL_OK) { return TCL_ERROR; }




		i__1 = *k - i__;
		if (dtrmv_(interp, "Lower", "No transpose", "Non-unit", &i__1, &t[i__ + 1 			+ (i__ + 1) * t_dim1], ldt, &t[i__ + 1 + i__ * t_dim1]
, &dlarzt_c__1)!=TCL_OK) { return TCL_ERROR; }


	    }
	    t[i__ + i__ * t_dim1] = tau[i__];
	}
    }
return TCL_OK;


} /* dlarzt_ */
static /* Subroutine */ int dlatrz_ (Tcl_Interp *interp, integer *m, integer *n, integer *l, doublereal *	a, integer *lda, doublereal *tau, doublereal *work)
{
    integer a_dim1, a_offset, i__1, i__2;

    integer i__;




























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

    if (*m == 0) {
return TCL_OK;
    } else if (*m == *n) {
	i__1 = *n;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    tau[i__] = 0.;
	}
return TCL_OK;
    }

    for (i__ = *m; i__ >= 1; --i__) {


	i__1 = *l + 1;
	if (dlarfp_(interp, &i__1, &a[i__ + i__ * a_dim1], &a[i__ + (*n - *l + 1) * 		a_dim1], lda, &tau[i__])!=TCL_OK) { return TCL_ERROR; }




	i__1 = i__ - 1;
	i__2 = *n - i__ + 1;
	if (dlarz_(interp, "Right", &i__1, &i__2, l, &a[i__ + (*n - *l + 1) * a_dim1], 		lda, &tau[i__], &a[i__ * a_dim1 + 1], lda, &work[1])!=TCL_OK) { return TCL_ERROR; }



    }

return TCL_OK;


} /* dlatrz_ */
static /* Double Complex */ VOID zdotc_ (doublecomplex * ret_val, integer *n, 	doublecomplex *zx, integer *incx, doublecomplex *zy, integer *incy)
{
    integer i__1, i__2;
    doublecomplex z__1, z__2, z__3;

    void d_cnjg(doublecomplex *, doublecomplex *);

    integer i__, ix, iy;
    doublecomplex ztemp;






    --zy;
    --zx;

    ztemp.r = 0., ztemp.i = 0.;
     ret_val->r = 0.,  ret_val->i = 0.;
    if (*n <= 0) {
	return ;
    }
    if (*incx == 1 && *incy == 1) {
	goto L20;
    }


    ix = 1;
    iy = 1;
    if (*incx < 0) {
	ix = (-(*n) + 1) * *incx + 1;
    }
    if (*incy < 0) {
	iy = (-(*n) + 1) * *incy + 1;
    }
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	d_cnjg(&z__3, &zx[ix]);
	i__2 = iy;
	z__2.r = z__3.r * zy[i__2].r - z__3.i * zy[i__2].i, z__2.i = z__3.r * 
		zy[i__2].i + z__3.i * zy[i__2].r;
	z__1.r = ztemp.r + z__2.r, z__1.i = ztemp.i + z__2.i;
	ztemp.r = z__1.r, ztemp.i = z__1.i;
	ix += *incx;
	iy += *incy;
    }
     ret_val->r = ztemp.r,  ret_val->i = ztemp.i;
    return ;


L20:
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	d_cnjg(&z__3, &zx[i__]);
	i__2 = i__;
	z__2.r = z__3.r * zy[i__2].r - z__3.i * zy[i__2].i, z__2.i = z__3.r * 
		zy[i__2].i + z__3.i * zy[i__2].r;
	z__1.r = ztemp.r + z__2.r, z__1.i = ztemp.i + z__2.i;
	ztemp.r = z__1.r, ztemp.i = z__1.i;
    }
     ret_val->r = ztemp.r,  ret_val->i = ztemp.i;
    return ;
} /* zdotc_ */
static /* Subroutine */ int zlaqp2_ (Tcl_Interp *interp, integer *m, integer *n, integer *offset, 	doublecomplex *a, integer *lda, integer *jpvt, doublecomplex *tau, 	doublereal *vn1, doublereal *vn2, doublecomplex *work)
{
    integer a_dim1, a_offset, i__1, i__2, i__3;
    doublereal d__1;
    doublecomplex z__1;

    double sqrt(doublereal);
    void d_cnjg(doublecomplex *, doublecomplex *);
    double z_abs(doublecomplex *);

    integer i__, j, mn;
    doublecomplex aii;
    integer pvt;
    doublereal temp, temp2, tol3z;
    integer offpi, itemp;





















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

    i__1 = *m - *offset;
    mn = min(i__1,*n);
    tol3z = sqrt(dlamch_("Epsilon"));


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

	offpi = *offset + i__;


	i__2 = *n - i__ + 1;
	pvt = i__ - 1 + idamax_(&i__2, &vn1[i__], &zlaqp2_c__1);

	if (pvt != i__) {
	    if (zswap_(interp, m, &a[pvt * a_dim1 + 1], &zlaqp2_c__1, &a[i__ * a_dim1 + 1], &		    zlaqp2_c__1)!=TCL_OK) { return TCL_ERROR; }


	    itemp = jpvt[pvt];
	    jpvt[pvt] = jpvt[i__];
	    jpvt[i__] = itemp;
	    vn1[pvt] = vn1[i__];
	    vn2[pvt] = vn2[i__];
	}


	if (offpi < *m) {
	    i__2 = *m - offpi + 1;
	    if (zlarfp_(interp, &i__2, &a[offpi + i__ * a_dim1], &a[offpi + 1 + i__ * 		    a_dim1], &zlaqp2_c__1, &tau[i__])!=TCL_OK) { return TCL_ERROR; }


	} else {
	    if (zlarfp_(interp, &zlaqp2_c__1, &a[*m + i__ * a_dim1], &a[*m + i__ * a_dim1], &		    zlaqp2_c__1, &tau[i__])!=TCL_OK) { return TCL_ERROR; }


	}

	if (i__ < *n) {


	    i__2 = offpi + i__ * a_dim1;
	    aii.r = a[i__2].r, aii.i = a[i__2].i;
	    i__2 = offpi + i__ * a_dim1;
	    a[i__2].r = 1., a[i__2].i = 0.;
	    i__2 = *m - offpi + 1;
	    i__3 = *n - i__;
	    d_cnjg(&z__1, &tau[i__]);
	    if (zlarf_(interp, "Left", &i__2, &i__3, &a[offpi + i__ * a_dim1], &zlaqp2_c__1, &		    z__1, &a[offpi + (i__ + 1) * a_dim1], lda, &work[1])!=TCL_OK) { return TCL_ERROR; }


	    i__2 = offpi + i__ * a_dim1;
	    a[i__2].r = aii.r, a[i__2].i = aii.i;
	}


	i__2 = *n;
	for (j = i__ + 1; j <= i__2; ++j) {
	    if (vn1[j] != 0.) {


		d__1 = z_abs(&a[offpi + j * a_dim1]) / vn1[j];
		temp = 1. - d__1 * d__1;
		temp = max(temp,0.);
		d__1 = vn1[j] / vn2[j];
		temp2 = temp * (d__1 * d__1);
		if (temp2 <= tol3z) {
		    if (offpi < *m) {
			i__3 = *m - offpi;
			vn1[j] = dznrm2_(&i__3, &a[offpi + 1 + j * a_dim1], &
				zlaqp2_c__1);
			vn2[j] = vn1[j];
		    } else {
			vn1[j] = 0.;
			vn2[j] = 0.;
		    }
		} else {
		    vn1[j] *= sqrt(temp);
		}
	    }
	}

    }

return TCL_OK;


} /* zlaqp2_ */
static /* Subroutine */ int zlaqps_ (Tcl_Interp *interp, integer *m, integer *n, integer *offset, integer 	*nb, integer *kb, doublecomplex *a, integer *lda, integer *jpvt, 	doublecomplex *tau, doublereal *vn1, doublereal *vn2, doublecomplex *	auxv, doublecomplex *f, integer *ldf)
{
    integer a_dim1, a_offset, f_dim1, f_offset, i__1, i__2, i__3;
    doublereal d__1, d__2;
    doublecomplex z__1;

    double sqrt(doublereal);
    void d_cnjg(doublecomplex *, doublecomplex *);
    double z_abs(doublecomplex *);
    integer i_dnnt(doublereal *);

    integer j, k, rk;
    doublecomplex akk;
    integer pvt;
    doublereal temp, temp2, tol3z;
    integer itemp;
    integer lsticc;
    integer lastrk;



























    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --jpvt;
    --tau;
    --vn1;
    --vn2;
    --auxv;
    f_dim1 = *ldf;
    f_offset = 1 + f_dim1;
    f -= f_offset;

    i__1 = *m, i__2 = *n + *offset;
    lastrk = min(i__1,i__2);
    lsticc = 0;
    k = 0;
    tol3z = sqrt(dlamch_("Epsilon"));


L10:
    if (k < *nb && lsticc == 0) {
	++k;
	rk = *offset + k;


	i__1 = *n - k + 1;
	pvt = k - 1 + idamax_(&i__1, &vn1[k], &zlaqps_c__1);
	if (pvt != k) {
	    if (zswap_(interp, m, &a[pvt * a_dim1 + 1], &zlaqps_c__1, &a[k * a_dim1 + 1], &zlaqps_c__1)!=TCL_OK) { return TCL_ERROR; }

	    i__1 = k - 1;
	    if (zswap_(interp, &i__1, &f[pvt + f_dim1], ldf, &f[k + f_dim1], ldf)!=TCL_OK) { return TCL_ERROR; }

	    itemp = jpvt[pvt];
	    jpvt[pvt] = jpvt[k];
	    jpvt[k] = itemp;
	    vn1[pvt] = vn1[k];
	    vn2[pvt] = vn2[k];
	}


	if (k > 1) {
	    i__1 = k - 1;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = k + j * f_dim1;
		d_cnjg(&z__1, &f[k + j * f_dim1]);
		f[i__2].r = z__1.r, f[i__2].i = z__1.i;
	    }
	    i__1 = *m - rk + 1;
	    i__2 = k - 1;
	    z__1.r = -1., z__1.i = -0.;
	    if (zgemv_(interp, "No transpose", &i__1, &i__2, &z__1, &a[rk + a_dim1], lda, 		    &f[k + f_dim1], ldf, &zlaqps_c_b2, &a[rk + k * a_dim1], &zlaqps_c__1)!=TCL_OK) { return TCL_ERROR; }


	    i__1 = k - 1;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = k + j * f_dim1;
		d_cnjg(&z__1, &f[k + j * f_dim1]);
		f[i__2].r = z__1.r, f[i__2].i = z__1.i;
	    }
	}


	if (rk < *m) {
	    i__1 = *m - rk + 1;
	    if (zlarfp_(interp, &i__1, &a[rk + k * a_dim1], &a[rk + 1 + k * a_dim1], &		    zlaqps_c__1, &tau[k])!=TCL_OK) { return TCL_ERROR; }


	} else {
	    if (zlarfp_(interp, &zlaqps_c__1, &a[rk + k * a_dim1], &a[rk + k * a_dim1], &zlaqps_c__1, &		    tau[k])!=TCL_OK) { return TCL_ERROR; }


	}

	i__1 = rk + k * a_dim1;
	akk.r = a[i__1].r, akk.i = a[i__1].i;
	i__1 = rk + k * a_dim1;
	a[i__1].r = 1., a[i__1].i = 0.;



	if (k < *n) {
	    i__1 = *m - rk + 1;
	    i__2 = *n - k;
	    if (zgemv_(interp, "Conjugate transpose", &i__1, &i__2, &tau[k], &a[rk + (k + 		    1) * a_dim1], lda, &a[rk + k * a_dim1], &zlaqps_c__1, &zlaqps_c_b1, &f[
		    k + 1 + k * f_dim1], &zlaqps_c__1)!=TCL_OK) { return TCL_ERROR; }


	}


	i__1 = k;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = j + k * f_dim1;
	    f[i__2].r = 0., f[i__2].i = 0.;
	}


	if (k > 1) {
	    i__1 = *m - rk + 1;
	    i__2 = k - 1;
	    i__3 = k;
	    z__1.r = -tau[i__3].r, z__1.i = -tau[i__3].i;
	    if (zgemv_(interp, "Conjugate transpose", &i__1, &i__2, &z__1, &a[rk + a_dim1], lda, &a[rk + k * a_dim1], &zlaqps_c__1, &zlaqps_c_b1, &auxv[1], &zlaqps_c__1)!=TCL_OK) { return TCL_ERROR; }



	    i__1 = k - 1;
	    if (zgemv_(interp, "No transpose", n, &i__1, &zlaqps_c_b2, &f[f_dim1 + 1], ldf, &		    auxv[1], &zlaqps_c__1, &zlaqps_c_b2, &f[k * f_dim1 + 1], &zlaqps_c__1)!=TCL_OK) { return TCL_ERROR; }


	}


	if (k < *n) {
	    i__1 = *n - k;
	    z__1.r = -1., z__1.i = -0.;
	    if (zgemm_(interp, "No transpose", "Conjugate transpose", &zlaqps_c__1, &i__1, &k, &		    z__1, &a[rk + a_dim1], lda, &f[k + 1 + f_dim1], ldf, &
		    zlaqps_c_b2, &a[rk + (k + 1) * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }


	}


	if (rk < lastrk) {
	    i__1 = *n;
	    for (j = k + 1; j <= i__1; ++j) {
		if (vn1[j] != 0.) {


		    temp = z_abs(&a[rk + j * a_dim1]) / vn1[j];
		    d__1 = 0., d__2 = (temp + 1.) * (1. - temp);
		    temp = max(d__1,d__2);
		    d__1 = vn1[j] / vn2[j];
		    temp2 = temp * (d__1 * d__1);
		    if (temp2 <= tol3z) {
			vn2[j] = (doublereal) lsticc;
			lsticc = j;
		    } else {
			vn1[j] *= sqrt(temp);
		    }
		}
	    }
	}

	i__1 = rk + k * a_dim1;
	a[i__1].r = akk.r, a[i__1].i = akk.i;


	goto L10;
    }
    *kb = k;
    rk = *offset + *kb;


    i__1 = *n, i__2 = *m - *offset;
    if (*kb < min(i__1,i__2)) {
	i__1 = *m - rk;
	i__2 = *n - *kb;
	z__1.r = -1., z__1.i = -0.;
	if (zgemm_(interp, "No transpose", "Conjugate transpose", &i__1, &i__2, kb, &z__1, 		 &a[rk + 1 + a_dim1], lda, &f[*kb + 1 + f_dim1], ldf, &zlaqps_c_b2, &
		a[rk + 1 + (*kb + 1) * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }


    }


L60:
    if (lsticc > 0) {
	itemp = i_dnnt(&vn2[lsticc]);
	i__1 = *m - rk;
	vn1[lsticc] = dznrm2_(&i__1, &a[rk + 1 + lsticc * a_dim1], &zlaqps_c__1);


	vn2[lsticc] = vn1[lsticc];
	lsticc = itemp;
	goto L60;
    }

return TCL_OK;


} /* zlaqps_ */
static /* Subroutine */ int zunmr3_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *k, integer *l, doublecomplex *a, integer *lda, doublecomplex 	*tau, doublecomplex *c__, integer *ldc, doublecomplex *work, integer *	info)
{
    integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3;
    doublecomplex z__1;

    void d_cnjg(doublecomplex *, doublecomplex *);

    integer i__, i1, i2, i3, ja, ic, jc, mi, ni, nq;
    logical left;
    doublecomplex taui;
    logical notran;
































    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --tau;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;
    --work;

    *info = 0;
    left = lsame_(side, "L");
    notran = lsame_(trans, "N");


    if (left) {
	nq = *m;
    } else {
	nq = *n;
    }
    if (! left && ! lsame_(side, "R")) {
	*info = -1;
    } else if (! notran && ! lsame_(trans, "C")) {
	*info = -2;
    } else if (*m < 0) {
	*info = -3;
    } else if (*n < 0) {
	*info = -4;
    } else if (*k < 0 || *k > nq) {
	*info = -5;
    } else if (*l < 0 || left && *l > *m || ! left && *l > *n) {
	*info = -6;
    } else if (*lda < max(1,*k)) {
	*info = -8;
    } else if (*ldc < max(1,*m)) {
	*info = -11;
    }
    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "ZUNMR3", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


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

    if (left && ! notran || ! left && notran) {
	i1 = 1;
	i2 = *k;
	i3 = 1;
    } else {
	i1 = *k;
	i2 = 1;
	i3 = -1;
    }

    if (left) {
	ni = *n;
	ja = *m - *l + 1;
	jc = 1;
    } else {
	mi = *m;
	ja = *n - *l + 1;
	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) {


	    mi = *m - i__ + 1;
	    ic = i__;
	} else {


	    ni = *n - i__ + 1;
	    jc = i__;
	}


	if (notran) {
	    i__3 = i__;
	    taui.r = tau[i__3].r, taui.i = tau[i__3].i;
	} else {
	    d_cnjg(&z__1, &tau[i__]);
	    taui.r = z__1.r, taui.i = z__1.i;
	}
	if (zlarz_(interp, side, &mi, &ni, l, &a[i__ + ja * a_dim1], lda, &taui, &c__[ic 		+ jc * c_dim1], ldc, &work[1])!=TCL_OK) { return TCL_ERROR; }



    }

return TCL_OK;


} /* zunmr3_ */
static /* Subroutine */ int zlarzb_ (Tcl_Interp *interp, char *side, char *trans, char *direct, char *	storev, integer *m, integer *n, integer *k, integer *l, doublecomplex 	*v, integer *ldv, doublecomplex *t, integer *ldt, doublecomplex *c__, 	integer *ldc, doublecomplex *work, integer *ldwork)
{
    integer c_dim1, c_offset, t_dim1, t_offset, v_dim1, v_offset, work_dim1, 
	    work_offset, i__1, i__2, i__3, i__4, i__5;
    doublecomplex z__1;

    integer i__, j, info;
    char transt[1];





























    v_dim1 = *ldv;
    v_offset = 1 + v_dim1;
    v -= v_offset;
    t_dim1 = *ldt;
    t_offset = 1 + t_dim1;
    t -= t_offset;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;
    work_dim1 = *ldwork;
    work_offset = 1 + work_dim1;
    work -= work_offset;

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


    info = 0;
    if (! lsame_(direct, "B")) {
	info = -3;
    } else if (! lsame_(storev, "R")) {
	info = -4;
    }
    if (info != 0) {
	i__1 = -info;
	vectcl_xerbla(interp, "ZLARZB", &i__1);
return TCL_ERROR;

return TCL_OK;
    }

    if (lsame_(trans, "N")) {
	*(unsigned char *)transt = 'C';
    } else {
	*(unsigned char *)transt = 'N';
    }

    if (lsame_(side, "L")) {



	i__1 = *k;
	for (j = 1; j <= i__1; ++j) {
	    if (zcopy_(interp, n, &c__[j + c_dim1], ldc, &work[j * work_dim1 + 1], &zlarzb_c__1)!=TCL_OK) { return TCL_ERROR; }

	}


	if (*l > 0) {
	    if (zgemm_(interp, "Transpose", "Conjugate transpose", n, k, l, &zlarzb_c_b1, &c__[*		    m - *l + 1 + c_dim1], ldc, &v[v_offset], ldv, &zlarzb_c_b1, &
		    work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }


	}


	if (ztrmm_(interp, "Right", "Lower", transt, "Non-unit", n, k, &zlarzb_c_b1, &t[t_offset], ldt, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }




	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *k;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		i__3 = i__ + j * c_dim1;
		i__4 = i__ + j * c_dim1;
		i__5 = j + i__ * work_dim1;
		z__1.r = c__[i__4].r - work[i__5].r, z__1.i = c__[i__4].i - 
			work[i__5].i;
		c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
	    }
	}


	if (*l > 0) {
	    z__1.r = -1., z__1.i = -0.;
	    if (zgemm_(interp, "Transpose", "Transpose", l, n, k, &z__1, &v[v_offset], 		    ldv, &work[work_offset], ldwork, &zlarzb_c_b1, &c__[*m - *l + 1 
		    + c_dim1], ldc)!=TCL_OK) { return TCL_ERROR; }


	}

    } else if (lsame_(side, "R")) {



	i__1 = *k;
	for (j = 1; j <= i__1; ++j) {
	    if (zcopy_(interp, m, &c__[j * c_dim1 + 1], &zlarzb_c__1, &work[j * work_dim1 + 1], &		    zlarzb_c__1)!=TCL_OK) { return TCL_ERROR; }


	}


	if (*l > 0) {
	    if (zgemm_(interp, "No transpose", "Transpose", m, k, l, &zlarzb_c_b1, &c__[(*n - *l 		    + 1) * c_dim1 + 1], ldc, &v[v_offset], ldv, &zlarzb_c_b1, &work[
		    work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }


	}


	i__1 = *k;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *k - j + 1;
	    if (zlacgv_(interp, &i__2, &t[j + j * t_dim1], &zlarzb_c__1)!=TCL_OK) { return TCL_ERROR; }

	}
	if (ztrmm_(interp, "Right", "Lower", trans, "Non-unit", m, k, &zlarzb_c_b1, &t[t_offset], 		 ldt, &work[work_offset], ldwork)!=TCL_OK) { return TCL_ERROR; }


	i__1 = *k;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *k - j + 1;
	    if (zlacgv_(interp, &i__2, &t[j + j * t_dim1], &zlarzb_c__1)!=TCL_OK) { return TCL_ERROR; }

	}


	i__1 = *k;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = *m;
	    for (i__ = 1; i__ <= i__2; ++i__) {
		i__3 = i__ + j * c_dim1;
		i__4 = i__ + j * c_dim1;
		i__5 = i__ + j * work_dim1;
		z__1.r = c__[i__4].r - work[i__5].r, z__1.i = c__[i__4].i - 
			work[i__5].i;
		c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
	    }
	}


	i__1 = *l;
	for (j = 1; j <= i__1; ++j) {
	    if (zlacgv_(interp, k, &v[j * v_dim1 + 1], &zlarzb_c__1)!=TCL_OK) { return TCL_ERROR; }

	}
	if (*l > 0) {
	    z__1.r = -1., z__1.i = -0.;
	    if (zgemm_(interp, "No transpose", "No transpose", m, l, k, &z__1, &work[		    work_offset], ldwork, &v[v_offset], ldv, &zlarzb_c_b1, &c__[(*n 
		    - *l + 1) * c_dim1 + 1], ldc)!=TCL_OK) { return TCL_ERROR; }


	}
	i__1 = *l;
	for (j = 1; j <= i__1; ++j) {
	    if (zlacgv_(interp, k, &v[j * v_dim1 + 1], &zlarzb_c__1)!=TCL_OK) { return TCL_ERROR; }

	}

    }

return TCL_OK;


} /* zlarzb_ */
static /* Subroutine */ int zlarzt_ (Tcl_Interp *interp, char *direct, char *storev, integer *n, integer *	k, doublecomplex *v, integer *ldv, doublecomplex *tau, doublecomplex *	t, integer *ldt)
{
    integer t_dim1, t_offset, v_dim1, v_offset, i__1, i__2;
    doublecomplex z__1;

    integer i__, j, info;

































    v_dim1 = *ldv;
    v_offset = 1 + v_dim1;
    v -= v_offset;
    --tau;
    t_dim1 = *ldt;
    t_offset = 1 + t_dim1;
    t -= t_offset;

    info = 0;
    if (! lsame_(direct, "B")) {
	info = -1;
    } else if (! lsame_(storev, "R")) {
	info = -2;
    }
    if (info != 0) {
	i__1 = -info;
	vectcl_xerbla(interp, "ZLARZT", &i__1);
return TCL_ERROR;

return TCL_OK;
    }

    for (i__ = *k; i__ >= 1; --i__) {
	i__1 = i__;
	if (tau[i__1].r == 0. && tau[i__1].i == 0.) {


	    i__1 = *k;
	    for (j = i__; j <= i__1; ++j) {
		i__2 = j + i__ * t_dim1;
		t[i__2].r = 0., t[i__2].i = 0.;
	    }
	} else {


	    if (i__ < *k) {


		if (zlacgv_(interp, n, &v[i__ + v_dim1], ldv)!=TCL_OK) { return TCL_ERROR; }

		i__1 = *k - i__;
		i__2 = i__;
		z__1.r = -tau[i__2].r, z__1.i = -tau[i__2].i;
		if (zgemv_(interp, "No transpose", &i__1, n, &z__1, &v[i__ + 1 + v_dim1], 			ldv, &v[i__ + v_dim1], ldv, &zlarzt_c_b1, &t[i__ + 1 + i__ * 
			t_dim1], &zlarzt_c__1)!=TCL_OK) { return TCL_ERROR; }


		if (zlacgv_(interp, n, &v[i__ + v_dim1], ldv)!=TCL_OK) { return TCL_ERROR; }



		i__1 = *k - i__;
		if (ztrmv_(interp, "Lower", "No transpose", "Non-unit", &i__1, &t[i__ + 1 			+ (i__ + 1) * t_dim1], ldt, &t[i__ + 1 + i__ * t_dim1]
, &zlarzt_c__1)!=TCL_OK) { return TCL_ERROR; }


	    }
	    i__1 = i__ + i__ * t_dim1;
	    i__2 = i__;
	    t[i__1].r = tau[i__2].r, t[i__1].i = tau[i__2].i;
	}
    }
return TCL_OK;


} /* zlarzt_ */
static /* Subroutine */ int zlatrz_ (Tcl_Interp *interp, integer *m, integer *n, integer *l, 	doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *	work)
{
    integer a_dim1, a_offset, i__1, i__2;
    doublecomplex z__1;

    void d_cnjg(doublecomplex *, doublecomplex *);

    integer i__;
    doublecomplex alpha;



























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

    if (*m == 0) {
return TCL_OK;
    } else if (*m == *n) {
	i__1 = *n;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    i__2 = i__;
	    tau[i__2].r = 0., tau[i__2].i = 0.;
	}
return TCL_OK;
    }

    for (i__ = *m; i__ >= 1; --i__) {


	if (zlacgv_(interp, l, &a[i__ + (*n - *l + 1) * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }

	d_cnjg(&z__1, &a[i__ + i__ * a_dim1]);
	alpha.r = z__1.r, alpha.i = z__1.i;
	i__1 = *l + 1;
	if (zlarfp_(interp, &i__1, &alpha, &a[i__ + (*n - *l + 1) * a_dim1], lda, &tau[		i__])!=TCL_OK) { return TCL_ERROR; }


	i__1 = i__;
	d_cnjg(&z__1, &tau[i__]);
	tau[i__1].r = z__1.r, tau[i__1].i = z__1.i;


	i__1 = i__ - 1;
	i__2 = *n - i__ + 1;
	d_cnjg(&z__1, &tau[i__]);
	if (zlarz_(interp, "Right", &i__1, &i__2, l, &a[i__ + (*n - *l + 1) * a_dim1], 		lda, &z__1, &a[i__ * a_dim1 + 1], lda, &work[1])!=TCL_OK) { return TCL_ERROR; }


	i__1 = i__ + i__ * a_dim1;
	d_cnjg(&z__1, &alpha);
	a[i__1].r = z__1.r, a[i__1].i = z__1.i;

    }

return TCL_OK;


} /* zlatrz_ */
static /* Subroutine */ int dgetf2_ (Tcl_Interp *interp, integer *m, integer *n, doublereal *a, integer *	lda, integer *ipiv, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3;
    doublereal d__1;

    integer i__, j, jp;
    doublereal sfmin;


















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

    *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);
	vectcl_xerbla(interp, "DGETF2", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


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


    sfmin = dlamch_("S");

    i__1 = min(*m,*n);
    for (j = 1; j <= i__1; ++j) {


	i__2 = *m - j + 1;
	jp = j - 1 + idamax_(&i__2, &a[j + j * a_dim1], &dgetf2_c__1);
	ipiv[j] = jp;
	if (a[jp + j * a_dim1] != 0.) {


	    if (jp != j) {
		if (dswap_(interp, n, &a[j + a_dim1], lda, &a[jp + a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }

	    }


	    if (j < *m) {
		if ((d__1 = a[j + j * a_dim1], abs(d__1)) >= sfmin) {
		    i__2 = *m - j;
		    d__1 = 1. / a[j + j * a_dim1];
		    if (dscal_(interp, &i__2, &d__1, &a[j + 1 + j * a_dim1], &dgetf2_c__1)!=TCL_OK) { return TCL_ERROR; }

		} else {
		    i__2 = *m - j;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			a[j + i__ + j * a_dim1] /= a[j + j * a_dim1];
		    }
		}
	    }

	} else if (*info == 0) {

	    *info = j;
	}

	if (j < min(*m,*n)) {


	    i__2 = *m - j;
	    i__3 = *n - j;
	    if (dger_(interp, &i__2, &i__3, &dgetf2_c_b8, &a[j + 1 + j * a_dim1], &dgetf2_c__1, &a[j + (		    j + 1) * a_dim1], lda, &a[j + 1 + (j + 1) * a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }


	}
    }
return TCL_OK;


} /* dgetf2_ */
static /* Subroutine */ int dlaswp_ (Tcl_Interp *interp, integer *n, doublereal *a, integer *lda, integer 	*k1, integer *k2, integer *ipiv, integer *incx)
{
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4;

    integer i__, j, k, i1, i2, n32, ip, ix, ix0, inc;
    doublereal temp;



















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

    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 TCL_OK;
    }

    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[i__ + k * a_dim1];
			a[i__ + k * a_dim1] = a[ip + k * a_dim1];
			a[ip + k * a_dim1] = temp;
		    }
		}
		ix += *incx;
	    }
	}
    }
    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[i__ + k * a_dim1];
		    a[i__ + k * a_dim1] = a[ip + k * a_dim1];
		    a[ip + k * a_dim1] = temp;
		}
	    }
	    ix += *incx;
	}
    }

return TCL_OK;


} /* dlaswp_ */
static /* Subroutine */ int zgetf2_ (Tcl_Interp *interp, integer *m, integer *n, doublecomplex *a, 	integer *lda, integer *ipiv, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3;
    doublecomplex z__1;

    double z_abs(doublecomplex *);
    void z_div(doublecomplex *, doublecomplex *, doublecomplex *);

    integer i__, j, jp;
    doublereal sfmin;


















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

    *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);
	vectcl_xerbla(interp, "ZGETF2", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


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


    sfmin = dlamch_("S");

    i__1 = min(*m,*n);
    for (j = 1; j <= i__1; ++j) {


	i__2 = *m - j + 1;
	jp = j - 1 + izamax_(&i__2, &a[j + j * a_dim1], &zgetf2_c__1);
	ipiv[j] = jp;
	i__2 = jp + j * a_dim1;
	if (a[i__2].r != 0. || a[i__2].i != 0.) {


	    if (jp != j) {
		if (zswap_(interp, n, &a[j + a_dim1], lda, &a[jp + a_dim1], lda)!=TCL_OK) { return TCL_ERROR; }

	    }


	    if (j < *m) {
		if (z_abs(&a[j + j * a_dim1]) >= sfmin) {
		    i__2 = *m - j;
		    z_div(&z__1, &zgetf2_c_b1, &a[j + j * a_dim1]);
		    if (zscal_(interp, &i__2, &z__1, &a[j + 1 + j * a_dim1], &zgetf2_c__1)!=TCL_OK) { return TCL_ERROR; }

		} else {
		    i__2 = *m - j;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			i__3 = j + i__ + j * a_dim1;
			z_div(&z__1, &a[j + i__ + j * a_dim1], &a[j + j * 
				a_dim1]);
			a[i__3].r = z__1.r, a[i__3].i = z__1.i;
		    }
		}
	    }

	} else if (*info == 0) {

	    *info = j;
	}

	if (j < min(*m,*n)) {


	    i__2 = *m - j;
	    i__3 = *n - j;
	    z__1.r = -1., z__1.i = -0.;
	    if (zgeru_(interp, &i__2, &i__3, &z__1, &a[j + 1 + j * a_dim1], &zgetf2_c__1, &a[j + 		    (j + 1) * a_dim1], lda, &a[j + 1 + (j + 1) * a_dim1], lda)
		    !=TCL_OK) { return TCL_ERROR; }


	}
    }
return TCL_OK;


} /* zgetf2_ */
static /* Subroutine */ int zlaswp_ (Tcl_Interp *interp, integer *n, doublecomplex *a, integer *lda, 	integer *k1, integer *k2, integer *ipiv, integer *incx)
{
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5, i__6;

    integer i__, j, k, i1, i2, n32, ip, ix, ix0, inc;
    doublecomplex temp;



















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

    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 TCL_OK;
    }

    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) {
			i__5 = i__ + k * a_dim1;
			temp.r = a[i__5].r, temp.i = a[i__5].i;
			i__5 = i__ + k * a_dim1;
			i__6 = ip + k * a_dim1;
			a[i__5].r = a[i__6].r, a[i__5].i = a[i__6].i;
			i__5 = ip + k * a_dim1;
			a[i__5].r = temp.r, a[i__5].i = temp.i;
		    }
		}
		ix += *incx;
	    }
	}
    }
    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) {
		    i__4 = i__ + k * a_dim1;
		    temp.r = a[i__4].r, temp.i = a[i__4].i;
		    i__4 = i__ + k * a_dim1;
		    i__5 = ip + k * a_dim1;
		    a[i__4].r = a[i__5].r, a[i__4].i = a[i__5].i;
		    i__4 = ip + k * a_dim1;
		    a[i__4].r = temp.r, a[i__4].i = temp.i;
		}
	    }
	    ix += *incx;
	}
    }

return TCL_OK;


} /* zlaswp_ */
static /* Subroutine */ int dlacn2_ (Tcl_Interp *interp, integer *n, doublereal *v, doublereal *x, 	integer *isgn, doublereal *est, integer *kase, integer *isave)
{
    integer i__1;
    doublereal d__1;

    double d_sign(doublereal *, doublereal *);
    integer i_dnnt(doublereal *);

    integer i__;
    doublereal temp;
    integer jlast;
    doublereal altsgn, estold;





















    --isave;
    --isgn;
    --x;
    --v;

    if (*kase == 0) {
	i__1 = *n;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    x[i__] = 1. / (doublereal) (*n);
	}
	*kase = 1;
	isave[1] = 1;
return TCL_OK;
    }

    switch (isave[1]) {
	case 1:  goto L20;
	case 2:  goto L40;
	case 3:  goto L70;
	case 4:  goto L110;
	case 5:  goto L140;
    }


L20:
    if (*n == 1) {
	v[1] = x[1];
	*est = abs(v[1]);
	goto L150;
    }
    *est = dasum_(n, &x[1], &dlacn2_c__1);

    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	x[i__] = d_sign(&dlacn2_c_b11, &x[i__]);
	isgn[i__] = i_dnnt(&x[i__]);
    }
    *kase = 2;
    isave[1] = 2;
return TCL_OK;


L40:
    isave[2] = idamax_(n, &x[1], &dlacn2_c__1);
    isave[3] = 2;


L50:
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	x[i__] = 0.;
    }
    x[isave[2]] = 1.;
    *kase = 1;
    isave[1] = 3;
return TCL_OK;


L70:
    if (dcopy_(interp, n, &x[1], &dlacn2_c__1, &v[1], &dlacn2_c__1)!=TCL_OK) { return TCL_ERROR; }

    estold = *est;
    *est = dasum_(n, &v[1], &dlacn2_c__1);
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	d__1 = d_sign(&dlacn2_c_b11, &x[i__]);
	if (i_dnnt(&d__1) != isgn[i__]) {
	    goto L90;
	}
    }
    goto L120;

L90:
    if (*est <= estold) {
	goto L120;
    }

    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	x[i__] = d_sign(&dlacn2_c_b11, &x[i__]);
	isgn[i__] = i_dnnt(&x[i__]);
    }
    *kase = 2;
    isave[1] = 4;
return TCL_OK;


L110:
    jlast = isave[2];
    isave[2] = idamax_(n, &x[1], &dlacn2_c__1);
    if (x[jlast] != (d__1 = x[isave[2]], abs(d__1)) && isave[3] < 5) {
	++isave[3];
	goto L50;
    }


L120:
    altsgn = 1.;
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	x[i__] = altsgn * ((doublereal) (i__ - 1) / (doublereal) (*n - 1) + 
		1.);
	altsgn = -altsgn;
    }
    *kase = 1;
    isave[1] = 5;
return TCL_OK;


L140:
    temp = dasum_(n, &x[1], &dlacn2_c__1) / (doublereal) (*n * 3) * 2.;
    if (temp > *est) {
	if (dcopy_(interp, n, &x[1], &dlacn2_c__1, &v[1], &dlacn2_c__1)!=TCL_OK) { return TCL_ERROR; }

	*est = temp;
    }

L150:
    *kase = 0;
return TCL_OK;


} /* dlacn2_ */
static /* Subroutine */ int dlatrs_ (Tcl_Interp *interp, char *uplo, char *trans, char *diag, char *	normin, integer *n, doublereal *a, integer *lda, doublereal *x, 	doublereal *scale, doublereal *cnorm, integer *info)
{
    integer a_dim1, a_offset, i__1, i__2, i__3;
    doublereal d__1, d__2, d__3;

    integer i__, j;
    doublereal xj, rec, tjj;
    integer jinc;
    doublereal xbnd;
    integer imax;
    doublereal tmax, tjjs, xmax, grow, sumj;
    doublereal tscal, uscal;
    integer jlast;
    logical upper;
    doublereal bignum;
    logical notran;
    integer jfirst;
    doublereal smlnum;
    logical nounit;










































    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --x;
    --cnorm;

    *info = 0;
    upper = lsame_(uplo, "U");
    notran = lsame_(trans, "N");
    nounit = lsame_(diag, "N");


    if (! upper && ! lsame_(uplo, "L")) {
	*info = -1;
    } else if (! notran && ! lsame_(trans, "T") && ! 
	    lsame_(trans, "C")) {
	*info = -2;
    } else if (! nounit && ! lsame_(diag, "U")) {
	*info = -3;
    } else if (! lsame_(normin, "Y") && ! lsame_(normin, 
	     "N")) {
	*info = -4;
    } else if (*n < 0) {
	*info = -5;
    } else if (*lda < max(1,*n)) {
	*info = -7;
    }
    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DLATRS", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


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


    smlnum = dlamch_("Safe minimum") / dlamch_("Precision");
    bignum = 1. / smlnum;
    *scale = 1.;

    if (lsame_(normin, "N")) {


	if (upper) {


	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = j - 1;
		cnorm[j] = dasum_(&i__2, &a[j * a_dim1 + 1], &dlatrs_c__1);
	    }
	} else {


	    i__1 = *n - 1;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = *n - j;
		cnorm[j] = dasum_(&i__2, &a[j + 1 + j * a_dim1], &dlatrs_c__1);
	    }
	    cnorm[*n] = 0.;
	}
    }


    imax = idamax_(n, &cnorm[1], &dlatrs_c__1);
    tmax = cnorm[imax];
    if (tmax <= bignum) {
	tscal = 1.;
    } else {
	tscal = 1. / (smlnum * tmax);
	if (dscal_(interp, n, &tscal, &cnorm[1], &dlatrs_c__1)!=TCL_OK) { return TCL_ERROR; }

    }


    j = idamax_(n, &x[1], &dlatrs_c__1);
    xmax = (d__1 = x[j], abs(d__1));
    xbnd = xmax;
    if (notran) {


	if (upper) {
	    jfirst = *n;
	    jlast = 1;
	    jinc = -1;
	} else {
	    jfirst = 1;
	    jlast = *n;
	    jinc = 1;
	}

	if (tscal != 1.) {
	    grow = 0.;
	    goto L50;
	}

	if (nounit) {



	    grow = 1. / max(xbnd,smlnum);
	    xbnd = grow;
	    i__1 = jlast;
	    i__2 = jinc;
	    for (j = jfirst; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) {


		if (grow <= smlnum) {
		    goto L50;
		}


		tjj = (d__1 = a[j + j * a_dim1], abs(d__1));
		d__1 = xbnd, d__2 = min(1.,tjj) * grow;
		xbnd = min(d__1,d__2);
		if (tjj + cnorm[j] >= smlnum) {


		    grow *= tjj / (tjj + cnorm[j]);
		} else {


		    grow = 0.;
		}
	    }
	    grow = xbnd;
	} else {



	    d__1 = 1., d__2 = 1. / max(xbnd,smlnum);
	    grow = min(d__1,d__2);
	    i__2 = jlast;
	    i__1 = jinc;
	    for (j = jfirst; i__1 < 0 ? j >= i__2 : j <= i__2; j += i__1) {


		if (grow <= smlnum) {
		    goto L50;
		}


		grow *= 1. / (cnorm[j] + 1.);
	    }
	}
L50:

	;
    } else {


	if (upper) {
	    jfirst = 1;
	    jlast = *n;
	    jinc = 1;
	} else {
	    jfirst = *n;
	    jlast = 1;
	    jinc = -1;
	}

	if (tscal != 1.) {
	    grow = 0.;
	    goto L80;
	}

	if (nounit) {



	    grow = 1. / max(xbnd,smlnum);
	    xbnd = grow;
	    i__1 = jlast;
	    i__2 = jinc;
	    for (j = jfirst; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) {


		if (grow <= smlnum) {
		    goto L80;
		}


		xj = cnorm[j] + 1.;
		d__1 = grow, d__2 = xbnd / xj;
		grow = min(d__1,d__2);


		tjj = (d__1 = a[j + j * a_dim1], abs(d__1));
		if (xj > tjj) {
		    xbnd *= tjj / xj;
		}
	    }
	    grow = min(grow,xbnd);
	} else {



	    d__1 = 1., d__2 = 1. / max(xbnd,smlnum);
	    grow = min(d__1,d__2);
	    i__2 = jlast;
	    i__1 = jinc;
	    for (j = jfirst; i__1 < 0 ? j >= i__2 : j <= i__2; j += i__1) {


		if (grow <= smlnum) {
		    goto L80;
		}


		xj = cnorm[j] + 1.;
		grow /= xj;
	    }
	}
L80:
	;
    }

    if (grow * tscal > smlnum) {


	if (dtrsv_(interp, uplo, trans, diag, n, &a[a_offset], lda, &x[1], &dlatrs_c__1)!=TCL_OK) { return TCL_ERROR; }

    } else {


	if (xmax > bignum) {


	    *scale = bignum / xmax;
	    if (dscal_(interp, n, scale, &x[1], &dlatrs_c__1)!=TCL_OK) { return TCL_ERROR; }

	    xmax = bignum;
	}

	if (notran) {


	    i__1 = jlast;
	    i__2 = jinc;
	    for (j = jfirst; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) {


		xj = (d__1 = x[j], abs(d__1));
		if (nounit) {
		    tjjs = a[j + j * a_dim1] * tscal;
		} else {
		    tjjs = tscal;
		    if (tscal == 1.) {
			goto L100;
		    }
		}
		tjj = abs(tjjs);
		if (tjj > smlnum) {


		    if (tjj < 1.) {
			if (xj > tjj * bignum) {


			    rec = 1. / xj;
			    if (dscal_(interp, n, &rec, &x[1], &dlatrs_c__1)!=TCL_OK) { return TCL_ERROR; }

			    *scale *= rec;
			    xmax *= rec;
			}
		    }
		    x[j] /= tjjs;
		    xj = (d__1 = x[j], abs(d__1));
		} else if (tjj > 0.) {


		    if (xj > tjj * bignum) {


			rec = tjj * bignum / xj;
			if (cnorm[j] > 1.) {


			    rec /= cnorm[j];
			}
			if (dscal_(interp, n, &rec, &x[1], &dlatrs_c__1)!=TCL_OK) { return TCL_ERROR; }

			*scale *= rec;
			xmax *= rec;
		    }
		    x[j] /= tjjs;
		    xj = (d__1 = x[j], abs(d__1));
		} else {


		    i__3 = *n;
		    for (i__ = 1; i__ <= i__3; ++i__) {
			x[i__] = 0.;
		    }
		    x[j] = 1.;
		    xj = 1.;
		    *scale = 0.;
		    xmax = 0.;
		}
L100:


		if (xj > 1.) {
		    rec = 1. / xj;
		    if (cnorm[j] > (bignum - xmax) * rec) {


			rec *= .5;
			if (dscal_(interp, n, &rec, &x[1], &dlatrs_c__1)!=TCL_OK) { return TCL_ERROR; }

			*scale *= rec;
		    }
		} else if (xj * cnorm[j] > bignum - xmax) {


		    if (dscal_(interp, n, &dlatrs_c_b36, &x[1], &dlatrs_c__1)!=TCL_OK) { return TCL_ERROR; }

		    *scale *= .5;
		}

		if (upper) {
		    if (j > 1) {


			i__3 = j - 1;
			d__1 = -x[j] * tscal;
			if (daxpy_(interp, &i__3, &d__1, &a[j * a_dim1 + 1], &dlatrs_c__1, &x[1], 				 &dlatrs_c__1)!=TCL_OK) { return TCL_ERROR; }


			i__3 = j - 1;
			i__ = idamax_(&i__3, &x[1], &dlatrs_c__1);
			xmax = (d__1 = x[i__], abs(d__1));
		    }
		} else {
		    if (j < *n) {


			i__3 = *n - j;
			d__1 = -x[j] * tscal;
			if (daxpy_(interp, &i__3, &d__1, &a[j + 1 + j * a_dim1], &dlatrs_c__1, &				x[j + 1], &dlatrs_c__1)!=TCL_OK) { return TCL_ERROR; }


			i__3 = *n - j;
			i__ = j + idamax_(&i__3, &x[j + 1], &dlatrs_c__1);
			xmax = (d__1 = x[i__], abs(d__1));
		    }
		}
	    }

	} else {


	    i__2 = jlast;
	    i__1 = jinc;
	    for (j = jfirst; i__1 < 0 ? j >= i__2 : j <= i__2; j += i__1) {


		xj = (d__1 = x[j], abs(d__1));
		uscal = tscal;
		rec = 1. / max(xmax,1.);
		if (cnorm[j] > (bignum - xj) * rec) {


		    rec *= .5;
		    if (nounit) {
			tjjs = a[j + j * a_dim1] * tscal;
		    } else {
			tjjs = tscal;
		    }
		    tjj = abs(tjjs);
		    if (tjj > 1.) {


			d__1 = 1., d__2 = rec * tjj;
			rec = min(d__1,d__2);
			uscal /= tjjs;
		    }
		    if (rec < 1.) {
			if (dscal_(interp, n, &rec, &x[1], &dlatrs_c__1)!=TCL_OK) { return TCL_ERROR; }

			*scale *= rec;
			xmax *= rec;
		    }
		}

		sumj = 0.;
		if (uscal == 1.) {


		    if (upper) {
			i__3 = j - 1;
			sumj = ddot_(&i__3, &a[j * a_dim1 + 1], &dlatrs_c__1, &x[1], 
				&dlatrs_c__1);
		    } else if (j < *n) {
			i__3 = *n - j;
			sumj = ddot_(&i__3, &a[j + 1 + j * a_dim1], &dlatrs_c__1, &x[
				j + 1], &dlatrs_c__1);
		    }
		} else {


		    if (upper) {
			i__3 = j - 1;
			for (i__ = 1; i__ <= i__3; ++i__) {
			    sumj += a[i__ + j * a_dim1] * uscal * x[i__];
			}
		    } else if (j < *n) {
			i__3 = *n;
			for (i__ = j + 1; i__ <= i__3; ++i__) {
			    sumj += a[i__ + j * a_dim1] * uscal * x[i__];
			}
		    }
		}

		if (uscal == tscal) {


		    x[j] -= sumj;
		    xj = (d__1 = x[j], abs(d__1));
		    if (nounit) {
			tjjs = a[j + j * a_dim1] * tscal;
		    } else {
			tjjs = tscal;
			if (tscal == 1.) {
			    goto L150;
			}
		    }


		    tjj = abs(tjjs);
		    if (tjj > smlnum) {


			if (tjj < 1.) {
			    if (xj > tjj * bignum) {


				rec = 1. / xj;
				if (dscal_(interp, n, &rec, &x[1], &dlatrs_c__1)!=TCL_OK) { return TCL_ERROR; }

				*scale *= rec;
				xmax *= rec;
			    }
			}
			x[j] /= tjjs;
		    } else if (tjj > 0.) {


			if (xj > tjj * bignum) {


			    rec = tjj * bignum / xj;
			    if (dscal_(interp, n, &rec, &x[1], &dlatrs_c__1)!=TCL_OK) { return TCL_ERROR; }

			    *scale *= rec;
			    xmax *= rec;
			}
			x[j] /= tjjs;
		    } else {


			i__3 = *n;
			for (i__ = 1; i__ <= i__3; ++i__) {
			    x[i__] = 0.;
			}
			x[j] = 1.;
			*scale = 0.;
			xmax = 0.;
		    }
L150:
		    ;
		} else {


		    x[j] = x[j] / tjjs - sumj;
		}
		d__2 = xmax, d__3 = (d__1 = x[j], abs(d__1));
		xmax = max(d__2,d__3);
	    }
	}
	*scale /= tscal;
    }


    if (tscal != 1.) {
	d__1 = 1. / tscal;
	if (dscal_(interp, n, &d__1, &cnorm[1], &dlatrs_c__1)!=TCL_OK) { return TCL_ERROR; }

    }

return TCL_OK;


} /* dlatrs_ */
static /* Subroutine */ int zlacn2_ (Tcl_Interp *interp, integer *n, doublecomplex *v, doublecomplex *x, 	doublereal *est, integer *kase, integer *isave)
{
    integer i__1, i__2, i__3;
    doublereal d__1, d__2;
    doublecomplex z__1;

    double z_abs(doublecomplex *), d_imag(doublecomplex *);

    integer i__;
    doublereal temp, absxi;
    integer jlast;
    doublereal safmin, altsgn, estold;





















    --isave;
    --x;
    --v;

    safmin = dlamch_("Safe minimum");
    if (*kase == 0) {
	i__1 = *n;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    i__2 = i__;
	    d__1 = 1. / (doublereal) (*n);
	    z__1.r = d__1, z__1.i = 0.;
	    x[i__2].r = z__1.r, x[i__2].i = z__1.i;
	}
	*kase = 1;
	isave[1] = 1;
return TCL_OK;
    }

    switch (isave[1]) {
	case 1:  goto L20;
	case 2:  goto L40;
	case 3:  goto L70;
	case 4:  goto L90;
	case 5:  goto L120;
    }


L20:
    if (*n == 1) {
	v[1].r = x[1].r, v[1].i = x[1].i;
	*est = z_abs(&v[1]);
	goto L130;
    }
    *est = dzsum1_(n, &x[1], &zlacn2_c__1);

    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	absxi = z_abs(&x[i__]);
	if (absxi > safmin) {
	    i__2 = i__;
	    i__3 = i__;
	    d__1 = x[i__3].r / absxi;
	    d__2 = d_imag(&x[i__]) / absxi;
	    z__1.r = d__1, z__1.i = d__2;
	    x[i__2].r = z__1.r, x[i__2].i = z__1.i;
	} else {
	    i__2 = i__;
	    x[i__2].r = 1., x[i__2].i = 0.;
	}
    }
    *kase = 2;
    isave[1] = 2;
return TCL_OK;


L40:
    isave[2] = izmax1_(n, &x[1], &zlacn2_c__1);
    isave[3] = 2;


L50:
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	i__2 = i__;
	x[i__2].r = 0., x[i__2].i = 0.;
    }
    i__1 = isave[2];
    x[i__1].r = 1., x[i__1].i = 0.;
    *kase = 1;
    isave[1] = 3;
return TCL_OK;


L70:
    if (zcopy_(interp, n, &x[1], &zlacn2_c__1, &v[1], &zlacn2_c__1)!=TCL_OK) { return TCL_ERROR; }

    estold = *est;
    *est = dzsum1_(n, &v[1], &zlacn2_c__1);

    if (*est <= estold) {
	goto L100;
    }

    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	absxi = z_abs(&x[i__]);
	if (absxi > safmin) {
	    i__2 = i__;
	    i__3 = i__;
	    d__1 = x[i__3].r / absxi;
	    d__2 = d_imag(&x[i__]) / absxi;
	    z__1.r = d__1, z__1.i = d__2;
	    x[i__2].r = z__1.r, x[i__2].i = z__1.i;
	} else {
	    i__2 = i__;
	    x[i__2].r = 1., x[i__2].i = 0.;
	}
    }
    *kase = 2;
    isave[1] = 4;
return TCL_OK;


L90:
    jlast = isave[2];
    isave[2] = izmax1_(n, &x[1], &zlacn2_c__1);
    if (z_abs(&x[jlast]) != z_abs(&x[isave[2]]) && isave[3] < 5) {
	++isave[3];
	goto L50;
    }


L100:
    altsgn = 1.;
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	i__2 = i__;
	d__1 = altsgn * ((doublereal) (i__ - 1) / (doublereal) (*n - 1) + 1.);
	z__1.r = d__1, z__1.i = 0.;
	x[i__2].r = z__1.r, x[i__2].i = z__1.i;
	altsgn = -altsgn;
    }
    *kase = 1;
    isave[1] = 5;
return TCL_OK;


L120:
    temp = dzsum1_(n, &x[1], &zlacn2_c__1) / (doublereal) (*n * 3) * 2.;
    if (temp > *est) {
	if (zcopy_(interp, n, &x[1], &zlacn2_c__1, &v[1], &zlacn2_c__1)!=TCL_OK) { return TCL_ERROR; }

	*est = temp;
    }

L130:
    *kase = 0;
return TCL_OK;


} /* zlacn2_ */
static /* Subroutine */ int dtrexc_ (Tcl_Interp *interp, char *compq, integer *n, doublereal *t, integer *	ldt, doublereal *q, integer *ldq, integer *ifst, integer *ilst, 	doublereal *work, integer *info)
{
    integer q_dim1, q_offset, t_dim1, t_offset, i__1;

    integer nbf, nbl, here;
    logical wantq;
    integer nbnext;





















    t_dim1 = *ldt;
    t_offset = 1 + t_dim1;
    t -= t_offset;
    q_dim1 = *ldq;
    q_offset = 1 + q_dim1;
    q -= q_offset;
    --work;

    *info = 0;
    wantq = lsame_(compq, "V");
    if (! wantq && ! lsame_(compq, "N")) {
	*info = -1;
    } else if (*n < 0) {
	*info = -2;
    } else if (*ldt < max(1,*n)) {
	*info = -4;
    } else if (*ldq < 1 || wantq && *ldq < max(1,*n)) {
	*info = -6;
    } else if (*ifst < 1 || *ifst > *n) {
	*info = -7;
    } else if (*ilst < 1 || *ilst > *n) {
	*info = -8;
    }
    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DTREXC", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


    if (*n <= 1) {
return TCL_OK;
    }


    if (*ifst > 1) {
	if (t[*ifst + (*ifst - 1) * t_dim1] != 0.) {
	    --(*ifst);
	}
    }
    nbf = 1;
    if (*ifst < *n) {
	if (t[*ifst + 1 + *ifst * t_dim1] != 0.) {
	    nbf = 2;
	}
    }


    if (*ilst > 1) {
	if (t[*ilst + (*ilst - 1) * t_dim1] != 0.) {
	    --(*ilst);
	}
    }
    nbl = 1;
    if (*ilst < *n) {
	if (t[*ilst + 1 + *ilst * t_dim1] != 0.) {
	    nbl = 2;
	}
    }

    if (*ifst == *ilst) {
return TCL_OK;
    }

    if (*ifst < *ilst) {


	if (nbf == 2 && nbl == 1) {
	    --(*ilst);
	}
	if (nbf == 1 && nbl == 2) {
	    ++(*ilst);
	}

	here = *ifst;

L10:


	if (nbf == 1 || nbf == 2) {


	    nbnext = 1;
	    if (here + nbf + 1 <= *n) {
		if (t[here + nbf + 1 + (here + nbf) * t_dim1] != 0.) {
		    nbnext = 2;
		}
	    }
	    if (dlaexc_(interp, &wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, &here, &		    nbf, &nbnext, &work[1], info)!=TCL_OK) { return TCL_ERROR; }


	    if (*info != 0) {
		*ilst = here;
return TCL_OK;
	    }
	    here += nbnext;


	    if (nbf == 2) {
		if (t[here + 1 + here * t_dim1] == 0.) {
		    nbf = 3;
		}
	    }

	} else {


	    nbnext = 1;
	    if (here + 3 <= *n) {
		if (t[here + 3 + (here + 2) * t_dim1] != 0.) {
		    nbnext = 2;
		}
	    }
	    i__1 = here + 1;
	    if (dlaexc_(interp, &wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, &i__1, &		    dtrexc_c__1, &nbnext, &work[1], info)!=TCL_OK) { return TCL_ERROR; }


	    if (*info != 0) {
		*ilst = here;
return TCL_OK;
	    }
	    if (nbnext == 1) {


		if (dlaexc_(interp, &wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, &			here, &dtrexc_c__1, &nbnext, &work[1], info)!=TCL_OK) { return TCL_ERROR; }


		++here;
	    } else {


		if (t[here + 2 + (here + 1) * t_dim1] == 0.) {
		    nbnext = 1;
		}
		if (nbnext == 2) {


		    if (dlaexc_(interp, &wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, &			    here, &dtrexc_c__1, &nbnext, &work[1], info)!=TCL_OK) { return TCL_ERROR; }


		    if (*info != 0) {
			*ilst = here;
return TCL_OK;
		    }
		    here += 2;
		} else {


		    if (dlaexc_(interp, &wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, &			    here, &dtrexc_c__1, &dtrexc_c__1, &work[1], info)!=TCL_OK) { return TCL_ERROR; }


		    i__1 = here + 1;
		    if (dlaexc_(interp, &wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, &			    i__1, &dtrexc_c__1, &dtrexc_c__1, &work[1], info)!=TCL_OK) { return TCL_ERROR; }


		    here += 2;
		}
	    }
	}
	if (here < *ilst) {
	    goto L10;
	}

    } else {

	here = *ifst;
L20:


	if (nbf == 1 || nbf == 2) {


	    nbnext = 1;
	    if (here >= 3) {
		if (t[here - 1 + (here - 2) * t_dim1] != 0.) {
		    nbnext = 2;
		}
	    }
	    i__1 = here - nbnext;
	    if (dlaexc_(interp, &wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, &i__1, &		    nbnext, &nbf, &work[1], info)!=TCL_OK) { return TCL_ERROR; }


	    if (*info != 0) {
		*ilst = here;
return TCL_OK;
	    }
	    here -= nbnext;


	    if (nbf == 2) {
		if (t[here + 1 + here * t_dim1] == 0.) {
		    nbf = 3;
		}
	    }

	} else {


	    nbnext = 1;
	    if (here >= 3) {
		if (t[here - 1 + (here - 2) * t_dim1] != 0.) {
		    nbnext = 2;
		}
	    }
	    i__1 = here - nbnext;
	    if (dlaexc_(interp, &wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, &i__1, &		    nbnext, &dtrexc_c__1, &work[1], info)!=TCL_OK) { return TCL_ERROR; }


	    if (*info != 0) {
		*ilst = here;
return TCL_OK;
	    }
	    if (nbnext == 1) {


		if (dlaexc_(interp, &wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, &			here, &nbnext, &dtrexc_c__1, &work[1], info)!=TCL_OK) { return TCL_ERROR; }


		--here;
	    } else {


		if (t[here + (here - 1) * t_dim1] == 0.) {
		    nbnext = 1;
		}
		if (nbnext == 2) {


		    i__1 = here - 1;
		    if (dlaexc_(interp, &wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, &			    i__1, &dtrexc_c__2, &dtrexc_c__1, &work[1], info)!=TCL_OK) { return TCL_ERROR; }


		    if (*info != 0) {
			*ilst = here;
return TCL_OK;
		    }
		    here += -2;
		} else {


		    if (dlaexc_(interp, &wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, &			    here, &dtrexc_c__1, &dtrexc_c__1, &work[1], info)!=TCL_OK) { return TCL_ERROR; }


		    i__1 = here - 1;
		    if (dlaexc_(interp, &wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, &			    i__1, &dtrexc_c__1, &dtrexc_c__1, &work[1], info)!=TCL_OK) { return TCL_ERROR; }


		    here += -2;
		}
	    }
	}
	if (here > *ilst) {
	    goto L20;
	}
    }
    *ilst = here;

return TCL_OK;


} /* dtrexc_ */
static /* Subroutine */ int dtrsyl_ (Tcl_Interp *interp, char *trana, char *tranb, integer *isgn, integer 	*m, integer *n, doublereal *a, integer *lda, doublereal *b, integer *	ldb, doublereal *c__, integer *ldc, doublereal *scale, integer *info)
{
    integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, 
	    i__3, i__4;
    doublereal d__1, d__2;

    integer j, k, l;
    doublereal x[4]	/* was [2][2] */;
    integer k1, k2, l1, l2;
    doublereal a11, db, da11, vec[4]	/* was [2][2] */, dum[1], eps, sgn;
    integer ierr;
    doublereal smin, suml, sumr;
    integer knext, lnext;
    doublereal xnorm;
    doublereal scaloc;
    doublereal bignum;
    logical notrna, notrnb;
    doublereal smlnum;


























    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    b_dim1 = *ldb;
    b_offset = 1 + b_dim1;
    b -= b_offset;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;

    notrna = lsame_(trana, "N");
    notrnb = lsame_(tranb, "N");

    *info = 0;
    if (! notrna && ! lsame_(trana, "T") && ! lsame_(
	    trana, "C")) {
	*info = -1;
    } else if (! notrnb && ! lsame_(tranb, "T") && ! 
	    lsame_(tranb, "C")) {
	*info = -2;
    } else if (*isgn != 1 && *isgn != -1) {
	*info = -3;
    } else if (*m < 0) {
	*info = -4;
    } else if (*n < 0) {
	*info = -5;
    } else if (*lda < max(1,*m)) {
	*info = -7;
    } else if (*ldb < max(1,*n)) {
	*info = -9;
    } else if (*ldc < max(1,*m)) {
	*info = -11;
    }
    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DTRSYL", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


    *scale = 1.;
    if (*m == 0 || *n == 0) {
return TCL_OK;
    }


    eps = dlamch_("P");
    smlnum = dlamch_("S");
    bignum = 1. / smlnum;
    if (dlabad_(interp, &smlnum, &bignum)!=TCL_OK) { return TCL_ERROR; }

    smlnum = smlnum * (doublereal) (*m * *n) / eps;
    bignum = 1. / smlnum;

    d__1 = smlnum, d__2 = eps * dlange_("M", m, m, &a[a_offset], lda, dum), d__1 = max(d__1,d__2), d__2 = eps * dlange_("M", n, n, 
	    &b[b_offset], ldb, dum);
    smin = max(d__1,d__2);

    sgn = (doublereal) (*isgn);

    if (notrna && notrnb) {






	lnext = 1;
	i__1 = *n;
	for (l = 1; l <= i__1; ++l) {
	    if (l < lnext) {
		goto L60;
	    }
	    if (l == *n) {
		l1 = l;
		l2 = l;
	    } else {
		if (b[l + 1 + l * b_dim1] != 0.) {
		    l1 = l;
		    l2 = l + 1;
		    lnext = l + 2;
		} else {
		    l1 = l;
		    l2 = l;
		    lnext = l + 1;
		}
	    }


	    knext = *m;
	    for (k = *m; k >= 1; --k) {
		if (k > knext) {
		    goto L50;
		}
		if (k == 1) {
		    k1 = k;
		    k2 = k;
		} else {
		    if (a[k + (k - 1) * a_dim1] != 0.) {
			k1 = k - 1;
			k2 = k;
			knext = k - 2;
		    } else {
			k1 = k;
			k2 = k;
			knext = k - 1;
		    }
		}

		if (l1 == l2 && k1 == k2) {
		    i__2 = *m - k1;
		    i__3 = k1 + 1;
		    i__4 = k1 + 1;
		    suml = ddot_(&i__2, &a[k1 + min(i__3, *m)* a_dim1], lda, &
			    c__[min(i__4, *m)+ l1 * c_dim1], &dtrsyl_c__1);
		    i__2 = l1 - 1;
		    sumr = ddot_(&i__2, &c__[k1 + c_dim1], ldc, &b[l1 * 
			    b_dim1 + 1], &dtrsyl_c__1);
		    vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr);
		    scaloc = 1.;

		    a11 = a[k1 + k1 * a_dim1] + sgn * b[l1 + l1 * b_dim1];
		    da11 = abs(a11);
		    if (da11 <= smin) {
			a11 = smin;
			da11 = smin;
			*info = 1;
		    }
		    db = abs(vec[0]);
		    if (da11 < 1. && db > 1.) {
			if (db > bignum * da11) {
			    scaloc = 1. / db;
			}
		    }
		    x[0] = vec[0] * scaloc / a11;

		    if (scaloc != 1.) {
			i__2 = *n;
			for (j = 1; j <= i__2; ++j) {
			    if (dscal_(interp, m, &scaloc, &c__[j * c_dim1 + 1], &dtrsyl_c__1)!=TCL_OK) { return TCL_ERROR; }

			}
			*scale *= scaloc;
		    }
		    c__[k1 + l1 * c_dim1] = x[0];

		} else if (l1 == l2 && k1 != k2) {

		    i__2 = *m - k2;
		    i__3 = k2 + 1;
		    i__4 = k2 + 1;
		    suml = ddot_(&i__2, &a[k1 + min(i__3, *m)* a_dim1], lda, &
			    c__[min(i__4, *m)+ l1 * c_dim1], &dtrsyl_c__1);
		    i__2 = l1 - 1;
		    sumr = ddot_(&i__2, &c__[k1 + c_dim1], ldc, &b[l1 * 
			    b_dim1 + 1], &dtrsyl_c__1);
		    vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr);

		    i__2 = *m - k2;
		    i__3 = k2 + 1;
		    i__4 = k2 + 1;
		    suml = ddot_(&i__2, &a[k2 + min(i__3, *m)* a_dim1], lda, &
			    c__[min(i__4, *m)+ l1 * c_dim1], &dtrsyl_c__1);
		    i__2 = l1 - 1;
		    sumr = ddot_(&i__2, &c__[k2 + c_dim1], ldc, &b[l1 * 
			    b_dim1 + 1], &dtrsyl_c__1);
		    vec[1] = c__[k2 + l1 * c_dim1] - (suml + sgn * sumr);

		    d__1 = -sgn * b[l1 + l1 * b_dim1];
		    if (dlaln2_(interp, &dtrsyl_c_false, &dtrsyl_c__2, &dtrsyl_c__1, &smin, &dtrsyl_c_b26, &a[k1 + k1 			    * a_dim1], lda, &dtrsyl_c_b26, &dtrsyl_c_b26, vec, &dtrsyl_c__2, &d__1, 
			     &dtrsyl_c_b30, x, &dtrsyl_c__2, &scaloc, &xnorm, &ierr)!=TCL_OK) { return TCL_ERROR; }


		    if (ierr != 0) {
			*info = 1;
		    }

		    if (scaloc != 1.) {
			i__2 = *n;
			for (j = 1; j <= i__2; ++j) {
			    if (dscal_(interp, m, &scaloc, &c__[j * c_dim1 + 1], &dtrsyl_c__1)!=TCL_OK) { return TCL_ERROR; }

			}
			*scale *= scaloc;
		    }
		    c__[k1 + l1 * c_dim1] = x[0];
		    c__[k2 + l1 * c_dim1] = x[1];

		} else if (l1 != l2 && k1 == k2) {

		    i__2 = *m - k1;
		    i__3 = k1 + 1;
		    i__4 = k1 + 1;
		    suml = ddot_(&i__2, &a[k1 + min(i__3, *m)* a_dim1], lda, &
			    c__[min(i__4, *m)+ l1 * c_dim1], &dtrsyl_c__1);
		    i__2 = l1 - 1;
		    sumr = ddot_(&i__2, &c__[k1 + c_dim1], ldc, &b[l1 * 
			    b_dim1 + 1], &dtrsyl_c__1);
		    vec[0] = sgn * (c__[k1 + l1 * c_dim1] - (suml + sgn * 
			    sumr));

		    i__2 = *m - k1;
		    i__3 = k1 + 1;
		    i__4 = k1 + 1;
		    suml = ddot_(&i__2, &a[k1 + min(i__3, *m)* a_dim1], lda, &
			    c__[min(i__4, *m)+ l2 * c_dim1], &dtrsyl_c__1);
		    i__2 = l1 - 1;
		    sumr = ddot_(&i__2, &c__[k1 + c_dim1], ldc, &b[l2 * 
			    b_dim1 + 1], &dtrsyl_c__1);
		    vec[1] = sgn * (c__[k1 + l2 * c_dim1] - (suml + sgn * 
			    sumr));

		    d__1 = -sgn * a[k1 + k1 * a_dim1];
		    if (dlaln2_(interp, &dtrsyl_c_true, &dtrsyl_c__2, &dtrsyl_c__1, &smin, &dtrsyl_c_b26, &b[l1 + l1 *			     b_dim1], ldb, &dtrsyl_c_b26, &dtrsyl_c_b26, vec, &dtrsyl_c__2, &d__1, 
			    &dtrsyl_c_b30, x, &dtrsyl_c__2, &scaloc, &xnorm, &ierr)!=TCL_OK) { return TCL_ERROR; }


		    if (ierr != 0) {
			*info = 1;
		    }

		    if (scaloc != 1.) {
			i__2 = *n;
			for (j = 1; j <= i__2; ++j) {
			    if (dscal_(interp, m, &scaloc, &c__[j * c_dim1 + 1], &dtrsyl_c__1)!=TCL_OK) { return TCL_ERROR; }

			}
			*scale *= scaloc;
		    }
		    c__[k1 + l1 * c_dim1] = x[0];
		    c__[k1 + l2 * c_dim1] = x[1];

		} else if (l1 != l2 && k1 != k2) {

		    i__2 = *m - k2;
		    i__3 = k2 + 1;
		    i__4 = k2 + 1;
		    suml = ddot_(&i__2, &a[k1 + min(i__3, *m)* a_dim1], lda, &
			    c__[min(i__4, *m)+ l1 * c_dim1], &dtrsyl_c__1);
		    i__2 = l1 - 1;
		    sumr = ddot_(&i__2, &c__[k1 + c_dim1], ldc, &b[l1 * 
			    b_dim1 + 1], &dtrsyl_c__1);
		    vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr);

		    i__2 = *m - k2;
		    i__3 = k2 + 1;
		    i__4 = k2 + 1;
		    suml = ddot_(&i__2, &a[k1 + min(i__3, *m)* a_dim1], lda, &
			    c__[min(i__4, *m)+ l2 * c_dim1], &dtrsyl_c__1);
		    i__2 = l1 - 1;
		    sumr = ddot_(&i__2, &c__[k1 + c_dim1], ldc, &b[l2 * 
			    b_dim1 + 1], &dtrsyl_c__1);
		    vec[2] = c__[k1 + l2 * c_dim1] - (suml + sgn * sumr);

		    i__2 = *m - k2;
		    i__3 = k2 + 1;
		    i__4 = k2 + 1;
		    suml = ddot_(&i__2, &a[k2 + min(i__3, *m)* a_dim1], lda, &
			    c__[min(i__4, *m)+ l1 * c_dim1], &dtrsyl_c__1);
		    i__2 = l1 - 1;
		    sumr = ddot_(&i__2, &c__[k2 + c_dim1], ldc, &b[l1 * 
			    b_dim1 + 1], &dtrsyl_c__1);
		    vec[1] = c__[k2 + l1 * c_dim1] - (suml + sgn * sumr);

		    i__2 = *m - k2;
		    i__3 = k2 + 1;
		    i__4 = k2 + 1;
		    suml = ddot_(&i__2, &a[k2 + min(i__3, *m)* a_dim1], lda, &
			    c__[min(i__4, *m)+ l2 * c_dim1], &dtrsyl_c__1);
		    i__2 = l1 - 1;
		    sumr = ddot_(&i__2, &c__[k2 + c_dim1], ldc, &b[l2 * 
			    b_dim1 + 1], &dtrsyl_c__1);
		    vec[3] = c__[k2 + l2 * c_dim1] - (suml + sgn * sumr);

		    if (dlasy2_(interp, &dtrsyl_c_false, &dtrsyl_c_false, isgn, &dtrsyl_c__2, &dtrsyl_c__2, &a[k1 + 			    k1 * a_dim1], lda, &b[l1 + l1 * b_dim1], ldb, vec, 
			     &dtrsyl_c__2, &scaloc, x, &dtrsyl_c__2, &xnorm, &ierr)!=TCL_OK) { return TCL_ERROR; }


		    if (ierr != 0) {
			*info = 1;
		    }

		    if (scaloc != 1.) {
			i__2 = *n;
			for (j = 1; j <= i__2; ++j) {
			    if (dscal_(interp, m, &scaloc, &c__[j * c_dim1 + 1], &dtrsyl_c__1)!=TCL_OK) { return TCL_ERROR; }

			}
			*scale *= scaloc;
		    }
		    c__[k1 + l1 * c_dim1] = x[0];
		    c__[k1 + l2 * c_dim1] = x[2];
		    c__[k2 + l1 * c_dim1] = x[1];
		    c__[k2 + l2 * c_dim1] = x[3];
		}

L50:
		;
	    }

L60:
	    ;
	}

    } else if (! notrna && notrnb) {






	lnext = 1;
	i__1 = *n;
	for (l = 1; l <= i__1; ++l) {
	    if (l < lnext) {
		goto L120;
	    }
	    if (l == *n) {
		l1 = l;
		l2 = l;
	    } else {
		if (b[l + 1 + l * b_dim1] != 0.) {
		    l1 = l;
		    l2 = l + 1;
		    lnext = l + 2;
		} else {
		    l1 = l;
		    l2 = l;
		    lnext = l + 1;
		}
	    }


	    knext = 1;
	    i__2 = *m;
	    for (k = 1; k <= i__2; ++k) {
		if (k < knext) {
		    goto L110;
		}
		if (k == *m) {
		    k1 = k;
		    k2 = k;
		} else {
		    if (a[k + 1 + k * a_dim1] != 0.) {
			k1 = k;
			k2 = k + 1;
			knext = k + 2;
		    } else {
			k1 = k;
			k2 = k;
			knext = k + 1;
		    }
		}

		if (l1 == l2 && k1 == k2) {
		    i__3 = k1 - 1;
		    suml = ddot_(&i__3, &a[k1 * a_dim1 + 1], &dtrsyl_c__1, &c__[l1 * 
			    c_dim1 + 1], &dtrsyl_c__1);
		    i__3 = l1 - 1;
		    sumr = ddot_(&i__3, &c__[k1 + c_dim1], ldc, &b[l1 * 
			    b_dim1 + 1], &dtrsyl_c__1);
		    vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr);
		    scaloc = 1.;

		    a11 = a[k1 + k1 * a_dim1] + sgn * b[l1 + l1 * b_dim1];
		    da11 = abs(a11);
		    if (da11 <= smin) {
			a11 = smin;
			da11 = smin;
			*info = 1;
		    }
		    db = abs(vec[0]);
		    if (da11 < 1. && db > 1.) {
			if (db > bignum * da11) {
			    scaloc = 1. / db;
			}
		    }
		    x[0] = vec[0] * scaloc / a11;

		    if (scaloc != 1.) {
			i__3 = *n;
			for (j = 1; j <= i__3; ++j) {
			    if (dscal_(interp, m, &scaloc, &c__[j * c_dim1 + 1], &dtrsyl_c__1)!=TCL_OK) { return TCL_ERROR; }

			}
			*scale *= scaloc;
		    }
		    c__[k1 + l1 * c_dim1] = x[0];

		} else if (l1 == l2 && k1 != k2) {

		    i__3 = k1 - 1;
		    suml = ddot_(&i__3, &a[k1 * a_dim1 + 1], &dtrsyl_c__1, &c__[l1 * 
			    c_dim1 + 1], &dtrsyl_c__1);
		    i__3 = l1 - 1;
		    sumr = ddot_(&i__3, &c__[k1 + c_dim1], ldc, &b[l1 * 
			    b_dim1 + 1], &dtrsyl_c__1);
		    vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr);

		    i__3 = k1 - 1;
		    suml = ddot_(&i__3, &a[k2 * a_dim1 + 1], &dtrsyl_c__1, &c__[l1 * 
			    c_dim1 + 1], &dtrsyl_c__1);
		    i__3 = l1 - 1;
		    sumr = ddot_(&i__3, &c__[k2 + c_dim1], ldc, &b[l1 * 
			    b_dim1 + 1], &dtrsyl_c__1);
		    vec[1] = c__[k2 + l1 * c_dim1] - (suml + sgn * sumr);

		    d__1 = -sgn * b[l1 + l1 * b_dim1];
		    if (dlaln2_(interp, &dtrsyl_c_true, &dtrsyl_c__2, &dtrsyl_c__1, &smin, &dtrsyl_c_b26, &a[k1 + k1 *			     a_dim1], lda, &dtrsyl_c_b26, &dtrsyl_c_b26, vec, &dtrsyl_c__2, &d__1, 
			    &dtrsyl_c_b30, x, &dtrsyl_c__2, &scaloc, &xnorm, &ierr)!=TCL_OK) { return TCL_ERROR; }


		    if (ierr != 0) {
			*info = 1;
		    }

		    if (scaloc != 1.) {
			i__3 = *n;
			for (j = 1; j <= i__3; ++j) {
			    if (dscal_(interp, m, &scaloc, &c__[j * c_dim1 + 1], &dtrsyl_c__1)!=TCL_OK) { return TCL_ERROR; }

			}
			*scale *= scaloc;
		    }
		    c__[k1 + l1 * c_dim1] = x[0];
		    c__[k2 + l1 * c_dim1] = x[1];

		} else if (l1 != l2 && k1 == k2) {

		    i__3 = k1 - 1;
		    suml = ddot_(&i__3, &a[k1 * a_dim1 + 1], &dtrsyl_c__1, &c__[l1 * 
			    c_dim1 + 1], &dtrsyl_c__1);
		    i__3 = l1 - 1;
		    sumr = ddot_(&i__3, &c__[k1 + c_dim1], ldc, &b[l1 * 
			    b_dim1 + 1], &dtrsyl_c__1);
		    vec[0] = sgn * (c__[k1 + l1 * c_dim1] - (suml + sgn * 
			    sumr));

		    i__3 = k1 - 1;
		    suml = ddot_(&i__3, &a[k1 * a_dim1 + 1], &dtrsyl_c__1, &c__[l2 * 
			    c_dim1 + 1], &dtrsyl_c__1);
		    i__3 = l1 - 1;
		    sumr = ddot_(&i__3, &c__[k1 + c_dim1], ldc, &b[l2 * 
			    b_dim1 + 1], &dtrsyl_c__1);
		    vec[1] = sgn * (c__[k1 + l2 * c_dim1] - (suml + sgn * 
			    sumr));

		    d__1 = -sgn * a[k1 + k1 * a_dim1];
		    if (dlaln2_(interp, &dtrsyl_c_true, &dtrsyl_c__2, &dtrsyl_c__1, &smin, &dtrsyl_c_b26, &b[l1 + l1 *			     b_dim1], ldb, &dtrsyl_c_b26, &dtrsyl_c_b26, vec, &dtrsyl_c__2, &d__1, 
			    &dtrsyl_c_b30, x, &dtrsyl_c__2, &scaloc, &xnorm, &ierr)!=TCL_OK) { return TCL_ERROR; }


		    if (ierr != 0) {
			*info = 1;
		    }

		    if (scaloc != 1.) {
			i__3 = *n;
			for (j = 1; j <= i__3; ++j) {
			    if (dscal_(interp, m, &scaloc, &c__[j * c_dim1 + 1], &dtrsyl_c__1)!=TCL_OK) { return TCL_ERROR; }

			}
			*scale *= scaloc;
		    }
		    c__[k1 + l1 * c_dim1] = x[0];
		    c__[k1 + l2 * c_dim1] = x[1];

		} else if (l1 != l2 && k1 != k2) {

		    i__3 = k1 - 1;
		    suml = ddot_(&i__3, &a[k1 * a_dim1 + 1], &dtrsyl_c__1, &c__[l1 * 
			    c_dim1 + 1], &dtrsyl_c__1);
		    i__3 = l1 - 1;
		    sumr = ddot_(&i__3, &c__[k1 + c_dim1], ldc, &b[l1 * 
			    b_dim1 + 1], &dtrsyl_c__1);
		    vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr);

		    i__3 = k1 - 1;
		    suml = ddot_(&i__3, &a[k1 * a_dim1 + 1], &dtrsyl_c__1, &c__[l2 * 
			    c_dim1 + 1], &dtrsyl_c__1);
		    i__3 = l1 - 1;
		    sumr = ddot_(&i__3, &c__[k1 + c_dim1], ldc, &b[l2 * 
			    b_dim1 + 1], &dtrsyl_c__1);
		    vec[2] = c__[k1 + l2 * c_dim1] - (suml + sgn * sumr);

		    i__3 = k1 - 1;
		    suml = ddot_(&i__3, &a[k2 * a_dim1 + 1], &dtrsyl_c__1, &c__[l1 * 
			    c_dim1 + 1], &dtrsyl_c__1);
		    i__3 = l1 - 1;
		    sumr = ddot_(&i__3, &c__[k2 + c_dim1], ldc, &b[l1 * 
			    b_dim1 + 1], &dtrsyl_c__1);
		    vec[1] = c__[k2 + l1 * c_dim1] - (suml + sgn * sumr);

		    i__3 = k1 - 1;
		    suml = ddot_(&i__3, &a[k2 * a_dim1 + 1], &dtrsyl_c__1, &c__[l2 * 
			    c_dim1 + 1], &dtrsyl_c__1);
		    i__3 = l1 - 1;
		    sumr = ddot_(&i__3, &c__[k2 + c_dim1], ldc, &b[l2 * 
			    b_dim1 + 1], &dtrsyl_c__1);
		    vec[3] = c__[k2 + l2 * c_dim1] - (suml + sgn * sumr);

		    if (dlasy2_(interp, &dtrsyl_c_true, &dtrsyl_c_false, isgn, &dtrsyl_c__2, &dtrsyl_c__2, &a[k1 + k1 			    * a_dim1], lda, &b[l1 + l1 * b_dim1], ldb, vec, &
			    dtrsyl_c__2, &scaloc, x, &dtrsyl_c__2, &xnorm, &ierr)!=TCL_OK) { return TCL_ERROR; }


		    if (ierr != 0) {
			*info = 1;
		    }

		    if (scaloc != 1.) {
			i__3 = *n;
			for (j = 1; j <= i__3; ++j) {
			    if (dscal_(interp, m, &scaloc, &c__[j * c_dim1 + 1], &dtrsyl_c__1)!=TCL_OK) { return TCL_ERROR; }

			}
			*scale *= scaloc;
		    }
		    c__[k1 + l1 * c_dim1] = x[0];
		    c__[k1 + l2 * c_dim1] = x[2];
		    c__[k2 + l1 * c_dim1] = x[1];
		    c__[k2 + l2 * c_dim1] = x[3];
		}

L110:
		;
	    }
L120:
	    ;
	}

    } else if (! notrna && ! notrnb) {






	lnext = *n;
	for (l = *n; l >= 1; --l) {
	    if (l > lnext) {
		goto L180;
	    }
	    if (l == 1) {
		l1 = l;
		l2 = l;
	    } else {
		if (b[l + (l - 1) * b_dim1] != 0.) {
		    l1 = l - 1;
		    l2 = l;
		    lnext = l - 2;
		} else {
		    l1 = l;
		    l2 = l;
		    lnext = l - 1;
		}
	    }


	    knext = 1;
	    i__1 = *m;
	    for (k = 1; k <= i__1; ++k) {
		if (k < knext) {
		    goto L170;
		}
		if (k == *m) {
		    k1 = k;
		    k2 = k;
		} else {
		    if (a[k + 1 + k * a_dim1] != 0.) {
			k1 = k;
			k2 = k + 1;
			knext = k + 2;
		    } else {
			k1 = k;
			k2 = k;
			knext = k + 1;
		    }
		}

		if (l1 == l2 && k1 == k2) {
		    i__2 = k1 - 1;
		    suml = ddot_(&i__2, &a[k1 * a_dim1 + 1], &dtrsyl_c__1, &c__[l1 * 
			    c_dim1 + 1], &dtrsyl_c__1);
		    i__2 = *n - l1;
		    i__3 = l1 + 1;
		    i__4 = l1 + 1;
		    sumr = ddot_(&i__2, &c__[k1 + min(i__3, *n)* c_dim1], ldc, 
			     &b[l1 + min(i__4, *n)* b_dim1], ldb);
		    vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr);
		    scaloc = 1.;

		    a11 = a[k1 + k1 * a_dim1] + sgn * b[l1 + l1 * b_dim1];
		    da11 = abs(a11);
		    if (da11 <= smin) {
			a11 = smin;
			da11 = smin;
			*info = 1;
		    }
		    db = abs(vec[0]);
		    if (da11 < 1. && db > 1.) {
			if (db > bignum * da11) {
			    scaloc = 1. / db;
			}
		    }
		    x[0] = vec[0] * scaloc / a11;

		    if (scaloc != 1.) {
			i__2 = *n;
			for (j = 1; j <= i__2; ++j) {
			    if (dscal_(interp, m, &scaloc, &c__[j * c_dim1 + 1], &dtrsyl_c__1)!=TCL_OK) { return TCL_ERROR; }

			}
			*scale *= scaloc;
		    }
		    c__[k1 + l1 * c_dim1] = x[0];

		} else if (l1 == l2 && k1 != k2) {

		    i__2 = k1 - 1;
		    suml = ddot_(&i__2, &a[k1 * a_dim1 + 1], &dtrsyl_c__1, &c__[l1 * 
			    c_dim1 + 1], &dtrsyl_c__1);
		    i__2 = *n - l2;
		    i__3 = l2 + 1;
		    i__4 = l2 + 1;
		    sumr = ddot_(&i__2, &c__[k1 + min(i__3, *n)* c_dim1], ldc, 
			     &b[l1 + min(i__4, *n)* b_dim1], ldb);
		    vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr);

		    i__2 = k1 - 1;
		    suml = ddot_(&i__2, &a[k2 * a_dim1 + 1], &dtrsyl_c__1, &c__[l1 * 
			    c_dim1 + 1], &dtrsyl_c__1);
		    i__2 = *n - l2;
		    i__3 = l2 + 1;
		    i__4 = l2 + 1;
		    sumr = ddot_(&i__2, &c__[k2 + min(i__3, *n)* c_dim1], ldc, 
			     &b[l1 + min(i__4, *n)* b_dim1], ldb);
		    vec[1] = c__[k2 + l1 * c_dim1] - (suml + sgn * sumr);

		    d__1 = -sgn * b[l1 + l1 * b_dim1];
		    if (dlaln2_(interp, &dtrsyl_c_true, &dtrsyl_c__2, &dtrsyl_c__1, &smin, &dtrsyl_c_b26, &a[k1 + k1 *			     a_dim1], lda, &dtrsyl_c_b26, &dtrsyl_c_b26, vec, &dtrsyl_c__2, &d__1, 
			    &dtrsyl_c_b30, x, &dtrsyl_c__2, &scaloc, &xnorm, &ierr)!=TCL_OK) { return TCL_ERROR; }


		    if (ierr != 0) {
			*info = 1;
		    }

		    if (scaloc != 1.) {
			i__2 = *n;
			for (j = 1; j <= i__2; ++j) {
			    if (dscal_(interp, m, &scaloc, &c__[j * c_dim1 + 1], &dtrsyl_c__1)!=TCL_OK) { return TCL_ERROR; }

			}
			*scale *= scaloc;
		    }
		    c__[k1 + l1 * c_dim1] = x[0];
		    c__[k2 + l1 * c_dim1] = x[1];

		} else if (l1 != l2 && k1 == k2) {

		    i__2 = k1 - 1;
		    suml = ddot_(&i__2, &a[k1 * a_dim1 + 1], &dtrsyl_c__1, &c__[l1 * 
			    c_dim1 + 1], &dtrsyl_c__1);
		    i__2 = *n - l2;
		    i__3 = l2 + 1;
		    i__4 = l2 + 1;
		    sumr = ddot_(&i__2, &c__[k1 + min(i__3, *n)* c_dim1], ldc, 
			     &b[l1 + min(i__4, *n)* b_dim1], ldb);
		    vec[0] = sgn * (c__[k1 + l1 * c_dim1] - (suml + sgn * 
			    sumr));

		    i__2 = k1 - 1;
		    suml = ddot_(&i__2, &a[k1 * a_dim1 + 1], &dtrsyl_c__1, &c__[l2 * 
			    c_dim1 + 1], &dtrsyl_c__1);
		    i__2 = *n - l2;
		    i__3 = l2 + 1;
		    i__4 = l2 + 1;
		    sumr = ddot_(&i__2, &c__[k1 + min(i__3, *n)* c_dim1], ldc, 
			     &b[l2 + min(i__4, *n)* b_dim1], ldb);
		    vec[1] = sgn * (c__[k1 + l2 * c_dim1] - (suml + sgn * 
			    sumr));

		    d__1 = -sgn * a[k1 + k1 * a_dim1];
		    if (dlaln2_(interp, &dtrsyl_c_false, &dtrsyl_c__2, &dtrsyl_c__1, &smin, &dtrsyl_c_b26, &b[l1 + l1 			    * b_dim1], ldb, &dtrsyl_c_b26, &dtrsyl_c_b26, vec, &dtrsyl_c__2, &d__1, 
			     &dtrsyl_c_b30, x, &dtrsyl_c__2, &scaloc, &xnorm, &ierr)!=TCL_OK) { return TCL_ERROR; }


		    if (ierr != 0) {
			*info = 1;
		    }

		    if (scaloc != 1.) {
			i__2 = *n;
			for (j = 1; j <= i__2; ++j) {
			    if (dscal_(interp, m, &scaloc, &c__[j * c_dim1 + 1], &dtrsyl_c__1)!=TCL_OK) { return TCL_ERROR; }

			}
			*scale *= scaloc;
		    }
		    c__[k1 + l1 * c_dim1] = x[0];
		    c__[k1 + l2 * c_dim1] = x[1];

		} else if (l1 != l2 && k1 != k2) {

		    i__2 = k1 - 1;
		    suml = ddot_(&i__2, &a[k1 * a_dim1 + 1], &dtrsyl_c__1, &c__[l1 * 
			    c_dim1 + 1], &dtrsyl_c__1);
		    i__2 = *n - l2;
		    i__3 = l2 + 1;
		    i__4 = l2 + 1;
		    sumr = ddot_(&i__2, &c__[k1 + min(i__3, *n)* c_dim1], ldc, 
			     &b[l1 + min(i__4, *n)* b_dim1], ldb);
		    vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr);

		    i__2 = k1 - 1;
		    suml = ddot_(&i__2, &a[k1 * a_dim1 + 1], &dtrsyl_c__1, &c__[l2 * 
			    c_dim1 + 1], &dtrsyl_c__1);
		    i__2 = *n - l2;
		    i__3 = l2 + 1;
		    i__4 = l2 + 1;
		    sumr = ddot_(&i__2, &c__[k1 + min(i__3, *n)* c_dim1], ldc, 
			     &b[l2 + min(i__4, *n)* b_dim1], ldb);
		    vec[2] = c__[k1 + l2 * c_dim1] - (suml + sgn * sumr);

		    i__2 = k1 - 1;
		    suml = ddot_(&i__2, &a[k2 * a_dim1 + 1], &dtrsyl_c__1, &c__[l1 * 
			    c_dim1 + 1], &dtrsyl_c__1);
		    i__2 = *n - l2;
		    i__3 = l2 + 1;
		    i__4 = l2 + 1;
		    sumr = ddot_(&i__2, &c__[k2 + min(i__3, *n)* c_dim1], ldc, 
			     &b[l1 + min(i__4, *n)* b_dim1], ldb);
		    vec[1] = c__[k2 + l1 * c_dim1] - (suml + sgn * sumr);

		    i__2 = k1 - 1;
		    suml = ddot_(&i__2, &a[k2 * a_dim1 + 1], &dtrsyl_c__1, &c__[l2 * 
			    c_dim1 + 1], &dtrsyl_c__1);
		    i__2 = *n - l2;
		    i__3 = l2 + 1;
		    i__4 = l2 + 1;
		    sumr = ddot_(&i__2, &c__[k2 + min(i__3, *n)* c_dim1], ldc, 
			     &b[l2 + min(i__4, *n)* b_dim1], ldb);
		    vec[3] = c__[k2 + l2 * c_dim1] - (suml + sgn * sumr);

		    if (dlasy2_(interp, &dtrsyl_c_true, &dtrsyl_c_true, isgn, &dtrsyl_c__2, &dtrsyl_c__2, &a[k1 + k1 *			     a_dim1], lda, &b[l1 + l1 * b_dim1], ldb, vec, &
			    dtrsyl_c__2, &scaloc, x, &dtrsyl_c__2, &xnorm, &ierr)!=TCL_OK) { return TCL_ERROR; }


		    if (ierr != 0) {
			*info = 1;
		    }

		    if (scaloc != 1.) {
			i__2 = *n;
			for (j = 1; j <= i__2; ++j) {
			    if (dscal_(interp, m, &scaloc, &c__[j * c_dim1 + 1], &dtrsyl_c__1)!=TCL_OK) { return TCL_ERROR; }

			}
			*scale *= scaloc;
		    }
		    c__[k1 + l1 * c_dim1] = x[0];
		    c__[k1 + l2 * c_dim1] = x[2];
		    c__[k2 + l1 * c_dim1] = x[1];
		    c__[k2 + l2 * c_dim1] = x[3];
		}

L170:
		;
	    }
L180:
	    ;
	}

    } else if (notrna && ! notrnb) {






	lnext = *n;
	for (l = *n; l >= 1; --l) {
	    if (l > lnext) {
		goto L240;
	    }
	    if (l == 1) {
		l1 = l;
		l2 = l;
	    } else {
		if (b[l + (l - 1) * b_dim1] != 0.) {
		    l1 = l - 1;
		    l2 = l;
		    lnext = l - 2;
		} else {
		    l1 = l;
		    l2 = l;
		    lnext = l - 1;
		}
	    }


	    knext = *m;
	    for (k = *m; k >= 1; --k) {
		if (k > knext) {
		    goto L230;
		}
		if (k == 1) {
		    k1 = k;
		    k2 = k;
		} else {
		    if (a[k + (k - 1) * a_dim1] != 0.) {
			k1 = k - 1;
			k2 = k;
			knext = k - 2;
		    } else {
			k1 = k;
			k2 = k;
			knext = k - 1;
		    }
		}

		if (l1 == l2 && k1 == k2) {
		    i__1 = *m - k1;
		    i__2 = k1 + 1;
		    i__3 = k1 + 1;
		    suml = ddot_(&i__1, &a[k1 + min(i__2, *m)* a_dim1], lda, &
			    c__[min(i__3, *m)+ l1 * c_dim1], &dtrsyl_c__1);
		    i__1 = *n - l1;
		    i__2 = l1 + 1;
		    i__3 = l1 + 1;
		    sumr = ddot_(&i__1, &c__[k1 + min(i__2, *n)* c_dim1], ldc, 
			     &b[l1 + min(i__3, *n)* b_dim1], ldb);
		    vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr);
		    scaloc = 1.;

		    a11 = a[k1 + k1 * a_dim1] + sgn * b[l1 + l1 * b_dim1];
		    da11 = abs(a11);
		    if (da11 <= smin) {
			a11 = smin;
			da11 = smin;
			*info = 1;
		    }
		    db = abs(vec[0]);
		    if (da11 < 1. && db > 1.) {
			if (db > bignum * da11) {
			    scaloc = 1. / db;
			}
		    }
		    x[0] = vec[0] * scaloc / a11;

		    if (scaloc != 1.) {
			i__1 = *n;
			for (j = 1; j <= i__1; ++j) {
			    if (dscal_(interp, m, &scaloc, &c__[j * c_dim1 + 1], &dtrsyl_c__1)!=TCL_OK) { return TCL_ERROR; }

			}
			*scale *= scaloc;
		    }
		    c__[k1 + l1 * c_dim1] = x[0];

		} else if (l1 == l2 && k1 != k2) {

		    i__1 = *m - k2;
		    i__2 = k2 + 1;
		    i__3 = k2 + 1;
		    suml = ddot_(&i__1, &a[k1 + min(i__2, *m)* a_dim1], lda, &
			    c__[min(i__3, *m)+ l1 * c_dim1], &dtrsyl_c__1);
		    i__1 = *n - l2;
		    i__2 = l2 + 1;
		    i__3 = l2 + 1;
		    sumr = ddot_(&i__1, &c__[k1 + min(i__2, *n)* c_dim1], ldc, 
			     &b[l1 + min(i__3, *n)* b_dim1], ldb);
		    vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr);

		    i__1 = *m - k2;
		    i__2 = k2 + 1;
		    i__3 = k2 + 1;
		    suml = ddot_(&i__1, &a[k2 + min(i__2, *m)* a_dim1], lda, &
			    c__[min(i__3, *m)+ l1 * c_dim1], &dtrsyl_c__1);
		    i__1 = *n - l2;
		    i__2 = l2 + 1;
		    i__3 = l2 + 1;
		    sumr = ddot_(&i__1, &c__[k2 + min(i__2, *n)* c_dim1], ldc, 
			     &b[l1 + min(i__3, *n)* b_dim1], ldb);
		    vec[1] = c__[k2 + l1 * c_dim1] - (suml + sgn * sumr);

		    d__1 = -sgn * b[l1 + l1 * b_dim1];
		    if (dlaln2_(interp, &dtrsyl_c_false, &dtrsyl_c__2, &dtrsyl_c__1, &smin, &dtrsyl_c_b26, &a[k1 + k1 			    * a_dim1], lda, &dtrsyl_c_b26, &dtrsyl_c_b26, vec, &dtrsyl_c__2, &d__1, 
			     &dtrsyl_c_b30, x, &dtrsyl_c__2, &scaloc, &xnorm, &ierr)!=TCL_OK) { return TCL_ERROR; }


		    if (ierr != 0) {
			*info = 1;
		    }

		    if (scaloc != 1.) {
			i__1 = *n;
			for (j = 1; j <= i__1; ++j) {
			    if (dscal_(interp, m, &scaloc, &c__[j * c_dim1 + 1], &dtrsyl_c__1)!=TCL_OK) { return TCL_ERROR; }

			}
			*scale *= scaloc;
		    }
		    c__[k1 + l1 * c_dim1] = x[0];
		    c__[k2 + l1 * c_dim1] = x[1];

		} else if (l1 != l2 && k1 == k2) {

		    i__1 = *m - k1;
		    i__2 = k1 + 1;
		    i__3 = k1 + 1;
		    suml = ddot_(&i__1, &a[k1 + min(i__2, *m)* a_dim1], lda, &
			    c__[min(i__3, *m)+ l1 * c_dim1], &dtrsyl_c__1);
		    i__1 = *n - l2;
		    i__2 = l2 + 1;
		    i__3 = l2 + 1;
		    sumr = ddot_(&i__1, &c__[k1 + min(i__2, *n)* c_dim1], ldc, 
			     &b[l1 + min(i__3, *n)* b_dim1], ldb);
		    vec[0] = sgn * (c__[k1 + l1 * c_dim1] - (suml + sgn * 
			    sumr));

		    i__1 = *m - k1;
		    i__2 = k1 + 1;
		    i__3 = k1 + 1;
		    suml = ddot_(&i__1, &a[k1 + min(i__2, *m)* a_dim1], lda, &
			    c__[min(i__3, *m)+ l2 * c_dim1], &dtrsyl_c__1);
		    i__1 = *n - l2;
		    i__2 = l2 + 1;
		    i__3 = l2 + 1;
		    sumr = ddot_(&i__1, &c__[k1 + min(i__2, *n)* c_dim1], ldc, 
			     &b[l2 + min(i__3, *n)* b_dim1], ldb);
		    vec[1] = sgn * (c__[k1 + l2 * c_dim1] - (suml + sgn * 
			    sumr));

		    d__1 = -sgn * a[k1 + k1 * a_dim1];
		    if (dlaln2_(interp, &dtrsyl_c_false, &dtrsyl_c__2, &dtrsyl_c__1, &smin, &dtrsyl_c_b26, &b[l1 + l1 			    * b_dim1], ldb, &dtrsyl_c_b26, &dtrsyl_c_b26, vec, &dtrsyl_c__2, &d__1, 
			     &dtrsyl_c_b30, x, &dtrsyl_c__2, &scaloc, &xnorm, &ierr)!=TCL_OK) { return TCL_ERROR; }


		    if (ierr != 0) {
			*info = 1;
		    }

		    if (scaloc != 1.) {
			i__1 = *n;
			for (j = 1; j <= i__1; ++j) {
			    if (dscal_(interp, m, &scaloc, &c__[j * c_dim1 + 1], &dtrsyl_c__1)!=TCL_OK) { return TCL_ERROR; }

			}
			*scale *= scaloc;
		    }
		    c__[k1 + l1 * c_dim1] = x[0];
		    c__[k1 + l2 * c_dim1] = x[1];

		} else if (l1 != l2 && k1 != k2) {

		    i__1 = *m - k2;
		    i__2 = k2 + 1;
		    i__3 = k2 + 1;
		    suml = ddot_(&i__1, &a[k1 + min(i__2, *m)* a_dim1], lda, &
			    c__[min(i__3, *m)+ l1 * c_dim1], &dtrsyl_c__1);
		    i__1 = *n - l2;
		    i__2 = l2 + 1;
		    i__3 = l2 + 1;
		    sumr = ddot_(&i__1, &c__[k1 + min(i__2, *n)* c_dim1], ldc, 
			     &b[l1 + min(i__3, *n)* b_dim1], ldb);
		    vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr);

		    i__1 = *m - k2;
		    i__2 = k2 + 1;
		    i__3 = k2 + 1;
		    suml = ddot_(&i__1, &a[k1 + min(i__2, *m)* a_dim1], lda, &
			    c__[min(i__3, *m)+ l2 * c_dim1], &dtrsyl_c__1);
		    i__1 = *n - l2;
		    i__2 = l2 + 1;
		    i__3 = l2 + 1;
		    sumr = ddot_(&i__1, &c__[k1 + min(i__2, *n)* c_dim1], ldc, 
			     &b[l2 + min(i__3, *n)* b_dim1], ldb);
		    vec[2] = c__[k1 + l2 * c_dim1] - (suml + sgn * sumr);

		    i__1 = *m - k2;
		    i__2 = k2 + 1;
		    i__3 = k2 + 1;
		    suml = ddot_(&i__1, &a[k2 + min(i__2, *m)* a_dim1], lda, &
			    c__[min(i__3, *m)+ l1 * c_dim1], &dtrsyl_c__1);
		    i__1 = *n - l2;
		    i__2 = l2 + 1;
		    i__3 = l2 + 1;
		    sumr = ddot_(&i__1, &c__[k2 + min(i__2, *n)* c_dim1], ldc, 
			     &b[l1 + min(i__3, *n)* b_dim1], ldb);
		    vec[1] = c__[k2 + l1 * c_dim1] - (suml + sgn * sumr);

		    i__1 = *m - k2;
		    i__2 = k2 + 1;
		    i__3 = k2 + 1;
		    suml = ddot_(&i__1, &a[k2 + min(i__2, *m)* a_dim1], lda, &
			    c__[min(i__3, *m)+ l2 * c_dim1], &dtrsyl_c__1);
		    i__1 = *n - l2;
		    i__2 = l2 + 1;
		    i__3 = l2 + 1;
		    sumr = ddot_(&i__1, &c__[k2 + min(i__2, *n)* c_dim1], ldc, 
			     &b[l2 + min(i__3, *n)* b_dim1], ldb);
		    vec[3] = c__[k2 + l2 * c_dim1] - (suml + sgn * sumr);

		    if (dlasy2_(interp, &dtrsyl_c_false, &dtrsyl_c_true, isgn, &dtrsyl_c__2, &dtrsyl_c__2, &a[k1 + k1 			    * a_dim1], lda, &b[l1 + l1 * b_dim1], ldb, vec, &
			    dtrsyl_c__2, &scaloc, x, &dtrsyl_c__2, &xnorm, &ierr)!=TCL_OK) { return TCL_ERROR; }


		    if (ierr != 0) {
			*info = 1;
		    }

		    if (scaloc != 1.) {
			i__1 = *n;
			for (j = 1; j <= i__1; ++j) {
			    if (dscal_(interp, m, &scaloc, &c__[j * c_dim1 + 1], &dtrsyl_c__1)!=TCL_OK) { return TCL_ERROR; }

			}
			*scale *= scaloc;
		    }
		    c__[k1 + l1 * c_dim1] = x[0];
		    c__[k1 + l2 * c_dim1] = x[2];
		    c__[k2 + l1 * c_dim1] = x[1];
		    c__[k2 + l2 * c_dim1] = x[3];
		}

L230:
		;
	    }
L240:
	    ;
	}

    }

return TCL_OK;


} /* dtrsyl_ */
static /* Subroutine */ int ztrexc_ (Tcl_Interp *interp, char *compq, integer *n, doublecomplex *t, 	integer *ldt, doublecomplex *q, integer *ldq, integer *ifst, integer *	ilst, integer *info)
{
    integer q_dim1, q_offset, t_dim1, t_offset, i__1, i__2, i__3;
    doublecomplex z__1;

    void d_cnjg(doublecomplex *, doublecomplex *);

    integer k, m1, m2, m3;
    doublereal cs;
    doublecomplex t11, t22, sn, temp;
    logical wantq;



















    t_dim1 = *ldt;
    t_offset = 1 + t_dim1;
    t -= t_offset;
    q_dim1 = *ldq;
    q_offset = 1 + q_dim1;
    q -= q_offset;

    *info = 0;
    wantq = lsame_(compq, "V");
    if (! lsame_(compq, "N") && ! wantq) {
	*info = -1;
    } else if (*n < 0) {
	*info = -2;
    } else if (*ldt < max(1,*n)) {
	*info = -4;
    } else if (*ldq < 1 || wantq && *ldq < max(1,*n)) {
	*info = -6;
    } else if (*ifst < 1 || *ifst > *n) {
	*info = -7;
    } else if (*ilst < 1 || *ilst > *n) {
	*info = -8;
    }
    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "ZTREXC", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


    if (*n == 1 || *ifst == *ilst) {
return TCL_OK;
    }

    if (*ifst < *ilst) {


	m1 = 0;
	m2 = -1;
	m3 = 1;
    } else {


	m1 = -1;
	m2 = 0;
	m3 = -1;
    }

    i__1 = *ilst + m2;
    i__2 = m3;
    for (k = *ifst + m1; i__2 < 0 ? k >= i__1 : k <= i__1; k += i__2) {


	i__3 = k + k * t_dim1;
	t11.r = t[i__3].r, t11.i = t[i__3].i;
	i__3 = k + 1 + (k + 1) * t_dim1;
	t22.r = t[i__3].r, t22.i = t[i__3].i;


	z__1.r = t22.r - t11.r, z__1.i = t22.i - t11.i;
	if (zlartg_(interp, &t[k + (k + 1) * t_dim1], &z__1, &cs, &sn, &temp)!=TCL_OK) { return TCL_ERROR; }



	if (k + 2 <= *n) {
	    i__3 = *n - k - 1;
	    if (zrot_(interp, &i__3, &t[k + (k + 2) * t_dim1], ldt, &t[k + 1 + (k + 2) * 		    t_dim1], ldt, &cs, &sn)!=TCL_OK) { return TCL_ERROR; }


	}
	i__3 = k - 1;
	d_cnjg(&z__1, &sn);
	if (zrot_(interp, &i__3, &t[k * t_dim1 + 1], &ztrexc_c__1, &t[(k + 1) * t_dim1 + 1], &		ztrexc_c__1, &cs, &z__1)!=TCL_OK) { return TCL_ERROR; }



	i__3 = k + k * t_dim1;
	t[i__3].r = t22.r, t[i__3].i = t22.i;
	i__3 = k + 1 + (k + 1) * t_dim1;
	t[i__3].r = t11.r, t[i__3].i = t11.i;

	if (wantq) {


	    d_cnjg(&z__1, &sn);
	    if (zrot_(interp, n, &q[k * q_dim1 + 1], &ztrexc_c__1, &q[(k + 1) * q_dim1 + 1], &		    ztrexc_c__1, &cs, &z__1)!=TCL_OK) { return TCL_ERROR; }


	}

    }

return TCL_OK;


} /* ztrexc_ */
static /* Subroutine */ int ztrsyl_ (Tcl_Interp *interp, char *trana, char *tranb, integer *isgn, integer 	*m, integer *n, doublecomplex *a, integer *lda, doublecomplex *b, 	integer *ldb, doublecomplex *c__, integer *ldc, doublereal *scale, 	integer *info)
{
    integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, 
	    i__3, i__4;
    doublereal d__1, d__2;
    doublecomplex z__1, z__2, z__3, z__4;

    double d_imag(doublecomplex *);
    void d_cnjg(doublecomplex *, doublecomplex *);

    integer j, k, l;
    doublecomplex a11;
    doublereal db;
    doublecomplex x11;
    doublereal da11;
    doublecomplex vec;
    doublereal dum[1], eps, sgn, smin;
    doublecomplex suml, sumr;
    doublereal scaloc;
    doublereal bignum;
    logical notrna, notrnb;
    doublereal smlnum;

























    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    b_dim1 = *ldb;
    b_offset = 1 + b_dim1;
    b -= b_offset;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;

    notrna = lsame_(trana, "N");
    notrnb = lsame_(tranb, "N");

    *info = 0;
    if (! notrna && ! lsame_(trana, "C")) {
	*info = -1;
    } else if (! notrnb && ! lsame_(tranb, "C")) {
	*info = -2;
    } else if (*isgn != 1 && *isgn != -1) {
	*info = -3;
    } else if (*m < 0) {
	*info = -4;
    } else if (*n < 0) {
	*info = -5;
    } else if (*lda < max(1,*m)) {
	*info = -7;
    } else if (*ldb < max(1,*n)) {
	*info = -9;
    } else if (*ldc < max(1,*m)) {
	*info = -11;
    }
    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "ZTRSYL", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


    *scale = 1.;
    if (*m == 0 || *n == 0) {
return TCL_OK;
    }


    eps = dlamch_("P");
    smlnum = dlamch_("S");
    bignum = 1. / smlnum;
    if (dlabad_(interp, &smlnum, &bignum)!=TCL_OK) { return TCL_ERROR; }

    smlnum = smlnum * (doublereal) (*m * *n) / eps;
    bignum = 1. / smlnum;
    d__1 = smlnum, d__2 = eps * zlange_("M", m, m, &a[a_offset], lda, dum), d__1 = max(d__1,d__2), d__2 = eps * zlange_("M", n, n, 
	    &b[b_offset], ldb, dum);
    smin = max(d__1,d__2);
    sgn = (doublereal) (*isgn);

    if (notrna && notrnb) {





	i__1 = *n;
	for (l = 1; l <= i__1; ++l) {
	    for (k = *m; k >= 1; --k) {

		i__2 = *m - k;
		i__3 = k + 1;
		i__4 = k + 1;
		zdotu_(&z__1, &i__2, &a[k + min(i__3, *m)* a_dim1], lda, &c__[
			min(i__4, *m)+ l * c_dim1], &ztrsyl_c__1);
		suml.r = z__1.r, suml.i = z__1.i;
		i__2 = l - 1;
		zdotu_(&z__1, &i__2, &c__[k + c_dim1], ldc, &b[l * b_dim1 + 1]
, &ztrsyl_c__1);
		sumr.r = z__1.r, sumr.i = z__1.i;
		i__2 = k + l * c_dim1;
		z__3.r = sgn * sumr.r, z__3.i = sgn * sumr.i;
		z__2.r = suml.r + z__3.r, z__2.i = suml.i + z__3.i;
		z__1.r = c__[i__2].r - z__2.r, z__1.i = c__[i__2].i - z__2.i;
		vec.r = z__1.r, vec.i = z__1.i;

		scaloc = 1.;
		i__2 = k + k * a_dim1;
		i__3 = l + l * b_dim1;
		z__2.r = sgn * b[i__3].r, z__2.i = sgn * b[i__3].i;
		z__1.r = a[i__2].r + z__2.r, z__1.i = a[i__2].i + z__2.i;
		a11.r = z__1.r, a11.i = z__1.i;
		da11 = (d__1 = a11.r, abs(d__1)) + (d__2 = d_imag(&a11), abs(
			d__2));
		if (da11 <= smin) {
		    a11.r = smin, a11.i = 0.;
		    da11 = smin;
		    *info = 1;
		}
		db = (d__1 = vec.r, abs(d__1)) + (d__2 = d_imag(&vec), abs(
			d__2));
		if (da11 < 1. && db > 1.) {
		    if (db > bignum * da11) {
			scaloc = 1. / db;
		    }
		}
		z__3.r = scaloc, z__3.i = 0.;
		z__2.r = vec.r * z__3.r - vec.i * z__3.i, z__2.i = vec.r * 
			z__3.i + vec.i * z__3.r;
		zladiv_(&z__1, &z__2, &a11);
		x11.r = z__1.r, x11.i = z__1.i;

		if (scaloc != 1.) {
		    i__2 = *n;
		    for (j = 1; j <= i__2; ++j) {
			if (zdscal_(interp, m, &scaloc, &c__[j * c_dim1 + 1], &ztrsyl_c__1)!=TCL_OK) { return TCL_ERROR; }

		    }
		    *scale *= scaloc;
		}
		i__2 = k + l * c_dim1;
		c__[i__2].r = x11.r, c__[i__2].i = x11.i;

	    }
	}

    } else if (! notrna && notrnb) {





	i__1 = *n;
	for (l = 1; l <= i__1; ++l) {
	    i__2 = *m;
	    for (k = 1; k <= i__2; ++k) {

		i__3 = k - 1;
		zdotc_(&z__1, &i__3, &a[k * a_dim1 + 1], &ztrsyl_c__1, &c__[l * 
			c_dim1 + 1], &ztrsyl_c__1);
		suml.r = z__1.r, suml.i = z__1.i;
		i__3 = l - 1;
		zdotu_(&z__1, &i__3, &c__[k + c_dim1], ldc, &b[l * b_dim1 + 1]
, &ztrsyl_c__1);
		sumr.r = z__1.r, sumr.i = z__1.i;
		i__3 = k + l * c_dim1;
		z__3.r = sgn * sumr.r, z__3.i = sgn * sumr.i;
		z__2.r = suml.r + z__3.r, z__2.i = suml.i + z__3.i;
		z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
		vec.r = z__1.r, vec.i = z__1.i;

		scaloc = 1.;
		d_cnjg(&z__2, &a[k + k * a_dim1]);
		i__3 = l + l * b_dim1;
		z__3.r = sgn * b[i__3].r, z__3.i = sgn * b[i__3].i;
		z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
		a11.r = z__1.r, a11.i = z__1.i;
		da11 = (d__1 = a11.r, abs(d__1)) + (d__2 = d_imag(&a11), abs(
			d__2));
		if (da11 <= smin) {
		    a11.r = smin, a11.i = 0.;
		    da11 = smin;
		    *info = 1;
		}
		db = (d__1 = vec.r, abs(d__1)) + (d__2 = d_imag(&vec), abs(
			d__2));
		if (da11 < 1. && db > 1.) {
		    if (db > bignum * da11) {
			scaloc = 1. / db;
		    }
		}

		z__3.r = scaloc, z__3.i = 0.;
		z__2.r = vec.r * z__3.r - vec.i * z__3.i, z__2.i = vec.r * 
			z__3.i + vec.i * z__3.r;
		zladiv_(&z__1, &z__2, &a11);
		x11.r = z__1.r, x11.i = z__1.i;

		if (scaloc != 1.) {
		    i__3 = *n;
		    for (j = 1; j <= i__3; ++j) {
			if (zdscal_(interp, m, &scaloc, &c__[j * c_dim1 + 1], &ztrsyl_c__1)!=TCL_OK) { return TCL_ERROR; }

		    }
		    *scale *= scaloc;
		}
		i__3 = k + l * c_dim1;
		c__[i__3].r = x11.r, c__[i__3].i = x11.i;

	    }
	}

    } else if (! notrna && ! notrnb) {





	for (l = *n; l >= 1; --l) {
	    i__1 = *m;
	    for (k = 1; k <= i__1; ++k) {

		i__2 = k - 1;
		zdotc_(&z__1, &i__2, &a[k * a_dim1 + 1], &ztrsyl_c__1, &c__[l * 
			c_dim1 + 1], &ztrsyl_c__1);
		suml.r = z__1.r, suml.i = z__1.i;
		i__2 = *n - l;
		i__3 = l + 1;
		i__4 = l + 1;
		zdotc_(&z__1, &i__2, &c__[k + min(i__3, *n)* c_dim1], ldc, &b[
			l + min(i__4, *n)* b_dim1], ldb);
		sumr.r = z__1.r, sumr.i = z__1.i;
		i__2 = k + l * c_dim1;
		d_cnjg(&z__4, &sumr);
		z__3.r = sgn * z__4.r, z__3.i = sgn * z__4.i;
		z__2.r = suml.r + z__3.r, z__2.i = suml.i + z__3.i;
		z__1.r = c__[i__2].r - z__2.r, z__1.i = c__[i__2].i - z__2.i;
		vec.r = z__1.r, vec.i = z__1.i;

		scaloc = 1.;
		i__2 = k + k * a_dim1;
		i__3 = l + l * b_dim1;
		z__3.r = sgn * b[i__3].r, z__3.i = sgn * b[i__3].i;
		z__2.r = a[i__2].r + z__3.r, z__2.i = a[i__2].i + z__3.i;
		d_cnjg(&z__1, &z__2);
		a11.r = z__1.r, a11.i = z__1.i;
		da11 = (d__1 = a11.r, abs(d__1)) + (d__2 = d_imag(&a11), abs(
			d__2));
		if (da11 <= smin) {
		    a11.r = smin, a11.i = 0.;
		    da11 = smin;
		    *info = 1;
		}
		db = (d__1 = vec.r, abs(d__1)) + (d__2 = d_imag(&vec), abs(
			d__2));
		if (da11 < 1. && db > 1.) {
		    if (db > bignum * da11) {
			scaloc = 1. / db;
		    }
		}

		z__3.r = scaloc, z__3.i = 0.;
		z__2.r = vec.r * z__3.r - vec.i * z__3.i, z__2.i = vec.r * 
			z__3.i + vec.i * z__3.r;
		zladiv_(&z__1, &z__2, &a11);
		x11.r = z__1.r, x11.i = z__1.i;

		if (scaloc != 1.) {
		    i__2 = *n;
		    for (j = 1; j <= i__2; ++j) {
			if (zdscal_(interp, m, &scaloc, &c__[j * c_dim1 + 1], &ztrsyl_c__1)!=TCL_OK) { return TCL_ERROR; }

		    }
		    *scale *= scaloc;
		}
		i__2 = k + l * c_dim1;
		c__[i__2].r = x11.r, c__[i__2].i = x11.i;

	    }
	}

    } else if (notrna && ! notrnb) {





	for (l = *n; l >= 1; --l) {
	    for (k = *m; k >= 1; --k) {

		i__1 = *m - k;
		i__2 = k + 1;
		i__3 = k + 1;
		zdotu_(&z__1, &i__1, &a[k + min(i__2, *m)* a_dim1], lda, &c__[
			min(i__3, *m)+ l * c_dim1], &ztrsyl_c__1);
		suml.r = z__1.r, suml.i = z__1.i;
		i__1 = *n - l;
		i__2 = l + 1;
		i__3 = l + 1;
		zdotc_(&z__1, &i__1, &c__[k + min(i__2, *n)* c_dim1], ldc, &b[
			l + min(i__3, *n)* b_dim1], ldb);
		sumr.r = z__1.r, sumr.i = z__1.i;
		i__1 = k + l * c_dim1;
		d_cnjg(&z__4, &sumr);
		z__3.r = sgn * z__4.r, z__3.i = sgn * z__4.i;
		z__2.r = suml.r + z__3.r, z__2.i = suml.i + z__3.i;
		z__1.r = c__[i__1].r - z__2.r, z__1.i = c__[i__1].i - z__2.i;
		vec.r = z__1.r, vec.i = z__1.i;

		scaloc = 1.;
		i__1 = k + k * a_dim1;
		d_cnjg(&z__3, &b[l + l * b_dim1]);
		z__2.r = sgn * z__3.r, z__2.i = sgn * z__3.i;
		z__1.r = a[i__1].r + z__2.r, z__1.i = a[i__1].i + z__2.i;
		a11.r = z__1.r, a11.i = z__1.i;
		da11 = (d__1 = a11.r, abs(d__1)) + (d__2 = d_imag(&a11), abs(
			d__2));
		if (da11 <= smin) {
		    a11.r = smin, a11.i = 0.;
		    da11 = smin;
		    *info = 1;
		}
		db = (d__1 = vec.r, abs(d__1)) + (d__2 = d_imag(&vec), abs(
			d__2));
		if (da11 < 1. && db > 1.) {
		    if (db > bignum * da11) {
			scaloc = 1. / db;
		    }
		}

		z__3.r = scaloc, z__3.i = 0.;
		z__2.r = vec.r * z__3.r - vec.i * z__3.i, z__2.i = vec.r * 
			z__3.i + vec.i * z__3.r;
		zladiv_(&z__1, &z__2, &a11);
		x11.r = z__1.r, x11.i = z__1.i;

		if (scaloc != 1.) {
		    i__1 = *n;
		    for (j = 1; j <= i__1; ++j) {
			if (zdscal_(interp, m, &scaloc, &c__[j * c_dim1 + 1], &ztrsyl_c__1)!=TCL_OK) { return TCL_ERROR; }

		    }
		    *scale *= scaloc;
		}
		i__1 = k + l * c_dim1;
		c__[i__1].r = x11.r, c__[i__1].i = x11.i;

	    }
	}

    }

return TCL_OK;


} /* ztrsyl_ */
static /* Subroutine */ int dlasd1_ (Tcl_Interp *interp, integer *nl, integer *nr, integer *sqre, 	doublereal *d__, doublereal *alpha, doublereal *beta, doublereal *u, 	integer *ldu, doublereal *vt, integer *ldvt, integer *idxq, integer *	iwork, doublereal *work, integer *info)
{
    integer u_dim1, u_offset, vt_dim1, vt_offset, i__1;
    doublereal d__1, d__2;

    integer i__, k, m, n, n1, n2, iq, iz, iu2, ldq, idx, ldu2, ivt2, idxc, 
	    idxp, ldvt2;
    integer isigma;
    doublereal orgnrm;
    integer coltyp;





































    --d__;
    u_dim1 = *ldu;
    u_offset = 1 + u_dim1;
    u -= u_offset;
    vt_dim1 = *ldvt;
    vt_offset = 1 + vt_dim1;
    vt -= vt_offset;
    --idxq;
    --iwork;
    --work;

    *info = 0;

    if (*nl < 1) {
	*info = -1;
    } else if (*nr < 1) {
	*info = -2;
    } else if (*sqre < 0 || *sqre > 1) {
	*info = -3;
    }
    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DLASD1", &i__1);
return TCL_ERROR;

return TCL_OK;
    }

    n = *nl + *nr + 1;
    m = n + *sqre;


    ldu2 = n;
    ldvt2 = m;

    iz = 1;
    isigma = iz + m;
    iu2 = isigma + n;
    ivt2 = iu2 + ldu2 * n;
    iq = ivt2 + ldvt2 * m;

    idx = 1;
    idxc = idx + n;
    coltyp = idxc + n;
    idxp = coltyp + n;


    d__1 = abs(*alpha), d__2 = abs(*beta);
    orgnrm = max(d__1,d__2);
    d__[*nl + 1] = 0.;
    i__1 = n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	if ((d__1 = d__[i__], abs(d__1)) > orgnrm) {
	    orgnrm = (d__1 = d__[i__], abs(d__1));
	}
    }
    if (dlascl_(interp, "G", &dlasd1_c__0, &dlasd1_c__0, &orgnrm, &dlasd1_c_b7, &n, &dlasd1_c__1, &d__[1], &n, info)!=TCL_OK) { return TCL_ERROR; }

    *alpha /= orgnrm;
    *beta /= orgnrm;


    if (dlasd2_(interp, nl, nr, sqre, &k, &d__[1], &work[iz], alpha, beta, &u[u_offset], 	    ldu, &vt[vt_offset], ldvt, &work[isigma], &work[iu2], &ldu2, &
	    work[ivt2], &ldvt2, &iwork[idxp], &iwork[idx], &iwork[idxc], &
	    idxq[1], &iwork[coltyp], info)!=TCL_OK) { return TCL_ERROR; }




    ldq = k;
    if (dlasd3_(interp, nl, nr, sqre, &k, &d__[1], &work[iq], &ldq, &work[isigma], &u[	    u_offset], ldu, &work[iu2], &ldu2, &vt[vt_offset], ldvt, &work[
	    ivt2], &ldvt2, &iwork[idxc], &iwork[coltyp], &work[iz], info)!=TCL_OK) { return TCL_ERROR; }


    if (*info != 0) {
return TCL_OK;
    }


    if (dlascl_(interp, "G", &dlasd1_c__0, &dlasd1_c__0, &dlasd1_c_b7, &orgnrm, &n, &dlasd1_c__1, &d__[1], &n, info)!=TCL_OK) { return TCL_ERROR; }



    n1 = k;
    n2 = n - k;
    if (dlamrg_(interp, &n1, &n2, &d__[1], &dlasd1_c__1, &dlasd1_c_n1, &idxq[1])!=TCL_OK) { return TCL_ERROR; }


return TCL_OK;


} /* dlasd1_ */
static /* Subroutine */ int dlasdt_ (Tcl_Interp *interp, integer *n, integer *lvl, integer *nd, integer *	inode, integer *ndiml, integer *ndimr, integer *msub)
{
    integer i__1, i__2;

    double log(doublereal);

    integer i__, il, ir, maxn;
    doublereal temp;
    integer nlvl, llst, ncrnt;



















    --ndimr;
    --ndiml;
    --inode;

    maxn = max(1,*n);
    temp = log((doublereal) maxn / (doublereal) (*msub + 1)) / log(2.);
    *lvl = (integer) temp + 1;

    i__ = *n / 2;
    inode[1] = i__ + 1;
    ndiml[1] = i__;
    ndimr[1] = *n - i__ - 1;
    il = 0;
    ir = 1;
    llst = 1;
    i__1 = *lvl - 1;
    for (nlvl = 1; nlvl <= i__1; ++nlvl) {


	i__2 = llst - 1;
	for (i__ = 0; i__ <= i__2; ++i__) {
	    il += 2;
	    ir += 2;
	    ncrnt = llst + i__;
	    ndiml[il] = ndiml[ncrnt] / 2;
	    ndimr[il] = ndiml[ncrnt] - ndiml[il] - 1;
	    inode[il] = inode[ncrnt] - ndimr[il] - 1;
	    ndiml[ir] = ndimr[ncrnt] / 2;
	    ndimr[ir] = ndimr[ncrnt] - ndiml[ir] - 1;
	    inode[ir] = inode[ncrnt] + ndiml[ir] + 1;
	}
	llst <<= 1;
    }
    *nd = (llst << 1) - 1;

return TCL_OK;


} /* dlasdt_ */
static /* Subroutine */ int dlasd6_ (Tcl_Interp *interp, integer *icompq, integer *nl, integer *nr, 	integer *sqre, doublereal *d__, doublereal *vf, doublereal *vl, 	doublereal *alpha, doublereal *beta, integer *idxq, integer *perm, 	integer *givptr, integer *givcol, integer *ldgcol, doublereal *givnum, 	 integer *ldgnum, doublereal *poles, doublereal *difl, doublereal *	difr, doublereal *z__, integer *k, doublereal *c__, doublereal *s, 	doublereal *work, integer *iwork, integer *info)
{
    integer givcol_dim1, givcol_offset, givnum_dim1, givnum_offset, 
	    poles_dim1, poles_offset, i__1;
    doublereal d__1, d__2;

    integer i__, m, n, n1, n2, iw, idx, idxc, idxp, ivfw, ivlw;
    integer isigma;
    doublereal orgnrm;


















































    --d__;
    --vf;
    --vl;
    --idxq;
    --perm;
    givcol_dim1 = *ldgcol;
    givcol_offset = 1 + givcol_dim1;
    givcol -= givcol_offset;
    poles_dim1 = *ldgnum;
    poles_offset = 1 + poles_dim1;
    poles -= poles_offset;
    givnum_dim1 = *ldgnum;
    givnum_offset = 1 + givnum_dim1;
    givnum -= givnum_offset;
    --difl;
    --difr;
    --z__;
    --work;
    --iwork;

    *info = 0;
    n = *nl + *nr + 1;
    m = n + *sqre;

    if (*icompq < 0 || *icompq > 1) {
	*info = -1;
    } else if (*nl < 1) {
	*info = -2;
    } else if (*nr < 1) {
	*info = -3;
    } else if (*sqre < 0 || *sqre > 1) {
	*info = -4;
    } else if (*ldgcol < n) {
	*info = -14;
    } else if (*ldgnum < n) {
	*info = -16;
    }
    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DLASD6", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


    isigma = 1;
    iw = isigma + n;
    ivfw = iw + m;
    ivlw = ivfw + m;

    idx = 1;
    idxc = idx + n;
    idxp = idxc + n;


    d__1 = abs(*alpha), d__2 = abs(*beta);
    orgnrm = max(d__1,d__2);
    d__[*nl + 1] = 0.;
    i__1 = n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	if ((d__1 = d__[i__], abs(d__1)) > orgnrm) {
	    orgnrm = (d__1 = d__[i__], abs(d__1));
	}
    }
    if (dlascl_(interp, "G", &dlasd6_c__0, &dlasd6_c__0, &orgnrm, &dlasd6_c_b7, &n, &dlasd6_c__1, &d__[1], &n, info)!=TCL_OK) { return TCL_ERROR; }

    *alpha /= orgnrm;
    *beta /= orgnrm;


    if (dlasd7_(interp, icompq, nl, nr, sqre, k, &d__[1], &z__[1], &work[iw], &vf[1], &	    work[ivfw], &vl[1], &work[ivlw], alpha, beta, &work[isigma], &
	    iwork[idx], &iwork[idxp], &idxq[1], &perm[1], givptr, &givcol[
	    givcol_offset], ldgcol, &givnum[givnum_offset], ldgnum, c__, s, 
	    info)!=TCL_OK) { return TCL_ERROR; }




    if (dlasd8_(interp, icompq, k, &d__[1], &z__[1], &vf[1], &vl[1], &difl[1], &difr[1], 	    ldgnum, &work[isigma], &work[iw], info)!=TCL_OK) { return TCL_ERROR; }




    if (*icompq == 1) {
	if (dcopy_(interp, k, &d__[1], &dlasd6_c__1, &poles[poles_dim1 + 1], &dlasd6_c__1)!=TCL_OK) { return TCL_ERROR; }

	if (dcopy_(interp, k, &work[isigma], &dlasd6_c__1, &poles[(poles_dim1 << 1) + 1], &dlasd6_c__1)!=TCL_OK) { return TCL_ERROR; }

    }


    if (dlascl_(interp, "G", &dlasd6_c__0, &dlasd6_c__0, &dlasd6_c_b7, &orgnrm, &n, &dlasd6_c__1, &d__[1], &n, info)!=TCL_OK) { return TCL_ERROR; }



    n1 = *k;
    n2 = n - *k;
    if (dlamrg_(interp, &n1, &n2, &d__[1], &dlasd6_c__1, &dlasd6_c_n1, &idxq[1])!=TCL_OK) { return TCL_ERROR; }


return TCL_OK;


} /* dlasd6_ */
static /* Subroutine */ int dlarf_ (Tcl_Interp *interp, char *side, integer *m, integer *n, doublereal *v, 	 integer *incv, doublereal *tau, doublereal *c__, integer *ldc, 	doublereal *work)
{
    integer c_dim1, c_offset;
    doublereal d__1;

    integer i__;
    logical applyleft;
    integer lastc, lastv;





















    --v;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;
    --work;

    applyleft = lsame_(side, "L");
    lastv = 0;
    lastc = 0;
    if (*tau != 0.) {
	if (applyleft) {
	    lastv = *m;
	} else {
	    lastv = *n;
	}
	if (*incv > 0) {
	    i__ = (lastv - 1) * *incv + 1;
	} else {
	    i__ = 1;
	}
	while(lastv > 0 && v[i__] == 0.) {
	    --lastv;
	    i__ -= *incv;
	}
	if (applyleft) {
	    lastc = iladlc_(&lastv, n, &c__[c_offset], ldc);
	} else {
	    lastc = iladlr_(m, &lastv, &c__[c_offset], ldc);
	}
    }
    if (applyleft) {


	if (lastv > 0) {


	    if (dgemv_(interp, "Transpose", &lastv, &lastc, &dlarf_c_b4, &c__[c_offset], ldc, &		    v[1], incv, &dlarf_c_b5, &work[1], &dlarf_c__1)!=TCL_OK) { return TCL_ERROR; }




	    d__1 = -(*tau);
	    if (dger_(interp, &lastv, &lastc, &d__1, &v[1], incv, &work[1], &dlarf_c__1, &c__[		    c_offset], ldc)!=TCL_OK) { return TCL_ERROR; }


	}
    } else {


	if (lastv > 0) {


	    if (dgemv_(interp, "No transpose", &lastc, &lastv, &dlarf_c_b4, &c__[c_offset], ldc, 		     &v[1], incv, &dlarf_c_b5, &work[1], &dlarf_c__1)!=TCL_OK) { return TCL_ERROR; }




	    d__1 = -(*tau);
	    if (dger_(interp, &lastc, &lastv, &d__1, &work[1], &dlarf_c__1, &v[1], incv, &c__[		    c_offset], ldc)!=TCL_OK) { return TCL_ERROR; }


	}
    }
return TCL_OK;


} /* dlarf_ */
static /* Subroutine */ int dlarfg_ (Tcl_Interp *interp, integer *n, doublereal *alpha, doublereal *x, 	integer *incx, doublereal *tau)
{
    integer i__1;
    doublereal d__1;

    double d_sign(doublereal *, doublereal *);

    integer j, knt;
    doublereal beta;
    doublereal xnorm;
    doublereal safmin, rsafmn;




















    --x;

    if (*n <= 1) {
	*tau = 0.;
return TCL_OK;
    }

    i__1 = *n - 1;
    xnorm = dnrm2_(&i__1, &x[1], incx);

    if (xnorm == 0.) {


	*tau = 0.;
    } else {


	d__1 = dlapy2_(alpha, &xnorm);
	beta = -d_sign(&d__1, alpha);
	safmin = dlamch_("S") / dlamch_("E");
	knt = 0;
	if (abs(beta) < safmin) {


	    rsafmn = 1. / safmin;
L10:
	    ++knt;
	    i__1 = *n - 1;
	    if (dscal_(interp, &i__1, &rsafmn, &x[1], incx)!=TCL_OK) { return TCL_ERROR; }

	    beta *= rsafmn;
	    *alpha *= rsafmn;
	    if (abs(beta) < safmin) {
		goto L10;
	    }


	    i__1 = *n - 1;
	    xnorm = dnrm2_(&i__1, &x[1], incx);
	    d__1 = dlapy2_(alpha, &xnorm);
	    beta = -d_sign(&d__1, alpha);
	}
	*tau = (beta - *alpha) / beta;
	i__1 = *n - 1;
	d__1 = 1. / (*alpha - beta);
	if (dscal_(interp, &i__1, &d__1, &x[1], incx)!=TCL_OK) { return TCL_ERROR; }



	i__1 = knt;
	for (j = 1; j <= i__1; ++j) {
	    beta *= safmin;
	}
	*alpha = beta;
    }

return TCL_OK;


} /* dlarfg_ */
static /* Subroutine */ int dlarfp_ (Tcl_Interp *interp, integer *n, doublereal *alpha, doublereal *x, 	integer *incx, doublereal *tau)
{
    integer i__1;
    doublereal d__1;

    double d_sign(doublereal *, doublereal *);

    integer j, knt;
    doublereal beta;
    doublereal xnorm;
    doublereal safmin, rsafmn;




















    --x;

    if (*n <= 0) {
	*tau = 0.;
return TCL_OK;
    }

    i__1 = *n - 1;
    xnorm = dnrm2_(&i__1, &x[1], incx);

    if (xnorm == 0.) {


	if (*alpha >= 0.) {
	    *tau = 0.;
	} else {
	    *tau = 2.;
	    i__1 = *n - 1;
	    for (j = 1; j <= i__1; ++j) {
		x[(j - 1) * *incx + 1] = 0.;
	    }
	    *alpha = -(*alpha);
	}
    } else {


	d__1 = dlapy2_(alpha, &xnorm);
	beta = d_sign(&d__1, alpha);
	safmin = dlamch_("S") / dlamch_("E");
	knt = 0;
	if (abs(beta) < safmin) {


	    rsafmn = 1. / safmin;
L10:
	    ++knt;
	    i__1 = *n - 1;
	    if (dscal_(interp, &i__1, &rsafmn, &x[1], incx)!=TCL_OK) { return TCL_ERROR; }

	    beta *= rsafmn;
	    *alpha *= rsafmn;
	    if (abs(beta) < safmin) {
		goto L10;
	    }


	    i__1 = *n - 1;
	    xnorm = dnrm2_(&i__1, &x[1], incx);
	    d__1 = dlapy2_(alpha, &xnorm);
	    beta = d_sign(&d__1, alpha);
	}
	*alpha += beta;
	if (beta < 0.) {
	    beta = -beta;
	    *tau = -(*alpha) / beta;
	} else {
	    *alpha = xnorm * (xnorm / *alpha);
	    *tau = *alpha / beta;
	    *alpha = -(*alpha);
	}
	i__1 = *n - 1;
	d__1 = 1. / *alpha;
	if (dscal_(interp, &i__1, &d__1, &x[1], incx)!=TCL_OK) { return TCL_ERROR; }



	i__1 = knt;
	for (j = 1; j <= i__1; ++j) {
	    beta *= safmin;
	}
	*alpha = beta;
    }

return TCL_OK;


} /* dlarfp_ */
static integer iladlc_ (integer *m, integer *n, doublereal *a, integer *lda)
{
    integer a_dim1, a_offset, ret_val, i__1;

    integer i__;















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

    if (*n == 0) {
	ret_val = *n;
    } else if (a[*n * a_dim1 + 1] != 0. || a[*m + *n * a_dim1] != 0.) {
	ret_val = *n;
    } else {
	for (ret_val = *n; ret_val >= 1; --ret_val) {
	    i__1 = *m;
	    for (i__ = 1; i__ <= i__1; ++i__) {
		if (a[i__ + ret_val * a_dim1] != 0.) {
		    return ret_val;
		}
	    }
	}
    }
    return ret_val;
} /* iladlc_ */
static integer iladlr_ (integer *m, integer *n, doublereal *a, integer *lda)
{
    integer a_dim1, a_offset, ret_val, i__1;

    integer i__, j;















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

    if (*m == 0) {
	ret_val = *m;
    } else if (a[*m + a_dim1] != 0. || a[*m + *n * a_dim1] != 0.) {
	ret_val = *m;
    } else {
	ret_val = 0;
	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    for (i__ = *m; i__ >= 1; --i__) {
		if (a[i__ + j * a_dim1] != 0.) {
		    break;
		}
	    }
	    ret_val = max(ret_val,i__);
	}
    }
    return ret_val;
} /* iladlr_ */
static /* Subroutine */ int dtrmv_ (Tcl_Interp *interp, char *uplo, char *trans, char *diag, integer *n, 	doublereal *a, integer *lda, doublereal *x, integer *incx)
{
    integer a_dim1, a_offset, i__1, i__2;

    integer i__, j, ix, jx, kx, info;
    doublereal temp;
    logical nounit;































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

    info = 0;
    if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {
	info = 1;
    } else if (! lsame_(trans, "N") && ! lsame_(trans, 
	    "T") && ! lsame_(trans, "C")) {
	info = 2;
    } else if (! lsame_(diag, "U") && ! lsame_(diag, 
	    "N")) {
	info = 3;
    } else if (*n < 0) {
	info = 4;
    } else if (*lda < max(1,*n)) {
	info = 6;
    } else if (*incx == 0) {
	info = 8;
    }
    if (info != 0) {
	vectcl_xerbla(interp, "DTRMV ", &info);
return TCL_ERROR;

return TCL_OK;
    }


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

    nounit = lsame_(diag, "N");


    if (*incx <= 0) {
	kx = 1 - (*n - 1) * *incx;
    } else if (*incx != 1) {
	kx = 1;
    }


    if (lsame_(trans, "N")) {


	if (lsame_(uplo, "U")) {
	    if (*incx == 1) {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    if (x[j] != 0.) {
			temp = x[j];
			i__2 = j - 1;
			for (i__ = 1; i__ <= i__2; ++i__) {
			    x[i__] += temp * a[i__ + j * a_dim1];
			}
			if (nounit) {
			    x[j] *= a[j + j * a_dim1];
			}
		    }
		}
	    } else {
		jx = kx;
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    if (x[jx] != 0.) {
			temp = x[jx];
			ix = kx;
			i__2 = j - 1;
			for (i__ = 1; i__ <= i__2; ++i__) {
			    x[ix] += temp * a[i__ + j * a_dim1];
			    ix += *incx;
			}
			if (nounit) {
			    x[jx] *= a[j + j * a_dim1];
			}
		    }
		    jx += *incx;
		}
	    }
	} else {
	    if (*incx == 1) {
		for (j = *n; j >= 1; --j) {
		    if (x[j] != 0.) {
			temp = x[j];
			i__1 = j + 1;
			for (i__ = *n; i__ >= i__1; --i__) {
			    x[i__] += temp * a[i__ + j * a_dim1];
			}
			if (nounit) {
			    x[j] *= a[j + j * a_dim1];
			}
		    }
		}
	    } else {
		kx += (*n - 1) * *incx;
		jx = kx;
		for (j = *n; j >= 1; --j) {
		    if (x[jx] != 0.) {
			temp = x[jx];
			ix = kx;
			i__1 = j + 1;
			for (i__ = *n; i__ >= i__1; --i__) {
			    x[ix] += temp * a[i__ + j * a_dim1];
			    ix -= *incx;
			}
			if (nounit) {
			    x[jx] *= a[j + j * a_dim1];
			}
		    }
		    jx -= *incx;
		}
	    }
	}
    } else {


	if (lsame_(uplo, "U")) {
	    if (*incx == 1) {
		for (j = *n; j >= 1; --j) {
		    temp = x[j];
		    if (nounit) {
			temp *= a[j + j * a_dim1];
		    }
		    for (i__ = j - 1; i__ >= 1; --i__) {
			temp += a[i__ + j * a_dim1] * x[i__];
		    }
		    x[j] = temp;
		}
	    } else {
		jx = kx + (*n - 1) * *incx;
		for (j = *n; j >= 1; --j) {
		    temp = x[jx];
		    ix = jx;
		    if (nounit) {
			temp *= a[j + j * a_dim1];
		    }
		    for (i__ = j - 1; i__ >= 1; --i__) {
			ix -= *incx;
			temp += a[i__ + j * a_dim1] * x[ix];
		    }
		    x[jx] = temp;
		    jx -= *incx;
		}
	    }
	} else {
	    if (*incx == 1) {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    temp = x[j];
		    if (nounit) {
			temp *= a[j + j * a_dim1];
		    }
		    i__2 = *n;
		    for (i__ = j + 1; i__ <= i__2; ++i__) {
			temp += a[i__ + j * a_dim1] * x[i__];
		    }
		    x[j] = temp;
		}
	    } else {
		jx = kx;
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    temp = x[jx];
		    ix = jx;
		    if (nounit) {
			temp *= a[j + j * a_dim1];
		    }
		    i__2 = *n;
		    for (i__ = j + 1; i__ <= i__2; ++i__) {
			ix += *incx;
			temp += a[i__ + j * a_dim1] * x[ix];
		    }
		    x[jx] = temp;
		    jx += *incx;
		}
	    }
	}
    }

return TCL_OK;


} /* dtrmv_ */
static logical dlaisnan_ (doublereal *din1, doublereal *din2)
{
    logical ret_val;











    ret_val = *din1 != *din2;
    return ret_val;
} /* dlaisnan_ */
static /* Subroutine */ int zlarf_ (Tcl_Interp *interp, char *side, integer *m, integer *n, doublecomplex 	*v, integer *incv, doublecomplex *tau, doublecomplex *c__, integer *	ldc, doublecomplex *work)
{
    integer c_dim1, c_offset, i__1;
    doublecomplex z__1;

    integer i__;
    logical applyleft;
    integer lastc;
    integer lastv;






















    --v;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;
    --work;

    applyleft = lsame_(side, "L");
    lastv = 0;
    lastc = 0;
    if (tau->r != 0. || tau->i != 0.) {
	if (applyleft) {
	    lastv = *m;
	} else {
	    lastv = *n;
	}
	if (*incv > 0) {
	    i__ = (lastv - 1) * *incv + 1;
	} else {
	    i__ = 1;
	}
	for(;;) { /* while(complicated condition) */
	    i__1 = i__;
	    if (!(lastv > 0 && (v[i__1].r == 0. && v[i__1].i == 0.)))
	    	break;
	    --lastv;
	    i__ -= *incv;
	}
	if (applyleft) {
	    lastc = ilazlc_(&lastv, n, &c__[c_offset], ldc);
	} else {
	    lastc = ilazlr_(m, &lastv, &c__[c_offset], ldc);
	}
    }
    if (applyleft) {


	if (lastv > 0) {


	    if (zgemv_(interp, "Conjugate transpose", &lastv, &lastc, &zlarf_c_b1, &c__[		    c_offset], ldc, &v[1], incv, &zlarf_c_b2, &work[1], &zlarf_c__1)!=TCL_OK) { return TCL_ERROR; }




	    z__1.r = -tau->r, z__1.i = -tau->i;
	    if (zgerc_(interp, &lastv, &lastc, &z__1, &v[1], incv, &work[1], &zlarf_c__1, &c__[		    c_offset], ldc)!=TCL_OK) { return TCL_ERROR; }


	}
    } else {


	if (lastv > 0) {


	    if (zgemv_(interp, "No transpose", &lastc, &lastv, &zlarf_c_b1, &c__[c_offset], ldc, 		     &v[1], incv, &zlarf_c_b2, &work[1], &zlarf_c__1)!=TCL_OK) { return TCL_ERROR; }




	    z__1.r = -tau->r, z__1.i = -tau->i;
	    if (zgerc_(interp, &lastc, &lastv, &z__1, &work[1], &zlarf_c__1, &v[1], incv, &c__[		    c_offset], ldc)!=TCL_OK) { return TCL_ERROR; }


	}
    }
return TCL_OK;


} /* zlarf_ */
static /* Subroutine */ int zlarfg_ (Tcl_Interp *interp, integer *n, doublecomplex *alpha, doublecomplex *	x, integer *incx, doublecomplex *tau)
{
    integer i__1;
    doublereal d__1, d__2;
    doublecomplex z__1, z__2;

    double d_imag(doublecomplex *), d_sign(doublereal *, doublereal *);

    integer j, knt;
    doublereal beta, alphi, alphr;
    doublereal xnorm;
    doublereal safmin;
    doublereal rsafmn;




















    --x;

    if (*n <= 0) {
	tau->r = 0., tau->i = 0.;
return TCL_OK;
    }

    i__1 = *n - 1;
    xnorm = dznrm2_(&i__1, &x[1], incx);
    alphr = alpha->r;
    alphi = d_imag(alpha);

    if (xnorm == 0. && alphi == 0.) {


	tau->r = 0., tau->i = 0.;
    } else {


	d__1 = dlapy3_(&alphr, &alphi, &xnorm);
	beta = -d_sign(&d__1, &alphr);
	safmin = dlamch_("S") / dlamch_("E");
	rsafmn = 1. / safmin;

	knt = 0;
	if (abs(beta) < safmin) {


L10:
	    ++knt;
	    i__1 = *n - 1;
	    if (zdscal_(interp, &i__1, &rsafmn, &x[1], incx)!=TCL_OK) { return TCL_ERROR; }

	    beta *= rsafmn;
	    alphi *= rsafmn;
	    alphr *= rsafmn;
	    if (abs(beta) < safmin) {
		goto L10;
	    }


	    i__1 = *n - 1;
	    xnorm = dznrm2_(&i__1, &x[1], incx);
	    z__1.r = alphr, z__1.i = alphi;
	    alpha->r = z__1.r, alpha->i = z__1.i;
	    d__1 = dlapy3_(&alphr, &alphi, &xnorm);
	    beta = -d_sign(&d__1, &alphr);
	}
	d__1 = (beta - alphr) / beta;
	d__2 = -alphi / beta;
	z__1.r = d__1, z__1.i = d__2;
	tau->r = z__1.r, tau->i = z__1.i;
	z__2.r = alpha->r - beta, z__2.i = alpha->i;
	zladiv_(&z__1, &zlarfg_c_b5, &z__2);
	alpha->r = z__1.r, alpha->i = z__1.i;
	i__1 = *n - 1;
	if (zscal_(interp, &i__1, alpha, &x[1], incx)!=TCL_OK) { return TCL_ERROR; }



	i__1 = knt;
	for (j = 1; j <= i__1; ++j) {
	    beta *= safmin;
	}
	alpha->r = beta, alpha->i = 0.;
    }

return TCL_OK;


} /* zlarfg_ */
static /* Subroutine */ int zlacgv_ (Tcl_Interp *interp, integer *n, doublecomplex *x, integer *incx)
{
    integer i__1, i__2;
    doublecomplex z__1;

    void d_cnjg(doublecomplex *, doublecomplex *);

    integer i__, ioff;












    --x;

    if (*incx == 1) {
	i__1 = *n;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    i__2 = i__;
	    d_cnjg(&z__1, &x[i__]);
	    x[i__2].r = z__1.r, x[i__2].i = z__1.i;
	}
    } else {
	ioff = 1;
	if (*incx < 0) {
	    ioff = 1 - (*n - 1) * *incx;
	}
	i__1 = *n;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    i__2 = ioff;
	    d_cnjg(&z__1, &x[ioff]);
	    x[i__2].r = z__1.r, x[i__2].i = z__1.i;
	    ioff += *incx;
	}
    }
return TCL_OK;


} /* zlacgv_ */
static /* Subroutine */ int zlarfp_ (Tcl_Interp *interp, integer *n, doublecomplex *alpha, doublecomplex *	x, integer *incx, doublecomplex *tau)
{
    integer i__1, i__2;
    doublereal d__1, d__2;
    doublecomplex z__1, z__2;

    double d_imag(doublecomplex *), d_sign(doublereal *, doublereal *);

    integer j, knt;
    doublereal beta, alphi, alphr;
    doublereal xnorm;
    doublereal safmin;
    doublereal rsafmn;




















    --x;

    if (*n <= 0) {
	tau->r = 0., tau->i = 0.;
return TCL_OK;
    }

    i__1 = *n - 1;
    xnorm = dznrm2_(&i__1, &x[1], incx);
    alphr = alpha->r;
    alphi = d_imag(alpha);

    if (xnorm == 0. && alphi == 0.) {


	if (alphi == 0.) {
	    if (alphr >= 0.) {
		tau->r = 0., tau->i = 0.;
	    } else {
		tau->r = 2., tau->i = 0.;
		i__1 = *n - 1;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = (j - 1) * *incx + 1;
		    x[i__2].r = 0., x[i__2].i = 0.;
		}
		z__1.r = -alpha->r, z__1.i = -alpha->i;
		alpha->r = z__1.r, alpha->i = z__1.i;
	    }
	} else {
	    xnorm = dlapy2_(&alphr, &alphi);
	    d__1 = 1. - alphr / xnorm;
	    d__2 = -alphi / xnorm;
	    z__1.r = d__1, z__1.i = d__2;
	    tau->r = z__1.r, tau->i = z__1.i;
	    i__1 = *n - 1;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = (j - 1) * *incx + 1;
		x[i__2].r = 0., x[i__2].i = 0.;
	    }
	    alpha->r = xnorm, alpha->i = 0.;
	}
    } else {


	d__1 = dlapy3_(&alphr, &alphi, &xnorm);
	beta = d_sign(&d__1, &alphr);
	safmin = dlamch_("S") / dlamch_("E");
	rsafmn = 1. / safmin;

	knt = 0;
	if (abs(beta) < safmin) {


L10:
	    ++knt;
	    i__1 = *n - 1;
	    if (zdscal_(interp, &i__1, &rsafmn, &x[1], incx)!=TCL_OK) { return TCL_ERROR; }

	    beta *= rsafmn;
	    alphi *= rsafmn;
	    alphr *= rsafmn;
	    if (abs(beta) < safmin) {
		goto L10;
	    }


	    i__1 = *n - 1;
	    xnorm = dznrm2_(&i__1, &x[1], incx);
	    z__1.r = alphr, z__1.i = alphi;
	    alpha->r = z__1.r, alpha->i = z__1.i;
	    d__1 = dlapy3_(&alphr, &alphi, &xnorm);
	    beta = d_sign(&d__1, &alphr);
	}
	z__1.r = alpha->r + beta, z__1.i = alpha->i;
	alpha->r = z__1.r, alpha->i = z__1.i;
	if (beta < 0.) {
	    beta = -beta;
	    z__2.r = -alpha->r, z__2.i = -alpha->i;
	    z__1.r = z__2.r / beta, z__1.i = z__2.i / beta;
	    tau->r = z__1.r, tau->i = z__1.i;
	} else {
	    alphr = alphi * (alphi / alpha->r);
	    alphr += xnorm * (xnorm / alpha->r);
	    d__1 = alphr / beta;
	    d__2 = -alphi / beta;
	    z__1.r = d__1, z__1.i = d__2;
	    tau->r = z__1.r, tau->i = z__1.i;
	    d__1 = -alphr;
	    z__1.r = d__1, z__1.i = alphi;
	    alpha->r = z__1.r, alpha->i = z__1.i;
	}
	zladiv_(&z__1, &zlarfp_c_b5, alpha);
	alpha->r = z__1.r, alpha->i = z__1.i;
	i__1 = *n - 1;
	if (zscal_(interp, &i__1, alpha, &x[1], incx)!=TCL_OK) { return TCL_ERROR; }



	i__1 = knt;
	for (j = 1; j <= i__1; ++j) {
	    beta *= safmin;
	}
	alpha->r = beta, alpha->i = 0.;
    }

return TCL_OK;


} /* zlarfp_ */
static integer ilazlc_ (integer *m, integer *n, doublecomplex *a, integer *lda)
{
    integer a_dim1, a_offset, ret_val, i__1, i__2;

    integer i__;















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

    if (*n == 0) {
	ret_val = *n;
    } else /* if(complicated condition) */ {
	i__1 = *n * a_dim1 + 1;
	i__2 = *m + *n * a_dim1;
	if (a[i__1].r != 0. || a[i__1].i != 0. || (a[i__2].r != 0. || a[i__2]
		.i != 0.)) {
	    ret_val = *n;
	} else {
	    for (ret_val = *n; ret_val >= 1; --ret_val) {
		i__1 = *m;
		for (i__ = 1; i__ <= i__1; ++i__) {
		    i__2 = i__ + ret_val * a_dim1;
		    if (a[i__2].r != 0. || a[i__2].i != 0.) {
			return ret_val;
		    }
		}
	    }
	}
    }
    return ret_val;
} /* ilazlc_ */
static integer ilazlr_ (integer *m, integer *n, doublecomplex *a, integer *lda)
{
    integer a_dim1, a_offset, ret_val, i__1, i__2;

    integer i__, j;















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

    if (*m == 0) {
	ret_val = *m;
    } else /* if(complicated condition) */ {
	i__1 = *m + a_dim1;
	i__2 = *m + *n * a_dim1;
	if (a[i__1].r != 0. || a[i__1].i != 0. || (a[i__2].r != 0. || a[i__2]
		.i != 0.)) {
	    ret_val = *m;
	} else {
	    ret_val = 0;
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		for (i__ = *m; i__ >= 1; --i__) {
		    i__2 = i__ + j * a_dim1;
		    if (a[i__2].r != 0. || a[i__2].i != 0.) {
			break;
		    }
		}
		ret_val = max(ret_val,i__);
	    }
	}
    }
    return ret_val;
} /* ilazlr_ */
static /* Subroutine */ int ztrmv_ (Tcl_Interp *interp, char *uplo, char *trans, char *diag, integer *n, 	doublecomplex *a, integer *lda, doublecomplex *x, integer *incx)
{
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
    doublecomplex z__1, z__2, z__3;

    void d_cnjg(doublecomplex *, doublecomplex *);

    integer i__, j, ix, jx, kx, info;
    doublecomplex temp;
    logical noconj, nounit;































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

    info = 0;
    if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {
	info = 1;
    } else if (! lsame_(trans, "N") && ! lsame_(trans, 
	    "T") && ! lsame_(trans, "C")) {
	info = 2;
    } else if (! lsame_(diag, "U") && ! lsame_(diag, 
	    "N")) {
	info = 3;
    } else if (*n < 0) {
	info = 4;
    } else if (*lda < max(1,*n)) {
	info = 6;
    } else if (*incx == 0) {
	info = 8;
    }
    if (info != 0) {
	vectcl_xerbla(interp, "ZTRMV ", &info);
return TCL_ERROR;

return TCL_OK;
    }


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

    noconj = lsame_(trans, "T");
    nounit = lsame_(diag, "N");


    if (*incx <= 0) {
	kx = 1 - (*n - 1) * *incx;
    } else if (*incx != 1) {
	kx = 1;
    }


    if (lsame_(trans, "N")) {


	if (lsame_(uplo, "U")) {
	    if (*incx == 1) {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = j;
		    if (x[i__2].r != 0. || x[i__2].i != 0.) {
			i__2 = j;
			temp.r = x[i__2].r, temp.i = x[i__2].i;
			i__2 = j - 1;
			for (i__ = 1; i__ <= i__2; ++i__) {
			    i__3 = i__;
			    i__4 = i__;
			    i__5 = i__ + j * a_dim1;
			    z__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i, 
				    z__2.i = temp.r * a[i__5].i + temp.i * a[
				    i__5].r;
			    z__1.r = x[i__4].r + z__2.r, z__1.i = x[i__4].i + 
				    z__2.i;
			    x[i__3].r = z__1.r, x[i__3].i = z__1.i;
			}
			if (nounit) {
			    i__2 = j;
			    i__3 = j;
			    i__4 = j + j * a_dim1;
			    z__1.r = x[i__3].r * a[i__4].r - x[i__3].i * a[
				    i__4].i, z__1.i = x[i__3].r * a[i__4].i + 
				    x[i__3].i * a[i__4].r;
			    x[i__2].r = z__1.r, x[i__2].i = z__1.i;
			}
		    }
		}
	    } else {
		jx = kx;
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = jx;
		    if (x[i__2].r != 0. || x[i__2].i != 0.) {
			i__2 = jx;
			temp.r = x[i__2].r, temp.i = x[i__2].i;
			ix = kx;
			i__2 = j - 1;
			for (i__ = 1; i__ <= i__2; ++i__) {
			    i__3 = ix;
			    i__4 = ix;
			    i__5 = i__ + j * a_dim1;
			    z__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i, 
				    z__2.i = temp.r * a[i__5].i + temp.i * a[
				    i__5].r;
			    z__1.r = x[i__4].r + z__2.r, z__1.i = x[i__4].i + 
				    z__2.i;
			    x[i__3].r = z__1.r, x[i__3].i = z__1.i;
			    ix += *incx;
			}
			if (nounit) {
			    i__2 = jx;
			    i__3 = jx;
			    i__4 = j + j * a_dim1;
			    z__1.r = x[i__3].r * a[i__4].r - x[i__3].i * a[
				    i__4].i, z__1.i = x[i__3].r * a[i__4].i + 
				    x[i__3].i * a[i__4].r;
			    x[i__2].r = z__1.r, x[i__2].i = z__1.i;
			}
		    }
		    jx += *incx;
		}
	    }
	} else {
	    if (*incx == 1) {
		for (j = *n; j >= 1; --j) {
		    i__1 = j;
		    if (x[i__1].r != 0. || x[i__1].i != 0.) {
			i__1 = j;
			temp.r = x[i__1].r, temp.i = x[i__1].i;
			i__1 = j + 1;
			for (i__ = *n; i__ >= i__1; --i__) {
			    i__2 = i__;
			    i__3 = i__;
			    i__4 = i__ + j * a_dim1;
			    z__2.r = temp.r * a[i__4].r - temp.i * a[i__4].i, 
				    z__2.i = temp.r * a[i__4].i + temp.i * a[
				    i__4].r;
			    z__1.r = x[i__3].r + z__2.r, z__1.i = x[i__3].i + 
				    z__2.i;
			    x[i__2].r = z__1.r, x[i__2].i = z__1.i;
			}
			if (nounit) {
			    i__1 = j;
			    i__2 = j;
			    i__3 = j + j * a_dim1;
			    z__1.r = x[i__2].r * a[i__3].r - x[i__2].i * a[
				    i__3].i, z__1.i = x[i__2].r * a[i__3].i + 
				    x[i__2].i * a[i__3].r;
			    x[i__1].r = z__1.r, x[i__1].i = z__1.i;
			}
		    }
		}
	    } else {
		kx += (*n - 1) * *incx;
		jx = kx;
		for (j = *n; j >= 1; --j) {
		    i__1 = jx;
		    if (x[i__1].r != 0. || x[i__1].i != 0.) {
			i__1 = jx;
			temp.r = x[i__1].r, temp.i = x[i__1].i;
			ix = kx;
			i__1 = j + 1;
			for (i__ = *n; i__ >= i__1; --i__) {
			    i__2 = ix;
			    i__3 = ix;
			    i__4 = i__ + j * a_dim1;
			    z__2.r = temp.r * a[i__4].r - temp.i * a[i__4].i, 
				    z__2.i = temp.r * a[i__4].i + temp.i * a[
				    i__4].r;
			    z__1.r = x[i__3].r + z__2.r, z__1.i = x[i__3].i + 
				    z__2.i;
			    x[i__2].r = z__1.r, x[i__2].i = z__1.i;
			    ix -= *incx;
			}
			if (nounit) {
			    i__1 = jx;
			    i__2 = jx;
			    i__3 = j + j * a_dim1;
			    z__1.r = x[i__2].r * a[i__3].r - x[i__2].i * a[
				    i__3].i, z__1.i = x[i__2].r * a[i__3].i + 
				    x[i__2].i * a[i__3].r;
			    x[i__1].r = z__1.r, x[i__1].i = z__1.i;
			}
		    }
		    jx -= *incx;
		}
	    }
	}
    } else {


	if (lsame_(uplo, "U")) {
	    if (*incx == 1) {
		for (j = *n; j >= 1; --j) {
		    i__1 = j;
		    temp.r = x[i__1].r, temp.i = x[i__1].i;
		    if (noconj) {
			if (nounit) {
			    i__1 = j + j * a_dim1;
			    z__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i, 
				    z__1.i = temp.r * a[i__1].i + temp.i * a[
				    i__1].r;
			    temp.r = z__1.r, temp.i = z__1.i;
			}
			for (i__ = j - 1; i__ >= 1; --i__) {
			    i__1 = i__ + j * a_dim1;
			    i__2 = i__;
			    z__2.r = a[i__1].r * x[i__2].r - a[i__1].i * x[
				    i__2].i, z__2.i = a[i__1].r * x[i__2].i + 
				    a[i__1].i * x[i__2].r;
			    z__1.r = temp.r + z__2.r, z__1.i = temp.i + 
				    z__2.i;
			    temp.r = z__1.r, temp.i = z__1.i;
			}
		    } else {
			if (nounit) {
			    d_cnjg(&z__2, &a[j + j * a_dim1]);
			    z__1.r = temp.r * z__2.r - temp.i * z__2.i, 
				    z__1.i = temp.r * z__2.i + temp.i * 
				    z__2.r;
			    temp.r = z__1.r, temp.i = z__1.i;
			}
			for (i__ = j - 1; i__ >= 1; --i__) {
			    d_cnjg(&z__3, &a[i__ + j * a_dim1]);
			    i__1 = i__;
			    z__2.r = z__3.r * x[i__1].r - z__3.i * x[i__1].i, 
				    z__2.i = z__3.r * x[i__1].i + z__3.i * x[
				    i__1].r;
			    z__1.r = temp.r + z__2.r, z__1.i = temp.i + 
				    z__2.i;
			    temp.r = z__1.r, temp.i = z__1.i;
			}
		    }
		    i__1 = j;
		    x[i__1].r = temp.r, x[i__1].i = temp.i;
		}
	    } else {
		jx = kx + (*n - 1) * *incx;
		for (j = *n; j >= 1; --j) {
		    i__1 = jx;
		    temp.r = x[i__1].r, temp.i = x[i__1].i;
		    ix = jx;
		    if (noconj) {
			if (nounit) {
			    i__1 = j + j * a_dim1;
			    z__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i, 
				    z__1.i = temp.r * a[i__1].i + temp.i * a[
				    i__1].r;
			    temp.r = z__1.r, temp.i = z__1.i;
			}
			for (i__ = j - 1; i__ >= 1; --i__) {
			    ix -= *incx;
			    i__1 = i__ + j * a_dim1;
			    i__2 = ix;
			    z__2.r = a[i__1].r * x[i__2].r - a[i__1].i * x[
				    i__2].i, z__2.i = a[i__1].r * x[i__2].i + 
				    a[i__1].i * x[i__2].r;
			    z__1.r = temp.r + z__2.r, z__1.i = temp.i + 
				    z__2.i;
			    temp.r = z__1.r, temp.i = z__1.i;
			}
		    } else {
			if (nounit) {
			    d_cnjg(&z__2, &a[j + j * a_dim1]);
			    z__1.r = temp.r * z__2.r - temp.i * z__2.i, 
				    z__1.i = temp.r * z__2.i + temp.i * 
				    z__2.r;
			    temp.r = z__1.r, temp.i = z__1.i;
			}
			for (i__ = j - 1; i__ >= 1; --i__) {
			    ix -= *incx;
			    d_cnjg(&z__3, &a[i__ + j * a_dim1]);
			    i__1 = ix;
			    z__2.r = z__3.r * x[i__1].r - z__3.i * x[i__1].i, 
				    z__2.i = z__3.r * x[i__1].i + z__3.i * x[
				    i__1].r;
			    z__1.r = temp.r + z__2.r, z__1.i = temp.i + 
				    z__2.i;
			    temp.r = z__1.r, temp.i = z__1.i;
			}
		    }
		    i__1 = jx;
		    x[i__1].r = temp.r, x[i__1].i = temp.i;
		    jx -= *incx;
		}
	    }
	} else {
	    if (*incx == 1) {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = j;
		    temp.r = x[i__2].r, temp.i = x[i__2].i;
		    if (noconj) {
			if (nounit) {
			    i__2 = j + j * a_dim1;
			    z__1.r = temp.r * a[i__2].r - temp.i * a[i__2].i, 
				    z__1.i = temp.r * a[i__2].i + temp.i * a[
				    i__2].r;
			    temp.r = z__1.r, temp.i = z__1.i;
			}
			i__2 = *n;
			for (i__ = j + 1; i__ <= i__2; ++i__) {
			    i__3 = i__ + j * a_dim1;
			    i__4 = i__;
			    z__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[
				    i__4].i, z__2.i = a[i__3].r * x[i__4].i + 
				    a[i__3].i * x[i__4].r;
			    z__1.r = temp.r + z__2.r, z__1.i = temp.i + 
				    z__2.i;
			    temp.r = z__1.r, temp.i = z__1.i;
			}
		    } else {
			if (nounit) {
			    d_cnjg(&z__2, &a[j + j * a_dim1]);
			    z__1.r = temp.r * z__2.r - temp.i * z__2.i, 
				    z__1.i = temp.r * z__2.i + temp.i * 
				    z__2.r;
			    temp.r = z__1.r, temp.i = z__1.i;
			}
			i__2 = *n;
			for (i__ = j + 1; i__ <= i__2; ++i__) {
			    d_cnjg(&z__3, &a[i__ + j * a_dim1]);
			    i__3 = i__;
			    z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, 
				    z__2.i = z__3.r * x[i__3].i + z__3.i * x[
				    i__3].r;
			    z__1.r = temp.r + z__2.r, z__1.i = temp.i + 
				    z__2.i;
			    temp.r = z__1.r, temp.i = z__1.i;
			}
		    }
		    i__2 = j;
		    x[i__2].r = temp.r, x[i__2].i = temp.i;
		}
	    } else {
		jx = kx;
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = jx;
		    temp.r = x[i__2].r, temp.i = x[i__2].i;
		    ix = jx;
		    if (noconj) {
			if (nounit) {
			    i__2 = j + j * a_dim1;
			    z__1.r = temp.r * a[i__2].r - temp.i * a[i__2].i, 
				    z__1.i = temp.r * a[i__2].i + temp.i * a[
				    i__2].r;
			    temp.r = z__1.r, temp.i = z__1.i;
			}
			i__2 = *n;
			for (i__ = j + 1; i__ <= i__2; ++i__) {
			    ix += *incx;
			    i__3 = i__ + j * a_dim1;
			    i__4 = ix;
			    z__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[
				    i__4].i, z__2.i = a[i__3].r * x[i__4].i + 
				    a[i__3].i * x[i__4].r;
			    z__1.r = temp.r + z__2.r, z__1.i = temp.i + 
				    z__2.i;
			    temp.r = z__1.r, temp.i = z__1.i;
			}
		    } else {
			if (nounit) {
			    d_cnjg(&z__2, &a[j + j * a_dim1]);
			    z__1.r = temp.r * z__2.r - temp.i * z__2.i, 
				    z__1.i = temp.r * z__2.i + temp.i * 
				    z__2.r;
			    temp.r = z__1.r, temp.i = z__1.i;
			}
			i__2 = *n;
			for (i__ = j + 1; i__ <= i__2; ++i__) {
			    ix += *incx;
			    d_cnjg(&z__3, &a[i__ + j * a_dim1]);
			    i__3 = ix;
			    z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, 
				    z__2.i = z__3.r * x[i__3].i + z__3.i * x[
				    i__3].r;
			    z__1.r = temp.r + z__2.r, z__1.i = temp.i + 
				    z__2.i;
			    temp.r = z__1.r, temp.i = z__1.i;
			}
		    }
		    i__2 = jx;
		    x[i__2].r = temp.r, x[i__2].i = temp.i;
		    jx += *incx;
		}
	    }
	}
    }

return TCL_OK;


} /* ztrmv_ */
static /* Subroutine */ int dlaruv_ (Tcl_Interp *interp, integer *iseed, integer *n, doublereal *x)
{

    static integer mm[512]	/* was [128][4] */ = { 494,2637,255,2008,1253,
	    3344,4084,1739,3143,3468,688,1657,1238,3166,1292,3422,1270,2016,
	    154,2862,697,1706,491,931,1444,444,3577,3944,2184,1661,3482,657,
	    3023,3618,1267,1828,164,3798,3087,2400,2870,3876,1905,1593,1797,
	    1234,3460,328,2861,1950,617,2070,3331,769,1558,2412,2800,189,287,
	    2045,1227,2838,209,2770,3654,3993,192,2253,3491,2889,2857,2094,
	    1818,688,1407,634,3231,815,3524,1914,516,164,303,2144,3480,119,
	    3357,837,2826,2332,2089,3780,1700,3712,150,2000,3375,1621,3090,
	    3765,1149,3146,33,3082,2741,359,3316,1749,185,2784,2202,2199,1364,
	    1244,2020,3160,2785,2772,1217,1822,1245,2252,3904,2774,997,2573,
	    1148,545,322,789,1440,752,2859,123,1848,643,2405,2638,2344,46,
	    3814,913,3649,339,3808,822,2832,3078,3633,2970,637,2249,2081,4019,
	    1478,242,481,2075,4058,622,3376,812,234,641,4005,1122,3135,2640,
	    2302,40,1832,2247,2034,2637,1287,1691,496,1597,2394,2584,1843,336,
	    1472,2407,433,2096,1761,2810,566,442,41,1238,1086,603,840,3168,
	    1499,1084,3438,2408,1589,2391,288,26,512,1456,171,1677,2657,2270,
	    2587,2961,1970,1817,676,1410,3723,2803,3185,184,663,499,3784,1631,
	    1925,3912,1398,1349,1441,2224,2411,1907,3192,2786,382,37,759,2948,
	    1862,3802,2423,2051,2295,1332,1832,2405,3638,3661,327,3660,716,
	    1842,3987,1368,1848,2366,2508,3754,1766,3572,2893,307,1297,3966,
	    758,2598,3406,2922,1038,2934,2091,2451,1580,1958,2055,1507,1078,
	    3273,17,854,2916,3971,2889,3831,2621,1541,893,736,3992,787,2125,
	    2364,2460,257,1574,3912,1216,3248,3401,2124,2762,149,2245,166,466,
	    4018,1399,190,2879,153,2320,18,712,2159,2318,2091,3443,1510,449,
	    1956,2201,3137,3399,1321,2271,3667,2703,629,2365,2431,1113,3922,
	    2554,184,2099,3228,4012,1921,3452,3901,572,3309,3171,817,3039,
	    1696,1256,3715,2077,3019,1497,1101,717,51,981,1978,1813,3881,76,
	    3846,3694,1682,124,1660,3997,479,1141,886,3514,1301,3604,1888,
	    1836,1990,2058,692,1194,20,3285,2046,2107,3508,3525,3801,2549,
	    1145,2253,305,3301,1065,3133,2913,3285,1241,1197,3729,2501,1673,
	    541,2753,949,2361,1165,4081,2725,3305,3069,3617,3733,409,2157,
	    1361,3973,1865,2525,1409,3445,3577,77,3761,2149,1449,3005,225,85,
	    3673,3117,3089,1349,2057,413,65,1845,697,3085,3441,1573,3689,2941,
	    929,533,2841,4077,721,2821,2249,2397,2817,245,1913,1997,3121,997,
	    1833,2877,1633,981,2009,941,2449,197,2441,285,1473,2741,3129,909,
	    2801,421,4073,2813,2337,1429,1177,1901,81,1669,2633,2269,129,1141,
	    249,3917,2481,3941,2217,2749,3041,1877,345,2861,1809,3141,2825,
	    157,2881,3637,1465,2829,2161,3365,361,2685,3745,2325,3609,3821,
	    3537,517,3017,2141,1537 };

    integer i__1;

    integer i__, i1, i2, i3, i4, it1, it2, it3, it4;















    --iseed;
    --x;


    i1 = iseed[1];
    i2 = iseed[2];
    i3 = iseed[3];
    i4 = iseed[4];

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

L20:


	it4 = i4 * mm[i__ + 383];
	it3 = it4 / 4096;
	it4 -= it3 << 12;
	it3 = it3 + i3 * mm[i__ + 383] + i4 * mm[i__ + 255];
	it2 = it3 / 4096;
	it3 -= it2 << 12;
	it2 = it2 + i2 * mm[i__ + 383] + i3 * mm[i__ + 255] + i4 * mm[i__ + 
		127];
	it1 = it2 / 4096;
	it2 -= it1 << 12;
	it1 = it1 + i1 * mm[i__ + 383] + i2 * mm[i__ + 255] + i3 * mm[i__ + 
		127] + i4 * mm[i__ - 1];
	it1 %= 4096;


	x[i__] = ((doublereal) it1 + ((doublereal) it2 + ((doublereal) it3 + (
		doublereal) it4 * 2.44140625e-4) * 2.44140625e-4) * 
		2.44140625e-4) * 2.44140625e-4;

	if (x[i__] == 1.) {
	    i1 += 2;
	    i2 += 2;
	    i3 += 2;
	    i4 += 2;
	    goto L20;
	}

    }


    iseed[1] = it1;
    iseed[2] = it2;
    iseed[3] = it3;
    iseed[4] = it4;
return TCL_OK;


} /* dlaruv_ */
static /* Subroutine */ int dlasq2_ (Tcl_Interp *interp, integer *n, doublereal *z__, integer *info)
{
    integer i__1, i__2, i__3;
    doublereal d__1, d__2;

    double sqrt(doublereal);

    doublereal d__, e, g;
    integer k;
    doublereal s, t;
    integer i0, i4, n0;
    doublereal dn;
    integer pp;
    doublereal dn1, dn2, dee, eps, tau, tol;
    integer ipn4;
    doublereal tol2;
    logical ieee;
    integer nbig;
    doublereal dmin__, emin, emax;
    integer kmin, ndiv, iter;
    doublereal qmin, temp, qmax, zmax;
    integer splt;
    doublereal dmin1, dmin2;
    integer nfail;
    doublereal desig, trace, sigma;
    integer iinfo, ttype;
    doublereal deemin;
    integer iwhila, iwhilb;
    doublereal oldemn, safmin;


















    --z__;

    *info = 0;
    eps = dlamch_("Precision");
    safmin = dlamch_("Safe minimum");
    tol = eps * 100.;
    d__1 = tol;
    tol2 = d__1 * d__1;

    if (*n < 0) {
	*info = -1;
	vectcl_xerbla(interp, "DLASQ2", &dlasq2_c__1);
return TCL_ERROR;

return TCL_OK;
    } else if (*n == 0) {
return TCL_OK;
    } else if (*n == 1) {


	if (z__[1] < 0.) {
	    *info = -201;
	    vectcl_xerbla(interp, "DLASQ2", &dlasq2_c__2);
return TCL_ERROR;

	}
return TCL_OK;
    } else if (*n == 2) {


	if (z__[2] < 0. || z__[3] < 0.) {
	    *info = -2;
	    vectcl_xerbla(interp, "DLASQ2", &dlasq2_c__2);
return TCL_ERROR;

return TCL_OK;
	} 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 TCL_OK;
    }


    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);
	    vectcl_xerbla(interp, "DLASQ2", &dlasq2_c__2);
return TCL_ERROR;

return TCL_OK;
	} else if (z__[k + 1] < 0.) {
	    *info = -(k + 201);
	    vectcl_xerbla(interp, "DLASQ2", &dlasq2_c__2);
return TCL_ERROR;

return TCL_OK;
	}
	d__ += z__[k];
	e += z__[k + 1];
	d__1 = qmax, d__2 = z__[k];
	qmax = max(d__1,d__2);
	d__1 = emin, d__2 = z__[k + 1];
	emin = min(d__1,d__2);
	d__1 = max(qmax,zmax), d__2 = z__[k + 1];
	zmax = max(d__1,d__2);
    }
    if (z__[(*n << 1) - 1] < 0.) {
	*info = -((*n << 1) + 199);
	vectcl_xerbla(interp, "DLASQ2", &dlasq2_c__2);
return TCL_ERROR;

return TCL_OK;
    }
    d__ += z__[(*n << 1) - 1];
    d__1 = qmax, d__2 = z__[(*n << 1) - 1];
    qmax = max(d__1,d__2);
    zmax = max(qmax,zmax);


    if (e == 0.) {
	i__1 = *n;
	for (k = 2; k <= i__1; ++k) {
	    z__[k] = z__[(k << 1) - 1];
	}
	if (dlasrt_(interp, "D", n, &z__[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }

	z__[(*n << 1) - 1] = d__;
return TCL_OK;
    }

    trace = d__ + e;


    if (trace == 0.) {
	z__[(*n << 1) - 1] = 0.;
return TCL_OK;
    }


    ieee = ilaenv_(&dlasq2_c__10, "DLASQ2", "N", &dlasq2_c__1, &dlasq2_c__2, &dlasq2_c__3, &dlasq2_c__4) == 1 && ilaenv_(&dlasq2_c__11, "DLASQ2", "N", &dlasq2_c__1, &dlasq2_c__2, 
	     &dlasq2_c__3, &dlasq2_c__4) == 1;


    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];
    }

    i0 = 1;
    n0 = *n;


    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;
	}
    }


    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]));
	    }
	}


	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]);
	    }
	    d__1 = emin, d__2 = z__[i4 - (pp << 1)];
	    emin = min(d__1,d__2);
	}
	z__[(n0 << 2) - pp - 2] = d__;


	qmax = z__[(i0 << 2) - pp - 2];
	i__1 = (n0 << 2) - pp - 2;
	for (i4 = (i0 << 2) - pp + 2; i4 <= i__1; i4 += 4) {
	    d__1 = qmax, d__2 = z__[i4];
	    qmax = max(d__1,d__2);
	}


	pp = 1 - pp;
    }


    ttype = 0;
    dmin1 = 0.;
    dmin2 = 0.;
    dn = 0.;
    dn1 = 0.;
    dn2 = 0.;
    g = 0.;
    tau = 0.;

    iter = 2;
    nfail = 0;
    ndiv = n0 - i0 << 1;

    i__1 = *n + 1;
    for (iwhila = 1; iwhila <= i__1; ++iwhila) {
	if (n0 < 1) {
	    goto L170;
	}



	desig = 0.;
	if (n0 == *n) {
	    sigma = 0.;
	} else {
	    sigma = -z__[(n0 << 2) - 1];
	}
	if (sigma < 0.) {
	    *info = 1;
return TCL_OK;
	}


	emax = 0.;
	if (n0 > i0) {
	    emin = (d__1 = z__[(n0 << 2) - 5], abs(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.) {
		d__1 = qmin, d__2 = z__[i4 - 3];
		qmin = min(d__1,d__2);
		d__1 = emax, d__2 = z__[i4 - 5];
		emax = max(d__1,d__2);
	    }
	    d__1 = qmax, d__2 = z__[i4 - 7] + z__[i4 - 5];
	    qmax = max(d__1,d__2);
	    d__1 = emin, d__2 = z__[i4 - 5];
	    emin = min(d__1,d__2);
	}
	i4 = 4;

L100:
	i0 = i4 / 4;
	pp = 0;

	if (n0 - i0 > 1) {
	    dee = z__[(i0 << 2) - 3];
	    deemin = dee;
	    kmin = i0;
	    i__2 = (n0 << 2) - 3;
	    for (i4 = (i0 << 2) + 1; i4 <= i__2; i4 += 4) {
		dee = z__[i4] * (dee / (dee + z__[i4 - 2]));
		if (dee <= deemin) {
		    deemin = dee;
		    kmin = (i4 + 3) / 4;
		}
	    }
	    if (kmin - i0 << 1 < n0 - kmin && deemin <= z__[(n0 << 2) - 3] * 
		    .5) {
		ipn4 = i0 + n0 << 2;
		pp = 2;
		i__2 = i0 + n0 - 1 << 1;
		for (i4 = i0 << 2; i4 <= i__2; i4 += 4) {
		    temp = z__[i4 - 3];
		    z__[i4 - 3] = z__[ipn4 - i4 - 3];
		    z__[ipn4 - i4 - 3] = temp;
		    temp = z__[i4 - 2];
		    z__[i4 - 2] = z__[ipn4 - i4 - 2];
		    z__[ipn4 - i4 - 2] = temp;
		    temp = z__[i4 - 1];
		    z__[i4 - 1] = z__[ipn4 - i4 - 5];
		    z__[ipn4 - i4 - 5] = temp;
		    temp = z__[i4];
		    z__[i4] = z__[ipn4 - i4 - 4];
		    z__[ipn4 - i4 - 4] = temp;
		}
	    }
	}


	d__1 = 0., d__2 = qmin - sqrt(qmin) * 2. * sqrt(emax);
	dmin__ = -max(d__1,d__2);


	nbig = (n0 - i0 + 1) * 30;
	i__2 = nbig;
	for (iwhilb = 1; iwhilb <= i__2; ++iwhilb) {
	    if (i0 > n0) {
		goto L150;
	    }


	    if (dlasq3_(interp, &i0, &n0, &z__[1], &pp, &dmin__, &sigma, &desig, &qmax, &		    nfail, &iter, &ndiv, &ieee, &ttype, &dmin1, &dmin2, &dn, &
		    dn1, &dn2, &g, &tau)!=TCL_OK) { return TCL_ERROR; }



	    pp = 1 - pp;


	    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 {
			    d__1 = qmax, d__2 = z__[i4 + 1];
			    qmax = max(d__1,d__2);
			    d__1 = emin, d__2 = z__[i4 - 1];
			    emin = min(d__1,d__2);
			    d__1 = oldemn, d__2 = z__[i4];
			    oldemn = min(d__1,d__2);
			}
		    }
		    z__[(n0 << 2) - 1] = emin;
		    z__[n0 * 4] = oldemn;
		    i0 = splt + 1;
		}
	    }

	}

	*info = 2;
return TCL_OK;


L150:

	;
    }

    *info = 3;
return TCL_OK;


L170:


    i__1 = *n;
    for (k = 2; k <= i__1; ++k) {
	z__[k] = z__[(k << 2) - 3];
    }


    if (dlasrt_(interp, "D", n, &z__[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }


    e = 0.;
    for (k = *n; k >= 1; --k) {
	e += z__[k];
    }


    z__[(*n << 1) + 1] = trace;
    z__[(*n << 1) + 2] = e;
    z__[(*n << 1) + 3] = (doublereal) iter;
    i__1 = *n;
    z__[(*n << 1) + 4] = (doublereal) ndiv / (doublereal) (i__1 * i__1);
    z__[(*n << 1) + 5] = nfail * 100. / (doublereal) iter;
return TCL_OK;


} /* dlasq2_ */
static /* Subroutine */ int dlarra_ (Tcl_Interp *interp, integer *n, doublereal *d__, doublereal *e, 	doublereal *e2, doublereal *spltol, doublereal *tnrm, integer *nsplit, 	 integer *isplit, integer *info)
{
    integer i__1;
    doublereal d__1, d__2;

    double sqrt(doublereal);

    integer i__;
    doublereal tmp1, eabs;





















    --isplit;
    --e2;
    --e;
    --d__;

    *info = 0;
    *nsplit = 1;
    if (*spltol < 0.) {
	tmp1 = abs(*spltol) * *tnrm;
	i__1 = *n - 1;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    eabs = (d__1 = e[i__], abs(d__1));
	    if (eabs <= tmp1) {
		e[i__] = 0.;
		e2[i__] = 0.;
		isplit[*nsplit] = i__;
		++(*nsplit);
	    }
	}
    } else {
	i__1 = *n - 1;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    eabs = (d__1 = e[i__], abs(d__1));
	    if (eabs <= *spltol * sqrt((d__1 = d__[i__], abs(d__1))) * sqrt((
		    d__2 = d__[i__ + 1], abs(d__2)))) {
		e[i__] = 0.;
		e2[i__] = 0.;
		isplit[*nsplit] = i__;
		++(*nsplit);
	    }
	}
    }
    isplit[*nsplit] = *n;
return TCL_OK;


} /* dlarra_ */
static /* Subroutine */ int dlarrb_ (Tcl_Interp *interp, integer *n, doublereal *d__, doublereal *lld, 	integer *ifirst, integer *ilast, doublereal *rtol1, doublereal *rtol2, 	 integer *offset, doublereal *w, doublereal *wgap, doublereal *werr, 	doublereal *work, integer *iwork, doublereal *pivmin, doublereal *	spdiam, integer *twist, integer *info)
{
    integer i__1;
    doublereal d__1, d__2;

    double log(doublereal);

    integer i__, k, r__, i1, ii, ip;
    doublereal gap, mid, tmp, back, lgap, rgap, left;
    integer iter, nint, prev, next;
    doublereal cvrgd, right, width;
    integer negcnt;
    doublereal mnwdth;
    integer olnint, maxitr;




























    --iwork;
    --work;
    --werr;
    --wgap;
    --w;
    --lld;
    --d__;

    *info = 0;

    maxitr = (integer) ((log(*spdiam + *pivmin) - log(*pivmin)) / log(2.)) + 
	    2;
    mnwdth = *pivmin * 2.;

    r__ = *twist;
    if (r__ < 1 || r__ > *n) {
	r__ = *n;
    }


    i1 = *ifirst;
    nint = 0;
    prev = 0;
    rgap = wgap[i1 - *offset];
    i__1 = *ilast;
    for (i__ = i1; i__ <= i__1; ++i__) {
	k = i__ << 1;
	ii = i__ - *offset;
	left = w[ii] - werr[ii];
	right = w[ii] + werr[ii];
	lgap = rgap;
	rgap = wgap[ii];
	gap = min(lgap,rgap);


	back = werr[ii];
L20:
	negcnt = dlaneg_(n, &d__[1], &lld[1], &left, pivmin, &r__);
	if (negcnt > i__ - 1) {
	    left -= back;
	    back *= 2.;
	    goto L20;
	}


	back = werr[ii];
L50:
	negcnt = dlaneg_(n, &d__[1], &lld[1], &right, pivmin, &r__);
	if (negcnt < i__) {
	    right += back;
	    back *= 2.;
	    goto L50;
	}
	width = (d__1 = left - right, abs(d__1)) * .5;
	d__1 = abs(left), d__2 = abs(right);
	tmp = max(d__1,d__2);
	d__1 = *rtol1 * gap, d__2 = *rtol2 * tmp;
	cvrgd = max(d__1,d__2);
	if (width <= cvrgd || width <= mnwdth) {
	    iwork[k - 1] = -1;
	    if (i__ == i1 && i__ < *ilast) {
		i1 = i__ + 1;
	    }
	    if (prev >= i1 && i__ <= *ilast) {
		iwork[(prev << 1) - 1] = i__ + 1;
	    }
	} else {
	    prev = i__;
	    ++nint;
	    iwork[k - 1] = i__ + 1;
	    iwork[k] = negcnt;
	}
	work[k - 1] = left;
	work[k] = right;
    }


    iter = 0;
L80:
    prev = i1 - 1;
    i__ = i1;
    olnint = nint;
    i__1 = olnint;
    for (ip = 1; ip <= i__1; ++ip) {
	k = i__ << 1;
	ii = i__ - *offset;
	rgap = wgap[ii];
	lgap = rgap;
	if (ii > 1) {
	    lgap = wgap[ii - 1];
	}
	gap = min(lgap,rgap);
	next = iwork[k - 1];
	left = work[k - 1];
	right = work[k];
	mid = (left + right) * .5;
	width = right - mid;
	d__1 = abs(left), d__2 = abs(right);
	tmp = max(d__1,d__2);
	d__1 = *rtol1 * gap, d__2 = *rtol2 * tmp;
	cvrgd = max(d__1,d__2);
	if (width <= cvrgd || width <= mnwdth || iter == maxitr) {
	    --nint;
	    iwork[k - 1] = 0;
	    if (i1 == i__) {
		i1 = next;
	    } else {
		if (prev >= i1) {
		    iwork[(prev << 1) - 1] = next;
		}
	    }
	    i__ = next;
	    goto L100;
	}
	prev = i__;


	negcnt = dlaneg_(n, &d__[1], &lld[1], &mid, pivmin, &r__);
	if (negcnt <= i__ - 1) {
	    work[k - 1] = mid;
	} else {
	    work[k] = mid;
	}
	i__ = next;
L100:
	;
    }
    ++iter;
    if (nint > 0 && iter <= maxitr) {
	goto L80;
    }


    i__1 = *ilast;
    for (i__ = *ifirst; i__ <= i__1; ++i__) {
	k = i__ << 1;
	ii = i__ - *offset;
	if (iwork[k - 1] == 0) {
	    w[ii] = (work[k - 1] + work[k]) * .5;
	    werr[ii] = work[k] - w[ii];
	}
    }

    i__1 = *ilast;
    for (i__ = *ifirst + 1; i__ <= i__1; ++i__) {
	k = i__ << 1;
	ii = i__ - *offset;
	d__1 = 0., d__2 = w[ii] - werr[ii] - w[ii - 1] - werr[ii - 1];
	wgap[ii - 1] = max(d__1,d__2);
    }
return TCL_OK;


} /* dlarrb_ */
static /* Subroutine */ int dlarrd_ (Tcl_Interp *interp, char *range, char *order, integer *n, doublereal 	*vl, doublereal *vu, integer *il, integer *iu, doublereal *gers, 	doublereal *reltol, doublereal *d__, doublereal *e, doublereal *e2, 	doublereal *pivmin, integer *nsplit, integer *isplit, integer *m, 	doublereal *w, doublereal *werr, doublereal *wl, doublereal *wu, 	integer *iblock, integer *indexw, doublereal *work, integer *iwork, 	integer *info)
{
    integer i__1, i__2, i__3;
    doublereal d__1, d__2;

    double log(doublereal);

    integer i__, j, ib, ie, je, nb;
    doublereal gl;
    integer im, in;
    doublereal gu;
    integer iw, jee;
    doublereal eps;
    integer nwl;
    doublereal wlu, wul;
    integer nwu;
    doublereal tmp1, tmp2;
    integer iend, jblk, ioff, iout, itmp1, itmp2, jdisc;
    integer iinfo;
    doublereal atoli;
    integer iwoff, itmax;
    doublereal wkill, rtoli, uflow, tnorm;
    integer ibegin;
    integer irange, idiscl, idumma[1];
    integer idiscu;
    logical ncnvrg, toofew;




































    --iwork;
    --work;
    --indexw;
    --iblock;
    --werr;
    --w;
    --isplit;
    --e2;
    --e;
    --d__;
    --gers;

    *info = 0;


    if (lsame_(range, "A")) {
	irange = 1;
    } else if (lsame_(range, "V")) {
	irange = 2;
    } else if (lsame_(range, "I")) {
	irange = 3;
    } else {
	irange = 0;
    }


    if (irange <= 0) {
	*info = -1;
    } else if (! (lsame_(order, "B") || lsame_(order, 
	    "E"))) {
	*info = -2;
    } else if (*n < 0) {
	*info = -3;
    } else if (irange == 2) {
	if (*vl >= *vu) {
	    *info = -5;
	}
    } else if (irange == 3 && (*il < 1 || *il > max(1,*n))) {
	*info = -6;
    } else if (irange == 3 && (*iu < min(*n,*il) || *iu > *n)) {
	*info = -7;
    }

    if (*info != 0) {
return TCL_OK;
    }
    *info = 0;
    ncnvrg = FALSE_;
    toofew = FALSE_;
    *m = 0;
    if (*n == 0) {
return TCL_OK;
    }
    if (irange == 3 && *il == 1 && *iu == *n) {
	irange = 1;
    }
    eps = dlamch_("P");
    uflow = dlamch_("U");
    if (*n == 1) {
	if (irange == 1 || irange == 2 && d__[1] > *vl && d__[1] <= *vu || 
		irange == 3 && *il == 1 && *iu == 1) {
	    *m = 1;
	    w[1] = d__[1];
	    werr[1] = 0.;
	    iblock[1] = 1;
	    indexw[1] = 1;
	}
return TCL_OK;
    }
    nb = ilaenv_(&dlarrd_c__1, "DSTEBZ", " ", n, &dlarrd_c_n1, &dlarrd_c_n1, &dlarrd_c_n1);
    if (nb <= 1) {
	nb = 0;
    }
    gl = d__[1];
    gu = d__[1];
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	d__1 = gl, d__2 = gers[(i__ << 1) - 1];
	gl = min(d__1,d__2);
	d__1 = gu, d__2 = gers[i__ * 2];
	gu = max(d__1,d__2);
    }
    d__1 = abs(gl), d__2 = abs(gu);
    tnorm = max(d__1,d__2);
    gl = gl - tnorm * 2. * eps * *n - *pivmin * 4.;
    gu = gu + tnorm * 2. * eps * *n + *pivmin * 4.;
    rtoli = *reltol;
    atoli = uflow * 4. + *pivmin * 4.;
    if (irange == 3) {
	itmax = (integer) ((log(tnorm + *pivmin) - log(*pivmin)) / log(2.)) + 
		2;
	work[*n + 1] = gl;
	work[*n + 2] = gl;
	work[*n + 3] = gu;
	work[*n + 4] = gu;
	work[*n + 5] = gl;
	work[*n + 6] = gu;
	iwork[1] = -1;
	iwork[2] = -1;
	iwork[3] = *n + 1;
	iwork[4] = *n + 1;
	iwork[5] = *il - 1;
	iwork[6] = *iu;

	if (dlaebz_(interp, &dlarrd_c__3, &itmax, n, &dlarrd_c__2, &dlarrd_c__2, &nb, &atoli, &rtoli, pivmin, &		d__[1], &e[1], &e2[1], &iwork[5], &work[*n + 1], &work[*n + 5]
, &iout, &iwork[1], &w[1], &iblock[1], &iinfo)!=TCL_OK) { return TCL_ERROR; }


	if (iinfo != 0) {
	    *info = iinfo;
return TCL_OK;
	}
	if (iwork[6] == *iu) {
	    *wl = work[*n + 1];
	    wlu = work[*n + 3];
	    nwl = iwork[1];
	    *wu = work[*n + 4];
	    wul = work[*n + 2];
	    nwu = iwork[4];
	} else {
	    *wl = work[*n + 2];
	    wlu = work[*n + 4];
	    nwl = iwork[2];
	    *wu = work[*n + 3];
	    wul = work[*n + 1];
	    nwu = iwork[3];
	}
	if (nwl < 0 || nwl >= *n || nwu < 1 || nwu > *n) {
	    *info = 4;
return TCL_OK;
	}
    } else if (irange == 2) {
	*wl = *vl;
	*wu = *vu;
    } else if (irange == 1) {
	*wl = gl;
	*wu = gu;
    }
    *m = 0;
    iend = 0;
    *info = 0;
    nwl = 0;
    nwu = 0;

    i__1 = *nsplit;
    for (jblk = 1; jblk <= i__1; ++jblk) {
	ioff = iend;
	ibegin = ioff + 1;
	iend = isplit[jblk];
	in = iend - ioff;

	if (in == 1) {
	    if (*wl >= d__[ibegin] - *pivmin) {
		++nwl;
	    }
	    if (*wu >= d__[ibegin] - *pivmin) {
		++nwu;
	    }
	    if (irange == 1 || *wl < d__[ibegin] - *pivmin && *wu >= d__[
		    ibegin] - *pivmin) {
		++(*m);
		w[*m] = d__[ibegin];
		werr[*m] = 0.;
		iblock[*m] = jblk;
		indexw[*m] = 1;
	    }

	} else {
	    gu = d__[ibegin];
	    gl = d__[ibegin];
	    tmp1 = 0.;
	    i__2 = iend;
	    for (j = ibegin; j <= i__2; ++j) {
		d__1 = gl, d__2 = gers[(j << 1) - 1];
		gl = min(d__1,d__2);
		d__1 = gu, d__2 = gers[j * 2];
		gu = max(d__1,d__2);
	    }
	    gl = gl - tnorm * 2. * eps * in - *pivmin * 2.;
	    gu = gu + tnorm * 2. * eps * in + *pivmin * 2.;

	    if (irange > 1) {
		if (gu < *wl) {
		    nwl += in;
		    nwu += in;
		    goto L70;
		}
		gl = max(gl,*wl);
		gu = min(gu,*wu);
		if (gl >= gu) {
		    goto L70;
		}
	    }
	    work[*n + 1] = gl;
	    work[*n + in + 1] = gu;
	    if (dlaebz_(interp, &dlarrd_c__1, &dlarrd_c__0, &in, &in, &dlarrd_c__1, &nb, &atoli, &rtoli, 		    pivmin, &d__[ibegin], &e[ibegin], &e2[ibegin], idumma, &
		    work[*n + 1], &work[*n + (in << 1) + 1], &im, &iwork[1], &
		    w[*m + 1], &iblock[*m + 1], &iinfo)!=TCL_OK) { return TCL_ERROR; }


	    if (iinfo != 0) {
		*info = iinfo;
return TCL_OK;
	    }

	    nwl += iwork[1];
	    nwu += iwork[in + 1];
	    iwoff = *m - iwork[1];
	    itmax = (integer) ((log(gu - gl + *pivmin) - log(*pivmin)) / log(
		    2.)) + 2;
	    if (dlaebz_(interp, &dlarrd_c__2, &itmax, &in, &in, &dlarrd_c__1, &nb, &atoli, &rtoli, 		    pivmin, &d__[ibegin], &e[ibegin], &e2[ibegin], idumma, &
		    work[*n + 1], &work[*n + (in << 1) + 1], &iout, &iwork[1], 
		     &w[*m + 1], &iblock[*m + 1], &iinfo)!=TCL_OK) { return TCL_ERROR; }


	    if (iinfo != 0) {
		*info = iinfo;
return TCL_OK;
	    }

	    i__2 = iout;
	    for (j = 1; j <= i__2; ++j) {
		tmp1 = (work[j + *n] + work[j + in + *n]) * .5;
		tmp2 = (d__1 = work[j + *n] - work[j + in + *n], abs(d__1)) * 
			.5;
		if (j > iout - iinfo) {
		    ncnvrg = TRUE_;
		    ib = -jblk;
		} else {
		    ib = jblk;
		}
		i__3 = iwork[j + in] + iwoff;
		for (je = iwork[j] + 1 + iwoff; je <= i__3; ++je) {
		    w[je] = tmp1;
		    werr[je] = tmp2;
		    indexw[je] = je - iwoff;
		    iblock[je] = ib;
		}
	    }

	    *m += im;
	}
L70:
	;
    }
    if (irange == 3) {
	idiscl = *il - 1 - nwl;
	idiscu = nwu - *iu;

	if (idiscl > 0) {
	    im = 0;
	    i__1 = *m;
	    for (je = 1; je <= i__1; ++je) {
		if (w[je] <= wlu && idiscl > 0) {
		    --idiscl;
		} else {
		    ++im;
		    w[im] = w[je];
		    werr[im] = werr[je];
		    indexw[im] = indexw[je];
		    iblock[im] = iblock[je];
		}
	    }
	    *m = im;
	}
	if (idiscu > 0) {
	    im = *m + 1;
	    for (je = *m; je >= 1; --je) {
		if (w[je] >= wul && idiscu > 0) {
		    --idiscu;
		} else {
		    --im;
		    w[im] = w[je];
		    werr[im] = werr[je];
		    indexw[im] = indexw[je];
		    iblock[im] = iblock[je];
		}
	    }
	    jee = 0;
	    i__1 = *m;
	    for (je = im; je <= i__1; ++je) {
		++jee;
		w[jee] = w[je];
		werr[jee] = werr[je];
		indexw[jee] = indexw[je];
		iblock[jee] = iblock[je];
	    }
	    *m = *m - im + 1;
	}
	if (idiscl > 0 || idiscu > 0) {
	    if (idiscl > 0) {
		wkill = *wu;
		i__1 = idiscl;
		for (jdisc = 1; jdisc <= i__1; ++jdisc) {
		    iw = 0;
		    i__2 = *m;
		    for (je = 1; je <= i__2; ++je) {
			if (iblock[je] != 0 && (w[je] < wkill || iw == 0)) {
			    iw = je;
			    wkill = w[je];
			}
		    }
		    iblock[iw] = 0;
		}
	    }
	    if (idiscu > 0) {
		wkill = *wl;
		i__1 = idiscu;
		for (jdisc = 1; jdisc <= i__1; ++jdisc) {
		    iw = 0;
		    i__2 = *m;
		    for (je = 1; je <= i__2; ++je) {
			if (iblock[je] != 0 && (w[je] >= wkill || iw == 0)) {
			    iw = je;
			    wkill = w[je];
			}
		    }
		    iblock[iw] = 0;
		}
	    }
	    im = 0;
	    i__1 = *m;
	    for (je = 1; je <= i__1; ++je) {
		if (iblock[je] != 0) {
		    ++im;
		    w[im] = w[je];
		    werr[im] = werr[je];
		    indexw[im] = indexw[je];
		    iblock[im] = iblock[je];
		}
	    }
	    *m = im;
	}
	if (idiscl < 0 || idiscu < 0) {
	    toofew = TRUE_;
	}
    }

    if (irange == 1 && *m != *n || irange == 3 && *m != *iu - *il + 1) {
	toofew = TRUE_;
    }
    if (lsame_(order, "E") && *nsplit > 1) {
	i__1 = *m - 1;
	for (je = 1; je <= i__1; ++je) {
	    ie = 0;
	    tmp1 = w[je];
	    i__2 = *m;
	    for (j = je + 1; j <= i__2; ++j) {
		if (w[j] < tmp1) {
		    ie = j;
		    tmp1 = w[j];
		}
	    }
	    if (ie != 0) {
		tmp2 = werr[ie];
		itmp1 = iblock[ie];
		itmp2 = indexw[ie];
		w[ie] = w[je];
		werr[ie] = werr[je];
		iblock[ie] = iblock[je];
		indexw[ie] = indexw[je];
		w[je] = tmp1;
		werr[je] = tmp2;
		iblock[je] = itmp1;
		indexw[je] = itmp2;
	    }
	}
    }

    *info = 0;
    if (ncnvrg) {
	++(*info);
    }
    if (toofew) {
	*info += 2;
    }
return TCL_OK;


} /* dlarrd_ */
static /* Subroutine */ int dlarrk_ (Tcl_Interp *interp, integer *n, integer *iw, doublereal *gl, 	doublereal *gu, doublereal *d__, doublereal *e2, doublereal *pivmin, 	doublereal *reltol, doublereal *w, doublereal *werr, integer *info)
{
    integer i__1;
    doublereal d__1, d__2;

    double log(doublereal);

    integer i__, it;
    doublereal mid, eps, tmp1, tmp2, left, atoli, right;
    integer itmax;
    doublereal rtoli, tnorm;
    integer negcnt;























    --e2;
    --d__;

    eps = dlamch_("P");
    d__1 = abs(*gl), d__2 = abs(*gu);
    tnorm = max(d__1,d__2);
    rtoli = *reltol;
    atoli = *pivmin * 4.;
    itmax = (integer) ((log(tnorm + *pivmin) - log(*pivmin)) / log(2.)) + 2;
    *info = -1;
    left = *gl - tnorm * 2. * eps * *n - *pivmin * 4.;
    right = *gu + tnorm * 2. * eps * *n + *pivmin * 4.;
    it = 0;
L10:


    tmp1 = (d__1 = right - left, abs(d__1));
    d__1 = abs(right), d__2 = abs(left);
    tmp2 = max(d__1,d__2);
    d__1 = max(atoli,*pivmin), d__2 = rtoli * tmp2;
    if (tmp1 < max(d__1,d__2)) {
	*info = 0;
	goto L30;
    }
    if (it > itmax) {
	goto L30;
    }


    ++it;
    mid = (left + right) * .5;
    negcnt = 0;
    tmp1 = d__[1] - mid;
    if (abs(tmp1) < *pivmin) {
	tmp1 = -(*pivmin);
    }
    if (tmp1 <= 0.) {
	++negcnt;
    }

    i__1 = *n;
    for (i__ = 2; i__ <= i__1; ++i__) {
	tmp1 = d__[i__] - e2[i__ - 1] / tmp1 - mid;
	if (abs(tmp1) < *pivmin) {
	    tmp1 = -(*pivmin);
	}
	if (tmp1 <= 0.) {
	    ++negcnt;
	}
    }
    if (negcnt >= *iw) {
	right = mid;
    } else {
	left = mid;
    }
    goto L10;
L30:


    *w = (left + right) * .5;
    *werr = (d__1 = right - left, abs(d__1)) * .5;
return TCL_OK;


} /* dlarrk_ */
static /* Subroutine */ int dlar1v_ (Tcl_Interp *interp, integer *n, integer *b1, integer *bn, doublereal 	*lambda, doublereal *d__, doublereal *l, doublereal *ld, doublereal *	lld, doublereal *pivmin, doublereal *gaptol, doublereal *z__, logical 	*wantnc, integer *negcnt, doublereal *ztz, doublereal *mingma, 	integer *r__, integer *isuppz, doublereal *nrminv, doublereal *resid, 	doublereal *rqcorr, doublereal *work)
{
    integer i__1;
    doublereal d__1, d__2, d__3;

    double sqrt(doublereal);

    integer i__;
    doublereal s;
    integer r1, r2;
    doublereal eps, tmp;
    integer neg1, neg2, indp, inds;
    doublereal dplus;
    integer indlpl, indumn;
    doublereal dminus;
    logical sawnan1, sawnan2;
































    --work;
    --isuppz;
    --z__;
    --lld;
    --ld;
    --l;
    --d__;

    eps = dlamch_("Precision");
    if (*r__ == 0) {
	r1 = *b1;
	r2 = *bn;
    } else {
	r1 = *r__;
	r2 = *r__;
    }
    indlpl = 0;
    indumn = *n;
    inds = (*n << 1) + 1;
    indp = *n * 3 + 1;
    if (*b1 == 1) {
	work[inds] = 0.;
    } else {
	work[inds + *b1 - 1] = lld[*b1 - 1];
    }


    sawnan1 = FALSE_;
    neg1 = 0;
    s = work[inds + *b1 - 1] - *lambda;
    i__1 = r1 - 1;
    for (i__ = *b1; i__ <= i__1; ++i__) {
	dplus = d__[i__] + s;
	work[indlpl + i__] = ld[i__] / dplus;
	if (dplus < 0.) {
	    ++neg1;
	}
	work[inds + i__] = s * work[indlpl + i__] * l[i__];
	s = work[inds + i__] - *lambda;
    }
    sawnan1 = disnan_(&s);
    if (sawnan1) {
	goto L60;
    }
    i__1 = r2 - 1;
    for (i__ = r1; i__ <= i__1; ++i__) {
	dplus = d__[i__] + s;
	work[indlpl + i__] = ld[i__] / dplus;
	work[inds + i__] = s * work[indlpl + i__] * l[i__];
	s = work[inds + i__] - *lambda;
    }
    sawnan1 = disnan_(&s);

L60:
    if (sawnan1) {
	neg1 = 0;
	s = work[inds + *b1 - 1] - *lambda;
	i__1 = r1 - 1;
	for (i__ = *b1; i__ <= i__1; ++i__) {
	    dplus = d__[i__] + s;
	    if (abs(dplus) < *pivmin) {
		dplus = -(*pivmin);
	    }
	    work[indlpl + i__] = ld[i__] / dplus;
	    if (dplus < 0.) {
		++neg1;
	    }
	    work[inds + i__] = s * work[indlpl + i__] * l[i__];
	    if (work[indlpl + i__] == 0.) {
		work[inds + i__] = lld[i__];
	    }
	    s = work[inds + i__] - *lambda;
	}
	i__1 = r2 - 1;
	for (i__ = r1; i__ <= i__1; ++i__) {
	    dplus = d__[i__] + s;
	    if (abs(dplus) < *pivmin) {
		dplus = -(*pivmin);
	    }
	    work[indlpl + i__] = ld[i__] / dplus;
	    work[inds + i__] = s * work[indlpl + i__] * l[i__];
	    if (work[indlpl + i__] == 0.) {
		work[inds + i__] = lld[i__];
	    }
	    s = work[inds + i__] - *lambda;
	}
    }


    sawnan2 = FALSE_;
    neg2 = 0;
    work[indp + *bn - 1] = d__[*bn] - *lambda;
    i__1 = r1;
    for (i__ = *bn - 1; i__ >= i__1; --i__) {
	dminus = lld[i__] + work[indp + i__];
	tmp = d__[i__] / dminus;
	if (dminus < 0.) {
	    ++neg2;
	}
	work[indumn + i__] = l[i__] * tmp;
	work[indp + i__ - 1] = work[indp + i__] * tmp - *lambda;
    }
    tmp = work[indp + r1 - 1];
    sawnan2 = disnan_(&tmp);
    if (sawnan2) {
	neg2 = 0;
	i__1 = r1;
	for (i__ = *bn - 1; i__ >= i__1; --i__) {
	    dminus = lld[i__] + work[indp + i__];
	    if (abs(dminus) < *pivmin) {
		dminus = -(*pivmin);
	    }
	    tmp = d__[i__] / dminus;
	    if (dminus < 0.) {
		++neg2;
	    }
	    work[indumn + i__] = l[i__] * tmp;
	    work[indp + i__ - 1] = work[indp + i__] * tmp - *lambda;
	    if (tmp == 0.) {
		work[indp + i__ - 1] = d__[i__] - *lambda;
	    }
	}
    }


    *mingma = work[inds + r1 - 1] + work[indp + r1 - 1];
    if (*mingma < 0.) {
	++neg1;
    }
    if (*wantnc) {
	*negcnt = neg1 + neg2;
    } else {
	*negcnt = -1;
    }
    if (abs(*mingma) == 0.) {
	*mingma = eps * work[inds + r1 - 1];
    }
    *r__ = r1;
    i__1 = r2 - 1;
    for (i__ = r1; i__ <= i__1; ++i__) {
	tmp = work[inds + i__] + work[indp + i__];
	if (tmp == 0.) {
	    tmp = eps * work[inds + i__];
	}
	if (abs(tmp) <= abs(*mingma)) {
	    *mingma = tmp;
	    *r__ = i__ + 1;
	}
    }


    isuppz[1] = *b1;
    isuppz[2] = *bn;
    z__[*r__] = 1.;
    *ztz = 1.;


    if (! sawnan1 && ! sawnan2) {
	i__1 = *b1;
	for (i__ = *r__ - 1; i__ >= i__1; --i__) {
	    z__[i__] = -(work[indlpl + i__] * z__[i__ + 1]);
	    if (((d__1 = z__[i__], abs(d__1)) + (d__2 = z__[i__ + 1], abs(
		    d__2))) * (d__3 = ld[i__], abs(d__3)) < *gaptol) {
		z__[i__] = 0.;
		isuppz[1] = i__ + 1;
		goto L220;
	    }
	    *ztz += z__[i__] * z__[i__];
	}
L220:
	;
    } else {
	i__1 = *b1;
	for (i__ = *r__ - 1; i__ >= i__1; --i__) {
	    if (z__[i__ + 1] == 0.) {
		z__[i__] = -(ld[i__ + 1] / ld[i__]) * z__[i__ + 2];
	    } else {
		z__[i__] = -(work[indlpl + i__] * z__[i__ + 1]);
	    }
	    if (((d__1 = z__[i__], abs(d__1)) + (d__2 = z__[i__ + 1], abs(
		    d__2))) * (d__3 = ld[i__], abs(d__3)) < *gaptol) {
		z__[i__] = 0.;
		isuppz[1] = i__ + 1;
		goto L240;
	    }
	    *ztz += z__[i__] * z__[i__];
	}
L240:
	;
    }
    if (! sawnan1 && ! sawnan2) {
	i__1 = *bn - 1;
	for (i__ = *r__; i__ <= i__1; ++i__) {
	    z__[i__ + 1] = -(work[indumn + i__] * z__[i__]);
	    if (((d__1 = z__[i__], abs(d__1)) + (d__2 = z__[i__ + 1], abs(
		    d__2))) * (d__3 = ld[i__], abs(d__3)) < *gaptol) {
		z__[i__ + 1] = 0.;
		isuppz[2] = i__;
		goto L260;
	    }
	    *ztz += z__[i__ + 1] * z__[i__ + 1];
	}
L260:
	;
    } else {
	i__1 = *bn - 1;
	for (i__ = *r__; i__ <= i__1; ++i__) {
	    if (z__[i__] == 0.) {
		z__[i__ + 1] = -(ld[i__ - 1] / ld[i__]) * z__[i__ - 1];
	    } else {
		z__[i__ + 1] = -(work[indumn + i__] * z__[i__]);
	    }
	    if (((d__1 = z__[i__], abs(d__1)) + (d__2 = z__[i__ + 1], abs(
		    d__2))) * (d__3 = ld[i__], abs(d__3)) < *gaptol) {
		z__[i__ + 1] = 0.;
		isuppz[2] = i__;
		goto L280;
	    }
	    *ztz += z__[i__ + 1] * z__[i__ + 1];
	}
L280:
	;
    }


    tmp = 1. / *ztz;
    *nrminv = sqrt(tmp);
    *resid = abs(*mingma) * *nrminv;
    *rqcorr = *mingma * tmp;


return TCL_OK;


} /* dlar1v_ */
static /* Subroutine */ int dlarrf_ (Tcl_Interp *interp, integer *n, doublereal *d__, doublereal *l, 	doublereal *ld, integer *clstrt, integer *clend, doublereal *w, 	doublereal *wgap, doublereal *werr, doublereal *spdiam, doublereal *	clgapl, doublereal *clgapr, doublereal *pivmin, doublereal *sigma, 	doublereal *dplus, doublereal *lplus, doublereal *work, integer *info)
{
    integer i__1;
    doublereal d__1, d__2, d__3;

    double sqrt(doublereal);

    integer i__;
    doublereal s, bestshift, smlgrowth, eps, tmp, max1, max2, rrr1, rrr2, 
	    znm2, growthbound, fail, fact, oldp;
    integer indx;
    doublereal prod;
    integer ktry;
    doublereal fail2, avgap, ldmax, rdmax;
    integer shift;
    logical dorrr1;
    doublereal ldelta;
    logical nofail;
    doublereal mingap, lsigma, rdelta;
    logical forcer;
    doublereal rsigma, clwdth;
    logical sawnan1, sawnan2, tryrrr1;


























    --work;
    --lplus;
    --dplus;
    --werr;
    --wgap;
    --w;
    --ld;
    --l;
    --d__;

    *info = 0;
    fact = 2.;
    eps = dlamch_("Precision");
    shift = 0;
    forcer = FALSE_;
    nofail = TRUE_;

    clwdth = (d__1 = w[*clend] - w[*clstrt], abs(d__1)) + werr[*clend] + werr[
	    *clstrt];
    avgap = clwdth / (doublereal) (*clend - *clstrt);
    mingap = min(*clgapl,*clgapr);
    d__1 = w[*clstrt], d__2 = w[*clend];
    lsigma = min(d__1,d__2) - werr[*clstrt];
    d__1 = w[*clstrt], d__2 = w[*clend];
    rsigma = max(d__1,d__2) + werr[*clend];
    lsigma -= abs(lsigma) * 4. * eps;
    rsigma += abs(rsigma) * 4. * eps;
    ldmax = mingap * .25 + *pivmin * 2.;
    rdmax = mingap * .25 + *pivmin * 2.;
    d__1 = avgap, d__2 = wgap[*clstrt];
    ldelta = max(d__1,d__2) / fact;
    d__1 = avgap, d__2 = wgap[*clend - 1];
    rdelta = max(d__1,d__2) / fact;


    s = dlamch_("S");
    smlgrowth = 1. / s;
    fail = (doublereal) (*n - 1) * mingap / (*spdiam * eps);
    fail2 = (doublereal) (*n - 1) * mingap / (*spdiam * sqrt(eps));
    bestshift = lsigma;

    ktry = 0;
    growthbound = *spdiam * 8.;
L5:
    sawnan1 = FALSE_;
    sawnan2 = FALSE_;
    ldelta = min(ldmax,ldelta);
    rdelta = min(rdmax,rdelta);
    s = -lsigma;
    dplus[1] = d__[1] + s;
    if (abs(dplus[1]) < *pivmin) {
	dplus[1] = -(*pivmin);
	sawnan1 = TRUE_;
    }
    max1 = abs(dplus[1]);
    i__1 = *n - 1;
    for (i__ = 1; i__ <= i__1; ++i__) {
	lplus[i__] = ld[i__] / dplus[i__];
	s = s * lplus[i__] * l[i__] - lsigma;
	dplus[i__ + 1] = d__[i__ + 1] + s;
	if ((d__1 = dplus[i__ + 1], abs(d__1)) < *pivmin) {
	    dplus[i__ + 1] = -(*pivmin);
	    sawnan1 = TRUE_;
	}
	d__2 = max1, d__3 = (d__1 = dplus[i__ + 1], abs(d__1));
	max1 = max(d__2,d__3);
    }
    sawnan1 = sawnan1 || disnan_(&max1);
    if (forcer || max1 <= growthbound && ! sawnan1) {
	*sigma = lsigma;
	shift = 1;
	goto L100;
    }
    s = -rsigma;
    work[1] = d__[1] + s;
    if (abs(work[1]) < *pivmin) {
	work[1] = -(*pivmin);
	sawnan2 = TRUE_;
    }
    max2 = abs(work[1]);
    i__1 = *n - 1;
    for (i__ = 1; i__ <= i__1; ++i__) {
	work[*n + i__] = ld[i__] / work[i__];
	s = s * work[*n + i__] * l[i__] - rsigma;
	work[i__ + 1] = d__[i__ + 1] + s;
	if ((d__1 = work[i__ + 1], abs(d__1)) < *pivmin) {
	    work[i__ + 1] = -(*pivmin);
	    sawnan2 = TRUE_;
	}
	d__2 = max2, d__3 = (d__1 = work[i__ + 1], abs(d__1));
	max2 = max(d__2,d__3);
    }
    sawnan2 = sawnan2 || disnan_(&max2);
    if (forcer || max2 <= growthbound && ! sawnan2) {
	*sigma = rsigma;
	shift = 2;
	goto L100;
    }
    if (sawnan1 && sawnan2) {
	goto L50;
    } else {
	if (! sawnan1) {
	    indx = 1;
	    if (max1 <= smlgrowth) {
		smlgrowth = max1;
		bestshift = lsigma;
	    }
	}
	if (! sawnan2) {
	    if (sawnan1 || max2 <= max1) {
		indx = 2;
	    }
	    if (max2 <= smlgrowth) {
		smlgrowth = max2;
		bestshift = rsigma;
	    }
	}
    }
    if (clwdth < mingap / 128. && min(max1,max2) < fail2 && ! sawnan1 && ! 
	    sawnan2) {
	dorrr1 = TRUE_;
    } else {
	dorrr1 = FALSE_;
    }
    tryrrr1 = TRUE_;
    if (tryrrr1 && dorrr1) {
	if (indx == 1) {
	    tmp = (d__1 = dplus[*n], abs(d__1));
	    znm2 = 1.;
	    prod = 1.;
	    oldp = 1.;
	    for (i__ = *n - 1; i__ >= 1; --i__) {
		if (prod <= eps) {
		    prod = dplus[i__ + 1] * work[*n + i__ + 1] / (dplus[i__] *
			     work[*n + i__]) * oldp;
		} else {
		    prod *= (d__1 = work[*n + i__], abs(d__1));
		}
		oldp = prod;
		d__1 = prod;
		znm2 += d__1 * d__1;
		d__2 = tmp, d__3 = (d__1 = dplus[i__] * prod, abs(d__1));
		tmp = max(d__2,d__3);
	    }
	    rrr1 = tmp / (*spdiam * sqrt(znm2));
	    if (rrr1 <= 8.) {
		*sigma = lsigma;
		shift = 1;
		goto L100;
	    }
	} else if (indx == 2) {
	    tmp = (d__1 = work[*n], abs(d__1));
	    znm2 = 1.;
	    prod = 1.;
	    oldp = 1.;
	    for (i__ = *n - 1; i__ >= 1; --i__) {
		if (prod <= eps) {
		    prod = work[i__ + 1] * lplus[i__ + 1] / (work[i__] * 
			    lplus[i__]) * oldp;
		} else {
		    prod *= (d__1 = lplus[i__], abs(d__1));
		}
		oldp = prod;
		d__1 = prod;
		znm2 += d__1 * d__1;
		d__2 = tmp, d__3 = (d__1 = work[i__] * prod, abs(d__1));
		tmp = max(d__2,d__3);
	    }
	    rrr2 = tmp / (*spdiam * sqrt(znm2));
	    if (rrr2 <= 8.) {
		*sigma = rsigma;
		shift = 2;
		goto L100;
	    }
	}
    }
L50:
    if (ktry < 1) {
	d__1 = lsigma - ldelta, d__2 = lsigma - ldmax;
	lsigma = max(d__1,d__2);
	d__1 = rsigma + rdelta, d__2 = rsigma + rdmax;
	rsigma = min(d__1,d__2);
	ldelta *= 2.;
	rdelta *= 2.;
	++ktry;
	goto L5;
    } else {
	if (smlgrowth < fail || nofail) {
	    lsigma = bestshift;
	    rsigma = bestshift;
	    forcer = TRUE_;
	    goto L5;
	} else {
	    *info = 1;
return TCL_OK;
	}
    }
L100:
    if (shift == 1) {
    } else if (shift == 2) {
	if (dcopy_(interp, n, &work[1], &dlarrf_c__1, &dplus[1], &dlarrf_c__1)!=TCL_OK) { return TCL_ERROR; }

	i__1 = *n - 1;
	if (dcopy_(interp, &i__1, &work[*n + 1], &dlarrf_c__1, &lplus[1], &dlarrf_c__1)!=TCL_OK) { return TCL_ERROR; }

    }
return TCL_OK;


} /* dlarrf_ */
static /* Subroutine */ int dorm2l_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *	c__, integer *ldc, doublereal *work, integer *info)
{
    integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2;

    integer i__, i1, i2, i3, mi, ni, nq;
    doublereal aii;
    logical left;
    logical notran;





























    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --tau;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;
    --work;

    *info = 0;
    left = lsame_(side, "L");
    notran = lsame_(trans, "N");


    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);
	vectcl_xerbla(interp, "DORM2L", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


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

    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) {


	    mi = *m - *k + i__;
	} else {


	    ni = *n - *k + i__;
	}


	aii = a[nq - *k + i__ + i__ * a_dim1];
	a[nq - *k + i__ + i__ * a_dim1] = 1.;
	if (dlarf_(interp, side, &mi, &ni, &a[i__ * a_dim1 + 1], &dorm2l_c__1, &tau[i__], &c__[		c_offset], ldc, &work[1])!=TCL_OK) { return TCL_ERROR; }


	a[nq - *k + i__ + i__ * a_dim1] = aii;
    }
return TCL_OK;


} /* dorm2l_ */
static /* Subroutine */ int dsyr2_ (Tcl_Interp *interp, char *uplo, integer *n, doublereal *alpha, 	doublereal *x, integer *incx, doublereal *y, integer *incy, 	doublereal *a, integer *lda)
{
    integer a_dim1, a_offset, i__1, i__2;

    integer i__, j, ix, iy, jx, jy, kx, ky, info;
    doublereal temp1, temp2;

























    --x;
    --y;
    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;

    info = 0;
    if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {
	info = 1;
    } else if (*n < 0) {
	info = 2;
    } else if (*incx == 0) {
	info = 5;
    } else if (*incy == 0) {
	info = 7;
    } else if (*lda < max(1,*n)) {
	info = 9;
    }
    if (info != 0) {
	vectcl_xerbla(interp, "DSYR2 ", &info);
return TCL_ERROR;

return TCL_OK;
    }


    if (*n == 0 || *alpha == 0.) {
return TCL_OK;
    }


    if (*incx != 1 || *incy != 1) {
	if (*incx > 0) {
	    kx = 1;
	} else {
	    kx = 1 - (*n - 1) * *incx;
	}
	if (*incy > 0) {
	    ky = 1;
	} else {
	    ky = 1 - (*n - 1) * *incy;
	}
	jx = kx;
	jy = ky;
    }


    if (lsame_(uplo, "U")) {


	if (*incx == 1 && *incy == 1) {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		if (x[j] != 0. || y[j] != 0.) {
		    temp1 = *alpha * y[j];
		    temp2 = *alpha * x[j];
		    i__2 = j;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			a[i__ + j * a_dim1] = a[i__ + j * a_dim1] + x[i__] * 
				temp1 + y[i__] * temp2;
		    }
		}
	    }
	} else {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		if (x[jx] != 0. || y[jy] != 0.) {
		    temp1 = *alpha * y[jy];
		    temp2 = *alpha * x[jx];
		    ix = kx;
		    iy = ky;
		    i__2 = j;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			a[i__ + j * a_dim1] = a[i__ + j * a_dim1] + x[ix] * 
				temp1 + y[iy] * temp2;
			ix += *incx;
			iy += *incy;
		    }
		}
		jx += *incx;
		jy += *incy;
	    }
	}
    } else {


	if (*incx == 1 && *incy == 1) {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		if (x[j] != 0. || y[j] != 0.) {
		    temp1 = *alpha * y[j];
		    temp2 = *alpha * x[j];
		    i__2 = *n;
		    for (i__ = j; i__ <= i__2; ++i__) {
			a[i__ + j * a_dim1] = a[i__ + j * a_dim1] + x[i__] * 
				temp1 + y[i__] * temp2;
		    }
		}
	    }
	} else {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		if (x[jx] != 0. || y[jy] != 0.) {
		    temp1 = *alpha * y[jy];
		    temp2 = *alpha * x[jx];
		    ix = jx;
		    iy = jy;
		    i__2 = *n;
		    for (i__ = j; i__ <= i__2; ++i__) {
			a[i__ + j * a_dim1] = a[i__ + j * a_dim1] + x[ix] * 
				temp1 + y[iy] * temp2;
			ix += *incx;
			iy += *incy;
		    }
		}
		jx += *incx;
		jy += *incy;
	    }
	}
    }

return TCL_OK;


} /* dsyr2_ */
static /* Subroutine */ int dsymv_ (Tcl_Interp *interp, char *uplo, integer *n, doublereal *alpha, 	doublereal *a, integer *lda, doublereal *x, integer *incx, doublereal 	*beta, doublereal *y, integer *incy)
{
    integer a_dim1, a_offset, i__1, i__2;

    integer i__, j, ix, iy, jx, jy, kx, ky, info;
    doublereal temp1, temp2;


























    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --x;
    --y;

    info = 0;
    if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {
	info = 1;
    } else if (*n < 0) {
	info = 2;
    } else if (*lda < max(1,*n)) {
	info = 5;
    } else if (*incx == 0) {
	info = 7;
    } else if (*incy == 0) {
	info = 10;
    }
    if (info != 0) {
	vectcl_xerbla(interp, "DSYMV ", &info);
return TCL_ERROR;

return TCL_OK;
    }


    if (*n == 0 || *alpha == 0. && *beta == 1.) {
return TCL_OK;
    }


    if (*incx > 0) {
	kx = 1;
    } else {
	kx = 1 - (*n - 1) * *incx;
    }
    if (*incy > 0) {
	ky = 1;
    } else {
	ky = 1 - (*n - 1) * *incy;
    }



    if (*beta != 1.) {
	if (*incy == 1) {
	    if (*beta == 0.) {
		i__1 = *n;
		for (i__ = 1; i__ <= i__1; ++i__) {
		    y[i__] = 0.;
		}
	    } else {
		i__1 = *n;
		for (i__ = 1; i__ <= i__1; ++i__) {
		    y[i__] = *beta * y[i__];
		}
	    }
	} else {
	    iy = ky;
	    if (*beta == 0.) {
		i__1 = *n;
		for (i__ = 1; i__ <= i__1; ++i__) {
		    y[iy] = 0.;
		    iy += *incy;
		}
	    } else {
		i__1 = *n;
		for (i__ = 1; i__ <= i__1; ++i__) {
		    y[iy] = *beta * y[iy];
		    iy += *incy;
		}
	    }
	}
    }
    if (*alpha == 0.) {
return TCL_OK;
    }
    if (lsame_(uplo, "U")) {


	if (*incx == 1 && *incy == 1) {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		temp1 = *alpha * x[j];
		temp2 = 0.;
		i__2 = j - 1;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    y[i__] += temp1 * a[i__ + j * a_dim1];
		    temp2 += a[i__ + j * a_dim1] * x[i__];
		}
		y[j] = y[j] + temp1 * a[j + j * a_dim1] + *alpha * temp2;
	    }
	} else {
	    jx = kx;
	    jy = ky;
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		temp1 = *alpha * x[jx];
		temp2 = 0.;
		ix = kx;
		iy = ky;
		i__2 = j - 1;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    y[iy] += temp1 * a[i__ + j * a_dim1];
		    temp2 += a[i__ + j * a_dim1] * x[ix];
		    ix += *incx;
		    iy += *incy;
		}
		y[jy] = y[jy] + temp1 * a[j + j * a_dim1] + *alpha * temp2;
		jx += *incx;
		jy += *incy;
	    }
	}
    } else {


	if (*incx == 1 && *incy == 1) {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		temp1 = *alpha * x[j];
		temp2 = 0.;
		y[j] += temp1 * a[j + j * a_dim1];
		i__2 = *n;
		for (i__ = j + 1; i__ <= i__2; ++i__) {
		    y[i__] += temp1 * a[i__ + j * a_dim1];
		    temp2 += a[i__ + j * a_dim1] * x[i__];
		}
		y[j] += *alpha * temp2;
	    }
	} else {
	    jx = kx;
	    jy = ky;
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		temp1 = *alpha * x[jx];
		temp2 = 0.;
		y[jy] += temp1 * a[j + j * a_dim1];
		ix = jx;
		iy = jy;
		i__2 = *n;
		for (i__ = j + 1; i__ <= i__2; ++i__) {
		    ix += *incx;
		    iy += *incy;
		    y[iy] += temp1 * a[i__ + j * a_dim1];
		    temp2 += a[i__ + j * a_dim1] * x[ix];
		}
		y[jy] += *alpha * temp2;
		jx += *incx;
		jy += *incy;
	    }
	}
    }

return TCL_OK;


} /* dsymv_ */
static /* Subroutine */ int zher2_ (Tcl_Interp *interp, char *uplo, integer *n, doublecomplex *alpha, 	doublecomplex *x, integer *incx, doublecomplex *y, integer *incy, 	doublecomplex *a, integer *lda)
{
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5, i__6;
    doublereal d__1;
    doublecomplex z__1, z__2, z__3, z__4;

    void d_cnjg(doublecomplex *, doublecomplex *);

    integer i__, j, ix, iy, jx, jy, kx, ky, info;
    doublecomplex temp1, temp2;

























    --x;
    --y;
    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;

    info = 0;
    if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {
	info = 1;
    } else if (*n < 0) {
	info = 2;
    } else if (*incx == 0) {
	info = 5;
    } else if (*incy == 0) {
	info = 7;
    } else if (*lda < max(1,*n)) {
	info = 9;
    }
    if (info != 0) {
	vectcl_xerbla(interp, "ZHER2 ", &info);
return TCL_ERROR;

return TCL_OK;
    }


    if (*n == 0 || alpha->r == 0. && alpha->i == 0.) {
return TCL_OK;
    }


    if (*incx != 1 || *incy != 1) {
	if (*incx > 0) {
	    kx = 1;
	} else {
	    kx = 1 - (*n - 1) * *incx;
	}
	if (*incy > 0) {
	    ky = 1;
	} else {
	    ky = 1 - (*n - 1) * *incy;
	}
	jx = kx;
	jy = ky;
    }


    if (lsame_(uplo, "U")) {


	if (*incx == 1 && *incy == 1) {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = j;
		i__3 = j;
		if (x[i__2].r != 0. || x[i__2].i != 0. || (y[i__3].r != 0. || 
			y[i__3].i != 0.)) {
		    d_cnjg(&z__2, &y[j]);
		    z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i = 
			    alpha->r * z__2.i + alpha->i * z__2.r;
		    temp1.r = z__1.r, temp1.i = z__1.i;
		    i__2 = j;
		    z__2.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, 
			    z__2.i = alpha->r * x[i__2].i + alpha->i * x[i__2]
			    .r;
		    d_cnjg(&z__1, &z__2);
		    temp2.r = z__1.r, temp2.i = z__1.i;
		    i__2 = j - 1;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			i__3 = i__ + j * a_dim1;
			i__4 = i__ + j * a_dim1;
			i__5 = i__;
			z__3.r = x[i__5].r * temp1.r - x[i__5].i * temp1.i, 
				z__3.i = x[i__5].r * temp1.i + x[i__5].i * 
				temp1.r;
			z__2.r = a[i__4].r + z__3.r, z__2.i = a[i__4].i + 
				z__3.i;
			i__6 = i__;
			z__4.r = y[i__6].r * temp2.r - y[i__6].i * temp2.i, 
				z__4.i = y[i__6].r * temp2.i + y[i__6].i * 
				temp2.r;
			z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;
			a[i__3].r = z__1.r, a[i__3].i = z__1.i;
		    }
		    i__2 = j + j * a_dim1;
		    i__3 = j + j * a_dim1;
		    i__4 = j;
		    z__2.r = x[i__4].r * temp1.r - x[i__4].i * temp1.i, 
			    z__2.i = x[i__4].r * temp1.i + x[i__4].i * 
			    temp1.r;
		    i__5 = j;
		    z__3.r = y[i__5].r * temp2.r - y[i__5].i * temp2.i, 
			    z__3.i = y[i__5].r * temp2.i + y[i__5].i * 
			    temp2.r;
		    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
		    d__1 = a[i__3].r + z__1.r;
		    a[i__2].r = d__1, a[i__2].i = 0.;
		} else {
		    i__2 = j + j * a_dim1;
		    i__3 = j + j * a_dim1;
		    d__1 = a[i__3].r;
		    a[i__2].r = d__1, a[i__2].i = 0.;
		}
	    }
	} else {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = jx;
		i__3 = jy;
		if (x[i__2].r != 0. || x[i__2].i != 0. || (y[i__3].r != 0. || 
			y[i__3].i != 0.)) {
		    d_cnjg(&z__2, &y[jy]);
		    z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i = 
			    alpha->r * z__2.i + alpha->i * z__2.r;
		    temp1.r = z__1.r, temp1.i = z__1.i;
		    i__2 = jx;
		    z__2.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, 
			    z__2.i = alpha->r * x[i__2].i + alpha->i * x[i__2]
			    .r;
		    d_cnjg(&z__1, &z__2);
		    temp2.r = z__1.r, temp2.i = z__1.i;
		    ix = kx;
		    iy = ky;
		    i__2 = j - 1;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			i__3 = i__ + j * a_dim1;
			i__4 = i__ + j * a_dim1;
			i__5 = ix;
			z__3.r = x[i__5].r * temp1.r - x[i__5].i * temp1.i, 
				z__3.i = x[i__5].r * temp1.i + x[i__5].i * 
				temp1.r;
			z__2.r = a[i__4].r + z__3.r, z__2.i = a[i__4].i + 
				z__3.i;
			i__6 = iy;
			z__4.r = y[i__6].r * temp2.r - y[i__6].i * temp2.i, 
				z__4.i = y[i__6].r * temp2.i + y[i__6].i * 
				temp2.r;
			z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;
			a[i__3].r = z__1.r, a[i__3].i = z__1.i;
			ix += *incx;
			iy += *incy;
		    }
		    i__2 = j + j * a_dim1;
		    i__3 = j + j * a_dim1;
		    i__4 = jx;
		    z__2.r = x[i__4].r * temp1.r - x[i__4].i * temp1.i, 
			    z__2.i = x[i__4].r * temp1.i + x[i__4].i * 
			    temp1.r;
		    i__5 = jy;
		    z__3.r = y[i__5].r * temp2.r - y[i__5].i * temp2.i, 
			    z__3.i = y[i__5].r * temp2.i + y[i__5].i * 
			    temp2.r;
		    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
		    d__1 = a[i__3].r + z__1.r;
		    a[i__2].r = d__1, a[i__2].i = 0.;
		} else {
		    i__2 = j + j * a_dim1;
		    i__3 = j + j * a_dim1;
		    d__1 = a[i__3].r;
		    a[i__2].r = d__1, a[i__2].i = 0.;
		}
		jx += *incx;
		jy += *incy;
	    }
	}
    } else {


	if (*incx == 1 && *incy == 1) {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = j;
		i__3 = j;
		if (x[i__2].r != 0. || x[i__2].i != 0. || (y[i__3].r != 0. || 
			y[i__3].i != 0.)) {
		    d_cnjg(&z__2, &y[j]);
		    z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i = 
			    alpha->r * z__2.i + alpha->i * z__2.r;
		    temp1.r = z__1.r, temp1.i = z__1.i;
		    i__2 = j;
		    z__2.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, 
			    z__2.i = alpha->r * x[i__2].i + alpha->i * x[i__2]
			    .r;
		    d_cnjg(&z__1, &z__2);
		    temp2.r = z__1.r, temp2.i = z__1.i;
		    i__2 = j + j * a_dim1;
		    i__3 = j + j * a_dim1;
		    i__4 = j;
		    z__2.r = x[i__4].r * temp1.r - x[i__4].i * temp1.i, 
			    z__2.i = x[i__4].r * temp1.i + x[i__4].i * 
			    temp1.r;
		    i__5 = j;
		    z__3.r = y[i__5].r * temp2.r - y[i__5].i * temp2.i, 
			    z__3.i = y[i__5].r * temp2.i + y[i__5].i * 
			    temp2.r;
		    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
		    d__1 = a[i__3].r + z__1.r;
		    a[i__2].r = d__1, a[i__2].i = 0.;
		    i__2 = *n;
		    for (i__ = j + 1; i__ <= i__2; ++i__) {
			i__3 = i__ + j * a_dim1;
			i__4 = i__ + j * a_dim1;
			i__5 = i__;
			z__3.r = x[i__5].r * temp1.r - x[i__5].i * temp1.i, 
				z__3.i = x[i__5].r * temp1.i + x[i__5].i * 
				temp1.r;
			z__2.r = a[i__4].r + z__3.r, z__2.i = a[i__4].i + 
				z__3.i;
			i__6 = i__;
			z__4.r = y[i__6].r * temp2.r - y[i__6].i * temp2.i, 
				z__4.i = y[i__6].r * temp2.i + y[i__6].i * 
				temp2.r;
			z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;
			a[i__3].r = z__1.r, a[i__3].i = z__1.i;
		    }
		} else {
		    i__2 = j + j * a_dim1;
		    i__3 = j + j * a_dim1;
		    d__1 = a[i__3].r;
		    a[i__2].r = d__1, a[i__2].i = 0.;
		}
	    }
	} else {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = jx;
		i__3 = jy;
		if (x[i__2].r != 0. || x[i__2].i != 0. || (y[i__3].r != 0. || 
			y[i__3].i != 0.)) {
		    d_cnjg(&z__2, &y[jy]);
		    z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i = 
			    alpha->r * z__2.i + alpha->i * z__2.r;
		    temp1.r = z__1.r, temp1.i = z__1.i;
		    i__2 = jx;
		    z__2.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, 
			    z__2.i = alpha->r * x[i__2].i + alpha->i * x[i__2]
			    .r;
		    d_cnjg(&z__1, &z__2);
		    temp2.r = z__1.r, temp2.i = z__1.i;
		    i__2 = j + j * a_dim1;
		    i__3 = j + j * a_dim1;
		    i__4 = jx;
		    z__2.r = x[i__4].r * temp1.r - x[i__4].i * temp1.i, 
			    z__2.i = x[i__4].r * temp1.i + x[i__4].i * 
			    temp1.r;
		    i__5 = jy;
		    z__3.r = y[i__5].r * temp2.r - y[i__5].i * temp2.i, 
			    z__3.i = y[i__5].r * temp2.i + y[i__5].i * 
			    temp2.r;
		    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
		    d__1 = a[i__3].r + z__1.r;
		    a[i__2].r = d__1, a[i__2].i = 0.;
		    ix = jx;
		    iy = jy;
		    i__2 = *n;
		    for (i__ = j + 1; i__ <= i__2; ++i__) {
			ix += *incx;
			iy += *incy;
			i__3 = i__ + j * a_dim1;
			i__4 = i__ + j * a_dim1;
			i__5 = ix;
			z__3.r = x[i__5].r * temp1.r - x[i__5].i * temp1.i, 
				z__3.i = x[i__5].r * temp1.i + x[i__5].i * 
				temp1.r;
			z__2.r = a[i__4].r + z__3.r, z__2.i = a[i__4].i + 
				z__3.i;
			i__6 = iy;
			z__4.r = y[i__6].r * temp2.r - y[i__6].i * temp2.i, 
				z__4.i = y[i__6].r * temp2.i + y[i__6].i * 
				temp2.r;
			z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;
			a[i__3].r = z__1.r, a[i__3].i = z__1.i;
		    }
		} else {
		    i__2 = j + j * a_dim1;
		    i__3 = j + j * a_dim1;
		    d__1 = a[i__3].r;
		    a[i__2].r = d__1, a[i__2].i = 0.;
		}
		jx += *incx;
		jy += *incy;
	    }
	}
    }

return TCL_OK;


} /* zher2_ */
static /* Subroutine */ int zhemv_ (Tcl_Interp *interp, char *uplo, integer *n, doublecomplex *alpha, 	doublecomplex *a, integer *lda, doublecomplex *x, integer *incx, 	doublecomplex *beta, doublecomplex *y, integer *incy)
{
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
    doublereal d__1;
    doublecomplex z__1, z__2, z__3, z__4;

    void d_cnjg(doublecomplex *, doublecomplex *);

    integer i__, j, ix, iy, jx, jy, kx, ky, info;
    doublecomplex temp1, temp2;


























    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --x;
    --y;

    info = 0;
    if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {
	info = 1;
    } else if (*n < 0) {
	info = 2;
    } else if (*lda < max(1,*n)) {
	info = 5;
    } else if (*incx == 0) {
	info = 7;
    } else if (*incy == 0) {
	info = 10;
    }
    if (info != 0) {
	vectcl_xerbla(interp, "ZHEMV ", &info);
return TCL_ERROR;

return TCL_OK;
    }


    if (*n == 0 || alpha->r == 0. && alpha->i == 0. && (beta->r == 1. && 
	    beta->i == 0.)) {
return TCL_OK;
    }


    if (*incx > 0) {
	kx = 1;
    } else {
	kx = 1 - (*n - 1) * *incx;
    }
    if (*incy > 0) {
	ky = 1;
    } else {
	ky = 1 - (*n - 1) * *incy;
    }



    if (beta->r != 1. || beta->i != 0.) {
	if (*incy == 1) {
	    if (beta->r == 0. && beta->i == 0.) {
		i__1 = *n;
		for (i__ = 1; i__ <= i__1; ++i__) {
		    i__2 = i__;
		    y[i__2].r = 0., y[i__2].i = 0.;
		}
	    } else {
		i__1 = *n;
		for (i__ = 1; i__ <= i__1; ++i__) {
		    i__2 = i__;
		    i__3 = i__;
		    z__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i, 
			    z__1.i = beta->r * y[i__3].i + beta->i * y[i__3]
			    .r;
		    y[i__2].r = z__1.r, y[i__2].i = z__1.i;
		}
	    }
	} else {
	    iy = ky;
	    if (beta->r == 0. && beta->i == 0.) {
		i__1 = *n;
		for (i__ = 1; i__ <= i__1; ++i__) {
		    i__2 = iy;
		    y[i__2].r = 0., y[i__2].i = 0.;
		    iy += *incy;
		}
	    } else {
		i__1 = *n;
		for (i__ = 1; i__ <= i__1; ++i__) {
		    i__2 = iy;
		    i__3 = iy;
		    z__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i, 
			    z__1.i = beta->r * y[i__3].i + beta->i * y[i__3]
			    .r;
		    y[i__2].r = z__1.r, y[i__2].i = z__1.i;
		    iy += *incy;
		}
	    }
	}
    }
    if (alpha->r == 0. && alpha->i == 0.) {
return TCL_OK;
    }
    if (lsame_(uplo, "U")) {


	if (*incx == 1 && *incy == 1) {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = j;
		z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, z__1.i =
			 alpha->r * x[i__2].i + alpha->i * x[i__2].r;
		temp1.r = z__1.r, temp1.i = z__1.i;
		temp2.r = 0., temp2.i = 0.;
		i__2 = j - 1;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    i__3 = i__;
		    i__4 = i__;
		    i__5 = i__ + j * a_dim1;
		    z__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i, 
			    z__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5]
			    .r;
		    z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;
		    y[i__3].r = z__1.r, y[i__3].i = z__1.i;
		    d_cnjg(&z__3, &a[i__ + j * a_dim1]);
		    i__3 = i__;
		    z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, z__2.i =
			     z__3.r * x[i__3].i + z__3.i * x[i__3].r;
		    z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
		    temp2.r = z__1.r, temp2.i = z__1.i;
		}
		i__2 = j;
		i__3 = j;
		i__4 = j + j * a_dim1;
		d__1 = a[i__4].r;
		z__3.r = d__1 * temp1.r, z__3.i = d__1 * temp1.i;
		z__2.r = y[i__3].r + z__3.r, z__2.i = y[i__3].i + z__3.i;
		z__4.r = alpha->r * temp2.r - alpha->i * temp2.i, z__4.i = 
			alpha->r * temp2.i + alpha->i * temp2.r;
		z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;
		y[i__2].r = z__1.r, y[i__2].i = z__1.i;
	    }
	} else {
	    jx = kx;
	    jy = ky;
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = jx;
		z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, z__1.i =
			 alpha->r * x[i__2].i + alpha->i * x[i__2].r;
		temp1.r = z__1.r, temp1.i = z__1.i;
		temp2.r = 0., temp2.i = 0.;
		ix = kx;
		iy = ky;
		i__2 = j - 1;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    i__3 = iy;
		    i__4 = iy;
		    i__5 = i__ + j * a_dim1;
		    z__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i, 
			    z__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5]
			    .r;
		    z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;
		    y[i__3].r = z__1.r, y[i__3].i = z__1.i;
		    d_cnjg(&z__3, &a[i__ + j * a_dim1]);
		    i__3 = ix;
		    z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, z__2.i =
			     z__3.r * x[i__3].i + z__3.i * x[i__3].r;
		    z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
		    temp2.r = z__1.r, temp2.i = z__1.i;
		    ix += *incx;
		    iy += *incy;
		}
		i__2 = jy;
		i__3 = jy;
		i__4 = j + j * a_dim1;
		d__1 = a[i__4].r;
		z__3.r = d__1 * temp1.r, z__3.i = d__1 * temp1.i;
		z__2.r = y[i__3].r + z__3.r, z__2.i = y[i__3].i + z__3.i;
		z__4.r = alpha->r * temp2.r - alpha->i * temp2.i, z__4.i = 
			alpha->r * temp2.i + alpha->i * temp2.r;
		z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;
		y[i__2].r = z__1.r, y[i__2].i = z__1.i;
		jx += *incx;
		jy += *incy;
	    }
	}
    } else {


	if (*incx == 1 && *incy == 1) {
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = j;
		z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, z__1.i =
			 alpha->r * x[i__2].i + alpha->i * x[i__2].r;
		temp1.r = z__1.r, temp1.i = z__1.i;
		temp2.r = 0., temp2.i = 0.;
		i__2 = j;
		i__3 = j;
		i__4 = j + j * a_dim1;
		d__1 = a[i__4].r;
		z__2.r = d__1 * temp1.r, z__2.i = d__1 * temp1.i;
		z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;
		y[i__2].r = z__1.r, y[i__2].i = z__1.i;
		i__2 = *n;
		for (i__ = j + 1; i__ <= i__2; ++i__) {
		    i__3 = i__;
		    i__4 = i__;
		    i__5 = i__ + j * a_dim1;
		    z__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i, 
			    z__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5]
			    .r;
		    z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;
		    y[i__3].r = z__1.r, y[i__3].i = z__1.i;
		    d_cnjg(&z__3, &a[i__ + j * a_dim1]);
		    i__3 = i__;
		    z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, z__2.i =
			     z__3.r * x[i__3].i + z__3.i * x[i__3].r;
		    z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
		    temp2.r = z__1.r, temp2.i = z__1.i;
		}
		i__2 = j;
		i__3 = j;
		z__2.r = alpha->r * temp2.r - alpha->i * temp2.i, z__2.i = 
			alpha->r * temp2.i + alpha->i * temp2.r;
		z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;
		y[i__2].r = z__1.r, y[i__2].i = z__1.i;
	    }
	} else {
	    jx = kx;
	    jy = ky;
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		i__2 = jx;
		z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, z__1.i =
			 alpha->r * x[i__2].i + alpha->i * x[i__2].r;
		temp1.r = z__1.r, temp1.i = z__1.i;
		temp2.r = 0., temp2.i = 0.;
		i__2 = jy;
		i__3 = jy;
		i__4 = j + j * a_dim1;
		d__1 = a[i__4].r;
		z__2.r = d__1 * temp1.r, z__2.i = d__1 * temp1.i;
		z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;
		y[i__2].r = z__1.r, y[i__2].i = z__1.i;
		ix = jx;
		iy = jy;
		i__2 = *n;
		for (i__ = j + 1; i__ <= i__2; ++i__) {
		    ix += *incx;
		    iy += *incy;
		    i__3 = iy;
		    i__4 = iy;
		    i__5 = i__ + j * a_dim1;
		    z__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i, 
			    z__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5]
			    .r;
		    z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;
		    y[i__3].r = z__1.r, y[i__3].i = z__1.i;
		    d_cnjg(&z__3, &a[i__ + j * a_dim1]);
		    i__3 = ix;
		    z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, z__2.i =
			     z__3.r * x[i__3].i + z__3.i * x[i__3].r;
		    z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
		    temp2.r = z__1.r, temp2.i = z__1.i;
		}
		i__2 = jy;
		i__3 = jy;
		z__2.r = alpha->r * temp2.r - alpha->i * temp2.i, z__2.i = 
			alpha->r * temp2.i + alpha->i * temp2.r;
		z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;
		y[i__2].r = z__1.r, y[i__2].i = z__1.i;
		jx += *incx;
		jy += *incy;
	    }
	}
    }

return TCL_OK;


} /* zhemv_ */
static /* Subroutine */ int zlar1v_ (Tcl_Interp *interp, integer *n, integer *b1, integer *bn, doublereal 	*lambda, doublereal *d__, doublereal *l, doublereal *ld, doublereal *	lld, doublereal *pivmin, doublereal *gaptol, doublecomplex *z__, 	logical *wantnc, integer *negcnt, doublereal *ztz, doublereal *mingma, 	 integer *r__, integer *isuppz, doublereal *nrminv, doublereal *resid, 	 doublereal *rqcorr, doublereal *work)
{
    integer i__1, i__2, i__3, i__4;
    doublereal d__1;
    doublecomplex z__1, z__2;

    double z_abs(doublecomplex *), sqrt(doublereal);

    integer i__;
    doublereal s;
    integer r1, r2;
    doublereal eps, tmp;
    integer neg1, neg2, indp, inds;
    doublereal dplus;
    integer indlpl, indumn;
    doublereal dminus;
    logical sawnan1, sawnan2;
































    --work;
    --isuppz;
    --z__;
    --lld;
    --ld;
    --l;
    --d__;

    eps = dlamch_("Precision");
    if (*r__ == 0) {
	r1 = *b1;
	r2 = *bn;
    } else {
	r1 = *r__;
	r2 = *r__;
    }
    indlpl = 0;
    indumn = *n;
    inds = (*n << 1) + 1;
    indp = *n * 3 + 1;
    if (*b1 == 1) {
	work[inds] = 0.;
    } else {
	work[inds + *b1 - 1] = lld[*b1 - 1];
    }


    sawnan1 = FALSE_;
    neg1 = 0;
    s = work[inds + *b1 - 1] - *lambda;
    i__1 = r1 - 1;
    for (i__ = *b1; i__ <= i__1; ++i__) {
	dplus = d__[i__] + s;
	work[indlpl + i__] = ld[i__] / dplus;
	if (dplus < 0.) {
	    ++neg1;
	}
	work[inds + i__] = s * work[indlpl + i__] * l[i__];
	s = work[inds + i__] - *lambda;
    }
    sawnan1 = disnan_(&s);
    if (sawnan1) {
	goto L60;
    }
    i__1 = r2 - 1;
    for (i__ = r1; i__ <= i__1; ++i__) {
	dplus = d__[i__] + s;
	work[indlpl + i__] = ld[i__] / dplus;
	work[inds + i__] = s * work[indlpl + i__] * l[i__];
	s = work[inds + i__] - *lambda;
    }
    sawnan1 = disnan_(&s);

L60:
    if (sawnan1) {
	neg1 = 0;
	s = work[inds + *b1 - 1] - *lambda;
	i__1 = r1 - 1;
	for (i__ = *b1; i__ <= i__1; ++i__) {
	    dplus = d__[i__] + s;
	    if (abs(dplus) < *pivmin) {
		dplus = -(*pivmin);
	    }
	    work[indlpl + i__] = ld[i__] / dplus;
	    if (dplus < 0.) {
		++neg1;
	    }
	    work[inds + i__] = s * work[indlpl + i__] * l[i__];
	    if (work[indlpl + i__] == 0.) {
		work[inds + i__] = lld[i__];
	    }
	    s = work[inds + i__] - *lambda;
	}
	i__1 = r2 - 1;
	for (i__ = r1; i__ <= i__1; ++i__) {
	    dplus = d__[i__] + s;
	    if (abs(dplus) < *pivmin) {
		dplus = -(*pivmin);
	    }
	    work[indlpl + i__] = ld[i__] / dplus;
	    work[inds + i__] = s * work[indlpl + i__] * l[i__];
	    if (work[indlpl + i__] == 0.) {
		work[inds + i__] = lld[i__];
	    }
	    s = work[inds + i__] - *lambda;
	}
    }


    sawnan2 = FALSE_;
    neg2 = 0;
    work[indp + *bn - 1] = d__[*bn] - *lambda;
    i__1 = r1;
    for (i__ = *bn - 1; i__ >= i__1; --i__) {
	dminus = lld[i__] + work[indp + i__];
	tmp = d__[i__] / dminus;
	if (dminus < 0.) {
	    ++neg2;
	}
	work[indumn + i__] = l[i__] * tmp;
	work[indp + i__ - 1] = work[indp + i__] * tmp - *lambda;
    }
    tmp = work[indp + r1 - 1];
    sawnan2 = disnan_(&tmp);
    if (sawnan2) {
	neg2 = 0;
	i__1 = r1;
	for (i__ = *bn - 1; i__ >= i__1; --i__) {
	    dminus = lld[i__] + work[indp + i__];
	    if (abs(dminus) < *pivmin) {
		dminus = -(*pivmin);
	    }
	    tmp = d__[i__] / dminus;
	    if (dminus < 0.) {
		++neg2;
	    }
	    work[indumn + i__] = l[i__] * tmp;
	    work[indp + i__ - 1] = work[indp + i__] * tmp - *lambda;
	    if (tmp == 0.) {
		work[indp + i__ - 1] = d__[i__] - *lambda;
	    }
	}
    }


    *mingma = work[inds + r1 - 1] + work[indp + r1 - 1];
    if (*mingma < 0.) {
	++neg1;
    }
    if (*wantnc) {
	*negcnt = neg1 + neg2;
    } else {
	*negcnt = -1;
    }
    if (abs(*mingma) == 0.) {
	*mingma = eps * work[inds + r1 - 1];
    }
    *r__ = r1;
    i__1 = r2 - 1;
    for (i__ = r1; i__ <= i__1; ++i__) {
	tmp = work[inds + i__] + work[indp + i__];
	if (tmp == 0.) {
	    tmp = eps * work[inds + i__];
	}
	if (abs(tmp) <= abs(*mingma)) {
	    *mingma = tmp;
	    *r__ = i__ + 1;
	}
    }


    isuppz[1] = *b1;
    isuppz[2] = *bn;
    i__1 = *r__;
    z__[i__1].r = 1., z__[i__1].i = 0.;
    *ztz = 1.;


    if (! sawnan1 && ! sawnan2) {
	i__1 = *b1;
	for (i__ = *r__ - 1; i__ >= i__1; --i__) {
	    i__2 = i__;
	    i__3 = indlpl + i__;
	    i__4 = i__ + 1;
	    z__2.r = work[i__3] * z__[i__4].r, z__2.i = work[i__3] * z__[i__4]
		    .i;
	    z__1.r = -z__2.r, z__1.i = -z__2.i;
	    z__[i__2].r = z__1.r, z__[i__2].i = z__1.i;
	    if ((z_abs(&z__[i__]) + z_abs(&z__[i__ + 1])) * (d__1 = ld[i__], 
		    abs(d__1)) < *gaptol) {
		i__2 = i__;
		z__[i__2].r = 0., z__[i__2].i = 0.;
		isuppz[1] = i__ + 1;
		goto L220;
	    }
	    i__2 = i__;
	    i__3 = i__;
	    z__1.r = z__[i__2].r * z__[i__3].r - z__[i__2].i * z__[i__3].i, 
		    z__1.i = z__[i__2].r * z__[i__3].i + z__[i__2].i * z__[
		    i__3].r;
	    *ztz += z__1.r;
	}
L220:
	;
    } else {
	i__1 = *b1;
	for (i__ = *r__ - 1; i__ >= i__1; --i__) {
	    i__2 = i__ + 1;
	    if (z__[i__2].r == 0. && z__[i__2].i == 0.) {
		i__2 = i__;
		d__1 = -(ld[i__ + 1] / ld[i__]);
		i__3 = i__ + 2;
		z__1.r = d__1 * z__[i__3].r, z__1.i = d__1 * z__[i__3].i;
		z__[i__2].r = z__1.r, z__[i__2].i = z__1.i;
	    } else {
		i__2 = i__;
		i__3 = indlpl + i__;
		i__4 = i__ + 1;
		z__2.r = work[i__3] * z__[i__4].r, z__2.i = work[i__3] * z__[
			i__4].i;
		z__1.r = -z__2.r, z__1.i = -z__2.i;
		z__[i__2].r = z__1.r, z__[i__2].i = z__1.i;
	    }
	    if ((z_abs(&z__[i__]) + z_abs(&z__[i__ + 1])) * (d__1 = ld[i__], 
		    abs(d__1)) < *gaptol) {
		i__2 = i__;
		z__[i__2].r = 0., z__[i__2].i = 0.;
		isuppz[1] = i__ + 1;
		goto L240;
	    }
	    i__2 = i__;
	    i__3 = i__;
	    z__1.r = z__[i__2].r * z__[i__3].r - z__[i__2].i * z__[i__3].i, 
		    z__1.i = z__[i__2].r * z__[i__3].i + z__[i__2].i * z__[
		    i__3].r;
	    *ztz += z__1.r;
	}
L240:
	;
    }
    if (! sawnan1 && ! sawnan2) {
	i__1 = *bn - 1;
	for (i__ = *r__; i__ <= i__1; ++i__) {
	    i__2 = i__ + 1;
	    i__3 = indumn + i__;
	    i__4 = i__;
	    z__2.r = work[i__3] * z__[i__4].r, z__2.i = work[i__3] * z__[i__4]
		    .i;
	    z__1.r = -z__2.r, z__1.i = -z__2.i;
	    z__[i__2].r = z__1.r, z__[i__2].i = z__1.i;
	    if ((z_abs(&z__[i__]) + z_abs(&z__[i__ + 1])) * (d__1 = ld[i__], 
		    abs(d__1)) < *gaptol) {
		i__2 = i__ + 1;
		z__[i__2].r = 0., z__[i__2].i = 0.;
		isuppz[2] = i__;
		goto L260;
	    }
	    i__2 = i__ + 1;
	    i__3 = i__ + 1;
	    z__1.r = z__[i__2].r * z__[i__3].r - z__[i__2].i * z__[i__3].i, 
		    z__1.i = z__[i__2].r * z__[i__3].i + z__[i__2].i * z__[
		    i__3].r;
	    *ztz += z__1.r;
	}
L260:
	;
    } else {
	i__1 = *bn - 1;
	for (i__ = *r__; i__ <= i__1; ++i__) {
	    i__2 = i__;
	    if (z__[i__2].r == 0. && z__[i__2].i == 0.) {
		i__2 = i__ + 1;
		d__1 = -(ld[i__ - 1] / ld[i__]);
		i__3 = i__ - 1;
		z__1.r = d__1 * z__[i__3].r, z__1.i = d__1 * z__[i__3].i;
		z__[i__2].r = z__1.r, z__[i__2].i = z__1.i;
	    } else {
		i__2 = i__ + 1;
		i__3 = indumn + i__;
		i__4 = i__;
		z__2.r = work[i__3] * z__[i__4].r, z__2.i = work[i__3] * z__[
			i__4].i;
		z__1.r = -z__2.r, z__1.i = -z__2.i;
		z__[i__2].r = z__1.r, z__[i__2].i = z__1.i;
	    }
	    if ((z_abs(&z__[i__]) + z_abs(&z__[i__ + 1])) * (d__1 = ld[i__], 
		    abs(d__1)) < *gaptol) {
		i__2 = i__ + 1;
		z__[i__2].r = 0., z__[i__2].i = 0.;
		isuppz[2] = i__;
		goto L280;
	    }
	    i__2 = i__ + 1;
	    i__3 = i__ + 1;
	    z__1.r = z__[i__2].r * z__[i__3].r - z__[i__2].i * z__[i__3].i, 
		    z__1.i = z__[i__2].r * z__[i__3].i + z__[i__2].i * z__[
		    i__3].r;
	    *ztz += z__1.r;
	}
L280:
	;
    }


    tmp = 1. / *ztz;
    *nrminv = sqrt(tmp);
    *resid = abs(*mingma) * *nrminv;
    *rqcorr = *mingma * tmp;


return TCL_OK;


} /* zlar1v_ */
static /* Subroutine */ int zunm2l_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *k, doublecomplex *a, integer *lda, doublecomplex *tau, 	doublecomplex *c__, integer *ldc, doublecomplex *work, integer *info)
{
    integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3;
    doublecomplex z__1;

    void d_cnjg(doublecomplex *, doublecomplex *);

    integer i__, i1, i2, i3, mi, ni, nq;
    doublecomplex aii;
    logical left;
    doublecomplex taui;
    logical notran;





























    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --tau;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;
    --work;

    *info = 0;
    left = lsame_(side, "L");
    notran = lsame_(trans, "N");


    if (left) {
	nq = *m;
    } else {
	nq = *n;
    }
    if (! left && ! lsame_(side, "R")) {
	*info = -1;
    } else if (! notran && ! lsame_(trans, "C")) {
	*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);
	vectcl_xerbla(interp, "ZUNM2L", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


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

    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) {


	    mi = *m - *k + i__;
	} else {


	    ni = *n - *k + i__;
	}


	if (notran) {
	    i__3 = i__;
	    taui.r = tau[i__3].r, taui.i = tau[i__3].i;
	} else {
	    d_cnjg(&z__1, &tau[i__]);
	    taui.r = z__1.r, taui.i = z__1.i;
	}
	i__3 = nq - *k + i__ + i__ * a_dim1;
	aii.r = a[i__3].r, aii.i = a[i__3].i;
	i__3 = nq - *k + i__ + i__ * a_dim1;
	a[i__3].r = 1., a[i__3].i = 0.;
	if (zlarf_(interp, side, &mi, &ni, &a[i__ * a_dim1 + 1], &zunm2l_c__1, &taui, &c__[		c_offset], ldc, &work[1])!=TCL_OK) { return TCL_ERROR; }


	i__3 = nq - *k + i__ + i__ * a_dim1;
	a[i__3].r = aii.r, a[i__3].i = aii.i;
    }
return TCL_OK;


} /* zunm2l_ */
static /* Subroutine */ int dlanv2_ (Tcl_Interp *interp, doublereal *a, doublereal *b, doublereal *c__, 	doublereal *d__, doublereal *rt1r, doublereal *rt1i, doublereal *rt2r, 	 doublereal *rt2i, doublereal *cs, doublereal *sn)
{
    doublereal d__1, d__2;

    double d_sign(doublereal *, doublereal *), sqrt(doublereal);

    doublereal p, z__, aa, bb, cc, dd, cs1, sn1, sab, sac, eps, tau, temp, 
	    scale, bcmax, bcmis, sigma;
















    eps = dlamch_("P");
    if (*c__ == 0.) {
	*cs = 1.;
	*sn = 0.;
	goto L10;

    } else if (*b == 0.) {


	*cs = 0.;
	*sn = 1.;
	temp = *d__;
	*d__ = *a;
	*a = temp;
	*b = -(*c__);
	*c__ = 0.;
	goto L10;
    } else if (*a - *d__ == 0. && d_sign(&dlanv2_c_b4, b) != d_sign(&dlanv2_c_b4, c__)) {
	*cs = 1.;
	*sn = 0.;
	goto L10;
    } else {

	temp = *a - *d__;
	p = temp * .5;
	d__1 = abs(*b), d__2 = abs(*c__);
	bcmax = max(d__1,d__2);
	d__1 = abs(*b), d__2 = abs(*c__);
	bcmis = min(d__1,d__2) * d_sign(&dlanv2_c_b4, b) * d_sign(&dlanv2_c_b4, c__);
	d__1 = abs(p);
	scale = max(d__1,bcmax);
	z__ = p / scale * p + bcmax / scale * bcmis;


	if (z__ >= eps * 4.) {


	    d__1 = sqrt(scale) * sqrt(z__);
	    z__ = p + d_sign(&d__1, &p);
	    *a = *d__ + z__;
	    *d__ -= bcmax / z__ * bcmis;


	    tau = dlapy2_(c__, &z__);
	    *cs = z__ / tau;
	    *sn = *c__ / tau;
	    *b -= *c__;
	    *c__ = 0.;
	} else {


	    sigma = *b + *c__;
	    tau = dlapy2_(&sigma, &temp);
	    *cs = sqrt((abs(sigma) / tau + 1.) * .5);
	    *sn = -(p / (tau * *cs)) * d_sign(&dlanv2_c_b4, &sigma);


	    aa = *a * *cs + *b * *sn;
	    bb = -(*a) * *sn + *b * *cs;
	    cc = *c__ * *cs + *d__ * *sn;
	    dd = -(*c__) * *sn + *d__ * *cs;


	    *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(&dlanv2_c_b4, b) == d_sign(&dlanv2_c_b4, c__)) {


			sab = sqrt((abs(*b)));
			sac = sqrt((abs(*c__)));
			d__1 = sab * sac;
			p = d_sign(&d__1, c__);
			tau = 1. / sqrt((d__1 = *b + *c__, abs(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:


    *rt1r = *a;
    *rt2r = *d__;
    if (*c__ == 0.) {
	*rt1i = 0.;
	*rt2i = 0.;
    } else {
	*rt1i = sqrt((abs(*b))) * sqrt((abs(*c__)));
	*rt2i = -(*rt1i);
    }
return TCL_OK;


} /* dlanv2_ */
static /* Subroutine */ int dlaqr3_ (Tcl_Interp *interp, logical *wantt, logical *wantz, integer *n, 	integer *ktop, integer *kbot, integer *nw, doublereal *h__, integer *	ldh, integer *iloz, integer *ihiz, doublereal *z__, integer *ldz, 	integer *ns, integer *nd, doublereal *sr, doublereal *si, doublereal *	v, integer *ldv, integer *nh, doublereal *t, integer *ldt, integer *	nv, doublereal *wv, integer *ldwv, doublereal *work, integer *lwork)
{
    integer h_dim1, h_offset, t_dim1, t_offset, v_dim1, v_offset, wv_dim1, 
	    wv_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4;
    doublereal d__1, d__2, d__3, d__4, d__5, d__6;

    double sqrt(doublereal);

    integer i__, j, k;
    doublereal s, aa, bb, cc, dd, cs, sn;
    integer jw;
    doublereal evi, evk, foo;
    integer kln;
    doublereal tau, ulp;
    integer lwk1, lwk2, lwk3;
    doublereal beta;
    integer kend, kcol, info, nmin, ifst, ilst, ltop, krow;
    logical bulge;
    integer infqr, kwtop;
    doublereal safmin;
    doublereal safmax;
    logical sorted;
    doublereal smlnum;
    integer lwkopt;


































    h_dim1 = *ldh;
    h_offset = 1 + h_dim1;
    h__ -= h_offset;
    z_dim1 = *ldz;
    z_offset = 1 + z_dim1;
    z__ -= z_offset;
    --sr;
    --si;
    v_dim1 = *ldv;
    v_offset = 1 + v_dim1;
    v -= v_offset;
    t_dim1 = *ldt;
    t_offset = 1 + t_dim1;
    t -= t_offset;
    wv_dim1 = *ldwv;
    wv_offset = 1 + wv_dim1;
    wv -= wv_offset;
    --work;

    i__1 = *nw, i__2 = *kbot - *ktop + 1;
    jw = min(i__1,i__2);
    if (jw <= 2) {
	lwkopt = 1;
    } else {


	i__1 = jw - 1;
	if (dgehrd_(interp, &jw, &dlaqr3_c__1, &i__1, &t[t_offset], ldt, &work[1], &work[1], &		dlaqr3_c_n1, &info)!=TCL_OK) { return TCL_ERROR; }


	lwk1 = (integer) work[1];


	i__1 = jw - 1;
	if (dormhr_(interp, "R", "N", &jw, &jw, &dlaqr3_c__1, &i__1, &t[t_offset], ldt, &work[1], 		 &v[v_offset], ldv, &work[1], &dlaqr3_c_n1, &info)!=TCL_OK) { return TCL_ERROR; }


	lwk2 = (integer) work[1];


	if (dlaqr4_(interp, &dlaqr3_c_true, &dlaqr3_c_true, &jw, &dlaqr3_c__1, &jw, &t[t_offset], ldt, &sr[1], 		&si[1], &dlaqr3_c__1, &jw, &v[v_offset], ldv, &work[1], &dlaqr3_c_n1, &
		infqr)!=TCL_OK) { return TCL_ERROR; }


	lwk3 = (integer) work[1];


	i__1 = jw + max(lwk1,lwk2);
	lwkopt = max(i__1,lwk3);
    }


    if (*lwork == -1) {
	work[1] = (doublereal) lwkopt;
return TCL_OK;
    }

    *ns = 0;
    *nd = 0;
    work[1] = 1.;
    if (*ktop > *kbot) {
return TCL_OK;
    }
    if (*nw < 1) {
return TCL_OK;
    }


    safmin = dlamch_("SAFE MINIMUM");
    safmax = 1. / safmin;
    if (dlabad_(interp, &safmin, &safmax)!=TCL_OK) { return TCL_ERROR; }

    ulp = dlamch_("PRECISION");
    smlnum = safmin * ((doublereal) (*n) / ulp);


    i__1 = *nw, i__2 = *kbot - *ktop + 1;
    jw = min(i__1,i__2);
    kwtop = *kbot - jw + 1;
    if (kwtop == *ktop) {
	s = 0.;
    } else {
	s = h__[kwtop + (kwtop - 1) * h_dim1];
    }

    if (*kbot == kwtop) {


	sr[kwtop] = h__[kwtop + kwtop * h_dim1];
	si[kwtop] = 0.;
	*ns = 1;
	*nd = 0;
	d__2 = smlnum, d__3 = ulp * (d__1 = h__[kwtop + kwtop * h_dim1], abs(
		d__1));
	if (abs(s) <= max(d__2,d__3)) {
	    *ns = 0;
	    *nd = 1;
	    if (kwtop > *ktop) {
		h__[kwtop + (kwtop - 1) * h_dim1] = 0.;
	    }
	}
	work[1] = 1.;
return TCL_OK;
    }


    if (dlacpy_(interp, "U", &jw, &jw, &h__[kwtop + kwtop * h_dim1], ldh, &t[t_offset], 	    ldt)!=TCL_OK) { return TCL_ERROR; }


    i__1 = jw - 1;
    i__2 = *ldh + 1;
    i__3 = *ldt + 1;
    if (dcopy_(interp, &i__1, &h__[kwtop + 1 + kwtop * h_dim1], &i__2, &t[t_dim1 + 2], &	    i__3)!=TCL_OK) { return TCL_ERROR; }



    if (dlaset_(interp, "A", &jw, &jw, &dlaqr3_c_b17, &dlaqr3_c_b18, &v[v_offset], ldv)!=TCL_OK) { return TCL_ERROR; }

    nmin = ilaenv_(&dlaqr3_c__12, "DLAQR3", "SV", &jw, &dlaqr3_c__1, &jw, lwork);
    if (jw > nmin) {
	if (dlaqr4_(interp, &dlaqr3_c_true, &dlaqr3_c_true, &jw, &dlaqr3_c__1, &jw, &t[t_offset], ldt, &sr[		kwtop], &si[kwtop], &dlaqr3_c__1, &jw, &v[v_offset], ldv, &work[1], 
		lwork, &infqr)!=TCL_OK) { return TCL_ERROR; }


    } else {
	if (dlahqr_(interp, &dlaqr3_c_true, &dlaqr3_c_true, &jw, &dlaqr3_c__1, &jw, &t[t_offset], ldt, &sr[		kwtop], &si[kwtop], &dlaqr3_c__1, &jw, &v[v_offset], ldv, &infqr)!=TCL_OK) { return TCL_ERROR; }


    }


    i__1 = jw - 3;
    for (j = 1; j <= i__1; ++j) {
	t[j + 2 + j * t_dim1] = 0.;
	t[j + 3 + j * t_dim1] = 0.;
    }
    if (jw > 2) {
	t[jw + (jw - 2) * t_dim1] = 0.;
    }


    *ns = jw;
    ilst = infqr + 1;
L20:
    if (ilst <= *ns) {
	if (*ns == 1) {
	    bulge = FALSE_;
	} else {
	    bulge = t[*ns + (*ns - 1) * t_dim1] != 0.;
	}


	if (! bulge) {


	    foo = (d__1 = t[*ns + *ns * t_dim1], abs(d__1));
	    if (foo == 0.) {
		foo = abs(s);
	    }
	    d__2 = smlnum, d__3 = ulp * foo;
	    if ((d__1 = s * v[*ns * v_dim1 + 1], abs(d__1)) <= max(d__2,d__3))
		     {


		--(*ns);
	    } else {


		ifst = *ns;
		if (dtrexc_(interp, "V", &jw, &t[t_offset], ldt, &v[v_offset], ldv, &ifst, 			 &ilst, &work[1], &info)!=TCL_OK) { return TCL_ERROR; }


		++ilst;
	    }
	} else {


	    foo = (d__3 = t[*ns + *ns * t_dim1], abs(d__3)) + sqrt((d__1 = t[*
		    ns + (*ns - 1) * t_dim1], abs(d__1))) * sqrt((d__2 = t[*
		    ns - 1 + *ns * t_dim1], abs(d__2)));
	    if (foo == 0.) {
		foo = abs(s);
	    }
	    d__3 = (d__1 = s * v[*ns * v_dim1 + 1], abs(d__1)), d__4 = (d__2 =
		     s * v[(*ns - 1) * v_dim1 + 1], abs(d__2));
	    d__5 = smlnum, d__6 = ulp * foo;
	    if (max(d__3,d__4) <= max(d__5,d__6)) {


		*ns += -2;
	    } else {


		ifst = *ns;
		if (dtrexc_(interp, "V", &jw, &t[t_offset], ldt, &v[v_offset], ldv, &ifst, 			 &ilst, &work[1], &info)!=TCL_OK) { return TCL_ERROR; }


		ilst += 2;
	    }
	}


	goto L20;
    }


    if (*ns == 0) {
	s = 0.;
    }

    if (*ns < jw) {


	sorted = FALSE_;
	i__ = *ns + 1;
L30:
	if (sorted) {
	    goto L50;
	}
	sorted = TRUE_;

	kend = i__ - 1;
	i__ = infqr + 1;
	if (i__ == *ns) {
	    k = i__ + 1;
	} else if (t[i__ + 1 + i__ * t_dim1] == 0.) {
	    k = i__ + 1;
	} else {
	    k = i__ + 2;
	}
L40:
	if (k <= kend) {
	    if (k == i__ + 1) {
		evi = (d__1 = t[i__ + i__ * t_dim1], abs(d__1));
	    } else {
		evi = (d__3 = t[i__ + i__ * t_dim1], abs(d__3)) + sqrt((d__1 =
			 t[i__ + 1 + i__ * t_dim1], abs(d__1))) * sqrt((d__2 =
			 t[i__ + (i__ + 1) * t_dim1], abs(d__2)));
	    }

	    if (k == kend) {
		evk = (d__1 = t[k + k * t_dim1], abs(d__1));
	    } else if (t[k + 1 + k * t_dim1] == 0.) {
		evk = (d__1 = t[k + k * t_dim1], abs(d__1));
	    } else {
		evk = (d__3 = t[k + k * t_dim1], abs(d__3)) + sqrt((d__1 = t[
			k + 1 + k * t_dim1], abs(d__1))) * sqrt((d__2 = t[k + 
			(k + 1) * t_dim1], abs(d__2)));
	    }

	    if (evi >= evk) {
		i__ = k;
	    } else {
		sorted = FALSE_;
		ifst = i__;
		ilst = k;
		if (dtrexc_(interp, "V", &jw, &t[t_offset], ldt, &v[v_offset], ldv, &ifst, 			 &ilst, &work[1], &info)!=TCL_OK) { return TCL_ERROR; }


		if (info == 0) {
		    i__ = ilst;
		} else {
		    i__ = k;
		}
	    }
	    if (i__ == kend) {
		k = i__ + 1;
	    } else if (t[i__ + 1 + i__ * t_dim1] == 0.) {
		k = i__ + 1;
	    } else {
		k = i__ + 2;
	    }
	    goto L40;
	}
	goto L30;
L50:
	;
    }


    i__ = jw;
L60:
    if (i__ >= infqr + 1) {
	if (i__ == infqr + 1) {
	    sr[kwtop + i__ - 1] = t[i__ + i__ * t_dim1];
	    si[kwtop + i__ - 1] = 0.;
	    --i__;
	} else if (t[i__ + (i__ - 1) * t_dim1] == 0.) {
	    sr[kwtop + i__ - 1] = t[i__ + i__ * t_dim1];
	    si[kwtop + i__ - 1] = 0.;
	    --i__;
	} else {
	    aa = t[i__ - 1 + (i__ - 1) * t_dim1];
	    cc = t[i__ + (i__ - 1) * t_dim1];
	    bb = t[i__ - 1 + i__ * t_dim1];
	    dd = t[i__ + i__ * t_dim1];
	    if (dlanv2_(interp, &aa, &bb, &cc, &dd, &sr[kwtop + i__ - 2], &si[kwtop + i__ 		    - 2], &sr[kwtop + i__ - 1], &si[kwtop + i__ - 1], &cs, &
		    sn)!=TCL_OK) { return TCL_ERROR; }


	    i__ += -2;
	}
	goto L60;
    }

    if (*ns < jw || s == 0.) {
	if (*ns > 1 && s != 0.) {


	    if (dcopy_(interp, ns, &v[v_offset], ldv, &work[1], &dlaqr3_c__1)!=TCL_OK) { return TCL_ERROR; }

	    beta = work[1];
	    if (dlarfg_(interp, ns, &beta, &work[2], &dlaqr3_c__1, &tau)!=TCL_OK) { return TCL_ERROR; }

	    work[1] = 1.;

	    i__1 = jw - 2;
	    i__2 = jw - 2;
	    if (dlaset_(interp, "L", &i__1, &i__2, &dlaqr3_c_b17, &dlaqr3_c_b17, &t[t_dim1 + 3], ldt)!=TCL_OK) { return TCL_ERROR; }


	    if (dlarf_(interp, "L", ns, &jw, &work[1], &dlaqr3_c__1, &tau, &t[t_offset], ldt, &		    work[jw + 1])!=TCL_OK) { return TCL_ERROR; }


	    if (dlarf_(interp, "R", ns, ns, &work[1], &dlaqr3_c__1, &tau, &t[t_offset], ldt, &		    work[jw + 1])!=TCL_OK) { return TCL_ERROR; }


	    if (dlarf_(interp, "R", &jw, ns, &work[1], &dlaqr3_c__1, &tau, &v[v_offset], ldv, &		    work[jw + 1])!=TCL_OK) { return TCL_ERROR; }



	    i__1 = *lwork - jw;
	    if (dgehrd_(interp, &jw, &dlaqr3_c__1, ns, &t[t_offset], ldt, &work[1], &work[jw + 1], &i__1, &info)!=TCL_OK) { return TCL_ERROR; }


	}


	if (kwtop > 1) {
	    h__[kwtop + (kwtop - 1) * h_dim1] = s * v[v_dim1 + 1];
	}
	if (dlacpy_(interp, "U", &jw, &jw, &t[t_offset], ldt, &h__[kwtop + kwtop * h_dim1], ldh)!=TCL_OK) { return TCL_ERROR; }


	i__1 = jw - 1;
	i__2 = *ldt + 1;
	i__3 = *ldh + 1;
	if (dcopy_(interp, &i__1, &t[t_dim1 + 2], &i__2, &h__[kwtop + 1 + kwtop * h_dim1], 		 &i__3)!=TCL_OK) { return TCL_ERROR; }




	if (*ns > 1 && s != 0.) {
	    i__1 = *lwork - jw;
	    if (dormhr_(interp, "R", "N", &jw, ns, &dlaqr3_c__1, ns, &t[t_offset], ldt, &work[1], 		     &v[v_offset], ldv, &work[jw + 1], &i__1, &info)!=TCL_OK) { return TCL_ERROR; }


	}


	if (*wantt) {
	    ltop = 1;
	} else {
	    ltop = *ktop;
	}
	i__1 = kwtop - 1;
	i__2 = *nv;
	for (krow = ltop; i__2 < 0 ? krow >= i__1 : krow <= i__1; krow += 
		i__2) {
	    i__3 = *nv, i__4 = kwtop - krow;
	    kln = min(i__3,i__4);
	    if (dgemm_(interp, "N", "N", &kln, &jw, &jw, &dlaqr3_c_b18, &h__[krow + kwtop * 		    h_dim1], ldh, &v[v_offset], ldv, &dlaqr3_c_b17, &wv[wv_offset], 
		    ldwv)!=TCL_OK) { return TCL_ERROR; }


	    if (dlacpy_(interp, "A", &kln, &jw, &wv[wv_offset], ldwv, &h__[krow + kwtop * 		    h_dim1], ldh)!=TCL_OK) { return TCL_ERROR; }


	}


	if (*wantt) {
	    i__2 = *n;
	    i__1 = *nh;
	    for (kcol = *kbot + 1; i__1 < 0 ? kcol >= i__2 : kcol <= i__2; 
		    kcol += i__1) {
		i__3 = *nh, i__4 = *n - kcol + 1;
		kln = min(i__3,i__4);
		if (dgemm_(interp, "C", "N", &jw, &kln, &jw, &dlaqr3_c_b18, &v[v_offset], ldv, &			h__[kwtop + kcol * h_dim1], ldh, &dlaqr3_c_b17, &t[t_offset], 
			 ldt)!=TCL_OK) { return TCL_ERROR; }


		if (dlacpy_(interp, "A", &jw, &kln, &t[t_offset], ldt, &h__[kwtop + kcol *			 h_dim1], ldh)!=TCL_OK) { return TCL_ERROR; }


	    }
	}


	if (*wantz) {
	    i__1 = *ihiz;
	    i__2 = *nv;
	    for (krow = *iloz; i__2 < 0 ? krow >= i__1 : krow <= i__1; krow +=
		     i__2) {
		i__3 = *nv, i__4 = *ihiz - krow + 1;
		kln = min(i__3,i__4);
		if (dgemm_(interp, "N", "N", &kln, &jw, &jw, &dlaqr3_c_b18, &z__[krow + kwtop * 			z_dim1], ldz, &v[v_offset], ldv, &dlaqr3_c_b17, &wv[
			wv_offset], ldwv)!=TCL_OK) { return TCL_ERROR; }


		if (dlacpy_(interp, "A", &kln, &jw, &wv[wv_offset], ldwv, &z__[krow + 			kwtop * z_dim1], ldz)!=TCL_OK) { return TCL_ERROR; }


	    }
	}
    }


    *nd = jw - *ns;


    *ns -= infqr;


    work[1] = (doublereal) lwkopt;


return TCL_OK;
} /* dlaqr3_ */
static /* Subroutine */ int dlaqr4_ (Tcl_Interp *interp, logical *wantt, logical *wantz, integer *n, 	integer *ilo, integer *ihi, doublereal *h__, integer *ldh, doublereal 	*wr, doublereal *wi, integer *iloz, integer *ihiz, doublereal *z__, 	integer *ldz, doublereal *work, integer *lwork, integer *info)
{
    integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4, i__5;
    doublereal d__1, d__2, d__3, d__4;

    integer i__, k;
    doublereal aa, bb, cc, dd;
    integer ld;
    doublereal cs;
    integer nh, it, ks, kt;
    doublereal sn;
    integer ku, kv, ls, ns;
    doublereal ss;
    integer nw, inf, kdu, nho, nve, kwh, nsr, nwr, kwv, ndec, ndfl, kbot, 
	    nmin;
    doublereal swap;
    integer ktop;
    doublereal zdum[1]	/* was [1][1] */;
    integer kacc22, itmax, nsmax, nwmax, kwtop;
    integer nibble;
    char jbcmpz[1];
    integer nwupbd;
    logical sorted;
    integer lwkopt;








































    h_dim1 = *ldh;
    h_offset = 1 + h_dim1;
    h__ -= h_offset;
    --wr;
    --wi;
    z_dim1 = *ldz;
    z_offset = 1 + z_dim1;
    z__ -= z_offset;
    --work;

    *info = 0;


    if (*n == 0) {
	work[1] = 1.;
return TCL_OK;
    }

    if (*n <= 11) {


	lwkopt = 1;
	if (*lwork != -1) {
	    if (dlahqr_(interp, wantt, wantz, n, ilo, ihi, &h__[h_offset], ldh, &wr[1], &		    wi[1], iloz, ihiz, &z__[z_offset], ldz, info)!=TCL_OK) { return TCL_ERROR; }


	}
    } else {



	*info = 0;


	if (*wantt) {
	    *(unsigned char *)jbcmpz = 'S';
	} else {
	    *(unsigned char *)jbcmpz = 'E';
	}
	if (*wantz) {
	    *(unsigned char *)&jbcmpz[1] = 'V';
	} else {
	    *(unsigned char *)&jbcmpz[1] = 'N';
	}


	nwr = ilaenv_(&dlaqr4_c__13, "DLAQR4", jbcmpz, n, ilo, ihi, lwork);
	nwr = max(2,nwr);
	i__1 = *ihi - *ilo + 1, i__2 = (*n - 1) / 3, i__1 = min(i__1,i__2);
	nwr = min(i__1,nwr);


	nsr = ilaenv_(&dlaqr4_c__15, "DLAQR4", jbcmpz, n, ilo, ihi, lwork);
	i__1 = nsr, i__2 = (*n + 6) / 9, i__1 = min(i__1,i__2), i__2 = *ihi - 
		*ilo;
	nsr = min(i__1,i__2);
	i__1 = 2, i__2 = nsr - nsr % 2;
	nsr = max(i__1,i__2);



	i__1 = nwr + 1;
	if (dlaqr2_(interp, wantt, wantz, n, ilo, ihi, &i__1, &h__[h_offset], ldh, iloz, 		ihiz, &z__[z_offset], ldz, &ls, &ld, &wr[1], &wi[1], &h__[
		h_offset], ldh, n, &h__[h_offset], ldh, n, &h__[h_offset], 
		ldh, &work[1], &dlaqr4_c_n1)!=TCL_OK) { return TCL_ERROR; }




	i__1 = nsr * 3 / 2, i__2 = (integer) work[1];
	lwkopt = max(i__1,i__2);


	if (*lwork == -1) {
	    work[1] = (doublereal) lwkopt;
return TCL_OK;
	}


	nmin = ilaenv_(&dlaqr4_c__12, "DLAQR4", jbcmpz, n, ilo, ihi, lwork);
	nmin = max(11,nmin);


	nibble = ilaenv_(&dlaqr4_c__14, "DLAQR4", jbcmpz, n, ilo, ihi, lwork);
	nibble = max(0,nibble);


	kacc22 = ilaenv_(&dlaqr4_c__16, "DLAQR4", jbcmpz, n, ilo, ihi, lwork);
	kacc22 = max(0,kacc22);
	kacc22 = min(2,kacc22);


	i__1 = (*n - 1) / 3, i__2 = *lwork / 2;
	nwmax = min(i__1,i__2);
	nw = nwmax;


	i__1 = (*n + 6) / 9, i__2 = (*lwork << 1) / 3;
	nsmax = min(i__1,i__2);
	nsmax -= nsmax % 2;


	ndfl = 1;


	i__1 = 10, i__2 = *ihi - *ilo + 1;
	itmax = max(i__1,i__2) * 30;


	kbot = *ihi;


	i__1 = itmax;
	for (it = 1; it <= i__1; ++it) {


	    if (kbot < *ilo) {
		goto L90;
	    }


	    i__2 = *ilo + 1;
	    for (k = kbot; k >= i__2; --k) {
		if (h__[k + (k - 1) * h_dim1] == 0.) {
		    goto L20;
		}
	    }
	    k = *ilo;
L20:
	    ktop = k;


	    nh = kbot - ktop + 1;
	    nwupbd = min(nh,nwmax);
	    if (ndfl < 5) {
		nw = min(nwupbd,nwr);
	    } else {
		i__2 = nwupbd, i__3 = nw << 1;
		nw = min(i__2,i__3);
	    }
	    if (nw < nwmax) {
		if (nw >= nh - 1) {
		    nw = nh;
		} else {
		    kwtop = kbot - nw + 1;
		    if ((d__1 = h__[kwtop + (kwtop - 1) * h_dim1], abs(d__1)) 
			    > (d__2 = h__[kwtop - 1 + (kwtop - 2) * h_dim1], 
			    abs(d__2))) {
			++nw;
		    }
		}
	    }
	    if (ndfl < 5) {
		ndec = -1;
	    } else if (ndec >= 0 || nw >= nwupbd) {
		++ndec;
		if (nw - ndec < 2) {
		    ndec = 0;
		}
		nw -= ndec;
	    }


	    kv = *n - nw + 1;
	    kt = nw + 1;
	    nho = *n - nw - 1 - kt + 1;
	    kwv = nw + 2;
	    nve = *n - nw - kwv + 1;


	    if (dlaqr2_(interp, wantt, wantz, n, &ktop, &kbot, &nw, &h__[h_offset], ldh, 		    iloz, ihiz, &z__[z_offset], ldz, &ls, &ld, &wr[1], &wi[1], 
		     &h__[kv + h_dim1], ldh, &nho, &h__[kv + kt * h_dim1], 
		    ldh, &nve, &h__[kwv + h_dim1], ldh, &work[1], lwork)!=TCL_OK) { return TCL_ERROR; }




	    kbot -= ld;


	    ks = kbot - ls + 1;


	    if (ld == 0 || ld * 100 <= nw * nibble && kbot - ktop + 1 > min(
		    nmin,nwmax)) {


		i__4 = 2, i__5 = kbot - ktop;
		i__2 = min(nsmax,nsr), i__3 = max(i__4,i__5);
		ns = min(i__2,i__3);
		ns -= ns % 2;


		if (ndfl % 6 == 0) {
		    ks = kbot - ns + 1;
		    i__3 = ks + 1, i__4 = ktop + 2;
		    i__2 = max(i__3,i__4);
		    for (i__ = kbot; i__ >= i__2; i__ += -2) {
			ss = (d__1 = h__[i__ + (i__ - 1) * h_dim1], abs(d__1))
				 + (d__2 = h__[i__ - 1 + (i__ - 2) * h_dim1], 
				abs(d__2));
			aa = ss * .75 + h__[i__ + i__ * h_dim1];
			bb = ss;
			cc = ss * -.4375;
			dd = aa;
			if (dlanv2_(interp, &aa, &bb, &cc, &dd, &wr[i__ - 1], &wi[i__ - 1], &wr[i__], &wi[i__], &cs, &sn)!=TCL_OK) { return TCL_ERROR; }


		    }
		    if (ks == ktop) {
			wr[ks + 1] = h__[ks + 1 + (ks + 1) * h_dim1];
			wi[ks + 1] = 0.;
			wr[ks] = wr[ks + 1];
			wi[ks] = wi[ks + 1];
		    }
		} else {


		    if (kbot - ks + 1 <= ns / 2) {
			ks = kbot - ns + 1;
			kt = *n - ns + 1;
			if (dlacpy_(interp, "A", &ns, &ns, &h__[ks + ks * h_dim1], ldh, &				h__[kt + h_dim1], ldh)!=TCL_OK) { return TCL_ERROR; }


			if (dlahqr_(interp, &dlaqr4_c_false, &dlaqr4_c_false, &ns, &dlaqr4_c__1, &ns, &h__[kt 				+ h_dim1], ldh, &wr[ks], &wi[ks], &dlaqr4_c__1, &
				dlaqr4_c__1, zdum, &dlaqr4_c__1, &inf)!=TCL_OK) { return TCL_ERROR; }


			ks += inf;


			if (ks >= kbot) {
			    aa = h__[kbot - 1 + (kbot - 1) * h_dim1];
			    cc = h__[kbot + (kbot - 1) * h_dim1];
			    bb = h__[kbot - 1 + kbot * h_dim1];
			    dd = h__[kbot + kbot * h_dim1];
			    if (dlanv2_(interp, &aa, &bb, &cc, &dd, &wr[kbot - 1], &wi[				    kbot - 1], &wr[kbot], &wi[kbot], &cs, &sn)
				    !=TCL_OK) { return TCL_ERROR; }


			    ks = kbot - 1;
			}
		    }

		    if (kbot - ks + 1 > ns) {


			sorted = FALSE_;
			i__2 = ks + 1;
			for (k = kbot; k >= i__2; --k) {
			    if (sorted) {
				goto L60;
			    }
			    sorted = TRUE_;
			    i__3 = k - 1;
			    for (i__ = ks; i__ <= i__3; ++i__) {
				if ((d__1 = wr[i__], abs(d__1)) + (d__2 = wi[
					i__], abs(d__2)) < (d__3 = wr[i__ + 1]
					, abs(d__3)) + (d__4 = wi[i__ + 1], 
					abs(d__4))) {
				    sorted = FALSE_;

				    swap = wr[i__];
				    wr[i__] = wr[i__ + 1];
				    wr[i__ + 1] = swap;

				    swap = wi[i__];
				    wi[i__] = wi[i__ + 1];
				    wi[i__ + 1] = swap;
				}
			    }
			}
L60:
			;
		    }


		    i__2 = ks + 2;
		    for (i__ = kbot; i__ >= i__2; i__ += -2) {
			if (wi[i__] != -wi[i__ - 1]) {

			    swap = wr[i__];
			    wr[i__] = wr[i__ - 1];
			    wr[i__ - 1] = wr[i__ - 2];
			    wr[i__ - 2] = swap;

			    swap = wi[i__];
			    wi[i__] = wi[i__ - 1];
			    wi[i__ - 1] = wi[i__ - 2];
			    wi[i__ - 2] = swap;
			}
		    }
		}


		if (kbot - ks + 1 == 2) {
		    if (wi[kbot] == 0.) {
			if ((d__1 = wr[kbot] - h__[kbot + kbot * h_dim1], abs(
				d__1)) < (d__2 = wr[kbot - 1] - h__[kbot + 
				kbot * h_dim1], abs(d__2))) {
			    wr[kbot - 1] = wr[kbot];
			} else {
			    wr[kbot] = wr[kbot - 1];
			}
		    }
		}


		i__2 = ns, i__3 = kbot - ks + 1;
		ns = min(i__2,i__3);
		ns -= ns % 2;
		ks = kbot - ns + 1;


		kdu = ns * 3 - 3;
		ku = *n - kdu + 1;
		kwh = kdu + 1;
		nho = *n - kdu - 3 - (kdu + 1) + 1;
		kwv = kdu + 4;
		nve = *n - kdu - kwv + 1;


		if (dlaqr5_(interp, wantt, wantz, &kacc22, n, &ktop, &kbot, &ns, &wr[ks], 			&wi[ks], &h__[h_offset], ldh, iloz, ihiz, &z__[
			z_offset], ldz, &work[1], &dlaqr4_c__3, &h__[ku + h_dim1], 
			ldh, &nve, &h__[kwv + h_dim1], ldh, &nho, &h__[ku + 
			kwh * h_dim1], ldh)!=TCL_OK) { return TCL_ERROR; }


	    }


	    if (ld > 0) {
		ndfl = 1;
	    } else {
		++ndfl;
	    }

	}


	*info = kbot;
L90:
	;
    }


    work[1] = (doublereal) lwkopt;


return TCL_OK;
} /* dlaqr4_ */
static /* Subroutine */ int dlaqr5_ (Tcl_Interp *interp, logical *wantt, logical *wantz, integer *kacc22, 	integer *n, integer *ktop, integer *kbot, integer *nshfts, doublereal 	*sr, doublereal *si, doublereal *h__, integer *ldh, integer *iloz, 	integer *ihiz, doublereal *z__, integer *ldz, doublereal *v, integer *	ldv, doublereal *u, integer *ldu, integer *nv, doublereal *wv, 	integer *ldwv, integer *nh, doublereal *wh, integer *ldwh)
{
    integer h_dim1, h_offset, u_dim1, u_offset, v_dim1, v_offset, wh_dim1, 
	    wh_offset, wv_dim1, wv_offset, z_dim1, z_offset, i__1, i__2, i__3,
	     i__4, i__5, i__6, i__7;
    doublereal d__1, d__2, d__3, d__4, d__5;

    integer i__, j, k, m, i2, j2, i4, j4, k1;
    doublereal h11, h12, h21, h22;
    integer m22, ns, nu;
    doublereal vt[3], scl;
    integer kdu, kms;
    doublereal ulp;
    integer knz, kzs;
    doublereal tst1, tst2, beta;
    logical blk22, bmp22;
    integer mend, jcol, jlen, jbot, mbot;
    doublereal swap;
    integer jtop, jrow, mtop;
    doublereal alpha;
    logical accum;
    integer ndcol, incol, krcol, nbmps;
    doublereal safmin;
    doublereal safmax, refsum;
    integer mstart;
    doublereal smlnum;

































    --sr;
    --si;
    h_dim1 = *ldh;
    h_offset = 1 + h_dim1;
    h__ -= h_offset;
    z_dim1 = *ldz;
    z_offset = 1 + z_dim1;
    z__ -= z_offset;
    v_dim1 = *ldv;
    v_offset = 1 + v_dim1;
    v -= v_offset;
    u_dim1 = *ldu;
    u_offset = 1 + u_dim1;
    u -= u_offset;
    wv_dim1 = *ldwv;
    wv_offset = 1 + wv_dim1;
    wv -= wv_offset;
    wh_dim1 = *ldwh;
    wh_offset = 1 + wh_dim1;
    wh -= wh_offset;

    if (*nshfts < 2) {
return TCL_OK;
    }


    if (*ktop >= *kbot) {
return TCL_OK;
    }


    i__1 = *nshfts - 2;
    for (i__ = 1; i__ <= i__1; i__ += 2) {
	if (si[i__] != -si[i__ + 1]) {

	    swap = sr[i__];
	    sr[i__] = sr[i__ + 1];
	    sr[i__ + 1] = sr[i__ + 2];
	    sr[i__ + 2] = swap;

	    swap = si[i__];
	    si[i__] = si[i__ + 1];
	    si[i__ + 1] = si[i__ + 2];
	    si[i__ + 2] = swap;
	}
    }


    ns = *nshfts - *nshfts % 2;


    safmin = dlamch_("SAFE MINIMUM");
    safmax = 1. / safmin;
    if (dlabad_(interp, &safmin, &safmax)!=TCL_OK) { return TCL_ERROR; }

    ulp = dlamch_("PRECISION");
    smlnum = safmin * ((doublereal) (*n) / ulp);


    accum = *kacc22 == 1 || *kacc22 == 2;


    blk22 = ns > 2 && *kacc22 == 2;


    if (*ktop + 2 <= *kbot) {
	h__[*ktop + 2 + *ktop * h_dim1] = 0.;
    }


    nbmps = ns / 2;


    kdu = nbmps * 6 - 3;


    i__1 = *kbot - 2;
    i__2 = nbmps * 3 - 2;
    for (incol = (1 - nbmps) * 3 + *ktop - 1; i__2 < 0 ? incol >= i__1 : 
	    incol <= i__1; incol += i__2) {
	ndcol = incol + kdu;
	if (accum) {
	    if (dlaset_(interp, "ALL", &kdu, &kdu, &dlaqr5_c_b7, &dlaqr5_c_b8, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }

	}


	i__4 = incol + nbmps * 3 - 3, i__5 = *kbot - 2;
	i__3 = min(i__4,i__5);
	for (krcol = incol; krcol <= i__3; ++krcol) {


	    i__4 = 1, i__5 = (*ktop - 1 - krcol + 2) / 3 + 1;
	    mtop = max(i__4,i__5);
	    i__4 = nbmps, i__5 = (*kbot - krcol) / 3;
	    mbot = min(i__4,i__5);
	    m22 = mbot + 1;
	    bmp22 = mbot < nbmps && krcol + (m22 - 1) * 3 == *kbot - 2;


	    i__4 = mbot;
	    for (m = mtop; m <= i__4; ++m) {
		k = krcol + (m - 1) * 3;
		if (k == *ktop - 1) {
		    if (dlaqr1_(interp, &dlaqr5_c__3, &h__[*ktop + *ktop * h_dim1], ldh, &sr[(m 			    << 1) - 1], &si[(m << 1) - 1], &sr[m * 2], &si[m *
			     2], &v[m * v_dim1 + 1])!=TCL_OK) { return TCL_ERROR; }


		    alpha = v[m * v_dim1 + 1];
		    if (dlarfg_(interp, &dlaqr5_c__3, &alpha, &v[m * v_dim1 + 2], &dlaqr5_c__1, &v[m * 			    v_dim1 + 1])!=TCL_OK) { return TCL_ERROR; }


		} else {
		    beta = h__[k + 1 + k * h_dim1];
		    v[m * v_dim1 + 2] = h__[k + 2 + k * h_dim1];
		    v[m * v_dim1 + 3] = h__[k + 3 + k * h_dim1];
		    if (dlarfg_(interp, &dlaqr5_c__3, &beta, &v[m * v_dim1 + 2], &dlaqr5_c__1, &v[m * 			    v_dim1 + 1])!=TCL_OK) { return TCL_ERROR; }




		    if (h__[k + 3 + k * h_dim1] != 0. || h__[k + 3 + (k + 1) *
			     h_dim1] != 0. || h__[k + 3 + (k + 2) * h_dim1] ==
			     0.) {


			h__[k + 1 + k * h_dim1] = beta;
			h__[k + 2 + k * h_dim1] = 0.;
			h__[k + 3 + k * h_dim1] = 0.;
		    } else {


			if (dlaqr1_(interp, &dlaqr5_c__3, &h__[k + 1 + (k + 1) * h_dim1], ldh, &				sr[(m << 1) - 1], &si[(m << 1) - 1], &sr[m * 
				2], &si[m * 2], vt)!=TCL_OK) { return TCL_ERROR; }


			alpha = vt[0];
			if (dlarfg_(interp, &dlaqr5_c__3, &alpha, &vt[1], &dlaqr5_c__1, vt)!=TCL_OK) { return TCL_ERROR; }

			refsum = vt[0] * (h__[k + 1 + k * h_dim1] + vt[1] * 
				h__[k + 2 + k * h_dim1]);

			if ((d__1 = h__[k + 2 + k * h_dim1] - refsum * vt[1], 
				abs(d__1)) + (d__2 = refsum * vt[2], abs(d__2)
				) > ulp * ((d__3 = h__[k + k * h_dim1], abs(
				d__3)) + (d__4 = h__[k + 1 + (k + 1) * h_dim1]
				, abs(d__4)) + (d__5 = h__[k + 2 + (k + 2) * 
				h_dim1], abs(d__5)))) {


			    h__[k + 1 + k * h_dim1] = beta;
			    h__[k + 2 + k * h_dim1] = 0.;
			    h__[k + 3 + k * h_dim1] = 0.;
			} else {


			    h__[k + 1 + k * h_dim1] -= refsum;
			    h__[k + 2 + k * h_dim1] = 0.;
			    h__[k + 3 + k * h_dim1] = 0.;
			    v[m * v_dim1 + 1] = vt[0];
			    v[m * v_dim1 + 2] = vt[1];
			    v[m * v_dim1 + 3] = vt[2];
			}
		    }
		}
	    }


	    k = krcol + (m22 - 1) * 3;
	    if (bmp22) {
		if (k == *ktop - 1) {
		    if (dlaqr1_(interp, &dlaqr5_c__2, &h__[k + 1 + (k + 1) * h_dim1], ldh, &sr[(			    m22 << 1) - 1], &si[(m22 << 1) - 1], &sr[m22 * 2], 
			     &si[m22 * 2], &v[m22 * v_dim1 + 1])!=TCL_OK) { return TCL_ERROR; }


		    beta = v[m22 * v_dim1 + 1];
		    if (dlarfg_(interp, &dlaqr5_c__2, &beta, &v[m22 * v_dim1 + 2], &dlaqr5_c__1, &v[m22 			    * v_dim1 + 1])!=TCL_OK) { return TCL_ERROR; }


		} else {
		    beta = h__[k + 1 + k * h_dim1];
		    v[m22 * v_dim1 + 2] = h__[k + 2 + k * h_dim1];
		    if (dlarfg_(interp, &dlaqr5_c__2, &beta, &v[m22 * v_dim1 + 2], &dlaqr5_c__1, &v[m22 			    * v_dim1 + 1])!=TCL_OK) { return TCL_ERROR; }


		    h__[k + 1 + k * h_dim1] = beta;
		    h__[k + 2 + k * h_dim1] = 0.;
		}
	    }


	    if (accum) {
		jbot = min(ndcol,*kbot);
	    } else if (*wantt) {
		jbot = *n;
	    } else {
		jbot = *kbot;
	    }
	    i__4 = jbot;
	    for (j = max(*ktop,krcol); j <= i__4; ++j) {
		i__5 = mbot, i__6 = (j - krcol + 2) / 3;
		mend = min(i__5,i__6);
		i__5 = mend;
		for (m = mtop; m <= i__5; ++m) {
		    k = krcol + (m - 1) * 3;
		    refsum = v[m * v_dim1 + 1] * (h__[k + 1 + j * h_dim1] + v[
			    m * v_dim1 + 2] * h__[k + 2 + j * h_dim1] + v[m * 
			    v_dim1 + 3] * h__[k + 3 + j * h_dim1]);
		    h__[k + 1 + j * h_dim1] -= refsum;
		    h__[k + 2 + j * h_dim1] -= refsum * v[m * v_dim1 + 2];
		    h__[k + 3 + j * h_dim1] -= refsum * v[m * v_dim1 + 3];
		}
	    }
	    if (bmp22) {
		k = krcol + (m22 - 1) * 3;
		i__4 = k + 1;
		i__5 = jbot;
		for (j = max(i__4,*ktop); j <= i__5; ++j) {
		    refsum = v[m22 * v_dim1 + 1] * (h__[k + 1 + j * h_dim1] + 
			    v[m22 * v_dim1 + 2] * h__[k + 2 + j * h_dim1]);
		    h__[k + 1 + j * h_dim1] -= refsum;
		    h__[k + 2 + j * h_dim1] -= refsum * v[m22 * v_dim1 + 2];
		}
	    }


	    if (accum) {
		jtop = max(*ktop,incol);
	    } else if (*wantt) {
		jtop = 1;
	    } else {
		jtop = *ktop;
	    }
	    i__5 = mbot;
	    for (m = mtop; m <= i__5; ++m) {
		if (v[m * v_dim1 + 1] != 0.) {
		    k = krcol + (m - 1) * 3;
		    i__6 = *kbot, i__7 = k + 3;
		    i__4 = min(i__6,i__7);
		    for (j = jtop; j <= i__4; ++j) {
			refsum = v[m * v_dim1 + 1] * (h__[j + (k + 1) * 
				h_dim1] + v[m * v_dim1 + 2] * h__[j + (k + 2) 
				* h_dim1] + v[m * v_dim1 + 3] * h__[j + (k + 
				3) * h_dim1]);
			h__[j + (k + 1) * h_dim1] -= refsum;
			h__[j + (k + 2) * h_dim1] -= refsum * v[m * v_dim1 + 
				2];
			h__[j + (k + 3) * h_dim1] -= refsum * v[m * v_dim1 + 
				3];
		    }

		    if (accum) {


			kms = k - incol;
			i__4 = 1, i__6 = *ktop - incol;
			i__7 = kdu;
			for (j = max(i__4,i__6); j <= i__7; ++j) {
			    refsum = v[m * v_dim1 + 1] * (u[j + (kms + 1) * 
				    u_dim1] + v[m * v_dim1 + 2] * u[j + (kms 
				    + 2) * u_dim1] + v[m * v_dim1 + 3] * u[j 
				    + (kms + 3) * u_dim1]);
			    u[j + (kms + 1) * u_dim1] -= refsum;
			    u[j + (kms + 2) * u_dim1] -= refsum * v[m * 
				    v_dim1 + 2];
			    u[j + (kms + 3) * u_dim1] -= refsum * v[m * 
				    v_dim1 + 3];
			}
		    } else if (*wantz) {


			i__7 = *ihiz;
			for (j = *iloz; j <= i__7; ++j) {
			    refsum = v[m * v_dim1 + 1] * (z__[j + (k + 1) * 
				    z_dim1] + v[m * v_dim1 + 2] * z__[j + (k 
				    + 2) * z_dim1] + v[m * v_dim1 + 3] * z__[
				    j + (k + 3) * z_dim1]);
			    z__[j + (k + 1) * z_dim1] -= refsum;
			    z__[j + (k + 2) * z_dim1] -= refsum * v[m * 
				    v_dim1 + 2];
			    z__[j + (k + 3) * z_dim1] -= refsum * v[m * 
				    v_dim1 + 3];
			}
		    }
		}
	    }


	    k = krcol + (m22 - 1) * 3;
	    if (bmp22 && v[m22 * v_dim1 + 1] != 0.) {
		i__7 = *kbot, i__4 = k + 3;
		i__5 = min(i__7,i__4);
		for (j = jtop; j <= i__5; ++j) {
		    refsum = v[m22 * v_dim1 + 1] * (h__[j + (k + 1) * h_dim1] 
			    + v[m22 * v_dim1 + 2] * h__[j + (k + 2) * h_dim1])
			    ;
		    h__[j + (k + 1) * h_dim1] -= refsum;
		    h__[j + (k + 2) * h_dim1] -= refsum * v[m22 * v_dim1 + 2];
		}

		if (accum) {
		    kms = k - incol;
		    i__5 = 1, i__7 = *ktop - incol;
		    i__4 = kdu;
		    for (j = max(i__5,i__7); j <= i__4; ++j) {
			refsum = v[m22 * v_dim1 + 1] * (u[j + (kms + 1) * 
				u_dim1] + v[m22 * v_dim1 + 2] * u[j + (kms + 
				2) * u_dim1]);
			u[j + (kms + 1) * u_dim1] -= refsum;
			u[j + (kms + 2) * u_dim1] -= refsum * v[m22 * v_dim1 
				+ 2];
		    }
		} else if (*wantz) {
		    i__4 = *ihiz;
		    for (j = *iloz; j <= i__4; ++j) {
			refsum = v[m22 * v_dim1 + 1] * (z__[j + (k + 1) * 
				z_dim1] + v[m22 * v_dim1 + 2] * z__[j + (k + 
				2) * z_dim1]);
			z__[j + (k + 1) * z_dim1] -= refsum;
			z__[j + (k + 2) * z_dim1] -= refsum * v[m22 * v_dim1 
				+ 2];
		    }
		}
	    }


	    mstart = mtop;
	    if (krcol + (mstart - 1) * 3 < *ktop) {
		++mstart;
	    }
	    mend = mbot;
	    if (bmp22) {
		++mend;
	    }
	    if (krcol == *kbot - 2) {
		++mend;
	    }
	    i__4 = mend;
	    for (m = mstart; m <= i__4; ++m) {
		i__5 = *kbot - 1, i__7 = krcol + (m - 1) * 3;
		k = min(i__5,i__7);


		if (h__[k + 1 + k * h_dim1] != 0.) {
		    tst1 = (d__1 = h__[k + k * h_dim1], abs(d__1)) + (d__2 = 
			    h__[k + 1 + (k + 1) * h_dim1], abs(d__2));
		    if (tst1 == 0.) {
			if (k >= *ktop + 1) {
			    tst1 += (d__1 = h__[k + (k - 1) * h_dim1], abs(
				    d__1));
			}
			if (k >= *ktop + 2) {
			    tst1 += (d__1 = h__[k + (k - 2) * h_dim1], abs(
				    d__1));
			}
			if (k >= *ktop + 3) {
			    tst1 += (d__1 = h__[k + (k - 3) * h_dim1], abs(
				    d__1));
			}
			if (k <= *kbot - 2) {
			    tst1 += (d__1 = h__[k + 2 + (k + 1) * h_dim1], 
				    abs(d__1));
			}
			if (k <= *kbot - 3) {
			    tst1 += (d__1 = h__[k + 3 + (k + 1) * h_dim1], 
				    abs(d__1));
			}
			if (k <= *kbot - 4) {
			    tst1 += (d__1 = h__[k + 4 + (k + 1) * h_dim1], 
				    abs(d__1));
			}
		    }
		    d__2 = smlnum, d__3 = ulp * tst1;
		    if ((d__1 = h__[k + 1 + k * h_dim1], abs(d__1)) <= max(
			    d__2,d__3)) {
			d__3 = (d__1 = h__[k + 1 + k * h_dim1], abs(d__1)), 
				d__4 = (d__2 = h__[k + (k + 1) * h_dim1], abs(
				d__2));
			h12 = max(d__3,d__4);
			d__3 = (d__1 = h__[k + 1 + k * h_dim1], abs(d__1)), 
				d__4 = (d__2 = h__[k + (k + 1) * h_dim1], abs(
				d__2));
			h21 = min(d__3,d__4);
			d__3 = (d__1 = h__[k + 1 + (k + 1) * h_dim1], abs(
				d__1)), d__4 = (d__2 = h__[k + k * h_dim1] - 
				h__[k + 1 + (k + 1) * h_dim1], abs(d__2));
			h11 = max(d__3,d__4);
			d__3 = (d__1 = h__[k + 1 + (k + 1) * h_dim1], abs(
				d__1)), d__4 = (d__2 = h__[k + k * h_dim1] - 
				h__[k + 1 + (k + 1) * h_dim1], abs(d__2));
			h22 = min(d__3,d__4);
			scl = h11 + h12;
			tst2 = h22 * (h11 / scl);

			d__1 = smlnum, d__2 = ulp * tst2;
			if (tst2 == 0. || h21 * (h12 / scl) <= max(d__1,d__2))
				 {
			    h__[k + 1 + k * h_dim1] = 0.;
			}
		    }
		}
	    }


	    i__4 = nbmps, i__5 = (*kbot - krcol - 1) / 3;
	    mend = min(i__4,i__5);
	    i__4 = mend;
	    for (m = mtop; m <= i__4; ++m) {
		k = krcol + (m - 1) * 3;
		refsum = v[m * v_dim1 + 1] * v[m * v_dim1 + 3] * h__[k + 4 + (
			k + 3) * h_dim1];
		h__[k + 4 + (k + 1) * h_dim1] = -refsum;
		h__[k + 4 + (k + 2) * h_dim1] = -refsum * v[m * v_dim1 + 2];
		h__[k + 4 + (k + 3) * h_dim1] -= refsum * v[m * v_dim1 + 3];
	    }


	}


	if (accum) {
	    if (*wantt) {
		jtop = 1;
		jbot = *n;
	    } else {
		jtop = *ktop;
		jbot = *kbot;
	    }
	    if (! blk22 || incol < *ktop || ndcol > *kbot || ns <= 2) {


		i__3 = 1, i__4 = *ktop - incol;
		k1 = max(i__3,i__4);
		i__3 = 0, i__4 = ndcol - *kbot;
		nu = kdu - max(i__3,i__4) - k1 + 1;


		i__3 = jbot;
		i__4 = *nh;
		for (jcol = min(ndcol,*kbot) + 1; i__4 < 0 ? jcol >= i__3 : 
			jcol <= i__3; jcol += i__4) {
		    i__5 = *nh, i__7 = jbot - jcol + 1;
		    jlen = min(i__5,i__7);
		    if (dgemm_(interp, "C", "N", &nu, &jlen, &nu, &dlaqr5_c_b8, &u[k1 + k1 * 			    u_dim1], ldu, &h__[incol + k1 + jcol * h_dim1], 
			    ldh, &dlaqr5_c_b7, &wh[wh_offset], ldwh)!=TCL_OK) { return TCL_ERROR; }


		    if (dlacpy_(interp, "ALL", &nu, &jlen, &wh[wh_offset], ldwh, &h__[			    incol + k1 + jcol * h_dim1], ldh)!=TCL_OK) { return TCL_ERROR; }


		}


		i__4 = max(*ktop,incol) - 1;
		i__3 = *nv;
		for (jrow = jtop; i__3 < 0 ? jrow >= i__4 : jrow <= i__4; 
			jrow += i__3) {
		    i__5 = *nv, i__7 = max(*ktop,incol) - jrow;
		    jlen = min(i__5,i__7);
		    if (dgemm_(interp, "N", "N", &jlen, &nu, &nu, &dlaqr5_c_b8, &h__[jrow + (			    incol + k1) * h_dim1], ldh, &u[k1 + k1 * u_dim1], 
			    ldu, &dlaqr5_c_b7, &wv[wv_offset], ldwv)!=TCL_OK) { return TCL_ERROR; }


		    if (dlacpy_(interp, "ALL", &jlen, &nu, &wv[wv_offset], ldwv, &h__[			    jrow + (incol + k1) * h_dim1], ldh)!=TCL_OK) { return TCL_ERROR; }


		}


		if (*wantz) {
		    i__3 = *ihiz;
		    i__4 = *nv;
		    for (jrow = *iloz; i__4 < 0 ? jrow >= i__3 : jrow <= i__3;
			     jrow += i__4) {
			i__5 = *nv, i__7 = *ihiz - jrow + 1;
			jlen = min(i__5,i__7);
			if (dgemm_(interp, "N", "N", &jlen, &nu, &nu, &dlaqr5_c_b8, &z__[jrow + (				incol + k1) * z_dim1], ldz, &u[k1 + k1 * 
				u_dim1], ldu, &dlaqr5_c_b7, &wv[wv_offset], ldwv)!=TCL_OK) { return TCL_ERROR; }


			if (dlacpy_(interp, "ALL", &jlen, &nu, &wv[wv_offset], ldwv, &z__[				jrow + (incol + k1) * z_dim1], ldz)
				!=TCL_OK) { return TCL_ERROR; }


		    }
		}
	    } else {


		i2 = (kdu + 1) / 2;
		i4 = kdu;
		j2 = i4 - i2;
		j4 = kdu;


		kzs = j4 - j2 - (ns + 1);
		knz = ns + 1;


		i__4 = jbot;
		i__3 = *nh;
		for (jcol = min(ndcol,*kbot) + 1; i__3 < 0 ? jcol >= i__4 : 
			jcol <= i__4; jcol += i__3) {
		    i__5 = *nh, i__7 = jbot - jcol + 1;
		    jlen = min(i__5,i__7);


		    if (dlacpy_(interp, "ALL", &knz, &jlen, &h__[incol + 1 + j2 + jcol * 			    h_dim1], ldh, &wh[kzs + 1 + wh_dim1], ldwh)!=TCL_OK) { return TCL_ERROR; }




		    if (dlaset_(interp, "ALL", &kzs, &jlen, &dlaqr5_c_b7, &dlaqr5_c_b7, &wh[wh_offset], 			    ldwh)!=TCL_OK) { return TCL_ERROR; }


		    if (dtrmm_(interp, "L", "U", "C", "N", &knz, &jlen, &dlaqr5_c_b8, &u[j2 + 1 			    + (kzs + 1) * u_dim1], ldu, &wh[kzs + 1 + wh_dim1]
, ldwh)!=TCL_OK) { return TCL_ERROR; }




		    if (dgemm_(interp, "C", "N", &i2, &jlen, &j2, &dlaqr5_c_b8, &u[u_offset], 			    ldu, &h__[incol + 1 + jcol * h_dim1], ldh, &dlaqr5_c_b8, 
			    &wh[wh_offset], ldwh)!=TCL_OK) { return TCL_ERROR; }




		    if (dlacpy_(interp, "ALL", &j2, &jlen, &h__[incol + 1 + jcol * h_dim1], ldh, &wh[i2 + 1 + wh_dim1], ldwh)!=TCL_OK) { return TCL_ERROR; }




		    if (dtrmm_(interp, "L", "L", "C", "N", &j2, &jlen, &dlaqr5_c_b8, &u[(i2 + 1) 			    * u_dim1 + 1], ldu, &wh[i2 + 1 + wh_dim1], ldwh)!=TCL_OK) { return TCL_ERROR; }




		    i__5 = i4 - i2;
		    i__7 = j4 - j2;
		    if (dgemm_(interp, "C", "N", &i__5, &jlen, &i__7, &dlaqr5_c_b8, &u[j2 + 1 + (			    i2 + 1) * u_dim1], ldu, &h__[incol + 1 + j2 + 
			    jcol * h_dim1], ldh, &dlaqr5_c_b8, &wh[i2 + 1 + wh_dim1], 
			     ldwh)!=TCL_OK) { return TCL_ERROR; }




		    if (dlacpy_(interp, "ALL", &kdu, &jlen, &wh[wh_offset], ldwh, &h__[			    incol + 1 + jcol * h_dim1], ldh)!=TCL_OK) { return TCL_ERROR; }


		}


		i__3 = max(incol,*ktop) - 1;
		i__4 = *nv;
		for (jrow = jtop; i__4 < 0 ? jrow >= i__3 : jrow <= i__3; 
			jrow += i__4) {
		    i__5 = *nv, i__7 = max(incol,*ktop) - jrow;
		    jlen = min(i__5,i__7);


		    if (dlacpy_(interp, "ALL", &jlen, &knz, &h__[jrow + (incol + 1 + j2) *			     h_dim1], ldh, &wv[(kzs + 1) * wv_dim1 + 1], ldwv)!=TCL_OK) { return TCL_ERROR; }




		    if (dlaset_(interp, "ALL", &jlen, &kzs, &dlaqr5_c_b7, &dlaqr5_c_b7, &wv[wv_offset], 			    ldwv)!=TCL_OK) { return TCL_ERROR; }


		    if (dtrmm_(interp, "R", "U", "N", "N", &jlen, &knz, &dlaqr5_c_b8, &u[j2 + 1 			    + (kzs + 1) * u_dim1], ldu, &wv[(kzs + 1) * 
			    wv_dim1 + 1], ldwv)!=TCL_OK) { return TCL_ERROR; }




		    if (dgemm_(interp, "N", "N", &jlen, &i2, &j2, &dlaqr5_c_b8, &h__[jrow + (			    incol + 1) * h_dim1], ldh, &u[u_offset], ldu, &
			    dlaqr5_c_b8, &wv[wv_offset], ldwv)!=TCL_OK) { return TCL_ERROR; }




		    if (dlacpy_(interp, "ALL", &jlen, &j2, &h__[jrow + (incol + 1) * 			    h_dim1], ldh, &wv[(i2 + 1) * wv_dim1 + 1], ldwv)!=TCL_OK) { return TCL_ERROR; }




		    i__5 = i4 - i2;
		    if (dtrmm_(interp, "R", "L", "N", "N", &jlen, &i__5, &dlaqr5_c_b8, &u[(i2 + 			    1) * u_dim1 + 1], ldu, &wv[(i2 + 1) * wv_dim1 + 1]
, ldwv)!=TCL_OK) { return TCL_ERROR; }




		    i__5 = i4 - i2;
		    i__7 = j4 - j2;
		    if (dgemm_(interp, "N", "N", &jlen, &i__5, &i__7, &dlaqr5_c_b8, &h__[jrow + (			    incol + 1 + j2) * h_dim1], ldh, &u[j2 + 1 + (i2 + 
			    1) * u_dim1], ldu, &dlaqr5_c_b8, &wv[(i2 + 1) * wv_dim1 
			    + 1], ldwv)!=TCL_OK) { return TCL_ERROR; }




		    if (dlacpy_(interp, "ALL", &jlen, &kdu, &wv[wv_offset], ldwv, &h__[			    jrow + (incol + 1) * h_dim1], ldh)!=TCL_OK) { return TCL_ERROR; }


		}


		if (*wantz) {
		    i__4 = *ihiz;
		    i__3 = *nv;
		    for (jrow = *iloz; i__3 < 0 ? jrow >= i__4 : jrow <= i__4;
			     jrow += i__3) {
			i__5 = *nv, i__7 = *ihiz - jrow + 1;
			jlen = min(i__5,i__7);


			if (dlacpy_(interp, "ALL", &jlen, &knz, &z__[jrow + (incol + 1 + 				j2) * z_dim1], ldz, &wv[(kzs + 1) * wv_dim1 + 
				1], ldwv)!=TCL_OK) { return TCL_ERROR; }




			if (dlaset_(interp, "ALL", &jlen, &kzs, &dlaqr5_c_b7, &dlaqr5_c_b7, &wv[				wv_offset], ldwv)!=TCL_OK) { return TCL_ERROR; }


			if (dtrmm_(interp, "R", "U", "N", "N", &jlen, &knz, &dlaqr5_c_b8, &u[j2 				+ 1 + (kzs + 1) * u_dim1], ldu, &wv[(kzs + 1) 
				* wv_dim1 + 1], ldwv)!=TCL_OK) { return TCL_ERROR; }




			if (dgemm_(interp, "N", "N", &jlen, &i2, &j2, &dlaqr5_c_b8, &z__[jrow + (				incol + 1) * z_dim1], ldz, &u[u_offset], ldu, 
				&dlaqr5_c_b8, &wv[wv_offset], ldwv)!=TCL_OK) { return TCL_ERROR; }




			if (dlacpy_(interp, "ALL", &jlen, &j2, &z__[jrow + (incol + 1) * 				z_dim1], ldz, &wv[(i2 + 1) * wv_dim1 + 1], 
				ldwv)!=TCL_OK) { return TCL_ERROR; }




			i__5 = i4 - i2;
			if (dtrmm_(interp, "R", "L", "N", "N", &jlen, &i__5, &dlaqr5_c_b8, &u[(				i2 + 1) * u_dim1 + 1], ldu, &wv[(i2 + 1) * 
				wv_dim1 + 1], ldwv)!=TCL_OK) { return TCL_ERROR; }




			i__5 = i4 - i2;
			i__7 = j4 - j2;
			if (dgemm_(interp, "N", "N", &jlen, &i__5, &i__7, &dlaqr5_c_b8, &z__[				jrow + (incol + 1 + j2) * z_dim1], ldz, &u[j2 
				+ 1 + (i2 + 1) * u_dim1], ldu, &dlaqr5_c_b8, &wv[(i2 
				+ 1) * wv_dim1 + 1], ldwv)!=TCL_OK) { return TCL_ERROR; }




			if (dlacpy_(interp, "ALL", &jlen, &kdu, &wv[wv_offset], ldwv, &				z__[jrow + (incol + 1) * z_dim1], ldz)!=TCL_OK) { return TCL_ERROR; }


		    }
		}
	    }
	}
    }


return TCL_OK;
} /* dlaqr5_ */
static /* Subroutine */ int dladiv_ (Tcl_Interp *interp, doublereal *a, doublereal *b, doublereal *c__, 	doublereal *d__, doublereal *p, doublereal *q)
{
    doublereal e, f;













    if (abs(*d__) < abs(*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 TCL_OK;


} /* dladiv_ */
static doublereal dcabs1_ (doublecomplex *z__)
{
    doublereal ret_val, d__1, d__2;

    double d_imag(doublecomplex *);




    ret_val = (d__1 = z__->r, abs(d__1)) + (d__2 = d_imag(z__), abs(d__2));
    return ret_val;
} /* dcabs1_ */
static /* Subroutine */ int zlaqr3_ (Tcl_Interp *interp, logical *wantt, logical *wantz, integer *n, 	integer *ktop, integer *kbot, integer *nw, doublecomplex *h__, 	integer *ldh, integer *iloz, integer *ihiz, doublecomplex *z__, 	integer *ldz, integer *ns, integer *nd, doublecomplex *sh, 	doublecomplex *v, integer *ldv, integer *nh, doublecomplex *t, 	integer *ldt, integer *nv, doublecomplex *wv, integer *ldwv, 	doublecomplex *work, integer *lwork)
{
    integer h_dim1, h_offset, t_dim1, t_offset, v_dim1, v_offset, wv_dim1, 
	    wv_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4;
    doublereal d__1, d__2, d__3, d__4, d__5, d__6;
    doublecomplex z__1, z__2;

    double d_imag(doublecomplex *);
    void d_cnjg(doublecomplex *, doublecomplex *);

    integer i__, j;
    doublecomplex s;
    integer jw;
    doublereal foo;
    integer kln;
    doublecomplex tau;
    integer knt;
    doublereal ulp;
    integer lwk1, lwk2, lwk3;
    doublecomplex beta;
    integer kcol, info, nmin, ifst, ilst, ltop, krow;
    integer infqr;
    integer kwtop;
    doublereal safmin;
    doublereal safmax;
    doublereal smlnum;
    integer lwkopt;


































    h_dim1 = *ldh;
    h_offset = 1 + h_dim1;
    h__ -= h_offset;
    z_dim1 = *ldz;
    z_offset = 1 + z_dim1;
    z__ -= z_offset;
    --sh;
    v_dim1 = *ldv;
    v_offset = 1 + v_dim1;
    v -= v_offset;
    t_dim1 = *ldt;
    t_offset = 1 + t_dim1;
    t -= t_offset;
    wv_dim1 = *ldwv;
    wv_offset = 1 + wv_dim1;
    wv -= wv_offset;
    --work;

    i__1 = *nw, i__2 = *kbot - *ktop + 1;
    jw = min(i__1,i__2);
    if (jw <= 2) {
	lwkopt = 1;
    } else {


	i__1 = jw - 1;
	if (zgehrd_(interp, &jw, &zlaqr3_c__1, &i__1, &t[t_offset], ldt, &work[1], &work[1], &		zlaqr3_c_n1, &info)!=TCL_OK) { return TCL_ERROR; }


	lwk1 = (integer) work[1].r;


	i__1 = jw - 1;
	if (zunmhr_(interp, "R", "N", &jw, &jw, &zlaqr3_c__1, &i__1, &t[t_offset], ldt, &work[1], 		 &v[v_offset], ldv, &work[1], &zlaqr3_c_n1, &info)!=TCL_OK) { return TCL_ERROR; }


	lwk2 = (integer) work[1].r;


	if (zlaqr4_(interp, &zlaqr3_c_true, &zlaqr3_c_true, &jw, &zlaqr3_c__1, &jw, &t[t_offset], ldt, &sh[1], 		&zlaqr3_c__1, &jw, &v[v_offset], ldv, &work[1], &zlaqr3_c_n1, &infqr)!=TCL_OK) { return TCL_ERROR; }


	lwk3 = (integer) work[1].r;


	i__1 = jw + max(lwk1,lwk2);
	lwkopt = max(i__1,lwk3);
    }


    if (*lwork == -1) {
	d__1 = (doublereal) lwkopt;
	z__1.r = d__1, z__1.i = 0.;
	work[1].r = z__1.r, work[1].i = z__1.i;
return TCL_OK;
    }

    *ns = 0;
    *nd = 0;
    work[1].r = 1., work[1].i = 0.;
    if (*ktop > *kbot) {
return TCL_OK;
    }
    if (*nw < 1) {
return TCL_OK;
    }


    safmin = dlamch_("SAFE MINIMUM");
    safmax = 1. / safmin;
    if (dlabad_(interp, &safmin, &safmax)!=TCL_OK) { return TCL_ERROR; }

    ulp = dlamch_("PRECISION");
    smlnum = safmin * ((doublereal) (*n) / ulp);


    i__1 = *nw, i__2 = *kbot - *ktop + 1;
    jw = min(i__1,i__2);
    kwtop = *kbot - jw + 1;
    if (kwtop == *ktop) {
	s.r = 0., s.i = 0.;
    } else {
	i__1 = kwtop + (kwtop - 1) * h_dim1;
	s.r = h__[i__1].r, s.i = h__[i__1].i;
    }

    if (*kbot == kwtop) {


	i__1 = kwtop;
	i__2 = kwtop + kwtop * h_dim1;
	sh[i__1].r = h__[i__2].r, sh[i__1].i = h__[i__2].i;
	*ns = 1;
	*nd = 0;
	i__1 = kwtop + kwtop * h_dim1;
	d__5 = smlnum, d__6 = ulp * ((d__1 = h__[i__1].r, abs(d__1)) + (d__2 =
		 d_imag(&h__[kwtop + kwtop * h_dim1]), abs(d__2)));
	if ((d__3 = s.r, abs(d__3)) + (d__4 = d_imag(&s), abs(d__4)) <= max(
		d__5,d__6)) {
	    *ns = 0;
	    *nd = 1;
	    if (kwtop > *ktop) {
		i__1 = kwtop + (kwtop - 1) * h_dim1;
		h__[i__1].r = 0., h__[i__1].i = 0.;
	    }
	}
	work[1].r = 1., work[1].i = 0.;
return TCL_OK;
    }


    if (zlacpy_(interp, "U", &jw, &jw, &h__[kwtop + kwtop * h_dim1], ldh, &t[t_offset], 	    ldt)!=TCL_OK) { return TCL_ERROR; }


    i__1 = jw - 1;
    i__2 = *ldh + 1;
    i__3 = *ldt + 1;
    if (zcopy_(interp, &i__1, &h__[kwtop + 1 + kwtop * h_dim1], &i__2, &t[t_dim1 + 2], &	    i__3)!=TCL_OK) { return TCL_ERROR; }



    if (zlaset_(interp, "A", &jw, &jw, &zlaqr3_c_b1, &zlaqr3_c_b2, &v[v_offset], ldv)!=TCL_OK) { return TCL_ERROR; }

    nmin = ilaenv_(&zlaqr3_c__12, "ZLAQR3", "SV", &jw, &zlaqr3_c__1, &jw, lwork);
    if (jw > nmin) {
	if (zlaqr4_(interp, &zlaqr3_c_true, &zlaqr3_c_true, &jw, &zlaqr3_c__1, &jw, &t[t_offset], ldt, &sh[		kwtop], &zlaqr3_c__1, &jw, &v[v_offset], ldv, &work[1], lwork, &
		infqr)!=TCL_OK) { return TCL_ERROR; }


    } else {
	if (zlahqr_(interp, &zlaqr3_c_true, &zlaqr3_c_true, &jw, &zlaqr3_c__1, &jw, &t[t_offset], ldt, &sh[		kwtop], &zlaqr3_c__1, &jw, &v[v_offset], ldv, &infqr)!=TCL_OK) { return TCL_ERROR; }


    }


    *ns = jw;
    ilst = infqr + 1;
    i__1 = jw;
    for (knt = infqr + 1; knt <= i__1; ++knt) {


	i__2 = *ns + *ns * t_dim1;
	foo = (d__1 = t[i__2].r, abs(d__1)) + (d__2 = d_imag(&t[*ns + *ns * 
		t_dim1]), abs(d__2));
	if (foo == 0.) {
	    foo = (d__1 = s.r, abs(d__1)) + (d__2 = d_imag(&s), abs(d__2));
	}
	i__2 = *ns * v_dim1 + 1;
	d__5 = smlnum, d__6 = ulp * foo;
	if (((d__1 = s.r, abs(d__1)) + (d__2 = d_imag(&s), abs(d__2))) * ((
		d__3 = v[i__2].r, abs(d__3)) + (d__4 = d_imag(&v[*ns * v_dim1 
		+ 1]), abs(d__4))) <= max(d__5,d__6)) {


	    --(*ns);
	} else {


	    ifst = *ns;
	    if (ztrexc_(interp, "V", &jw, &t[t_offset], ldt, &v[v_offset], ldv, &ifst, &		    ilst, &info)!=TCL_OK) { return TCL_ERROR; }


	    ++ilst;
	}
    }


    if (*ns == 0) {
	s.r = 0., s.i = 0.;
    }

    if (*ns < jw) {


	i__1 = *ns;
	for (i__ = infqr + 1; i__ <= i__1; ++i__) {
	    ifst = i__;
	    i__2 = *ns;
	    for (j = i__ + 1; j <= i__2; ++j) {
		i__3 = j + j * t_dim1;
		i__4 = ifst + ifst * t_dim1;
		if ((d__1 = t[i__3].r, abs(d__1)) + (d__2 = d_imag(&t[j + j * 
			t_dim1]), abs(d__2)) > (d__3 = t[i__4].r, abs(d__3)) 
			+ (d__4 = d_imag(&t[ifst + ifst * t_dim1]), abs(d__4))
			) {
		    ifst = j;
		}
	    }
	    ilst = i__;
	    if (ifst != ilst) {
		if (ztrexc_(interp, "V", &jw, &t[t_offset], ldt, &v[v_offset], ldv, &ifst, 			 &ilst, &info)!=TCL_OK) { return TCL_ERROR; }


	    }
	}
    }


    i__1 = jw;
    for (i__ = infqr + 1; i__ <= i__1; ++i__) {
	i__2 = kwtop + i__ - 1;
	i__3 = i__ + i__ * t_dim1;
	sh[i__2].r = t[i__3].r, sh[i__2].i = t[i__3].i;
    }


    if (*ns < jw || s.r == 0. && s.i == 0.) {
	if (*ns > 1 && (s.r != 0. || s.i != 0.)) {


	    if (zcopy_(interp, ns, &v[v_offset], ldv, &work[1], &zlaqr3_c__1)!=TCL_OK) { return TCL_ERROR; }

	    i__1 = *ns;
	    for (i__ = 1; i__ <= i__1; ++i__) {
		i__2 = i__;
		d_cnjg(&z__1, &work[i__]);
		work[i__2].r = z__1.r, work[i__2].i = z__1.i;
	    }
	    beta.r = work[1].r, beta.i = work[1].i;
	    if (zlarfg_(interp, ns, &beta, &work[2], &zlaqr3_c__1, &tau)!=TCL_OK) { return TCL_ERROR; }

	    work[1].r = 1., work[1].i = 0.;

	    i__1 = jw - 2;
	    i__2 = jw - 2;
	    if (zlaset_(interp, "L", &i__1, &i__2, &zlaqr3_c_b1, &zlaqr3_c_b1, &t[t_dim1 + 3], ldt)!=TCL_OK) { return TCL_ERROR; }


	    d_cnjg(&z__1, &tau);
	    if (zlarf_(interp, "L", ns, &jw, &work[1], &zlaqr3_c__1, &z__1, &t[t_offset], ldt, &		    work[jw + 1])!=TCL_OK) { return TCL_ERROR; }


	    if (zlarf_(interp, "R", ns, ns, &work[1], &zlaqr3_c__1, &tau, &t[t_offset], ldt, &		    work[jw + 1])!=TCL_OK) { return TCL_ERROR; }


	    if (zlarf_(interp, "R", &jw, ns, &work[1], &zlaqr3_c__1, &tau, &v[v_offset], ldv, &		    work[jw + 1])!=TCL_OK) { return TCL_ERROR; }



	    i__1 = *lwork - jw;
	    if (zgehrd_(interp, &jw, &zlaqr3_c__1, ns, &t[t_offset], ldt, &work[1], &work[jw + 1], &i__1, &info)!=TCL_OK) { return TCL_ERROR; }


	}


	if (kwtop > 1) {
	    i__1 = kwtop + (kwtop - 1) * h_dim1;
	    d_cnjg(&z__2, &v[v_dim1 + 1]);
	    z__1.r = s.r * z__2.r - s.i * z__2.i, z__1.i = s.r * z__2.i + s.i 
		    * z__2.r;
	    h__[i__1].r = z__1.r, h__[i__1].i = z__1.i;
	}
	if (zlacpy_(interp, "U", &jw, &jw, &t[t_offset], ldt, &h__[kwtop + kwtop * h_dim1], ldh)!=TCL_OK) { return TCL_ERROR; }


	i__1 = jw - 1;
	i__2 = *ldt + 1;
	i__3 = *ldh + 1;
	if (zcopy_(interp, &i__1, &t[t_dim1 + 2], &i__2, &h__[kwtop + 1 + kwtop * h_dim1], 		 &i__3)!=TCL_OK) { return TCL_ERROR; }




	if (*ns > 1 && (s.r != 0. || s.i != 0.)) {
	    i__1 = *lwork - jw;
	    if (zunmhr_(interp, "R", "N", &jw, ns, &zlaqr3_c__1, ns, &t[t_offset], ldt, &work[1], 		     &v[v_offset], ldv, &work[jw + 1], &i__1, &info)!=TCL_OK) { return TCL_ERROR; }


	}


	if (*wantt) {
	    ltop = 1;
	} else {
	    ltop = *ktop;
	}
	i__1 = kwtop - 1;
	i__2 = *nv;
	for (krow = ltop; i__2 < 0 ? krow >= i__1 : krow <= i__1; krow += 
		i__2) {
	    i__3 = *nv, i__4 = kwtop - krow;
	    kln = min(i__3,i__4);
	    if (zgemm_(interp, "N", "N", &kln, &jw, &jw, &zlaqr3_c_b2, &h__[krow + kwtop * 		    h_dim1], ldh, &v[v_offset], ldv, &zlaqr3_c_b1, &wv[wv_offset], 
		    ldwv)!=TCL_OK) { return TCL_ERROR; }


	    if (zlacpy_(interp, "A", &kln, &jw, &wv[wv_offset], ldwv, &h__[krow + kwtop * 		    h_dim1], ldh)!=TCL_OK) { return TCL_ERROR; }


	}


	if (*wantt) {
	    i__2 = *n;
	    i__1 = *nh;
	    for (kcol = *kbot + 1; i__1 < 0 ? kcol >= i__2 : kcol <= i__2; 
		    kcol += i__1) {
		i__3 = *nh, i__4 = *n - kcol + 1;
		kln = min(i__3,i__4);
		if (zgemm_(interp, "C", "N", &jw, &kln, &jw, &zlaqr3_c_b2, &v[v_offset], ldv, &			h__[kwtop + kcol * h_dim1], ldh, &zlaqr3_c_b1, &t[t_offset], 
			ldt)!=TCL_OK) { return TCL_ERROR; }


		if (zlacpy_(interp, "A", &jw, &kln, &t[t_offset], ldt, &h__[kwtop + kcol *			 h_dim1], ldh)!=TCL_OK) { return TCL_ERROR; }


	    }
	}


	if (*wantz) {
	    i__1 = *ihiz;
	    i__2 = *nv;
	    for (krow = *iloz; i__2 < 0 ? krow >= i__1 : krow <= i__1; krow +=
		     i__2) {
		i__3 = *nv, i__4 = *ihiz - krow + 1;
		kln = min(i__3,i__4);
		if (zgemm_(interp, "N", "N", &kln, &jw, &jw, &zlaqr3_c_b2, &z__[krow + kwtop * 			z_dim1], ldz, &v[v_offset], ldv, &zlaqr3_c_b1, &wv[wv_offset]
, ldwv)!=TCL_OK) { return TCL_ERROR; }


		if (zlacpy_(interp, "A", &kln, &jw, &wv[wv_offset], ldwv, &z__[krow + 			kwtop * z_dim1], ldz)!=TCL_OK) { return TCL_ERROR; }


	    }
	}
    }


    *nd = jw - *ns;


    *ns -= infqr;


    d__1 = (doublereal) lwkopt;
    z__1.r = d__1, z__1.i = 0.;
    work[1].r = z__1.r, work[1].i = z__1.i;


return TCL_OK;
} /* zlaqr3_ */
static /* Subroutine */ int zlaqr4_ (Tcl_Interp *interp, logical *wantt, logical *wantz, integer *n, 	integer *ilo, integer *ihi, doublecomplex *h__, integer *ldh, 	doublecomplex *w, integer *iloz, integer *ihiz, doublecomplex *z__, 	integer *ldz, doublecomplex *work, integer *lwork, integer *info)
{
    integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4, i__5;
    doublereal d__1, d__2, d__3, d__4, d__5, d__6, d__7, d__8;
    doublecomplex z__1, z__2, z__3, z__4, z__5;

    double d_imag(doublecomplex *);
    void z_sqrt(doublecomplex *, doublecomplex *);

    integer i__, k;
    doublereal s;
    doublecomplex aa, bb, cc, dd;
    integer ld, nh, it, ks, kt, ku, kv, ls, ns, nw;
    doublecomplex tr2, det;
    integer inf, kdu, nho, nve, kwh, nsr, nwr, kwv, ndec, ndfl, kbot, nmin;
    doublecomplex swap;
    integer ktop;
    doublecomplex zdum[1]	/* was [1][1] */;
    integer kacc22, itmax, nsmax, nwmax, kwtop;
    integer nibble;
    char jbcmpz[1];
    doublecomplex rtdisc;
    integer nwupbd;
    logical sorted;
    integer lwkopt;







































    h_dim1 = *ldh;
    h_offset = 1 + h_dim1;
    h__ -= h_offset;
    --w;
    z_dim1 = *ldz;
    z_offset = 1 + z_dim1;
    z__ -= z_offset;
    --work;

    *info = 0;


    if (*n == 0) {
	work[1].r = 1., work[1].i = 0.;
return TCL_OK;
    }

    if (*n <= 11) {


	lwkopt = 1;
	if (*lwork != -1) {
	    if (zlahqr_(interp, wantt, wantz, n, ilo, ihi, &h__[h_offset], ldh, &w[1], 		    iloz, ihiz, &z__[z_offset], ldz, info)!=TCL_OK) { return TCL_ERROR; }


	}
    } else {



	*info = 0;


	if (*wantt) {
	    *(unsigned char *)jbcmpz = 'S';
	} else {
	    *(unsigned char *)jbcmpz = 'E';
	}
	if (*wantz) {
	    *(unsigned char *)&jbcmpz[1] = 'V';
	} else {
	    *(unsigned char *)&jbcmpz[1] = 'N';
	}


	nwr = ilaenv_(&zlaqr4_c__13, "ZLAQR4", jbcmpz, n, ilo, ihi, lwork);
	nwr = max(2,nwr);
	i__1 = *ihi - *ilo + 1, i__2 = (*n - 1) / 3, i__1 = min(i__1,i__2);
	nwr = min(i__1,nwr);


	nsr = ilaenv_(&zlaqr4_c__15, "ZLAQR4", jbcmpz, n, ilo, ihi, lwork);
	i__1 = nsr, i__2 = (*n + 6) / 9, i__1 = min(i__1,i__2), i__2 = *ihi - 
		*ilo;
	nsr = min(i__1,i__2);
	i__1 = 2, i__2 = nsr - nsr % 2;
	nsr = max(i__1,i__2);



	i__1 = nwr + 1;
	if (zlaqr2_(interp, wantt, wantz, n, ilo, ihi, &i__1, &h__[h_offset], ldh, iloz, 		ihiz, &z__[z_offset], ldz, &ls, &ld, &w[1], &h__[h_offset], 
		ldh, n, &h__[h_offset], ldh, n, &h__[h_offset], ldh, &work[1], 
		 &zlaqr4_c_n1)!=TCL_OK) { return TCL_ERROR; }




	i__1 = nsr * 3 / 2, i__2 = (integer) work[1].r;
	lwkopt = max(i__1,i__2);


	if (*lwork == -1) {
	    d__1 = (doublereal) lwkopt;
	    z__1.r = d__1, z__1.i = 0.;
	    work[1].r = z__1.r, work[1].i = z__1.i;
return TCL_OK;
	}


	nmin = ilaenv_(&zlaqr4_c__12, "ZLAQR4", jbcmpz, n, ilo, ihi, lwork);
	nmin = max(11,nmin);


	nibble = ilaenv_(&zlaqr4_c__14, "ZLAQR4", jbcmpz, n, ilo, ihi, lwork);
	nibble = max(0,nibble);


	kacc22 = ilaenv_(&zlaqr4_c__16, "ZLAQR4", jbcmpz, n, ilo, ihi, lwork);
	kacc22 = max(0,kacc22);
	kacc22 = min(2,kacc22);


	i__1 = (*n - 1) / 3, i__2 = *lwork / 2;
	nwmax = min(i__1,i__2);
	nw = nwmax;


	i__1 = (*n + 6) / 9, i__2 = (*lwork << 1) / 3;
	nsmax = min(i__1,i__2);
	nsmax -= nsmax % 2;


	ndfl = 1;


	i__1 = 10, i__2 = *ihi - *ilo + 1;
	itmax = max(i__1,i__2) * 30;


	kbot = *ihi;


	i__1 = itmax;
	for (it = 1; it <= i__1; ++it) {


	    if (kbot < *ilo) {
		goto L80;
	    }


	    i__2 = *ilo + 1;
	    for (k = kbot; k >= i__2; --k) {
		i__3 = k + (k - 1) * h_dim1;
		if (h__[i__3].r == 0. && h__[i__3].i == 0.) {
		    goto L20;
		}
	    }
	    k = *ilo;
L20:
	    ktop = k;


	    nh = kbot - ktop + 1;
	    nwupbd = min(nh,nwmax);
	    if (ndfl < 5) {
		nw = min(nwupbd,nwr);
	    } else {
		i__2 = nwupbd, i__3 = nw << 1;
		nw = min(i__2,i__3);
	    }
	    if (nw < nwmax) {
		if (nw >= nh - 1) {
		    nw = nh;
		} else {
		    kwtop = kbot - nw + 1;
		    i__2 = kwtop + (kwtop - 1) * h_dim1;
		    i__3 = kwtop - 1 + (kwtop - 2) * h_dim1;
		    if ((d__1 = h__[i__2].r, abs(d__1)) + (d__2 = d_imag(&h__[
			    kwtop + (kwtop - 1) * h_dim1]), abs(d__2)) > (
			    d__3 = h__[i__3].r, abs(d__3)) + (d__4 = d_imag(&
			    h__[kwtop - 1 + (kwtop - 2) * h_dim1]), abs(d__4))
			    ) {
			++nw;
		    }
		}
	    }
	    if (ndfl < 5) {
		ndec = -1;
	    } else if (ndec >= 0 || nw >= nwupbd) {
		++ndec;
		if (nw - ndec < 2) {
		    ndec = 0;
		}
		nw -= ndec;
	    }


	    kv = *n - nw + 1;
	    kt = nw + 1;
	    nho = *n - nw - 1 - kt + 1;
	    kwv = nw + 2;
	    nve = *n - nw - kwv + 1;


	    if (zlaqr2_(interp, wantt, wantz, n, &ktop, &kbot, &nw, &h__[h_offset], ldh, 		    iloz, ihiz, &z__[z_offset], ldz, &ls, &ld, &w[1], &h__[kv 
		    + h_dim1], ldh, &nho, &h__[kv + kt * h_dim1], ldh, &nve, &
		    h__[kwv + h_dim1], ldh, &work[1], lwork)!=TCL_OK) { return TCL_ERROR; }




	    kbot -= ld;


	    ks = kbot - ls + 1;


	    if (ld == 0 || ld * 100 <= nw * nibble && kbot - ktop + 1 > min(
		    nmin,nwmax)) {


		i__4 = 2, i__5 = kbot - ktop;
		i__2 = min(nsmax,nsr), i__3 = max(i__4,i__5);
		ns = min(i__2,i__3);
		ns -= ns % 2;


		if (ndfl % 6 == 0) {
		    ks = kbot - ns + 1;
		    i__2 = ks + 1;
		    for (i__ = kbot; i__ >= i__2; i__ += -2) {
			i__3 = i__;
			i__4 = i__ + i__ * h_dim1;
			i__5 = i__ + (i__ - 1) * h_dim1;
			d__3 = ((d__1 = h__[i__5].r, abs(d__1)) + (d__2 = 
				d_imag(&h__[i__ + (i__ - 1) * h_dim1]), abs(
				d__2))) * .75;
			z__1.r = h__[i__4].r + d__3, z__1.i = h__[i__4].i;
			w[i__3].r = z__1.r, w[i__3].i = z__1.i;
			i__3 = i__ - 1;
			i__4 = i__;
			w[i__3].r = w[i__4].r, w[i__3].i = w[i__4].i;
		    }
		} else {


		    if (kbot - ks + 1 <= ns / 2) {
			ks = kbot - ns + 1;
			kt = *n - ns + 1;
			if (zlacpy_(interp, "A", &ns, &ns, &h__[ks + ks * h_dim1], ldh, &				h__[kt + h_dim1], ldh)!=TCL_OK) { return TCL_ERROR; }


			if (zlahqr_(interp, &zlaqr4_c_false, &zlaqr4_c_false, &ns, &zlaqr4_c__1, &ns, &h__[kt 				+ h_dim1], ldh, &w[ks], &zlaqr4_c__1, &zlaqr4_c__1, zdum, &
				zlaqr4_c__1, &inf)!=TCL_OK) { return TCL_ERROR; }


			ks += inf;


			if (ks >= kbot) {
			    i__2 = kbot - 1 + (kbot - 1) * h_dim1;
			    i__3 = kbot + (kbot - 1) * h_dim1;
			    i__4 = kbot - 1 + kbot * h_dim1;
			    i__5 = kbot + kbot * h_dim1;
			    s = (d__1 = h__[i__2].r, abs(d__1)) + (d__2 = 
				    d_imag(&h__[kbot - 1 + (kbot - 1) * 
				    h_dim1]), abs(d__2)) + ((d__3 = h__[i__3]
				    .r, abs(d__3)) + (d__4 = d_imag(&h__[kbot 
				    + (kbot - 1) * h_dim1]), abs(d__4))) + ((
				    d__5 = h__[i__4].r, abs(d__5)) + (d__6 = 
				    d_imag(&h__[kbot - 1 + kbot * h_dim1]), 
				    abs(d__6))) + ((d__7 = h__[i__5].r, abs(
				    d__7)) + (d__8 = d_imag(&h__[kbot + kbot *
				     h_dim1]), abs(d__8)));
			    i__2 = kbot - 1 + (kbot - 1) * h_dim1;
			    z__1.r = h__[i__2].r / s, z__1.i = h__[i__2].i / 
				    s;
			    aa.r = z__1.r, aa.i = z__1.i;
			    i__2 = kbot + (kbot - 1) * h_dim1;
			    z__1.r = h__[i__2].r / s, z__1.i = h__[i__2].i / 
				    s;
			    cc.r = z__1.r, cc.i = z__1.i;
			    i__2 = kbot - 1 + kbot * h_dim1;
			    z__1.r = h__[i__2].r / s, z__1.i = h__[i__2].i / 
				    s;
			    bb.r = z__1.r, bb.i = z__1.i;
			    i__2 = kbot + kbot * h_dim1;
			    z__1.r = h__[i__2].r / s, z__1.i = h__[i__2].i / 
				    s;
			    dd.r = z__1.r, dd.i = z__1.i;
			    z__2.r = aa.r + dd.r, z__2.i = aa.i + dd.i;
			    z__1.r = z__2.r / 2., z__1.i = z__2.i / 2.;
			    tr2.r = z__1.r, tr2.i = z__1.i;
			    z__3.r = aa.r - tr2.r, z__3.i = aa.i - tr2.i;
			    z__4.r = dd.r - tr2.r, z__4.i = dd.i - tr2.i;
			    z__2.r = z__3.r * z__4.r - z__3.i * z__4.i, 
				    z__2.i = z__3.r * z__4.i + z__3.i * 
				    z__4.r;
			    z__5.r = bb.r * cc.r - bb.i * cc.i, z__5.i = bb.r 
				    * cc.i + bb.i * cc.r;
			    z__1.r = z__2.r - z__5.r, z__1.i = z__2.i - 
				    z__5.i;
			    det.r = z__1.r, det.i = z__1.i;
			    z__2.r = -det.r, z__2.i = -det.i;
			    z_sqrt(&z__1, &z__2);
			    rtdisc.r = z__1.r, rtdisc.i = z__1.i;
			    i__2 = kbot - 1;
			    z__2.r = tr2.r + rtdisc.r, z__2.i = tr2.i + 
				    rtdisc.i;
			    z__1.r = s * z__2.r, z__1.i = s * z__2.i;
			    w[i__2].r = z__1.r, w[i__2].i = z__1.i;
			    i__2 = kbot;
			    z__2.r = tr2.r - rtdisc.r, z__2.i = tr2.i - 
				    rtdisc.i;
			    z__1.r = s * z__2.r, z__1.i = s * z__2.i;
			    w[i__2].r = z__1.r, w[i__2].i = z__1.i;

			    ks = kbot - 1;
			}
		    }

		    if (kbot - ks + 1 > ns) {


			sorted = FALSE_;
			i__2 = ks + 1;
			for (k = kbot; k >= i__2; --k) {
			    if (sorted) {
				goto L60;
			    }
			    sorted = TRUE_;
			    i__3 = k - 1;
			    for (i__ = ks; i__ <= i__3; ++i__) {
				i__4 = i__;
				i__5 = i__ + 1;
				if ((d__1 = w[i__4].r, abs(d__1)) + (d__2 = 
					d_imag(&w[i__]), abs(d__2)) < (d__3 = 
					w[i__5].r, abs(d__3)) + (d__4 = 
					d_imag(&w[i__ + 1]), abs(d__4))) {
				    sorted = FALSE_;
				    i__4 = i__;
				    swap.r = w[i__4].r, swap.i = w[i__4].i;
				    i__4 = i__;
				    i__5 = i__ + 1;
				    w[i__4].r = w[i__5].r, w[i__4].i = w[i__5]
					    .i;
				    i__4 = i__ + 1;
				    w[i__4].r = swap.r, w[i__4].i = swap.i;
				}
			    }
			}
L60:
			;
		    }
		}


		if (kbot - ks + 1 == 2) {
		    i__2 = kbot;
		    i__3 = kbot + kbot * h_dim1;
		    z__2.r = w[i__2].r - h__[i__3].r, z__2.i = w[i__2].i - 
			    h__[i__3].i;
		    z__1.r = z__2.r, z__1.i = z__2.i;
		    i__4 = kbot - 1;
		    i__5 = kbot + kbot * h_dim1;
		    z__4.r = w[i__4].r - h__[i__5].r, z__4.i = w[i__4].i - 
			    h__[i__5].i;
		    z__3.r = z__4.r, z__3.i = z__4.i;
		    if ((d__1 = z__1.r, abs(d__1)) + (d__2 = d_imag(&z__1), 
			    abs(d__2)) < (d__3 = z__3.r, abs(d__3)) + (d__4 = 
			    d_imag(&z__3), abs(d__4))) {
			i__2 = kbot - 1;
			i__3 = kbot;
			w[i__2].r = w[i__3].r, w[i__2].i = w[i__3].i;
		    } else {
			i__2 = kbot;
			i__3 = kbot - 1;
			w[i__2].r = w[i__3].r, w[i__2].i = w[i__3].i;
		    }
		}


		i__2 = ns, i__3 = kbot - ks + 1;
		ns = min(i__2,i__3);
		ns -= ns % 2;
		ks = kbot - ns + 1;


		kdu = ns * 3 - 3;
		ku = *n - kdu + 1;
		kwh = kdu + 1;
		nho = *n - kdu - 3 - (kdu + 1) + 1;
		kwv = kdu + 4;
		nve = *n - kdu - kwv + 1;


		if (zlaqr5_(interp, wantt, wantz, &kacc22, n, &ktop, &kbot, &ns, &w[ks], &			h__[h_offset], ldh, iloz, ihiz, &z__[z_offset], ldz, &
			work[1], &zlaqr4_c__3, &h__[ku + h_dim1], ldh, &nve, &h__[
			kwv + h_dim1], ldh, &nho, &h__[ku + kwh * h_dim1], 
			ldh)!=TCL_OK) { return TCL_ERROR; }


	    }


	    if (ld > 0) {
		ndfl = 1;
	    } else {
		++ndfl;
	    }

	}


	*info = kbot;
L80:
	;
    }


    d__1 = (doublereal) lwkopt;
    z__1.r = d__1, z__1.i = 0.;
    work[1].r = z__1.r, work[1].i = z__1.i;


return TCL_OK;
} /* zlaqr4_ */
static /* Subroutine */ int zlaqr5_ (Tcl_Interp *interp, logical *wantt, logical *wantz, integer *kacc22, 	integer *n, integer *ktop, integer *kbot, integer *nshfts, 	doublecomplex *s, doublecomplex *h__, integer *ldh, integer *iloz, 	integer *ihiz, doublecomplex *z__, integer *ldz, doublecomplex *v, 	integer *ldv, doublecomplex *u, integer *ldu, integer *nv, 	doublecomplex *wv, integer *ldwv, integer *nh, doublecomplex *wh, 	integer *ldwh)
{
    integer h_dim1, h_offset, u_dim1, u_offset, v_dim1, v_offset, wh_dim1, 
	    wh_offset, wv_dim1, wv_offset, z_dim1, z_offset, i__1, i__2, i__3,
	     i__4, i__5, i__6, i__7, i__8, i__9, i__10, i__11;
    doublereal d__1, d__2, d__3, d__4, d__5, d__6, d__7, d__8, d__9, d__10;
    doublecomplex z__1, z__2, z__3, z__4, z__5, z__6, z__7, z__8;

    void d_cnjg(doublecomplex *, doublecomplex *);
    double d_imag(doublecomplex *);

    integer j, k, m, i2, j2, i4, j4, k1;
    doublereal h11, h12, h21, h22;
    integer m22, ns, nu;
    doublecomplex vt[3];
    doublereal scl;
    integer kdu, kms;
    doublereal ulp;
    integer knz, kzs;
    doublereal tst1, tst2;
    doublecomplex beta;
    logical blk22, bmp22;
    integer mend, jcol, jlen, jbot, mbot, jtop, jrow, mtop;
    doublecomplex alpha;
    logical accum;
    integer ndcol, incol, krcol, nbmps;
    doublereal safmin, safmax;
    doublecomplex refsum;
    integer mstart;
    doublereal smlnum;

































    --s;
    h_dim1 = *ldh;
    h_offset = 1 + h_dim1;
    h__ -= h_offset;
    z_dim1 = *ldz;
    z_offset = 1 + z_dim1;
    z__ -= z_offset;
    v_dim1 = *ldv;
    v_offset = 1 + v_dim1;
    v -= v_offset;
    u_dim1 = *ldu;
    u_offset = 1 + u_dim1;
    u -= u_offset;
    wv_dim1 = *ldwv;
    wv_offset = 1 + wv_dim1;
    wv -= wv_offset;
    wh_dim1 = *ldwh;
    wh_offset = 1 + wh_dim1;
    wh -= wh_offset;

    if (*nshfts < 2) {
return TCL_OK;
    }


    if (*ktop >= *kbot) {
return TCL_OK;
    }


    ns = *nshfts - *nshfts % 2;


    safmin = dlamch_("SAFE MINIMUM");
    safmax = 1. / safmin;
    if (dlabad_(interp, &safmin, &safmax)!=TCL_OK) { return TCL_ERROR; }

    ulp = dlamch_("PRECISION");
    smlnum = safmin * ((doublereal) (*n) / ulp);


    accum = *kacc22 == 1 || *kacc22 == 2;


    blk22 = ns > 2 && *kacc22 == 2;


    if (*ktop + 2 <= *kbot) {
	i__1 = *ktop + 2 + *ktop * h_dim1;
	h__[i__1].r = 0., h__[i__1].i = 0.;
    }


    nbmps = ns / 2;


    kdu = nbmps * 6 - 3;


    i__1 = *kbot - 2;
    i__2 = nbmps * 3 - 2;
    for (incol = (1 - nbmps) * 3 + *ktop - 1; i__2 < 0 ? incol >= i__1 : 
	    incol <= i__1; incol += i__2) {
	ndcol = incol + kdu;
	if (accum) {
	    if (zlaset_(interp, "ALL", &kdu, &kdu, &zlaqr5_c_b1, &zlaqr5_c_b2, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }

	}


	i__4 = incol + nbmps * 3 - 3, i__5 = *kbot - 2;
	i__3 = min(i__4,i__5);
	for (krcol = incol; krcol <= i__3; ++krcol) {


	    i__4 = 1, i__5 = (*ktop - 1 - krcol + 2) / 3 + 1;
	    mtop = max(i__4,i__5);
	    i__4 = nbmps, i__5 = (*kbot - krcol) / 3;
	    mbot = min(i__4,i__5);
	    m22 = mbot + 1;
	    bmp22 = mbot < nbmps && krcol + (m22 - 1) * 3 == *kbot - 2;


	    i__4 = mbot;
	    for (m = mtop; m <= i__4; ++m) {
		k = krcol + (m - 1) * 3;
		if (k == *ktop - 1) {
		    if (zlaqr1_(interp, &zlaqr5_c__3, &h__[*ktop + *ktop * h_dim1], ldh, &s[(m <<			     1) - 1], &s[m * 2], &v[m * v_dim1 + 1])!=TCL_OK) { return TCL_ERROR; }


		    i__5 = m * v_dim1 + 1;
		    alpha.r = v[i__5].r, alpha.i = v[i__5].i;
		    if (zlarfg_(interp, &zlaqr5_c__3, &alpha, &v[m * v_dim1 + 2], &zlaqr5_c__1, &v[m * 			    v_dim1 + 1])!=TCL_OK) { return TCL_ERROR; }


		} else {
		    i__5 = k + 1 + k * h_dim1;
		    beta.r = h__[i__5].r, beta.i = h__[i__5].i;
		    i__5 = m * v_dim1 + 2;
		    i__6 = k + 2 + k * h_dim1;
		    v[i__5].r = h__[i__6].r, v[i__5].i = h__[i__6].i;
		    i__5 = m * v_dim1 + 3;
		    i__6 = k + 3 + k * h_dim1;
		    v[i__5].r = h__[i__6].r, v[i__5].i = h__[i__6].i;
		    if (zlarfg_(interp, &zlaqr5_c__3, &beta, &v[m * v_dim1 + 2], &zlaqr5_c__1, &v[m * 			    v_dim1 + 1])!=TCL_OK) { return TCL_ERROR; }




		    i__5 = k + 3 + k * h_dim1;
		    i__6 = k + 3 + (k + 1) * h_dim1;
		    i__7 = k + 3 + (k + 2) * h_dim1;
		    if (h__[i__5].r != 0. || h__[i__5].i != 0. || (h__[i__6]
			    .r != 0. || h__[i__6].i != 0.) || h__[i__7].r == 
			    0. && h__[i__7].i == 0.) {


			i__5 = k + 1 + k * h_dim1;
			h__[i__5].r = beta.r, h__[i__5].i = beta.i;
			i__5 = k + 2 + k * h_dim1;
			h__[i__5].r = 0., h__[i__5].i = 0.;
			i__5 = k + 3 + k * h_dim1;
			h__[i__5].r = 0., h__[i__5].i = 0.;
		    } else {


			if (zlaqr1_(interp, &zlaqr5_c__3, &h__[k + 1 + (k + 1) * h_dim1], ldh, &				s[(m << 1) - 1], &s[m * 2], vt)!=TCL_OK) { return TCL_ERROR; }


			alpha.r = vt[0].r, alpha.i = vt[0].i;
			if (zlarfg_(interp, &zlaqr5_c__3, &alpha, &vt[1], &zlaqr5_c__1, vt)!=TCL_OK) { return TCL_ERROR; }

			d_cnjg(&z__2, vt);
			i__5 = k + 1 + k * h_dim1;
			d_cnjg(&z__5, &vt[1]);
			i__6 = k + 2 + k * h_dim1;
			z__4.r = z__5.r * h__[i__6].r - z__5.i * h__[i__6].i, 
				z__4.i = z__5.r * h__[i__6].i + z__5.i * h__[
				i__6].r;
			z__3.r = h__[i__5].r + z__4.r, z__3.i = h__[i__5].i + 
				z__4.i;
			z__1.r = z__2.r * z__3.r - z__2.i * z__3.i, z__1.i = 
				z__2.r * z__3.i + z__2.i * z__3.r;
			refsum.r = z__1.r, refsum.i = z__1.i;

			i__5 = k + 2 + k * h_dim1;
			z__3.r = refsum.r * vt[1].r - refsum.i * vt[1].i, 
				z__3.i = refsum.r * vt[1].i + refsum.i * vt[1]
				.r;
			z__2.r = h__[i__5].r - z__3.r, z__2.i = h__[i__5].i - 
				z__3.i;
			z__1.r = z__2.r, z__1.i = z__2.i;
			z__5.r = refsum.r * vt[2].r - refsum.i * vt[2].i, 
				z__5.i = refsum.r * vt[2].i + refsum.i * vt[2]
				.r;
			z__4.r = z__5.r, z__4.i = z__5.i;
			i__6 = k + k * h_dim1;
			i__7 = k + 1 + (k + 1) * h_dim1;
			i__8 = k + 2 + (k + 2) * h_dim1;
			if ((d__1 = z__1.r, abs(d__1)) + (d__2 = d_imag(&z__1)
				, abs(d__2)) + ((d__3 = z__4.r, abs(d__3)) + (
				d__4 = d_imag(&z__4), abs(d__4))) > ulp * ((
				d__5 = h__[i__6].r, abs(d__5)) + (d__6 = 
				d_imag(&h__[k + k * h_dim1]), abs(d__6)) + ((
				d__7 = h__[i__7].r, abs(d__7)) + (d__8 = 
				d_imag(&h__[k + 1 + (k + 1) * h_dim1]), abs(
				d__8))) + ((d__9 = h__[i__8].r, abs(d__9)) + (
				d__10 = d_imag(&h__[k + 2 + (k + 2) * h_dim1])
				, abs(d__10))))) {


			    i__5 = k + 1 + k * h_dim1;
			    h__[i__5].r = beta.r, h__[i__5].i = beta.i;
			    i__5 = k + 2 + k * h_dim1;
			    h__[i__5].r = 0., h__[i__5].i = 0.;
			    i__5 = k + 3 + k * h_dim1;
			    h__[i__5].r = 0., h__[i__5].i = 0.;
			} else {


			    i__5 = k + 1 + k * h_dim1;
			    i__6 = k + 1 + k * h_dim1;
			    z__1.r = h__[i__6].r - refsum.r, z__1.i = h__[
				    i__6].i - refsum.i;
			    h__[i__5].r = z__1.r, h__[i__5].i = z__1.i;
			    i__5 = k + 2 + k * h_dim1;
			    h__[i__5].r = 0., h__[i__5].i = 0.;
			    i__5 = k + 3 + k * h_dim1;
			    h__[i__5].r = 0., h__[i__5].i = 0.;
			    i__5 = m * v_dim1 + 1;
			    v[i__5].r = vt[0].r, v[i__5].i = vt[0].i;
			    i__5 = m * v_dim1 + 2;
			    v[i__5].r = vt[1].r, v[i__5].i = vt[1].i;
			    i__5 = m * v_dim1 + 3;
			    v[i__5].r = vt[2].r, v[i__5].i = vt[2].i;
			}
		    }
		}
	    }


	    k = krcol + (m22 - 1) * 3;
	    if (bmp22) {
		if (k == *ktop - 1) {
		    if (zlaqr1_(interp, &zlaqr5_c__2, &h__[k + 1 + (k + 1) * h_dim1], ldh, &s[(			    m22 << 1) - 1], &s[m22 * 2], &v[m22 * v_dim1 + 1])
			    !=TCL_OK) { return TCL_ERROR; }


		    i__4 = m22 * v_dim1 + 1;
		    beta.r = v[i__4].r, beta.i = v[i__4].i;
		    if (zlarfg_(interp, &zlaqr5_c__2, &beta, &v[m22 * v_dim1 + 2], &zlaqr5_c__1, &v[m22 			    * v_dim1 + 1])!=TCL_OK) { return TCL_ERROR; }


		} else {
		    i__4 = k + 1 + k * h_dim1;
		    beta.r = h__[i__4].r, beta.i = h__[i__4].i;
		    i__4 = m22 * v_dim1 + 2;
		    i__5 = k + 2 + k * h_dim1;
		    v[i__4].r = h__[i__5].r, v[i__4].i = h__[i__5].i;
		    if (zlarfg_(interp, &zlaqr5_c__2, &beta, &v[m22 * v_dim1 + 2], &zlaqr5_c__1, &v[m22 			    * v_dim1 + 1])!=TCL_OK) { return TCL_ERROR; }


		    i__4 = k + 1 + k * h_dim1;
		    h__[i__4].r = beta.r, h__[i__4].i = beta.i;
		    i__4 = k + 2 + k * h_dim1;
		    h__[i__4].r = 0., h__[i__4].i = 0.;
		}
	    }


	    if (accum) {
		jbot = min(ndcol,*kbot);
	    } else if (*wantt) {
		jbot = *n;
	    } else {
		jbot = *kbot;
	    }
	    i__4 = jbot;
	    for (j = max(*ktop,krcol); j <= i__4; ++j) {
		i__5 = mbot, i__6 = (j - krcol + 2) / 3;
		mend = min(i__5,i__6);
		i__5 = mend;
		for (m = mtop; m <= i__5; ++m) {
		    k = krcol + (m - 1) * 3;
		    d_cnjg(&z__2, &v[m * v_dim1 + 1]);
		    i__6 = k + 1 + j * h_dim1;
		    d_cnjg(&z__6, &v[m * v_dim1 + 2]);
		    i__7 = k + 2 + j * h_dim1;
		    z__5.r = z__6.r * h__[i__7].r - z__6.i * h__[i__7].i, 
			    z__5.i = z__6.r * h__[i__7].i + z__6.i * h__[i__7]
			    .r;
		    z__4.r = h__[i__6].r + z__5.r, z__4.i = h__[i__6].i + 
			    z__5.i;
		    d_cnjg(&z__8, &v[m * v_dim1 + 3]);
		    i__8 = k + 3 + j * h_dim1;
		    z__7.r = z__8.r * h__[i__8].r - z__8.i * h__[i__8].i, 
			    z__7.i = z__8.r * h__[i__8].i + z__8.i * h__[i__8]
			    .r;
		    z__3.r = z__4.r + z__7.r, z__3.i = z__4.i + z__7.i;
		    z__1.r = z__2.r * z__3.r - z__2.i * z__3.i, z__1.i = 
			    z__2.r * z__3.i + z__2.i * z__3.r;
		    refsum.r = z__1.r, refsum.i = z__1.i;
		    i__6 = k + 1 + j * h_dim1;
		    i__7 = k + 1 + j * h_dim1;
		    z__1.r = h__[i__7].r - refsum.r, z__1.i = h__[i__7].i - 
			    refsum.i;
		    h__[i__6].r = z__1.r, h__[i__6].i = z__1.i;
		    i__6 = k + 2 + j * h_dim1;
		    i__7 = k + 2 + j * h_dim1;
		    i__8 = m * v_dim1 + 2;
		    z__2.r = refsum.r * v[i__8].r - refsum.i * v[i__8].i, 
			    z__2.i = refsum.r * v[i__8].i + refsum.i * v[i__8]
			    .r;
		    z__1.r = h__[i__7].r - z__2.r, z__1.i = h__[i__7].i - 
			    z__2.i;
		    h__[i__6].r = z__1.r, h__[i__6].i = z__1.i;
		    i__6 = k + 3 + j * h_dim1;
		    i__7 = k + 3 + j * h_dim1;
		    i__8 = m * v_dim1 + 3;
		    z__2.r = refsum.r * v[i__8].r - refsum.i * v[i__8].i, 
			    z__2.i = refsum.r * v[i__8].i + refsum.i * v[i__8]
			    .r;
		    z__1.r = h__[i__7].r - z__2.r, z__1.i = h__[i__7].i - 
			    z__2.i;
		    h__[i__6].r = z__1.r, h__[i__6].i = z__1.i;
		}
	    }
	    if (bmp22) {
		k = krcol + (m22 - 1) * 3;
		i__4 = k + 1;
		i__5 = jbot;
		for (j = max(i__4,*ktop); j <= i__5; ++j) {
		    d_cnjg(&z__2, &v[m22 * v_dim1 + 1]);
		    i__4 = k + 1 + j * h_dim1;
		    d_cnjg(&z__5, &v[m22 * v_dim1 + 2]);
		    i__6 = k + 2 + j * h_dim1;
		    z__4.r = z__5.r * h__[i__6].r - z__5.i * h__[i__6].i, 
			    z__4.i = z__5.r * h__[i__6].i + z__5.i * h__[i__6]
			    .r;
		    z__3.r = h__[i__4].r + z__4.r, z__3.i = h__[i__4].i + 
			    z__4.i;
		    z__1.r = z__2.r * z__3.r - z__2.i * z__3.i, z__1.i = 
			    z__2.r * z__3.i + z__2.i * z__3.r;
		    refsum.r = z__1.r, refsum.i = z__1.i;
		    i__4 = k + 1 + j * h_dim1;
		    i__6 = k + 1 + j * h_dim1;
		    z__1.r = h__[i__6].r - refsum.r, z__1.i = h__[i__6].i - 
			    refsum.i;
		    h__[i__4].r = z__1.r, h__[i__4].i = z__1.i;
		    i__4 = k + 2 + j * h_dim1;
		    i__6 = k + 2 + j * h_dim1;
		    i__7 = m22 * v_dim1 + 2;
		    z__2.r = refsum.r * v[i__7].r - refsum.i * v[i__7].i, 
			    z__2.i = refsum.r * v[i__7].i + refsum.i * v[i__7]
			    .r;
		    z__1.r = h__[i__6].r - z__2.r, z__1.i = h__[i__6].i - 
			    z__2.i;
		    h__[i__4].r = z__1.r, h__[i__4].i = z__1.i;
		}
	    }


	    if (accum) {
		jtop = max(*ktop,incol);
	    } else if (*wantt) {
		jtop = 1;
	    } else {
		jtop = *ktop;
	    }
	    i__5 = mbot;
	    for (m = mtop; m <= i__5; ++m) {
		i__4 = m * v_dim1 + 1;
		if (v[i__4].r != 0. || v[i__4].i != 0.) {
		    k = krcol + (m - 1) * 3;
		    i__6 = *kbot, i__7 = k + 3;
		    i__4 = min(i__6,i__7);
		    for (j = jtop; j <= i__4; ++j) {
			i__6 = m * v_dim1 + 1;
			i__7 = j + (k + 1) * h_dim1;
			i__8 = m * v_dim1 + 2;
			i__9 = j + (k + 2) * h_dim1;
			z__4.r = v[i__8].r * h__[i__9].r - v[i__8].i * h__[
				i__9].i, z__4.i = v[i__8].r * h__[i__9].i + v[
				i__8].i * h__[i__9].r;
			z__3.r = h__[i__7].r + z__4.r, z__3.i = h__[i__7].i + 
				z__4.i;
			i__10 = m * v_dim1 + 3;
			i__11 = j + (k + 3) * h_dim1;
			z__5.r = v[i__10].r * h__[i__11].r - v[i__10].i * h__[
				i__11].i, z__5.i = v[i__10].r * h__[i__11].i 
				+ v[i__10].i * h__[i__11].r;
			z__2.r = z__3.r + z__5.r, z__2.i = z__3.i + z__5.i;
			z__1.r = v[i__6].r * z__2.r - v[i__6].i * z__2.i, 
				z__1.i = v[i__6].r * z__2.i + v[i__6].i * 
				z__2.r;
			refsum.r = z__1.r, refsum.i = z__1.i;
			i__6 = j + (k + 1) * h_dim1;
			i__7 = j + (k + 1) * h_dim1;
			z__1.r = h__[i__7].r - refsum.r, z__1.i = h__[i__7].i 
				- refsum.i;
			h__[i__6].r = z__1.r, h__[i__6].i = z__1.i;
			i__6 = j + (k + 2) * h_dim1;
			i__7 = j + (k + 2) * h_dim1;
			d_cnjg(&z__3, &v[m * v_dim1 + 2]);
			z__2.r = refsum.r * z__3.r - refsum.i * z__3.i, 
				z__2.i = refsum.r * z__3.i + refsum.i * 
				z__3.r;
			z__1.r = h__[i__7].r - z__2.r, z__1.i = h__[i__7].i - 
				z__2.i;
			h__[i__6].r = z__1.r, h__[i__6].i = z__1.i;
			i__6 = j + (k + 3) * h_dim1;
			i__7 = j + (k + 3) * h_dim1;
			d_cnjg(&z__3, &v[m * v_dim1 + 3]);
			z__2.r = refsum.r * z__3.r - refsum.i * z__3.i, 
				z__2.i = refsum.r * z__3.i + refsum.i * 
				z__3.r;
			z__1.r = h__[i__7].r - z__2.r, z__1.i = h__[i__7].i - 
				z__2.i;
			h__[i__6].r = z__1.r, h__[i__6].i = z__1.i;
		    }

		    if (accum) {


			kms = k - incol;
			i__4 = 1, i__6 = *ktop - incol;
			i__7 = kdu;
			for (j = max(i__4,i__6); j <= i__7; ++j) {
			    i__4 = m * v_dim1 + 1;
			    i__6 = j + (kms + 1) * u_dim1;
			    i__8 = m * v_dim1 + 2;
			    i__9 = j + (kms + 2) * u_dim1;
			    z__4.r = v[i__8].r * u[i__9].r - v[i__8].i * u[
				    i__9].i, z__4.i = v[i__8].r * u[i__9].i + 
				    v[i__8].i * u[i__9].r;
			    z__3.r = u[i__6].r + z__4.r, z__3.i = u[i__6].i + 
				    z__4.i;
			    i__10 = m * v_dim1 + 3;
			    i__11 = j + (kms + 3) * u_dim1;
			    z__5.r = v[i__10].r * u[i__11].r - v[i__10].i * u[
				    i__11].i, z__5.i = v[i__10].r * u[i__11]
				    .i + v[i__10].i * u[i__11].r;
			    z__2.r = z__3.r + z__5.r, z__2.i = z__3.i + 
				    z__5.i;
			    z__1.r = v[i__4].r * z__2.r - v[i__4].i * z__2.i, 
				    z__1.i = v[i__4].r * z__2.i + v[i__4].i * 
				    z__2.r;
			    refsum.r = z__1.r, refsum.i = z__1.i;
			    i__4 = j + (kms + 1) * u_dim1;
			    i__6 = j + (kms + 1) * u_dim1;
			    z__1.r = u[i__6].r - refsum.r, z__1.i = u[i__6].i 
				    - refsum.i;
			    u[i__4].r = z__1.r, u[i__4].i = z__1.i;
			    i__4 = j + (kms + 2) * u_dim1;
			    i__6 = j + (kms + 2) * u_dim1;
			    d_cnjg(&z__3, &v[m * v_dim1 + 2]);
			    z__2.r = refsum.r * z__3.r - refsum.i * z__3.i, 
				    z__2.i = refsum.r * z__3.i + refsum.i * 
				    z__3.r;
			    z__1.r = u[i__6].r - z__2.r, z__1.i = u[i__6].i - 
				    z__2.i;
			    u[i__4].r = z__1.r, u[i__4].i = z__1.i;
			    i__4 = j + (kms + 3) * u_dim1;
			    i__6 = j + (kms + 3) * u_dim1;
			    d_cnjg(&z__3, &v[m * v_dim1 + 3]);
			    z__2.r = refsum.r * z__3.r - refsum.i * z__3.i, 
				    z__2.i = refsum.r * z__3.i + refsum.i * 
				    z__3.r;
			    z__1.r = u[i__6].r - z__2.r, z__1.i = u[i__6].i - 
				    z__2.i;
			    u[i__4].r = z__1.r, u[i__4].i = z__1.i;
			}
		    } else if (*wantz) {


			i__7 = *ihiz;
			for (j = *iloz; j <= i__7; ++j) {
			    i__4 = m * v_dim1 + 1;
			    i__6 = j + (k + 1) * z_dim1;
			    i__8 = m * v_dim1 + 2;
			    i__9 = j + (k + 2) * z_dim1;
			    z__4.r = v[i__8].r * z__[i__9].r - v[i__8].i * 
				    z__[i__9].i, z__4.i = v[i__8].r * z__[
				    i__9].i + v[i__8].i * z__[i__9].r;
			    z__3.r = z__[i__6].r + z__4.r, z__3.i = z__[i__6]
				    .i + z__4.i;
			    i__10 = m * v_dim1 + 3;
			    i__11 = j + (k + 3) * z_dim1;
			    z__5.r = v[i__10].r * z__[i__11].r - v[i__10].i * 
				    z__[i__11].i, z__5.i = v[i__10].r * z__[
				    i__11].i + v[i__10].i * z__[i__11].r;
			    z__2.r = z__3.r + z__5.r, z__2.i = z__3.i + 
				    z__5.i;
			    z__1.r = v[i__4].r * z__2.r - v[i__4].i * z__2.i, 
				    z__1.i = v[i__4].r * z__2.i + v[i__4].i * 
				    z__2.r;
			    refsum.r = z__1.r, refsum.i = z__1.i;
			    i__4 = j + (k + 1) * z_dim1;
			    i__6 = j + (k + 1) * z_dim1;
			    z__1.r = z__[i__6].r - refsum.r, z__1.i = z__[
				    i__6].i - refsum.i;
			    z__[i__4].r = z__1.r, z__[i__4].i = z__1.i;
			    i__4 = j + (k + 2) * z_dim1;
			    i__6 = j + (k + 2) * z_dim1;
			    d_cnjg(&z__3, &v[m * v_dim1 + 2]);
			    z__2.r = refsum.r * z__3.r - refsum.i * z__3.i, 
				    z__2.i = refsum.r * z__3.i + refsum.i * 
				    z__3.r;
			    z__1.r = z__[i__6].r - z__2.r, z__1.i = z__[i__6]
				    .i - z__2.i;
			    z__[i__4].r = z__1.r, z__[i__4].i = z__1.i;
			    i__4 = j + (k + 3) * z_dim1;
			    i__6 = j + (k + 3) * z_dim1;
			    d_cnjg(&z__3, &v[m * v_dim1 + 3]);
			    z__2.r = refsum.r * z__3.r - refsum.i * z__3.i, 
				    z__2.i = refsum.r * z__3.i + refsum.i * 
				    z__3.r;
			    z__1.r = z__[i__6].r - z__2.r, z__1.i = z__[i__6]
				    .i - z__2.i;
			    z__[i__4].r = z__1.r, z__[i__4].i = z__1.i;
			}
		    }
		}
	    }


	    k = krcol + (m22 - 1) * 3;
	    i__5 = m22 * v_dim1 + 1;
	    if (bmp22 && (v[i__5].r != 0. || v[i__5].i != 0.)) {
		i__7 = *kbot, i__4 = k + 3;
		i__5 = min(i__7,i__4);
		for (j = jtop; j <= i__5; ++j) {
		    i__7 = m22 * v_dim1 + 1;
		    i__4 = j + (k + 1) * h_dim1;
		    i__6 = m22 * v_dim1 + 2;
		    i__8 = j + (k + 2) * h_dim1;
		    z__3.r = v[i__6].r * h__[i__8].r - v[i__6].i * h__[i__8]
			    .i, z__3.i = v[i__6].r * h__[i__8].i + v[i__6].i *
			     h__[i__8].r;
		    z__2.r = h__[i__4].r + z__3.r, z__2.i = h__[i__4].i + 
			    z__3.i;
		    z__1.r = v[i__7].r * z__2.r - v[i__7].i * z__2.i, z__1.i =
			     v[i__7].r * z__2.i + v[i__7].i * z__2.r;
		    refsum.r = z__1.r, refsum.i = z__1.i;
		    i__7 = j + (k + 1) * h_dim1;
		    i__4 = j + (k + 1) * h_dim1;
		    z__1.r = h__[i__4].r - refsum.r, z__1.i = h__[i__4].i - 
			    refsum.i;
		    h__[i__7].r = z__1.r, h__[i__7].i = z__1.i;
		    i__7 = j + (k + 2) * h_dim1;
		    i__4 = j + (k + 2) * h_dim1;
		    d_cnjg(&z__3, &v[m22 * v_dim1 + 2]);
		    z__2.r = refsum.r * z__3.r - refsum.i * z__3.i, z__2.i = 
			    refsum.r * z__3.i + refsum.i * z__3.r;
		    z__1.r = h__[i__4].r - z__2.r, z__1.i = h__[i__4].i - 
			    z__2.i;
		    h__[i__7].r = z__1.r, h__[i__7].i = z__1.i;
		}

		if (accum) {
		    kms = k - incol;
		    i__5 = 1, i__7 = *ktop - incol;
		    i__4 = kdu;
		    for (j = max(i__5,i__7); j <= i__4; ++j) {
			i__5 = m22 * v_dim1 + 1;
			i__7 = j + (kms + 1) * u_dim1;
			i__6 = m22 * v_dim1 + 2;
			i__8 = j + (kms + 2) * u_dim1;
			z__3.r = v[i__6].r * u[i__8].r - v[i__6].i * u[i__8]
				.i, z__3.i = v[i__6].r * u[i__8].i + v[i__6]
				.i * u[i__8].r;
			z__2.r = u[i__7].r + z__3.r, z__2.i = u[i__7].i + 
				z__3.i;
			z__1.r = v[i__5].r * z__2.r - v[i__5].i * z__2.i, 
				z__1.i = v[i__5].r * z__2.i + v[i__5].i * 
				z__2.r;
			refsum.r = z__1.r, refsum.i = z__1.i;
			i__5 = j + (kms + 1) * u_dim1;
			i__7 = j + (kms + 1) * u_dim1;
			z__1.r = u[i__7].r - refsum.r, z__1.i = u[i__7].i - 
				refsum.i;
			u[i__5].r = z__1.r, u[i__5].i = z__1.i;
			i__5 = j + (kms + 2) * u_dim1;
			i__7 = j + (kms + 2) * u_dim1;
			d_cnjg(&z__3, &v[m22 * v_dim1 + 2]);
			z__2.r = refsum.r * z__3.r - refsum.i * z__3.i, 
				z__2.i = refsum.r * z__3.i + refsum.i * 
				z__3.r;
			z__1.r = u[i__7].r - z__2.r, z__1.i = u[i__7].i - 
				z__2.i;
			u[i__5].r = z__1.r, u[i__5].i = z__1.i;
		    }
		} else if (*wantz) {
		    i__4 = *ihiz;
		    for (j = *iloz; j <= i__4; ++j) {
			i__5 = m22 * v_dim1 + 1;
			i__7 = j + (k + 1) * z_dim1;
			i__6 = m22 * v_dim1 + 2;
			i__8 = j + (k + 2) * z_dim1;
			z__3.r = v[i__6].r * z__[i__8].r - v[i__6].i * z__[
				i__8].i, z__3.i = v[i__6].r * z__[i__8].i + v[
				i__6].i * z__[i__8].r;
			z__2.r = z__[i__7].r + z__3.r, z__2.i = z__[i__7].i + 
				z__3.i;
			z__1.r = v[i__5].r * z__2.r - v[i__5].i * z__2.i, 
				z__1.i = v[i__5].r * z__2.i + v[i__5].i * 
				z__2.r;
			refsum.r = z__1.r, refsum.i = z__1.i;
			i__5 = j + (k + 1) * z_dim1;
			i__7 = j + (k + 1) * z_dim1;
			z__1.r = z__[i__7].r - refsum.r, z__1.i = z__[i__7].i 
				- refsum.i;
			z__[i__5].r = z__1.r, z__[i__5].i = z__1.i;
			i__5 = j + (k + 2) * z_dim1;
			i__7 = j + (k + 2) * z_dim1;
			d_cnjg(&z__3, &v[m22 * v_dim1 + 2]);
			z__2.r = refsum.r * z__3.r - refsum.i * z__3.i, 
				z__2.i = refsum.r * z__3.i + refsum.i * 
				z__3.r;
			z__1.r = z__[i__7].r - z__2.r, z__1.i = z__[i__7].i - 
				z__2.i;
			z__[i__5].r = z__1.r, z__[i__5].i = z__1.i;
		    }
		}
	    }


	    mstart = mtop;
	    if (krcol + (mstart - 1) * 3 < *ktop) {
		++mstart;
	    }
	    mend = mbot;
	    if (bmp22) {
		++mend;
	    }
	    if (krcol == *kbot - 2) {
		++mend;
	    }
	    i__4 = mend;
	    for (m = mstart; m <= i__4; ++m) {
		i__5 = *kbot - 1, i__7 = krcol + (m - 1) * 3;
		k = min(i__5,i__7);


		i__5 = k + 1 + k * h_dim1;
		if (h__[i__5].r != 0. || h__[i__5].i != 0.) {
		    i__5 = k + k * h_dim1;
		    i__7 = k + 1 + (k + 1) * h_dim1;
		    tst1 = (d__1 = h__[i__5].r, abs(d__1)) + (d__2 = d_imag(&
			    h__[k + k * h_dim1]), abs(d__2)) + ((d__3 = h__[
			    i__7].r, abs(d__3)) + (d__4 = d_imag(&h__[k + 1 + 
			    (k + 1) * h_dim1]), abs(d__4)));
		    if (tst1 == 0.) {
			if (k >= *ktop + 1) {
			    i__5 = k + (k - 1) * h_dim1;
			    tst1 += (d__1 = h__[i__5].r, abs(d__1)) + (d__2 = 
				    d_imag(&h__[k + (k - 1) * h_dim1]), abs(
				    d__2));
			}
			if (k >= *ktop + 2) {
			    i__5 = k + (k - 2) * h_dim1;
			    tst1 += (d__1 = h__[i__5].r, abs(d__1)) + (d__2 = 
				    d_imag(&h__[k + (k - 2) * h_dim1]), abs(
				    d__2));
			}
			if (k >= *ktop + 3) {
			    i__5 = k + (k - 3) * h_dim1;
			    tst1 += (d__1 = h__[i__5].r, abs(d__1)) + (d__2 = 
				    d_imag(&h__[k + (k - 3) * h_dim1]), abs(
				    d__2));
			}
			if (k <= *kbot - 2) {
			    i__5 = k + 2 + (k + 1) * h_dim1;
			    tst1 += (d__1 = h__[i__5].r, abs(d__1)) + (d__2 = 
				    d_imag(&h__[k + 2 + (k + 1) * h_dim1]), 
				    abs(d__2));
			}
			if (k <= *kbot - 3) {
			    i__5 = k + 3 + (k + 1) * h_dim1;
			    tst1 += (d__1 = h__[i__5].r, abs(d__1)) + (d__2 = 
				    d_imag(&h__[k + 3 + (k + 1) * h_dim1]), 
				    abs(d__2));
			}
			if (k <= *kbot - 4) {
			    i__5 = k + 4 + (k + 1) * h_dim1;
			    tst1 += (d__1 = h__[i__5].r, abs(d__1)) + (d__2 = 
				    d_imag(&h__[k + 4 + (k + 1) * h_dim1]), 
				    abs(d__2));
			}
		    }
		    i__5 = k + 1 + k * h_dim1;
		    d__3 = smlnum, d__4 = ulp * tst1;
		    if ((d__1 = h__[i__5].r, abs(d__1)) + (d__2 = d_imag(&h__[
			    k + 1 + k * h_dim1]), abs(d__2)) <= max(d__3,d__4)
			    ) {
			i__5 = k + 1 + k * h_dim1;
			i__7 = k + (k + 1) * h_dim1;
			d__5 = (d__1 = h__[i__5].r, abs(d__1)) + (d__2 = 
				d_imag(&h__[k + 1 + k * h_dim1]), abs(d__2)), 
				d__6 = (d__3 = h__[i__7].r, abs(d__3)) + (
				d__4 = d_imag(&h__[k + (k + 1) * h_dim1]), 
				abs(d__4));
			h12 = max(d__5,d__6);
			i__5 = k + 1 + k * h_dim1;
			i__7 = k + (k + 1) * h_dim1;
			d__5 = (d__1 = h__[i__5].r, abs(d__1)) + (d__2 = 
				d_imag(&h__[k + 1 + k * h_dim1]), abs(d__2)), 
				d__6 = (d__3 = h__[i__7].r, abs(d__3)) + (
				d__4 = d_imag(&h__[k + (k + 1) * h_dim1]), 
				abs(d__4));
			h21 = min(d__5,d__6);
			i__5 = k + k * h_dim1;
			i__7 = k + 1 + (k + 1) * h_dim1;
			z__2.r = h__[i__5].r - h__[i__7].r, z__2.i = h__[i__5]
				.i - h__[i__7].i;
			z__1.r = z__2.r, z__1.i = z__2.i;
			i__6 = k + 1 + (k + 1) * h_dim1;
			d__5 = (d__1 = h__[i__6].r, abs(d__1)) + (d__2 = 
				d_imag(&h__[k + 1 + (k + 1) * h_dim1]), abs(
				d__2)), d__6 = (d__3 = z__1.r, abs(d__3)) + (
				d__4 = d_imag(&z__1), abs(d__4));
			h11 = max(d__5,d__6);
			i__5 = k + k * h_dim1;
			i__7 = k + 1 + (k + 1) * h_dim1;
			z__2.r = h__[i__5].r - h__[i__7].r, z__2.i = h__[i__5]
				.i - h__[i__7].i;
			z__1.r = z__2.r, z__1.i = z__2.i;
			i__6 = k + 1 + (k + 1) * h_dim1;
			d__5 = (d__1 = h__[i__6].r, abs(d__1)) + (d__2 = 
				d_imag(&h__[k + 1 + (k + 1) * h_dim1]), abs(
				d__2)), d__6 = (d__3 = z__1.r, abs(d__3)) + (
				d__4 = d_imag(&z__1), abs(d__4));
			h22 = min(d__5,d__6);
			scl = h11 + h12;
			tst2 = h22 * (h11 / scl);

			d__1 = smlnum, d__2 = ulp * tst2;
			if (tst2 == 0. || h21 * (h12 / scl) <= max(d__1,d__2))
				 {
			    i__5 = k + 1 + k * h_dim1;
			    h__[i__5].r = 0., h__[i__5].i = 0.;
			}
		    }
		}
	    }


	    i__4 = nbmps, i__5 = (*kbot - krcol - 1) / 3;
	    mend = min(i__4,i__5);
	    i__4 = mend;
	    for (m = mtop; m <= i__4; ++m) {
		k = krcol + (m - 1) * 3;
		i__5 = m * v_dim1 + 1;
		i__7 = m * v_dim1 + 3;
		z__2.r = v[i__5].r * v[i__7].r - v[i__5].i * v[i__7].i, 
			z__2.i = v[i__5].r * v[i__7].i + v[i__5].i * v[i__7]
			.r;
		i__6 = k + 4 + (k + 3) * h_dim1;
		z__1.r = z__2.r * h__[i__6].r - z__2.i * h__[i__6].i, z__1.i =
			 z__2.r * h__[i__6].i + z__2.i * h__[i__6].r;
		refsum.r = z__1.r, refsum.i = z__1.i;
		i__5 = k + 4 + (k + 1) * h_dim1;
		z__1.r = -refsum.r, z__1.i = -refsum.i;
		h__[i__5].r = z__1.r, h__[i__5].i = z__1.i;
		i__5 = k + 4 + (k + 2) * h_dim1;
		z__2.r = -refsum.r, z__2.i = -refsum.i;
		d_cnjg(&z__3, &v[m * v_dim1 + 2]);
		z__1.r = z__2.r * z__3.r - z__2.i * z__3.i, z__1.i = z__2.r * 
			z__3.i + z__2.i * z__3.r;
		h__[i__5].r = z__1.r, h__[i__5].i = z__1.i;
		i__5 = k + 4 + (k + 3) * h_dim1;
		i__7 = k + 4 + (k + 3) * h_dim1;
		d_cnjg(&z__3, &v[m * v_dim1 + 3]);
		z__2.r = refsum.r * z__3.r - refsum.i * z__3.i, z__2.i = 
			refsum.r * z__3.i + refsum.i * z__3.r;
		z__1.r = h__[i__7].r - z__2.r, z__1.i = h__[i__7].i - z__2.i;
		h__[i__5].r = z__1.r, h__[i__5].i = z__1.i;
	    }


	}


	if (accum) {
	    if (*wantt) {
		jtop = 1;
		jbot = *n;
	    } else {
		jtop = *ktop;
		jbot = *kbot;
	    }
	    if (! blk22 || incol < *ktop || ndcol > *kbot || ns <= 2) {


		i__3 = 1, i__4 = *ktop - incol;
		k1 = max(i__3,i__4);
		i__3 = 0, i__4 = ndcol - *kbot;
		nu = kdu - max(i__3,i__4) - k1 + 1;


		i__3 = jbot;
		i__4 = *nh;
		for (jcol = min(ndcol,*kbot) + 1; i__4 < 0 ? jcol >= i__3 : 
			jcol <= i__3; jcol += i__4) {
		    i__5 = *nh, i__7 = jbot - jcol + 1;
		    jlen = min(i__5,i__7);
		    if (zgemm_(interp, "C", "N", &nu, &jlen, &nu, &zlaqr5_c_b2, &u[k1 + k1 * 			    u_dim1], ldu, &h__[incol + k1 + jcol * h_dim1], 
			    ldh, &zlaqr5_c_b1, &wh[wh_offset], ldwh)!=TCL_OK) { return TCL_ERROR; }


		    if (zlacpy_(interp, "ALL", &nu, &jlen, &wh[wh_offset], ldwh, &h__[			    incol + k1 + jcol * h_dim1], ldh)!=TCL_OK) { return TCL_ERROR; }


		}


		i__4 = max(*ktop,incol) - 1;
		i__3 = *nv;
		for (jrow = jtop; i__3 < 0 ? jrow >= i__4 : jrow <= i__4; 
			jrow += i__3) {
		    i__5 = *nv, i__7 = max(*ktop,incol) - jrow;
		    jlen = min(i__5,i__7);
		    if (zgemm_(interp, "N", "N", &jlen, &nu, &nu, &zlaqr5_c_b2, &h__[jrow + (			    incol + k1) * h_dim1], ldh, &u[k1 + k1 * u_dim1], 
			    ldu, &zlaqr5_c_b1, &wv[wv_offset], ldwv)!=TCL_OK) { return TCL_ERROR; }


		    if (zlacpy_(interp, "ALL", &jlen, &nu, &wv[wv_offset], ldwv, &h__[			    jrow + (incol + k1) * h_dim1], ldh)!=TCL_OK) { return TCL_ERROR; }


		}


		if (*wantz) {
		    i__3 = *ihiz;
		    i__4 = *nv;
		    for (jrow = *iloz; i__4 < 0 ? jrow >= i__3 : jrow <= i__3;
			     jrow += i__4) {
			i__5 = *nv, i__7 = *ihiz - jrow + 1;
			jlen = min(i__5,i__7);
			if (zgemm_(interp, "N", "N", &jlen, &nu, &nu, &zlaqr5_c_b2, &z__[jrow + (				incol + k1) * z_dim1], ldz, &u[k1 + k1 * 
				u_dim1], ldu, &zlaqr5_c_b1, &wv[wv_offset], ldwv)!=TCL_OK) { return TCL_ERROR; }


			if (zlacpy_(interp, "ALL", &jlen, &nu, &wv[wv_offset], ldwv, &z__[				jrow + (incol + k1) * z_dim1], ldz)
				!=TCL_OK) { return TCL_ERROR; }


		    }
		}
	    } else {


		i2 = (kdu + 1) / 2;
		i4 = kdu;
		j2 = i4 - i2;
		j4 = kdu;


		kzs = j4 - j2 - (ns + 1);
		knz = ns + 1;


		i__4 = jbot;
		i__3 = *nh;
		for (jcol = min(ndcol,*kbot) + 1; i__3 < 0 ? jcol >= i__4 : 
			jcol <= i__4; jcol += i__3) {
		    i__5 = *nh, i__7 = jbot - jcol + 1;
		    jlen = min(i__5,i__7);


		    if (zlacpy_(interp, "ALL", &knz, &jlen, &h__[incol + 1 + j2 + jcol * 			    h_dim1], ldh, &wh[kzs + 1 + wh_dim1], ldwh)!=TCL_OK) { return TCL_ERROR; }




		    if (zlaset_(interp, "ALL", &kzs, &jlen, &zlaqr5_c_b1, &zlaqr5_c_b1, &wh[wh_offset], 			    ldwh)!=TCL_OK) { return TCL_ERROR; }


		    if (ztrmm_(interp, "L", "U", "C", "N", &knz, &jlen, &zlaqr5_c_b2, &u[j2 + 1 			    + (kzs + 1) * u_dim1], ldu, &wh[kzs + 1 + wh_dim1]
, ldwh)!=TCL_OK) { return TCL_ERROR; }




		    if (zgemm_(interp, "C", "N", &i2, &jlen, &j2, &zlaqr5_c_b2, &u[u_offset], 			    ldu, &h__[incol + 1 + jcol * h_dim1], ldh, &zlaqr5_c_b2, 
			    &wh[wh_offset], ldwh)!=TCL_OK) { return TCL_ERROR; }




		    if (zlacpy_(interp, "ALL", &j2, &jlen, &h__[incol + 1 + jcol * h_dim1], ldh, &wh[i2 + 1 + wh_dim1], ldwh)!=TCL_OK) { return TCL_ERROR; }




		    if (ztrmm_(interp, "L", "L", "C", "N", &j2, &jlen, &zlaqr5_c_b2, &u[(i2 + 1) 			    * u_dim1 + 1], ldu, &wh[i2 + 1 + wh_dim1], ldwh)!=TCL_OK) { return TCL_ERROR; }




		    i__5 = i4 - i2;
		    i__7 = j4 - j2;
		    if (zgemm_(interp, "C", "N", &i__5, &jlen, &i__7, &zlaqr5_c_b2, &u[j2 + 1 + (			    i2 + 1) * u_dim1], ldu, &h__[incol + 1 + j2 + 
			    jcol * h_dim1], ldh, &zlaqr5_c_b2, &wh[i2 + 1 + wh_dim1], 
			     ldwh)!=TCL_OK) { return TCL_ERROR; }




		    if (zlacpy_(interp, "ALL", &kdu, &jlen, &wh[wh_offset], ldwh, &h__[			    incol + 1 + jcol * h_dim1], ldh)!=TCL_OK) { return TCL_ERROR; }


		}


		i__3 = max(incol,*ktop) - 1;
		i__4 = *nv;
		for (jrow = jtop; i__4 < 0 ? jrow >= i__3 : jrow <= i__3; 
			jrow += i__4) {
		    i__5 = *nv, i__7 = max(incol,*ktop) - jrow;
		    jlen = min(i__5,i__7);


		    if (zlacpy_(interp, "ALL", &jlen, &knz, &h__[jrow + (incol + 1 + j2) *			     h_dim1], ldh, &wv[(kzs + 1) * wv_dim1 + 1], ldwv)!=TCL_OK) { return TCL_ERROR; }




		    if (zlaset_(interp, "ALL", &jlen, &kzs, &zlaqr5_c_b1, &zlaqr5_c_b1, &wv[wv_offset], 			    ldwv)!=TCL_OK) { return TCL_ERROR; }


		    if (ztrmm_(interp, "R", "U", "N", "N", &jlen, &knz, &zlaqr5_c_b2, &u[j2 + 1 			    + (kzs + 1) * u_dim1], ldu, &wv[(kzs + 1) * 
			    wv_dim1 + 1], ldwv)!=TCL_OK) { return TCL_ERROR; }




		    if (zgemm_(interp, "N", "N", &jlen, &i2, &j2, &zlaqr5_c_b2, &h__[jrow + (			    incol + 1) * h_dim1], ldh, &u[u_offset], ldu, &
			    zlaqr5_c_b2, &wv[wv_offset], ldwv)!=TCL_OK) { return TCL_ERROR; }




		    if (zlacpy_(interp, "ALL", &jlen, &j2, &h__[jrow + (incol + 1) * 			    h_dim1], ldh, &wv[(i2 + 1) * wv_dim1 + 1], ldwv)!=TCL_OK) { return TCL_ERROR; }




		    i__5 = i4 - i2;
		    if (ztrmm_(interp, "R", "L", "N", "N", &jlen, &i__5, &zlaqr5_c_b2, &u[(i2 + 			    1) * u_dim1 + 1], ldu, &wv[(i2 + 1) * wv_dim1 + 1]
, ldwv)!=TCL_OK) { return TCL_ERROR; }




		    i__5 = i4 - i2;
		    i__7 = j4 - j2;
		    if (zgemm_(interp, "N", "N", &jlen, &i__5, &i__7, &zlaqr5_c_b2, &h__[jrow + (			    incol + 1 + j2) * h_dim1], ldh, &u[j2 + 1 + (i2 + 
			    1) * u_dim1], ldu, &zlaqr5_c_b2, &wv[(i2 + 1) * wv_dim1 
			    + 1], ldwv)!=TCL_OK) { return TCL_ERROR; }




		    if (zlacpy_(interp, "ALL", &jlen, &kdu, &wv[wv_offset], ldwv, &h__[			    jrow + (incol + 1) * h_dim1], ldh)!=TCL_OK) { return TCL_ERROR; }


		}


		if (*wantz) {
		    i__4 = *ihiz;
		    i__3 = *nv;
		    for (jrow = *iloz; i__3 < 0 ? jrow >= i__4 : jrow <= i__4;
			     jrow += i__3) {
			i__5 = *nv, i__7 = *ihiz - jrow + 1;
			jlen = min(i__5,i__7);


			if (zlacpy_(interp, "ALL", &jlen, &knz, &z__[jrow + (incol + 1 + 				j2) * z_dim1], ldz, &wv[(kzs + 1) * wv_dim1 + 
				1], ldwv)!=TCL_OK) { return TCL_ERROR; }




			if (zlaset_(interp, "ALL", &jlen, &kzs, &zlaqr5_c_b1, &zlaqr5_c_b1, &wv[				wv_offset], ldwv)!=TCL_OK) { return TCL_ERROR; }


			if (ztrmm_(interp, "R", "U", "N", "N", &jlen, &knz, &zlaqr5_c_b2, &u[j2 				+ 1 + (kzs + 1) * u_dim1], ldu, &wv[(kzs + 1) 
				* wv_dim1 + 1], ldwv)!=TCL_OK) { return TCL_ERROR; }




			if (zgemm_(interp, "N", "N", &jlen, &i2, &j2, &zlaqr5_c_b2, &z__[jrow + (				incol + 1) * z_dim1], ldz, &u[u_offset], ldu, 
				&zlaqr5_c_b2, &wv[wv_offset], ldwv)!=TCL_OK) { return TCL_ERROR; }




			if (zlacpy_(interp, "ALL", &jlen, &j2, &z__[jrow + (incol + 1) * 				z_dim1], ldz, &wv[(i2 + 1) * wv_dim1 + 1], 
				ldwv)!=TCL_OK) { return TCL_ERROR; }




			i__5 = i4 - i2;
			if (ztrmm_(interp, "R", "L", "N", "N", &jlen, &i__5, &zlaqr5_c_b2, &u[(				i2 + 1) * u_dim1 + 1], ldu, &wv[(i2 + 1) * 
				wv_dim1 + 1], ldwv)!=TCL_OK) { return TCL_ERROR; }




			i__5 = i4 - i2;
			i__7 = j4 - j2;
			if (zgemm_(interp, "N", "N", &jlen, &i__5, &i__7, &zlaqr5_c_b2, &z__[				jrow + (incol + 1 + j2) * z_dim1], ldz, &u[j2 
				+ 1 + (i2 + 1) * u_dim1], ldu, &zlaqr5_c_b2, &wv[(i2 
				+ 1) * wv_dim1 + 1], ldwv)!=TCL_OK) { return TCL_ERROR; }




			if (zlacpy_(interp, "ALL", &jlen, &kdu, &wv[wv_offset], ldwv, &				z__[jrow + (incol + 1) * z_dim1], ldz)!=TCL_OK) { return TCL_ERROR; }


		    }
		}
	    }
	}
    }


return TCL_OK;
} /* zlaqr5_ */
static /* Double Complex */ VOID zladiv_ (doublecomplex * ret_val, doublecomplex *x, 	doublecomplex *y)
{
    doublereal d__1, d__2, d__3, d__4;
    doublecomplex z__1;

    double d_imag(doublecomplex *);

    doublereal zi, zr;










    d__1 = x->r;
    d__2 = d_imag(x);
    d__3 = y->r;
    d__4 = d_imag(y);
    dladiv_(NULL, &d__1, &d__2, &d__3, &d__4, &zr, &zi);
    z__1.r = zr, z__1.i = zi;
     ret_val->r = z__1.r,  ret_val->i = z__1.i;

    return ;


} /* zladiv_ */
static /* Double Complex */ VOID zdotu_ (doublecomplex * ret_val, integer *n, 	doublecomplex *zx, integer *incx, doublecomplex *zy, integer *incy)
{
    integer i__1, i__2, i__3;
    doublecomplex z__1, z__2;

    integer i__, ix, iy;
    doublecomplex ztemp;






    --zy;
    --zx;

    ztemp.r = 0., ztemp.i = 0.;
     ret_val->r = 0.,  ret_val->i = 0.;
    if (*n <= 0) {
	return ;
    }
    if (*incx == 1 && *incy == 1) {
	goto L20;
    }


    ix = 1;
    iy = 1;
    if (*incx < 0) {
	ix = (-(*n) + 1) * *incx + 1;
    }
    if (*incy < 0) {
	iy = (-(*n) + 1) * *incy + 1;
    }
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	i__2 = ix;
	i__3 = iy;
	z__2.r = zx[i__2].r * zy[i__3].r - zx[i__2].i * zy[i__3].i, z__2.i = 
		zx[i__2].r * zy[i__3].i + zx[i__2].i * zy[i__3].r;
	z__1.r = ztemp.r + z__2.r, z__1.i = ztemp.i + z__2.i;
	ztemp.r = z__1.r, ztemp.i = z__1.i;
	ix += *incx;
	iy += *incy;
    }
     ret_val->r = ztemp.r,  ret_val->i = ztemp.i;
    return ;


L20:
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	i__2 = i__;
	i__3 = i__;
	z__2.r = zx[i__2].r * zy[i__3].r - zx[i__2].i * zy[i__3].i, z__2.i = 
		zx[i__2].r * zy[i__3].i + zx[i__2].i * zy[i__3].r;
	z__1.r = ztemp.r + z__2.r, z__1.i = ztemp.i + z__2.i;
	ztemp.r = z__1.r, ztemp.i = z__1.i;
    }
     ret_val->r = ztemp.r,  ret_val->i = ztemp.i;
    return ;
} /* zdotu_ */
static /* Subroutine */ int ztrsv_ (Tcl_Interp *interp, char *uplo, char *trans, char *diag, integer *n, 	doublecomplex *a, integer *lda, doublecomplex *x, integer *incx)
{
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
    doublecomplex z__1, z__2, z__3;

    void z_div(doublecomplex *, doublecomplex *, doublecomplex *), d_cnjg(
	    doublecomplex *, doublecomplex *);

    integer i__, j, ix, jx, kx, info;
    doublecomplex temp;
    logical noconj, nounit;
































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

    info = 0;
    if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {
	info = 1;
    } else if (! lsame_(trans, "N") && ! lsame_(trans, 
	    "T") && ! lsame_(trans, "C")) {
	info = 2;
    } else if (! lsame_(diag, "U") && ! lsame_(diag, 
	    "N")) {
	info = 3;
    } else if (*n < 0) {
	info = 4;
    } else if (*lda < max(1,*n)) {
	info = 6;
    } else if (*incx == 0) {
	info = 8;
    }
    if (info != 0) {
	vectcl_xerbla(interp, "ZTRSV ", &info);
return TCL_ERROR;

return TCL_OK;
    }


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

    noconj = lsame_(trans, "T");
    nounit = lsame_(diag, "N");


    if (*incx <= 0) {
	kx = 1 - (*n - 1) * *incx;
    } else if (*incx != 1) {
	kx = 1;
    }


    if (lsame_(trans, "N")) {


	if (lsame_(uplo, "U")) {
	    if (*incx == 1) {
		for (j = *n; j >= 1; --j) {
		    i__1 = j;
		    if (x[i__1].r != 0. || x[i__1].i != 0.) {
			if (nounit) {
			    i__1 = j;
			    z_div(&z__1, &x[j], &a[j + j * a_dim1]);
			    x[i__1].r = z__1.r, x[i__1].i = z__1.i;
			}
			i__1 = j;
			temp.r = x[i__1].r, temp.i = x[i__1].i;
			for (i__ = j - 1; i__ >= 1; --i__) {
			    i__1 = i__;
			    i__2 = i__;
			    i__3 = i__ + j * a_dim1;
			    z__2.r = temp.r * a[i__3].r - temp.i * a[i__3].i, 
				    z__2.i = temp.r * a[i__3].i + temp.i * a[
				    i__3].r;
			    z__1.r = x[i__2].r - z__2.r, z__1.i = x[i__2].i - 
				    z__2.i;
			    x[i__1].r = z__1.r, x[i__1].i = z__1.i;
			}
		    }
		}
	    } else {
		jx = kx + (*n - 1) * *incx;
		for (j = *n; j >= 1; --j) {
		    i__1 = jx;
		    if (x[i__1].r != 0. || x[i__1].i != 0.) {
			if (nounit) {
			    i__1 = jx;
			    z_div(&z__1, &x[jx], &a[j + j * a_dim1]);
			    x[i__1].r = z__1.r, x[i__1].i = z__1.i;
			}
			i__1 = jx;
			temp.r = x[i__1].r, temp.i = x[i__1].i;
			ix = jx;
			for (i__ = j - 1; i__ >= 1; --i__) {
			    ix -= *incx;
			    i__1 = ix;
			    i__2 = ix;
			    i__3 = i__ + j * a_dim1;
			    z__2.r = temp.r * a[i__3].r - temp.i * a[i__3].i, 
				    z__2.i = temp.r * a[i__3].i + temp.i * a[
				    i__3].r;
			    z__1.r = x[i__2].r - z__2.r, z__1.i = x[i__2].i - 
				    z__2.i;
			    x[i__1].r = z__1.r, x[i__1].i = z__1.i;
			}
		    }
		    jx -= *incx;
		}
	    }
	} else {
	    if (*incx == 1) {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = j;
		    if (x[i__2].r != 0. || x[i__2].i != 0.) {
			if (nounit) {
			    i__2 = j;
			    z_div(&z__1, &x[j], &a[j + j * a_dim1]);
			    x[i__2].r = z__1.r, x[i__2].i = z__1.i;
			}
			i__2 = j;
			temp.r = x[i__2].r, temp.i = x[i__2].i;
			i__2 = *n;
			for (i__ = j + 1; i__ <= i__2; ++i__) {
			    i__3 = i__;
			    i__4 = i__;
			    i__5 = i__ + j * a_dim1;
			    z__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i, 
				    z__2.i = temp.r * a[i__5].i + temp.i * a[
				    i__5].r;
			    z__1.r = x[i__4].r - z__2.r, z__1.i = x[i__4].i - 
				    z__2.i;
			    x[i__3].r = z__1.r, x[i__3].i = z__1.i;
			}
		    }
		}
	    } else {
		jx = kx;
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = jx;
		    if (x[i__2].r != 0. || x[i__2].i != 0.) {
			if (nounit) {
			    i__2 = jx;
			    z_div(&z__1, &x[jx], &a[j + j * a_dim1]);
			    x[i__2].r = z__1.r, x[i__2].i = z__1.i;
			}
			i__2 = jx;
			temp.r = x[i__2].r, temp.i = x[i__2].i;
			ix = jx;
			i__2 = *n;
			for (i__ = j + 1; i__ <= i__2; ++i__) {
			    ix += *incx;
			    i__3 = ix;
			    i__4 = ix;
			    i__5 = i__ + j * a_dim1;
			    z__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i, 
				    z__2.i = temp.r * a[i__5].i + temp.i * a[
				    i__5].r;
			    z__1.r = x[i__4].r - z__2.r, z__1.i = x[i__4].i - 
				    z__2.i;
			    x[i__3].r = z__1.r, x[i__3].i = z__1.i;
			}
		    }
		    jx += *incx;
		}
	    }
	}
    } else {


	if (lsame_(uplo, "U")) {
	    if (*incx == 1) {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    i__2 = j;
		    temp.r = x[i__2].r, temp.i = x[i__2].i;
		    if (noconj) {
			i__2 = j - 1;
			for (i__ = 1; i__ <= i__2; ++i__) {
			    i__3 = i__ + j * a_dim1;
			    i__4 = i__;
			    z__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[
				    i__4].i, z__2.i = a[i__3].r * x[i__4].i + 
				    a[i__3].i * x[i__4].r;
			    z__1.r = temp.r - z__2.r, z__1.i = temp.i - 
				    z__2.i;
			    temp.r = z__1.r, temp.i = z__1.i;
			}
			if (nounit) {
			    z_div(&z__1, &temp, &a[j + j * a_dim1]);
			    temp.r = z__1.r, temp.i = z__1.i;
			}
		    } else {
			i__2 = j - 1;
			for (i__ = 1; i__ <= i__2; ++i__) {
			    d_cnjg(&z__3, &a[i__ + j * a_dim1]);
			    i__3 = i__;
			    z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, 
				    z__2.i = z__3.r * x[i__3].i + z__3.i * x[
				    i__3].r;
			    z__1.r = temp.r - z__2.r, z__1.i = temp.i - 
				    z__2.i;
			    temp.r = z__1.r, temp.i = z__1.i;
			}
			if (nounit) {
			    d_cnjg(&z__2, &a[j + j * a_dim1]);
			    z_div(&z__1, &temp, &z__2);
			    temp.r = z__1.r, temp.i = z__1.i;
			}
		    }
		    i__2 = j;
		    x[i__2].r = temp.r, x[i__2].i = temp.i;
		}
	    } else {
		jx = kx;
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    ix = kx;
		    i__2 = jx;
		    temp.r = x[i__2].r, temp.i = x[i__2].i;
		    if (noconj) {
			i__2 = j - 1;
			for (i__ = 1; i__ <= i__2; ++i__) {
			    i__3 = i__ + j * a_dim1;
			    i__4 = ix;
			    z__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[
				    i__4].i, z__2.i = a[i__3].r * x[i__4].i + 
				    a[i__3].i * x[i__4].r;
			    z__1.r = temp.r - z__2.r, z__1.i = temp.i - 
				    z__2.i;
			    temp.r = z__1.r, temp.i = z__1.i;
			    ix += *incx;
			}
			if (nounit) {
			    z_div(&z__1, &temp, &a[j + j * a_dim1]);
			    temp.r = z__1.r, temp.i = z__1.i;
			}
		    } else {
			i__2 = j - 1;
			for (i__ = 1; i__ <= i__2; ++i__) {
			    d_cnjg(&z__3, &a[i__ + j * a_dim1]);
			    i__3 = ix;
			    z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, 
				    z__2.i = z__3.r * x[i__3].i + z__3.i * x[
				    i__3].r;
			    z__1.r = temp.r - z__2.r, z__1.i = temp.i - 
				    z__2.i;
			    temp.r = z__1.r, temp.i = z__1.i;
			    ix += *incx;
			}
			if (nounit) {
			    d_cnjg(&z__2, &a[j + j * a_dim1]);
			    z_div(&z__1, &temp, &z__2);
			    temp.r = z__1.r, temp.i = z__1.i;
			}
		    }
		    i__2 = jx;
		    x[i__2].r = temp.r, x[i__2].i = temp.i;
		    jx += *incx;
		}
	    }
	} else {
	    if (*incx == 1) {
		for (j = *n; j >= 1; --j) {
		    i__1 = j;
		    temp.r = x[i__1].r, temp.i = x[i__1].i;
		    if (noconj) {
			i__1 = j + 1;
			for (i__ = *n; i__ >= i__1; --i__) {
			    i__2 = i__ + j * a_dim1;
			    i__3 = i__;
			    z__2.r = a[i__2].r * x[i__3].r - a[i__2].i * x[
				    i__3].i, z__2.i = a[i__2].r * x[i__3].i + 
				    a[i__2].i * x[i__3].r;
			    z__1.r = temp.r - z__2.r, z__1.i = temp.i - 
				    z__2.i;
			    temp.r = z__1.r, temp.i = z__1.i;
			}
			if (nounit) {
			    z_div(&z__1, &temp, &a[j + j * a_dim1]);
			    temp.r = z__1.r, temp.i = z__1.i;
			}
		    } else {
			i__1 = j + 1;
			for (i__ = *n; i__ >= i__1; --i__) {
			    d_cnjg(&z__3, &a[i__ + j * a_dim1]);
			    i__2 = i__;
			    z__2.r = z__3.r * x[i__2].r - z__3.i * x[i__2].i, 
				    z__2.i = z__3.r * x[i__2].i + z__3.i * x[
				    i__2].r;
			    z__1.r = temp.r - z__2.r, z__1.i = temp.i - 
				    z__2.i;
			    temp.r = z__1.r, temp.i = z__1.i;
			}
			if (nounit) {
			    d_cnjg(&z__2, &a[j + j * a_dim1]);
			    z_div(&z__1, &temp, &z__2);
			    temp.r = z__1.r, temp.i = z__1.i;
			}
		    }
		    i__1 = j;
		    x[i__1].r = temp.r, x[i__1].i = temp.i;
		}
	    } else {
		kx += (*n - 1) * *incx;
		jx = kx;
		for (j = *n; j >= 1; --j) {
		    ix = kx;
		    i__1 = jx;
		    temp.r = x[i__1].r, temp.i = x[i__1].i;
		    if (noconj) {
			i__1 = j + 1;
			for (i__ = *n; i__ >= i__1; --i__) {
			    i__2 = i__ + j * a_dim1;
			    i__3 = ix;
			    z__2.r = a[i__2].r * x[i__3].r - a[i__2].i * x[
				    i__3].i, z__2.i = a[i__2].r * x[i__3].i + 
				    a[i__2].i * x[i__3].r;
			    z__1.r = temp.r - z__2.r, z__1.i = temp.i - 
				    z__2.i;
			    temp.r = z__1.r, temp.i = z__1.i;
			    ix -= *incx;
			}
			if (nounit) {
			    z_div(&z__1, &temp, &a[j + j * a_dim1]);
			    temp.r = z__1.r, temp.i = z__1.i;
			}
		    } else {
			i__1 = j + 1;
			for (i__ = *n; i__ >= i__1; --i__) {
			    d_cnjg(&z__3, &a[i__ + j * a_dim1]);
			    i__2 = ix;
			    z__2.r = z__3.r * x[i__2].r - z__3.i * x[i__2].i, 
				    z__2.i = z__3.r * x[i__2].i + z__3.i * x[
				    i__2].r;
			    z__1.r = temp.r - z__2.r, z__1.i = temp.i - 
				    z__2.i;
			    temp.r = z__1.r, temp.i = z__1.i;
			    ix -= *incx;
			}
			if (nounit) {
			    d_cnjg(&z__2, &a[j + j * a_dim1]);
			    z_div(&z__1, &temp, &z__2);
			    temp.r = z__1.r, temp.i = z__1.i;
			}
		    }
		    i__1 = jx;
		    x[i__1].r = temp.r, x[i__1].i = temp.i;
		    jx -= *incx;
		}
	    }
	}
    }

return TCL_OK;


} /* ztrsv_ */
static /* Subroutine */ int dlarz_ (Tcl_Interp *interp, char *side, integer *m, integer *n, integer *l, 	doublereal *v, integer *incv, doublereal *tau, doublereal *c__, 	integer *ldc, doublereal *work)
{
    integer c_dim1, c_offset;
    doublereal d__1;



























    --v;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;
    --work;

    if (lsame_(side, "L")) {


	if (*tau != 0.) {


	    if (dcopy_(interp, n, &c__[c_offset], ldc, &work[1], &dlarz_c__1)!=TCL_OK) { return TCL_ERROR; }



	    if (dgemv_(interp, "Transpose", l, n, &dlarz_c_b5, &c__[*m - *l + 1 + c_dim1], ldc, 		    &v[1], incv, &dlarz_c_b5, &work[1], &dlarz_c__1)!=TCL_OK) { return TCL_ERROR; }




	    d__1 = -(*tau);
	    if (daxpy_(interp, n, &d__1, &work[1], &dlarz_c__1, &c__[c_offset], ldc)!=TCL_OK) { return TCL_ERROR; }



	    d__1 = -(*tau);
	    if (dger_(interp, l, n, &d__1, &v[1], incv, &work[1], &dlarz_c__1, &c__[*m - *l + 1 		    + c_dim1], ldc)!=TCL_OK) { return TCL_ERROR; }


	}

    } else {


	if (*tau != 0.) {


	    if (dcopy_(interp, m, &c__[c_offset], &dlarz_c__1, &work[1], &dlarz_c__1)!=TCL_OK) { return TCL_ERROR; }



	    if (dgemv_(interp, "No transpose", m, l, &dlarz_c_b5, &c__[(*n - *l + 1) * c_dim1 + 		    1], ldc, &v[1], incv, &dlarz_c_b5, &work[1], &dlarz_c__1)!=TCL_OK) { return TCL_ERROR; }




	    d__1 = -(*tau);
	    if (daxpy_(interp, m, &d__1, &work[1], &dlarz_c__1, &c__[c_offset], &dlarz_c__1)!=TCL_OK) { return TCL_ERROR; }



	    d__1 = -(*tau);
	    if (dger_(interp, m, l, &d__1, &work[1], &dlarz_c__1, &v[1], incv, &c__[(*n - *l + 		    1) * c_dim1 + 1], ldc)!=TCL_OK) { return TCL_ERROR; }



	}

    }

return TCL_OK;


} /* dlarz_ */
static /* Subroutine */ int zlarz_ (Tcl_Interp *interp, char *side, integer *m, integer *n, integer *l, 	doublecomplex *v, integer *incv, doublecomplex *tau, doublecomplex *	c__, integer *ldc, doublecomplex *work)
{
    integer c_dim1, c_offset;
    doublecomplex z__1;



























    --v;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;
    --work;

    if (lsame_(side, "L")) {


	if (tau->r != 0. || tau->i != 0.) {


	    if (zcopy_(interp, n, &c__[c_offset], ldc, &work[1], &zlarz_c__1)!=TCL_OK) { return TCL_ERROR; }

	    if (zlacgv_(interp, n, &work[1], &zlarz_c__1)!=TCL_OK) { return TCL_ERROR; }



	    if (zgemv_(interp, "Conjugate transpose", l, n, &zlarz_c_b1, &c__[*m - *l + 1 + 		    c_dim1], ldc, &v[1], incv, &zlarz_c_b1, &work[1], &zlarz_c__1)!=TCL_OK) { return TCL_ERROR; }


	    if (zlacgv_(interp, n, &work[1], &zlarz_c__1)!=TCL_OK) { return TCL_ERROR; }



	    z__1.r = -tau->r, z__1.i = -tau->i;
	    if (zaxpy_(interp, n, &z__1, &work[1], &zlarz_c__1, &c__[c_offset], ldc)!=TCL_OK) { return TCL_ERROR; }



	    z__1.r = -tau->r, z__1.i = -tau->i;
	    if (zgeru_(interp, l, n, &z__1, &v[1], incv, &work[1], &zlarz_c__1, &c__[*m - *l + 		    1 + c_dim1], ldc)!=TCL_OK) { return TCL_ERROR; }


	}

    } else {


	if (tau->r != 0. || tau->i != 0.) {


	    if (zcopy_(interp, m, &c__[c_offset], &zlarz_c__1, &work[1], &zlarz_c__1)!=TCL_OK) { return TCL_ERROR; }



	    if (zgemv_(interp, "No transpose", m, l, &zlarz_c_b1, &c__[(*n - *l + 1) * c_dim1 + 		    1], ldc, &v[1], incv, &zlarz_c_b1, &work[1], &zlarz_c__1)!=TCL_OK) { return TCL_ERROR; }




	    z__1.r = -tau->r, z__1.i = -tau->i;
	    if (zaxpy_(interp, m, &z__1, &work[1], &zlarz_c__1, &c__[c_offset], &zlarz_c__1)!=TCL_OK) { return TCL_ERROR; }



	    z__1.r = -tau->r, z__1.i = -tau->i;
	    if (zgerc_(interp, m, l, &z__1, &work[1], &zlarz_c__1, &v[1], incv, &c__[(*n - *l + 		    1) * c_dim1 + 1], ldc)!=TCL_OK) { return TCL_ERROR; }



	}

    }

return TCL_OK;


} /* zlarz_ */
static /* Subroutine */ int dger_ (Tcl_Interp *interp, integer *m, integer *n, doublereal *alpha, 	doublereal *x, integer *incx, doublereal *y, integer *incy, 	doublereal *a, integer *lda)
{
    integer a_dim1, a_offset, i__1, i__2;

    integer i__, j, ix, jy, kx, info;
    doublereal temp;






















    --x;
    --y;
    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;

    info = 0;
    if (*m < 0) {
	info = 1;
    } else if (*n < 0) {
	info = 2;
    } else if (*incx == 0) {
	info = 5;
    } else if (*incy == 0) {
	info = 7;
    } else if (*lda < max(1,*m)) {
	info = 9;
    }
    if (info != 0) {
	vectcl_xerbla(interp, "DGER  ", &info);
return TCL_ERROR;

return TCL_OK;
    }


    if (*m == 0 || *n == 0 || *alpha == 0.) {
return TCL_OK;
    }


    if (*incy > 0) {
	jy = 1;
    } else {
	jy = 1 - (*n - 1) * *incy;
    }
    if (*incx == 1) {
	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    if (y[jy] != 0.) {
		temp = *alpha * y[jy];
		i__2 = *m;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    a[i__ + j * a_dim1] += x[i__] * temp;
		}
	    }
	    jy += *incy;
	}
    } else {
	if (*incx > 0) {
	    kx = 1;
	} else {
	    kx = 1 - (*m - 1) * *incx;
	}
	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    if (y[jy] != 0.) {
		temp = *alpha * y[jy];
		ix = kx;
		i__2 = *m;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    a[i__ + j * a_dim1] += x[ix] * temp;
		    ix += *incx;
		}
	    }
	    jy += *incy;
	}
    }

return TCL_OK;


} /* dger_ */
static /* Subroutine */ int zgeru_ (Tcl_Interp *interp, integer *m, integer *n, doublecomplex *alpha, 	doublecomplex *x, integer *incx, doublecomplex *y, integer *incy, 	doublecomplex *a, integer *lda)
{
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
    doublecomplex z__1, z__2;

    integer i__, j, ix, jy, kx, info;
    doublecomplex temp;






















    --x;
    --y;
    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;

    info = 0;
    if (*m < 0) {
	info = 1;
    } else if (*n < 0) {
	info = 2;
    } else if (*incx == 0) {
	info = 5;
    } else if (*incy == 0) {
	info = 7;
    } else if (*lda < max(1,*m)) {
	info = 9;
    }
    if (info != 0) {
	vectcl_xerbla(interp, "ZGERU ", &info);
return TCL_ERROR;

return TCL_OK;
    }


    if (*m == 0 || *n == 0 || alpha->r == 0. && alpha->i == 0.) {
return TCL_OK;
    }


    if (*incy > 0) {
	jy = 1;
    } else {
	jy = 1 - (*n - 1) * *incy;
    }
    if (*incx == 1) {
	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = jy;
	    if (y[i__2].r != 0. || y[i__2].i != 0.) {
		i__2 = jy;
		z__1.r = alpha->r * y[i__2].r - alpha->i * y[i__2].i, z__1.i =
			 alpha->r * y[i__2].i + alpha->i * y[i__2].r;
		temp.r = z__1.r, temp.i = z__1.i;
		i__2 = *m;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    i__3 = i__ + j * a_dim1;
		    i__4 = i__ + j * a_dim1;
		    i__5 = i__;
		    z__2.r = x[i__5].r * temp.r - x[i__5].i * temp.i, z__2.i =
			     x[i__5].r * temp.i + x[i__5].i * temp.r;
		    z__1.r = a[i__4].r + z__2.r, z__1.i = a[i__4].i + z__2.i;
		    a[i__3].r = z__1.r, a[i__3].i = z__1.i;
		}
	    }
	    jy += *incy;
	}
    } else {
	if (*incx > 0) {
	    kx = 1;
	} else {
	    kx = 1 - (*m - 1) * *incx;
	}
	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = jy;
	    if (y[i__2].r != 0. || y[i__2].i != 0.) {
		i__2 = jy;
		z__1.r = alpha->r * y[i__2].r - alpha->i * y[i__2].i, z__1.i =
			 alpha->r * y[i__2].i + alpha->i * y[i__2].r;
		temp.r = z__1.r, temp.i = z__1.i;
		ix = kx;
		i__2 = *m;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    i__3 = i__ + j * a_dim1;
		    i__4 = i__ + j * a_dim1;
		    i__5 = ix;
		    z__2.r = x[i__5].r * temp.r - x[i__5].i * temp.i, z__2.i =
			     x[i__5].r * temp.i + x[i__5].i * temp.r;
		    z__1.r = a[i__4].r + z__2.r, z__1.i = a[i__4].i + z__2.i;
		    a[i__3].r = z__1.r, a[i__3].i = z__1.i;
		    ix += *incx;
		}
	    }
	    jy += *incy;
	}
    }

return TCL_OK;


} /* zgeru_ */
static /* Subroutine */ int dtrsv_ (Tcl_Interp *interp, char *uplo, char *trans, char *diag, integer *n, 	doublereal *a, integer *lda, doublereal *x, integer *incx)
{
    integer a_dim1, a_offset, i__1, i__2;

    integer i__, j, ix, jx, kx, info;
    doublereal temp;
    logical nounit;
































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

    info = 0;
    if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {
	info = 1;
    } else if (! lsame_(trans, "N") && ! lsame_(trans, 
	    "T") && ! lsame_(trans, "C")) {
	info = 2;
    } else if (! lsame_(diag, "U") && ! lsame_(diag, 
	    "N")) {
	info = 3;
    } else if (*n < 0) {
	info = 4;
    } else if (*lda < max(1,*n)) {
	info = 6;
    } else if (*incx == 0) {
	info = 8;
    }
    if (info != 0) {
	vectcl_xerbla(interp, "DTRSV ", &info);
return TCL_ERROR;

return TCL_OK;
    }


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

    nounit = lsame_(diag, "N");


    if (*incx <= 0) {
	kx = 1 - (*n - 1) * *incx;
    } else if (*incx != 1) {
	kx = 1;
    }


    if (lsame_(trans, "N")) {


	if (lsame_(uplo, "U")) {
	    if (*incx == 1) {
		for (j = *n; j >= 1; --j) {
		    if (x[j] != 0.) {
			if (nounit) {
			    x[j] /= a[j + j * a_dim1];
			}
			temp = x[j];
			for (i__ = j - 1; i__ >= 1; --i__) {
			    x[i__] -= temp * a[i__ + j * a_dim1];
			}
		    }
		}
	    } else {
		jx = kx + (*n - 1) * *incx;
		for (j = *n; j >= 1; --j) {
		    if (x[jx] != 0.) {
			if (nounit) {
			    x[jx] /= a[j + j * a_dim1];
			}
			temp = x[jx];
			ix = jx;
			for (i__ = j - 1; i__ >= 1; --i__) {
			    ix -= *incx;
			    x[ix] -= temp * a[i__ + j * a_dim1];
			}
		    }
		    jx -= *incx;
		}
	    }
	} else {
	    if (*incx == 1) {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    if (x[j] != 0.) {
			if (nounit) {
			    x[j] /= a[j + j * a_dim1];
			}
			temp = x[j];
			i__2 = *n;
			for (i__ = j + 1; i__ <= i__2; ++i__) {
			    x[i__] -= temp * a[i__ + j * a_dim1];
			}
		    }
		}
	    } else {
		jx = kx;
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    if (x[jx] != 0.) {
			if (nounit) {
			    x[jx] /= a[j + j * a_dim1];
			}
			temp = x[jx];
			ix = jx;
			i__2 = *n;
			for (i__ = j + 1; i__ <= i__2; ++i__) {
			    ix += *incx;
			    x[ix] -= temp * a[i__ + j * a_dim1];
			}
		    }
		    jx += *incx;
		}
	    }
	}
    } else {


	if (lsame_(uplo, "U")) {
	    if (*incx == 1) {
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    temp = x[j];
		    i__2 = j - 1;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			temp -= a[i__ + j * a_dim1] * x[i__];
		    }
		    if (nounit) {
			temp /= a[j + j * a_dim1];
		    }
		    x[j] = temp;
		}
	    } else {
		jx = kx;
		i__1 = *n;
		for (j = 1; j <= i__1; ++j) {
		    temp = x[jx];
		    ix = kx;
		    i__2 = j - 1;
		    for (i__ = 1; i__ <= i__2; ++i__) {
			temp -= a[i__ + j * a_dim1] * x[ix];
			ix += *incx;
		    }
		    if (nounit) {
			temp /= a[j + j * a_dim1];
		    }
		    x[jx] = temp;
		    jx += *incx;
		}
	    }
	} else {
	    if (*incx == 1) {
		for (j = *n; j >= 1; --j) {
		    temp = x[j];
		    i__1 = j + 1;
		    for (i__ = *n; i__ >= i__1; --i__) {
			temp -= a[i__ + j * a_dim1] * x[i__];
		    }
		    if (nounit) {
			temp /= a[j + j * a_dim1];
		    }
		    x[j] = temp;
		}
	    } else {
		kx += (*n - 1) * *incx;
		jx = kx;
		for (j = *n; j >= 1; --j) {
		    temp = x[jx];
		    ix = kx;
		    i__1 = j + 1;
		    for (i__ = *n; i__ >= i__1; --i__) {
			temp -= a[i__ + j * a_dim1] * x[ix];
			ix -= *incx;
		    }
		    if (nounit) {
			temp /= a[j + j * a_dim1];
		    }
		    x[jx] = temp;
		    jx -= *incx;
		}
	    }
	}
    }

return TCL_OK;


} /* dtrsv_ */
static integer izmax1_ (integer *n, doublecomplex *cx, integer *incx)
{
    integer ret_val, i__1;

    double z_abs(doublecomplex *);

    integer i__, ix;
    doublereal smax;















    --cx;

    ret_val = 0;
    if (*n < 1) {
	return ret_val;
    }
    ret_val = 1;
    if (*n == 1) {
	return ret_val;
    }
    if (*incx == 1) {
	goto L30;
    }


    ix = 1;
    smax = z_abs(&cx[1]);
    ix += *incx;
    i__1 = *n;
    for (i__ = 2; i__ <= i__1; ++i__) {
	if (z_abs(&cx[ix]) <= smax) {
	    goto L10;
	}
	ret_val = i__;
	smax = z_abs(&cx[ix]);
L10:
	ix += *incx;
    }
    return ret_val;


L30:
    smax = z_abs(&cx[1]);
    i__1 = *n;
    for (i__ = 2; i__ <= i__1; ++i__) {
	if (z_abs(&cx[i__]) <= smax) {
	    goto L40;
	}
	ret_val = i__;
	smax = z_abs(&cx[i__]);
L40:
	;
    }
    return ret_val;


} /* izmax1_ */
static doublereal dzsum1_ (integer *n, doublecomplex *cx, integer *incx)
{
    integer i__1, i__2;
    doublereal ret_val;

    double z_abs(doublecomplex *);

    integer i__, nincx;
    doublereal stemp;














    --cx;

    ret_val = 0.;
    stemp = 0.;
    if (*n <= 0) {
	return ret_val;
    }
    if (*incx == 1) {
	goto L20;
    }


    nincx = *n * *incx;
    i__1 = nincx;
    i__2 = *incx;
    for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {


	stemp += z_abs(&cx[i__]);
    }
    ret_val = stemp;
    return ret_val;


L20:
    i__2 = *n;
    for (i__ = 1; i__ <= i__2; ++i__) {


	stemp += z_abs(&cx[i__]);
    }
    ret_val = stemp;
    return ret_val;


} /* dzsum1_ */
static /* Subroutine */ int dlaexc_ (Tcl_Interp *interp, logical *wantq, integer *n, doublereal *t, 	integer *ldt, doublereal *q, integer *ldq, integer *j1, integer *n1, 	integer *n2, doublereal *work, integer *info)
{
    integer q_dim1, q_offset, t_dim1, t_offset, i__1;
    doublereal d__1, d__2, d__3;

    doublereal d__[16]	/* was [4][4] */;
    integer k;
    doublereal u[3], x[4]	/* was [2][2] */;
    integer j2, j3, j4;
    doublereal u1[3], u2[3];
    integer nd;
    doublereal cs, t11, t22, t33, sn, wi1, wi2, wr1, wr2, eps, tau, tau1, 
	    tau2;
    integer ierr;
    doublereal temp;
    doublereal scale, dnorm, xnorm;
    doublereal thresh, smlnum;





















    t_dim1 = *ldt;
    t_offset = 1 + t_dim1;
    t -= t_offset;
    q_dim1 = *ldq;
    q_offset = 1 + q_dim1;
    q -= q_offset;
    --work;

    *info = 0;


    if (*n == 0 || *n1 == 0 || *n2 == 0) {
return TCL_OK;
    }
    if (*j1 + *n1 > *n) {
return TCL_OK;
    }

    j2 = *j1 + 1;
    j3 = *j1 + 2;
    j4 = *j1 + 3;

    if (*n1 == 1 && *n2 == 1) {


	t11 = t[*j1 + *j1 * t_dim1];
	t22 = t[j2 + j2 * t_dim1];


	d__1 = t22 - t11;
	if (dlartg_(interp, &t[*j1 + j2 * t_dim1], &d__1, &cs, &sn, &temp)!=TCL_OK) { return TCL_ERROR; }



	if (j3 <= *n) {
	    i__1 = *n - *j1 - 1;
	    if (drot_(interp, &i__1, &t[*j1 + j3 * t_dim1], ldt, &t[j2 + j3 * t_dim1], 		    ldt, &cs, &sn)!=TCL_OK) { return TCL_ERROR; }


	}
	i__1 = *j1 - 1;
	if (drot_(interp, &i__1, &t[*j1 * t_dim1 + 1], &dlaexc_c__1, &t[j2 * t_dim1 + 1], &dlaexc_c__1, 		&cs, &sn)!=TCL_OK) { return TCL_ERROR; }



	t[*j1 + *j1 * t_dim1] = t22;
	t[j2 + j2 * t_dim1] = t11;

	if (*wantq) {


	    if (drot_(interp, n, &q[*j1 * q_dim1 + 1], &dlaexc_c__1, &q[j2 * q_dim1 + 1], &dlaexc_c__1, 		    &cs, &sn)!=TCL_OK) { return TCL_ERROR; }


	}

    } else {



	nd = *n1 + *n2;
	if (dlacpy_(interp, "Full", &nd, &nd, &t[*j1 + *j1 * t_dim1], ldt, d__, &dlaexc_c__4)!=TCL_OK) { return TCL_ERROR; }

	dnorm = dlange_("Max", &nd, &nd, d__, &dlaexc_c__4, &work[1]);


	eps = dlamch_("P");
	smlnum = dlamch_("S") / eps;
	d__1 = eps * 10. * dnorm;
	thresh = max(d__1,smlnum);


	if (dlasy2_(interp, &dlaexc_c_false, &dlaexc_c_false, &dlaexc_c_n1, n1, n2, d__, &dlaexc_c__4, &d__[*n1 + 1 + 		(*n1 + 1 << 2) - 5], &dlaexc_c__4, &d__[(*n1 + 1 << 2) - 4], &dlaexc_c__4, &
		scale, x, &dlaexc_c__2, &xnorm, &ierr)!=TCL_OK) { return TCL_ERROR; }




	k = *n1 + *n1 + *n2 - 3;
	switch (k) {
	    case 1:  goto L10;
	    case 2:  goto L20;
	    case 3:  goto L30;
	}

L10:



	u[0] = scale;
	u[1] = x[0];
	u[2] = x[2];
	if (dlarfg_(interp, &dlaexc_c__3, &u[2], u, &dlaexc_c__1, &tau)!=TCL_OK) { return TCL_ERROR; }

	u[2] = 1.;
	t11 = t[*j1 + *j1 * t_dim1];


	if (dlarfx_(interp, "L", &dlaexc_c__3, &dlaexc_c__3, u, &tau, d__, &dlaexc_c__4, &work[1])!=TCL_OK) { return TCL_ERROR; }

	if (dlarfx_(interp, "R", &dlaexc_c__3, &dlaexc_c__3, u, &tau, d__, &dlaexc_c__4, &work[1])!=TCL_OK) { return TCL_ERROR; }



	d__2 = abs(d__[2]), d__3 = abs(d__[6]), d__2 = max(d__2,d__3), d__3 = 
		(d__1 = d__[10] - t11, abs(d__1));
	if (max(d__2,d__3) > thresh) {
	    goto L50;
	}


	i__1 = *n - *j1 + 1;
	if (dlarfx_(interp, "L", &dlaexc_c__3, &i__1, u, &tau, &t[*j1 + *j1 * t_dim1], ldt, &		work[1])!=TCL_OK) { return TCL_ERROR; }


	if (dlarfx_(interp, "R", &j2, &dlaexc_c__3, u, &tau, &t[*j1 * t_dim1 + 1], ldt, &work[1])!=TCL_OK) { return TCL_ERROR; }


	t[j3 + *j1 * t_dim1] = 0.;
	t[j3 + j2 * t_dim1] = 0.;
	t[j3 + j3 * t_dim1] = t11;

	if (*wantq) {


	    if (dlarfx_(interp, "R", n, &dlaexc_c__3, u, &tau, &q[*j1 * q_dim1 + 1], ldq, &work[		    1])!=TCL_OK) { return TCL_ERROR; }


	}
	goto L40;

L20:



	u[0] = -x[0];
	u[1] = -x[1];
	u[2] = scale;
	if (dlarfg_(interp, &dlaexc_c__3, u, &u[1], &dlaexc_c__1, &tau)!=TCL_OK) { return TCL_ERROR; }

	u[0] = 1.;
	t33 = t[j3 + j3 * t_dim1];


	if (dlarfx_(interp, "L", &dlaexc_c__3, &dlaexc_c__3, u, &tau, d__, &dlaexc_c__4, &work[1])!=TCL_OK) { return TCL_ERROR; }

	if (dlarfx_(interp, "R", &dlaexc_c__3, &dlaexc_c__3, u, &tau, d__, &dlaexc_c__4, &work[1])!=TCL_OK) { return TCL_ERROR; }



	d__2 = abs(d__[1]), d__3 = abs(d__[2]), d__2 = max(d__2,d__3), d__3 = 
		(d__1 = d__[0] - t33, abs(d__1));
	if (max(d__2,d__3) > thresh) {
	    goto L50;
	}


	if (dlarfx_(interp, "R", &j3, &dlaexc_c__3, u, &tau, &t[*j1 * t_dim1 + 1], ldt, &work[1])!=TCL_OK) { return TCL_ERROR; }

	i__1 = *n - *j1;
	if (dlarfx_(interp, "L", &dlaexc_c__3, &i__1, u, &tau, &t[*j1 + j2 * t_dim1], ldt, &work[		1])!=TCL_OK) { return TCL_ERROR; }



	t[*j1 + *j1 * t_dim1] = t33;
	t[j2 + *j1 * t_dim1] = 0.;
	t[j3 + *j1 * t_dim1] = 0.;

	if (*wantq) {


	    if (dlarfx_(interp, "R", n, &dlaexc_c__3, u, &tau, &q[*j1 * q_dim1 + 1], ldq, &work[		    1])!=TCL_OK) { return TCL_ERROR; }


	}
	goto L40;

L30:



	u1[0] = -x[0];
	u1[1] = -x[1];
	u1[2] = scale;
	if (dlarfg_(interp, &dlaexc_c__3, u1, &u1[1], &dlaexc_c__1, &tau1)!=TCL_OK) { return TCL_ERROR; }

	u1[0] = 1.;

	temp = -tau1 * (x[2] + u1[1] * x[3]);
	u2[0] = -temp * u1[1] - x[3];
	u2[1] = -temp * u1[2];
	u2[2] = scale;
	if (dlarfg_(interp, &dlaexc_c__3, u2, &u2[1], &dlaexc_c__1, &tau2)!=TCL_OK) { return TCL_ERROR; }

	u2[0] = 1.;


	if (dlarfx_(interp, "L", &dlaexc_c__3, &dlaexc_c__4, u1, &tau1, d__, &dlaexc_c__4, &work[1])		!=TCL_OK) { return TCL_ERROR; }


	if (dlarfx_(interp, "R", &dlaexc_c__4, &dlaexc_c__3, u1, &tau1, d__, &dlaexc_c__4, &work[1])		!=TCL_OK) { return TCL_ERROR; }


	if (dlarfx_(interp, "L", &dlaexc_c__3, &dlaexc_c__4, u2, &tau2, &d__[1], &dlaexc_c__4, &work[1])!=TCL_OK) { return TCL_ERROR; }

	if (dlarfx_(interp, "R", &dlaexc_c__4, &dlaexc_c__3, u2, &tau2, &d__[4], &dlaexc_c__4, &work[1])!=TCL_OK) { return TCL_ERROR; }



	d__1 = abs(d__[2]), d__2 = abs(d__[6]), d__1 = max(d__1,d__2), d__2 = 
		abs(d__[3]), d__1 = max(d__1,d__2), d__2 = abs(d__[7]);
	if (max(d__1,d__2) > thresh) {
	    goto L50;
	}


	i__1 = *n - *j1 + 1;
	if (dlarfx_(interp, "L", &dlaexc_c__3, &i__1, u1, &tau1, &t[*j1 + *j1 * t_dim1], ldt, &		work[1])!=TCL_OK) { return TCL_ERROR; }


	if (dlarfx_(interp, "R", &j4, &dlaexc_c__3, u1, &tau1, &t[*j1 * t_dim1 + 1], ldt, &work[		1])!=TCL_OK) { return TCL_ERROR; }


	i__1 = *n - *j1 + 1;
	if (dlarfx_(interp, "L", &dlaexc_c__3, &i__1, u2, &tau2, &t[j2 + *j1 * t_dim1], ldt, &		work[1])!=TCL_OK) { return TCL_ERROR; }


	if (dlarfx_(interp, "R", &j4, &dlaexc_c__3, u2, &tau2, &t[j2 * t_dim1 + 1], ldt, &work[1])!=TCL_OK) { return TCL_ERROR; }



	t[j3 + *j1 * t_dim1] = 0.;
	t[j3 + j2 * t_dim1] = 0.;
	t[j4 + *j1 * t_dim1] = 0.;
	t[j4 + j2 * t_dim1] = 0.;

	if (*wantq) {


	    if (dlarfx_(interp, "R", n, &dlaexc_c__3, u1, &tau1, &q[*j1 * q_dim1 + 1], ldq, &		    work[1])!=TCL_OK) { return TCL_ERROR; }


	    if (dlarfx_(interp, "R", n, &dlaexc_c__3, u2, &tau2, &q[j2 * q_dim1 + 1], ldq, &work[		    1])!=TCL_OK) { return TCL_ERROR; }


	}

L40:

	if (*n2 == 2) {


	    if (dlanv2_(interp, &t[*j1 + *j1 * t_dim1], &t[*j1 + j2 * t_dim1], &t[j2 + *		    j1 * t_dim1], &t[j2 + j2 * t_dim1], &wr1, &wi1, &wr2, &
		    wi2, &cs, &sn)!=TCL_OK) { return TCL_ERROR; }


	    i__1 = *n - *j1 - 1;
	    if (drot_(interp, &i__1, &t[*j1 + (*j1 + 2) * t_dim1], ldt, &t[j2 + (*j1 + 2) 		    * t_dim1], ldt, &cs, &sn)!=TCL_OK) { return TCL_ERROR; }


	    i__1 = *j1 - 1;
	    if (drot_(interp, &i__1, &t[*j1 * t_dim1 + 1], &dlaexc_c__1, &t[j2 * t_dim1 + 1], &		    dlaexc_c__1, &cs, &sn)!=TCL_OK) { return TCL_ERROR; }


	    if (*wantq) {
		if (drot_(interp, n, &q[*j1 * q_dim1 + 1], &dlaexc_c__1, &q[j2 * q_dim1 + 1], &			dlaexc_c__1, &cs, &sn)!=TCL_OK) { return TCL_ERROR; }


	    }
	}

	if (*n1 == 2) {


	    j3 = *j1 + *n2;
	    j4 = j3 + 1;
	    if (dlanv2_(interp, &t[j3 + j3 * t_dim1], &t[j3 + j4 * t_dim1], &t[j4 + j3 * 		    t_dim1], &t[j4 + j4 * t_dim1], &wr1, &wi1, &wr2, &wi2, &
		    cs, &sn)!=TCL_OK) { return TCL_ERROR; }


	    if (j3 + 2 <= *n) {
		i__1 = *n - j3 - 1;
		if (drot_(interp, &i__1, &t[j3 + (j3 + 2) * t_dim1], ldt, &t[j4 + (j3 + 2)			 * t_dim1], ldt, &cs, &sn)!=TCL_OK) { return TCL_ERROR; }


	    }
	    i__1 = j3 - 1;
	    if (drot_(interp, &i__1, &t[j3 * t_dim1 + 1], &dlaexc_c__1, &t[j4 * t_dim1 + 1], &		    dlaexc_c__1, &cs, &sn)!=TCL_OK) { return TCL_ERROR; }


	    if (*wantq) {
		if (drot_(interp, n, &q[j3 * q_dim1 + 1], &dlaexc_c__1, &q[j4 * q_dim1 + 1], &			dlaexc_c__1, &cs, &sn)!=TCL_OK) { return TCL_ERROR; }


	    }
	}

    }
return TCL_OK;


L50:
    *info = 1;
return TCL_OK;


} /* dlaexc_ */
static /* Subroutine */ int dlasy2_ (Tcl_Interp *interp, logical *ltranl, logical *ltranr, integer *isgn, 	integer *n1, integer *n2, doublereal *tl, integer *ldtl, doublereal *	tr, integer *ldtr, doublereal *b, integer *ldb, doublereal *scale, 	doublereal *x, integer *ldx, doublereal *xnorm, integer *info)
{

    static integer locu12[4] = { 3,4,1,2 };
    static integer locl21[4] = { 2,1,4,3 };
    static integer locu22[4] = { 4,3,2,1 };
    static logical xswpiv[4] = { FALSE_,FALSE_,TRUE_,TRUE_ };
    static logical bswpiv[4] = { FALSE_,TRUE_,FALSE_,TRUE_ };

    integer b_dim1, b_offset, tl_dim1, tl_offset, tr_dim1, tr_offset, x_dim1, 
	    x_offset;
    doublereal d__1, d__2, d__3, d__4, d__5, d__6, d__7, d__8;

    integer i__, j, k;
    doublereal x2[2], l21, u11, u12;
    integer ip, jp;
    doublereal u22, t16[16]	/* was [4][4] */, gam, bet, eps, sgn, tmp[4], 
	    tau1, btmp[4], smin;
    integer ipiv;
    doublereal temp;
    integer jpiv[4];
    doublereal xmax;
    integer ipsv, jpsv;
    logical bswap;
    logical xswap;
    doublereal smlnum;


























    tl_dim1 = *ldtl;
    tl_offset = 1 + tl_dim1;
    tl -= tl_offset;
    tr_dim1 = *ldtr;
    tr_offset = 1 + tr_dim1;
    tr -= tr_offset;
    b_dim1 = *ldb;
    b_offset = 1 + b_dim1;
    b -= b_offset;
    x_dim1 = *ldx;
    x_offset = 1 + x_dim1;
    x -= x_offset;



    *info = 0;


    if (*n1 == 0 || *n2 == 0) {
return TCL_OK;
    }


    eps = dlamch_("P");
    smlnum = dlamch_("S") / eps;
    sgn = (doublereal) (*isgn);

    k = *n1 + *n1 + *n2 - 2;
    switch (k) {
	case 1:  goto L10;
	case 2:  goto L20;
	case 3:  goto L30;
	case 4:  goto L50;
    }


L10:
    tau1 = tl[tl_dim1 + 1] + sgn * tr[tr_dim1 + 1];
    bet = abs(tau1);
    if (bet <= smlnum) {
	tau1 = smlnum;
	bet = smlnum;
	*info = 1;
    }

    *scale = 1.;
    gam = (d__1 = b[b_dim1 + 1], abs(d__1));
    if (smlnum * gam > bet) {
	*scale = 1. / gam;
    }

    x[x_dim1 + 1] = b[b_dim1 + 1] * *scale / tau1;
    *xnorm = (d__1 = x[x_dim1 + 1], abs(d__1));
return TCL_OK;


L20:

    d__7 = (d__1 = tl[tl_dim1 + 1], abs(d__1)), d__8 = (d__2 = tr[tr_dim1 + 1]
	    , abs(d__2)), d__7 = max(d__7,d__8), d__8 = (d__3 = tr[(tr_dim1 <<
	     1) + 1], abs(d__3)), d__7 = max(d__7,d__8), d__8 = (d__4 = tr[
	    tr_dim1 + 2], abs(d__4)), d__7 = max(d__7,d__8), d__8 = (d__5 = 
	    tr[(tr_dim1 << 1) + 2], abs(d__5));
    d__6 = eps * max(d__7,d__8);
    smin = max(d__6,smlnum);
    tmp[0] = tl[tl_dim1 + 1] + sgn * tr[tr_dim1 + 1];
    tmp[3] = tl[tl_dim1 + 1] + sgn * tr[(tr_dim1 << 1) + 2];
    if (*ltranr) {
	tmp[1] = sgn * tr[tr_dim1 + 2];
	tmp[2] = sgn * tr[(tr_dim1 << 1) + 1];
    } else {
	tmp[1] = sgn * tr[(tr_dim1 << 1) + 1];
	tmp[2] = sgn * tr[tr_dim1 + 2];
    }
    btmp[0] = b[b_dim1 + 1];
    btmp[1] = b[(b_dim1 << 1) + 1];
    goto L40;


L30:
    d__7 = (d__1 = tr[tr_dim1 + 1], abs(d__1)), d__8 = (d__2 = tl[tl_dim1 + 1]
	    , abs(d__2)), d__7 = max(d__7,d__8), d__8 = (d__3 = tl[(tl_dim1 <<
	     1) + 1], abs(d__3)), d__7 = max(d__7,d__8), d__8 = (d__4 = tl[
	    tl_dim1 + 2], abs(d__4)), d__7 = max(d__7,d__8), d__8 = (d__5 = 
	    tl[(tl_dim1 << 1) + 2], abs(d__5));
    d__6 = eps * max(d__7,d__8);
    smin = max(d__6,smlnum);
    tmp[0] = tl[tl_dim1 + 1] + sgn * tr[tr_dim1 + 1];
    tmp[3] = tl[(tl_dim1 << 1) + 2] + sgn * tr[tr_dim1 + 1];
    if (*ltranl) {
	tmp[1] = tl[(tl_dim1 << 1) + 1];
	tmp[2] = tl[tl_dim1 + 2];
    } else {
	tmp[1] = tl[tl_dim1 + 2];
	tmp[2] = tl[(tl_dim1 << 1) + 1];
    }
    btmp[0] = b[b_dim1 + 1];
    btmp[1] = b[b_dim1 + 2];
L40:


    ipiv = idamax_(&dlasy2_c__4, tmp, &dlasy2_c__1);
    u11 = tmp[ipiv - 1];
    if (abs(u11) <= smin) {
	*info = 1;
	u11 = smin;
    }
    u12 = tmp[locu12[ipiv - 1] - 1];
    l21 = tmp[locl21[ipiv - 1] - 1] / u11;
    u22 = tmp[locu22[ipiv - 1] - 1] - u12 * l21;
    xswap = xswpiv[ipiv - 1];
    bswap = bswpiv[ipiv - 1];
    if (abs(u22) <= smin) {
	*info = 1;
	u22 = smin;
    }
    if (bswap) {
	temp = btmp[1];
	btmp[1] = btmp[0] - l21 * temp;
	btmp[0] = temp;
    } else {
	btmp[1] -= l21 * btmp[0];
    }
    *scale = 1.;
    if (smlnum * 2. * abs(btmp[1]) > abs(u22) || smlnum * 2. * abs(btmp[0]) > 
	    abs(u11)) {
	d__1 = abs(btmp[0]), d__2 = abs(btmp[1]);
	*scale = .5 / max(d__1,d__2);
	btmp[0] *= *scale;
	btmp[1] *= *scale;
    }
    x2[1] = btmp[1] / u22;
    x2[0] = btmp[0] / u11 - u12 / u11 * x2[1];
    if (xswap) {
	temp = x2[1];
	x2[1] = x2[0];
	x2[0] = temp;
    }
    x[x_dim1 + 1] = x2[0];
    if (*n1 == 1) {
	x[(x_dim1 << 1) + 1] = x2[1];
	*xnorm = (d__1 = x[x_dim1 + 1], abs(d__1)) + (d__2 = x[(x_dim1 << 1) 
		+ 1], abs(d__2));
    } else {
	x[x_dim1 + 2] = x2[1];
	d__3 = (d__1 = x[x_dim1 + 1], abs(d__1)), d__4 = (d__2 = x[x_dim1 + 2]
		, abs(d__2));
	*xnorm = max(d__3,d__4);
    }
return TCL_OK;



L50:
    d__5 = (d__1 = tr[tr_dim1 + 1], abs(d__1)), d__6 = (d__2 = tr[(tr_dim1 << 
	    1) + 1], abs(d__2)), d__5 = max(d__5,d__6), d__6 = (d__3 = tr[
	    tr_dim1 + 2], abs(d__3)), d__5 = max(d__5,d__6), d__6 = (d__4 = 
	    tr[(tr_dim1 << 1) + 2], abs(d__4));
    smin = max(d__5,d__6);
    d__5 = smin, d__6 = (d__1 = tl[tl_dim1 + 1], abs(d__1)), d__5 = max(d__5,
	    d__6), d__6 = (d__2 = tl[(tl_dim1 << 1) + 1], abs(d__2)), d__5 = 
	    max(d__5,d__6), d__6 = (d__3 = tl[tl_dim1 + 2], abs(d__3)), d__5 =
	     max(d__5,d__6), d__6 = (d__4 = tl[(tl_dim1 << 1) + 2], abs(d__4))
	    ;
    smin = max(d__5,d__6);
    d__1 = eps * smin;
    smin = max(d__1,smlnum);
    btmp[0] = 0.;
    if (dcopy_(interp, &dlasy2_c__16, btmp, &dlasy2_c__0, t16, &dlasy2_c__1)!=TCL_OK) { return TCL_ERROR; }

    t16[0] = tl[tl_dim1 + 1] + sgn * tr[tr_dim1 + 1];
    t16[5] = tl[(tl_dim1 << 1) + 2] + sgn * tr[tr_dim1 + 1];
    t16[10] = tl[tl_dim1 + 1] + sgn * tr[(tr_dim1 << 1) + 2];
    t16[15] = tl[(tl_dim1 << 1) + 2] + sgn * tr[(tr_dim1 << 1) + 2];
    if (*ltranl) {
	t16[4] = tl[tl_dim1 + 2];
	t16[1] = tl[(tl_dim1 << 1) + 1];
	t16[14] = tl[tl_dim1 + 2];
	t16[11] = tl[(tl_dim1 << 1) + 1];
    } else {
	t16[4] = tl[(tl_dim1 << 1) + 1];
	t16[1] = tl[tl_dim1 + 2];
	t16[14] = tl[(tl_dim1 << 1) + 1];
	t16[11] = tl[tl_dim1 + 2];
    }
    if (*ltranr) {
	t16[8] = sgn * tr[(tr_dim1 << 1) + 1];
	t16[13] = sgn * tr[(tr_dim1 << 1) + 1];
	t16[2] = sgn * tr[tr_dim1 + 2];
	t16[7] = sgn * tr[tr_dim1 + 2];
    } else {
	t16[8] = sgn * tr[tr_dim1 + 2];
	t16[13] = sgn * tr[tr_dim1 + 2];
	t16[2] = sgn * tr[(tr_dim1 << 1) + 1];
	t16[7] = sgn * tr[(tr_dim1 << 1) + 1];
    }
    btmp[0] = b[b_dim1 + 1];
    btmp[1] = b[b_dim1 + 2];
    btmp[2] = b[(b_dim1 << 1) + 1];
    btmp[3] = b[(b_dim1 << 1) + 2];


    for (i__ = 1; i__ <= 3; ++i__) {
	xmax = 0.;
	for (ip = i__; ip <= 4; ++ip) {
	    for (jp = i__; jp <= 4; ++jp) {
		if ((d__1 = t16[ip + (jp << 2) - 5], abs(d__1)) >= xmax) {
		    xmax = (d__1 = t16[ip + (jp << 2) - 5], abs(d__1));
		    ipsv = ip;
		    jpsv = jp;
		}
	    }
	}
	if (ipsv != i__) {
	    if (dswap_(interp, &dlasy2_c__4, &t16[ipsv - 1], &dlasy2_c__4, &t16[i__ - 1], &dlasy2_c__4)!=TCL_OK) { return TCL_ERROR; }

	    temp = btmp[i__ - 1];
	    btmp[i__ - 1] = btmp[ipsv - 1];
	    btmp[ipsv - 1] = temp;
	}
	if (jpsv != i__) {
	    if (dswap_(interp, &dlasy2_c__4, &t16[(jpsv << 2) - 4], &dlasy2_c__1, &t16[(i__ << 2) - 4], 		    &dlasy2_c__1)!=TCL_OK) { return TCL_ERROR; }


	}
	jpiv[i__ - 1] = jpsv;
	if ((d__1 = t16[i__ + (i__ << 2) - 5], abs(d__1)) < smin) {
	    *info = 1;
	    t16[i__ + (i__ << 2) - 5] = smin;
	}
	for (j = i__ + 1; j <= 4; ++j) {
	    t16[j + (i__ << 2) - 5] /= t16[i__ + (i__ << 2) - 5];
	    btmp[j - 1] -= t16[j + (i__ << 2) - 5] * btmp[i__ - 1];
	    for (k = i__ + 1; k <= 4; ++k) {
		t16[j + (k << 2) - 5] -= t16[j + (i__ << 2) - 5] * t16[i__ + (
			k << 2) - 5];
	    }
	}
    }
    if (abs(t16[15]) < smin) {
	t16[15] = smin;
    }
    *scale = 1.;
    if (smlnum * 8. * abs(btmp[0]) > abs(t16[0]) || smlnum * 8. * abs(btmp[1])
	     > abs(t16[5]) || smlnum * 8. * abs(btmp[2]) > abs(t16[10]) || 
	    smlnum * 8. * abs(btmp[3]) > abs(t16[15])) {
	d__1 = abs(btmp[0]), d__2 = abs(btmp[1]), d__1 = max(d__1,d__2), d__2 
		= abs(btmp[2]), d__1 = max(d__1,d__2), d__2 = abs(btmp[3]);
	*scale = .125 / max(d__1,d__2);
	btmp[0] *= *scale;
	btmp[1] *= *scale;
	btmp[2] *= *scale;
	btmp[3] *= *scale;
    }
    for (i__ = 1; i__ <= 4; ++i__) {
	k = 5 - i__;
	temp = 1. / t16[k + (k << 2) - 5];
	tmp[k - 1] = btmp[k - 1] * temp;
	for (j = k + 1; j <= 4; ++j) {
	    tmp[k - 1] -= temp * t16[k + (j << 2) - 5] * tmp[j - 1];
	}
    }
    for (i__ = 1; i__ <= 3; ++i__) {
	if (jpiv[4 - i__ - 1] != 4 - i__) {
	    temp = tmp[4 - i__ - 1];
	    tmp[4 - i__ - 1] = tmp[jpiv[4 - i__ - 1] - 1];
	    tmp[jpiv[4 - i__ - 1] - 1] = temp;
	}
    }
    x[x_dim1 + 1] = tmp[0];
    x[x_dim1 + 2] = tmp[1];
    x[(x_dim1 << 1) + 1] = tmp[2];
    x[(x_dim1 << 1) + 2] = tmp[3];
    d__1 = abs(tmp[0]) + abs(tmp[2]), d__2 = abs(tmp[1]) + abs(tmp[3]);
    *xnorm = max(d__1,d__2);
return TCL_OK;


} /* dlasy2_ */
static /* Subroutine */ int zrot_ (Tcl_Interp *interp, integer *n, doublecomplex *cx, integer *incx, 	doublecomplex *cy, integer *incy, doublereal *c__, doublecomplex *s)
{
    integer i__1, i__2, i__3, i__4;
    doublecomplex z__1, z__2, z__3, z__4;

    void d_cnjg(doublecomplex *, doublecomplex *);

    integer i__, ix, iy;
    doublecomplex stemp;















    --cy;
    --cx;

    if (*n <= 0) {
return TCL_OK;
    }
    if (*incx == 1 && *incy == 1) {
	goto L20;
    }


    ix = 1;
    iy = 1;
    if (*incx < 0) {
	ix = (-(*n) + 1) * *incx + 1;
    }
    if (*incy < 0) {
	iy = (-(*n) + 1) * *incy + 1;
    }
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	i__2 = ix;
	z__2.r = *c__ * cx[i__2].r, z__2.i = *c__ * cx[i__2].i;
	i__3 = iy;
	z__3.r = s->r * cy[i__3].r - s->i * cy[i__3].i, z__3.i = s->r * cy[
		i__3].i + s->i * cy[i__3].r;
	z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
	stemp.r = z__1.r, stemp.i = z__1.i;
	i__2 = iy;
	i__3 = iy;
	z__2.r = *c__ * cy[i__3].r, z__2.i = *c__ * cy[i__3].i;
	d_cnjg(&z__4, s);
	i__4 = ix;
	z__3.r = z__4.r * cx[i__4].r - z__4.i * cx[i__4].i, z__3.i = z__4.r * 
		cx[i__4].i + z__4.i * cx[i__4].r;
	z__1.r = z__2.r - z__3.r, z__1.i = z__2.i - z__3.i;
	cy[i__2].r = z__1.r, cy[i__2].i = z__1.i;
	i__2 = ix;
	cx[i__2].r = stemp.r, cx[i__2].i = stemp.i;
	ix += *incx;
	iy += *incy;
    }
return TCL_OK;


L20:
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	i__2 = i__;
	z__2.r = *c__ * cx[i__2].r, z__2.i = *c__ * cx[i__2].i;
	i__3 = i__;
	z__3.r = s->r * cy[i__3].r - s->i * cy[i__3].i, z__3.i = s->r * cy[
		i__3].i + s->i * cy[i__3].r;
	z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
	stemp.r = z__1.r, stemp.i = z__1.i;
	i__2 = i__;
	i__3 = i__;
	z__2.r = *c__ * cy[i__3].r, z__2.i = *c__ * cy[i__3].i;
	d_cnjg(&z__4, s);
	i__4 = i__;
	z__3.r = z__4.r * cx[i__4].r - z__4.i * cx[i__4].i, z__3.i = z__4.r * 
		cx[i__4].i + z__4.i * cx[i__4].r;
	z__1.r = z__2.r - z__3.r, z__1.i = z__2.i - z__3.i;
	cy[i__2].r = z__1.r, cy[i__2].i = z__1.i;
	i__2 = i__;
	cx[i__2].r = stemp.r, cx[i__2].i = stemp.i;
    }
return TCL_OK;
} /* zrot_ */
static /* Subroutine */ int zlartg_ (Tcl_Interp *interp, doublecomplex *f, doublecomplex *g, doublereal *	cs, doublecomplex *sn, doublecomplex *r__)
{
    integer i__1;
    doublereal d__1, d__2, d__3, d__4, d__5, d__6, d__7, d__8, d__9, d__10;
    doublecomplex z__1, z__2, z__3;

    double log(doublereal), pow_di(doublereal *, integer *), d_imag(
	    doublecomplex *), sqrt(doublereal);
    void d_cnjg(doublecomplex *, doublecomplex *);

    doublereal d__;
    integer i__;
    doublereal f2, g2;
    doublecomplex ff;
    doublereal di, dr;
    doublecomplex fs, gs;
    doublereal f2s, g2s, eps, scale;
    integer count;
    doublereal safmn2;
    doublereal safmx2;
    doublereal safmin;



















    safmin = dlamch_("S");
    eps = dlamch_("E");
    d__1 = dlamch_("B");
    i__1 = (integer) (log(safmin / eps) / log(dlamch_("B")) / 2.);
    safmn2 = pow_di(&d__1, &i__1);
    safmx2 = 1. / safmn2;
    d__7 = (d__1 = f->r, abs(d__1)), d__8 = (d__2 = d_imag(f), abs(d__2));
    d__9 = (d__3 = g->r, abs(d__3)), d__10 = (d__4 = d_imag(g), abs(d__4));
    d__5 = max(d__7,d__8), d__6 = max(d__9,d__10);
    scale = max(d__5,d__6);
    fs.r = f->r, fs.i = f->i;
    gs.r = g->r, gs.i = g->i;
    count = 0;
    if (scale >= safmx2) {
L10:
	++count;
	z__1.r = safmn2 * fs.r, z__1.i = safmn2 * fs.i;
	fs.r = z__1.r, fs.i = z__1.i;
	z__1.r = safmn2 * gs.r, z__1.i = safmn2 * gs.i;
	gs.r = z__1.r, gs.i = z__1.i;
	scale *= safmn2;
	if (scale >= safmx2) {
	    goto L10;
	}
    } else if (scale <= safmn2) {
	if (g->r == 0. && g->i == 0.) {
	    *cs = 1.;
	    sn->r = 0., sn->i = 0.;
	    r__->r = f->r, r__->i = f->i;
return TCL_OK;
	}
L20:
	--count;
	z__1.r = safmx2 * fs.r, z__1.i = safmx2 * fs.i;
	fs.r = z__1.r, fs.i = z__1.i;
	z__1.r = safmx2 * gs.r, z__1.i = safmx2 * gs.i;
	gs.r = z__1.r, gs.i = z__1.i;
	scale *= safmx2;
	if (scale <= safmn2) {
	    goto L20;
	}
    }
    d__1 = fs.r;
    d__2 = d_imag(&fs);
    f2 = d__1 * d__1 + d__2 * d__2;
    d__1 = gs.r;
    d__2 = d_imag(&gs);
    g2 = d__1 * d__1 + d__2 * d__2;
    if (f2 <= max(g2,1.) * safmin) {


	if (f->r == 0. && f->i == 0.) {
	    *cs = 0.;
	    d__2 = g->r;
	    d__3 = d_imag(g);
	    d__1 = dlapy2_(&d__2, &d__3);
	    r__->r = d__1, r__->i = 0.;
	    d__1 = gs.r;
	    d__2 = d_imag(&gs);
	    d__ = dlapy2_(&d__1, &d__2);
	    d__1 = gs.r / d__;
	    d__2 = -d_imag(&gs) / d__;
	    z__1.r = d__1, z__1.i = d__2;
	    sn->r = z__1.r, sn->i = z__1.i;
return TCL_OK;
	}
	d__1 = fs.r;
	d__2 = d_imag(&fs);
	f2s = dlapy2_(&d__1, &d__2);
	g2s = sqrt(g2);
	*cs = f2s / g2s;
	d__3 = (d__1 = f->r, abs(d__1)), d__4 = (d__2 = d_imag(f), abs(d__2));
	if (max(d__3,d__4) > 1.) {
	    d__1 = f->r;
	    d__2 = d_imag(f);
	    d__ = dlapy2_(&d__1, &d__2);
	    d__1 = f->r / d__;
	    d__2 = d_imag(f) / d__;
	    z__1.r = d__1, z__1.i = d__2;
	    ff.r = z__1.r, ff.i = z__1.i;
	} else {
	    dr = safmx2 * f->r;
	    di = safmx2 * d_imag(f);
	    d__ = dlapy2_(&dr, &di);
	    d__1 = dr / d__;
	    d__2 = di / d__;
	    z__1.r = d__1, z__1.i = d__2;
	    ff.r = z__1.r, ff.i = z__1.i;
	}
	d__1 = gs.r / g2s;
	d__2 = -d_imag(&gs) / g2s;
	z__2.r = d__1, z__2.i = d__2;
	z__1.r = ff.r * z__2.r - ff.i * z__2.i, z__1.i = ff.r * z__2.i + ff.i 
		* z__2.r;
	sn->r = z__1.r, sn->i = z__1.i;
	z__2.r = *cs * f->r, z__2.i = *cs * f->i;
	z__3.r = sn->r * g->r - sn->i * g->i, z__3.i = sn->r * g->i + sn->i * 
		g->r;
	z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
	r__->r = z__1.r, r__->i = z__1.i;
    } else {


	f2s = sqrt(g2 / f2 + 1.);
	d__1 = f2s * fs.r;
	d__2 = f2s * d_imag(&fs);
	z__1.r = d__1, z__1.i = d__2;
	r__->r = z__1.r, r__->i = z__1.i;
	*cs = 1. / f2s;
	d__ = f2 + g2;
	d__1 = r__->r / d__;
	d__2 = d_imag(r__) / d__;
	z__1.r = d__1, z__1.i = d__2;
	sn->r = z__1.r, sn->i = z__1.i;
	d_cnjg(&z__2, &gs);
	z__1.r = sn->r * z__2.r - sn->i * z__2.i, z__1.i = sn->r * z__2.i + 
		sn->i * z__2.r;
	sn->r = z__1.r, sn->i = z__1.i;
	if (count != 0) {
	    if (count > 0) {
		i__1 = count;
		for (i__ = 1; i__ <= i__1; ++i__) {
		    z__1.r = safmx2 * r__->r, z__1.i = safmx2 * r__->i;
		    r__->r = z__1.r, r__->i = z__1.i;
		}
	    } else {
		i__1 = -count;
		for (i__ = 1; i__ <= i__1; ++i__) {
		    z__1.r = safmn2 * r__->r, z__1.i = safmn2 * r__->i;
		    r__->r = z__1.r, r__->i = z__1.i;
		}
	    }
	}
    }
return TCL_OK;


} /* zlartg_ */
static /* Subroutine */ int dlasd2_ (Tcl_Interp *interp, integer *nl, integer *nr, integer *sqre, integer 	*k, doublereal *d__, doublereal *z__, doublereal *alpha, doublereal *	beta, doublereal *u, integer *ldu, doublereal *vt, integer *ldvt, 	doublereal *dsigma, doublereal *u2, integer *ldu2, doublereal *vt2, 	integer *ldvt2, integer *idxp, integer *idx, integer *idxc, integer *	idxq, integer *coltyp, integer *info)
{
    integer u_dim1, u_offset, u2_dim1, u2_offset, vt_dim1, vt_offset, 
	    vt2_dim1, vt2_offset, i__1;
    doublereal d__1, d__2;

    doublereal c__;
    integer i__, j, m, n;
    doublereal s;
    integer k2;
    doublereal z1;
    integer ct, jp;
    doublereal eps, tau, tol;
    integer psm[4], nlp1, nlp2, idxi, idxj;
    integer ctot[4], idxjp;
    integer jprev;
    doublereal hlftol;






































    --d__;
    --z__;
    u_dim1 = *ldu;
    u_offset = 1 + u_dim1;
    u -= u_offset;
    vt_dim1 = *ldvt;
    vt_offset = 1 + vt_dim1;
    vt -= vt_offset;
    --dsigma;
    u2_dim1 = *ldu2;
    u2_offset = 1 + u2_dim1;
    u2 -= u2_offset;
    vt2_dim1 = *ldvt2;
    vt2_offset = 1 + vt2_dim1;
    vt2 -= vt2_offset;
    --idxp;
    --idx;
    --idxc;
    --idxq;
    --coltyp;

    *info = 0;

    if (*nl < 1) {
	*info = -1;
    } else if (*nr < 1) {
	*info = -2;
    } else if (*sqre != 1 && *sqre != 0) {
	*info = -3;
    }

    n = *nl + *nr + 1;
    m = n + *sqre;

    if (*ldu < n) {
	*info = -10;
    } else if (*ldvt < m) {
	*info = -12;
    } else if (*ldu2 < n) {
	*info = -15;
    } else if (*ldvt2 < m) {
	*info = -17;
    }
    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DLASD2", &i__1);
return TCL_ERROR;

return TCL_OK;
    }

    nlp1 = *nl + 1;
    nlp2 = *nl + 2;


    z1 = *alpha * vt[nlp1 + nlp1 * vt_dim1];
    z__[1] = z1;
    for (i__ = *nl; i__ >= 1; --i__) {
	z__[i__ + 1] = *alpha * vt[i__ + nlp1 * vt_dim1];
	d__[i__ + 1] = d__[i__];
	idxq[i__ + 1] = idxq[i__] + 1;
    }


    i__1 = m;
    for (i__ = nlp2; i__ <= i__1; ++i__) {
	z__[i__] = *beta * vt[i__ + nlp2 * vt_dim1];
    }


    i__1 = nlp1;
    for (i__ = 2; i__ <= i__1; ++i__) {
	coltyp[i__] = 1;
    }
    i__1 = n;
    for (i__ = nlp2; i__ <= i__1; ++i__) {
	coltyp[i__] = 2;
    }


    i__1 = n;
    for (i__ = nlp2; i__ <= i__1; ++i__) {
	idxq[i__] += nlp1;
    }


    i__1 = n;
    for (i__ = 2; i__ <= i__1; ++i__) {
	dsigma[i__] = d__[idxq[i__]];
	u2[i__ + u2_dim1] = z__[idxq[i__]];
	idxc[i__] = coltyp[idxq[i__]];
    }

    if (dlamrg_(interp, nl, nr, &dsigma[2], &dlasd2_c__1, &dlasd2_c__1, &idx[2])!=TCL_OK) { return TCL_ERROR; }


    i__1 = n;
    for (i__ = 2; i__ <= i__1; ++i__) {
	idxi = idx[i__] + 1;
	d__[i__] = dsigma[idxi];
	z__[i__] = u2[idxi + u2_dim1];
	coltyp[i__] = idxc[idxi];
    }


    eps = dlamch_("Epsilon");
    d__1 = abs(*alpha), d__2 = abs(*beta);
    tol = max(d__1,d__2);
    d__2 = (d__1 = d__[n], abs(d__1));
    tol = eps * 8. * max(d__2,tol);





    *k = 1;
    k2 = n + 1;
    i__1 = n;
    for (j = 2; j <= i__1; ++j) {
	if ((d__1 = z__[j], abs(d__1)) <= tol) {


	    --k2;
	    idxp[k2] = j;
	    coltyp[j] = 4;
	    if (j == n) {
		goto L120;
	    }
	} else {
	    jprev = j;
	    goto L90;
	}
    }
L90:
    j = jprev;
L100:
    ++j;
    if (j > n) {
	goto L110;
    }
    if ((d__1 = z__[j], abs(d__1)) <= tol) {


	--k2;
	idxp[k2] = j;
	coltyp[j] = 4;
    } else {


	if ((d__1 = d__[j] - d__[jprev], abs(d__1)) <= tol) {


	    s = z__[jprev];
	    c__ = z__[j];


	    tau = dlapy2_(&c__, &s);
	    c__ /= tau;
	    s = -s / tau;
	    z__[j] = tau;
	    z__[jprev] = 0.;


	    idxjp = idxq[idx[jprev] + 1];
	    idxj = idxq[idx[j] + 1];
	    if (idxjp <= nlp1) {
		--idxjp;
	    }
	    if (idxj <= nlp1) {
		--idxj;
	    }
	    if (drot_(interp, &n, &u[idxjp * u_dim1 + 1], &dlasd2_c__1, &u[idxj * u_dim1 + 1], &		    dlasd2_c__1, &c__, &s)!=TCL_OK) { return TCL_ERROR; }


	    if (drot_(interp, &m, &vt[idxjp + vt_dim1], ldvt, &vt[idxj + vt_dim1], ldvt, &		    c__, &s)!=TCL_OK) { return TCL_ERROR; }


	    if (coltyp[j] != coltyp[jprev]) {
		coltyp[j] = 3;
	    }
	    coltyp[jprev] = 4;
	    --k2;
	    idxp[k2] = jprev;
	    jprev = j;
	} else {
	    ++(*k);
	    u2[*k + u2_dim1] = z__[jprev];
	    dsigma[*k] = d__[jprev];
	    idxp[*k] = jprev;
	    jprev = j;
	}
    }
    goto L100;
L110:


    ++(*k);
    u2[*k + u2_dim1] = z__[jprev];
    dsigma[*k] = d__[jprev];
    idxp[*k] = jprev;

L120:


    for (j = 1; j <= 4; ++j) {
	ctot[j - 1] = 0;
    }
    i__1 = n;
    for (j = 2; j <= i__1; ++j) {
	ct = coltyp[j];
	++ctot[ct - 1];
    }


    psm[0] = 2;
    psm[1] = ctot[0] + 2;
    psm[2] = psm[1] + ctot[1];
    psm[3] = psm[2] + ctot[2];


    i__1 = n;
    for (j = 2; j <= i__1; ++j) {
	jp = idxp[j];
	ct = coltyp[jp];
	idxc[psm[ct - 1]] = j;
	++psm[ct - 1];
    }


    i__1 = n;
    for (j = 2; j <= i__1; ++j) {
	jp = idxp[j];
	dsigma[j] = d__[jp];
	idxj = idxq[idx[idxp[idxc[j]]] + 1];
	if (idxj <= nlp1) {
	    --idxj;
	}
	if (dcopy_(interp, &n, &u[idxj * u_dim1 + 1], &dlasd2_c__1, &u2[j * u2_dim1 + 1], &dlasd2_c__1)!=TCL_OK) { return TCL_ERROR; }

	if (dcopy_(interp, &m, &vt[idxj + vt_dim1], ldvt, &vt2[j + vt2_dim1], ldvt2)!=TCL_OK) { return TCL_ERROR; }

    }


    dsigma[1] = 0.;
    hlftol = tol / 2.;
    if (abs(dsigma[2]) <= hlftol) {
	dsigma[2] = hlftol;
    }
    if (m > n) {
	z__[1] = dlapy2_(&z1, &z__[m]);
	if (z__[1] <= tol) {
	    c__ = 1.;
	    s = 0.;
	    z__[1] = tol;
	} else {
	    c__ = z1 / z__[1];
	    s = z__[m] / z__[1];
	}
    } else {
	if (abs(z1) <= tol) {
	    z__[1] = tol;
	} else {
	    z__[1] = z1;
	}
    }


    i__1 = *k - 1;
    if (dcopy_(interp, &i__1, &u2[u2_dim1 + 2], &dlasd2_c__1, &z__[2], &dlasd2_c__1)!=TCL_OK) { return TCL_ERROR; }



    if (dlaset_(interp, "A", &n, &dlasd2_c__1, &dlasd2_c_b30, &dlasd2_c_b30, &u2[u2_offset], ldu2)!=TCL_OK) { return TCL_ERROR; }

    u2[nlp1 + u2_dim1] = 1.;
    if (m > n) {
	i__1 = nlp1;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    vt[m + i__ * vt_dim1] = -s * vt[nlp1 + i__ * vt_dim1];
	    vt2[i__ * vt2_dim1 + 1] = c__ * vt[nlp1 + i__ * vt_dim1];
	}
	i__1 = m;
	for (i__ = nlp2; i__ <= i__1; ++i__) {
	    vt2[i__ * vt2_dim1 + 1] = s * vt[m + i__ * vt_dim1];
	    vt[m + i__ * vt_dim1] = c__ * vt[m + i__ * vt_dim1];
	}
    } else {
	if (dcopy_(interp, &m, &vt[nlp1 + vt_dim1], ldvt, &vt2[vt2_dim1 + 1], ldvt2)!=TCL_OK) { return TCL_ERROR; }

    }
    if (m > n) {
	if (dcopy_(interp, &m, &vt[m + vt_dim1], ldvt, &vt2[m + vt2_dim1], ldvt2)!=TCL_OK) { return TCL_ERROR; }

    }


    if (n > *k) {
	i__1 = n - *k;
	if (dcopy_(interp, &i__1, &dsigma[*k + 1], &dlasd2_c__1, &d__[*k + 1], &dlasd2_c__1)!=TCL_OK) { return TCL_ERROR; }

	i__1 = n - *k;
	if (dlacpy_(interp, "A", &n, &i__1, &u2[(*k + 1) * u2_dim1 + 1], ldu2, &u[(*k + 1)		 * u_dim1 + 1], ldu)!=TCL_OK) { return TCL_ERROR; }


	i__1 = n - *k;
	if (dlacpy_(interp, "A", &i__1, &m, &vt2[*k + 1 + vt2_dim1], ldvt2, &vt[*k + 1 + 		vt_dim1], ldvt)!=TCL_OK) { return TCL_ERROR; }


    }


    for (j = 1; j <= 4; ++j) {
	coltyp[j] = ctot[j - 1];
    }

return TCL_OK;


} /* dlasd2_ */
static /* Subroutine */ int dlasd3_ (Tcl_Interp *interp, integer *nl, integer *nr, integer *sqre, integer 	*k, doublereal *d__, doublereal *q, integer *ldq, doublereal *dsigma, 	doublereal *u, integer *ldu, doublereal *u2, integer *ldu2, 	doublereal *vt, integer *ldvt, doublereal *vt2, integer *ldvt2, 	integer *idxc, integer *ctot, doublereal *z__, integer *info)
{
    integer q_dim1, q_offset, u_dim1, u_offset, u2_dim1, u2_offset, vt_dim1, 
	    vt_offset, vt2_dim1, vt2_offset, i__1, i__2;
    doublereal d__1, d__2;

    double sqrt(doublereal), d_sign(doublereal *, doublereal *);

    integer i__, j, m, n, jc;
    doublereal rho;
    integer nlp1, nlp2, nrp1;
    doublereal temp;
    integer ctemp;
    integer ktemp;




































    --d__;
    q_dim1 = *ldq;
    q_offset = 1 + q_dim1;
    q -= q_offset;
    --dsigma;
    u_dim1 = *ldu;
    u_offset = 1 + u_dim1;
    u -= u_offset;
    u2_dim1 = *ldu2;
    u2_offset = 1 + u2_dim1;
    u2 -= u2_offset;
    vt_dim1 = *ldvt;
    vt_offset = 1 + vt_dim1;
    vt -= vt_offset;
    vt2_dim1 = *ldvt2;
    vt2_offset = 1 + vt2_dim1;
    vt2 -= vt2_offset;
    --idxc;
    --ctot;
    --z__;

    *info = 0;

    if (*nl < 1) {
	*info = -1;
    } else if (*nr < 1) {
	*info = -2;
    } else if (*sqre != 1 && *sqre != 0) {
	*info = -3;
    }

    n = *nl + *nr + 1;
    m = n + *sqre;
    nlp1 = *nl + 1;
    nlp2 = *nl + 2;

    if (*k < 1 || *k > n) {
	*info = -4;
    } else if (*ldq < *k) {
	*info = -7;
    } else if (*ldu < n) {
	*info = -10;
    } else if (*ldu2 < n) {
	*info = -12;
    } else if (*ldvt < m) {
	*info = -14;
    } else if (*ldvt2 < m) {
	*info = -16;
    }
    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DLASD3", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


    if (*k == 1) {
	d__[1] = abs(z__[1]);
	if (dcopy_(interp, &m, &vt2[vt2_dim1 + 1], ldvt2, &vt[vt_dim1 + 1], ldvt)!=TCL_OK) { return TCL_ERROR; }

	if (z__[1] > 0.) {
	    if (dcopy_(interp, &n, &u2[u2_dim1 + 1], &dlasd3_c__1, &u[u_dim1 + 1], &dlasd3_c__1)!=TCL_OK) { return TCL_ERROR; }

	} else {
	    i__1 = n;
	    for (i__ = 1; i__ <= i__1; ++i__) {
		u[i__ + u_dim1] = -u2[i__ + u2_dim1];
	    }
	}
return TCL_OK;
    }


    i__1 = *k;
    for (i__ = 1; i__ <= i__1; ++i__) {
	dsigma[i__] = dlamc3_(&dsigma[i__], &dsigma[i__]) - dsigma[i__];
    }


    if (dcopy_(interp, k, &z__[1], &dlasd3_c__1, &q[q_offset], &dlasd3_c__1)!=TCL_OK) { return TCL_ERROR; }



    rho = dnrm2_(k, &z__[1], &dlasd3_c__1);
    if (dlascl_(interp, "G", &dlasd3_c__0, &dlasd3_c__0, &rho, &dlasd3_c_b13, k, &dlasd3_c__1, &z__[1], k, info)!=TCL_OK) { return TCL_ERROR; }

    rho *= rho;


    i__1 = *k;
    for (j = 1; j <= i__1; ++j) {
	if (dlasd4_(interp, k, &j, &dsigma[1], &z__[1], &u[j * u_dim1 + 1], &rho, &d__[j], 		 &vt[j * vt_dim1 + 1], info)!=TCL_OK) { return TCL_ERROR; }




	if (*info != 0) {
return TCL_OK;
	}
    }


    i__1 = *k;
    for (i__ = 1; i__ <= i__1; ++i__) {
	z__[i__] = u[i__ + *k * u_dim1] * vt[i__ + *k * vt_dim1];
	i__2 = i__ - 1;
	for (j = 1; j <= i__2; ++j) {
	    z__[i__] *= u[i__ + j * u_dim1] * vt[i__ + j * vt_dim1] / (dsigma[
		    i__] - dsigma[j]) / (dsigma[i__] + dsigma[j]);
	}
	i__2 = *k - 1;
	for (j = i__; j <= i__2; ++j) {
	    z__[i__] *= u[i__ + j * u_dim1] * vt[i__ + j * vt_dim1] / (dsigma[
		    i__] - dsigma[j + 1]) / (dsigma[i__] + dsigma[j + 1]);
	}
	d__2 = sqrt((d__1 = z__[i__], abs(d__1)));
	z__[i__] = d_sign(&d__2, &q[i__ + q_dim1]);
    }


    i__1 = *k;
    for (i__ = 1; i__ <= i__1; ++i__) {
	vt[i__ * vt_dim1 + 1] = z__[1] / u[i__ * u_dim1 + 1] / vt[i__ * 
		vt_dim1 + 1];
	u[i__ * u_dim1 + 1] = -1.;
	i__2 = *k;
	for (j = 2; j <= i__2; ++j) {
	    vt[j + i__ * vt_dim1] = z__[j] / u[j + i__ * u_dim1] / vt[j + i__ 
		    * vt_dim1];
	    u[j + i__ * u_dim1] = dsigma[j] * vt[j + i__ * vt_dim1];
	}
	temp = dnrm2_(k, &u[i__ * u_dim1 + 1], &dlasd3_c__1);
	q[i__ * q_dim1 + 1] = u[i__ * u_dim1 + 1] / temp;
	i__2 = *k;
	for (j = 2; j <= i__2; ++j) {
	    jc = idxc[j];
	    q[j + i__ * q_dim1] = u[jc + i__ * u_dim1] / temp;
	}
    }


    if (*k == 2) {
	if (dgemm_(interp, "N", "N", &n, k, k, &dlasd3_c_b13, &u2[u2_offset], ldu2, &q[q_offset], 		 ldq, &dlasd3_c_b26, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }


	goto L100;
    }
    if (ctot[1] > 0) {
	if (dgemm_(interp, "N", "N", nl, k, &ctot[1], &dlasd3_c_b13, &u2[(u2_dim1 << 1) + 1], 		ldu2, &q[q_dim1 + 2], ldq, &dlasd3_c_b26, &u[u_dim1 + 1], ldu)!=TCL_OK) { return TCL_ERROR; }


	if (ctot[3] > 0) {
	    ktemp = ctot[1] + 2 + ctot[2];
	    if (dgemm_(interp, "N", "N", nl, k, &ctot[3], &dlasd3_c_b13, &u2[ktemp * u2_dim1 + 1], ldu2, &q[ktemp + q_dim1], ldq, &dlasd3_c_b13, &u[u_dim1 + 1], 
		    ldu)!=TCL_OK) { return TCL_ERROR; }


	}
    } else if (ctot[3] > 0) {
	ktemp = ctot[1] + 2 + ctot[2];
	if (dgemm_(interp, "N", "N", nl, k, &ctot[3], &dlasd3_c_b13, &u2[ktemp * u2_dim1 + 1], 		ldu2, &q[ktemp + q_dim1], ldq, &dlasd3_c_b26, &u[u_dim1 + 1], ldu)!=TCL_OK) { return TCL_ERROR; }


    } else {
	if (dlacpy_(interp, "F", nl, k, &u2[u2_offset], ldu2, &u[u_offset], ldu)!=TCL_OK) { return TCL_ERROR; }

    }
    if (dcopy_(interp, k, &q[q_dim1 + 1], ldq, &u[nlp1 + u_dim1], ldu)!=TCL_OK) { return TCL_ERROR; }

    ktemp = ctot[1] + 2;
    ctemp = ctot[2] + ctot[3];
    if (dgemm_(interp, "N", "N", nr, k, &ctemp, &dlasd3_c_b13, &u2[nlp2 + ktemp * u2_dim1], ldu2, 	     &q[ktemp + q_dim1], ldq, &dlasd3_c_b26, &u[nlp2 + u_dim1], ldu)!=TCL_OK) { return TCL_ERROR; }




L100:
    i__1 = *k;
    for (i__ = 1; i__ <= i__1; ++i__) {
	temp = dnrm2_(k, &vt[i__ * vt_dim1 + 1], &dlasd3_c__1);
	q[i__ + q_dim1] = vt[i__ * vt_dim1 + 1] / temp;
	i__2 = *k;
	for (j = 2; j <= i__2; ++j) {
	    jc = idxc[j];
	    q[i__ + j * q_dim1] = vt[jc + i__ * vt_dim1] / temp;
	}
    }


    if (*k == 2) {
	if (dgemm_(interp, "N", "N", k, &m, k, &dlasd3_c_b13, &q[q_offset], ldq, &vt2[vt2_offset], ldvt2, &dlasd3_c_b26, &vt[vt_offset], ldvt)!=TCL_OK) { return TCL_ERROR; }


return TCL_OK;
    }
    ktemp = ctot[1] + 1;
    if (dgemm_(interp, "N", "N", k, &nlp1, &ktemp, &dlasd3_c_b13, &q[q_dim1 + 1], ldq, &vt2[	    vt2_dim1 + 1], ldvt2, &dlasd3_c_b26, &vt[vt_dim1 + 1], ldvt)!=TCL_OK) { return TCL_ERROR; }


    ktemp = ctot[1] + 2 + ctot[2];
    if (ktemp <= *ldvt2) {
	if (dgemm_(interp, "N", "N", k, &nlp1, &ctot[3], &dlasd3_c_b13, &q[ktemp * q_dim1 + 1], 		ldq, &vt2[ktemp + vt2_dim1], ldvt2, &dlasd3_c_b13, &vt[vt_dim1 + 1], 
		ldvt)!=TCL_OK) { return TCL_ERROR; }


    }

    ktemp = ctot[1] + 1;
    nrp1 = *nr + *sqre;
    if (ktemp > 1) {
	i__1 = *k;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    q[i__ + ktemp * q_dim1] = q[i__ + q_dim1];
	}
	i__1 = m;
	for (i__ = nlp2; i__ <= i__1; ++i__) {
	    vt2[ktemp + i__ * vt2_dim1] = vt2[i__ * vt2_dim1 + 1];
	}
    }
    ctemp = ctot[2] + 1 + ctot[3];
    if (dgemm_(interp, "N", "N", k, &nrp1, &ctemp, &dlasd3_c_b13, &q[ktemp * q_dim1 + 1], ldq, &	    vt2[ktemp + nlp2 * vt2_dim1], ldvt2, &dlasd3_c_b26, &vt[nlp2 * vt_dim1 + 
	    1], ldvt)!=TCL_OK) { return TCL_ERROR; }



return TCL_OK;


} /* dlasd3_ */
static /* Subroutine */ int dlamrg_ (Tcl_Interp *interp, integer *n1, integer *n2, doublereal *a, integer 	*dtrd1, integer *dtrd2, integer *index)
{
    integer i__1;

    integer i__, ind1, ind2, n1sv, n2sv;













    --index;
    --a;

    n1sv = *n1;
    n2sv = *n2;
    if (*dtrd1 > 0) {
	ind1 = 1;
    } else {
	ind1 = *n1;
    }
    if (*dtrd2 > 0) {
	ind2 = *n1 + 1;
    } else {
	ind2 = *n1 + *n2;
    }
    i__ = 1;
L10:
    if (n1sv > 0 && n2sv > 0) {
	if (a[ind1] <= a[ind2]) {
	    index[i__] = ind1;
	    ++i__;
	    ind1 += *dtrd1;
	    --n1sv;
	} else {
	    index[i__] = ind2;
	    ++i__;
	    ind2 += *dtrd2;
	    --n2sv;
	}
	goto L10;
    }
    if (n1sv == 0) {
	i__1 = n2sv;
	for (n1sv = 1; n1sv <= i__1; ++n1sv) {
	    index[i__] = ind2;
	    ++i__;
	    ind2 += *dtrd2;
	}
    } else {
	i__1 = n1sv;
	for (n2sv = 1; n2sv <= i__1; ++n2sv) {
	    index[i__] = ind1;
	    ++i__;
	    ind1 += *dtrd1;
	}
    }

return TCL_OK;


} /* dlamrg_ */
static /* Subroutine */ int dlasd7_ (Tcl_Interp *interp, integer *icompq, integer *nl, integer *nr, 	integer *sqre, integer *k, doublereal *d__, doublereal *z__, 	doublereal *zw, doublereal *vf, doublereal *vfw, doublereal *vl, 	doublereal *vlw, doublereal *alpha, doublereal *beta, doublereal *	dsigma, integer *idx, integer *idxp, integer *idxq, integer *perm, 	integer *givptr, integer *givcol, integer *ldgcol, doublereal *givnum, 	 integer *ldgnum, doublereal *c__, doublereal *s, integer *info)
{
    integer givcol_dim1, givcol_offset, givnum_dim1, givnum_offset, i__1;
    doublereal d__1, d__2;

    integer i__, j, m, n, k2;
    doublereal z1;
    integer jp;
    doublereal eps, tau, tol;
    integer nlp1, nlp2, idxi, idxj;
    integer idxjp;
    integer jprev;
    doublereal hlftol;










































    --d__;
    --z__;
    --zw;
    --vf;
    --vfw;
    --vl;
    --vlw;
    --dsigma;
    --idx;
    --idxp;
    --idxq;
    --perm;
    givcol_dim1 = *ldgcol;
    givcol_offset = 1 + givcol_dim1;
    givcol -= givcol_offset;
    givnum_dim1 = *ldgnum;
    givnum_offset = 1 + givnum_dim1;
    givnum -= givnum_offset;

    *info = 0;
    n = *nl + *nr + 1;
    m = n + *sqre;

    if (*icompq < 0 || *icompq > 1) {
	*info = -1;
    } else if (*nl < 1) {
	*info = -2;
    } else if (*nr < 1) {
	*info = -3;
    } else if (*sqre < 0 || *sqre > 1) {
	*info = -4;
    } else if (*ldgcol < n) {
	*info = -22;
    } else if (*ldgnum < n) {
	*info = -24;
    }
    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DLASD7", &i__1);
return TCL_ERROR;

return TCL_OK;
    }

    nlp1 = *nl + 1;
    nlp2 = *nl + 2;
    if (*icompq == 1) {
	*givptr = 0;
    }


    z1 = *alpha * vl[nlp1];
    vl[nlp1] = 0.;
    tau = vf[nlp1];
    for (i__ = *nl; i__ >= 1; --i__) {
	z__[i__ + 1] = *alpha * vl[i__];
	vl[i__] = 0.;
	vf[i__ + 1] = vf[i__];
	d__[i__ + 1] = d__[i__];
	idxq[i__ + 1] = idxq[i__] + 1;
    }
    vf[1] = tau;


    i__1 = m;
    for (i__ = nlp2; i__ <= i__1; ++i__) {
	z__[i__] = *beta * vf[i__];
	vf[i__] = 0.;
    }


    i__1 = n;
    for (i__ = nlp2; i__ <= i__1; ++i__) {
	idxq[i__] += nlp1;
    }


    i__1 = n;
    for (i__ = 2; i__ <= i__1; ++i__) {
	dsigma[i__] = d__[idxq[i__]];
	zw[i__] = z__[idxq[i__]];
	vfw[i__] = vf[idxq[i__]];
	vlw[i__] = vl[idxq[i__]];
    }

    if (dlamrg_(interp, nl, nr, &dsigma[2], &dlasd7_c__1, &dlasd7_c__1, &idx[2])!=TCL_OK) { return TCL_ERROR; }


    i__1 = n;
    for (i__ = 2; i__ <= i__1; ++i__) {
	idxi = idx[i__] + 1;
	d__[i__] = dsigma[idxi];
	z__[i__] = zw[idxi];
	vf[i__] = vfw[idxi];
	vl[i__] = vlw[idxi];
    }


    eps = dlamch_("Epsilon");
    d__1 = abs(*alpha), d__2 = abs(*beta);
    tol = max(d__1,d__2);
    d__2 = (d__1 = d__[n], abs(d__1));
    tol = eps * 64. * max(d__2,tol);





    *k = 1;
    k2 = n + 1;
    i__1 = n;
    for (j = 2; j <= i__1; ++j) {
	if ((d__1 = z__[j], abs(d__1)) <= tol) {


	    --k2;
	    idxp[k2] = j;
	    if (j == n) {
		goto L100;
	    }
	} else {
	    jprev = j;
	    goto L70;
	}
    }
L70:
    j = jprev;
L80:
    ++j;
    if (j > n) {
	goto L90;
    }
    if ((d__1 = z__[j], abs(d__1)) <= tol) {


	--k2;
	idxp[k2] = j;
    } else {


	if ((d__1 = d__[j] - d__[jprev], abs(d__1)) <= tol) {


	    *s = z__[jprev];
	    *c__ = z__[j];


	    tau = dlapy2_(c__, s);
	    z__[j] = tau;
	    z__[jprev] = 0.;
	    *c__ /= tau;
	    *s = -(*s) / tau;


	    if (*icompq == 1) {
		++(*givptr);
		idxjp = idxq[idx[jprev] + 1];
		idxj = idxq[idx[j] + 1];
		if (idxjp <= nlp1) {
		    --idxjp;
		}
		if (idxj <= nlp1) {
		    --idxj;
		}
		givcol[*givptr + (givcol_dim1 << 1)] = idxjp;
		givcol[*givptr + givcol_dim1] = idxj;
		givnum[*givptr + (givnum_dim1 << 1)] = *c__;
		givnum[*givptr + givnum_dim1] = *s;
	    }
	    if (drot_(interp, &dlasd7_c__1, &vf[jprev], &dlasd7_c__1, &vf[j], &dlasd7_c__1, c__, s)!=TCL_OK) { return TCL_ERROR; }

	    if (drot_(interp, &dlasd7_c__1, &vl[jprev], &dlasd7_c__1, &vl[j], &dlasd7_c__1, c__, s)!=TCL_OK) { return TCL_ERROR; }

	    --k2;
	    idxp[k2] = jprev;
	    jprev = j;
	} else {
	    ++(*k);
	    zw[*k] = z__[jprev];
	    dsigma[*k] = d__[jprev];
	    idxp[*k] = jprev;
	    jprev = j;
	}
    }
    goto L80;
L90:


    ++(*k);
    zw[*k] = z__[jprev];
    dsigma[*k] = d__[jprev];
    idxp[*k] = jprev;

L100:


    i__1 = n;
    for (j = 2; j <= i__1; ++j) {
	jp = idxp[j];
	dsigma[j] = d__[jp];
	vfw[j] = vf[jp];
	vlw[j] = vl[jp];
    }
    if (*icompq == 1) {
	i__1 = n;
	for (j = 2; j <= i__1; ++j) {
	    jp = idxp[j];
	    perm[j] = idxq[idx[jp] + 1];
	    if (perm[j] <= nlp1) {
		--perm[j];
	    }
	}
    }


    i__1 = n - *k;
    if (dcopy_(interp, &i__1, &dsigma[*k + 1], &dlasd7_c__1, &d__[*k + 1], &dlasd7_c__1)!=TCL_OK) { return TCL_ERROR; }



    dsigma[1] = 0.;
    hlftol = tol / 2.;
    if (abs(dsigma[2]) <= hlftol) {
	dsigma[2] = hlftol;
    }
    if (m > n) {
	z__[1] = dlapy2_(&z1, &z__[m]);
	if (z__[1] <= tol) {
	    *c__ = 1.;
	    *s = 0.;
	    z__[1] = tol;
	} else {
	    *c__ = z1 / z__[1];
	    *s = -z__[m] / z__[1];
	}
	if (drot_(interp, &dlasd7_c__1, &vf[m], &dlasd7_c__1, &vf[1], &dlasd7_c__1, c__, s)!=TCL_OK) { return TCL_ERROR; }

	if (drot_(interp, &dlasd7_c__1, &vl[m], &dlasd7_c__1, &vl[1], &dlasd7_c__1, c__, s)!=TCL_OK) { return TCL_ERROR; }

    } else {
	if (abs(z1) <= tol) {
	    z__[1] = tol;
	} else {
	    z__[1] = z1;
	}
    }


    i__1 = *k - 1;
    if (dcopy_(interp, &i__1, &zw[2], &dlasd7_c__1, &z__[2], &dlasd7_c__1)!=TCL_OK) { return TCL_ERROR; }

    i__1 = n - 1;
    if (dcopy_(interp, &i__1, &vfw[2], &dlasd7_c__1, &vf[2], &dlasd7_c__1)!=TCL_OK) { return TCL_ERROR; }

    i__1 = n - 1;
    if (dcopy_(interp, &i__1, &vlw[2], &dlasd7_c__1, &vl[2], &dlasd7_c__1)!=TCL_OK) { return TCL_ERROR; }


return TCL_OK;


} /* dlasd7_ */
static /* Subroutine */ int dlasd8_ (Tcl_Interp *interp, integer *icompq, integer *k, doublereal *d__, 	doublereal *z__, doublereal *vf, doublereal *vl, doublereal *difl, 	doublereal *difr, integer *lddifr, doublereal *dsigma, doublereal *	work, integer *info)
{
    integer difr_dim1, difr_offset, i__1, i__2;
    doublereal d__1, d__2;

    double sqrt(doublereal), d_sign(doublereal *, doublereal *);

    integer i__, j;
    doublereal dj, rho;
    integer iwk1, iwk2, iwk3;
    doublereal temp;
    integer iwk2i, iwk3i;
    doublereal diflj, difrj, dsigj;
    doublereal dsigjp;


























    --d__;
    --z__;
    --vf;
    --vl;
    --difl;
    difr_dim1 = *lddifr;
    difr_offset = 1 + difr_dim1;
    difr -= difr_offset;
    --dsigma;
    --work;

    *info = 0;

    if (*icompq < 0 || *icompq > 1) {
	*info = -1;
    } else if (*k < 1) {
	*info = -2;
    } else if (*lddifr < *k) {
	*info = -9;
    }
    if (*info != 0) {
	i__1 = -(*info);
	vectcl_xerbla(interp, "DLASD8", &i__1);
return TCL_ERROR;

return TCL_OK;
    }


    if (*k == 1) {
	d__[1] = abs(z__[1]);
	difl[1] = d__[1];
	if (*icompq == 1) {
	    difl[2] = 1.;
	    difr[(difr_dim1 << 1) + 1] = 1.;
	}
return TCL_OK;
    }


    i__1 = *k;
    for (i__ = 1; i__ <= i__1; ++i__) {
	dsigma[i__] = dlamc3_(&dsigma[i__], &dsigma[i__]) - dsigma[i__];
    }


    iwk1 = 1;
    iwk2 = iwk1 + *k;
    iwk3 = iwk2 + *k;
    iwk2i = iwk2 - 1;
    iwk3i = iwk3 - 1;


    rho = dnrm2_(k, &z__[1], &dlasd8_c__1);
    if (dlascl_(interp, "G", &dlasd8_c__0, &dlasd8_c__0, &rho, &dlasd8_c_b8, k, &dlasd8_c__1, &z__[1], k, info)!=TCL_OK) { return TCL_ERROR; }

    rho *= rho;


    if (dlaset_(interp, "A", k, &dlasd8_c__1, &dlasd8_c_b8, &dlasd8_c_b8, &work[iwk3], k)!=TCL_OK) { return TCL_ERROR; }



    i__1 = *k;
    for (j = 1; j <= i__1; ++j) {
	if (dlasd4_(interp, k, &j, &dsigma[1], &z__[1], &work[iwk1], &rho, &d__[j], &work[		iwk2], info)!=TCL_OK) { return TCL_ERROR; }




	if (*info != 0) {
return TCL_OK;
	}
	work[iwk3i + j] = work[iwk3i + j] * work[j] * work[iwk2i + j];
	difl[j] = -work[j];
	difr[j + difr_dim1] = -work[j + 1];
	i__2 = j - 1;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    work[iwk3i + i__] = work[iwk3i + i__] * work[i__] * work[iwk2i + 
		    i__] / (dsigma[i__] - dsigma[j]) / (dsigma[i__] + dsigma[
		    j]);
	}
	i__2 = *k;
	for (i__ = j + 1; i__ <= i__2; ++i__) {
	    work[iwk3i + i__] = work[iwk3i + i__] * work[i__] * work[iwk2i + 
		    i__] / (dsigma[i__] - dsigma[j]) / (dsigma[i__] + dsigma[
		    j]);
	}
    }


    i__1 = *k;
    for (i__ = 1; i__ <= i__1; ++i__) {
	d__2 = sqrt((d__1 = work[iwk3i + i__], abs(d__1)));
	z__[i__] = d_sign(&d__2, &z__[i__]);
    }


    i__1 = *k;
    for (j = 1; j <= i__1; ++j) {
	diflj = difl[j];
	dj = d__[j];
	dsigj = -dsigma[j];
	if (j < *k) {
	    difrj = -difr[j + difr_dim1];
	    dsigjp = -dsigma[j + 1];
	}
	work[j] = -z__[j] / diflj / (dsigma[j] + dj);
	i__2 = j - 1;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    work[i__] = z__[i__] / (dlamc3_(&dsigma[i__], &dsigj) - diflj) / (
		    dsigma[i__] + dj);
	}
	i__2 = *k;
	for (i__ = j + 1; i__ <= i__2; ++i__) {
	    work[i__] = z__[i__] / (dlamc3_(&dsigma[i__], &dsigjp) + difrj) / 
		    (dsigma[i__] + dj);
	}
	temp = dnrm2_(k, &work[1], &dlasd8_c__1);
	work[iwk2i + j] = ddot_(k, &work[1], &dlasd8_c__1, &vf[1], &dlasd8_c__1) / temp;
	work[iwk3i + j] = ddot_(k, &work[1], &dlasd8_c__1, &vl[1], &dlasd8_c__1) / temp;
	if (*icompq == 1) {
	    difr[j + (difr_dim1 << 1)] = temp;
	}
    }

    if (dcopy_(interp, k, &work[iwk2], &dlasd8_c__1, &vf[1], &dlasd8_c__1)!=TCL_OK) { return TCL_ERROR; }

    if (dcopy_(interp, k, &work[iwk3], &dlasd8_c__1, &vl[1], &dlasd8_c__1)!=TCL_OK) { return TCL_ERROR; }


return TCL_OK;


} /* dlasd8_ */
static /* Subroutine */ int zgerc_ (Tcl_Interp *interp, integer *m, integer *n, doublecomplex *alpha, 	doublecomplex *x, integer *incx, doublecomplex *y, integer *incy, 	doublecomplex *a, integer *lda)
{
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
    doublecomplex z__1, z__2;

    void d_cnjg(doublecomplex *, doublecomplex *);

    integer i__, j, ix, jy, kx, info;
    doublecomplex temp;






















    --x;
    --y;
    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;

    info = 0;
    if (*m < 0) {
	info = 1;
    } else if (*n < 0) {
	info = 2;
    } else if (*incx == 0) {
	info = 5;
    } else if (*incy == 0) {
	info = 7;
    } else if (*lda < max(1,*m)) {
	info = 9;
    }
    if (info != 0) {
	vectcl_xerbla(interp, "ZGERC ", &info);
return TCL_ERROR;

return TCL_OK;
    }


    if (*m == 0 || *n == 0 || alpha->r == 0. && alpha->i == 0.) {
return TCL_OK;
    }


    if (*incy > 0) {
	jy = 1;
    } else {
	jy = 1 - (*n - 1) * *incy;
    }
    if (*incx == 1) {
	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = jy;
	    if (y[i__2].r != 0. || y[i__2].i != 0.) {
		d_cnjg(&z__2, &y[jy]);
		z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i = 
			alpha->r * z__2.i + alpha->i * z__2.r;
		temp.r = z__1.r, temp.i = z__1.i;
		i__2 = *m;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    i__3 = i__ + j * a_dim1;
		    i__4 = i__ + j * a_dim1;
		    i__5 = i__;
		    z__2.r = x[i__5].r * temp.r - x[i__5].i * temp.i, z__2.i =
			     x[i__5].r * temp.i + x[i__5].i * temp.r;
		    z__1.r = a[i__4].r + z__2.r, z__1.i = a[i__4].i + z__2.i;
		    a[i__3].r = z__1.r, a[i__3].i = z__1.i;
		}
	    }
	    jy += *incy;
	}
    } else {
	if (*incx > 0) {
	    kx = 1;
	} else {
	    kx = 1 - (*m - 1) * *incx;
	}
	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    i__2 = jy;
	    if (y[i__2].r != 0. || y[i__2].i != 0.) {
		d_cnjg(&z__2, &y[jy]);
		z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i = 
			alpha->r * z__2.i + alpha->i * z__2.r;
		temp.r = z__1.r, temp.i = z__1.i;
		ix = kx;
		i__2 = *m;
		for (i__ = 1; i__ <= i__2; ++i__) {
		    i__3 = i__ + j * a_dim1;
		    i__4 = i__ + j * a_dim1;
		    i__5 = ix;
		    z__2.r = x[i__5].r * temp.r - x[i__5].i * temp.i, z__2.i =
			     x[i__5].r * temp.i + x[i__5].i * temp.r;
		    z__1.r = a[i__4].r + z__2.r, z__1.i = a[i__4].i + z__2.i;
		    a[i__3].r = z__1.r, a[i__3].i = z__1.i;
		    ix += *incx;
		}
	    }
	    jy += *incy;
	}
    }

return TCL_OK;


} /* zgerc_ */
static doublereal dlapy3_ (doublereal *x, doublereal *y, doublereal *z__)
{
    doublereal ret_val, d__1, d__2, d__3;

    double sqrt(doublereal);

    doublereal w, xabs, yabs, zabs;










    xabs = abs(*x);
    yabs = abs(*y);
    zabs = abs(*z__);
    d__1 = max(xabs,yabs);
    w = max(d__1,zabs);
    if (w == 0.) {
	ret_val = xabs + yabs + zabs;
    } else {
	d__1 = xabs / w;
	d__2 = yabs / w;
	d__3 = zabs / w;
	ret_val = w * sqrt(d__1 * d__1 + d__2 * d__2 + d__3 * d__3);
    }
    return ret_val;


} /* dlapy3_ */
static /* Subroutine */ int dlasq3_ (Tcl_Interp *interp, integer *i0, integer *n0, doublereal *z__, 	integer *pp, doublereal *dmin__, doublereal *sigma, doublereal *desig, 	 doublereal *qmax, integer *nfail, integer *iter, integer *ndiv, 	logical *ieee, integer *ttype, doublereal *dmin1, doublereal *dmin2, 	doublereal *dn, doublereal *dn1, doublereal *dn2, doublereal *g, 	doublereal *tau)
{
    integer i__1;
    doublereal d__1, d__2;

    double sqrt(doublereal);

    doublereal s, t;
    integer j4, nn;
    doublereal eps, tol;
    integer n0in, ipn4;
    doublereal tol2, temp;

























    --z__;

    n0in = *n0;
    eps = dlamch_("Precision");
    tol = eps * 100.;
    d__1 = tol;
    tol2 = d__1 * d__1;


L10:

    if (*n0 < *i0) {
return TCL_OK;
    }
    if (*n0 == *i0) {
	goto L20;
    }
    nn = (*n0 << 2) + *pp;
    if (*n0 == *i0 + 1) {
	goto L40;
    }


    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;


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:
    if (*pp == 2) {
	*pp = 0;
    }


    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;
	    }
	    if (*n0 - *i0 <= 4) {
		z__[(*n0 << 2) + *pp - 1] = z__[(*i0 << 2) + *pp - 1];
		z__[(*n0 << 2) - *pp] = z__[(*i0 << 2) - *pp];
	    }
	    d__1 = *dmin2, d__2 = z__[(*n0 << 2) + *pp - 1];
	    *dmin2 = min(d__1,d__2);
	    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);
	    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);
	    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.;
	}
    }


    if (dlasq4_(interp, i0, n0, &z__[1], pp, &n0in, dmin__, dmin1, dmin2, dn, dn1, dn2, 	    tau, ttype, g)!=TCL_OK) { return TCL_ERROR; }




L70:

    if (dlasq5_(interp, i0, n0, &z__[1], pp, tau, dmin__, dmin1, dmin2, dn, dn1, dn2, 	    ieee)!=TCL_OK) { return TCL_ERROR; }



    *ndiv += *n0 - *i0 + 2;
    ++(*iter);


    if (*dmin__ >= 0. && *dmin1 > 0.) {


	goto L90;

    } else if (*dmin__ < 0. && *dmin1 > 0. && z__[(*n0 - 1 << 2) - *pp] < tol 
	    * (*sigma + *dn1) && abs(*dn) < tol * *sigma) {


	z__[(*n0 - 1 << 2) - *pp + 2] = 0.;
	*dmin__ = 0.;
	goto L90;
    } else if (*dmin__ < 0.) {


	++(*nfail);
	if (*ttype < -22) {


	    *tau = 0.;
	} else if (*dmin1 > 0.) {


	    *tau = (*tau + *dmin__) * (1. - eps * 2.);
	    *ttype += -11;
	} else {


	    *tau *= .25;
	    *ttype += -12;
	}
	goto L70;
    } else if (disnan_(dmin__)) {


	if (*tau == 0.) {
	    goto L80;
	} else {
	    *tau = 0.;
	    goto L70;
	}
    } else {


	goto L80;
    }


L80:
    if (dlasq6_(interp, i0, n0, &z__[1], pp, dmin__, dmin1, dmin2, dn, dn1, dn2)!=TCL_OK) { return TCL_ERROR; }

    *ndiv += *n0 - *i0 + 2;
    ++(*iter);
    *tau = 0.;

L90:
    if (*tau < *sigma) {
	*desig += *tau;
	t = *sigma + *desig;
	*desig -= t - *sigma;
    } else {
	t = *sigma + *tau;
	*desig = *sigma - (t - *tau) + *desig;
    }
    *sigma = t;

return TCL_OK;


} /* dlasq3_ */
static integer dlaneg_ (integer *n, doublereal *d__, doublereal *lld, doublereal *	sigma, doublereal *pivmin, integer *r__)
{
    integer ret_val, i__1, i__2, i__3, i__4;

    integer j;
    doublereal p, t;
    integer bj;
    doublereal tmp;
    integer neg1, neg2;
    doublereal bsav, gamma, dplus;
    integer negcnt;
    logical sawnan;
    doublereal dminus;



















    --lld;
    --d__;

    negcnt = 0;
    t = -(*sigma);
    i__1 = *r__ - 1;
    for (bj = 1; bj <= i__1; bj += 128) {
	neg1 = 0;
	bsav = t;
	i__3 = bj + 127, i__4 = *r__ - 1;
	i__2 = min(i__3,i__4);
	for (j = bj; j <= i__2; ++j) {
	    dplus = d__[j] + t;
	    if (dplus < 0.) {
		++neg1;
	    }
	    tmp = t / dplus;
	    t = tmp * lld[j] - *sigma;
	}
	sawnan = disnan_(&t);
	if (sawnan) {
	    neg1 = 0;
	    t = bsav;
	    i__3 = bj + 127, i__4 = *r__ - 1;
	    i__2 = min(i__3,i__4);
	    for (j = bj; j <= i__2; ++j) {
		dplus = d__[j] + t;
		if (dplus < 0.) {
		    ++neg1;
		}
		tmp = t / dplus;
		if (disnan_(&tmp)) {
		    tmp = 1.;
		}
		t = tmp * lld[j] - *sigma;
	    }
	}
	negcnt += neg1;
    }

    p = d__[*n] - *sigma;
    i__1 = *r__;
    for (bj = *n - 1; bj >= i__1; bj += -128) {
	neg2 = 0;
	bsav = p;
	i__3 = bj - 127;
	i__2 = max(i__3,*r__);
	for (j = bj; j >= i__2; --j) {
	    dminus = lld[j] + p;
	    if (dminus < 0.) {
		++neg2;
	    }
	    tmp = p / dminus;
	    p = tmp * d__[j] - *sigma;
	}
	sawnan = disnan_(&p);

	if (sawnan) {
	    neg2 = 0;
	    p = bsav;
	    i__3 = bj - 127;
	    i__2 = max(i__3,*r__);
	    for (j = bj; j >= i__2; --j) {
		dminus = lld[j] + p;
		if (dminus < 0.) {
		    ++neg2;
		}
		tmp = p / dminus;
		if (disnan_(&tmp)) {
		    tmp = 1.;
		}
		p = tmp * d__[j] - *sigma;
	    }
	}
	negcnt += neg2;
    }

    gamma = t + *sigma + p;
    if (gamma < 0.) {
	++negcnt;
    }
    ret_val = negcnt;
    return ret_val;
} /* dlaneg_ */
static /* Subroutine */ int dormhr_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *ilo, integer *ihi, doublereal *a, integer *lda, doublereal *	tau, doublereal *c__, integer *ldc, doublereal *work, integer *lwork, 	integer *info)
{
    address a__1[2];
    integer a_dim1, a_offset, c_dim1, c_offset, i__1[2], i__2;
    char ch__1[2];

    /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);

    integer i1, i2, nb, mi, nh, ni, nq, nw;
    logical left;
    integer iinfo;
    integer lwkopt;
    logical lquery;



























    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --tau;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;
    --work;

    *info = 0;
    nh = *ihi - *ilo;
    left = lsame_(side, "L");
    lquery = *lwork == -1;


    if (left) {
	nq = *m;
	nw = *n;
    } else {
	nq = *n;
	nw = *m;
    }
    if (! left && ! lsame_(side, "R")) {
	*info = -1;
    } else if (! lsame_(trans, "N") && ! lsame_(trans, 
	    "T")) {
	*info = -2;
    } else if (*m < 0) {
	*info = -3;
    } else if (*n < 0) {
	*info = -4;
    } else if (*ilo < 1 || *ilo > max(1,nq)) {
	*info = -5;
    } else if (*ihi < min(*ilo,nq) || *ihi > nq) {
	*info = -6;
    } else if (*lda < max(1,nq)) {
	*info = -8;
    } else if (*ldc < max(1,*m)) {
	*info = -11;
    } else if (*lwork < max(1,nw) && ! lquery) {
	*info = -13;
    }

    if (*info == 0) {
	if (left) {
	    i__1[0] = 1, a__1[0] = side;
	    i__1[1] = 1, a__1[1] = trans;
	    s_cat(ch__1, a__1, i__1, &dormhr_c__2, (ftnlen)2);
	    nb = ilaenv_(&dormhr_c__1, "DORMQR", ch__1, &nh, n, &nh, &dormhr_c_n1);
	} else {
	    i__1[0] = 1, a__1[0] = side;
	    i__1[1] = 1, a__1[1] = trans;
	    s_cat(ch__1, a__1, i__1, &dormhr_c__2, (ftnlen)2);
	    nb = ilaenv_(&dormhr_c__1, "DORMQR", ch__1, m, &nh, &nh, &dormhr_c_n1);
	}
	lwkopt = max(1,nw) * nb;
	work[1] = (doublereal) lwkopt;
    }

    if (*info != 0) {
	i__2 = -(*info);
	vectcl_xerbla(interp, "DORMHR", &i__2);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


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

    if (left) {
	mi = nh;
	ni = *n;
	i1 = *ilo + 1;
	i2 = 1;
    } else {
	mi = *m;
	ni = nh;
	i1 = 1;
	i2 = *ilo + 1;
    }

    if (dormqr_(interp, side, trans, &mi, &ni, &nh, &a[*ilo + 1 + *ilo * a_dim1], lda, &	    tau[*ilo], &c__[i1 + i2 * c_dim1], ldc, &work[1], lwork, &iinfo)!=TCL_OK) { return TCL_ERROR; }



    work[1] = (doublereal) lwkopt;
return TCL_OK;


} /* dormhr_ */
static /* Subroutine */ int dlaqr2_ (Tcl_Interp *interp, logical *wantt, logical *wantz, integer *n, 	integer *ktop, integer *kbot, integer *nw, doublereal *h__, integer *	ldh, integer *iloz, integer *ihiz, doublereal *z__, integer *ldz, 	integer *ns, integer *nd, doublereal *sr, doublereal *si, doublereal *	v, integer *ldv, integer *nh, doublereal *t, integer *ldt, integer *	nv, doublereal *wv, integer *ldwv, doublereal *work, integer *lwork)
{
    integer h_dim1, h_offset, t_dim1, t_offset, v_dim1, v_offset, wv_dim1, 
	    wv_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4;
    doublereal d__1, d__2, d__3, d__4, d__5, d__6;

    double sqrt(doublereal);

    integer i__, j, k;
    doublereal s, aa, bb, cc, dd, cs, sn;
    integer jw;
    doublereal evi, evk, foo;
    integer kln;
    doublereal tau, ulp;
    integer lwk1, lwk2;
    doublereal beta;
    integer kend, kcol, info, ifst, ilst, ltop, krow;
    logical bulge;
    integer infqr, kwtop;
    doublereal safmin;
    doublereal safmax;
    logical sorted;
    doublereal smlnum;
    integer lwkopt;




































    h_dim1 = *ldh;
    h_offset = 1 + h_dim1;
    h__ -= h_offset;
    z_dim1 = *ldz;
    z_offset = 1 + z_dim1;
    z__ -= z_offset;
    --sr;
    --si;
    v_dim1 = *ldv;
    v_offset = 1 + v_dim1;
    v -= v_offset;
    t_dim1 = *ldt;
    t_offset = 1 + t_dim1;
    t -= t_offset;
    wv_dim1 = *ldwv;
    wv_offset = 1 + wv_dim1;
    wv -= wv_offset;
    --work;

    i__1 = *nw, i__2 = *kbot - *ktop + 1;
    jw = min(i__1,i__2);
    if (jw <= 2) {
	lwkopt = 1;
    } else {


	i__1 = jw - 1;
	if (dgehrd_(interp, &jw, &dlaqr2_c__1, &i__1, &t[t_offset], ldt, &work[1], &work[1], &		dlaqr2_c_n1, &info)!=TCL_OK) { return TCL_ERROR; }


	lwk1 = (integer) work[1];


	i__1 = jw - 1;
	if (dormhr_(interp, "R", "N", &jw, &jw, &dlaqr2_c__1, &i__1, &t[t_offset], ldt, &work[1], 		 &v[v_offset], ldv, &work[1], &dlaqr2_c_n1, &info)!=TCL_OK) { return TCL_ERROR; }


	lwk2 = (integer) work[1];


	lwkopt = jw + max(lwk1,lwk2);
    }


    if (*lwork == -1) {
	work[1] = (doublereal) lwkopt;
return TCL_OK;
    }

    *ns = 0;
    *nd = 0;
    work[1] = 1.;
    if (*ktop > *kbot) {
return TCL_OK;
    }
    if (*nw < 1) {
return TCL_OK;
    }


    safmin = dlamch_("SAFE MINIMUM");
    safmax = 1. / safmin;
    if (dlabad_(interp, &safmin, &safmax)!=TCL_OK) { return TCL_ERROR; }

    ulp = dlamch_("PRECISION");
    smlnum = safmin * ((doublereal) (*n) / ulp);


    i__1 = *nw, i__2 = *kbot - *ktop + 1;
    jw = min(i__1,i__2);
    kwtop = *kbot - jw + 1;
    if (kwtop == *ktop) {
	s = 0.;
    } else {
	s = h__[kwtop + (kwtop - 1) * h_dim1];
    }

    if (*kbot == kwtop) {


	sr[kwtop] = h__[kwtop + kwtop * h_dim1];
	si[kwtop] = 0.;
	*ns = 1;
	*nd = 0;
	d__2 = smlnum, d__3 = ulp * (d__1 = h__[kwtop + kwtop * h_dim1], abs(
		d__1));
	if (abs(s) <= max(d__2,d__3)) {
	    *ns = 0;
	    *nd = 1;
	    if (kwtop > *ktop) {
		h__[kwtop + (kwtop - 1) * h_dim1] = 0.;
	    }
	}
	work[1] = 1.;
return TCL_OK;
    }


    if (dlacpy_(interp, "U", &jw, &jw, &h__[kwtop + kwtop * h_dim1], ldh, &t[t_offset], 	    ldt)!=TCL_OK) { return TCL_ERROR; }


    i__1 = jw - 1;
    i__2 = *ldh + 1;
    i__3 = *ldt + 1;
    if (dcopy_(interp, &i__1, &h__[kwtop + 1 + kwtop * h_dim1], &i__2, &t[t_dim1 + 2], &	    i__3)!=TCL_OK) { return TCL_ERROR; }



    if (dlaset_(interp, "A", &jw, &jw, &dlaqr2_c_b12, &dlaqr2_c_b13, &v[v_offset], ldv)!=TCL_OK) { return TCL_ERROR; }

    if (dlahqr_(interp, &dlaqr2_c_true, &dlaqr2_c_true, &jw, &dlaqr2_c__1, &jw, &t[t_offset], ldt, &sr[kwtop], 	    &si[kwtop], &dlaqr2_c__1, &jw, &v[v_offset], ldv, &infqr)!=TCL_OK) { return TCL_ERROR; }




    i__1 = jw - 3;
    for (j = 1; j <= i__1; ++j) {
	t[j + 2 + j * t_dim1] = 0.;
	t[j + 3 + j * t_dim1] = 0.;
    }
    if (jw > 2) {
	t[jw + (jw - 2) * t_dim1] = 0.;
    }


    *ns = jw;
    ilst = infqr + 1;
L20:
    if (ilst <= *ns) {
	if (*ns == 1) {
	    bulge = FALSE_;
	} else {
	    bulge = t[*ns + (*ns - 1) * t_dim1] != 0.;
	}


	if (! bulge) {


	    foo = (d__1 = t[*ns + *ns * t_dim1], abs(d__1));
	    if (foo == 0.) {
		foo = abs(s);
	    }
	    d__2 = smlnum, d__3 = ulp * foo;
	    if ((d__1 = s * v[*ns * v_dim1 + 1], abs(d__1)) <= max(d__2,d__3))
		     {


		--(*ns);
	    } else {


		ifst = *ns;
		if (dtrexc_(interp, "V", &jw, &t[t_offset], ldt, &v[v_offset], ldv, &ifst, 			 &ilst, &work[1], &info)!=TCL_OK) { return TCL_ERROR; }


		++ilst;
	    }
	} else {


	    foo = (d__3 = t[*ns + *ns * t_dim1], abs(d__3)) + sqrt((d__1 = t[*
		    ns + (*ns - 1) * t_dim1], abs(d__1))) * sqrt((d__2 = t[*
		    ns - 1 + *ns * t_dim1], abs(d__2)));
	    if (foo == 0.) {
		foo = abs(s);
	    }
	    d__3 = (d__1 = s * v[*ns * v_dim1 + 1], abs(d__1)), d__4 = (d__2 =
		     s * v[(*ns - 1) * v_dim1 + 1], abs(d__2));
	    d__5 = smlnum, d__6 = ulp * foo;
	    if (max(d__3,d__4) <= max(d__5,d__6)) {


		*ns += -2;
	    } else {


		ifst = *ns;
		if (dtrexc_(interp, "V", &jw, &t[t_offset], ldt, &v[v_offset], ldv, &ifst, 			 &ilst, &work[1], &info)!=TCL_OK) { return TCL_ERROR; }


		ilst += 2;
	    }
	}


	goto L20;
    }


    if (*ns == 0) {
	s = 0.;
    }

    if (*ns < jw) {


	sorted = FALSE_;
	i__ = *ns + 1;
L30:
	if (sorted) {
	    goto L50;
	}
	sorted = TRUE_;

	kend = i__ - 1;
	i__ = infqr + 1;
	if (i__ == *ns) {
	    k = i__ + 1;
	} else if (t[i__ + 1 + i__ * t_dim1] == 0.) {
	    k = i__ + 1;
	} else {
	    k = i__ + 2;
	}
L40:
	if (k <= kend) {
	    if (k == i__ + 1) {
		evi = (d__1 = t[i__ + i__ * t_dim1], abs(d__1));
	    } else {
		evi = (d__3 = t[i__ + i__ * t_dim1], abs(d__3)) + sqrt((d__1 =
			 t[i__ + 1 + i__ * t_dim1], abs(d__1))) * sqrt((d__2 =
			 t[i__ + (i__ + 1) * t_dim1], abs(d__2)));
	    }

	    if (k == kend) {
		evk = (d__1 = t[k + k * t_dim1], abs(d__1));
	    } else if (t[k + 1 + k * t_dim1] == 0.) {
		evk = (d__1 = t[k + k * t_dim1], abs(d__1));
	    } else {
		evk = (d__3 = t[k + k * t_dim1], abs(d__3)) + sqrt((d__1 = t[
			k + 1 + k * t_dim1], abs(d__1))) * sqrt((d__2 = t[k + 
			(k + 1) * t_dim1], abs(d__2)));
	    }

	    if (evi >= evk) {
		i__ = k;
	    } else {
		sorted = FALSE_;
		ifst = i__;
		ilst = k;
		if (dtrexc_(interp, "V", &jw, &t[t_offset], ldt, &v[v_offset], ldv, &ifst, 			 &ilst, &work[1], &info)!=TCL_OK) { return TCL_ERROR; }


		if (info == 0) {
		    i__ = ilst;
		} else {
		    i__ = k;
		}
	    }
	    if (i__ == kend) {
		k = i__ + 1;
	    } else if (t[i__ + 1 + i__ * t_dim1] == 0.) {
		k = i__ + 1;
	    } else {
		k = i__ + 2;
	    }
	    goto L40;
	}
	goto L30;
L50:
	;
    }


    i__ = jw;
L60:
    if (i__ >= infqr + 1) {
	if (i__ == infqr + 1) {
	    sr[kwtop + i__ - 1] = t[i__ + i__ * t_dim1];
	    si[kwtop + i__ - 1] = 0.;
	    --i__;
	} else if (t[i__ + (i__ - 1) * t_dim1] == 0.) {
	    sr[kwtop + i__ - 1] = t[i__ + i__ * t_dim1];
	    si[kwtop + i__ - 1] = 0.;
	    --i__;
	} else {
	    aa = t[i__ - 1 + (i__ - 1) * t_dim1];
	    cc = t[i__ + (i__ - 1) * t_dim1];
	    bb = t[i__ - 1 + i__ * t_dim1];
	    dd = t[i__ + i__ * t_dim1];
	    if (dlanv2_(interp, &aa, &bb, &cc, &dd, &sr[kwtop + i__ - 2], &si[kwtop + i__ 		    - 2], &sr[kwtop + i__ - 1], &si[kwtop + i__ - 1], &cs, &
		    sn)!=TCL_OK) { return TCL_ERROR; }


	    i__ += -2;
	}
	goto L60;
    }

    if (*ns < jw || s == 0.) {
	if (*ns > 1 && s != 0.) {


	    if (dcopy_(interp, ns, &v[v_offset], ldv, &work[1], &dlaqr2_c__1)!=TCL_OK) { return TCL_ERROR; }

	    beta = work[1];
	    if (dlarfg_(interp, ns, &beta, &work[2], &dlaqr2_c__1, &tau)!=TCL_OK) { return TCL_ERROR; }

	    work[1] = 1.;

	    i__1 = jw - 2;
	    i__2 = jw - 2;
	    if (dlaset_(interp, "L", &i__1, &i__2, &dlaqr2_c_b12, &dlaqr2_c_b12, &t[t_dim1 + 3], ldt)!=TCL_OK) { return TCL_ERROR; }


	    if (dlarf_(interp, "L", ns, &jw, &work[1], &dlaqr2_c__1, &tau, &t[t_offset], ldt, &		    work[jw + 1])!=TCL_OK) { return TCL_ERROR; }


	    if (dlarf_(interp, "R", ns, ns, &work[1], &dlaqr2_c__1, &tau, &t[t_offset], ldt, &		    work[jw + 1])!=TCL_OK) { return TCL_ERROR; }


	    if (dlarf_(interp, "R", &jw, ns, &work[1], &dlaqr2_c__1, &tau, &v[v_offset], ldv, &		    work[jw + 1])!=TCL_OK) { return TCL_ERROR; }



	    i__1 = *lwork - jw;
	    if (dgehrd_(interp, &jw, &dlaqr2_c__1, ns, &t[t_offset], ldt, &work[1], &work[jw + 1], &i__1, &info)!=TCL_OK) { return TCL_ERROR; }


	}


	if (kwtop > 1) {
	    h__[kwtop + (kwtop - 1) * h_dim1] = s * v[v_dim1 + 1];
	}
	if (dlacpy_(interp, "U", &jw, &jw, &t[t_offset], ldt, &h__[kwtop + kwtop * h_dim1], ldh)!=TCL_OK) { return TCL_ERROR; }


	i__1 = jw - 1;
	i__2 = *ldt + 1;
	i__3 = *ldh + 1;
	if (dcopy_(interp, &i__1, &t[t_dim1 + 2], &i__2, &h__[kwtop + 1 + kwtop * h_dim1], 		 &i__3)!=TCL_OK) { return TCL_ERROR; }




	if (*ns > 1 && s != 0.) {
	    i__1 = *lwork - jw;
	    if (dormhr_(interp, "R", "N", &jw, ns, &dlaqr2_c__1, ns, &t[t_offset], ldt, &work[1], 		     &v[v_offset], ldv, &work[jw + 1], &i__1, &info)!=TCL_OK) { return TCL_ERROR; }


	}


	if (*wantt) {
	    ltop = 1;
	} else {
	    ltop = *ktop;
	}
	i__1 = kwtop - 1;
	i__2 = *nv;
	for (krow = ltop; i__2 < 0 ? krow >= i__1 : krow <= i__1; krow += 
		i__2) {
	    i__3 = *nv, i__4 = kwtop - krow;
	    kln = min(i__3,i__4);
	    if (dgemm_(interp, "N", "N", &kln, &jw, &jw, &dlaqr2_c_b13, &h__[krow + kwtop * 		    h_dim1], ldh, &v[v_offset], ldv, &dlaqr2_c_b12, &wv[wv_offset], 
		    ldwv)!=TCL_OK) { return TCL_ERROR; }


	    if (dlacpy_(interp, "A", &kln, &jw, &wv[wv_offset], ldwv, &h__[krow + kwtop * 		    h_dim1], ldh)!=TCL_OK) { return TCL_ERROR; }


	}


	if (*wantt) {
	    i__2 = *n;
	    i__1 = *nh;
	    for (kcol = *kbot + 1; i__1 < 0 ? kcol >= i__2 : kcol <= i__2; 
		    kcol += i__1) {
		i__3 = *nh, i__4 = *n - kcol + 1;
		kln = min(i__3,i__4);
		if (dgemm_(interp, "C", "N", &jw, &kln, &jw, &dlaqr2_c_b13, &v[v_offset], ldv, &			h__[kwtop + kcol * h_dim1], ldh, &dlaqr2_c_b12, &t[t_offset], 
			 ldt)!=TCL_OK) { return TCL_ERROR; }


		if (dlacpy_(interp, "A", &jw, &kln, &t[t_offset], ldt, &h__[kwtop + kcol *			 h_dim1], ldh)!=TCL_OK) { return TCL_ERROR; }


	    }
	}


	if (*wantz) {
	    i__1 = *ihiz;
	    i__2 = *nv;
	    for (krow = *iloz; i__2 < 0 ? krow >= i__1 : krow <= i__1; krow +=
		     i__2) {
		i__3 = *nv, i__4 = *ihiz - krow + 1;
		kln = min(i__3,i__4);
		if (dgemm_(interp, "N", "N", &kln, &jw, &jw, &dlaqr2_c_b13, &z__[krow + kwtop * 			z_dim1], ldz, &v[v_offset], ldv, &dlaqr2_c_b12, &wv[
			wv_offset], ldwv)!=TCL_OK) { return TCL_ERROR; }


		if (dlacpy_(interp, "A", &kln, &jw, &wv[wv_offset], ldwv, &z__[krow + 			kwtop * z_dim1], ldz)!=TCL_OK) { return TCL_ERROR; }


	    }
	}
    }


    *nd = jw - *ns;


    *ns -= infqr;


    work[1] = (doublereal) lwkopt;


return TCL_OK;
} /* dlaqr2_ */
static /* Subroutine */ int dlaqr1_ (Tcl_Interp *interp, integer *n, doublereal *h__, integer *ldh, 	doublereal *sr1, doublereal *si1, doublereal *sr2, doublereal *si2, 	doublereal *v)
{
    integer h_dim1, h_offset;
    doublereal d__1, d__2, d__3;

    doublereal s, h21s, h31s;

















    h_dim1 = *ldh;
    h_offset = 1 + h_dim1;
    h__ -= h_offset;
    --v;

    if (*n == 2) {
	s = (d__1 = h__[h_dim1 + 1] - *sr2, abs(d__1)) + abs(*si2) + (d__2 = 
		h__[h_dim1 + 2], abs(d__2));
	if (s == 0.) {
	    v[1] = 0.;
	    v[2] = 0.;
	} else {
	    h21s = h__[h_dim1 + 2] / s;
	    v[1] = h21s * h__[(h_dim1 << 1) + 1] + (h__[h_dim1 + 1] - *sr1) * 
		    ((h__[h_dim1 + 1] - *sr2) / s) - *si1 * (*si2 / s);
	    v[2] = h21s * (h__[h_dim1 + 1] + h__[(h_dim1 << 1) + 2] - *sr1 - *
		    sr2);
	}
    } else {
	s = (d__1 = h__[h_dim1 + 1] - *sr2, abs(d__1)) + abs(*si2) + (d__2 = 
		h__[h_dim1 + 2], abs(d__2)) + (d__3 = h__[h_dim1 + 3], abs(
		d__3));
	if (s == 0.) {
	    v[1] = 0.;
	    v[2] = 0.;
	    v[3] = 0.;
	} else {
	    h21s = h__[h_dim1 + 2] / s;
	    h31s = h__[h_dim1 + 3] / s;
	    v[1] = (h__[h_dim1 + 1] - *sr1) * ((h__[h_dim1 + 1] - *sr2) / s) 
		    - *si1 * (*si2 / s) + h__[(h_dim1 << 1) + 1] * h21s + h__[
		    h_dim1 * 3 + 1] * h31s;
	    v[2] = h21s * (h__[h_dim1 + 1] + h__[(h_dim1 << 1) + 2] - *sr1 - *
		    sr2) + h__[h_dim1 * 3 + 2] * h31s;
	    v[3] = h31s * (h__[h_dim1 + 1] + h__[h_dim1 * 3 + 3] - *sr1 - *
		    sr2) + h21s * h__[(h_dim1 << 1) + 3];
	}
    }
return TCL_OK;
} /* dlaqr1_ */
static /* Subroutine */ int zunmhr_ (Tcl_Interp *interp, char *side, char *trans, integer *m, integer *n, 	integer *ilo, integer *ihi, doublecomplex *a, integer *lda, 	doublecomplex *tau, doublecomplex *c__, integer *ldc, doublecomplex *	work, integer *lwork, integer *info)
{
    address a__1[2];
    integer a_dim1, a_offset, c_dim1, c_offset, i__1[2], i__2;
    char ch__1[2];

    /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);

    integer i1, i2, nb, mi, nh, ni, nq, nw;
    logical left;
    integer iinfo;
    integer lwkopt;
    logical lquery;



























    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --tau;
    c_dim1 = *ldc;
    c_offset = 1 + c_dim1;
    c__ -= c_offset;
    --work;

    *info = 0;
    nh = *ihi - *ilo;
    left = lsame_(side, "L");
    lquery = *lwork == -1;


    if (left) {
	nq = *m;
	nw = *n;
    } else {
	nq = *n;
	nw = *m;
    }
    if (! left && ! lsame_(side, "R")) {
	*info = -1;
    } else if (! lsame_(trans, "N") && ! lsame_(trans, 
	    "C")) {
	*info = -2;
    } else if (*m < 0) {
	*info = -3;
    } else if (*n < 0) {
	*info = -4;
    } else if (*ilo < 1 || *ilo > max(1,nq)) {
	*info = -5;
    } else if (*ihi < min(*ilo,nq) || *ihi > nq) {
	*info = -6;
    } else if (*lda < max(1,nq)) {
	*info = -8;
    } else if (*ldc < max(1,*m)) {
	*info = -11;
    } else if (*lwork < max(1,nw) && ! lquery) {
	*info = -13;
    }

    if (*info == 0) {
	if (left) {
	    i__1[0] = 1, a__1[0] = side;
	    i__1[1] = 1, a__1[1] = trans;
	    s_cat(ch__1, a__1, i__1, &zunmhr_c__2, (ftnlen)2);
	    nb = ilaenv_(&zunmhr_c__1, "ZUNMQR", ch__1, &nh, n, &nh, &zunmhr_c_n1);
	} else {
	    i__1[0] = 1, a__1[0] = side;
	    i__1[1] = 1, a__1[1] = trans;
	    s_cat(ch__1, a__1, i__1, &zunmhr_c__2, (ftnlen)2);
	    nb = ilaenv_(&zunmhr_c__1, "ZUNMQR", ch__1, m, &nh, &nh, &zunmhr_c_n1);
	}
	lwkopt = max(1,nw) * nb;
	work[1].r = (doublereal) lwkopt, work[1].i = 0.;
    }

    if (*info != 0) {
	i__2 = -(*info);
	vectcl_xerbla(interp, "ZUNMHR", &i__2);
return TCL_ERROR;

return TCL_OK;
    } else if (lquery) {
return TCL_OK;
    }


    if (*m == 0 || *n == 0 || nh == 0) {
	work[1].r = 1., work[1].i = 0.;
return TCL_OK;
    }

    if (left) {
	mi = nh;
	ni = *n;
	i1 = *ilo + 1;
	i2 = 1;
    } else {
	mi = *m;
	ni = nh;
	i1 = 1;
	i2 = *ilo + 1;
    }

    if (zunmqr_(interp, side, trans, &mi, &ni, &nh, &a[*ilo + 1 + *ilo * a_dim1], lda, &	    tau[*ilo], &c__[i1 + i2 * c_dim1], ldc, &work[1], lwork, &iinfo)!=TCL_OK) { return TCL_ERROR; }



    work[1].r = (doublereal) lwkopt, work[1].i = 0.;
return TCL_OK;


} /* zunmhr_ */
static /* Subroutine */ int zlaqr2_ (Tcl_Interp *interp, logical *wantt, logical *wantz, integer *n, 	integer *ktop, integer *kbot, integer *nw, doublecomplex *h__, 	integer *ldh, integer *iloz, integer *ihiz, doublecomplex *z__, 	integer *ldz, integer *ns, integer *nd, doublecomplex *sh, 	doublecomplex *v, integer *ldv, integer *nh, doublecomplex *t, 	integer *ldt, integer *nv, doublecomplex *wv, integer *ldwv, 	doublecomplex *work, integer *lwork)
{
    integer h_dim1, h_offset, t_dim1, t_offset, v_dim1, v_offset, wv_dim1, 
	    wv_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4;
    doublereal d__1, d__2, d__3, d__4, d__5, d__6;
    doublecomplex z__1, z__2;

    double d_imag(doublecomplex *);
    void d_cnjg(doublecomplex *, doublecomplex *);

    integer i__, j;
    doublecomplex s;
    integer jw;
    doublereal foo;
    integer kln;
    doublecomplex tau;
    integer knt;
    doublereal ulp;
    integer lwk1, lwk2;
    doublecomplex beta;
    integer kcol, info, ifst, ilst, ltop, krow;
    integer infqr;
    integer kwtop;
    doublereal safmin, safmax;
    doublereal smlnum;
    integer lwkopt;




































    h_dim1 = *ldh;
    h_offset = 1 + h_dim1;
    h__ -= h_offset;
    z_dim1 = *ldz;
    z_offset = 1 + z_dim1;
    z__ -= z_offset;
    --sh;
    v_dim1 = *ldv;
    v_offset = 1 + v_dim1;
    v -= v_offset;
    t_dim1 = *ldt;
    t_offset = 1 + t_dim1;
    t -= t_offset;
    wv_dim1 = *ldwv;
    wv_offset = 1 + wv_dim1;
    wv -= wv_offset;
    --work;

    i__1 = *nw, i__2 = *kbot - *ktop + 1;
    jw = min(i__1,i__2);
    if (jw <= 2) {
	lwkopt = 1;
    } else {


	i__1 = jw - 1;
	if (zgehrd_(interp, &jw, &zlaqr2_c__1, &i__1, &t[t_offset], ldt, &work[1], &work[1], &		zlaqr2_c_n1, &info)!=TCL_OK) { return TCL_ERROR; }


	lwk1 = (integer) work[1].r;


	i__1 = jw - 1;
	if (zunmhr_(interp, "R", "N", &jw, &jw, &zlaqr2_c__1, &i__1, &t[t_offset], ldt, &work[1], 		 &v[v_offset], ldv, &work[1], &zlaqr2_c_n1, &info)!=TCL_OK) { return TCL_ERROR; }


	lwk2 = (integer) work[1].r;


	lwkopt = jw + max(lwk1,lwk2);
    }


    if (*lwork == -1) {
	d__1 = (doublereal) lwkopt;
	z__1.r = d__1, z__1.i = 0.;
	work[1].r = z__1.r, work[1].i = z__1.i;
return TCL_OK;
    }

    *ns = 0;
    *nd = 0;
    work[1].r = 1., work[1].i = 0.;
    if (*ktop > *kbot) {
return TCL_OK;
    }
    if (*nw < 1) {
return TCL_OK;
    }


    safmin = dlamch_("SAFE MINIMUM");
    safmax = 1. / safmin;
    if (dlabad_(interp, &safmin, &safmax)!=TCL_OK) { return TCL_ERROR; }

    ulp = dlamch_("PRECISION");
    smlnum = safmin * ((doublereal) (*n) / ulp);


    i__1 = *nw, i__2 = *kbot - *ktop + 1;
    jw = min(i__1,i__2);
    kwtop = *kbot - jw + 1;
    if (kwtop == *ktop) {
	s.r = 0., s.i = 0.;
    } else {
	i__1 = kwtop + (kwtop - 1) * h_dim1;
	s.r = h__[i__1].r, s.i = h__[i__1].i;
    }

    if (*kbot == kwtop) {


	i__1 = kwtop;
	i__2 = kwtop + kwtop * h_dim1;
	sh[i__1].r = h__[i__2].r, sh[i__1].i = h__[i__2].i;
	*ns = 1;
	*nd = 0;
	i__1 = kwtop + kwtop * h_dim1;
	d__5 = smlnum, d__6 = ulp * ((d__1 = h__[i__1].r, abs(d__1)) + (d__2 =
		 d_imag(&h__[kwtop + kwtop * h_dim1]), abs(d__2)));
	if ((d__3 = s.r, abs(d__3)) + (d__4 = d_imag(&s), abs(d__4)) <= max(
		d__5,d__6)) {
	    *ns = 0;
	    *nd = 1;
	    if (kwtop > *ktop) {
		i__1 = kwtop + (kwtop - 1) * h_dim1;
		h__[i__1].r = 0., h__[i__1].i = 0.;
	    }
	}
	work[1].r = 1., work[1].i = 0.;
return TCL_OK;
    }


    if (zlacpy_(interp, "U", &jw, &jw, &h__[kwtop + kwtop * h_dim1], ldh, &t[t_offset], 	    ldt)!=TCL_OK) { return TCL_ERROR; }


    i__1 = jw - 1;
    i__2 = *ldh + 1;
    i__3 = *ldt + 1;
    if (zcopy_(interp, &i__1, &h__[kwtop + 1 + kwtop * h_dim1], &i__2, &t[t_dim1 + 2], &	    i__3)!=TCL_OK) { return TCL_ERROR; }



    if (zlaset_(interp, "A", &jw, &jw, &zlaqr2_c_b1, &zlaqr2_c_b2, &v[v_offset], ldv)!=TCL_OK) { return TCL_ERROR; }

    if (zlahqr_(interp, &zlaqr2_c_true, &zlaqr2_c_true, &jw, &zlaqr2_c__1, &jw, &t[t_offset], ldt, &sh[kwtop], 	    &zlaqr2_c__1, &jw, &v[v_offset], ldv, &infqr)!=TCL_OK) { return TCL_ERROR; }




    *ns = jw;
    ilst = infqr + 1;
    i__1 = jw;
    for (knt = infqr + 1; knt <= i__1; ++knt) {


	i__2 = *ns + *ns * t_dim1;
	foo = (d__1 = t[i__2].r, abs(d__1)) + (d__2 = d_imag(&t[*ns + *ns * 
		t_dim1]), abs(d__2));
	if (foo == 0.) {
	    foo = (d__1 = s.r, abs(d__1)) + (d__2 = d_imag(&s), abs(d__2));
	}
	i__2 = *ns * v_dim1 + 1;
	d__5 = smlnum, d__6 = ulp * foo;
	if (((d__1 = s.r, abs(d__1)) + (d__2 = d_imag(&s), abs(d__2))) * ((
		d__3 = v[i__2].r, abs(d__3)) + (d__4 = d_imag(&v[*ns * v_dim1 
		+ 1]), abs(d__4))) <= max(d__5,d__6)) {


	    --(*ns);
	} else {


	    ifst = *ns;
	    if (ztrexc_(interp, "V", &jw, &t[t_offset], ldt, &v[v_offset], ldv, &ifst, &		    ilst, &info)!=TCL_OK) { return TCL_ERROR; }


	    ++ilst;
	}
    }


    if (*ns == 0) {
	s.r = 0., s.i = 0.;
    }

    if (*ns < jw) {


	i__1 = *ns;
	for (i__ = infqr + 1; i__ <= i__1; ++i__) {
	    ifst = i__;
	    i__2 = *ns;
	    for (j = i__ + 1; j <= i__2; ++j) {
		i__3 = j + j * t_dim1;
		i__4 = ifst + ifst * t_dim1;
		if ((d__1 = t[i__3].r, abs(d__1)) + (d__2 = d_imag(&t[j + j * 
			t_dim1]), abs(d__2)) > (d__3 = t[i__4].r, abs(d__3)) 
			+ (d__4 = d_imag(&t[ifst + ifst * t_dim1]), abs(d__4))
			) {
		    ifst = j;
		}
	    }
	    ilst = i__;
	    if (ifst != ilst) {
		if (ztrexc_(interp, "V", &jw, &t[t_offset], ldt, &v[v_offset], ldv, &ifst, 			 &ilst, &info)!=TCL_OK) { return TCL_ERROR; }


	    }
	}
    }


    i__1 = jw;
    for (i__ = infqr + 1; i__ <= i__1; ++i__) {
	i__2 = kwtop + i__ - 1;
	i__3 = i__ + i__ * t_dim1;
	sh[i__2].r = t[i__3].r, sh[i__2].i = t[i__3].i;
    }


    if (*ns < jw || s.r == 0. && s.i == 0.) {
	if (*ns > 1 && (s.r != 0. || s.i != 0.)) {


	    if (zcopy_(interp, ns, &v[v_offset], ldv, &work[1], &zlaqr2_c__1)!=TCL_OK) { return TCL_ERROR; }

	    i__1 = *ns;
	    for (i__ = 1; i__ <= i__1; ++i__) {
		i__2 = i__;
		d_cnjg(&z__1, &work[i__]);
		work[i__2].r = z__1.r, work[i__2].i = z__1.i;
	    }
	    beta.r = work[1].r, beta.i = work[1].i;
	    if (zlarfg_(interp, ns, &beta, &work[2], &zlaqr2_c__1, &tau)!=TCL_OK) { return TCL_ERROR; }

	    work[1].r = 1., work[1].i = 0.;

	    i__1 = jw - 2;
	    i__2 = jw - 2;
	    if (zlaset_(interp, "L", &i__1, &i__2, &zlaqr2_c_b1, &zlaqr2_c_b1, &t[t_dim1 + 3], ldt)!=TCL_OK) { return TCL_ERROR; }


	    d_cnjg(&z__1, &tau);
	    if (zlarf_(interp, "L", ns, &jw, &work[1], &zlaqr2_c__1, &z__1, &t[t_offset], ldt, &		    work[jw + 1])!=TCL_OK) { return TCL_ERROR; }


	    if (zlarf_(interp, "R", ns, ns, &work[1], &zlaqr2_c__1, &tau, &t[t_offset], ldt, &		    work[jw + 1])!=TCL_OK) { return TCL_ERROR; }


	    if (zlarf_(interp, "R", &jw, ns, &work[1], &zlaqr2_c__1, &tau, &v[v_offset], ldv, &		    work[jw + 1])!=TCL_OK) { return TCL_ERROR; }



	    i__1 = *lwork - jw;
	    if (zgehrd_(interp, &jw, &zlaqr2_c__1, ns, &t[t_offset], ldt, &work[1], &work[jw + 1], &i__1, &info)!=TCL_OK) { return TCL_ERROR; }


	}


	if (kwtop > 1) {
	    i__1 = kwtop + (kwtop - 1) * h_dim1;
	    d_cnjg(&z__2, &v[v_dim1 + 1]);
	    z__1.r = s.r * z__2.r - s.i * z__2.i, z__1.i = s.r * z__2.i + s.i 
		    * z__2.r;
	    h__[i__1].r = z__1.r, h__[i__1].i = z__1.i;
	}
	if (zlacpy_(interp, "U", &jw, &jw, &t[t_offset], ldt, &h__[kwtop + kwtop * h_dim1], ldh)!=TCL_OK) { return TCL_ERROR; }


	i__1 = jw - 1;
	i__2 = *ldt + 1;
	i__3 = *ldh + 1;
	if (zcopy_(interp, &i__1, &t[t_dim1 + 2], &i__2, &h__[kwtop + 1 + kwtop * h_dim1], 		 &i__3)!=TCL_OK) { return TCL_ERROR; }




	if (*ns > 1 && (s.r != 0. || s.i != 0.)) {
	    i__1 = *lwork - jw;
	    if (zunmhr_(interp, "R", "N", &jw, ns, &zlaqr2_c__1, ns, &t[t_offset], ldt, &work[1], 		     &v[v_offset], ldv, &work[jw + 1], &i__1, &info)!=TCL_OK) { return TCL_ERROR; }


	}


	if (*wantt) {
	    ltop = 1;
	} else {
	    ltop = *ktop;
	}
	i__1 = kwtop - 1;
	i__2 = *nv;
	for (krow = ltop; i__2 < 0 ? krow >= i__1 : krow <= i__1; krow += 
		i__2) {
	    i__3 = *nv, i__4 = kwtop - krow;
	    kln = min(i__3,i__4);
	    if (zgemm_(interp, "N", "N", &kln, &jw, &jw, &zlaqr2_c_b2, &h__[krow + kwtop * 		    h_dim1], ldh, &v[v_offset], ldv, &zlaqr2_c_b1, &wv[wv_offset], 
		    ldwv)!=TCL_OK) { return TCL_ERROR; }


	    if (zlacpy_(interp, "A", &kln, &jw, &wv[wv_offset], ldwv, &h__[krow + kwtop * 		    h_dim1], ldh)!=TCL_OK) { return TCL_ERROR; }


	}


	if (*wantt) {
	    i__2 = *n;
	    i__1 = *nh;
	    for (kcol = *kbot + 1; i__1 < 0 ? kcol >= i__2 : kcol <= i__2; 
		    kcol += i__1) {
		i__3 = *nh, i__4 = *n - kcol + 1;
		kln = min(i__3,i__4);
		if (zgemm_(interp, "C", "N", &jw, &kln, &jw, &zlaqr2_c_b2, &v[v_offset], ldv, &			h__[kwtop + kcol * h_dim1], ldh, &zlaqr2_c_b1, &t[t_offset], 
			ldt)!=TCL_OK) { return TCL_ERROR; }


		if (zlacpy_(interp, "A", &jw, &kln, &t[t_offset], ldt, &h__[kwtop + kcol *			 h_dim1], ldh)!=TCL_OK) { return TCL_ERROR; }


	    }
	}


	if (*wantz) {
	    i__1 = *ihiz;
	    i__2 = *nv;
	    for (krow = *iloz; i__2 < 0 ? krow >= i__1 : krow <= i__1; krow +=
		     i__2) {
		i__3 = *nv, i__4 = *ihiz - krow + 1;
		kln = min(i__3,i__4);
		if (zgemm_(interp, "N", "N", &kln, &jw, &jw, &zlaqr2_c_b2, &z__[krow + kwtop * 			z_dim1], ldz, &v[v_offset], ldv, &zlaqr2_c_b1, &wv[wv_offset]
, ldwv)!=TCL_OK) { return TCL_ERROR; }


		if (zlacpy_(interp, "A", &kln, &jw, &wv[wv_offset], ldwv, &z__[krow + 			kwtop * z_dim1], ldz)!=TCL_OK) { return TCL_ERROR; }


	    }
	}
    }


    *nd = jw - *ns;


    *ns -= infqr;


    d__1 = (doublereal) lwkopt;
    z__1.r = d__1, z__1.i = 0.;
    work[1].r = z__1.r, work[1].i = z__1.i;


return TCL_OK;
} /* zlaqr2_ */
static /* Subroutine */ int zlaqr1_ (Tcl_Interp *interp, integer *n, doublecomplex *h__, integer *ldh, 	doublecomplex *s1, doublecomplex *s2, doublecomplex *v)
{
    integer h_dim1, h_offset, i__1, i__2, i__3, i__4;
    doublereal d__1, d__2, d__3, d__4, d__5, d__6;
    doublecomplex z__1, z__2, z__3, z__4, z__5, z__6, z__7, z__8;

    double d_imag(doublecomplex *);

    doublereal s;
    doublecomplex h21s, h31s;
















    h_dim1 = *ldh;
    h_offset = 1 + h_dim1;
    h__ -= h_offset;
    --v;

    if (*n == 2) {
	i__1 = h_dim1 + 1;
	z__2.r = h__[i__1].r - s2->r, z__2.i = h__[i__1].i - s2->i;
	z__1.r = z__2.r, z__1.i = z__2.i;
	i__2 = h_dim1 + 2;
	s = (d__1 = z__1.r, abs(d__1)) + (d__2 = d_imag(&z__1), abs(d__2)) + (
		(d__3 = h__[i__2].r, abs(d__3)) + (d__4 = d_imag(&h__[h_dim1 
		+ 2]), abs(d__4)));
	if (s == 0.) {
	    v[1].r = 0., v[1].i = 0.;
	    v[2].r = 0., v[2].i = 0.;
	} else {
	    i__1 = h_dim1 + 2;
	    z__1.r = h__[i__1].r / s, z__1.i = h__[i__1].i / s;
	    h21s.r = z__1.r, h21s.i = z__1.i;
	    i__1 = (h_dim1 << 1) + 1;
	    z__2.r = h21s.r * h__[i__1].r - h21s.i * h__[i__1].i, z__2.i = 
		    h21s.r * h__[i__1].i + h21s.i * h__[i__1].r;
	    i__2 = h_dim1 + 1;
	    z__4.r = h__[i__2].r - s1->r, z__4.i = h__[i__2].i - s1->i;
	    i__3 = h_dim1 + 1;
	    z__6.r = h__[i__3].r - s2->r, z__6.i = h__[i__3].i - s2->i;
	    z__5.r = z__6.r / s, z__5.i = z__6.i / s;
	    z__3.r = z__4.r * z__5.r - z__4.i * z__5.i, z__3.i = z__4.r * 
		    z__5.i + z__4.i * z__5.r;
	    z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
	    v[1].r = z__1.r, v[1].i = z__1.i;
	    i__1 = h_dim1 + 1;
	    i__2 = (h_dim1 << 1) + 2;
	    z__4.r = h__[i__1].r + h__[i__2].r, z__4.i = h__[i__1].i + h__[
		    i__2].i;
	    z__3.r = z__4.r - s1->r, z__3.i = z__4.i - s1->i;
	    z__2.r = z__3.r - s2->r, z__2.i = z__3.i - s2->i;
	    z__1.r = h21s.r * z__2.r - h21s.i * z__2.i, z__1.i = h21s.r * 
		    z__2.i + h21s.i * z__2.r;
	    v[2].r = z__1.r, v[2].i = z__1.i;
	}
    } else {
	i__1 = h_dim1 + 1;
	z__2.r = h__[i__1].r - s2->r, z__2.i = h__[i__1].i - s2->i;
	z__1.r = z__2.r, z__1.i = z__2.i;
	i__2 = h_dim1 + 2;
	i__3 = h_dim1 + 3;
	s = (d__1 = z__1.r, abs(d__1)) + (d__2 = d_imag(&z__1), abs(d__2)) + (
		(d__3 = h__[i__2].r, abs(d__3)) + (d__4 = d_imag(&h__[h_dim1 
		+ 2]), abs(d__4))) + ((d__5 = h__[i__3].r, abs(d__5)) + (d__6 
		= d_imag(&h__[h_dim1 + 3]), abs(d__6)));
	if (s == 0.) {
	    v[1].r = 0., v[1].i = 0.;
	    v[2].r = 0., v[2].i = 0.;
	    v[3].r = 0., v[3].i = 0.;
	} else {
	    i__1 = h_dim1 + 2;
	    z__1.r = h__[i__1].r / s, z__1.i = h__[i__1].i / s;
	    h21s.r = z__1.r, h21s.i = z__1.i;
	    i__1 = h_dim1 + 3;
	    z__1.r = h__[i__1].r / s, z__1.i = h__[i__1].i / s;
	    h31s.r = z__1.r, h31s.i = z__1.i;
	    i__1 = h_dim1 + 1;
	    z__4.r = h__[i__1].r - s1->r, z__4.i = h__[i__1].i - s1->i;
	    i__2 = h_dim1 + 1;
	    z__6.r = h__[i__2].r - s2->r, z__6.i = h__[i__2].i - s2->i;
	    z__5.r = z__6.r / s, z__5.i = z__6.i / s;
	    z__3.r = z__4.r * z__5.r - z__4.i * z__5.i, z__3.i = z__4.r * 
		    z__5.i + z__4.i * z__5.r;
	    i__3 = (h_dim1 << 1) + 1;
	    z__7.r = h__[i__3].r * h21s.r - h__[i__3].i * h21s.i, z__7.i = 
		    h__[i__3].r * h21s.i + h__[i__3].i * h21s.r;
	    z__2.r = z__3.r + z__7.r, z__2.i = z__3.i + z__7.i;
	    i__4 = h_dim1 * 3 + 1;
	    z__8.r = h__[i__4].r * h31s.r - h__[i__4].i * h31s.i, z__8.i = 
		    h__[i__4].r * h31s.i + h__[i__4].i * h31s.r;
	    z__1.r = z__2.r + z__8.r, z__1.i = z__2.i + z__8.i;
	    v[1].r = z__1.r, v[1].i = z__1.i;
	    i__1 = h_dim1 + 1;
	    i__2 = (h_dim1 << 1) + 2;
	    z__5.r = h__[i__1].r + h__[i__2].r, z__5.i = h__[i__1].i + h__[
		    i__2].i;
	    z__4.r = z__5.r - s1->r, z__4.i = z__5.i - s1->i;
	    z__3.r = z__4.r - s2->r, z__3.i = z__4.i - s2->i;
	    z__2.r = h21s.r * z__3.r - h21s.i * z__3.i, z__2.i = h21s.r * 
		    z__3.i + h21s.i * z__3.r;
	    i__3 = h_dim1 * 3 + 2;
	    z__6.r = h__[i__3].r * h31s.r - h__[i__3].i * h31s.i, z__6.i = 
		    h__[i__3].r * h31s.i + h__[i__3].i * h31s.r;
	    z__1.r = z__2.r + z__6.r, z__1.i = z__2.i + z__6.i;
	    v[2].r = z__1.r, v[2].i = z__1.i;
	    i__1 = h_dim1 + 1;
	    i__2 = h_dim1 * 3 + 3;
	    z__5.r = h__[i__1].r + h__[i__2].r, z__5.i = h__[i__1].i + h__[
		    i__2].i;
	    z__4.r = z__5.r - s1->r, z__4.i = z__5.i - s1->i;
	    z__3.r = z__4.r - s2->r, z__3.i = z__4.i - s2->i;
	    z__2.r = h31s.r * z__3.r - h31s.i * z__3.i, z__2.i = h31s.r * 
		    z__3.i + h31s.i * z__3.r;
	    i__3 = (h_dim1 << 1) + 3;
	    z__6.r = h21s.r * h__[i__3].r - h21s.i * h__[i__3].i, z__6.i = 
		    h21s.r * h__[i__3].i + h21s.i * h__[i__3].r;
	    z__1.r = z__2.r + z__6.r, z__1.i = z__2.i + z__6.i;
	    v[3].r = z__1.r, v[3].i = z__1.i;
	}
    }
return TCL_OK;
} /* zlaqr1_ */
static /* Subroutine */ int dlarfx_ (Tcl_Interp *interp, char *side, integer *m, integer *n, doublereal *	v, doublereal *tau, doublereal *c__, integer *ldc, doublereal *work)
{
    integer c_dim1, c_offset, i__1;

    integer j;
    doublereal 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;
    c__ -= c_offset;
    --work;

    if (*tau == 0.) {
return TCL_OK;
    }
    if (lsame_(side, "L")) {


	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;
	}


	if (dlarf_(interp, side, m, n, &v[1], &dlarfx_c__1, tau, &c__[c_offset], ldc, &work[1])!=TCL_OK) { return TCL_ERROR; }

	goto L410;
L10:


	t1 = 1. - *tau * v[1] * v[1];
	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    c__[j * c_dim1 + 1] = t1 * c__[j * c_dim1 + 1];
	}
	goto L410;
L30:


	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__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2];
	    c__[j * c_dim1 + 1] -= sum * t1;
	    c__[j * c_dim1 + 2] -= sum * t2;
	}
	goto L410;
L50:


	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__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2] + v3 * 
		    c__[j * c_dim1 + 3];
	    c__[j * c_dim1 + 1] -= sum * t1;
	    c__[j * c_dim1 + 2] -= sum * t2;
	    c__[j * c_dim1 + 3] -= sum * t3;
	}
	goto L410;
L70:


	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__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2] + v3 * 
		    c__[j * c_dim1 + 3] + v4 * c__[j * c_dim1 + 4];
	    c__[j * c_dim1 + 1] -= sum * t1;
	    c__[j * c_dim1 + 2] -= sum * t2;
	    c__[j * c_dim1 + 3] -= sum * t3;
	    c__[j * c_dim1 + 4] -= sum * t4;
	}
	goto L410;
L90:


	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__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2] + v3 * 
		    c__[j * c_dim1 + 3] + v4 * c__[j * c_dim1 + 4] + v5 * c__[
		    j * c_dim1 + 5];
	    c__[j * c_dim1 + 1] -= sum * t1;
	    c__[j * c_dim1 + 2] -= sum * t2;
	    c__[j * c_dim1 + 3] -= sum * t3;
	    c__[j * c_dim1 + 4] -= sum * t4;
	    c__[j * c_dim1 + 5] -= sum * t5;
	}
	goto L410;
L110:


	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__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2] + v3 * 
		    c__[j * c_dim1 + 3] + v4 * c__[j * c_dim1 + 4] + v5 * c__[
		    j * c_dim1 + 5] + v6 * c__[j * c_dim1 + 6];
	    c__[j * c_dim1 + 1] -= sum * t1;
	    c__[j * c_dim1 + 2] -= sum * t2;
	    c__[j * c_dim1 + 3] -= sum * t3;
	    c__[j * c_dim1 + 4] -= sum * t4;
	    c__[j * c_dim1 + 5] -= sum * t5;
	    c__[j * c_dim1 + 6] -= sum * t6;
	}
	goto L410;
L130:


	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__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2] + v3 * 
		    c__[j * c_dim1 + 3] + v4 * c__[j * c_dim1 + 4] + v5 * c__[
		    j * c_dim1 + 5] + v6 * c__[j * c_dim1 + 6] + v7 * c__[j * 
		    c_dim1 + 7];
	    c__[j * c_dim1 + 1] -= sum * t1;
	    c__[j * c_dim1 + 2] -= sum * t2;
	    c__[j * c_dim1 + 3] -= sum * t3;
	    c__[j * c_dim1 + 4] -= sum * t4;
	    c__[j * c_dim1 + 5] -= sum * t5;
	    c__[j * c_dim1 + 6] -= sum * t6;
	    c__[j * c_dim1 + 7] -= sum * t7;
	}
	goto L410;
L150:


	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__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2] + v3 * 
		    c__[j * c_dim1 + 3] + v4 * c__[j * c_dim1 + 4] + v5 * c__[
		    j * c_dim1 + 5] + v6 * c__[j * c_dim1 + 6] + v7 * c__[j * 
		    c_dim1 + 7] + v8 * c__[j * c_dim1 + 8];
	    c__[j * c_dim1 + 1] -= sum * t1;
	    c__[j * c_dim1 + 2] -= sum * t2;
	    c__[j * c_dim1 + 3] -= sum * t3;
	    c__[j * c_dim1 + 4] -= sum * t4;
	    c__[j * c_dim1 + 5] -= sum * t5;
	    c__[j * c_dim1 + 6] -= sum * t6;
	    c__[j * c_dim1 + 7] -= sum * t7;
	    c__[j * c_dim1 + 8] -= sum * t8;
	}
	goto L410;
L170:


	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__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2] + v3 * 
		    c__[j * c_dim1 + 3] + v4 * c__[j * c_dim1 + 4] + v5 * c__[
		    j * c_dim1 + 5] + v6 * c__[j * c_dim1 + 6] + v7 * c__[j * 
		    c_dim1 + 7] + v8 * c__[j * c_dim1 + 8] + v9 * c__[j * 
		    c_dim1 + 9];
	    c__[j * c_dim1 + 1] -= sum * t1;
	    c__[j * c_dim1 + 2] -= sum * t2;
	    c__[j * c_dim1 + 3] -= sum * t3;
	    c__[j * c_dim1 + 4] -= sum * t4;
	    c__[j * c_dim1 + 5] -= sum * t5;
	    c__[j * c_dim1 + 6] -= sum * t6;
	    c__[j * c_dim1 + 7] -= sum * t7;
	    c__[j * c_dim1 + 8] -= sum * t8;
	    c__[j * c_dim1 + 9] -= sum * t9;
	}
	goto L410;
L190:


	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__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2] + v3 * 
		    c__[j * c_dim1 + 3] + v4 * c__[j * c_dim1 + 4] + v5 * c__[
		    j * c_dim1 + 5] + v6 * c__[j * c_dim1 + 6] + v7 * c__[j * 
		    c_dim1 + 7] + v8 * c__[j * c_dim1 + 8] + v9 * c__[j * 
		    c_dim1 + 9] + v10 * c__[j * c_dim1 + 10];
	    c__[j * c_dim1 + 1] -= sum * t1;
	    c__[j * c_dim1 + 2] -= sum * t2;
	    c__[j * c_dim1 + 3] -= sum * t3;
	    c__[j * c_dim1 + 4] -= sum * t4;
	    c__[j * c_dim1 + 5] -= sum * t5;
	    c__[j * c_dim1 + 6] -= sum * t6;
	    c__[j * c_dim1 + 7] -= sum * t7;
	    c__[j * c_dim1 + 8] -= sum * t8;
	    c__[j * c_dim1 + 9] -= sum * t9;
	    c__[j * c_dim1 + 10] -= sum * t10;
	}
	goto L410;
    } else {


	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;
	}


	if (dlarf_(interp, side, m, n, &v[1], &dlarfx_c__1, tau, &c__[c_offset], ldc, &work[1])!=TCL_OK) { return TCL_ERROR; }

	goto L410;
L210:


	t1 = 1. - *tau * v[1] * v[1];
	i__1 = *m;
	for (j = 1; j <= i__1; ++j) {
	    c__[j + c_dim1] = t1 * c__[j + c_dim1];
	}
	goto L410;
L230:


	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__[j + c_dim1] + v2 * c__[j + (c_dim1 << 1)];
	    c__[j + c_dim1] -= sum * t1;
	    c__[j + (c_dim1 << 1)] -= sum * t2;
	}
	goto L410;
L250:


	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__[j + c_dim1] + v2 * c__[j + (c_dim1 << 1)] + v3 * 
		    c__[j + c_dim1 * 3];
	    c__[j + c_dim1] -= sum * t1;
	    c__[j + (c_dim1 << 1)] -= sum * t2;
	    c__[j + c_dim1 * 3] -= sum * t3;
	}
	goto L410;
L270:


	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__[j + c_dim1] + v2 * c__[j + (c_dim1 << 1)] + v3 * 
		    c__[j + c_dim1 * 3] + v4 * c__[j + (c_dim1 << 2)];
	    c__[j + c_dim1] -= sum * t1;
	    c__[j + (c_dim1 << 1)] -= sum * t2;
	    c__[j + c_dim1 * 3] -= sum * t3;
	    c__[j + (c_dim1 << 2)] -= sum * t4;
	}
	goto L410;
L290:


	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__[j + c_dim1] + v2 * c__[j + (c_dim1 << 1)] + v3 * 
		    c__[j + c_dim1 * 3] + v4 * c__[j + (c_dim1 << 2)] + v5 * 
		    c__[j + c_dim1 * 5];
	    c__[j + c_dim1] -= sum * t1;
	    c__[j + (c_dim1 << 1)] -= sum * t2;
	    c__[j + c_dim1 * 3] -= sum * t3;
	    c__[j + (c_dim1 << 2)] -= sum * t4;
	    c__[j + c_dim1 * 5] -= sum * t5;
	}
	goto L410;
L310:


	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__[j + c_dim1] + v2 * c__[j + (c_dim1 << 1)] + v3 * 
		    c__[j + c_dim1 * 3] + v4 * c__[j + (c_dim1 << 2)] + v5 * 
		    c__[j + c_dim1 * 5] + v6 * c__[j + c_dim1 * 6];
	    c__[j + c_dim1] -= sum * t1;
	    c__[j + (c_dim1 << 1)] -= sum * t2;
	    c__[j + c_dim1 * 3] -= sum * t3;
	    c__[j + (c_dim1 << 2)] -= sum * t4;
	    c__[j + c_dim1 * 5] -= sum * t5;
	    c__[j + c_dim1 * 6] -= sum * t6;
	}
	goto L410;
L330:


	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__[j + c_dim1] + v2 * c__[j + (c_dim1 << 1)] + v3 * 
		    c__[j + c_dim1 * 3] + v4 * c__[j + (c_dim1 << 2)] + v5 * 
		    c__[j + c_dim1 * 5] + v6 * c__[j + c_dim1 * 6] + v7 * c__[
		    j + c_dim1 * 7];
	    c__[j + c_dim1] -= sum * t1;
	    c__[j + (c_dim1 << 1)] -= sum * t2;
	    c__[j + c_dim1 * 3] -= sum * t3;
	    c__[j + (c_dim1 << 2)] -= sum * t4;
	    c__[j + c_dim1 * 5] -= sum * t5;
	    c__[j + c_dim1 * 6] -= sum * t6;
	    c__[j + c_dim1 * 7] -= sum * t7;
	}
	goto L410;
L350:


	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__[j + c_dim1] + v2 * c__[j + (c_dim1 << 1)] + v3 * 
		    c__[j + c_dim1 * 3] + v4 * c__[j + (c_dim1 << 2)] + v5 * 
		    c__[j + c_dim1 * 5] + v6 * c__[j + c_dim1 * 6] + v7 * c__[
		    j + c_dim1 * 7] + v8 * c__[j + (c_dim1 << 3)];
	    c__[j + c_dim1] -= sum * t1;
	    c__[j + (c_dim1 << 1)] -= sum * t2;
	    c__[j + c_dim1 * 3] -= sum * t3;
	    c__[j + (c_dim1 << 2)] -= sum * t4;
	    c__[j + c_dim1 * 5] -= sum * t5;
	    c__[j + c_dim1 * 6] -= sum * t6;
	    c__[j + c_dim1 * 7] -= sum * t7;
	    c__[j + (c_dim1 << 3)] -= sum * t8;
	}
	goto L410;
L370:


	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__[j + c_dim1] + v2 * c__[j + (c_dim1 << 1)] + v3 * 
		    c__[j + c_dim1 * 3] + v4 * c__[j + (c_dim1 << 2)] + v5 * 
		    c__[j + c_dim1 * 5] + v6 * c__[j + c_dim1 * 6] + v7 * c__[
		    j + c_dim1 * 7] + v8 * c__[j + (c_dim1 << 3)] + v9 * c__[
		    j + c_dim1 * 9];
	    c__[j + c_dim1] -= sum * t1;
	    c__[j + (c_dim1 << 1)] -= sum * t2;
	    c__[j + c_dim1 * 3] -= sum * t3;
	    c__[j + (c_dim1 << 2)] -= sum * t4;
	    c__[j + c_dim1 * 5] -= sum * t5;
	    c__[j + c_dim1 * 6] -= sum * t6;
	    c__[j + c_dim1 * 7] -= sum * t7;
	    c__[j + (c_dim1 << 3)] -= sum * t8;
	    c__[j + c_dim1 * 9] -= sum * t9;
	}
	goto L410;
L390:


	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__[j + c_dim1] + v2 * c__[j + (c_dim1 << 1)] + v3 * 
		    c__[j + c_dim1 * 3] + v4 * c__[j + (c_dim1 << 2)] + v5 * 
		    c__[j + c_dim1 * 5] + v6 * c__[j + c_dim1 * 6] + v7 * c__[
		    j + c_dim1 * 7] + v8 * c__[j + (c_dim1 << 3)] + v9 * c__[
		    j + c_dim1 * 9] + v10 * c__[j + c_dim1 * 10];
	    c__[j + c_dim1] -= sum * t1;
	    c__[j + (c_dim1 << 1)] -= sum * t2;
	    c__[j + c_dim1 * 3] -= sum * t3;
	    c__[j + (c_dim1 << 2)] -= sum * t4;
	    c__[j + c_dim1 * 5] -= sum * t5;
	    c__[j + c_dim1 * 6] -= sum * t6;
	    c__[j + c_dim1 * 7] -= sum * t7;
	    c__[j + (c_dim1 << 3)] -= sum * t8;
	    c__[j + c_dim1 * 9] -= sum * t9;
	    c__[j + c_dim1 * 10] -= sum * t10;
	}
	goto L410;
    }
L410:
return TCL_OK;


} /* dlarfx_ */
static /* Subroutine */ int dlasd4_ (Tcl_Interp *interp, integer *n, integer *i__, doublereal *d__, 	doublereal *z__, doublereal *delta, doublereal *rho, doublereal *	sigma, doublereal *work, integer *info)
{
    integer i__1;
    doublereal d__1;

    double sqrt(doublereal);

    doublereal a, b, c__;
    integer j;
    doublereal w, dd[3];
    integer ii;
    doublereal dw, zz[3];
    integer ip1;
    doublereal eta, phi, eps, tau, psi;
    integer iim1, iip1;
    doublereal dphi, dpsi;
    integer iter;
    doublereal temp, prew, sg2lb, sg2ub, temp1, temp2, dtiim, delsq, dtiip;
    integer niter;
    doublereal dtisq;
    logical swtch;
    doublereal dtnsq;
    doublereal delsq2, dtnsq1;
    logical swtch3;
    logical orgati;
    doublereal erretm, dtipsq, rhoinv;
































    --work;
    --delta;
    --z__;
    --d__;

    *info = 0;
    if (*n == 1) {


	*sigma = sqrt(d__[1] * d__[1] + *rho * z__[1] * z__[1]);
	delta[1] = 1.;
	work[1] = 1.;
return TCL_OK;
    }
    if (*n == 2) {
	if (dlasd5_(interp, i__, &d__[1], &z__[1], &delta[1], rho, sigma, &work[1])!=TCL_OK) { return TCL_ERROR; }

return TCL_OK;
    }


    eps = dlamch_("Epsilon");
    rhoinv = 1. / *rho;


    if (*i__ == *n) {


	ii = *n - 1;
	niter = 1;


	temp = *rho / 2.;


	temp1 = temp / (d__[*n] + sqrt(d__[*n] * d__[*n] + temp));
	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    work[j] = d__[j] + d__[*n] + temp1;
	    delta[j] = d__[j] - d__[*n] - temp1;
	}

	psi = 0.;
	i__1 = *n - 2;
	for (j = 1; j <= i__1; ++j) {
	    psi += z__[j] * z__[j] / (delta[j] * work[j]);
	}

	c__ = rhoinv + psi;
	w = c__ + z__[ii] * z__[ii] / (delta[ii] * work[ii]) + z__[*n] * z__[*
		n] / (delta[*n] * work[*n]);

	if (w <= 0.) {
	    temp1 = sqrt(d__[*n] * d__[*n] + *rho);
	    temp = z__[*n - 1] * z__[*n - 1] / ((d__[*n - 1] + temp1) * (d__[*
		    n] - d__[*n - 1] + *rho / (d__[*n] + temp1))) + z__[*n] * 
		    z__[*n] / *rho;


	    if (c__ <= temp) {
		tau = *rho;
	    } else {
		delsq = (d__[*n] - d__[*n - 1]) * (d__[*n] + d__[*n - 1]);
		a = -c__ * delsq + z__[*n - 1] * z__[*n - 1] + z__[*n] * z__[*
			n];
		b = z__[*n] * z__[*n] * delsq;
		if (a < 0.) {
		    tau = b * 2. / (sqrt(a * a + b * 4. * c__) - a);
		} else {
		    tau = (a + sqrt(a * a + b * 4. * c__)) / (c__ * 2.);
		}
	    }


	} else {
	    delsq = (d__[*n] - d__[*n - 1]) * (d__[*n] + d__[*n - 1]);
	    a = -c__ * delsq + z__[*n - 1] * z__[*n - 1] + z__[*n] * z__[*n];
	    b = z__[*n] * z__[*n] * delsq;


	    if (a < 0.) {
		tau = b * 2. / (sqrt(a * a + b * 4. * c__) - a);
	    } else {
		tau = (a + sqrt(a * a + b * 4. * c__)) / (c__ * 2.);
	    }


	}


	eta = tau / (d__[*n] + sqrt(d__[*n] * d__[*n] + tau));

	*sigma = d__[*n] + eta;
	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    delta[j] = d__[j] - d__[*i__] - eta;
	    work[j] = d__[j] + d__[*i__] + eta;
	}


	dpsi = 0.;
	psi = 0.;
	erretm = 0.;
	i__1 = ii;
	for (j = 1; j <= i__1; ++j) {
	    temp = z__[j] / (delta[j] * work[j]);
	    psi += z__[j] * temp;
	    dpsi += temp * temp;
	    erretm += psi;
	}
	erretm = abs(erretm);


	temp = z__[*n] / (delta[*n] * work[*n]);
	phi = z__[*n] * temp;
	dphi = temp * temp;
	erretm = (-phi - psi) * 8. + erretm - phi + rhoinv + abs(tau) * (dpsi 
		+ dphi);

	w = rhoinv + phi + psi;


	if (abs(w) <= eps * erretm) {
	    goto L240;
	}


	++niter;
	dtnsq1 = work[*n - 1] * delta[*n - 1];
	dtnsq = work[*n] * delta[*n];
	c__ = w - dtnsq1 * dpsi - dtnsq * dphi;
	a = (dtnsq + dtnsq1) * w - dtnsq * dtnsq1 * (dpsi + dphi);
	b = dtnsq * dtnsq1 * w;
	if (c__ < 0.) {
	    c__ = abs(c__);
	}
	if (c__ == 0.) {
	    eta = *rho - *sigma * *sigma;
	} else if (a >= 0.) {
	    eta = (a + sqrt((d__1 = a * a - b * 4. * c__, abs(d__1)))) / (c__ 
		    * 2.);
	} else {
	    eta = b * 2. / (a - sqrt((d__1 = a * a - b * 4. * c__, abs(d__1)))
		    );
	}


	if (w * eta > 0.) {
	    eta = -w / (dpsi + dphi);
	}
	temp = eta - dtnsq;
	if (temp > *rho) {
	    eta = *rho + dtnsq;
	}

	tau += eta;
	eta /= *sigma + sqrt(eta + *sigma * *sigma);
	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    delta[j] -= eta;
	    work[j] += eta;
	}

	*sigma += eta;


	dpsi = 0.;
	psi = 0.;
	erretm = 0.;
	i__1 = ii;
	for (j = 1; j <= i__1; ++j) {
	    temp = z__[j] / (work[j] * delta[j]);
	    psi += z__[j] * temp;
	    dpsi += temp * temp;
	    erretm += psi;
	}
	erretm = abs(erretm);


	temp = z__[*n] / (work[*n] * delta[*n]);
	phi = z__[*n] * temp;
	dphi = temp * temp;
	erretm = (-phi - psi) * 8. + erretm - phi + rhoinv + abs(tau) * (dpsi 
		+ dphi);

	w = rhoinv + phi + psi;


	iter = niter + 1;

	for (niter = iter; niter <= 20; ++niter) {


	    if (abs(w) <= eps * erretm) {
		goto L240;
	    }


	    dtnsq1 = work[*n - 1] * delta[*n - 1];
	    dtnsq = work[*n] * delta[*n];
	    c__ = w - dtnsq1 * dpsi - dtnsq * dphi;
	    a = (dtnsq + dtnsq1) * w - dtnsq1 * dtnsq * (dpsi + dphi);
	    b = dtnsq1 * dtnsq * w;
	    if (a >= 0.) {
		eta = (a + sqrt((d__1 = a * a - b * 4. * c__, abs(d__1)))) / (
			c__ * 2.);
	    } else {
		eta = b * 2. / (a - sqrt((d__1 = a * a - b * 4. * c__, abs(
			d__1))));
	    }


	    if (w * eta > 0.) {
		eta = -w / (dpsi + dphi);
	    }
	    temp = eta - dtnsq;
	    if (temp <= 0.) {
		eta /= 2.;
	    }

	    tau += eta;
	    eta /= *sigma + sqrt(eta + *sigma * *sigma);
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		delta[j] -= eta;
		work[j] += eta;
	    }

	    *sigma += eta;


	    dpsi = 0.;
	    psi = 0.;
	    erretm = 0.;
	    i__1 = ii;
	    for (j = 1; j <= i__1; ++j) {
		temp = z__[j] / (work[j] * delta[j]);
		psi += z__[j] * temp;
		dpsi += temp * temp;
		erretm += psi;
	    }
	    erretm = abs(erretm);


	    temp = z__[*n] / (work[*n] * delta[*n]);
	    phi = z__[*n] * temp;
	    dphi = temp * temp;
	    erretm = (-phi - psi) * 8. + erretm - phi + rhoinv + abs(tau) * (
		    dpsi + dphi);

	    w = rhoinv + phi + psi;
	}


	*info = 1;
	goto L240;


    } else {


	niter = 1;
	ip1 = *i__ + 1;


	delsq = (d__[ip1] - d__[*i__]) * (d__[ip1] + d__[*i__]);
	delsq2 = delsq / 2.;
	temp = delsq2 / (d__[*i__] + sqrt(d__[*i__] * d__[*i__] + delsq2));
	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    work[j] = d__[j] + d__[*i__] + temp;
	    delta[j] = d__[j] - d__[*i__] - temp;
	}

	psi = 0.;
	i__1 = *i__ - 1;
	for (j = 1; j <= i__1; ++j) {
	    psi += z__[j] * z__[j] / (work[j] * delta[j]);
	}

	phi = 0.;
	i__1 = *i__ + 2;
	for (j = *n; j >= i__1; --j) {
	    phi += z__[j] * z__[j] / (work[j] * delta[j]);
	}
	c__ = rhoinv + psi + phi;
	w = c__ + z__[*i__] * z__[*i__] / (work[*i__] * delta[*i__]) + z__[
		ip1] * z__[ip1] / (work[ip1] * delta[ip1]);

	if (w > 0.) {



	    orgati = TRUE_;
	    sg2lb = 0.;
	    sg2ub = delsq2;
	    a = c__ * delsq + z__[*i__] * z__[*i__] + z__[ip1] * z__[ip1];
	    b = z__[*i__] * z__[*i__] * delsq;
	    if (a > 0.) {
		tau = b * 2. / (a + sqrt((d__1 = a * a - b * 4. * c__, abs(
			d__1))));
	    } else {
		tau = (a - sqrt((d__1 = a * a - b * 4. * c__, abs(d__1)))) / (
			c__ * 2.);
	    }


	    eta = tau / (d__[*i__] + sqrt(d__[*i__] * d__[*i__] + tau));
	} else {



	    orgati = FALSE_;
	    sg2lb = -delsq2;
	    sg2ub = 0.;
	    a = c__ * delsq - z__[*i__] * z__[*i__] - z__[ip1] * z__[ip1];
	    b = z__[ip1] * z__[ip1] * delsq;
	    if (a < 0.) {
		tau = b * 2. / (a - sqrt((d__1 = a * a + b * 4. * c__, abs(
			d__1))));
	    } else {
		tau = -(a + sqrt((d__1 = a * a + b * 4. * c__, abs(d__1)))) / 
			(c__ * 2.);
	    }


	    eta = tau / (d__[ip1] + sqrt((d__1 = d__[ip1] * d__[ip1] + tau, 
		    abs(d__1))));
	}

	if (orgati) {
	    ii = *i__;
	    *sigma = d__[*i__] + eta;
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		work[j] = d__[j] + d__[*i__] + eta;
		delta[j] = d__[j] - d__[*i__] - eta;
	    }
	} else {
	    ii = *i__ + 1;
	    *sigma = d__[ip1] + eta;
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		work[j] = d__[j] + d__[ip1] + eta;
		delta[j] = d__[j] - d__[ip1] - eta;
	    }
	}
	iim1 = ii - 1;
	iip1 = ii + 1;


	dpsi = 0.;
	psi = 0.;
	erretm = 0.;
	i__1 = iim1;
	for (j = 1; j <= i__1; ++j) {
	    temp = z__[j] / (work[j] * delta[j]);
	    psi += z__[j] * temp;
	    dpsi += temp * temp;
	    erretm += psi;
	}
	erretm = abs(erretm);


	dphi = 0.;
	phi = 0.;
	i__1 = iip1;
	for (j = *n; j >= i__1; --j) {
	    temp = z__[j] / (work[j] * delta[j]);
	    phi += z__[j] * temp;
	    dphi += temp * temp;
	    erretm += phi;
	}

	w = rhoinv + phi + psi;


	swtch3 = FALSE_;
	if (orgati) {
	    if (w < 0.) {
		swtch3 = TRUE_;
	    }
	} else {
	    if (w > 0.) {
		swtch3 = TRUE_;
	    }
	}
	if (ii == 1 || ii == *n) {
	    swtch3 = FALSE_;
	}

	temp = z__[ii] / (work[ii] * delta[ii]);
	dw = dpsi + dphi + temp * temp;
	temp = z__[ii] * temp;
	w += temp;
	erretm = (phi - psi) * 8. + erretm + rhoinv * 2. + abs(temp) * 3. + 
		abs(tau) * dw;


	if (abs(w) <= eps * erretm) {
	    goto L240;
	}

	if (w <= 0.) {
	    sg2lb = max(sg2lb,tau);
	} else {
	    sg2ub = min(sg2ub,tau);
	}


	++niter;
	if (! swtch3) {
	    dtipsq = work[ip1] * delta[ip1];
	    dtisq = work[*i__] * delta[*i__];
	    if (orgati) {
		d__1 = z__[*i__] / dtisq;
		c__ = w - dtipsq * dw + delsq * (d__1 * d__1);
	    } else {
		d__1 = z__[ip1] / dtipsq;
		c__ = w - dtisq * dw - delsq * (d__1 * d__1);
	    }
	    a = (dtipsq + dtisq) * w - dtipsq * dtisq * dw;
	    b = dtipsq * dtisq * w;
	    if (c__ == 0.) {
		if (a == 0.) {
		    if (orgati) {
			a = z__[*i__] * z__[*i__] + dtipsq * dtipsq * (dpsi + 
				dphi);
		    } else {
			a = z__[ip1] * z__[ip1] + dtisq * dtisq * (dpsi + 
				dphi);
		    }
		}
		eta = b / a;
	    } else if (a <= 0.) {
		eta = (a - sqrt((d__1 = a * a - b * 4. * c__, abs(d__1)))) / (
			c__ * 2.);
	    } else {
		eta = b * 2. / (a + sqrt((d__1 = a * a - b * 4. * c__, abs(
			d__1))));
	    }
	} else {


	    dtiim = work[iim1] * delta[iim1];
	    dtiip = work[iip1] * delta[iip1];
	    temp = rhoinv + psi + phi;
	    if (orgati) {
		temp1 = z__[iim1] / dtiim;
		temp1 *= temp1;
		c__ = temp - dtiip * (dpsi + dphi) - (d__[iim1] - d__[iip1]) *
			 (d__[iim1] + d__[iip1]) * temp1;
		zz[0] = z__[iim1] * z__[iim1];
		if (dpsi < temp1) {
		    zz[2] = dtiip * dtiip * dphi;
		} else {
		    zz[2] = dtiip * dtiip * (dpsi - temp1 + dphi);
		}
	    } else {
		temp1 = z__[iip1] / dtiip;
		temp1 *= temp1;
		c__ = temp - dtiim * (dpsi + dphi) - (d__[iip1] - d__[iim1]) *
			 (d__[iim1] + d__[iip1]) * temp1;
		if (dphi < temp1) {
		    zz[0] = dtiim * dtiim * dpsi;
		} else {
		    zz[0] = dtiim * dtiim * (dpsi + (dphi - temp1));
		}
		zz[2] = z__[iip1] * z__[iip1];
	    }
	    zz[1] = z__[ii] * z__[ii];
	    dd[0] = dtiim;
	    dd[1] = delta[ii] * work[ii];
	    dd[2] = dtiip;
	    if (dlaed6_(interp, &niter, &orgati, &c__, dd, zz, &w, &eta, info)!=TCL_OK) { return TCL_ERROR; }

	    if (*info != 0) {
		goto L240;
	    }
	}


	if (w * eta >= 0.) {
	    eta = -w / dw;
	}
	if (orgati) {
	    temp1 = work[*i__] * delta[*i__];
	    temp = eta - temp1;
	} else {
	    temp1 = work[ip1] * delta[ip1];
	    temp = eta - temp1;
	}
	if (temp > sg2ub || temp < sg2lb) {
	    if (w < 0.) {
		eta = (sg2ub - tau) / 2.;
	    } else {
		eta = (sg2lb - tau) / 2.;
	    }
	}

	tau += eta;
	eta /= *sigma + sqrt(*sigma * *sigma + eta);

	prew = w;

	*sigma += eta;
	i__1 = *n;
	for (j = 1; j <= i__1; ++j) {
	    work[j] += eta;
	    delta[j] -= eta;
	}


	dpsi = 0.;
	psi = 0.;
	erretm = 0.;
	i__1 = iim1;
	for (j = 1; j <= i__1; ++j) {
	    temp = z__[j] / (work[j] * delta[j]);
	    psi += z__[j] * temp;
	    dpsi += temp * temp;
	    erretm += psi;
	}
	erretm = abs(erretm);


	dphi = 0.;
	phi = 0.;
	i__1 = iip1;
	for (j = *n; j >= i__1; --j) {
	    temp = z__[j] / (work[j] * delta[j]);
	    phi += z__[j] * temp;
	    dphi += temp * temp;
	    erretm += phi;
	}

	temp = z__[ii] / (work[ii] * delta[ii]);
	dw = dpsi + dphi + temp * temp;
	temp = z__[ii] * temp;
	w = rhoinv + phi + psi + temp;
	erretm = (phi - psi) * 8. + erretm + rhoinv * 2. + abs(temp) * 3. + 
		abs(tau) * dw;

	if (w <= 0.) {
	    sg2lb = max(sg2lb,tau);
	} else {
	    sg2ub = min(sg2ub,tau);
	}

	swtch = FALSE_;
	if (orgati) {
	    if (-w > abs(prew) / 10.) {
		swtch = TRUE_;
	    }
	} else {
	    if (w > abs(prew) / 10.) {
		swtch = TRUE_;
	    }
	}


	iter = niter + 1;

	for (niter = iter; niter <= 20; ++niter) {


	    if (abs(w) <= eps * erretm) {
		goto L240;
	    }


	    if (! swtch3) {
		dtipsq = work[ip1] * delta[ip1];
		dtisq = work[*i__] * delta[*i__];
		if (! swtch) {
		    if (orgati) {
			d__1 = z__[*i__] / dtisq;
			c__ = w - dtipsq * dw + delsq * (d__1 * d__1);
		    } else {
			d__1 = z__[ip1] / dtipsq;
			c__ = w - dtisq * dw - delsq * (d__1 * d__1);
		    }
		} else {
		    temp = z__[ii] / (work[ii] * delta[ii]);
		    if (orgati) {
			dpsi += temp * temp;
		    } else {
			dphi += temp * temp;
		    }
		    c__ = w - dtisq * dpsi - dtipsq * dphi;
		}
		a = (dtipsq + dtisq) * w - dtipsq * dtisq * dw;
		b = dtipsq * dtisq * w;
		if (c__ == 0.) {
		    if (a == 0.) {
			if (! swtch) {
			    if (orgati) {
				a = z__[*i__] * z__[*i__] + dtipsq * dtipsq * 
					(dpsi + dphi);
			    } else {
				a = z__[ip1] * z__[ip1] + dtisq * dtisq * (
					dpsi + dphi);
			    }
			} else {
			    a = dtisq * dtisq * dpsi + dtipsq * dtipsq * dphi;
			}
		    }
		    eta = b / a;
		} else if (a <= 0.) {
		    eta = (a - sqrt((d__1 = a * a - b * 4. * c__, abs(d__1))))
			     / (c__ * 2.);
		} else {
		    eta = b * 2. / (a + sqrt((d__1 = a * a - b * 4. * c__, 
			    abs(d__1))));
		}
	    } else {


		dtiim = work[iim1] * delta[iim1];
		dtiip = work[iip1] * delta[iip1];
		temp = rhoinv + psi + phi;
		if (swtch) {
		    c__ = temp - dtiim * dpsi - dtiip * dphi;
		    zz[0] = dtiim * dtiim * dpsi;
		    zz[2] = dtiip * dtiip * dphi;
		} else {
		    if (orgati) {
			temp1 = z__[iim1] / dtiim;
			temp1 *= temp1;
			temp2 = (d__[iim1] - d__[iip1]) * (d__[iim1] + d__[
				iip1]) * temp1;
			c__ = temp - dtiip * (dpsi + dphi) - temp2;
			zz[0] = z__[iim1] * z__[iim1];
			if (dpsi < temp1) {
			    zz[2] = dtiip * dtiip * dphi;
			} else {
			    zz[2] = dtiip * dtiip * (dpsi - temp1 + dphi);
			}
		    } else {
			temp1 = z__[iip1] / dtiip;
			temp1 *= temp1;
			temp2 = (d__[iip1] - d__[iim1]) * (d__[iim1] + d__[
				iip1]) * temp1;
			c__ = temp - dtiim * (dpsi + dphi) - temp2;
			if (dphi < temp1) {
			    zz[0] = dtiim * dtiim * dpsi;
			} else {
			    zz[0] = dtiim * dtiim * (dpsi + (dphi - temp1));
			}
			zz[2] = z__[iip1] * z__[iip1];
		    }
		}
		dd[0] = dtiim;
		dd[1] = delta[ii] * work[ii];
		dd[2] = dtiip;
		if (dlaed6_(interp, &niter, &orgati, &c__, dd, zz, &w, &eta, info)!=TCL_OK) { return TCL_ERROR; }

		if (*info != 0) {
		    goto L240;
		}
	    }


	    if (w * eta >= 0.) {
		eta = -w / dw;
	    }
	    if (orgati) {
		temp1 = work[*i__] * delta[*i__];
		temp = eta - temp1;
	    } else {
		temp1 = work[ip1] * delta[ip1];
		temp = eta - temp1;
	    }
	    if (temp > sg2ub || temp < sg2lb) {
		if (w < 0.) {
		    eta = (sg2ub - tau) / 2.;
		} else {
		    eta = (sg2lb - tau) / 2.;
		}
	    }

	    tau += eta;
	    eta /= *sigma + sqrt(*sigma * *sigma + eta);

	    *sigma += eta;
	    i__1 = *n;
	    for (j = 1; j <= i__1; ++j) {
		work[j] += eta;
		delta[j] -= eta;
	    }

	    prew = w;


	    dpsi = 0.;
	    psi = 0.;
	    erretm = 0.;
	    i__1 = iim1;
	    for (j = 1; j <= i__1; ++j) {
		temp = z__[j] / (work[j] * delta[j]);
		psi += z__[j] * temp;
		dpsi += temp * temp;
		erretm += psi;
	    }
	    erretm = abs(erretm);


	    dphi = 0.;
	    phi = 0.;
	    i__1 = iip1;
	    for (j = *n; j >= i__1; --j) {
		temp = z__[j] / (work[j] * delta[j]);
		phi += z__[j] * temp;
		dphi += temp * temp;
		erretm += phi;
	    }

	    temp = z__[ii] / (work[ii] * delta[ii]);
	    dw = dpsi + dphi + temp * temp;
	    temp = z__[ii] * temp;
	    w = rhoinv + phi + psi + temp;
	    erretm = (phi - psi) * 8. + erretm + rhoinv * 2. + abs(temp) * 3. 
		    + abs(tau) * dw;
	    if (w * prew > 0. && abs(w) > abs(prew) / 10.) {
		swtch = ! swtch;
	    }

	    if (w <= 0.) {
		sg2lb = max(sg2lb,tau);
	    } else {
		sg2ub = min(sg2ub,tau);
	    }

	}


	*info = 1;

    }

L240:
return TCL_OK;


} /* dlasd4_ */
static /* Subroutine */ int dlasq4_ (Tcl_Interp *interp, integer *i0, integer *n0, doublereal *z__, 	integer *pp, integer *n0in, doublereal *dmin__, doublereal *dmin1, 	doublereal *dmin2, doublereal *dn, doublereal *dn1, doublereal *dn2, 	doublereal *tau, integer *ttype, doublereal *g)
{
    integer i__1;
    doublereal d__1, d__2;

    double sqrt(doublereal);

    doublereal s, a2, b1, b2;
    integer i4, nn, np;
    doublereal gam, gap1, gap2;


























    --z__;

    if (*dmin__ <= 0.) {
	*tau = -(*dmin__);
	*ttype = -1;
return TCL_OK;
    }

    nn = (*n0 << 2) + *pp;
    if (*n0in == *n0) {


	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];


	    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) {
		    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) {
			d__1 = s, d__2 = a2 - (b1 + b2);
			s = min(d__1,d__2);
		    }
		    d__1 = s, d__2 = *dmin__ * .333;
		    s = max(d__1,d__2);
		    *ttype = -3;
		}
	    } else {


		*ttype = -4;
		s = *dmin__ * .25;
		if (*dmin__ == *dn) {
		    gam = *dn;
		    a2 = 0.;
		    if (z__[nn - 5] > z__[nn - 7]) {
return TCL_OK;
		    }
		    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 TCL_OK;
		    }
		    a2 = z__[np - 4] / z__[np - 2];
		    if (z__[nn - 9] > z__[nn - 11]) {
return TCL_OK;
		    }
		    b2 = z__[nn - 9] / z__[nn - 11];
		    np = nn - 13;
		}


		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 TCL_OK;
		    }
		    b2 *= z__[i4] / z__[i4 - 2];
		    a2 += b2;
		    if (max(b2,b1) * 100. < a2 || .563 < a2) {
			goto L20;
		    }
		}
L20:
		a2 *= 1.05;


		if (a2 < .563) {
		    s = gam * (1. - sqrt(a2)) / (a2 + 1.);
		}
	    }
	} else if (*dmin__ == *dn2) {


	    *ttype = -5;
	    s = *dmin__ * .25;


	    np = nn - (*pp << 1);
	    b1 = z__[np - 2];
	    b2 = z__[np - 6];
	    gam = *dn2;
	    if (z__[np - 8] > b2 || z__[np - 4] > b1) {
return TCL_OK;
	    }
	    a2 = z__[np - 8] / b2 * (z__[np - 4] / b1 + 1.);


	    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 TCL_OK;
		    }
		    b2 *= z__[i4] / z__[i4 - 2];
		    a2 += b2;
		    if (max(b2,b1) * 100. < a2 || .563 < a2) {
			goto L40;
		    }
		}
L40:
		a2 *= 1.05;
	    }

	    if (a2 < .563) {
		s = gam * (1. - sqrt(a2)) / (a2 + 1.);
	    }
	} else {


	    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) {


	if (*dmin1 == *dn1 && *dmin2 == *dn2) {


	    *ttype = -7;
	    s = *dmin1 * .333;
	    if (z__[nn - 5] > z__[nn - 7]) {
return TCL_OK;
	    }
	    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 TCL_OK;
		}
		b1 *= z__[i4] / z__[i4 - 2];
		b2 += b1;
		if (max(b1,a2) * 100. < b2) {
		    goto L60;
		}
	    }
L60:
	    b2 = sqrt(b2 * 1.05);
	    d__1 = b2;
	    a2 = *dmin1 / (d__1 * d__1 + 1.);
	    gap2 = *dmin2 * .5 - a2;
	    if (gap2 > 0. && gap2 > b2 * a2) {
		d__1 = s, d__2 = a2 * (1. - a2 * 1.01 * (b2 / gap2) * b2);
		s = max(d__1,d__2);
	    } else {
		d__1 = s, d__2 = a2 * (1. - b2 * 1.01);
		s = max(d__1,d__2);
		*ttype = -8;
	    }
	} else {


	    s = *dmin1 * .25;
	    if (*dmin1 == *dn1) {
		s = *dmin1 * .5;
	    }
	    *ttype = -9;
	}

    } else if (*n0in == *n0 + 2) {



	if (*dmin2 == *dn2 && z__[nn - 5] * 2. < z__[nn - 7]) {
	    *ttype = -10;
	    s = *dmin2 * .333;
	    if (z__[nn - 5] > z__[nn - 7]) {
return TCL_OK;
	    }
	    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 TCL_OK;
		}
		b1 *= z__[i4] / z__[i4 - 2];
		b2 += b1;
		if (b1 * 100. < b2) {
		    goto L80;
		}
	    }
L80:
	    b2 = sqrt(b2 * 1.05);
	    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) {
		d__1 = s, d__2 = a2 * (1. - a2 * 1.01 * (b2 / gap2) * b2);
		s = max(d__1,d__2);
	    } else {
		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) {


	s = 0.;
	*ttype = -12;
    }

    *tau = s;
return TCL_OK;


} /* dlasq4_ */
static /* Subroutine */ int dlasq5_ (Tcl_Interp *interp, integer *i0, integer *n0, doublereal *z__, 	integer *pp, doublereal *tau, doublereal *dmin__, doublereal *dmin1, 	doublereal *dmin2, doublereal *dn, doublereal *dnm1, doublereal *dnm2, 	 logical *ieee)
{
    integer i__1;
    doublereal d__1, d__2;

    doublereal d__;
    integer j4, j4p2;
    doublereal emin, temp;























    --z__;

    if (*n0 - *i0 - 1 <= 0) {
return TCL_OK;
    }

    j4 = (*i0 << 2) + *pp - 3;
    emin = z__[j4 + 4];
    d__ = z__[j4] - *tau;
    *dmin__ = d__;
    *dmin1 = -z__[j4];

    if (*ieee) {


	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;
		d__1 = z__[j4];
		emin = min(d__1,emin);
	    }
	} 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;
		d__1 = z__[j4 - 1];
		emin = min(d__1,emin);
	    }
	}


	*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 {


	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 TCL_OK;
		} 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__);
		d__1 = emin, d__2 = z__[j4];
		emin = min(d__1,d__2);
	    }
	} 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 TCL_OK;
		} 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__);
		d__1 = emin, d__2 = z__[j4 - 1];
		emin = min(d__1,d__2);
	    }
	}


	*dnm2 = d__;
	*dmin2 = *dmin__;
	j4 = (*n0 - 2 << 2) - *pp;
	j4p2 = j4 + (*pp << 1) - 1;
	z__[j4 - 2] = *dnm2 + z__[j4p2];
	if (*dnm2 < 0.) {
return TCL_OK;
	} 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 TCL_OK;
	} 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 TCL_OK;


} /* dlasq5_ */
static /* Subroutine */ int dlasq6_ (Tcl_Interp *interp, integer *i0, integer *n0, doublereal *z__, 	integer *pp, doublereal *dmin__, doublereal *dmin1, doublereal *dmin2, 	 doublereal *dn, doublereal *dnm1, doublereal *dnm2)
{
    integer i__1;
    doublereal d__1, d__2;

    doublereal d__;
    integer j4, j4p2;
    doublereal emin, temp;
    doublereal safmin;





















    --z__;

    if (*n0 - *i0 - 1 <= 0) {
return TCL_OK;
    }

    safmin = 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__);
	    d__1 = emin, d__2 = z__[j4];
	    emin = min(d__1,d__2);
	}
    } 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__);
	    d__1 = emin, d__2 = z__[j4 - 1];
	    emin = min(d__1,d__2);
	}
    }


    *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 TCL_OK;


} /* dlasq6_ */
static /* Subroutine */ int dlaed6_ (Tcl_Interp *interp, integer *kniter, logical *orgati, doublereal *	rho, doublereal *d__, doublereal *z__, doublereal *finit, doublereal *	tau, integer *info)
{
    integer i__1;
    doublereal d__1, d__2, d__3, d__4;

    double sqrt(doublereal), log(doublereal), pow_di(doublereal *, integer *);

    doublereal a, b, c__, f;
    integer i__;
    doublereal fc, df, ddf, lbd, eta, ubd, eps, base;
    integer iter;
    doublereal temp, temp1, temp2, temp3, temp4;
    logical scale;
    integer niter;
    doublereal small1, small2, sminv1, sminv2;
    doublereal dscale[3], sclfac, zscale[3], erretm, sclinv;
























    --z__;
    --d__;

    *info = 0;

    if (*orgati) {
	lbd = d__[2];
	ubd = d__[3];
    } else {
	lbd = d__[1];
	ubd = d__[2];
    }
    if (*finit < 0.) {
	lbd = 0.;
    } else {
	ubd = 0.;
    }

    niter = 1;
    *tau = 0.;
    if (*kniter == 2) {
	if (*orgati) {
	    temp = (d__[3] - d__[2]) / 2.;
	    c__ = *rho + z__[1] / (d__[1] - d__[2] - temp);
	    a = c__ * (d__[2] + d__[3]) + z__[2] + z__[3];
	    b = c__ * d__[2] * d__[3] + z__[2] * d__[3] + z__[3] * d__[2];
	} else {
	    temp = (d__[1] - d__[2]) / 2.;
	    c__ = *rho + z__[3] / (d__[3] - d__[2] - temp);
	    a = c__ * (d__[1] + d__[2]) + z__[1] + z__[2];
	    b = c__ * d__[1] * d__[2] + z__[1] * d__[2] + z__[2] * d__[1];
	}
	d__1 = abs(a), d__2 = abs(b), d__1 = max(d__1,d__2), d__2 = abs(c__);
	temp = max(d__1,d__2);
	a /= temp;
	b /= temp;
	c__ /= temp;
	if (c__ == 0.) {
	    *tau = b / a;
	} else if (a <= 0.) {
	    *tau = (a - sqrt((d__1 = a * a - b * 4. * c__, abs(d__1)))) / (
		    c__ * 2.);
	} else {
	    *tau = b * 2. / (a + sqrt((d__1 = a * a - b * 4. * c__, abs(d__1))
		    ));
	}
	if (*tau < lbd || *tau > ubd) {
	    *tau = (lbd + ubd) / 2.;
	}
	if (d__[1] == *tau || d__[2] == *tau || d__[3] == *tau) {
	    *tau = 0.;
	} else {
	    temp = *finit + *tau * z__[1] / (d__[1] * (d__[1] - *tau)) + *tau 
		    * z__[2] / (d__[2] * (d__[2] - *tau)) + *tau * z__[3] / (
		    d__[3] * (d__[3] - *tau));
	    if (temp <= 0.) {
		lbd = *tau;
	    } else {
		ubd = *tau;
	    }
	    if (abs(*finit) <= abs(temp)) {
		*tau = 0.;
	    }
	}
    }



    eps = dlamch_("Epsilon");
    base = dlamch_("Base");
    i__1 = (integer) (log(dlamch_("SafMin")) / log(base) / 3.);
    small1 = pow_di(&base, &i__1);
    sminv1 = 1. / small1;
    small2 = small1 * small1;
    sminv2 = sminv1 * sminv1;


    if (*orgati) {
	d__3 = (d__1 = d__[2] - *tau, abs(d__1)), d__4 = (d__2 = d__[3] - *
		tau, abs(d__2));
	temp = min(d__3,d__4);
    } else {
	d__3 = (d__1 = d__[1] - *tau, abs(d__1)), d__4 = (d__2 = d__[2] - *
		tau, abs(d__2));
	temp = min(d__3,d__4);
    }
    scale = FALSE_;
    if (temp <= small1) {
	scale = TRUE_;
	if (temp <= small2) {


	    sclfac = sminv2;
	    sclinv = small2;
	} else {


	    sclfac = sminv1;
	    sclinv = small1;
	}


	for (i__ = 1; i__ <= 3; ++i__) {
	    dscale[i__ - 1] = d__[i__] * sclfac;
	    zscale[i__ - 1] = z__[i__] * sclfac;
	}
	*tau *= sclfac;
	lbd *= sclfac;
	ubd *= sclfac;
    } else {


	for (i__ = 1; i__ <= 3; ++i__) {
	    dscale[i__ - 1] = d__[i__];
	    zscale[i__ - 1] = z__[i__];
	}
    }

    fc = 0.;
    df = 0.;
    ddf = 0.;
    for (i__ = 1; i__ <= 3; ++i__) {
	temp = 1. / (dscale[i__ - 1] - *tau);
	temp1 = zscale[i__ - 1] * temp;
	temp2 = temp1 * temp;
	temp3 = temp2 * temp;
	fc += temp1 / dscale[i__ - 1];
	df += temp2;
	ddf += temp3;
    }
    f = *finit + *tau * fc;

    if (abs(f) <= 0.) {
	goto L60;
    }
    if (f <= 0.) {
	lbd = *tau;
    } else {
	ubd = *tau;
    }





    iter = niter + 1;

    for (niter = iter; niter <= 40; ++niter) {

	if (*orgati) {
	    temp1 = dscale[1] - *tau;
	    temp2 = dscale[2] - *tau;
	} else {
	    temp1 = dscale[0] - *tau;
	    temp2 = dscale[1] - *tau;
	}
	a = (temp1 + temp2) * f - temp1 * temp2 * df;
	b = temp1 * temp2 * f;
	c__ = f - (temp1 + temp2) * df + temp1 * temp2 * ddf;
	d__1 = abs(a), d__2 = abs(b), d__1 = max(d__1,d__2), d__2 = abs(c__);
	temp = max(d__1,d__2);
	a /= temp;
	b /= temp;
	c__ /= temp;
	if (c__ == 0.) {
	    eta = b / a;
	} else if (a <= 0.) {
	    eta = (a - sqrt((d__1 = a * a - b * 4. * c__, abs(d__1)))) / (c__ 
		    * 2.);
	} else {
	    eta = b * 2. / (a + sqrt((d__1 = a * a - b * 4. * c__, abs(d__1)))
		    );
	}
	if (f * eta >= 0.) {
	    eta = -f / df;
	}

	*tau += eta;
	if (*tau < lbd || *tau > ubd) {
	    *tau = (lbd + ubd) / 2.;
	}

	fc = 0.;
	erretm = 0.;
	df = 0.;
	ddf = 0.;
	for (i__ = 1; i__ <= 3; ++i__) {
	    temp = 1. / (dscale[i__ - 1] - *tau);
	    temp1 = zscale[i__ - 1] * temp;
	    temp2 = temp1 * temp;
	    temp3 = temp2 * temp;
	    temp4 = temp1 / dscale[i__ - 1];
	    fc += temp4;
	    erretm += abs(temp4);
	    df += temp2;
	    ddf += temp3;
	}
	f = *finit + *tau * fc;
	erretm = (abs(*finit) + abs(*tau) * erretm) * 8. + abs(*tau) * df;
	if (abs(f) <= eps * erretm) {
	    goto L60;
	}
	if (f <= 0.) {
	    lbd = *tau;
	} else {
	    ubd = *tau;
	}
    }
    *info = 1;
L60:


    if (scale) {
	*tau *= sclinv;
    }
return TCL_OK;


} /* dlaed6_ */
static /* Subroutine */ int dlasd5_ (Tcl_Interp *interp, integer *i__, doublereal *d__, doublereal *z__, 	doublereal *delta, doublereal *rho, doublereal *dsigma, doublereal *	work)
{
    doublereal d__1;

    double sqrt(doublereal);

    doublereal b, c__, w, del, tau, delsq;






















    --work;
    --delta;
    --z__;
    --d__;

    del = d__[2] - d__[1];
    delsq = del * (d__[2] + d__[1]);
    if (*i__ == 1) {
	w = *rho * 4. * (z__[2] * z__[2] / (d__[1] + d__[2] * 3.) - z__[1] * 
		z__[1] / (d__[1] * 3. + d__[2])) / del + 1.;
	if (w > 0.) {
	    b = delsq + *rho * (z__[1] * z__[1] + z__[2] * z__[2]);
	    c__ = *rho * z__[1] * z__[1] * delsq;



	    tau = c__ * 2. / (b + sqrt((d__1 = b * b - c__ * 4., abs(d__1))));


	    tau /= d__[1] + sqrt(d__[1] * d__[1] + tau);
	    *dsigma = d__[1] + tau;
	    delta[1] = -tau;
	    delta[2] = del - tau;
	    work[1] = d__[1] * 2. + tau;
	    work[2] = d__[1] + tau + d__[2];
	} else {
	    b = -delsq + *rho * (z__[1] * z__[1] + z__[2] * z__[2]);
	    c__ = *rho * z__[2] * z__[2] * delsq;


	    if (b > 0.) {
		tau = c__ * -2. / (b + sqrt(b * b + c__ * 4.));
	    } else {
		tau = (b - sqrt(b * b + c__ * 4.)) / 2.;
	    }


	    tau /= d__[2] + sqrt((d__1 = d__[2] * d__[2] + tau, abs(d__1)));
	    *dsigma = d__[2] + tau;
	    delta[1] = -(del + tau);
	    delta[2] = -tau;
	    work[1] = d__[1] + tau + d__[2];
	    work[2] = d__[2] * 2. + tau;
	}
    } else {


	b = -delsq + *rho * (z__[1] * z__[1] + z__[2] * z__[2]);
	c__ = *rho * z__[2] * z__[2] * delsq;


	if (b > 0.) {
	    tau = (b + sqrt(b * b + c__ * 4.)) / 2.;
	} else {
	    tau = c__ * 2. / (-b + sqrt(b * b + c__ * 4.));
	}


	tau /= d__[2] + sqrt(d__[2] * d__[2] + tau);
	*dsigma = d__[2] + tau;
	delta[1] = -(del + tau);
	delta[2] = -tau;
	work[1] = d__[1] + tau + d__[2];
	work[2] = d__[2] * 2. + tau;
    }
return TCL_OK;


} /* dlasd5_ */

