398 SUBROUTINE csyrfsx( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV,
399 $ S, B, LDB, X, LDX, RCOND, BERR, N_ERR_BNDS,
400 $ ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS,
401 $ WORK, RWORK, INFO )
408 CHARACTER UPLO, EQUED
409 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS, NPARAMS,
415 COMPLEX A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
416 $ X( LDX, * ), WORK( * )
417 REAL S( * ), PARAMS( * ), BERR( * ), RWORK( * ),
418 $ err_bnds_norm( nrhs, * ),
419 $ err_bnds_comp( nrhs, * )
426 PARAMETER ( ZERO = 0.0e+0, one = 1.0e+0 )
427 REAL ITREF_DEFAULT, ITHRESH_DEFAULT,
428 $ componentwise_default
429 REAL RTHRESH_DEFAULT, DZTHRESH_DEFAULT
430 parameter( itref_default = 1.0 )
431 parameter( ithresh_default = 10.0 )
432 parameter( componentwise_default = 1.0 )
433 parameter( rthresh_default = 0.5 )
434 parameter( dzthresh_default = 0.25 )
435 INTEGER LA_LINRX_ITREF_I, LA_LINRX_ITHRESH_I,
437 parameter( la_linrx_itref_i = 1,
438 $ la_linrx_ithresh_i = 2 )
439 parameter( la_linrx_cwise_i = 3 )
440 INTEGER LA_LINRX_TRUST_I, LA_LINRX_ERR_I,
442 parameter( la_linrx_trust_i = 1, la_linrx_err_i = 2 )
443 parameter( la_linrx_rcond_i = 3 )
448 INTEGER J, PREC_TYPE, REF_TYPE
450 REAL ANORM, RCOND_TMP
451 REAL ILLRCOND_THRESH, ERR_LBND, CWISE_WRONG
454 REAL RTHRESH, UNSTABLE_THRESH
460 INTRINSIC max, sqrt, transfer
465 REAL SLAMCH, CLANSY, CLA_SYRCOND_X, CLA_SYRCOND_C
474 ref_type = int( itref_default )
475 IF ( nparams .GE. la_linrx_itref_i )
THEN
476 IF ( params( la_linrx_itref_i ) .LT. 0.0 )
THEN
477 params( la_linrx_itref_i ) = itref_default
479 ref_type = params( la_linrx_itref_i )
485 illrcond_thresh = real( n ) * slamch(
'Epsilon' )
486 ithresh = int( ithresh_default )
487 rthresh = rthresh_default
488 unstable_thresh = dzthresh_default
489 ignore_cwise = componentwise_default .EQ. 0.0
491 IF ( nparams.GE.la_linrx_ithresh_i )
THEN
492 IF ( params( la_linrx_ithresh_i ).LT.0.0 )
THEN
493 params( la_linrx_ithresh_i ) = ithresh
495 ithresh = int( params( la_linrx_ithresh_i ) )
498 IF ( nparams.GE.la_linrx_cwise_i )
THEN
499 IF ( params( la_linrx_cwise_i ).LT.0.0 )
THEN
500 IF ( ignore_cwise )
THEN
501 params( la_linrx_cwise_i ) = 0.0
503 params( la_linrx_cwise_i ) = 1.0
506 ignore_cwise = params( la_linrx_cwise_i ) .EQ. 0.0
509 IF ( ref_type .EQ. 0 .OR. n_err_bnds .EQ. 0 )
THEN
511 ELSE IF ( ignore_cwise )
THEN
517 rcequ = lsame( equed,
'Y' )
521 IF ( .NOT.lsame( uplo,
'U' ) .AND. .NOT.lsame( uplo,
'L' ) )
THEN
523 ELSE IF( .NOT.rcequ .AND. .NOT.lsame( equed,
'N' ) )
THEN
525 ELSE IF( n.LT.0 )
THEN
527 ELSE IF( nrhs.LT.0 )
THEN
529 ELSE IF( lda.LT.max( 1, n ) )
THEN
531 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
533 ELSE IF( ldb.LT.max( 1, n ) )
THEN
535 ELSE IF( ldx.LT.max( 1, n ) )
THEN
539 CALL xerbla(
'CSYRFSX', -info )
545 IF( n.EQ.0 .OR. nrhs.EQ.0 )
THEN
549 IF ( n_err_bnds .GE. 1 )
THEN
550 err_bnds_norm( j, la_linrx_trust_i ) = 1.0
551 err_bnds_comp( j, la_linrx_trust_i ) = 1.0
553 IF ( n_err_bnds .GE. 2 )
THEN
554 err_bnds_norm( j, la_linrx_err_i ) = 0.0
555 err_bnds_comp( j, la_linrx_err_i ) = 0.0
557 IF ( n_err_bnds .GE. 3 )
THEN
558 err_bnds_norm( j, la_linrx_rcond_i ) = 1.0
559 err_bnds_comp( j, la_linrx_rcond_i ) = 1.0
570 IF ( n_err_bnds .GE. 1 )
THEN
571 err_bnds_norm( j, la_linrx_trust_i ) = 1.0
572 err_bnds_comp( j, la_linrx_trust_i ) = 1.0
574 IF ( n_err_bnds .GE. 2 )
THEN
575 err_bnds_norm( j, la_linrx_err_i ) = 1.0
576 err_bnds_comp( j, la_linrx_err_i ) = 1.0
578 IF ( n_err_bnds .GE. 3 )
THEN
579 err_bnds_norm( j, la_linrx_rcond_i ) = 0.0
580 err_bnds_comp( j, la_linrx_rcond_i ) = 0.0
588 anorm = clansy( norm, uplo, n, a, lda, rwork )
589 CALL csycon( uplo, n, af, ldaf, ipiv, anorm, rcond, work,
594 IF ( ref_type .NE. 0 )
THEN
596 prec_type = ilaprec(
'D' )
599 $ nrhs, a, lda, af, ldaf, ipiv, rcequ, s, b,
600 $ ldb, x, ldx, berr, n_norms, err_bnds_norm, err_bnds_comp,
601 $ work, rwork, work(n+1),
602 $ transfer(rwork(1:2*n), (/ (zero, zero) /), n), rcond,
603 $ ithresh, rthresh, unstable_thresh, ignore_cwise,
607 err_lbnd = max( 10.0, sqrt( real( n ) ) ) * slamch(
'Epsilon' )
608 IF (n_err_bnds .GE. 1 .AND. n_norms .GE. 1)
THEN
613 rcond_tmp = cla_syrcond_c( uplo, n, a, lda, af, ldaf, ipiv,
614 $ s, .true., info, work, rwork )
616 rcond_tmp = cla_syrcond_c( uplo, n, a, lda, af, ldaf, ipiv,
617 $ s, .false., info, work, rwork )
623 IF ( n_err_bnds .GE. la_linrx_err_i
624 $ .AND. err_bnds_norm( j, la_linrx_err_i ) .GT. 1.0 )
625 $ err_bnds_norm( j, la_linrx_err_i ) = 1.0
629 IF ( rcond_tmp .LT. illrcond_thresh )
THEN
630 err_bnds_norm( j, la_linrx_err_i ) = 1.0
631 err_bnds_norm( j, la_linrx_trust_i ) = 0.0
632 IF ( info .LE. n ) info = n + j
633 ELSE IF ( err_bnds_norm( j, la_linrx_err_i ) .LT. err_lbnd )
635 err_bnds_norm( j, la_linrx_err_i ) = err_lbnd
636 err_bnds_norm( j, la_linrx_trust_i ) = 1.0
641 IF ( n_err_bnds .GE. la_linrx_rcond_i )
THEN
642 err_bnds_norm( j, la_linrx_rcond_i ) = rcond_tmp
647 IF ( n_err_bnds .GE. 1 .AND. n_norms .GE. 2 )
THEN
657 cwise_wrong = sqrt( slamch(
'Epsilon' ) )
659 IF ( err_bnds_comp( j, la_linrx_err_i ) .LT. cwise_wrong )
661 rcond_tmp = cla_syrcond_x( uplo, n, a, lda, af, ldaf,
662 $ ipiv, x(1,j), info, work, rwork )
669 IF ( n_err_bnds .GE. la_linrx_err_i
670 $ .AND. err_bnds_comp( j, la_linrx_err_i ) .GT. 1.0 )
671 $ 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
subroutine xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME
integer function ilaprec(PREC)
ILAPREC
real function clansy(NORM, UPLO, N, A, LDA, WORK)
CLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm,...
subroutine csyrfsx(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, RWORK, INFO)
CSYRFSX
subroutine cla_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)
CLA_SYRFSX_EXTENDED improves the computed solution to a system of linear equations for symmetric inde...
real function cla_syrcond_c(UPLO, N, A, LDA, AF, LDAF, IPIV, C, CAPPLY, INFO, WORK, RWORK)
CLA_SYRCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for symmetric indefin...
subroutine csycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
CSYCON
real function cla_syrcond_x(UPLO, N, A, LDA, AF, LDAF, IPIV, X, INFO, WORK, RWORK)
CLA_SYRCOND_X computes the infinity norm condition number of op(A)*diag(x) for symmetric indefinite m...
real function slamch(CMACH)
SLAMCH