135 SUBROUTINE dlqt02( M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK,
144 INTEGER K, LDA, LWORK, M, N
147 DOUBLE PRECISION A( lda, * ), AF( lda, * ), L( lda, * ),
148 $ q( 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
165 DOUBLE PRECISION DLAMCH, DLANGE, DLANSY
166 EXTERNAL dlamch, dlange, dlansy
178 COMMON / srnamc / srnamt
182 eps = dlamch(
'Epsilon' )
186 CALL
dlaset(
'Full', m, n, rogue, rogue, q, lda )
187 CALL
dlacpy(
'Upper', k, n-1, af( 1, 2 ), lda, q( 1, 2 ), lda )
192 CALL
dorglq( m, n, k, q, lda, tau, work, lwork, info )
196 CALL
dlaset(
'Full', k, m, zero, zero, l, lda )
197 CALL
dlacpy(
'Lower', k, m, af, lda, l, lda )
201 CALL
dgemm(
'No transpose',
'Transpose', k, m, n, -one, a, lda, q,
206 anorm = dlange(
'1', k, n, a, lda, rwork )
207 resid = dlange(
'1', k, m, l, lda, rwork )
208 IF( anorm.GT.zero )
THEN
209 result( 1 ) = ( ( resid / dble( max( 1, n ) ) ) / anorm ) / eps
216 CALL
dlaset(
'Full', m, m, zero, one, l, lda )
217 CALL
dsyrk(
'Upper',
'No transpose', m, n, -one, q, lda, one, l,
222 resid = dlansy(
'1',
'Upper', m, l, lda, rwork )
224 result( 2 ) = ( resid / dble( max( 1, n ) ) ) / eps
subroutine dorglq(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
DORGLQ
subroutine dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
DGEMM
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.
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 dlqt02(M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DLQT02