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
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' ) )
real function clantb(NORM, UPLO, DIAG, N, K, AB, LDAB, WORK)
CLANTB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular band matrix.
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 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
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
logical function lsame(CA, CB)
LSAME
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
real function slamch(CMACH)
SLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine cgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, RWORK, INFO)
CGBCON
subroutine cgbequ(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
CGBEQU
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine cgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
CGBTRS
subroutine cgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
CGBTRF
subroutine cgbrfs(TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CGBRFS
real function clangb(NORM, N, KL, KU, AB, LDAB, WORK)
CLANGB returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...