136 SUBROUTINE sqlt03( 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( zero = 0.0e0, one = 1.0e0 )
159 parameter( rogue = -1.0e+10 )
162 CHARACTER side, trans
163 INTEGER info, iside, itrans,
j, mc, minmn, nc
164 REAL cnorm, eps, resid
178 INTRINSIC max, min, real
184 COMMON / srnamc / srnamt
187 DATA iseed / 1988, 1989, 1990, 1991 /
196 IF( minmn.EQ.0 )
THEN
206 CALL
slaset(
'Full', m, m, rogue, rogue, q, lda )
207 IF( k.GT.0 .AND. m.GT.k )
208 $ CALL
slacpy(
'Full', m-k, k, af( 1, n-k+1 ), lda,
209 $ q( 1, m-k+1 ), lda )
211 $ CALL
slacpy(
'Upper', k-1, k-1, af( m-k+1, n-k+2 ), lda,
212 $ q( m-k+1, m-k+2 ), lda )
217 CALL
sorgql( m, m, k, q, lda, tau( minmn-k+1 ), work, lwork,
221 IF( iside.EQ.1 )
THEN
234 CALL
slarnv( 2, iseed, mc, c( 1,
j ) )
236 cnorm =
slange(
'1', mc, nc, c, lda, rwork )
241 IF( itrans.EQ.1 )
THEN
249 CALL
slacpy(
'Full', mc, nc, c, lda, cc, lda )
255 $ CALL
sormql( side, trans, mc, nc, k, af( 1, n-k+1 ), lda,
256 $ tau( minmn-k+1 ), cc, lda, work, lwork,
261 IF(
lsame( side,
'L' ) )
THEN
262 CALL
sgemm( trans,
'No transpose', mc, nc, mc, -one, q,
263 $ lda, c, lda, one, cc, lda )
265 CALL
sgemm(
'No transpose', trans, mc, nc, nc, -one, c,
266 $ lda, q, lda, one, cc, lda )
271 resid =
slange(
'1', mc, nc, cc, lda, rwork )
272 result( ( iside-1 )*2+itrans ) = resid /
273 $ (
REAL( MAX( 1, M ) )*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 sormql(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMQL
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 sqlt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
SQLT03
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 sorgql(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
SORGQL