136 SUBROUTINE cqrt03( 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
178 INTRINSIC cmplx, max, real
184 COMMON / srnamc / srnamt
187 DATA iseed / 1988, 1989, 1990, 1991 /
195 CALL
claset(
'Full', m, m, rogue, rogue, q, lda )
196 CALL
clacpy(
'Lower', m-1, k, af( 2, 1 ), lda, q( 2, 1 ), lda )
201 CALL
cungqr( m, m, 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
cunmqr( 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, M ) )*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...
LOGICAL function lsame(CA, CB)
LSAME
REAL function slamch(CMACH)
SLAMCH
subroutine cunmqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMQR
REAL function clange(NORM, M, N, A, LDA, WORK)
CLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine clarnv(IDIST, ISEED, N, X)
CLARNV returns a vector of random numbers from a uniform or normal distribution.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine cqrt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
CQRT03
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM
subroutine cungqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
CUNGQR