135 SUBROUTINE slqt02( M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK,
144 INTEGER k, lda, lwork, m, n
147 REAL a( lda, * ), af( lda, * ), l( lda, * ),
148 $ q( lda, * ), result( * ), rwork( * ), tau( * ),
156 parameter( zero = 0.0e+0, one = 1.0e+0 )
158 parameter( rogue = -1.0e+10 )
162 REAL anorm, eps, resid
178 COMMON / srnamc / srnamt
186 CALL
slaset(
'Full', m, n, rogue, rogue, q, lda )
187 CALL
slacpy(
'Upper', k, n-1, af( 1, 2 ), lda, q( 1, 2 ), lda )
192 CALL
sorglq( m, n, k, q, lda, tau, work, lwork, info )
196 CALL
slaset(
'Full', k, m, zero, zero, l, lda )
197 CALL
slacpy(
'Lower', k, m, af, lda, l, lda )
201 CALL
sgemm(
'No transpose',
'Transpose', k, m, n, -one, a, lda, q,
206 anorm =
slange(
'1', k, n, a, lda, rwork )
207 resid =
slange(
'1', k, m, l, lda, rwork )
208 IF( anorm.GT.zero )
THEN
209 result( 1 ) = ( ( resid /
REAL( MAX( 1, N ) ) ) / anorm ) / eps
216 CALL
slaset(
'Full', m, m, zero, one, l, lda )
217 CALL
ssyrk(
'Upper',
'No transpose', m, n, -one, q, lda, one, l,
222 resid =
slansy(
'1',
'Upper', m, l, lda, rwork )
224 result( 2 ) = ( resid /
REAL( MAX( 1, N ) ) ) / eps
subroutine slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
REAL function slansy(NORM, UPLO, N, A, LDA, WORK)
SLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric matrix.
REAL function slamch(CMACH)
SLAMCH
subroutine ssyrk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
SSYRK
subroutine slqt02(M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
SLQT02
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
REAL function slange(NORM, M, N, A, LDA, WORK)
SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM
subroutine sorglq(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
SORGLQ