341 SUBROUTINE zpbsvx( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB,
342 $ equed, s, b, ldb, x, ldx, rcond, ferr, berr,
343 $ work, rwork, info )
351 CHARACTER EQUED, FACT, UPLO
352 INTEGER INFO, KD, LDAB, LDAFB, LDB, LDX, N, NRHS
353 DOUBLE PRECISION RCOND
356 DOUBLE PRECISION BERR( * ), FERR( * ), RWORK( * ), S( * )
357 COMPLEX*16 AB( ldab, * ), AFB( ldafb, * ), B( ldb, * ),
358 $ work( * ), x( ldx, * )
364 DOUBLE PRECISION ZERO, ONE
365 parameter ( zero = 0.0d+0, one = 1.0d+0 )
368 LOGICAL EQUIL, NOFACT, RCEQU, UPPER
369 INTEGER I, INFEQU, J, J1, J2
370 DOUBLE PRECISION AMAX, ANORM, BIGNUM, SCOND, SMAX, SMIN, SMLNUM
374 DOUBLE PRECISION DLAMCH, ZLANHB
375 EXTERNAL lsame, dlamch, zlanhb
387 nofact = lsame( fact,
'N' )
388 equil = lsame( fact,
'E' )
389 upper = lsame( uplo,
'U' )
390 IF( nofact .OR. equil )
THEN
394 rcequ = lsame( equed,
'Y' )
395 smlnum = dlamch(
'Safe minimum' )
396 bignum = one / smlnum
401 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.lsame( fact,
'F' ) )
404 ELSE IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
406 ELSE IF( n.LT.0 )
THEN
408 ELSE IF( kd.LT.0 )
THEN
410 ELSE IF( nrhs.LT.0 )
THEN
412 ELSE IF( ldab.LT.kd+1 )
THEN
414 ELSE IF( ldafb.LT.kd+1 )
THEN
416 ELSE IF( lsame( fact,
'F' ) .AND. .NOT.
417 $ ( rcequ .OR. lsame( equed,
'N' ) ) )
THEN
424 smin = min( smin, s( j ) )
425 smax = max( smax, s( j ) )
427 IF( smin.LE.zero )
THEN
429 ELSE IF( n.GT.0 )
THEN
430 scond = max( smin, smlnum ) / min( smax, bignum )
436 IF( ldb.LT.max( 1, n ) )
THEN
438 ELSE IF( ldx.LT.max( 1, n ) )
THEN
445 CALL xerbla(
'ZPBSVX', -info )
453 CALL zpbequ( uplo, n, kd, ab, ldab, s, scond, amax, infequ )
454 IF( infequ.EQ.0 )
THEN
458 CALL zlaqhb( uplo, n, kd, ab, ldab, s, scond, amax, equed )
459 rcequ = lsame( equed,
'Y' )
468 b( i, j ) = s( i )*b( i, j )
473 IF( nofact .OR. equil )
THEN
480 CALL zcopy( j-j1+1, ab( kd+1-j+j1, j ), 1,
481 $ afb( kd+1-j+j1, j ), 1 )
486 CALL zcopy( j2-j+1, ab( 1, j ), 1, afb( 1, j ), 1 )
490 CALL zpbtrf( uplo, n, kd, afb, ldafb, info )
502 anorm = zlanhb(
'1', uplo, n, kd, ab, ldab, rwork )
506 CALL zpbcon( uplo, n, kd, afb, ldafb, anorm, rcond, work, rwork,
511 CALL zlacpy(
'Full', n, nrhs, b, ldb, x, ldx )
512 CALL zpbtrs( uplo, n, kd, nrhs, afb, ldafb, x, ldx, info )
517 CALL zpbrfs( uplo, n, kd, nrhs, ab, ldab, afb, ldafb, b, ldb, x,
518 $ ldx, ferr, berr, work, rwork, info )
526 x( i, j ) = s( i )*x( i, j )
530 ferr( j ) = ferr( j ) / scond
536 IF( rcond.LT.dlamch(
'Epsilon' ) )
subroutine zpbtrs(UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO)
ZPBTRS
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 zpbtrf(UPLO, N, KD, AB, LDAB, INFO)
ZPBTRF
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zpbcon(UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK, RWORK, INFO)
ZPBCON
subroutine zpbrfs(UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZPBRFS
subroutine zpbequ(UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO)
ZPBEQU
subroutine zpbsvx(FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
ZPBSVX computes the solution to system of linear equations A * X = B for OTHER matrices ...
subroutine zlaqhb(UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, EQUED)
ZLAQHB scales a Hermitian band matrix, using scaling factors computed by cpbequ.