396 SUBROUTINE zsyrfsx( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF,
398 $ S, B, LDB, X, LDX, RCOND, BERR, N_ERR_BNDS,
399 $ ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS,
400 $ WORK, RWORK, INFO )
407 CHARACTER UPLO, EQUED
408 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS, NPARAMS,
410 DOUBLE PRECISION RCOND
414 COMPLEX*16 A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
415 $ X( LDX, * ), WORK( * )
416 DOUBLE PRECISION S( * ), PARAMS( * ), BERR( * ), RWORK( * ),
417 $ err_bnds_norm( nrhs, * ),
418 $ err_bnds_comp( nrhs, * )
424 DOUBLE PRECISION ZERO, ONE
425 PARAMETER ( ZERO = 0.0d+0, one = 1.0d+0 )
426 DOUBLE PRECISION ITREF_DEFAULT, ITHRESH_DEFAULT
427 DOUBLE PRECISION COMPONENTWISE_DEFAULT, RTHRESH_DEFAULT
428 DOUBLE PRECISION DZTHRESH_DEFAULT
429 parameter( itref_default = 1.0d+0 )
430 parameter( ithresh_default = 10.0d+0 )
431 parameter( componentwise_default = 1.0d+0 )
432 parameter( rthresh_default = 0.5d+0 )
433 parameter( dzthresh_default = 0.25d+0 )
434 INTEGER LA_LINRX_ITREF_I, LA_LINRX_ITHRESH_I,
436 parameter( la_linrx_itref_i = 1,
437 $ la_linrx_ithresh_i = 2 )
438 parameter( la_linrx_cwise_i = 3 )
439 INTEGER LA_LINRX_TRUST_I, LA_LINRX_ERR_I,
441 parameter( la_linrx_trust_i = 1, la_linrx_err_i = 2 )
442 parameter( la_linrx_rcond_i = 3 )
447 INTEGER J, PREC_TYPE, REF_TYPE
449 DOUBLE PRECISION ANORM, RCOND_TMP
450 DOUBLE PRECISION ILLRCOND_THRESH, ERR_LBND, CWISE_WRONG
453 DOUBLE PRECISION RTHRESH, UNSTABLE_THRESH
459 INTRINSIC max, sqrt, transfer
465 DOUBLE PRECISION DLAMCH, ZLANSY, ZLA_SYRCOND_X, ZLA_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.0d+0 )
THEN
477 params( la_linrx_itref_i ) = itref_default
479 ref_type = params( la_linrx_itref_i )
485 illrcond_thresh = dble( n ) * dlamch(
'Epsilon' )
486 ithresh = int( ithresh_default )
487 rthresh = rthresh_default
488 unstable_thresh = dzthresh_default
489 ignore_cwise = componentwise_default .EQ. 0.0d+0
491 IF ( nparams.GE.la_linrx_ithresh_i )
THEN
492 IF ( params( la_linrx_ithresh_i ).LT.0.0d+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.0d+0 )
THEN
500 IF ( ignore_cwise )
THEN
501 params( la_linrx_cwise_i ) = 0.0d+0
503 params( la_linrx_cwise_i ) = 1.0d+0
506 ignore_cwise = params( la_linrx_cwise_i ) .EQ. 0.0d+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.
522 $ .NOT.lsame( uplo,
'L' ) )
THEN
524 ELSE IF( .NOT.rcequ .AND. .NOT.lsame( equed,
'N' ) )
THEN
526 ELSE IF( n.LT.0 )
THEN
528 ELSE IF( nrhs.LT.0 )
THEN
530 ELSE IF( lda.LT.max( 1, n ) )
THEN
532 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
534 ELSE IF( ldb.LT.max( 1, n ) )
THEN
536 ELSE IF( ldx.LT.max( 1, n ) )
THEN
540 CALL xerbla(
'ZSYRFSX', -info )
546 IF( n.EQ.0 .OR. nrhs.EQ.0 )
THEN
550 IF ( n_err_bnds .GE. 1 )
THEN
551 err_bnds_norm( j, la_linrx_trust_i ) = 1.0d+0
552 err_bnds_comp( j, la_linrx_trust_i ) = 1.0d+0
554 IF ( n_err_bnds .GE. 2 )
THEN
555 err_bnds_norm( j, la_linrx_err_i ) = 0.0d+0
556 err_bnds_comp( j, la_linrx_err_i ) = 0.0d+0
558 IF ( n_err_bnds .GE. 3 )
THEN
559 err_bnds_norm( j, la_linrx_rcond_i ) = 1.0d+0
560 err_bnds_comp( j, la_linrx_rcond_i ) = 1.0d+0
571 IF ( n_err_bnds .GE. 1 )
THEN
572 err_bnds_norm( j, la_linrx_trust_i ) = 1.0d+0
573 err_bnds_comp( j, la_linrx_trust_i ) = 1.0d+0
575 IF ( n_err_bnds .GE. 2 )
THEN
576 err_bnds_norm( j, la_linrx_err_i ) = 1.0d+0
577 err_bnds_comp( j, la_linrx_err_i ) = 1.0d+0
579 IF ( n_err_bnds .GE. 3 )
THEN
580 err_bnds_norm( j, la_linrx_rcond_i ) = 0.0d+0
581 err_bnds_comp( j, la_linrx_rcond_i ) = 0.0d+0
589 anorm = zlansy( norm, uplo, n, a, lda, rwork )
590 CALL zsycon( uplo, n, af, ldaf, ipiv, anorm, rcond, work,
595 IF ( ref_type .NE. 0 )
THEN
597 prec_type = ilaprec(
'E' )
600 $ nrhs, a, lda, af, ldaf, ipiv, rcequ, s, b,
601 $ ldb, x, ldx, berr, n_norms, err_bnds_norm, err_bnds_comp,
602 $ work, rwork, work(n+1),
603 $ transfer(rwork(1:2*n), (/ (zero, zero) /), n), rcond,
604 $ ithresh, rthresh, unstable_thresh, ignore_cwise,
608 err_lbnd = max( 10.0d+0,
609 $ sqrt( dble( n ) ) ) * dlamch(
'Epsilon' )
610 IF (n_err_bnds .GE. 1 .AND. n_norms .GE. 1)
THEN
615 rcond_tmp = zla_syrcond_c( uplo, n, a, lda, af, ldaf,
617 $ s, .true., info, work, rwork )
619 rcond_tmp = zla_syrcond_c( uplo, n, a, lda, af, ldaf,
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.0d+0 )
629 $ err_bnds_norm( j, la_linrx_err_i ) = 1.0d+0
633 IF ( rcond_tmp .LT. illrcond_thresh )
THEN
634 err_bnds_norm( j, la_linrx_err_i ) = 1.0d+0
635 err_bnds_norm( j, la_linrx_trust_i ) = 0.0d+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.0d+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( dlamch(
'Epsilon' ) )
663 IF ( err_bnds_comp( j, la_linrx_err_i ) .LT. cwise_wrong )
665 rcond_tmp = zla_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.0d+0 )
675 $ err_bnds_comp( j, la_linrx_err_i ) = 1.0d+0
680 IF ( rcond_tmp .LT. illrcond_thresh )
THEN
681 err_bnds_comp( j, la_linrx_err_i ) = 1.0d+0
682 err_bnds_comp( j, la_linrx_trust_i ) = 0.0d+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.0d+0
693 IF ( n_err_bnds .GE. la_linrx_rcond_i )
THEN
694 err_bnds_comp( j, la_linrx_rcond_i ) = rcond_tmp