154 DOUBLE PRECISION FUNCTION zla_gbrcond_x( TRANS, N, KL, KU, AB,
155 $ ldab, afb, ldafb, ipiv,
156 $ x, info, work, rwork )
165 INTEGER N, KL, KU, KD, KE, LDAB, LDAFB, INFO
169 COMPLEX*16 AB( ldab, * ), AFB( ldafb, * ), WORK( * ),
171 DOUBLE PRECISION RWORK( * )
179 DOUBLE PRECISION AINVNM, ANORM, TMP
196 DOUBLE PRECISION CABS1
199 cabs1( zdum ) = abs( dble( zdum ) ) + abs( dimag( zdum ) )
206 notrans = lsame( trans,
'N' )
207 IF ( .NOT. notrans .AND. .NOT. lsame(trans,
'T') .AND. .NOT.
208 $ lsame( trans,
'C' ) )
THEN
210 ELSE IF( n.LT.0 )
THEN
212 ELSE IF( kl.LT.0 .OR. kl.GT.n-1 )
THEN
214 ELSE IF( ku.LT.0 .OR. ku.GT.n-1 )
THEN
216 ELSE IF( ldab.LT.kl+ku+1 )
THEN
218 ELSE IF( ldafb.LT.2*kl+ku+1 )
THEN
222 CALL xerbla(
'ZLA_GBRCOND_X', -info )
234 DO j = max( i-kl, 1 ), min( i+ku, n )
235 tmp = tmp + cabs1( ab( kd+i-j, j) * x( j ) )
238 anorm = max( anorm, tmp )
243 DO j = max( i-kl, 1 ), min( i+ku, n )
244 tmp = tmp + cabs1( ab( ke-i+j, i ) * x( j ) )
247 anorm = max( anorm, tmp )
256 ELSE IF( anorm .EQ. 0.0d+0 )
THEN
266 CALL zlacn2( n, work( n+1 ), work, ainvnm, kase, isave )
273 work( i ) = work( i ) * rwork( i )
277 CALL zgbtrs(
'No transpose', n, kl, ku, 1, afb, ldafb,
278 $ ipiv, work, n, info )
280 CALL zgbtrs(
'Conjugate transpose', n, kl, ku, 1, afb,
281 $ ldafb, ipiv, work, n, info )
287 work( i ) = work( i ) / x( i )
294 work( i ) = work( i ) / x( i )
298 CALL zgbtrs(
'Conjugate transpose', n, kl, ku, 1, afb,
299 $ ldafb, ipiv, work, n, info )
301 CALL zgbtrs(
'No transpose', n, kl, ku, 1, afb, ldafb,
302 $ ipiv, work, n, info )
308 work( i ) = work( i ) * rwork( i )
316 IF( ainvnm .NE. 0.0d+0 )
subroutine zgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
ZGBTRS
subroutine zlacn2(N, V, X, EST, KASE, ISAVE)
ZLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
double precision function zla_gbrcond_x(TRANS, N, KL, KU, AB, LDAB, AFB, LDAFB, IPIV, X, INFO, WORK, RWORK)
ZLA_GBRCOND_X computes the infinity norm condition number of op(A)*diag(x) for general banded matrice...
subroutine xerbla(SRNAME, INFO)
XERBLA