130 SUBROUTINE dtpcon( NORM, UPLO, DIAG, N, AP, RCOND, WORK, IWORK,
139 CHARACTER DIAG, NORM, UPLO
141 DOUBLE PRECISION RCOND
145 DOUBLE PRECISION AP( * ), WORK( * )
151 DOUBLE PRECISION ONE, ZERO
152 parameter ( one = 1.0d+0, zero = 0.0d+0 )
155 LOGICAL NOUNIT, ONENRM, UPPER
157 INTEGER IX, KASE, KASE1
158 DOUBLE PRECISION AINVNM, ANORM, SCALE, SMLNUM, XNORM
166 DOUBLE PRECISION DLAMCH, DLANTP
167 EXTERNAL lsame, idamax, dlamch, dlantp
173 INTRINSIC abs, dble, max
180 upper = lsame( uplo,
'U' )
181 onenrm = norm.EQ.
'1' .OR. lsame( norm,
'O' )
182 nounit = lsame( diag,
'N' )
184 IF( .NOT.onenrm .AND. .NOT.lsame( norm,
'I' ) )
THEN
186 ELSE IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
188 ELSE IF( .NOT.nounit .AND. .NOT.lsame( diag,
'U' ) )
THEN
190 ELSE IF( n.LT.0 )
THEN
194 CALL xerbla(
'DTPCON', -info )
206 smlnum = dlamch(
'Safe minimum' )*dble( max( 1, n ) )
210 anorm = dlantp( norm, uplo, diag, n, ap, work )
214 IF( anorm.GT.zero )
THEN
227 CALL dlacn2( n, work( n+1 ), work, iwork, ainvnm, kase, isave )
229 IF( kase.EQ.kase1 )
THEN
233 CALL dlatps( uplo,
'No transpose', diag, normin, n, ap,
234 $ work, scale, work( 2*n+1 ), info )
239 CALL dlatps( uplo,
'Transpose', diag, normin, n, ap,
240 $ work, scale, work( 2*n+1 ), info )
246 IF( scale.NE.one )
THEN
247 ix = idamax( n, work, 1 )
248 xnorm = abs( work( ix ) )
249 IF( scale.LT.xnorm*smlnum .OR. scale.EQ.zero )
251 CALL drscl( n, scale, work, 1 )
259 $ rcond = ( one / anorm ) / ainvnm
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 dtpcon(NORM, UPLO, DIAG, N, AP, RCOND, WORK, IWORK, INFO)
DTPCON
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.