137 SUBROUTINE ctrcon( NORM, UPLO, DIAG, N, A, LDA, RCOND, WORK,
146 CHARACTER DIAG, NORM, UPLO
152 COMPLEX A( lda, * ), WORK( * )
159 parameter ( one = 1.0e+0, zero = 0.0e+0 )
162 LOGICAL NOUNIT, ONENRM, UPPER
164 INTEGER IX, KASE, KASE1
165 REAL AINVNM, ANORM, SCALE, SMLNUM, XNORM
175 EXTERNAL lsame, icamax, clantr, slamch
181 INTRINSIC abs, aimag, max, real
187 cabs1( zdum ) = abs(
REAL( ZDUM ) ) + abs( AIMAG( zdum ) )
194 upper = lsame( uplo,
'U' )
195 onenrm = norm.EQ.
'1' .OR. lsame( norm,
'O' )
196 nounit = lsame( diag,
'N' )
198 IF( .NOT.onenrm .AND. .NOT.lsame( norm,
'I' ) )
THEN
200 ELSE IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
202 ELSE IF( .NOT.nounit .AND. .NOT.lsame( diag,
'U' ) )
THEN
204 ELSE IF( n.LT.0 )
THEN
206 ELSE IF( lda.LT.max( 1, n ) )
THEN
210 CALL xerbla(
'CTRCON', -info )
222 smlnum = slamch(
'Safe minimum' )*
REAL( MAX( 1, N ) )
226 anorm = clantr( norm, uplo, diag, n, n, a, lda, rwork )
230 IF( anorm.GT.zero )
THEN
243 CALL clacn2( n, work( n+1 ), work, ainvnm, kase, isave )
245 IF( kase.EQ.kase1 )
THEN
249 CALL clatrs( uplo,
'No transpose', diag, normin, n, a,
250 $ lda, work, scale, rwork, info )
255 CALL clatrs( uplo,
'Conjugate transpose', diag, normin,
256 $ n, a, lda, work, scale, rwork, info )
262 IF( scale.NE.one )
THEN
263 ix = icamax( n, work, 1 )
264 xnorm = cabs1( work( ix ) )
265 IF( scale.LT.xnorm*smlnum .OR. scale.EQ.zero )
267 CALL csrscl( n, scale, work, 1 )
275 $ rcond = ( one / anorm ) / ainvnm
subroutine csrscl(N, SA, SX, INCX)
CSRSCL multiplies a vector by the reciprocal of a real scalar.
subroutine clatrs(UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, CNORM, INFO)
CLATRS solves a triangular system of equations with the scale factor set to prevent overflow...
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 ctrcon(NORM, UPLO, DIAG, N, A, LDA, RCOND, WORK, RWORK, INFO)
CTRCON