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 slaswp(N, A, LDA, K1, K2, IPIV, INCX)
SLASWP performs a series of row interchanges on a general rectangular matrix.
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
subroutine strmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
STRMV
subroutine sget01(M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK, RESID)
SGET01
subroutine sscal(N, SA, SX, INCX)
SSCAL