libflame  revision_anchor
Functions
FLA_Givens2.c File Reference

(r)

Functions

FLA_Error FLA_Givens2 (FLA_Obj chi_1, FLA_Obj chi_2, FLA_Obj gamma, FLA_Obj sigma, FLA_Obj chi_1_new)
 
FLA_Error FLA_Givens2_ops (float *chi_1, float *chi_2, float *gamma, float *sigma, float *chi_1_new)
 
FLA_Error FLA_Givens2_opd (double *chi_1, double *chi_2, double *gamma, double *sigma, double *chi_1_new)
 

Function Documentation

◆ FLA_Givens2()

FLA_Error FLA_Givens2 ( FLA_Obj  chi_1,
FLA_Obj  chi_2,
FLA_Obj  gamma,
FLA_Obj  sigma,
FLA_Obj  chi_1_new 
)

References FLA_Check_error_level(), FLA_Givens2_check(), FLA_Givens2_opd(), FLA_Givens2_ops(), and FLA_Obj_datatype().

47 {
48  FLA_Datatype datatype;
49 
50  datatype = FLA_Obj_datatype( chi_1 );
51 
52  if ( FLA_Check_error_level() >= FLA_MIN_ERROR_CHECKING )
53  FLA_Givens2_check( chi_1, chi_2, gamma, sigma, chi_1_new );
54 
55  switch ( datatype )
56  {
57  case FLA_FLOAT:
58  {
59  float* chi_1_p = ( float* ) FLA_FLOAT_PTR( chi_1 );
60  float* chi_2_p = ( float* ) FLA_FLOAT_PTR( chi_2 );
61  float* gamma_p = ( float* ) FLA_FLOAT_PTR( gamma );
62  float* sigma_p = ( float* ) FLA_FLOAT_PTR( sigma );
63  float* chi_1_new_p = ( float* ) FLA_FLOAT_PTR( chi_1_new );
64 
65  FLA_Givens2_ops( chi_1_p,
66  chi_2_p,
67  gamma_p,
68  sigma_p,
69  chi_1_new_p );
70 
71  break;
72  }
73 
74  case FLA_DOUBLE:
75  {
76  double* chi_1_p = ( double* ) FLA_DOUBLE_PTR( chi_1 );
77  double* chi_2_p = ( double* ) FLA_DOUBLE_PTR( chi_2 );
78  double* gamma_p = ( double* ) FLA_DOUBLE_PTR( gamma );
79  double* sigma_p = ( double* ) FLA_DOUBLE_PTR( sigma );
80  double* chi_1_new_p = ( double* ) FLA_DOUBLE_PTR( chi_1_new );
81 
82  FLA_Givens2_opd( chi_1_p,
83  chi_2_p,
84  gamma_p,
85  sigma_p,
86  chi_1_new_p );
87 
88  break;
89  }
90 
91  }
92 
93  return FLA_SUCCESS;
94 }
FLA_Error FLA_Givens2_opd(double *chi_1, double *chi_2, double *gamma, double *sigma, double *chi_1_new)
Definition: FLA_Givens2.c:107
FLA_Datatype FLA_Obj_datatype(FLA_Obj obj)
Definition: FLA_Query.c:13
FLA_Error FLA_Givens2_ops(float *chi_1, float *chi_2, float *gamma, float *sigma, float *chi_1_new)
Definition: FLA_Givens2.c:98
unsigned int FLA_Check_error_level(void)
Definition: FLA_Check.c:18
int FLA_Datatype
Definition: FLA_type_defs.h:49
FLA_Error FLA_Givens2_check(FLA_Obj chi_1, FLA_Obj chi_2, FLA_Obj gamma, FLA_Obj sigma, FLA_Obj chi_1_new)
Definition: FLA_Givens2_check.c:13

◆ FLA_Givens2_opd()

FLA_Error FLA_Givens2_opd ( double *  chi_1,
double *  chi_2,
double *  gamma,
double *  sigma,
double *  chi_1_new 
)

References FLA_Mach_params_opd(), and i.

Referenced by FLA_Givens2().

112 {
113  double zero = 0.0;
114  double one = 1.0;
115  double two = 2.0;
116 
117  double f = *chi_1;
118  double g = *chi_2;
119  double cs;
120  double sn;
121  double r;
122 
123  int count, i;
124  double eps, f1, g1, safmin, safmin2, safmax2, scale;
125  double base;
126 
127  safmin = FLA_Mach_params_opd( FLA_MACH_SFMIN );
128  eps = FLA_Mach_params_opd( FLA_MACH_EPS );
129  base = FLA_Mach_params_opd( FLA_MACH_BASE );
130 
131  safmin2 = pow( base, ( double )(( int )( log( safmin / eps ) /
132  log( base ) /
133  two ) ) );
134  safmax2 = one / safmin2;
135 
136  if ( g == zero )
137  {
138  cs = one;
139  sn = zero;
140  r = f;
141  }
142  else if ( f == zero )
143  {
144  cs = zero;
145  sn = one;
146  r = g;
147  }
148  else
149  {
150  f1 = f;
151  g1 = g;
152  scale = max( fabs( f1 ), fabs( g1 ) );
153 
154  if ( scale >= safmax2 )
155  {
156  count = 0;
157  do
158  {
159  ++count;
160  f1 = f1 * safmin2;
161  g1 = g1 * safmin2;
162  scale = max( fabs( f1 ), fabs( g1 ) );
163  }
164  while ( scale >= safmax2 );
165 
166  r = sqrt( f1 * f1 + g1 * g1 );
167  cs = f1 / r;
168  sn = g1 / r;
169 
170  for ( i = 0; i < count; ++i )
171  r = r * safmax2;
172  }
173  else if ( scale <= safmin2 )
174  {
175  count = 0;
176  do
177  {
178  ++count;
179  f1 = f1 * safmax2;
180  g1 = g1 * safmax2;
181  scale = max( fabs( f1 ), fabs( g1 ) );
182  }
183  while ( scale <= safmin2 );
184 
185  r = sqrt( f1 * f1 + g1 * g1 );
186  cs = f1 / r;
187  sn = g1 / r;
188 
189  for ( i = 0; i < count; ++i )
190  r = r * safmin2;
191  }
192  else
193  {
194  r = sqrt( f1 * f1 + g1 * g1 );
195  cs = f1 / r;
196  sn = g1 / r;
197  }
198 
199  if ( fabs( f ) > fabs ( g ) && cs < zero )
200  {
201  cs = -cs;
202  sn = -sn;
203  r = -r;
204  }
205  }
206 
207  // Save the output values.
208  *gamma = cs;
209  *sigma = sn;
210  *chi_1_new = r;
211 
212  return FLA_SUCCESS;
213 }
double FLA_Mach_params_opd(FLA_Machval machval)
Definition: FLA_Mach_params.c:74
int i
Definition: bl1_axmyv2.c:145

◆ FLA_Givens2_ops()

FLA_Error FLA_Givens2_ops ( float *  chi_1,
float *  chi_2,
float *  gamma,
float *  sigma,
float *  chi_1_new 
)

Referenced by FLA_Givens2().

103 {
104  return FLA_SUCCESS;
105 }