392 SUBROUTINE dporfsx( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, S, B,
393 $ ldb, x, ldx, rcond, berr, n_err_bnds,
394 $ err_bnds_norm, err_bnds_comp, nparams, params,
395 $ work, iwork, info )
403 CHARACTER UPLO, EQUED
404 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS, NPARAMS,
406 DOUBLE PRECISION RCOND
410 DOUBLE PRECISION A( lda, * ), AF( ldaf, * ), B( ldb, * ),
411 $ x( ldx, * ), work( * )
412 DOUBLE PRECISION S( * ), PARAMS( * ), BERR( * ),
413 $ err_bnds_norm( nrhs, * ),
414 $ err_bnds_comp( nrhs, * )
420 DOUBLE PRECISION ZERO, ONE
421 parameter( zero = 0.0d+0, one = 1.0d+0 )
422 DOUBLE PRECISION ITREF_DEFAULT, ITHRESH_DEFAULT
423 DOUBLE PRECISION COMPONENTWISE_DEFAULT, RTHRESH_DEFAULT
424 DOUBLE PRECISION DZTHRESH_DEFAULT
425 parameter( itref_default = 1.0d+0 )
426 parameter( ithresh_default = 10.0d+0 )
427 parameter( componentwise_default = 1.0d+0 )
428 parameter( rthresh_default = 0.5d+0 )
429 parameter( dzthresh_default = 0.25d+0 )
430 INTEGER LA_LINRX_ITREF_I, LA_LINRX_ITHRESH_I,
432 parameter( la_linrx_itref_i = 1,
433 $ la_linrx_ithresh_i = 2 )
434 parameter( la_linrx_cwise_i = 3 )
435 INTEGER LA_LINRX_TRUST_I, LA_LINRX_ERR_I,
437 parameter( la_linrx_trust_i = 1, la_linrx_err_i = 2 )
438 parameter( la_linrx_rcond_i = 3 )
443 INTEGER J, PREC_TYPE, REF_TYPE
445 DOUBLE PRECISION ANORM, RCOND_TMP
446 DOUBLE PRECISION ILLRCOND_THRESH, ERR_LBND, CWISE_WRONG
449 DOUBLE PRECISION RTHRESH, UNSTABLE_THRESH
458 EXTERNAL lsame, blas_fpinfo_x, ilatrans, ilaprec
460 DOUBLE PRECISION DLAMCH, DLANSY, DLA_PORCOND
462 INTEGER BLAS_FPINFO_X
463 INTEGER ILATRANS, ILAPREC
470 ref_type = int( itref_default )
471 IF ( nparams .GE. la_linrx_itref_i )
THEN
472 IF ( params( la_linrx_itref_i ) .LT. 0.0d+0 )
THEN
473 params( la_linrx_itref_i ) = itref_default
475 ref_type = params( la_linrx_itref_i )
481 illrcond_thresh = dble( n ) * dlamch(
'Epsilon' )
482 ithresh = int( ithresh_default )
483 rthresh = rthresh_default
484 unstable_thresh = dzthresh_default
485 ignore_cwise = componentwise_default .EQ. 0.0d+0
487 IF ( nparams.GE.la_linrx_ithresh_i )
THEN
488 IF ( params( la_linrx_ithresh_i ).LT.0.0d+0 )
THEN
489 params( la_linrx_ithresh_i ) = ithresh
491 ithresh = int( params( la_linrx_ithresh_i ) )
494 IF ( nparams.GE.la_linrx_cwise_i )
THEN
495 IF ( params( la_linrx_cwise_i ).LT.0.0d+0 )
THEN
496 IF ( ignore_cwise )
THEN
497 params( la_linrx_cwise_i ) = 0.0d+0
499 params( la_linrx_cwise_i ) = 1.0d+0
502 ignore_cwise = params( la_linrx_cwise_i ) .EQ. 0.0d+0
505 IF ( ref_type .EQ. 0 .OR. n_err_bnds .EQ. 0 )
THEN
507 ELSE IF ( ignore_cwise )
THEN
513 rcequ = lsame( equed,
'Y' )
517 IF (.NOT.lsame(uplo,
'U') .AND. .NOT.lsame(uplo,
'L'))
THEN
519 ELSE IF( .NOT.rcequ .AND. .NOT.lsame( equed,
'N' ) )
THEN
521 ELSE IF( n.LT.0 )
THEN
523 ELSE IF( nrhs.LT.0 )
THEN
525 ELSE IF( lda.LT.max( 1, n ) )
THEN
527 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
529 ELSE IF( ldb.LT.max( 1, n ) )
THEN
531 ELSE IF( ldx.LT.max( 1, n ) )
THEN
535 CALL
xerbla(
'DPORFSX', -info )
541 IF( n.EQ.0 .OR. nrhs.EQ.0 )
THEN
545 IF ( n_err_bnds .GE. 1 )
THEN
546 err_bnds_norm( j, la_linrx_trust_i ) = 1.0d+0
547 err_bnds_comp( j, la_linrx_trust_i ) = 1.0d+0
549 IF ( n_err_bnds .GE. 2 )
THEN
550 err_bnds_norm( j, la_linrx_err_i ) = 0.0d+0
551 err_bnds_comp( j, la_linrx_err_i ) = 0.0d+0
553 IF ( n_err_bnds .GE. 3 )
THEN
554 err_bnds_norm( j, la_linrx_rcond_i ) = 1.0d+0
555 err_bnds_comp( j, la_linrx_rcond_i ) = 1.0d+0
566 IF ( n_err_bnds .GE. 1 )
THEN
567 err_bnds_norm( j, la_linrx_trust_i ) = 1.0d+0
568 err_bnds_comp( j, la_linrx_trust_i ) = 1.0d+0
570 IF ( n_err_bnds .GE. 2 )
THEN
571 err_bnds_norm( j, la_linrx_err_i ) = 1.0d+0
572 err_bnds_comp( j, la_linrx_err_i ) = 1.0d+0
574 IF ( n_err_bnds .GE. 3 )
THEN
575 err_bnds_norm( j, la_linrx_rcond_i ) = 0.0d+0
576 err_bnds_comp( j, la_linrx_rcond_i ) = 0.0d+0
584 anorm = dlansy( norm, uplo, n, a, lda, work )
585 CALL
dpocon( uplo, n, af, ldaf, anorm, rcond, work,
590 IF ( ref_type .NE. 0 )
THEN
592 prec_type = ilaprec(
'E' )
595 $ nrhs, a, lda, af, ldaf, rcequ, s, b,
596 $ ldb, x, ldx, berr, n_norms, err_bnds_norm, err_bnds_comp,
597 $ work( n+1 ), work( 1 ), work( 2*n+1 ), work( 1 ), rcond,
598 $ ithresh, rthresh, unstable_thresh, ignore_cwise,
602 err_lbnd = max( 10.0d+0, sqrt( dble( n ) ) ) * dlamch(
'Epsilon' )
603 IF ( n_err_bnds .GE. 1 .AND. n_norms .GE. 1 )
THEN
608 rcond_tmp = dla_porcond( uplo, n, a, lda, af, ldaf,
609 $ -1, s, info, work, iwork )
611 rcond_tmp = dla_porcond( uplo, n, a, lda, af, ldaf,
612 $ 0, s, info, work, iwork )
618 IF ( n_err_bnds .GE. la_linrx_err_i
619 $ .AND. err_bnds_norm( j, la_linrx_err_i ) .GT. 1.0d+0 )
620 $ err_bnds_norm( j, la_linrx_err_i ) = 1.0d+0
624 IF ( rcond_tmp .LT. illrcond_thresh )
THEN
625 err_bnds_norm( j, la_linrx_err_i ) = 1.0d+0
626 err_bnds_norm( j, la_linrx_trust_i ) = 0.0d+0
627 IF ( info .LE. n ) info = n + j
628 ELSE IF ( err_bnds_norm( j, la_linrx_err_i ) .LT. err_lbnd )
630 err_bnds_norm( j, la_linrx_err_i ) = err_lbnd
631 err_bnds_norm( j, la_linrx_trust_i ) = 1.0d+0
636 IF (n_err_bnds .GE. la_linrx_rcond_i)
THEN
637 err_bnds_norm( j, la_linrx_rcond_i ) = rcond_tmp
642 IF ( n_err_bnds .GE. 1 .AND. n_norms .GE. 2 )
THEN
652 cwise_wrong = sqrt( dlamch(
'Epsilon' ) )
654 IF (err_bnds_comp( j, la_linrx_err_i ) .LT. cwise_wrong )
656 rcond_tmp = dla_porcond( uplo, n, a, lda, af, ldaf, 1,
657 $ x( 1, j ), info, work, iwork )
664 IF ( n_err_bnds .GE. la_linrx_err_i
665 $ .AND. err_bnds_comp( j, la_linrx_err_i ) .GT. 1.0d+0 )
666 $ err_bnds_comp( j, la_linrx_err_i ) = 1.0d+0
670 IF ( rcond_tmp .LT. illrcond_thresh )
THEN
671 err_bnds_comp( j, la_linrx_err_i ) = 1.0d+0
672 err_bnds_comp( j, la_linrx_trust_i ) = 0.0d+0
673 IF ( params( la_linrx_cwise_i ) .EQ. 1.0d+0
674 $ .AND. info.LT.n + j ) info = n + j
675 ELSE IF ( err_bnds_comp( j, la_linrx_err_i )
676 $ .LT. err_lbnd )
THEN
677 err_bnds_comp( j, la_linrx_err_i ) = err_lbnd
678 err_bnds_comp( j, la_linrx_trust_i ) = 1.0d+0
683 IF ( n_err_bnds .GE. la_linrx_rcond_i )
THEN
684 err_bnds_comp( j, la_linrx_rcond_i ) = rcond_tmp
subroutine dporfsx(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, IWORK, INFO)
DPORFSX
double precision function dla_porcond(UPLO, N, A, LDA, AF, LDAF, CMODE, C, INFO, WORK, IWORK)
DLA_PORCOND estimates the Skeel condition number for a symmetric positive-definite matrix...
subroutine xerbla(SRNAME, INFO)
XERBLA
double precision function dlansy(NORM, UPLO, N, A, LDA, WORK)
DLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric matrix.
subroutine dla_porfsx_extended(PREC_TYPE, UPLO, N, NRHS, A, LDA, AF, LDAF, COLEQU, C, B, LDB, Y, LDY, BERR_OUT, N_NORMS, ERR_BNDS_NORM, ERR_BNDS_COMP, RES, AYB, DY, Y_TAIL, RCOND, ITHRESH, RTHRESH, DZ_UB, IGNORE_CWISE, INFO)
DLA_PORFSX_EXTENDED improves the computed solution to a system of linear equations for symmetric or H...
subroutine dpocon(UPLO, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO)
DPOCON