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
LOGICAL function lsame(CA, CB)
LSAME
INTEGER function isamax(N, SX, INCX)
ISAMAX
REAL function slamch(CMACH)
SLAMCH
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.
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.
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...