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 cgbrfs(TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CGBRFS
subroutine cgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, RWORK, INFO)
CGBCON
subroutine cgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
CGBTRF
subroutine cgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
CGBTRS
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 xerbla(SRNAME, INFO)
XERBLA
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 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...