/* Subroutine */ int sorgtr_(char *uplo, integer *n, real *a, integer *lda,
real *tau, real *work, integer *lwork, integer *info)
{
/* -- LAPACK routine (version 2.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
September 30, 1994
Purpose
=======
SORGTR generates a real orthogonal matrix Q which is defined as the
product of n-1 elementary reflectors of order N, as returned by
SSYTRD:
if UPLO = 'U', Q = H(n-1) . . . H(2) H(1),
if UPLO = 'L', Q = H(1) H(2) . . . H(n-1).
Arguments
=========
UPLO (input) CHARACTER*1
= 'U': Upper triangle of A contains elementary reflectors
from SSYTRD;
= 'L': Lower triangle of A contains elementary reflectors
from SSYTRD.
N (input) INTEGER
The order of the matrix Q. N >= 0.
A (input/output) REAL array, dimension (LDA,N)
On entry, the vectors which define the elementary reflectors,
as returned by SSYTRD.
On exit, the N-by-N orthogonal matrix Q.
LDA (input) INTEGER
The leading dimension of the array A. LDA >= max(1,N).
TAU (input) REAL array, dimension (N-1)
TAU(i) must contain the scalar factor of the elementary
reflector H(i), as returned by SSYTRD.
WORK (workspace/output) REAL array, dimension (LWORK)
On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
LWORK (input) INTEGER
The dimension of the array WORK. LWORK >= max(1,N-1).
For optimum performance LWORK >= (N-1)*NB, where NB is
the optimal blocksize.
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value
=====================================================================
Test the input arguments
Parameter adjustments
Function Body */
/* System generated locals */
integer a_dim1, a_offset, i__1, i__2, i__3;
/* Local variables */
static integer i, j;
extern logical lsame_(char *, char *);
static integer iinfo;
static logical upper;
extern /* Subroutine */ int xerbla_(char *, integer *), sorgql_(
integer *, integer *, integer *, real *, integer *, real *, real *
, integer *, integer *), sorgqr_(integer *, integer *, integer *,
real *, integer *, real *, real *, integer *, integer *);
#define TAU(I) tau[(I)-1]
#define WORK(I) work[(I)-1]
#define A(I,J) a[(I)-1 + ((J)-1)* ( *lda)]
*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;
} else /* if(complicated condition) */ {
/* Computing MAX */
i__1 = 1, i__2 = *n - 1;
if (*lwork < max(i__1,i__2)) {
*info = -7;
}
}
if (*info != 0) {
i__1 = -(*info);
xerbla_("SORGTR", &i__1);
return 0;
}
/* Quick return if possible */
if (*n == 0) {
WORK(1) = 1.f;
return 0;
}
if (upper) {
/* Q was determined by a call to SSYTRD with UPLO = 'U'
Shift the vectors which define the elementary reflectors one
column to the left, and set the last row and column of Q to
those of the unit matrix */
i__1 = *n - 1;
for (j = 1; j <= *n-1; ++j) {
i__2 = j - 1;
for (i = 1; i <= j-1; ++i) {
A(i,j) = A(i,j+1);
/* L10: */
}
A(*n,j) = 0.f;
/* L20: */
}
i__1 = *n - 1;
for (i = 1; i <= *n-1; ++i) {
A(i,*n) = 0.f;
/* L30: */
}
A(*n,*n) = 1.f;
/* Generate Q(1:n-1,1:n-1) */
i__1 = *n - 1;
i__2 = *n - 1;
i__3 = *n - 1;
sorgql_(&i__1, &i__2, &i__3, &A(1,1), lda, &TAU(1), &WORK(1),
lwork, &iinfo);
} else {
/* Q was determined by a call to SSYTRD with UPLO = 'L'.
Shift the vectors which define the elementary reflectors one
column to the right, and set the first row and column of Q t
o
those of the unit matrix */
for (j = *n; j >= 2; --j) {
A(1,j) = 0.f;
i__1 = *n;
for (i = j + 1; i <= *n; ++i) {
A(i,j) = A(i,j-1);
/* L40: */
}
/* L50: */
}
A(1,1) = 1.f;
i__1 = *n;
for (i = 2; i <= *n; ++i) {
A(i,1) = 0.f;
/* L60: */
}
if (*n > 1) {
/* Generate Q(2:n,2:n) */
i__1 = *n - 1;
i__2 = *n - 1;
i__3 = *n - 1;
sorgqr_(&i__1, &i__2, &i__3, &A(2,2), lda, &TAU(1),
&WORK(1), lwork, &iinfo);
}
}
return 0;
/* End of SORGTR */
} /* sorgtr_ */
/* Subroutine */ int sorgtr_(char *uplo, integer *n, real *a, integer *lda,
real *tau, real *work, integer *lwork, integer *info)
{
/* -- LAPACK routine (version 3.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
June 30, 1999
Purpose
=======
SORGTR generates a real orthogonal matrix Q which is defined as the
product of n-1 elementary reflectors of order N, as returned by
SSYTRD:
if UPLO = 'U', Q = H(n-1) . . . H(2) H(1),
if UPLO = 'L', Q = H(1) H(2) . . . H(n-1).
Arguments
=========
UPLO (input) CHARACTER*1
= 'U': Upper triangle of A contains elementary reflectors
from SSYTRD;
= 'L': Lower triangle of A contains elementary reflectors
from SSYTRD.
N (input) INTEGER
The order of the matrix Q. N >= 0.
A (input/output) REAL array, dimension (LDA,N)
On entry, the vectors which define the elementary reflectors,
as returned by SSYTRD.
On exit, the N-by-N orthogonal matrix Q.
LDA (input) INTEGER
The leading dimension of the array A. LDA >= max(1,N).
TAU (input) REAL array, dimension (N-1)
TAU(i) must contain the scalar factor of the elementary
reflector H(i), as returned by SSYTRD.
WORK (workspace/output) REAL array, dimension (LWORK)
On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
LWORK (input) INTEGER
The dimension of the array WORK. LWORK >= max(1,N-1).
For optimum performance LWORK >= (N-1)*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
=====================================================================
Test the input arguments
Parameter adjustments */
/* Table of constant values */
static integer c__1 = 1;
static integer c_n1 = -1;
/* System generated locals */
integer a_dim1, a_offset, i__1, i__2, i__3;
/* Local variables */
static integer i__, j;
extern logical lsame_(char *, char *);
static integer iinfo;
static logical upper;
static integer nb;
extern /* Subroutine */ int xerbla_(char *, integer *);
extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
integer *, integer *, ftnlen, ftnlen);
extern /* Subroutine */ int sorgql_(integer *, integer *, integer *, real
*, integer *, real *, real *, integer *, integer *), sorgqr_(
integer *, integer *, integer *, real *, integer *, real *, real *
, integer *, integer *);
static logical lquery;
static integer lwkopt;
#define a_ref(a_1,a_2) a[(a_2)*a_dim1 + a_1]
a_dim1 = *lda;
a_offset = 1 + a_dim1 * 1;
a -= a_offset;
--tau;
--work;
/* Function Body */
*info = 0;
lquery = *lwork == -1;
upper = lsame_(uplo, "U");
if (! upper && ! lsame_(uplo, "L")) {
*info = -1;
} else if (*n < 0) {
*info = -2;
} else if (*lda < max(1,*n)) {
*info = -4;
} else /* if(complicated condition) */ {
/* Computing MAX */
i__1 = 1, i__2 = *n - 1;
if (*lwork < max(i__1,i__2) && ! lquery) {
*info = -7;
}
}
if (*info == 0) {
if (upper) {
i__1 = *n - 1;
i__2 = *n - 1;
i__3 = *n - 1;
nb = ilaenv_(&c__1, "SORGQL", " ", &i__1, &i__2, &i__3, &c_n1, (
ftnlen)6, (ftnlen)1);
} else {
i__1 = *n - 1;
i__2 = *n - 1;
i__3 = *n - 1;
nb = ilaenv_(&c__1, "SORGQR", " ", &i__1, &i__2, &i__3, &c_n1, (
ftnlen)6, (ftnlen)1);
}
/* Computing MAX */
i__1 = 1, i__2 = *n - 1;
lwkopt = max(i__1,i__2) * nb;
work[1] = (real) lwkopt;
}
if (*info != 0) {
i__1 = -(*info);
xerbla_("SORGTR", &i__1);
return 0;
} else if (lquery) {
return 0;
}
/* Quick return if possible */
if (*n == 0) {
work[1] = 1.f;
return 0;
}
if (upper) {
/* Q was determined by a call to SSYTRD with UPLO = 'U'
Shift the vectors which define the elementary reflectors one
column to the left, and set the last row and column of Q to
those of the unit matrix */
i__1 = *n - 1;
for (j = 1; j <= i__1; ++j) {
i__2 = j - 1;
for (i__ = 1; i__ <= i__2; ++i__) {
a_ref(i__, j) = a_ref(i__, j + 1);
/* L10: */
}
a_ref(*n, j) = 0.f;
/* L20: */
}
i__1 = *n - 1;
for (i__ = 1; i__ <= i__1; ++i__) {
a_ref(i__, *n) = 0.f;
/* L30: */
}
a_ref(*n, *n) = 1.f;
/* Generate Q(1:n-1,1:n-1) */
i__1 = *n - 1;
i__2 = *n - 1;
i__3 = *n - 1;
sorgql_(&i__1, &i__2, &i__3, &a[a_offset], lda, &tau[1], &work[1],
lwork, &iinfo);
} else {
/* Q was determined by a call to SSYTRD with UPLO = 'L'.
Shift the vectors which define the elementary reflectors one
column to the right, and set the first row and column of Q to
those of the unit matrix */
for (j = *n; j >= 2; --j) {
a_ref(1, j) = 0.f;
i__1 = *n;
for (i__ = j + 1; i__ <= i__1; ++i__) {
a_ref(i__, j) = a_ref(i__, j - 1);
/* L40: */
}
/* L50: */
}
a_ref(1, 1) = 1.f;
i__1 = *n;
for (i__ = 2; i__ <= i__1; ++i__) {
a_ref(i__, 1) = 0.f;
/* L60: */
}
if (*n > 1) {
/* Generate Q(2:n,2:n) */
i__1 = *n - 1;
i__2 = *n - 1;
i__3 = *n - 1;
sorgqr_(&i__1, &i__2, &i__3, &a_ref(2, 2), lda, &tau[1], &work[1],
lwork, &iinfo);
}
}
work[1] = (real) lwkopt;
return 0;
/* End of SORGTR */
} /* sorgtr_ */
/* Subroutine */ int sorgtr_(char *uplo, integer *n, real *a, integer *lda,
real *tau, real *work, integer *lwork, integer *info)
{
/* System generated locals */
integer a_dim1, a_offset, i__1, i__2, i__3;
/* Local variables */
integer i__, j, nb;
extern logical lsame_(char *, char *);
integer iinfo;
logical upper;
extern /* Subroutine */ int xerbla_(char *, integer *);
extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
integer *, integer *);
extern /* Subroutine */ int sorgql_(integer *, integer *, integer *, real
*, integer *, real *, real *, integer *, integer *), sorgqr_(
integer *, integer *, integer *, real *, integer *, real *, real *
, integer *, integer *);
logical lquery;
integer lwkopt;
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* SORGTR generates a real orthogonal matrix Q which is defined as the */
/* product of n-1 elementary reflectors of order N, as returned by */
/* SSYTRD: */
/* if UPLO = 'U', Q = H(n-1) . . . H(2) H(1), */
/* if UPLO = 'L', Q = H(1) H(2) . . . H(n-1). */
/* Arguments */
/* ========= */
/* UPLO (input) CHARACTER*1 */
/* = 'U': Upper triangle of A contains elementary reflectors */
/* from SSYTRD; */
/* = 'L': Lower triangle of A contains elementary reflectors */
/* from SSYTRD. */
/* N (input) INTEGER */
/* The order of the matrix Q. N >= 0. */
/* A (input/output) REAL array, dimension (LDA,N) */
/* On entry, the vectors which define the elementary reflectors, */
/* as returned by SSYTRD. */
/* On exit, the N-by-N orthogonal matrix Q. */
/* LDA (input) INTEGER */
/* The leading dimension of the array A. LDA >= max(1,N). */
/* TAU (input) REAL array, dimension (N-1) */
/* TAU(i) must contain the scalar factor of the elementary */
/* reflector H(i), as returned by SSYTRD. */
/* WORK (workspace/output) REAL 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,N-1). */
/* For optimum performance LWORK >= (N-1)*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 */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Intrinsic 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;
lquery = *lwork == -1;
upper = lsame_(uplo, "U");
if (! upper && ! lsame_(uplo, "L")) {
*info = -1;
} else if (*n < 0) {
*info = -2;
} else if (*lda < max(1,*n)) {
*info = -4;
} else /* if(complicated condition) */ {
/* Computing MAX */
i__1 = 1, i__2 = *n - 1;
if (*lwork < max(i__1,i__2) && ! lquery) {
*info = -7;
}
}
if (*info == 0) {
if (upper) {
i__1 = *n - 1;
i__2 = *n - 1;
i__3 = *n - 1;
nb = ilaenv_(&c__1, "SORGQL", " ", &i__1, &i__2, &i__3, &c_n1);
} else {
i__1 = *n - 1;
i__2 = *n - 1;
i__3 = *n - 1;
nb = ilaenv_(&c__1, "SORGQR", " ", &i__1, &i__2, &i__3, &c_n1);
}
/* Computing MAX */
i__1 = 1, i__2 = *n - 1;
lwkopt = max(i__1,i__2) * nb;
work[1] = (real) lwkopt;
}
if (*info != 0) {
i__1 = -(*info);
xerbla_("SORGTR", &i__1);
return 0;
} else if (lquery) {
return 0;
}
/* Quick return if possible */
if (*n == 0) {
work[1] = 1.f;
return 0;
}
if (upper) {
/* Q was determined by a call to SSYTRD with UPLO = 'U' */
/* Shift the vectors which define the elementary reflectors one */
/* column to the left, and set the last row and column of Q to */
/* those of the unit matrix */
i__1 = *n - 1;
for (j = 1; j <= i__1; ++j) {
i__2 = j - 1;
for (i__ = 1; i__ <= i__2; ++i__) {
a[i__ + j * a_dim1] = a[i__ + (j + 1) * a_dim1];
/* L10: */
}
a[*n + j * a_dim1] = 0.f;
/* L20: */
}
i__1 = *n - 1;
for (i__ = 1; i__ <= i__1; ++i__) {
a[i__ + *n * a_dim1] = 0.f;
/* L30: */
}
a[*n + *n * a_dim1] = 1.f;
/* Generate Q(1:n-1,1:n-1) */
i__1 = *n - 1;
i__2 = *n - 1;
i__3 = *n - 1;
sorgql_(&i__1, &i__2, &i__3, &a[a_offset], lda, &tau[1], &work[1],
lwork, &iinfo);
} else {
/* Q was determined by a call to SSYTRD with UPLO = 'L'. */
/* Shift the vectors which define the elementary reflectors one */
/* column to the right, and set the first row and column of Q to */
/* those of the unit matrix */
for (j = *n; j >= 2; --j) {
a[j * a_dim1 + 1] = 0.f;
i__1 = *n;
for (i__ = j + 1; i__ <= i__1; ++i__) {
a[i__ + j * a_dim1] = a[i__ + (j - 1) * a_dim1];
/* L40: */
}
/* L50: */
}
a[a_dim1 + 1] = 1.f;
i__1 = *n;
for (i__ = 2; i__ <= i__1; ++i__) {
a[i__ + a_dim1] = 0.f;
/* L60: */
}
if (*n > 1) {
/* Generate Q(2:n,2:n) */
i__1 = *n - 1;
i__2 = *n - 1;
i__3 = *n - 1;
sorgqr_(&i__1, &i__2, &i__3, &a[(a_dim1 << 1) + 2], lda, &tau[1],
&work[1], lwork, &iinfo);
}
}
work[1] = (real) lwkopt;
return 0;
/* End of SORGTR */
} /* sorgtr_ */
/* Subroutine */ int sqlt02_(integer *m, integer *n, integer *k, real *a,
real *af, real *q, real *l, integer *lda, real *tau, real *work,
integer *lwork, real *rwork, real *result)
{
/* System generated locals */
integer a_dim1, a_offset, af_dim1, af_offset, l_dim1, l_offset, q_dim1,
q_offset, i__1, i__2;
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
real eps;
integer info;
real resid;
extern /* Subroutine */ int sgemm_(char *, char *, integer *, integer *,
integer *, real *, real *, integer *, real *, integer *, real *,
real *, integer *);
real anorm;
extern /* Subroutine */ int ssyrk_(char *, char *, integer *, integer *,
real *, real *, integer *, real *, real *, integer *);
extern doublereal slamch_(char *), slange_(char *, integer *,
integer *, real *, integer *, real *);
extern /* Subroutine */ int slacpy_(char *, integer *, integer *, real *,
integer *, real *, integer *), slaset_(char *, integer *,
integer *, real *, real *, real *, integer *), sorgql_(
integer *, integer *, integer *, real *, integer *, real *, real *
, integer *, integer *);
extern doublereal slansy_(char *, char *, integer *, real *, integer *,
real *);
/* -- LAPACK test routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* SQLT02 tests SORGQL, which generates an m-by-n matrix Q with */
/* orthonornmal columns that is defined as the product of k elementary */
/* reflectors. */
/* Given the QL factorization of an m-by-n matrix A, SQLT02 generates */
/* the orthogonal matrix Q defined by the factorization of the last k */
/* columns of A; it compares L(m-n+1:m,n-k+1:n) with */
/* Q(1:m,m-n+1:m)'*A(1:m,n-k+1:n), and checks that the columns of Q are */
/* orthonormal. */
/* Arguments */
/* ========= */
/* M (input) INTEGER */
/* The number of rows of the matrix Q to be generated. M >= 0. */
/* N (input) INTEGER */
/* The number of columns of the matrix Q to be generated. */
/* M >= N >= 0. */
/* K (input) INTEGER */
/* The number of elementary reflectors whose product defines the */
/* matrix Q. N >= K >= 0. */
/* A (input) REAL array, dimension (LDA,N) */
/* The m-by-n matrix A which was factorized by SQLT01. */
/* AF (input) REAL array, dimension (LDA,N) */
/* Details of the QL factorization of A, as returned by SGEQLF. */
/* See SGEQLF for further details. */
/* Q (workspace) REAL array, dimension (LDA,N) */
/* L (workspace) REAL array, dimension (LDA,N) */
/* LDA (input) INTEGER */
/* The leading dimension of the arrays A, AF, Q and L. LDA >= M. */
/* TAU (input) REAL array, dimension (N) */
/* The scalar factors of the elementary reflectors corresponding */
/* to the QL factorization in AF. */
/* WORK (workspace) REAL array, dimension (LWORK) */
/* LWORK (input) INTEGER */
/* The dimension of the array WORK. */
/* RWORK (workspace) REAL array, dimension (M) */
/* RESULT (output) REAL array, dimension (2) */
/* The test ratios: */
/* RESULT(1) = norm( L - Q'*A ) / ( M * norm(A) * EPS ) */
/* RESULT(2) = norm( I - Q'*Q ) / ( M * EPS ) */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Scalars in Common .. */
/* .. */
/* .. Common blocks .. */
/* .. */
/* .. Executable Statements .. */
/* Quick return if possible */
/* Parameter adjustments */
l_dim1 = *lda;
l_offset = 1 + l_dim1;
l -= l_offset;
q_dim1 = *lda;
q_offset = 1 + q_dim1;
q -= q_offset;
af_dim1 = *lda;
af_offset = 1 + af_dim1;
af -= af_offset;
a_dim1 = *lda;
a_offset = 1 + a_dim1;
a -= a_offset;
--tau;
--work;
--rwork;
--result;
/* Function Body */
if (*m == 0 || *n == 0 || *k == 0) {
result[1] = 0.f;
result[2] = 0.f;
return 0;
}
eps = slamch_("Epsilon");
/* Copy the last k columns of the factorization to the array Q */
slaset_("Full", m, n, &c_b4, &c_b4, &q[q_offset], lda);
if (*k < *m) {
i__1 = *m - *k;
slacpy_("Full", &i__1, k, &af[(*n - *k + 1) * af_dim1 + 1], lda, &q[(*
n - *k + 1) * q_dim1 + 1], lda);
}
if (*k > 1) {
i__1 = *k - 1;
i__2 = *k - 1;
slacpy_("Upper", &i__1, &i__2, &af[*m - *k + 1 + (*n - *k + 2) *
af_dim1], lda, &q[*m - *k + 1 + (*n - *k + 2) * q_dim1], lda);
}
/* Generate the last n columns of the matrix Q */
s_copy(srnamc_1.srnamt, "SORGQL", (ftnlen)6, (ftnlen)6);
sorgql_(m, n, k, &q[q_offset], lda, &tau[*n - *k + 1], &work[1], lwork, &
info);
/* Copy L(m-n+1:m,n-k+1:n) */
slaset_("Full", n, k, &c_b10, &c_b10, &l[*m - *n + 1 + (*n - *k + 1) *
l_dim1], lda);
slacpy_("Lower", k, k, &af[*m - *k + 1 + (*n - *k + 1) * af_dim1], lda, &
l[*m - *k + 1 + (*n - *k + 1) * l_dim1], lda);
/* Compute L(m-n+1:m,n-k+1:n) - Q(1:m,m-n+1:m)' * A(1:m,n-k+1:n) */
sgemm_("Transpose", "No transpose", n, k, m, &c_b15, &q[q_offset], lda, &
a[(*n - *k + 1) * a_dim1 + 1], lda, &c_b16, &l[*m - *n + 1 + (*n
- *k + 1) * l_dim1], lda);
/* Compute norm( L - Q'*A ) / ( M * norm(A) * EPS ) . */
anorm = slange_("1", m, k, &a[(*n - *k + 1) * a_dim1 + 1], lda, &rwork[1]);
resid = slange_("1", n, k, &l[*m - *n + 1 + (*n - *k + 1) * l_dim1], lda,
&rwork[1]);
if (anorm > 0.f) {
result[1] = resid / (real) max(1,*m) / anorm / eps;
} else {
result[1] = 0.f;
}
/* Compute I - Q'*Q */
slaset_("Full", n, n, &c_b10, &c_b16, &l[l_offset], lda);
ssyrk_("Upper", "Transpose", n, m, &c_b15, &q[q_offset], lda, &c_b16, &l[
l_offset], lda);
/* Compute norm( I - Q'*Q ) / ( M * EPS ) . */
resid = slansy_("1", "Upper", n, &l[l_offset], lda, &rwork[1]);
result[2] = resid / (real) max(1,*m) / eps;
return 0;
/* End of SQLT02 */
} /* sqlt02_ */
