491 SUBROUTINE zposvxx( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED,
492 $ s, b, ldb, x, ldx, rcond, rpvgrw, berr,
493 $ n_err_bnds, err_bnds_norm, err_bnds_comp,
494 $ nparams, params, work, rwork, info )
502 CHARACTER equed, fact, uplo
503 INTEGER info, lda, ldaf, ldb, ldx, n, nrhs, nparams,
505 DOUBLE PRECISION rcond, rpvgrw
508 COMPLEX*16 a( lda, * ), af( ldaf, * ), b( ldb, * ),
509 $ work( * ), x( ldx, * )
510 DOUBLE PRECISION s( * ), params( * ), berr( * ), rwork( * ),
511 $ err_bnds_norm( nrhs, * ),
512 $ err_bnds_comp( nrhs, * )
518 DOUBLE PRECISION zero, one
519 parameter( zero = 0.0d+0, one = 1.0d+0 )
520 INTEGER final_nrm_err_i, final_cmp_err_i, berr_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 DOUBLE PRECISION amax, bignum, smin, smax, scond, smlnum
549 nofact =
lsame( fact,
'N' )
550 equil =
lsame( fact,
'E' )
551 smlnum =
dlamch(
'Safe minimum' )
552 bignum = one / smlnum
553 IF( nofact .OR. equil )
THEN
557 rcequ =
lsame( equed,
'Y' )
568 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.
569 $
lsame( fact,
'F' ) )
THEN
571 ELSE IF( .NOT.
lsame( uplo,
'U' ) .AND.
572 $ .NOT.
lsame( uplo,
'L' ) )
THEN
574 ELSE IF( n.LT.0 )
THEN
576 ELSE IF( nrhs.LT.0 )
THEN
578 ELSE IF( lda.LT.max( 1, n ) )
THEN
580 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
582 ELSE IF(
lsame( fact,
'F' ) .AND. .NOT.
583 $ ( rcequ .OR.
lsame( equed,
'N' ) ) )
THEN
590 smin = min( smin, s( j ) )
591 smax = max( smax, s( j ) )
593 IF( smin.LE.zero )
THEN
595 ELSE IF( n.GT.0 )
THEN
596 scond = max( smin, smlnum ) / min( smax, bignum )
602 IF( ldb.LT.max( 1, n ) )
THEN
604 ELSE IF( ldx.LT.max( 1, n ) )
THEN
611 CALL
xerbla(
'ZPOSVXX', -info )
619 CALL
zpoequb( n, a, lda, s, scond, amax, infequ )
620 IF( infequ.EQ.0 )
THEN
624 CALL
zlaqhe( uplo, n, a, lda, s, scond, amax, equed )
625 rcequ =
lsame( equed,
'Y' )
631 IF( rcequ ) CALL
zlascl2( n, nrhs, s, b, ldb )
633 IF( nofact .OR. equil )
THEN
637 CALL
zlacpy( uplo, n, n, a, lda, af, ldaf )
638 CALL
zpotrf( uplo, n, af, ldaf, info )
648 rpvgrw =
zla_porpvgrw( uplo, n, a, lda, af, ldaf, rwork )
655 rpvgrw =
zla_porpvgrw( uplo, n, a, lda, af, ldaf, rwork )
659 CALL
zlacpy(
'Full', n, nrhs, b, ldb, x, ldx )
660 CALL
zpotrs( uplo, n, nrhs, af, ldaf, x, ldx, info )
665 CALL
zporfsx( 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
zlascl2( n, nrhs, s, x, ldx )