136 SUBROUTINE clqt03( M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK,
145 INTEGER K, LDA, LWORK, M, N
148 REAL RESULT( * ), RWORK( * )
149 COMPLEX AF( lda, * ), C( lda, * ), CC( lda, * ),
150 $ q( lda, * ), tau( * ), work( lwork )
157 parameter ( zero = 0.0e+0, one = 1.0e+0 )
159 parameter ( rogue = ( -1.0e+10, -1.0e+10 ) )
162 CHARACTER SIDE, TRANS
163 INTEGER INFO, ISIDE, ITRANS, J, MC, NC
164 REAL CNORM, EPS, RESID
169 EXTERNAL lsame, clange, slamch
178 INTRINSIC cmplx, max, real
184 COMMON / srnamc / srnamt
187 DATA iseed / 1988, 1989, 1990, 1991 /
191 eps = slamch(
'Epsilon' )
195 CALL claset(
'Full', n, n, rogue, rogue, q, lda )
196 CALL clacpy(
'Upper', k, n-1, af( 1, 2 ), lda, q( 1, 2 ), lda )
201 CALL cunglq( n, n, k, q, lda, tau, work, lwork, info )
204 IF( iside.EQ.1 )
THEN
217 CALL clarnv( 2, iseed, mc, c( 1, j ) )
219 cnorm = clange(
'1', mc, nc, c, lda, rwork )
224 IF( itrans.EQ.1 )
THEN
232 CALL clacpy(
'Full', mc, nc, c, lda, cc, lda )
237 CALL cunmlq( side, trans, mc, nc, k, af, lda, tau, cc, lda,
238 $ work, lwork, info )
242 IF( lsame( side,
'L' ) )
THEN
243 CALL cgemm( trans,
'No transpose', mc, nc, mc,
244 $ cmplx( -one ), q, lda, c, lda, cmplx( one ),
247 CALL cgemm(
'No transpose', trans, mc, nc, nc,
248 $ cmplx( -one ), c, lda, q, lda, cmplx( one ),
254 resid = clange(
'1', mc, nc, cc, lda, rwork )
255 result( ( iside-1 )*2+itrans ) = resid /
256 $ (
REAL( MAX( 1, N ) )*cnorm*eps )
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine clarnv(IDIST, ISEED, N, X)
CLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine clqt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
CLQT03
subroutine cunglq(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
CUNGLQ
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM
subroutine cunmlq(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMLQ