205 SUBROUTINE cgbrfs( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB,
206 $ ipiv, b, ldb, x, ldx, ferr, berr, work, rwork,
216 INTEGER INFO, KL, KU, LDAB, LDAFB, LDB, LDX, N, NRHS
220 REAL BERR( * ), FERR( * ), RWORK( * )
221 COMPLEX AB( ldab, * ), AFB( ldafb, * ), B( ldb, * ),
222 $ work( * ), x( ldx, * )
229 parameter ( itmax = 5 )
231 parameter ( zero = 0.0e+0 )
233 parameter ( cone = ( 1.0e+0, 0.0e+0 ) )
235 parameter ( two = 2.0e+0 )
237 parameter ( three = 3.0e+0 )
241 CHARACTER TRANSN, TRANST
242 INTEGER COUNT, I, J, K, KASE, KK, NZ
243 REAL EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
253 INTRINSIC abs, aimag, max, min, real
258 EXTERNAL lsame, slamch
264 cabs1( zdum ) = abs(
REAL( ZDUM ) ) + abs( AIMAG( zdum ) )
271 notran = lsame( trans,
'N' )
272 IF( .NOT.notran .AND. .NOT.lsame( trans,
'T' ) .AND. .NOT.
273 $ lsame( trans,
'C' ) )
THEN
275 ELSE IF( n.LT.0 )
THEN
277 ELSE IF( kl.LT.0 )
THEN
279 ELSE IF( ku.LT.0 )
THEN
281 ELSE IF( nrhs.LT.0 )
THEN
283 ELSE IF( ldab.LT.kl+ku+1 )
THEN
285 ELSE IF( ldafb.LT.2*kl+ku+1 )
THEN
287 ELSE IF( ldb.LT.max( 1, n ) )
THEN
289 ELSE IF( ldx.LT.max( 1, n ) )
THEN
293 CALL xerbla(
'CGBRFS', -info )
299 IF( n.EQ.0 .OR. nrhs.EQ.0 )
THEN
317 nz = min( kl+ku+2, n+1 )
318 eps = slamch(
'Epsilon' )
319 safmin = slamch(
'Safe minimum' )
336 CALL ccopy( n, b( 1, j ), 1, work, 1 )
337 CALL cgbmv( trans, n, n, kl, ku, -cone, ab, ldab, x( 1, j ), 1,
350 rwork( i ) = cabs1( b( i, j ) )
358 xk = cabs1( x( k, j ) )
359 DO 40 i = max( 1, k-ku ), min( n, k+kl )
360 rwork( i ) = rwork( i ) + cabs1( ab( kk+i, k ) )*xk
367 DO 60 i = max( 1, k-ku ), min( n, k+kl )
368 s = s + cabs1( ab( kk+i, k ) )*cabs1( x( i, j ) )
370 rwork( k ) = rwork( k ) + s
375 IF( rwork( i ).GT.safe2 )
THEN
376 s = max( s, cabs1( work( i ) ) / rwork( i ) )
378 s = max( s, ( cabs1( work( i ) )+safe1 ) /
379 $ ( rwork( i )+safe1 ) )
390 IF( berr( j ).GT.eps .AND. two*berr( j ).LE.lstres .AND.
391 $ count.LE.itmax )
THEN
395 CALL cgbtrs( trans, n, kl, ku, 1, afb, ldafb, ipiv, work, n,
397 CALL caxpy( n, cone, work, 1, x( 1, j ), 1 )
426 IF( rwork( i ).GT.safe2 )
THEN
427 rwork( i ) = cabs1( work( i ) ) + nz*eps*rwork( i )
429 rwork( i ) = cabs1( work( i ) ) + nz*eps*rwork( i ) +
436 CALL clacn2( n, work( n+1 ), work, ferr( j ), kase, isave )
442 CALL cgbtrs( transt, n, kl, ku, 1, afb, ldafb, ipiv,
445 work( i ) = rwork( i )*work( i )
452 work( i ) = rwork( i )*work( i )
454 CALL cgbtrs( transn, n, kl, ku, 1, afb, ldafb, ipiv,
464 lstres = max( lstres, cabs1( x( i, j ) ) )
467 $ ferr( j ) = ferr( j ) / lstres
subroutine cgbmv(TRANS, M, N, KL, KU, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGBMV
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 ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine cgbrfs(TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CGBRFS
subroutine caxpy(N, CA, CX, INCX, CY, INCY)
CAXPY
subroutine cgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
CGBTRS