126 SUBROUTINE drqt01( 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
dgerqf( m, n, af, lda, tau, work, lwork, info )
187 CALL
dlaset(
'Full', n, n, rogue, rogue, q, lda )
189 IF( m.GT.0 .AND. m.LT.n )
190 $ CALL
dlacpy(
'Full', m, n-m, af, lda, q( n-m+1, 1 ), lda )
192 $ CALL
dlacpy(
'Lower', m-1, m-1, af( 2, n-m+1 ), lda,
193 $ q( n-m+2, n-m+1 ), lda )
196 $ CALL
dlacpy(
'Lower', n-1, n-1, af( m-n+2, 1 ), lda,
203 CALL
dorgrq( n, n, minmn, q, lda, tau, work, lwork, info )
207 CALL
dlaset(
'Full', m, n, zero, zero, r, lda )
210 $ CALL
dlacpy(
'Upper', m, m, af( 1, n-m+1 ), lda,
211 $ r( 1, n-m+1 ), lda )
213 IF( m.GT.n .AND. n.GT.0 )
214 $ CALL
dlacpy(
'Full', m-n, n, af, lda, r, lda )
216 $ CALL
dlacpy(
'Upper', n, n, af( m-n+1, 1 ), lda,
217 $ r( m-n+1, 1 ), lda )
222 CALL
dgemm(
'No transpose',
'Transpose', m, n, n, -one, a, lda, q,
227 anorm =
dlange(
'1', m, n, a, lda, rwork )
228 resid =
dlange(
'1', m, n, r, lda, rwork )
229 IF( anorm.GT.zero )
THEN
230 result( 1 ) = ( ( resid / dble( max( 1, n ) ) ) / anorm ) / eps
237 CALL
dlaset(
'Full', n, n, zero, one, r, lda )
238 CALL
dsyrk(
'Upper',
'No transpose', n, n, -one, q, lda, one, r,
243 resid =
dlansy(
'1',
'Upper', n, r, lda, rwork )
245 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 dgerqf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
DGERQF
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 drqt01(M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DRQT01