libflame  revision_anchor
Functions
FLA_Tevd_eigval_n_opt_var1.c File Reference

(r)

Functions

FLA_Error FLA_Tevd_eigval_n_opt_var1 (FLA_Obj G, FLA_Obj d, FLA_Obj e, FLA_Obj k)
 
FLA_Error FLA_Tevd_eigval_n_ops_var1 (int m_A, int n_G, float *buff_d, int inc_d, float *buff_e, int inc_e, int *n_iter)
 
FLA_Error FLA_Tevd_eigval_n_opd_var1 (int m_A, int n_G, double *buff_d, int inc_d, double *buff_e, int inc_e, int *n_iter)
 

Function Documentation

◆ FLA_Tevd_eigval_n_opd_var1()

FLA_Error FLA_Tevd_eigval_n_opd_var1 ( int  m_A,
int  n_G,
double *  buff_d,
int  inc_d,
double *  buff_e,
int  inc_e,
int *  n_iter 
)
83 {
84  FLA_Error r_val;
85  double eps2;
86  double safmin;
87  double* e_last;
88  double* d_last;
89  double* d_last_m1;
90  double shift;
91  int k;
92  int n_iter_allowed = n_G;
93 
94  // Query epsilon and safmin, which are used in the test for convergence.
95  eps2 = FLA_Mach_params_opd( FLA_MACH_EPS2 );
96  safmin = FLA_Mach_params_opd( FLA_MACH_SFMIN );
97 
98  // Initialize a pointer to the last sub-diagonal element and two
99  // more to the last and second last
100  e_last = &buff_e[ (m_A-2)*inc_e ];
101  d_last_m1 = &buff_d[ (m_A-2)*inc_d ];
102  d_last = &buff_d[ (m_A-1)*inc_d ];
103 
104  for ( k = 0; k < n_iter_allowed; ++k )
105  {
106 
107  /*------------------------------------------------------------*/
108 
109  // If we've converged, record k and return index of eigenvalue found.
110  // The reason we check before the Francis step (rather than after)
111  // is so we correctly handle situations where the last diagonal
112  // element has already converged from previous eigenvalue searches
113  // and thus no iteration is necessary. If we checked after the
114  // Francis step, we would have unnecessarily executed an additional
115  // Francis step's worth of rotations with a sub-optimal shift (since
116  // it would be using a 2x2 that was not "centered" properly).
117  if ( MAC_Tevd_eigval_converged2_opd( eps2, safmin, *d_last_m1, *e_last, *d_last ) )
118  {
119  *e_last = 0.0;
120  *n_iter = k;
121  return m_A - 1;
122  }
123 
124 //if ( (n_iter_allowed - k) % 2 == 0 )
125  // Compute a Wilkinson shift with the last 2x2 matrix.
126  FLA_Wilkshift_tridiag_opd( *d_last_m1,
127  *e_last,
128  *d_last,
129  &shift );
130 //else
131 // shift = *d_last;
132 
133  // Perform a Francis step.
134  r_val = FLA_Tevd_francis_n_opd_var1( m_A,
135  &shift,
136  buff_d, inc_d,
137  buff_e, inc_e );
138 
139  // Check for internal deflation.
140  if ( r_val != FLA_SUCCESS )
141  {
142 #ifdef PRINTF
143  printf( "FLA_Tevd_eigval_n_opt_var1: Internal deflation in col %d, eig %d\n", r_val, m_A - 1 );
144  printf( "FLA_Tevd_eigval_n_opt_var1: alpha11 = %23.19e\n", buff_d[r_val*inc_d] );
145  printf( "FLA_Tevd_eigval_n_opt_var1: alpha21 alpha22 = %23.19e %23.19e\n", buff_e[r_val*inc_e], buff_d[(r_val+1)*inc_d] );
146 #endif
147 
148  // Set the off-diagonal element to zero.
149  buff_e[ r_val*inc_e ] = 0.0;
150 
151  *n_iter = k + 1;
152  return r_val;
153  }
154 
155  /*------------------------------------------------------------*/
156  }
157 
158  *n_iter = n_iter_allowed;
159  return FLA_FAILURE;
160 }
FLA_Error FLA_Tevd_francis_n_opd_var1(int m_A, double *buff_shift, double *buff_d, int inc_d, double *buff_e, int inc_e)
Definition: FLA_Tevd_francis_n_opt_var1.c:74
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

References FLA_Mach_params_opd(), FLA_Tevd_francis_n_opd_var1(), and FLA_Wilkshift_tridiag_opd().

Referenced by FLA_Tevd_eigval_n_opt_var1(), and FLA_Tevd_iteracc_n_opd_var1().

◆ FLA_Tevd_eigval_n_ops_var1()

FLA_Error FLA_Tevd_eigval_n_ops_var1 ( int  m_A,
int  n_G,
float *  buff_d,
int  inc_d,
float *  buff_e,
int  inc_e,
int *  n_iter 
)
72 {
73  return FLA_SUCCESS;
74 }

Referenced by FLA_Tevd_eigval_n_opt_var1().

◆ FLA_Tevd_eigval_n_opt_var1()

FLA_Error FLA_Tevd_eigval_n_opt_var1 ( FLA_Obj  G,
FLA_Obj  d,
FLA_Obj  e,
FLA_Obj  k 
)
14 {
15  FLA_Datatype datatype;
16  int m_A, n_G;
17  int inc_d;
18  int inc_e;
19 
20  datatype = FLA_Obj_datatype( d );
21 
22  m_A = FLA_Obj_vector_dim( d );
23  n_G = FLA_Obj_width( G );
24 
25  inc_d = FLA_Obj_vector_inc( d );
26  inc_e = FLA_Obj_vector_inc( e );
27 
28 
29  switch ( datatype )
30  {
31  case FLA_FLOAT:
32  {
33  float* buff_d = FLA_FLOAT_PTR( d );
34  float* buff_e = FLA_FLOAT_PTR( e );
35  int* buff_k = FLA_INT_PTR( k );
36 
38  n_G,
39  buff_d, inc_d,
40  buff_e, inc_e,
41  buff_k );
42 
43  break;
44  }
45 
46  case FLA_DOUBLE:
47  {
48  double* buff_d = FLA_DOUBLE_PTR( d );
49  double* buff_e = FLA_DOUBLE_PTR( e );
50  int* buff_k = FLA_INT_PTR( k );
51 
53  n_G,
54  buff_d, inc_d,
55  buff_e, inc_e,
56  buff_k );
57 
58  break;
59  }
60  }
61 
62  return FLA_SUCCESS;
63 }
FLA_Error FLA_Tevd_eigval_n_opd_var1(int m_A, int n_G, double *buff_d, int inc_d, double *buff_e, int inc_e, int *n_iter)
Definition: FLA_Tevd_eigval_n_opt_var1.c:78
FLA_Error FLA_Tevd_eigval_n_ops_var1(int m_A, int n_G, float *buff_d, int inc_d, float *buff_e, int inc_e, int *n_iter)
Definition: FLA_Tevd_eigval_n_opt_var1.c:67
dim_t FLA_Obj_width(FLA_Obj obj)
Definition: FLA_Query.c:123
dim_t FLA_Obj_vector_inc(FLA_Obj obj)
Definition: FLA_Query.c:145
dim_t FLA_Obj_vector_dim(FLA_Obj obj)
Definition: FLA_Query.c:137
FLA_Datatype FLA_Obj_datatype(FLA_Obj obj)
Definition: FLA_Query.c:13
int FLA_Datatype
Definition: FLA_type_defs.h:49

References FLA_Obj_datatype(), FLA_Obj_vector_dim(), FLA_Obj_vector_inc(), FLA_Obj_width(), FLA_Tevd_eigval_n_opd_var1(), and FLA_Tevd_eigval_n_ops_var1().