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
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 )
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