492 SUBROUTINE cposvxx( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED,
493 $ S, B, LDB, X, LDX, RCOND, RPVGRW, BERR,
494 $ N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP,
495 $ NPARAMS, PARAMS, WORK, RWORK, INFO )
502 CHARACTER EQUED, FACT, UPLO
503 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS, NPARAMS,
508 COMPLEX A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
509 $ WORK( * ), X( LDX, * )
510 REAL S( * ), PARAMS( * ), BERR( * ), RWORK( * ),
511 $ err_bnds_norm( nrhs, * ),
512 $ err_bnds_comp( nrhs, * )
519 PARAMETER ( ZERO = 0.0e+0, one = 1.0e+0 )
520 INTEGER FINAL_NRM_ERR_I, FINAL_CMP_ERR_I,
521 INTEGER RCOND_I, NRM_RCOND_I, NRM_ERR_I, CMP_RCOND_I
522 INTEGER CMP_ERR_I, PIV_GROWTH_I
523 parameter( final_nrm_err_i = 1, final_cmp_err_i = 2,
525 parameter( rcond_i = 4, nrm_rcond_i = 5, nrm_err_i = 6 )
526 parameter( cmp_rcond_i = 7, cmp_err_i = 8,
530 LOGICAL EQUIL, NOFACT, RCEQU
532 REAL AMAX, BIGNUM, SMIN, SMAX, SCOND, SMLNUM
537 REAL SLAMCH, CLA_PORPVGRW
549 nofact = lsame( fact,
'N' )
550 equil = lsame( fact,
'E' )
551 smlnum = slamch(
'Safe minimum' )
552 bignum = one / smlnum
553 IF( nofact .OR. equil )
THEN
557 rcequ = lsame( equed, 'y
' )
568.NOT..AND..NOT..AND..NOT.
IF( NOFACT EQUIL
569 $ LSAME( FACT, 'f
' ) ) THEN
571.NOT.
ELSE IF( LSAME( UPLO, 'u.AND.
' )
572.NOT.
$ LSAME( UPLO, 'l
' ) ) THEN
574.LT.
ELSE IF( N0 ) THEN
576.LT.
ELSE IF( NRHS0 ) THEN
578.LT.
ELSE IF( LDAMAX( 1, N ) ) THEN
580.LT.
ELSE IF( LDAFMAX( 1, N ) ) THEN
582 ELSE IF( LSAME( FACT, 'f.AND..NOT.
' )
583.OR.
$ ( RCEQU LSAME( EQUED, 'n
' ) ) ) THEN
590 SMIN = MIN( SMIN, S( J ) )
591 SMAX = MAX( SMAX, S( J ) )
593.LE.
IF( SMINZERO ) THEN
595.GT.
ELSE IF( N0 ) THEN
596 SCOND = MAX( SMIN, SMLNUM ) / MIN( SMAX, BIGNUM )
602.LT.
IF( LDBMAX( 1, N ) ) THEN
604.LT.
ELSE IF( LDXMAX( 1, N ) ) THEN
611 CALL XERBLA( 'cposvxx', -INFO )
619 CALL CPOEQUB( N, A, LDA, S, SCOND, AMAX, INFEQU )
620.EQ.
IF( INFEQU0 ) THEN
624 CALL CLAQHE( UPLO, N, A, LDA, S, SCOND, AMAX, EQUED )
625 RCEQU = LSAME( EQUED, 'y
' )
631 IF( RCEQU ) CALL CLASCL2( N, NRHS, S, B, LDB )
633.OR.
IF( NOFACT EQUIL ) THEN
637 CALL CLACPY( UPLO, N, N, A, LDA, AF, LDAF )
638 CALL CPOTRF( UPLO, N, AF, LDAF, INFO )
648 RPVGRW = CLA_PORPVGRW( UPLO, N, A, LDA, AF, LDAF, RWORK )
655 RPVGRW = CLA_PORPVGRW( UPLO, N, A, LDA, AF, LDAF, RWORK )
659 CALL CLACPY( 'full
', N, NRHS, B, LDB, X, LDX )
660 CALL CPOTRS( UPLO, N, NRHS, AF, LDAF, X, LDX, INFO )
665 CALL CPORFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF,
666 $ S, B, LDB, X, LDX, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_NORM,
667 $ ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, RWORK, INFO )
673 CALL CLASCL2( N, NRHS, S, X, LDX )
subroutine xerbla(srname, info)
XERBLA
logical function lsame(ca, cb)
LSAME
subroutine claqhe(uplo, n, a, lda, s, scond, amax, equed)
CLAQHE scales a Hermitian matrix.
subroutine clacpy(uplo, m, n, a, lda, b, ldb)
CLACPY copies all or part of one two-dimensional array to another.
subroutine clascl2(m, n, d, x, ldx)
CLASCL2 performs diagonal scaling on a vector.
subroutine cpoequb(n, a, lda, s, scond, amax, info)
CPOEQUB
subroutine cporfsx(uplo, equed, n, nrhs, a, lda, af, ldaf, s, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, rwork, info)
CPORFSX
subroutine cpotrs(uplo, n, nrhs, a, lda, b, ldb, info)
CPOTRS
subroutine cpotrf(uplo, n, a, lda, info)
CPOTRF
real function cla_porpvgrw(uplo, ncols, a, lda, af, ldaf, work)
CLA_PORPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric or Hermitian...
subroutine cposvxx(fact, uplo, n, nrhs, a, lda, af, ldaf, equed, s, b, ldb, x, ldx, rcond, rpvgrw, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, rwork, info)
CPOSVXX computes the solution to system of linear equations A * X = B for PO matrices
real function slamch(cmach)
SLAMCH