124 SUBROUTINE cgecon( NORM, N, A, LDA, ANORM, RCOND, WORK, RWORK,
139 COMPLEX a( lda, * ), work( * )
146 parameter( one = 1.0e+0, zero = 0.0e+0 )
151 INTEGER ix, kase, kase1
152 REAL ainvnm, scale, sl, smlnum, su
168 INTRINSIC abs, aimag, max, real
174 cabs1( zdum ) = abs(
REAL( ZDUM ) ) + abs( aimag( zdum ) )
181 onenrm = norm.EQ.
'1' .OR.
lsame( norm,
'O' )
182 IF( .NOT.onenrm .AND. .NOT.
lsame( norm,
'I' ) )
THEN
184 ELSE IF( n.LT.0 )
THEN
186 ELSE IF( lda.LT.max( 1, n ) )
THEN
188 ELSE IF( anorm.LT.zero )
THEN
192 CALL
xerbla(
'CGECON', -info )
202 ELSE IF( anorm.EQ.zero )
THEN
206 smlnum =
slamch(
'Safe minimum' )
219 CALL
clacn2( n, work( n+1 ), work, ainvnm, kase, isave )
221 IF( kase.EQ.kase1 )
THEN
225 CALL
clatrs(
'Lower',
'No transpose',
'Unit', normin, n, a,
226 $ lda, work, sl, rwork, info )
230 CALL
clatrs(
'Upper',
'No transpose',
'Non-unit', normin, n,
231 $ a, lda, work, su, rwork( n+1 ), info )
236 CALL
clatrs(
'Upper',
'Conjugate transpose',
'Non-unit',
237 $ normin, n, a, lda, work, su, rwork( n+1 ),
242 CALL
clatrs(
'Lower',
'Conjugate transpose',
'Unit', normin,
243 $ n, a, lda, work, sl, rwork, info )
250 IF( scale.NE.one )
THEN
252 IF( scale.LT.cabs1( work( ix ) )*smlnum .OR. scale.EQ.zero )
254 CALL
csrscl( n, scale, work, 1 )
262 $ rcond = ( one / ainvnm ) / anorm
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
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...
real function slamch(CMACH)
SLAMCH
subroutine cgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
CGECON
subroutine clacn2(N, V, X, EST, KASE, ISAVE)
CLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...