119 SUBROUTINE sppcon( UPLO, N, AP, ANORM, RCOND, WORK, IWORK, INFO )
133 REAL ap( * ), work( * )
140 parameter( one = 1.0e+0, zero = 0.0e+0 )
146 REAL ainvnm, scale, scalel, scaleu, smlnum
168 upper =
lsame( uplo,
'U' )
169 IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
171 ELSE IF( n.LT.0 )
THEN
173 ELSE IF( anorm.LT.zero )
THEN
177 CALL
xerbla(
'SPPCON', -info )
187 ELSE IF( anorm.EQ.zero )
THEN
191 smlnum =
slamch(
'Safe minimum' )
198 CALL
slacn2( n, work( n+1 ), work, iwork, ainvnm, kase, isave )
204 CALL
slatps(
'Upper',
'Transpose',
'Non-unit', normin, n,
205 $ ap, work, scalel, work( 2*n+1 ), info )
210 CALL
slatps(
'Upper',
'No transpose',
'Non-unit', normin, n,
211 $ ap, work, scaleu, work( 2*n+1 ), info )
216 CALL
slatps(
'Lower',
'No transpose',
'Non-unit', normin, n,
217 $ ap, work, scalel, work( 2*n+1 ), info )
222 CALL
slatps(
'Lower',
'Transpose',
'Non-unit', normin, n,
223 $ ap, work, scaleu, work( 2*n+1 ), info )
228 scale = scalel*scaleu
229 IF( scale.NE.one )
THEN
231 IF( scale.LT.abs( work( ix ) )*smlnum .OR. scale.EQ.zero )
233 CALL
srscl( n, scale, work, 1 )
241 $ rcond = ( one / ainvnm ) / anorm
integer function isamax(N, SX, INCX)
ISAMAX
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine slatps(UPLO, TRANS, DIAG, NORMIN, N, AP, X, SCALE, CNORM, INFO)
SLATPS solves a triangular system of equations with the matrix held in packed storage.
logical function lsame(CA, CB)
LSAME
subroutine sppcon(UPLO, N, AP, ANORM, RCOND, WORK, IWORK, INFO)
SPPCON
subroutine srscl(N, SA, SX, INCX)
SRSCL multiplies a vector by the reciprocal of a real scalar.
real function slamch(CMACH)
SLAMCH
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...