489 SUBROUTINE zposvxx( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED,
490 $ S, B, LDB, X, LDX, RCOND, RPVGRW, BERR,
491 $ N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP,
492 $ NPARAMS, PARAMS, WORK, RWORK, INFO )
499 CHARACTER EQUED, FACT, UPLO
500 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS, NPARAMS,
502 DOUBLE PRECISION RCOND, RPVGRW
505 COMPLEX*16 A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
506 $ WORK( * ), X( LDX, * )
507 DOUBLE PRECISION S( * ), PARAMS( * ), BERR( * ), RWORK( * ),
508 $ err_bnds_norm( nrhs, * ),
509 $ err_bnds_comp( nrhs, * )
515 DOUBLE PRECISION ZERO, ONE
516 PARAMETER ( ZERO = 0.0d+0, one = 1.0d+0 )
517 INTEGER FINAL_NRM_ERR_I, FINAL_CMP_ERR_I, BERR_I
518 INTEGER RCOND_I, NRM_RCOND_I
519INTEGER CMP_ERR_I, PIV_GROWTH_I
520 parameter( final_nrm_err_i = 1, final_cmp_err_i = 2,
522 parameter( rcond_i = 4, nrm_rcond_i = 5, nrm_err_i = 6 )
523 parameter( cmp_rcond_i = 7, cmp_err_i = 8,
527 LOGICAL EQUIL, NOFACT
529 DOUBLE PRECISION AMAX, BIGNUM, SMIN, SMAX, SCOND, SMLNUM
534 DOUBLE PRECISION DLAMCH,
547 EQUIL = LSAME( FACT, 'e
' )
548 SMLNUM = DLAMCH( 'safe minimum
' )
549 BIGNUM = ONE / SMLNUM
550.OR.
IF( NOFACT EQUIL ) THEN
554 RCEQU = LSAME( EQUED, 'y
' )
565.NOT..AND..NOT..AND..NOT.
IF( NOFACT EQUIL
566 $ LSAME( FACT, 'f
' ) ) THEN
568.NOT.
ELSE IF( LSAME( UPLO, 'u.AND.
' )
569.NOT.
$ LSAME( UPLO, 'l
' ) ) THEN
571.LT.
ELSE IF( N0 ) THEN
573.LT.
ELSE IF( NRHS0 ) THEN
575.LT.
ELSE IF( LDAMAX( 1, N ) ) THEN
577.LT.
ELSE IF( LDAFMAX( 1, N ) ) THEN
579 ELSE IF( LSAME( FACT, 'f.AND..NOT.
' )
580.OR.
$ ( RCEQU LSAME( EQUED, 'n
' ) ) ) THEN
587 SMIN = MIN( SMIN, S( J ) )
588 SMAX = MAX( SMAX, S( J ) )
590.LE.
IF( SMINZERO ) THEN
592.GT.
ELSE IF( N0 ) THEN
593 SCOND = MAX( SMIN, SMLNUM ) / MIN( SMAX, BIGNUM )
599.LT.
IF( LDBMAX( 1, N ) ) THEN
601.LT.
ELSE IF( LDXMAX( 1, N ) ) THEN
608 CALL XERBLA( 'zposvxx', -INFO )
616 CALL ZPOEQUB( N, A, LDA, S, SCOND, AMAX, INFEQU )
617.EQ.
IF( INFEQU0 ) THEN
621 CALL ZLAQHE( UPLO, N, A, LDA, S, SCOND, AMAX, EQUED )
622 RCEQU = LSAME( EQUED, 'y
' )
628 IF( RCEQU ) CALL ZLASCL2( N, NRHS, S, B, LDB )
630.OR.
IF( NOFACT EQUIL ) THEN
634 CALL ZLACPY( UPLO, N, N, A, LDA, AF, LDAF )
635 CALL ZPOTRF( UPLO, N, AF, LDAF, INFO )
645 RPVGRW = ZLA_PORPVGRW( UPLO, N, A, LDA, AF, LDAF, RWORK )
652 RPVGRW = ZLA_PORPVGRW( UPLO, N, A, LDA, AF, LDAF, RWORK )
656 CALL ZLACPY( 'full
', N, NRHS, B, LDB, X, LDX )
657 CALL ZPOTRS( UPLO, N, NRHS, AF, LDAF, X, LDX, INFO )
662 CALL ZPORFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF,
663 $ S, B, LDB, X, LDX, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_NORM,
664 $ ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, RWORK, INFO )
670 CALL ZLASCL2( N, NRHS, S, X, LDX )
subroutine xerbla(srname, info)
XERBLA
logical function lsame(ca, cb)
LSAME
subroutine zlaqhe(uplo, n, a, lda, s, scond, amax, equed)
ZLAQHE scales a Hermitian matrix.
subroutine zlacpy(uplo, m, n, a, lda, b, ldb)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zlascl2(m, n, d, x, ldx)
ZLASCL2 performs diagonal scaling on a vector.
subroutine zporfsx(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)
ZPORFSX
double precision function zla_porpvgrw(uplo, ncols, a, lda, af, ldaf, work)
ZLA_PORPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric or Hermitian...
subroutine zpoequb(n, a, lda, s, scond, amax, info)
ZPOEQUB
subroutine zpotrs(uplo, n, nrhs, a, lda, b, ldb, info)
ZPOTRS
subroutine zposvxx(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)
ZPOSVXX computes the solution to system of linear equations A * X = B for PO matrices
subroutine zpotrf(uplo, n, a, lda, info)
ZPOTRF VARIANT: right looking block version of the algorithm, calling Level 3 BLAS.
double precision function dlamch(cmach)
DLAMCH