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
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 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 cheequb(UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO)
CHEEQUB
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 chetrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRF
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 checon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
CHECON
subroutine xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine claqhe(UPLO, N, A, LDA, S, SCOND, AMAX, EQUED)
CLAQHE scales a Hermitian matrix.
logical function lsame(CA, CB)
LSAME
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
real function slamch(CMACH)
SLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
real function cla_herpvgrw(UPLO, N, INFO, A, LDA, AF, LDAF, IPIV, WORK)
CLA_HERPVGRW