367 SUBROUTINE zgbsvx( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB,
368 $ LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX,
369 $ RCOND, FERR, BERR, WORK, RWORK, INFO )
376 CHARACTER EQUED, FACT, TRANS
377 INTEGER INFO, KL, KU, LDAB, LDAFB, LDB, LDX, N, NRHS
378 DOUBLE PRECISION RCOND
382 DOUBLE PRECISION BERR( * ), C( * ), FERR( * ), R( * ),
384 COMPLEX*16 AB( ldab, * ), AFB( ldafb, * ), B( ldb, * ),
385 $ work( * ), x( ldx, * )
394 DOUBLE PRECISION ZERO, ONE
395 parameter( zero = 0.0d+0, one = 1.0d+0 )
398 LOGICAL COLEQU, EQUIL, NOFACT, NOTRAN, ROWEQU
400 INTEGER I, INFEQU, J, J1, J2
401 DOUBLE PRECISION AMAX, ANORM, BIGNUM, COLCND, RCMAX, RCMIN,
402 $ rowcnd, rpvgrw, smlnum
406 DOUBLE PRECISION DLAMCH, ZLANGB, ZLANTB
407 EXTERNAL lsame, dlamch, zlangb, zlantb
414 INTRINSIC abs, max, min
419 nofact = lsame( fact,
'N' )
420 equil = lsame( fact,
'E' )
421 notran = lsame( trans,
'N' )
422 IF( nofact .OR. equil )
THEN 427 rowequ = lsame( equed,
'R' ) .OR. lsame( equed,
'B' )
428 colequ = lsame( equed,
'C' ) .OR. lsame( equed,
'B' )
429 smlnum = dlamch(
'Safe minimum' )
430 bignum = one / smlnum
435 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.lsame( fact,
'F' ) )
438 ELSE IF( .NOT.notran .AND. .NOT.lsame( trans,
'T' ) .AND. .NOT.
439 $ lsame( trans,
'C' ) )
THEN 441 ELSE IF( n.LT.0 )
THEN 443 ELSE IF( kl.LT.0 )
THEN 445 ELSE IF( ku.LT.0 )
THEN 447 ELSE IF( nrhs.LT.0 )
THEN 449 ELSE IF( ldab.LT.kl+ku+1 )
THEN 451 ELSE IF( ldafb.LT.2*kl+ku+1 )
THEN 453 ELSE IF( lsame( fact,
'F' ) .AND. .NOT.
454 $ ( rowequ .OR. colequ .OR. lsame( equed,
'N' ) ) )
THEN 461 rcmin = min( rcmin, r( j ) )
462 rcmax = max( rcmax, r( j ) )
464 IF( rcmin.LE.zero )
THEN 466 ELSE IF( n.GT.0 )
THEN 467 rowcnd = max( rcmin, smlnum ) / min( rcmax, bignum )
472 IF( colequ .AND. info.EQ.0 )
THEN 476 rcmin = min( rcmin, c( j ) )
477 rcmax = max( rcmax, c( j ) )
479 IF( rcmin.LE.zero )
THEN 481 ELSE IF( n.GT.0 )
THEN 482 colcnd = max( rcmin, smlnum ) / min( rcmax, bignum )
488 IF( ldb.LT.max( 1, n ) )
THEN 490 ELSE IF( ldx.LT.max( 1, n ) )
THEN 497 CALL xerbla(
'ZGBSVX', -info )
505 CALL zgbequ( n, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,
507 IF( infequ.EQ.0 )
THEN 511 CALL zlaqgb( n, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,
513 rowequ = lsame( equed,
'R' ) .OR. lsame( equed,
'B' )
514 colequ = lsame( equed,
'C' ) .OR. lsame( equed,
'B' )
524 b( i, j ) = r( i )*b( i, j )
528 ELSE IF( colequ )
THEN 531 b( i, j ) = c( i )*b( i, j )
536 IF( nofact .OR. equil )
THEN 543 CALL zcopy( j2-j1+1, ab( ku+1-j+j1, j ), 1,
544 $ afb( kl+ku+1-j+j1, j ), 1 )
547 CALL zgbtrf( n, n, kl, ku, afb, ldafb, ipiv, info )
558 DO 80 i = max( ku+2-j, 1 ), min( n+ku+1-j, kl+ku+1 )
559 anorm = max( anorm, abs( ab( i, j ) ) )
562 rpvgrw = zlantb(
'M',
'U',
'N', info, min( info-1, kl+ku ),
563 $ afb( max( 1, kl+ku+2-info ), 1 ), ldafb,
565 IF( rpvgrw.EQ.zero )
THEN 568 rpvgrw = anorm / rpvgrw
584 anorm = zlangb( norm, n, kl, ku, ab, ldab, rwork )
585 rpvgrw = zlantb(
'M',
'U',
'N', n, kl+ku, afb, ldafb, rwork )
586 IF( rpvgrw.EQ.zero )
THEN 589 rpvgrw = zlangb(
'M', n, kl, ku, ab, ldab, rwork ) / rpvgrw
594 CALL zgbcon( norm, n, kl, ku, afb, ldafb, ipiv, anorm, rcond,
595 $ work, rwork, info )
599 CALL zlacpy(
'Full', n, nrhs, b, ldb, x, ldx )
600 CALL zgbtrs( trans, n, kl, ku, nrhs, afb, ldafb, ipiv, x, ldx,
606 CALL zgbrfs( trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv,
607 $ b, ldb, x, ldx, ferr, berr, work, rwork, info )
616 x( i, j ) = c( i )*x( i, j )
620 ferr( j ) = ferr( j ) / colcnd
623 ELSE IF( rowequ )
THEN 626 x( i, j ) = r( i )*x( i, j )
630 ferr( j ) = ferr( j ) / rowcnd
636 IF( rcond.LT.dlamch(
'Epsilon' ) )
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 xerbla(SRNAME, INFO)
XERBLA
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zgbrfs(TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZGBRFS
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
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 zgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, RWORK, INFO)
ZGBCON
subroutine zgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
ZGBTRS
subroutine zgbequ(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
ZGBEQU
subroutine zgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
ZGBTRF