412 SUBROUTINE cgerfsx( TRANS, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV,
413 $ r, c, b, ldb, x, ldx, rcond, berr, n_err_bnds,
414 $ err_bnds_norm, err_bnds_comp, nparams, params,
415 $ work, rwork, info )
423 CHARACTER trans, equed
424 INTEGER info, lda, ldaf, ldb, ldx, n, nrhs, nparams,
430 COMPLEX a( lda, * ), af( ldaf, * ), b( ldb, * ),
431 $ x( ldx , * ), work( * )
432 REAL r( * ), c( * ), params( * ), berr( * ),
433 $ err_bnds_norm( nrhs, * ),
434 $ err_bnds_comp( nrhs, * ), rwork( * )
441 parameter( zero = 0.0e+0, one = 1.0e+0 )
442 REAL itref_default, ithresh_default,
443 $ componentwise_default
444 REAL rthresh_default, dzthresh_default
445 parameter( itref_default = 1.0 )
446 parameter( ithresh_default = 10.0 )
447 parameter( componentwise_default = 1.0 )
448 parameter( rthresh_default = 0.5 )
449 parameter( dzthresh_default = 0.25 )
450 INTEGER la_linrx_itref_i, la_linrx_ithresh_i,
452 parameter( la_linrx_itref_i = 1,
453 $ la_linrx_ithresh_i = 2 )
454 parameter( la_linrx_cwise_i = 3 )
455 INTEGER la_linrx_trust_i, la_linrx_err_i,
457 parameter( la_linrx_trust_i = 1, la_linrx_err_i = 2 )
458 parameter( la_linrx_rcond_i = 3 )
462 LOGICAL rowequ, colequ, notran
463 INTEGER j, trans_type, prec_type, ref_type
465 REAL anorm, rcond_tmp
466 REAL illrcond_thresh, err_lbnd, cwise_wrong
469 REAL rthresh, unstable_thresh
475 INTRINSIC max, sqrt, transfer
482 INTEGER blas_fpinfo_x
491 ref_type = int( itref_default )
492 IF ( nparams .GE. la_linrx_itref_i )
THEN
493 IF ( params( la_linrx_itref_i ) .LT. 0.0 )
THEN
494 params( la_linrx_itref_i ) = itref_default
496 ref_type = params( la_linrx_itref_i )
502 illrcond_thresh =
REAL( N ) *
slamch(
'Epsilon' )
503 ithresh = int( ithresh_default )
504 rthresh = rthresh_default
505 unstable_thresh = dzthresh_default
506 ignore_cwise = componentwise_default .EQ. 0.0
508 IF ( nparams.GE.la_linrx_ithresh_i )
THEN
509 IF ( params( la_linrx_ithresh_i ).LT.0.0 )
THEN
510 params(la_linrx_ithresh_i) = ithresh
512 ithresh = int( params( la_linrx_ithresh_i ) )
515 IF ( nparams.GE.la_linrx_cwise_i )
THEN
516 IF ( params( la_linrx_cwise_i ).LT.0.0 )
THEN
517 IF ( ignore_cwise )
THEN
518 params( la_linrx_cwise_i ) = 0.0
520 params( la_linrx_cwise_i ) = 1.0
523 ignore_cwise = params( la_linrx_cwise_i ) .EQ. 0.0
526 IF ( ref_type .EQ. 0 .OR. n_err_bnds .EQ. 0 )
THEN
528 ELSE IF ( ignore_cwise )
THEN
534 notran =
lsame( trans,
'N' )
535 rowequ =
lsame( equed,
'R' ) .OR.
lsame( equed,
'B' )
536 colequ =
lsame( equed,
'C' ) .OR.
lsame( equed,
'B' )
540 IF( trans_type.EQ.-1 )
THEN
542 ELSE IF( .NOT.rowequ .AND. .NOT.colequ .AND.
543 $ .NOT.
lsame( equed,
'N' ) )
THEN
545 ELSE IF( n.LT.0 )
THEN
547 ELSE IF( nrhs.LT.0 )
THEN
549 ELSE IF( lda.LT.max( 1, n ) )
THEN
551 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
553 ELSE IF( ldb.LT.max( 1, n ) )
THEN
555 ELSE IF( ldx.LT.max( 1, n ) )
THEN
559 CALL
xerbla(
'CGERFSX', -info )
565 IF( n.EQ.0 .OR. nrhs.EQ.0 )
THEN
569 IF ( n_err_bnds .GE. 1 )
THEN
570 err_bnds_norm( j, la_linrx_trust_i ) = 1.0
571 err_bnds_comp( j, la_linrx_trust_i ) = 1.0
573 IF ( n_err_bnds .GE. 2 )
THEN
574 err_bnds_norm( j, la_linrx_err_i ) = 0.0
575 err_bnds_comp( j, la_linrx_err_i ) = 0.0
577 IF ( n_err_bnds .GE. 3 )
THEN
578 err_bnds_norm( j, la_linrx_rcond_i ) = 1.0
579 err_bnds_comp( j, la_linrx_rcond_i ) = 1.0
590 IF ( n_err_bnds .GE. 1 )
THEN
591 err_bnds_norm( j, la_linrx_trust_i ) = 1.0
592 err_bnds_comp( j, la_linrx_trust_i ) = 1.0
594 IF ( n_err_bnds .GE. 2 )
THEN
595 err_bnds_norm( j, la_linrx_err_i ) = 1.0
596 err_bnds_comp( j, la_linrx_err_i ) = 1.0
598 IF ( n_err_bnds .GE. 3 )
THEN
599 err_bnds_norm( j, la_linrx_rcond_i ) = 0.0
600 err_bnds_comp( j, la_linrx_rcond_i ) = 0.0
612 anorm =
clange( norm, n, n, a, lda, rwork )
613 CALL
cgecon( norm, n, af, ldaf, anorm, rcond, work, rwork, info )
617 IF ( ref_type .NE. 0 )
THEN
623 $ nrhs, a, lda, af, ldaf, ipiv, colequ, c, b,
624 $ ldb, x, ldx, berr, n_norms, err_bnds_norm,
625 $ err_bnds_comp, work, rwork, work(n+1),
626 $ transfer(rwork(1:2*n), (/ (zero, zero) /), n),
627 $ rcond, ithresh, rthresh, unstable_thresh, ignore_cwise,
631 $ nrhs, a, lda, af, ldaf, ipiv, rowequ, r, b,
632 $ ldb, x, ldx, berr, n_norms, err_bnds_norm,
633 $ err_bnds_comp, work, rwork, work(n+1),
634 $ transfer(rwork(1:2*n), (/ (zero, zero) /), n),
635 $ rcond, ithresh, rthresh, unstable_thresh, ignore_cwise,
640 err_lbnd = max( 10.0, sqrt(
REAL( N ) ) ) *
slamch(
'Epsilon' )
641 IF ( n_err_bnds .GE. 1 .AND. n_norms .GE. 1 )
THEN
645 IF ( colequ .AND. notran )
THEN
647 $ c, .true., info, work, rwork )
648 ELSE IF ( rowequ .AND. .NOT. notran )
THEN
650 $ r, .true., info, work, rwork )
653 $ c, .false., info, work, rwork )
659 IF ( n_err_bnds .GE. la_linrx_err_i
660 $ .AND. err_bnds_norm( j, la_linrx_err_i ) .GT. 1.0 )
661 $ err_bnds_norm( j, la_linrx_err_i ) = 1.0
665 IF ( rcond_tmp .LT. illrcond_thresh )
THEN
666 err_bnds_norm( j, la_linrx_err_i ) = 1.0
667 err_bnds_norm( j, la_linrx_trust_i ) = 0.0
668 IF ( info .LE. n ) info = n + j
669 ELSE IF (err_bnds_norm( j, la_linrx_err_i ) .LT. err_lbnd)
671 err_bnds_norm( j, la_linrx_err_i ) = err_lbnd
672 err_bnds_norm( j, la_linrx_trust_i ) = 1.0
677 IF ( n_err_bnds .GE. la_linrx_rcond_i )
THEN
678 err_bnds_norm( j, la_linrx_rcond_i ) = rcond_tmp
683 IF ( n_err_bnds .GE. 1 .AND. n_norms .GE. 2 )
THEN
693 cwise_wrong = sqrt(
slamch(
'Epsilon' ) )
695 IF ( err_bnds_comp( j, la_linrx_err_i ) .LT. cwise_wrong )
698 $ ipiv, x(1,j), info, work, rwork )
705 IF ( n_err_bnds .GE. la_linrx_err_i
706 $ .AND. err_bnds_comp( j, la_linrx_err_i ) .GT. 1.0 )
707 $ err_bnds_comp( j, la_linrx_err_i ) = 1.0
711 IF ( rcond_tmp .LT. illrcond_thresh )
THEN
712 err_bnds_comp( j, la_linrx_err_i ) = 1.0
713 err_bnds_comp( j, la_linrx_trust_i ) = 0.0
714 IF ( params( la_linrx_cwise_i ) .EQ. 1.0
715 $ .AND. info.LT.n + j ) info = n + j
716 ELSE IF ( err_bnds_comp( j, la_linrx_err_i )
717 $ .LT. err_lbnd )
THEN
718 err_bnds_comp( j, la_linrx_err_i ) = err_lbnd
719 err_bnds_comp( j, la_linrx_trust_i ) = 1.0
724 IF ( n_err_bnds .GE. la_linrx_rcond_i )
THEN
725 err_bnds_comp( j, la_linrx_rcond_i ) = rcond_tmp