libflame  revision_anchor
Functions
FLA_Tevd_francis_n.h File Reference

(r)

Go to the source code of this file.

Functions

FLA_Error FLA_Tevd_francis_n_opt_var1 (FLA_Obj shift, FLA_Obj d, FLA_Obj e)
 
FLA_Error FLA_Tevd_francis_n_ops_var1 (int m_A, float *buff_shift, float *buff_d, int inc_d, float *buff_e, int inc_e)
 
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)
 

Function Documentation

◆ FLA_Tevd_francis_n_opd_var1()

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 
)
78 {
79  double eps2, safmin;
80  double temp0, temp1;
81  double bulge;
82  double gamma, sigma;
83  int ij_deflated;
84  int i;
85 
86  // Initialize the deflation index.
87  ij_deflated = FLA_SUCCESS;
88 
89  // Initialize the bulge variable to zero.
90  bulge = 0.0;
91 
92  // Query epsilon and safmin.
93  eps2 = FLA_Mach_params_opd( FLA_MACH_EPS2 );
94  safmin = FLA_Mach_params_opd( FLA_MACH_SFMIN );
95 
96  // Apply the rotations in forward order.
97  for ( i = 0; i < m_A - 1; ++i )
98  {
99  double* alpha00 = buff_d + (i-1)*inc_d;
100  double* alpha10 = buff_e + (i-1)*inc_e;
101  double* alpha20 = &bulge;
102 
103  double* alpha11 = buff_d + (i )*inc_d;
104  double* alpha21 = buff_e + (i )*inc_e;
105  double* alpha22 = buff_d + (i+1)*inc_d;
106 
107  double* alpha31 = &bulge;
108  double* alpha32 = buff_e + (i+1)*inc_e;
109 
110  double* gamma1 = &gamma;
111  double* sigma1 = &sigma;
112 
113  double alpha10_new;
114 
115  int m_behind = i;
116  int m_ahead = m_A - i - 2;
117 
118  /*------------------------------------------------------------*/
119 
120  if ( i == 0 )
121  {
122  // Induce an iteration that introduces the bulge by
123  // changing the addresses of alpha10 and alpha20.
124  temp0 = *buff_d - *buff_shift;
125  temp1 = *buff_e;
126  alpha10 = &temp0;
127  alpha20 = &temp1;
128 
129  // Compute a new Givens rotation that introduces the bulge.
130  MAC_Givens2_opd( alpha10,
131  alpha20,
132  gamma1,
133  sigma1,
134  &alpha10_new );
135 
136  // We don't apply the Givens rotation to the 2x1 vector at
137  // alpha10 when introducing the bulge.
138  }
139  else
140  {
141  // Compute a new Givens rotation to push the bulge.
142  MAC_Givens2_opd( alpha10,
143  alpha20,
144  gamma1,
145  sigma1,
146  &alpha10_new );
147 
148  // Apply the Givens rotation to the 2x1 vector from which it
149  // was computed, which annihilates alpha20.
150  *alpha10 = alpha10_new;
151  *alpha20 = 0.0;
152  }
153 
154  // Apply the Givens rotation to the 2x2 submatrix at alpha11.
155  MAC_Apply_GTG_opd( gamma1,
156  sigma1,
157  alpha11,
158  alpha21,
159  alpha22 );
160 
161  if ( m_ahead > 0 )
162  {
163  // Apply the Givens rotation to the 1x2 vector below the 2x2
164  // submatrix. This should move the bulge to alpha31.
165  MAC_Apply_G_1x2_opd( gamma1,
166  sigma1,
167  alpha31,
168  alpha32 );
169 
170  // Check for deflation after applying the rotations, except after
171  // applying the initial bulge-introducing rotations.
172  if ( m_behind > 0 )
173  {
174  // We check for deflation in the previous column now that we
175  // are done modifying it. If deflation occurred, record the
176  // index.
177  if ( MAC_Tevd_eigval_converged2_opd( eps2, safmin, *alpha00, *alpha10, *alpha11 ) )
178  {
179  ij_deflated = i - 1;
180  }
181  }
182 
183  // Sanity check. If the bulge ever disappears, something is wrong.
184  if ( *alpha31 == 0.0 )
185  {
186  printf( "FLA_Tevd_francis_n_opt_var1: bulge disappeared!\n" );
187  if ( MAC_Tevd_eigval_converged2_opd( eps2, safmin, *alpha11, *alpha21, *alpha22 ) )
188  {
189  printf( "FLA_Tevd_francis_n_opt_var1: deflation detected (col %d)\n", i );
190  printf( "FLA_Tevd_francis_n_opt_var1: alpha11 = %23.19e\n", *alpha11 );
191  printf( "FLA_Tevd_francis_n_opt_var1: alpha21 alpha22 = %23.19e %23.19e\n", *alpha21, *alpha22 );
192  return i;
193  }
194  else
195  {
196  printf( "FLA_Tevd_francis_n_opt_var1: but NO deflation detected! (col %d)\n", i );
197  printf( "FLA_Tevd_francis_n_opt_var1: alpha11 = %23.19e\n", *alpha11 );
198  printf( "FLA_Tevd_francis_n_opt_var1: alpha21 alpha22 = %23.19e %23.19e\n", *alpha21, *alpha22 );
199  FLA_Abort();
200  return FLA_FAILURE;
201  }
202  }
203  }
204 
205  /*------------------------------------------------------------*/
206  }
207 
208  // Return the index of column where deflation most recently occurred,
209  // or FLA_SUCCESS if no deflation was detected.
210  return ij_deflated;
211 }
void FLA_Abort(void)
Definition: FLA_Error.c:248
double FLA_Mach_params_opd(FLA_Machval machval)
Definition: FLA_Mach_params.c:74
int i
Definition: bl1_axmyv2.c:145
double temp1
Definition: bl1_axpyv2b.c:146

References FLA_Abort(), FLA_Mach_params_opd(), i, and temp1.

Referenced by FLA_Tevd_eigval_n_opd_var1(), and FLA_Tevd_francis_n_opt_var1().

◆ FLA_Tevd_francis_n_ops_var1()

FLA_Error FLA_Tevd_francis_n_ops_var1 ( int  m_A,
float *  buff_shift,
float *  buff_d,
int  inc_d,
float *  buff_e,
int  inc_e 
)
68 {
69  return FLA_SUCCESS;
70 }

Referenced by FLA_Tevd_francis_n_opt_var1().

◆ FLA_Tevd_francis_n_opt_var1()

FLA_Error FLA_Tevd_francis_n_opt_var1 ( FLA_Obj  shift,
FLA_Obj  d,
FLA_Obj  e 
)
14 {
15  FLA_Datatype datatype;
16  int m_A;
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 
24  inc_d = FLA_Obj_vector_inc( d );
25  inc_e = FLA_Obj_vector_inc( e );
26 
27 
28  switch ( datatype )
29  {
30  case FLA_FLOAT:
31  {
32  float* buff_shift = FLA_FLOAT_PTR( shift );
33  float* buff_d = FLA_FLOAT_PTR( d );
34  float* buff_e = FLA_FLOAT_PTR( e );
35 
37  buff_shift,
38  buff_d, inc_d,
39  buff_e, inc_e );
40 
41  break;
42  }
43 
44  case FLA_DOUBLE:
45  {
46  double* buff_shift = FLA_DOUBLE_PTR( shift );
47  double* buff_d = FLA_DOUBLE_PTR( d );
48  double* buff_e = FLA_DOUBLE_PTR( e );
49 
51  buff_shift,
52  buff_d, inc_d,
53  buff_e, inc_e );
54 
55  break;
56  }
57  }
58 
59  return FLA_SUCCESS;
60 }
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
FLA_Error FLA_Tevd_francis_n_ops_var1(int m_A, float *buff_shift, float *buff_d, int inc_d, float *buff_e, int inc_e)
Definition: FLA_Tevd_francis_n_opt_var1.c:64
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_Tevd_francis_n_opd_var1(), and FLA_Tevd_francis_n_ops_var1().