369 SUBROUTINE zgbsvx( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB,
370 $ ldafb, ipiv, equed, r, c, b, ldb, x, ldx,
371 $ rcond, ferr, berr, work, rwork, info )
379 CHARACTER equed, fact, trans
380 INTEGER info, kl, ku, ldab, ldafb, ldb, ldx, n, nrhs
381 DOUBLE PRECISION rcond
385 DOUBLE PRECISION berr( * ), c( * ), ferr( * ), r( * ),
387 COMPLEX*16 ab( ldab, * ), afb( ldafb, * ), b( ldb, * ),
388 $ work( * ), x( ldx, * )
397 DOUBLE PRECISION zero, one
398 parameter( zero = 0.0d+0, one = 1.0d+0 )
401 LOGICAL colequ, equil, nofact, notran, rowequ
403 INTEGER i, infequ, j, j1, j2
404 DOUBLE PRECISION amax, anorm, bignum, colcnd, rcmax, rcmin,
405 $ rowcnd, rpvgrw, smlnum
417 INTRINSIC abs, max, min
422 nofact =
lsame( fact,
'N' )
423 equil =
lsame( fact,
'E' )
424 notran =
lsame( trans,
'N' )
425 IF( nofact .OR. equil )
THEN
430 rowequ =
lsame( equed,
'R' ) .OR.
lsame( equed,
'B' )
431 colequ =
lsame( equed,
'C' ) .OR.
lsame( equed,
'B' )
432 smlnum =
dlamch(
'Safe minimum' )
433 bignum = one / smlnum
438 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.
lsame( fact,
'F' ) )
441 ELSE IF( .NOT.notran .AND. .NOT.
lsame( trans,
'T' ) .AND. .NOT.
442 $
lsame( trans,
'C' ) )
THEN
444 ELSE IF( n.LT.0 )
THEN
446 ELSE IF( kl.LT.0 )
THEN
448 ELSE IF( ku.LT.0 )
THEN
450 ELSE IF( nrhs.LT.0 )
THEN
452 ELSE IF( ldab.LT.kl+ku+1 )
THEN
454 ELSE IF( ldafb.LT.2*kl+ku+1 )
THEN
456 ELSE IF(
lsame( fact,
'F' ) .AND. .NOT.
457 $ ( rowequ .OR. colequ .OR.
lsame( equed,
'N' ) ) )
THEN
464 rcmin = min( rcmin, r( j ) )
465 rcmax = max( rcmax, r( j ) )
467 IF( rcmin.LE.zero )
THEN
469 ELSE IF( n.GT.0 )
THEN
470 rowcnd = max( rcmin, smlnum ) / min( rcmax, bignum )
475 IF( colequ .AND. info.EQ.0 )
THEN
479 rcmin = min( rcmin, c( j ) )
480 rcmax = max( rcmax, c( j ) )
482 IF( rcmin.LE.zero )
THEN
484 ELSE IF( n.GT.0 )
THEN
485 colcnd = max( rcmin, smlnum ) / min( rcmax, bignum )
491 IF( ldb.LT.max( 1, n ) )
THEN
493 ELSE IF( ldx.LT.max( 1, n ) )
THEN
500 CALL
xerbla(
'ZGBSVX', -info )
508 CALL
zgbequ( n, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,
510 IF( infequ.EQ.0 )
THEN
514 CALL
zlaqgb( n, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,
516 rowequ =
lsame( equed,
'R' ) .OR.
lsame( equed,
'B' )
517 colequ =
lsame( equed,
'C' ) .OR.
lsame( equed,
'B' )
527 b( i, j ) = r( i )*b( i, j )
531 ELSE IF( colequ )
THEN
534 b( i, j ) = c( i )*b( i, j )
539 IF( nofact .OR. equil )
THEN
546 CALL
zcopy( j2-j1+1, ab( ku+1-j+j1, j ), 1,
547 $ afb( kl+ku+1-j+j1, j ), 1 )
550 CALL
zgbtrf( n, n, kl, ku, afb, ldafb, ipiv, info )
561 DO 80 i = max( ku+2-j, 1 ), min( n+ku+1-j, kl+ku+1 )
562 anorm = max( anorm, abs( ab( i, j ) ) )
565 rpvgrw =
zlantb(
'M',
'U',
'N', info, min( info-1, kl+ku ),
566 $ afb( max( 1, kl+ku+2-info ), 1 ), ldafb,
568 IF( rpvgrw.EQ.zero )
THEN
571 rpvgrw = anorm / rpvgrw
587 anorm =
zlangb( norm, n, kl, ku, ab, ldab, rwork )
588 rpvgrw =
zlantb(
'M',
'U',
'N', n, kl+ku, afb, ldafb, rwork )
589 IF( rpvgrw.EQ.zero )
THEN
592 rpvgrw =
zlangb(
'M', n, kl, ku, ab, ldab, rwork ) / rpvgrw
597 CALL
zgbcon( norm, n, kl, ku, afb, ldafb, ipiv, anorm, rcond,
598 $ work, rwork, info )
602 CALL
zlacpy(
'Full', n, nrhs, b, ldb, x, ldx )
603 CALL
zgbtrs( trans, n, kl, ku, nrhs, afb, ldafb, ipiv, x, ldx,
609 CALL
zgbrfs( trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv,
610 $ b, ldb, x, ldx, ferr, berr, work, rwork, info )
619 x( i, j ) = c( i )*x( i, j )
623 ferr( j ) = ferr( j ) / colcnd
626 ELSE IF( rowequ )
THEN
629 x( i, j ) = r( i )*x( i, j )
633 ferr( j ) = ferr( j ) / rowcnd
639 IF( rcond.LT.
dlamch(
'Epsilon' ) )