502 SUBROUTINE zsysvxx( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV,
503 $ EQUED, S, B, LDB, X, LDX, RCOND, RPVGRW, BERR,
504 $ N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP,
505 $ NPARAMS, PARAMS, WORK, RWORK, INFO )
512 CHARACTER EQUED, FACT, UPLO
513 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS, NPARAMS,
515 DOUBLE PRECISION RCOND, RPVGRW
519 COMPLEX*16 A( LDA, * ), ( LDAF, * ), B( LDB, * ),
520 $ X( LDX, * ), WORK( * )
521 DOUBLE PRECISION S( * ), PARAMS( * ), BERR( * ),
522 $ err_bnds_norm( nrhs, * ),
523 $ err_bnds_comp( nrhs, * ), rwork( * )
529 DOUBLE PRECISION ZERO, ONE
530 PARAMETER ( ZERO = 0.0d+0, one = 1.0d+0 )
531 INTEGER FINAL_NRM_ERR_I, FINAL_CMP_ERR_I,
532 INTEGER RCOND_I, NRM_RCOND_I, NRM_ERR_I, CMP_RCOND_I
533 INTEGER , PIV_GROWTH_I
534 parameter( final_nrm_err_i = 1, final_cmp_err_i = 2,
536 parameter( rcond_i = 4, nrm_rcond_i = 5, nrm_err_i = 6 )
537 parameter( cmp_rcond_i = 7, cmp_err_i = 8,
541 LOGICAL EQUIL, NOFACT, RCEQU
543 DOUBLE PRECISION AMAX, BIGNUM, , SMAX, , SMLNUM
548 DOUBLE PRECISION DLAMCH, ZLA_SYRPVGRW
560 nofact = lsame( fact,
'N' )
561 equil = lsame( fact,
'E' )
562 smlnum = dlamch(
'Safe minimum' )
563 bignum = one / smlnum
564 IF( nofact .OR. equil )
THEN
568 rcequ = lsame( equed,
'Y' )
579 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.
580 $ lsame( fact,
'F' ) )
THEN
582 ELSE IF( .NOT.lsame(uplo,
'U') .AND.
583 $ .NOT.lsame(uplo,
'L') )
THEN
585 ELSE IF( n.LT.0 )
THEN
587 ELSE IF( nrhs.LT.0 )
THEN
589 ELSE IF( lda.LT.
max( 1, n ) )
THEN
591 ELSE IF( ldaf.LT.
max( 1, n ) )
THEN
593 ELSE IF( lsame( fact,
'F' ) .AND. .NOT.
594 $ ( rcequ .OR. lsame( equed,
'N' ) ) )
THEN
601 smin =
min( smin, s( j ) )
602 smax =
max( smax, s( j ) )
604 IF( smin.LE.zero )
THEN
606 ELSE IF( n.GT.0 )
THEN
607 scond =
max( smin, smlnum ) /
min( smax, bignum )
613 IF( ldb.LT.
max( 1, n ) )
THEN
615 ELSE IF( ldx.LT.
max( 1, n ) )
THEN
622 CALL xerbla(
'ZSYSVXX', -info )
630 CALL zsyequb( uplo, n, a, lda, s, scond, amax, work, infequ )
631 IF( infequ.EQ.0 )
THEN
635 CALL zlaqsy( uplo, n, a, lda, s, scond, amax, equed )
636 rcequ = lsame( equed,
'Y' )
643 IF( rcequ )
CALL zlascl2( n, nrhs, s, b, ldb )
645 IF( nofact .OR. equil )
THEN
649 CALL zlacpy( uplo, n, n, a, lda, af, ldaf )
650 CALL zsytrf( uplo, n, af, ldaf, ipiv, work, 5*
max(1,n), info )
661 $ rpvgrw = zla_syrpvgrw( uplo, n, info, a, lda, af,
662 $ ldaf, ipiv, rwork )
670 $ rpvgrw = zla_syrpvgrw( uplo, n, info, a, lda, af, ldaf,
675 CALL zlacpy(
'Full', n, nrhs, b, ldb, x, ldx )
676 CALL zsytrs( uplo, n, nrhs, af, ldaf, ipiv, x, ldx, info )
681 CALL zsyrfsx( uplo, equed, n, nrhs, a, lda, af, ldaf, ipiv,
682 $ s, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm,
683 $ err_bnds_comp, nparams, params, work, rwork, info )
688 CALL zlascl2 (n, nrhs, s, x, ldx )
subroutine zsyrfsx(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)
ZSYRFSX
subroutine zsysvxx(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)
ZSYSVXX computes the solution to system of linear equations A * X = B for SY matrices