119 SUBROUTINE dppcon( UPLO, N, AP, ANORM, RCOND, WORK, IWORK, INFO )
129 DOUBLE PRECISION anorm, rcond
133 DOUBLE PRECISION ap( * ), work( * )
139 DOUBLE PRECISION one, zero
140 parameter( one = 1.0d+0, zero = 0.0d+0 )
146 DOUBLE PRECISION 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(
'DPPCON', -info )
187 ELSE IF( anorm.EQ.zero )
THEN
191 smlnum =
dlamch(
'Safe minimum' )
198 CALL
dlacn2( n, work( n+1 ), work, iwork, ainvnm, kase, isave )
204 CALL
dlatps(
'Upper',
'Transpose',
'Non-unit', normin, n,
205 $ ap, work, scalel, work( 2*n+1 ), info )
210 CALL
dlatps(
'Upper',
'No transpose',
'Non-unit', normin, n,
211 $ ap, work, scaleu, work( 2*n+1 ), info )
216 CALL
dlatps(
'Lower',
'No transpose',
'Non-unit', normin, n,
217 $ ap, work, scalel, work( 2*n+1 ), info )
222 CALL
dlatps(
'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
drscl( n, scale, work, 1 )
241 $ rcond = ( one / ainvnm ) / anorm
subroutine dlatps(UPLO, TRANS, DIAG, NORMIN, N, AP, X, SCALE, CNORM, INFO)
DLATPS solves a triangular system of equations with the matrix held in packed storage.
LOGICAL function lsame(CA, CB)
LSAME
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dlacn2(N, V, X, ISGN, EST, KASE, ISAVE)
DLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
subroutine dppcon(UPLO, N, AP, ANORM, RCOND, WORK, IWORK, INFO)
DPPCON
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
subroutine drscl(N, SA, SX, INCX)
DRSCL multiplies a vector by the reciprocal of a real scalar.
INTEGER function idamax(N, DX, INCX)
IDAMAX