1 SUBROUTINE zgecon( NORM, N, A, LDA, ANORM, RCOND, WORK, RWORK,
12 DOUBLE PRECISION ANORM, RCOND
15 DOUBLE PRECISION RWORK( * )
16 COMPLEX*16 A( LDA, * ), WORK( * )
68 DOUBLE PRECISION ONE, ZERO
69 parameter( one = 1.0d+0, zero = 0.0d+0 )
74 INTEGER IX, KASE, KASE1
75 DOUBLE PRECISION AINVNM, SCALE, SL, SMLNUM, SU
81 DOUBLE PRECISION DLAMCH
82 EXTERNAL lsame, izamax, dlamch
88 INTRINSIC abs, dble, dimag, max
91 DOUBLE PRECISION CABS1
94 cabs1( zdum ) = abs( dble( zdum ) ) + abs( dimag( zdum ) )
101 onenrm = norm.EQ.
'1' .OR. lsame( norm,
'O' )
102 IF( .NOT.onenrm .AND. .NOT.lsame( norm,
'I' ) )
THEN
104 ELSE IF( n.LT.0 )
THEN
106 ELSE IF( lda.LT.max( 1, n ) )
THEN
108 ELSE IF( anorm.LT.zero )
THEN
112 CALL xerbla(
'ZGECON', -info )
122 ELSE IF( anorm.EQ.zero )
THEN
126 smlnum = dlamch(
'Safe minimum' )
139 CALL zlacon( n, work( n+1 ), work, ainvnm, kase )
141 IF( kase.EQ.kase1 )
THEN
145 CALL zlatrs(
'Lower',
'No transpose',
'Unit', normin, n, a,
146 $ lda, work, sl, rwork, info )
150 CALL zlatrs(
'Upper',
'No transpose',
'Non-unit', normin, n,
151 $ a, lda, work, su, rwork( n+1 ), info )
156 CALL zlatrs(
'Upper',
'Conjugate transpose',
'Non-unit',
157 $ normin, n, a, lda, work, su, rwork( n+1 ),
162 CALL zlatrs(
'Lower',
'Conjugate transpose',
'Unit', normin,
163 $ n, a, lda, work, sl, rwork, info )
170 IF( scale.NE.one )
THEN
171 ix = izamax( n, work, 1 )
172 IF( scale.LT.cabs1( work( ix ) )*smlnum .OR. scale.EQ.zero )
174 CALL zdrscl( n, scale, work, 1 )
182 $ rcond = ( one / ainvnm ) / anorm
subroutine xerbla(SRNAME, INFO)
subroutine zdrscl(N, SA, SX, INCX)
subroutine zgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
subroutine zlacon(N, V, X, EST, KASE)
subroutine zlatrs(UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, CNORM, INFO)