394 $ lda, af, ldaf, ipiv, colequ, c, b,
395 $ ldb, y, ldy, berr_out, n_norms,
396 $ errs_n, errs_c, res, ayb, dy,
397 $ y_tail, rcond, ithresh, rthresh,
398 $ dz_ub, ignore_cwise, info )
406 INTEGER info, lda, ldaf, ldb, ldy, n, nrhs, prec_type,
407 $ trans_type, n_norms
408 LOGICAL colequ, ignore_cwise
414 COMPLEX a( lda, * ), af( ldaf, * ), b( ldb, * ),
415 $ y( ldy, * ), res( * ), dy( * ), y_tail( * )
416 REAL c( * ), ayb( * ), rcond, berr_out( * ),
417 $ errs_n( nrhs, * ), errs_c( nrhs, * )
424 INTEGER cnt, i, j, x_state, z_state, y_prec_state
425 REAL yk, dyk, ymin, normy, normx, normdx, dxrat,
426 $ dzrat, prevnormdx, prev_dz_z, dxratmax,
427 $ dzratmax, dx_x, dz_z, final_dx_x, final_dz_z,
428 $ eps, hugeval, incr_thresh
433 INTEGER unstable_state, working_state, conv_state,
434 $ noprog_state, base_residual, extra_residual,
436 parameter( unstable_state = 0, working_state = 1,
439 parameter( base_residual = 0, extra_residual = 1,
441 INTEGER final_nrm_err_i, final_cmp_err_i, berr_i
442 INTEGER rcond_i, nrm_rcond_i, nrm_err_i, cmp_rcond_i
443 INTEGER cmp_err_i, piv_growth_i
444 parameter( final_nrm_err_i = 1, final_cmp_err_i = 2,
446 parameter( rcond_i = 4, nrm_rcond_i = 5, nrm_err_i = 6 )
447 parameter( cmp_rcond_i = 7, cmp_err_i = 8,
449 INTEGER la_linrx_itref_i, la_linrx_ithresh_i,
451 parameter( la_linrx_itref_i = 1,
452 $ la_linrx_ithresh_i = 2 )
453 parameter( la_linrx_cwise_i = 3 )
454 INTEGER la_linrx_trust_i, la_linrx_err_i,
456 parameter( la_linrx_trust_i = 1, la_linrx_err_i = 2 )
457 parameter( la_linrx_rcond_i = 3 )
467 INTRINSIC abs, max, min
473 cabs1( zdum ) = abs(
REAL( ZDUM ) ) + abs( aimag( zdum ) )
477 IF ( info.NE.0 ) return
480 hugeval =
slamch(
'Overflow' )
482 hugeval = hugeval * hugeval
484 incr_thresh =
REAL( N ) * eps
487 y_prec_state = extra_residual
488 IF ( y_prec_state .EQ. extra_y )
THEN
505 x_state = working_state
506 z_state = unstable_state
514 CALL
ccopy( n, b( 1, j ), 1, res, 1 )
515 IF ( y_prec_state .EQ. base_residual )
THEN
516 CALL
cgemv( trans, n, n, (-1.0e+0,0.0e+0), a, lda,
517 $ y( 1, j ), 1, (1.0e+0,0.0e+0), res, 1)
518 ELSE IF (y_prec_state .EQ. extra_residual)
THEN
519 CALL blas_cgemv_x( trans_type, n, n, (-1.0e+0,0.0e+0), a,
520 $ lda, y( 1, j ), 1, (1.0e+0,0.0e+0),
521 $ res, 1, prec_type )
523 CALL blas_cgemv2_x( trans_type, n, n, (-1.0e+0,0.0e+0),
524 $ a, lda, y(1, j), y_tail, 1, (1.0e+0,0.0e+0), res, 1,
529 CALL
ccopy( n, res, 1, dy, 1 )
530 CALL
cgetrs( trans, n, 1, af, ldaf, ipiv, dy, n, info )
541 yk = cabs1( y( i, j ) )
542 dyk = cabs1( dy( i ) )
544 IF ( yk .NE. 0.0e+0 )
THEN
545 dz_z = max( dz_z, dyk / yk )
546 ELSE IF ( dyk .NE. 0.0 )
THEN
550 ymin = min( ymin, yk )
552 normy = max( normy, yk )
555 normx = max( normx, yk * c( i ) )
556 normdx = max( normdx, dyk * c( i ) )
559 normdx = max(normdx, dyk)
563 IF ( normx .NE. 0.0 )
THEN
564 dx_x = normdx / normx
565 ELSE IF ( normdx .EQ. 0.0 )
THEN
571 dxrat = normdx / prevnormdx
572 dzrat = dz_z / prev_dz_z
576 IF (.NOT.ignore_cwise
577 $ .AND. ymin*rcond .LT. incr_thresh*normy
578 $ .AND. y_prec_state .LT. extra_y )
581 IF ( x_state .EQ. noprog_state .AND. dxrat .LE. rthresh )
582 $ x_state = working_state
583 IF ( x_state .EQ. working_state )
THEN
584 IF (dx_x .LE. eps)
THEN
586 ELSE IF ( dxrat .GT. rthresh )
THEN
587 IF ( y_prec_state .NE. extra_y )
THEN
590 x_state = noprog_state
593 IF ( dxrat .GT. dxratmax ) dxratmax = dxrat
595 IF ( x_state .GT. working_state ) final_dx_x = dx_x
598 IF ( z_state .EQ. unstable_state .AND. dz_z .LE. dz_ub )
599 $ z_state = working_state
600 IF ( z_state .EQ. noprog_state .AND. dzrat .LE. rthresh )
601 $ z_state = working_state
602 IF ( z_state .EQ. working_state )
THEN
603 IF ( dz_z .LE. eps )
THEN
605 ELSE IF ( dz_z .GT. dz_ub )
THEN
606 z_state = unstable_state
609 ELSE IF ( dzrat .GT. rthresh )
THEN
610 IF ( y_prec_state .NE. extra_y )
THEN
613 z_state = noprog_state
616 IF ( dzrat .GT. dzratmax ) dzratmax = dzrat
618 IF ( z_state .GT. working_state ) final_dz_z = dz_z
625 IF ( x_state.NE.working_state )
THEN
626 IF ( ignore_cwise ) goto 666
627 IF ( z_state.EQ.noprog_state .OR. z_state.EQ.conv_state )
629 IF ( z_state.EQ.unstable_state .AND. cnt.GT.1 ) goto 666
632 IF ( incr_prec )
THEN
634 y_prec_state = y_prec_state + 1
645 IF ( y_prec_state .LT. extra_y )
THEN
646 CALL
caxpy( n, (1.0e+0,0.0e+0), dy, 1, y(1,j), 1 )
657 IF ( x_state .EQ. working_state ) final_dx_x = dx_x
658 IF ( z_state .EQ. working_state ) final_dz_z = dz_z
662 IF (n_norms .GE. 1)
THEN
663 errs_n( j, la_linrx_err_i ) = final_dx_x / (1 - dxratmax)
666 IF ( n_norms .GE. 2 )
THEN
667 errs_c( j, la_linrx_err_i ) = final_dz_z / (1 - dzratmax)
678 CALL
ccopy( n, b( 1, j ), 1, res, 1 )
679 CALL
cgemv( trans, n, n, (-1.0e+0,0.0e+0), a, lda, y(1,j), 1,
680 $ (1.0e+0,0.0e+0), res, 1 )
683 ayb( i ) = cabs1( b( i, j ) )
688 CALL
cla_geamv( trans_type, n, n, 1.0e+0,
689 $ a, lda, y(1, j), 1, 1.0e+0, ayb, 1 )