400 SUBROUTINE ssyrfsx( 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,
417 INTEGER IPIV( * ), IWORK( * )
418 REAL A( lda, * ), AF( ldaf, * ), B( ldb, * ),
419 $ x( ldx, * ), work( * )
420 REAL S( * ), PARAMS( * ), BERR( * ),
421 $ err_bnds_norm( nrhs, * ),
422 $ err_bnds_comp( nrhs, * )
429 parameter ( zero = 0.0e+0, one = 1.0e+0 )
430 REAL ITREF_DEFAULT, ITHRESH_DEFAULT,
431 $ componentwise_default
432 REAL RTHRESH_DEFAULT, DZTHRESH_DEFAULT
433 parameter ( itref_default = 1.0 )
434 parameter ( ithresh_default = 10.0 )
435 parameter ( componentwise_default = 1.0 )
436 parameter ( rthresh_default = 0.5 )
437 parameter ( dzthresh_default = 0.25 )
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 REAL ANORM, RCOND_TMP
453 REAL ILLRCOND_THRESH, ERR_LBND, CWISE_WRONG
456 REAL RTHRESH, UNSTABLE_THRESH
467 REAL SLAMCH, SLANSY, SLA_SYRCOND
476 ref_type = int( itref_default )
477 IF ( nparams .GE. la_linrx_itref_i )
THEN
478 IF ( params( la_linrx_itref_i ) .LT. 0.0 )
THEN
479 params( la_linrx_itref_i ) = itref_default
481 ref_type = params( la_linrx_itref_i )
487 illrcond_thresh =
REAL( n )*SLAMCH(
'Epsilon' )
488 ithresh = int( ithresh_default )
489 rthresh = rthresh_default
490 unstable_thresh = dzthresh_default
491 ignore_cwise = componentwise_default .EQ. 0.0
493 IF ( nparams.GE.la_linrx_ithresh_i )
THEN
494 IF ( params( la_linrx_ithresh_i ).LT.0.0 )
THEN
495 params( la_linrx_ithresh_i ) = ithresh
497 ithresh = int( params( la_linrx_ithresh_i ) )
500 IF ( nparams.GE.la_linrx_cwise_i )
THEN
501 IF ( params( la_linrx_cwise_i ).LT.0.0 )
THEN
502 IF ( ignore_cwise )
THEN
503 params( la_linrx_cwise_i ) = 0.0
505 params( la_linrx_cwise_i ) = 1.0
508 ignore_cwise = params( la_linrx_cwise_i ) .EQ. 0.0
511 IF ( ref_type .EQ. 0 .OR. n_err_bnds .EQ. 0 )
THEN
513 ELSE IF ( ignore_cwise )
THEN
519 rcequ = lsame( equed,
'Y' )
523 IF ( .NOT.lsame( uplo,
'U' ) .AND. .NOT.lsame( uplo,
'L' ) )
THEN
525 ELSE IF( .NOT.rcequ .AND. .NOT.lsame( equed,
'N' ) )
THEN
527 ELSE IF( n.LT.0 )
THEN
529 ELSE IF( nrhs.LT.0 )
THEN
531 ELSE IF( lda.LT.max( 1, n ) )
THEN
533 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
535 ELSE IF( ldb.LT.max( 1, n ) )
THEN
537 ELSE IF( ldx.LT.max( 1, n ) )
THEN
541 CALL xerbla(
'SSYRFSX', -info )
547 IF( n.EQ.0 .OR. nrhs.EQ.0 )
THEN
551 IF ( n_err_bnds .GE. 1 )
THEN
552 err_bnds_norm( j, la_linrx_trust_i ) = 1.0
553 err_bnds_comp( j, la_linrx_trust_i ) = 1.0
555 IF ( n_err_bnds .GE. 2 )
THEN
556 err_bnds_norm( j, la_linrx_err_i ) = 0.0
557 err_bnds_comp( j, la_linrx_err_i ) = 0.0
559 IF ( n_err_bnds .GE. 3 )
THEN
560 err_bnds_norm( j, la_linrx_rcond_i ) = 1.0
561 err_bnds_comp( j, la_linrx_rcond_i ) = 1.0
572 IF ( n_err_bnds .GE. 1 )
THEN
573 err_bnds_norm( j, la_linrx_trust_i ) = 1.0
574 err_bnds_comp( j, la_linrx_trust_i ) = 1.0
576 IF ( n_err_bnds .GE. 2 )
THEN
577 err_bnds_norm( j, la_linrx_err_i ) = 1.0
578 err_bnds_comp( j, la_linrx_err_i ) = 1.0
580 IF ( n_err_bnds .GE. 3 )
THEN
581 err_bnds_norm( j, la_linrx_rcond_i ) = 0.0
582 err_bnds_comp( j, la_linrx_rcond_i ) = 0.0
590 anorm = slansy( norm, uplo, n, a, lda, work )
591 CALL ssycon( uplo, n, af, ldaf, ipiv, anorm, rcond, work,
596 IF ( ref_type .NE. 0 )
THEN
598 prec_type = ilaprec(
'D' )
601 $ nrhs, a, lda, af, ldaf, ipiv, rcequ, s, b,
602 $ ldb, x, ldx, berr, n_norms, err_bnds_norm, err_bnds_comp,
603 $ work( n+1 ), work( 1 ), work( 2*n+1 ), work( 1 ), rcond,
604 $ ithresh, rthresh, unstable_thresh, ignore_cwise,
608 err_lbnd = max( 10.0, sqrt(
REAL( N ) ) )*slamch(
'Epsilon' )
609 IF (n_err_bnds .GE. 1 .AND. n_norms .GE. 1)
THEN
614 rcond_tmp = sla_syrcond( uplo, n, a, lda, af, ldaf, ipiv,
615 $ -1, s, info, work, iwork )
617 rcond_tmp = sla_syrcond( uplo, n, a, lda, af, ldaf, ipiv,
618 $ 0, s, info, work, iwork )
624 IF (n_err_bnds .GE. la_linrx_err_i
625 $ .AND. err_bnds_norm( j, la_linrx_err_i ) .GT. 1.0)
626 $ err_bnds_norm( j, la_linrx_err_i ) = 1.0
630 IF ( rcond_tmp .LT. illrcond_thresh )
THEN
631 err_bnds_norm( j, la_linrx_err_i ) = 1.0
632 err_bnds_norm( j, la_linrx_trust_i ) = 0.0
633 IF ( info .LE. n ) info = n + j
634 ELSE IF (err_bnds_norm( j, la_linrx_err_i ) .LT. err_lbnd)
636 err_bnds_norm( j, la_linrx_err_i ) = err_lbnd
637 err_bnds_norm( j, la_linrx_trust_i ) = 1.0
642 IF (n_err_bnds .GE. la_linrx_rcond_i)
THEN
643 err_bnds_norm( j, la_linrx_rcond_i ) = rcond_tmp
648 IF ( n_err_bnds .GE. 1 .AND. n_norms .GE. 2 )
THEN
658 cwise_wrong = sqrt( slamch(
'Epsilon' ) )
660 IF ( err_bnds_comp( j, la_linrx_err_i ) .LT. cwise_wrong )
662 rcond_tmp = sla_syrcond( uplo, n, a, lda, af, ldaf, ipiv,
663 $ 1, x(1,j), info, work, iwork )
670 IF ( n_err_bnds .GE. la_linrx_err_i
671 $ .AND. err_bnds_comp( j, la_linrx_err_i ) .GT. 1.0 )
672 $ err_bnds_comp( j, la_linrx_err_i ) = 1.0
676 IF ( rcond_tmp .LT. illrcond_thresh )
THEN
677 err_bnds_comp( j, la_linrx_err_i ) = 1.0
678 err_bnds_comp( j, la_linrx_trust_i ) = 0.0
679 IF ( .NOT. ignore_cwise
680 $ .AND. info.LT.n + j ) info = n + j
681 ELSE IF ( err_bnds_comp( j, la_linrx_err_i )
682 $ .LT. err_lbnd )
THEN
683 err_bnds_comp( j, la_linrx_err_i ) = err_lbnd
684 err_bnds_comp( j, la_linrx_trust_i ) = 1.0
689 IF ( n_err_bnds .GE. la_linrx_rcond_i )
THEN
690 err_bnds_comp( j, la_linrx_rcond_i ) = rcond_tmp
real function sla_syrcond(UPLO, N, A, LDA, AF, LDAF, IPIV, CMODE, C, INFO, WORK, IWORK)
SLA_SYRCOND estimates the Skeel condition number for a symmetric indefinite matrix.
subroutine ssyrfsx(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)
SSYRFSX
subroutine ssycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SSYCON
integer function ilaprec(PREC)
ILAPREC
subroutine xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME
real function slamch(CMACH)
SLAMCH
subroutine sla_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)
SLA_SYRFSX_EXTENDED improves the computed solution to a system of linear equations for symmetric inde...
real function slansy(NORM, UPLO, N, A, LDA, WORK)
SLANSY 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.