140 $ ldaf, ipiv, c, capply,
141 $ info, work, rwork )
151 INTEGER n, lda, ldaf, info
155 COMPLEX*16 a( lda, * ), af( ldaf, * ), work( * )
156 DOUBLE PRECISION c ( * ), rwork( * )
163 DOUBLE PRECISION ainvnm, anorm, tmp
181 DOUBLE PRECISION cabs1
184 cabs1( zdum ) = abs( dble( zdum ) ) + abs( dimag( zdum ) )
191 upper =
lsame( uplo,
'U' )
192 IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
194 ELSE IF( n.LT.0 )
THEN
196 ELSE IF( lda.LT.max( 1, n ) )
THEN
198 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
202 CALL
xerbla(
'ZLA_HERCOND_C', -info )
206 IF (
lsame( uplo,
'U' ) ) up = .true.
216 tmp = tmp + cabs1( a(
j, i ) ) / c(
j )
219 tmp = tmp + cabs1( a( i,
j ) ) / c(
j )
223 tmp = tmp + cabs1( a(
j, i ) )
226 tmp = tmp + cabs1( a( i,
j ) )
230 anorm = max( anorm, tmp )
237 tmp = tmp + cabs1( a( i,
j ) ) / c(
j )
240 tmp = tmp + cabs1( a(
j, i ) ) / c(
j )
244 tmp = tmp + cabs1( a( i,
j ) )
247 tmp = tmp + cabs1( a(
j, i ) )
251 anorm = max( anorm, tmp )
260 ELSE IF( anorm .EQ. 0.0d+0 )
THEN
270 CALL
zlacn2( n, work( n+1 ), work, ainvnm, kase, isave )
277 work( i ) = work( i ) * rwork( i )
281 CALL
zhetrs(
'U', n, 1, af, ldaf, ipiv,
284 CALL
zhetrs(
'L', n, 1, af, ldaf, ipiv,
292 work( i ) = work( i ) * c( i )
301 work( i ) = work( i ) * c( i )
306 CALL
zhetrs(
'U', n, 1, af, ldaf, ipiv,
309 CALL
zhetrs(
'L', n, 1, af, ldaf, ipiv,
316 work( i ) = work( i ) * rwork( i )
324 IF( ainvnm .NE. 0.0d+0 )
double precision function zla_hercond_c(UPLO, N, A, LDA, AF, LDAF, IPIV, C, CAPPLY, INFO, WORK, RWORK)
ZLA_HERCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for Hermitian indefin...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zlacn2(N, V, X, EST, KASE, ISAVE)
ZLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
logical function lsame(CA, CB)
LSAME
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine zhetrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZHETRS