128 SUBROUTINE ctpcon( NORM, UPLO, DIAG, N, AP, RCOND, WORK, RWORK,
136 CHARACTER DIAG, NORM, UPLO
142 COMPLEX AP( * ), WORK( * )
149 parameter( one = 1.0e+0, zero = 0.0e+0 )
152 LOGICAL NOUNIT, ONENRM, UPPER
154 INTEGER IX, KASE, KASE1
155 REAL AINVNM, ANORM, SCALE, SMLNUM, XNORM
165 EXTERNAL lsame, icamax, clantp, slamch
171 INTRINSIC abs, aimag, max, real
177 cabs1( zdum ) = abs( real( zdum ) ) + abs( aimag( zdum ) )
184 upper = lsame( uplo,
'U' )
185 onenrm = norm.EQ.
'1' .OR. lsame( norm,
'O' )
186 nounit = lsame( diag,
'N' )
188 IF( .NOT.onenrm .AND. .NOT.lsame( norm,
'I' ) )
THEN
190 ELSE IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
192 ELSE IF( .NOT.nounit .AND. .NOT.lsame( diag,
'U' ) )
THEN
194 ELSE IF( n.LT.0 )
THEN
198 CALL xerbla(
'CTPCON', -info )
210 smlnum = slamch(
'Safe minimum' )*real( max( 1, n ) )
214 anorm = clantp( norm, uplo, diag, n, ap, rwork )
218 IF( anorm.GT.zero )
THEN
231 CALL clacn2( n, work( n+1 ), work, ainvnm, kase, isave )
233 IF( kase.EQ.kase1 )
THEN
237 CALL clatps( uplo,
'No transpose', diag, normin, n, ap,
238 $ work, scale, rwork, info )
243 CALL clatps( uplo,
'Conjugate transpose', diag, normin,
244 $ n, ap, work, scale, rwork, info )
250 IF( scale.NE.one )
THEN
251 ix = icamax( n, work, 1 )
252 xnorm = cabs1( work( ix ) )
253 IF( scale.LT.xnorm*smlnum .OR. scale.EQ.zero )
255 CALL csrscl( n, scale, work, 1 )
263 $ rcond = ( one / anorm ) / ainvnm
subroutine xerbla(srname, info)
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 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 ctpcon(norm, uplo, diag, n, ap, rcond, work, rwork, info)
CTPCON