342 SUBROUTINE dpbsvx( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB,
343 $ equed, s, b, ldb, x, ldx, rcond, ferr, berr,
344 $ work, iwork, info )
352 CHARACTER EQUED, FACT, UPLO
353 INTEGER INFO, KD, LDAB, LDAFB, LDB, LDX, N, NRHS
354 DOUBLE PRECISION RCOND
358 DOUBLE PRECISION AB( ldab, * ), AFB( ldafb, * ), B( ldb, * ),
359 $ berr( * ), ferr( * ), s( * ), work( * ),
366 DOUBLE PRECISION ZERO, ONE
367 parameter ( zero = 0.0d+0, one = 1.0d+0 )
370 LOGICAL EQUIL, NOFACT, RCEQU, UPPER
371 INTEGER I, INFEQU, J, J1, J2
372 DOUBLE PRECISION AMAX, ANORM, BIGNUM, SCOND, SMAX, SMIN, SMLNUM
376 DOUBLE PRECISION DLAMCH, DLANSB
377 EXTERNAL lsame, dlamch, dlansb
389 nofact = lsame( fact,
'N' )
390 equil = lsame( fact,
'E' )
391 upper = lsame( uplo,
'U' )
392 IF( nofact .OR. equil )
THEN
396 rcequ = lsame( equed,
'Y' )
397 smlnum = dlamch(
'Safe minimum' )
398 bignum = one / smlnum
403 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.lsame( fact,
'F' ) )
406 ELSE IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
408 ELSE IF( n.LT.0 )
THEN
410 ELSE IF( kd.LT.0 )
THEN
412 ELSE IF( nrhs.LT.0 )
THEN
414 ELSE IF( ldab.LT.kd+1 )
THEN
416 ELSE IF( ldafb.LT.kd+1 )
THEN
418 ELSE IF( lsame( fact,
'F' ) .AND. .NOT.
419 $ ( rcequ .OR. lsame( equed,
'N' ) ) )
THEN
426 smin = min( smin, s( j ) )
427 smax = max( smax, s( j ) )
429 IF( smin.LE.zero )
THEN
431 ELSE IF( n.GT.0 )
THEN
432 scond = max( smin, smlnum ) / min( smax, bignum )
438 IF( ldb.LT.max( 1, n ) )
THEN
440 ELSE IF( ldx.LT.max( 1, n ) )
THEN
447 CALL xerbla(
'DPBSVX', -info )
455 CALL dpbequ( uplo, n, kd, ab, ldab, s, scond, amax, infequ )
456 IF( infequ.EQ.0 )
THEN
460 CALL dlaqsb( uplo, n, kd, ab, ldab, s, scond, amax, equed )
461 rcequ = lsame( equed,
'Y' )
470 b( i, j ) = s( i )*b( i, j )
475 IF( nofact .OR. equil )
THEN
482 CALL dcopy( j-j1+1, ab( kd+1-j+j1, j ), 1,
483 $ afb( kd+1-j+j1, j ), 1 )
488 CALL dcopy( j2-j+1, ab( 1, j ), 1, afb( 1, j ), 1 )
492 CALL dpbtrf( uplo, n, kd, afb, ldafb, info )
504 anorm = dlansb(
'1', uplo, n, kd, ab, ldab, work )
508 CALL dpbcon( uplo, n, kd, afb, ldafb, anorm, rcond, work, iwork,
513 CALL dlacpy(
'Full', n, nrhs, b, ldb, x, ldx )
514 CALL dpbtrs( uplo, n, kd, nrhs, afb, ldafb, x, ldx, info )
519 CALL dpbrfs( uplo, n, kd, nrhs, ab, ldab, afb, ldafb, b, ldb, x,
520 $ ldx, ferr, berr, work, iwork, info )
528 x( i, j ) = s( i )*x( i, j )
532 ferr( j ) = ferr( j ) / scond
538 IF( rcond.LT.dlamch(
'Epsilon' ) )
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dpbtrf(UPLO, N, KD, AB, LDAB, INFO)
DPBTRF
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine dpbrfs(UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DPBRFS
subroutine dlaqsb(UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, EQUED)
DLAQSB scales a symmetric/Hermitian band matrix, using scaling factors computed by spbequ...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dpbequ(UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO)
DPBEQU
subroutine dpbtrs(UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO)
DPBTRS
subroutine dpbsvx(FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, IWORK, INFO)
DPBSVX computes the solution to system of linear equations A * X = B for OTHER matrices ...
subroutine dpbcon(UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK, IWORK, INFO)
DPBCON