126 SUBROUTINE dqrt01p( M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK,
135 INTEGER lda, lwork, m, n
138 DOUBLE PRECISION a( lda, * ), af( lda, * ), q( lda, * ),
139 $ r( lda, * ), result( * ), rwork( * ), tau( * ),
146 DOUBLE PRECISION zero, one
147 parameter( zero = 0.0d+0, one = 1.0d+0 )
148 DOUBLE PRECISION rogue
149 parameter( rogue = -1.0d+10 )
153 DOUBLE PRECISION anorm, eps, resid
163 INTRINSIC dble, max, min
169 COMMON / srnamc / srnamt
178 CALL
dlacpy(
'Full', m, n, a, lda, af, lda )
183 CALL
dgeqrfp( m, n, af, lda, tau, work, lwork, info )
187 CALL
dlaset(
'Full', m, m, rogue, rogue, q, lda )
188 CALL
dlacpy(
'Lower', m-1, n, af( 2, 1 ), lda, q( 2, 1 ), lda )
193 CALL
dorgqr( m, m, minmn, q, lda, tau, work, lwork, info )
197 CALL
dlaset(
'Full', m, n, zero, zero, r, lda )
198 CALL
dlacpy(
'Upper', m, n, af, lda, r, lda )
202 CALL
dgemm(
'Transpose',
'No transpose', m, n, m, -one, q, lda, a,
207 anorm =
dlange(
'1', m, n, a, lda, rwork )
208 resid =
dlange(
'1', m, n, r, lda, rwork )
209 IF( anorm.GT.zero )
THEN
210 result( 1 ) = ( ( resid / dble( max( 1, m ) ) ) / anorm ) / eps
217 CALL
dlaset(
'Full', m, m, zero, one, r, lda )
218 CALL
dsyrk(
'Upper',
'Transpose', m, m, -one, q, lda, one, r,
223 resid =
dlansy(
'1',
'Upper', m, r, lda, rwork )
225 result( 2 ) = ( resid / dble( max( 1, m ) ) ) / eps
subroutine dqrt01p(M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DQRT01P
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 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 dgeqrfp(M, N, A, LDA, TAU, WORK, LWORK, INFO)
DGEQRFP