1 #include <stdlib.h>
2 #include <math.h>
3 #include "blas_extended.h"
4 #include "blas_extended_private.h"
5 #include "blas_extended_test.h"
6
7
test_BLAS_sdot(int n,enum blas_conj_type conj,float alpha,float beta,float rin,float rout,double r_true_l,double r_true_t,float * x,int incx,float * y,int incy,double eps_int,double un_int,double * test_ratio)8 void test_BLAS_sdot(int n, enum blas_conj_type conj, float alpha, float beta,
9 float rin, float rout, double r_true_l, double r_true_t,
10 float *x, int incx, float *y, int incy, double eps_int,
11 double un_int, double *test_ratio)
12
13 /* Purpose
14 * =======
15 *
16 * Computes ratio of the computed error from SDOT over the expected
17 * error bound.
18 *
19 * Arguments
20 * =========
21 *
22 * n (input) int
23 * The length of the vectors X and Y.
24 *
25 * conj (input) enum blas_conj_type
26 *
27 * alpha (input) float
28 *
29 * beta (input) float
30 *
31 * rin (input) float
32 *
33 * rout (input) float
34 * This result was computed by some other routine, and will be
35 * tested by this routine by comparing it with the truth.
36 *
37 * r_true_l (input) double
38 * The leading part of the truth.
39 *
40 * r_true_t (input) double
41 * The trailing part of the truth.
42 *
43 * x (input) float*
44 *
45 * y (input) float*
46 *
47 * eps_int (input) double
48 * The internal machine precision.
49 *
50 * un_int (input) double
51 * The internal underflow threshold.
52 *
53 * test_ratio (output) float*
54 * The ratio of computed error for r over the error bound.
55 */
56 {
57 int i, ix, iy;
58 double eps_accurate, eps_out, tmp1, S, S1, S2, U;
59 double un_d, un_accurate, un_out;
60
61 /* Set the starting position */
62 ix = 0;
63 iy = 0;
64 if (incx < 0)
65 ix = -(n - 1) * incx;
66 if (incy < 0)
67 iy = -(n - 1) * incy;
68
69 /* computing S */
70 S = S1 = S2 = 0.;
71 for (i = 0; i < n; ++i) {
72 S += fabs(x[ix] * y[iy]);
73 S1 += fabs(x[ix]);
74 S2 += fabs(y[iy]);
75 ix += incx;
76 iy += incy;
77 }
78 S *= fabs(alpha);
79 S += fabs(beta * rin);
80
81 un_d = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
82 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
83 S = MAX(S, un_d);
84
85 eps_accurate = power(2, -BITS_E);
86 un_accurate = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra),
87 (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra));
88
89 eps_out = power(2, -BITS_S);
90 un_out = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_single),
91 (double) BLAS_fpinfo_x(blas_emin, blas_prec_single));
92 tmp1 = fabs((rout - r_true_l) - r_true_t);
93
94 /* underflow */
95 U = 2 * fabs(alpha) * n + 3;
96 U = MAX(U, S1 + 2 * n + 1);
97 U = MAX(U, S2 + 2 * n + 1) * (un_int + un_accurate) + un_out;
98
99 *test_ratio = tmp1 / ((n + 2) * (eps_int + eps_accurate) * S
100 + eps_out * fabs(r_true_l) + U);
101 } /* end of test_BLAS_sdot */
test_BLAS_ddot(int n,enum blas_conj_type conj,double alpha,double beta,double rin,double rout,double r_true_l,double r_true_t,double * x,int incx,double * y,int incy,double eps_int,double un_int,double * test_ratio)102 void test_BLAS_ddot(int n, enum blas_conj_type conj, double alpha,
103 double beta, double rin, double rout, double r_true_l,
104 double r_true_t, double *x, int incx, double *y, int incy,
105 double eps_int, double un_int, double *test_ratio)
106
107 /* Purpose
108 * =======
109 *
110 * Computes ratio of the computed error from SDOT over the expected
111 * error bound.
112 *
113 * Arguments
114 * =========
115 *
116 * n (input) int
117 * The length of the vectors X and Y.
118 *
119 * conj (input) enum blas_conj_type
120 *
121 * alpha (input) double
122 *
123 * beta (input) double
124 *
125 * rin (input) double
126 *
127 * rout (input) double
128 * This result was computed by some other routine, and will be
129 * tested by this routine by comparing it with the truth.
130 *
131 * r_true_l (input) double
132 * The leading part of the truth.
133 *
134 * r_true_t (input) double
135 * The trailing part of the truth.
136 *
137 * x (input) double*
138 *
139 * y (input) double*
140 *
141 * eps_int (input) double
142 * The internal machine precision.
143 *
144 * un_int (input) double
145 * The internal underflow threshold.
146 *
147 * test_ratio (output) float*
148 * The ratio of computed error for r over the error bound.
149 */
150 {
151 int i, ix, iy;
152 double eps_accurate, eps_out, tmp1, S, S1, S2, U;
153 double un_d, un_accurate, un_out;
154
155 /* Set the starting position */
156 ix = 0;
157 iy = 0;
158 if (incx < 0)
159 ix = -(n - 1) * incx;
160 if (incy < 0)
161 iy = -(n - 1) * incy;
162
163 /* computing S */
164 S = S1 = S2 = 0.;
165 for (i = 0; i < n; ++i) {
166 S += fabs(x[ix] * y[iy]);
167 S1 += fabs(x[ix]);
168 S2 += fabs(y[iy]);
169 ix += incx;
170 iy += incy;
171 }
172 S *= fabs(alpha);
173 S += fabs(beta * rin);
174
175 un_d = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
176 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
177 S = MAX(S, un_d);
178
179 eps_accurate = power(2, -BITS_E);
180 un_accurate = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra),
181 (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra));
182
183 eps_out = power(2, -BITS_D);
184 un_out = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
185 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
186 tmp1 = fabs((rout - r_true_l) - r_true_t);
187
188 /* underflow */
189 U = 2 * fabs(alpha) * n + 3;
190 U = MAX(U, S1 + 2 * n + 1);
191 U = MAX(U, S2 + 2 * n + 1) * (un_int + un_accurate) + un_out;
192
193 *test_ratio = tmp1 / ((n + 2) * (eps_int + eps_accurate) * S
194 + eps_out * fabs(r_true_l) + U);
195 } /* end of test_BLAS_ddot */
test_BLAS_cdot(int n,enum blas_conj_type conj,const void * alpha,const void * beta,const void * rin,const void * rout,double * r_true_l,double * r_true_t,void * x,int incx,void * y,int incy,double eps_int,double un_int,double * test_ratio)196 void test_BLAS_cdot(int n, enum blas_conj_type conj, const void *alpha,
197 const void *beta, const void *rin, const void *rout,
198 double *r_true_l, double *r_true_t, void *x, int incx,
199 void *y, int incy, double eps_int, double un_int,
200 double *test_ratio)
201
202 /* Purpose
203 * =======
204 *
205 * Computes ratio of the computed error from SDOT over the expected
206 * error bound.
207 *
208 * Arguments
209 * =========
210 *
211 * n (input) int
212 * The length of the vectors X and Y.
213 *
214 * conj (input) enum blas_conj_type
215 *
216 * alpha (input) const void*
217 *
218 * beta (input) const void*
219 *
220 * rin (input) const void*
221 *
222 * rout (input) const void*
223 * This result was computed by some other routine, and will be
224 * tested by this routine by comparing it with the truth.
225 *
226 * r_true_l (input) double*
227 * The leading part of the truth.
228 *
229 * r_true_t (input) double*
230 * The trailing part of the truth.
231 *
232 * x (input) void*
233 *
234 * y (input) void*
235 *
236 * eps_int (input) double
237 * The internal machine precision.
238 *
239 * un_int (input) double
240 * The internal underflow threshold.
241 *
242 * test_ratio (output) float*
243 * The ratio of computed error for r over the error bound.
244 */
245 {
246 int i, ix, iy;
247 double eps_accurate, eps_out, tmp1, S, S1, S2, U, prod[2], tmp[2];
248 double un_d, un_accurate, un_out;
249 float *x_i = (float *) x;
250 float *y_i = (float *) y;
251 float *alpha_i = (float *) alpha;
252 float *beta_i = (float *) beta;
253 float *rin_i = (float *) rin;
254 float *rout_i = (float *) rout;
255 float x_ii[2];
256 float y_ii[2];
257
258 /* Set the starting position */
259 incx *= 2;
260 incy *= 2;
261 ix = 0;
262 iy = 0;
263 if (incx < 0)
264 ix = -(n - 1) * incx;
265 if (incy < 0)
266 iy = -(n - 1) * incy;
267
268 /* computing S */
269 S = S1 = S2 = 0.;
270 for (i = 0; i < n; ++i) {
271 x_ii[0] = x_i[ix];
272 x_ii[1] = x_i[ix + 1];
273 y_ii[0] = y_i[iy];
274 y_ii[1] = y_i[iy + 1];
275 if (conj == blas_conj) {
276 x_ii[1] = -x_ii[1];
277 }
278 S1 += sqrt(x_ii[0] * x_ii[0] + x_ii[1] * x_ii[1]);
279 S2 += sqrt(y_ii[0] * y_ii[0] + y_ii[1] * y_ii[1]); {
280 prod[0] = x_ii[0] * y_ii[0] - x_ii[1] * y_ii[1];
281 prod[1] = x_ii[0] * y_ii[1] + x_ii[1] * y_ii[0];
282 }
283 /* prod = x[i]*y[i] */
284 S += sqrt(prod[0] * prod[0] + prod[1] * prod[1]);
285 ix += incx;
286 iy += incy;
287 }
288 S *= sqrt(alpha_i[0] * alpha_i[0] + alpha_i[1] * alpha_i[1]);
289 {
290 prod[0] = beta_i[0] * rin_i[0] - beta_i[1] * rin_i[1];
291 prod[1] = beta_i[0] * rin_i[1] + beta_i[1] * rin_i[0];
292 }
293
294 S += sqrt(prod[0] * prod[0] + prod[1] * prod[1]);
295
296 un_d = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
297 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
298 S = MAX(S, un_d);
299
300 eps_accurate = power(2, -BITS_E);
301 un_accurate = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra),
302 (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra));
303 eps_out = power(2, -BITS_S);
304 un_out = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_single),
305 (double) BLAS_fpinfo_x(blas_emin, blas_prec_single));
306 tmp[0] = (rout_i[0] - r_true_l[0]) - r_true_t[0];
307 tmp[1] = (rout_i[1] - r_true_l[1]) - r_true_t[1];
308 tmp1 = sqrt(tmp[0] * tmp[0] + tmp[1] * tmp[1]);
309
310 /* underflow */
311 U = 2 * sqrt(alpha_i[0] * alpha_i[0] + alpha_i[1] * alpha_i[1]) * n + 3;
312 U = MAX(U, S1 + 2 * n + 1);
313 U = MAX(U, S2 + 2 * n + 1) * (un_int + un_accurate) + un_out;
314 U *= 2 * sqrt(2.);
315
316 *test_ratio = tmp1 / (2 * sqrt(2.) * (n + 2) * (eps_int + eps_accurate) * S
317 +
318 sqrt(2.) * eps_out * sqrt(r_true_l[0] * r_true_l[0] +
319 r_true_l[1] * r_true_l[1]) +
320 U);
321 }
322
323 /* end of test_BLAS_cdot */
test_BLAS_zdot(int n,enum blas_conj_type conj,const void * alpha,const void * beta,const void * rin,const void * rout,double * r_true_l,double * r_true_t,void * x,int incx,void * y,int incy,double eps_int,double un_int,double * test_ratio)324 void test_BLAS_zdot(int n, enum blas_conj_type conj, const void *alpha,
325 const void *beta, const void *rin, const void *rout,
326 double *r_true_l, double *r_true_t, void *x, int incx,
327 void *y, int incy, double eps_int, double un_int,
328 double *test_ratio)
329
330 /* Purpose
331 * =======
332 *
333 * Computes ratio of the computed error from SDOT over the expected
334 * error bound.
335 *
336 * Arguments
337 * =========
338 *
339 * n (input) int
340 * The length of the vectors X and Y.
341 *
342 * conj (input) enum blas_conj_type
343 *
344 * alpha (input) const void*
345 *
346 * beta (input) const void*
347 *
348 * rin (input) const void*
349 *
350 * rout (input) const void*
351 * This result was computed by some other routine, and will be
352 * tested by this routine by comparing it with the truth.
353 *
354 * r_true_l (input) double*
355 * The leading part of the truth.
356 *
357 * r_true_t (input) double*
358 * The trailing part of the truth.
359 *
360 * x (input) void*
361 *
362 * y (input) void*
363 *
364 * eps_int (input) double
365 * The internal machine precision.
366 *
367 * un_int (input) double
368 * The internal underflow threshold.
369 *
370 * test_ratio (output) float*
371 * The ratio of computed error for r over the error bound.
372 */
373 {
374 int i, ix, iy;
375 double eps_accurate, eps_out, tmp1, S, S1, S2, U, prod[2], tmp[2];
376 double un_d, un_accurate, un_out;
377 double *x_i = (double *) x;
378 double *y_i = (double *) y;
379 double *alpha_i = (double *) alpha;
380 double *beta_i = (double *) beta;
381 double *rin_i = (double *) rin;
382 double *rout_i = (double *) rout;
383 double x_ii[2];
384 double y_ii[2];
385
386 /* Set the starting position */
387 incx *= 2;
388 incy *= 2;
389 ix = 0;
390 iy = 0;
391 if (incx < 0)
392 ix = -(n - 1) * incx;
393 if (incy < 0)
394 iy = -(n - 1) * incy;
395
396 /* computing S */
397 S = S1 = S2 = 0.;
398 for (i = 0; i < n; ++i) {
399 x_ii[0] = x_i[ix];
400 x_ii[1] = x_i[ix + 1];
401 y_ii[0] = y_i[iy];
402 y_ii[1] = y_i[iy + 1];
403 if (conj == blas_conj) {
404 x_ii[1] = -x_ii[1];
405 }
406 S1 += sqrt(x_ii[0] * x_ii[0] + x_ii[1] * x_ii[1]);
407 S2 += sqrt(y_ii[0] * y_ii[0] + y_ii[1] * y_ii[1]); {
408 prod[0] = (double) x_ii[0] * y_ii[0] - (double) x_ii[1] * y_ii[1];
409 prod[1] = (double) x_ii[0] * y_ii[1] + (double) x_ii[1] * y_ii[0];
410 } /* prod = x[i]*y[i] */
411 S += sqrt(prod[0] * prod[0] + prod[1] * prod[1]);
412 ix += incx;
413 iy += incy;
414 }
415 S *= sqrt(alpha_i[0] * alpha_i[0] + alpha_i[1] * alpha_i[1]);
416 {
417 prod[0] = (double) beta_i[0] * rin_i[0] - (double) beta_i[1] * rin_i[1];
418 prod[1] = (double) beta_i[0] * rin_i[1] + (double) beta_i[1] * rin_i[0];
419 }
420 S += sqrt(prod[0] * prod[0] + prod[1] * prod[1]);
421
422 un_d = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
423 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
424 S = MAX(S, un_d);
425
426 eps_accurate = power(2, -BITS_E);
427 un_accurate = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra),
428 (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra));
429 eps_out = power(2, -BITS_D);
430 un_out = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
431 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
432 tmp[0] = (rout_i[0] - r_true_l[0]) - r_true_t[0];
433 tmp[1] = (rout_i[1] - r_true_l[1]) - r_true_t[1];
434 tmp1 = sqrt(tmp[0] * tmp[0] + tmp[1] * tmp[1]);
435
436 /* underflow */
437 U = 2 * sqrt(alpha_i[0] * alpha_i[0] + alpha_i[1] * alpha_i[1]) * n + 3;
438 U = MAX(U, S1 + 2 * n + 1);
439 U = MAX(U, S2 + 2 * n + 1) * (un_int + un_accurate) + un_out;
440 U *= 2 * sqrt(2.);
441
442 *test_ratio = tmp1 / (2 * sqrt(2.) * (n + 2) * (eps_int + eps_accurate) * S
443 +
444 sqrt(2.) * eps_out * sqrt(r_true_l[0] * r_true_l[0] +
445 r_true_l[1] * r_true_l[1]) +
446 U);
447 }
448
449 /* end of test_BLAS_zdot */
test_BLAS_cdot_s_s(int n,enum blas_conj_type conj,const void * alpha,const void * beta,const void * rin,const void * rout,double * r_true_l,double * r_true_t,float * x,int incx,float * y,int incy,double eps_int,double un_int,double * test_ratio)450 void test_BLAS_cdot_s_s(int n, enum blas_conj_type conj, const void *alpha,
451 const void *beta, const void *rin, const void *rout,
452 double *r_true_l, double *r_true_t, float *x,
453 int incx, float *y, int incy, double eps_int,
454 double un_int, double *test_ratio)
455
456 /* Purpose
457 * =======
458 *
459 * Computes ratio of the computed error from SDOT over the expected
460 * error bound.
461 *
462 * Arguments
463 * =========
464 *
465 * n (input) int
466 * The length of the vectors X and Y.
467 *
468 * conj (input) enum blas_conj_type
469 *
470 * alpha (input) const void*
471 *
472 * beta (input) const void*
473 *
474 * rin (input) const void*
475 *
476 * rout (input) const void*
477 * This result was computed by some other routine, and will be
478 * tested by this routine by comparing it with the truth.
479 *
480 * r_true_l (input) double*
481 * The leading part of the truth.
482 *
483 * r_true_t (input) double*
484 * The trailing part of the truth.
485 *
486 * x (input) float*
487 *
488 * y (input) float*
489 *
490 * eps_int (input) double
491 * The internal machine precision.
492 *
493 * un_int (input) double
494 * The internal underflow threshold.
495 *
496 * test_ratio (output) float*
497 * The ratio of computed error for r over the error bound.
498 */
499 {
500 int i, ix, iy;
501 double eps_accurate, eps_out, tmp1, S, S1, S2, U, prod[2], tmp[2];
502 double un_d, un_accurate, un_out;
503 float *x_i = x;
504 float *y_i = y;
505 float *alpha_i = (float *) alpha;
506 float *beta_i = (float *) beta;
507 float *rin_i = (float *) rin;
508 float *rout_i = (float *) rout;
509 float x_ii;
510 float y_ii;
511
512 /* Set the starting position */
513
514
515 ix = 0;
516 iy = 0;
517 if (incx < 0)
518 ix = -(n - 1) * incx;
519 if (incy < 0)
520 iy = -(n - 1) * incy;
521
522 /* computing S */
523 S = S1 = S2 = 0.;
524 for (i = 0; i < n; ++i) {
525 x_ii = x_i[ix];
526 y_ii = y_i[iy];
527 S1 += fabs(x_ii);
528 S2 += fabs(y_ii);
529 prod[0] = x_ii * y_ii;
530 prod[1] = 0.0; /* prod = x[i]*y[i] */
531 S += sqrt(prod[0] * prod[0] + prod[1] * prod[1]);
532 ix += incx;
533 iy += incy;
534 }
535 S *= sqrt(alpha_i[0] * alpha_i[0] + alpha_i[1] * alpha_i[1]);
536 {
537 prod[0] = beta_i[0] * rin_i[0] - beta_i[1] * rin_i[1];
538 prod[1] = beta_i[0] * rin_i[1] + beta_i[1] * rin_i[0];
539 }
540
541 S += sqrt(prod[0] * prod[0] + prod[1] * prod[1]);
542
543 un_d = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
544 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
545 S = MAX(S, un_d);
546
547 eps_accurate = power(2, -BITS_E);
548 un_accurate = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra),
549 (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra));
550 eps_out = power(2, -BITS_S);
551 un_out = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_single),
552 (double) BLAS_fpinfo_x(blas_emin, blas_prec_single));
553 tmp[0] = (rout_i[0] - r_true_l[0]) - r_true_t[0];
554 tmp[1] = (rout_i[1] - r_true_l[1]) - r_true_t[1];
555 tmp1 = sqrt(tmp[0] * tmp[0] + tmp[1] * tmp[1]);
556
557 /* underflow */
558 U = 2 * sqrt(alpha_i[0] * alpha_i[0] + alpha_i[1] * alpha_i[1]) * n + 3;
559 U = MAX(U, S1 + 2 * n + 1);
560 U = MAX(U, S2 + 2 * n + 1) * (un_int + un_accurate) + un_out;
561 U *= 2 * sqrt(2.);
562
563 *test_ratio = tmp1 / (2 * sqrt(2.) * (n + 2) * (eps_int + eps_accurate) * S
564 +
565 sqrt(2.) * eps_out * sqrt(r_true_l[0] * r_true_l[0] +
566 r_true_l[1] * r_true_l[1]) +
567 U);
568 }
569
570 /* end of test_BLAS_cdot_s_s */
test_BLAS_cdot_s_c(int n,enum blas_conj_type conj,const void * alpha,const void * beta,const void * rin,const void * rout,double * r_true_l,double * r_true_t,float * x,int incx,void * y,int incy,double eps_int,double un_int,double * test_ratio)571 void test_BLAS_cdot_s_c(int n, enum blas_conj_type conj, const void *alpha,
572 const void *beta, const void *rin, const void *rout,
573 double *r_true_l, double *r_true_t, float *x,
574 int incx, void *y, int incy, double eps_int,
575 double un_int, double *test_ratio)
576
577 /* Purpose
578 * =======
579 *
580 * Computes ratio of the computed error from SDOT over the expected
581 * error bound.
582 *
583 * Arguments
584 * =========
585 *
586 * n (input) int
587 * The length of the vectors X and Y.
588 *
589 * conj (input) enum blas_conj_type
590 *
591 * alpha (input) const void*
592 *
593 * beta (input) const void*
594 *
595 * rin (input) const void*
596 *
597 * rout (input) const void*
598 * This result was computed by some other routine, and will be
599 * tested by this routine by comparing it with the truth.
600 *
601 * r_true_l (input) double*
602 * The leading part of the truth.
603 *
604 * r_true_t (input) double*
605 * The trailing part of the truth.
606 *
607 * x (input) float*
608 *
609 * y (input) void*
610 *
611 * eps_int (input) double
612 * The internal machine precision.
613 *
614 * un_int (input) double
615 * The internal underflow threshold.
616 *
617 * test_ratio (output) float*
618 * The ratio of computed error for r over the error bound.
619 */
620 {
621 int i, ix, iy;
622 double eps_accurate, eps_out, tmp1, S, S1, S2, U, prod[2], tmp[2];
623 double un_d, un_accurate, un_out;
624 float *x_i = x;
625 float *y_i = (float *) y;
626 float *alpha_i = (float *) alpha;
627 float *beta_i = (float *) beta;
628 float *rin_i = (float *) rin;
629 float *rout_i = (float *) rout;
630 float x_ii;
631 float y_ii[2];
632
633 /* Set the starting position */
634
635 incy *= 2;
636 ix = 0;
637 iy = 0;
638 if (incx < 0)
639 ix = -(n - 1) * incx;
640 if (incy < 0)
641 iy = -(n - 1) * incy;
642
643 /* computing S */
644 S = S1 = S2 = 0.;
645 for (i = 0; i < n; ++i) {
646 x_ii = x_i[ix];
647 y_ii[0] = y_i[iy];
648 y_ii[1] = y_i[iy + 1];
649 S1 += fabs(x_ii);
650 S2 += sqrt(y_ii[0] * y_ii[0] + y_ii[1] * y_ii[1]); {
651 prod[0] = y_ii[0] * x_ii;
652 prod[1] = y_ii[1] * x_ii;
653 } /* prod = x[i]*y[i] */
654 S += sqrt(prod[0] * prod[0] + prod[1] * prod[1]);
655 ix += incx;
656 iy += incy;
657 }
658 S *= sqrt(alpha_i[0] * alpha_i[0] + alpha_i[1] * alpha_i[1]);
659 {
660 prod[0] = beta_i[0] * rin_i[0] - beta_i[1] * rin_i[1];
661 prod[1] = beta_i[0] * rin_i[1] + beta_i[1] * rin_i[0];
662 }
663
664 S += sqrt(prod[0] * prod[0] + prod[1] * prod[1]);
665
666 un_d = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
667 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
668 S = MAX(S, un_d);
669
670 eps_accurate = power(2, -BITS_E);
671 un_accurate = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra),
672 (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra));
673 eps_out = power(2, -BITS_S);
674 un_out = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_single),
675 (double) BLAS_fpinfo_x(blas_emin, blas_prec_single));
676 tmp[0] = (rout_i[0] - r_true_l[0]) - r_true_t[0];
677 tmp[1] = (rout_i[1] - r_true_l[1]) - r_true_t[1];
678 tmp1 = sqrt(tmp[0] * tmp[0] + tmp[1] * tmp[1]);
679
680 /* underflow */
681 U = 2 * sqrt(alpha_i[0] * alpha_i[0] + alpha_i[1] * alpha_i[1]) * n + 3;
682 U = MAX(U, S1 + 2 * n + 1);
683 U = MAX(U, S2 + 2 * n + 1) * (un_int + un_accurate) + un_out;
684 U *= 2 * sqrt(2.);
685
686 *test_ratio = tmp1 / (2 * sqrt(2.) * (n + 2) * (eps_int + eps_accurate) * S
687 +
688 sqrt(2.) * eps_out * sqrt(r_true_l[0] * r_true_l[0] +
689 r_true_l[1] * r_true_l[1]) +
690 U);
691 }
692
693 /* end of test_BLAS_cdot_s_c */
test_BLAS_cdot_c_s(int n,enum blas_conj_type conj,const void * alpha,const void * beta,const void * rin,const void * rout,double * r_true_l,double * r_true_t,void * x,int incx,float * y,int incy,double eps_int,double un_int,double * test_ratio)694 void test_BLAS_cdot_c_s(int n, enum blas_conj_type conj, const void *alpha,
695 const void *beta, const void *rin, const void *rout,
696 double *r_true_l, double *r_true_t, void *x, int incx,
697 float *y, int incy, double eps_int, double un_int,
698 double *test_ratio)
699
700 /* Purpose
701 * =======
702 *
703 * Computes ratio of the computed error from SDOT over the expected
704 * error bound.
705 *
706 * Arguments
707 * =========
708 *
709 * n (input) int
710 * The length of the vectors X and Y.
711 *
712 * conj (input) enum blas_conj_type
713 *
714 * alpha (input) const void*
715 *
716 * beta (input) const void*
717 *
718 * rin (input) const void*
719 *
720 * rout (input) const void*
721 * This result was computed by some other routine, and will be
722 * tested by this routine by comparing it with the truth.
723 *
724 * r_true_l (input) double*
725 * The leading part of the truth.
726 *
727 * r_true_t (input) double*
728 * The trailing part of the truth.
729 *
730 * x (input) void*
731 *
732 * y (input) float*
733 *
734 * eps_int (input) double
735 * The internal machine precision.
736 *
737 * un_int (input) double
738 * The internal underflow threshold.
739 *
740 * test_ratio (output) float*
741 * The ratio of computed error for r over the error bound.
742 */
743 {
744 int i, ix, iy;
745 double eps_accurate, eps_out, tmp1, S, S1, S2, U, prod[2], tmp[2];
746 double un_d, un_accurate, un_out;
747 float *x_i = (float *) x;
748 float *y_i = y;
749 float *alpha_i = (float *) alpha;
750 float *beta_i = (float *) beta;
751 float *rin_i = (float *) rin;
752 float *rout_i = (float *) rout;
753 float x_ii[2];
754 float y_ii;
755
756 /* Set the starting position */
757 incx *= 2;
758
759 ix = 0;
760 iy = 0;
761 if (incx < 0)
762 ix = -(n - 1) * incx;
763 if (incy < 0)
764 iy = -(n - 1) * incy;
765
766 /* computing S */
767 S = S1 = S2 = 0.;
768 for (i = 0; i < n; ++i) {
769 x_ii[0] = x_i[ix];
770 x_ii[1] = x_i[ix + 1];
771 y_ii = y_i[iy];
772 if (conj == blas_conj) {
773 x_ii[1] = -x_ii[1];
774 }
775 S1 += sqrt(x_ii[0] * x_ii[0] + x_ii[1] * x_ii[1]);
776 S2 += fabs(y_ii); {
777 prod[0] = x_ii[0] * y_ii;
778 prod[1] = x_ii[1] * y_ii;
779 } /* prod = x[i]*y[i] */
780 S += sqrt(prod[0] * prod[0] + prod[1] * prod[1]);
781 ix += incx;
782 iy += incy;
783 }
784 S *= sqrt(alpha_i[0] * alpha_i[0] + alpha_i[1] * alpha_i[1]);
785 {
786 prod[0] = beta_i[0] * rin_i[0] - beta_i[1] * rin_i[1];
787 prod[1] = beta_i[0] * rin_i[1] + beta_i[1] * rin_i[0];
788 }
789
790 S += sqrt(prod[0] * prod[0] + prod[1] * prod[1]);
791
792 un_d = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
793 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
794 S = MAX(S, un_d);
795
796 eps_accurate = power(2, -BITS_E);
797 un_accurate = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra),
798 (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra));
799 eps_out = power(2, -BITS_S);
800 un_out = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_single),
801 (double) BLAS_fpinfo_x(blas_emin, blas_prec_single));
802 tmp[0] = (rout_i[0] - r_true_l[0]) - r_true_t[0];
803 tmp[1] = (rout_i[1] - r_true_l[1]) - r_true_t[1];
804 tmp1 = sqrt(tmp[0] * tmp[0] + tmp[1] * tmp[1]);
805
806 /* underflow */
807 U = 2 * sqrt(alpha_i[0] * alpha_i[0] + alpha_i[1] * alpha_i[1]) * n + 3;
808 U = MAX(U, S1 + 2 * n + 1);
809 U = MAX(U, S2 + 2 * n + 1) * (un_int + un_accurate) + un_out;
810 U *= 2 * sqrt(2.);
811
812 *test_ratio = tmp1 / (2 * sqrt(2.) * (n + 2) * (eps_int + eps_accurate) * S
813 +
814 sqrt(2.) * eps_out * sqrt(r_true_l[0] * r_true_l[0] +
815 r_true_l[1] * r_true_l[1]) +
816 U);
817 }
818
819 /* end of test_BLAS_cdot_c_s */
test_BLAS_zdot_d_d(int n,enum blas_conj_type conj,const void * alpha,const void * beta,const void * rin,const void * rout,double * r_true_l,double * r_true_t,double * x,int incx,double * y,int incy,double eps_int,double un_int,double * test_ratio)820 void test_BLAS_zdot_d_d(int n, enum blas_conj_type conj, const void *alpha,
821 const void *beta, const void *rin, const void *rout,
822 double *r_true_l, double *r_true_t, double *x,
823 int incx, double *y, int incy, double eps_int,
824 double un_int, double *test_ratio)
825
826 /* Purpose
827 * =======
828 *
829 * Computes ratio of the computed error from SDOT over the expected
830 * error bound.
831 *
832 * Arguments
833 * =========
834 *
835 * n (input) int
836 * The length of the vectors X and Y.
837 *
838 * conj (input) enum blas_conj_type
839 *
840 * alpha (input) const void*
841 *
842 * beta (input) const void*
843 *
844 * rin (input) const void*
845 *
846 * rout (input) const void*
847 * This result was computed by some other routine, and will be
848 * tested by this routine by comparing it with the truth.
849 *
850 * r_true_l (input) double*
851 * The leading part of the truth.
852 *
853 * r_true_t (input) double*
854 * The trailing part of the truth.
855 *
856 * x (input) double*
857 *
858 * y (input) double*
859 *
860 * eps_int (input) double
861 * The internal machine precision.
862 *
863 * un_int (input) double
864 * The internal underflow threshold.
865 *
866 * test_ratio (output) float*
867 * The ratio of computed error for r over the error bound.
868 */
869 {
870 int i, ix, iy;
871 double eps_accurate, eps_out, tmp1, S, S1, S2, U, prod[2], tmp[2];
872 double un_d, un_accurate, un_out;
873 double *x_i = x;
874 double *y_i = y;
875 double *alpha_i = (double *) alpha;
876 double *beta_i = (double *) beta;
877 double *rin_i = (double *) rin;
878 double *rout_i = (double *) rout;
879 double x_ii;
880 double y_ii;
881
882 /* Set the starting position */
883
884
885 ix = 0;
886 iy = 0;
887 if (incx < 0)
888 ix = -(n - 1) * incx;
889 if (incy < 0)
890 iy = -(n - 1) * incy;
891
892 /* computing S */
893 S = S1 = S2 = 0.;
894 for (i = 0; i < n; ++i) {
895 x_ii = x_i[ix];
896 y_ii = y_i[iy];
897 S1 += fabs(x_ii);
898 S2 += fabs(y_ii);
899 prod[0] = x_ii * y_ii;
900 prod[1] = 0.0; /* prod = x[i]*y[i] */
901 S += sqrt(prod[0] * prod[0] + prod[1] * prod[1]);
902 ix += incx;
903 iy += incy;
904 }
905 S *= sqrt(alpha_i[0] * alpha_i[0] + alpha_i[1] * alpha_i[1]);
906 {
907 prod[0] = (double) beta_i[0] * rin_i[0] - (double) beta_i[1] * rin_i[1];
908 prod[1] = (double) beta_i[0] * rin_i[1] + (double) beta_i[1] * rin_i[0];
909 }
910 S += sqrt(prod[0] * prod[0] + prod[1] * prod[1]);
911
912 un_d = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
913 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
914 S = MAX(S, un_d);
915
916 eps_accurate = power(2, -BITS_E);
917 un_accurate = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra),
918 (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra));
919 eps_out = power(2, -BITS_D);
920 un_out = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
921 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
922 tmp[0] = (rout_i[0] - r_true_l[0]) - r_true_t[0];
923 tmp[1] = (rout_i[1] - r_true_l[1]) - r_true_t[1];
924 tmp1 = sqrt(tmp[0] * tmp[0] + tmp[1] * tmp[1]);
925
926 /* underflow */
927 U = 2 * sqrt(alpha_i[0] * alpha_i[0] + alpha_i[1] * alpha_i[1]) * n + 3;
928 U = MAX(U, S1 + 2 * n + 1);
929 U = MAX(U, S2 + 2 * n + 1) * (un_int + un_accurate) + un_out;
930 U *= 2 * sqrt(2.);
931
932 *test_ratio = tmp1 / (2 * sqrt(2.) * (n + 2) * (eps_int + eps_accurate) * S
933 +
934 sqrt(2.) * eps_out * sqrt(r_true_l[0] * r_true_l[0] +
935 r_true_l[1] * r_true_l[1]) +
936 U);
937 }
938
939 /* end of test_BLAS_zdot_d_d */
test_BLAS_zdot_d_z(int n,enum blas_conj_type conj,const void * alpha,const void * beta,const void * rin,const void * rout,double * r_true_l,double * r_true_t,double * x,int incx,void * y,int incy,double eps_int,double un_int,double * test_ratio)940 void test_BLAS_zdot_d_z(int n, enum blas_conj_type conj, const void *alpha,
941 const void *beta, const void *rin, const void *rout,
942 double *r_true_l, double *r_true_t, double *x,
943 int incx, void *y, int incy, double eps_int,
944 double un_int, double *test_ratio)
945
946 /* Purpose
947 * =======
948 *
949 * Computes ratio of the computed error from SDOT over the expected
950 * error bound.
951 *
952 * Arguments
953 * =========
954 *
955 * n (input) int
956 * The length of the vectors X and Y.
957 *
958 * conj (input) enum blas_conj_type
959 *
960 * alpha (input) const void*
961 *
962 * beta (input) const void*
963 *
964 * rin (input) const void*
965 *
966 * rout (input) const void*
967 * This result was computed by some other routine, and will be
968 * tested by this routine by comparing it with the truth.
969 *
970 * r_true_l (input) double*
971 * The leading part of the truth.
972 *
973 * r_true_t (input) double*
974 * The trailing part of the truth.
975 *
976 * x (input) double*
977 *
978 * y (input) void*
979 *
980 * eps_int (input) double
981 * The internal machine precision.
982 *
983 * un_int (input) double
984 * The internal underflow threshold.
985 *
986 * test_ratio (output) float*
987 * The ratio of computed error for r over the error bound.
988 */
989 {
990 int i, ix, iy;
991 double eps_accurate, eps_out, tmp1, S, S1, S2, U, prod[2], tmp[2];
992 double un_d, un_accurate, un_out;
993 double *x_i = x;
994 double *y_i = (double *) y;
995 double *alpha_i = (double *) alpha;
996 double *beta_i = (double *) beta;
997 double *rin_i = (double *) rin;
998 double *rout_i = (double *) rout;
999 double x_ii;
1000 double y_ii[2];
1001
1002 /* Set the starting position */
1003
1004 incy *= 2;
1005 ix = 0;
1006 iy = 0;
1007 if (incx < 0)
1008 ix = -(n - 1) * incx;
1009 if (incy < 0)
1010 iy = -(n - 1) * incy;
1011
1012 /* computing S */
1013 S = S1 = S2 = 0.;
1014 for (i = 0; i < n; ++i) {
1015 x_ii = x_i[ix];
1016 y_ii[0] = y_i[iy];
1017 y_ii[1] = y_i[iy + 1];
1018 S1 += fabs(x_ii);
1019 S2 += sqrt(y_ii[0] * y_ii[0] + y_ii[1] * y_ii[1]); {
1020 prod[0] = y_ii[0] * x_ii;
1021 prod[1] = y_ii[1] * x_ii;
1022 } /* prod = x[i]*y[i] */
1023 S += sqrt(prod[0] * prod[0] + prod[1] * prod[1]);
1024 ix += incx;
1025 iy += incy;
1026 }
1027 S *= sqrt(alpha_i[0] * alpha_i[0] + alpha_i[1] * alpha_i[1]);
1028 {
1029 prod[0] = (double) beta_i[0] * rin_i[0] - (double) beta_i[1] * rin_i[1];
1030 prod[1] = (double) beta_i[0] * rin_i[1] + (double) beta_i[1] * rin_i[0];
1031 }
1032 S += sqrt(prod[0] * prod[0] + prod[1] * prod[1]);
1033
1034 un_d = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
1035 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
1036 S = MAX(S, un_d);
1037
1038 eps_accurate = power(2, -BITS_E);
1039 un_accurate = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra),
1040 (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra));
1041 eps_out = power(2, -BITS_D);
1042 un_out = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
1043 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
1044 tmp[0] = (rout_i[0] - r_true_l[0]) - r_true_t[0];
1045 tmp[1] = (rout_i[1] - r_true_l[1]) - r_true_t[1];
1046 tmp1 = sqrt(tmp[0] * tmp[0] + tmp[1] * tmp[1]);
1047
1048 /* underflow */
1049 U = 2 * sqrt(alpha_i[0] * alpha_i[0] + alpha_i[1] * alpha_i[1]) * n + 3;
1050 U = MAX(U, S1 + 2 * n + 1);
1051 U = MAX(U, S2 + 2 * n + 1) * (un_int + un_accurate) + un_out;
1052 U *= 2 * sqrt(2.);
1053
1054 *test_ratio = tmp1 / (2 * sqrt(2.) * (n + 2) * (eps_int + eps_accurate) * S
1055 +
1056 sqrt(2.) * eps_out * sqrt(r_true_l[0] * r_true_l[0] +
1057 r_true_l[1] * r_true_l[1]) +
1058 U);
1059 }
1060
1061 /* end of test_BLAS_zdot_d_z */
test_BLAS_zdot_z_d(int n,enum blas_conj_type conj,const void * alpha,const void * beta,const void * rin,const void * rout,double * r_true_l,double * r_true_t,void * x,int incx,double * y,int incy,double eps_int,double un_int,double * test_ratio)1062 void test_BLAS_zdot_z_d(int n, enum blas_conj_type conj, const void *alpha,
1063 const void *beta, const void *rin, const void *rout,
1064 double *r_true_l, double *r_true_t, void *x, int incx,
1065 double *y, int incy, double eps_int, double un_int,
1066 double *test_ratio)
1067
1068 /* Purpose
1069 * =======
1070 *
1071 * Computes ratio of the computed error from SDOT over the expected
1072 * error bound.
1073 *
1074 * Arguments
1075 * =========
1076 *
1077 * n (input) int
1078 * The length of the vectors X and Y.
1079 *
1080 * conj (input) enum blas_conj_type
1081 *
1082 * alpha (input) const void*
1083 *
1084 * beta (input) const void*
1085 *
1086 * rin (input) const void*
1087 *
1088 * rout (input) const void*
1089 * This result was computed by some other routine, and will be
1090 * tested by this routine by comparing it with the truth.
1091 *
1092 * r_true_l (input) double*
1093 * The leading part of the truth.
1094 *
1095 * r_true_t (input) double*
1096 * The trailing part of the truth.
1097 *
1098 * x (input) void*
1099 *
1100 * y (input) double*
1101 *
1102 * eps_int (input) double
1103 * The internal machine precision.
1104 *
1105 * un_int (input) double
1106 * The internal underflow threshold.
1107 *
1108 * test_ratio (output) float*
1109 * The ratio of computed error for r over the error bound.
1110 */
1111 {
1112 int i, ix, iy;
1113 double eps_accurate, eps_out, tmp1, S, S1, S2, U, prod[2], tmp[2];
1114 double un_d, un_accurate, un_out;
1115 double *x_i = (double *) x;
1116 double *y_i = y;
1117 double *alpha_i = (double *) alpha;
1118 double *beta_i = (double *) beta;
1119 double *rin_i = (double *) rin;
1120 double *rout_i = (double *) rout;
1121 double x_ii[2];
1122 double y_ii;
1123
1124 /* Set the starting position */
1125 incx *= 2;
1126
1127 ix = 0;
1128 iy = 0;
1129 if (incx < 0)
1130 ix = -(n - 1) * incx;
1131 if (incy < 0)
1132 iy = -(n - 1) * incy;
1133
1134 /* computing S */
1135 S = S1 = S2 = 0.;
1136 for (i = 0; i < n; ++i) {
1137 x_ii[0] = x_i[ix];
1138 x_ii[1] = x_i[ix + 1];
1139 y_ii = y_i[iy];
1140 if (conj == blas_conj) {
1141 x_ii[1] = -x_ii[1];
1142 }
1143 S1 += sqrt(x_ii[0] * x_ii[0] + x_ii[1] * x_ii[1]);
1144 S2 += fabs(y_ii); {
1145 prod[0] = x_ii[0] * y_ii;
1146 prod[1] = x_ii[1] * y_ii;
1147 } /* prod = x[i]*y[i] */
1148 S += sqrt(prod[0] * prod[0] + prod[1] * prod[1]);
1149 ix += incx;
1150 iy += incy;
1151 }
1152 S *= sqrt(alpha_i[0] * alpha_i[0] + alpha_i[1] * alpha_i[1]);
1153 {
1154 prod[0] = (double) beta_i[0] * rin_i[0] - (double) beta_i[1] * rin_i[1];
1155 prod[1] = (double) beta_i[0] * rin_i[1] + (double) beta_i[1] * rin_i[0];
1156 }
1157 S += sqrt(prod[0] * prod[0] + prod[1] * prod[1]);
1158
1159 un_d = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
1160 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
1161 S = MAX(S, un_d);
1162
1163 eps_accurate = power(2, -BITS_E);
1164 un_accurate = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra),
1165 (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra));
1166 eps_out = power(2, -BITS_D);
1167 un_out = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
1168 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
1169 tmp[0] = (rout_i[0] - r_true_l[0]) - r_true_t[0];
1170 tmp[1] = (rout_i[1] - r_true_l[1]) - r_true_t[1];
1171 tmp1 = sqrt(tmp[0] * tmp[0] + tmp[1] * tmp[1]);
1172
1173 /* underflow */
1174 U = 2 * sqrt(alpha_i[0] * alpha_i[0] + alpha_i[1] * alpha_i[1]) * n + 3;
1175 U = MAX(U, S1 + 2 * n + 1);
1176 U = MAX(U, S2 + 2 * n + 1) * (un_int + un_accurate) + un_out;
1177 U *= 2 * sqrt(2.);
1178
1179 *test_ratio = tmp1 / (2 * sqrt(2.) * (n + 2) * (eps_int + eps_accurate) * S
1180 +
1181 sqrt(2.) * eps_out * sqrt(r_true_l[0] * r_true_l[0] +
1182 r_true_l[1] * r_true_l[1]) +
1183 U);
1184 }
1185
1186 /* end of test_BLAS_zdot_z_d */
test_BLAS_ddot_s_s(int n,enum blas_conj_type conj,double alpha,double beta,double rin,double rout,double r_true_l,double r_true_t,float * x,int incx,float * y,int incy,double eps_int,double un_int,double * test_ratio)1187 void test_BLAS_ddot_s_s(int n, enum blas_conj_type conj, double alpha,
1188 double beta, double rin, double rout, double r_true_l,
1189 double r_true_t, float *x, int incx, float *y,
1190 int incy, double eps_int, double un_int,
1191 double *test_ratio)
1192
1193 /* Purpose
1194 * =======
1195 *
1196 * Computes ratio of the computed error from SDOT over the expected
1197 * error bound.
1198 *
1199 * Arguments
1200 * =========
1201 *
1202 * n (input) int
1203 * The length of the vectors X and Y.
1204 *
1205 * conj (input) enum blas_conj_type
1206 *
1207 * alpha (input) double
1208 *
1209 * beta (input) double
1210 *
1211 * rin (input) double
1212 *
1213 * rout (input) double
1214 * This result was computed by some other routine, and will be
1215 * tested by this routine by comparing it with the truth.
1216 *
1217 * r_true_l (input) double
1218 * The leading part of the truth.
1219 *
1220 * r_true_t (input) double
1221 * The trailing part of the truth.
1222 *
1223 * x (input) float*
1224 *
1225 * y (input) float*
1226 *
1227 * eps_int (input) double
1228 * The internal machine precision.
1229 *
1230 * un_int (input) double
1231 * The internal underflow threshold.
1232 *
1233 * test_ratio (output) float*
1234 * The ratio of computed error for r over the error bound.
1235 */
1236 {
1237 int i, ix, iy;
1238 double eps_accurate, eps_out, tmp1, S, S1, S2, U;
1239 double un_d, un_accurate, un_out;
1240
1241 /* Set the starting position */
1242 ix = 0;
1243 iy = 0;
1244 if (incx < 0)
1245 ix = -(n - 1) * incx;
1246 if (incy < 0)
1247 iy = -(n - 1) * incy;
1248
1249 /* computing S */
1250 S = S1 = S2 = 0.;
1251 for (i = 0; i < n; ++i) {
1252 S += fabs(x[ix] * y[iy]);
1253 S1 += fabs(x[ix]);
1254 S2 += fabs(y[iy]);
1255 ix += incx;
1256 iy += incy;
1257 }
1258 S *= fabs(alpha);
1259 S += fabs(beta * rin);
1260
1261 un_d = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
1262 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
1263 S = MAX(S, un_d);
1264
1265 eps_accurate = power(2, -BITS_E);
1266 un_accurate = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra),
1267 (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra));
1268
1269 eps_out = power(2, -BITS_D);
1270 un_out = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
1271 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
1272 tmp1 = fabs((rout - r_true_l) - r_true_t);
1273
1274 /* underflow */
1275 U = 2 * fabs(alpha) * n + 3;
1276 U = MAX(U, S1 + 2 * n + 1);
1277 U = MAX(U, S2 + 2 * n + 1) * (un_int + un_accurate) + un_out;
1278
1279 *test_ratio = tmp1 / ((n + 2) * (eps_int + eps_accurate) * S
1280 + eps_out * fabs(r_true_l) + U);
1281 } /* end of test_BLAS_ddot_s_s */
test_BLAS_ddot_s_d(int n,enum blas_conj_type conj,double alpha,double beta,double rin,double rout,double r_true_l,double r_true_t,float * x,int incx,double * y,int incy,double eps_int,double un_int,double * test_ratio)1282 void test_BLAS_ddot_s_d(int n, enum blas_conj_type conj, double alpha,
1283 double beta, double rin, double rout, double r_true_l,
1284 double r_true_t, float *x, int incx, double *y,
1285 int incy, double eps_int, double un_int,
1286 double *test_ratio)
1287
1288 /* Purpose
1289 * =======
1290 *
1291 * Computes ratio of the computed error from SDOT over the expected
1292 * error bound.
1293 *
1294 * Arguments
1295 * =========
1296 *
1297 * n (input) int
1298 * The length of the vectors X and Y.
1299 *
1300 * conj (input) enum blas_conj_type
1301 *
1302 * alpha (input) double
1303 *
1304 * beta (input) double
1305 *
1306 * rin (input) double
1307 *
1308 * rout (input) double
1309 * This result was computed by some other routine, and will be
1310 * tested by this routine by comparing it with the truth.
1311 *
1312 * r_true_l (input) double
1313 * The leading part of the truth.
1314 *
1315 * r_true_t (input) double
1316 * The trailing part of the truth.
1317 *
1318 * x (input) float*
1319 *
1320 * y (input) double*
1321 *
1322 * eps_int (input) double
1323 * The internal machine precision.
1324 *
1325 * un_int (input) double
1326 * The internal underflow threshold.
1327 *
1328 * test_ratio (output) float*
1329 * The ratio of computed error for r over the error bound.
1330 */
1331 {
1332 int i, ix, iy;
1333 double eps_accurate, eps_out, tmp1, S, S1, S2, U;
1334 double un_d, un_accurate, un_out;
1335
1336 /* Set the starting position */
1337 ix = 0;
1338 iy = 0;
1339 if (incx < 0)
1340 ix = -(n - 1) * incx;
1341 if (incy < 0)
1342 iy = -(n - 1) * incy;
1343
1344 /* computing S */
1345 S = S1 = S2 = 0.;
1346 for (i = 0; i < n; ++i) {
1347 S += fabs(x[ix] * y[iy]);
1348 S1 += fabs(x[ix]);
1349 S2 += fabs(y[iy]);
1350 ix += incx;
1351 iy += incy;
1352 }
1353 S *= fabs(alpha);
1354 S += fabs(beta * rin);
1355
1356 un_d = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
1357 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
1358 S = MAX(S, un_d);
1359
1360 eps_accurate = power(2, -BITS_E);
1361 un_accurate = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra),
1362 (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra));
1363
1364 eps_out = power(2, -BITS_D);
1365 un_out = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
1366 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
1367 tmp1 = fabs((rout - r_true_l) - r_true_t);
1368
1369 /* underflow */
1370 U = 2 * fabs(alpha) * n + 3;
1371 U = MAX(U, S1 + 2 * n + 1);
1372 U = MAX(U, S2 + 2 * n + 1) * (un_int + un_accurate) + un_out;
1373
1374 *test_ratio = tmp1 / ((n + 2) * (eps_int + eps_accurate) * S
1375 + eps_out * fabs(r_true_l) + U);
1376 } /* end of test_BLAS_ddot_s_d */
test_BLAS_ddot_d_s(int n,enum blas_conj_type conj,double alpha,double beta,double rin,double rout,double r_true_l,double r_true_t,double * x,int incx,float * y,int incy,double eps_int,double un_int,double * test_ratio)1377 void test_BLAS_ddot_d_s(int n, enum blas_conj_type conj, double alpha,
1378 double beta, double rin, double rout, double r_true_l,
1379 double r_true_t, double *x, int incx, float *y,
1380 int incy, double eps_int, double un_int,
1381 double *test_ratio)
1382
1383 /* Purpose
1384 * =======
1385 *
1386 * Computes ratio of the computed error from SDOT over the expected
1387 * error bound.
1388 *
1389 * Arguments
1390 * =========
1391 *
1392 * n (input) int
1393 * The length of the vectors X and Y.
1394 *
1395 * conj (input) enum blas_conj_type
1396 *
1397 * alpha (input) double
1398 *
1399 * beta (input) double
1400 *
1401 * rin (input) double
1402 *
1403 * rout (input) double
1404 * This result was computed by some other routine, and will be
1405 * tested by this routine by comparing it with the truth.
1406 *
1407 * r_true_l (input) double
1408 * The leading part of the truth.
1409 *
1410 * r_true_t (input) double
1411 * The trailing part of the truth.
1412 *
1413 * x (input) double*
1414 *
1415 * y (input) float*
1416 *
1417 * eps_int (input) double
1418 * The internal machine precision.
1419 *
1420 * un_int (input) double
1421 * The internal underflow threshold.
1422 *
1423 * test_ratio (output) float*
1424 * The ratio of computed error for r over the error bound.
1425 */
1426 {
1427 int i, ix, iy;
1428 double eps_accurate, eps_out, tmp1, S, S1, S2, U;
1429 double un_d, un_accurate, un_out;
1430
1431 /* Set the starting position */
1432 ix = 0;
1433 iy = 0;
1434 if (incx < 0)
1435 ix = -(n - 1) * incx;
1436 if (incy < 0)
1437 iy = -(n - 1) * incy;
1438
1439 /* computing S */
1440 S = S1 = S2 = 0.;
1441 for (i = 0; i < n; ++i) {
1442 S += fabs(x[ix] * y[iy]);
1443 S1 += fabs(x[ix]);
1444 S2 += fabs(y[iy]);
1445 ix += incx;
1446 iy += incy;
1447 }
1448 S *= fabs(alpha);
1449 S += fabs(beta * rin);
1450
1451 un_d = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
1452 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
1453 S = MAX(S, un_d);
1454
1455 eps_accurate = power(2, -BITS_E);
1456 un_accurate = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra),
1457 (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra));
1458
1459 eps_out = power(2, -BITS_D);
1460 un_out = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
1461 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
1462 tmp1 = fabs((rout - r_true_l) - r_true_t);
1463
1464 /* underflow */
1465 U = 2 * fabs(alpha) * n + 3;
1466 U = MAX(U, S1 + 2 * n + 1);
1467 U = MAX(U, S2 + 2 * n + 1) * (un_int + un_accurate) + un_out;
1468
1469 *test_ratio = tmp1 / ((n + 2) * (eps_int + eps_accurate) * S
1470 + eps_out * fabs(r_true_l) + U);
1471 } /* end of test_BLAS_ddot_d_s */
test_BLAS_zdot_c_c(int n,enum blas_conj_type conj,const void * alpha,const void * beta,const void * rin,const void * rout,double * r_true_l,double * r_true_t,void * x,int incx,void * y,int incy,double eps_int,double un_int,double * test_ratio)1472 void test_BLAS_zdot_c_c(int n, enum blas_conj_type conj, const void *alpha,
1473 const void *beta, const void *rin, const void *rout,
1474 double *r_true_l, double *r_true_t, void *x, int incx,
1475 void *y, int incy, double eps_int, double un_int,
1476 double *test_ratio)
1477
1478 /* Purpose
1479 * =======
1480 *
1481 * Computes ratio of the computed error from SDOT over the expected
1482 * error bound.
1483 *
1484 * Arguments
1485 * =========
1486 *
1487 * n (input) int
1488 * The length of the vectors X and Y.
1489 *
1490 * conj (input) enum blas_conj_type
1491 *
1492 * alpha (input) const void*
1493 *
1494 * beta (input) const void*
1495 *
1496 * rin (input) const void*
1497 *
1498 * rout (input) const void*
1499 * This result was computed by some other routine, and will be
1500 * tested by this routine by comparing it with the truth.
1501 *
1502 * r_true_l (input) double*
1503 * The leading part of the truth.
1504 *
1505 * r_true_t (input) double*
1506 * The trailing part of the truth.
1507 *
1508 * x (input) void*
1509 *
1510 * y (input) void*
1511 *
1512 * eps_int (input) double
1513 * The internal machine precision.
1514 *
1515 * un_int (input) double
1516 * The internal underflow threshold.
1517 *
1518 * test_ratio (output) float*
1519 * The ratio of computed error for r over the error bound.
1520 */
1521 {
1522 int i, ix, iy;
1523 double eps_accurate, eps_out, tmp1, S, S1, S2, U, prod[2], tmp[2];
1524 double un_d, un_accurate, un_out;
1525 float *x_i = (float *) x;
1526 float *y_i = (float *) y;
1527 double *alpha_i = (double *) alpha;
1528 double *beta_i = (double *) beta;
1529 double *rin_i = (double *) rin;
1530 double *rout_i = (double *) rout;
1531 float x_ii[2];
1532 float y_ii[2];
1533
1534 /* Set the starting position */
1535 incx *= 2;
1536 incy *= 2;
1537 ix = 0;
1538 iy = 0;
1539 if (incx < 0)
1540 ix = -(n - 1) * incx;
1541 if (incy < 0)
1542 iy = -(n - 1) * incy;
1543
1544 /* computing S */
1545 S = S1 = S2 = 0.;
1546 for (i = 0; i < n; ++i) {
1547 x_ii[0] = x_i[ix];
1548 x_ii[1] = x_i[ix + 1];
1549 y_ii[0] = y_i[iy];
1550 y_ii[1] = y_i[iy + 1];
1551 if (conj == blas_conj) {
1552 x_ii[1] = -x_ii[1];
1553 }
1554 S1 += sqrt(x_ii[0] * x_ii[0] + x_ii[1] * x_ii[1]);
1555 S2 += sqrt(y_ii[0] * y_ii[0] + y_ii[1] * y_ii[1]); {
1556 prod[0] = (double) x_ii[0] * y_ii[0] - (double) x_ii[1] * y_ii[1];
1557 prod[1] = (double) x_ii[0] * y_ii[1] + (double) x_ii[1] * y_ii[0];
1558 } /* prod = x[i]*y[i] */
1559 S += sqrt(prod[0] * prod[0] + prod[1] * prod[1]);
1560 ix += incx;
1561 iy += incy;
1562 }
1563 S *= sqrt(alpha_i[0] * alpha_i[0] + alpha_i[1] * alpha_i[1]);
1564 {
1565 prod[0] = (double) beta_i[0] * rin_i[0] - (double) beta_i[1] * rin_i[1];
1566 prod[1] = (double) beta_i[0] * rin_i[1] + (double) beta_i[1] * rin_i[0];
1567 }
1568 S += sqrt(prod[0] * prod[0] + prod[1] * prod[1]);
1569
1570 un_d = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
1571 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
1572 S = MAX(S, un_d);
1573
1574 eps_accurate = power(2, -BITS_E);
1575 un_accurate = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra),
1576 (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra));
1577 eps_out = power(2, -BITS_D);
1578 un_out = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
1579 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
1580 tmp[0] = (rout_i[0] - r_true_l[0]) - r_true_t[0];
1581 tmp[1] = (rout_i[1] - r_true_l[1]) - r_true_t[1];
1582 tmp1 = sqrt(tmp[0] * tmp[0] + tmp[1] * tmp[1]);
1583
1584 /* underflow */
1585 U = 2 * sqrt(alpha_i[0] * alpha_i[0] + alpha_i[1] * alpha_i[1]) * n + 3;
1586 U = MAX(U, S1 + 2 * n + 1);
1587 U = MAX(U, S2 + 2 * n + 1) * (un_int + un_accurate) + un_out;
1588 U *= 2 * sqrt(2.);
1589
1590 *test_ratio = tmp1 / (2 * sqrt(2.) * (n + 2) * (eps_int + eps_accurate) * S
1591 +
1592 sqrt(2.) * eps_out * sqrt(r_true_l[0] * r_true_l[0] +
1593 r_true_l[1] * r_true_l[1]) +
1594 U);
1595 }
1596
1597 /* end of test_BLAS_zdot_c_c */
test_BLAS_zdot_c_z(int n,enum blas_conj_type conj,const void * alpha,const void * beta,const void * rin,const void * rout,double * r_true_l,double * r_true_t,void * x,int incx,void * y,int incy,double eps_int,double un_int,double * test_ratio)1598 void test_BLAS_zdot_c_z(int n, enum blas_conj_type conj, const void *alpha,
1599 const void *beta, const void *rin, const void *rout,
1600 double *r_true_l, double *r_true_t, void *x, int incx,
1601 void *y, int incy, double eps_int, double un_int,
1602 double *test_ratio)
1603
1604 /* Purpose
1605 * =======
1606 *
1607 * Computes ratio of the computed error from SDOT over the expected
1608 * error bound.
1609 *
1610 * Arguments
1611 * =========
1612 *
1613 * n (input) int
1614 * The length of the vectors X and Y.
1615 *
1616 * conj (input) enum blas_conj_type
1617 *
1618 * alpha (input) const void*
1619 *
1620 * beta (input) const void*
1621 *
1622 * rin (input) const void*
1623 *
1624 * rout (input) const void*
1625 * This result was computed by some other routine, and will be
1626 * tested by this routine by comparing it with the truth.
1627 *
1628 * r_true_l (input) double*
1629 * The leading part of the truth.
1630 *
1631 * r_true_t (input) double*
1632 * The trailing part of the truth.
1633 *
1634 * x (input) void*
1635 *
1636 * y (input) void*
1637 *
1638 * eps_int (input) double
1639 * The internal machine precision.
1640 *
1641 * un_int (input) double
1642 * The internal underflow threshold.
1643 *
1644 * test_ratio (output) float*
1645 * The ratio of computed error for r over the error bound.
1646 */
1647 {
1648 int i, ix, iy;
1649 double eps_accurate, eps_out, tmp1, S, S1, S2, U, prod[2], tmp[2];
1650 double un_d, un_accurate, un_out;
1651 float *x_i = (float *) x;
1652 double *y_i = (double *) y;
1653 double *alpha_i = (double *) alpha;
1654 double *beta_i = (double *) beta;
1655 double *rin_i = (double *) rin;
1656 double *rout_i = (double *) rout;
1657 float x_ii[2];
1658 double y_ii[2];
1659
1660 /* Set the starting position */
1661 incx *= 2;
1662 incy *= 2;
1663 ix = 0;
1664 iy = 0;
1665 if (incx < 0)
1666 ix = -(n - 1) * incx;
1667 if (incy < 0)
1668 iy = -(n - 1) * incy;
1669
1670 /* computing S */
1671 S = S1 = S2 = 0.;
1672 for (i = 0; i < n; ++i) {
1673 x_ii[0] = x_i[ix];
1674 x_ii[1] = x_i[ix + 1];
1675 y_ii[0] = y_i[iy];
1676 y_ii[1] = y_i[iy + 1];
1677 if (conj == blas_conj) {
1678 x_ii[1] = -x_ii[1];
1679 }
1680 S1 += sqrt(x_ii[0] * x_ii[0] + x_ii[1] * x_ii[1]);
1681 S2 += sqrt(y_ii[0] * y_ii[0] + y_ii[1] * y_ii[1]); {
1682 prod[0] = (double) x_ii[0] * y_ii[0] - (double) x_ii[1] * y_ii[1];
1683 prod[1] = (double) x_ii[0] * y_ii[1] + (double) x_ii[1] * y_ii[0];
1684 } /* prod = x[i]*y[i] */
1685 S += sqrt(prod[0] * prod[0] + prod[1] * prod[1]);
1686 ix += incx;
1687 iy += incy;
1688 }
1689 S *= sqrt(alpha_i[0] * alpha_i[0] + alpha_i[1] * alpha_i[1]);
1690 {
1691 prod[0] = (double) beta_i[0] * rin_i[0] - (double) beta_i[1] * rin_i[1];
1692 prod[1] = (double) beta_i[0] * rin_i[1] + (double) beta_i[1] * rin_i[0];
1693 }
1694 S += sqrt(prod[0] * prod[0] + prod[1] * prod[1]);
1695
1696 un_d = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
1697 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
1698 S = MAX(S, un_d);
1699
1700 eps_accurate = power(2, -BITS_E);
1701 un_accurate = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra),
1702 (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra));
1703 eps_out = power(2, -BITS_D);
1704 un_out = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
1705 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
1706 tmp[0] = (rout_i[0] - r_true_l[0]) - r_true_t[0];
1707 tmp[1] = (rout_i[1] - r_true_l[1]) - r_true_t[1];
1708 tmp1 = sqrt(tmp[0] * tmp[0] + tmp[1] * tmp[1]);
1709
1710 /* underflow */
1711 U = 2 * sqrt(alpha_i[0] * alpha_i[0] + alpha_i[1] * alpha_i[1]) * n + 3;
1712 U = MAX(U, S1 + 2 * n + 1);
1713 U = MAX(U, S2 + 2 * n + 1) * (un_int + un_accurate) + un_out;
1714 U *= 2 * sqrt(2.);
1715
1716 *test_ratio = tmp1 / (2 * sqrt(2.) * (n + 2) * (eps_int + eps_accurate) * S
1717 +
1718 sqrt(2.) * eps_out * sqrt(r_true_l[0] * r_true_l[0] +
1719 r_true_l[1] * r_true_l[1]) +
1720 U);
1721 }
1722
1723 /* end of test_BLAS_zdot_c_z */
test_BLAS_zdot_z_c(int n,enum blas_conj_type conj,const void * alpha,const void * beta,const void * rin,const void * rout,double * r_true_l,double * r_true_t,void * x,int incx,void * y,int incy,double eps_int,double un_int,double * test_ratio)1724 void test_BLAS_zdot_z_c(int n, enum blas_conj_type conj, const void *alpha,
1725 const void *beta, const void *rin, const void *rout,
1726 double *r_true_l, double *r_true_t, void *x, int incx,
1727 void *y, int incy, double eps_int, double un_int,
1728 double *test_ratio)
1729
1730 /* Purpose
1731 * =======
1732 *
1733 * Computes ratio of the computed error from SDOT over the expected
1734 * error bound.
1735 *
1736 * Arguments
1737 * =========
1738 *
1739 * n (input) int
1740 * The length of the vectors X and Y.
1741 *
1742 * conj (input) enum blas_conj_type
1743 *
1744 * alpha (input) const void*
1745 *
1746 * beta (input) const void*
1747 *
1748 * rin (input) const void*
1749 *
1750 * rout (input) const void*
1751 * This result was computed by some other routine, and will be
1752 * tested by this routine by comparing it with the truth.
1753 *
1754 * r_true_l (input) double*
1755 * The leading part of the truth.
1756 *
1757 * r_true_t (input) double*
1758 * The trailing part of the truth.
1759 *
1760 * x (input) void*
1761 *
1762 * y (input) void*
1763 *
1764 * eps_int (input) double
1765 * The internal machine precision.
1766 *
1767 * un_int (input) double
1768 * The internal underflow threshold.
1769 *
1770 * test_ratio (output) float*
1771 * The ratio of computed error for r over the error bound.
1772 */
1773 {
1774 int i, ix, iy;
1775 double eps_accurate, eps_out, tmp1, S, S1, S2, U, prod[2], tmp[2];
1776 double un_d, un_accurate, un_out;
1777 double *x_i = (double *) x;
1778 float *y_i = (float *) y;
1779 double *alpha_i = (double *) alpha;
1780 double *beta_i = (double *) beta;
1781 double *rin_i = (double *) rin;
1782 double *rout_i = (double *) rout;
1783 double x_ii[2];
1784 float y_ii[2];
1785
1786 /* Set the starting position */
1787 incx *= 2;
1788 incy *= 2;
1789 ix = 0;
1790 iy = 0;
1791 if (incx < 0)
1792 ix = -(n - 1) * incx;
1793 if (incy < 0)
1794 iy = -(n - 1) * incy;
1795
1796 /* computing S */
1797 S = S1 = S2 = 0.;
1798 for (i = 0; i < n; ++i) {
1799 x_ii[0] = x_i[ix];
1800 x_ii[1] = x_i[ix + 1];
1801 y_ii[0] = y_i[iy];
1802 y_ii[1] = y_i[iy + 1];
1803 if (conj == blas_conj) {
1804 x_ii[1] = -x_ii[1];
1805 }
1806 S1 += sqrt(x_ii[0] * x_ii[0] + x_ii[1] * x_ii[1]);
1807 S2 += sqrt(y_ii[0] * y_ii[0] + y_ii[1] * y_ii[1]); {
1808 prod[0] = (double) x_ii[0] * y_ii[0] - (double) x_ii[1] * y_ii[1];
1809 prod[1] = (double) x_ii[0] * y_ii[1] + (double) x_ii[1] * y_ii[0];
1810 } /* prod = x[i]*y[i] */
1811 S += sqrt(prod[0] * prod[0] + prod[1] * prod[1]);
1812 ix += incx;
1813 iy += incy;
1814 }
1815 S *= sqrt(alpha_i[0] * alpha_i[0] + alpha_i[1] * alpha_i[1]);
1816 {
1817 prod[0] = (double) beta_i[0] * rin_i[0] - (double) beta_i[1] * rin_i[1];
1818 prod[1] = (double) beta_i[0] * rin_i[1] + (double) beta_i[1] * rin_i[0];
1819 }
1820 S += sqrt(prod[0] * prod[0] + prod[1] * prod[1]);
1821
1822 un_d = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
1823 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
1824 S = MAX(S, un_d);
1825
1826 eps_accurate = power(2, -BITS_E);
1827 un_accurate = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra),
1828 (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra));
1829 eps_out = power(2, -BITS_D);
1830 un_out = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
1831 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
1832 tmp[0] = (rout_i[0] - r_true_l[0]) - r_true_t[0];
1833 tmp[1] = (rout_i[1] - r_true_l[1]) - r_true_t[1];
1834 tmp1 = sqrt(tmp[0] * tmp[0] + tmp[1] * tmp[1]);
1835
1836 /* underflow */
1837 U = 2 * sqrt(alpha_i[0] * alpha_i[0] + alpha_i[1] * alpha_i[1]) * n + 3;
1838 U = MAX(U, S1 + 2 * n + 1);
1839 U = MAX(U, S2 + 2 * n + 1) * (un_int + un_accurate) + un_out;
1840 U *= 2 * sqrt(2.);
1841
1842 *test_ratio = tmp1 / (2 * sqrt(2.) * (n + 2) * (eps_int + eps_accurate) * S
1843 +
1844 sqrt(2.) * eps_out * sqrt(r_true_l[0] * r_true_l[0] +
1845 r_true_l[1] * r_true_l[1]) +
1846 U);
1847 }
1848
1849 /* end of test_BLAS_zdot_z_c */
1850