136 SUBROUTINE dqlt02( M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK,
145 INTEGER K, LDA, LWORK, M, N
148 DOUBLE PRECISION A( lda, * ), AF( lda, * ), L( lda, * ),
149 $ q( 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
166 DOUBLE PRECISION DLAMCH, DLANGE, DLANSY
167 EXTERNAL dlamch, dlange, dlansy
179 COMMON / srnamc / srnamt
185 IF( m.EQ.0 .OR. n.EQ.0 .OR. k.EQ.0 )
THEN
191 eps = dlamch(
'Epsilon' )
195 CALL dlaset(
'Full', m, n, rogue, rogue, q, lda )
197 $
CALL dlacpy(
'Full', m-k, k, af( 1, n-k+1 ), lda,
198 $ q( 1, n-k+1 ), lda )
200 $
CALL dlacpy(
'Upper', k-1, k-1, af( m-k+1, n-k+2 ), lda,
201 $ q( m-k+1, n-k+2 ), lda )
206 CALL dorgql( m, n, k, q, lda, tau( n-k+1 ), work, lwork, info )
210 CALL dlaset(
'Full', n, k, zero, zero, l( m-n+1, n-k+1 ), lda )
211 CALL dlacpy(
'Lower', k, k, af( m-k+1, n-k+1 ), lda,
212 $ l( m-k+1, n-k+1 ), lda )
216 CALL dgemm(
'Transpose',
'No transpose', n, k, m, -one, q, lda,
217 $ a( 1, n-k+1 ), lda, one, l( m-n+1, n-k+1 ), lda )
221 anorm = dlange(
'1', m, k, a( 1, n-k+1 ), lda, rwork )
222 resid = dlange(
'1', n, k, l( m-n+1, n-k+1 ), lda, rwork )
223 IF( anorm.GT.zero )
THEN
224 result( 1 ) = ( ( resid / dble( max( 1, m ) ) ) / anorm ) / eps
231 CALL dlaset(
'Full', n, n, zero, one, l, lda )
232 CALL dsyrk(
'Upper',
'Transpose', n, m, -one, q, lda, one, l,
237 resid = dlansy(
'1',
'Upper', n, l, lda, rwork )
239 result( 2 ) = ( resid / dble( max( 1, m ) ) ) / eps
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dorgql(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
DORGQL
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 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 dqlt02(M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DQLT02