341 SUBROUTINE cpbsvx( 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
356 REAL BERR( * ), FERR( * ), RWORK( * ), S( * )
357 COMPLEX AB( ldab, * ), AFB( ldafb, * ), B( ldb, * ),
358 $ work( * ), x( ldx, * )
365 parameter ( zero = 0.0e+0, one = 1.0e+0 )
368 LOGICAL EQUIL, NOFACT, RCEQU, UPPER
369 INTEGER I, INFEQU, J, J1, J2
370 REAL AMAX, ANORM, BIGNUM, SCOND, SMAX, SMIN, SMLNUM
375 EXTERNAL lsame, clanhb, slamch
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 = slamch(
'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(
'CPBSVX', -info )
453 CALL cpbequ( uplo, n, kd, ab, ldab, s, scond, amax, infequ )
454 IF( infequ.EQ.0 )
THEN
458 CALL claqhb( 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 ccopy( j-j1+1, ab( kd+1-j+j1, j ), 1,
481 $ afb( kd+1-j+j1, j ), 1 )
486 CALL ccopy( j2-j+1, ab( 1, j ), 1, afb( 1, j ), 1 )
490 CALL cpbtrf( uplo, n, kd, afb, ldafb, info )
502 anorm = clanhb(
'1', uplo, n, kd, ab, ldab, rwork )
506 CALL cpbcon( uplo, n, kd, afb, ldafb, anorm, rcond, work, rwork,
511 CALL clacpy(
'Full', n, nrhs, b, ldb, x, ldx )
512 CALL cpbtrs( uplo, n, kd, nrhs, afb, ldafb, x, ldx, info )
517 CALL cpbrfs( 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.slamch(
'Epsilon' ) )
subroutine cpbequ(UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO)
CPBEQU
subroutine cpbcon(UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK, RWORK, INFO)
CPBCON
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cpbrfs(UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CPBRFS
subroutine claqhb(UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, EQUED)
CLAQHB scales a Hermitian band matrix, using scaling factors computed by cpbequ.
subroutine cpbsvx(FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
CPBSVX computes the solution to system of linear equations A * X = B for OTHER matrices ...
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine cpbtrf(UPLO, N, KD, AB, LDAB, INFO)
CPBTRF
subroutine cpbtrs(UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO)
CPBTRS