/* Subroutine */ int cgelqf_(integer *m, integer *n, complex *a, integer *lda,
complex *tau, complex *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__, k, ib, nb, nx, iws, nbmin, iinfo;
extern /* Subroutine */ int cgelq2_(integer *, integer *, complex *,
integer *, complex *, complex *, integer *), clarfb_(char *, char
*, char *, char *, integer *, integer *, integer *, complex *,
integer *, complex *, integer *, complex *, integer *, complex *,
integer *), clarft_(char *, char *
, integer *, integer *, complex *, integer *, complex *, complex *
, integer *), xerbla_(char *, integer *);
extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
integer *, integer *);
integer ldwork, lwkopt;
logical lquery;
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* CGELQF computes an LQ factorization of a complex M-by-N matrix A: */
/* A = L * Q. */
/* Arguments */
/* ========= */
/* M (input) INTEGER */
/* The number of rows of the matrix A. M >= 0. */
/* N (input) INTEGER */
/* The number of columns of the matrix A. N >= 0. */
/* A (input/output) COMPLEX array, dimension (LDA,N) */
/* On entry, the M-by-N matrix A. */
/* On exit, the elements on and below the diagonal of the array */
/* contain the m-by-min(m,n) lower trapezoidal matrix L (L is */
/* lower triangular if m <= n); the elements above the diagonal, */
/* with the array TAU, represent the unitary matrix Q as a */
/* product of elementary reflectors (see Further Details). */
/* LDA (input) INTEGER */
/* The leading dimension of the array A. LDA >= max(1,M). */
/* TAU (output) COMPLEX array, dimension (min(M,N)) */
/* The scalar factors of the elementary reflectors (see Further */
/* Details). */
/* WORK (workspace/output) COMPLEX 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 had an illegal value */
/* Further Details */
/* =============== */
/* The matrix Q is represented as a product of elementary reflectors */
/* Q = H(k)' . . . H(2)' H(1)', where k = min(m,n). */
/* Each H(i) has the form */
/* H(i) = I - tau * v * v' */
/* where tau is a complex scalar, and v is a complex vector with */
/* v(1:i-1) = 0 and v(i) = 1; conjg(v(i+1:n)) is stored on exit in */
/* A(i,i+1:n), and tau in TAU(i). */
/* ===================================================================== */
/* .. 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, "CGELQF", " ", m, n, &c_n1, &c_n1);
lwkopt = *m * nb;
work[1].r = (real) lwkopt, work[1].i = 0.f;
lquery = *lwork == -1;
if (*m < 0) {
*info = -1;
} else if (*n < 0) {
*info = -2;
} else if (*lda < max(1,*m)) {
*info = -4;
} else if (*lwork < max(1,*m) && ! lquery) {
*info = -7;
}
if (*info != 0) {
i__1 = -(*info);
xerbla_("CGELQF", &i__1);
return 0;
} else if (lquery) {
return 0;
}
/* Quick return if possible */
k = min(*m,*n);
if (k == 0) {
work[1].r = 1.f, work[1].i = 0.f;
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, "CGELQF", " ", m, n, &c_n1, &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, "CGELQF", " ", m, n, &c_n1, &
c_n1);
nbmin = max(i__1,i__2);
}
}
}
if (nb >= nbmin && nb < k && nx < k) {
/* Use blocked code initially */
i__1 = k - nx;
i__2 = nb;
for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
/* Computing MIN */
i__3 = k - i__ + 1;
ib = min(i__3,nb);
/* Compute the LQ factorization of the current block */
/* A(i:i+ib-1,i:n) */
i__3 = *n - i__ + 1;
cgelq2_(&ib, &i__3, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[
1], &iinfo);
if (i__ + ib <= *m) {
/* Form the triangular factor of the block reflector */
/* H = H(i) H(i+1) . . . H(i+ib-1) */
i__3 = *n - i__ + 1;
clarft_("Forward", "Rowwise", &i__3, &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__3 = *m - i__ - ib + 1;
i__4 = *n - i__ + 1;
clarfb_("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);
}
/* L10: */
}
} else {
i__ = 1;
}
/* Use unblocked code to factor the last or only block. */
if (i__ <= k) {
i__2 = *m - i__ + 1;
i__1 = *n - i__ + 1;
cgelq2_(&i__2, &i__1, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[1]
, &iinfo);
}
work[1].r = (real) iws, work[1].i = 0.f;
return 0;
/* End of CGELQF */
} /* cgelqf_ */
/* Subroutine */
int cgelqf_(integer *m, integer *n, complex *a, integer *lda, complex *tau, complex *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__, k, ib, nb, nx, iws, nbmin, iinfo;
extern /* Subroutine */
int cgelq2_(integer *, integer *, complex *, integer *, complex *, complex *, integer *), clarfb_(char *, char *, char *, char *, integer *, integer *, integer *, complex *, integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_(char *, char * , integer *, integer *, complex *, integer *, complex *, complex * , integer *), xerbla_(char *, integer *);
extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *);
integer ldwork, lwkopt;
logical lquery;
/* -- LAPACK computational routine (version 3.4.0) -- */
/* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
/* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
/* November 2011 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* ===================================================================== */
/* .. 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, "CGELQF", " ", m, n, &c_n1, &c_n1);
lwkopt = *m * nb;
work[1].r = (real) lwkopt;
work[1].i = 0.f; // , expr subst
lquery = *lwork == -1;
if (*m < 0)
{
*info = -1;
}
else if (*n < 0)
{
*info = -2;
}
else if (*lda < max(1,*m))
{
*info = -4;
}
else if (*lwork < max(1,*m) && ! lquery)
{
*info = -7;
}
if (*info != 0)
{
i__1 = -(*info);
xerbla_("CGELQF", &i__1);
return 0;
}
else if (lquery)
{
return 0;
}
/* Quick return if possible */
k = min(*m,*n);
if (k == 0)
{
work[1].r = 1.f;
work[1].i = 0.f; // , expr subst
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, "CGELQF", " ", m, n, &c_n1, &c_n1); // , expr subst
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, "CGELQF", " ", m, n, &c_n1, & c_n1); // , expr subst
nbmin = max(i__1,i__2);
}
}
}
if (nb >= nbmin && nb < k && nx < k)
{
/* Use blocked code initially */
i__1 = k - nx;
i__2 = nb;
for (i__ = 1;
i__2 < 0 ? i__ >= i__1 : i__ <= i__1;
i__ += i__2)
{
/* Computing MIN */
i__3 = k - i__ + 1;
ib = min(i__3,nb);
/* Compute the LQ factorization of the current block */
/* A(i:i+ib-1,i:n) */
i__3 = *n - i__ + 1;
cgelq2_(&ib, &i__3, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[ 1], &iinfo);
if (i__ + ib <= *m)
{
/* Form the triangular factor of the block reflector */
/* H = H(i) H(i+1) . . . H(i+ib-1) */
i__3 = *n - i__ + 1;
clarft_("Forward", "Rowwise", &i__3, &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__3 = *m - i__ - ib + 1;
i__4 = *n - i__ + 1;
clarfb_("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);
}
/* L10: */
}
}
else
{
i__ = 1;
}
/* Use unblocked code to factor the last or only block. */
if (i__ <= k)
{
i__2 = *m - i__ + 1;
i__1 = *n - i__ + 1;
cgelq2_(&i__2, &i__1, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[1] , &iinfo);
}
work[1].r = (real) iws;
work[1].i = 0.f; // , expr subst
return 0;
/* End of CGELQF */
}
