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' ) )
subroutine cgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
CGBTRF
subroutine claqgb(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, EQUED)
CLAQGB scales a general band matrix, using row and column scaling factors computed by sgbequ...
subroutine xerbla(SRNAME, INFO)
XERBLA
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 ...
subroutine cgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, RWORK, INFO)
CGBCON
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine cgbequ(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
CGBEQU
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine cgbrfs(TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CGBRFS
subroutine cgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
CGBTRS