121 SUBROUTINE spocon( UPLO, N, A, LDA, ANORM, RCOND, WORK, IWORK,
136 REAL a( lda, * ), work( * )
143 parameter( one = 1.0e+0, zero = 0.0e+0 )
149 REAL ainvnm, scale, scalel, scaleu, smlnum
171 upper =
lsame( uplo,
'U' )
172 IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
174 ELSE IF( n.LT.0 )
THEN
176 ELSE IF( lda.LT.max( 1, n ) )
THEN
178 ELSE IF( anorm.LT.zero )
THEN
182 CALL
xerbla(
'SPOCON', -info )
192 ELSE IF( anorm.EQ.zero )
THEN
196 smlnum =
slamch(
'Safe minimum' )
203 CALL
slacn2( n, work( n+1 ), work, iwork, ainvnm, kase, isave )
209 CALL
slatrs(
'Upper',
'Transpose',
'Non-unit', normin, n, a,
210 $ lda, work, scalel, work( 2*n+1 ), info )
215 CALL
slatrs(
'Upper',
'No transpose',
'Non-unit', normin, n,
216 $ a, lda, work, scaleu, work( 2*n+1 ), info )
221 CALL
slatrs(
'Lower',
'No transpose',
'Non-unit', normin, n,
222 $ a, lda, work, scalel, work( 2*n+1 ), info )
227 CALL
slatrs(
'Lower',
'Transpose',
'Non-unit', normin, n, a,
228 $ lda, work, scaleu, work( 2*n+1 ), info )
233 scale = scalel*scaleu
234 IF( scale.NE.one )
THEN
236 IF( scale.LT.abs( work( ix ) )*smlnum .OR. scale.EQ.zero )
238 CALL
srscl( n, scale, work, 1 )
246 $ rcond = ( one / ainvnm ) / anorm
LOGICAL function lsame(CA, CB)
LSAME
INTEGER function isamax(N, SX, INCX)
ISAMAX
REAL function slamch(CMACH)
SLAMCH
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine slatrs(UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, CNORM, INFO)
SLATRS solves a triangular system of equations with the scale factor set to prevent overflow...
subroutine spocon(UPLO, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO)
SPOCON
subroutine srscl(N, SA, SX, INCX)
SRSCL multiplies a vector by the reciprocal of a real scalar.
subroutine slacn2(N, V, X, ISGN, EST, KASE, ISAVE)
SLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...