kusano 7d535a
/*  -- translated by f2c (version 19940927).
kusano 7d535a
   You must link the resulting object file with the libraries:
kusano 7d535a
	-lf2c -lm   (in that order)
kusano 7d535a
*/
kusano 7d535a
kusano 7d535a
#include "f2c.h"
kusano 7d535a
kusano 7d535a
/* Table of constant values */
kusano 7d535a
kusano 7d535a
static doublecomplex c_b1 = {0.,0.};
kusano 7d535a
static doublecomplex c_b2 = {1.,0.};
kusano 7d535a
static integer c__3 = 3;
kusano 7d535a
static integer c__1 = 1;
kusano 7d535a
kusano 7d535a
/* Subroutine */ int zlagge_(integer *m, integer *n, integer *kl, integer *ku,
kusano 7d535a
	 doublereal *d, doublecomplex *a, integer *lda, integer *iseed, 
kusano 7d535a
	doublecomplex *work, integer *info)
kusano 7d535a
{
kusano 7d535a
    /* System generated locals */
kusano 7d535a
    integer a_dim1, a_offset, i__1, i__2, i__3;
kusano 7d535a
    doublereal d__1;
kusano 7d535a
    doublecomplex z__1;
kusano 7d535a
kusano 7d535a
    /* Builtin functions */
kusano 7d535a
    double z_abs(doublecomplex *);
kusano 7d535a
    void z_div(doublecomplex *, doublecomplex *, doublecomplex *);
kusano 7d535a
kusano 7d535a
    /* Local variables */
kusano 7d535a
    static integer i, j;
kusano 7d535a
    extern /* Subroutine */ int zgerc_(integer *, integer *, doublecomplex *, 
kusano 7d535a
	    doublecomplex *, integer *, doublecomplex *, integer *, 
kusano 7d535a
	    doublecomplex *, integer *), zscal_(integer *, doublecomplex *, 
kusano 7d535a
	    doublecomplex *, integer *), zgemv_(char *, integer *, integer *, 
kusano 7d535a
	    doublecomplex *, doublecomplex *, integer *, doublecomplex *, 
kusano 7d535a
	    integer *, doublecomplex *, doublecomplex *, integer *);
kusano 7d535a
    extern doublereal dznrm2_(integer *, doublecomplex *, integer *);
kusano 7d535a
    static doublecomplex wa, wb;
kusano 7d535a
    static doublereal wn;
kusano 7d535a
    extern /* Subroutine */ int xerbla_(char *, integer *), zlacgv_(
kusano 7d535a
	    integer *, doublecomplex *, integer *), zlarnv_(integer *, 
kusano 7d535a
	    integer *, integer *, doublecomplex *);
kusano 7d535a
    static doublecomplex tau;
kusano 7d535a
kusano 7d535a
kusano 7d535a
/*  -- LAPACK auxiliary test routine (version 2.0) --   
kusano 7d535a
       Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,   
kusano 7d535a
       Courant Institute, Argonne National Lab, and Rice University   
kusano 7d535a
       September 30, 1994   
kusano 7d535a
kusano 7d535a
kusano 7d535a
    Purpose   
kusano 7d535a
    =======   
kusano 7d535a
kusano 7d535a
    ZLAGGE generates a complex general m by n matrix A, by pre- and post- 
kusano 7d535a
  
kusano 7d535a
    multiplying a real diagonal matrix D with random unitary matrices:   
kusano 7d535a
    A = U*D*V. The lower and upper bandwidths may then be reduced to   
kusano 7d535a
    kl and ku by additional unitary transformations.   
kusano 7d535a
kusano 7d535a
    Arguments   
kusano 7d535a
    =========   
kusano 7d535a
kusano 7d535a
    M       (input) INTEGER   
kusano 7d535a
            The number of rows of the matrix A.  M >= 0.   
kusano 7d535a
kusano 7d535a
    N       (input) INTEGER   
kusano 7d535a
            The number of columns of the matrix A.  N >= 0.   
kusano 7d535a
kusano 7d535a
    KL      (input) INTEGER   
kusano 7d535a
            The number of nonzero subdiagonals within the band of A.   
kusano 7d535a
            0 <= KL <= M-1.   
kusano 7d535a
kusano 7d535a
    KU      (input) INTEGER   
kusano 7d535a
            The number of nonzero superdiagonals within the band of A.   
kusano 7d535a
            0 <= KU <= N-1.   
kusano 7d535a
kusano 7d535a
    D       (input) DOUBLE PRECISION array, dimension (min(M,N))   
kusano 7d535a
            The diagonal elements of the diagonal matrix D.   
kusano 7d535a
kusano 7d535a
    A       (output) COMPLEX*16 array, dimension (LDA,N)   
kusano 7d535a
            The generated m by n matrix A.   
kusano 7d535a
kusano 7d535a
    LDA     (input) INTEGER   
kusano 7d535a
            The leading dimension of the array A.  LDA >= M.   
kusano 7d535a
kusano 7d535a
    ISEED   (input/output) INTEGER array, dimension (4)   
kusano 7d535a
            On entry, the seed of the random number generator; the array 
kusano 7d535a
  
kusano 7d535a
            elements must be between 0 and 4095, and ISEED(4) must be   
kusano 7d535a
            odd.   
kusano 7d535a
            On exit, the seed is updated.   
kusano 7d535a
kusano 7d535a
    WORK    (workspace) COMPLEX*16 array, dimension (M+N)   
kusano 7d535a
kusano 7d535a
    INFO    (output) INTEGER   
kusano 7d535a
            = 0: successful exit   
kusano 7d535a
            < 0: if INFO = -i, the i-th argument had an illegal value   
kusano 7d535a
kusano 7d535a
    ===================================================================== 
kusano 7d535a
  
kusano 7d535a
kusano 7d535a
kusano 7d535a
       Test the input arguments   
kusano 7d535a
kusano 7d535a
       Parameter adjustments */
kusano 7d535a
    --d;
kusano 7d535a
    a_dim1 = *lda;
kusano 7d535a
    a_offset = a_dim1 + 1;
kusano 7d535a
    a -= a_offset;
kusano 7d535a
    --iseed;
kusano 7d535a
    --work;
kusano 7d535a
kusano 7d535a
    /* Function Body */
kusano 7d535a
    *info = 0;
kusano 7d535a
    if (*m < 0) {
kusano 7d535a
	*info = -1;
kusano 7d535a
    } else if (*n < 0) {
kusano 7d535a
	*info = -2;
kusano 7d535a
    } else if (*kl < 0 || *kl > *m - 1) {
kusano 7d535a
	*info = -3;
kusano 7d535a
    } else if (*ku < 0 || *ku > *n - 1) {
kusano 7d535a
	*info = -4;
kusano 7d535a
    } else if (*lda < max(1,*m)) {
kusano 7d535a
	*info = -7;
kusano 7d535a
    }
kusano 7d535a
    if (*info < 0) {
kusano 7d535a
	i__1 = -(*info);
kusano 7d535a
	xerbla_("ZLAGGE", &i__1);
kusano 7d535a
	return 0;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     initialize A to diagonal matrix */
kusano 7d535a
kusano 7d535a
    i__1 = *n;
kusano 7d535a
    for (j = 1; j <= i__1; ++j) {
kusano 7d535a
	i__2 = *m;
kusano 7d535a
	for (i = 1; i <= i__2; ++i) {
kusano 7d535a
	    i__3 = i + j * a_dim1;
kusano 7d535a
	    a[i__3].r = 0., a[i__3].i = 0.;
kusano 7d535a
/* L10: */
kusano 7d535a
	}
kusano 7d535a
/* L20: */
kusano 7d535a
    }
kusano 7d535a
    i__1 = min(*m,*n);
kusano 7d535a
    for (i = 1; i <= i__1; ++i) {
kusano 7d535a
	i__2 = i + i * a_dim1;
kusano 7d535a
	i__3 = i;
kusano 7d535a
	a[i__2].r = d[i__3], a[i__2].i = 0.;
kusano 7d535a
/* L30: */
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     pre- and post-multiply A by random unitary matrices */
kusano 7d535a
kusano 7d535a
    for (i = min(*m,*n); i >= 1; --i) {
kusano 7d535a
	if (i < *m) {
kusano 7d535a
kusano 7d535a
/*           generate random reflection */
kusano 7d535a
kusano 7d535a
	    i__1 = *m - i + 1;
kusano 7d535a
	    zlarnv_(&c__3, &iseed[1], &i__1, &work[1]);
kusano 7d535a
	    i__1 = *m - i + 1;
kusano 7d535a
	    wn = dznrm2_(&i__1, &work[1], &c__1);
kusano 7d535a
	    d__1 = wn / z_abs(&work[1]);
kusano 7d535a
	    z__1.r = d__1 * work[1].r, z__1.i = d__1 * work[1].i;
kusano 7d535a
	    wa.r = z__1.r, wa.i = z__1.i;
kusano 7d535a
	    if (wn == 0.) {
kusano 7d535a
		tau.r = 0., tau.i = 0.;
kusano 7d535a
	    } else {
kusano 7d535a
		z__1.r = work[1].r + wa.r, z__1.i = work[1].i + wa.i;
kusano 7d535a
		wb.r = z__1.r, wb.i = z__1.i;
kusano 7d535a
		i__1 = *m - i;
kusano 7d535a
		z_div(&z__1, &c_b2, &wb);
kusano 7d535a
		zscal_(&i__1, &z__1, &work[2], &c__1);
kusano 7d535a
		work[1].r = 1., work[1].i = 0.;
kusano 7d535a
		z_div(&z__1, &wb, &wa);
kusano 7d535a
		d__1 = z__1.r;
kusano 7d535a
		tau.r = d__1, tau.i = 0.;
kusano 7d535a
	    }
kusano 7d535a
kusano 7d535a
/*           multiply A(i:m,i:n) by random reflection from the lef
kusano 7d535a
t */
kusano 7d535a
kusano 7d535a
	    i__1 = *m - i + 1;
kusano 7d535a
	    i__2 = *n - i + 1;
kusano 7d535a
	    zgemv_("Conjugate transpose", &i__1, &i__2, &c_b2, &a[i + i * 
kusano 7d535a
		    a_dim1], lda, &work[1], &c__1, &c_b1, &work[*m + 1], &
kusano 7d535a
		    c__1);
kusano 7d535a
	    i__1 = *m - i + 1;
kusano 7d535a
	    i__2 = *n - i + 1;
kusano 7d535a
	    z__1.r = -tau.r, z__1.i = -tau.i;
kusano 7d535a
	    zgerc_(&i__1, &i__2, &z__1, &work[1], &c__1, &work[*m + 1], &c__1,
kusano 7d535a
		     &a[i + i * a_dim1], lda);
kusano 7d535a
	}
kusano 7d535a
	if (i < *n) {
kusano 7d535a
kusano 7d535a
/*           generate random reflection */
kusano 7d535a
kusano 7d535a
	    i__1 = *n - i + 1;
kusano 7d535a
	    zlarnv_(&c__3, &iseed[1], &i__1, &work[1]);
kusano 7d535a
	    i__1 = *n - i + 1;
kusano 7d535a
	    wn = dznrm2_(&i__1, &work[1], &c__1);
kusano 7d535a
	    d__1 = wn / z_abs(&work[1]);
kusano 7d535a
	    z__1.r = d__1 * work[1].r, z__1.i = d__1 * work[1].i;
kusano 7d535a
	    wa.r = z__1.r, wa.i = z__1.i;
kusano 7d535a
	    if (wn == 0.) {
kusano 7d535a
		tau.r = 0., tau.i = 0.;
kusano 7d535a
	    } else {
kusano 7d535a
		z__1.r = work[1].r + wa.r, z__1.i = work[1].i + wa.i;
kusano 7d535a
		wb.r = z__1.r, wb.i = z__1.i;
kusano 7d535a
		i__1 = *n - i;
kusano 7d535a
		z_div(&z__1, &c_b2, &wb);
kusano 7d535a
		zscal_(&i__1, &z__1, &work[2], &c__1);
kusano 7d535a
		work[1].r = 1., work[1].i = 0.;
kusano 7d535a
		z_div(&z__1, &wb, &wa);
kusano 7d535a
		d__1 = z__1.r;
kusano 7d535a
		tau.r = d__1, tau.i = 0.;
kusano 7d535a
	    }
kusano 7d535a
kusano 7d535a
/*           multiply A(i:m,i:n) by random reflection from the rig
kusano 7d535a
ht */
kusano 7d535a
kusano 7d535a
	    i__1 = *m - i + 1;
kusano 7d535a
	    i__2 = *n - i + 1;
kusano 7d535a
	    zgemv_("No transpose", &i__1, &i__2, &c_b2, &a[i + i * a_dim1], 
kusano 7d535a
		    lda, &work[1], &c__1, &c_b1, &work[*n + 1], &c__1);
kusano 7d535a
	    i__1 = *m - i + 1;
kusano 7d535a
	    i__2 = *n - i + 1;
kusano 7d535a
	    z__1.r = -tau.r, z__1.i = -tau.i;
kusano 7d535a
	    zgerc_(&i__1, &i__2, &z__1, &work[*n + 1], &c__1, &work[1], &c__1,
kusano 7d535a
		     &a[i + i * a_dim1], lda);
kusano 7d535a
	}
kusano 7d535a
/* L40: */
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     Reduce number of subdiagonals to KL and number of superdiagonals   
kusano 7d535a
       to KU   
kusano 7d535a
kusano 7d535a
   Computing MAX */
kusano 7d535a
    i__2 = *m - 1 - *kl, i__3 = *n - 1 - *ku;
kusano 7d535a
    i__1 = max(i__2,i__3);
kusano 7d535a
    for (i = 1; i <= i__1; ++i) {
kusano 7d535a
	if (*kl <= *ku) {
kusano 7d535a
kusano 7d535a
/*           annihilate subdiagonal elements first (necessary if K
kusano 7d535a
L = 0)   
kusano 7d535a
kusano 7d535a
   Computing MIN */
kusano 7d535a
	    i__2 = *m - 1 - *kl;
kusano 7d535a
	    if (i <= min(i__2,*n)) {
kusano 7d535a
kusano 7d535a
/*              generate reflection to annihilate A(kl+i+1:m,i
kusano 7d535a
) */
kusano 7d535a
kusano 7d535a
		i__2 = *m - *kl - i + 1;
kusano 7d535a
		wn = dznrm2_(&i__2, &a[*kl + i + i * a_dim1], &c__1);
kusano 7d535a
		d__1 = wn / z_abs(&a[*kl + i + i * a_dim1]);
kusano 7d535a
		i__2 = *kl + i + i * a_dim1;
kusano 7d535a
		z__1.r = d__1 * a[i__2].r, z__1.i = d__1 * a[i__2].i;
kusano 7d535a
		wa.r = z__1.r, wa.i = z__1.i;
kusano 7d535a
		if (wn == 0.) {
kusano 7d535a
		    tau.r = 0., tau.i = 0.;
kusano 7d535a
		} else {
kusano 7d535a
		    i__2 = *kl + i + i * a_dim1;
kusano 7d535a
		    z__1.r = a[i__2].r + wa.r, z__1.i = a[i__2].i + wa.i;
kusano 7d535a
		    wb.r = z__1.r, wb.i = z__1.i;
kusano 7d535a
		    i__2 = *m - *kl - i;
kusano 7d535a
		    z_div(&z__1, &c_b2, &wb);
kusano 7d535a
		    zscal_(&i__2, &z__1, &a[*kl + i + 1 + i * a_dim1], &c__1);
kusano 7d535a
		    i__2 = *kl + i + i * a_dim1;
kusano 7d535a
		    a[i__2].r = 1., a[i__2].i = 0.;
kusano 7d535a
		    z_div(&z__1, &wb, &wa);
kusano 7d535a
		    d__1 = z__1.r;
kusano 7d535a
		    tau.r = d__1, tau.i = 0.;
kusano 7d535a
		}
kusano 7d535a
kusano 7d535a
/*              apply reflection to A(kl+i:m,i+1:n) from the l
kusano 7d535a
eft */
kusano 7d535a
kusano 7d535a
		i__2 = *m - *kl - i + 1;
kusano 7d535a
		i__3 = *n - i;
kusano 7d535a
		zgemv_("Conjugate transpose", &i__2, &i__3, &c_b2, &a[*kl + i 
kusano 7d535a
			+ (i + 1) * a_dim1], lda, &a[*kl + i + i * a_dim1], &
kusano 7d535a
			c__1, &c_b1, &work[1], &c__1);
kusano 7d535a
		i__2 = *m - *kl - i + 1;
kusano 7d535a
		i__3 = *n - i;
kusano 7d535a
		z__1.r = -tau.r, z__1.i = -tau.i;
kusano 7d535a
		zgerc_(&i__2, &i__3, &z__1, &a[*kl + i + i * a_dim1], &c__1, &
kusano 7d535a
			work[1], &c__1, &a[*kl + i + (i + 1) * a_dim1], lda);
kusano 7d535a
		i__2 = *kl + i + i * a_dim1;
kusano 7d535a
		z__1.r = -wa.r, z__1.i = -wa.i;
kusano 7d535a
		a[i__2].r = z__1.r, a[i__2].i = z__1.i;
kusano 7d535a
	    }
kusano 7d535a
kusano 7d535a
/* Computing MIN */
kusano 7d535a
	    i__2 = *n - 1 - *ku;
kusano 7d535a
	    if (i <= min(i__2,*m)) {
kusano 7d535a
kusano 7d535a
/*              generate reflection to annihilate A(i,ku+i+1:n
kusano 7d535a
) */
kusano 7d535a
kusano 7d535a
		i__2 = *n - *ku - i + 1;
kusano 7d535a
		wn = dznrm2_(&i__2, &a[i + (*ku + i) * a_dim1], lda);
kusano 7d535a
		d__1 = wn / z_abs(&a[i + (*ku + i) * a_dim1]);
kusano 7d535a
		i__2 = i + (*ku + i) * a_dim1;
kusano 7d535a
		z__1.r = d__1 * a[i__2].r, z__1.i = d__1 * a[i__2].i;
kusano 7d535a
		wa.r = z__1.r, wa.i = z__1.i;
kusano 7d535a
		if (wn == 0.) {
kusano 7d535a
		    tau.r = 0., tau.i = 0.;
kusano 7d535a
		} else {
kusano 7d535a
		    i__2 = i + (*ku + i) * a_dim1;
kusano 7d535a
		    z__1.r = a[i__2].r + wa.r, z__1.i = a[i__2].i + wa.i;
kusano 7d535a
		    wb.r = z__1.r, wb.i = z__1.i;
kusano 7d535a
		    i__2 = *n - *ku - i;
kusano 7d535a
		    z_div(&z__1, &c_b2, &wb);
kusano 7d535a
		    zscal_(&i__2, &z__1, &a[i + (*ku + i + 1) * a_dim1], lda);
kusano 7d535a
		    i__2 = i + (*ku + i) * a_dim1;
kusano 7d535a
		    a[i__2].r = 1., a[i__2].i = 0.;
kusano 7d535a
		    z_div(&z__1, &wb, &wa);
kusano 7d535a
		    d__1 = z__1.r;
kusano 7d535a
		    tau.r = d__1, tau.i = 0.;
kusano 7d535a
		}
kusano 7d535a
kusano 7d535a
/*              apply reflection to A(i+1:m,ku+i:n) from the r
kusano 7d535a
ight */
kusano 7d535a
kusano 7d535a
		i__2 = *n - *ku - i + 1;
kusano 7d535a
		zlacgv_(&i__2, &a[i + (*ku + i) * a_dim1], lda);
kusano 7d535a
		i__2 = *m - i;
kusano 7d535a
		i__3 = *n - *ku - i + 1;
kusano 7d535a
		zgemv_("No transpose", &i__2, &i__3, &c_b2, &a[i + 1 + (*ku + 
kusano 7d535a
			i) * a_dim1], lda, &a[i + (*ku + i) * a_dim1], lda, &
kusano 7d535a
			c_b1, &work[1], &c__1);
kusano 7d535a
		i__2 = *m - i;
kusano 7d535a
		i__3 = *n - *ku - i + 1;
kusano 7d535a
		z__1.r = -tau.r, z__1.i = -tau.i;
kusano 7d535a
		zgerc_(&i__2, &i__3, &z__1, &work[1], &c__1, &a[i + (*ku + i) 
kusano 7d535a
			* a_dim1], lda, &a[i + 1 + (*ku + i) * a_dim1], lda);
kusano 7d535a
		i__2 = i + (*ku + i) * a_dim1;
kusano 7d535a
		z__1.r = -wa.r, z__1.i = -wa.i;
kusano 7d535a
		a[i__2].r = z__1.r, a[i__2].i = z__1.i;
kusano 7d535a
	    }
kusano 7d535a
	} else {
kusano 7d535a
kusano 7d535a
/*           annihilate superdiagonal elements first (necessary if
kusano 7d535a
   
kusano 7d535a
             KU = 0)   
kusano 7d535a
kusano 7d535a
   Computing MIN */
kusano 7d535a
	    i__2 = *n - 1 - *ku;
kusano 7d535a
	    if (i <= min(i__2,*m)) {
kusano 7d535a
kusano 7d535a
/*              generate reflection to annihilate A(i,ku+i+1:n
kusano 7d535a
) */
kusano 7d535a
kusano 7d535a
		i__2 = *n - *ku - i + 1;
kusano 7d535a
		wn = dznrm2_(&i__2, &a[i + (*ku + i) * a_dim1], lda);
kusano 7d535a
		d__1 = wn / z_abs(&a[i + (*ku + i) * a_dim1]);
kusano 7d535a
		i__2 = i + (*ku + i) * a_dim1;
kusano 7d535a
		z__1.r = d__1 * a[i__2].r, z__1.i = d__1 * a[i__2].i;
kusano 7d535a
		wa.r = z__1.r, wa.i = z__1.i;
kusano 7d535a
		if (wn == 0.) {
kusano 7d535a
		    tau.r = 0., tau.i = 0.;
kusano 7d535a
		} else {
kusano 7d535a
		    i__2 = i + (*ku + i) * a_dim1;
kusano 7d535a
		    z__1.r = a[i__2].r + wa.r, z__1.i = a[i__2].i + wa.i;
kusano 7d535a
		    wb.r = z__1.r, wb.i = z__1.i;
kusano 7d535a
		    i__2 = *n - *ku - i;
kusano 7d535a
		    z_div(&z__1, &c_b2, &wb);
kusano 7d535a
		    zscal_(&i__2, &z__1, &a[i + (*ku + i + 1) * a_dim1], lda);
kusano 7d535a
		    i__2 = i + (*ku + i) * a_dim1;
kusano 7d535a
		    a[i__2].r = 1., a[i__2].i = 0.;
kusano 7d535a
		    z_div(&z__1, &wb, &wa);
kusano 7d535a
		    d__1 = z__1.r;
kusano 7d535a
		    tau.r = d__1, tau.i = 0.;
kusano 7d535a
		}
kusano 7d535a
kusano 7d535a
/*              apply reflection to A(i+1:m,ku+i:n) from the r
kusano 7d535a
ight */
kusano 7d535a
kusano 7d535a
		i__2 = *n - *ku - i + 1;
kusano 7d535a
		zlacgv_(&i__2, &a[i + (*ku + i) * a_dim1], lda);
kusano 7d535a
		i__2 = *m - i;
kusano 7d535a
		i__3 = *n - *ku - i + 1;
kusano 7d535a
		zgemv_("No transpose", &i__2, &i__3, &c_b2, &a[i + 1 + (*ku + 
kusano 7d535a
			i) * a_dim1], lda, &a[i + (*ku + i) * a_dim1], lda, &
kusano 7d535a
			c_b1, &work[1], &c__1);
kusano 7d535a
		i__2 = *m - i;
kusano 7d535a
		i__3 = *n - *ku - i + 1;
kusano 7d535a
		z__1.r = -tau.r, z__1.i = -tau.i;
kusano 7d535a
		zgerc_(&i__2, &i__3, &z__1, &work[1], &c__1, &a[i + (*ku + i) 
kusano 7d535a
			* a_dim1], lda, &a[i + 1 + (*ku + i) * a_dim1], lda);
kusano 7d535a
		i__2 = i + (*ku + i) * a_dim1;
kusano 7d535a
		z__1.r = -wa.r, z__1.i = -wa.i;
kusano 7d535a
		a[i__2].r = z__1.r, a[i__2].i = z__1.i;
kusano 7d535a
	    }
kusano 7d535a
kusano 7d535a
/* Computing MIN */
kusano 7d535a
	    i__2 = *m - 1 - *kl;
kusano 7d535a
	    if (i <= min(i__2,*n)) {
kusano 7d535a
kusano 7d535a
/*              generate reflection to annihilate A(kl+i+1:m,i
kusano 7d535a
) */
kusano 7d535a
kusano 7d535a
		i__2 = *m - *kl - i + 1;
kusano 7d535a
		wn = dznrm2_(&i__2, &a[*kl + i + i * a_dim1], &c__1);
kusano 7d535a
		d__1 = wn / z_abs(&a[*kl + i + i * a_dim1]);
kusano 7d535a
		i__2 = *kl + i + i * a_dim1;
kusano 7d535a
		z__1.r = d__1 * a[i__2].r, z__1.i = d__1 * a[i__2].i;
kusano 7d535a
		wa.r = z__1.r, wa.i = z__1.i;
kusano 7d535a
		if (wn == 0.) {
kusano 7d535a
		    tau.r = 0., tau.i = 0.;
kusano 7d535a
		} else {
kusano 7d535a
		    i__2 = *kl + i + i * a_dim1;
kusano 7d535a
		    z__1.r = a[i__2].r + wa.r, z__1.i = a[i__2].i + wa.i;
kusano 7d535a
		    wb.r = z__1.r, wb.i = z__1.i;
kusano 7d535a
		    i__2 = *m - *kl - i;
kusano 7d535a
		    z_div(&z__1, &c_b2, &wb);
kusano 7d535a
		    zscal_(&i__2, &z__1, &a[*kl + i + 1 + i * a_dim1], &c__1);
kusano 7d535a
		    i__2 = *kl + i + i * a_dim1;
kusano 7d535a
		    a[i__2].r = 1., a[i__2].i = 0.;
kusano 7d535a
		    z_div(&z__1, &wb, &wa);
kusano 7d535a
		    d__1 = z__1.r;
kusano 7d535a
		    tau.r = d__1, tau.i = 0.;
kusano 7d535a
		}
kusano 7d535a
kusano 7d535a
/*              apply reflection to A(kl+i:m,i+1:n) from the l
kusano 7d535a
eft */
kusano 7d535a
kusano 7d535a
		i__2 = *m - *kl - i + 1;
kusano 7d535a
		i__3 = *n - i;
kusano 7d535a
		zgemv_("Conjugate transpose", &i__2, &i__3, &c_b2, &a[*kl + i 
kusano 7d535a
			+ (i + 1) * a_dim1], lda, &a[*kl + i + i * a_dim1], &
kusano 7d535a
			c__1, &c_b1, &work[1], &c__1);
kusano 7d535a
		i__2 = *m - *kl - i + 1;
kusano 7d535a
		i__3 = *n - i;
kusano 7d535a
		z__1.r = -tau.r, z__1.i = -tau.i;
kusano 7d535a
		zgerc_(&i__2, &i__3, &z__1, &a[*kl + i + i * a_dim1], &c__1, &
kusano 7d535a
			work[1], &c__1, &a[*kl + i + (i + 1) * a_dim1], lda);
kusano 7d535a
		i__2 = *kl + i + i * a_dim1;
kusano 7d535a
		z__1.r = -wa.r, z__1.i = -wa.i;
kusano 7d535a
		a[i__2].r = z__1.r, a[i__2].i = z__1.i;
kusano 7d535a
	    }
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
	i__2 = *m;
kusano 7d535a
	for (j = *kl + i + 1; j <= i__2; ++j) {
kusano 7d535a
	    i__3 = j + i * a_dim1;
kusano 7d535a
	    a[i__3].r = 0., a[i__3].i = 0.;
kusano 7d535a
/* L50: */
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
	i__2 = *n;
kusano 7d535a
	for (j = *ku + i + 1; j <= i__2; ++j) {
kusano 7d535a
	    i__3 = i + j * a_dim1;
kusano 7d535a
	    a[i__3].r = 0., a[i__3].i = 0.;
kusano 7d535a
/* L60: */
kusano 7d535a
	}
kusano 7d535a
/* L70: */
kusano 7d535a
    }
kusano 7d535a
    return 0;
kusano 7d535a
kusano 7d535a
/*     End of ZLAGGE */
kusano 7d535a
kusano 7d535a
} /* zlagge_ */
kusano 7d535a