libflame  revision_anchor
Functions
FLA_Househ2_UT.c File Reference

(r)

Functions

FLA_Error FLA_Househ2_UT (FLA_Side side, FLA_Obj chi_1, FLA_Obj x2, FLA_Obj tau)
 
FLA_Error FLA_Househ2_UT_l_ops (int m_x2, float *chi_1, float *x2, int inc_x2, float *tau)
 
FLA_Error FLA_Househ2_UT_l_opd (int m_x2, double *chi_1, double *x2, int inc_x2, double *tau)
 
FLA_Error FLA_Househ2_UT_l_opc (int m_x2, scomplex *chi_1, scomplex *x2, int inc_x2, scomplex *tau)
 
FLA_Error FLA_Househ2_UT_l_opz (int m_x2, dcomplex *chi_1, dcomplex *x2, int inc_x2, dcomplex *tau)
 
FLA_Error FLA_Househ2_UT_r_ops (int m_x2, float *chi_1, float *x2, int inc_x2, float *tau)
 
FLA_Error FLA_Househ2_UT_r_opd (int m_x2, double *chi_1, double *x2, int inc_x2, double *tau)
 
FLA_Error FLA_Househ2_UT_r_opc (int m_x2, scomplex *chi_1, scomplex *x2, int inc_x2, scomplex *tau)
 
FLA_Error FLA_Househ2_UT_r_opz (int m_x2, dcomplex *chi_1, dcomplex *x2, int inc_x2, dcomplex *tau)
 

Function Documentation

◆ FLA_Househ2_UT()

FLA_Error FLA_Househ2_UT ( FLA_Side  side,
FLA_Obj  chi_1,
FLA_Obj  x2,
FLA_Obj  tau 
)

References FLA_Check_error_level(), FLA_Househ2_UT_check(), FLA_Househ2_UT_l_opc(), FLA_Househ2_UT_l_opd(), FLA_Househ2_UT_l_ops(), FLA_Househ2_UT_l_opz(), FLA_Househ2_UT_r_opc(), FLA_Househ2_UT_r_opd(), FLA_Househ2_UT_r_ops(), FLA_Househ2_UT_r_opz(), FLA_Obj_datatype(), FLA_Obj_vector_dim(), and FLA_Obj_vector_inc().

Referenced by FLA_Bidiag_UT_u_step_unb_var1(), FLA_Bidiag_UT_u_step_unb_var2(), FLA_Bidiag_UT_u_step_unb_var3(), FLA_Bidiag_UT_u_step_unb_var4(), FLA_Bidiag_UT_u_step_unb_var5(), FLA_CAQR2_UT_unb_var1(), FLA_Hess_UT_step_unb_var1(), FLA_Hess_UT_step_unb_var2(), FLA_Hess_UT_step_unb_var3(), FLA_Hess_UT_step_unb_var4(), FLA_Hess_UT_step_unb_var5(), FLA_LQ_UT_unb_var1(), FLA_LQ_UT_unb_var2(), FLA_QR2_UT_unb_var1(), FLA_QR_UT_piv_unb_var1(), FLA_QR_UT_piv_unb_var2(), FLA_QR_UT_unb_var1(), FLA_QR_UT_unb_var2(), FLA_Tridiag_UT_l_step_unb_var1(), FLA_Tridiag_UT_l_step_unb_var2(), and FLA_Tridiag_UT_l_step_unb_var3().

59 {
60  FLA_Datatype datatype;
61  int m_x2;
62  int inc_x2;
63 
64  datatype = FLA_Obj_datatype( x2 );
65 
66  m_x2 = FLA_Obj_vector_dim( x2 );
67  inc_x2 = FLA_Obj_vector_inc( x2 );
68 
69  if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
70  FLA_Househ2_UT_check( side, chi_1, x2, tau );
71 
72  switch ( datatype )
73  {
74  case FLA_FLOAT:
75  {
76  float* chi_1_p = ( float* ) FLA_FLOAT_PTR( chi_1 );
77  float* x2_p = ( float* ) FLA_FLOAT_PTR( x2 );
78  float* tau_p = ( float* ) FLA_FLOAT_PTR( tau );
79 
80  if ( side == FLA_LEFT )
82  chi_1_p,
83  x2_p, inc_x2,
84  tau_p );
85  else // if ( side == FLA_RIGHT )
87  chi_1_p,
88  x2_p, inc_x2,
89  tau_p );
90 
91  break;
92  }
93 
94  case FLA_DOUBLE:
95  {
96  double* chi_1_p = ( double* ) FLA_DOUBLE_PTR( chi_1 );
97  double* x2_p = ( double* ) FLA_DOUBLE_PTR( x2 );
98  double* tau_p = ( double* ) FLA_DOUBLE_PTR( tau );
99 
100  if ( side == FLA_LEFT )
101  FLA_Househ2_UT_l_opd( m_x2,
102  chi_1_p,
103  x2_p, inc_x2,
104  tau_p );
105  else // if ( side == FLA_RIGHT )
106  FLA_Househ2_UT_r_opd( m_x2,
107  chi_1_p,
108  x2_p, inc_x2,
109  tau_p );
110 
111  break;
112  }
113 
114  case FLA_COMPLEX:
115  {
116  scomplex* chi_1_p = ( scomplex* ) FLA_COMPLEX_PTR( chi_1 );
117  scomplex* x2_p = ( scomplex* ) FLA_COMPLEX_PTR( x2 );
118  scomplex* tau_p = ( scomplex* ) FLA_COMPLEX_PTR( tau );
119 
120  if ( side == FLA_LEFT )
121  FLA_Househ2_UT_l_opc( m_x2,
122  chi_1_p,
123  x2_p, inc_x2,
124  tau_p );
125  else // if ( side == FLA_RIGHT )
126  FLA_Househ2_UT_r_opc( m_x2,
127  chi_1_p,
128  x2_p, inc_x2,
129  tau_p );
130 
131  break;
132  }
133 
134  case FLA_DOUBLE_COMPLEX:
135  {
136  dcomplex* chi_1_p = ( dcomplex* ) FLA_DOUBLE_COMPLEX_PTR( chi_1 );
137  dcomplex* x2_p = ( dcomplex* ) FLA_DOUBLE_COMPLEX_PTR( x2 );
138  dcomplex* tau_p = ( dcomplex* ) FLA_DOUBLE_COMPLEX_PTR( tau );
139 
140  if ( side == FLA_LEFT )
141  FLA_Househ2_UT_l_opz( m_x2,
142  chi_1_p,
143  x2_p, inc_x2,
144  tau_p );
145  else // if ( side == FLA_RIGHT )
146  FLA_Househ2_UT_r_opz( m_x2,
147  chi_1_p,
148  x2_p, inc_x2,
149  tau_p );
150 
151  break;
152  }
153  }
154 
155  return FLA_SUCCESS;
156 }
FLA_Error FLA_Househ2_UT_r_opc(int m_x2, scomplex *chi_1, scomplex *x2, int inc_x2, scomplex *tau)
Definition: FLA_Househ2_UT.c:677
FLA_Error FLA_Househ2_UT_r_ops(int m_x2, float *chi_1, float *x2, int inc_x2, float *tau)
Definition: FLA_Househ2_UT.c:651
FLA_Error FLA_Househ2_UT_l_opc(int m_x2, scomplex *chi_1, scomplex *x2, int inc_x2, scomplex *tau)
Definition: FLA_Househ2_UT.c:390
FLA_Datatype FLA_Obj_datatype(FLA_Obj obj)
Definition: FLA_Query.c:13
FLA_Error FLA_Househ2_UT_r_opz(int m_x2, dcomplex *chi_1, dcomplex *x2, int inc_x2, dcomplex *tau)
Definition: FLA_Househ2_UT.c:693
FLA_Error FLA_Househ2_UT_r_opd(int m_x2, double *chi_1, double *x2, int inc_x2, double *tau)
Definition: FLA_Househ2_UT.c:664
Definition: blis_type_defs.h:132
FLA_Error FLA_Househ2_UT_check(FLA_Side side, FLA_Obj chi_1, FLA_Obj x2, FLA_Obj tau)
Definition: FLA_Househ2_UT_check.c:13
FLA_Error FLA_Househ2_UT_l_opd(int m_x2, double *chi_1, double *x2, int inc_x2, double *tau)
Definition: FLA_Househ2_UT.c:274
dim_t FLA_Obj_vector_dim(FLA_Obj obj)
Definition: FLA_Query.c:137
unsigned int FLA_Check_error_level(void)
Definition: FLA_Check.c:18
int FLA_Datatype
Definition: FLA_type_defs.h:49
FLA_Error FLA_Househ2_UT_l_ops(int m_x2, float *chi_1, float *x2, int inc_x2, float *tau)
Definition: FLA_Househ2_UT.c:160
dim_t FLA_Obj_vector_inc(FLA_Obj obj)
Definition: FLA_Query.c:145
FLA_Error FLA_Househ2_UT_l_opz(int m_x2, dcomplex *chi_1, dcomplex *x2, int inc_x2, dcomplex *tau)
Definition: FLA_Househ2_UT.c:521
Definition: blis_type_defs.h:137

◆ FLA_Househ2_UT_l_opc()

FLA_Error FLA_Househ2_UT_l_opc ( int  m_x2,
scomplex chi_1,
scomplex x2,
int  inc_x2,
scomplex tau 
)

References bl1_cinvscalv(), bl1_cnrm2(), BLIS1_NO_CONJUGATE, FLA_ONE_HALF, scomplex::imag, and scomplex::real.

Referenced by FLA_Bidiag_UT_u_step_ofc_var2(), FLA_Bidiag_UT_u_step_ofc_var3(), FLA_Bidiag_UT_u_step_ofc_var4(), FLA_Bidiag_UT_u_step_opc_var1(), FLA_Bidiag_UT_u_step_opc_var2(), FLA_Bidiag_UT_u_step_opc_var3(), FLA_Bidiag_UT_u_step_opc_var4(), FLA_Bidiag_UT_u_step_opc_var5(), FLA_CAQR2_UT_opc_var1(), FLA_Hess_UT_step_ofc_var2(), FLA_Hess_UT_step_ofc_var3(), FLA_Hess_UT_step_ofc_var4(), FLA_Hess_UT_step_opc_var1(), FLA_Hess_UT_step_opc_var2(), FLA_Hess_UT_step_opc_var3(), FLA_Hess_UT_step_opc_var4(), FLA_Hess_UT_step_opc_var5(), FLA_Househ2_UT(), FLA_Househ2_UT_r_opc(), FLA_QR2_UT_opc_var1(), FLA_QR_UT_opc_var1(), FLA_QR_UT_opc_var2(), FLA_Tridiag_UT_l_step_ofc_var2(), FLA_Tridiag_UT_l_step_ofc_var3(), FLA_Tridiag_UT_l_step_opc_var1(), FLA_Tridiag_UT_l_step_opc_var2(), and FLA_Tridiag_UT_l_step_opc_var3().

394 {
395  scomplex one_half = *FLA_COMPLEX_PTR( FLA_ONE_HALF );
396  scomplex y[2];
397  scomplex alpha;
398  scomplex chi_1_minus_alpha;
399  float abs_chi_1;
400  float norm_x_2;
401  float norm_x;
402  float abs_chi_1_minus_alpha;
403  float norm_x_2_div_abs_chi_1_minus_alpha;
404  int i_one = 1;
405  int i_two = 2;
406 
407  //
408  // Compute the 2-norm of x_2:
409  //
410  // norm_x_2 := || x_2 ||_2
411  //
412 
413  bl1_cnrm2( m_x2,
414  x2, inc_x2,
415  &norm_x_2 );
416 
417  //
418  // If 2-norm of x_2 is zero, then return with trivial values.
419  //
420 
421  if ( norm_x_2 == 0.0F )
422  {
423  chi_1->real = -(chi_1->real);
424  chi_1->imag = -(chi_1->imag);
425  tau->real = one_half.real;
426  tau->imag = one_half.imag;
427 
428  return FLA_SUCCESS;
429  }
430 
431  //
432  // Compute the absolute value (magnitude) of chi_1, which equals the 2-norm
433  // of chi_1:
434  //
435  // abs_chi_1 := | chi_1 | = || chi_1 ||_2
436  //
437 
438  bl1_cnrm2( i_one,
439  chi_1, i_one,
440  &abs_chi_1 );
441 
442  //
443  // Compute the 2-norm of x via the two norms previously computed above:
444  //
445  // norm_x := || x ||_2 = || / chi_1 \ || = || / || chi_1 ||_2 \ ||
446  // || \ x_2 / ||_2 || \ || x_2 ||_2 / ||_2
447  //
448 
449  y[0].real = abs_chi_1;
450  y[0].imag = 0.0F;
451 
452  y[1].real = norm_x_2;
453  y[1].imag = 0.0F;
454 
455  bl1_cnrm2( i_two,
456  y, i_one,
457  &norm_x );
458 
459  //
460  // Compute alpha:
461  //
462  // alpha := - || x ||_2 * chi_1 / | chi_1 |
463  //
464 
465  if ( abs_chi_1 == 0.0F )
466  {
467  alpha.real = norm_x * ( -1.0F );
468  alpha.imag = norm_x * ( -1.0F );
469  }
470  else
471  {
472  alpha.real = norm_x * ( -chi_1->real / abs_chi_1 );
473  alpha.imag = norm_x * ( -chi_1->imag / abs_chi_1 );
474  }
475 
476  //
477  // Overwrite x_2 with u_2:
478  //
479  // x_2 := x_2 / ( chi_1 - alpha )
480  //
481 
482  chi_1_minus_alpha.real = chi_1->real - alpha.real;
483  chi_1_minus_alpha.imag = chi_1->imag - alpha.imag;
484 
486  m_x2,
487  &chi_1_minus_alpha,
488  x2, inc_x2 );
489 
490  //
491  // Compute tau:
492  //
493  // tau := ( 1 + u_2' * u_2 ) / 2
494  // = ( ( chi_1 - alpha ) * conj( chi_1 - alpha ) + x_2' * x_2 ) /
495  // ( 2 * ( chi_1 - alpha ) * conj( chi_1 - alpha ) )
496  // = 1/2 + ( || x ||_2 / | chi_1 - alpha | )^2
497  //
498 
499  bl1_csabsval2( &chi_1_minus_alpha, &abs_chi_1_minus_alpha );
500 
501  norm_x_2_div_abs_chi_1_minus_alpha = norm_x_2 / abs_chi_1_minus_alpha;
502  tau->real = one_half.real + one_half.real*(norm_x_2_div_abs_chi_1_minus_alpha *
503  norm_x_2_div_abs_chi_1_minus_alpha);
504  tau->imag = 0.0F;
505 
506  //
507  // Overwrite chi_1 with alpha:
508  //
509  // chi_1 := alpha
510  //
511 
512  chi_1->real = alpha.real;
513  chi_1->imag = alpha.imag;
514 
515  return FLA_SUCCESS;
516 }
float real
Definition: blis_type_defs.h:134
Definition: blis_type_defs.h:81
FLA_Obj FLA_ONE_HALF
Definition: FLA_Init.c:19
void bl1_cnrm2(int n, scomplex *x, int incx, float *norm)
Definition: bl1_nrm2.c:35
Definition: blis_type_defs.h:132
void bl1_cinvscalv(conj1_t conj, int n, scomplex *alpha, scomplex *x, int incx)
Definition: bl1_invscalv.c:52
float imag
Definition: blis_type_defs.h:134

◆ FLA_Househ2_UT_l_opd()

FLA_Error FLA_Househ2_UT_l_opd ( int  m_x2,
double *  chi_1,
double *  x2,
int  inc_x2,
double *  tau 
)

References bl1_dinvscalv(), bl1_dnrm2(), BLIS1_NO_CONJUGATE, and FLA_ONE_HALF.

Referenced by FLA_Bidiag_UT_u_step_ofd_var2(), FLA_Bidiag_UT_u_step_ofd_var3(), FLA_Bidiag_UT_u_step_ofd_var4(), FLA_Bidiag_UT_u_step_opd_var1(), FLA_Bidiag_UT_u_step_opd_var2(), FLA_Bidiag_UT_u_step_opd_var3(), FLA_Bidiag_UT_u_step_opd_var4(), FLA_Bidiag_UT_u_step_opd_var5(), FLA_CAQR2_UT_opd_var1(), FLA_Hess_UT_step_ofd_var2(), FLA_Hess_UT_step_ofd_var3(), FLA_Hess_UT_step_ofd_var4(), FLA_Hess_UT_step_opd_var1(), FLA_Hess_UT_step_opd_var2(), FLA_Hess_UT_step_opd_var3(), FLA_Hess_UT_step_opd_var4(), FLA_Hess_UT_step_opd_var5(), FLA_Househ2_UT(), FLA_Househ2_UT_r_opd(), FLA_QR2_UT_opd_var1(), FLA_QR_UT_opd_var1(), FLA_QR_UT_opd_var2(), FLA_Tridiag_UT_l_step_ofd_var2(), FLA_Tridiag_UT_l_step_ofd_var3(), FLA_Tridiag_UT_l_step_opd_var1(), FLA_Tridiag_UT_l_step_opd_var2(), and FLA_Tridiag_UT_l_step_opd_var3().

278 {
279  double one_half = *FLA_DOUBLE_PTR( FLA_ONE_HALF );
280  double y[2];
281  double alpha;
282  double chi_1_minus_alpha;
283  double abs_chi_1;
284  double norm_x_2;
285  double norm_x;
286  double abs_chi_1_minus_alpha;
287  double norm_x_2_div_abs_chi_1_minus_alpha;
288  int i_one = 1;
289  int i_two = 2;
290 
291  //
292  // Compute the 2-norm of x_2:
293  //
294  // norm_x_2 := || x_2 ||_2
295  //
296 
297  bl1_dnrm2( m_x2,
298  x2, inc_x2,
299  &norm_x_2 );
300 
301  //
302  // If 2-norm of x_2 is zero, then return with trivial values.
303  //
304 
305  if ( norm_x_2 == 0.0 )
306  {
307  *chi_1 = -(*chi_1);
308  *tau = one_half;
309 
310  return FLA_SUCCESS;
311  }
312 
313  //
314  // Compute the absolute value (magnitude) of chi_1, which equals the 2-norm
315  // of chi_1:
316  //
317  // abs_chi_1 := | chi_1 | = || chi_1 ||_2
318  //
319 
320  bl1_dnrm2( i_one,
321  chi_1, i_one,
322  &abs_chi_1 );
323 
324  //
325  // Compute the 2-norm of x via the two norms previously computed above:
326  //
327  // norm_x := || x ||_2 = || / chi_1 \ || = || / || chi_1 ||_2 \ ||
328  // || \ x_2 / ||_2 || \ || x_2 ||_2 / ||_2
329  //
330 
331  y[0] = abs_chi_1;
332  y[1] = norm_x_2;
333 
334  bl1_dnrm2( i_two,
335  y, i_one,
336  &norm_x );
337 
338  //
339  // Compute alpha:
340  //
341  // alpha := - || x ||_2 * chi_1 / | chi_1 |
342  // = -sign( chi_1 ) * || x ||_2
343  //
344 
345  alpha = -dsign( *chi_1 ) * norm_x;
346 
347  //
348  // Overwrite x_2 with u_2:
349  //
350  // x_2 := x_2 / ( chi_1 - alpha )
351  //
352 
353  chi_1_minus_alpha = *chi_1 - alpha;
354 
356  m_x2,
357  &chi_1_minus_alpha,
358  x2, inc_x2 );
359 
360  //
361  // Compute tau:
362  //
363  // tau := ( 1 + u_2' * u_2 ) / 2
364  // = ( ( chi_1 - alpha ) * conj( chi_1 - alpha ) + x_2' * x_2 ) /
365  // ( 2 * ( chi_1 - alpha ) * conj( chi_1 - alpha ) )
366  // = 1/2 + ( || x ||_2 / | chi_1 - alpha | )^2
367  //
368 
369  bl1_dabsval2( &chi_1_minus_alpha, &abs_chi_1_minus_alpha );
370 
371  abs_chi_1_minus_alpha = (double)fabs(chi_1_minus_alpha);
372 
373  norm_x_2_div_abs_chi_1_minus_alpha = norm_x_2 / abs_chi_1_minus_alpha;
374  *tau = one_half + one_half*(norm_x_2_div_abs_chi_1_minus_alpha *
375  norm_x_2_div_abs_chi_1_minus_alpha);
376 
377  //
378  // Overwrite chi_1 with alpha:
379  //
380  // chi_1 := alpha
381  //
382 
383  *chi_1 = alpha;
384 
385  return FLA_SUCCESS;
386 }
Definition: blis_type_defs.h:81
FLA_Obj FLA_ONE_HALF
Definition: FLA_Init.c:19
void bl1_dinvscalv(conj1_t conj, int n, double *alpha, double *x, int incx)
Definition: bl1_invscalv.c:26
void bl1_dnrm2(int n, double *x, int incx, double *norm)
Definition: bl1_nrm2.c:24

◆ FLA_Househ2_UT_l_ops()

FLA_Error FLA_Househ2_UT_l_ops ( int  m_x2,
float *  chi_1,
float *  x2,
int  inc_x2,
float *  tau 
)

References bl1_sinvscalv(), bl1_snrm2(), BLIS1_NO_CONJUGATE, and FLA_ONE_HALF.

Referenced by FLA_Bidiag_UT_u_step_ofs_var2(), FLA_Bidiag_UT_u_step_ofs_var3(), FLA_Bidiag_UT_u_step_ofs_var4(), FLA_Bidiag_UT_u_step_ops_var1(), FLA_Bidiag_UT_u_step_ops_var2(), FLA_Bidiag_UT_u_step_ops_var3(), FLA_Bidiag_UT_u_step_ops_var4(), FLA_Bidiag_UT_u_step_ops_var5(), FLA_CAQR2_UT_ops_var1(), FLA_Hess_UT_step_ofs_var2(), FLA_Hess_UT_step_ofs_var3(), FLA_Hess_UT_step_ofs_var4(), FLA_Hess_UT_step_ops_var1(), FLA_Hess_UT_step_ops_var2(), FLA_Hess_UT_step_ops_var3(), FLA_Hess_UT_step_ops_var4(), FLA_Hess_UT_step_ops_var5(), FLA_Househ2_UT(), FLA_Househ2_UT_r_ops(), FLA_QR2_UT_ops_var1(), FLA_QR_UT_ops_var1(), FLA_QR_UT_ops_var2(), FLA_Tridiag_UT_l_step_ofs_var2(), FLA_Tridiag_UT_l_step_ofs_var3(), FLA_Tridiag_UT_l_step_ops_var1(), FLA_Tridiag_UT_l_step_ops_var2(), and FLA_Tridiag_UT_l_step_ops_var3().

164 {
165  float one_half = *FLA_FLOAT_PTR( FLA_ONE_HALF );
166  float y[2];
167  float alpha;
168  float chi_1_minus_alpha;
169  float abs_chi_1;
170  float norm_x_2;
171  float norm_x;
172  float abs_chi_1_minus_alpha;
173  float norm_x_2_div_abs_chi_1_minus_alpha;
174  int i_one = 1;
175  int i_two = 2;
176 
177  //
178  // Compute the 2-norm of x_2:
179  //
180  // norm_x_2 := || x_2 ||_2
181  //
182 
183  bl1_snrm2( m_x2,
184  x2, inc_x2,
185  &norm_x_2 );
186 
187  //
188  // If 2-norm of x_2 is zero, then return with trivial values.
189  //
190 
191  if ( norm_x_2 == 0.0F )
192  {
193  *chi_1 = -(*chi_1);
194  *tau = one_half;
195 
196  return FLA_SUCCESS;
197  }
198 
199  //
200  // Compute the absolute value (magnitude) of chi_1, which equals the 2-norm
201  // of chi_1:
202  //
203  // abs_chi_1 := | chi_1 | = || chi_1 ||_2
204  //
205 
206  bl1_snrm2( i_one,
207  chi_1, i_one,
208  &abs_chi_1 );
209 
210  //
211  // Compute the 2-norm of x via the two norms previously computed above:
212  //
213  // norm_x := || x ||_2 = || / chi_1 \ || = || / || chi_1 ||_2 \ ||
214  // || \ x_2 / ||_2 || \ || x_2 ||_2 / ||_2
215  //
216 
217  y[0] = abs_chi_1;
218  y[1] = norm_x_2;
219 
220  bl1_snrm2( i_two,
221  y, i_one,
222  &norm_x );
223 
224  //
225  // Compute alpha:
226  //
227  // alpha := - || x ||_2 * chi_1 / | chi_1 |
228  // = -sign( chi_1 ) * || x ||_2
229  //
230 
231  alpha = -ssign( *chi_1 ) * norm_x;
232 
233  //
234  // Overwrite x_2 with u_2:
235  //
236  // x_2 := x_2 / ( chi_1 - alpha )
237  //
238 
239  chi_1_minus_alpha = *chi_1 - alpha;
240 
242  m_x2,
243  &chi_1_minus_alpha,
244  x2, inc_x2 );
245 
246  //
247  // Compute tau:
248  //
249  // tau := ( 1 + u_2' * u_2 ) / 2
250  // = ( ( chi_1 - alpha ) * conj( chi_1 - alpha ) + x_2' * x_2 ) /
251  // ( 2 * ( chi_1 - alpha ) * conj( chi_1 - alpha ) )
252  // = 1/2 + ( || x ||_2 / | chi_1 - alpha | )^2
253  //
254 
255  bl1_sabsval2( &chi_1_minus_alpha, &abs_chi_1_minus_alpha );
256 
257  norm_x_2_div_abs_chi_1_minus_alpha = norm_x_2 / abs_chi_1_minus_alpha;
258  *tau = one_half + one_half*(norm_x_2_div_abs_chi_1_minus_alpha *
259  norm_x_2_div_abs_chi_1_minus_alpha);
260 
261  //
262  // Overwrite chi_1 with alpha:
263  //
264  // chi_1 := alpha
265  //
266 
267  *chi_1 = alpha;
268 
269  return FLA_SUCCESS;
270 }
Definition: blis_type_defs.h:81
FLA_Obj FLA_ONE_HALF
Definition: FLA_Init.c:19
void bl1_sinvscalv(conj1_t conj, int n, float *alpha, float *x, int incx)
Definition: bl1_invscalv.c:13
void bl1_snrm2(int n, float *x, int incx, float *norm)
Definition: bl1_nrm2.c:13

◆ FLA_Househ2_UT_l_opz()

FLA_Error FLA_Househ2_UT_l_opz ( int  m_x2,
dcomplex chi_1,
dcomplex x2,
int  inc_x2,
dcomplex tau 
)

References bl1_zinvscalv(), bl1_znrm2(), BLIS1_NO_CONJUGATE, FLA_ONE_HALF, dcomplex::imag, and dcomplex::real.

Referenced by FLA_Bidiag_UT_u_step_ofz_var2(), FLA_Bidiag_UT_u_step_ofz_var3(), FLA_Bidiag_UT_u_step_ofz_var4(), FLA_Bidiag_UT_u_step_opz_var1(), FLA_Bidiag_UT_u_step_opz_var2(), FLA_Bidiag_UT_u_step_opz_var3(), FLA_Bidiag_UT_u_step_opz_var4(), FLA_Bidiag_UT_u_step_opz_var5(), FLA_CAQR2_UT_opz_var1(), FLA_Hess_UT_step_ofz_var2(), FLA_Hess_UT_step_ofz_var3(), FLA_Hess_UT_step_ofz_var4(), FLA_Hess_UT_step_opz_var1(), FLA_Hess_UT_step_opz_var2(), FLA_Hess_UT_step_opz_var3(), FLA_Hess_UT_step_opz_var4(), FLA_Hess_UT_step_opz_var5(), FLA_Househ2_UT(), FLA_Househ2_UT_r_opz(), FLA_QR2_UT_opz_var1(), FLA_QR_UT_opz_var1(), FLA_QR_UT_opz_var2(), FLA_Tridiag_UT_l_step_ofz_var2(), FLA_Tridiag_UT_l_step_ofz_var3(), FLA_Tridiag_UT_l_step_opz_var1(), FLA_Tridiag_UT_l_step_opz_var2(), and FLA_Tridiag_UT_l_step_opz_var3().

525 {
526  dcomplex one_half = *FLA_DOUBLE_COMPLEX_PTR( FLA_ONE_HALF );
527  dcomplex y[2];
528  dcomplex alpha;
529  dcomplex chi_1_minus_alpha;
530  double abs_chi_1;
531  double norm_x_2;
532  double norm_x;
533  double abs_chi_1_minus_alpha;
534  double norm_x_2_div_abs_chi_1_minus_alpha;
535  int i_one = 1;
536  int i_two = 2;
537 
538  //
539  // Compute the 2-norm of x_2:
540  //
541  // norm_x_2 := || x_2 ||_2
542  //
543 
544  bl1_znrm2( m_x2,
545  x2, inc_x2,
546  &norm_x_2 );
547 
548  //
549  // If 2-norm of x_2 is zero, then return with trivial values.
550  //
551 
552  if ( norm_x_2 == 0.0 )
553  {
554  chi_1->real = -(chi_1->real);
555  chi_1->imag = -(chi_1->imag);
556  tau->real = one_half.real;
557  tau->imag = one_half.imag;
558 
559  return FLA_SUCCESS;
560  }
561 
562  //
563  // Compute the absolute value (magnitude) of chi_1, which equals the 2-norm
564  // of chi_1:
565  //
566  // abs_chi_1 := | chi_1 | = || chi_1 ||_2
567  //
568 
569  bl1_znrm2( i_one,
570  chi_1, i_one,
571  &abs_chi_1 );
572 
573  //
574  // Compute the 2-norm of x via the two norms previously computed above:
575  //
576  // norm_x := || x ||_2 = || / chi_1 \ || = || / || chi_1 ||_2 \ ||
577  // || \ x_2 / ||_2 || \ || x_2 ||_2 / ||_2
578  //
579 
580  y[0].real = abs_chi_1;
581  y[0].imag = 0.0;
582 
583  y[1].real = norm_x_2;
584  y[1].imag = 0.0;
585 
586  bl1_znrm2( i_two,
587  y, i_one,
588  &norm_x );
589 
590  //
591  // Compute alpha:
592  //
593  // alpha := - || x ||_2 * chi_1 / | chi_1 |
594  //
595 
596  if ( abs_chi_1 == 0.0 )
597  {
598  alpha.real = norm_x * ( -1.0 );
599  alpha.imag = norm_x * ( -1.0 );
600  }
601  else
602  {
603  alpha.real = norm_x * ( -chi_1->real / abs_chi_1 );
604  alpha.imag = norm_x * ( -chi_1->imag / abs_chi_1 );
605  }
606 
607  //
608  // Overwrite x_2 with u_2:
609  //
610  // x_2 := x_2 / ( chi_1 - alpha )
611  //
612 
613  chi_1_minus_alpha.real = chi_1->real - alpha.real;
614  chi_1_minus_alpha.imag = chi_1->imag - alpha.imag;
615 
617  m_x2,
618  &chi_1_minus_alpha,
619  x2, inc_x2 );
620 
621  //
622  // Compute tau:
623  //
624  // tau := ( 1 + u_2' * u_2 ) / 2
625  // = ( ( chi_1 - alpha ) * conj( chi_1 - alpha ) + x_2' * x_2 ) /
626  // ( 2 * ( chi_1 - alpha ) * conj( chi_1 - alpha ) )
627  // = 1/2 + ( || x ||_2 / | chi_1 - alpha | )^2
628  //
629 
630  bl1_zdabsval2( &chi_1_minus_alpha, &abs_chi_1_minus_alpha );
631 
632  norm_x_2_div_abs_chi_1_minus_alpha = norm_x_2 / abs_chi_1_minus_alpha;
633  tau->real = one_half.real + one_half.real*(norm_x_2_div_abs_chi_1_minus_alpha *
634  norm_x_2_div_abs_chi_1_minus_alpha);
635  tau->imag = 0.0;
636 
637  //
638  // Overwrite chi_1 with alpha:
639  //
640  // chi_1 := alpha
641  //
642 
643  chi_1->real = alpha.real;
644  chi_1->imag = alpha.imag;
645 
646  return FLA_SUCCESS;
647 }
void bl1_zinvscalv(conj1_t conj, int n, dcomplex *alpha, dcomplex *x, int incx)
Definition: bl1_invscalv.c:78
double imag
Definition: blis_type_defs.h:139
Definition: blis_type_defs.h:81
FLA_Obj FLA_ONE_HALF
Definition: FLA_Init.c:19
void bl1_znrm2(int n, dcomplex *x, int incx, double *norm)
Definition: bl1_nrm2.c:46
double real
Definition: blis_type_defs.h:139
Definition: blis_type_defs.h:137

◆ FLA_Househ2_UT_r_opc()

FLA_Error FLA_Househ2_UT_r_opc ( int  m_x2,
scomplex chi_1,
scomplex x2,
int  inc_x2,
scomplex tau 
)

References bl1_cconjv(), and FLA_Househ2_UT_l_opc().

Referenced by FLA_Bidiag_UT_u_step_ofc_var2(), FLA_Bidiag_UT_u_step_opc_var1(), FLA_Bidiag_UT_u_step_opc_var2(), FLA_Bidiag_UT_u_step_opc_var5(), FLA_Househ2_UT(), FLA_LQ_UT_opc_var1(), and FLA_LQ_UT_opc_var2().

681 {
682  FLA_Househ2_UT_l_opc( m_x2,
683  chi_1,
684  x2, inc_x2,
685  tau );
686 
687  bl1_cconjv( m_x2,
688  x2, inc_x2 );
689 
690  return FLA_SUCCESS;
691 }
FLA_Error FLA_Househ2_UT_l_opc(int m_x2, scomplex *chi_1, scomplex *x2, int inc_x2, scomplex *tau)
Definition: FLA_Househ2_UT.c:390
void bl1_cconjv(int m, scomplex *x, int incx)
Definition: bl1_conjv.c:23

◆ FLA_Househ2_UT_r_opd()

FLA_Error FLA_Househ2_UT_r_opd ( int  m_x2,
double *  chi_1,
double *  x2,
int  inc_x2,
double *  tau 
)

References FLA_Househ2_UT_l_opd().

Referenced by FLA_Bidiag_UT_u_step_ofd_var2(), FLA_Bidiag_UT_u_step_opd_var1(), FLA_Bidiag_UT_u_step_opd_var2(), FLA_Bidiag_UT_u_step_opd_var5(), FLA_Househ2_UT(), FLA_LQ_UT_opd_var1(), and FLA_LQ_UT_opd_var2().

668 {
669  FLA_Househ2_UT_l_opd( m_x2,
670  chi_1,
671  x2, inc_x2,
672  tau );
673 
674  return FLA_SUCCESS;
675 }
FLA_Error FLA_Househ2_UT_l_opd(int m_x2, double *chi_1, double *x2, int inc_x2, double *tau)
Definition: FLA_Househ2_UT.c:274

◆ FLA_Househ2_UT_r_ops()

FLA_Error FLA_Househ2_UT_r_ops ( int  m_x2,
float *  chi_1,
float *  x2,
int  inc_x2,
float *  tau 
)

References FLA_Househ2_UT_l_ops().

Referenced by FLA_Bidiag_UT_u_step_ofs_var2(), FLA_Bidiag_UT_u_step_ops_var1(), FLA_Bidiag_UT_u_step_ops_var2(), FLA_Bidiag_UT_u_step_ops_var5(), FLA_Househ2_UT(), FLA_LQ_UT_ops_var1(), and FLA_LQ_UT_ops_var2().

655 {
656  FLA_Househ2_UT_l_ops( m_x2,
657  chi_1,
658  x2, inc_x2,
659  tau );
660 
661  return FLA_SUCCESS;
662 }
FLA_Error FLA_Househ2_UT_l_ops(int m_x2, float *chi_1, float *x2, int inc_x2, float *tau)
Definition: FLA_Househ2_UT.c:160

◆ FLA_Househ2_UT_r_opz()

FLA_Error FLA_Househ2_UT_r_opz ( int  m_x2,
dcomplex chi_1,
dcomplex x2,
int  inc_x2,
dcomplex tau 
)

References bl1_zconjv(), and FLA_Househ2_UT_l_opz().

Referenced by FLA_Bidiag_UT_u_step_ofz_var2(), FLA_Bidiag_UT_u_step_opz_var1(), FLA_Bidiag_UT_u_step_opz_var2(), FLA_Bidiag_UT_u_step_opz_var5(), FLA_Househ2_UT(), FLA_LQ_UT_opz_var1(), and FLA_LQ_UT_opz_var2().

697 {
698  FLA_Househ2_UT_l_opz( m_x2,
699  chi_1,
700  x2, inc_x2,
701  tau );
702 
703  bl1_zconjv( m_x2,
704  x2, inc_x2 );
705 
706  return FLA_SUCCESS;
707 }
FLA_Error FLA_Househ2_UT_l_opz(int m_x2, dcomplex *chi_1, dcomplex *x2, int inc_x2, dcomplex *tau)
Definition: FLA_Househ2_UT.c:521
void bl1_zconjv(int m, dcomplex *x, int incx)
Definition: bl1_conjv.c:34