136 SUBROUTINE zqlt03( 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, MINMN, NC
164 DOUBLE PRECISION CNORM, EPS, RESID
168 DOUBLE PRECISION DLAMCH, ZLANGE
169 EXTERNAL lsame, dlamch, zlange
178 INTRINSIC dble, dcmplx, 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 zlaset(
'Full', m, m, rogue, rogue, q, lda )
207 IF( k.GT.0 .AND. m.GT.k )
208 $
CALL zlacpy(
'Full', m-k, k, af( 1, n-k+1 ), lda,
209 $ q( 1, m-k+1 ), lda )
211 $
CALL zlacpy(
'Upper', k-1, k-1, af( m-k+1, n-k+2 ), lda,
212 $ q( m-k+1, m-k+2 ), lda )
217 CALL zungql( m, m, k, q, lda, tau( minmn-k+1 ), work, lwork,
221 IF( iside.EQ.1 )
THEN
234 CALL zlarnv( 2, iseed, mc, c( 1, j ) )
236 cnorm = zlange(
'1', mc, nc, c, lda, rwork )
241 IF( itrans.EQ.1 )
THEN
249 CALL zlacpy(
'Full', mc, nc, c, lda, cc, lda )
255 $
CALL zunmql( side, trans, mc, nc, k, af( 1, n-k+1 ), lda,
256 $ tau( minmn-k+1 ), cc, lda, work, lwork,
261 IF( lsame( side,
'L' ) )
THEN
262 CALL zgemm( trans,
'No transpose', mc, nc, mc,
263 $ dcmplx( -one ), q, lda, c, lda,
264 $ dcmplx( one ), cc, lda )
266 CALL zgemm(
'No transpose', trans, mc, nc, nc,
267 $ dcmplx( -one ), c, lda, q, lda,
268 $ dcmplx( one ), cc, lda )
273 resid = zlange(
'1', mc, nc, cc, lda, rwork )
274 result( ( iside-1 )*2+itrans ) = resid /
275 $ ( dble( max( 1, m ) )*cnorm*eps )
subroutine zungql(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGQL
subroutine zunmql(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
ZUNMQL
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 zqlt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
ZQLT03
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.