368 SUBROUTINE dgbsvx( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB,
369 $ ldafb, ipiv, equed, r, c, b, ldb, x, ldx,
370 $ rcond, ferr, berr, work, iwork, info )
378 CHARACTER equed, fact, trans
379 INTEGER info, kl, ku, ldab, ldafb, ldb, ldx, n, nrhs
380 DOUBLE PRECISION rcond
383 INTEGER ipiv( * ), iwork( * )
384 DOUBLE PRECISION ab( ldab, * ), afb( ldafb, * ), b( ldb, * ),
385 $ berr( * ), c( * ), ferr( * ), r( * ),
386 $ work( * ), x( ldx, * )
392 DOUBLE PRECISION zero, one
393 parameter( zero = 0.0d+0, one = 1.0d+0 )
396 LOGICAL colequ, equil, nofact, notran, rowequ
398 INTEGER i, infequ, j, j1, j2
399 DOUBLE PRECISION amax, anorm, bignum, colcnd, rcmax, rcmin,
400 $ rowcnd, rpvgrw, smlnum
412 INTRINSIC abs, max, min
417 nofact =
lsame( fact,
'N' )
418 equil =
lsame( fact,
'E' )
419 notran =
lsame( trans,
'N' )
420 IF( nofact .OR. equil )
THEN
425 rowequ =
lsame( equed,
'R' ) .OR.
lsame( equed,
'B' )
426 colequ =
lsame( equed,
'C' ) .OR.
lsame( equed,
'B' )
427 smlnum =
dlamch(
'Safe minimum' )
428 bignum = one / smlnum
433 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.
lsame( fact,
'F' ) )
436 ELSE IF( .NOT.notran .AND. .NOT.
lsame( trans,
'T' ) .AND. .NOT.
437 $
lsame( trans,
'C' ) )
THEN
439 ELSE IF( n.LT.0 )
THEN
441 ELSE IF( kl.LT.0 )
THEN
443 ELSE IF( ku.LT.0 )
THEN
445 ELSE IF( nrhs.LT.0 )
THEN
447 ELSE IF( ldab.LT.kl+ku+1 )
THEN
449 ELSE IF( ldafb.LT.2*kl+ku+1 )
THEN
451 ELSE IF(
lsame( fact,
'F' ) .AND. .NOT.
452 $ ( rowequ .OR. colequ .OR.
lsame( equed,
'N' ) ) )
THEN
459 rcmin = min( rcmin, r( j ) )
460 rcmax = max( rcmax, r( j ) )
462 IF( rcmin.LE.zero )
THEN
464 ELSE IF( n.GT.0 )
THEN
465 rowcnd = max( rcmin, smlnum ) / min( rcmax, bignum )
470 IF( colequ .AND. info.EQ.0 )
THEN
474 rcmin = min( rcmin, c( j ) )
475 rcmax = max( rcmax, c( j ) )
477 IF( rcmin.LE.zero )
THEN
479 ELSE IF( n.GT.0 )
THEN
480 colcnd = max( rcmin, smlnum ) / min( rcmax, bignum )
486 IF( ldb.LT.max( 1, n ) )
THEN
488 ELSE IF( ldx.LT.max( 1, n ) )
THEN
495 CALL
xerbla(
'DGBSVX', -info )
503 CALL
dgbequ( n, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,
505 IF( infequ.EQ.0 )
THEN
509 CALL
dlaqgb( n, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,
511 rowequ =
lsame( equed,
'R' ) .OR.
lsame( equed,
'B' )
512 colequ =
lsame( equed,
'C' ) .OR.
lsame( equed,
'B' )
522 b( i, j ) = r( i )*b( i, j )
526 ELSE IF( colequ )
THEN
529 b( i, j ) = c( i )*b( i, j )
534 IF( nofact .OR. equil )
THEN
541 CALL
dcopy( j2-j1+1, ab( ku+1-j+j1, j ), 1,
542 $ afb( kl+ku+1-j+j1, j ), 1 )
545 CALL
dgbtrf( n, n, kl, ku, afb, ldafb, ipiv, info )
556 DO 80 i = max( ku+2-j, 1 ), min( n+ku+1-j, kl+ku+1 )
557 anorm = max( anorm, abs( ab( i, j ) ) )
560 rpvgrw =
dlantb(
'M',
'U',
'N', info, min( info-1, kl+ku ),
561 $ afb( max( 1, kl+ku+2-info ), 1 ), ldafb,
563 IF( rpvgrw.EQ.zero )
THEN
566 rpvgrw = anorm / rpvgrw
582 anorm =
dlangb( norm, n, kl, ku, ab, ldab, work )
583 rpvgrw =
dlantb(
'M',
'U',
'N', n, kl+ku, afb, ldafb, work )
584 IF( rpvgrw.EQ.zero )
THEN
587 rpvgrw =
dlangb(
'M', n, kl, ku, ab, ldab, work ) / rpvgrw
592 CALL
dgbcon( norm, n, kl, ku, afb, ldafb, ipiv, anorm, rcond,
593 $ work, iwork, info )
597 CALL
dlacpy(
'Full', n, nrhs, b, ldb, x, ldx )
598 CALL
dgbtrs( trans, n, kl, ku, nrhs, afb, ldafb, ipiv, x, ldx,
604 CALL
dgbrfs( trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv,
605 $ b, ldb, x, ldx, ferr, berr, work, iwork, info )
614 x( i, j ) = c( i )*x( i, j )
618 ferr( j ) = ferr( j ) / colcnd
621 ELSE IF( rowequ )
THEN
624 x( i, j ) = r( i )*x( i, j )
628 ferr( j ) = ferr( j ) / rowcnd
634 IF( rcond.LT.
dlamch(
'Epsilon' ) )