107 SUBROUTINE sget01( M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK,
116 INTEGER LDA, LDAFAC, M, N
121 REAL A( lda, * ), AFAC( ldafac, * ), RWORK( * )
129 parameter( zero = 0.0e+0, one = 1.0e+0 )
136 REAL SDOT, SLAMCH, SLANGE
137 EXTERNAL sdot, slamch, slange
149 IF( m.LE.0 .OR. n.LE.0 )
THEN
156 eps = slamch(
'Epsilon' )
157 anorm = slange(
'1', m, n, a, lda, rwork )
165 CALL
strmv(
'Lower',
'No transpose',
'Unit', m, afac,
166 $ ldafac, afac( 1, k ), 1 )
173 CALL
sscal( m-k, t, afac( k+1, k ), 1 )
174 CALL
sgemv(
'No transpose', m-k, k-1, one,
175 $ afac( k+1, 1 ), ldafac, afac( 1, k ), 1, one,
176 $ afac( k+1, k ), 1 )
181 afac( k, k ) = t + sdot( k-1, afac( k, 1 ), ldafac,
186 CALL
strmv(
'Lower',
'No transpose',
'Unit', k-1, afac,
187 $ ldafac, afac( 1, k ), 1 )
190 CALL
slaswp( n, afac, ldafac, 1, min( m, n ), ipiv, -1 )
196 afac( i, j ) = afac( i, j ) - a( i, j )
202 resid = slange(
'1', m, n, afac, ldafac, rwork )
204 IF( anorm.LE.zero )
THEN
208 resid = ( ( resid /
REAL( N ) ) / anorm ) / eps
subroutine strmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
STRMV
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
subroutine sget01(M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK, RESID)
SGET01
subroutine slaswp(N, A, LDA, K1, K2, IPIV, INCX)
SLASWP performs a series of row interchanges on a general rectangular matrix.
subroutine sscal(N, SA, SX, INCX)
SSCAL