136 SUBROUTINE dlqt03( M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK,
145 INTEGER K, LDA, LWORK, M, N
148 DOUBLE PRECISION AF( lda, * ), C( lda, * ), CC( lda, * ),
149 $ q( lda, * ), result( * ), rwork( * ), tau( * ),
157 parameter ( one = 1.0d0 )
158 DOUBLE PRECISION ROGUE
159 parameter ( rogue = -1.0d+10 )
162 CHARACTER SIDE, TRANS
163 INTEGER INFO, ISIDE, ITRANS, J, MC, NC
164 DOUBLE PRECISION CNORM, EPS, RESID
168 DOUBLE PRECISION DLAMCH, DLANGE
169 EXTERNAL lsame, dlamch, dlange
184 COMMON / srnamc / srnamt
187 DATA iseed / 1988, 1989, 1990, 1991 /
191 eps = dlamch(
'Epsilon' )
195 CALL dlaset(
'Full', n, n, rogue, rogue, q, lda )
196 CALL dlacpy(
'Upper', k, n-1, af( 1, 2 ), lda, q( 1, 2 ), lda )
201 CALL dorglq( n, n, k, q, lda, tau, work, lwork, info )
204 IF( iside.EQ.1 )
THEN
217 CALL dlarnv( 2, iseed, mc, c( 1, j ) )
219 cnorm = dlange(
'1', mc, nc, c, lda, rwork )
224 IF( itrans.EQ.1 )
THEN
232 CALL dlacpy(
'Full', mc, nc, c, lda, cc, lda )
237 CALL dormlq( side, trans, mc, nc, k, af, lda, tau, cc, lda,
238 $ work, lwork, info )
242 IF( lsame( side,
'L' ) )
THEN
243 CALL dgemm( trans,
'No transpose', mc, nc, mc, -one, q,
244 $ lda, c, lda, one, cc, lda )
246 CALL dgemm(
'No transpose', trans, mc, nc, nc, -one, c,
247 $ lda, q, lda, one, cc, lda )
252 resid = dlange(
'1', mc, nc, cc, lda, rwork )
253 result( ( iside-1 )*2+itrans ) = resid /
254 $ ( dble( max( 1, n ) )*cnorm*eps )
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dorglq(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
DORGLQ
subroutine dlqt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DLQT03
subroutine dlarnv(IDIST, ISEED, N, X)
DLARNV returns a vector of random numbers from a uniform or normal distribution.
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 dormlq(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
DORMLQ