1 SUBROUTINE zlqt03( M, N, K, AF, C, CC, Q, LDA, T, WORK, LWORK,
11 INTEGER k, lda, lwork, m, n
15 DOUBLE PRECISION result( * ), rwork( * )
16 COMPLEX*16 af( lda, * ), c( lda, * ), cc( lda, * ),
17 $ q( lda, * ), work( lwork )
80 DOUBLE PRECISION zero, one
81 parameter( zero = 0.0d+0, one = 1.0d+0 )
83 parameter( rogue = ( -1.0d+10, -1.0d+10 ) )
87 INTEGER info, iside, itrans, j, mc, nc
88 INTEGER plasma_side, plasma_trans
89 DOUBLE PRECISION cnorm, eps, resid
93 DOUBLE PRECISION dlamch, zlange
94 EXTERNAL lsame, dlamch, zlange
97 EXTERNAL zgemm, zlacpy, zlarnv,
zlaset, zunglq, zunmlq
103 INTRINSIC dble, dcmplx,
max
109 common / srnamc / srnamt
112 DATA iseed / 1988, 1989, 1990, 1991 /
116 eps = dlamch(
'Epsilon' )
121 CALL
zlaset(
'Full', n, n, rogue, rogue, q, lda )
123 CALL
zlaset(
'Full', n, n, dcmplx( zero ), dcmplx( one ),
133 IF( iside.EQ.1 )
THEN
135 plasma_side = plasmaleft
140 plasma_side = plasmaright
148 CALL zlarnv( 2, iseed, mc, c( 1, j ) )
150 cnorm = zlange(
'1', mc, nc, c, lda, rwork )
155 IF( itrans.EQ.1 )
THEN
156 plasma_trans = plasmanotrans
160 plasma_trans = plasmaconjtrans
165 CALL zlacpy(
'Full', mc, nc, c, lda, cc, lda )
171 $ af, lda, t, cc, lda, info )
176 CALL
zlaset(
'Full', n, n, dcmplx( zero ),
177 $ dcmplx( one ), q, lda )
179 IF( lsame(
side,
'L' ) )
THEN
180 CALL zgemm(
trans,
'No transpose', mc, nc, mc,
181 $ dcmplx( -one ), q, lda, c, lda,
182 $ dcmplx( one ), cc, lda )
184 CALL zgemm(
'No transpose',
trans, mc, nc, nc,
185 $ dcmplx( -one ), c, lda, q, lda,
186 $ dcmplx( one ), cc, lda )
191 resid = zlange(
'1', mc, nc, cc, lda, rwork )
192 result( ( iside-1 )*2+itrans ) = resid /
193 $ ( dble(
max( 1, n ) )*cnorm*eps )