#include #include #include #include "blas_extended.h" #include "blas_extended_private.h" #include "blas_extended_test.h" double do_test_sdot(int n, int ntests, int *seed, double thresh, int debug, float test_prob, double *min_ratio, int *num_bad_ratio, int *num_tests) /* * Purpose * ======= * * Runs a series of tests on dots * * Arguments * ========= * * n (input) int * The size of vector being tested * * ntests (input) int * The number of tests to run for each set of attributes. * * seed (input/output) int * The seed for the random number generator used in testgen(). * * thresh (input) double * When the ratio returned from test() exceeds the specified * threshold, the current size, r_true, r_comp, and ratio will be * printed. (Since ratio is supposed to be O(1), we can set thresh * to ~10.) * * debug (input) int * If debug=3, print summary * If debug=2, print summary only if the number of bad ratios > 0 * If debug=1, print complete info if tests fail * If debug=0, return max ratio * * min_ratio (output) double * The minimum ratio * * num_bad_ratio (output) int * The number of tests fail; they are above the threshold. * * num_tests (output) int * The number of tests is being performed. * * Return value * ============ * * The maximum ratio if run successfully, otherwise return -1 * */ { /* function name */ const char fname[] = "BLAS_sdot"; /* max number of debug lines to print */ const int max_print = 32; /* Variables in the "x_val" form are loop vars for corresponding variables */ int i; /* iterate through the repeating tests */ int incx_val, incy_val; /* for testing different inc values */ int incx_gen, incy_gen; /* for complex case inc=2, for real case inc=1 */ int d_count; /* counter for debug */ int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ int p_count; /* counter for the number of debug lines printed */ int tot_tests; /* total number of tests to be done */ int norm; /* input values of near underflow/one/overflow */ double ratio_max; /* the current maximum ratio */ double ratio_min; /* the current minimum ratio */ double ratio; /* the per-use test ratio from test() */ int bad_ratios = 0; /* the number of ratios over the threshold */ double eps_int; /* the internal epsilon expected--2^(-24) for float */ double un_int; /* the internal underflow threshold */ float alpha; float beta; float *x; float *y; /* x_gen and y_gen are used to store vectors generated by testgen. they eventually are copied back to x and y */ float *x_gen; float *y_gen; /* the true r calculated by testgen(), in double-double */ double head_r_true, tail_r_true; float r; /* the generated r */ float r_comp; /* the r computed by BLAS_sdot */ int alpha_val; int alpha_flag; /* input flag for BLAS_sdot_testgen */ int beta_val; int beta_flag; /* input flag for BLAS_sdot_testgen */ int conj_val; enum blas_conj_type conj_type; enum blas_prec_type prec; int saved_seed; /* for saving the original seed */ int count = 0, old_count = 0; /* use for counting the number of testgen calls * 2 */ FPU_FIX_DECL; /* test for bad arguments */ if (n < 0) BLAS_error(fname, -1, n, NULL); else if (ntests < 0) BLAS_error(fname, -2, ntests, NULL); /* if there is nothing to test, return all zero */ if (n == 0 || ntests == 0) { *min_ratio = 0.0; *num_bad_ratio = 0; *num_tests = 0; return 0.0; } FPU_FIX_START; /* initialization */ saved_seed = *seed; ratio_min = 1e308; ratio_max = 0.0; tot_tests = 0; p_count = 0; count = 0; find_max_ratio = 0; if (debug == 3) find_max_ratio = 1; incx_gen = incy_gen = 1; /* get space for calculation */ x = (float *) blas_malloc(n * 2 * incx_gen * sizeof(float)); if (n * 2 * incx_gen > 0 && x == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y = (float *) blas_malloc(n * 2 * incy_gen * sizeof(float)); if (n * 2 * incy_gen > 0 && y == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } x_gen = (float *) blas_malloc(n * incx_gen * sizeof(float)); if (n * incx_gen > 0 && x_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y_gen = (float *) blas_malloc(n * incy_gen * sizeof(float)); if (n * incy_gen > 0 && y_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } /* The debug iteration: If debug=1, then will execute the iteration twice. First, compute the max ratio. Second, print info if ratio > (50% * ratio_max). */ for (d_count = 0; d_count <= find_max_ratio; d_count++) { bad_ratios = 0; /* set to zero */ if ((debug == 3) && (d_count == find_max_ratio)) *seed = saved_seed; /* restore the original seed */ /* varying alpha */ for (alpha_val = 1; alpha_val < 3; alpha_val++) { alpha_flag = 0; switch (alpha_val) { case 0: alpha = 0.0; alpha_flag = 1; break; case 1: alpha = 1.0; alpha_flag = 1; break; } /* varying beta */ for (beta_val = 0; beta_val < 3; beta_val++) { beta_flag = 0; switch (beta_val) { case 0: beta = 0.0; beta_flag = 1; break; case 1: beta = 1.0; beta_flag = 1; break; } eps_int = power(2, -BITS_S); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_single), (double) BLAS_fpinfo_x(blas_emin, blas_prec_single)); prec = blas_prec_single; /* values near underflow, 1, or overflow */ for (norm = -1; norm <= 1; norm++) { /* number of tests */ for (i = 0; i < ntests; i++) { /* conj or not */ for (conj_val = 0; conj_val < 2; conj_val++) { switch (conj_val) { case 0: conj_type = blas_no_conj; break; case 1: default: conj_type = blas_conj; break; } /* For the sake of speed, we throw out this case at random */ if (xrand(seed) >= test_prob) continue; BLAS_sdot_testgen(n, 0, 0, norm, conj_type, &alpha, alpha_flag, &beta, beta_flag, x_gen, y_gen, seed, &r, &head_r_true, &tail_r_true); count++; /* varying incx */ for (incx_val = -2; incx_val <= 2; incx_val++) { if (incx_val == 0) continue; scopy_vector(x_gen, n, 1, x, incx_val); /* varying incy */ for (incy_val = -2; incy_val <= 2; incy_val++) { if (incy_val == 0) continue; scopy_vector(y_gen, n, 1, y, incy_val); /* call BLAS_sdot to get r_comp */ r_comp = r; FPU_FIX_STOP; BLAS_sdot(conj_type, n, alpha, x, incx_val, beta, y, incy_val, &r_comp); FPU_FIX_START; /* computing the ratio */ test_BLAS_sdot(n, conj_type, alpha, beta, r, r_comp, head_r_true, tail_r_true, x, incx_val, y, incy_val, eps_int, un_int, &ratio); /* Increase the number of bad ratio, if the ratio is bigger than the threshold. The !<= below causes NaN error to be detected. Note that (NaN > thresh) is always false. */ if (!(ratio <= thresh)) { bad_ratios++; if ((debug == 3) && /* print only when debug is on */ (count != old_count) && /* print if old vector is different from the current one */ (d_count == find_max_ratio) && (p_count <= max_print) && (ratio > 0.5 * ratio_max)) { old_count = count; printf ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", fname, n, ntests, thresh); /* Print test info */ switch (prec) { case blas_prec_single: printf("single "); break; case blas_prec_double: printf("double "); break; case blas_prec_indigenous: printf("indigenous "); break; case blas_prec_extra: printf("extra "); break; } switch (norm) { case -1: printf("near_underflow "); break; case 0: printf("near_one "); break; case 1: printf("near_overflow "); break; } switch (conj_type) { case blas_no_conj: printf("no_conj "); break; case blas_conj: printf("conj "); break; } printf("incx=%d, incy=%d:\n", incx_val, incy_val); sprint_vector(x, n, incx_val, "x"); sprint_vector(y, n, incy_val, "y"); printf(" "); printf("alpha = "); printf("%16.8e", alpha); printf("\n "); printf("beta = "); printf("%16.8e", beta); printf("\n"); printf(" "); printf("r = "); printf("%16.8e", r); printf("\n "); printf("r_comp = "); printf("%16.8e", r_comp); printf("\n"); printf(" "); printf("r_true = "); printf("[%24.16e %24.16e]", head_r_true, tail_r_true); printf(" ratio=%.4e\n", ratio); p_count++; } } if (d_count == 0) { if (ratio > ratio_max) ratio_max = ratio; if (ratio != 0.0 && ratio < ratio_min) ratio_min = ratio; tot_tests++; } } /* incy */ } /* incx */ } /* conj */ } /* tests */ } /* norm */ } /* beta */ } /* alpha */ } /* debug */ if ((debug == 2) || ((debug == 1) && (bad_ratios > 0))) { printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", fname, n, ntests, thresh); printf (" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests), ratio_min, ratio_max); } blas_free(x); blas_free(y); blas_free(x_gen); blas_free(y_gen); *min_ratio = ratio_min; *num_bad_ratio = bad_ratios; *num_tests = tot_tests; FPU_FIX_STOP; return ratio_max; } double do_test_ddot(int n, int ntests, int *seed, double thresh, int debug, float test_prob, double *min_ratio, int *num_bad_ratio, int *num_tests) /* * Purpose * ======= * * Runs a series of tests on dots * * Arguments * ========= * * n (input) int * The size of vector being tested * * ntests (input) int * The number of tests to run for each set of attributes. * * seed (input/output) int * The seed for the random number generator used in testgen(). * * thresh (input) double * When the ratio returned from test() exceeds the specified * threshold, the current size, r_true, r_comp, and ratio will be * printed. (Since ratio is supposed to be O(1), we can set thresh * to ~10.) * * debug (input) int * If debug=3, print summary * If debug=2, print summary only if the number of bad ratios > 0 * If debug=1, print complete info if tests fail * If debug=0, return max ratio * * min_ratio (output) double * The minimum ratio * * num_bad_ratio (output) int * The number of tests fail; they are above the threshold. * * num_tests (output) int * The number of tests is being performed. * * Return value * ============ * * The maximum ratio if run successfully, otherwise return -1 * */ { /* function name */ const char fname[] = "BLAS_ddot"; /* max number of debug lines to print */ const int max_print = 32; /* Variables in the "x_val" form are loop vars for corresponding variables */ int i; /* iterate through the repeating tests */ int incx_val, incy_val; /* for testing different inc values */ int incx_gen, incy_gen; /* for complex case inc=2, for real case inc=1 */ int d_count; /* counter for debug */ int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ int p_count; /* counter for the number of debug lines printed */ int tot_tests; /* total number of tests to be done */ int norm; /* input values of near underflow/one/overflow */ double ratio_max; /* the current maximum ratio */ double ratio_min; /* the current minimum ratio */ double ratio; /* the per-use test ratio from test() */ int bad_ratios = 0; /* the number of ratios over the threshold */ double eps_int; /* the internal epsilon expected--2^(-24) for float */ double un_int; /* the internal underflow threshold */ double alpha; double beta; double *x; double *y; /* x_gen and y_gen are used to store vectors generated by testgen. they eventually are copied back to x and y */ double *x_gen; double *y_gen; /* the true r calculated by testgen(), in double-double */ double head_r_true, tail_r_true; double r; /* the generated r */ double r_comp; /* the r computed by BLAS_ddot */ int alpha_val; int alpha_flag; /* input flag for BLAS_ddot_testgen */ int beta_val; int beta_flag; /* input flag for BLAS_ddot_testgen */ int conj_val; enum blas_conj_type conj_type; enum blas_prec_type prec; int saved_seed; /* for saving the original seed */ int count = 0, old_count = 0; /* use for counting the number of testgen calls * 2 */ FPU_FIX_DECL; /* test for bad arguments */ if (n < 0) BLAS_error(fname, -1, n, NULL); else if (ntests < 0) BLAS_error(fname, -2, ntests, NULL); /* if there is nothing to test, return all zero */ if (n == 0 || ntests == 0) { *min_ratio = 0.0; *num_bad_ratio = 0; *num_tests = 0; return 0.0; } FPU_FIX_START; /* initialization */ saved_seed = *seed; ratio_min = 1e308; ratio_max = 0.0; tot_tests = 0; p_count = 0; count = 0; find_max_ratio = 0; if (debug == 3) find_max_ratio = 1; incx_gen = incy_gen = 1; /* get space for calculation */ x = (double *) blas_malloc(n * 2 * incx_gen * sizeof(double)); if (n * 2 * incx_gen > 0 && x == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y = (double *) blas_malloc(n * 2 * incy_gen * sizeof(double)); if (n * 2 * incy_gen > 0 && y == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } x_gen = (double *) blas_malloc(n * incx_gen * sizeof(double)); if (n * incx_gen > 0 && x_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y_gen = (double *) blas_malloc(n * incy_gen * sizeof(double)); if (n * incy_gen > 0 && y_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } /* The debug iteration: If debug=1, then will execute the iteration twice. First, compute the max ratio. Second, print info if ratio > (50% * ratio_max). */ for (d_count = 0; d_count <= find_max_ratio; d_count++) { bad_ratios = 0; /* set to zero */ if ((debug == 3) && (d_count == find_max_ratio)) *seed = saved_seed; /* restore the original seed */ /* varying alpha */ for (alpha_val = 1; alpha_val < 3; alpha_val++) { alpha_flag = 0; switch (alpha_val) { case 0: alpha = 0.0; alpha_flag = 1; break; case 1: alpha = 1.0; alpha_flag = 1; break; } /* varying beta */ for (beta_val = 0; beta_val < 3; beta_val++) { beta_flag = 0; switch (beta_val) { case 0: beta = 0.0; beta_flag = 1; break; case 1: beta = 1.0; beta_flag = 1; break; } eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; /* values near underflow, 1, or overflow */ for (norm = -1; norm <= 1; norm++) { /* number of tests */ for (i = 0; i < ntests; i++) { /* conj or not */ for (conj_val = 0; conj_val < 2; conj_val++) { switch (conj_val) { case 0: conj_type = blas_no_conj; break; case 1: default: conj_type = blas_conj; break; } /* For the sake of speed, we throw out this case at random */ if (xrand(seed) >= test_prob) continue; BLAS_ddot_testgen(n, 0, 0, norm, conj_type, &alpha, alpha_flag, &beta, beta_flag, x_gen, y_gen, seed, &r, &head_r_true, &tail_r_true); count++; /* varying incx */ for (incx_val = -2; incx_val <= 2; incx_val++) { if (incx_val == 0) continue; dcopy_vector(x_gen, n, 1, x, incx_val); /* varying incy */ for (incy_val = -2; incy_val <= 2; incy_val++) { if (incy_val == 0) continue; dcopy_vector(y_gen, n, 1, y, incy_val); /* call BLAS_ddot to get r_comp */ r_comp = r; FPU_FIX_STOP; BLAS_ddot(conj_type, n, alpha, x, incx_val, beta, y, incy_val, &r_comp); FPU_FIX_START; /* computing the ratio */ test_BLAS_ddot(n, conj_type, alpha, beta, r, r_comp, head_r_true, tail_r_true, x, incx_val, y, incy_val, eps_int, un_int, &ratio); /* Increase the number of bad ratio, if the ratio is bigger than the threshold. The !<= below causes NaN error to be detected. Note that (NaN > thresh) is always false. */ if (!(ratio <= thresh)) { bad_ratios++; if ((debug == 3) && /* print only when debug is on */ (count != old_count) && /* print if old vector is different from the current one */ (d_count == find_max_ratio) && (p_count <= max_print) && (ratio > 0.5 * ratio_max)) { old_count = count; printf ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", fname, n, ntests, thresh); /* Print test info */ switch (prec) { case blas_prec_single: printf("single "); break; case blas_prec_double: printf("double "); break; case blas_prec_indigenous: printf("indigenous "); break; case blas_prec_extra: printf("extra "); break; } switch (norm) { case -1: printf("near_underflow "); break; case 0: printf("near_one "); break; case 1: printf("near_overflow "); break; } switch (conj_type) { case blas_no_conj: printf("no_conj "); break; case blas_conj: printf("conj "); break; } printf("incx=%d, incy=%d:\n", incx_val, incy_val); dprint_vector(x, n, incx_val, "x"); dprint_vector(y, n, incy_val, "y"); printf(" "); printf("alpha = "); printf("%24.16e", alpha); printf("\n "); printf("beta = "); printf("%24.16e", beta); printf("\n"); printf(" "); printf("r = "); printf("%24.16e", r); printf("\n "); printf("r_comp = "); printf("%24.16e", r_comp); printf("\n"); printf(" "); printf("r_true = "); printf("[%24.16e %24.16e]", head_r_true, tail_r_true); printf(" ratio=%.4e\n", ratio); p_count++; } } if (d_count == 0) { if (ratio > ratio_max) ratio_max = ratio; if (ratio != 0.0 && ratio < ratio_min) ratio_min = ratio; tot_tests++; } } /* incy */ } /* incx */ } /* conj */ } /* tests */ } /* norm */ } /* beta */ } /* alpha */ } /* debug */ if ((debug == 2) || ((debug == 1) && (bad_ratios > 0))) { printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", fname, n, ntests, thresh); printf (" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests), ratio_min, ratio_max); } blas_free(x); blas_free(y); blas_free(x_gen); blas_free(y_gen); *min_ratio = ratio_min; *num_bad_ratio = bad_ratios; *num_tests = tot_tests; FPU_FIX_STOP; return ratio_max; } double do_test_cdot(int n, int ntests, int *seed, double thresh, int debug, float test_prob, double *min_ratio, int *num_bad_ratio, int *num_tests) /* * Purpose * ======= * * Runs a series of tests on dots * * Arguments * ========= * * n (input) int * The size of vector being tested * * ntests (input) int * The number of tests to run for each set of attributes. * * seed (input/output) int * The seed for the random number generator used in testgen(). * * thresh (input) double * When the ratio returned from test() exceeds the specified * threshold, the current size, r_true, r_comp, and ratio will be * printed. (Since ratio is supposed to be O(1), we can set thresh * to ~10.) * * debug (input) int * If debug=3, print summary * If debug=2, print summary only if the number of bad ratios > 0 * If debug=1, print complete info if tests fail * If debug=0, return max ratio * * min_ratio (output) double * The minimum ratio * * num_bad_ratio (output) int * The number of tests fail; they are above the threshold. * * num_tests (output) int * The number of tests is being performed. * * Return value * ============ * * The maximum ratio if run successfully, otherwise return -1 * */ { /* function name */ const char fname[] = "BLAS_cdot"; /* max number of debug lines to print */ const int max_print = 32; /* Variables in the "x_val" form are loop vars for corresponding variables */ int i; /* iterate through the repeating tests */ int incx_val, incy_val; /* for testing different inc values */ int incx_gen, incy_gen; /* for complex case inc=2, for real case inc=1 */ int d_count; /* counter for debug */ int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ int p_count; /* counter for the number of debug lines printed */ int tot_tests; /* total number of tests to be done */ int norm; /* input values of near underflow/one/overflow */ double ratio_max; /* the current maximum ratio */ double ratio_min; /* the current minimum ratio */ double ratio; /* the per-use test ratio from test() */ int bad_ratios = 0; /* the number of ratios over the threshold */ double eps_int; /* the internal epsilon expected--2^(-24) for float */ double un_int; /* the internal underflow threshold */ float alpha[2]; float beta[2]; float *x; float *y; /* x_gen and y_gen are used to store vectors generated by testgen. they eventually are copied back to x and y */ float *x_gen; float *y_gen; /* the true r calculated by testgen(), in double-double */ double head_r_true[2], tail_r_true[2]; float r[2]; /* the generated r */ float r_comp[2]; /* the r computed by BLAS_cdot */ int alpha_val; int alpha_flag; /* input flag for BLAS_cdot_testgen */ int beta_val; int beta_flag; /* input flag for BLAS_cdot_testgen */ int conj_val; enum blas_conj_type conj_type; enum blas_prec_type prec; int saved_seed; /* for saving the original seed */ int count = 0, old_count = 0; /* use for counting the number of testgen calls * 2 */ FPU_FIX_DECL; /* test for bad arguments */ if (n < 0) BLAS_error(fname, -1, n, NULL); else if (ntests < 0) BLAS_error(fname, -2, ntests, NULL); /* if there is nothing to test, return all zero */ if (n == 0 || ntests == 0) { *min_ratio = 0.0; *num_bad_ratio = 0; *num_tests = 0; return 0.0; } FPU_FIX_START; /* initialization */ saved_seed = *seed; ratio_min = 1e308; ratio_max = 0.0; tot_tests = 0; p_count = 0; count = 0; find_max_ratio = 0; if (debug == 3) find_max_ratio = 1; incx_gen = incy_gen = 1; incx_gen *= 2; incy_gen *= 2; /* get space for calculation */ x = (float *) blas_malloc(n * 2 * incx_gen * sizeof(float) * 2); if (n * 2 * incx_gen > 0 && x == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y = (float *) blas_malloc(n * 2 * incy_gen * sizeof(float) * 2); if (n * 2 * incy_gen > 0 && y == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } x_gen = (float *) blas_malloc(n * incx_gen * sizeof(float) * 2); if (n * incx_gen > 0 && x_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y_gen = (float *) blas_malloc(n * incy_gen * sizeof(float) * 2); if (n * incy_gen > 0 && y_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } /* The debug iteration: If debug=1, then will execute the iteration twice. First, compute the max ratio. Second, print info if ratio > (50% * ratio_max). */ for (d_count = 0; d_count <= find_max_ratio; d_count++) { bad_ratios = 0; /* set to zero */ if ((debug == 3) && (d_count == find_max_ratio)) *seed = saved_seed; /* restore the original seed */ /* varying alpha */ for (alpha_val = 1; alpha_val < 3; alpha_val++) { alpha_flag = 0; switch (alpha_val) { case 0: alpha[0] = alpha[1] = 0.0; alpha_flag = 1; break; case 1: alpha[0] = 1.0; alpha[1] = 0.0; alpha_flag = 1; break; } /* varying beta */ for (beta_val = 0; beta_val < 3; beta_val++) { beta_flag = 0; switch (beta_val) { case 0: beta[0] = beta[1] = 0.0; beta_flag = 1; break; case 1: beta[0] = 1.0; beta[1] = 0.0; beta_flag = 1; break; } eps_int = power(2, -BITS_S); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_single), (double) BLAS_fpinfo_x(blas_emin, blas_prec_single)); prec = blas_prec_single; /* values near underflow, 1, or overflow */ for (norm = -1; norm <= 1; norm++) { /* number of tests */ for (i = 0; i < ntests; i++) { /* conj or not */ for (conj_val = 0; conj_val < 2; conj_val++) { switch (conj_val) { case 0: conj_type = blas_no_conj; break; case 1: default: conj_type = blas_conj; break; } /* For the sake of speed, we throw out this case at random */ if (xrand(seed) >= test_prob) continue; BLAS_cdot_testgen(n, 0, 0, norm, conj_type, &alpha, alpha_flag, &beta, beta_flag, x_gen, y_gen, seed, &r, head_r_true, tail_r_true); count++; /* varying incx */ for (incx_val = -2; incx_val <= 2; incx_val++) { if (incx_val == 0) continue; ccopy_vector(x_gen, n, 1, x, incx_val); /* varying incy */ for (incy_val = -2; incy_val <= 2; incy_val++) { if (incy_val == 0) continue; ccopy_vector(y_gen, n, 1, y, incy_val); /* call BLAS_cdot to get r_comp */ r_comp[0] = r[0]; r_comp[1] = r[1]; FPU_FIX_STOP; BLAS_cdot(conj_type, n, alpha, x, incx_val, beta, y, incy_val, &r_comp); FPU_FIX_START; /* computing the ratio */ test_BLAS_cdot(n, conj_type, alpha, beta, r, r_comp, head_r_true, tail_r_true, x, incx_val, y, incy_val, eps_int, un_int, &ratio); /* Increase the number of bad ratio, if the ratio is bigger than the threshold. The !<= below causes NaN error to be detected. Note that (NaN > thresh) is always false. */ if (!(ratio <= thresh)) { bad_ratios++; if ((debug == 3) && /* print only when debug is on */ (count != old_count) && /* print if old vector is different from the current one */ (d_count == find_max_ratio) && (p_count <= max_print) && (ratio > 0.5 * ratio_max)) { old_count = count; printf ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", fname, n, ntests, thresh); /* Print test info */ switch (prec) { case blas_prec_single: printf("single "); break; case blas_prec_double: printf("double "); break; case blas_prec_indigenous: printf("indigenous "); break; case blas_prec_extra: printf("extra "); break; } switch (norm) { case -1: printf("near_underflow "); break; case 0: printf("near_one "); break; case 1: printf("near_overflow "); break; } switch (conj_type) { case blas_no_conj: printf("no_conj "); break; case blas_conj: printf("conj "); break; } printf("incx=%d, incy=%d:\n", incx_val, incy_val); cprint_vector(x, n, incx_val, "x"); cprint_vector(y, n, incy_val, "y"); printf(" "); printf("alpha = "); printf("(%16.8e, %16.8e)", alpha[0], alpha[1]); printf("\n "); printf("beta = "); printf("(%16.8e, %16.8e)", beta[0], beta[1]); printf("\n"); printf(" "); printf("r = "); printf("(%16.8e, %16.8e)", r[0], r[1]); printf("\n "); printf("r_comp = "); printf("(%16.8e, %16.8e)", r_comp[0], r_comp[1]); printf("\n"); printf(" "); printf("r_true = "); printf("([%24.16e %24.16e], [%24.16e %24.16e])", head_r_true[0], tail_r_true[0], head_r_true[1], tail_r_true[1]); printf(" ratio=%.4e\n", ratio); p_count++; } } if (d_count == 0) { if (ratio > ratio_max) ratio_max = ratio; if (ratio != 0.0 && ratio < ratio_min) ratio_min = ratio; tot_tests++; } } /* incy */ } /* incx */ } /* conj */ } /* tests */ } /* norm */ } /* beta */ } /* alpha */ } /* debug */ if ((debug == 2) || ((debug == 1) && (bad_ratios > 0))) { printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", fname, n, ntests, thresh); printf (" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests), ratio_min, ratio_max); } blas_free(x); blas_free(y); blas_free(x_gen); blas_free(y_gen); *min_ratio = ratio_min; *num_bad_ratio = bad_ratios; *num_tests = tot_tests; FPU_FIX_STOP; return ratio_max; } double do_test_zdot(int n, int ntests, int *seed, double thresh, int debug, float test_prob, double *min_ratio, int *num_bad_ratio, int *num_tests) /* * Purpose * ======= * * Runs a series of tests on dots * * Arguments * ========= * * n (input) int * The size of vector being tested * * ntests (input) int * The number of tests to run for each set of attributes. * * seed (input/output) int * The seed for the random number generator used in testgen(). * * thresh (input) double * When the ratio returned from test() exceeds the specified * threshold, the current size, r_true, r_comp, and ratio will be * printed. (Since ratio is supposed to be O(1), we can set thresh * to ~10.) * * debug (input) int * If debug=3, print summary * If debug=2, print summary only if the number of bad ratios > 0 * If debug=1, print complete info if tests fail * If debug=0, return max ratio * * min_ratio (output) double * The minimum ratio * * num_bad_ratio (output) int * The number of tests fail; they are above the threshold. * * num_tests (output) int * The number of tests is being performed. * * Return value * ============ * * The maximum ratio if run successfully, otherwise return -1 * */ { /* function name */ const char fname[] = "BLAS_zdot"; /* max number of debug lines to print */ const int max_print = 32; /* Variables in the "x_val" form are loop vars for corresponding variables */ int i; /* iterate through the repeating tests */ int incx_val, incy_val; /* for testing different inc values */ int incx_gen, incy_gen; /* for complex case inc=2, for real case inc=1 */ int d_count; /* counter for debug */ int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ int p_count; /* counter for the number of debug lines printed */ int tot_tests; /* total number of tests to be done */ int norm; /* input values of near underflow/one/overflow */ double ratio_max; /* the current maximum ratio */ double ratio_min; /* the current minimum ratio */ double ratio; /* the per-use test ratio from test() */ int bad_ratios = 0; /* the number of ratios over the threshold */ double eps_int; /* the internal epsilon expected--2^(-24) for float */ double un_int; /* the internal underflow threshold */ double alpha[2]; double beta[2]; double *x; double *y; /* x_gen and y_gen are used to store vectors generated by testgen. they eventually are copied back to x and y */ double *x_gen; double *y_gen; /* the true r calculated by testgen(), in double-double */ double head_r_true[2], tail_r_true[2]; double r[2]; /* the generated r */ double r_comp[2]; /* the r computed by BLAS_zdot */ int alpha_val; int alpha_flag; /* input flag for BLAS_zdot_testgen */ int beta_val; int beta_flag; /* input flag for BLAS_zdot_testgen */ int conj_val; enum blas_conj_type conj_type; enum blas_prec_type prec; int saved_seed; /* for saving the original seed */ int count = 0, old_count = 0; /* use for counting the number of testgen calls * 2 */ FPU_FIX_DECL; /* test for bad arguments */ if (n < 0) BLAS_error(fname, -1, n, NULL); else if (ntests < 0) BLAS_error(fname, -2, ntests, NULL); /* if there is nothing to test, return all zero */ if (n == 0 || ntests == 0) { *min_ratio = 0.0; *num_bad_ratio = 0; *num_tests = 0; return 0.0; } FPU_FIX_START; /* initialization */ saved_seed = *seed; ratio_min = 1e308; ratio_max = 0.0; tot_tests = 0; p_count = 0; count = 0; find_max_ratio = 0; if (debug == 3) find_max_ratio = 1; incx_gen = incy_gen = 1; incx_gen *= 2; incy_gen *= 2; /* get space for calculation */ x = (double *) blas_malloc(n * 2 * incx_gen * sizeof(double) * 2); if (n * 2 * incx_gen > 0 && x == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y = (double *) blas_malloc(n * 2 * incy_gen * sizeof(double) * 2); if (n * 2 * incy_gen > 0 && y == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } x_gen = (double *) blas_malloc(n * incx_gen * sizeof(double) * 2); if (n * incx_gen > 0 && x_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y_gen = (double *) blas_malloc(n * incy_gen * sizeof(double) * 2); if (n * incy_gen > 0 && y_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } /* The debug iteration: If debug=1, then will execute the iteration twice. First, compute the max ratio. Second, print info if ratio > (50% * ratio_max). */ for (d_count = 0; d_count <= find_max_ratio; d_count++) { bad_ratios = 0; /* set to zero */ if ((debug == 3) && (d_count == find_max_ratio)) *seed = saved_seed; /* restore the original seed */ /* varying alpha */ for (alpha_val = 1; alpha_val < 3; alpha_val++) { alpha_flag = 0; switch (alpha_val) { case 0: alpha[0] = alpha[1] = 0.0; alpha_flag = 1; break; case 1: alpha[0] = 1.0; alpha[1] = 0.0; alpha_flag = 1; break; } /* varying beta */ for (beta_val = 0; beta_val < 3; beta_val++) { beta_flag = 0; switch (beta_val) { case 0: beta[0] = beta[1] = 0.0; beta_flag = 1; break; case 1: beta[0] = 1.0; beta[1] = 0.0; beta_flag = 1; break; } eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; /* values near underflow, 1, or overflow */ for (norm = -1; norm <= 1; norm++) { /* number of tests */ for (i = 0; i < ntests; i++) { /* conj or not */ for (conj_val = 0; conj_val < 2; conj_val++) { switch (conj_val) { case 0: conj_type = blas_no_conj; break; case 1: default: conj_type = blas_conj; break; } /* For the sake of speed, we throw out this case at random */ if (xrand(seed) >= test_prob) continue; BLAS_zdot_testgen(n, 0, 0, norm, conj_type, &alpha, alpha_flag, &beta, beta_flag, x_gen, y_gen, seed, &r, head_r_true, tail_r_true); count++; /* varying incx */ for (incx_val = -2; incx_val <= 2; incx_val++) { if (incx_val == 0) continue; zcopy_vector(x_gen, n, 1, x, incx_val); /* varying incy */ for (incy_val = -2; incy_val <= 2; incy_val++) { if (incy_val == 0) continue; zcopy_vector(y_gen, n, 1, y, incy_val); /* call BLAS_zdot to get r_comp */ r_comp[0] = r[0]; r_comp[1] = r[1]; FPU_FIX_STOP; BLAS_zdot(conj_type, n, alpha, x, incx_val, beta, y, incy_val, &r_comp); FPU_FIX_START; /* computing the ratio */ test_BLAS_zdot(n, conj_type, alpha, beta, r, r_comp, head_r_true, tail_r_true, x, incx_val, y, incy_val, eps_int, un_int, &ratio); /* Increase the number of bad ratio, if the ratio is bigger than the threshold. The !<= below causes NaN error to be detected. Note that (NaN > thresh) is always false. */ if (!(ratio <= thresh)) { bad_ratios++; if ((debug == 3) && /* print only when debug is on */ (count != old_count) && /* print if old vector is different from the current one */ (d_count == find_max_ratio) && (p_count <= max_print) && (ratio > 0.5 * ratio_max)) { old_count = count; printf ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", fname, n, ntests, thresh); /* Print test info */ switch (prec) { case blas_prec_single: printf("single "); break; case blas_prec_double: printf("double "); break; case blas_prec_indigenous: printf("indigenous "); break; case blas_prec_extra: printf("extra "); break; } switch (norm) { case -1: printf("near_underflow "); break; case 0: printf("near_one "); break; case 1: printf("near_overflow "); break; } switch (conj_type) { case blas_no_conj: printf("no_conj "); break; case blas_conj: printf("conj "); break; } printf("incx=%d, incy=%d:\n", incx_val, incy_val); zprint_vector(x, n, incx_val, "x"); zprint_vector(y, n, incy_val, "y"); printf(" "); printf("alpha = "); printf("(%24.16e, %24.16e)", alpha[0], alpha[1]); printf("\n "); printf("beta = "); printf("(%24.16e, %24.16e)", beta[0], beta[1]); printf("\n"); printf(" "); printf("r = "); printf("(%24.16e, %24.16e)", r[0], r[1]); printf("\n "); printf("r_comp = "); printf("(%24.16e, %24.16e)", r_comp[0], r_comp[1]); printf("\n"); printf(" "); printf("r_true = "); printf("([%24.16e %24.16e], [%24.16e %24.16e])", head_r_true[0], tail_r_true[0], head_r_true[1], tail_r_true[1]); printf(" ratio=%.4e\n", ratio); p_count++; } } if (d_count == 0) { if (ratio > ratio_max) ratio_max = ratio; if (ratio != 0.0 && ratio < ratio_min) ratio_min = ratio; tot_tests++; } } /* incy */ } /* incx */ } /* conj */ } /* tests */ } /* norm */ } /* beta */ } /* alpha */ } /* debug */ if ((debug == 2) || ((debug == 1) && (bad_ratios > 0))) { printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", fname, n, ntests, thresh); printf (" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests), ratio_min, ratio_max); } blas_free(x); blas_free(y); blas_free(x_gen); blas_free(y_gen); *min_ratio = ratio_min; *num_bad_ratio = bad_ratios; *num_tests = tot_tests; FPU_FIX_STOP; return ratio_max; } double do_test_ddot_d_s(int n, int ntests, int *seed, double thresh, int debug, float test_prob, double *min_ratio, int *num_bad_ratio, int *num_tests) /* * Purpose * ======= * * Runs a series of tests on dots * * Arguments * ========= * * n (input) int * The size of vector being tested * * ntests (input) int * The number of tests to run for each set of attributes. * * seed (input/output) int * The seed for the random number generator used in testgen(). * * thresh (input) double * When the ratio returned from test() exceeds the specified * threshold, the current size, r_true, r_comp, and ratio will be * printed. (Since ratio is supposed to be O(1), we can set thresh * to ~10.) * * debug (input) int * If debug=3, print summary * If debug=2, print summary only if the number of bad ratios > 0 * If debug=1, print complete info if tests fail * If debug=0, return max ratio * * min_ratio (output) double * The minimum ratio * * num_bad_ratio (output) int * The number of tests fail; they are above the threshold. * * num_tests (output) int * The number of tests is being performed. * * Return value * ============ * * The maximum ratio if run successfully, otherwise return -1 * */ { /* function name */ const char fname[] = "BLAS_ddot_d_s"; /* max number of debug lines to print */ const int max_print = 32; /* Variables in the "x_val" form are loop vars for corresponding variables */ int i; /* iterate through the repeating tests */ int incx_val, incy_val; /* for testing different inc values */ int incx_gen, incy_gen; /* for complex case inc=2, for real case inc=1 */ int d_count; /* counter for debug */ int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ int p_count; /* counter for the number of debug lines printed */ int tot_tests; /* total number of tests to be done */ int norm; /* input values of near underflow/one/overflow */ double ratio_max; /* the current maximum ratio */ double ratio_min; /* the current minimum ratio */ double ratio; /* the per-use test ratio from test() */ int bad_ratios = 0; /* the number of ratios over the threshold */ double eps_int; /* the internal epsilon expected--2^(-24) for float */ double un_int; /* the internal underflow threshold */ double alpha; double beta; double *x; float *y; /* x_gen and y_gen are used to store vectors generated by testgen. they eventually are copied back to x and y */ double *x_gen; float *y_gen; /* the true r calculated by testgen(), in double-double */ double head_r_true, tail_r_true; double r; /* the generated r */ double r_comp; /* the r computed by BLAS_ddot_d_s */ int alpha_val; int alpha_flag; /* input flag for BLAS_ddot_d_s_testgen */ int beta_val; int beta_flag; /* input flag for BLAS_ddot_d_s_testgen */ int conj_val; enum blas_conj_type conj_type; enum blas_prec_type prec; int saved_seed; /* for saving the original seed */ int count = 0, old_count = 0; /* use for counting the number of testgen calls * 2 */ FPU_FIX_DECL; /* test for bad arguments */ if (n < 0) BLAS_error(fname, -1, n, NULL); else if (ntests < 0) BLAS_error(fname, -2, ntests, NULL); /* if there is nothing to test, return all zero */ if (n == 0 || ntests == 0) { *min_ratio = 0.0; *num_bad_ratio = 0; *num_tests = 0; return 0.0; } FPU_FIX_START; /* initialization */ saved_seed = *seed; ratio_min = 1e308; ratio_max = 0.0; tot_tests = 0; p_count = 0; count = 0; find_max_ratio = 0; if (debug == 3) find_max_ratio = 1; incx_gen = incy_gen = 1; /* get space for calculation */ x = (double *) blas_malloc(n * 2 * incx_gen * sizeof(double)); if (n * 2 * incx_gen > 0 && x == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y = (float *) blas_malloc(n * 2 * incy_gen * sizeof(float)); if (n * 2 * incy_gen > 0 && y == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } x_gen = (double *) blas_malloc(n * incx_gen * sizeof(double)); if (n * incx_gen > 0 && x_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y_gen = (float *) blas_malloc(n * incy_gen * sizeof(float)); if (n * incy_gen > 0 && y_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } /* The debug iteration: If debug=1, then will execute the iteration twice. First, compute the max ratio. Second, print info if ratio > (50% * ratio_max). */ for (d_count = 0; d_count <= find_max_ratio; d_count++) { bad_ratios = 0; /* set to zero */ if ((debug == 3) && (d_count == find_max_ratio)) *seed = saved_seed; /* restore the original seed */ /* varying alpha */ for (alpha_val = 1; alpha_val < 3; alpha_val++) { alpha_flag = 0; switch (alpha_val) { case 0: alpha = 0.0; alpha_flag = 1; break; case 1: alpha = 1.0; alpha_flag = 1; break; } /* varying beta */ for (beta_val = 0; beta_val < 3; beta_val++) { beta_flag = 0; switch (beta_val) { case 0: beta = 0.0; beta_flag = 1; break; case 1: beta = 1.0; beta_flag = 1; break; } eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; /* values near underflow, 1, or overflow */ for (norm = -1; norm <= 1; norm++) { /* number of tests */ for (i = 0; i < ntests; i++) { /* conj or not */ for (conj_val = 0; conj_val < 2; conj_val++) { switch (conj_val) { case 0: conj_type = blas_no_conj; break; case 1: default: conj_type = blas_conj; break; } /* For the sake of speed, we throw out this case at random */ if (xrand(seed) >= test_prob) continue; BLAS_ddot_d_s_testgen(n, 0, 0, norm, conj_type, &alpha, alpha_flag, &beta, beta_flag, x_gen, y_gen, seed, &r, &head_r_true, &tail_r_true); count++; /* varying incx */ for (incx_val = -2; incx_val <= 2; incx_val++) { if (incx_val == 0) continue; dcopy_vector(x_gen, n, 1, x, incx_val); /* varying incy */ for (incy_val = -2; incy_val <= 2; incy_val++) { if (incy_val == 0) continue; scopy_vector(y_gen, n, 1, y, incy_val); /* call BLAS_ddot_d_s to get r_comp */ r_comp = r; FPU_FIX_STOP; BLAS_ddot_d_s(conj_type, n, alpha, x, incx_val, beta, y, incy_val, &r_comp); FPU_FIX_START; /* computing the ratio */ test_BLAS_ddot_d_s(n, conj_type, alpha, beta, r, r_comp, head_r_true, tail_r_true, x, incx_val, y, incy_val, eps_int, un_int, &ratio); /* Increase the number of bad ratio, if the ratio is bigger than the threshold. The !<= below causes NaN error to be detected. Note that (NaN > thresh) is always false. */ if (!(ratio <= thresh)) { bad_ratios++; if ((debug == 3) && /* print only when debug is on */ (count != old_count) && /* print if old vector is different from the current one */ (d_count == find_max_ratio) && (p_count <= max_print) && (ratio > 0.5 * ratio_max)) { old_count = count; printf ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", fname, n, ntests, thresh); /* Print test info */ switch (prec) { case blas_prec_single: printf("single "); break; case blas_prec_double: printf("double "); break; case blas_prec_indigenous: printf("indigenous "); break; case blas_prec_extra: printf("extra "); break; } switch (norm) { case -1: printf("near_underflow "); break; case 0: printf("near_one "); break; case 1: printf("near_overflow "); break; } switch (conj_type) { case blas_no_conj: printf("no_conj "); break; case blas_conj: printf("conj "); break; } printf("incx=%d, incy=%d:\n", incx_val, incy_val); dprint_vector(x, n, incx_val, "x"); sprint_vector(y, n, incy_val, "y"); printf(" "); printf("alpha = "); printf("%24.16e", alpha); printf("\n "); printf("beta = "); printf("%24.16e", beta); printf("\n"); printf(" "); printf("r = "); printf("%24.16e", r); printf("\n "); printf("r_comp = "); printf("%24.16e", r_comp); printf("\n"); printf(" "); printf("r_true = "); printf("[%24.16e %24.16e]", head_r_true, tail_r_true); printf(" ratio=%.4e\n", ratio); p_count++; } } if (d_count == 0) { if (ratio > ratio_max) ratio_max = ratio; if (ratio != 0.0 && ratio < ratio_min) ratio_min = ratio; tot_tests++; } } /* incy */ } /* incx */ } /* conj */ } /* tests */ } /* norm */ } /* beta */ } /* alpha */ } /* debug */ if ((debug == 2) || ((debug == 1) && (bad_ratios > 0))) { printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", fname, n, ntests, thresh); printf (" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests), ratio_min, ratio_max); } blas_free(x); blas_free(y); blas_free(x_gen); blas_free(y_gen); *min_ratio = ratio_min; *num_bad_ratio = bad_ratios; *num_tests = tot_tests; FPU_FIX_STOP; return ratio_max; } double do_test_ddot_s_d(int n, int ntests, int *seed, double thresh, int debug, float test_prob, double *min_ratio, int *num_bad_ratio, int *num_tests) /* * Purpose * ======= * * Runs a series of tests on dots * * Arguments * ========= * * n (input) int * The size of vector being tested * * ntests (input) int * The number of tests to run for each set of attributes. * * seed (input/output) int * The seed for the random number generator used in testgen(). * * thresh (input) double * When the ratio returned from test() exceeds the specified * threshold, the current size, r_true, r_comp, and ratio will be * printed. (Since ratio is supposed to be O(1), we can set thresh * to ~10.) * * debug (input) int * If debug=3, print summary * If debug=2, print summary only if the number of bad ratios > 0 * If debug=1, print complete info if tests fail * If debug=0, return max ratio * * min_ratio (output) double * The minimum ratio * * num_bad_ratio (output) int * The number of tests fail; they are above the threshold. * * num_tests (output) int * The number of tests is being performed. * * Return value * ============ * * The maximum ratio if run successfully, otherwise return -1 * */ { /* function name */ const char fname[] = "BLAS_ddot_s_d"; /* max number of debug lines to print */ const int max_print = 32; /* Variables in the "x_val" form are loop vars for corresponding variables */ int i; /* iterate through the repeating tests */ int incx_val, incy_val; /* for testing different inc values */ int incx_gen, incy_gen; /* for complex case inc=2, for real case inc=1 */ int d_count; /* counter for debug */ int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ int p_count; /* counter for the number of debug lines printed */ int tot_tests; /* total number of tests to be done */ int norm; /* input values of near underflow/one/overflow */ double ratio_max; /* the current maximum ratio */ double ratio_min; /* the current minimum ratio */ double ratio; /* the per-use test ratio from test() */ int bad_ratios = 0; /* the number of ratios over the threshold */ double eps_int; /* the internal epsilon expected--2^(-24) for float */ double un_int; /* the internal underflow threshold */ double alpha; double beta; float *x; double *y; /* x_gen and y_gen are used to store vectors generated by testgen. they eventually are copied back to x and y */ float *x_gen; double *y_gen; /* the true r calculated by testgen(), in double-double */ double head_r_true, tail_r_true; double r; /* the generated r */ double r_comp; /* the r computed by BLAS_ddot_s_d */ int alpha_val; int alpha_flag; /* input flag for BLAS_ddot_s_d_testgen */ int beta_val; int beta_flag; /* input flag for BLAS_ddot_s_d_testgen */ int conj_val; enum blas_conj_type conj_type; enum blas_prec_type prec; int saved_seed; /* for saving the original seed */ int count = 0, old_count = 0; /* use for counting the number of testgen calls * 2 */ FPU_FIX_DECL; /* test for bad arguments */ if (n < 0) BLAS_error(fname, -1, n, NULL); else if (ntests < 0) BLAS_error(fname, -2, ntests, NULL); /* if there is nothing to test, return all zero */ if (n == 0 || ntests == 0) { *min_ratio = 0.0; *num_bad_ratio = 0; *num_tests = 0; return 0.0; } FPU_FIX_START; /* initialization */ saved_seed = *seed; ratio_min = 1e308; ratio_max = 0.0; tot_tests = 0; p_count = 0; count = 0; find_max_ratio = 0; if (debug == 3) find_max_ratio = 1; incx_gen = incy_gen = 1; /* get space for calculation */ x = (float *) blas_malloc(n * 2 * incx_gen * sizeof(float)); if (n * 2 * incx_gen > 0 && x == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y = (double *) blas_malloc(n * 2 * incy_gen * sizeof(double)); if (n * 2 * incy_gen > 0 && y == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } x_gen = (float *) blas_malloc(n * incx_gen * sizeof(float)); if (n * incx_gen > 0 && x_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y_gen = (double *) blas_malloc(n * incy_gen * sizeof(double)); if (n * incy_gen > 0 && y_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } /* The debug iteration: If debug=1, then will execute the iteration twice. First, compute the max ratio. Second, print info if ratio > (50% * ratio_max). */ for (d_count = 0; d_count <= find_max_ratio; d_count++) { bad_ratios = 0; /* set to zero */ if ((debug == 3) && (d_count == find_max_ratio)) *seed = saved_seed; /* restore the original seed */ /* varying alpha */ for (alpha_val = 1; alpha_val < 3; alpha_val++) { alpha_flag = 0; switch (alpha_val) { case 0: alpha = 0.0; alpha_flag = 1; break; case 1: alpha = 1.0; alpha_flag = 1; break; } /* varying beta */ for (beta_val = 0; beta_val < 3; beta_val++) { beta_flag = 0; switch (beta_val) { case 0: beta = 0.0; beta_flag = 1; break; case 1: beta = 1.0; beta_flag = 1; break; } eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; /* values near underflow, 1, or overflow */ for (norm = -1; norm <= 1; norm++) { /* number of tests */ for (i = 0; i < ntests; i++) { /* conj or not */ for (conj_val = 0; conj_val < 2; conj_val++) { switch (conj_val) { case 0: conj_type = blas_no_conj; break; case 1: default: conj_type = blas_conj; break; } /* For the sake of speed, we throw out this case at random */ if (xrand(seed) >= test_prob) continue; BLAS_ddot_s_d_testgen(n, 0, 0, norm, conj_type, &alpha, alpha_flag, &beta, beta_flag, x_gen, y_gen, seed, &r, &head_r_true, &tail_r_true); count++; /* varying incx */ for (incx_val = -2; incx_val <= 2; incx_val++) { if (incx_val == 0) continue; scopy_vector(x_gen, n, 1, x, incx_val); /* varying incy */ for (incy_val = -2; incy_val <= 2; incy_val++) { if (incy_val == 0) continue; dcopy_vector(y_gen, n, 1, y, incy_val); /* call BLAS_ddot_s_d to get r_comp */ r_comp = r; FPU_FIX_STOP; BLAS_ddot_s_d(conj_type, n, alpha, x, incx_val, beta, y, incy_val, &r_comp); FPU_FIX_START; /* computing the ratio */ test_BLAS_ddot_s_d(n, conj_type, alpha, beta, r, r_comp, head_r_true, tail_r_true, x, incx_val, y, incy_val, eps_int, un_int, &ratio); /* Increase the number of bad ratio, if the ratio is bigger than the threshold. The !<= below causes NaN error to be detected. Note that (NaN > thresh) is always false. */ if (!(ratio <= thresh)) { bad_ratios++; if ((debug == 3) && /* print only when debug is on */ (count != old_count) && /* print if old vector is different from the current one */ (d_count == find_max_ratio) && (p_count <= max_print) && (ratio > 0.5 * ratio_max)) { old_count = count; printf ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", fname, n, ntests, thresh); /* Print test info */ switch (prec) { case blas_prec_single: printf("single "); break; case blas_prec_double: printf("double "); break; case blas_prec_indigenous: printf("indigenous "); break; case blas_prec_extra: printf("extra "); break; } switch (norm) { case -1: printf("near_underflow "); break; case 0: printf("near_one "); break; case 1: printf("near_overflow "); break; } switch (conj_type) { case blas_no_conj: printf("no_conj "); break; case blas_conj: printf("conj "); break; } printf("incx=%d, incy=%d:\n", incx_val, incy_val); sprint_vector(x, n, incx_val, "x"); dprint_vector(y, n, incy_val, "y"); printf(" "); printf("alpha = "); printf("%24.16e", alpha); printf("\n "); printf("beta = "); printf("%24.16e", beta); printf("\n"); printf(" "); printf("r = "); printf("%24.16e", r); printf("\n "); printf("r_comp = "); printf("%24.16e", r_comp); printf("\n"); printf(" "); printf("r_true = "); printf("[%24.16e %24.16e]", head_r_true, tail_r_true); printf(" ratio=%.4e\n", ratio); p_count++; } } if (d_count == 0) { if (ratio > ratio_max) ratio_max = ratio; if (ratio != 0.0 && ratio < ratio_min) ratio_min = ratio; tot_tests++; } } /* incy */ } /* incx */ } /* conj */ } /* tests */ } /* norm */ } /* beta */ } /* alpha */ } /* debug */ if ((debug == 2) || ((debug == 1) && (bad_ratios > 0))) { printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", fname, n, ntests, thresh); printf (" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests), ratio_min, ratio_max); } blas_free(x); blas_free(y); blas_free(x_gen); blas_free(y_gen); *min_ratio = ratio_min; *num_bad_ratio = bad_ratios; *num_tests = tot_tests; FPU_FIX_STOP; return ratio_max; } double do_test_ddot_s_s(int n, int ntests, int *seed, double thresh, int debug, float test_prob, double *min_ratio, int *num_bad_ratio, int *num_tests) /* * Purpose * ======= * * Runs a series of tests on dots * * Arguments * ========= * * n (input) int * The size of vector being tested * * ntests (input) int * The number of tests to run for each set of attributes. * * seed (input/output) int * The seed for the random number generator used in testgen(). * * thresh (input) double * When the ratio returned from test() exceeds the specified * threshold, the current size, r_true, r_comp, and ratio will be * printed. (Since ratio is supposed to be O(1), we can set thresh * to ~10.) * * debug (input) int * If debug=3, print summary * If debug=2, print summary only if the number of bad ratios > 0 * If debug=1, print complete info if tests fail * If debug=0, return max ratio * * min_ratio (output) double * The minimum ratio * * num_bad_ratio (output) int * The number of tests fail; they are above the threshold. * * num_tests (output) int * The number of tests is being performed. * * Return value * ============ * * The maximum ratio if run successfully, otherwise return -1 * */ { /* function name */ const char fname[] = "BLAS_ddot_s_s"; /* max number of debug lines to print */ const int max_print = 32; /* Variables in the "x_val" form are loop vars for corresponding variables */ int i; /* iterate through the repeating tests */ int incx_val, incy_val; /* for testing different inc values */ int incx_gen, incy_gen; /* for complex case inc=2, for real case inc=1 */ int d_count; /* counter for debug */ int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ int p_count; /* counter for the number of debug lines printed */ int tot_tests; /* total number of tests to be done */ int norm; /* input values of near underflow/one/overflow */ double ratio_max; /* the current maximum ratio */ double ratio_min; /* the current minimum ratio */ double ratio; /* the per-use test ratio from test() */ int bad_ratios = 0; /* the number of ratios over the threshold */ double eps_int; /* the internal epsilon expected--2^(-24) for float */ double un_int; /* the internal underflow threshold */ double alpha; double beta; float *x; float *y; /* x_gen and y_gen are used to store vectors generated by testgen. they eventually are copied back to x and y */ float *x_gen; float *y_gen; /* the true r calculated by testgen(), in double-double */ double head_r_true, tail_r_true; double r; /* the generated r */ double r_comp; /* the r computed by BLAS_ddot_s_s */ int alpha_val; int alpha_flag; /* input flag for BLAS_ddot_s_s_testgen */ int beta_val; int beta_flag; /* input flag for BLAS_ddot_s_s_testgen */ int conj_val; enum blas_conj_type conj_type; enum blas_prec_type prec; int saved_seed; /* for saving the original seed */ int count = 0, old_count = 0; /* use for counting the number of testgen calls * 2 */ FPU_FIX_DECL; /* test for bad arguments */ if (n < 0) BLAS_error(fname, -1, n, NULL); else if (ntests < 0) BLAS_error(fname, -2, ntests, NULL); /* if there is nothing to test, return all zero */ if (n == 0 || ntests == 0) { *min_ratio = 0.0; *num_bad_ratio = 0; *num_tests = 0; return 0.0; } FPU_FIX_START; /* initialization */ saved_seed = *seed; ratio_min = 1e308; ratio_max = 0.0; tot_tests = 0; p_count = 0; count = 0; find_max_ratio = 0; if (debug == 3) find_max_ratio = 1; incx_gen = incy_gen = 1; /* get space for calculation */ x = (float *) blas_malloc(n * 2 * incx_gen * sizeof(float)); if (n * 2 * incx_gen > 0 && x == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y = (float *) blas_malloc(n * 2 * incy_gen * sizeof(float)); if (n * 2 * incy_gen > 0 && y == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } x_gen = (float *) blas_malloc(n * incx_gen * sizeof(float)); if (n * incx_gen > 0 && x_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y_gen = (float *) blas_malloc(n * incy_gen * sizeof(float)); if (n * incy_gen > 0 && y_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } /* The debug iteration: If debug=1, then will execute the iteration twice. First, compute the max ratio. Second, print info if ratio > (50% * ratio_max). */ for (d_count = 0; d_count <= find_max_ratio; d_count++) { bad_ratios = 0; /* set to zero */ if ((debug == 3) && (d_count == find_max_ratio)) *seed = saved_seed; /* restore the original seed */ /* varying alpha */ for (alpha_val = 1; alpha_val < 3; alpha_val++) { alpha_flag = 0; switch (alpha_val) { case 0: alpha = 0.0; alpha_flag = 1; break; case 1: alpha = 1.0; alpha_flag = 1; break; } /* varying beta */ for (beta_val = 0; beta_val < 3; beta_val++) { beta_flag = 0; switch (beta_val) { case 0: beta = 0.0; beta_flag = 1; break; case 1: beta = 1.0; beta_flag = 1; break; } eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; /* values near underflow, 1, or overflow */ for (norm = -1; norm <= 1; norm++) { /* number of tests */ for (i = 0; i < ntests; i++) { /* conj or not */ for (conj_val = 0; conj_val < 2; conj_val++) { switch (conj_val) { case 0: conj_type = blas_no_conj; break; case 1: default: conj_type = blas_conj; break; } /* For the sake of speed, we throw out this case at random */ if (xrand(seed) >= test_prob) continue; BLAS_ddot_s_s_testgen(n, 0, 0, norm, conj_type, &alpha, alpha_flag, &beta, beta_flag, x_gen, y_gen, seed, &r, &head_r_true, &tail_r_true); count++; /* varying incx */ for (incx_val = -2; incx_val <= 2; incx_val++) { if (incx_val == 0) continue; scopy_vector(x_gen, n, 1, x, incx_val); /* varying incy */ for (incy_val = -2; incy_val <= 2; incy_val++) { if (incy_val == 0) continue; scopy_vector(y_gen, n, 1, y, incy_val); /* call BLAS_ddot_s_s to get r_comp */ r_comp = r; FPU_FIX_STOP; BLAS_ddot_s_s(conj_type, n, alpha, x, incx_val, beta, y, incy_val, &r_comp); FPU_FIX_START; /* computing the ratio */ test_BLAS_ddot_s_s(n, conj_type, alpha, beta, r, r_comp, head_r_true, tail_r_true, x, incx_val, y, incy_val, eps_int, un_int, &ratio); /* Increase the number of bad ratio, if the ratio is bigger than the threshold. The !<= below causes NaN error to be detected. Note that (NaN > thresh) is always false. */ if (!(ratio <= thresh)) { bad_ratios++; if ((debug == 3) && /* print only when debug is on */ (count != old_count) && /* print if old vector is different from the current one */ (d_count == find_max_ratio) && (p_count <= max_print) && (ratio > 0.5 * ratio_max)) { old_count = count; printf ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", fname, n, ntests, thresh); /* Print test info */ switch (prec) { case blas_prec_single: printf("single "); break; case blas_prec_double: printf("double "); break; case blas_prec_indigenous: printf("indigenous "); break; case blas_prec_extra: printf("extra "); break; } switch (norm) { case -1: printf("near_underflow "); break; case 0: printf("near_one "); break; case 1: printf("near_overflow "); break; } switch (conj_type) { case blas_no_conj: printf("no_conj "); break; case blas_conj: printf("conj "); break; } printf("incx=%d, incy=%d:\n", incx_val, incy_val); sprint_vector(x, n, incx_val, "x"); sprint_vector(y, n, incy_val, "y"); printf(" "); printf("alpha = "); printf("%24.16e", alpha); printf("\n "); printf("beta = "); printf("%24.16e", beta); printf("\n"); printf(" "); printf("r = "); printf("%24.16e", r); printf("\n "); printf("r_comp = "); printf("%24.16e", r_comp); printf("\n"); printf(" "); printf("r_true = "); printf("[%24.16e %24.16e]", head_r_true, tail_r_true); printf(" ratio=%.4e\n", ratio); p_count++; } } if (d_count == 0) { if (ratio > ratio_max) ratio_max = ratio; if (ratio != 0.0 && ratio < ratio_min) ratio_min = ratio; tot_tests++; } } /* incy */ } /* incx */ } /* conj */ } /* tests */ } /* norm */ } /* beta */ } /* alpha */ } /* debug */ if ((debug == 2) || ((debug == 1) && (bad_ratios > 0))) { printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", fname, n, ntests, thresh); printf (" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests), ratio_min, ratio_max); } blas_free(x); blas_free(y); blas_free(x_gen); blas_free(y_gen); *min_ratio = ratio_min; *num_bad_ratio = bad_ratios; *num_tests = tot_tests; FPU_FIX_STOP; return ratio_max; } double do_test_zdot_z_c(int n, int ntests, int *seed, double thresh, int debug, float test_prob, double *min_ratio, int *num_bad_ratio, int *num_tests) /* * Purpose * ======= * * Runs a series of tests on dots * * Arguments * ========= * * n (input) int * The size of vector being tested * * ntests (input) int * The number of tests to run for each set of attributes. * * seed (input/output) int * The seed for the random number generator used in testgen(). * * thresh (input) double * When the ratio returned from test() exceeds the specified * threshold, the current size, r_true, r_comp, and ratio will be * printed. (Since ratio is supposed to be O(1), we can set thresh * to ~10.) * * debug (input) int * If debug=3, print summary * If debug=2, print summary only if the number of bad ratios > 0 * If debug=1, print complete info if tests fail * If debug=0, return max ratio * * min_ratio (output) double * The minimum ratio * * num_bad_ratio (output) int * The number of tests fail; they are above the threshold. * * num_tests (output) int * The number of tests is being performed. * * Return value * ============ * * The maximum ratio if run successfully, otherwise return -1 * */ { /* function name */ const char fname[] = "BLAS_zdot_z_c"; /* max number of debug lines to print */ const int max_print = 32; /* Variables in the "x_val" form are loop vars for corresponding variables */ int i; /* iterate through the repeating tests */ int incx_val, incy_val; /* for testing different inc values */ int incx_gen, incy_gen; /* for complex case inc=2, for real case inc=1 */ int d_count; /* counter for debug */ int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ int p_count; /* counter for the number of debug lines printed */ int tot_tests; /* total number of tests to be done */ int norm; /* input values of near underflow/one/overflow */ double ratio_max; /* the current maximum ratio */ double ratio_min; /* the current minimum ratio */ double ratio; /* the per-use test ratio from test() */ int bad_ratios = 0; /* the number of ratios over the threshold */ double eps_int; /* the internal epsilon expected--2^(-24) for float */ double un_int; /* the internal underflow threshold */ double alpha[2]; double beta[2]; double *x; float *y; /* x_gen and y_gen are used to store vectors generated by testgen. they eventually are copied back to x and y */ double *x_gen; float *y_gen; /* the true r calculated by testgen(), in double-double */ double head_r_true[2], tail_r_true[2]; double r[2]; /* the generated r */ double r_comp[2]; /* the r computed by BLAS_zdot_z_c */ int alpha_val; int alpha_flag; /* input flag for BLAS_zdot_z_c_testgen */ int beta_val; int beta_flag; /* input flag for BLAS_zdot_z_c_testgen */ int conj_val; enum blas_conj_type conj_type; enum blas_prec_type prec; int saved_seed; /* for saving the original seed */ int count = 0, old_count = 0; /* use for counting the number of testgen calls * 2 */ FPU_FIX_DECL; /* test for bad arguments */ if (n < 0) BLAS_error(fname, -1, n, NULL); else if (ntests < 0) BLAS_error(fname, -2, ntests, NULL); /* if there is nothing to test, return all zero */ if (n == 0 || ntests == 0) { *min_ratio = 0.0; *num_bad_ratio = 0; *num_tests = 0; return 0.0; } FPU_FIX_START; /* initialization */ saved_seed = *seed; ratio_min = 1e308; ratio_max = 0.0; tot_tests = 0; p_count = 0; count = 0; find_max_ratio = 0; if (debug == 3) find_max_ratio = 1; incx_gen = incy_gen = 1; incx_gen *= 2; incy_gen *= 2; /* get space for calculation */ x = (double *) blas_malloc(n * 2 * incx_gen * sizeof(double) * 2); if (n * 2 * incx_gen > 0 && x == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y = (float *) blas_malloc(n * 2 * incy_gen * sizeof(float) * 2); if (n * 2 * incy_gen > 0 && y == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } x_gen = (double *) blas_malloc(n * incx_gen * sizeof(double) * 2); if (n * incx_gen > 0 && x_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y_gen = (float *) blas_malloc(n * incy_gen * sizeof(float) * 2); if (n * incy_gen > 0 && y_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } /* The debug iteration: If debug=1, then will execute the iteration twice. First, compute the max ratio. Second, print info if ratio > (50% * ratio_max). */ for (d_count = 0; d_count <= find_max_ratio; d_count++) { bad_ratios = 0; /* set to zero */ if ((debug == 3) && (d_count == find_max_ratio)) *seed = saved_seed; /* restore the original seed */ /* varying alpha */ for (alpha_val = 1; alpha_val < 3; alpha_val++) { alpha_flag = 0; switch (alpha_val) { case 0: alpha[0] = alpha[1] = 0.0; alpha_flag = 1; break; case 1: alpha[0] = 1.0; alpha[1] = 0.0; alpha_flag = 1; break; } /* varying beta */ for (beta_val = 0; beta_val < 3; beta_val++) { beta_flag = 0; switch (beta_val) { case 0: beta[0] = beta[1] = 0.0; beta_flag = 1; break; case 1: beta[0] = 1.0; beta[1] = 0.0; beta_flag = 1; break; } eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; /* values near underflow, 1, or overflow */ for (norm = -1; norm <= 1; norm++) { /* number of tests */ for (i = 0; i < ntests; i++) { /* conj or not */ for (conj_val = 0; conj_val < 2; conj_val++) { switch (conj_val) { case 0: conj_type = blas_no_conj; break; case 1: default: conj_type = blas_conj; break; } /* For the sake of speed, we throw out this case at random */ if (xrand(seed) >= test_prob) continue; BLAS_zdot_z_c_testgen(n, 0, 0, norm, conj_type, &alpha, alpha_flag, &beta, beta_flag, x_gen, y_gen, seed, &r, head_r_true, tail_r_true); count++; /* varying incx */ for (incx_val = -2; incx_val <= 2; incx_val++) { if (incx_val == 0) continue; zcopy_vector(x_gen, n, 1, x, incx_val); /* varying incy */ for (incy_val = -2; incy_val <= 2; incy_val++) { if (incy_val == 0) continue; ccopy_vector(y_gen, n, 1, y, incy_val); /* call BLAS_zdot_z_c to get r_comp */ r_comp[0] = r[0]; r_comp[1] = r[1]; FPU_FIX_STOP; BLAS_zdot_z_c(conj_type, n, alpha, x, incx_val, beta, y, incy_val, &r_comp); FPU_FIX_START; /* computing the ratio */ test_BLAS_zdot_z_c(n, conj_type, alpha, beta, r, r_comp, head_r_true, tail_r_true, x, incx_val, y, incy_val, eps_int, un_int, &ratio); /* Increase the number of bad ratio, if the ratio is bigger than the threshold. The !<= below causes NaN error to be detected. Note that (NaN > thresh) is always false. */ if (!(ratio <= thresh)) { bad_ratios++; if ((debug == 3) && /* print only when debug is on */ (count != old_count) && /* print if old vector is different from the current one */ (d_count == find_max_ratio) && (p_count <= max_print) && (ratio > 0.5 * ratio_max)) { old_count = count; printf ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", fname, n, ntests, thresh); /* Print test info */ switch (prec) { case blas_prec_single: printf("single "); break; case blas_prec_double: printf("double "); break; case blas_prec_indigenous: printf("indigenous "); break; case blas_prec_extra: printf("extra "); break; } switch (norm) { case -1: printf("near_underflow "); break; case 0: printf("near_one "); break; case 1: printf("near_overflow "); break; } switch (conj_type) { case blas_no_conj: printf("no_conj "); break; case blas_conj: printf("conj "); break; } printf("incx=%d, incy=%d:\n", incx_val, incy_val); zprint_vector(x, n, incx_val, "x"); cprint_vector(y, n, incy_val, "y"); printf(" "); printf("alpha = "); printf("(%24.16e, %24.16e)", alpha[0], alpha[1]); printf("\n "); printf("beta = "); printf("(%24.16e, %24.16e)", beta[0], beta[1]); printf("\n"); printf(" "); printf("r = "); printf("(%24.16e, %24.16e)", r[0], r[1]); printf("\n "); printf("r_comp = "); printf("(%24.16e, %24.16e)", r_comp[0], r_comp[1]); printf("\n"); printf(" "); printf("r_true = "); printf("([%24.16e %24.16e], [%24.16e %24.16e])", head_r_true[0], tail_r_true[0], head_r_true[1], tail_r_true[1]); printf(" ratio=%.4e\n", ratio); p_count++; } } if (d_count == 0) { if (ratio > ratio_max) ratio_max = ratio; if (ratio != 0.0 && ratio < ratio_min) ratio_min = ratio; tot_tests++; } } /* incy */ } /* incx */ } /* conj */ } /* tests */ } /* norm */ } /* beta */ } /* alpha */ } /* debug */ if ((debug == 2) || ((debug == 1) && (bad_ratios > 0))) { printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", fname, n, ntests, thresh); printf (" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests), ratio_min, ratio_max); } blas_free(x); blas_free(y); blas_free(x_gen); blas_free(y_gen); *min_ratio = ratio_min; *num_bad_ratio = bad_ratios; *num_tests = tot_tests; FPU_FIX_STOP; return ratio_max; } double do_test_zdot_c_z(int n, int ntests, int *seed, double thresh, int debug, float test_prob, double *min_ratio, int *num_bad_ratio, int *num_tests) /* * Purpose * ======= * * Runs a series of tests on dots * * Arguments * ========= * * n (input) int * The size of vector being tested * * ntests (input) int * The number of tests to run for each set of attributes. * * seed (input/output) int * The seed for the random number generator used in testgen(). * * thresh (input) double * When the ratio returned from test() exceeds the specified * threshold, the current size, r_true, r_comp, and ratio will be * printed. (Since ratio is supposed to be O(1), we can set thresh * to ~10.) * * debug (input) int * If debug=3, print summary * If debug=2, print summary only if the number of bad ratios > 0 * If debug=1, print complete info if tests fail * If debug=0, return max ratio * * min_ratio (output) double * The minimum ratio * * num_bad_ratio (output) int * The number of tests fail; they are above the threshold. * * num_tests (output) int * The number of tests is being performed. * * Return value * ============ * * The maximum ratio if run successfully, otherwise return -1 * */ { /* function name */ const char fname[] = "BLAS_zdot_c_z"; /* max number of debug lines to print */ const int max_print = 32; /* Variables in the "x_val" form are loop vars for corresponding variables */ int i; /* iterate through the repeating tests */ int incx_val, incy_val; /* for testing different inc values */ int incx_gen, incy_gen; /* for complex case inc=2, for real case inc=1 */ int d_count; /* counter for debug */ int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ int p_count; /* counter for the number of debug lines printed */ int tot_tests; /* total number of tests to be done */ int norm; /* input values of near underflow/one/overflow */ double ratio_max; /* the current maximum ratio */ double ratio_min; /* the current minimum ratio */ double ratio; /* the per-use test ratio from test() */ int bad_ratios = 0; /* the number of ratios over the threshold */ double eps_int; /* the internal epsilon expected--2^(-24) for float */ double un_int; /* the internal underflow threshold */ double alpha[2]; double beta[2]; float *x; double *y; /* x_gen and y_gen are used to store vectors generated by testgen. they eventually are copied back to x and y */ float *x_gen; double *y_gen; /* the true r calculated by testgen(), in double-double */ double head_r_true[2], tail_r_true[2]; double r[2]; /* the generated r */ double r_comp[2]; /* the r computed by BLAS_zdot_c_z */ int alpha_val; int alpha_flag; /* input flag for BLAS_zdot_c_z_testgen */ int beta_val; int beta_flag; /* input flag for BLAS_zdot_c_z_testgen */ int conj_val; enum blas_conj_type conj_type; enum blas_prec_type prec; int saved_seed; /* for saving the original seed */ int count = 0, old_count = 0; /* use for counting the number of testgen calls * 2 */ FPU_FIX_DECL; /* test for bad arguments */ if (n < 0) BLAS_error(fname, -1, n, NULL); else if (ntests < 0) BLAS_error(fname, -2, ntests, NULL); /* if there is nothing to test, return all zero */ if (n == 0 || ntests == 0) { *min_ratio = 0.0; *num_bad_ratio = 0; *num_tests = 0; return 0.0; } FPU_FIX_START; /* initialization */ saved_seed = *seed; ratio_min = 1e308; ratio_max = 0.0; tot_tests = 0; p_count = 0; count = 0; find_max_ratio = 0; if (debug == 3) find_max_ratio = 1; incx_gen = incy_gen = 1; incx_gen *= 2; incy_gen *= 2; /* get space for calculation */ x = (float *) blas_malloc(n * 2 * incx_gen * sizeof(float) * 2); if (n * 2 * incx_gen > 0 && x == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y = (double *) blas_malloc(n * 2 * incy_gen * sizeof(double) * 2); if (n * 2 * incy_gen > 0 && y == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } x_gen = (float *) blas_malloc(n * incx_gen * sizeof(float) * 2); if (n * incx_gen > 0 && x_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y_gen = (double *) blas_malloc(n * incy_gen * sizeof(double) * 2); if (n * incy_gen > 0 && y_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } /* The debug iteration: If debug=1, then will execute the iteration twice. First, compute the max ratio. Second, print info if ratio > (50% * ratio_max). */ for (d_count = 0; d_count <= find_max_ratio; d_count++) { bad_ratios = 0; /* set to zero */ if ((debug == 3) && (d_count == find_max_ratio)) *seed = saved_seed; /* restore the original seed */ /* varying alpha */ for (alpha_val = 1; alpha_val < 3; alpha_val++) { alpha_flag = 0; switch (alpha_val) { case 0: alpha[0] = alpha[1] = 0.0; alpha_flag = 1; break; case 1: alpha[0] = 1.0; alpha[1] = 0.0; alpha_flag = 1; break; } /* varying beta */ for (beta_val = 0; beta_val < 3; beta_val++) { beta_flag = 0; switch (beta_val) { case 0: beta[0] = beta[1] = 0.0; beta_flag = 1; break; case 1: beta[0] = 1.0; beta[1] = 0.0; beta_flag = 1; break; } eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; /* values near underflow, 1, or overflow */ for (norm = -1; norm <= 1; norm++) { /* number of tests */ for (i = 0; i < ntests; i++) { /* conj or not */ for (conj_val = 0; conj_val < 2; conj_val++) { switch (conj_val) { case 0: conj_type = blas_no_conj; break; case 1: default: conj_type = blas_conj; break; } /* For the sake of speed, we throw out this case at random */ if (xrand(seed) >= test_prob) continue; BLAS_zdot_c_z_testgen(n, 0, 0, norm, conj_type, &alpha, alpha_flag, &beta, beta_flag, x_gen, y_gen, seed, &r, head_r_true, tail_r_true); count++; /* varying incx */ for (incx_val = -2; incx_val <= 2; incx_val++) { if (incx_val == 0) continue; ccopy_vector(x_gen, n, 1, x, incx_val); /* varying incy */ for (incy_val = -2; incy_val <= 2; incy_val++) { if (incy_val == 0) continue; zcopy_vector(y_gen, n, 1, y, incy_val); /* call BLAS_zdot_c_z to get r_comp */ r_comp[0] = r[0]; r_comp[1] = r[1]; FPU_FIX_STOP; BLAS_zdot_c_z(conj_type, n, alpha, x, incx_val, beta, y, incy_val, &r_comp); FPU_FIX_START; /* computing the ratio */ test_BLAS_zdot_c_z(n, conj_type, alpha, beta, r, r_comp, head_r_true, tail_r_true, x, incx_val, y, incy_val, eps_int, un_int, &ratio); /* Increase the number of bad ratio, if the ratio is bigger than the threshold. The !<= below causes NaN error to be detected. Note that (NaN > thresh) is always false. */ if (!(ratio <= thresh)) { bad_ratios++; if ((debug == 3) && /* print only when debug is on */ (count != old_count) && /* print if old vector is different from the current one */ (d_count == find_max_ratio) && (p_count <= max_print) && (ratio > 0.5 * ratio_max)) { old_count = count; printf ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", fname, n, ntests, thresh); /* Print test info */ switch (prec) { case blas_prec_single: printf("single "); break; case blas_prec_double: printf("double "); break; case blas_prec_indigenous: printf("indigenous "); break; case blas_prec_extra: printf("extra "); break; } switch (norm) { case -1: printf("near_underflow "); break; case 0: printf("near_one "); break; case 1: printf("near_overflow "); break; } switch (conj_type) { case blas_no_conj: printf("no_conj "); break; case blas_conj: printf("conj "); break; } printf("incx=%d, incy=%d:\n", incx_val, incy_val); cprint_vector(x, n, incx_val, "x"); zprint_vector(y, n, incy_val, "y"); printf(" "); printf("alpha = "); printf("(%24.16e, %24.16e)", alpha[0], alpha[1]); printf("\n "); printf("beta = "); printf("(%24.16e, %24.16e)", beta[0], beta[1]); printf("\n"); printf(" "); printf("r = "); printf("(%24.16e, %24.16e)", r[0], r[1]); printf("\n "); printf("r_comp = "); printf("(%24.16e, %24.16e)", r_comp[0], r_comp[1]); printf("\n"); printf(" "); printf("r_true = "); printf("([%24.16e %24.16e], [%24.16e %24.16e])", head_r_true[0], tail_r_true[0], head_r_true[1], tail_r_true[1]); printf(" ratio=%.4e\n", ratio); p_count++; } } if (d_count == 0) { if (ratio > ratio_max) ratio_max = ratio; if (ratio != 0.0 && ratio < ratio_min) ratio_min = ratio; tot_tests++; } } /* incy */ } /* incx */ } /* conj */ } /* tests */ } /* norm */ } /* beta */ } /* alpha */ } /* debug */ if ((debug == 2) || ((debug == 1) && (bad_ratios > 0))) { printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", fname, n, ntests, thresh); printf (" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests), ratio_min, ratio_max); } blas_free(x); blas_free(y); blas_free(x_gen); blas_free(y_gen); *min_ratio = ratio_min; *num_bad_ratio = bad_ratios; *num_tests = tot_tests; FPU_FIX_STOP; return ratio_max; } double do_test_zdot_c_c(int n, int ntests, int *seed, double thresh, int debug, float test_prob, double *min_ratio, int *num_bad_ratio, int *num_tests) /* * Purpose * ======= * * Runs a series of tests on dots * * Arguments * ========= * * n (input) int * The size of vector being tested * * ntests (input) int * The number of tests to run for each set of attributes. * * seed (input/output) int * The seed for the random number generator used in testgen(). * * thresh (input) double * When the ratio returned from test() exceeds the specified * threshold, the current size, r_true, r_comp, and ratio will be * printed. (Since ratio is supposed to be O(1), we can set thresh * to ~10.) * * debug (input) int * If debug=3, print summary * If debug=2, print summary only if the number of bad ratios > 0 * If debug=1, print complete info if tests fail * If debug=0, return max ratio * * min_ratio (output) double * The minimum ratio * * num_bad_ratio (output) int * The number of tests fail; they are above the threshold. * * num_tests (output) int * The number of tests is being performed. * * Return value * ============ * * The maximum ratio if run successfully, otherwise return -1 * */ { /* function name */ const char fname[] = "BLAS_zdot_c_c"; /* max number of debug lines to print */ const int max_print = 32; /* Variables in the "x_val" form are loop vars for corresponding variables */ int i; /* iterate through the repeating tests */ int incx_val, incy_val; /* for testing different inc values */ int incx_gen, incy_gen; /* for complex case inc=2, for real case inc=1 */ int d_count; /* counter for debug */ int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ int p_count; /* counter for the number of debug lines printed */ int tot_tests; /* total number of tests to be done */ int norm; /* input values of near underflow/one/overflow */ double ratio_max; /* the current maximum ratio */ double ratio_min; /* the current minimum ratio */ double ratio; /* the per-use test ratio from test() */ int bad_ratios = 0; /* the number of ratios over the threshold */ double eps_int; /* the internal epsilon expected--2^(-24) for float */ double un_int; /* the internal underflow threshold */ double alpha[2]; double beta[2]; float *x; float *y; /* x_gen and y_gen are used to store vectors generated by testgen. they eventually are copied back to x and y */ float *x_gen; float *y_gen; /* the true r calculated by testgen(), in double-double */ double head_r_true[2], tail_r_true[2]; double r[2]; /* the generated r */ double r_comp[2]; /* the r computed by BLAS_zdot_c_c */ int alpha_val; int alpha_flag; /* input flag for BLAS_zdot_c_c_testgen */ int beta_val; int beta_flag; /* input flag for BLAS_zdot_c_c_testgen */ int conj_val; enum blas_conj_type conj_type; enum blas_prec_type prec; int saved_seed; /* for saving the original seed */ int count = 0, old_count = 0; /* use for counting the number of testgen calls * 2 */ FPU_FIX_DECL; /* test for bad arguments */ if (n < 0) BLAS_error(fname, -1, n, NULL); else if (ntests < 0) BLAS_error(fname, -2, ntests, NULL); /* if there is nothing to test, return all zero */ if (n == 0 || ntests == 0) { *min_ratio = 0.0; *num_bad_ratio = 0; *num_tests = 0; return 0.0; } FPU_FIX_START; /* initialization */ saved_seed = *seed; ratio_min = 1e308; ratio_max = 0.0; tot_tests = 0; p_count = 0; count = 0; find_max_ratio = 0; if (debug == 3) find_max_ratio = 1; incx_gen = incy_gen = 1; incx_gen *= 2; incy_gen *= 2; /* get space for calculation */ x = (float *) blas_malloc(n * 2 * incx_gen * sizeof(float) * 2); if (n * 2 * incx_gen > 0 && x == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y = (float *) blas_malloc(n * 2 * incy_gen * sizeof(float) * 2); if (n * 2 * incy_gen > 0 && y == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } x_gen = (float *) blas_malloc(n * incx_gen * sizeof(float) * 2); if (n * incx_gen > 0 && x_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y_gen = (float *) blas_malloc(n * incy_gen * sizeof(float) * 2); if (n * incy_gen > 0 && y_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } /* The debug iteration: If debug=1, then will execute the iteration twice. First, compute the max ratio. Second, print info if ratio > (50% * ratio_max). */ for (d_count = 0; d_count <= find_max_ratio; d_count++) { bad_ratios = 0; /* set to zero */ if ((debug == 3) && (d_count == find_max_ratio)) *seed = saved_seed; /* restore the original seed */ /* varying alpha */ for (alpha_val = 1; alpha_val < 3; alpha_val++) { alpha_flag = 0; switch (alpha_val) { case 0: alpha[0] = alpha[1] = 0.0; alpha_flag = 1; break; case 1: alpha[0] = 1.0; alpha[1] = 0.0; alpha_flag = 1; break; } /* varying beta */ for (beta_val = 0; beta_val < 3; beta_val++) { beta_flag = 0; switch (beta_val) { case 0: beta[0] = beta[1] = 0.0; beta_flag = 1; break; case 1: beta[0] = 1.0; beta[1] = 0.0; beta_flag = 1; break; } eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; /* values near underflow, 1, or overflow */ for (norm = -1; norm <= 1; norm++) { /* number of tests */ for (i = 0; i < ntests; i++) { /* conj or not */ for (conj_val = 0; conj_val < 2; conj_val++) { switch (conj_val) { case 0: conj_type = blas_no_conj; break; case 1: default: conj_type = blas_conj; break; } /* For the sake of speed, we throw out this case at random */ if (xrand(seed) >= test_prob) continue; BLAS_zdot_c_c_testgen(n, 0, 0, norm, conj_type, &alpha, alpha_flag, &beta, beta_flag, x_gen, y_gen, seed, &r, head_r_true, tail_r_true); count++; /* varying incx */ for (incx_val = -2; incx_val <= 2; incx_val++) { if (incx_val == 0) continue; ccopy_vector(x_gen, n, 1, x, incx_val); /* varying incy */ for (incy_val = -2; incy_val <= 2; incy_val++) { if (incy_val == 0) continue; ccopy_vector(y_gen, n, 1, y, incy_val); /* call BLAS_zdot_c_c to get r_comp */ r_comp[0] = r[0]; r_comp[1] = r[1]; FPU_FIX_STOP; BLAS_zdot_c_c(conj_type, n, alpha, x, incx_val, beta, y, incy_val, &r_comp); FPU_FIX_START; /* computing the ratio */ test_BLAS_zdot_c_c(n, conj_type, alpha, beta, r, r_comp, head_r_true, tail_r_true, x, incx_val, y, incy_val, eps_int, un_int, &ratio); /* Increase the number of bad ratio, if the ratio is bigger than the threshold. The !<= below causes NaN error to be detected. Note that (NaN > thresh) is always false. */ if (!(ratio <= thresh)) { bad_ratios++; if ((debug == 3) && /* print only when debug is on */ (count != old_count) && /* print if old vector is different from the current one */ (d_count == find_max_ratio) && (p_count <= max_print) && (ratio > 0.5 * ratio_max)) { old_count = count; printf ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", fname, n, ntests, thresh); /* Print test info */ switch (prec) { case blas_prec_single: printf("single "); break; case blas_prec_double: printf("double "); break; case blas_prec_indigenous: printf("indigenous "); break; case blas_prec_extra: printf("extra "); break; } switch (norm) { case -1: printf("near_underflow "); break; case 0: printf("near_one "); break; case 1: printf("near_overflow "); break; } switch (conj_type) { case blas_no_conj: printf("no_conj "); break; case blas_conj: printf("conj "); break; } printf("incx=%d, incy=%d:\n", incx_val, incy_val); cprint_vector(x, n, incx_val, "x"); cprint_vector(y, n, incy_val, "y"); printf(" "); printf("alpha = "); printf("(%24.16e, %24.16e)", alpha[0], alpha[1]); printf("\n "); printf("beta = "); printf("(%24.16e, %24.16e)", beta[0], beta[1]); printf("\n"); printf(" "); printf("r = "); printf("(%24.16e, %24.16e)", r[0], r[1]); printf("\n "); printf("r_comp = "); printf("(%24.16e, %24.16e)", r_comp[0], r_comp[1]); printf("\n"); printf(" "); printf("r_true = "); printf("([%24.16e %24.16e], [%24.16e %24.16e])", head_r_true[0], tail_r_true[0], head_r_true[1], tail_r_true[1]); printf(" ratio=%.4e\n", ratio); p_count++; } } if (d_count == 0) { if (ratio > ratio_max) ratio_max = ratio; if (ratio != 0.0 && ratio < ratio_min) ratio_min = ratio; tot_tests++; } } /* incy */ } /* incx */ } /* conj */ } /* tests */ } /* norm */ } /* beta */ } /* alpha */ } /* debug */ if ((debug == 2) || ((debug == 1) && (bad_ratios > 0))) { printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", fname, n, ntests, thresh); printf (" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests), ratio_min, ratio_max); } blas_free(x); blas_free(y); blas_free(x_gen); blas_free(y_gen); *min_ratio = ratio_min; *num_bad_ratio = bad_ratios; *num_tests = tot_tests; FPU_FIX_STOP; return ratio_max; } double do_test_cdot_c_s(int n, int ntests, int *seed, double thresh, int debug, float test_prob, double *min_ratio, int *num_bad_ratio, int *num_tests) /* * Purpose * ======= * * Runs a series of tests on dots * * Arguments * ========= * * n (input) int * The size of vector being tested * * ntests (input) int * The number of tests to run for each set of attributes. * * seed (input/output) int * The seed for the random number generator used in testgen(). * * thresh (input) double * When the ratio returned from test() exceeds the specified * threshold, the current size, r_true, r_comp, and ratio will be * printed. (Since ratio is supposed to be O(1), we can set thresh * to ~10.) * * debug (input) int * If debug=3, print summary * If debug=2, print summary only if the number of bad ratios > 0 * If debug=1, print complete info if tests fail * If debug=0, return max ratio * * min_ratio (output) double * The minimum ratio * * num_bad_ratio (output) int * The number of tests fail; they are above the threshold. * * num_tests (output) int * The number of tests is being performed. * * Return value * ============ * * The maximum ratio if run successfully, otherwise return -1 * */ { /* function name */ const char fname[] = "BLAS_cdot_c_s"; /* max number of debug lines to print */ const int max_print = 32; /* Variables in the "x_val" form are loop vars for corresponding variables */ int i; /* iterate through the repeating tests */ int incx_val, incy_val; /* for testing different inc values */ int incx_gen, incy_gen; /* for complex case inc=2, for real case inc=1 */ int d_count; /* counter for debug */ int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ int p_count; /* counter for the number of debug lines printed */ int tot_tests; /* total number of tests to be done */ int norm; /* input values of near underflow/one/overflow */ double ratio_max; /* the current maximum ratio */ double ratio_min; /* the current minimum ratio */ double ratio; /* the per-use test ratio from test() */ int bad_ratios = 0; /* the number of ratios over the threshold */ double eps_int; /* the internal epsilon expected--2^(-24) for float */ double un_int; /* the internal underflow threshold */ float alpha[2]; float beta[2]; float *x; float *y; /* x_gen and y_gen are used to store vectors generated by testgen. they eventually are copied back to x and y */ float *x_gen; float *y_gen; /* the true r calculated by testgen(), in double-double */ double head_r_true[2], tail_r_true[2]; float r[2]; /* the generated r */ float r_comp[2]; /* the r computed by BLAS_cdot_c_s */ int alpha_val; int alpha_flag; /* input flag for BLAS_cdot_c_s_testgen */ int beta_val; int beta_flag; /* input flag for BLAS_cdot_c_s_testgen */ int conj_val; enum blas_conj_type conj_type; enum blas_prec_type prec; int saved_seed; /* for saving the original seed */ int count = 0, old_count = 0; /* use for counting the number of testgen calls * 2 */ FPU_FIX_DECL; /* test for bad arguments */ if (n < 0) BLAS_error(fname, -1, n, NULL); else if (ntests < 0) BLAS_error(fname, -2, ntests, NULL); /* if there is nothing to test, return all zero */ if (n == 0 || ntests == 0) { *min_ratio = 0.0; *num_bad_ratio = 0; *num_tests = 0; return 0.0; } FPU_FIX_START; /* initialization */ saved_seed = *seed; ratio_min = 1e308; ratio_max = 0.0; tot_tests = 0; p_count = 0; count = 0; find_max_ratio = 0; if (debug == 3) find_max_ratio = 1; incx_gen = incy_gen = 1; incx_gen *= 2; /* get space for calculation */ x = (float *) blas_malloc(n * 2 * incx_gen * sizeof(float) * 2); if (n * 2 * incx_gen > 0 && x == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y = (float *) blas_malloc(n * 2 * incy_gen * sizeof(float)); if (n * 2 * incy_gen > 0 && y == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } x_gen = (float *) blas_malloc(n * incx_gen * sizeof(float) * 2); if (n * incx_gen > 0 && x_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y_gen = (float *) blas_malloc(n * incy_gen * sizeof(float)); if (n * incy_gen > 0 && y_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } /* The debug iteration: If debug=1, then will execute the iteration twice. First, compute the max ratio. Second, print info if ratio > (50% * ratio_max). */ for (d_count = 0; d_count <= find_max_ratio; d_count++) { bad_ratios = 0; /* set to zero */ if ((debug == 3) && (d_count == find_max_ratio)) *seed = saved_seed; /* restore the original seed */ /* varying alpha */ for (alpha_val = 1; alpha_val < 3; alpha_val++) { alpha_flag = 0; switch (alpha_val) { case 0: alpha[0] = alpha[1] = 0.0; alpha_flag = 1; break; case 1: alpha[0] = 1.0; alpha[1] = 0.0; alpha_flag = 1; break; } /* varying beta */ for (beta_val = 0; beta_val < 3; beta_val++) { beta_flag = 0; switch (beta_val) { case 0: beta[0] = beta[1] = 0.0; beta_flag = 1; break; case 1: beta[0] = 1.0; beta[1] = 0.0; beta_flag = 1; break; } eps_int = power(2, -BITS_S); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_single), (double) BLAS_fpinfo_x(blas_emin, blas_prec_single)); prec = blas_prec_single; /* values near underflow, 1, or overflow */ for (norm = -1; norm <= 1; norm++) { /* number of tests */ for (i = 0; i < ntests; i++) { /* conj or not */ for (conj_val = 0; conj_val < 2; conj_val++) { switch (conj_val) { case 0: conj_type = blas_no_conj; break; case 1: default: conj_type = blas_conj; break; } /* For the sake of speed, we throw out this case at random */ if (xrand(seed) >= test_prob) continue; BLAS_cdot_c_s_testgen(n, 0, 0, norm, conj_type, &alpha, alpha_flag, &beta, beta_flag, x_gen, y_gen, seed, &r, head_r_true, tail_r_true); count++; /* varying incx */ for (incx_val = -2; incx_val <= 2; incx_val++) { if (incx_val == 0) continue; ccopy_vector(x_gen, n, 1, x, incx_val); /* varying incy */ for (incy_val = -2; incy_val <= 2; incy_val++) { if (incy_val == 0) continue; scopy_vector(y_gen, n, 1, y, incy_val); /* call BLAS_cdot_c_s to get r_comp */ r_comp[0] = r[0]; r_comp[1] = r[1]; FPU_FIX_STOP; BLAS_cdot_c_s(conj_type, n, alpha, x, incx_val, beta, y, incy_val, &r_comp); FPU_FIX_START; /* computing the ratio */ test_BLAS_cdot_c_s(n, conj_type, alpha, beta, r, r_comp, head_r_true, tail_r_true, x, incx_val, y, incy_val, eps_int, un_int, &ratio); /* Increase the number of bad ratio, if the ratio is bigger than the threshold. The !<= below causes NaN error to be detected. Note that (NaN > thresh) is always false. */ if (!(ratio <= thresh)) { bad_ratios++; if ((debug == 3) && /* print only when debug is on */ (count != old_count) && /* print if old vector is different from the current one */ (d_count == find_max_ratio) && (p_count <= max_print) && (ratio > 0.5 * ratio_max)) { old_count = count; printf ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", fname, n, ntests, thresh); /* Print test info */ switch (prec) { case blas_prec_single: printf("single "); break; case blas_prec_double: printf("double "); break; case blas_prec_indigenous: printf("indigenous "); break; case blas_prec_extra: printf("extra "); break; } switch (norm) { case -1: printf("near_underflow "); break; case 0: printf("near_one "); break; case 1: printf("near_overflow "); break; } switch (conj_type) { case blas_no_conj: printf("no_conj "); break; case blas_conj: printf("conj "); break; } printf("incx=%d, incy=%d:\n", incx_val, incy_val); cprint_vector(x, n, incx_val, "x"); sprint_vector(y, n, incy_val, "y"); printf(" "); printf("alpha = "); printf("(%16.8e, %16.8e)", alpha[0], alpha[1]); printf("\n "); printf("beta = "); printf("(%16.8e, %16.8e)", beta[0], beta[1]); printf("\n"); printf(" "); printf("r = "); printf("(%16.8e, %16.8e)", r[0], r[1]); printf("\n "); printf("r_comp = "); printf("(%16.8e, %16.8e)", r_comp[0], r_comp[1]); printf("\n"); printf(" "); printf("r_true = "); printf("([%24.16e %24.16e], [%24.16e %24.16e])", head_r_true[0], tail_r_true[0], head_r_true[1], tail_r_true[1]); printf(" ratio=%.4e\n", ratio); p_count++; } } if (d_count == 0) { if (ratio > ratio_max) ratio_max = ratio; if (ratio != 0.0 && ratio < ratio_min) ratio_min = ratio; tot_tests++; } } /* incy */ } /* incx */ } /* conj */ } /* tests */ } /* norm */ } /* beta */ } /* alpha */ } /* debug */ if ((debug == 2) || ((debug == 1) && (bad_ratios > 0))) { printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", fname, n, ntests, thresh); printf (" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests), ratio_min, ratio_max); } blas_free(x); blas_free(y); blas_free(x_gen); blas_free(y_gen); *min_ratio = ratio_min; *num_bad_ratio = bad_ratios; *num_tests = tot_tests; FPU_FIX_STOP; return ratio_max; } double do_test_cdot_s_c(int n, int ntests, int *seed, double thresh, int debug, float test_prob, double *min_ratio, int *num_bad_ratio, int *num_tests) /* * Purpose * ======= * * Runs a series of tests on dots * * Arguments * ========= * * n (input) int * The size of vector being tested * * ntests (input) int * The number of tests to run for each set of attributes. * * seed (input/output) int * The seed for the random number generator used in testgen(). * * thresh (input) double * When the ratio returned from test() exceeds the specified * threshold, the current size, r_true, r_comp, and ratio will be * printed. (Since ratio is supposed to be O(1), we can set thresh * to ~10.) * * debug (input) int * If debug=3, print summary * If debug=2, print summary only if the number of bad ratios > 0 * If debug=1, print complete info if tests fail * If debug=0, return max ratio * * min_ratio (output) double * The minimum ratio * * num_bad_ratio (output) int * The number of tests fail; they are above the threshold. * * num_tests (output) int * The number of tests is being performed. * * Return value * ============ * * The maximum ratio if run successfully, otherwise return -1 * */ { /* function name */ const char fname[] = "BLAS_cdot_s_c"; /* max number of debug lines to print */ const int max_print = 32; /* Variables in the "x_val" form are loop vars for corresponding variables */ int i; /* iterate through the repeating tests */ int incx_val, incy_val; /* for testing different inc values */ int incx_gen, incy_gen; /* for complex case inc=2, for real case inc=1 */ int d_count; /* counter for debug */ int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ int p_count; /* counter for the number of debug lines printed */ int tot_tests; /* total number of tests to be done */ int norm; /* input values of near underflow/one/overflow */ double ratio_max; /* the current maximum ratio */ double ratio_min; /* the current minimum ratio */ double ratio; /* the per-use test ratio from test() */ int bad_ratios = 0; /* the number of ratios over the threshold */ double eps_int; /* the internal epsilon expected--2^(-24) for float */ double un_int; /* the internal underflow threshold */ float alpha[2]; float beta[2]; float *x; float *y; /* x_gen and y_gen are used to store vectors generated by testgen. they eventually are copied back to x and y */ float *x_gen; float *y_gen; /* the true r calculated by testgen(), in double-double */ double head_r_true[2], tail_r_true[2]; float r[2]; /* the generated r */ float r_comp[2]; /* the r computed by BLAS_cdot_s_c */ int alpha_val; int alpha_flag; /* input flag for BLAS_cdot_s_c_testgen */ int beta_val; int beta_flag; /* input flag for BLAS_cdot_s_c_testgen */ int conj_val; enum blas_conj_type conj_type; enum blas_prec_type prec; int saved_seed; /* for saving the original seed */ int count = 0, old_count = 0; /* use for counting the number of testgen calls * 2 */ FPU_FIX_DECL; /* test for bad arguments */ if (n < 0) BLAS_error(fname, -1, n, NULL); else if (ntests < 0) BLAS_error(fname, -2, ntests, NULL); /* if there is nothing to test, return all zero */ if (n == 0 || ntests == 0) { *min_ratio = 0.0; *num_bad_ratio = 0; *num_tests = 0; return 0.0; } FPU_FIX_START; /* initialization */ saved_seed = *seed; ratio_min = 1e308; ratio_max = 0.0; tot_tests = 0; p_count = 0; count = 0; find_max_ratio = 0; if (debug == 3) find_max_ratio = 1; incx_gen = incy_gen = 1; incy_gen *= 2; /* get space for calculation */ x = (float *) blas_malloc(n * 2 * incx_gen * sizeof(float)); if (n * 2 * incx_gen > 0 && x == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y = (float *) blas_malloc(n * 2 * incy_gen * sizeof(float) * 2); if (n * 2 * incy_gen > 0 && y == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } x_gen = (float *) blas_malloc(n * incx_gen * sizeof(float)); if (n * incx_gen > 0 && x_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y_gen = (float *) blas_malloc(n * incy_gen * sizeof(float) * 2); if (n * incy_gen > 0 && y_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } /* The debug iteration: If debug=1, then will execute the iteration twice. First, compute the max ratio. Second, print info if ratio > (50% * ratio_max). */ for (d_count = 0; d_count <= find_max_ratio; d_count++) { bad_ratios = 0; /* set to zero */ if ((debug == 3) && (d_count == find_max_ratio)) *seed = saved_seed; /* restore the original seed */ /* varying alpha */ for (alpha_val = 1; alpha_val < 3; alpha_val++) { alpha_flag = 0; switch (alpha_val) { case 0: alpha[0] = alpha[1] = 0.0; alpha_flag = 1; break; case 1: alpha[0] = 1.0; alpha[1] = 0.0; alpha_flag = 1; break; } /* varying beta */ for (beta_val = 0; beta_val < 3; beta_val++) { beta_flag = 0; switch (beta_val) { case 0: beta[0] = beta[1] = 0.0; beta_flag = 1; break; case 1: beta[0] = 1.0; beta[1] = 0.0; beta_flag = 1; break; } eps_int = power(2, -BITS_S); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_single), (double) BLAS_fpinfo_x(blas_emin, blas_prec_single)); prec = blas_prec_single; /* values near underflow, 1, or overflow */ for (norm = -1; norm <= 1; norm++) { /* number of tests */ for (i = 0; i < ntests; i++) { /* conj or not */ for (conj_val = 0; conj_val < 2; conj_val++) { switch (conj_val) { case 0: conj_type = blas_no_conj; break; case 1: default: conj_type = blas_conj; break; } /* For the sake of speed, we throw out this case at random */ if (xrand(seed) >= test_prob) continue; BLAS_cdot_s_c_testgen(n, 0, 0, norm, conj_type, &alpha, alpha_flag, &beta, beta_flag, x_gen, y_gen, seed, &r, head_r_true, tail_r_true); count++; /* varying incx */ for (incx_val = -2; incx_val <= 2; incx_val++) { if (incx_val == 0) continue; scopy_vector(x_gen, n, 1, x, incx_val); /* varying incy */ for (incy_val = -2; incy_val <= 2; incy_val++) { if (incy_val == 0) continue; ccopy_vector(y_gen, n, 1, y, incy_val); /* call BLAS_cdot_s_c to get r_comp */ r_comp[0] = r[0]; r_comp[1] = r[1]; FPU_FIX_STOP; BLAS_cdot_s_c(conj_type, n, alpha, x, incx_val, beta, y, incy_val, &r_comp); FPU_FIX_START; /* computing the ratio */ test_BLAS_cdot_s_c(n, conj_type, alpha, beta, r, r_comp, head_r_true, tail_r_true, x, incx_val, y, incy_val, eps_int, un_int, &ratio); /* Increase the number of bad ratio, if the ratio is bigger than the threshold. The !<= below causes NaN error to be detected. Note that (NaN > thresh) is always false. */ if (!(ratio <= thresh)) { bad_ratios++; if ((debug == 3) && /* print only when debug is on */ (count != old_count) && /* print if old vector is different from the current one */ (d_count == find_max_ratio) && (p_count <= max_print) && (ratio > 0.5 * ratio_max)) { old_count = count; printf ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", fname, n, ntests, thresh); /* Print test info */ switch (prec) { case blas_prec_single: printf("single "); break; case blas_prec_double: printf("double "); break; case blas_prec_indigenous: printf("indigenous "); break; case blas_prec_extra: printf("extra "); break; } switch (norm) { case -1: printf("near_underflow "); break; case 0: printf("near_one "); break; case 1: printf("near_overflow "); break; } switch (conj_type) { case blas_no_conj: printf("no_conj "); break; case blas_conj: printf("conj "); break; } printf("incx=%d, incy=%d:\n", incx_val, incy_val); sprint_vector(x, n, incx_val, "x"); cprint_vector(y, n, incy_val, "y"); printf(" "); printf("alpha = "); printf("(%16.8e, %16.8e)", alpha[0], alpha[1]); printf("\n "); printf("beta = "); printf("(%16.8e, %16.8e)", beta[0], beta[1]); printf("\n"); printf(" "); printf("r = "); printf("(%16.8e, %16.8e)", r[0], r[1]); printf("\n "); printf("r_comp = "); printf("(%16.8e, %16.8e)", r_comp[0], r_comp[1]); printf("\n"); printf(" "); printf("r_true = "); printf("([%24.16e %24.16e], [%24.16e %24.16e])", head_r_true[0], tail_r_true[0], head_r_true[1], tail_r_true[1]); printf(" ratio=%.4e\n", ratio); p_count++; } } if (d_count == 0) { if (ratio > ratio_max) ratio_max = ratio; if (ratio != 0.0 && ratio < ratio_min) ratio_min = ratio; tot_tests++; } } /* incy */ } /* incx */ } /* conj */ } /* tests */ } /* norm */ } /* beta */ } /* alpha */ } /* debug */ if ((debug == 2) || ((debug == 1) && (bad_ratios > 0))) { printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", fname, n, ntests, thresh); printf (" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests), ratio_min, ratio_max); } blas_free(x); blas_free(y); blas_free(x_gen); blas_free(y_gen); *min_ratio = ratio_min; *num_bad_ratio = bad_ratios; *num_tests = tot_tests; FPU_FIX_STOP; return ratio_max; } double do_test_cdot_s_s(int n, int ntests, int *seed, double thresh, int debug, float test_prob, double *min_ratio, int *num_bad_ratio, int *num_tests) /* * Purpose * ======= * * Runs a series of tests on dots * * Arguments * ========= * * n (input) int * The size of vector being tested * * ntests (input) int * The number of tests to run for each set of attributes. * * seed (input/output) int * The seed for the random number generator used in testgen(). * * thresh (input) double * When the ratio returned from test() exceeds the specified * threshold, the current size, r_true, r_comp, and ratio will be * printed. (Since ratio is supposed to be O(1), we can set thresh * to ~10.) * * debug (input) int * If debug=3, print summary * If debug=2, print summary only if the number of bad ratios > 0 * If debug=1, print complete info if tests fail * If debug=0, return max ratio * * min_ratio (output) double * The minimum ratio * * num_bad_ratio (output) int * The number of tests fail; they are above the threshold. * * num_tests (output) int * The number of tests is being performed. * * Return value * ============ * * The maximum ratio if run successfully, otherwise return -1 * */ { /* function name */ const char fname[] = "BLAS_cdot_s_s"; /* max number of debug lines to print */ const int max_print = 32; /* Variables in the "x_val" form are loop vars for corresponding variables */ int i; /* iterate through the repeating tests */ int incx_val, incy_val; /* for testing different inc values */ int incx_gen, incy_gen; /* for complex case inc=2, for real case inc=1 */ int d_count; /* counter for debug */ int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ int p_count; /* counter for the number of debug lines printed */ int tot_tests; /* total number of tests to be done */ int norm; /* input values of near underflow/one/overflow */ double ratio_max; /* the current maximum ratio */ double ratio_min; /* the current minimum ratio */ double ratio; /* the per-use test ratio from test() */ int bad_ratios = 0; /* the number of ratios over the threshold */ double eps_int; /* the internal epsilon expected--2^(-24) for float */ double un_int; /* the internal underflow threshold */ float alpha[2]; float beta[2]; float *x; float *y; /* x_gen and y_gen are used to store vectors generated by testgen. they eventually are copied back to x and y */ float *x_gen; float *y_gen; /* the true r calculated by testgen(), in double-double */ double head_r_true[2], tail_r_true[2]; float r[2]; /* the generated r */ float r_comp[2]; /* the r computed by BLAS_cdot_s_s */ int alpha_val; int alpha_flag; /* input flag for BLAS_cdot_s_s_testgen */ int beta_val; int beta_flag; /* input flag for BLAS_cdot_s_s_testgen */ int conj_val; enum blas_conj_type conj_type; enum blas_prec_type prec; int saved_seed; /* for saving the original seed */ int count = 0, old_count = 0; /* use for counting the number of testgen calls * 2 */ FPU_FIX_DECL; /* test for bad arguments */ if (n < 0) BLAS_error(fname, -1, n, NULL); else if (ntests < 0) BLAS_error(fname, -2, ntests, NULL); /* if there is nothing to test, return all zero */ if (n == 0 || ntests == 0) { *min_ratio = 0.0; *num_bad_ratio = 0; *num_tests = 0; return 0.0; } FPU_FIX_START; /* initialization */ saved_seed = *seed; ratio_min = 1e308; ratio_max = 0.0; tot_tests = 0; p_count = 0; count = 0; find_max_ratio = 0; if (debug == 3) find_max_ratio = 1; incx_gen = incy_gen = 1; /* get space for calculation */ x = (float *) blas_malloc(n * 2 * incx_gen * sizeof(float)); if (n * 2 * incx_gen > 0 && x == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y = (float *) blas_malloc(n * 2 * incy_gen * sizeof(float)); if (n * 2 * incy_gen > 0 && y == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } x_gen = (float *) blas_malloc(n * incx_gen * sizeof(float)); if (n * incx_gen > 0 && x_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y_gen = (float *) blas_malloc(n * incy_gen * sizeof(float)); if (n * incy_gen > 0 && y_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } /* The debug iteration: If debug=1, then will execute the iteration twice. First, compute the max ratio. Second, print info if ratio > (50% * ratio_max). */ for (d_count = 0; d_count <= find_max_ratio; d_count++) { bad_ratios = 0; /* set to zero */ if ((debug == 3) && (d_count == find_max_ratio)) *seed = saved_seed; /* restore the original seed */ /* varying alpha */ for (alpha_val = 1; alpha_val < 3; alpha_val++) { alpha_flag = 0; switch (alpha_val) { case 0: alpha[0] = alpha[1] = 0.0; alpha_flag = 1; break; case 1: alpha[0] = 1.0; alpha[1] = 0.0; alpha_flag = 1; break; } /* varying beta */ for (beta_val = 0; beta_val < 3; beta_val++) { beta_flag = 0; switch (beta_val) { case 0: beta[0] = beta[1] = 0.0; beta_flag = 1; break; case 1: beta[0] = 1.0; beta[1] = 0.0; beta_flag = 1; break; } eps_int = power(2, -BITS_S); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_single), (double) BLAS_fpinfo_x(blas_emin, blas_prec_single)); prec = blas_prec_single; /* values near underflow, 1, or overflow */ for (norm = -1; norm <= 1; norm++) { /* number of tests */ for (i = 0; i < ntests; i++) { /* conj or not */ for (conj_val = 0; conj_val < 2; conj_val++) { switch (conj_val) { case 0: conj_type = blas_no_conj; break; case 1: default: conj_type = blas_conj; break; } /* For the sake of speed, we throw out this case at random */ if (xrand(seed) >= test_prob) continue; BLAS_cdot_s_s_testgen(n, 0, 0, norm, conj_type, &alpha, alpha_flag, &beta, beta_flag, x_gen, y_gen, seed, &r, head_r_true, tail_r_true); count++; /* varying incx */ for (incx_val = -2; incx_val <= 2; incx_val++) { if (incx_val == 0) continue; scopy_vector(x_gen, n, 1, x, incx_val); /* varying incy */ for (incy_val = -2; incy_val <= 2; incy_val++) { if (incy_val == 0) continue; scopy_vector(y_gen, n, 1, y, incy_val); /* call BLAS_cdot_s_s to get r_comp */ r_comp[0] = r[0]; r_comp[1] = r[1]; FPU_FIX_STOP; BLAS_cdot_s_s(conj_type, n, alpha, x, incx_val, beta, y, incy_val, &r_comp); FPU_FIX_START; /* computing the ratio */ test_BLAS_cdot_s_s(n, conj_type, alpha, beta, r, r_comp, head_r_true, tail_r_true, x, incx_val, y, incy_val, eps_int, un_int, &ratio); /* Increase the number of bad ratio, if the ratio is bigger than the threshold. The !<= below causes NaN error to be detected. Note that (NaN > thresh) is always false. */ if (!(ratio <= thresh)) { bad_ratios++; if ((debug == 3) && /* print only when debug is on */ (count != old_count) && /* print if old vector is different from the current one */ (d_count == find_max_ratio) && (p_count <= max_print) && (ratio > 0.5 * ratio_max)) { old_count = count; printf ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", fname, n, ntests, thresh); /* Print test info */ switch (prec) { case blas_prec_single: printf("single "); break; case blas_prec_double: printf("double "); break; case blas_prec_indigenous: printf("indigenous "); break; case blas_prec_extra: printf("extra "); break; } switch (norm) { case -1: printf("near_underflow "); break; case 0: printf("near_one "); break; case 1: printf("near_overflow "); break; } switch (conj_type) { case blas_no_conj: printf("no_conj "); break; case blas_conj: printf("conj "); break; } printf("incx=%d, incy=%d:\n", incx_val, incy_val); sprint_vector(x, n, incx_val, "x"); sprint_vector(y, n, incy_val, "y"); printf(" "); printf("alpha = "); printf("(%16.8e, %16.8e)", alpha[0], alpha[1]); printf("\n "); printf("beta = "); printf("(%16.8e, %16.8e)", beta[0], beta[1]); printf("\n"); printf(" "); printf("r = "); printf("(%16.8e, %16.8e)", r[0], r[1]); printf("\n "); printf("r_comp = "); printf("(%16.8e, %16.8e)", r_comp[0], r_comp[1]); printf("\n"); printf(" "); printf("r_true = "); printf("([%24.16e %24.16e], [%24.16e %24.16e])", head_r_true[0], tail_r_true[0], head_r_true[1], tail_r_true[1]); printf(" ratio=%.4e\n", ratio); p_count++; } } if (d_count == 0) { if (ratio > ratio_max) ratio_max = ratio; if (ratio != 0.0 && ratio < ratio_min) ratio_min = ratio; tot_tests++; } } /* incy */ } /* incx */ } /* conj */ } /* tests */ } /* norm */ } /* beta */ } /* alpha */ } /* debug */ if ((debug == 2) || ((debug == 1) && (bad_ratios > 0))) { printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", fname, n, ntests, thresh); printf (" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests), ratio_min, ratio_max); } blas_free(x); blas_free(y); blas_free(x_gen); blas_free(y_gen); *min_ratio = ratio_min; *num_bad_ratio = bad_ratios; *num_tests = tot_tests; FPU_FIX_STOP; return ratio_max; } double do_test_zdot_z_d(int n, int ntests, int *seed, double thresh, int debug, float test_prob, double *min_ratio, int *num_bad_ratio, int *num_tests) /* * Purpose * ======= * * Runs a series of tests on dots * * Arguments * ========= * * n (input) int * The size of vector being tested * * ntests (input) int * The number of tests to run for each set of attributes. * * seed (input/output) int * The seed for the random number generator used in testgen(). * * thresh (input) double * When the ratio returned from test() exceeds the specified * threshold, the current size, r_true, r_comp, and ratio will be * printed. (Since ratio is supposed to be O(1), we can set thresh * to ~10.) * * debug (input) int * If debug=3, print summary * If debug=2, print summary only if the number of bad ratios > 0 * If debug=1, print complete info if tests fail * If debug=0, return max ratio * * min_ratio (output) double * The minimum ratio * * num_bad_ratio (output) int * The number of tests fail; they are above the threshold. * * num_tests (output) int * The number of tests is being performed. * * Return value * ============ * * The maximum ratio if run successfully, otherwise return -1 * */ { /* function name */ const char fname[] = "BLAS_zdot_z_d"; /* max number of debug lines to print */ const int max_print = 32; /* Variables in the "x_val" form are loop vars for corresponding variables */ int i; /* iterate through the repeating tests */ int incx_val, incy_val; /* for testing different inc values */ int incx_gen, incy_gen; /* for complex case inc=2, for real case inc=1 */ int d_count; /* counter for debug */ int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ int p_count; /* counter for the number of debug lines printed */ int tot_tests; /* total number of tests to be done */ int norm; /* input values of near underflow/one/overflow */ double ratio_max; /* the current maximum ratio */ double ratio_min; /* the current minimum ratio */ double ratio; /* the per-use test ratio from test() */ int bad_ratios = 0; /* the number of ratios over the threshold */ double eps_int; /* the internal epsilon expected--2^(-24) for float */ double un_int; /* the internal underflow threshold */ double alpha[2]; double beta[2]; double *x; double *y; /* x_gen and y_gen are used to store vectors generated by testgen. they eventually are copied back to x and y */ double *x_gen; double *y_gen; /* the true r calculated by testgen(), in double-double */ double head_r_true[2], tail_r_true[2]; double r[2]; /* the generated r */ double r_comp[2]; /* the r computed by BLAS_zdot_z_d */ int alpha_val; int alpha_flag; /* input flag for BLAS_zdot_z_d_testgen */ int beta_val; int beta_flag; /* input flag for BLAS_zdot_z_d_testgen */ int conj_val; enum blas_conj_type conj_type; enum blas_prec_type prec; int saved_seed; /* for saving the original seed */ int count = 0, old_count = 0; /* use for counting the number of testgen calls * 2 */ FPU_FIX_DECL; /* test for bad arguments */ if (n < 0) BLAS_error(fname, -1, n, NULL); else if (ntests < 0) BLAS_error(fname, -2, ntests, NULL); /* if there is nothing to test, return all zero */ if (n == 0 || ntests == 0) { *min_ratio = 0.0; *num_bad_ratio = 0; *num_tests = 0; return 0.0; } FPU_FIX_START; /* initialization */ saved_seed = *seed; ratio_min = 1e308; ratio_max = 0.0; tot_tests = 0; p_count = 0; count = 0; find_max_ratio = 0; if (debug == 3) find_max_ratio = 1; incx_gen = incy_gen = 1; incx_gen *= 2; /* get space for calculation */ x = (double *) blas_malloc(n * 2 * incx_gen * sizeof(double) * 2); if (n * 2 * incx_gen > 0 && x == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y = (double *) blas_malloc(n * 2 * incy_gen * sizeof(double)); if (n * 2 * incy_gen > 0 && y == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } x_gen = (double *) blas_malloc(n * incx_gen * sizeof(double) * 2); if (n * incx_gen > 0 && x_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y_gen = (double *) blas_malloc(n * incy_gen * sizeof(double)); if (n * incy_gen > 0 && y_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } /* The debug iteration: If debug=1, then will execute the iteration twice. First, compute the max ratio. Second, print info if ratio > (50% * ratio_max). */ for (d_count = 0; d_count <= find_max_ratio; d_count++) { bad_ratios = 0; /* set to zero */ if ((debug == 3) && (d_count == find_max_ratio)) *seed = saved_seed; /* restore the original seed */ /* varying alpha */ for (alpha_val = 1; alpha_val < 3; alpha_val++) { alpha_flag = 0; switch (alpha_val) { case 0: alpha[0] = alpha[1] = 0.0; alpha_flag = 1; break; case 1: alpha[0] = 1.0; alpha[1] = 0.0; alpha_flag = 1; break; } /* varying beta */ for (beta_val = 0; beta_val < 3; beta_val++) { beta_flag = 0; switch (beta_val) { case 0: beta[0] = beta[1] = 0.0; beta_flag = 1; break; case 1: beta[0] = 1.0; beta[1] = 0.0; beta_flag = 1; break; } eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; /* values near underflow, 1, or overflow */ for (norm = -1; norm <= 1; norm++) { /* number of tests */ for (i = 0; i < ntests; i++) { /* conj or not */ for (conj_val = 0; conj_val < 2; conj_val++) { switch (conj_val) { case 0: conj_type = blas_no_conj; break; case 1: default: conj_type = blas_conj; break; } /* For the sake of speed, we throw out this case at random */ if (xrand(seed) >= test_prob) continue; BLAS_zdot_z_d_testgen(n, 0, 0, norm, conj_type, &alpha, alpha_flag, &beta, beta_flag, x_gen, y_gen, seed, &r, head_r_true, tail_r_true); count++; /* varying incx */ for (incx_val = -2; incx_val <= 2; incx_val++) { if (incx_val == 0) continue; zcopy_vector(x_gen, n, 1, x, incx_val); /* varying incy */ for (incy_val = -2; incy_val <= 2; incy_val++) { if (incy_val == 0) continue; dcopy_vector(y_gen, n, 1, y, incy_val); /* call BLAS_zdot_z_d to get r_comp */ r_comp[0] = r[0]; r_comp[1] = r[1]; FPU_FIX_STOP; BLAS_zdot_z_d(conj_type, n, alpha, x, incx_val, beta, y, incy_val, &r_comp); FPU_FIX_START; /* computing the ratio */ test_BLAS_zdot_z_d(n, conj_type, alpha, beta, r, r_comp, head_r_true, tail_r_true, x, incx_val, y, incy_val, eps_int, un_int, &ratio); /* Increase the number of bad ratio, if the ratio is bigger than the threshold. The !<= below causes NaN error to be detected. Note that (NaN > thresh) is always false. */ if (!(ratio <= thresh)) { bad_ratios++; if ((debug == 3) && /* print only when debug is on */ (count != old_count) && /* print if old vector is different from the current one */ (d_count == find_max_ratio) && (p_count <= max_print) && (ratio > 0.5 * ratio_max)) { old_count = count; printf ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", fname, n, ntests, thresh); /* Print test info */ switch (prec) { case blas_prec_single: printf("single "); break; case blas_prec_double: printf("double "); break; case blas_prec_indigenous: printf("indigenous "); break; case blas_prec_extra: printf("extra "); break; } switch (norm) { case -1: printf("near_underflow "); break; case 0: printf("near_one "); break; case 1: printf("near_overflow "); break; } switch (conj_type) { case blas_no_conj: printf("no_conj "); break; case blas_conj: printf("conj "); break; } printf("incx=%d, incy=%d:\n", incx_val, incy_val); zprint_vector(x, n, incx_val, "x"); dprint_vector(y, n, incy_val, "y"); printf(" "); printf("alpha = "); printf("(%24.16e, %24.16e)", alpha[0], alpha[1]); printf("\n "); printf("beta = "); printf("(%24.16e, %24.16e)", beta[0], beta[1]); printf("\n"); printf(" "); printf("r = "); printf("(%24.16e, %24.16e)", r[0], r[1]); printf("\n "); printf("r_comp = "); printf("(%24.16e, %24.16e)", r_comp[0], r_comp[1]); printf("\n"); printf(" "); printf("r_true = "); printf("([%24.16e %24.16e], [%24.16e %24.16e])", head_r_true[0], tail_r_true[0], head_r_true[1], tail_r_true[1]); printf(" ratio=%.4e\n", ratio); p_count++; } } if (d_count == 0) { if (ratio > ratio_max) ratio_max = ratio; if (ratio != 0.0 && ratio < ratio_min) ratio_min = ratio; tot_tests++; } } /* incy */ } /* incx */ } /* conj */ } /* tests */ } /* norm */ } /* beta */ } /* alpha */ } /* debug */ if ((debug == 2) || ((debug == 1) && (bad_ratios > 0))) { printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", fname, n, ntests, thresh); printf (" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests), ratio_min, ratio_max); } blas_free(x); blas_free(y); blas_free(x_gen); blas_free(y_gen); *min_ratio = ratio_min; *num_bad_ratio = bad_ratios; *num_tests = tot_tests; FPU_FIX_STOP; return ratio_max; } double do_test_zdot_d_z(int n, int ntests, int *seed, double thresh, int debug, float test_prob, double *min_ratio, int *num_bad_ratio, int *num_tests) /* * Purpose * ======= * * Runs a series of tests on dots * * Arguments * ========= * * n (input) int * The size of vector being tested * * ntests (input) int * The number of tests to run for each set of attributes. * * seed (input/output) int * The seed for the random number generator used in testgen(). * * thresh (input) double * When the ratio returned from test() exceeds the specified * threshold, the current size, r_true, r_comp, and ratio will be * printed. (Since ratio is supposed to be O(1), we can set thresh * to ~10.) * * debug (input) int * If debug=3, print summary * If debug=2, print summary only if the number of bad ratios > 0 * If debug=1, print complete info if tests fail * If debug=0, return max ratio * * min_ratio (output) double * The minimum ratio * * num_bad_ratio (output) int * The number of tests fail; they are above the threshold. * * num_tests (output) int * The number of tests is being performed. * * Return value * ============ * * The maximum ratio if run successfully, otherwise return -1 * */ { /* function name */ const char fname[] = "BLAS_zdot_d_z"; /* max number of debug lines to print */ const int max_print = 32; /* Variables in the "x_val" form are loop vars for corresponding variables */ int i; /* iterate through the repeating tests */ int incx_val, incy_val; /* for testing different inc values */ int incx_gen, incy_gen; /* for complex case inc=2, for real case inc=1 */ int d_count; /* counter for debug */ int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ int p_count; /* counter for the number of debug lines printed */ int tot_tests; /* total number of tests to be done */ int norm; /* input values of near underflow/one/overflow */ double ratio_max; /* the current maximum ratio */ double ratio_min; /* the current minimum ratio */ double ratio; /* the per-use test ratio from test() */ int bad_ratios = 0; /* the number of ratios over the threshold */ double eps_int; /* the internal epsilon expected--2^(-24) for float */ double un_int; /* the internal underflow threshold */ double alpha[2]; double beta[2]; double *x; double *y; /* x_gen and y_gen are used to store vectors generated by testgen. they eventually are copied back to x and y */ double *x_gen; double *y_gen; /* the true r calculated by testgen(), in double-double */ double head_r_true[2], tail_r_true[2]; double r[2]; /* the generated r */ double r_comp[2]; /* the r computed by BLAS_zdot_d_z */ int alpha_val; int alpha_flag; /* input flag for BLAS_zdot_d_z_testgen */ int beta_val; int beta_flag; /* input flag for BLAS_zdot_d_z_testgen */ int conj_val; enum blas_conj_type conj_type; enum blas_prec_type prec; int saved_seed; /* for saving the original seed */ int count = 0, old_count = 0; /* use for counting the number of testgen calls * 2 */ FPU_FIX_DECL; /* test for bad arguments */ if (n < 0) BLAS_error(fname, -1, n, NULL); else if (ntests < 0) BLAS_error(fname, -2, ntests, NULL); /* if there is nothing to test, return all zero */ if (n == 0 || ntests == 0) { *min_ratio = 0.0; *num_bad_ratio = 0; *num_tests = 0; return 0.0; } FPU_FIX_START; /* initialization */ saved_seed = *seed; ratio_min = 1e308; ratio_max = 0.0; tot_tests = 0; p_count = 0; count = 0; find_max_ratio = 0; if (debug == 3) find_max_ratio = 1; incx_gen = incy_gen = 1; incy_gen *= 2; /* get space for calculation */ x = (double *) blas_malloc(n * 2 * incx_gen * sizeof(double)); if (n * 2 * incx_gen > 0 && x == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y = (double *) blas_malloc(n * 2 * incy_gen * sizeof(double) * 2); if (n * 2 * incy_gen > 0 && y == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } x_gen = (double *) blas_malloc(n * incx_gen * sizeof(double)); if (n * incx_gen > 0 && x_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y_gen = (double *) blas_malloc(n * incy_gen * sizeof(double) * 2); if (n * incy_gen > 0 && y_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } /* The debug iteration: If debug=1, then will execute the iteration twice. First, compute the max ratio. Second, print info if ratio > (50% * ratio_max). */ for (d_count = 0; d_count <= find_max_ratio; d_count++) { bad_ratios = 0; /* set to zero */ if ((debug == 3) && (d_count == find_max_ratio)) *seed = saved_seed; /* restore the original seed */ /* varying alpha */ for (alpha_val = 1; alpha_val < 3; alpha_val++) { alpha_flag = 0; switch (alpha_val) { case 0: alpha[0] = alpha[1] = 0.0; alpha_flag = 1; break; case 1: alpha[0] = 1.0; alpha[1] = 0.0; alpha_flag = 1; break; } /* varying beta */ for (beta_val = 0; beta_val < 3; beta_val++) { beta_flag = 0; switch (beta_val) { case 0: beta[0] = beta[1] = 0.0; beta_flag = 1; break; case 1: beta[0] = 1.0; beta[1] = 0.0; beta_flag = 1; break; } eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; /* values near underflow, 1, or overflow */ for (norm = -1; norm <= 1; norm++) { /* number of tests */ for (i = 0; i < ntests; i++) { /* conj or not */ for (conj_val = 0; conj_val < 2; conj_val++) { switch (conj_val) { case 0: conj_type = blas_no_conj; break; case 1: default: conj_type = blas_conj; break; } /* For the sake of speed, we throw out this case at random */ if (xrand(seed) >= test_prob) continue; BLAS_zdot_d_z_testgen(n, 0, 0, norm, conj_type, &alpha, alpha_flag, &beta, beta_flag, x_gen, y_gen, seed, &r, head_r_true, tail_r_true); count++; /* varying incx */ for (incx_val = -2; incx_val <= 2; incx_val++) { if (incx_val == 0) continue; dcopy_vector(x_gen, n, 1, x, incx_val); /* varying incy */ for (incy_val = -2; incy_val <= 2; incy_val++) { if (incy_val == 0) continue; zcopy_vector(y_gen, n, 1, y, incy_val); /* call BLAS_zdot_d_z to get r_comp */ r_comp[0] = r[0]; r_comp[1] = r[1]; FPU_FIX_STOP; BLAS_zdot_d_z(conj_type, n, alpha, x, incx_val, beta, y, incy_val, &r_comp); FPU_FIX_START; /* computing the ratio */ test_BLAS_zdot_d_z(n, conj_type, alpha, beta, r, r_comp, head_r_true, tail_r_true, x, incx_val, y, incy_val, eps_int, un_int, &ratio); /* Increase the number of bad ratio, if the ratio is bigger than the threshold. The !<= below causes NaN error to be detected. Note that (NaN > thresh) is always false. */ if (!(ratio <= thresh)) { bad_ratios++; if ((debug == 3) && /* print only when debug is on */ (count != old_count) && /* print if old vector is different from the current one */ (d_count == find_max_ratio) && (p_count <= max_print) && (ratio > 0.5 * ratio_max)) { old_count = count; printf ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", fname, n, ntests, thresh); /* Print test info */ switch (prec) { case blas_prec_single: printf("single "); break; case blas_prec_double: printf("double "); break; case blas_prec_indigenous: printf("indigenous "); break; case blas_prec_extra: printf("extra "); break; } switch (norm) { case -1: printf("near_underflow "); break; case 0: printf("near_one "); break; case 1: printf("near_overflow "); break; } switch (conj_type) { case blas_no_conj: printf("no_conj "); break; case blas_conj: printf("conj "); break; } printf("incx=%d, incy=%d:\n", incx_val, incy_val); dprint_vector(x, n, incx_val, "x"); zprint_vector(y, n, incy_val, "y"); printf(" "); printf("alpha = "); printf("(%24.16e, %24.16e)", alpha[0], alpha[1]); printf("\n "); printf("beta = "); printf("(%24.16e, %24.16e)", beta[0], beta[1]); printf("\n"); printf(" "); printf("r = "); printf("(%24.16e, %24.16e)", r[0], r[1]); printf("\n "); printf("r_comp = "); printf("(%24.16e, %24.16e)", r_comp[0], r_comp[1]); printf("\n"); printf(" "); printf("r_true = "); printf("([%24.16e %24.16e], [%24.16e %24.16e])", head_r_true[0], tail_r_true[0], head_r_true[1], tail_r_true[1]); printf(" ratio=%.4e\n", ratio); p_count++; } } if (d_count == 0) { if (ratio > ratio_max) ratio_max = ratio; if (ratio != 0.0 && ratio < ratio_min) ratio_min = ratio; tot_tests++; } } /* incy */ } /* incx */ } /* conj */ } /* tests */ } /* norm */ } /* beta */ } /* alpha */ } /* debug */ if ((debug == 2) || ((debug == 1) && (bad_ratios > 0))) { printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", fname, n, ntests, thresh); printf (" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests), ratio_min, ratio_max); } blas_free(x); blas_free(y); blas_free(x_gen); blas_free(y_gen); *min_ratio = ratio_min; *num_bad_ratio = bad_ratios; *num_tests = tot_tests; FPU_FIX_STOP; return ratio_max; } double do_test_zdot_d_d(int n, int ntests, int *seed, double thresh, int debug, float test_prob, double *min_ratio, int *num_bad_ratio, int *num_tests) /* * Purpose * ======= * * Runs a series of tests on dots * * Arguments * ========= * * n (input) int * The size of vector being tested * * ntests (input) int * The number of tests to run for each set of attributes. * * seed (input/output) int * The seed for the random number generator used in testgen(). * * thresh (input) double * When the ratio returned from test() exceeds the specified * threshold, the current size, r_true, r_comp, and ratio will be * printed. (Since ratio is supposed to be O(1), we can set thresh * to ~10.) * * debug (input) int * If debug=3, print summary * If debug=2, print summary only if the number of bad ratios > 0 * If debug=1, print complete info if tests fail * If debug=0, return max ratio * * min_ratio (output) double * The minimum ratio * * num_bad_ratio (output) int * The number of tests fail; they are above the threshold. * * num_tests (output) int * The number of tests is being performed. * * Return value * ============ * * The maximum ratio if run successfully, otherwise return -1 * */ { /* function name */ const char fname[] = "BLAS_zdot_d_d"; /* max number of debug lines to print */ const int max_print = 32; /* Variables in the "x_val" form are loop vars for corresponding variables */ int i; /* iterate through the repeating tests */ int incx_val, incy_val; /* for testing different inc values */ int incx_gen, incy_gen; /* for complex case inc=2, for real case inc=1 */ int d_count; /* counter for debug */ int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ int p_count; /* counter for the number of debug lines printed */ int tot_tests; /* total number of tests to be done */ int norm; /* input values of near underflow/one/overflow */ double ratio_max; /* the current maximum ratio */ double ratio_min; /* the current minimum ratio */ double ratio; /* the per-use test ratio from test() */ int bad_ratios = 0; /* the number of ratios over the threshold */ double eps_int; /* the internal epsilon expected--2^(-24) for float */ double un_int; /* the internal underflow threshold */ double alpha[2]; double beta[2]; double *x; double *y; /* x_gen and y_gen are used to store vectors generated by testgen. they eventually are copied back to x and y */ double *x_gen; double *y_gen; /* the true r calculated by testgen(), in double-double */ double head_r_true[2], tail_r_true[2]; double r[2]; /* the generated r */ double r_comp[2]; /* the r computed by BLAS_zdot_d_d */ int alpha_val; int alpha_flag; /* input flag for BLAS_zdot_d_d_testgen */ int beta_val; int beta_flag; /* input flag for BLAS_zdot_d_d_testgen */ int conj_val; enum blas_conj_type conj_type; enum blas_prec_type prec; int saved_seed; /* for saving the original seed */ int count = 0, old_count = 0; /* use for counting the number of testgen calls * 2 */ FPU_FIX_DECL; /* test for bad arguments */ if (n < 0) BLAS_error(fname, -1, n, NULL); else if (ntests < 0) BLAS_error(fname, -2, ntests, NULL); /* if there is nothing to test, return all zero */ if (n == 0 || ntests == 0) { *min_ratio = 0.0; *num_bad_ratio = 0; *num_tests = 0; return 0.0; } FPU_FIX_START; /* initialization */ saved_seed = *seed; ratio_min = 1e308; ratio_max = 0.0; tot_tests = 0; p_count = 0; count = 0; find_max_ratio = 0; if (debug == 3) find_max_ratio = 1; incx_gen = incy_gen = 1; /* get space for calculation */ x = (double *) blas_malloc(n * 2 * incx_gen * sizeof(double)); if (n * 2 * incx_gen > 0 && x == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y = (double *) blas_malloc(n * 2 * incy_gen * sizeof(double)); if (n * 2 * incy_gen > 0 && y == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } x_gen = (double *) blas_malloc(n * incx_gen * sizeof(double)); if (n * incx_gen > 0 && x_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y_gen = (double *) blas_malloc(n * incy_gen * sizeof(double)); if (n * incy_gen > 0 && y_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } /* The debug iteration: If debug=1, then will execute the iteration twice. First, compute the max ratio. Second, print info if ratio > (50% * ratio_max). */ for (d_count = 0; d_count <= find_max_ratio; d_count++) { bad_ratios = 0; /* set to zero */ if ((debug == 3) && (d_count == find_max_ratio)) *seed = saved_seed; /* restore the original seed */ /* varying alpha */ for (alpha_val = 1; alpha_val < 3; alpha_val++) { alpha_flag = 0; switch (alpha_val) { case 0: alpha[0] = alpha[1] = 0.0; alpha_flag = 1; break; case 1: alpha[0] = 1.0; alpha[1] = 0.0; alpha_flag = 1; break; } /* varying beta */ for (beta_val = 0; beta_val < 3; beta_val++) { beta_flag = 0; switch (beta_val) { case 0: beta[0] = beta[1] = 0.0; beta_flag = 1; break; case 1: beta[0] = 1.0; beta[1] = 0.0; beta_flag = 1; break; } eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; /* values near underflow, 1, or overflow */ for (norm = -1; norm <= 1; norm++) { /* number of tests */ for (i = 0; i < ntests; i++) { /* conj or not */ for (conj_val = 0; conj_val < 2; conj_val++) { switch (conj_val) { case 0: conj_type = blas_no_conj; break; case 1: default: conj_type = blas_conj; break; } /* For the sake of speed, we throw out this case at random */ if (xrand(seed) >= test_prob) continue; BLAS_zdot_d_d_testgen(n, 0, 0, norm, conj_type, &alpha, alpha_flag, &beta, beta_flag, x_gen, y_gen, seed, &r, head_r_true, tail_r_true); count++; /* varying incx */ for (incx_val = -2; incx_val <= 2; incx_val++) { if (incx_val == 0) continue; dcopy_vector(x_gen, n, 1, x, incx_val); /* varying incy */ for (incy_val = -2; incy_val <= 2; incy_val++) { if (incy_val == 0) continue; dcopy_vector(y_gen, n, 1, y, incy_val); /* call BLAS_zdot_d_d to get r_comp */ r_comp[0] = r[0]; r_comp[1] = r[1]; FPU_FIX_STOP; BLAS_zdot_d_d(conj_type, n, alpha, x, incx_val, beta, y, incy_val, &r_comp); FPU_FIX_START; /* computing the ratio */ test_BLAS_zdot_d_d(n, conj_type, alpha, beta, r, r_comp, head_r_true, tail_r_true, x, incx_val, y, incy_val, eps_int, un_int, &ratio); /* Increase the number of bad ratio, if the ratio is bigger than the threshold. The !<= below causes NaN error to be detected. Note that (NaN > thresh) is always false. */ if (!(ratio <= thresh)) { bad_ratios++; if ((debug == 3) && /* print only when debug is on */ (count != old_count) && /* print if old vector is different from the current one */ (d_count == find_max_ratio) && (p_count <= max_print) && (ratio > 0.5 * ratio_max)) { old_count = count; printf ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", fname, n, ntests, thresh); /* Print test info */ switch (prec) { case blas_prec_single: printf("single "); break; case blas_prec_double: printf("double "); break; case blas_prec_indigenous: printf("indigenous "); break; case blas_prec_extra: printf("extra "); break; } switch (norm) { case -1: printf("near_underflow "); break; case 0: printf("near_one "); break; case 1: printf("near_overflow "); break; } switch (conj_type) { case blas_no_conj: printf("no_conj "); break; case blas_conj: printf("conj "); break; } printf("incx=%d, incy=%d:\n", incx_val, incy_val); dprint_vector(x, n, incx_val, "x"); dprint_vector(y, n, incy_val, "y"); printf(" "); printf("alpha = "); printf("(%24.16e, %24.16e)", alpha[0], alpha[1]); printf("\n "); printf("beta = "); printf("(%24.16e, %24.16e)", beta[0], beta[1]); printf("\n"); printf(" "); printf("r = "); printf("(%24.16e, %24.16e)", r[0], r[1]); printf("\n "); printf("r_comp = "); printf("(%24.16e, %24.16e)", r_comp[0], r_comp[1]); printf("\n"); printf(" "); printf("r_true = "); printf("([%24.16e %24.16e], [%24.16e %24.16e])", head_r_true[0], tail_r_true[0], head_r_true[1], tail_r_true[1]); printf(" ratio=%.4e\n", ratio); p_count++; } } if (d_count == 0) { if (ratio > ratio_max) ratio_max = ratio; if (ratio != 0.0 && ratio < ratio_min) ratio_min = ratio; tot_tests++; } } /* incy */ } /* incx */ } /* conj */ } /* tests */ } /* norm */ } /* beta */ } /* alpha */ } /* debug */ if ((debug == 2) || ((debug == 1) && (bad_ratios > 0))) { printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", fname, n, ntests, thresh); printf (" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests), ratio_min, ratio_max); } blas_free(x); blas_free(y); blas_free(x_gen); blas_free(y_gen); *min_ratio = ratio_min; *num_bad_ratio = bad_ratios; *num_tests = tot_tests; FPU_FIX_STOP; return ratio_max; } double do_test_sdot_x(int n, int ntests, int *seed, double thresh, int debug, float test_prob, double *min_ratio, int *num_bad_ratio, int *num_tests) /* * Purpose * ======= * * Runs a series of tests on dots * * Arguments * ========= * * n (input) int * The size of vector being tested * * ntests (input) int * The number of tests to run for each set of attributes. * * seed (input/output) int * The seed for the random number generator used in testgen(). * * thresh (input) double * When the ratio returned from test() exceeds the specified * threshold, the current size, r_true, r_comp, and ratio will be * printed. (Since ratio is supposed to be O(1), we can set thresh * to ~10.) * * debug (input) int * If debug=3, print summary * If debug=2, print summary only if the number of bad ratios > 0 * If debug=1, print complete info if tests fail * If debug=0, return max ratio * * min_ratio (output) double * The minimum ratio * * num_bad_ratio (output) int * The number of tests fail; they are above the threshold. * * num_tests (output) int * The number of tests is being performed. * * Return value * ============ * * The maximum ratio if run successfully, otherwise return -1 * */ { /* function name */ const char fname[] = "BLAS_sdot_x"; /* max number of debug lines to print */ const int max_print = 32; /* Variables in the "x_val" form are loop vars for corresponding variables */ int i; /* iterate through the repeating tests */ int incx_val, incy_val; /* for testing different inc values */ int incx_gen, incy_gen; /* for complex case inc=2, for real case inc=1 */ int d_count; /* counter for debug */ int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ int p_count; /* counter for the number of debug lines printed */ int tot_tests; /* total number of tests to be done */ int norm; /* input values of near underflow/one/overflow */ double ratio_max; /* the current maximum ratio */ double ratio_min; /* the current minimum ratio */ double ratio; /* the per-use test ratio from test() */ int bad_ratios = 0; /* the number of ratios over the threshold */ double eps_int; /* the internal epsilon expected--2^(-24) for float */ double un_int; /* the internal underflow threshold */ float alpha; float beta; float *x; float *y; /* x_gen and y_gen are used to store vectors generated by testgen. they eventually are copied back to x and y */ float *x_gen; float *y_gen; /* the true r calculated by testgen(), in double-double */ double head_r_true, tail_r_true; float r; /* the generated r */ float r_comp; /* the r computed by BLAS_sdot_x */ int alpha_val; int alpha_flag; /* input flag for BLAS_sdot_testgen */ int beta_val; int beta_flag; /* input flag for BLAS_sdot_testgen */ int conj_val; enum blas_conj_type conj_type; int prec_val; enum blas_prec_type prec; int saved_seed; /* for saving the original seed */ int count = 0, old_count = 0; /* use for counting the number of testgen calls * 2 */ FPU_FIX_DECL; /* test for bad arguments */ if (n < 0) BLAS_error(fname, -1, n, NULL); else if (ntests < 0) BLAS_error(fname, -2, ntests, NULL); /* if there is nothing to test, return all zero */ if (n == 0 || ntests == 0) { *min_ratio = 0.0; *num_bad_ratio = 0; *num_tests = 0; return 0.0; } FPU_FIX_START; /* initialization */ saved_seed = *seed; ratio_min = 1e308; ratio_max = 0.0; tot_tests = 0; p_count = 0; count = 0; find_max_ratio = 0; if (debug == 3) find_max_ratio = 1; incx_gen = incy_gen = 1; /* get space for calculation */ x = (float *) blas_malloc(n * 2 * incx_gen * sizeof(float)); if (n * 2 * incx_gen > 0 && x == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y = (float *) blas_malloc(n * 2 * incy_gen * sizeof(float)); if (n * 2 * incy_gen > 0 && y == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } x_gen = (float *) blas_malloc(n * incx_gen * sizeof(float)); if (n * incx_gen > 0 && x_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y_gen = (float *) blas_malloc(n * incy_gen * sizeof(float)); if (n * incy_gen > 0 && y_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } /* The debug iteration: If debug=1, then will execute the iteration twice. First, compute the max ratio. Second, print info if ratio > (50% * ratio_max). */ for (d_count = 0; d_count <= find_max_ratio; d_count++) { bad_ratios = 0; /* set to zero */ if ((debug == 3) && (d_count == find_max_ratio)) *seed = saved_seed; /* restore the original seed */ /* varying alpha */ for (alpha_val = 1; alpha_val < 3; alpha_val++) { alpha_flag = 0; switch (alpha_val) { case 0: alpha = 0.0; alpha_flag = 1; break; case 1: alpha = 1.0; alpha_flag = 1; break; } /* varying beta */ for (beta_val = 0; beta_val < 3; beta_val++) { beta_flag = 0; switch (beta_val) { case 0: beta = 0.0; beta_flag = 1; break; case 1: beta = 1.0; beta_flag = 1; break; } /* varying extra precs */ for (prec_val = 0; prec_val <= 2; prec_val++) { switch (prec_val) { case 0: eps_int = power(2, -BITS_S); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_single), (double) BLAS_fpinfo_x(blas_emin, blas_prec_single)); prec = blas_prec_single; break; case 1: eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; break; case 2: default: eps_int = power(2, -BITS_E); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra), (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra)); prec = blas_prec_extra; break; } /* values near underflow, 1, or overflow */ for (norm = -1; norm <= 1; norm++) { /* number of tests */ for (i = 0; i < ntests; i++) { /* conj or not */ for (conj_val = 0; conj_val < 2; conj_val++) { switch (conj_val) { case 0: conj_type = blas_no_conj; break; case 1: default: conj_type = blas_conj; break; } /* For the sake of speed, we throw out this case at random */ if (xrand(seed) >= test_prob) continue; BLAS_sdot_testgen(n, 0, 0, norm, conj_type, &alpha, alpha_flag, &beta, beta_flag, x_gen, y_gen, seed, &r, &head_r_true, &tail_r_true); count++; /* varying incx */ for (incx_val = -2; incx_val <= 2; incx_val++) { if (incx_val == 0) continue; scopy_vector(x_gen, n, 1, x, incx_val); /* varying incy */ for (incy_val = -2; incy_val <= 2; incy_val++) { if (incy_val == 0) continue; scopy_vector(y_gen, n, 1, y, incy_val); /* call BLAS_sdot_x to get r_comp */ r_comp = r; FPU_FIX_STOP; BLAS_sdot_x(conj_type, n, alpha, x, incx_val, beta, y, incy_val, &r_comp, prec); FPU_FIX_START; /* computing the ratio */ test_BLAS_sdot(n, conj_type, alpha, beta, r, r_comp, head_r_true, tail_r_true, x, incx_val, y, incy_val, eps_int, un_int, &ratio); /* Increase the number of bad ratio, if the ratio is bigger than the threshold. The !<= below causes NaN error to be detected. Note that (NaN > thresh) is always false. */ if (!(ratio <= thresh)) { bad_ratios++; if ((debug == 3) && /* print only when debug is on */ (count != old_count) && /* print if old vector is different from the current one */ (d_count == find_max_ratio) && (p_count <= max_print) && (ratio > 0.5 * ratio_max)) { old_count = count; printf ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", fname, n, ntests, thresh); /* Print test info */ switch (prec) { case blas_prec_single: printf("single "); break; case blas_prec_double: printf("double "); break; case blas_prec_indigenous: printf("indigenous "); break; case blas_prec_extra: printf("extra "); break; } switch (norm) { case -1: printf("near_underflow "); break; case 0: printf("near_one "); break; case 1: printf("near_overflow "); break; } switch (conj_type) { case blas_no_conj: printf("no_conj "); break; case blas_conj: printf("conj "); break; } printf("incx=%d, incy=%d:\n", incx_val, incy_val); sprint_vector(x, n, incx_val, "x"); sprint_vector(y, n, incy_val, "y"); printf(" "); printf("alpha = "); printf("%16.8e", alpha); printf("\n "); printf("beta = "); printf("%16.8e", beta); printf("\n"); printf(" "); printf("r = "); printf("%16.8e", r); printf("\n "); printf("r_comp = "); printf("%16.8e", r_comp); printf("\n"); printf(" "); printf("r_true = "); printf("[%24.16e %24.16e]", head_r_true, tail_r_true); printf(" ratio=%.4e\n", ratio); p_count++; } } if (d_count == 0) { if (ratio > ratio_max) ratio_max = ratio; if (ratio != 0.0 && ratio < ratio_min) ratio_min = ratio; tot_tests++; } } /* incy */ } /* incx */ } /* conj */ } /* tests */ } /* norm */ } /* prec */ } /* beta */ } /* alpha */ } /* debug */ if ((debug == 2) || ((debug == 1) && (bad_ratios > 0))) { printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", fname, n, ntests, thresh); printf (" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests), ratio_min, ratio_max); } blas_free(x); blas_free(y); blas_free(x_gen); blas_free(y_gen); *min_ratio = ratio_min; *num_bad_ratio = bad_ratios; *num_tests = tot_tests; FPU_FIX_STOP; return ratio_max; } double do_test_ddot_x(int n, int ntests, int *seed, double thresh, int debug, float test_prob, double *min_ratio, int *num_bad_ratio, int *num_tests) /* * Purpose * ======= * * Runs a series of tests on dots * * Arguments * ========= * * n (input) int * The size of vector being tested * * ntests (input) int * The number of tests to run for each set of attributes. * * seed (input/output) int * The seed for the random number generator used in testgen(). * * thresh (input) double * When the ratio returned from test() exceeds the specified * threshold, the current size, r_true, r_comp, and ratio will be * printed. (Since ratio is supposed to be O(1), we can set thresh * to ~10.) * * debug (input) int * If debug=3, print summary * If debug=2, print summary only if the number of bad ratios > 0 * If debug=1, print complete info if tests fail * If debug=0, return max ratio * * min_ratio (output) double * The minimum ratio * * num_bad_ratio (output) int * The number of tests fail; they are above the threshold. * * num_tests (output) int * The number of tests is being performed. * * Return value * ============ * * The maximum ratio if run successfully, otherwise return -1 * */ { /* function name */ const char fname[] = "BLAS_ddot_x"; /* max number of debug lines to print */ const int max_print = 32; /* Variables in the "x_val" form are loop vars for corresponding variables */ int i; /* iterate through the repeating tests */ int incx_val, incy_val; /* for testing different inc values */ int incx_gen, incy_gen; /* for complex case inc=2, for real case inc=1 */ int d_count; /* counter for debug */ int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ int p_count; /* counter for the number of debug lines printed */ int tot_tests; /* total number of tests to be done */ int norm; /* input values of near underflow/one/overflow */ double ratio_max; /* the current maximum ratio */ double ratio_min; /* the current minimum ratio */ double ratio; /* the per-use test ratio from test() */ int bad_ratios = 0; /* the number of ratios over the threshold */ double eps_int; /* the internal epsilon expected--2^(-24) for float */ double un_int; /* the internal underflow threshold */ double alpha; double beta; double *x; double *y; /* x_gen and y_gen are used to store vectors generated by testgen. they eventually are copied back to x and y */ double *x_gen; double *y_gen; /* the true r calculated by testgen(), in double-double */ double head_r_true, tail_r_true; double r; /* the generated r */ double r_comp; /* the r computed by BLAS_ddot_x */ int alpha_val; int alpha_flag; /* input flag for BLAS_ddot_testgen */ int beta_val; int beta_flag; /* input flag for BLAS_ddot_testgen */ int conj_val; enum blas_conj_type conj_type; int prec_val; enum blas_prec_type prec; int saved_seed; /* for saving the original seed */ int count = 0, old_count = 0; /* use for counting the number of testgen calls * 2 */ FPU_FIX_DECL; /* test for bad arguments */ if (n < 0) BLAS_error(fname, -1, n, NULL); else if (ntests < 0) BLAS_error(fname, -2, ntests, NULL); /* if there is nothing to test, return all zero */ if (n == 0 || ntests == 0) { *min_ratio = 0.0; *num_bad_ratio = 0; *num_tests = 0; return 0.0; } FPU_FIX_START; /* initialization */ saved_seed = *seed; ratio_min = 1e308; ratio_max = 0.0; tot_tests = 0; p_count = 0; count = 0; find_max_ratio = 0; if (debug == 3) find_max_ratio = 1; incx_gen = incy_gen = 1; /* get space for calculation */ x = (double *) blas_malloc(n * 2 * incx_gen * sizeof(double)); if (n * 2 * incx_gen > 0 && x == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y = (double *) blas_malloc(n * 2 * incy_gen * sizeof(double)); if (n * 2 * incy_gen > 0 && y == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } x_gen = (double *) blas_malloc(n * incx_gen * sizeof(double)); if (n * incx_gen > 0 && x_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y_gen = (double *) blas_malloc(n * incy_gen * sizeof(double)); if (n * incy_gen > 0 && y_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } /* The debug iteration: If debug=1, then will execute the iteration twice. First, compute the max ratio. Second, print info if ratio > (50% * ratio_max). */ for (d_count = 0; d_count <= find_max_ratio; d_count++) { bad_ratios = 0; /* set to zero */ if ((debug == 3) && (d_count == find_max_ratio)) *seed = saved_seed; /* restore the original seed */ /* varying alpha */ for (alpha_val = 1; alpha_val < 3; alpha_val++) { alpha_flag = 0; switch (alpha_val) { case 0: alpha = 0.0; alpha_flag = 1; break; case 1: alpha = 1.0; alpha_flag = 1; break; } /* varying beta */ for (beta_val = 0; beta_val < 3; beta_val++) { beta_flag = 0; switch (beta_val) { case 0: beta = 0.0; beta_flag = 1; break; case 1: beta = 1.0; beta_flag = 1; break; } /* varying extra precs */ for (prec_val = 0; prec_val <= 2; prec_val++) { switch (prec_val) { case 0: eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; break; case 1: eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; break; case 2: default: eps_int = power(2, -BITS_E); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra), (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra)); prec = blas_prec_extra; break; } /* values near underflow, 1, or overflow */ for (norm = -1; norm <= 1; norm++) { /* number of tests */ for (i = 0; i < ntests; i++) { /* conj or not */ for (conj_val = 0; conj_val < 2; conj_val++) { switch (conj_val) { case 0: conj_type = blas_no_conj; break; case 1: default: conj_type = blas_conj; break; } /* For the sake of speed, we throw out this case at random */ if (xrand(seed) >= test_prob) continue; BLAS_ddot_testgen(n, 0, 0, norm, conj_type, &alpha, alpha_flag, &beta, beta_flag, x_gen, y_gen, seed, &r, &head_r_true, &tail_r_true); count++; /* varying incx */ for (incx_val = -2; incx_val <= 2; incx_val++) { if (incx_val == 0) continue; dcopy_vector(x_gen, n, 1, x, incx_val); /* varying incy */ for (incy_val = -2; incy_val <= 2; incy_val++) { if (incy_val == 0) continue; dcopy_vector(y_gen, n, 1, y, incy_val); /* call BLAS_ddot_x to get r_comp */ r_comp = r; FPU_FIX_STOP; BLAS_ddot_x(conj_type, n, alpha, x, incx_val, beta, y, incy_val, &r_comp, prec); FPU_FIX_START; /* computing the ratio */ test_BLAS_ddot(n, conj_type, alpha, beta, r, r_comp, head_r_true, tail_r_true, x, incx_val, y, incy_val, eps_int, un_int, &ratio); /* Increase the number of bad ratio, if the ratio is bigger than the threshold. The !<= below causes NaN error to be detected. Note that (NaN > thresh) is always false. */ if (!(ratio <= thresh)) { bad_ratios++; if ((debug == 3) && /* print only when debug is on */ (count != old_count) && /* print if old vector is different from the current one */ (d_count == find_max_ratio) && (p_count <= max_print) && (ratio > 0.5 * ratio_max)) { old_count = count; printf ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", fname, n, ntests, thresh); /* Print test info */ switch (prec) { case blas_prec_single: printf("single "); break; case blas_prec_double: printf("double "); break; case blas_prec_indigenous: printf("indigenous "); break; case blas_prec_extra: printf("extra "); break; } switch (norm) { case -1: printf("near_underflow "); break; case 0: printf("near_one "); break; case 1: printf("near_overflow "); break; } switch (conj_type) { case blas_no_conj: printf("no_conj "); break; case blas_conj: printf("conj "); break; } printf("incx=%d, incy=%d:\n", incx_val, incy_val); dprint_vector(x, n, incx_val, "x"); dprint_vector(y, n, incy_val, "y"); printf(" "); printf("alpha = "); printf("%24.16e", alpha); printf("\n "); printf("beta = "); printf("%24.16e", beta); printf("\n"); printf(" "); printf("r = "); printf("%24.16e", r); printf("\n "); printf("r_comp = "); printf("%24.16e", r_comp); printf("\n"); printf(" "); printf("r_true = "); printf("[%24.16e %24.16e]", head_r_true, tail_r_true); printf(" ratio=%.4e\n", ratio); p_count++; } } if (d_count == 0) { if (ratio > ratio_max) ratio_max = ratio; if (ratio != 0.0 && ratio < ratio_min) ratio_min = ratio; tot_tests++; } } /* incy */ } /* incx */ } /* conj */ } /* tests */ } /* norm */ } /* prec */ } /* beta */ } /* alpha */ } /* debug */ if ((debug == 2) || ((debug == 1) && (bad_ratios > 0))) { printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", fname, n, ntests, thresh); printf (" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests), ratio_min, ratio_max); } blas_free(x); blas_free(y); blas_free(x_gen); blas_free(y_gen); *min_ratio = ratio_min; *num_bad_ratio = bad_ratios; *num_tests = tot_tests; FPU_FIX_STOP; return ratio_max; } double do_test_cdot_x(int n, int ntests, int *seed, double thresh, int debug, float test_prob, double *min_ratio, int *num_bad_ratio, int *num_tests) /* * Purpose * ======= * * Runs a series of tests on dots * * Arguments * ========= * * n (input) int * The size of vector being tested * * ntests (input) int * The number of tests to run for each set of attributes. * * seed (input/output) int * The seed for the random number generator used in testgen(). * * thresh (input) double * When the ratio returned from test() exceeds the specified * threshold, the current size, r_true, r_comp, and ratio will be * printed. (Since ratio is supposed to be O(1), we can set thresh * to ~10.) * * debug (input) int * If debug=3, print summary * If debug=2, print summary only if the number of bad ratios > 0 * If debug=1, print complete info if tests fail * If debug=0, return max ratio * * min_ratio (output) double * The minimum ratio * * num_bad_ratio (output) int * The number of tests fail; they are above the threshold. * * num_tests (output) int * The number of tests is being performed. * * Return value * ============ * * The maximum ratio if run successfully, otherwise return -1 * */ { /* function name */ const char fname[] = "BLAS_cdot_x"; /* max number of debug lines to print */ const int max_print = 32; /* Variables in the "x_val" form are loop vars for corresponding variables */ int i; /* iterate through the repeating tests */ int incx_val, incy_val; /* for testing different inc values */ int incx_gen, incy_gen; /* for complex case inc=2, for real case inc=1 */ int d_count; /* counter for debug */ int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ int p_count; /* counter for the number of debug lines printed */ int tot_tests; /* total number of tests to be done */ int norm; /* input values of near underflow/one/overflow */ double ratio_max; /* the current maximum ratio */ double ratio_min; /* the current minimum ratio */ double ratio; /* the per-use test ratio from test() */ int bad_ratios = 0; /* the number of ratios over the threshold */ double eps_int; /* the internal epsilon expected--2^(-24) for float */ double un_int; /* the internal underflow threshold */ float alpha[2]; float beta[2]; float *x; float *y; /* x_gen and y_gen are used to store vectors generated by testgen. they eventually are copied back to x and y */ float *x_gen; float *y_gen; /* the true r calculated by testgen(), in double-double */ double head_r_true[2], tail_r_true[2]; float r[2]; /* the generated r */ float r_comp[2]; /* the r computed by BLAS_cdot_x */ int alpha_val; int alpha_flag; /* input flag for BLAS_cdot_testgen */ int beta_val; int beta_flag; /* input flag for BLAS_cdot_testgen */ int conj_val; enum blas_conj_type conj_type; int prec_val; enum blas_prec_type prec; int saved_seed; /* for saving the original seed */ int count = 0, old_count = 0; /* use for counting the number of testgen calls * 2 */ FPU_FIX_DECL; /* test for bad arguments */ if (n < 0) BLAS_error(fname, -1, n, NULL); else if (ntests < 0) BLAS_error(fname, -2, ntests, NULL); /* if there is nothing to test, return all zero */ if (n == 0 || ntests == 0) { *min_ratio = 0.0; *num_bad_ratio = 0; *num_tests = 0; return 0.0; } FPU_FIX_START; /* initialization */ saved_seed = *seed; ratio_min = 1e308; ratio_max = 0.0; tot_tests = 0; p_count = 0; count = 0; find_max_ratio = 0; if (debug == 3) find_max_ratio = 1; incx_gen = incy_gen = 1; incx_gen *= 2; incy_gen *= 2; /* get space for calculation */ x = (float *) blas_malloc(n * 2 * incx_gen * sizeof(float) * 2); if (n * 2 * incx_gen > 0 && x == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y = (float *) blas_malloc(n * 2 * incy_gen * sizeof(float) * 2); if (n * 2 * incy_gen > 0 && y == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } x_gen = (float *) blas_malloc(n * incx_gen * sizeof(float) * 2); if (n * incx_gen > 0 && x_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y_gen = (float *) blas_malloc(n * incy_gen * sizeof(float) * 2); if (n * incy_gen > 0 && y_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } /* The debug iteration: If debug=1, then will execute the iteration twice. First, compute the max ratio. Second, print info if ratio > (50% * ratio_max). */ for (d_count = 0; d_count <= find_max_ratio; d_count++) { bad_ratios = 0; /* set to zero */ if ((debug == 3) && (d_count == find_max_ratio)) *seed = saved_seed; /* restore the original seed */ /* varying alpha */ for (alpha_val = 1; alpha_val < 3; alpha_val++) { alpha_flag = 0; switch (alpha_val) { case 0: alpha[0] = alpha[1] = 0.0; alpha_flag = 1; break; case 1: alpha[0] = 1.0; alpha[1] = 0.0; alpha_flag = 1; break; } /* varying beta */ for (beta_val = 0; beta_val < 3; beta_val++) { beta_flag = 0; switch (beta_val) { case 0: beta[0] = beta[1] = 0.0; beta_flag = 1; break; case 1: beta[0] = 1.0; beta[1] = 0.0; beta_flag = 1; break; } /* varying extra precs */ for (prec_val = 0; prec_val <= 2; prec_val++) { switch (prec_val) { case 0: eps_int = power(2, -BITS_S); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_single), (double) BLAS_fpinfo_x(blas_emin, blas_prec_single)); prec = blas_prec_single; break; case 1: eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; break; case 2: default: eps_int = power(2, -BITS_E); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra), (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra)); prec = blas_prec_extra; break; } /* values near underflow, 1, or overflow */ for (norm = -1; norm <= 1; norm++) { /* number of tests */ for (i = 0; i < ntests; i++) { /* conj or not */ for (conj_val = 0; conj_val < 2; conj_val++) { switch (conj_val) { case 0: conj_type = blas_no_conj; break; case 1: default: conj_type = blas_conj; break; } /* For the sake of speed, we throw out this case at random */ if (xrand(seed) >= test_prob) continue; BLAS_cdot_testgen(n, 0, 0, norm, conj_type, &alpha, alpha_flag, &beta, beta_flag, x_gen, y_gen, seed, &r, head_r_true, tail_r_true); count++; /* varying incx */ for (incx_val = -2; incx_val <= 2; incx_val++) { if (incx_val == 0) continue; ccopy_vector(x_gen, n, 1, x, incx_val); /* varying incy */ for (incy_val = -2; incy_val <= 2; incy_val++) { if (incy_val == 0) continue; ccopy_vector(y_gen, n, 1, y, incy_val); /* call BLAS_cdot_x to get r_comp */ r_comp[0] = r[0]; r_comp[1] = r[1]; FPU_FIX_STOP; BLAS_cdot_x(conj_type, n, alpha, x, incx_val, beta, y, incy_val, &r_comp, prec); FPU_FIX_START; /* computing the ratio */ test_BLAS_cdot(n, conj_type, alpha, beta, r, r_comp, head_r_true, tail_r_true, x, incx_val, y, incy_val, eps_int, un_int, &ratio); /* Increase the number of bad ratio, if the ratio is bigger than the threshold. The !<= below causes NaN error to be detected. Note that (NaN > thresh) is always false. */ if (!(ratio <= thresh)) { bad_ratios++; if ((debug == 3) && /* print only when debug is on */ (count != old_count) && /* print if old vector is different from the current one */ (d_count == find_max_ratio) && (p_count <= max_print) && (ratio > 0.5 * ratio_max)) { old_count = count; printf ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", fname, n, ntests, thresh); /* Print test info */ switch (prec) { case blas_prec_single: printf("single "); break; case blas_prec_double: printf("double "); break; case blas_prec_indigenous: printf("indigenous "); break; case blas_prec_extra: printf("extra "); break; } switch (norm) { case -1: printf("near_underflow "); break; case 0: printf("near_one "); break; case 1: printf("near_overflow "); break; } switch (conj_type) { case blas_no_conj: printf("no_conj "); break; case blas_conj: printf("conj "); break; } printf("incx=%d, incy=%d:\n", incx_val, incy_val); cprint_vector(x, n, incx_val, "x"); cprint_vector(y, n, incy_val, "y"); printf(" "); printf("alpha = "); printf("(%16.8e, %16.8e)", alpha[0], alpha[1]); printf("\n "); printf("beta = "); printf("(%16.8e, %16.8e)", beta[0], beta[1]); printf("\n"); printf(" "); printf("r = "); printf("(%16.8e, %16.8e)", r[0], r[1]); printf("\n "); printf("r_comp = "); printf("(%16.8e, %16.8e)", r_comp[0], r_comp[1]); printf("\n"); printf(" "); printf("r_true = "); printf("([%24.16e %24.16e], [%24.16e %24.16e])", head_r_true[0], tail_r_true[0], head_r_true[1], tail_r_true[1]); printf(" ratio=%.4e\n", ratio); p_count++; } } if (d_count == 0) { if (ratio > ratio_max) ratio_max = ratio; if (ratio != 0.0 && ratio < ratio_min) ratio_min = ratio; tot_tests++; } } /* incy */ } /* incx */ } /* conj */ } /* tests */ } /* norm */ } /* prec */ } /* beta */ } /* alpha */ } /* debug */ if ((debug == 2) || ((debug == 1) && (bad_ratios > 0))) { printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", fname, n, ntests, thresh); printf (" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests), ratio_min, ratio_max); } blas_free(x); blas_free(y); blas_free(x_gen); blas_free(y_gen); *min_ratio = ratio_min; *num_bad_ratio = bad_ratios; *num_tests = tot_tests; FPU_FIX_STOP; return ratio_max; } double do_test_zdot_x(int n, int ntests, int *seed, double thresh, int debug, float test_prob, double *min_ratio, int *num_bad_ratio, int *num_tests) /* * Purpose * ======= * * Runs a series of tests on dots * * Arguments * ========= * * n (input) int * The size of vector being tested * * ntests (input) int * The number of tests to run for each set of attributes. * * seed (input/output) int * The seed for the random number generator used in testgen(). * * thresh (input) double * When the ratio returned from test() exceeds the specified * threshold, the current size, r_true, r_comp, and ratio will be * printed. (Since ratio is supposed to be O(1), we can set thresh * to ~10.) * * debug (input) int * If debug=3, print summary * If debug=2, print summary only if the number of bad ratios > 0 * If debug=1, print complete info if tests fail * If debug=0, return max ratio * * min_ratio (output) double * The minimum ratio * * num_bad_ratio (output) int * The number of tests fail; they are above the threshold. * * num_tests (output) int * The number of tests is being performed. * * Return value * ============ * * The maximum ratio if run successfully, otherwise return -1 * */ { /* function name */ const char fname[] = "BLAS_zdot_x"; /* max number of debug lines to print */ const int max_print = 32; /* Variables in the "x_val" form are loop vars for corresponding variables */ int i; /* iterate through the repeating tests */ int incx_val, incy_val; /* for testing different inc values */ int incx_gen, incy_gen; /* for complex case inc=2, for real case inc=1 */ int d_count; /* counter for debug */ int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ int p_count; /* counter for the number of debug lines printed */ int tot_tests; /* total number of tests to be done */ int norm; /* input values of near underflow/one/overflow */ double ratio_max; /* the current maximum ratio */ double ratio_min; /* the current minimum ratio */ double ratio; /* the per-use test ratio from test() */ int bad_ratios = 0; /* the number of ratios over the threshold */ double eps_int; /* the internal epsilon expected--2^(-24) for float */ double un_int; /* the internal underflow threshold */ double alpha[2]; double beta[2]; double *x; double *y; /* x_gen and y_gen are used to store vectors generated by testgen. they eventually are copied back to x and y */ double *x_gen; double *y_gen; /* the true r calculated by testgen(), in double-double */ double head_r_true[2], tail_r_true[2]; double r[2]; /* the generated r */ double r_comp[2]; /* the r computed by BLAS_zdot_x */ int alpha_val; int alpha_flag; /* input flag for BLAS_zdot_testgen */ int beta_val; int beta_flag; /* input flag for BLAS_zdot_testgen */ int conj_val; enum blas_conj_type conj_type; int prec_val; enum blas_prec_type prec; int saved_seed; /* for saving the original seed */ int count = 0, old_count = 0; /* use for counting the number of testgen calls * 2 */ FPU_FIX_DECL; /* test for bad arguments */ if (n < 0) BLAS_error(fname, -1, n, NULL); else if (ntests < 0) BLAS_error(fname, -2, ntests, NULL); /* if there is nothing to test, return all zero */ if (n == 0 || ntests == 0) { *min_ratio = 0.0; *num_bad_ratio = 0; *num_tests = 0; return 0.0; } FPU_FIX_START; /* initialization */ saved_seed = *seed; ratio_min = 1e308; ratio_max = 0.0; tot_tests = 0; p_count = 0; count = 0; find_max_ratio = 0; if (debug == 3) find_max_ratio = 1; incx_gen = incy_gen = 1; incx_gen *= 2; incy_gen *= 2; /* get space for calculation */ x = (double *) blas_malloc(n * 2 * incx_gen * sizeof(double) * 2); if (n * 2 * incx_gen > 0 && x == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y = (double *) blas_malloc(n * 2 * incy_gen * sizeof(double) * 2); if (n * 2 * incy_gen > 0 && y == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } x_gen = (double *) blas_malloc(n * incx_gen * sizeof(double) * 2); if (n * incx_gen > 0 && x_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y_gen = (double *) blas_malloc(n * incy_gen * sizeof(double) * 2); if (n * incy_gen > 0 && y_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } /* The debug iteration: If debug=1, then will execute the iteration twice. First, compute the max ratio. Second, print info if ratio > (50% * ratio_max). */ for (d_count = 0; d_count <= find_max_ratio; d_count++) { bad_ratios = 0; /* set to zero */ if ((debug == 3) && (d_count == find_max_ratio)) *seed = saved_seed; /* restore the original seed */ /* varying alpha */ for (alpha_val = 1; alpha_val < 3; alpha_val++) { alpha_flag = 0; switch (alpha_val) { case 0: alpha[0] = alpha[1] = 0.0; alpha_flag = 1; break; case 1: alpha[0] = 1.0; alpha[1] = 0.0; alpha_flag = 1; break; } /* varying beta */ for (beta_val = 0; beta_val < 3; beta_val++) { beta_flag = 0; switch (beta_val) { case 0: beta[0] = beta[1] = 0.0; beta_flag = 1; break; case 1: beta[0] = 1.0; beta[1] = 0.0; beta_flag = 1; break; } /* varying extra precs */ for (prec_val = 0; prec_val <= 2; prec_val++) { switch (prec_val) { case 0: eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; break; case 1: eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; break; case 2: default: eps_int = power(2, -BITS_E); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra), (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra)); prec = blas_prec_extra; break; } /* values near underflow, 1, or overflow */ for (norm = -1; norm <= 1; norm++) { /* number of tests */ for (i = 0; i < ntests; i++) { /* conj or not */ for (conj_val = 0; conj_val < 2; conj_val++) { switch (conj_val) { case 0: conj_type = blas_no_conj; break; case 1: default: conj_type = blas_conj; break; } /* For the sake of speed, we throw out this case at random */ if (xrand(seed) >= test_prob) continue; BLAS_zdot_testgen(n, 0, 0, norm, conj_type, &alpha, alpha_flag, &beta, beta_flag, x_gen, y_gen, seed, &r, head_r_true, tail_r_true); count++; /* varying incx */ for (incx_val = -2; incx_val <= 2; incx_val++) { if (incx_val == 0) continue; zcopy_vector(x_gen, n, 1, x, incx_val); /* varying incy */ for (incy_val = -2; incy_val <= 2; incy_val++) { if (incy_val == 0) continue; zcopy_vector(y_gen, n, 1, y, incy_val); /* call BLAS_zdot_x to get r_comp */ r_comp[0] = r[0]; r_comp[1] = r[1]; FPU_FIX_STOP; BLAS_zdot_x(conj_type, n, alpha, x, incx_val, beta, y, incy_val, &r_comp, prec); FPU_FIX_START; /* computing the ratio */ test_BLAS_zdot(n, conj_type, alpha, beta, r, r_comp, head_r_true, tail_r_true, x, incx_val, y, incy_val, eps_int, un_int, &ratio); /* Increase the number of bad ratio, if the ratio is bigger than the threshold. The !<= below causes NaN error to be detected. Note that (NaN > thresh) is always false. */ if (!(ratio <= thresh)) { bad_ratios++; if ((debug == 3) && /* print only when debug is on */ (count != old_count) && /* print if old vector is different from the current one */ (d_count == find_max_ratio) && (p_count <= max_print) && (ratio > 0.5 * ratio_max)) { old_count = count; printf ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", fname, n, ntests, thresh); /* Print test info */ switch (prec) { case blas_prec_single: printf("single "); break; case blas_prec_double: printf("double "); break; case blas_prec_indigenous: printf("indigenous "); break; case blas_prec_extra: printf("extra "); break; } switch (norm) { case -1: printf("near_underflow "); break; case 0: printf("near_one "); break; case 1: printf("near_overflow "); break; } switch (conj_type) { case blas_no_conj: printf("no_conj "); break; case blas_conj: printf("conj "); break; } printf("incx=%d, incy=%d:\n", incx_val, incy_val); zprint_vector(x, n, incx_val, "x"); zprint_vector(y, n, incy_val, "y"); printf(" "); printf("alpha = "); printf("(%24.16e, %24.16e)", alpha[0], alpha[1]); printf("\n "); printf("beta = "); printf("(%24.16e, %24.16e)", beta[0], beta[1]); printf("\n"); printf(" "); printf("r = "); printf("(%24.16e, %24.16e)", r[0], r[1]); printf("\n "); printf("r_comp = "); printf("(%24.16e, %24.16e)", r_comp[0], r_comp[1]); printf("\n"); printf(" "); printf("r_true = "); printf("([%24.16e %24.16e], [%24.16e %24.16e])", head_r_true[0], tail_r_true[0], head_r_true[1], tail_r_true[1]); printf(" ratio=%.4e\n", ratio); p_count++; } } if (d_count == 0) { if (ratio > ratio_max) ratio_max = ratio; if (ratio != 0.0 && ratio < ratio_min) ratio_min = ratio; tot_tests++; } } /* incy */ } /* incx */ } /* conj */ } /* tests */ } /* norm */ } /* prec */ } /* beta */ } /* alpha */ } /* debug */ if ((debug == 2) || ((debug == 1) && (bad_ratios > 0))) { printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", fname, n, ntests, thresh); printf (" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests), ratio_min, ratio_max); } blas_free(x); blas_free(y); blas_free(x_gen); blas_free(y_gen); *min_ratio = ratio_min; *num_bad_ratio = bad_ratios; *num_tests = tot_tests; FPU_FIX_STOP; return ratio_max; } double do_test_ddot_d_s_x(int n, int ntests, int *seed, double thresh, int debug, float test_prob, double *min_ratio, int *num_bad_ratio, int *num_tests) /* * Purpose * ======= * * Runs a series of tests on dots * * Arguments * ========= * * n (input) int * The size of vector being tested * * ntests (input) int * The number of tests to run for each set of attributes. * * seed (input/output) int * The seed for the random number generator used in testgen(). * * thresh (input) double * When the ratio returned from test() exceeds the specified * threshold, the current size, r_true, r_comp, and ratio will be * printed. (Since ratio is supposed to be O(1), we can set thresh * to ~10.) * * debug (input) int * If debug=3, print summary * If debug=2, print summary only if the number of bad ratios > 0 * If debug=1, print complete info if tests fail * If debug=0, return max ratio * * min_ratio (output) double * The minimum ratio * * num_bad_ratio (output) int * The number of tests fail; they are above the threshold. * * num_tests (output) int * The number of tests is being performed. * * Return value * ============ * * The maximum ratio if run successfully, otherwise return -1 * */ { /* function name */ const char fname[] = "BLAS_ddot_d_s_x"; /* max number of debug lines to print */ const int max_print = 32; /* Variables in the "x_val" form are loop vars for corresponding variables */ int i; /* iterate through the repeating tests */ int incx_val, incy_val; /* for testing different inc values */ int incx_gen, incy_gen; /* for complex case inc=2, for real case inc=1 */ int d_count; /* counter for debug */ int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ int p_count; /* counter for the number of debug lines printed */ int tot_tests; /* total number of tests to be done */ int norm; /* input values of near underflow/one/overflow */ double ratio_max; /* the current maximum ratio */ double ratio_min; /* the current minimum ratio */ double ratio; /* the per-use test ratio from test() */ int bad_ratios = 0; /* the number of ratios over the threshold */ double eps_int; /* the internal epsilon expected--2^(-24) for float */ double un_int; /* the internal underflow threshold */ double alpha; double beta; double *x; float *y; /* x_gen and y_gen are used to store vectors generated by testgen. they eventually are copied back to x and y */ double *x_gen; float *y_gen; /* the true r calculated by testgen(), in double-double */ double head_r_true, tail_r_true; double r; /* the generated r */ double r_comp; /* the r computed by BLAS_ddot_d_s_x */ int alpha_val; int alpha_flag; /* input flag for BLAS_ddot_d_s_testgen */ int beta_val; int beta_flag; /* input flag for BLAS_ddot_d_s_testgen */ int conj_val; enum blas_conj_type conj_type; int prec_val; enum blas_prec_type prec; int saved_seed; /* for saving the original seed */ int count = 0, old_count = 0; /* use for counting the number of testgen calls * 2 */ FPU_FIX_DECL; /* test for bad arguments */ if (n < 0) BLAS_error(fname, -1, n, NULL); else if (ntests < 0) BLAS_error(fname, -2, ntests, NULL); /* if there is nothing to test, return all zero */ if (n == 0 || ntests == 0) { *min_ratio = 0.0; *num_bad_ratio = 0; *num_tests = 0; return 0.0; } FPU_FIX_START; /* initialization */ saved_seed = *seed; ratio_min = 1e308; ratio_max = 0.0; tot_tests = 0; p_count = 0; count = 0; find_max_ratio = 0; if (debug == 3) find_max_ratio = 1; incx_gen = incy_gen = 1; /* get space for calculation */ x = (double *) blas_malloc(n * 2 * incx_gen * sizeof(double)); if (n * 2 * incx_gen > 0 && x == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y = (float *) blas_malloc(n * 2 * incy_gen * sizeof(float)); if (n * 2 * incy_gen > 0 && y == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } x_gen = (double *) blas_malloc(n * incx_gen * sizeof(double)); if (n * incx_gen > 0 && x_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y_gen = (float *) blas_malloc(n * incy_gen * sizeof(float)); if (n * incy_gen > 0 && y_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } /* The debug iteration: If debug=1, then will execute the iteration twice. First, compute the max ratio. Second, print info if ratio > (50% * ratio_max). */ for (d_count = 0; d_count <= find_max_ratio; d_count++) { bad_ratios = 0; /* set to zero */ if ((debug == 3) && (d_count == find_max_ratio)) *seed = saved_seed; /* restore the original seed */ /* varying alpha */ for (alpha_val = 1; alpha_val < 3; alpha_val++) { alpha_flag = 0; switch (alpha_val) { case 0: alpha = 0.0; alpha_flag = 1; break; case 1: alpha = 1.0; alpha_flag = 1; break; } /* varying beta */ for (beta_val = 0; beta_val < 3; beta_val++) { beta_flag = 0; switch (beta_val) { case 0: beta = 0.0; beta_flag = 1; break; case 1: beta = 1.0; beta_flag = 1; break; } /* varying extra precs */ for (prec_val = 0; prec_val <= 2; prec_val++) { switch (prec_val) { case 0: eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; break; case 1: eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; break; case 2: default: eps_int = power(2, -BITS_E); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra), (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra)); prec = blas_prec_extra; break; } /* values near underflow, 1, or overflow */ for (norm = -1; norm <= 1; norm++) { /* number of tests */ for (i = 0; i < ntests; i++) { /* conj or not */ for (conj_val = 0; conj_val < 2; conj_val++) { switch (conj_val) { case 0: conj_type = blas_no_conj; break; case 1: default: conj_type = blas_conj; break; } /* For the sake of speed, we throw out this case at random */ if (xrand(seed) >= test_prob) continue; BLAS_ddot_d_s_testgen(n, 0, 0, norm, conj_type, &alpha, alpha_flag, &beta, beta_flag, x_gen, y_gen, seed, &r, &head_r_true, &tail_r_true); count++; /* varying incx */ for (incx_val = -2; incx_val <= 2; incx_val++) { if (incx_val == 0) continue; dcopy_vector(x_gen, n, 1, x, incx_val); /* varying incy */ for (incy_val = -2; incy_val <= 2; incy_val++) { if (incy_val == 0) continue; scopy_vector(y_gen, n, 1, y, incy_val); /* call BLAS_ddot_d_s_x to get r_comp */ r_comp = r; FPU_FIX_STOP; BLAS_ddot_d_s_x(conj_type, n, alpha, x, incx_val, beta, y, incy_val, &r_comp, prec); FPU_FIX_START; /* computing the ratio */ test_BLAS_ddot_d_s(n, conj_type, alpha, beta, r, r_comp, head_r_true, tail_r_true, x, incx_val, y, incy_val, eps_int, un_int, &ratio); /* Increase the number of bad ratio, if the ratio is bigger than the threshold. The !<= below causes NaN error to be detected. Note that (NaN > thresh) is always false. */ if (!(ratio <= thresh)) { bad_ratios++; if ((debug == 3) && /* print only when debug is on */ (count != old_count) && /* print if old vector is different from the current one */ (d_count == find_max_ratio) && (p_count <= max_print) && (ratio > 0.5 * ratio_max)) { old_count = count; printf ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", fname, n, ntests, thresh); /* Print test info */ switch (prec) { case blas_prec_single: printf("single "); break; case blas_prec_double: printf("double "); break; case blas_prec_indigenous: printf("indigenous "); break; case blas_prec_extra: printf("extra "); break; } switch (norm) { case -1: printf("near_underflow "); break; case 0: printf("near_one "); break; case 1: printf("near_overflow "); break; } switch (conj_type) { case blas_no_conj: printf("no_conj "); break; case blas_conj: printf("conj "); break; } printf("incx=%d, incy=%d:\n", incx_val, incy_val); dprint_vector(x, n, incx_val, "x"); sprint_vector(y, n, incy_val, "y"); printf(" "); printf("alpha = "); printf("%24.16e", alpha); printf("\n "); printf("beta = "); printf("%24.16e", beta); printf("\n"); printf(" "); printf("r = "); printf("%24.16e", r); printf("\n "); printf("r_comp = "); printf("%24.16e", r_comp); printf("\n"); printf(" "); printf("r_true = "); printf("[%24.16e %24.16e]", head_r_true, tail_r_true); printf(" ratio=%.4e\n", ratio); p_count++; } } if (d_count == 0) { if (ratio > ratio_max) ratio_max = ratio; if (ratio != 0.0 && ratio < ratio_min) ratio_min = ratio; tot_tests++; } } /* incy */ } /* incx */ } /* conj */ } /* tests */ } /* norm */ } /* prec */ } /* beta */ } /* alpha */ } /* debug */ if ((debug == 2) || ((debug == 1) && (bad_ratios > 0))) { printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", fname, n, ntests, thresh); printf (" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests), ratio_min, ratio_max); } blas_free(x); blas_free(y); blas_free(x_gen); blas_free(y_gen); *min_ratio = ratio_min; *num_bad_ratio = bad_ratios; *num_tests = tot_tests; FPU_FIX_STOP; return ratio_max; } double do_test_ddot_s_d_x(int n, int ntests, int *seed, double thresh, int debug, float test_prob, double *min_ratio, int *num_bad_ratio, int *num_tests) /* * Purpose * ======= * * Runs a series of tests on dots * * Arguments * ========= * * n (input) int * The size of vector being tested * * ntests (input) int * The number of tests to run for each set of attributes. * * seed (input/output) int * The seed for the random number generator used in testgen(). * * thresh (input) double * When the ratio returned from test() exceeds the specified * threshold, the current size, r_true, r_comp, and ratio will be * printed. (Since ratio is supposed to be O(1), we can set thresh * to ~10.) * * debug (input) int * If debug=3, print summary * If debug=2, print summary only if the number of bad ratios > 0 * If debug=1, print complete info if tests fail * If debug=0, return max ratio * * min_ratio (output) double * The minimum ratio * * num_bad_ratio (output) int * The number of tests fail; they are above the threshold. * * num_tests (output) int * The number of tests is being performed. * * Return value * ============ * * The maximum ratio if run successfully, otherwise return -1 * */ { /* function name */ const char fname[] = "BLAS_ddot_s_d_x"; /* max number of debug lines to print */ const int max_print = 32; /* Variables in the "x_val" form are loop vars for corresponding variables */ int i; /* iterate through the repeating tests */ int incx_val, incy_val; /* for testing different inc values */ int incx_gen, incy_gen; /* for complex case inc=2, for real case inc=1 */ int d_count; /* counter for debug */ int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ int p_count; /* counter for the number of debug lines printed */ int tot_tests; /* total number of tests to be done */ int norm; /* input values of near underflow/one/overflow */ double ratio_max; /* the current maximum ratio */ double ratio_min; /* the current minimum ratio */ double ratio; /* the per-use test ratio from test() */ int bad_ratios = 0; /* the number of ratios over the threshold */ double eps_int; /* the internal epsilon expected--2^(-24) for float */ double un_int; /* the internal underflow threshold */ double alpha; double beta; float *x; double *y; /* x_gen and y_gen are used to store vectors generated by testgen. they eventually are copied back to x and y */ float *x_gen; double *y_gen; /* the true r calculated by testgen(), in double-double */ double head_r_true, tail_r_true; double r; /* the generated r */ double r_comp; /* the r computed by BLAS_ddot_s_d_x */ int alpha_val; int alpha_flag; /* input flag for BLAS_ddot_s_d_testgen */ int beta_val; int beta_flag; /* input flag for BLAS_ddot_s_d_testgen */ int conj_val; enum blas_conj_type conj_type; int prec_val; enum blas_prec_type prec; int saved_seed; /* for saving the original seed */ int count = 0, old_count = 0; /* use for counting the number of testgen calls * 2 */ FPU_FIX_DECL; /* test for bad arguments */ if (n < 0) BLAS_error(fname, -1, n, NULL); else if (ntests < 0) BLAS_error(fname, -2, ntests, NULL); /* if there is nothing to test, return all zero */ if (n == 0 || ntests == 0) { *min_ratio = 0.0; *num_bad_ratio = 0; *num_tests = 0; return 0.0; } FPU_FIX_START; /* initialization */ saved_seed = *seed; ratio_min = 1e308; ratio_max = 0.0; tot_tests = 0; p_count = 0; count = 0; find_max_ratio = 0; if (debug == 3) find_max_ratio = 1; incx_gen = incy_gen = 1; /* get space for calculation */ x = (float *) blas_malloc(n * 2 * incx_gen * sizeof(float)); if (n * 2 * incx_gen > 0 && x == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y = (double *) blas_malloc(n * 2 * incy_gen * sizeof(double)); if (n * 2 * incy_gen > 0 && y == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } x_gen = (float *) blas_malloc(n * incx_gen * sizeof(float)); if (n * incx_gen > 0 && x_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y_gen = (double *) blas_malloc(n * incy_gen * sizeof(double)); if (n * incy_gen > 0 && y_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } /* The debug iteration: If debug=1, then will execute the iteration twice. First, compute the max ratio. Second, print info if ratio > (50% * ratio_max). */ for (d_count = 0; d_count <= find_max_ratio; d_count++) { bad_ratios = 0; /* set to zero */ if ((debug == 3) && (d_count == find_max_ratio)) *seed = saved_seed; /* restore the original seed */ /* varying alpha */ for (alpha_val = 1; alpha_val < 3; alpha_val++) { alpha_flag = 0; switch (alpha_val) { case 0: alpha = 0.0; alpha_flag = 1; break; case 1: alpha = 1.0; alpha_flag = 1; break; } /* varying beta */ for (beta_val = 0; beta_val < 3; beta_val++) { beta_flag = 0; switch (beta_val) { case 0: beta = 0.0; beta_flag = 1; break; case 1: beta = 1.0; beta_flag = 1; break; } /* varying extra precs */ for (prec_val = 0; prec_val <= 2; prec_val++) { switch (prec_val) { case 0: eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; break; case 1: eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; break; case 2: default: eps_int = power(2, -BITS_E); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra), (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra)); prec = blas_prec_extra; break; } /* values near underflow, 1, or overflow */ for (norm = -1; norm <= 1; norm++) { /* number of tests */ for (i = 0; i < ntests; i++) { /* conj or not */ for (conj_val = 0; conj_val < 2; conj_val++) { switch (conj_val) { case 0: conj_type = blas_no_conj; break; case 1: default: conj_type = blas_conj; break; } /* For the sake of speed, we throw out this case at random */ if (xrand(seed) >= test_prob) continue; BLAS_ddot_s_d_testgen(n, 0, 0, norm, conj_type, &alpha, alpha_flag, &beta, beta_flag, x_gen, y_gen, seed, &r, &head_r_true, &tail_r_true); count++; /* varying incx */ for (incx_val = -2; incx_val <= 2; incx_val++) { if (incx_val == 0) continue; scopy_vector(x_gen, n, 1, x, incx_val); /* varying incy */ for (incy_val = -2; incy_val <= 2; incy_val++) { if (incy_val == 0) continue; dcopy_vector(y_gen, n, 1, y, incy_val); /* call BLAS_ddot_s_d_x to get r_comp */ r_comp = r; FPU_FIX_STOP; BLAS_ddot_s_d_x(conj_type, n, alpha, x, incx_val, beta, y, incy_val, &r_comp, prec); FPU_FIX_START; /* computing the ratio */ test_BLAS_ddot_s_d(n, conj_type, alpha, beta, r, r_comp, head_r_true, tail_r_true, x, incx_val, y, incy_val, eps_int, un_int, &ratio); /* Increase the number of bad ratio, if the ratio is bigger than the threshold. The !<= below causes NaN error to be detected. Note that (NaN > thresh) is always false. */ if (!(ratio <= thresh)) { bad_ratios++; if ((debug == 3) && /* print only when debug is on */ (count != old_count) && /* print if old vector is different from the current one */ (d_count == find_max_ratio) && (p_count <= max_print) && (ratio > 0.5 * ratio_max)) { old_count = count; printf ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", fname, n, ntests, thresh); /* Print test info */ switch (prec) { case blas_prec_single: printf("single "); break; case blas_prec_double: printf("double "); break; case blas_prec_indigenous: printf("indigenous "); break; case blas_prec_extra: printf("extra "); break; } switch (norm) { case -1: printf("near_underflow "); break; case 0: printf("near_one "); break; case 1: printf("near_overflow "); break; } switch (conj_type) { case blas_no_conj: printf("no_conj "); break; case blas_conj: printf("conj "); break; } printf("incx=%d, incy=%d:\n", incx_val, incy_val); sprint_vector(x, n, incx_val, "x"); dprint_vector(y, n, incy_val, "y"); printf(" "); printf("alpha = "); printf("%24.16e", alpha); printf("\n "); printf("beta = "); printf("%24.16e", beta); printf("\n"); printf(" "); printf("r = "); printf("%24.16e", r); printf("\n "); printf("r_comp = "); printf("%24.16e", r_comp); printf("\n"); printf(" "); printf("r_true = "); printf("[%24.16e %24.16e]", head_r_true, tail_r_true); printf(" ratio=%.4e\n", ratio); p_count++; } } if (d_count == 0) { if (ratio > ratio_max) ratio_max = ratio; if (ratio != 0.0 && ratio < ratio_min) ratio_min = ratio; tot_tests++; } } /* incy */ } /* incx */ } /* conj */ } /* tests */ } /* norm */ } /* prec */ } /* beta */ } /* alpha */ } /* debug */ if ((debug == 2) || ((debug == 1) && (bad_ratios > 0))) { printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", fname, n, ntests, thresh); printf (" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests), ratio_min, ratio_max); } blas_free(x); blas_free(y); blas_free(x_gen); blas_free(y_gen); *min_ratio = ratio_min; *num_bad_ratio = bad_ratios; *num_tests = tot_tests; FPU_FIX_STOP; return ratio_max; } double do_test_ddot_s_s_x(int n, int ntests, int *seed, double thresh, int debug, float test_prob, double *min_ratio, int *num_bad_ratio, int *num_tests) /* * Purpose * ======= * * Runs a series of tests on dots * * Arguments * ========= * * n (input) int * The size of vector being tested * * ntests (input) int * The number of tests to run for each set of attributes. * * seed (input/output) int * The seed for the random number generator used in testgen(). * * thresh (input) double * When the ratio returned from test() exceeds the specified * threshold, the current size, r_true, r_comp, and ratio will be * printed. (Since ratio is supposed to be O(1), we can set thresh * to ~10.) * * debug (input) int * If debug=3, print summary * If debug=2, print summary only if the number of bad ratios > 0 * If debug=1, print complete info if tests fail * If debug=0, return max ratio * * min_ratio (output) double * The minimum ratio * * num_bad_ratio (output) int * The number of tests fail; they are above the threshold. * * num_tests (output) int * The number of tests is being performed. * * Return value * ============ * * The maximum ratio if run successfully, otherwise return -1 * */ { /* function name */ const char fname[] = "BLAS_ddot_s_s_x"; /* max number of debug lines to print */ const int max_print = 32; /* Variables in the "x_val" form are loop vars for corresponding variables */ int i; /* iterate through the repeating tests */ int incx_val, incy_val; /* for testing different inc values */ int incx_gen, incy_gen; /* for complex case inc=2, for real case inc=1 */ int d_count; /* counter for debug */ int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ int p_count; /* counter for the number of debug lines printed */ int tot_tests; /* total number of tests to be done */ int norm; /* input values of near underflow/one/overflow */ double ratio_max; /* the current maximum ratio */ double ratio_min; /* the current minimum ratio */ double ratio; /* the per-use test ratio from test() */ int bad_ratios = 0; /* the number of ratios over the threshold */ double eps_int; /* the internal epsilon expected--2^(-24) for float */ double un_int; /* the internal underflow threshold */ double alpha; double beta; float *x; float *y; /* x_gen and y_gen are used to store vectors generated by testgen. they eventually are copied back to x and y */ float *x_gen; float *y_gen; /* the true r calculated by testgen(), in double-double */ double head_r_true, tail_r_true; double r; /* the generated r */ double r_comp; /* the r computed by BLAS_ddot_s_s_x */ int alpha_val; int alpha_flag; /* input flag for BLAS_ddot_s_s_testgen */ int beta_val; int beta_flag; /* input flag for BLAS_ddot_s_s_testgen */ int conj_val; enum blas_conj_type conj_type; int prec_val; enum blas_prec_type prec; int saved_seed; /* for saving the original seed */ int count = 0, old_count = 0; /* use for counting the number of testgen calls * 2 */ FPU_FIX_DECL; /* test for bad arguments */ if (n < 0) BLAS_error(fname, -1, n, NULL); else if (ntests < 0) BLAS_error(fname, -2, ntests, NULL); /* if there is nothing to test, return all zero */ if (n == 0 || ntests == 0) { *min_ratio = 0.0; *num_bad_ratio = 0; *num_tests = 0; return 0.0; } FPU_FIX_START; /* initialization */ saved_seed = *seed; ratio_min = 1e308; ratio_max = 0.0; tot_tests = 0; p_count = 0; count = 0; find_max_ratio = 0; if (debug == 3) find_max_ratio = 1; incx_gen = incy_gen = 1; /* get space for calculation */ x = (float *) blas_malloc(n * 2 * incx_gen * sizeof(float)); if (n * 2 * incx_gen > 0 && x == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y = (float *) blas_malloc(n * 2 * incy_gen * sizeof(float)); if (n * 2 * incy_gen > 0 && y == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } x_gen = (float *) blas_malloc(n * incx_gen * sizeof(float)); if (n * incx_gen > 0 && x_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y_gen = (float *) blas_malloc(n * incy_gen * sizeof(float)); if (n * incy_gen > 0 && y_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } /* The debug iteration: If debug=1, then will execute the iteration twice. First, compute the max ratio. Second, print info if ratio > (50% * ratio_max). */ for (d_count = 0; d_count <= find_max_ratio; d_count++) { bad_ratios = 0; /* set to zero */ if ((debug == 3) && (d_count == find_max_ratio)) *seed = saved_seed; /* restore the original seed */ /* varying alpha */ for (alpha_val = 1; alpha_val < 3; alpha_val++) { alpha_flag = 0; switch (alpha_val) { case 0: alpha = 0.0; alpha_flag = 1; break; case 1: alpha = 1.0; alpha_flag = 1; break; } /* varying beta */ for (beta_val = 0; beta_val < 3; beta_val++) { beta_flag = 0; switch (beta_val) { case 0: beta = 0.0; beta_flag = 1; break; case 1: beta = 1.0; beta_flag = 1; break; } /* varying extra precs */ for (prec_val = 0; prec_val <= 2; prec_val++) { switch (prec_val) { case 0: eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; break; case 1: eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; break; case 2: default: eps_int = power(2, -BITS_E); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra), (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra)); prec = blas_prec_extra; break; } /* values near underflow, 1, or overflow */ for (norm = -1; norm <= 1; norm++) { /* number of tests */ for (i = 0; i < ntests; i++) { /* conj or not */ for (conj_val = 0; conj_val < 2; conj_val++) { switch (conj_val) { case 0: conj_type = blas_no_conj; break; case 1: default: conj_type = blas_conj; break; } /* For the sake of speed, we throw out this case at random */ if (xrand(seed) >= test_prob) continue; BLAS_ddot_s_s_testgen(n, 0, 0, norm, conj_type, &alpha, alpha_flag, &beta, beta_flag, x_gen, y_gen, seed, &r, &head_r_true, &tail_r_true); count++; /* varying incx */ for (incx_val = -2; incx_val <= 2; incx_val++) { if (incx_val == 0) continue; scopy_vector(x_gen, n, 1, x, incx_val); /* varying incy */ for (incy_val = -2; incy_val <= 2; incy_val++) { if (incy_val == 0) continue; scopy_vector(y_gen, n, 1, y, incy_val); /* call BLAS_ddot_s_s_x to get r_comp */ r_comp = r; FPU_FIX_STOP; BLAS_ddot_s_s_x(conj_type, n, alpha, x, incx_val, beta, y, incy_val, &r_comp, prec); FPU_FIX_START; /* computing the ratio */ test_BLAS_ddot_s_s(n, conj_type, alpha, beta, r, r_comp, head_r_true, tail_r_true, x, incx_val, y, incy_val, eps_int, un_int, &ratio); /* Increase the number of bad ratio, if the ratio is bigger than the threshold. The !<= below causes NaN error to be detected. Note that (NaN > thresh) is always false. */ if (!(ratio <= thresh)) { bad_ratios++; if ((debug == 3) && /* print only when debug is on */ (count != old_count) && /* print if old vector is different from the current one */ (d_count == find_max_ratio) && (p_count <= max_print) && (ratio > 0.5 * ratio_max)) { old_count = count; printf ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", fname, n, ntests, thresh); /* Print test info */ switch (prec) { case blas_prec_single: printf("single "); break; case blas_prec_double: printf("double "); break; case blas_prec_indigenous: printf("indigenous "); break; case blas_prec_extra: printf("extra "); break; } switch (norm) { case -1: printf("near_underflow "); break; case 0: printf("near_one "); break; case 1: printf("near_overflow "); break; } switch (conj_type) { case blas_no_conj: printf("no_conj "); break; case blas_conj: printf("conj "); break; } printf("incx=%d, incy=%d:\n", incx_val, incy_val); sprint_vector(x, n, incx_val, "x"); sprint_vector(y, n, incy_val, "y"); printf(" "); printf("alpha = "); printf("%24.16e", alpha); printf("\n "); printf("beta = "); printf("%24.16e", beta); printf("\n"); printf(" "); printf("r = "); printf("%24.16e", r); printf("\n "); printf("r_comp = "); printf("%24.16e", r_comp); printf("\n"); printf(" "); printf("r_true = "); printf("[%24.16e %24.16e]", head_r_true, tail_r_true); printf(" ratio=%.4e\n", ratio); p_count++; } } if (d_count == 0) { if (ratio > ratio_max) ratio_max = ratio; if (ratio != 0.0 && ratio < ratio_min) ratio_min = ratio; tot_tests++; } } /* incy */ } /* incx */ } /* conj */ } /* tests */ } /* norm */ } /* prec */ } /* beta */ } /* alpha */ } /* debug */ if ((debug == 2) || ((debug == 1) && (bad_ratios > 0))) { printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", fname, n, ntests, thresh); printf (" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests), ratio_min, ratio_max); } blas_free(x); blas_free(y); blas_free(x_gen); blas_free(y_gen); *min_ratio = ratio_min; *num_bad_ratio = bad_ratios; *num_tests = tot_tests; FPU_FIX_STOP; return ratio_max; } double do_test_zdot_z_c_x(int n, int ntests, int *seed, double thresh, int debug, float test_prob, double *min_ratio, int *num_bad_ratio, int *num_tests) /* * Purpose * ======= * * Runs a series of tests on dots * * Arguments * ========= * * n (input) int * The size of vector being tested * * ntests (input) int * The number of tests to run for each set of attributes. * * seed (input/output) int * The seed for the random number generator used in testgen(). * * thresh (input) double * When the ratio returned from test() exceeds the specified * threshold, the current size, r_true, r_comp, and ratio will be * printed. (Since ratio is supposed to be O(1), we can set thresh * to ~10.) * * debug (input) int * If debug=3, print summary * If debug=2, print summary only if the number of bad ratios > 0 * If debug=1, print complete info if tests fail * If debug=0, return max ratio * * min_ratio (output) double * The minimum ratio * * num_bad_ratio (output) int * The number of tests fail; they are above the threshold. * * num_tests (output) int * The number of tests is being performed. * * Return value * ============ * * The maximum ratio if run successfully, otherwise return -1 * */ { /* function name */ const char fname[] = "BLAS_zdot_z_c_x"; /* max number of debug lines to print */ const int max_print = 32; /* Variables in the "x_val" form are loop vars for corresponding variables */ int i; /* iterate through the repeating tests */ int incx_val, incy_val; /* for testing different inc values */ int incx_gen, incy_gen; /* for complex case inc=2, for real case inc=1 */ int d_count; /* counter for debug */ int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ int p_count; /* counter for the number of debug lines printed */ int tot_tests; /* total number of tests to be done */ int norm; /* input values of near underflow/one/overflow */ double ratio_max; /* the current maximum ratio */ double ratio_min; /* the current minimum ratio */ double ratio; /* the per-use test ratio from test() */ int bad_ratios = 0; /* the number of ratios over the threshold */ double eps_int; /* the internal epsilon expected--2^(-24) for float */ double un_int; /* the internal underflow threshold */ double alpha[2]; double beta[2]; double *x; float *y; /* x_gen and y_gen are used to store vectors generated by testgen. they eventually are copied back to x and y */ double *x_gen; float *y_gen; /* the true r calculated by testgen(), in double-double */ double head_r_true[2], tail_r_true[2]; double r[2]; /* the generated r */ double r_comp[2]; /* the r computed by BLAS_zdot_z_c_x */ int alpha_val; int alpha_flag; /* input flag for BLAS_zdot_z_c_testgen */ int beta_val; int beta_flag; /* input flag for BLAS_zdot_z_c_testgen */ int conj_val; enum blas_conj_type conj_type; int prec_val; enum blas_prec_type prec; int saved_seed; /* for saving the original seed */ int count = 0, old_count = 0; /* use for counting the number of testgen calls * 2 */ FPU_FIX_DECL; /* test for bad arguments */ if (n < 0) BLAS_error(fname, -1, n, NULL); else if (ntests < 0) BLAS_error(fname, -2, ntests, NULL); /* if there is nothing to test, return all zero */ if (n == 0 || ntests == 0) { *min_ratio = 0.0; *num_bad_ratio = 0; *num_tests = 0; return 0.0; } FPU_FIX_START; /* initialization */ saved_seed = *seed; ratio_min = 1e308; ratio_max = 0.0; tot_tests = 0; p_count = 0; count = 0; find_max_ratio = 0; if (debug == 3) find_max_ratio = 1; incx_gen = incy_gen = 1; incx_gen *= 2; incy_gen *= 2; /* get space for calculation */ x = (double *) blas_malloc(n * 2 * incx_gen * sizeof(double) * 2); if (n * 2 * incx_gen > 0 && x == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y = (float *) blas_malloc(n * 2 * incy_gen * sizeof(float) * 2); if (n * 2 * incy_gen > 0 && y == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } x_gen = (double *) blas_malloc(n * incx_gen * sizeof(double) * 2); if (n * incx_gen > 0 && x_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y_gen = (float *) blas_malloc(n * incy_gen * sizeof(float) * 2); if (n * incy_gen > 0 && y_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } /* The debug iteration: If debug=1, then will execute the iteration twice. First, compute the max ratio. Second, print info if ratio > (50% * ratio_max). */ for (d_count = 0; d_count <= find_max_ratio; d_count++) { bad_ratios = 0; /* set to zero */ if ((debug == 3) && (d_count == find_max_ratio)) *seed = saved_seed; /* restore the original seed */ /* varying alpha */ for (alpha_val = 1; alpha_val < 3; alpha_val++) { alpha_flag = 0; switch (alpha_val) { case 0: alpha[0] = alpha[1] = 0.0; alpha_flag = 1; break; case 1: alpha[0] = 1.0; alpha[1] = 0.0; alpha_flag = 1; break; } /* varying beta */ for (beta_val = 0; beta_val < 3; beta_val++) { beta_flag = 0; switch (beta_val) { case 0: beta[0] = beta[1] = 0.0; beta_flag = 1; break; case 1: beta[0] = 1.0; beta[1] = 0.0; beta_flag = 1; break; } /* varying extra precs */ for (prec_val = 0; prec_val <= 2; prec_val++) { switch (prec_val) { case 0: eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; break; case 1: eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; break; case 2: default: eps_int = power(2, -BITS_E); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra), (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra)); prec = blas_prec_extra; break; } /* values near underflow, 1, or overflow */ for (norm = -1; norm <= 1; norm++) { /* number of tests */ for (i = 0; i < ntests; i++) { /* conj or not */ for (conj_val = 0; conj_val < 2; conj_val++) { switch (conj_val) { case 0: conj_type = blas_no_conj; break; case 1: default: conj_type = blas_conj; break; } /* For the sake of speed, we throw out this case at random */ if (xrand(seed) >= test_prob) continue; BLAS_zdot_z_c_testgen(n, 0, 0, norm, conj_type, &alpha, alpha_flag, &beta, beta_flag, x_gen, y_gen, seed, &r, head_r_true, tail_r_true); count++; /* varying incx */ for (incx_val = -2; incx_val <= 2; incx_val++) { if (incx_val == 0) continue; zcopy_vector(x_gen, n, 1, x, incx_val); /* varying incy */ for (incy_val = -2; incy_val <= 2; incy_val++) { if (incy_val == 0) continue; ccopy_vector(y_gen, n, 1, y, incy_val); /* call BLAS_zdot_z_c_x to get r_comp */ r_comp[0] = r[0]; r_comp[1] = r[1]; FPU_FIX_STOP; BLAS_zdot_z_c_x(conj_type, n, alpha, x, incx_val, beta, y, incy_val, &r_comp, prec); FPU_FIX_START; /* computing the ratio */ test_BLAS_zdot_z_c(n, conj_type, alpha, beta, r, r_comp, head_r_true, tail_r_true, x, incx_val, y, incy_val, eps_int, un_int, &ratio); /* Increase the number of bad ratio, if the ratio is bigger than the threshold. The !<= below causes NaN error to be detected. Note that (NaN > thresh) is always false. */ if (!(ratio <= thresh)) { bad_ratios++; if ((debug == 3) && /* print only when debug is on */ (count != old_count) && /* print if old vector is different from the current one */ (d_count == find_max_ratio) && (p_count <= max_print) && (ratio > 0.5 * ratio_max)) { old_count = count; printf ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", fname, n, ntests, thresh); /* Print test info */ switch (prec) { case blas_prec_single: printf("single "); break; case blas_prec_double: printf("double "); break; case blas_prec_indigenous: printf("indigenous "); break; case blas_prec_extra: printf("extra "); break; } switch (norm) { case -1: printf("near_underflow "); break; case 0: printf("near_one "); break; case 1: printf("near_overflow "); break; } switch (conj_type) { case blas_no_conj: printf("no_conj "); break; case blas_conj: printf("conj "); break; } printf("incx=%d, incy=%d:\n", incx_val, incy_val); zprint_vector(x, n, incx_val, "x"); cprint_vector(y, n, incy_val, "y"); printf(" "); printf("alpha = "); printf("(%24.16e, %24.16e)", alpha[0], alpha[1]); printf("\n "); printf("beta = "); printf("(%24.16e, %24.16e)", beta[0], beta[1]); printf("\n"); printf(" "); printf("r = "); printf("(%24.16e, %24.16e)", r[0], r[1]); printf("\n "); printf("r_comp = "); printf("(%24.16e, %24.16e)", r_comp[0], r_comp[1]); printf("\n"); printf(" "); printf("r_true = "); printf("([%24.16e %24.16e], [%24.16e %24.16e])", head_r_true[0], tail_r_true[0], head_r_true[1], tail_r_true[1]); printf(" ratio=%.4e\n", ratio); p_count++; } } if (d_count == 0) { if (ratio > ratio_max) ratio_max = ratio; if (ratio != 0.0 && ratio < ratio_min) ratio_min = ratio; tot_tests++; } } /* incy */ } /* incx */ } /* conj */ } /* tests */ } /* norm */ } /* prec */ } /* beta */ } /* alpha */ } /* debug */ if ((debug == 2) || ((debug == 1) && (bad_ratios > 0))) { printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", fname, n, ntests, thresh); printf (" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests), ratio_min, ratio_max); } blas_free(x); blas_free(y); blas_free(x_gen); blas_free(y_gen); *min_ratio = ratio_min; *num_bad_ratio = bad_ratios; *num_tests = tot_tests; FPU_FIX_STOP; return ratio_max; } double do_test_zdot_c_z_x(int n, int ntests, int *seed, double thresh, int debug, float test_prob, double *min_ratio, int *num_bad_ratio, int *num_tests) /* * Purpose * ======= * * Runs a series of tests on dots * * Arguments * ========= * * n (input) int * The size of vector being tested * * ntests (input) int * The number of tests to run for each set of attributes. * * seed (input/output) int * The seed for the random number generator used in testgen(). * * thresh (input) double * When the ratio returned from test() exceeds the specified * threshold, the current size, r_true, r_comp, and ratio will be * printed. (Since ratio is supposed to be O(1), we can set thresh * to ~10.) * * debug (input) int * If debug=3, print summary * If debug=2, print summary only if the number of bad ratios > 0 * If debug=1, print complete info if tests fail * If debug=0, return max ratio * * min_ratio (output) double * The minimum ratio * * num_bad_ratio (output) int * The number of tests fail; they are above the threshold. * * num_tests (output) int * The number of tests is being performed. * * Return value * ============ * * The maximum ratio if run successfully, otherwise return -1 * */ { /* function name */ const char fname[] = "BLAS_zdot_c_z_x"; /* max number of debug lines to print */ const int max_print = 32; /* Variables in the "x_val" form are loop vars for corresponding variables */ int i; /* iterate through the repeating tests */ int incx_val, incy_val; /* for testing different inc values */ int incx_gen, incy_gen; /* for complex case inc=2, for real case inc=1 */ int d_count; /* counter for debug */ int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ int p_count; /* counter for the number of debug lines printed */ int tot_tests; /* total number of tests to be done */ int norm; /* input values of near underflow/one/overflow */ double ratio_max; /* the current maximum ratio */ double ratio_min; /* the current minimum ratio */ double ratio; /* the per-use test ratio from test() */ int bad_ratios = 0; /* the number of ratios over the threshold */ double eps_int; /* the internal epsilon expected--2^(-24) for float */ double un_int; /* the internal underflow threshold */ double alpha[2]; double beta[2]; float *x; double *y; /* x_gen and y_gen are used to store vectors generated by testgen. they eventually are copied back to x and y */ float *x_gen; double *y_gen; /* the true r calculated by testgen(), in double-double */ double head_r_true[2], tail_r_true[2]; double r[2]; /* the generated r */ double r_comp[2]; /* the r computed by BLAS_zdot_c_z_x */ int alpha_val; int alpha_flag; /* input flag for BLAS_zdot_c_z_testgen */ int beta_val; int beta_flag; /* input flag for BLAS_zdot_c_z_testgen */ int conj_val; enum blas_conj_type conj_type; int prec_val; enum blas_prec_type prec; int saved_seed; /* for saving the original seed */ int count = 0, old_count = 0; /* use for counting the number of testgen calls * 2 */ FPU_FIX_DECL; /* test for bad arguments */ if (n < 0) BLAS_error(fname, -1, n, NULL); else if (ntests < 0) BLAS_error(fname, -2, ntests, NULL); /* if there is nothing to test, return all zero */ if (n == 0 || ntests == 0) { *min_ratio = 0.0; *num_bad_ratio = 0; *num_tests = 0; return 0.0; } FPU_FIX_START; /* initialization */ saved_seed = *seed; ratio_min = 1e308; ratio_max = 0.0; tot_tests = 0; p_count = 0; count = 0; find_max_ratio = 0; if (debug == 3) find_max_ratio = 1; incx_gen = incy_gen = 1; incx_gen *= 2; incy_gen *= 2; /* get space for calculation */ x = (float *) blas_malloc(n * 2 * incx_gen * sizeof(float) * 2); if (n * 2 * incx_gen > 0 && x == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y = (double *) blas_malloc(n * 2 * incy_gen * sizeof(double) * 2); if (n * 2 * incy_gen > 0 && y == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } x_gen = (float *) blas_malloc(n * incx_gen * sizeof(float) * 2); if (n * incx_gen > 0 && x_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y_gen = (double *) blas_malloc(n * incy_gen * sizeof(double) * 2); if (n * incy_gen > 0 && y_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } /* The debug iteration: If debug=1, then will execute the iteration twice. First, compute the max ratio. Second, print info if ratio > (50% * ratio_max). */ for (d_count = 0; d_count <= find_max_ratio; d_count++) { bad_ratios = 0; /* set to zero */ if ((debug == 3) && (d_count == find_max_ratio)) *seed = saved_seed; /* restore the original seed */ /* varying alpha */ for (alpha_val = 1; alpha_val < 3; alpha_val++) { alpha_flag = 0; switch (alpha_val) { case 0: alpha[0] = alpha[1] = 0.0; alpha_flag = 1; break; case 1: alpha[0] = 1.0; alpha[1] = 0.0; alpha_flag = 1; break; } /* varying beta */ for (beta_val = 0; beta_val < 3; beta_val++) { beta_flag = 0; switch (beta_val) { case 0: beta[0] = beta[1] = 0.0; beta_flag = 1; break; case 1: beta[0] = 1.0; beta[1] = 0.0; beta_flag = 1; break; } /* varying extra precs */ for (prec_val = 0; prec_val <= 2; prec_val++) { switch (prec_val) { case 0: eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; break; case 1: eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; break; case 2: default: eps_int = power(2, -BITS_E); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra), (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra)); prec = blas_prec_extra; break; } /* values near underflow, 1, or overflow */ for (norm = -1; norm <= 1; norm++) { /* number of tests */ for (i = 0; i < ntests; i++) { /* conj or not */ for (conj_val = 0; conj_val < 2; conj_val++) { switch (conj_val) { case 0: conj_type = blas_no_conj; break; case 1: default: conj_type = blas_conj; break; } /* For the sake of speed, we throw out this case at random */ if (xrand(seed) >= test_prob) continue; BLAS_zdot_c_z_testgen(n, 0, 0, norm, conj_type, &alpha, alpha_flag, &beta, beta_flag, x_gen, y_gen, seed, &r, head_r_true, tail_r_true); count++; /* varying incx */ for (incx_val = -2; incx_val <= 2; incx_val++) { if (incx_val == 0) continue; ccopy_vector(x_gen, n, 1, x, incx_val); /* varying incy */ for (incy_val = -2; incy_val <= 2; incy_val++) { if (incy_val == 0) continue; zcopy_vector(y_gen, n, 1, y, incy_val); /* call BLAS_zdot_c_z_x to get r_comp */ r_comp[0] = r[0]; r_comp[1] = r[1]; FPU_FIX_STOP; BLAS_zdot_c_z_x(conj_type, n, alpha, x, incx_val, beta, y, incy_val, &r_comp, prec); FPU_FIX_START; /* computing the ratio */ test_BLAS_zdot_c_z(n, conj_type, alpha, beta, r, r_comp, head_r_true, tail_r_true, x, incx_val, y, incy_val, eps_int, un_int, &ratio); /* Increase the number of bad ratio, if the ratio is bigger than the threshold. The !<= below causes NaN error to be detected. Note that (NaN > thresh) is always false. */ if (!(ratio <= thresh)) { bad_ratios++; if ((debug == 3) && /* print only when debug is on */ (count != old_count) && /* print if old vector is different from the current one */ (d_count == find_max_ratio) && (p_count <= max_print) && (ratio > 0.5 * ratio_max)) { old_count = count; printf ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", fname, n, ntests, thresh); /* Print test info */ switch (prec) { case blas_prec_single: printf("single "); break; case blas_prec_double: printf("double "); break; case blas_prec_indigenous: printf("indigenous "); break; case blas_prec_extra: printf("extra "); break; } switch (norm) { case -1: printf("near_underflow "); break; case 0: printf("near_one "); break; case 1: printf("near_overflow "); break; } switch (conj_type) { case blas_no_conj: printf("no_conj "); break; case blas_conj: printf("conj "); break; } printf("incx=%d, incy=%d:\n", incx_val, incy_val); cprint_vector(x, n, incx_val, "x"); zprint_vector(y, n, incy_val, "y"); printf(" "); printf("alpha = "); printf("(%24.16e, %24.16e)", alpha[0], alpha[1]); printf("\n "); printf("beta = "); printf("(%24.16e, %24.16e)", beta[0], beta[1]); printf("\n"); printf(" "); printf("r = "); printf("(%24.16e, %24.16e)", r[0], r[1]); printf("\n "); printf("r_comp = "); printf("(%24.16e, %24.16e)", r_comp[0], r_comp[1]); printf("\n"); printf(" "); printf("r_true = "); printf("([%24.16e %24.16e], [%24.16e %24.16e])", head_r_true[0], tail_r_true[0], head_r_true[1], tail_r_true[1]); printf(" ratio=%.4e\n", ratio); p_count++; } } if (d_count == 0) { if (ratio > ratio_max) ratio_max = ratio; if (ratio != 0.0 && ratio < ratio_min) ratio_min = ratio; tot_tests++; } } /* incy */ } /* incx */ } /* conj */ } /* tests */ } /* norm */ } /* prec */ } /* beta */ } /* alpha */ } /* debug */ if ((debug == 2) || ((debug == 1) && (bad_ratios > 0))) { printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", fname, n, ntests, thresh); printf (" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests), ratio_min, ratio_max); } blas_free(x); blas_free(y); blas_free(x_gen); blas_free(y_gen); *min_ratio = ratio_min; *num_bad_ratio = bad_ratios; *num_tests = tot_tests; FPU_FIX_STOP; return ratio_max; } double do_test_zdot_c_c_x(int n, int ntests, int *seed, double thresh, int debug, float test_prob, double *min_ratio, int *num_bad_ratio, int *num_tests) /* * Purpose * ======= * * Runs a series of tests on dots * * Arguments * ========= * * n (input) int * The size of vector being tested * * ntests (input) int * The number of tests to run for each set of attributes. * * seed (input/output) int * The seed for the random number generator used in testgen(). * * thresh (input) double * When the ratio returned from test() exceeds the specified * threshold, the current size, r_true, r_comp, and ratio will be * printed. (Since ratio is supposed to be O(1), we can set thresh * to ~10.) * * debug (input) int * If debug=3, print summary * If debug=2, print summary only if the number of bad ratios > 0 * If debug=1, print complete info if tests fail * If debug=0, return max ratio * * min_ratio (output) double * The minimum ratio * * num_bad_ratio (output) int * The number of tests fail; they are above the threshold. * * num_tests (output) int * The number of tests is being performed. * * Return value * ============ * * The maximum ratio if run successfully, otherwise return -1 * */ { /* function name */ const char fname[] = "BLAS_zdot_c_c_x"; /* max number of debug lines to print */ const int max_print = 32; /* Variables in the "x_val" form are loop vars for corresponding variables */ int i; /* iterate through the repeating tests */ int incx_val, incy_val; /* for testing different inc values */ int incx_gen, incy_gen; /* for complex case inc=2, for real case inc=1 */ int d_count; /* counter for debug */ int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ int p_count; /* counter for the number of debug lines printed */ int tot_tests; /* total number of tests to be done */ int norm; /* input values of near underflow/one/overflow */ double ratio_max; /* the current maximum ratio */ double ratio_min; /* the current minimum ratio */ double ratio; /* the per-use test ratio from test() */ int bad_ratios = 0; /* the number of ratios over the threshold */ double eps_int; /* the internal epsilon expected--2^(-24) for float */ double un_int; /* the internal underflow threshold */ double alpha[2]; double beta[2]; float *x; float *y; /* x_gen and y_gen are used to store vectors generated by testgen. they eventually are copied back to x and y */ float *x_gen; float *y_gen; /* the true r calculated by testgen(), in double-double */ double head_r_true[2], tail_r_true[2]; double r[2]; /* the generated r */ double r_comp[2]; /* the r computed by BLAS_zdot_c_c_x */ int alpha_val; int alpha_flag; /* input flag for BLAS_zdot_c_c_testgen */ int beta_val; int beta_flag; /* input flag for BLAS_zdot_c_c_testgen */ int conj_val; enum blas_conj_type conj_type; int prec_val; enum blas_prec_type prec; int saved_seed; /* for saving the original seed */ int count = 0, old_count = 0; /* use for counting the number of testgen calls * 2 */ FPU_FIX_DECL; /* test for bad arguments */ if (n < 0) BLAS_error(fname, -1, n, NULL); else if (ntests < 0) BLAS_error(fname, -2, ntests, NULL); /* if there is nothing to test, return all zero */ if (n == 0 || ntests == 0) { *min_ratio = 0.0; *num_bad_ratio = 0; *num_tests = 0; return 0.0; } FPU_FIX_START; /* initialization */ saved_seed = *seed; ratio_min = 1e308; ratio_max = 0.0; tot_tests = 0; p_count = 0; count = 0; find_max_ratio = 0; if (debug == 3) find_max_ratio = 1; incx_gen = incy_gen = 1; incx_gen *= 2; incy_gen *= 2; /* get space for calculation */ x = (float *) blas_malloc(n * 2 * incx_gen * sizeof(float) * 2); if (n * 2 * incx_gen > 0 && x == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y = (float *) blas_malloc(n * 2 * incy_gen * sizeof(float) * 2); if (n * 2 * incy_gen > 0 && y == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } x_gen = (float *) blas_malloc(n * incx_gen * sizeof(float) * 2); if (n * incx_gen > 0 && x_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y_gen = (float *) blas_malloc(n * incy_gen * sizeof(float) * 2); if (n * incy_gen > 0 && y_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } /* The debug iteration: If debug=1, then will execute the iteration twice. First, compute the max ratio. Second, print info if ratio > (50% * ratio_max). */ for (d_count = 0; d_count <= find_max_ratio; d_count++) { bad_ratios = 0; /* set to zero */ if ((debug == 3) && (d_count == find_max_ratio)) *seed = saved_seed; /* restore the original seed */ /* varying alpha */ for (alpha_val = 1; alpha_val < 3; alpha_val++) { alpha_flag = 0; switch (alpha_val) { case 0: alpha[0] = alpha[1] = 0.0; alpha_flag = 1; break; case 1: alpha[0] = 1.0; alpha[1] = 0.0; alpha_flag = 1; break; } /* varying beta */ for (beta_val = 0; beta_val < 3; beta_val++) { beta_flag = 0; switch (beta_val) { case 0: beta[0] = beta[1] = 0.0; beta_flag = 1; break; case 1: beta[0] = 1.0; beta[1] = 0.0; beta_flag = 1; break; } /* varying extra precs */ for (prec_val = 0; prec_val <= 2; prec_val++) { switch (prec_val) { case 0: eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; break; case 1: eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; break; case 2: default: eps_int = power(2, -BITS_E); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra), (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra)); prec = blas_prec_extra; break; } /* values near underflow, 1, or overflow */ for (norm = -1; norm <= 1; norm++) { /* number of tests */ for (i = 0; i < ntests; i++) { /* conj or not */ for (conj_val = 0; conj_val < 2; conj_val++) { switch (conj_val) { case 0: conj_type = blas_no_conj; break; case 1: default: conj_type = blas_conj; break; } /* For the sake of speed, we throw out this case at random */ if (xrand(seed) >= test_prob) continue; BLAS_zdot_c_c_testgen(n, 0, 0, norm, conj_type, &alpha, alpha_flag, &beta, beta_flag, x_gen, y_gen, seed, &r, head_r_true, tail_r_true); count++; /* varying incx */ for (incx_val = -2; incx_val <= 2; incx_val++) { if (incx_val == 0) continue; ccopy_vector(x_gen, n, 1, x, incx_val); /* varying incy */ for (incy_val = -2; incy_val <= 2; incy_val++) { if (incy_val == 0) continue; ccopy_vector(y_gen, n, 1, y, incy_val); /* call BLAS_zdot_c_c_x to get r_comp */ r_comp[0] = r[0]; r_comp[1] = r[1]; FPU_FIX_STOP; BLAS_zdot_c_c_x(conj_type, n, alpha, x, incx_val, beta, y, incy_val, &r_comp, prec); FPU_FIX_START; /* computing the ratio */ test_BLAS_zdot_c_c(n, conj_type, alpha, beta, r, r_comp, head_r_true, tail_r_true, x, incx_val, y, incy_val, eps_int, un_int, &ratio); /* Increase the number of bad ratio, if the ratio is bigger than the threshold. The !<= below causes NaN error to be detected. Note that (NaN > thresh) is always false. */ if (!(ratio <= thresh)) { bad_ratios++; if ((debug == 3) && /* print only when debug is on */ (count != old_count) && /* print if old vector is different from the current one */ (d_count == find_max_ratio) && (p_count <= max_print) && (ratio > 0.5 * ratio_max)) { old_count = count; printf ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", fname, n, ntests, thresh); /* Print test info */ switch (prec) { case blas_prec_single: printf("single "); break; case blas_prec_double: printf("double "); break; case blas_prec_indigenous: printf("indigenous "); break; case blas_prec_extra: printf("extra "); break; } switch (norm) { case -1: printf("near_underflow "); break; case 0: printf("near_one "); break; case 1: printf("near_overflow "); break; } switch (conj_type) { case blas_no_conj: printf("no_conj "); break; case blas_conj: printf("conj "); break; } printf("incx=%d, incy=%d:\n", incx_val, incy_val); cprint_vector(x, n, incx_val, "x"); cprint_vector(y, n, incy_val, "y"); printf(" "); printf("alpha = "); printf("(%24.16e, %24.16e)", alpha[0], alpha[1]); printf("\n "); printf("beta = "); printf("(%24.16e, %24.16e)", beta[0], beta[1]); printf("\n"); printf(" "); printf("r = "); printf("(%24.16e, %24.16e)", r[0], r[1]); printf("\n "); printf("r_comp = "); printf("(%24.16e, %24.16e)", r_comp[0], r_comp[1]); printf("\n"); printf(" "); printf("r_true = "); printf("([%24.16e %24.16e], [%24.16e %24.16e])", head_r_true[0], tail_r_true[0], head_r_true[1], tail_r_true[1]); printf(" ratio=%.4e\n", ratio); p_count++; } } if (d_count == 0) { if (ratio > ratio_max) ratio_max = ratio; if (ratio != 0.0 && ratio < ratio_min) ratio_min = ratio; tot_tests++; } } /* incy */ } /* incx */ } /* conj */ } /* tests */ } /* norm */ } /* prec */ } /* beta */ } /* alpha */ } /* debug */ if ((debug == 2) || ((debug == 1) && (bad_ratios > 0))) { printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", fname, n, ntests, thresh); printf (" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests), ratio_min, ratio_max); } blas_free(x); blas_free(y); blas_free(x_gen); blas_free(y_gen); *min_ratio = ratio_min; *num_bad_ratio = bad_ratios; *num_tests = tot_tests; FPU_FIX_STOP; return ratio_max; } double do_test_cdot_c_s_x(int n, int ntests, int *seed, double thresh, int debug, float test_prob, double *min_ratio, int *num_bad_ratio, int *num_tests) /* * Purpose * ======= * * Runs a series of tests on dots * * Arguments * ========= * * n (input) int * The size of vector being tested * * ntests (input) int * The number of tests to run for each set of attributes. * * seed (input/output) int * The seed for the random number generator used in testgen(). * * thresh (input) double * When the ratio returned from test() exceeds the specified * threshold, the current size, r_true, r_comp, and ratio will be * printed. (Since ratio is supposed to be O(1), we can set thresh * to ~10.) * * debug (input) int * If debug=3, print summary * If debug=2, print summary only if the number of bad ratios > 0 * If debug=1, print complete info if tests fail * If debug=0, return max ratio * * min_ratio (output) double * The minimum ratio * * num_bad_ratio (output) int * The number of tests fail; they are above the threshold. * * num_tests (output) int * The number of tests is being performed. * * Return value * ============ * * The maximum ratio if run successfully, otherwise return -1 * */ { /* function name */ const char fname[] = "BLAS_cdot_c_s_x"; /* max number of debug lines to print */ const int max_print = 32; /* Variables in the "x_val" form are loop vars for corresponding variables */ int i; /* iterate through the repeating tests */ int incx_val, incy_val; /* for testing different inc values */ int incx_gen, incy_gen; /* for complex case inc=2, for real case inc=1 */ int d_count; /* counter for debug */ int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ int p_count; /* counter for the number of debug lines printed */ int tot_tests; /* total number of tests to be done */ int norm; /* input values of near underflow/one/overflow */ double ratio_max; /* the current maximum ratio */ double ratio_min; /* the current minimum ratio */ double ratio; /* the per-use test ratio from test() */ int bad_ratios = 0; /* the number of ratios over the threshold */ double eps_int; /* the internal epsilon expected--2^(-24) for float */ double un_int; /* the internal underflow threshold */ float alpha[2]; float beta[2]; float *x; float *y; /* x_gen and y_gen are used to store vectors generated by testgen. they eventually are copied back to x and y */ float *x_gen; float *y_gen; /* the true r calculated by testgen(), in double-double */ double head_r_true[2], tail_r_true[2]; float r[2]; /* the generated r */ float r_comp[2]; /* the r computed by BLAS_cdot_c_s_x */ int alpha_val; int alpha_flag; /* input flag for BLAS_cdot_c_s_testgen */ int beta_val; int beta_flag; /* input flag for BLAS_cdot_c_s_testgen */ int conj_val; enum blas_conj_type conj_type; int prec_val; enum blas_prec_type prec; int saved_seed; /* for saving the original seed */ int count = 0, old_count = 0; /* use for counting the number of testgen calls * 2 */ FPU_FIX_DECL; /* test for bad arguments */ if (n < 0) BLAS_error(fname, -1, n, NULL); else if (ntests < 0) BLAS_error(fname, -2, ntests, NULL); /* if there is nothing to test, return all zero */ if (n == 0 || ntests == 0) { *min_ratio = 0.0; *num_bad_ratio = 0; *num_tests = 0; return 0.0; } FPU_FIX_START; /* initialization */ saved_seed = *seed; ratio_min = 1e308; ratio_max = 0.0; tot_tests = 0; p_count = 0; count = 0; find_max_ratio = 0; if (debug == 3) find_max_ratio = 1; incx_gen = incy_gen = 1; incx_gen *= 2; /* get space for calculation */ x = (float *) blas_malloc(n * 2 * incx_gen * sizeof(float) * 2); if (n * 2 * incx_gen > 0 && x == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y = (float *) blas_malloc(n * 2 * incy_gen * sizeof(float)); if (n * 2 * incy_gen > 0 && y == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } x_gen = (float *) blas_malloc(n * incx_gen * sizeof(float) * 2); if (n * incx_gen > 0 && x_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y_gen = (float *) blas_malloc(n * incy_gen * sizeof(float)); if (n * incy_gen > 0 && y_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } /* The debug iteration: If debug=1, then will execute the iteration twice. First, compute the max ratio. Second, print info if ratio > (50% * ratio_max). */ for (d_count = 0; d_count <= find_max_ratio; d_count++) { bad_ratios = 0; /* set to zero */ if ((debug == 3) && (d_count == find_max_ratio)) *seed = saved_seed; /* restore the original seed */ /* varying alpha */ for (alpha_val = 1; alpha_val < 3; alpha_val++) { alpha_flag = 0; switch (alpha_val) { case 0: alpha[0] = alpha[1] = 0.0; alpha_flag = 1; break; case 1: alpha[0] = 1.0; alpha[1] = 0.0; alpha_flag = 1; break; } /* varying beta */ for (beta_val = 0; beta_val < 3; beta_val++) { beta_flag = 0; switch (beta_val) { case 0: beta[0] = beta[1] = 0.0; beta_flag = 1; break; case 1: beta[0] = 1.0; beta[1] = 0.0; beta_flag = 1; break; } /* varying extra precs */ for (prec_val = 0; prec_val <= 2; prec_val++) { switch (prec_val) { case 0: eps_int = power(2, -BITS_S); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_single), (double) BLAS_fpinfo_x(blas_emin, blas_prec_single)); prec = blas_prec_single; break; case 1: eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; break; case 2: default: eps_int = power(2, -BITS_E); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra), (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra)); prec = blas_prec_extra; break; } /* values near underflow, 1, or overflow */ for (norm = -1; norm <= 1; norm++) { /* number of tests */ for (i = 0; i < ntests; i++) { /* conj or not */ for (conj_val = 0; conj_val < 2; conj_val++) { switch (conj_val) { case 0: conj_type = blas_no_conj; break; case 1: default: conj_type = blas_conj; break; } /* For the sake of speed, we throw out this case at random */ if (xrand(seed) >= test_prob) continue; BLAS_cdot_c_s_testgen(n, 0, 0, norm, conj_type, &alpha, alpha_flag, &beta, beta_flag, x_gen, y_gen, seed, &r, head_r_true, tail_r_true); count++; /* varying incx */ for (incx_val = -2; incx_val <= 2; incx_val++) { if (incx_val == 0) continue; ccopy_vector(x_gen, n, 1, x, incx_val); /* varying incy */ for (incy_val = -2; incy_val <= 2; incy_val++) { if (incy_val == 0) continue; scopy_vector(y_gen, n, 1, y, incy_val); /* call BLAS_cdot_c_s_x to get r_comp */ r_comp[0] = r[0]; r_comp[1] = r[1]; FPU_FIX_STOP; BLAS_cdot_c_s_x(conj_type, n, alpha, x, incx_val, beta, y, incy_val, &r_comp, prec); FPU_FIX_START; /* computing the ratio */ test_BLAS_cdot_c_s(n, conj_type, alpha, beta, r, r_comp, head_r_true, tail_r_true, x, incx_val, y, incy_val, eps_int, un_int, &ratio); /* Increase the number of bad ratio, if the ratio is bigger than the threshold. The !<= below causes NaN error to be detected. Note that (NaN > thresh) is always false. */ if (!(ratio <= thresh)) { bad_ratios++; if ((debug == 3) && /* print only when debug is on */ (count != old_count) && /* print if old vector is different from the current one */ (d_count == find_max_ratio) && (p_count <= max_print) && (ratio > 0.5 * ratio_max)) { old_count = count; printf ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", fname, n, ntests, thresh); /* Print test info */ switch (prec) { case blas_prec_single: printf("single "); break; case blas_prec_double: printf("double "); break; case blas_prec_indigenous: printf("indigenous "); break; case blas_prec_extra: printf("extra "); break; } switch (norm) { case -1: printf("near_underflow "); break; case 0: printf("near_one "); break; case 1: printf("near_overflow "); break; } switch (conj_type) { case blas_no_conj: printf("no_conj "); break; case blas_conj: printf("conj "); break; } printf("incx=%d, incy=%d:\n", incx_val, incy_val); cprint_vector(x, n, incx_val, "x"); sprint_vector(y, n, incy_val, "y"); printf(" "); printf("alpha = "); printf("(%16.8e, %16.8e)", alpha[0], alpha[1]); printf("\n "); printf("beta = "); printf("(%16.8e, %16.8e)", beta[0], beta[1]); printf("\n"); printf(" "); printf("r = "); printf("(%16.8e, %16.8e)", r[0], r[1]); printf("\n "); printf("r_comp = "); printf("(%16.8e, %16.8e)", r_comp[0], r_comp[1]); printf("\n"); printf(" "); printf("r_true = "); printf("([%24.16e %24.16e], [%24.16e %24.16e])", head_r_true[0], tail_r_true[0], head_r_true[1], tail_r_true[1]); printf(" ratio=%.4e\n", ratio); p_count++; } } if (d_count == 0) { if (ratio > ratio_max) ratio_max = ratio; if (ratio != 0.0 && ratio < ratio_min) ratio_min = ratio; tot_tests++; } } /* incy */ } /* incx */ } /* conj */ } /* tests */ } /* norm */ } /* prec */ } /* beta */ } /* alpha */ } /* debug */ if ((debug == 2) || ((debug == 1) && (bad_ratios > 0))) { printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", fname, n, ntests, thresh); printf (" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests), ratio_min, ratio_max); } blas_free(x); blas_free(y); blas_free(x_gen); blas_free(y_gen); *min_ratio = ratio_min; *num_bad_ratio = bad_ratios; *num_tests = tot_tests; FPU_FIX_STOP; return ratio_max; } double do_test_cdot_s_c_x(int n, int ntests, int *seed, double thresh, int debug, float test_prob, double *min_ratio, int *num_bad_ratio, int *num_tests) /* * Purpose * ======= * * Runs a series of tests on dots * * Arguments * ========= * * n (input) int * The size of vector being tested * * ntests (input) int * The number of tests to run for each set of attributes. * * seed (input/output) int * The seed for the random number generator used in testgen(). * * thresh (input) double * When the ratio returned from test() exceeds the specified * threshold, the current size, r_true, r_comp, and ratio will be * printed. (Since ratio is supposed to be O(1), we can set thresh * to ~10.) * * debug (input) int * If debug=3, print summary * If debug=2, print summary only if the number of bad ratios > 0 * If debug=1, print complete info if tests fail * If debug=0, return max ratio * * min_ratio (output) double * The minimum ratio * * num_bad_ratio (output) int * The number of tests fail; they are above the threshold. * * num_tests (output) int * The number of tests is being performed. * * Return value * ============ * * The maximum ratio if run successfully, otherwise return -1 * */ { /* function name */ const char fname[] = "BLAS_cdot_s_c_x"; /* max number of debug lines to print */ const int max_print = 32; /* Variables in the "x_val" form are loop vars for corresponding variables */ int i; /* iterate through the repeating tests */ int incx_val, incy_val; /* for testing different inc values */ int incx_gen, incy_gen; /* for complex case inc=2, for real case inc=1 */ int d_count; /* counter for debug */ int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ int p_count; /* counter for the number of debug lines printed */ int tot_tests; /* total number of tests to be done */ int norm; /* input values of near underflow/one/overflow */ double ratio_max; /* the current maximum ratio */ double ratio_min; /* the current minimum ratio */ double ratio; /* the per-use test ratio from test() */ int bad_ratios = 0; /* the number of ratios over the threshold */ double eps_int; /* the internal epsilon expected--2^(-24) for float */ double un_int; /* the internal underflow threshold */ float alpha[2]; float beta[2]; float *x; float *y; /* x_gen and y_gen are used to store vectors generated by testgen. they eventually are copied back to x and y */ float *x_gen; float *y_gen; /* the true r calculated by testgen(), in double-double */ double head_r_true[2], tail_r_true[2]; float r[2]; /* the generated r */ float r_comp[2]; /* the r computed by BLAS_cdot_s_c_x */ int alpha_val; int alpha_flag; /* input flag for BLAS_cdot_s_c_testgen */ int beta_val; int beta_flag; /* input flag for BLAS_cdot_s_c_testgen */ int conj_val; enum blas_conj_type conj_type; int prec_val; enum blas_prec_type prec; int saved_seed; /* for saving the original seed */ int count = 0, old_count = 0; /* use for counting the number of testgen calls * 2 */ FPU_FIX_DECL; /* test for bad arguments */ if (n < 0) BLAS_error(fname, -1, n, NULL); else if (ntests < 0) BLAS_error(fname, -2, ntests, NULL); /* if there is nothing to test, return all zero */ if (n == 0 || ntests == 0) { *min_ratio = 0.0; *num_bad_ratio = 0; *num_tests = 0; return 0.0; } FPU_FIX_START; /* initialization */ saved_seed = *seed; ratio_min = 1e308; ratio_max = 0.0; tot_tests = 0; p_count = 0; count = 0; find_max_ratio = 0; if (debug == 3) find_max_ratio = 1; incx_gen = incy_gen = 1; incy_gen *= 2; /* get space for calculation */ x = (float *) blas_malloc(n * 2 * incx_gen * sizeof(float)); if (n * 2 * incx_gen > 0 && x == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y = (float *) blas_malloc(n * 2 * incy_gen * sizeof(float) * 2); if (n * 2 * incy_gen > 0 && y == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } x_gen = (float *) blas_malloc(n * incx_gen * sizeof(float)); if (n * incx_gen > 0 && x_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y_gen = (float *) blas_malloc(n * incy_gen * sizeof(float) * 2); if (n * incy_gen > 0 && y_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } /* The debug iteration: If debug=1, then will execute the iteration twice. First, compute the max ratio. Second, print info if ratio > (50% * ratio_max). */ for (d_count = 0; d_count <= find_max_ratio; d_count++) { bad_ratios = 0; /* set to zero */ if ((debug == 3) && (d_count == find_max_ratio)) *seed = saved_seed; /* restore the original seed */ /* varying alpha */ for (alpha_val = 1; alpha_val < 3; alpha_val++) { alpha_flag = 0; switch (alpha_val) { case 0: alpha[0] = alpha[1] = 0.0; alpha_flag = 1; break; case 1: alpha[0] = 1.0; alpha[1] = 0.0; alpha_flag = 1; break; } /* varying beta */ for (beta_val = 0; beta_val < 3; beta_val++) { beta_flag = 0; switch (beta_val) { case 0: beta[0] = beta[1] = 0.0; beta_flag = 1; break; case 1: beta[0] = 1.0; beta[1] = 0.0; beta_flag = 1; break; } /* varying extra precs */ for (prec_val = 0; prec_val <= 2; prec_val++) { switch (prec_val) { case 0: eps_int = power(2, -BITS_S); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_single), (double) BLAS_fpinfo_x(blas_emin, blas_prec_single)); prec = blas_prec_single; break; case 1: eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; break; case 2: default: eps_int = power(2, -BITS_E); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra), (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra)); prec = blas_prec_extra; break; } /* values near underflow, 1, or overflow */ for (norm = -1; norm <= 1; norm++) { /* number of tests */ for (i = 0; i < ntests; i++) { /* conj or not */ for (conj_val = 0; conj_val < 2; conj_val++) { switch (conj_val) { case 0: conj_type = blas_no_conj; break; case 1: default: conj_type = blas_conj; break; } /* For the sake of speed, we throw out this case at random */ if (xrand(seed) >= test_prob) continue; BLAS_cdot_s_c_testgen(n, 0, 0, norm, conj_type, &alpha, alpha_flag, &beta, beta_flag, x_gen, y_gen, seed, &r, head_r_true, tail_r_true); count++; /* varying incx */ for (incx_val = -2; incx_val <= 2; incx_val++) { if (incx_val == 0) continue; scopy_vector(x_gen, n, 1, x, incx_val); /* varying incy */ for (incy_val = -2; incy_val <= 2; incy_val++) { if (incy_val == 0) continue; ccopy_vector(y_gen, n, 1, y, incy_val); /* call BLAS_cdot_s_c_x to get r_comp */ r_comp[0] = r[0]; r_comp[1] = r[1]; FPU_FIX_STOP; BLAS_cdot_s_c_x(conj_type, n, alpha, x, incx_val, beta, y, incy_val, &r_comp, prec); FPU_FIX_START; /* computing the ratio */ test_BLAS_cdot_s_c(n, conj_type, alpha, beta, r, r_comp, head_r_true, tail_r_true, x, incx_val, y, incy_val, eps_int, un_int, &ratio); /* Increase the number of bad ratio, if the ratio is bigger than the threshold. The !<= below causes NaN error to be detected. Note that (NaN > thresh) is always false. */ if (!(ratio <= thresh)) { bad_ratios++; if ((debug == 3) && /* print only when debug is on */ (count != old_count) && /* print if old vector is different from the current one */ (d_count == find_max_ratio) && (p_count <= max_print) && (ratio > 0.5 * ratio_max)) { old_count = count; printf ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", fname, n, ntests, thresh); /* Print test info */ switch (prec) { case blas_prec_single: printf("single "); break; case blas_prec_double: printf("double "); break; case blas_prec_indigenous: printf("indigenous "); break; case blas_prec_extra: printf("extra "); break; } switch (norm) { case -1: printf("near_underflow "); break; case 0: printf("near_one "); break; case 1: printf("near_overflow "); break; } switch (conj_type) { case blas_no_conj: printf("no_conj "); break; case blas_conj: printf("conj "); break; } printf("incx=%d, incy=%d:\n", incx_val, incy_val); sprint_vector(x, n, incx_val, "x"); cprint_vector(y, n, incy_val, "y"); printf(" "); printf("alpha = "); printf("(%16.8e, %16.8e)", alpha[0], alpha[1]); printf("\n "); printf("beta = "); printf("(%16.8e, %16.8e)", beta[0], beta[1]); printf("\n"); printf(" "); printf("r = "); printf("(%16.8e, %16.8e)", r[0], r[1]); printf("\n "); printf("r_comp = "); printf("(%16.8e, %16.8e)", r_comp[0], r_comp[1]); printf("\n"); printf(" "); printf("r_true = "); printf("([%24.16e %24.16e], [%24.16e %24.16e])", head_r_true[0], tail_r_true[0], head_r_true[1], tail_r_true[1]); printf(" ratio=%.4e\n", ratio); p_count++; } } if (d_count == 0) { if (ratio > ratio_max) ratio_max = ratio; if (ratio != 0.0 && ratio < ratio_min) ratio_min = ratio; tot_tests++; } } /* incy */ } /* incx */ } /* conj */ } /* tests */ } /* norm */ } /* prec */ } /* beta */ } /* alpha */ } /* debug */ if ((debug == 2) || ((debug == 1) && (bad_ratios > 0))) { printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", fname, n, ntests, thresh); printf (" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests), ratio_min, ratio_max); } blas_free(x); blas_free(y); blas_free(x_gen); blas_free(y_gen); *min_ratio = ratio_min; *num_bad_ratio = bad_ratios; *num_tests = tot_tests; FPU_FIX_STOP; return ratio_max; } double do_test_cdot_s_s_x(int n, int ntests, int *seed, double thresh, int debug, float test_prob, double *min_ratio, int *num_bad_ratio, int *num_tests) /* * Purpose * ======= * * Runs a series of tests on dots * * Arguments * ========= * * n (input) int * The size of vector being tested * * ntests (input) int * The number of tests to run for each set of attributes. * * seed (input/output) int * The seed for the random number generator used in testgen(). * * thresh (input) double * When the ratio returned from test() exceeds the specified * threshold, the current size, r_true, r_comp, and ratio will be * printed. (Since ratio is supposed to be O(1), we can set thresh * to ~10.) * * debug (input) int * If debug=3, print summary * If debug=2, print summary only if the number of bad ratios > 0 * If debug=1, print complete info if tests fail * If debug=0, return max ratio * * min_ratio (output) double * The minimum ratio * * num_bad_ratio (output) int * The number of tests fail; they are above the threshold. * * num_tests (output) int * The number of tests is being performed. * * Return value * ============ * * The maximum ratio if run successfully, otherwise return -1 * */ { /* function name */ const char fname[] = "BLAS_cdot_s_s_x"; /* max number of debug lines to print */ const int max_print = 32; /* Variables in the "x_val" form are loop vars for corresponding variables */ int i; /* iterate through the repeating tests */ int incx_val, incy_val; /* for testing different inc values */ int incx_gen, incy_gen; /* for complex case inc=2, for real case inc=1 */ int d_count; /* counter for debug */ int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ int p_count; /* counter for the number of debug lines printed */ int tot_tests; /* total number of tests to be done */ int norm; /* input values of near underflow/one/overflow */ double ratio_max; /* the current maximum ratio */ double ratio_min; /* the current minimum ratio */ double ratio; /* the per-use test ratio from test() */ int bad_ratios = 0; /* the number of ratios over the threshold */ double eps_int; /* the internal epsilon expected--2^(-24) for float */ double un_int; /* the internal underflow threshold */ float alpha[2]; float beta[2]; float *x; float *y; /* x_gen and y_gen are used to store vectors generated by testgen. they eventually are copied back to x and y */ float *x_gen; float *y_gen; /* the true r calculated by testgen(), in double-double */ double head_r_true[2], tail_r_true[2]; float r[2]; /* the generated r */ float r_comp[2]; /* the r computed by BLAS_cdot_s_s_x */ int alpha_val; int alpha_flag; /* input flag for BLAS_cdot_s_s_testgen */ int beta_val; int beta_flag; /* input flag for BLAS_cdot_s_s_testgen */ int conj_val; enum blas_conj_type conj_type; int prec_val; enum blas_prec_type prec; int saved_seed; /* for saving the original seed */ int count = 0, old_count = 0; /* use for counting the number of testgen calls * 2 */ FPU_FIX_DECL; /* test for bad arguments */ if (n < 0) BLAS_error(fname, -1, n, NULL); else if (ntests < 0) BLAS_error(fname, -2, ntests, NULL); /* if there is nothing to test, return all zero */ if (n == 0 || ntests == 0) { *min_ratio = 0.0; *num_bad_ratio = 0; *num_tests = 0; return 0.0; } FPU_FIX_START; /* initialization */ saved_seed = *seed; ratio_min = 1e308; ratio_max = 0.0; tot_tests = 0; p_count = 0; count = 0; find_max_ratio = 0; if (debug == 3) find_max_ratio = 1; incx_gen = incy_gen = 1; /* get space for calculation */ x = (float *) blas_malloc(n * 2 * incx_gen * sizeof(float)); if (n * 2 * incx_gen > 0 && x == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y = (float *) blas_malloc(n * 2 * incy_gen * sizeof(float)); if (n * 2 * incy_gen > 0 && y == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } x_gen = (float *) blas_malloc(n * incx_gen * sizeof(float)); if (n * incx_gen > 0 && x_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y_gen = (float *) blas_malloc(n * incy_gen * sizeof(float)); if (n * incy_gen > 0 && y_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } /* The debug iteration: If debug=1, then will execute the iteration twice. First, compute the max ratio. Second, print info if ratio > (50% * ratio_max). */ for (d_count = 0; d_count <= find_max_ratio; d_count++) { bad_ratios = 0; /* set to zero */ if ((debug == 3) && (d_count == find_max_ratio)) *seed = saved_seed; /* restore the original seed */ /* varying alpha */ for (alpha_val = 1; alpha_val < 3; alpha_val++) { alpha_flag = 0; switch (alpha_val) { case 0: alpha[0] = alpha[1] = 0.0; alpha_flag = 1; break; case 1: alpha[0] = 1.0; alpha[1] = 0.0; alpha_flag = 1; break; } /* varying beta */ for (beta_val = 0; beta_val < 3; beta_val++) { beta_flag = 0; switch (beta_val) { case 0: beta[0] = beta[1] = 0.0; beta_flag = 1; break; case 1: beta[0] = 1.0; beta[1] = 0.0; beta_flag = 1; break; } /* varying extra precs */ for (prec_val = 0; prec_val <= 2; prec_val++) { switch (prec_val) { case 0: eps_int = power(2, -BITS_S); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_single), (double) BLAS_fpinfo_x(blas_emin, blas_prec_single)); prec = blas_prec_single; break; case 1: eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; break; case 2: default: eps_int = power(2, -BITS_E); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra), (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra)); prec = blas_prec_extra; break; } /* values near underflow, 1, or overflow */ for (norm = -1; norm <= 1; norm++) { /* number of tests */ for (i = 0; i < ntests; i++) { /* conj or not */ for (conj_val = 0; conj_val < 2; conj_val++) { switch (conj_val) { case 0: conj_type = blas_no_conj; break; case 1: default: conj_type = blas_conj; break; } /* For the sake of speed, we throw out this case at random */ if (xrand(seed) >= test_prob) continue; BLAS_cdot_s_s_testgen(n, 0, 0, norm, conj_type, &alpha, alpha_flag, &beta, beta_flag, x_gen, y_gen, seed, &r, head_r_true, tail_r_true); count++; /* varying incx */ for (incx_val = -2; incx_val <= 2; incx_val++) { if (incx_val == 0) continue; scopy_vector(x_gen, n, 1, x, incx_val); /* varying incy */ for (incy_val = -2; incy_val <= 2; incy_val++) { if (incy_val == 0) continue; scopy_vector(y_gen, n, 1, y, incy_val); /* call BLAS_cdot_s_s_x to get r_comp */ r_comp[0] = r[0]; r_comp[1] = r[1]; FPU_FIX_STOP; BLAS_cdot_s_s_x(conj_type, n, alpha, x, incx_val, beta, y, incy_val, &r_comp, prec); FPU_FIX_START; /* computing the ratio */ test_BLAS_cdot_s_s(n, conj_type, alpha, beta, r, r_comp, head_r_true, tail_r_true, x, incx_val, y, incy_val, eps_int, un_int, &ratio); /* Increase the number of bad ratio, if the ratio is bigger than the threshold. The !<= below causes NaN error to be detected. Note that (NaN > thresh) is always false. */ if (!(ratio <= thresh)) { bad_ratios++; if ((debug == 3) && /* print only when debug is on */ (count != old_count) && /* print if old vector is different from the current one */ (d_count == find_max_ratio) && (p_count <= max_print) && (ratio > 0.5 * ratio_max)) { old_count = count; printf ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", fname, n, ntests, thresh); /* Print test info */ switch (prec) { case blas_prec_single: printf("single "); break; case blas_prec_double: printf("double "); break; case blas_prec_indigenous: printf("indigenous "); break; case blas_prec_extra: printf("extra "); break; } switch (norm) { case -1: printf("near_underflow "); break; case 0: printf("near_one "); break; case 1: printf("near_overflow "); break; } switch (conj_type) { case blas_no_conj: printf("no_conj "); break; case blas_conj: printf("conj "); break; } printf("incx=%d, incy=%d:\n", incx_val, incy_val); sprint_vector(x, n, incx_val, "x"); sprint_vector(y, n, incy_val, "y"); printf(" "); printf("alpha = "); printf("(%16.8e, %16.8e)", alpha[0], alpha[1]); printf("\n "); printf("beta = "); printf("(%16.8e, %16.8e)", beta[0], beta[1]); printf("\n"); printf(" "); printf("r = "); printf("(%16.8e, %16.8e)", r[0], r[1]); printf("\n "); printf("r_comp = "); printf("(%16.8e, %16.8e)", r_comp[0], r_comp[1]); printf("\n"); printf(" "); printf("r_true = "); printf("([%24.16e %24.16e], [%24.16e %24.16e])", head_r_true[0], tail_r_true[0], head_r_true[1], tail_r_true[1]); printf(" ratio=%.4e\n", ratio); p_count++; } } if (d_count == 0) { if (ratio > ratio_max) ratio_max = ratio; if (ratio != 0.0 && ratio < ratio_min) ratio_min = ratio; tot_tests++; } } /* incy */ } /* incx */ } /* conj */ } /* tests */ } /* norm */ } /* prec */ } /* beta */ } /* alpha */ } /* debug */ if ((debug == 2) || ((debug == 1) && (bad_ratios > 0))) { printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", fname, n, ntests, thresh); printf (" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests), ratio_min, ratio_max); } blas_free(x); blas_free(y); blas_free(x_gen); blas_free(y_gen); *min_ratio = ratio_min; *num_bad_ratio = bad_ratios; *num_tests = tot_tests; FPU_FIX_STOP; return ratio_max; } double do_test_zdot_z_d_x(int n, int ntests, int *seed, double thresh, int debug, float test_prob, double *min_ratio, int *num_bad_ratio, int *num_tests) /* * Purpose * ======= * * Runs a series of tests on dots * * Arguments * ========= * * n (input) int * The size of vector being tested * * ntests (input) int * The number of tests to run for each set of attributes. * * seed (input/output) int * The seed for the random number generator used in testgen(). * * thresh (input) double * When the ratio returned from test() exceeds the specified * threshold, the current size, r_true, r_comp, and ratio will be * printed. (Since ratio is supposed to be O(1), we can set thresh * to ~10.) * * debug (input) int * If debug=3, print summary * If debug=2, print summary only if the number of bad ratios > 0 * If debug=1, print complete info if tests fail * If debug=0, return max ratio * * min_ratio (output) double * The minimum ratio * * num_bad_ratio (output) int * The number of tests fail; they are above the threshold. * * num_tests (output) int * The number of tests is being performed. * * Return value * ============ * * The maximum ratio if run successfully, otherwise return -1 * */ { /* function name */ const char fname[] = "BLAS_zdot_z_d_x"; /* max number of debug lines to print */ const int max_print = 32; /* Variables in the "x_val" form are loop vars for corresponding variables */ int i; /* iterate through the repeating tests */ int incx_val, incy_val; /* for testing different inc values */ int incx_gen, incy_gen; /* for complex case inc=2, for real case inc=1 */ int d_count; /* counter for debug */ int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ int p_count; /* counter for the number of debug lines printed */ int tot_tests; /* total number of tests to be done */ int norm; /* input values of near underflow/one/overflow */ double ratio_max; /* the current maximum ratio */ double ratio_min; /* the current minimum ratio */ double ratio; /* the per-use test ratio from test() */ int bad_ratios = 0; /* the number of ratios over the threshold */ double eps_int; /* the internal epsilon expected--2^(-24) for float */ double un_int; /* the internal underflow threshold */ double alpha[2]; double beta[2]; double *x; double *y; /* x_gen and y_gen are used to store vectors generated by testgen. they eventually are copied back to x and y */ double *x_gen; double *y_gen; /* the true r calculated by testgen(), in double-double */ double head_r_true[2], tail_r_true[2]; double r[2]; /* the generated r */ double r_comp[2]; /* the r computed by BLAS_zdot_z_d_x */ int alpha_val; int alpha_flag; /* input flag for BLAS_zdot_z_d_testgen */ int beta_val; int beta_flag; /* input flag for BLAS_zdot_z_d_testgen */ int conj_val; enum blas_conj_type conj_type; int prec_val; enum blas_prec_type prec; int saved_seed; /* for saving the original seed */ int count = 0, old_count = 0; /* use for counting the number of testgen calls * 2 */ FPU_FIX_DECL; /* test for bad arguments */ if (n < 0) BLAS_error(fname, -1, n, NULL); else if (ntests < 0) BLAS_error(fname, -2, ntests, NULL); /* if there is nothing to test, return all zero */ if (n == 0 || ntests == 0) { *min_ratio = 0.0; *num_bad_ratio = 0; *num_tests = 0; return 0.0; } FPU_FIX_START; /* initialization */ saved_seed = *seed; ratio_min = 1e308; ratio_max = 0.0; tot_tests = 0; p_count = 0; count = 0; find_max_ratio = 0; if (debug == 3) find_max_ratio = 1; incx_gen = incy_gen = 1; incx_gen *= 2; /* get space for calculation */ x = (double *) blas_malloc(n * 2 * incx_gen * sizeof(double) * 2); if (n * 2 * incx_gen > 0 && x == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y = (double *) blas_malloc(n * 2 * incy_gen * sizeof(double)); if (n * 2 * incy_gen > 0 && y == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } x_gen = (double *) blas_malloc(n * incx_gen * sizeof(double) * 2); if (n * incx_gen > 0 && x_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y_gen = (double *) blas_malloc(n * incy_gen * sizeof(double)); if (n * incy_gen > 0 && y_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } /* The debug iteration: If debug=1, then will execute the iteration twice. First, compute the max ratio. Second, print info if ratio > (50% * ratio_max). */ for (d_count = 0; d_count <= find_max_ratio; d_count++) { bad_ratios = 0; /* set to zero */ if ((debug == 3) && (d_count == find_max_ratio)) *seed = saved_seed; /* restore the original seed */ /* varying alpha */ for (alpha_val = 1; alpha_val < 3; alpha_val++) { alpha_flag = 0; switch (alpha_val) { case 0: alpha[0] = alpha[1] = 0.0; alpha_flag = 1; break; case 1: alpha[0] = 1.0; alpha[1] = 0.0; alpha_flag = 1; break; } /* varying beta */ for (beta_val = 0; beta_val < 3; beta_val++) { beta_flag = 0; switch (beta_val) { case 0: beta[0] = beta[1] = 0.0; beta_flag = 1; break; case 1: beta[0] = 1.0; beta[1] = 0.0; beta_flag = 1; break; } /* varying extra precs */ for (prec_val = 0; prec_val <= 2; prec_val++) { switch (prec_val) { case 0: eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; break; case 1: eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; break; case 2: default: eps_int = power(2, -BITS_E); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra), (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra)); prec = blas_prec_extra; break; } /* values near underflow, 1, or overflow */ for (norm = -1; norm <= 1; norm++) { /* number of tests */ for (i = 0; i < ntests; i++) { /* conj or not */ for (conj_val = 0; conj_val < 2; conj_val++) { switch (conj_val) { case 0: conj_type = blas_no_conj; break; case 1: default: conj_type = blas_conj; break; } /* For the sake of speed, we throw out this case at random */ if (xrand(seed) >= test_prob) continue; BLAS_zdot_z_d_testgen(n, 0, 0, norm, conj_type, &alpha, alpha_flag, &beta, beta_flag, x_gen, y_gen, seed, &r, head_r_true, tail_r_true); count++; /* varying incx */ for (incx_val = -2; incx_val <= 2; incx_val++) { if (incx_val == 0) continue; zcopy_vector(x_gen, n, 1, x, incx_val); /* varying incy */ for (incy_val = -2; incy_val <= 2; incy_val++) { if (incy_val == 0) continue; dcopy_vector(y_gen, n, 1, y, incy_val); /* call BLAS_zdot_z_d_x to get r_comp */ r_comp[0] = r[0]; r_comp[1] = r[1]; FPU_FIX_STOP; BLAS_zdot_z_d_x(conj_type, n, alpha, x, incx_val, beta, y, incy_val, &r_comp, prec); FPU_FIX_START; /* computing the ratio */ test_BLAS_zdot_z_d(n, conj_type, alpha, beta, r, r_comp, head_r_true, tail_r_true, x, incx_val, y, incy_val, eps_int, un_int, &ratio); /* Increase the number of bad ratio, if the ratio is bigger than the threshold. The !<= below causes NaN error to be detected. Note that (NaN > thresh) is always false. */ if (!(ratio <= thresh)) { bad_ratios++; if ((debug == 3) && /* print only when debug is on */ (count != old_count) && /* print if old vector is different from the current one */ (d_count == find_max_ratio) && (p_count <= max_print) && (ratio > 0.5 * ratio_max)) { old_count = count; printf ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", fname, n, ntests, thresh); /* Print test info */ switch (prec) { case blas_prec_single: printf("single "); break; case blas_prec_double: printf("double "); break; case blas_prec_indigenous: printf("indigenous "); break; case blas_prec_extra: printf("extra "); break; } switch (norm) { case -1: printf("near_underflow "); break; case 0: printf("near_one "); break; case 1: printf("near_overflow "); break; } switch (conj_type) { case blas_no_conj: printf("no_conj "); break; case blas_conj: printf("conj "); break; } printf("incx=%d, incy=%d:\n", incx_val, incy_val); zprint_vector(x, n, incx_val, "x"); dprint_vector(y, n, incy_val, "y"); printf(" "); printf("alpha = "); printf("(%24.16e, %24.16e)", alpha[0], alpha[1]); printf("\n "); printf("beta = "); printf("(%24.16e, %24.16e)", beta[0], beta[1]); printf("\n"); printf(" "); printf("r = "); printf("(%24.16e, %24.16e)", r[0], r[1]); printf("\n "); printf("r_comp = "); printf("(%24.16e, %24.16e)", r_comp[0], r_comp[1]); printf("\n"); printf(" "); printf("r_true = "); printf("([%24.16e %24.16e], [%24.16e %24.16e])", head_r_true[0], tail_r_true[0], head_r_true[1], tail_r_true[1]); printf(" ratio=%.4e\n", ratio); p_count++; } } if (d_count == 0) { if (ratio > ratio_max) ratio_max = ratio; if (ratio != 0.0 && ratio < ratio_min) ratio_min = ratio; tot_tests++; } } /* incy */ } /* incx */ } /* conj */ } /* tests */ } /* norm */ } /* prec */ } /* beta */ } /* alpha */ } /* debug */ if ((debug == 2) || ((debug == 1) && (bad_ratios > 0))) { printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", fname, n, ntests, thresh); printf (" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests), ratio_min, ratio_max); } blas_free(x); blas_free(y); blas_free(x_gen); blas_free(y_gen); *min_ratio = ratio_min; *num_bad_ratio = bad_ratios; *num_tests = tot_tests; FPU_FIX_STOP; return ratio_max; } double do_test_zdot_d_z_x(int n, int ntests, int *seed, double thresh, int debug, float test_prob, double *min_ratio, int *num_bad_ratio, int *num_tests) /* * Purpose * ======= * * Runs a series of tests on dots * * Arguments * ========= * * n (input) int * The size of vector being tested * * ntests (input) int * The number of tests to run for each set of attributes. * * seed (input/output) int * The seed for the random number generator used in testgen(). * * thresh (input) double * When the ratio returned from test() exceeds the specified * threshold, the current size, r_true, r_comp, and ratio will be * printed. (Since ratio is supposed to be O(1), we can set thresh * to ~10.) * * debug (input) int * If debug=3, print summary * If debug=2, print summary only if the number of bad ratios > 0 * If debug=1, print complete info if tests fail * If debug=0, return max ratio * * min_ratio (output) double * The minimum ratio * * num_bad_ratio (output) int * The number of tests fail; they are above the threshold. * * num_tests (output) int * The number of tests is being performed. * * Return value * ============ * * The maximum ratio if run successfully, otherwise return -1 * */ { /* function name */ const char fname[] = "BLAS_zdot_d_z_x"; /* max number of debug lines to print */ const int max_print = 32; /* Variables in the "x_val" form are loop vars for corresponding variables */ int i; /* iterate through the repeating tests */ int incx_val, incy_val; /* for testing different inc values */ int incx_gen, incy_gen; /* for complex case inc=2, for real case inc=1 */ int d_count; /* counter for debug */ int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ int p_count; /* counter for the number of debug lines printed */ int tot_tests; /* total number of tests to be done */ int norm; /* input values of near underflow/one/overflow */ double ratio_max; /* the current maximum ratio */ double ratio_min; /* the current minimum ratio */ double ratio; /* the per-use test ratio from test() */ int bad_ratios = 0; /* the number of ratios over the threshold */ double eps_int; /* the internal epsilon expected--2^(-24) for float */ double un_int; /* the internal underflow threshold */ double alpha[2]; double beta[2]; double *x; double *y; /* x_gen and y_gen are used to store vectors generated by testgen. they eventually are copied back to x and y */ double *x_gen; double *y_gen; /* the true r calculated by testgen(), in double-double */ double head_r_true[2], tail_r_true[2]; double r[2]; /* the generated r */ double r_comp[2]; /* the r computed by BLAS_zdot_d_z_x */ int alpha_val; int alpha_flag; /* input flag for BLAS_zdot_d_z_testgen */ int beta_val; int beta_flag; /* input flag for BLAS_zdot_d_z_testgen */ int conj_val; enum blas_conj_type conj_type; int prec_val; enum blas_prec_type prec; int saved_seed; /* for saving the original seed */ int count = 0, old_count = 0; /* use for counting the number of testgen calls * 2 */ FPU_FIX_DECL; /* test for bad arguments */ if (n < 0) BLAS_error(fname, -1, n, NULL); else if (ntests < 0) BLAS_error(fname, -2, ntests, NULL); /* if there is nothing to test, return all zero */ if (n == 0 || ntests == 0) { *min_ratio = 0.0; *num_bad_ratio = 0; *num_tests = 0; return 0.0; } FPU_FIX_START; /* initialization */ saved_seed = *seed; ratio_min = 1e308; ratio_max = 0.0; tot_tests = 0; p_count = 0; count = 0; find_max_ratio = 0; if (debug == 3) find_max_ratio = 1; incx_gen = incy_gen = 1; incy_gen *= 2; /* get space for calculation */ x = (double *) blas_malloc(n * 2 * incx_gen * sizeof(double)); if (n * 2 * incx_gen > 0 && x == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y = (double *) blas_malloc(n * 2 * incy_gen * sizeof(double) * 2); if (n * 2 * incy_gen > 0 && y == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } x_gen = (double *) blas_malloc(n * incx_gen * sizeof(double)); if (n * incx_gen > 0 && x_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y_gen = (double *) blas_malloc(n * incy_gen * sizeof(double) * 2); if (n * incy_gen > 0 && y_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } /* The debug iteration: If debug=1, then will execute the iteration twice. First, compute the max ratio. Second, print info if ratio > (50% * ratio_max). */ for (d_count = 0; d_count <= find_max_ratio; d_count++) { bad_ratios = 0; /* set to zero */ if ((debug == 3) && (d_count == find_max_ratio)) *seed = saved_seed; /* restore the original seed */ /* varying alpha */ for (alpha_val = 1; alpha_val < 3; alpha_val++) { alpha_flag = 0; switch (alpha_val) { case 0: alpha[0] = alpha[1] = 0.0; alpha_flag = 1; break; case 1: alpha[0] = 1.0; alpha[1] = 0.0; alpha_flag = 1; break; } /* varying beta */ for (beta_val = 0; beta_val < 3; beta_val++) { beta_flag = 0; switch (beta_val) { case 0: beta[0] = beta[1] = 0.0; beta_flag = 1; break; case 1: beta[0] = 1.0; beta[1] = 0.0; beta_flag = 1; break; } /* varying extra precs */ for (prec_val = 0; prec_val <= 2; prec_val++) { switch (prec_val) { case 0: eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; break; case 1: eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; break; case 2: default: eps_int = power(2, -BITS_E); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra), (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra)); prec = blas_prec_extra; break; } /* values near underflow, 1, or overflow */ for (norm = -1; norm <= 1; norm++) { /* number of tests */ for (i = 0; i < ntests; i++) { /* conj or not */ for (conj_val = 0; conj_val < 2; conj_val++) { switch (conj_val) { case 0: conj_type = blas_no_conj; break; case 1: default: conj_type = blas_conj; break; } /* For the sake of speed, we throw out this case at random */ if (xrand(seed) >= test_prob) continue; BLAS_zdot_d_z_testgen(n, 0, 0, norm, conj_type, &alpha, alpha_flag, &beta, beta_flag, x_gen, y_gen, seed, &r, head_r_true, tail_r_true); count++; /* varying incx */ for (incx_val = -2; incx_val <= 2; incx_val++) { if (incx_val == 0) continue; dcopy_vector(x_gen, n, 1, x, incx_val); /* varying incy */ for (incy_val = -2; incy_val <= 2; incy_val++) { if (incy_val == 0) continue; zcopy_vector(y_gen, n, 1, y, incy_val); /* call BLAS_zdot_d_z_x to get r_comp */ r_comp[0] = r[0]; r_comp[1] = r[1]; FPU_FIX_STOP; BLAS_zdot_d_z_x(conj_type, n, alpha, x, incx_val, beta, y, incy_val, &r_comp, prec); FPU_FIX_START; /* computing the ratio */ test_BLAS_zdot_d_z(n, conj_type, alpha, beta, r, r_comp, head_r_true, tail_r_true, x, incx_val, y, incy_val, eps_int, un_int, &ratio); /* Increase the number of bad ratio, if the ratio is bigger than the threshold. The !<= below causes NaN error to be detected. Note that (NaN > thresh) is always false. */ if (!(ratio <= thresh)) { bad_ratios++; if ((debug == 3) && /* print only when debug is on */ (count != old_count) && /* print if old vector is different from the current one */ (d_count == find_max_ratio) && (p_count <= max_print) && (ratio > 0.5 * ratio_max)) { old_count = count; printf ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", fname, n, ntests, thresh); /* Print test info */ switch (prec) { case blas_prec_single: printf("single "); break; case blas_prec_double: printf("double "); break; case blas_prec_indigenous: printf("indigenous "); break; case blas_prec_extra: printf("extra "); break; } switch (norm) { case -1: printf("near_underflow "); break; case 0: printf("near_one "); break; case 1: printf("near_overflow "); break; } switch (conj_type) { case blas_no_conj: printf("no_conj "); break; case blas_conj: printf("conj "); break; } printf("incx=%d, incy=%d:\n", incx_val, incy_val); dprint_vector(x, n, incx_val, "x"); zprint_vector(y, n, incy_val, "y"); printf(" "); printf("alpha = "); printf("(%24.16e, %24.16e)", alpha[0], alpha[1]); printf("\n "); printf("beta = "); printf("(%24.16e, %24.16e)", beta[0], beta[1]); printf("\n"); printf(" "); printf("r = "); printf("(%24.16e, %24.16e)", r[0], r[1]); printf("\n "); printf("r_comp = "); printf("(%24.16e, %24.16e)", r_comp[0], r_comp[1]); printf("\n"); printf(" "); printf("r_true = "); printf("([%24.16e %24.16e], [%24.16e %24.16e])", head_r_true[0], tail_r_true[0], head_r_true[1], tail_r_true[1]); printf(" ratio=%.4e\n", ratio); p_count++; } } if (d_count == 0) { if (ratio > ratio_max) ratio_max = ratio; if (ratio != 0.0 && ratio < ratio_min) ratio_min = ratio; tot_tests++; } } /* incy */ } /* incx */ } /* conj */ } /* tests */ } /* norm */ } /* prec */ } /* beta */ } /* alpha */ } /* debug */ if ((debug == 2) || ((debug == 1) && (bad_ratios > 0))) { printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", fname, n, ntests, thresh); printf (" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests), ratio_min, ratio_max); } blas_free(x); blas_free(y); blas_free(x_gen); blas_free(y_gen); *min_ratio = ratio_min; *num_bad_ratio = bad_ratios; *num_tests = tot_tests; FPU_FIX_STOP; return ratio_max; } double do_test_zdot_d_d_x(int n, int ntests, int *seed, double thresh, int debug, float test_prob, double *min_ratio, int *num_bad_ratio, int *num_tests) /* * Purpose * ======= * * Runs a series of tests on dots * * Arguments * ========= * * n (input) int * The size of vector being tested * * ntests (input) int * The number of tests to run for each set of attributes. * * seed (input/output) int * The seed for the random number generator used in testgen(). * * thresh (input) double * When the ratio returned from test() exceeds the specified * threshold, the current size, r_true, r_comp, and ratio will be * printed. (Since ratio is supposed to be O(1), we can set thresh * to ~10.) * * debug (input) int * If debug=3, print summary * If debug=2, print summary only if the number of bad ratios > 0 * If debug=1, print complete info if tests fail * If debug=0, return max ratio * * min_ratio (output) double * The minimum ratio * * num_bad_ratio (output) int * The number of tests fail; they are above the threshold. * * num_tests (output) int * The number of tests is being performed. * * Return value * ============ * * The maximum ratio if run successfully, otherwise return -1 * */ { /* function name */ const char fname[] = "BLAS_zdot_d_d_x"; /* max number of debug lines to print */ const int max_print = 32; /* Variables in the "x_val" form are loop vars for corresponding variables */ int i; /* iterate through the repeating tests */ int incx_val, incy_val; /* for testing different inc values */ int incx_gen, incy_gen; /* for complex case inc=2, for real case inc=1 */ int d_count; /* counter for debug */ int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ int p_count; /* counter for the number of debug lines printed */ int tot_tests; /* total number of tests to be done */ int norm; /* input values of near underflow/one/overflow */ double ratio_max; /* the current maximum ratio */ double ratio_min; /* the current minimum ratio */ double ratio; /* the per-use test ratio from test() */ int bad_ratios = 0; /* the number of ratios over the threshold */ double eps_int; /* the internal epsilon expected--2^(-24) for float */ double un_int; /* the internal underflow threshold */ double alpha[2]; double beta[2]; double *x; double *y; /* x_gen and y_gen are used to store vectors generated by testgen. they eventually are copied back to x and y */ double *x_gen; double *y_gen; /* the true r calculated by testgen(), in double-double */ double head_r_true[2], tail_r_true[2]; double r[2]; /* the generated r */ double r_comp[2]; /* the r computed by BLAS_zdot_d_d_x */ int alpha_val; int alpha_flag; /* input flag for BLAS_zdot_d_d_testgen */ int beta_val; int beta_flag; /* input flag for BLAS_zdot_d_d_testgen */ int conj_val; enum blas_conj_type conj_type; int prec_val; enum blas_prec_type prec; int saved_seed; /* for saving the original seed */ int count = 0, old_count = 0; /* use for counting the number of testgen calls * 2 */ FPU_FIX_DECL; /* test for bad arguments */ if (n < 0) BLAS_error(fname, -1, n, NULL); else if (ntests < 0) BLAS_error(fname, -2, ntests, NULL); /* if there is nothing to test, return all zero */ if (n == 0 || ntests == 0) { *min_ratio = 0.0; *num_bad_ratio = 0; *num_tests = 0; return 0.0; } FPU_FIX_START; /* initialization */ saved_seed = *seed; ratio_min = 1e308; ratio_max = 0.0; tot_tests = 0; p_count = 0; count = 0; find_max_ratio = 0; if (debug == 3) find_max_ratio = 1; incx_gen = incy_gen = 1; /* get space for calculation */ x = (double *) blas_malloc(n * 2 * incx_gen * sizeof(double)); if (n * 2 * incx_gen > 0 && x == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y = (double *) blas_malloc(n * 2 * incy_gen * sizeof(double)); if (n * 2 * incy_gen > 0 && y == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } x_gen = (double *) blas_malloc(n * incx_gen * sizeof(double)); if (n * incx_gen > 0 && x_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } y_gen = (double *) blas_malloc(n * incy_gen * sizeof(double)); if (n * incy_gen > 0 && y_gen == NULL) { BLAS_error("blas_malloc", 0, 0, "malloc failed.\n"); } /* The debug iteration: If debug=1, then will execute the iteration twice. First, compute the max ratio. Second, print info if ratio > (50% * ratio_max). */ for (d_count = 0; d_count <= find_max_ratio; d_count++) { bad_ratios = 0; /* set to zero */ if ((debug == 3) && (d_count == find_max_ratio)) *seed = saved_seed; /* restore the original seed */ /* varying alpha */ for (alpha_val = 1; alpha_val < 3; alpha_val++) { alpha_flag = 0; switch (alpha_val) { case 0: alpha[0] = alpha[1] = 0.0; alpha_flag = 1; break; case 1: alpha[0] = 1.0; alpha[1] = 0.0; alpha_flag = 1; break; } /* varying beta */ for (beta_val = 0; beta_val < 3; beta_val++) { beta_flag = 0; switch (beta_val) { case 0: beta[0] = beta[1] = 0.0; beta_flag = 1; break; case 1: beta[0] = 1.0; beta[1] = 0.0; beta_flag = 1; break; } /* varying extra precs */ for (prec_val = 0; prec_val <= 2; prec_val++) { switch (prec_val) { case 0: eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; break; case 1: eps_int = power(2, -BITS_D); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double), (double) BLAS_fpinfo_x(blas_emin, blas_prec_double)); prec = blas_prec_double; break; case 2: default: eps_int = power(2, -BITS_E); un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra), (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra)); prec = blas_prec_extra; break; } /* values near underflow, 1, or overflow */ for (norm = -1; norm <= 1; norm++) { /* number of tests */ for (i = 0; i < ntests; i++) { /* conj or not */ for (conj_val = 0; conj_val < 2; conj_val++) { switch (conj_val) { case 0: conj_type = blas_no_conj; break; case 1: default: conj_type = blas_conj; break; } /* For the sake of speed, we throw out this case at random */ if (xrand(seed) >= test_prob) continue; BLAS_zdot_d_d_testgen(n, 0, 0, norm, conj_type, &alpha, alpha_flag, &beta, beta_flag, x_gen, y_gen, seed, &r, head_r_true, tail_r_true); count++; /* varying incx */ for (incx_val = -2; incx_val <= 2; incx_val++) { if (incx_val == 0) continue; dcopy_vector(x_gen, n, 1, x, incx_val); /* varying incy */ for (incy_val = -2; incy_val <= 2; incy_val++) { if (incy_val == 0) continue; dcopy_vector(y_gen, n, 1, y, incy_val); /* call BLAS_zdot_d_d_x to get r_comp */ r_comp[0] = r[0]; r_comp[1] = r[1]; FPU_FIX_STOP; BLAS_zdot_d_d_x(conj_type, n, alpha, x, incx_val, beta, y, incy_val, &r_comp, prec); FPU_FIX_START; /* computing the ratio */ test_BLAS_zdot_d_d(n, conj_type, alpha, beta, r, r_comp, head_r_true, tail_r_true, x, incx_val, y, incy_val, eps_int, un_int, &ratio); /* Increase the number of bad ratio, if the ratio is bigger than the threshold. The !<= below causes NaN error to be detected. Note that (NaN > thresh) is always false. */ if (!(ratio <= thresh)) { bad_ratios++; if ((debug == 3) && /* print only when debug is on */ (count != old_count) && /* print if old vector is different from the current one */ (d_count == find_max_ratio) && (p_count <= max_print) && (ratio > 0.5 * ratio_max)) { old_count = count; printf ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", fname, n, ntests, thresh); /* Print test info */ switch (prec) { case blas_prec_single: printf("single "); break; case blas_prec_double: printf("double "); break; case blas_prec_indigenous: printf("indigenous "); break; case blas_prec_extra: printf("extra "); break; } switch (norm) { case -1: printf("near_underflow "); break; case 0: printf("near_one "); break; case 1: printf("near_overflow "); break; } switch (conj_type) { case blas_no_conj: printf("no_conj "); break; case blas_conj: printf("conj "); break; } printf("incx=%d, incy=%d:\n", incx_val, incy_val); dprint_vector(x, n, incx_val, "x"); dprint_vector(y, n, incy_val, "y"); printf(" "); printf("alpha = "); printf("(%24.16e, %24.16e)", alpha[0], alpha[1]); printf("\n "); printf("beta = "); printf("(%24.16e, %24.16e)", beta[0], beta[1]); printf("\n"); printf(" "); printf("r = "); printf("(%24.16e, %24.16e)", r[0], r[1]); printf("\n "); printf("r_comp = "); printf("(%24.16e, %24.16e)", r_comp[0], r_comp[1]); printf("\n"); printf(" "); printf("r_true = "); printf("([%24.16e %24.16e], [%24.16e %24.16e])", head_r_true[0], tail_r_true[0], head_r_true[1], tail_r_true[1]); printf(" ratio=%.4e\n", ratio); p_count++; } } if (d_count == 0) { if (ratio > ratio_max) ratio_max = ratio; if (ratio != 0.0 && ratio < ratio_min) ratio_min = ratio; tot_tests++; } } /* incy */ } /* incx */ } /* conj */ } /* tests */ } /* norm */ } /* prec */ } /* beta */ } /* alpha */ } /* debug */ if ((debug == 2) || ((debug == 1) && (bad_ratios > 0))) { printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", fname, n, ntests, thresh); printf (" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests), ratio_min, ratio_max); } blas_free(x); blas_free(y); blas_free(x_gen); blas_free(y_gen); *min_ratio = ratio_min; *num_bad_ratio = bad_ratios; *num_tests = tot_tests; FPU_FIX_STOP; return ratio_max; } int main(int argc, char **argv) { int nsizes, ntests, debug; double thresh, test_prob; double total_min_ratio, total_max_ratio; int total_bad_ratios; int seed, num_bad_ratio, num_tests; int total_tests, nr_failed_routines = 0, nr_routines = 0; double min_ratio, max_ratio; const char *base_routine = "dot"; char *fname; int n; if (argc != 6) { printf("Usage:\n"); printf("do_test_dot \n"); printf(" : number of sizes to be run.\n"); printf (" : the number of tests performed for each set of attributes\n"); printf (" : to catch bad ratios if it is greater than \n"); printf(" : 0, 1, 2, or 3; \n"); printf(" if 0, no printing \n"); printf(" if 1, print error summary only if tests fail\n"); printf(" if 2, print error summary for each n\n"); printf(" if 3, print complete info each test fails \n"); printf(": probability of preforming a given \n"); printf(" test case: 0.0 does no tests, 1.0 does all tests\n"); return -1; } else { nsizes = atoi(argv[1]); ntests = atoi(argv[2]); thresh = atof(argv[3]); debug = atoi(argv[4]); test_prob = atof(argv[5]); } seed = 1999; if (nsizes < 0 || ntests < 0 || debug < 0 || debug > 3) BLAS_error("Testing dot", 0, 0, NULL); printf("Testing %s...\n", base_routine); printf("INPUT: nsizes = %d, ntests = %d, thresh = %4.2f, debug = %d\n\n", nsizes, ntests, thresh, debug); min_ratio = 1e308; max_ratio = 0.0; total_bad_ratios = 0; total_tests = 0; fname = "BLAS_sdot"; printf("Testing %s...\n", fname); for (n = 0; n <= nsizes; n++) { total_max_ratio = do_test_sdot(n, ntests, &seed, thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, &num_tests); if (total_max_ratio > max_ratio) max_ratio = total_max_ratio; if (total_min_ratio != 0.0 && total_min_ratio < min_ratio) min_ratio = total_min_ratio; total_bad_ratios += num_bad_ratio; total_tests += num_tests; } if (total_bad_ratios == 0) printf("PASS> "); else { printf("FAIL> "); nr_failed_routines++; } nr_routines++; if (min_ratio == 1e308) min_ratio = 0.0; printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", fname, total_bad_ratios, total_tests, max_ratio); min_ratio = 1e308; max_ratio = 0.0; total_bad_ratios = 0; total_tests = 0; fname = "BLAS_ddot"; printf("Testing %s...\n", fname); for (n = 0; n <= nsizes; n++) { total_max_ratio = do_test_ddot(n, ntests, &seed, thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, &num_tests); if (total_max_ratio > max_ratio) max_ratio = total_max_ratio; if (total_min_ratio != 0.0 && total_min_ratio < min_ratio) min_ratio = total_min_ratio; total_bad_ratios += num_bad_ratio; total_tests += num_tests; } if (total_bad_ratios == 0) printf("PASS> "); else { printf("FAIL> "); nr_failed_routines++; } nr_routines++; if (min_ratio == 1e308) min_ratio = 0.0; printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", fname, total_bad_ratios, total_tests, max_ratio); min_ratio = 1e308; max_ratio = 0.0; total_bad_ratios = 0; total_tests = 0; fname = "BLAS_cdot"; printf("Testing %s...\n", fname); for (n = 0; n <= nsizes; n++) { total_max_ratio = do_test_cdot(n, ntests, &seed, thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, &num_tests); if (total_max_ratio > max_ratio) max_ratio = total_max_ratio; if (total_min_ratio != 0.0 && total_min_ratio < min_ratio) min_ratio = total_min_ratio; total_bad_ratios += num_bad_ratio; total_tests += num_tests; } if (total_bad_ratios == 0) printf("PASS> "); else { printf("FAIL> "); nr_failed_routines++; } nr_routines++; if (min_ratio == 1e308) min_ratio = 0.0; printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", fname, total_bad_ratios, total_tests, max_ratio); min_ratio = 1e308; max_ratio = 0.0; total_bad_ratios = 0; total_tests = 0; fname = "BLAS_zdot"; printf("Testing %s...\n", fname); for (n = 0; n <= nsizes; n++) { total_max_ratio = do_test_zdot(n, ntests, &seed, thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, &num_tests); if (total_max_ratio > max_ratio) max_ratio = total_max_ratio; if (total_min_ratio != 0.0 && total_min_ratio < min_ratio) min_ratio = total_min_ratio; total_bad_ratios += num_bad_ratio; total_tests += num_tests; } if (total_bad_ratios == 0) printf("PASS> "); else { printf("FAIL> "); nr_failed_routines++; } nr_routines++; if (min_ratio == 1e308) min_ratio = 0.0; printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", fname, total_bad_ratios, total_tests, max_ratio); min_ratio = 1e308; max_ratio = 0.0; total_bad_ratios = 0; total_tests = 0; fname = "BLAS_ddot_d_s"; printf("Testing %s...\n", fname); for (n = 0; n <= nsizes; n++) { total_max_ratio = do_test_ddot_d_s(n, ntests, &seed, thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, &num_tests); if (total_max_ratio > max_ratio) max_ratio = total_max_ratio; if (total_min_ratio != 0.0 && total_min_ratio < min_ratio) min_ratio = total_min_ratio; total_bad_ratios += num_bad_ratio; total_tests += num_tests; } if (total_bad_ratios == 0) printf("PASS> "); else { printf("FAIL> "); nr_failed_routines++; } nr_routines++; if (min_ratio == 1e308) min_ratio = 0.0; printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", fname, total_bad_ratios, total_tests, max_ratio); min_ratio = 1e308; max_ratio = 0.0; total_bad_ratios = 0; total_tests = 0; fname = "BLAS_ddot_s_d"; printf("Testing %s...\n", fname); for (n = 0; n <= nsizes; n++) { total_max_ratio = do_test_ddot_s_d(n, ntests, &seed, thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, &num_tests); if (total_max_ratio > max_ratio) max_ratio = total_max_ratio; if (total_min_ratio != 0.0 && total_min_ratio < min_ratio) min_ratio = total_min_ratio; total_bad_ratios += num_bad_ratio; total_tests += num_tests; } if (total_bad_ratios == 0) printf("PASS> "); else { printf("FAIL> "); nr_failed_routines++; } nr_routines++; if (min_ratio == 1e308) min_ratio = 0.0; printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", fname, total_bad_ratios, total_tests, max_ratio); min_ratio = 1e308; max_ratio = 0.0; total_bad_ratios = 0; total_tests = 0; fname = "BLAS_ddot_s_s"; printf("Testing %s...\n", fname); for (n = 0; n <= nsizes; n++) { total_max_ratio = do_test_ddot_s_s(n, ntests, &seed, thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, &num_tests); if (total_max_ratio > max_ratio) max_ratio = total_max_ratio; if (total_min_ratio != 0.0 && total_min_ratio < min_ratio) min_ratio = total_min_ratio; total_bad_ratios += num_bad_ratio; total_tests += num_tests; } if (total_bad_ratios == 0) printf("PASS> "); else { printf("FAIL> "); nr_failed_routines++; } nr_routines++; if (min_ratio == 1e308) min_ratio = 0.0; printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", fname, total_bad_ratios, total_tests, max_ratio); min_ratio = 1e308; max_ratio = 0.0; total_bad_ratios = 0; total_tests = 0; fname = "BLAS_zdot_z_c"; printf("Testing %s...\n", fname); for (n = 0; n <= nsizes; n++) { total_max_ratio = do_test_zdot_z_c(n, ntests, &seed, thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, &num_tests); if (total_max_ratio > max_ratio) max_ratio = total_max_ratio; if (total_min_ratio != 0.0 && total_min_ratio < min_ratio) min_ratio = total_min_ratio; total_bad_ratios += num_bad_ratio; total_tests += num_tests; } if (total_bad_ratios == 0) printf("PASS> "); else { printf("FAIL> "); nr_failed_routines++; } nr_routines++; if (min_ratio == 1e308) min_ratio = 0.0; printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", fname, total_bad_ratios, total_tests, max_ratio); min_ratio = 1e308; max_ratio = 0.0; total_bad_ratios = 0; total_tests = 0; fname = "BLAS_zdot_c_z"; printf("Testing %s...\n", fname); for (n = 0; n <= nsizes; n++) { total_max_ratio = do_test_zdot_c_z(n, ntests, &seed, thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, &num_tests); if (total_max_ratio > max_ratio) max_ratio = total_max_ratio; if (total_min_ratio != 0.0 && total_min_ratio < min_ratio) min_ratio = total_min_ratio; total_bad_ratios += num_bad_ratio; total_tests += num_tests; } if (total_bad_ratios == 0) printf("PASS> "); else { printf("FAIL> "); nr_failed_routines++; } nr_routines++; if (min_ratio == 1e308) min_ratio = 0.0; printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", fname, total_bad_ratios, total_tests, max_ratio); min_ratio = 1e308; max_ratio = 0.0; total_bad_ratios = 0; total_tests = 0; fname = "BLAS_zdot_c_c"; printf("Testing %s...\n", fname); for (n = 0; n <= nsizes; n++) { total_max_ratio = do_test_zdot_c_c(n, ntests, &seed, thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, &num_tests); if (total_max_ratio > max_ratio) max_ratio = total_max_ratio; if (total_min_ratio != 0.0 && total_min_ratio < min_ratio) min_ratio = total_min_ratio; total_bad_ratios += num_bad_ratio; total_tests += num_tests; } if (total_bad_ratios == 0) printf("PASS> "); else { printf("FAIL> "); nr_failed_routines++; } nr_routines++; if (min_ratio == 1e308) min_ratio = 0.0; printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", fname, total_bad_ratios, total_tests, max_ratio); min_ratio = 1e308; max_ratio = 0.0; total_bad_ratios = 0; total_tests = 0; fname = "BLAS_cdot_c_s"; printf("Testing %s...\n", fname); for (n = 0; n <= nsizes; n++) { total_max_ratio = do_test_cdot_c_s(n, ntests, &seed, thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, &num_tests); if (total_max_ratio > max_ratio) max_ratio = total_max_ratio; if (total_min_ratio != 0.0 && total_min_ratio < min_ratio) min_ratio = total_min_ratio; total_bad_ratios += num_bad_ratio; total_tests += num_tests; } if (total_bad_ratios == 0) printf("PASS> "); else { printf("FAIL> "); nr_failed_routines++; } nr_routines++; if (min_ratio == 1e308) min_ratio = 0.0; printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", fname, total_bad_ratios, total_tests, max_ratio); min_ratio = 1e308; max_ratio = 0.0; total_bad_ratios = 0; total_tests = 0; fname = "BLAS_cdot_s_c"; printf("Testing %s...\n", fname); for (n = 0; n <= nsizes; n++) { total_max_ratio = do_test_cdot_s_c(n, ntests, &seed, thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, &num_tests); if (total_max_ratio > max_ratio) max_ratio = total_max_ratio; if (total_min_ratio != 0.0 && total_min_ratio < min_ratio) min_ratio = total_min_ratio; total_bad_ratios += num_bad_ratio; total_tests += num_tests; } if (total_bad_ratios == 0) printf("PASS> "); else { printf("FAIL> "); nr_failed_routines++; } nr_routines++; if (min_ratio == 1e308) min_ratio = 0.0; printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", fname, total_bad_ratios, total_tests, max_ratio); min_ratio = 1e308; max_ratio = 0.0; total_bad_ratios = 0; total_tests = 0; fname = "BLAS_cdot_s_s"; printf("Testing %s...\n", fname); for (n = 0; n <= nsizes; n++) { total_max_ratio = do_test_cdot_s_s(n, ntests, &seed, thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, &num_tests); if (total_max_ratio > max_ratio) max_ratio = total_max_ratio; if (total_min_ratio != 0.0 && total_min_ratio < min_ratio) min_ratio = total_min_ratio; total_bad_ratios += num_bad_ratio; total_tests += num_tests; } if (total_bad_ratios == 0) printf("PASS> "); else { printf("FAIL> "); nr_failed_routines++; } nr_routines++; if (min_ratio == 1e308) min_ratio = 0.0; printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", fname, total_bad_ratios, total_tests, max_ratio); min_ratio = 1e308; max_ratio = 0.0; total_bad_ratios = 0; total_tests = 0; fname = "BLAS_zdot_z_d"; printf("Testing %s...\n", fname); for (n = 0; n <= nsizes; n++) { total_max_ratio = do_test_zdot_z_d(n, ntests, &seed, thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, &num_tests); if (total_max_ratio > max_ratio) max_ratio = total_max_ratio; if (total_min_ratio != 0.0 && total_min_ratio < min_ratio) min_ratio = total_min_ratio; total_bad_ratios += num_bad_ratio; total_tests += num_tests; } if (total_bad_ratios == 0) printf("PASS> "); else { printf("FAIL> "); nr_failed_routines++; } nr_routines++; if (min_ratio == 1e308) min_ratio = 0.0; printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", fname, total_bad_ratios, total_tests, max_ratio); min_ratio = 1e308; max_ratio = 0.0; total_bad_ratios = 0; total_tests = 0; fname = "BLAS_zdot_d_z"; printf("Testing %s...\n", fname); for (n = 0; n <= nsizes; n++) { total_max_ratio = do_test_zdot_d_z(n, ntests, &seed, thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, &num_tests); if (total_max_ratio > max_ratio) max_ratio = total_max_ratio; if (total_min_ratio != 0.0 && total_min_ratio < min_ratio) min_ratio = total_min_ratio; total_bad_ratios += num_bad_ratio; total_tests += num_tests; } if (total_bad_ratios == 0) printf("PASS> "); else { printf("FAIL> "); nr_failed_routines++; } nr_routines++; if (min_ratio == 1e308) min_ratio = 0.0; printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", fname, total_bad_ratios, total_tests, max_ratio); min_ratio = 1e308; max_ratio = 0.0; total_bad_ratios = 0; total_tests = 0; fname = "BLAS_zdot_d_d"; printf("Testing %s...\n", fname); for (n = 0; n <= nsizes; n++) { total_max_ratio = do_test_zdot_d_d(n, ntests, &seed, thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, &num_tests); if (total_max_ratio > max_ratio) max_ratio = total_max_ratio; if (total_min_ratio != 0.0 && total_min_ratio < min_ratio) min_ratio = total_min_ratio; total_bad_ratios += num_bad_ratio; total_tests += num_tests; } if (total_bad_ratios == 0) printf("PASS> "); else { printf("FAIL> "); nr_failed_routines++; } nr_routines++; if (min_ratio == 1e308) min_ratio = 0.0; printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", fname, total_bad_ratios, total_tests, max_ratio); min_ratio = 1e308; max_ratio = 0.0; total_bad_ratios = 0; total_tests = 0; fname = "BLAS_sdot_x"; printf("Testing %s...\n", fname); for (n = 0; n <= nsizes; n++) { total_max_ratio = do_test_sdot_x(n, ntests, &seed, thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, &num_tests); if (total_max_ratio > max_ratio) max_ratio = total_max_ratio; if (total_min_ratio != 0.0 && total_min_ratio < min_ratio) min_ratio = total_min_ratio; total_bad_ratios += num_bad_ratio; total_tests += num_tests; } if (total_bad_ratios == 0) printf("PASS> "); else { printf("FAIL> "); nr_failed_routines++; } nr_routines++; if (min_ratio == 1e308) min_ratio = 0.0; printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", fname, total_bad_ratios, total_tests, max_ratio); min_ratio = 1e308; max_ratio = 0.0; total_bad_ratios = 0; total_tests = 0; fname = "BLAS_ddot_x"; printf("Testing %s...\n", fname); for (n = 0; n <= nsizes; n++) { total_max_ratio = do_test_ddot_x(n, ntests, &seed, thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, &num_tests); if (total_max_ratio > max_ratio) max_ratio = total_max_ratio; if (total_min_ratio != 0.0 && total_min_ratio < min_ratio) min_ratio = total_min_ratio; total_bad_ratios += num_bad_ratio; total_tests += num_tests; } if (total_bad_ratios == 0) printf("PASS> "); else { printf("FAIL> "); nr_failed_routines++; } nr_routines++; if (min_ratio == 1e308) min_ratio = 0.0; printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", fname, total_bad_ratios, total_tests, max_ratio); min_ratio = 1e308; max_ratio = 0.0; total_bad_ratios = 0; total_tests = 0; fname = "BLAS_cdot_x"; printf("Testing %s...\n", fname); for (n = 0; n <= nsizes; n++) { total_max_ratio = do_test_cdot_x(n, ntests, &seed, thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, &num_tests); if (total_max_ratio > max_ratio) max_ratio = total_max_ratio; if (total_min_ratio != 0.0 && total_min_ratio < min_ratio) min_ratio = total_min_ratio; total_bad_ratios += num_bad_ratio; total_tests += num_tests; } if (total_bad_ratios == 0) printf("PASS> "); else { printf("FAIL> "); nr_failed_routines++; } nr_routines++; if (min_ratio == 1e308) min_ratio = 0.0; printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", fname, total_bad_ratios, total_tests, max_ratio); min_ratio = 1e308; max_ratio = 0.0; total_bad_ratios = 0; total_tests = 0; fname = "BLAS_zdot_x"; printf("Testing %s...\n", fname); for (n = 0; n <= nsizes; n++) { total_max_ratio = do_test_zdot_x(n, ntests, &seed, thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, &num_tests); if (total_max_ratio > max_ratio) max_ratio = total_max_ratio; if (total_min_ratio != 0.0 && total_min_ratio < min_ratio) min_ratio = total_min_ratio; total_bad_ratios += num_bad_ratio; total_tests += num_tests; } if (total_bad_ratios == 0) printf("PASS> "); else { printf("FAIL> "); nr_failed_routines++; } nr_routines++; if (min_ratio == 1e308) min_ratio = 0.0; printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", fname, total_bad_ratios, total_tests, max_ratio); min_ratio = 1e308; max_ratio = 0.0; total_bad_ratios = 0; total_tests = 0; fname = "BLAS_ddot_d_s_x"; printf("Testing %s...\n", fname); for (n = 0; n <= nsizes; n++) { total_max_ratio = do_test_ddot_d_s_x(n, ntests, &seed, thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, &num_tests); if (total_max_ratio > max_ratio) max_ratio = total_max_ratio; if (total_min_ratio != 0.0 && total_min_ratio < min_ratio) min_ratio = total_min_ratio; total_bad_ratios += num_bad_ratio; total_tests += num_tests; } if (total_bad_ratios == 0) printf("PASS> "); else { printf("FAIL> "); nr_failed_routines++; } nr_routines++; if (min_ratio == 1e308) min_ratio = 0.0; printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", fname, total_bad_ratios, total_tests, max_ratio); min_ratio = 1e308; max_ratio = 0.0; total_bad_ratios = 0; total_tests = 0; fname = "BLAS_ddot_s_d_x"; printf("Testing %s...\n", fname); for (n = 0; n <= nsizes; n++) { total_max_ratio = do_test_ddot_s_d_x(n, ntests, &seed, thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, &num_tests); if (total_max_ratio > max_ratio) max_ratio = total_max_ratio; if (total_min_ratio != 0.0 && total_min_ratio < min_ratio) min_ratio = total_min_ratio; total_bad_ratios += num_bad_ratio; total_tests += num_tests; } if (total_bad_ratios == 0) printf("PASS> "); else { printf("FAIL> "); nr_failed_routines++; } nr_routines++; if (min_ratio == 1e308) min_ratio = 0.0; printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", fname, total_bad_ratios, total_tests, max_ratio); min_ratio = 1e308; max_ratio = 0.0; total_bad_ratios = 0; total_tests = 0; fname = "BLAS_ddot_s_s_x"; printf("Testing %s...\n", fname); for (n = 0; n <= nsizes; n++) { total_max_ratio = do_test_ddot_s_s_x(n, ntests, &seed, thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, &num_tests); if (total_max_ratio > max_ratio) max_ratio = total_max_ratio; if (total_min_ratio != 0.0 && total_min_ratio < min_ratio) min_ratio = total_min_ratio; total_bad_ratios += num_bad_ratio; total_tests += num_tests; } if (total_bad_ratios == 0) printf("PASS> "); else { printf("FAIL> "); nr_failed_routines++; } nr_routines++; if (min_ratio == 1e308) min_ratio = 0.0; printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", fname, total_bad_ratios, total_tests, max_ratio); min_ratio = 1e308; max_ratio = 0.0; total_bad_ratios = 0; total_tests = 0; fname = "BLAS_zdot_z_c_x"; printf("Testing %s...\n", fname); for (n = 0; n <= nsizes; n++) { total_max_ratio = do_test_zdot_z_c_x(n, ntests, &seed, thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, &num_tests); if (total_max_ratio > max_ratio) max_ratio = total_max_ratio; if (total_min_ratio != 0.0 && total_min_ratio < min_ratio) min_ratio = total_min_ratio; total_bad_ratios += num_bad_ratio; total_tests += num_tests; } if (total_bad_ratios == 0) printf("PASS> "); else { printf("FAIL> "); nr_failed_routines++; } nr_routines++; if (min_ratio == 1e308) min_ratio = 0.0; printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", fname, total_bad_ratios, total_tests, max_ratio); min_ratio = 1e308; max_ratio = 0.0; total_bad_ratios = 0; total_tests = 0; fname = "BLAS_zdot_c_z_x"; printf("Testing %s...\n", fname); for (n = 0; n <= nsizes; n++) { total_max_ratio = do_test_zdot_c_z_x(n, ntests, &seed, thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, &num_tests); if (total_max_ratio > max_ratio) max_ratio = total_max_ratio; if (total_min_ratio != 0.0 && total_min_ratio < min_ratio) min_ratio = total_min_ratio; total_bad_ratios += num_bad_ratio; total_tests += num_tests; } if (total_bad_ratios == 0) printf("PASS> "); else { printf("FAIL> "); nr_failed_routines++; } nr_routines++; if (min_ratio == 1e308) min_ratio = 0.0; printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", fname, total_bad_ratios, total_tests, max_ratio); min_ratio = 1e308; max_ratio = 0.0; total_bad_ratios = 0; total_tests = 0; fname = "BLAS_zdot_c_c_x"; printf("Testing %s...\n", fname); for (n = 0; n <= nsizes; n++) { total_max_ratio = do_test_zdot_c_c_x(n, ntests, &seed, thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, &num_tests); if (total_max_ratio > max_ratio) max_ratio = total_max_ratio; if (total_min_ratio != 0.0 && total_min_ratio < min_ratio) min_ratio = total_min_ratio; total_bad_ratios += num_bad_ratio; total_tests += num_tests; } if (total_bad_ratios == 0) printf("PASS> "); else { printf("FAIL> "); nr_failed_routines++; } nr_routines++; if (min_ratio == 1e308) min_ratio = 0.0; printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", fname, total_bad_ratios, total_tests, max_ratio); min_ratio = 1e308; max_ratio = 0.0; total_bad_ratios = 0; total_tests = 0; fname = "BLAS_cdot_c_s_x"; printf("Testing %s...\n", fname); for (n = 0; n <= nsizes; n++) { total_max_ratio = do_test_cdot_c_s_x(n, ntests, &seed, thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, &num_tests); if (total_max_ratio > max_ratio) max_ratio = total_max_ratio; if (total_min_ratio != 0.0 && total_min_ratio < min_ratio) min_ratio = total_min_ratio; total_bad_ratios += num_bad_ratio; total_tests += num_tests; } if (total_bad_ratios == 0) printf("PASS> "); else { printf("FAIL> "); nr_failed_routines++; } nr_routines++; if (min_ratio == 1e308) min_ratio = 0.0; printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", fname, total_bad_ratios, total_tests, max_ratio); min_ratio = 1e308; max_ratio = 0.0; total_bad_ratios = 0; total_tests = 0; fname = "BLAS_cdot_s_c_x"; printf("Testing %s...\n", fname); for (n = 0; n <= nsizes; n++) { total_max_ratio = do_test_cdot_s_c_x(n, ntests, &seed, thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, &num_tests); if (total_max_ratio > max_ratio) max_ratio = total_max_ratio; if (total_min_ratio != 0.0 && total_min_ratio < min_ratio) min_ratio = total_min_ratio; total_bad_ratios += num_bad_ratio; total_tests += num_tests; } if (total_bad_ratios == 0) printf("PASS> "); else { printf("FAIL> "); nr_failed_routines++; } nr_routines++; if (min_ratio == 1e308) min_ratio = 0.0; printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", fname, total_bad_ratios, total_tests, max_ratio); min_ratio = 1e308; max_ratio = 0.0; total_bad_ratios = 0; total_tests = 0; fname = "BLAS_cdot_s_s_x"; printf("Testing %s...\n", fname); for (n = 0; n <= nsizes; n++) { total_max_ratio = do_test_cdot_s_s_x(n, ntests, &seed, thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, &num_tests); if (total_max_ratio > max_ratio) max_ratio = total_max_ratio; if (total_min_ratio != 0.0 && total_min_ratio < min_ratio) min_ratio = total_min_ratio; total_bad_ratios += num_bad_ratio; total_tests += num_tests; } if (total_bad_ratios == 0) printf("PASS> "); else { printf("FAIL> "); nr_failed_routines++; } nr_routines++; if (min_ratio == 1e308) min_ratio = 0.0; printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", fname, total_bad_ratios, total_tests, max_ratio); min_ratio = 1e308; max_ratio = 0.0; total_bad_ratios = 0; total_tests = 0; fname = "BLAS_zdot_z_d_x"; printf("Testing %s...\n", fname); for (n = 0; n <= nsizes; n++) { total_max_ratio = do_test_zdot_z_d_x(n, ntests, &seed, thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, &num_tests); if (total_max_ratio > max_ratio) max_ratio = total_max_ratio; if (total_min_ratio != 0.0 && total_min_ratio < min_ratio) min_ratio = total_min_ratio; total_bad_ratios += num_bad_ratio; total_tests += num_tests; } if (total_bad_ratios == 0) printf("PASS> "); else { printf("FAIL> "); nr_failed_routines++; } nr_routines++; if (min_ratio == 1e308) min_ratio = 0.0; printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", fname, total_bad_ratios, total_tests, max_ratio); min_ratio = 1e308; max_ratio = 0.0; total_bad_ratios = 0; total_tests = 0; fname = "BLAS_zdot_d_z_x"; printf("Testing %s...\n", fname); for (n = 0; n <= nsizes; n++) { total_max_ratio = do_test_zdot_d_z_x(n, ntests, &seed, thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, &num_tests); if (total_max_ratio > max_ratio) max_ratio = total_max_ratio; if (total_min_ratio != 0.0 && total_min_ratio < min_ratio) min_ratio = total_min_ratio; total_bad_ratios += num_bad_ratio; total_tests += num_tests; } if (total_bad_ratios == 0) printf("PASS> "); else { printf("FAIL> "); nr_failed_routines++; } nr_routines++; if (min_ratio == 1e308) min_ratio = 0.0; printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", fname, total_bad_ratios, total_tests, max_ratio); min_ratio = 1e308; max_ratio = 0.0; total_bad_ratios = 0; total_tests = 0; fname = "BLAS_zdot_d_d_x"; printf("Testing %s...\n", fname); for (n = 0; n <= nsizes; n++) { total_max_ratio = do_test_zdot_d_d_x(n, ntests, &seed, thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, &num_tests); if (total_max_ratio > max_ratio) max_ratio = total_max_ratio; if (total_min_ratio != 0.0 && total_min_ratio < min_ratio) min_ratio = total_min_ratio; total_bad_ratios += num_bad_ratio; total_tests += num_tests; } if (total_bad_ratios == 0) printf("PASS> "); else { printf("FAIL> "); nr_failed_routines++; } nr_routines++; if (min_ratio == 1e308) min_ratio = 0.0; printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", fname, total_bad_ratios, total_tests, max_ratio); printf("\n"); if (nr_failed_routines) printf("FAILED "); else printf("PASSED "); printf("%-10s: FAIL/TOTAL = %d/%d\n", base_routine, nr_failed_routines, nr_routines); return 0; }