136 SUBROUTINE sqlt02( M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK,
145 INTEGER k, lda, lwork, m, n
148 REAL a( lda, * ), af( lda, * ), l( lda, * ),
149 $ q( lda, * ), result( * ), rwork( * ), tau( * ),
157 parameter( zero = 0.0e+0, one = 1.0e+0 )
159 parameter( rogue = -1.0e+10 )
163 REAL anorm, eps, resid
179 COMMON / srnamc / srnamt
185 IF( m.EQ.0 .OR. n.EQ.0 .OR. k.EQ.0 )
THEN
195 CALL
slaset(
'Full', m, n, rogue, rogue, q, lda )
197 $ CALL
slacpy(
'Full', m-k, k, af( 1, n-k+1 ), lda,
198 $ q( 1, n-k+1 ), lda )
200 $ CALL
slacpy(
'Upper', k-1, k-1, af( m-k+1, n-k+2 ), lda,
201 $ q( m-k+1, n-k+2 ), lda )
206 CALL
sorgql( m, n, k, q, lda, tau( n-k+1 ), work, lwork, info )
210 CALL
slaset(
'Full', n, k, zero, zero, l( m-n+1, n-k+1 ), lda )
211 CALL
slacpy(
'Lower', k, k, af( m-k+1, n-k+1 ), lda,
212 $ l( m-k+1, n-k+1 ), lda )
216 CALL
sgemm(
'Transpose',
'No transpose', n, k, m, -one, q, lda,
217 $ a( 1, n-k+1 ), lda, one, l( m-n+1, n-k+1 ), lda )
221 anorm =
slange(
'1', m, k, a( 1, n-k+1 ), lda, rwork )
222 resid =
slange(
'1', n, k, l( m-n+1, n-k+1 ), lda, rwork )
223 IF( anorm.GT.zero )
THEN
224 result( 1 ) = ( ( resid /
REAL( MAX( 1, M ) ) ) / anorm ) / eps
231 CALL
slaset(
'Full', n, n, zero, one, l, lda )
232 CALL
ssyrk(
'Upper',
'Transpose', n, m, -one, q, lda, one, l,
237 resid =
slansy(
'1',
'Upper', n, l, lda, rwork )
239 result( 2 ) = ( resid /
REAL( MAX( 1, M ) ) ) / 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 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 sorgql(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
SORGQL
subroutine sqlt02(M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
SQLT02