412 SUBROUTINE dgerfsx( 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, iwork, info )
423 CHARACTER trans, equed
424 INTEGER info, lda, ldaf, ldb, ldx, n, nrhs, nparams,
426 DOUBLE PRECISION rcond
429 INTEGER ipiv( * ), iwork( * )
430 DOUBLE PRECISION a( lda, * ), af( ldaf, * ), b( ldb, * ),
431 $ x( ldx , * ), work( * )
432 DOUBLE PRECISION r( * ), c( * ), params( * ), berr( * ),
433 $ err_bnds_norm( nrhs, * ),
434 $ err_bnds_comp( nrhs, * )
440 DOUBLE PRECISION zero, one
441 parameter( zero = 0.0d+0, one = 1.0d+0 )
442 DOUBLE PRECISION itref_default, ithresh_default
443 DOUBLE PRECISION componentwise_default, rthresh_default
444 DOUBLE PRECISION dzthresh_default
445 parameter( itref_default = 1.0d+0 )
446 parameter( ithresh_default = 10.0d+0 )
447 parameter( componentwise_default = 1.0d+0 )
448 parameter( rthresh_default = 0.5d+0 )
449 parameter( dzthresh_default = 0.25d+0 )
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 DOUBLE PRECISION anorm, rcond_tmp
466 DOUBLE PRECISION illrcond_thresh, err_lbnd, cwise_wrong
469 DOUBLE PRECISION rthresh, unstable_thresh
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.0d+0 )
THEN
494 params( la_linrx_itref_i ) = itref_default
496 ref_type = params( la_linrx_itref_i )
502 illrcond_thresh = dble( n ) *
dlamch(
'Epsilon' )
503 ithresh = int( ithresh_default )
504 rthresh = rthresh_default
505 unstable_thresh = dzthresh_default
506 ignore_cwise = componentwise_default .EQ. 0.0d+0
508 IF ( nparams.GE.la_linrx_ithresh_i )
THEN
509 IF ( params( la_linrx_ithresh_i ).LT.0.0d+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.0d+0 )
THEN
517 IF ( ignore_cwise )
THEN
518 params( la_linrx_cwise_i ) = 0.0d+0
520 params( la_linrx_cwise_i ) = 1.0d+0
523 ignore_cwise = params( la_linrx_cwise_i ) .EQ. 0.0d+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(
'DGERFSX', -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.0d+0
571 err_bnds_comp( j, la_linrx_trust_i ) = 1.0d+0
573 IF ( n_err_bnds .GE. 2 )
THEN
574 err_bnds_norm( j, la_linrx_err_i) = 0.0d+0
575 err_bnds_comp( j, la_linrx_err_i ) = 0.0d+0
577 IF ( n_err_bnds .GE. 3 )
THEN
578 err_bnds_norm( j, la_linrx_rcond_i) = 1.0d+0
579 err_bnds_comp( j, la_linrx_rcond_i ) = 1.0d+0
590 IF ( n_err_bnds .GE. 1 )
THEN
591 err_bnds_norm( j, la_linrx_trust_i ) = 1.0d+0
592 err_bnds_comp( j, la_linrx_trust_i ) = 1.0d+0
594 IF ( n_err_bnds .GE. 2 )
THEN
595 err_bnds_norm( j, la_linrx_err_i ) = 1.0d+0
596 err_bnds_comp( j, la_linrx_err_i ) = 1.0d+0
598 IF ( n_err_bnds .GE. 3 )
THEN
599 err_bnds_norm( j, la_linrx_rcond_i ) = 0.0d+0
600 err_bnds_comp( j, la_linrx_rcond_i ) = 0.0d+0
612 anorm =
dlange( norm, n, n, a, lda, work )
613 CALL
dgecon( norm, n, af, ldaf, anorm, rcond, work, iwork, 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(n+1), work(1), work(2*n+1),
626 $ work(1), rcond, ithresh, rthresh, unstable_thresh,
627 $ ignore_cwise, info )
630 $ nrhs, a, lda, af, ldaf, ipiv, rowequ, r, b,
631 $ ldb, x, ldx, berr, n_norms, err_bnds_norm,
632 $ err_bnds_comp, work(n+1), work(1), work(2*n+1),
633 $ work(1), rcond, ithresh, rthresh, unstable_thresh,
634 $ ignore_cwise, info )
638 err_lbnd = max( 10.0d+0, sqrt( dble( n ) ) ) *
dlamch(
'Epsilon' )
639 IF ( n_err_bnds .GE. 1 .AND. n_norms .GE. 1 )
THEN
643 IF ( colequ .AND. notran )
THEN
644 rcond_tmp =
dla_gercond( trans, n, a, lda, af, ldaf, ipiv,
645 $ -1, c, info, work, iwork )
646 ELSE IF ( rowequ .AND. .NOT. notran )
THEN
647 rcond_tmp =
dla_gercond( trans, n, a, lda, af, ldaf, ipiv,
648 $ -1, r, info, work, iwork )
650 rcond_tmp =
dla_gercond( trans, n, a, lda, af, ldaf, ipiv,
651 $ 0, r, info, work, iwork )
657 IF ( n_err_bnds .GE. la_linrx_err_i
658 $ .AND. err_bnds_norm( j, la_linrx_err_i ) .GT. 1.0d+0 )
659 $ err_bnds_norm( j, la_linrx_err_i ) = 1.0d+0
663 IF ( rcond_tmp .LT. illrcond_thresh )
THEN
664 err_bnds_norm( j, la_linrx_err_i ) = 1.0d+0
665 err_bnds_norm( j, la_linrx_trust_i ) = 0.0d+0
666 IF ( info .LE. n ) info = n + j
667 ELSE IF ( err_bnds_norm( j, la_linrx_err_i ) .LT. err_lbnd )
669 err_bnds_norm( j, la_linrx_err_i ) = err_lbnd
670 err_bnds_norm( j, la_linrx_trust_i ) = 1.0d+0
675 IF ( n_err_bnds .GE. la_linrx_rcond_i )
THEN
676 err_bnds_norm( j, la_linrx_rcond_i ) = rcond_tmp
681 IF ( n_err_bnds .GE. 1 .AND. n_norms .GE. 2 )
THEN
691 cwise_wrong = sqrt(
dlamch(
'Epsilon' ) )
693 IF ( err_bnds_comp( j, la_linrx_err_i ) .LT. cwise_wrong )
695 rcond_tmp =
dla_gercond( trans, n, a, lda, af, ldaf,
696 $ ipiv, 1, x(1,j), info, work, iwork )
703 IF ( n_err_bnds .GE. la_linrx_err_i
704 $ .AND. err_bnds_comp( j, la_linrx_err_i ) .GT. 1.0d+0 )
705 $ err_bnds_comp( j, la_linrx_err_i ) = 1.0d+0
709 IF ( rcond_tmp .LT. illrcond_thresh )
THEN
710 err_bnds_comp( j, la_linrx_err_i ) = 1.0d+0
711 err_bnds_comp( j, la_linrx_trust_i ) = 0.0d+0
712 IF ( params( la_linrx_cwise_i ) .EQ. 1.0d+0
713 $ .AND. info.LT.n + j ) info = n + j
714 ELSE IF ( err_bnds_comp( j, la_linrx_err_i )
715 $ .LT. err_lbnd )
THEN
716 err_bnds_comp( j, la_linrx_err_i ) = err_lbnd
717 err_bnds_comp( j, la_linrx_trust_i ) = 1.0d+0
722 IF ( n_err_bnds .GE. la_linrx_rcond_i )
THEN
723 err_bnds_comp( j, la_linrx_rcond_i ) = rcond_tmp