121 SUBROUTINE dpocon( UPLO, N, A, LDA, ANORM, RCOND, WORK, IWORK,
132 DOUBLE PRECISION anorm, rcond
136 DOUBLE PRECISION a( lda, * ), work( * )
142 DOUBLE PRECISION one, zero
143 parameter( one = 1.0d+0, zero = 0.0d+0 )
149 DOUBLE PRECISION ainvnm, scale, scalel, scaleu, smlnum
171 upper =
lsame( uplo,
'U' )
172 IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
174 ELSE IF( n.LT.0 )
THEN
176 ELSE IF( lda.LT.max( 1, n ) )
THEN
178 ELSE IF( anorm.LT.zero )
THEN
182 CALL
xerbla(
'DPOCON', -info )
192 ELSE IF( anorm.EQ.zero )
THEN
196 smlnum =
dlamch(
'Safe minimum' )
203 CALL
dlacn2( n, work( n+1 ), work, iwork, ainvnm, kase, isave )
209 CALL
dlatrs(
'Upper',
'Transpose',
'Non-unit', normin, n, a,
210 $ lda, work, scalel, work( 2*n+1 ), info )
215 CALL
dlatrs(
'Upper',
'No transpose',
'Non-unit', normin, n,
216 $ a, lda, work, scaleu, work( 2*n+1 ), info )
221 CALL
dlatrs(
'Lower',
'No transpose',
'Non-unit', normin, n,
222 $ a, lda, work, scalel, work( 2*n+1 ), info )
227 CALL
dlatrs(
'Lower',
'Transpose',
'Non-unit', normin, n, a,
228 $ lda, work, scaleu, work( 2*n+1 ), info )
233 scale = scalel*scaleu
234 IF( scale.NE.one )
THEN
236 IF( scale.LT.abs( work( ix ) )*smlnum .OR. scale.EQ.zero )
238 CALL
drscl( n, scale, work, 1 )
246 $ rcond = ( one / ainvnm ) / anorm
subroutine dlatrs(UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, CNORM, INFO)
DLATRS solves a triangular system of equations with the scale factor set to prevent overflow...
subroutine xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME
double precision function dlamch(CMACH)
DLAMCH
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...
integer function idamax(N, DX, INCX)
IDAMAX
subroutine dpocon(UPLO, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO)
DPOCON
subroutine drscl(N, SA, SX, INCX)
DRSCL multiplies a vector by the reciprocal of a real scalar.