119 SUBROUTINE cppcon( UPLO, N, AP, ANORM, RCOND, WORK, RWORK, INFO )
133 COMPLEX ap( * ), work( * )
140 parameter( one = 1.0e+0, zero = 0.0e+0 )
146 REAL ainvnm, scale, scalel, scaleu, smlnum
162 INTRINSIC abs, aimag, real
168 cabs1( zdum ) = abs(
REAL( ZDUM ) ) + abs( aimag( zdum ) )
175 upper =
lsame( uplo,
'U' )
176 IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
178 ELSE IF( n.LT.0 )
THEN
180 ELSE IF( anorm.LT.zero )
THEN
184 CALL
xerbla(
'CPPCON', -info )
194 ELSE IF( anorm.EQ.zero )
THEN
198 smlnum =
slamch(
'Safe minimum' )
205 CALL
clacn2( n, work( n+1 ), work, ainvnm, kase, isave )
211 CALL
clatps(
'Upper',
'Conjugate transpose',
'Non-unit',
212 $ normin, n, ap, work, scalel, rwork, info )
217 CALL
clatps(
'Upper',
'No transpose',
'Non-unit', normin, n,
218 $ ap, work, scaleu, rwork, info )
223 CALL
clatps(
'Lower',
'No transpose',
'Non-unit', normin, n,
224 $ ap, work, scalel, rwork, info )
229 CALL
clatps(
'Lower',
'Conjugate transpose',
'Non-unit',
230 $ normin, n, ap, work, scaleu, rwork, info )
235 scale = scalel*scaleu
236 IF( scale.NE.one )
THEN
238 IF( scale.LT.cabs1( work( ix ) )*smlnum .OR. scale.EQ.zero )
240 CALL
csrscl( n, scale, work, 1 )
248 $ rcond = ( one / ainvnm ) / anorm
subroutine clatps(UPLO, TRANS, DIAG, NORMIN, N, AP, X, SCALE, CNORM, INFO)
CLATPS solves a triangular system of equations with the matrix held in packed storage.
subroutine xerbla(SRNAME, INFO)
XERBLA
integer function icamax(N, CX, INCX)
ICAMAX
subroutine csrscl(N, SA, SX, INCX)
CSRSCL multiplies a vector by the reciprocal of a real scalar.
logical function lsame(CA, CB)
LSAME
real function slamch(CMACH)
SLAMCH
subroutine cppcon(UPLO, N, AP, ANORM, RCOND, WORK, RWORK, INFO)
CPPCON
subroutine clacn2(N, V, X, EST, KASE, ISAVE)
CLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...