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)
XERBLA
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 sgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
SGBTRS
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine sgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SGBCON
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...
subroutine sgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
SGBTRF
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 slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.