504 SUBROUTINE zhesvxx( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV,
505 $ EQUED, S, B, LDB, X, LDX, RCOND, RPVGRW, BERR,
506 $ N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP,
507 $ NPARAMS, PARAMS, WORK, RWORK, INFO )
515 CHARACTER EQUED, FACT, UPLO
516 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS, NPARAMS,
518 DOUBLE PRECISION RCOND, RPVGRW
522 COMPLEX*16 A( lda, * ), AF( ldaf, * ), B( ldb, * ),
523 $ work( * ), x( ldx, * )
524 DOUBLE PRECISION S( * ), PARAMS( * ), BERR( * ), RWORK( * ),
525 $ err_bnds_norm( nrhs, * ),
526 $ err_bnds_comp( nrhs, * )
532 DOUBLE PRECISION ZERO, ONE
533 parameter( zero = 0.0d+0, one = 1.0d+0 )
534 INTEGER FINAL_NRM_ERR_I, FINAL_CMP_ERR_I, BERR_I
535 INTEGER RCOND_I, NRM_RCOND_I, NRM_ERR_I, CMP_RCOND_I
536 INTEGER CMP_ERR_I, PIV_GROWTH_I
537 parameter( final_nrm_err_i = 1, final_cmp_err_i = 2,
539 parameter( rcond_i = 4, nrm_rcond_i = 5, nrm_err_i = 6 )
540 parameter( cmp_rcond_i = 7, cmp_err_i = 8,
544 LOGICAL EQUIL, NOFACT, RCEQU
546 DOUBLE PRECISION AMAX, BIGNUM, SMIN, SMAX, SCOND, SMLNUM
551 DOUBLE PRECISION DLAMCH, ZLA_HERPVGRW
563 nofact = lsame( fact,
'N' )
564 equil = lsame( fact,
'E' )
565 smlnum = dlamch(
'Safe minimum' )
566 bignum = one / smlnum
567 IF( nofact .OR. equil )
THEN 571 rcequ = lsame( equed,
'Y' )
582 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.
583 $ lsame( fact,
'F' ) )
THEN 585 ELSE IF( .NOT.lsame( uplo,
'U' ) .AND.
586 $ .NOT.lsame( uplo,
'L' ) )
THEN 588 ELSE IF( n.LT.0 )
THEN 590 ELSE IF( nrhs.LT.0 )
THEN 592 ELSE IF( lda.LT.max( 1, n ) )
THEN 594 ELSE IF( ldaf.LT.max( 1, n ) )
THEN 596 ELSE IF( lsame( fact,
'F' ) .AND. .NOT.
597 $ ( rcequ .OR. lsame( equed,
'N' ) ) )
THEN 604 smin = min( smin, s( j ) )
605 smax = max( smax, s( j ) )
607 IF( smin.LE.zero )
THEN 609 ELSE IF( n.GT.0 )
THEN 610 scond = max( smin, smlnum ) / min( smax, bignum )
616 IF( ldb.LT.max( 1, n ) )
THEN 618 ELSE IF( ldx.LT.max( 1, n ) )
THEN 625 CALL xerbla(
'ZHESVXX', -info )
633 CALL zheequb( uplo, n, a, lda, s, scond, amax, work, infequ )
634 IF( infequ.EQ.0 )
THEN 638 CALL zlaqhe( uplo, n, a, lda, s, scond, amax, equed )
639 rcequ = lsame( equed,
'Y' )
645 IF( rcequ )
CALL zlascl2( n, nrhs, s, b, ldb )
647 IF( nofact .OR. equil )
THEN 651 CALL zlacpy( uplo, n, n, a, lda, af, ldaf )
652 CALL zhetrf( uplo, n, af, ldaf, ipiv, work, 5*max(1,n), info )
663 $ rpvgrw = zla_herpvgrw( uplo, n, info, a, lda, af, ldaf,
672 $ rpvgrw = zla_herpvgrw( uplo, n, info, a, lda, af, ldaf, ipiv,
677 CALL zlacpy(
'Full', n, nrhs, b, ldb, x, ldx )
678 CALL zhetrs( uplo, n, nrhs, af, ldaf, ipiv, x, ldx, info )
683 CALL zherfsx( uplo, equed, n, nrhs, a, lda, af, ldaf, ipiv,
684 $ s, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm,
685 $ err_bnds_comp, nparams, params, work, rwork, info )
690 CALL zlascl2 ( n, nrhs, s, x, ldx )
double precision function dlamch(CMACH)
DLAMCH
double precision function zla_herpvgrw(UPLO, N, INFO, A, LDA, AF, LDAF, IPIV, WORK)
ZLA_HERPVGRW
subroutine zhetrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZHETRS
subroutine zlaqhe(UPLO, N, A, LDA, S, SCOND, AMAX, EQUED)
ZLAQHE scales a Hermitian matrix.
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zherfsx(UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, S, B, LDB, X, LDX, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, RWORK, INFO)
ZHERFSX
subroutine zheequb(UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO)
ZHEEQUB
subroutine xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME
subroutine zhesvxx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, EQUED, S, B, LDB, X, LDX, RCOND, RPVGRW, BERR, N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, RWORK, INFO)
ZHESVXX computes the solution to system of linear equations A * X = B for HE matrices ...
subroutine zhetrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRF
subroutine zlascl2(M, N, D, X, LDX)
ZLASCL2 performs diagonal scaling on a vector.