136 SUBROUTINE dqrt03( M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK,
145 INTEGER k, lda, lwork, m, n
148 DOUBLE PRECISION af( lda, * ), c( lda, * ), cc( lda, * ),
149 $ q( lda, * ), result( * ), rwork( * ), tau( * ),
157 parameter( one = 1.0d0 )
158 DOUBLE PRECISION rogue
159 parameter( rogue = -1.0d+10 )
162 CHARACTER side, trans
163 INTEGER info, iside, itrans,
j, mc, nc
164 DOUBLE PRECISION cnorm, eps, resid
184 COMMON / srnamc / srnamt
187 DATA iseed / 1988, 1989, 1990, 1991 /
195 CALL
dlaset(
'Full', m, m, rogue, rogue, q, lda )
196 CALL
dlacpy(
'Lower', m-1, k, af( 2, 1 ), lda, q( 2, 1 ), lda )
201 CALL
dorgqr( m, m, k, q, lda, tau, work, lwork, info )
204 IF( iside.EQ.1 )
THEN
217 CALL
dlarnv( 2, iseed, mc, c( 1,
j ) )
219 cnorm =
dlange(
'1', mc, nc, c, lda, rwork )
224 IF( itrans.EQ.1 )
THEN
232 CALL
dlacpy(
'Full', mc, nc, c, lda, cc, lda )
237 CALL
dormqr( side, trans, mc, nc, k, af, lda, tau, cc, lda,
238 $ work, lwork, info )
242 IF(
lsame( side,
'L' ) )
THEN
243 CALL
dgemm( trans,
'No transpose', mc, nc, mc, -one, q,
244 $ lda, c, lda, one, cc, lda )
246 CALL
dgemm(
'No transpose', trans, mc, nc, nc, -one, c,
247 $ lda, q, lda, one, cc, lda )
252 resid =
dlange(
'1', mc, nc, cc, lda, rwork )
253 result( ( iside-1 )*2+itrans ) = resid /
254 $ ( dble( max( 1, m ) )*cnorm*eps )
subroutine dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
DGEMM
subroutine dormqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
DORMQR
subroutine dlarnv(IDIST, ISEED, N, X)
DLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine dqrt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DQRT03
logical function lsame(CA, CB)
LSAME
subroutine dorgqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
DORGQR
double precision function dlange(NORM, M, N, A, LDA, WORK)
DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
double precision function dlamch(CMACH)
DLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...