153 REAL FUNCTION cla_gbrcond_x( TRANS, N, KL, KU, AB, LDAB, AFB,
154 $ ldafb, ipiv, x, info, work, rwork )
163 INTEGER N, KL, KU, KD, KE, LDAB, LDAFB, INFO
167 COMPLEX AB( ldab, * ), AFB( ldafb, * ), WORK( * ),
177 REAL AINVNM, ANORM, TMP
197 cabs1( zdum ) = abs(
REAL( ZDUM ) ) + abs( AIMAG( zdum ) )
204 notrans = lsame( trans,
'N' )
205 IF ( .NOT. notrans .AND. .NOT. lsame(trans,
'T') .AND. .NOT.
206 $ lsame( trans,
'C' ) )
THEN
208 ELSE IF( n.LT.0 )
THEN
210 ELSE IF( kl.LT.0 .OR. kl.GT.n-1 )
THEN
212 ELSE IF( ku.LT.0 .OR. ku.GT.n-1 )
THEN
214 ELSE IF( ldab.LT.kl+ku+1 )
THEN
216 ELSE IF( ldafb.LT.2*kl+ku+1 )
THEN
220 CALL xerbla(
'CLA_GBRCOND_X', -info )
232 DO j = max( i-kl, 1 ), min( i+ku, n )
233 tmp = tmp + cabs1( ab( kd+i-j, j) * x( j ) )
236 anorm = max( anorm, tmp )
241 DO j = max( i-kl, 1 ), min( i+ku, n )
242 tmp = tmp + cabs1( ab( ke-i+j, i ) * x( j ) )
245 anorm = max( anorm, tmp )
254 ELSE IF( anorm .EQ. 0.0e+0 )
THEN
264 CALL clacn2( n, work( n+1 ), work, ainvnm, kase, isave )
271 work( i ) = work( i ) * rwork( i )
275 CALL cgbtrs(
'No transpose', n, kl, ku, 1, afb, ldafb,
276 $ ipiv, work, n, info )
278 CALL cgbtrs(
'Conjugate transpose', n, kl, ku, 1, afb,
279 $ ldafb, ipiv, work, n, info )
285 work( i ) = work( i ) / x( i )
292 work( i ) = work( i ) / x( i )
296 CALL cgbtrs(
'Conjugate transpose', n, kl, ku, 1, afb,
297 $ ldafb, ipiv, work, n, info )
299 CALL cgbtrs(
'No transpose', n, kl, ku, 1, afb, ldafb,
300 $ ipiv, work, n, info )
306 work( i ) = work( i ) * rwork( i )
314 IF( ainvnm .NE. 0.0e+0 )
real function cla_gbrcond_x(TRANS, N, KL, KU, AB, LDAB, AFB, LDAFB, IPIV, X, INFO, WORK, RWORK)
CLA_GBRCOND_X computes the infinity norm condition number of op(A)*diag(x) for general banded matrice...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
CGBTRS
subroutine clacn2(N, V, X, EST, KASE, ISAVE)
CLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...