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
154 DOUBLE PRECISION DLAMCH
155 EXTERNAL lsame, idamax, dlamch
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
230 ix = idamax( n, work, 1 )
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.
subroutine dppcon(UPLO, N, AP, ANORM, RCOND, WORK, IWORK, INFO)
DPPCON
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 xerbla(SRNAME, INFO)
XERBLA
subroutine drscl(N, SA, SX, INCX)
DRSCL multiplies a vector by the reciprocal of a real scalar.