365 SUBROUTINE sgbsvx( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB,
366 $ LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX,
367 $ RCOND, FERR, BERR, WORK, IWORK, INFO )
374 CHARACTER EQUED, FACT, TRANS
375 INTEGER INFO, KL, KU, LDAB, LDAFB, LDB, LDX, N, NRHS
379 INTEGER IPIV( * ), IWORK( * )
380 REAL AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ),
381 $ berr( * ), c( * ), ferr( * ), r( * ),
382 $ work( * ), x( ldx, * )
392 PARAMETER ( ZERO = 0.0e+0, one = 1.0e+0 )
395 LOGICAL COLEQU, EQUIL, NOFACT, NOTRAN, ROWEQU
397 INTEGER I, INFEQU, J, J1, J2
398 REAL AMAX, ANORM, BIGNUM, COLCND, RCMAX, RCMIN,
399 $ rowcnd, rpvgrw, smlnum
403 REAL SLAMCH, SLANGB, SLANTB
404 EXTERNAL lsame, slamch, slangb, slantb
411 INTRINSIC abs, max, min
416 nofact = lsame( fact,
'N' )
417 equil = lsame( fact,
'E' )
418 notran = lsame( trans,
'N' )
419 IF( nofact .OR. equil )
THEN
424 rowequ = lsame( equed,
'R' ) .OR. lsame( equed,
'B' )
425 colequ = lsame( equed,
'C' ) .OR. lsame( equed,
'B' )
426 smlnum = slamch(
'Safe minimum' )
427 bignum = one / smlnum
432 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.lsame( fact,
'F' ) )
435 ELSE IF( .NOT.notran .AND. .NOT.lsame( trans,
'T' ) .AND. .NOT.
436 $ lsame( trans,
'C' ) )
THEN
438 ELSE IF( n.LT.0 )
THEN
440 ELSE IF( kl.LT.0 )
THEN
442 ELSE IF( ku.LT.0 )
THEN
444 ELSE IF( nrhs.LT.0 )
THEN
446 ELSE IF( ldab.LT.kl+ku+1 )
THEN
448 ELSE IF( ldafb.LT.2*kl+ku+1 )
THEN
450 ELSE IF( lsame( fact,
'F' ) .AND. .NOT.
451 $ ( rowequ .OR. colequ .OR. lsame( equed,
'N' ) ) )
THEN
458 rcmin = min( rcmin, r( j ) )
459 rcmax = max( rcmax, r( j ) )
461 IF( rcmin.LE.zero )
THEN
463 ELSE IF( n.GT.0 )
THEN
464 rowcnd = max( rcmin, smlnum ) / min( rcmax, bignum )
469 IF( colequ .AND. info.EQ.0 )
THEN
473 rcmin = min( rcmin, c( j ) )
474 rcmax = max( rcmax, c( j ) )
476 IF( rcmin.LE.zero )
THEN
478 ELSE IF( n.GT.0 )
THEN
479 colcnd = max( rcmin, smlnum ) / min( rcmax, bignum )
485 IF( ldb.LT.max( 1, n ) )
THEN
487 ELSE IF( ldx.LT.max( 1, n ) )
THEN
494 CALL xerbla(
'SGBSVX', -info )
502 CALL sgbequ( n, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,
504 IF( infequ.EQ.0 )
THEN
508 CALL slaqgb( n, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,
510 rowequ = lsame( equed,
'R' ) .OR. lsame( equed,
'B' )
511 colequ = lsame( equed,
'C' ) .OR. lsame( equed,
'B' )
521 b( i, j ) = r( i )*b( i, j )
525 ELSE IF( colequ )
THEN
528 b( i, j ) = c( i )*b( i, j )
533 IF( nofact .OR. equil )
THEN
540 CALL scopy( j2-j1+1, ab( ku+1-j+j1, j ), 1,
541 $ afb( kl+ku+1-j+j1, j ), 1 )
544 CALL sgbtrf( n, n, kl, ku, afb, ldafb, ipiv, info )
555 DO 80 i = max( ku+2-j, 1 ), min( n+ku+1-j, kl+ku+1 )
556 anorm = max( anorm, abs( ab( i, j ) ) )
559 rpvgrw = slantb(
'M',
'U',
'N', info, min( info-1, kl+ku ),
560 $ afb( max( 1, kl+ku+2-info ), 1 ), ldafb,
562 IF( rpvgrw.EQ.zero )
THEN
565 rpvgrw = anorm / rpvgrw
581 anorm = slangb( norm, n, kl, ku, ab, ldab, work )
582 rpvgrw = slantb(
'M',
'U',
'N', n, kl+ku, afb, ldafb, work )
583 IF( rpvgrw.EQ.zero )
THEN
586 rpvgrw = slangb(
'M', n, kl, ku, ab, ldab, work ) / rpvgrw
591 CALL sgbcon( norm, n, kl, ku, afb, ldafb, ipiv, anorm, rcond,
592 $ work, iwork, info )
596 CALL slacpy(
'Full', n, nrhs, b, ldb, x, ldx )
597 CALL sgbtrs( trans, n, kl, ku, nrhs, afb, ldafb, ipiv, x, ldx,
603 CALL sgbrfs( trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv,
604 $ b, ldb, x, ldx, ferr, berr, work, iwork, info )
613 x( i, j ) = c( i )*x( i, j )
617 ferr( j ) = ferr( j ) / colcnd
620 ELSE IF( rowequ )
THEN
623 x( i, j ) = r( i )*x( i, j )
627 ferr( j ) = ferr( j ) / rowcnd
633 IF( rcond.LT.slamch(
'Epsilon' ) )
subroutine xerbla(srname, info)
subroutine scopy(n, sx, incx, sy, incy)
SCOPY
subroutine sgbcon(norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond, work, iwork, info)
SGBCON
subroutine sgbequ(m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd, amax, info)
SGBEQU
subroutine sgbrfs(trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork, info)
SGBRFS
subroutine sgbsvx(fact, trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv, equed, r, c, b, ldb, x, ldx, rcond, ferr, berr, work, iwork, info)
SGBSVX computes the solution to system of linear equations A * X = B for GB matrices
subroutine sgbtrf(m, n, kl, ku, ab, ldab, ipiv, info)
SGBTRF
subroutine sgbtrs(trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info)
SGBTRS
subroutine slacpy(uplo, m, n, a, lda, b, ldb)
SLACPY copies all or part of one two-dimensional array to another.
subroutine slaqgb(m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd, amax, equed)
SLAQGB scales a general band matrix, using row and column scaling factors computed by sgbequ.