142 DOUBLE PRECISION FUNCTION zla_gercond_c( TRANS, N, A, LDA, AF,
143 $ ldaf, ipiv, c, capply,
144 $ info, work, rwork )
154 INTEGER N, LDA, LDAF, INFO
158 COMPLEX*16 A( lda, * ), AF( ldaf, * ), WORK( * )
159 DOUBLE PRECISION C( * ), RWORK( * )
167 DOUBLE PRECISION AINVNM, ANORM, TMP
181 INTRINSIC abs, max,
REAL, DIMAG
184 DOUBLE PRECISION CABS1
187 cabs1( zdum ) = abs( dble( zdum ) ) + abs( dimag( zdum ) )
193 notrans = lsame( trans,
'N' )
194 IF ( .NOT. notrans .AND. .NOT. lsame( trans,
'T' ) .AND. .NOT.
195 $ lsame( trans,
'C' ) )
THEN
197 ELSE IF( n.LT.0 )
THEN
199 ELSE IF( lda.LT.max( 1, n ) )
THEN
201 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
205 CALL xerbla(
'ZLA_GERCOND_C', -info )
217 tmp = tmp + cabs1( a( i, j ) ) / c( j )
221 tmp = tmp + cabs1( a( i, j ) )
225 anorm = max( anorm, tmp )
232 tmp = tmp + cabs1( a( j, i ) ) / c( j )
236 tmp = tmp + cabs1( a( j, i ) )
240 anorm = max( anorm, tmp )
249 ELSE IF( anorm .EQ. 0.0d+0 )
THEN
259 CALL zlacn2( n, work( n+1 ), work, ainvnm, kase, isave )
266 work( i ) = work( i ) * rwork( i )
270 CALL zgetrs(
'No transpose', n, 1, af, ldaf, ipiv,
273 CALL zgetrs(
'Conjugate transpose', n, 1, af, ldaf, ipiv,
281 work( i ) = work( i ) * c( i )
290 work( i ) = work( i ) * c( i )
295 CALL zgetrs(
'Conjugate transpose', n, 1, af, ldaf, ipiv,
298 CALL zgetrs(
'No transpose', n, 1, af, ldaf, ipiv,
305 work( i ) = work( i ) * rwork( i )
313 IF( ainvnm .NE. 0.0d+0 )
subroutine zgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZGETRS
subroutine zlacn2(N, V, X, EST, KASE, ISAVE)
ZLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
subroutine xerbla(SRNAME, INFO)
XERBLA
double precision function zla_gercond_c(TRANS, N, A, LDA, AF, LDAF, IPIV, C, CAPPLY, INFO, WORK, RWORK)
ZLA_GERCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for general matrices...