libflame revision_anchor
FLA_Tevd_eigval_v_opt_var3.c File Reference

(r)

Functions

FLA_Error FLA_Tevd_eigval_v_ops_var3 (int m_A, int m_U, int n_G, scomplex *buff_G, int rs_G, int cs_G, float *buff_d, int inc_d, float *buff_e, int inc_e, float *buff_l, int inc_l, int *buff_ls, int inc_ls, float *buff_pu, int inc_pu, int *n_iter)
 
FLA_Error FLA_Tevd_eigval_v_opd_var3 (int m_A, int m_U, int n_G, dcomplex *buff_G, int rs_G, int cs_G, double *buff_d, int inc_d, double *buff_e, int inc_e, double *buff_l, int inc_l, int *buff_ls, int inc_ls, double *buff_pu, int inc_pu, int *n_iter)
 

Function Documentation

◆ FLA_Tevd_eigval_v_opd_var3()

FLA_Error FLA_Tevd_eigval_v_opd_var3 ( int m_A,
int m_U,
int n_G,
dcomplex * buff_G,
int rs_G,
int cs_G,
double * buff_d,
int inc_d,
double * buff_e,
int inc_e,
double * buff_l,
int inc_l,
int * buff_ls,
int inc_ls,
double * buff_pu,
int inc_pu,
int * n_iter )
40{
41 FLA_Error r_val;
42 double eps;
43 double safmin;
44 double* e_last;
45 double* d_last;
46 double* d_last_m1;
47 double shift;
48 int ij_shift;
49 int k;
50 int n_iter_allowed = n_G;
51
52 // Query epsilon and safmin, which are used in the test for convergence.
53 eps = FLA_Mach_params_opd( FLA_MACH_EPS );
54 safmin = FLA_Mach_params_opd( FLA_MACH_SFMIN );
55
56 // Initialize a pointer to the last sub-diagonal element and two
57 // more to the last and second last
58 e_last = &buff_e[ (m_A-2)*inc_e ];
59 d_last_m1 = &buff_d[ (m_A-2)*inc_d ];
60 d_last = &buff_d[ (m_A-1)*inc_d ];
61
62
63 for ( k = 0; k < n_iter_allowed; ++k )
64 {
65 dcomplex* g1 = buff_G + (k )*cs_G;
66
67 /*------------------------------------------------------------*/
68
69 // If we've converged, record k and return index of eigenvalue found.
70 // The reason we check before the Francis step (rather than after)
71 // is so we correctly handle situations where the last diagonal
72 // element has already converged from previous eigenvalue searches
73 // and thus no iteration is necessary. If we checked after the
74 // Francis step, we would have unnecessarily executed an additional
75 // Francis step's worth of rotations with a sub-optimal shift (since
76 // it would be using a 2x2 that was not "centered" properly).
77 if ( MAC_Tevd_eigval_converged_opd( eps, safmin, *d_last_m1, *e_last, *d_last ) )
78 {
79 *e_last = 0.0;
80 *n_iter = k;
81 return m_A - 1;
82 }
83
85 m_U,
86 buff_d, inc_d,
87 buff_e, inc_e,
88 buff_l, inc_l,
89 buff_ls, inc_ls,
90 buff_pu, inc_pu,
91 &ij_shift );
92
93 if ( ij_shift == -1 )
94 {
95 FLA_Wilkshift_tridiag_opd( *d_last_m1,
96 *e_last,
97 *d_last,
98 &shift );
99 }
100 else
101 {
102 shift = buff_l[ ij_shift*inc_l ];
103 }
104
105 // Perform a Francis step.
106 r_val = FLA_Tevd_francis_v_opd_var1( m_A,
107 &shift,
108 g1, rs_G,
109 buff_d, inc_d,
110 buff_e, inc_e );
111
112 if ( ij_shift >= 0 &&
113 MAC_Tevd_eigval_converged_opd( eps, safmin, *d_last_m1, *e_last, *d_last ) )
114 {
115 buff_ls[ ij_shift * inc_ls ] = 1;
116 *e_last = 0.0;
117 *n_iter = k + 1;
118 return m_A - 1;
119 }
120
121 // Check for internal deflation.
122 if ( r_val != FLA_SUCCESS )
123 {
124#ifdef PRINTF
125 printf( "FLA_Tevd_eigval_v_opt_var3: Internal deflation in col %d, eig %d\n", r_val, m_A - 1 );
126 printf( "FLA_Tevd_eigval_v_opt_var3: alpha11 = %23.19e\n", buff_d[r_val*inc_d] );
127 printf( "FLA_Tevd_eigval_v_opt_var3: alpha21 alpha22 = %23.19e %23.19e\n", buff_e[r_val*inc_e], buff_d[(r_val+1)*inc_d] );
128#endif
129
130 // Set the off-diagonal element to zero.
131 buff_e[ r_val*inc_e ] = 0.0;
132
133 *n_iter = k + 1;
134 return r_val;
135 }
136
137 /*------------------------------------------------------------*/
138 }
139
140 *n_iter = n_iter_allowed;
141 return FLA_FAILURE;
142}
FLA_Error FLA_Tevd_find_perfshift_opd(int m_d, int m_l, double *buff_d, int inc_d, double *buff_e, int inc_e, double *buff_l, int inc_l, int *buff_ls, int inc_ls, double *buff_pu, int inc_pu, int *ij_shift)
Definition FLA_Tevd_find_perfshift.c:30
FLA_Error FLA_Tevd_francis_v_opd_var1(int m_A, double *buff_shift, dcomplex *buff_g, int inc_g, double *buff_d, int inc_d, double *buff_e, int inc_e)
Definition FLA_Tevd_francis_v_opt_var1.c:81
int FLA_Error
Definition FLA_type_defs.h:47
double FLA_Mach_params_opd(FLA_Machval machval)
Definition FLA_Mach_params.c:74
FLA_Error FLA_Wilkshift_tridiag_opd(double delta1, double epsilon, double delta2, double *kappa)
Definition FLA_Wilkshift_tridiag.c:155
Definition blis_type_defs.h:138

References FLA_Mach_params_opd(), FLA_Tevd_find_perfshift_opd(), FLA_Tevd_francis_v_opd_var1(), and FLA_Wilkshift_tridiag_opd().

Referenced by FLA_Tevd_iteracc_v_opd_var3().

◆ FLA_Tevd_eigval_v_ops_var3()

FLA_Error FLA_Tevd_eigval_v_ops_var3 ( int m_A,
int m_U,
int n_G,
scomplex * buff_G,
int rs_G,
int cs_G,
float * buff_d,
int inc_d,
float * buff_e,
int inc_e,
float * buff_l,
int inc_l,
int * buff_ls,
int inc_ls,
float * buff_pu,
int inc_pu,
int * n_iter )
24{
25 return FLA_SUCCESS;
26}