131 REAL FUNCTION cla_hercond_x( UPLO, N, A, LDA, AF, LDAF, IPIV, X,
132 $ info, work, rwork )
141 INTEGER N, LDA, LDAF, INFO
145 COMPLEX A( lda, * ), AF( ldaf, * ), WORK( * ), X( * )
153 REAL AINVNM, ANORM, TMP
174 cabs1( zdum ) = abs(
REAL( ZDUM ) ) + abs( AIMAG( zdum ) )
181 upper = lsame( uplo,
'U' )
182 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
184 ELSE IF ( n.LT.0 )
THEN
186 ELSE IF( lda.LT.max( 1, n ) )
THEN
188 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
192 CALL xerbla(
'CLA_HERCOND_X', -info )
196 IF ( lsame( uplo,
'U' ) ) up = .true.
205 tmp = tmp + cabs1( a( j, i ) * x( j ) )
208 tmp = tmp + cabs1( a( i, j ) * x( j ) )
211 anorm = max( anorm, tmp )
217 tmp = tmp + cabs1( a( i, j ) * x( j ) )
220 tmp = tmp + cabs1( a( j, i ) * x( j ) )
223 anorm = max( anorm, tmp )
232 ELSE IF( anorm .EQ. 0.0e+0 )
THEN
242 CALL clacn2( n, work( n+1 ), work, ainvnm, kase, isave )
249 work( i ) = work( i ) * rwork( i )
253 CALL chetrs(
'U', n, 1, af, ldaf, ipiv,
256 CALL chetrs(
'L', n, 1, af, ldaf, ipiv,
263 work( i ) = work( i ) / x( i )
270 work( i ) = work( i ) / x( i )
274 CALL chetrs(
'U', n, 1, af, ldaf, ipiv,
277 CALL chetrs(
'L', n, 1, af, ldaf, ipiv,
284 work( i ) = work( i ) * rwork( i )
292 IF( ainvnm .NE. 0.0e+0 )
real function cla_hercond_x(UPLO, N, A, LDA, AF, LDAF, IPIV, X, INFO, WORK, RWORK)
CLA_HERCOND_X computes the infinity norm condition number of op(A)*diag(x) for Hermitian indefinite m...
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 chetrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CHETRS