136 SUBROUTINE drqt02( M, N, K, A, AF, Q, R, LDA, TAU, WORK, LWORK,
145 INTEGER k, lda, lwork, m, n
148 DOUBLE PRECISION a( lda, * ), af( lda, * ), q( lda, * ),
149 $ r( lda, * ), result( * ), rwork( * ), tau( * ),
156 DOUBLE PRECISION zero, one
157 parameter( zero = 0.0d+0, one = 1.0d+0 )
158 DOUBLE PRECISION rogue
159 parameter( rogue = -1.0d+10 )
163 DOUBLE PRECISION anorm, eps, resid
179 COMMON / srnamc / srnamt
185 IF( m.EQ.0 .OR. n.EQ.0 .OR. k.EQ.0 )
THEN
195 CALL
dlaset(
'Full', m, n, rogue, rogue, q, lda )
197 $ CALL
dlacpy(
'Full', k, n-k, af( m-k+1, 1 ), lda,
198 $ q( m-k+1, 1 ), lda )
200 $ CALL
dlacpy(
'Lower', k-1, k-1, af( m-k+2, n-k+1 ), lda,
201 $ q( m-k+2, n-k+1 ), lda )
206 CALL
dorgrq( m, n, k, q, lda, tau( m-k+1 ), work, lwork, info )
210 CALL
dlaset(
'Full', k, m, zero, zero, r( m-k+1, n-m+1 ), lda )
211 CALL
dlacpy(
'Upper', k, k, af( m-k+1, n-k+1 ), lda,
212 $ r( m-k+1, n-k+1 ), lda )
216 CALL
dgemm(
'No transpose',
'Transpose', k, m, n, -one,
217 $ a( m-k+1, 1 ), lda, q, lda, one, r( m-k+1, n-m+1 ),
222 anorm =
dlange(
'1', k, n, a( m-k+1, 1 ), lda, rwork )
223 resid =
dlange(
'1', k, m, r( m-k+1, n-m+1 ), lda, rwork )
224 IF( anorm.GT.zero )
THEN
225 result( 1 ) = ( ( resid / dble( max( 1, n ) ) ) / anorm ) / eps
232 CALL
dlaset(
'Full', m, m, zero, one, r, lda )
233 CALL
dsyrk(
'Upper',
'No transpose', m, n, -one, q, lda, one, r,
238 resid =
dlansy(
'1',
'Upper', m, r, lda, rwork )
240 result( 2 ) = ( resid / dble( max( 1, n ) ) ) / eps
DOUBLE PRECISION function dlansy(NORM, UPLO, N, A, LDA, WORK)
DLANSY 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.
subroutine dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
DGEMM
DOUBLE PRECISION function dlange(NORM, M, N, A, LDA, WORK)
DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine dsyrk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
DSYRK
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine dorgrq(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
DORGRQ
subroutine drqt02(M, N, K, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DRQT02