507 SUBROUTINE chesvxx( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV,
508 $ EQUED, S, B, LDB, X, LDX, RCOND, RPVGRW, BERR,
509 $ N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP,
510 $ NPARAMS, PARAMS, WORK, RWORK, INFO )
518 CHARACTER EQUED, FACT, UPLO
519 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS, NPARAMS,
525 COMPLEX A( lda, * ), AF( ldaf, * ), B( ldb, * ),
526 $ work( * ), x( ldx, * )
527 REAL S( * ), PARAMS( * ), BERR( * ), RWORK( * ),
528 $ err_bnds_norm( nrhs, * ),
529 $ err_bnds_comp( nrhs, * )
536 parameter( zero = 0.0e+0, one = 1.0e+0 )
537 INTEGER FINAL_NRM_ERR_I, FINAL_CMP_ERR_I, BERR_I
538 INTEGER RCOND_I, NRM_RCOND_I, NRM_ERR_I, CMP_RCOND_I
539 INTEGER CMP_ERR_I, PIV_GROWTH_I
540 parameter( final_nrm_err_i = 1, final_cmp_err_i = 2,
542 parameter( rcond_i = 4, nrm_rcond_i = 5, nrm_err_i = 6 )
543 parameter( cmp_rcond_i = 7, cmp_err_i = 8,
547 LOGICAL EQUIL, NOFACT, RCEQU
549 REAL AMAX, BIGNUM, SMIN, SMAX, SCOND, SMLNUM
554 REAL SLAMCH, CLA_HERPVGRW
566 nofact = lsame( fact,
'N' )
567 equil = lsame( fact,
'E' )
568 smlnum = slamch(
'Safe minimum' )
569 bignum = one / smlnum
570 IF( nofact .OR. equil )
THEN 574 rcequ = lsame( equed,
'Y' )
585 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.
586 $ lsame( fact,
'F' ) )
THEN 588 ELSE IF( .NOT.lsame( uplo,
'U' ) .AND.
589 $ .NOT.lsame( uplo,
'L' ) )
THEN 591 ELSE IF( n.LT.0 )
THEN 593 ELSE IF( nrhs.LT.0 )
THEN 595 ELSE IF( lda.LT.max( 1, n ) )
THEN 597 ELSE IF( ldaf.LT.max( 1, n ) )
THEN 599 ELSE IF( lsame( fact,
'F' ) .AND. .NOT.
600 $ ( rcequ .OR. lsame( equed,
'N' ) ) )
THEN 607 smin = min( smin, s( j ) )
608 smax = max( smax, s( j ) )
610 IF( smin.LE.zero )
THEN 612 ELSE IF( n.GT.0 )
THEN 613 scond = max( smin, smlnum ) / min( smax, bignum )
619 IF( ldb.LT.max( 1, n ) )
THEN 621 ELSE IF( ldx.LT.max( 1, n ) )
THEN 628 CALL xerbla(
'CHESVXX', -info )
636 CALL cheequb( uplo, n, a, lda, s, scond, amax, work, infequ )
637 IF( infequ.EQ.0 )
THEN 641 CALL claqhe( uplo, n, a, lda, s, scond, amax, equed )
642 rcequ = lsame( equed,
'Y' )
648 IF( rcequ )
CALL clascl2( n, nrhs, s, b, ldb )
650 IF( nofact .OR. equil )
THEN 654 CALL clacpy( uplo, n, n, a, lda, af, ldaf )
655 CALL chetrf( uplo, n, af, ldaf, ipiv, work, 5*max(1,n), info )
666 $ rpvgrw = cla_herpvgrw( uplo, n, info, a, lda, af, ldaf,
675 $ rpvgrw = cla_herpvgrw( uplo, n, info, a, lda, af, ldaf, ipiv,
680 CALL clacpy(
'Full', n, nrhs, b, ldb, x, ldx )
681 CALL chetrs( uplo, n, nrhs, af, ldaf, ipiv, x, ldx, info )
686 CALL cherfsx( uplo, equed, n, nrhs, a, lda, af, ldaf, ipiv,
687 $ s, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm,
688 $ err_bnds_comp, nparams, params, work, rwork, info )
693 CALL clascl2 ( n, nrhs, s, x, ldx )
subroutine cherfsx(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)
CHERFSX
subroutine cheequb(UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO)
CHEEQUB
real function cla_herpvgrw(UPLO, N, INFO, A, LDA, AF, LDAF, IPIV, WORK)
CLA_HERPVGRW
subroutine claqhe(UPLO, N, A, LDA, S, SCOND, AMAX, EQUED)
CLAQHE scales a Hermitian matrix.
subroutine xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME
real function slamch(CMACH)
SLAMCH
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine clascl2(M, N, D, X, LDX)
CLASCL2 performs diagonal scaling on a vector.
subroutine chetrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CHETRS
subroutine chesvxx(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)
CHESVXX computes the solution to system of linear equations A * X = B for HE matrices ...
subroutine chetrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRF