136 SUBROUTINE sqrt03( 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
169 EXTERNAL lsame, slamch, slange
184 COMMON / srnamc / srnamt
187 DATA iseed / 1988, 1989, 1990, 1991 /
191 eps = slamch(
'Epsilon' )
195 CALL slaset(
'Full', m, m, rogue, rogue, q, lda )
196 CALL slacpy(
'Lower', m-1, k, af( 2, 1 ), lda, q( 2, 1 ), lda )
201 CALL sorgqr( m, m, 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 sormqr( 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, M ) )*cnorm*eps )
subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM
subroutine sormqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMQR
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 slarnv(IDIST, ISEED, N, X)
SLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine sorgqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
SORGQR
subroutine sqrt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
SQRT03
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.