205 SUBROUTINE zgbrfs( 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 DOUBLE PRECISION berr( * ), ferr( * ), rwork( * )
221 COMPLEX*16 ab( ldab, * ), afb( ldafb, * ), b( ldb, * ),
222 $ work( * ), x( ldx, * )
229 parameter( itmax = 5 )
230 DOUBLE PRECISION zero
231 parameter( zero = 0.0d+0 )
233 parameter( cone = ( 1.0d+0, 0.0d+0 ) )
235 parameter( two = 2.0d+0 )
236 DOUBLE PRECISION three
237 parameter( three = 3.0d+0 )
241 CHARACTER transn, transt
242 INTEGER count, i, j, k, kase, kk, nz
243 DOUBLE PRECISION eps, lstres, s, safe1, safe2, safmin, xk
253 INTRINSIC abs, dble, dimag, max, min
261 DOUBLE PRECISION cabs1
264 cabs1( zdum ) = abs( dble( zdum ) ) + abs( dimag( 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(
'ZGBRFS', -info )
299 IF( n.EQ.0 .OR. nrhs.EQ.0 )
THEN
317 nz = min( kl+ku+2, n+1 )
319 safmin =
dlamch(
'Safe minimum' )
336 CALL
zcopy( n, b( 1, j ), 1, work, 1 )
337 CALL
zgbmv( 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
zgbtrs( trans, n, kl, ku, 1, afb, ldafb, ipiv, work, n,
397 CALL
zaxpy( 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
zlacn2( n, work( n+1 ), work, ferr( j ), kase, isave )
442 CALL
zgbtrs( transt, n, kl, ku, 1, afb, ldafb, ipiv,
445 work( i ) = rwork( i )*work( i )
452 work( i ) = rwork( i )*work( i )
454 CALL
zgbtrs( transn, n, kl, ku, 1, afb, ldafb, ipiv,
464 lstres = max( lstres, cabs1( x( i, j ) ) )
467 $ ferr( j ) = ferr( j ) / lstres