136 SUBROUTINE drqt03( 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( * ),
156 DOUBLE PRECISION ZERO, ONE
157 parameter ( zero = 0.0d0, one = 1.0d0 )
158 DOUBLE PRECISION ROGUE
159 parameter ( rogue = -1.0d+10 )
162 CHARACTER SIDE, TRANS
163 INTEGER INFO, ISIDE, ITRANS, J, MC, MINMN, NC
164 DOUBLE PRECISION CNORM, EPS, RESID
168 DOUBLE PRECISION DLAMCH, DLANGE
169 EXTERNAL lsame, dlamch, dlange
178 INTRINSIC dble, max, min
184 COMMON / srnamc / srnamt
187 DATA iseed / 1988, 1989, 1990, 1991 /
191 eps = dlamch(
'Epsilon' )
196 IF( minmn.EQ.0 )
THEN
206 CALL dlaset(
'Full', n, n, rogue, rogue, q, lda )
207 IF( k.GT.0 .AND. n.GT.k )
208 $
CALL dlacpy(
'Full', k, n-k, af( m-k+1, 1 ), lda,
209 $ q( n-k+1, 1 ), lda )
211 $
CALL dlacpy(
'Lower', k-1, k-1, af( m-k+2, n-k+1 ), lda,
212 $ q( n-k+2, n-k+1 ), lda )
217 CALL dorgrq( n, n, k, q, lda, tau( minmn-k+1 ), work, lwork,
221 IF( iside.EQ.1 )
THEN
234 CALL dlarnv( 2, iseed, mc, c( 1, j ) )
236 cnorm = dlange(
'1', mc, nc, c, lda, rwork )
241 IF( itrans.EQ.1 )
THEN
249 CALL dlacpy(
'Full', mc, nc, c, lda, cc, lda )
255 $
CALL dormrq( side, trans, mc, nc, k, af( m-k+1, 1 ), lda,
256 $ tau( minmn-k+1 ), cc, lda, work, lwork,
261 IF( lsame( side,
'L' ) )
THEN
262 CALL dgemm( trans,
'No transpose', mc, nc, mc, -one, q,
263 $ lda, c, lda, one, cc, lda )
265 CALL dgemm(
'No transpose', trans, mc, nc, nc, -one, c,
266 $ lda, q, lda, one, cc, lda )
271 resid = dlange(
'1', mc, nc, cc, lda, rwork )
272 result( ( iside-1 )*2+itrans ) = resid /
273 $ ( 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 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 dorgrq(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
DORGRQ
subroutine dormrq(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
DORMRQ
subroutine drqt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DRQT03