136 SUBROUTINE crqt03( 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, minmn, nc
164 REAL cnorm, eps, resid
178 INTRINSIC cmplx, max, min, real
184 COMMON / srnamc / srnamt
187 DATA iseed / 1988, 1989, 1990, 1991 /
196 IF( minmn.EQ.0 )
THEN
206 CALL
claset(
'Full', n, n, rogue, rogue, q, lda )
207 IF( k.GT.0 .AND. n.GT.k )
208 $ CALL
clacpy(
'Full', k, n-k, af( m-k+1, 1 ), lda,
209 $ q( n-k+1, 1 ), lda )
211 $ CALL
clacpy(
'Lower', k-1, k-1, af( m-k+2, n-k+1 ), lda,
212 $ q( n-k+2, n-k+1 ), lda )
217 CALL
cungrq( n, n, k, q, lda, tau( minmn-k+1 ), work, lwork,
221 IF( iside.EQ.1 )
THEN
234 CALL
clarnv( 2, iseed, mc, c( 1,
j ) )
236 cnorm =
clange(
'1', mc, nc, c, lda, rwork )
241 IF( itrans.EQ.1 )
THEN
249 CALL
clacpy(
'Full', mc, nc, c, lda, cc, lda )
255 $ CALL
cunmrq( side, trans, mc, nc, k, af( m-k+1, 1 ), lda,
256 $ tau( minmn-k+1 ), cc, lda, work, lwork,
261 IF(
lsame( side,
'L' ) )
THEN
262 CALL
cgemm( trans,
'No transpose', mc, nc, mc,
263 $ cmplx( -one ), q, lda, c, lda, cmplx( one ),
266 CALL
cgemm(
'No transpose', trans, mc, nc, nc,
267 $ cmplx( -one ), c, lda, q, lda, cmplx( one ),
273 resid =
clange(
'1', mc, nc, cc, lda, rwork )
274 result( ( iside-1 )*2+itrans ) = resid /
275 $ (
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...
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 cunmrq(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMRQ
subroutine cungrq(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
CUNGRQ
logical function lsame(CA, CB)
LSAME
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine crqt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
CRQT03
real function slamch(CMACH)
SLAMCH
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 cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM