136 SUBROUTINE zlqt03( 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
178 INTRINSIC dble, dcmplx, max
184 COMMON / srnamc / srnamt
187 DATA iseed / 1988, 1989, 1990, 1991 /
195 CALL
zlaset(
'Full', n, n, rogue, rogue, q, lda )
196 CALL
zlacpy(
'Upper', k, n-1, af( 1, 2 ), lda, q( 1, 2 ), lda )
201 CALL
zunglq( n, n, 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
zunmlq( 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, n ) )*cnorm*eps )
LOGICAL function lsame(CA, CB)
LSAME
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zunmlq(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
ZUNMLQ
DOUBLE PRECISION function zlange(NORM, M, N, A, LDA, WORK)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
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 zunglq(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGLQ
subroutine zlarnv(IDIST, ISEED, N, X)
ZLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine zlqt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
ZLQT03
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH