503 SUBROUTINE chesvxx( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF,
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 )
514 CHARACTER EQUED, FACT, UPLO
515 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS, NPARAMS,
521 COMPLEX A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
522 $ WORK( * ), X( LDX, * )
523 REAL S( * ), PARAMS( * ), BERR( * ), RWORK( * ),
524 $ err_bnds_norm( nrhs, * ),
525 $ err_bnds_comp( nrhs, * )
532 PARAMETER ( ZERO = 0.0e+0, one = 1.0e+0 )
533 INTEGER FINAL_NRM_ERR_I, FINAL_CMP_ERR_I, BERR_I
534 INTEGER RCOND_I, NRM_RCOND_I, NRM_ERR_I, CMP_RCOND_I
535 INTEGER CMP_ERR_I, PIV_GROWTH_I
536 parameter( final_nrm_err_i = 1, final_cmp_err_i = 2,
538 parameter( rcond_i = 4, nrm_rcond_i = 5, nrm_err_i = 6 )
539 parameter( cmp_rcond_i = 7, cmp_err_i = 8,
543 LOGICAL EQUIL, NOFACT, RCEQU
545 REAL AMAX, BIGNUM, SMIN, SMAX, SCOND, SMLNUM
550 REAL SLAMCH, CLA_HERPVGRW
562 nofact = lsame( fact,
'N' )
563 equil = lsame( fact,
'E' )
564 smlnum = slamch(
'Safe minimum' )
565 bignum = one / smlnum
566 IF( nofact .OR. equil )
THEN
570 rcequ = lsame( equed,
'Y' )
581 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.
582 $ lsame( fact,
'F' ) )
THEN
584 ELSE IF( .NOT.lsame( uplo,
'U' ) .AND.
585 $ .NOT.lsame( uplo,
'L' ) )
THEN
587 ELSE IF( n.LT.0 )
THEN
589 ELSE IF( nrhs.LT.0 )
THEN
591 ELSE IF( lda.LT.max( 1, n ) )
THEN
593 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
595 ELSE IF( lsame( fact,
'F' ) .AND. .NOT.
596 $ ( rcequ .OR. lsame( equed,
'N' ) ) )
THEN
603 smin = min( smin, s( j ) )
604 smax = max( smax, s( j ) )
606 IF( smin.LE.zero )
THEN
608 ELSE IF( n.GT.0 )
THEN
609 scond = max( smin, smlnum ) / min( smax, bignum )
615 IF( ldb.LT.max( 1, n ) )
THEN
617 ELSE IF( ldx.LT.max( 1, n ) )
THEN
624 CALL xerbla(
'CHESVXX', -info )
632 CALL cheequb( uplo, n, a, lda, s, scond, amax, work,
634 IF( infequ.EQ.0 )
THEN
638 CALL claqhe( uplo, n, a, lda, s, scond, amax, equed )
639 rcequ = lsame( equed,
'Y' )
645 IF( rcequ )
CALL clascl2( n, nrhs, s, b, ldb )
647 IF( nofact .OR. equil )
THEN
651 CALL clacpy( uplo, n, n, a, lda, af, ldaf )
652 CALL chetrf( uplo, n, af, ldaf, ipiv, work, 5*max(1,n),
664 $ rpvgrw = cla_herpvgrw( uplo, n, info, a, lda, af,
674 $ rpvgrw = cla_herpvgrw( uplo, n, info, a, lda, af, ldaf,
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 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