365 SUBROUTINE cgbsvx( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB,
366 $ LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX,
367 $ RCOND, FERR, BERR, WORK, RWORK, INFO )
374 CHARACTER EQUED, FACT, TRANS
375 INTEGER INFO, KL, KU, LDAB, LDAFB, LDB, LDX, N, NRHS
380 REAL BERR( * ), C( * ), FERR( * ), R( * ),
382 COMPLEX AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ),
383 $ WORK( * ), X( LDX, * )
393 PARAMETER ( ZERO = 0.0e+0, one = 1.0e+0 )
396 LOGICAL COLEQU, EQUIL, NOFACT, NOTRAN, ROWEQU
398 INTEGER I, INFEQU, J, J1, J2
399 REAL AMAX, ANORM, BIGNUM, COLCND, RCMAX, RCMIN,
400 $ rowcnd, rpvgrw, smlnum
404 REAL CLANGB, CLANTB, SLAMCH
405 EXTERNAL lsame, clangb, clantb, slamch
413 INTRINSIC abs, max, min
418 nofact = lsame( fact,
'N' )
419 equil = lsame( fact,
'E' )
420 notran = lsame( trans,
'N' )
421 IF( nofact .OR. equil )
THEN
426 rowequ = lsame( equed,
'R' ) .OR. lsame( equed,
'B' )
427 colequ = lsame( equed,
'C' ) .OR. lsame( equed,
'B' )
428 smlnum = slamch(
'Safe minimum' )
429 bignum = one / smlnum
434 IF( .NOT.nofact .AND.
436 $ .NOT.lsame( fact,
'F' ) )
439 ELSE IF( .NOT.notran .AND. .NOT.lsame( trans,
'T' ) .AND. .NOT.
440 $ lsame( trans,
'C' ) )
THEN
442 ELSE IF( n.LT.0 )
THEN
444 ELSE IF( kl.LT.0 )
THEN
446 ELSE IF( ku.LT.0 )
THEN
448 ELSE IF( nrhs.LT.0 )
THEN
450 ELSE IF( ldab.LT.kl+ku+1 )
THEN
452 ELSE IF( ldafb.LT.2*kl+ku+1 )
THEN
454 ELSE IF( lsame( fact,
'F' ) .AND. .NOT.
455 $ ( rowequ .OR. colequ .OR. lsame( equed,
'N' ) ) )
THEN
462 rcmin = min( rcmin, r( j ) )
463 rcmax = max( rcmax, r( j ) )
465 IF( rcmin.LE.zero )
THEN
467 ELSE IF( n.GT.0 )
THEN
468 rowcnd = max( rcmin, smlnum ) / min( rcmax, bignum )
473 IF( colequ .AND. info.EQ.0 )
THEN
477 rcmin = min( rcmin, c( j ) )
478 rcmax = max( rcmax, c( j ) )
480 IF( rcmin.LE.zero )
THEN
482 ELSE IF( n.GT.0 )
THEN
483 colcnd = max( rcmin, smlnum ) / min( rcmax, bignum )
489 IF( ldb.LT.max( 1, n ) )
THEN
491 ELSE IF( ldx.LT.max( 1, n ) )
THEN
498 CALL xerbla(
'CGBSVX', -info )
506 CALL cgbequ( n, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,
508 IF( infequ.EQ.0 )
THEN
512 CALL claqgb( n, n, kl, ku, ab, ldab, r, c, rowcnd,
515 rowequ = lsame( equed,
'R' ) .OR. lsame( equed,
'B' )
516 colequ = lsame( equed,
'C' ) .OR. lsame( equed,
'B' )
526 b( i, j ) = r( i )*b( i, j )
530 ELSE IF( colequ )
THEN
533 b( i, j ) = c( i )*b( i, j )
538 IF( nofact .OR. equil )
THEN
545 CALL ccopy( j2-j1+1, ab( ku+1-j+j1, j ), 1,
546 $ afb( kl+ku+1-j+j1, j ), 1 )
549 CALL cgbtrf( n, n, kl, ku, afb, ldafb, ipiv, info )
560 DO 80 i = max( ku+2-j, 1 ), min( n+ku+1-j, kl+ku+1 )
561 anorm = max( anorm, abs( ab( i, j ) ) )
564 rpvgrw = clantb(
'M',
'U',
'N', info, min( info-1,
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,
611 $ b, ldb, x, ldx, ferr, berr, work, rwork, info )
620 x( i, j ) = c( i )*x( i, j )
624 ferr( j ) = ferr( j ) / colcnd
627 ELSE IF( rowequ )
THEN
630 x( i, j ) = r( i )*x( i, j )
634 ferr( j ) = ferr( j ) / rowcnd
640 IF( rcond.LT.slamch(
'Epsilon' ) )
subroutine cgbsvx(fact, trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv, equed, r, c, b, ldb, x, ldx, rcond, ferr, berr, work, rwork, info)
CGBSVX computes the solution to system of linear equations A * X = B for GB matrices