400 SUBROUTINE csyrfsx( 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, rwork, info )
411 CHARACTER UPLO, EQUED
412 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS, NPARAMS,
418 COMPLEX A( lda, * ), AF( ldaf, * ), B( ldb, * ),
419 $ x( ldx, * ), work( * )
420 REAL S( * ), PARAMS( * ), BERR( * ), RWORK( * ),
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
453 REAL ANORM, RCOND_TMP
454 REAL ILLRCOND_THRESH, ERR_LBND, CWISE_WRONG
457 REAL RTHRESH, UNSTABLE_THRESH
463 INTRINSIC max, sqrt, transfer
468 REAL SLAMCH, CLANSY, CLA_SYRCOND_X, CLA_SYRCOND_C
470 INTEGER BLAS_FPINFO_X
471 INTEGER ILATRANS, ILAPREC
478 ref_type = int( itref_default )
479 IF ( nparams .GE. la_linrx_itref_i )
THEN
480 IF ( params( la_linrx_itref_i ) .LT. 0.0 )
THEN
481 params( la_linrx_itref_i ) = itref_default
483 ref_type = params( la_linrx_itref_i )
489 illrcond_thresh =
REAL( N ) * SLAMCH(
'Epsilon' )
490 ithresh = int( ithresh_default )
491 rthresh = rthresh_default
492 unstable_thresh = dzthresh_default
493 ignore_cwise = componentwise_default .EQ. 0.0
495 IF ( nparams.GE.la_linrx_ithresh_i )
THEN
496 IF ( params( la_linrx_ithresh_i ).LT.0.0 )
THEN
497 params( la_linrx_ithresh_i ) = ithresh
499 ithresh = int( params( la_linrx_ithresh_i ) )
502 IF ( nparams.GE.la_linrx_cwise_i )
THEN
503 IF ( params( la_linrx_cwise_i ).LT.0.0 )
THEN
504 IF ( ignore_cwise )
THEN
505 params( la_linrx_cwise_i ) = 0.0
507 params( la_linrx_cwise_i ) = 1.0
510 ignore_cwise = params( la_linrx_cwise_i ) .EQ. 0.0
513 IF ( ref_type .EQ. 0 .OR. n_err_bnds .EQ. 0 )
THEN
515 ELSE IF ( ignore_cwise )
THEN
521 rcequ = lsame( equed,
'Y' )
525 IF ( .NOT.lsame( uplo,
'U' ) .AND. .NOT.lsame( uplo,
'L' ) )
THEN
527 ELSE IF( .NOT.rcequ .AND. .NOT.lsame( equed,
'N' ) )
THEN
529 ELSE IF( n.LT.0 )
THEN
531 ELSE IF( nrhs.LT.0 )
THEN
533 ELSE IF( lda.LT.max( 1, n ) )
THEN
535 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
537 ELSE IF( ldb.LT.max( 1, n ) )
THEN
539 ELSE IF( ldx.LT.max( 1, n ) )
THEN
543 CALL xerbla(
'CSYRFSX', -info )
549 IF( n.EQ.0 .OR. nrhs.EQ.0 )
THEN
553 IF ( n_err_bnds .GE. 1 )
THEN
554 err_bnds_norm( j, la_linrx_trust_i ) = 1.0
555 err_bnds_comp( j, la_linrx_trust_i ) = 1.0
557 IF ( n_err_bnds .GE. 2 )
THEN
558 err_bnds_norm( j, la_linrx_err_i ) = 0.0
559 err_bnds_comp( j, la_linrx_err_i ) = 0.0
561 IF ( n_err_bnds .GE. 3 )
THEN
562 err_bnds_norm( j, la_linrx_rcond_i ) = 1.0
563 err_bnds_comp( j, la_linrx_rcond_i ) = 1.0
574 IF ( n_err_bnds .GE. 1 )
THEN
575 err_bnds_norm( j, la_linrx_trust_i ) = 1.0
576 err_bnds_comp( j, la_linrx_trust_i ) = 1.0
578 IF ( n_err_bnds .GE. 2 )
THEN
579 err_bnds_norm( j, la_linrx_err_i ) = 1.0
580 err_bnds_comp( j, la_linrx_err_i ) = 1.0
582 IF ( n_err_bnds .GE. 3 )
THEN
583 err_bnds_norm( j, la_linrx_rcond_i ) = 0.0
584 err_bnds_comp( j, la_linrx_rcond_i ) = 0.0
592 anorm = clansy( norm, uplo, n, a, lda, rwork )
593 CALL csycon( uplo, n, af, ldaf, ipiv, anorm, rcond, work,
598 IF ( ref_type .NE. 0 )
THEN
600 prec_type = ilaprec(
'D' )
603 $ nrhs, a, lda, af, ldaf, ipiv, rcequ, s, b,
604 $ ldb, x, ldx, berr, n_norms, err_bnds_norm, err_bnds_comp,
605 $ work, rwork, work(n+1),
606 $ transfer(rwork(1:2*n), (/ (zero, zero) /), n), rcond,
607 $ ithresh, rthresh, unstable_thresh, ignore_cwise,
611 err_lbnd = max( 10.0, sqrt(
REAL( N ) ) ) * slamch(
'Epsilon' )
612 IF (n_err_bnds .GE. 1 .AND. n_norms .GE. 1)
THEN
617 rcond_tmp = cla_syrcond_c( uplo, n, a, lda, af, ldaf, ipiv,
618 $ s, .true., info, work, rwork )
620 rcond_tmp = cla_syrcond_c( uplo, n, a, lda, af, ldaf, ipiv,
621 $ s, .false., info, work, rwork )
627 IF ( n_err_bnds .GE. la_linrx_err_i
628 $ .AND. err_bnds_norm( j, la_linrx_err_i ) .GT. 1.0 )
629 $ err_bnds_norm( j, la_linrx_err_i ) = 1.0
633 IF ( rcond_tmp .LT. illrcond_thresh )
THEN
634 err_bnds_norm( j, la_linrx_err_i ) = 1.0
635 err_bnds_norm( j, la_linrx_trust_i ) = 0.0
636 IF ( info .LE. n ) info = n + j
637 ELSE IF ( err_bnds_norm( j, la_linrx_err_i ) .LT. err_lbnd )
639 err_bnds_norm( j, la_linrx_err_i ) = err_lbnd
640 err_bnds_norm( j, la_linrx_trust_i ) = 1.0
645 IF ( n_err_bnds .GE. la_linrx_rcond_i )
THEN
646 err_bnds_norm( j, la_linrx_rcond_i ) = rcond_tmp
651 IF ( n_err_bnds .GE. 1 .AND. n_norms .GE. 2 )
THEN
661 cwise_wrong = sqrt( slamch(
'Epsilon' ) )
663 IF ( err_bnds_comp( j, la_linrx_err_i ) .LT. cwise_wrong )
665 rcond_tmp = cla_syrcond_x( uplo, n, a, lda, af, ldaf,
666 $ ipiv, x(1,j), info, work, rwork )
673 IF ( n_err_bnds .GE. la_linrx_err_i
674 $ .AND. err_bnds_comp( j, la_linrx_err_i ) .GT. 1.0 )
675 $ err_bnds_comp( j, la_linrx_err_i ) = 1.0
680 IF ( rcond_tmp .LT. illrcond_thresh )
THEN
681 err_bnds_comp( j, la_linrx_err_i ) = 1.0
682 err_bnds_comp( j, la_linrx_trust_i ) = 0.0
683 IF ( .NOT. ignore_cwise
684 $ .AND. info.LT.n + j ) info = n + j
685 ELSE IF ( err_bnds_comp( j, la_linrx_err_i )
686 $ .LT. err_lbnd )
THEN
687 err_bnds_comp( j, la_linrx_err_i ) = err_lbnd
688 err_bnds_comp( j, la_linrx_trust_i ) = 1.0
693 IF ( n_err_bnds .GE. la_linrx_rcond_i )
THEN
694 err_bnds_comp( j, la_linrx_rcond_i ) = rcond_tmp
integer function ilatrans(TRANS)
ILATRANS
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...
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 xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME
integer function ilaprec(PREC)
ILAPREC
real function slamch(CMACH)
SLAMCH
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, or the element of largest absolute value of a complex symmetric matrix.
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 csycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
CSYCON