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
168 EXTERNAL lsame, icamax, clantp, slamch
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
254 ix = icamax( n, work, 1 )
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.
subroutine csrscl(N, SA, SX, INCX)
CSRSCL multiplies a vector by the reciprocal of a real scalar.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine clacn2(N, V, X, EST, KASE, ISAVE)
CLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
subroutine ctpcon(NORM, UPLO, DIAG, N, AP, RCOND, WORK, RWORK, INFO)
CTPCON