136 SUBROUTINE slqt03( M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK,
145 INTEGER k, lda, lwork, m, n
148 REAL af( lda, * ), c( lda, * ), cc( lda, * ),
149 $ q( lda, * ), result( * ), rwork( * ), tau( * ),
157 parameter( one = 1.0e0 )
159 parameter( rogue = -1.0e+10 )
162 CHARACTER side, trans
163 INTEGER info, iside, itrans,
j, mc, nc
164 REAL cnorm, eps, resid
184 COMMON / srnamc / srnamt
187 DATA iseed / 1988, 1989, 1990, 1991 /
195 CALL
slaset(
'Full', n, n, rogue, rogue, q, lda )
196 CALL
slacpy(
'Upper', k, n-1, af( 1, 2 ), lda, q( 1, 2 ), lda )
201 CALL
sorglq( n, n, k, q, lda, tau, work, lwork, info )
204 IF( iside.EQ.1 )
THEN
217 CALL
slarnv( 2, iseed, mc, c( 1,
j ) )
219 cnorm =
slange(
'1', mc, nc, c, lda, rwork )
224 IF( itrans.EQ.1 )
THEN
232 CALL
slacpy(
'Full', mc, nc, c, lda, cc, lda )
237 CALL
sormlq( side, trans, mc, nc, k, af, lda, tau, cc, lda,
238 $ work, lwork, info )
242 IF(
lsame( side,
'L' ) )
THEN
243 CALL
sgemm( trans,
'No transpose', mc, nc, mc, -one, q,
244 $ lda, c, lda, one, cc, lda )
246 CALL
sgemm(
'No transpose', trans, mc, nc, nc, -one, c,
247 $ lda, q, lda, one, cc, lda )
252 resid =
slange(
'1', mc, nc, cc, lda, rwork )
253 result( ( iside-1 )*2+itrans ) = resid /
254 $ (
REAL( MAX( 1, N ) )*cnorm*eps )
subroutine slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine sormlq(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMLQ
real function slange(NORM, M, N, A, LDA, WORK)
SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine slqt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
SLQT03
logical function lsame(CA, CB)
LSAME
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM
real function slamch(CMACH)
SLAMCH
subroutine slarnv(IDIST, ISEED, N, X)
SLARNV 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 sorglq(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
SORGLQ