130 SUBROUTINE ctpcon( NORM, UPLO, DIAG, N, AP, RCOND, WORK, RWORK,
139 CHARACTER diag, norm, uplo
145 COMPLEX ap( * ), work( * )
152 parameter( one = 1.0e+0, zero = 0.0e+0 )
155 LOGICAL nounit, onenrm, upper
157 INTEGER ix, kase, kase1
158 REAL ainvnm, anorm, scale, smlnum, xnorm
174 INTRINSIC abs, aimag, max, real
180 cabs1( zdum ) = abs(
REAL( ZDUM ) ) + abs( aimag( zdum ) )
187 upper =
lsame( uplo,
'U' )
188 onenrm = norm.EQ.
'1' .OR.
lsame( norm,
'O' )
189 nounit =
lsame( diag,
'N' )
191 IF( .NOT.onenrm .AND. .NOT.
lsame( norm,
'I' ) )
THEN
193 ELSE IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
195 ELSE IF( .NOT.nounit .AND. .NOT.
lsame( diag,
'U' ) )
THEN
197 ELSE IF( n.LT.0 )
THEN
201 CALL
xerbla(
'CTPCON', -info )
213 smlnum =
slamch(
'Safe minimum' )*
REAL( MAX( 1, N ) )
217 anorm =
clantp( norm, uplo, diag, n, ap, rwork )
221 IF( anorm.GT.zero )
THEN
234 CALL
clacn2( n, work( n+1 ), work, ainvnm, kase, isave )
236 IF( kase.EQ.kase1 )
THEN
240 CALL
clatps( uplo,
'No transpose', diag, normin, n, ap,
241 $ work, scale, rwork, info )
246 CALL
clatps( uplo,
'Conjugate transpose', diag, normin,
247 $ n, ap, work, scale, rwork, info )
253 IF( scale.NE.one )
THEN
255 xnorm = cabs1( work( ix ) )
256 IF( scale.LT.xnorm*smlnum .OR. scale.EQ.zero )
258 CALL
csrscl( n, scale, work, 1 )
266 $ rcond = ( one / anorm ) / ainvnm
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.
real function clantp(NORM, UPLO, DIAG, N, AP, WORK)
CLANTP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular matrix supplied in packed form.
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 ctpcon(NORM, UPLO, DIAG, N, AP, RCOND, WORK, RWORK, INFO)
CTPCON
subroutine clacn2(N, V, X, EST, KASE, ISAVE)
CLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...