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 )
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
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 ...
double precision function dlamch(CMACH)
DLAMCH
subroutine zlaqhe(UPLO, N, A, LDA, S, SCOND, AMAX, EQUED)
ZLAQHE scales a Hermitian matrix.
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 xerbla(SRNAME, INFO)
XERBLA
subroutine zheequb(UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO)
ZHEEQUB
double precision function zla_herpvgrw(UPLO, N, INFO, A, LDA, AF, LDAF, IPIV, WORK)
ZLA_HERPVGRW
subroutine zhetrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRF
subroutine zhetrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZHETRS
logical function lsame(CA, CB)
LSAME
subroutine zlascl2(M, N, D, X, LDX)
ZLASCL2 performs diagonal scaling on a vector.
subroutine zhecon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
ZHECON