136 SUBROUTINE zqrt03( M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK,
145 INTEGER K, LDA, LWORK, M, N
148 DOUBLE PRECISION RESULT( * ), RWORK( * )
149 COMPLEX*16 AF( lda, * ), C( lda, * ), CC( lda, * ),
150 $ q( lda, * ), tau( * ), work( lwork )
156 DOUBLE PRECISION ZERO, ONE
157 parameter ( zero = 0.0d+0, one = 1.0d+0 )
159 parameter ( rogue = ( -1.0d+10, -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, ZLANGE
169 EXTERNAL lsame, dlamch, zlange
178 INTRINSIC dble, dcmplx, max
184 COMMON / srnamc / srnamt
187 DATA iseed / 1988, 1989, 1990, 1991 /
191 eps = dlamch(
'Epsilon' )
195 CALL zlaset(
'Full', m, m, rogue, rogue, q, lda )
196 CALL zlacpy(
'Lower', m-1, k, af( 2, 1 ), lda, q( 2, 1 ), lda )
201 CALL zungqr( m, m, k, q, lda, tau, work, lwork, info )
204 IF( iside.EQ.1 )
THEN
217 CALL zlarnv( 2, iseed, mc, c( 1, j ) )
219 cnorm = zlange(
'1', mc, nc, c, lda, rwork )
224 IF( itrans.EQ.1 )
THEN
232 CALL zlacpy(
'Full', mc, nc, c, lda, cc, lda )
237 CALL zunmqr( side, trans, mc, nc, k, af, lda, tau, cc, lda,
238 $ work, lwork, info )
242 IF( lsame( side,
'L' ) )
THEN
243 CALL zgemm( trans,
'No transpose', mc, nc, mc,
244 $ dcmplx( -one ), q, lda, c, lda,
245 $ dcmplx( one ), cc, lda )
247 CALL zgemm(
'No transpose', trans, mc, nc, nc,
248 $ dcmplx( -one ), c, lda, q, lda,
249 $ dcmplx( one ), cc, lda )
254 resid = zlange(
'1', mc, nc, cc, lda, rwork )
255 result( ( iside-1 )*2+itrans ) = resid /
256 $ ( dble( max( 1, m ) )*cnorm*eps )
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
subroutine zungqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGQR
subroutine zqrt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
ZQRT03
subroutine zunmqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
ZUNMQR
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine zlarnv(IDIST, ISEED, N, X)
ZLARNV returns a vector of random numbers from a uniform or normal distribution.