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 dgbequ(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
DGBEQU
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dgbrfs(TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DGBRFS
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...
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 dgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
DGBTRS
subroutine dgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
DGBTRF
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine dgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DGBCON