400 SUBROUTINE dsyrfsx( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV,
401 $ s,
b, ldb, x, ldx, rcond, berr, n_err_bnds,
402 $ err_bnds_norm, err_bnds_comp, nparams, params,
403 $ work, iwork, info )
411 CHARACTER uplo, equed
412 INTEGER info, lda, ldaf, ldb, ldx, n, nrhs, nparams,
414 DOUBLE PRECISION rcond
417 INTEGER ipiv( * ), iwork( * )
418 DOUBLE PRECISION a( lda, * ), af( ldaf, * ),
b( ldb, * ),
419 $ x( ldx, * ), work( * )
420 DOUBLE PRECISION s( * ), params( * ), berr( * ),
421 $ err_bnds_norm( nrhs, * ),
422 $ err_bnds_comp( nrhs, * )
428 DOUBLE PRECISION zero, one
429 parameter( zero = 0.0d+0, one = 1.0d+0 )
430 DOUBLE PRECISION itref_default, ithresh_default
431 DOUBLE PRECISION componentwise_default, rthresh_default
432 DOUBLE PRECISION dzthresh_default
433 parameter( itref_default = 1.0d+0 )
434 parameter( ithresh_default = 10.0d+0 )
435 parameter( componentwise_default = 1.0d+0 )
436 parameter( rthresh_default = 0.5d+0 )
437 parameter( dzthresh_default = 0.25d+0 )
438 INTEGER la_linrx_itref_i, la_linrx_ithresh_i,
440 parameter( la_linrx_itref_i = 1,
441 $ la_linrx_ithresh_i = 2 )
442 parameter( la_linrx_cwise_i = 3 )
443 INTEGER la_linrx_trust_i, la_linrx_err_i,
445 parameter( la_linrx_trust_i = 1, la_linrx_err_i = 2 )
446 parameter( la_linrx_rcond_i = 3 )
451 INTEGER j, prec_type, ref_type, n_norms
452 DOUBLE PRECISION anorm, rcond_tmp
453 DOUBLE PRECISION illrcond_thresh, err_lbnd, cwise_wrong
456 DOUBLE PRECISION rthresh, unstable_thresh
469 INTEGER blas_fpinfo_x
477 ref_type = int( itref_default )
478 IF ( nparams .GE. la_linrx_itref_i )
THEN
479 IF ( params( la_linrx_itref_i ) .LT. 0.0d+0 )
THEN
480 params( la_linrx_itref_i ) = itref_default
482 ref_type = params( la_linrx_itref_i )
488 illrcond_thresh = dble( n )*
dlamch(
'Epsilon' )
489 ithresh = int( ithresh_default )
490 rthresh = rthresh_default
491 unstable_thresh = dzthresh_default
492 ignore_cwise = componentwise_default .EQ. 0.0d+0
494 IF ( nparams.GE.la_linrx_ithresh_i )
THEN
495 IF ( params( la_linrx_ithresh_i ).LT.0.0d+0 )
THEN
496 params( la_linrx_ithresh_i ) = ithresh
498 ithresh = int( params( la_linrx_ithresh_i ) )
501 IF ( nparams.GE.la_linrx_cwise_i )
THEN
502 IF ( params( la_linrx_cwise_i ).LT.0.0d+0 )
THEN
503 IF ( ignore_cwise )
THEN
504 params( la_linrx_cwise_i ) = 0.0d+0
506 params( la_linrx_cwise_i ) = 1.0d+0
509 ignore_cwise = params( la_linrx_cwise_i ) .EQ. 0.0d+0
512 IF ( ref_type .EQ. 0 .OR. n_err_bnds .EQ. 0 )
THEN
514 ELSE IF ( ignore_cwise )
THEN
520 rcequ =
lsame( equed,
'Y' )
524 IF ( .NOT.
lsame( uplo,
'U' ) .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
526 ELSE IF( .NOT.rcequ .AND. .NOT.
lsame( equed,
'N' ) )
THEN
528 ELSE IF( n.LT.0 )
THEN
530 ELSE IF( nrhs.LT.0 )
THEN
532 ELSE IF( lda.LT.max( 1, n ) )
THEN
534 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
536 ELSE IF( ldb.LT.max( 1, n ) )
THEN
538 ELSE IF( ldx.LT.max( 1, n ) )
THEN
542 CALL
xerbla(
'DSYRFSX', -info )
548 IF( n.EQ.0 .OR. nrhs.EQ.0 )
THEN
552 IF ( n_err_bnds .GE. 1 )
THEN
553 err_bnds_norm(
j, la_linrx_trust_i ) = 1.0d+0
554 err_bnds_comp(
j, la_linrx_trust_i ) = 1.0d+0
556 IF ( n_err_bnds .GE. 2 )
THEN
557 err_bnds_norm(
j, la_linrx_err_i ) = 0.0d+0
558 err_bnds_comp(
j, la_linrx_err_i ) = 0.0d+0
560 IF ( n_err_bnds .GE. 3 )
THEN
561 err_bnds_norm(
j, la_linrx_rcond_i ) = 1.0d+0
562 err_bnds_comp(
j, la_linrx_rcond_i ) = 1.0d+0
573 IF ( n_err_bnds .GE. 1 )
THEN
574 err_bnds_norm(
j, la_linrx_trust_i ) = 1.0d+0
575 err_bnds_comp(
j, la_linrx_trust_i ) = 1.0d+0
577 IF ( n_err_bnds .GE. 2 )
THEN
578 err_bnds_norm(
j, la_linrx_err_i ) = 1.0d+0
579 err_bnds_comp(
j, la_linrx_err_i ) = 1.0d+0
581 IF ( n_err_bnds .GE. 3 )
THEN
582 err_bnds_norm(
j, la_linrx_rcond_i ) = 0.0d+0
583 err_bnds_comp(
j, la_linrx_rcond_i ) = 0.0d+0
591 anorm =
dlansy( norm, uplo, n, a, lda, work )
592 CALL
dsycon( uplo, n, af, ldaf, ipiv, anorm, rcond, work,
597 IF ( ref_type .NE. 0 )
THEN
602 $ nrhs, a, lda, af, ldaf, ipiv, rcequ, s,
b,
603 $ ldb, x, ldx, berr, n_norms, err_bnds_norm, err_bnds_comp,
604 $ work( n+1 ), work( 1 ), work( 2*n+1 ), work( 1 ), rcond,
605 $ ithresh, rthresh, unstable_thresh, ignore_cwise,
609 err_lbnd = max( 10.0d+0, sqrt( dble( n ) ) )*
dlamch(
'Epsilon' )
610 IF (n_err_bnds .GE. 1 .AND. n_norms .GE. 1)
THEN
615 rcond_tmp =
dla_syrcond( uplo, n, a, lda, af, ldaf, ipiv,
616 $ -1, s, info, work, iwork )
618 rcond_tmp =
dla_syrcond( uplo, n, a, lda, af, ldaf, ipiv,
619 $ 0, s, info, work, iwork )
625 IF (n_err_bnds .GE. la_linrx_err_i
626 $ .AND. err_bnds_norm(
j, la_linrx_err_i ) .GT. 1.0d+0)
627 $ err_bnds_norm(
j, la_linrx_err_i ) = 1.0d+0
631 IF ( rcond_tmp .LT. illrcond_thresh )
THEN
632 err_bnds_norm(
j, la_linrx_err_i ) = 1.0d+0
633 err_bnds_norm(
j, la_linrx_trust_i ) = 0.0d+0
634 IF ( info .LE. n ) info = n +
j
635 ELSE IF (err_bnds_norm(
j, la_linrx_err_i ) .LT. err_lbnd)
637 err_bnds_norm(
j, la_linrx_err_i ) = err_lbnd
638 err_bnds_norm(
j, la_linrx_trust_i ) = 1.0d+0
643 IF (n_err_bnds .GE. la_linrx_rcond_i)
THEN
644 err_bnds_norm(
j, la_linrx_rcond_i ) = rcond_tmp
649 IF ( n_err_bnds .GE. 1 .AND. n_norms .GE. 2 )
THEN
659 cwise_wrong = sqrt(
dlamch(
'Epsilon' ) )
661 IF ( err_bnds_comp(
j, la_linrx_err_i ) .LT. cwise_wrong )
663 rcond_tmp =
dla_syrcond( uplo, n, a, lda, af, ldaf, ipiv,
664 $ 1, x(1,
j), info, work, iwork )
671 IF ( n_err_bnds .GE. la_linrx_err_i
672 $ .AND. err_bnds_comp(
j, la_linrx_err_i ) .GT. 1.0d+0 )
673 $ err_bnds_comp(
j, la_linrx_err_i ) = 1.0d+0
677 IF ( rcond_tmp .LT. illrcond_thresh )
THEN
678 err_bnds_comp(
j, la_linrx_err_i ) = 1.0d+0
679 err_bnds_comp(
j, la_linrx_trust_i ) = 0.0d+0
680 IF ( .NOT. ignore_cwise
681 $ .AND. info.LT.n +
j ) info = n +
j
682 ELSE IF ( err_bnds_comp(
j, la_linrx_err_i )
683 $ .LT. err_lbnd )
THEN
684 err_bnds_comp(
j, la_linrx_err_i ) = err_lbnd
685 err_bnds_comp(
j, la_linrx_trust_i ) = 1.0d+0
690 IF ( n_err_bnds .GE. la_linrx_rcond_i )
THEN
691 err_bnds_comp(
j, la_linrx_rcond_i ) = rcond_tmp
integer function ilatrans(TRANS)
ILATRANS
subroutine dsycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DSYCON
subroutine dla_syrfsx_extended(PREC_TYPE, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, 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_SYRFSX_EXTENDED improves the computed solution to a system of linear equations for symmetric inde...
subroutine xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
logical function lsame(CA, CB)
LSAME
integer function ilaprec(PREC)
ILAPREC
double precision function dlamch(CMACH)
DLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
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 dsyrfsx(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, IWORK, INFO)
DSYRFSX
double precision function dla_syrcond(UPLO, N, A, LDA, AF, LDAF, IPIV, CMODE, C, INFO, WORK, IWORK)
DLA_SYRCOND estimates the Skeel condition number for a symmetric indefinite matrix.