389 $ AF, LDAF, IPIV, COLEQU, C, B, LDB,
390 $ Y, LDY, BERR_OUT, N_NORMS,
391 $ ERR_BNDS_NORM, ERR_BNDS_COMP, RES,
392 $ AYB, DY, Y_TAIL, RCOND, ITHRESH,
393 $ RTHRESH, DZ_UB, IGNORE_CWISE,
401 INTEGER INFO, LDA, LDAF, LDB, LDY, N, NRHS, PREC_TYPE,
404 LOGICAL COLEQU, IGNORE_CWISE
405 DOUBLE PRECISION RTHRESH, DZ_UB
409 COMPLEX*16 A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
410 $ y( ldy, * ), res( * ), dy( * ), y_tail( * )
411 DOUBLE PRECISION C( * ), AYB( * ), RCOND, BERR_OUT( * ),
412 $ ERR_BNDS_NORM( NRHS, * ),
413 $ ERR_BNDS_COMP( NRHS, * )
419 INTEGER UPLO2, CNT, I, J, X_STATE, Z_STATE,
421 DOUBLE PRECISION YK, DYK, YMIN, NORMY, NORMX, NORMDX, DXRAT,
422 $ DZRAT, PREVNORMDX, PREV_DZ_Z, DXRATMAX,
423 $ DZRATMAX, DX_X, DZ_Z, FINAL_DX_X, FINAL_DZ_Z,
424 $ EPS, HUGEVAL, INCR_THRESH
425 LOGICAL INCR_PREC, UPPER
429 INTEGER UNSTABLE_STATE, WORKING_STATE, CONV_STATE,
430 $ NOPROG_STATE, BASE_RESIDUAL, EXTRA_RESIDUAL,
432 parameter( unstable_state = 0, working_state = 1,
433 $ conv_state = 2, noprog_state = 3 )
434 parameter( base_residual = 0, extra_residual = 1,
436 INTEGER FINAL_NRM_ERR_I, FINAL_CMP_ERR_I, BERR_I
437 INTEGER RCOND_I, NRM_RCOND_I, NRM_ERR_I, CMP_RCOND_I
438 INTEGER CMP_ERR_I, PIV_GROWTH_I
439 PARAMETER ( FINAL_NRM_ERR_I = 1, final_cmp_err_i = 2,
441 parameter( rcond_i = 4, nrm_rcond_i = 5, nrm_err_i = 6 )
442 parameter( cmp_rcond_i = 7, cmp_err_i = 8,
444 INTEGER LA_LINRX_ITREF_I, LA_LINRX_ITHRESH_I,
446 parameter( la_linrx_itref_i = 1,
447 $ la_linrx_ithresh_i = 2 )
448 parameter( la_linrx_cwise_i = 3 )
449 INTEGER LA_LINRX_TRUST_I, LA_LINRX_ERR_I,
451 parameter( la_linrx_trust_i = 1, la_linrx_err_i = 2 )
452 parameter( la_linrx_rcond_i = 3 )
463 DOUBLE PRECISION DLAMCH
466 INTRINSIC abs, real, dimag, max, min
469 DOUBLE PRECISION CABS1
472 cabs1( zdum ) = abs( dble( zdum ) ) + abs( dimag( zdum ) )
477 upper = lsame( uplo,
'U' )
478 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
480 ELSE IF( n.LT.0 )
THEN
482 ELSE IF( nrhs.LT.0 )
THEN
484 ELSE IF( lda.LT.max( 1, n ) )
THEN
486 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
488 ELSE IF( ldb.LT.max( 1, n ) )
THEN
490 ELSE IF( ldy.LT.max( 1, n ) )
THEN
494 CALL xerbla(
'ZLA_HERFSX_EXTENDED', -info )
497 eps = dlamch(
'Epsilon' )
498 hugeval = dlamch(
'Overflow' )
500 hugeval = hugeval * hugeval
502 incr_thresh = dble( n ) * eps
504 IF ( lsame( uplo,
'L' ) )
THEN
505 uplo2 = ilauplo(
'L' )
507 uplo2 = ilauplo(
'U' )
511 y_prec_state = extra_residual
512 IF ( y_prec_state .EQ. extra_y )
THEN
529 x_state = working_state
530 z_state = unstable_state
538 CALL zcopy( n, b( 1, j ), 1, res, 1 )
539 IF ( y_prec_state .EQ. base_residual )
THEN
540 CALL zsymv( uplo, n, dcmplx(-1.0d+0), a, lda, y(1,j), 1,
541 $ dcmplx(1.0d+0), res, 1 )
542 ELSE IF ( y_prec_state .EQ. extra_residual )
THEN
543 CALL blas_zsymv_x( uplo2, n, dcmplx(-1.0d+0), a, lda,
544 $ y( 1, j ), 1, dcmplx(1.0d+0), res, 1, prec_type )
546 CALL blas_zsymv2_x(uplo2, n, dcmplx(-1.0d+0), a, lda,
547 $ y(1, j), y_tail, 1, dcmplx(1.0d+0), res, 1,
552 CALL zcopy( n, res, 1, dy, 1 )
553 CALL zsytrs( uplo, n, 1, af, ldaf, ipiv, dy, n, info )
564 yk = cabs1( y( i, j ) )
565 dyk = cabs1( dy( i ) )
567 IF ( yk .NE. 0.0d+0 )
THEN
568 dz_z = max( dz_z, dyk / yk )
569 ELSE IF ( dyk .NE. 0.0d+0 )
THEN
573 ymin = min( ymin, yk )
575 normy = max( normy, yk )
578 normx = max( normx, yk * c( i ) )
579 normdx = max( normdx, dyk * c( i ) )
582 normdx = max( normdx, dyk )
586 IF ( normx .NE. 0.0d+0 )
THEN
587 dx_x = normdx / normx
588 ELSE IF ( normdx .EQ. 0.0d+0 )
THEN
594 dxrat = normdx / prevnormdx
595 dzrat = dz_z / prev_dz_z
599 IF ( ymin*rcond .LT. incr_thresh*normy
600 $ .AND. y_prec_state .LT. extra_y )
603 IF ( x_state .EQ. noprog_state .AND. dxrat .LE. rthresh )
604 $ x_state = working_state
605 IF ( x_state .EQ. working_state )
THEN
606 IF ( dx_x .LE. eps )
THEN
608 ELSE IF ( dxrat .GT. rthresh )
THEN
609 IF ( y_prec_state .NE. extra_y )
THEN
612 x_state = noprog_state
615 IF (dxrat .GT. dxratmax) dxratmax = dxrat
617 IF ( x_state .GT. working_state ) final_dx_x = dx_x
620 IF ( z_state .EQ. unstable_state .AND. dz_z .LE. dz_ub )
621 $ z_state = working_state
622 IF ( z_state .EQ. noprog_state .AND. dzrat .LE. rthresh )
623 $ z_state = working_state
624 IF ( z_state .EQ. working_state )
THEN
625 IF ( dz_z .LE. eps )
THEN
627 ELSE IF ( dz_z .GT. dz_ub )
THEN
628 z_state = unstable_state
631 ELSE IF ( dzrat .GT. rthresh )
THEN
632 IF ( y_prec_state .NE. extra_y )
THEN
635 z_state = noprog_state
638 IF ( dzrat .GT. dzratmax ) dzratmax = dzrat
640 IF ( z_state .GT. working_state ) final_dz_z = dz_z
643 IF ( x_state.NE.working_state.AND.
644 $ ( ignore_cwise.OR.z_state.NE.working_state ) )
647 IF ( incr_prec )
THEN
649 y_prec_state = y_prec_state + 1
660 IF ( y_prec_state .LT. extra_y )
THEN
661 CALL zaxpy( n, dcmplx(1.0d+0), dy, 1, y(1,j), 1 )
672 IF ( x_state .EQ. working_state ) final_dx_x = dx_x
673 IF ( z_state .EQ. working_state ) final_dz_z = dz_z
677 IF ( n_norms .GE. 1 )
THEN
678 err_bnds_norm( j, la_linrx_err_i ) =
679 $ final_dx_x / (1 - dxratmax)
681 IF ( n_norms .GE. 2 )
THEN
682 err_bnds_comp( j, la_linrx_err_i ) =
683 $ final_dz_z / (1 - dzratmax)
694 CALL zcopy( n, b( 1, j ), 1, res, 1 )
695 CALL zsymv( uplo, n, dcmplx(-1.0d+0), a, lda, y(1,j), 1,
696 $ dcmplx(1.0d+0), res, 1 )
699 ayb( i ) = cabs1( b( i, j ) )
705 $ a, lda, y(1, j), 1, 1.0d+0, ayb, 1 )
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zaxpy(N, ZA, ZX, INCX, ZY, INCY)
ZAXPY
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zla_wwaddw(N, X, Y, W)
ZLA_WWADDW adds a vector into a doubled-single vector.
subroutine zla_lin_berr(N, NZ, NRHS, RES, AYB, BERR)
ZLA_LIN_BERR computes a component-wise relative backward error.
subroutine zsymv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZSYMV computes a matrix-vector product for a complex symmetric matrix.
subroutine zla_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)
ZLA_SYRFSX_EXTENDED improves the computed solution to a system of linear equations for symmetric inde...
subroutine zsytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZSYTRS
subroutine zla_syamv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZLA_SYAMV computes a matrix-vector product using a symmetric indefinite matrix to calculate error bou...