124 SUBROUTINE zgecon( NORM, N, A, LDA, ANORM, RCOND, WORK, RWORK,
135 DOUBLE PRECISION anorm, rcond
138 DOUBLE PRECISION rwork( * )
139 COMPLEX*16 a( lda, * ), work( * )
145 DOUBLE PRECISION one, zero
146 parameter( one = 1.0d+0, zero = 0.0d+0 )
151 INTEGER ix, kase, kase1
152 DOUBLE PRECISION ainvnm, scale, sl, smlnum, su
168 INTRINSIC abs, dble, dimag, max
171 DOUBLE PRECISION cabs1
174 cabs1( zdum ) = abs( dble( zdum ) ) + abs( dimag( 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(
'ZGECON', -info )
202 ELSE IF( anorm.EQ.zero )
THEN
206 smlnum =
dlamch(
'Safe minimum' )
219 CALL
zlacn2( n, work( n+1 ), work, ainvnm, kase, isave )
221 IF( kase.EQ.kase1 )
THEN
225 CALL
zlatrs(
'Lower',
'No transpose',
'Unit', normin, n, a,
226 $ lda, work, sl, rwork, info )
230 CALL
zlatrs(
'Upper',
'No transpose',
'Non-unit', normin, n,
231 $ a, lda, work, su, rwork( n+1 ), info )
236 CALL
zlatrs(
'Upper',
'Conjugate transpose',
'Non-unit',
237 $ normin, n, a, lda, work, su, rwork( n+1 ),
242 CALL
zlatrs(
'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
zdrscl( n, scale, work, 1 )
262 $ rcond = ( one / ainvnm ) / anorm