369 SUBROUTINE cgbsvx( 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
385 REAL BERR( * ), C( * ), FERR( * ), R( * ),
387 COMPLEX AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ),
388 $ WORK( * ), X( LDX, * )
398 PARAMETER ( ZERO = 0.0e+0, one = 1.0e+0 )
401 LOGICAL COLEQU, EQUIL, NOFACT, NOTRAN, ROWEQU
403 INTEGER I, INFEQU, J, J1, J2
404 REAL AMAX, ANORM, BIGNUM, COLCND, RCMAX, RCMIN,
405 $ rowcnd, rpvgrw, smlnum
409 REAL CLANGB, CLANTB, SLAMCH
410 EXTERNAL lsame, clangb, clantb, slamch
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 = slamch(
'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(
'CGBSVX', -info )
508 CALL cgbequ( n, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,
510 IF( infequ.EQ.0 )
THEN
514 CALL claqgb( 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 ccopy( j2-j1+1, ab( ku+1-j+j1, j ), 1,
547 $ afb( kl+ku+1-j+j1, j ), 1 )
550 CALL cgbtrf( 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 = clantb(
'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 = clangb( norm, n, kl, ku, ab, ldab, rwork )
588 rpvgrw = clantb(
'M',
'U',
'N', n, kl+ku, afb, ldafb, rwork )
589 IF( rpvgrw.EQ.zero )
THEN
592 rpvgrw = clangb(
'M', n, kl, ku, ab, ldab, rwork ) / rpvgrw
597 CALL cgbcon( norm, n, kl, ku, afb, ldafb, ipiv, anorm, rcond,
598 $ work, rwork, info )
602 CALL clacpy(
'Full', n, nrhs, b, ldb, x, ldx )
603 CALL cgbtrs( trans, n, kl, ku, nrhs, afb, ldafb, ipiv, x, ldx,
609 CALL cgbrfs( 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.slamch(
'Epsilon' ) )