135 SUBROUTINE dqrt02( M, N, K, A, AF, Q, R, LDA, TAU, WORK, LWORK,
144 INTEGER k, lda, lwork, m, n
147 DOUBLE PRECISION a( lda, * ), af( lda, * ), q( lda, * ),
148 $ r( lda, * ), result( * ), rwork( * ), tau( * ),
155 DOUBLE PRECISION zero, one
156 parameter( zero = 0.0d+0, one = 1.0d+0 )
157 DOUBLE PRECISION rogue
158 parameter( rogue = -1.0d+10 )
162 DOUBLE PRECISION anorm, eps, resid
178 COMMON / srnamc / srnamt
186 CALL
dlaset(
'Full', m, n, rogue, rogue, q, lda )
187 CALL
dlacpy(
'Lower', m-1, k, af( 2, 1 ), lda, q( 2, 1 ), lda )
192 CALL
dorgqr( m, n, k, q, lda, tau, work, lwork, info )
196 CALL
dlaset(
'Full', n, k, zero, zero, r, lda )
197 CALL
dlacpy(
'Upper', n, k, af, lda, r, lda )
201 CALL
dgemm(
'Transpose',
'No transpose', n, k, m, -one, q, lda, a,
206 anorm =
dlange(
'1', m, k, a, lda, rwork )
207 resid =
dlange(
'1', n, k, r, lda, rwork )
208 IF( anorm.GT.zero )
THEN
209 result( 1 ) = ( ( resid / dble( max( 1, m ) ) ) / anorm ) / eps
216 CALL
dlaset(
'Full', n, n, zero, one, r, lda )
217 CALL
dsyrk(
'Upper',
'Transpose', n, m, -one, q, lda, one, r,
222 resid =
dlansy(
'1',
'Upper', n, r, lda, rwork )
224 result( 2 ) = ( resid / dble( max( 1, m ) ) ) / 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 dorgqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
DORGQR
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 dqrt02(M, N, K, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DQRT02
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...