/* Subroutine */ int zerrlq_(char *path, integer *nunit)
{
/* System generated locals */
integer i__1;
doublereal d__1, d__2;
doublecomplex z__1;
/* Builtin functions */
integer s_wsle(cilist *), e_wsle(void);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
doublecomplex a[4] /* was [2][2] */, b[2];
integer i__, j;
doublecomplex w[2], x[2], af[4] /* was [2][2] */;
integer info;
extern /* Subroutine */ int zgelq2_(integer *, integer *, doublecomplex *,
integer *, doublecomplex *, doublecomplex *, integer *), zungl2_(
integer *, integer *, integer *, doublecomplex *, integer *,
doublecomplex *, doublecomplex *, integer *), zunml2_(char *,
char *, integer *, integer *, integer *, doublecomplex *, integer
*, doublecomplex *, doublecomplex *, integer *, doublecomplex *,
integer *), alaesm_(char *, logical *, integer *), chkxer_(char *, integer *, integer *, logical *, logical
*), zgelqf_(integer *, integer *, doublecomplex *,
integer *, doublecomplex *, doublecomplex *, integer *, integer *)
, zgelqs_(integer *, integer *, integer *, doublecomplex *,
integer *, doublecomplex *, doublecomplex *, integer *,
doublecomplex *, integer *, integer *), zunglq_(integer *,
integer *, integer *, doublecomplex *, integer *, doublecomplex *,
doublecomplex *, integer *, integer *), zunmlq_(char *, char *,
integer *, integer *, integer *, doublecomplex *, integer *,
doublecomplex *, doublecomplex *, integer *, doublecomplex *,
integer *, integer *);
/* Fortran I/O blocks */
static cilist io___1 = { 0, 0, 0, 0, 0 };
/* -- LAPACK test routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* ZERRLQ tests the error exits for the COMPLEX*16 routines */
/* that use the LQ decomposition of a general matrix. */
/* Arguments */
/* ========= */
/* PATH (input) CHARACTER*3 */
/* The LAPACK path name for the routines to be tested. */
/* NUNIT (input) INTEGER */
/* The unit number for output. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. Local Arrays .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Scalars in Common .. */
/* .. */
/* .. Common blocks .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Executable Statements .. */
infoc_1.nout = *nunit;
io___1.ciunit = infoc_1.nout;
s_wsle(&io___1);
e_wsle();
/* Set the variables to innocuous values. */
for (j = 1; j <= 2; ++j) {
for (i__ = 1; i__ <= 2; ++i__) {
i__1 = i__ + (j << 1) - 3;
d__1 = 1. / (doublereal) (i__ + j);
d__2 = -1. / (doublereal) (i__ + j);
z__1.r = d__1, z__1.i = d__2;
a[i__1].r = z__1.r, a[i__1].i = z__1.i;
i__1 = i__ + (j << 1) - 3;
d__1 = 1. / (doublereal) (i__ + j);
d__2 = -1. / (doublereal) (i__ + j);
z__1.r = d__1, z__1.i = d__2;
af[i__1].r = z__1.r, af[i__1].i = z__1.i;
/* L10: */
}
i__1 = j - 1;
b[i__1].r = 0., b[i__1].i = 0.;
i__1 = j - 1;
w[i__1].r = 0., w[i__1].i = 0.;
i__1 = j - 1;
x[i__1].r = 0., x[i__1].i = 0.;
/* L20: */
}
infoc_1.ok = TRUE_;
/* Error exits for LQ factorization */
/* ZGELQF */
s_copy(srnamc_1.srnamt, "ZGELQF", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
zgelqf_(&c_n1, &c__0, a, &c__1, b, w, &c__1, &info);
chkxer_("ZGELQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zgelqf_(&c__0, &c_n1, a, &c__1, b, w, &c__1, &info);
chkxer_("ZGELQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
zgelqf_(&c__2, &c__1, a, &c__1, b, w, &c__2, &info);
chkxer_("ZGELQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
zgelqf_(&c__2, &c__1, a, &c__2, b, w, &c__1, &info);
chkxer_("ZGELQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZGELQ2 */
s_copy(srnamc_1.srnamt, "ZGELQ2", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
zgelq2_(&c_n1, &c__0, a, &c__1, b, w, &info);
chkxer_("ZGELQ2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zgelq2_(&c__0, &c_n1, a, &c__1, b, w, &info);
chkxer_("ZGELQ2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
zgelq2_(&c__2, &c__1, a, &c__1, b, w, &info);
chkxer_("ZGELQ2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZGELQS */
s_copy(srnamc_1.srnamt, "ZGELQS", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
zgelqs_(&c_n1, &c__0, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info);
chkxer_("ZGELQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zgelqs_(&c__0, &c_n1, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info);
chkxer_("ZGELQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zgelqs_(&c__2, &c__1, &c__0, a, &c__2, x, b, &c__1, w, &c__1, &info);
chkxer_("ZGELQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zgelqs_(&c__0, &c__0, &c_n1, a, &c__1, x, b, &c__1, w, &c__1, &info);
chkxer_("ZGELQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zgelqs_(&c__2, &c__2, &c__0, a, &c__1, x, b, &c__2, w, &c__1, &info);
chkxer_("ZGELQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
zgelqs_(&c__1, &c__2, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info);
chkxer_("ZGELQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
zgelqs_(&c__1, &c__1, &c__2, a, &c__1, x, b, &c__1, w, &c__1, &info);
chkxer_("ZGELQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZUNGLQ */
s_copy(srnamc_1.srnamt, "ZUNGLQ", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
zunglq_(&c_n1, &c__0, &c__0, a, &c__1, x, w, &c__1, &info);
chkxer_("ZUNGLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zunglq_(&c__0, &c_n1, &c__0, a, &c__1, x, w, &c__1, &info);
chkxer_("ZUNGLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zunglq_(&c__2, &c__1, &c__0, a, &c__2, x, w, &c__2, &info);
chkxer_("ZUNGLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zunglq_(&c__0, &c__0, &c_n1, a, &c__1, x, w, &c__1, &info);
chkxer_("ZUNGLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zunglq_(&c__1, &c__1, &c__2, a, &c__1, x, w, &c__1, &info);
chkxer_("ZUNGLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zunglq_(&c__2, &c__2, &c__0, a, &c__1, x, w, &c__2, &info);
chkxer_("ZUNGLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 8;
zunglq_(&c__2, &c__2, &c__0, a, &c__2, x, w, &c__1, &info);
chkxer_("ZUNGLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZUNGL2 */
s_copy(srnamc_1.srnamt, "ZUNGL2", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
zungl2_(&c_n1, &c__0, &c__0, a, &c__1, x, w, &info);
chkxer_("ZUNGL2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zungl2_(&c__0, &c_n1, &c__0, a, &c__1, x, w, &info);
chkxer_("ZUNGL2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zungl2_(&c__2, &c__1, &c__0, a, &c__2, x, w, &info);
chkxer_("ZUNGL2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zungl2_(&c__0, &c__0, &c_n1, a, &c__1, x, w, &info);
chkxer_("ZUNGL2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zungl2_(&c__1, &c__1, &c__2, a, &c__1, x, w, &info);
chkxer_("ZUNGL2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zungl2_(&c__2, &c__2, &c__0, a, &c__1, x, w, &info);
chkxer_("ZUNGL2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZUNMLQ */
s_copy(srnamc_1.srnamt, "ZUNMLQ", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
zunmlq_("/", "N", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, &
info);
chkxer_("ZUNMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zunmlq_("L", "/", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, &
info);
chkxer_("ZUNMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zunmlq_("L", "N", &c_n1, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, &
info);
chkxer_("ZUNMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
zunmlq_("L", "N", &c__0, &c_n1, &c__0, a, &c__1, x, af, &c__1, w, &c__1, &
info);
chkxer_("ZUNMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zunmlq_("L", "N", &c__0, &c__0, &c_n1, a, &c__1, x, af, &c__1, w, &c__1, &
info);
chkxer_("ZUNMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zunmlq_("L", "N", &c__0, &c__1, &c__1, a, &c__1, x, af, &c__1, w, &c__1, &
info);
chkxer_("ZUNMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zunmlq_("R", "N", &c__1, &c__0, &c__1, a, &c__1, x, af, &c__1, w, &c__1, &
info);
chkxer_("ZUNMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
zunmlq_("L", "N", &c__2, &c__0, &c__2, a, &c__1, x, af, &c__2, w, &c__1, &
info);
chkxer_("ZUNMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
zunmlq_("R", "N", &c__0, &c__2, &c__2, a, &c__1, x, af, &c__1, w, &c__1, &
info);
chkxer_("ZUNMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
zunmlq_("L", "N", &c__2, &c__1, &c__0, a, &c__2, x, af, &c__1, w, &c__1, &
info);
chkxer_("ZUNMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
zunmlq_("L", "N", &c__1, &c__2, &c__0, a, &c__1, x, af, &c__1, w, &c__1, &
info);
chkxer_("ZUNMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 12;
zunmlq_("R", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__2, w, &c__1, &
info);
chkxer_("ZUNMLQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* ZUNML2 */
s_copy(srnamc_1.srnamt, "ZUNML2", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
zunml2_("/", "N", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info);
chkxer_("ZUNML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zunml2_("L", "/", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info);
chkxer_("ZUNML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 3;
zunml2_("L", "N", &c_n1, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info);
chkxer_("ZUNML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
zunml2_("L", "N", &c__0, &c_n1, &c__0, a, &c__1, x, af, &c__1, w, &info);
chkxer_("ZUNML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zunml2_("L", "N", &c__0, &c__0, &c_n1, a, &c__1, x, af, &c__1, w, &info);
chkxer_("ZUNML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zunml2_("L", "N", &c__0, &c__1, &c__1, a, &c__1, x, af, &c__1, w, &info);
chkxer_("ZUNML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 5;
zunml2_("R", "N", &c__1, &c__0, &c__1, a, &c__1, x, af, &c__1, w, &info);
chkxer_("ZUNML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
zunml2_("L", "N", &c__2, &c__1, &c__2, a, &c__1, x, af, &c__2, w, &info);
chkxer_("ZUNML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
zunml2_("R", "N", &c__1, &c__2, &c__2, a, &c__1, x, af, &c__1, w, &info);
chkxer_("ZUNML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 10;
zunml2_("L", "N", &c__2, &c__1, &c__0, a, &c__2, x, af, &c__1, w, &info);
chkxer_("ZUNML2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* Print a summary line. */
alaesm_(path, &infoc_1.ok, &infoc_1.nout);
return 0;
/* End of ZERRLQ */
} /* zerrlq_ */
/* Subroutine */ int zunglq_(integer *m, integer *n, integer *k,
doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
work, integer *lwork, integer *info)
{
/* System generated locals */
integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
/* Local variables */
integer i__, j, l, ib, nb, ki, kk, nx, iws, nbmin, iinfo;
extern /* Subroutine */ int zungl2_(integer *, integer *, integer *,
doublecomplex *, integer *, doublecomplex *, doublecomplex *,
integer *), xerbla_(char *, integer *);
extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
integer *, integer *);
extern /* Subroutine */ int zlarfb_(char *, char *, char *, char *,
integer *, integer *, integer *, doublecomplex *, integer *,
doublecomplex *, integer *, doublecomplex *, integer *,
doublecomplex *, integer *);
integer ldwork;
extern /* Subroutine */ int zlarft_(char *, char *, integer *, integer *,
doublecomplex *, integer *, doublecomplex *, doublecomplex *,
integer *);
logical lquery;
integer lwkopt;
/* -- LAPACK routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* ZUNGLQ generates an M-by-N complex matrix Q with orthonormal rows, */
/* which is defined as the first M rows of a product of K elementary */
/* reflectors of order N */
/* Q = H(k)' . . . H(2)' H(1)' */
/* as returned by ZGELQF. */
/* Arguments */
/* ========= */
/* M (input) INTEGER */
/* The number of rows of the matrix Q. M >= 0. */
/* N (input) INTEGER */
/* The number of columns of the matrix Q. N >= M. */
/* K (input) INTEGER */
/* The number of elementary reflectors whose product defines the */
/* matrix Q. M >= K >= 0. */
/* A (input/output) COMPLEX*16 array, dimension (LDA,N) */
/* On entry, the i-th row must contain the vector which defines */
/* the elementary reflector H(i), for i = 1,2,...,k, as returned */
/* by ZGELQF in the first k rows of its array argument A. */
/* On exit, the M-by-N matrix Q. */
/* LDA (input) INTEGER */
/* The first dimension of the array A. LDA >= max(1,M). */
/* TAU (input) COMPLEX*16 array, dimension (K) */
/* TAU(i) must contain the scalar factor of the elementary */
/* reflector H(i), as returned by ZGELQF. */
/* WORK (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK)) */
/* On exit, if INFO = 0, WORK(1) returns the optimal LWORK. */
/* LWORK (input) INTEGER */
/* The dimension of the array WORK. LWORK >= max(1,M). */
/* For optimum performance LWORK >= M*NB, where NB is */
/* the optimal blocksize. */
/* If LWORK = -1, then a workspace query is assumed; the routine */
/* only calculates the optimal size of the WORK array, returns */
/* this value as the first entry of the WORK array, and no error */
/* message related to LWORK is issued by XERBLA. */
/* INFO (output) INTEGER */
/* = 0: successful exit; */
/* < 0: if INFO = -i, the i-th argument has an illegal value */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. Executable Statements .. */
/* Test the input arguments */
/* Parameter adjustments */
a_dim1 = *lda;
a_offset = 1 + a_dim1;
a -= a_offset;
--tau;
--work;
/* Function Body */
*info = 0;
nb = ilaenv_(&c__1, "ZUNGLQ", " ", m, n, k, &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);
xerbla_("ZUNGLQ", &i__1);
return 0;
} else if (lquery) {
return 0;
}
/* Quick return if possible */
if (*m <= 0) {
work[1].r = 1., work[1].i = 0.;
return 0;
}
nbmin = 2;
nx = 0;
iws = *m;
if (nb > 1 && nb < *k) {
/* Determine when to cross over from blocked to unblocked code. */
/* Computing MAX */
i__1 = 0, i__2 = ilaenv_(&c__3, "ZUNGLQ", " ", m, n, k, &c_n1);
nx = max(i__1,i__2);
if (nx < *k) {
/* Determine if workspace is large enough for blocked code. */
ldwork = *m;
iws = ldwork * nb;
if (*lwork < iws) {
/* Not enough workspace to use optimal NB: reduce NB and */
/* determine the minimum value of NB. */
nb = *lwork / ldwork;
/* Computing MAX */
i__1 = 2, i__2 = ilaenv_(&c__2, "ZUNGLQ", " ", m, n, k, &c_n1);
nbmin = max(i__1,i__2);
}
}
}
if (nb >= nbmin && nb < *k && nx < *k) {
/* Use blocked code after the last block. */
/* The first kk rows are handled by the block method. */
ki = (*k - nx - 1) / nb * nb;
/* Computing MIN */
i__1 = *k, i__2 = ki + nb;
kk = min(i__1,i__2);
/* Set A(kk+1:m,1:kk) to zero. */
i__1 = kk;
for (j = 1; j <= i__1; ++j) {
i__2 = *m;
for (i__ = kk + 1; i__ <= i__2; ++i__) {
i__3 = i__ + j * a_dim1;
a[i__3].r = 0., a[i__3].i = 0.;
/* L10: */
}
/* L20: */
}
} else {
kk = 0;
}
/* Use unblocked code for the last or only block. */
if (kk < *m) {
i__1 = *m - kk;
i__2 = *n - kk;
i__3 = *k - kk;
zungl2_(&i__1, &i__2, &i__3, &a[kk + 1 + (kk + 1) * a_dim1], lda, &
tau[kk + 1], &work[1], &iinfo);
}
if (kk > 0) {
/* Use blocked code */
i__1 = -nb;
for (i__ = ki + 1; i__1 < 0 ? i__ >= 1 : i__ <= 1; i__ += i__1) {
/* Computing MIN */
i__2 = nb, i__3 = *k - i__ + 1;
ib = min(i__2,i__3);
if (i__ + ib <= *m) {
/* Form the triangular factor of the block reflector */
/* H = H(i) H(i+1) . . . H(i+ib-1) */
i__2 = *n - i__ + 1;
zlarft_("Forward", "Rowwise", &i__2, &ib, &a[i__ + i__ *
a_dim1], lda, &tau[i__], &work[1], &ldwork);
/* Apply H' to A(i+ib:m,i:n) from the right */
i__2 = *m - i__ - ib + 1;
i__3 = *n - i__ + 1;
zlarfb_("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);
}
/* Apply H' to columns i:n of current block */
i__2 = *n - i__ + 1;
zungl2_(&ib, &i__2, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &
work[1], &iinfo);
/* Set columns 1:i-1 of current block to zero */
i__2 = i__ - 1;
for (j = 1; j <= i__2; ++j) {
i__3 = i__ + ib - 1;
for (l = i__; l <= i__3; ++l) {
i__4 = l + j * a_dim1;
a[i__4].r = 0., a[i__4].i = 0.;
/* L30: */
}
/* L40: */
}
/* L50: */
}
}
work[1].r = (doublereal) iws, work[1].i = 0.;
return 0;
/* End of ZUNGLQ */
} /* zunglq_ */