507 SUBROUTINE csysvxx( 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 $ x( ldx, * ), work( * )
527 REAL s( * ), params( * ), berr( * ),
528 $ err_bnds_norm( nrhs, * ),
529 $ err_bnds_comp( nrhs, * ), rwork( * )
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(
'CSYSVXX', -info )
636 CALL
csyequb( uplo, n, a, lda, s, scond, amax, work, infequ )
637 IF( infequ.EQ.0 )
THEN
641 CALL
claqsy( uplo, n, a, lda, s, scond, amax, equed )
642 rcequ =
lsame( equed,
'Y' )
649 IF( rcequ ) CALL
clascl2( n, nrhs, s, b, ldb )
651 IF( nofact .OR. equil )
THEN
655 CALL
clacpy( uplo, n, n, a, lda, af, ldaf )
656 CALL
csytrf( uplo, n, af, ldaf, ipiv, work, 5*max(1,n), info )
668 $ ldaf, ipiv, rwork )
676 $ rpvgrw =
cla_syrpvgrw( uplo, n, info, a, lda, af, ldaf,
681 CALL
clacpy(
'Full', n, nrhs, b, ldb, x, ldx )
682 CALL
csytrs( uplo, n, nrhs, af, ldaf, ipiv, x, ldx, info )
687 CALL
csyrfsx( uplo, equed, n, nrhs, a, lda, af, ldaf, ipiv,
688 $ s, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm,
689 $ err_bnds_comp, nparams, params, work, rwork, info )
694 CALL
clascl2(n, nrhs, s, x, ldx )