369 SUBROUTINE zgbsvx( 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
381 DOUBLE PRECISION RCOND
385 DOUBLE PRECISION BERR( * ), C( * ), FERR( * ), R( * ),
387 COMPLEX*16 AB( ldab, * ), AFB( ldafb, * ), B( ldb, * ),
388 $ work( * ), x( ldx, * )
397 DOUBLE PRECISION ZERO, ONE
398 parameter ( zero = 0.0d+0, one = 1.0d+0 )
401 LOGICAL COLEQU, EQUIL, NOFACT, NOTRAN, ROWEQU
403 INTEGER I, INFEQU, J, J1, J2
404 DOUBLE PRECISION AMAX, ANORM, BIGNUM, COLCND, RCMAX, RCMIN,
405 $ rowcnd, rpvgrw, smlnum
409 DOUBLE PRECISION DLAMCH, ZLANGB, ZLANTB
410 EXTERNAL lsame, dlamch, zlangb, zlantb
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 = dlamch(
'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(
'ZGBSVX', -info )
508 CALL zgbequ( n, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,
510 IF( infequ.EQ.0 )
THEN
514 CALL zlaqgb( 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 zcopy( j2-j1+1, ab( ku+1-j+j1, j ), 1,
547 $ afb( kl+ku+1-j+j1, j ), 1 )
550 CALL zgbtrf( 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 = zlantb(
'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 = zlangb( norm, n, kl, ku, ab, ldab, rwork )
588 rpvgrw = zlantb(
'M',
'U',
'N', n, kl+ku, afb, ldafb, rwork )
589 IF( rpvgrw.EQ.zero )
THEN
592 rpvgrw = zlangb(
'M', n, kl, ku, ab, ldab, rwork ) / rpvgrw
597 CALL zgbcon( norm, n, kl, ku, afb, ldafb, ipiv, anorm, rcond,
598 $ work, rwork, info )
602 CALL zlacpy(
'Full', n, nrhs, b, ldb, x, ldx )
603 CALL zgbtrs( trans, n, kl, ku, nrhs, afb, ldafb, ipiv, x, ldx,
609 CALL zgbrfs( 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.dlamch(
'Epsilon' ) )
subroutine zlaqgb(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, EQUED)
ZLAQGB scales a general band matrix, using row and column scaling factors computed by sgbequ...
subroutine zgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
ZGBTRS
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, RWORK, INFO)
ZGBCON
subroutine zgbrfs(TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZGBRFS
subroutine zgbequ(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
ZGBEQU
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zgbsvx(FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
ZGBSVX computes the solution to system of linear equations A * X = B for GB matrices ...
subroutine zgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
ZGBTRF