366 SUBROUTINE dgbsvx( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB,
367 $ LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX,
368 $ RCOND, FERR, BERR, WORK, IWORK, INFO )
375 CHARACTER EQUED, FACT, TRANS
376 INTEGER INFO, KL, KU, LDAB, LDAFB, LDB, LDX, N, NRHS
377 DOUBLE PRECISION RCOND
380 INTEGER IPIV( * ), IWORK( * )
381 DOUBLE PRECISION AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ),
382 $ berr( * ), c( * ), ferr( * ), r( * ),
383 $ work( * ), x( ldx, * )
389 DOUBLE PRECISION ZERO, ONE
390 PARAMETER ( ZERO = 0.0d+0, one = 1.0d+0 )
393 LOGICAL COLEQU, EQUIL, NOFACT, NOTRAN, ROWEQU
395 INTEGER I, INFEQU, J, J1, J2
396 DOUBLE PRECISION AMAX, ANORM, BIGNUM, COLCND, RCMAX, RCMIN,
397 $ rowcnd, rpvgrw, smlnum
401 DOUBLE PRECISION DLAMCH, DLANGB, DLANTB
402 EXTERNAL lsame, dlamch, dlangb, dlantb
409 INTRINSIC abs, max, min
414 nofact = lsame( fact,
'N' )
415 equil = lsame( fact,
'E' )
416 notran = lsame( trans,
'N' )
417 IF( nofact .OR. equil )
THEN
422 rowequ = lsame( equed,
'R' ) .OR. lsame( equed,
'B' )
423 colequ = lsame( equed,
'C' ) .OR. lsame( equed,
'B' )
424 smlnum = dlamch(
'Safe minimum' )
425 bignum = one / smlnum
430 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.lsame( fact,
'F' ) )
433 ELSE IF( .NOT.notran .AND. .NOT.lsame( trans,
'T' ) .AND. .NOT.
434 $ lsame( trans,
'C' ) )
THEN
436 ELSE IF( n.LT.0 )
THEN
438 ELSE IF( kl.LT.0 )
THEN
440 ELSE IF( ku.LT.0 )
THEN
442 ELSE IF( nrhs.LT.0 )
THEN
444 ELSE IF( ldab.LT.kl+ku+1 )
THEN
446 ELSE IF( ldafb.LT.2*kl+ku+1 )
THEN
448 ELSE IF( lsame( fact,
'F' ) .AND. .NOT.
449 $ ( rowequ .OR. colequ .OR. lsame( equed,
'N' ) ) )
THEN
456 rcmin = min( rcmin, r( j ) )
457 rcmax = max( rcmax, r( j ) )
459 IF( rcmin.LE.zero )
THEN
461 ELSE IF( n.GT.0 )
THEN
462 rowcnd = max( rcmin, smlnum ) / min( rcmax, bignum )
467 IF( colequ .AND. info.EQ.0 )
THEN
471 rcmin = min( rcmin, c( j ) )
472 rcmax = max( rcmax, c( j ) )
474 IF( rcmin.LE.zero )
THEN
476 ELSE IF( n.GT.0 )
THEN
477 colcnd = max( rcmin, smlnum ) / min( rcmax, bignum )
483 IF( ldb.LT.max( 1, n ) )
THEN
485 ELSE IF( ldx.LT.max( 1, n ) )
THEN
492 CALL xerbla(
'DGBSVX', -info )
500 CALL dgbequ( n, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,
502 IF( infequ.EQ.0 )
THEN
506 CALL dlaqgb( n, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,
508 rowequ = lsame( equed,
'R' ) .OR. lsame( equed,
'B' )
509 colequ = lsame( equed,
'C' ) .OR. lsame( equed,
'B' )
519 b( i, j ) = r( i )*b( i, j )
523 ELSE IF( colequ )
THEN
526 b( i, j ) = c( i )*b( i, j )
531 IF( nofact .OR. equil )
THEN
538 CALL dcopy( j2-j1+1, ab( ku+1-j+j1, j ), 1,
539 $ afb( kl+ku+1-j+j1, j ), 1 )
542 CALL dgbtrf( n, n, kl, ku, afb, ldafb, ipiv, info )
553 DO 80 i = max( ku+2-j, 1 ), min( n+ku+1-j, kl+ku+1 )
554 anorm = max( anorm, abs( ab( i, j ) ) )
557 rpvgrw = dlantb(
'M',
'U',
'N', info, min( info-1, kl+ku ),
558 $ afb( max( 1, kl+ku+2-info ), 1 ), ldafb,
560 IF( rpvgrw.EQ.zero )
THEN
563 rpvgrw = anorm / rpvgrw
579 anorm = dlangb( norm, n, kl, ku, ab, ldab, work )
580 rpvgrw = dlantb(
'M',
'U',
'N', n, kl+ku, afb, ldafb, work )
581 IF( rpvgrw.EQ.zero )
THEN
584 rpvgrw = dlangb(
'M', n, kl, ku, ab, ldab, work ) / rpvgrw
589 CALL dgbcon( norm, n, kl, ku, afb, ldafb, ipiv, anorm, rcond,
590 $ work, iwork, info )
594 CALL dlacpy(
'Full', n, nrhs, b, ldb, x, ldx )
595 CALL dgbtrs( trans, n, kl, ku, nrhs, afb, ldafb, ipiv, x, ldx,
601 CALL dgbrfs( trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv,
602 $ b, ldb, x, ldx, ferr, berr, work, iwork, info )
611 x( i, j ) = c( i )*x( i, j )
615 ferr( j ) = ferr( j ) / colcnd
618 ELSE IF( rowequ )
THEN
621 x( i, j ) = r( i )*x( i, j )
625 ferr( j ) = ferr( j ) / rowcnd
631 IF( rcond.LT.dlamch(
'Epsilon' ) )
subroutine xerbla(srname, info)
subroutine dcopy(n, dx, incx, dy, incy)
DCOPY
subroutine dgbcon(norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond, work, iwork, info)
DGBCON
subroutine dgbequ(m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd, amax, info)
DGBEQU
subroutine dgbrfs(trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork, info)
DGBRFS
subroutine dgbsvx(fact, trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv, equed, r, c, b, ldb, x, ldx, rcond, ferr, berr, work, iwork, info)
DGBSVX computes the solution to system of linear equations A * X = B for GB matrices
subroutine dgbtrf(m, n, kl, ku, ab, ldab, ipiv, info)
DGBTRF
subroutine dgbtrs(trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info)
DGBTRS
subroutine dlacpy(uplo, m, n, a, lda, b, ldb)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dlaqgb(m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd, amax, equed)
DLAQGB scales a general band matrix, using row and column scaling factors computed by sgbequ.