505 SUBROUTINE csysvxx( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV,
506 $ EQUED, S, B, LDB, X, LDX, RCOND, RPVGRW, BERR,
507 $ N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP,
508 $ NPARAMS, PARAMS, WORK, RWORK, INFO )
515 CHARACTER EQUED, FACT, UPLO
516 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS, NPARAMS,
522 COMPLEX A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
523 $ X( LDX, * ), WORK( * )
524 REAL S( * ), PARAMS( * ), BERR( * ),
525 $ err_bnds_norm( nrhs, * ),
526 $ err_bnds_comp( nrhs, * ), rwork( * )
533 PARAMETER ( ZERO = 0.0e+0, one = 1.0e+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 REAL AMAX, BIGNUM, SMIN, SMAX, SCOND, SMLNUM
551 REAL SLAMCH, CLA_SYRPVGRW
563 nofact = lsame( fact,
'N' )
564 equil = lsame( fact,
'E' )
565 smlnum = slamch(
'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(
'CSYSVXX', -info )
633 CALL csyequb( uplo, n, a, lda, s, scond, amax, work, infequ )
634 IF( infequ.EQ.0 )
THEN
638 CALL claqsy( uplo, n, a, lda, s, scond, amax, equed )
639 rcequ = lsame( equed,
'Y' )
646 IF( rcequ )
CALL clascl2( n, nrhs, s, b, ldb )
648 IF( nofact .OR. equil )
THEN
652 CALL clacpy( uplo, n, n, a, lda, af, ldaf )
653 CALL csytrf( uplo, n, af, ldaf, ipiv, work, 5*max(1,n), info )
664 $ rpvgrw = cla_syrpvgrw( uplo, n, info, a, lda, af,
665 $ ldaf, ipiv, rwork )
673 $ rpvgrw = cla_syrpvgrw( uplo, n, info, a, lda, af, ldaf,
678 CALL clacpy(
'Full', n, nrhs, b, ldb, x, ldx )
679 CALL csytrs( uplo, n, nrhs, af, ldaf, ipiv, x, ldx, info )
684 CALL csyrfsx( uplo, equed, n, nrhs, a, lda, af, ldaf, ipiv,
685 $ s, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm,
686 $ err_bnds_comp, nparams, params, work, rwork, info )
691 CALL clascl2 (n, nrhs, s, x, ldx )
subroutine xerbla(srname, info)
subroutine csyequb(uplo, n, a, lda, s, scond, amax, work, info)
CSYEQUB
subroutine csyrfsx(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)
CSYRFSX
subroutine csysvxx(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)
CSYSVXX computes the solution to system of linear equations A * X = B for SY matrices
subroutine csytrf(uplo, n, a, lda, ipiv, work, lwork, info)
CSYTRF
subroutine csytrs(uplo, n, nrhs, a, lda, ipiv, b, ldb, info)
CSYTRS
real function cla_syrpvgrw(uplo, n, info, a, lda, af, ldaf, ipiv, work)
CLA_SYRPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric indefinite m...
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
subroutine claqsy(uplo, n, a, lda, s, scond, amax, equed)
CLAQSY scales a symmetric/Hermitian matrix, using scaling factors computed by spoequ.
subroutine clascl2(m, n, d, x, ldx)
CLASCL2 performs diagonal scaling on a matrix.
logical function lsame(ca, cb)
LSAME