/* tz_fcmp(x1, x2) compare two double float numbers. * tz_fcmp(x1, x2, ep) compare the double float numbers at the accuracy ep, * which is 1e-5 by default. */ void mexFunction(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]) { check_argin(nrhs, prhs); double epsilon = 1e-5; if (nrhs == 3) { epsilon = *mxGetPr(prhs[2]); } mwSize length; mwSize length1 = tz_mxGetL(prhs[0]); mwSize length2 = tz_mxGetL(prhs[1]); const mxArray *array = NULL; if (mxIsScalar(prhs[0]) && mxIsScalar(prhs[1])) { plhs[0] = mxCreateNumericMatrix(1, 1, mxINT8_CLASS, mxREAL); length = 1; } else if (!mxIsScalar(prhs[0]) && !mxIsScalar(prhs[1])) { plhs[0] = mxCreateNumericArray(mxGetNumberOfDimensions(prhs[0]), mxGetDimensions(prhs[0]), mxINT8_CLASS, mxREAL); length = length1; } else { if (length1 == 1) { array = prhs[1]; length = length2; } else { array = prhs[0]; length = length1; } plhs[0] = mxCreateNumericArray(mxGetNumberOfDimensions(array), mxGetDimensions(array), mxINT8_CLASS, mxREAL); } INT8_T *y = (INT8_T *) mxGetPr(plhs[0]); double *x1 = mxGetPr(prhs[0]); double *x2 = mxGetPr(prhs[1]); mwSize i; if (length1 == length2) { for (i = 0; i < length; i++) { y[i] = (INT8_T) gsl_fcmp(x1[i], x2[i], epsilon); } } else if (length1 > length2) { for (i = 0; i < length; i++) { y[i] = (INT8_T) gsl_fcmp(x1[i], x2[0], epsilon); } } else { for (i = 0; i < length; i++) { y[i] = (INT8_T) gsl_fcmp(x1[0], x2[i], epsilon); } } }
/* * FUNCTION * Name: entropy_of_state * Description: Calculate the Von Neumann entropy of state 'rho' * */ double entropy_of_state ( const gsl_vector* rho ) { double entr = 0 ; /* Finding the eigenvalues */ gsl_eigen_herm_workspace* rho_ei = gsl_eigen_herm_alloc(2); gsl_matrix_complex* dens = gsl_matrix_complex_calloc (2,2); gsl_matrix_complex_set (dens, 0, 0, gsl_complex_rect(1+VECTOR(rho, 3),0)); gsl_matrix_complex_set (dens,0,1,gsl_complex_rect(VECTOR(rho,1),-VECTOR(rho,2))); gsl_matrix_complex_set (dens,1,0,gsl_complex_rect(VECTOR(rho,1),VECTOR(rho,2))); gsl_matrix_complex_set (dens,1,1,gsl_complex_rect(1-VECTOR(rho,3),0)); gsl_matrix_complex_scale (dens, gsl_complex_rect(0.5,0)); gsl_vector* eigenvalues = gsl_vector_calloc(2) ; gsl_eigen_herm (dens, eigenvalues, rho_ei) ; /* Calculating entropy */ double norm = gsl_hypot3( VECTOR(rho,1), VECTOR(rho,2), VECTOR(rho,3) ) ; if ( gsl_fcmp(norm, 1, 1e-9) > 0 ) entr = 0 ; else entr = - (VECTOR(eigenvalues,0)*gsl_sf_log(VECTOR(eigenvalues,0)) + VECTOR(eigenvalues,1)*gsl_sf_log(VECTOR(eigenvalues,1))) ; return (entr); } /* ----- end of function entropy_of_state ----- */
int workspace_add_point( workspace *w, point p) { //see if this point exists int i; for( i = w->npoints-1; i >= 0; i--) { if( !gsl_fcmp( p.x, w->points[i].x, CMPEPS) && !gsl_fcmp( p.y, w->points[i].y, CMPEPS)) { return i; } } //else edge_matrix_expand( w); if( w->npoints == w->lenpoints) { w->points = realloc( w->points, 2*w->lenpoints*sizeof( point)); w->lenpoints *= 2; } w->points[w->npoints] = p; return w->npoints++; }
static VALUE rb_GSL_MIN(VALUE obj, VALUE aa, VALUE bb) { double a, b; double min; /* Need_Float(aa); Need_Float(bb);*/ a = NUM2DBL(aa); b = NUM2DBL(bb); min = GSL_MIN_DBL(a, b); if (gsl_fcmp(min, a, 1.0e-10) == 0) return aa; else return bb; }
bool Tree::isUltrametric (double epsilon) const { const auto dist = distanceFromRoot(); TreeBranchLength minDist = numeric_limits<double>::infinity(); for (TreeNodeIndex node = 0; node < nodes(); ++node) if (isLeaf(node)) minDist = min (minDist, dist[node]); for (TreeNodeIndex node = 0; node < nodes(); ++node) if (isLeaf(node)) if (gsl_fcmp (dist[node], minDist, epsilon) != 0) return false; return true; }
static int matrix_is_equal(gsl_matrix_complex *m1, gsl_matrix_complex *m2, gsl_complex *c) { gsl_complex a, b, ab, absave; double eps = 1e-6; size_t i, j; absave.dat[0] = 99999; absave.dat[1] = 99999; if (m1->size1 != m2->size1 || m1->size2 != m2->size2) return 0; for (i = 0; i < m1->size1; i++) { for (j = 0; j < m1->size2; j++) { a = gsl_matrix_complex_get(m1, i, j); b = gsl_matrix_complex_get(m2, i, j); if (!gsl_fcmp(gsl_complex_abs(b), 0.0, eps)) continue; ab = gsl_complex_div(a, b); if (!gsl_fcmp(gsl_complex_abs(ab), 0.0, eps)) continue; if ((int) absave.dat[0] == 99999) absave = ab; if (gsl_fcmp(ab.dat[0], absave.dat[0], eps)) return 0; if (gsl_fcmp(ab.dat[1], absave.dat[1], eps)) return 0; } } if ((int) absave.dat[0] == 99999) return 0; *c = ab; return 1; }
/** Rotates point b around point a using the rotation matrix R. */ void rotate(bool transpose, const gsl_matrix *R, const gsl_vector *a, gsl_vector *b) { declare_stack_allocated_vector(v, 3); gsl_vector_memcpy(v, b); gsl_vector_sub(v, a); /* Rotate end vector. */ declare_stack_allocated_vector(w, 3); gsl_blas_dgemv(transpose == false ? CblasNoTrans : CblasTrans, 1.0, R, v, 0.0, w); /* Update position. */ gsl_vector_memcpy(b, a); gsl_vector_add(b, w); assert(gsl_fcmp(gsl_blas_dnrm2(v), gsl_blas_dnrm2(w), 1e-15) == 0); }
int main (int argc, char *argv[]) { double a, b, epsilon; g_assert (argc == 4); a = strtod (argv[1], NULL); g_assert (errno != ERANGE); b = strtod (argv[2], NULL); g_assert (errno != ERANGE); epsilon = strtod (argv[3], NULL); g_assert (errno != ERANGE); printf ("%i\n", gsl_fcmp (a, b, epsilon)); return EXIT_SUCCESS; }
static VALUE rb_gsl_fcmp(int argc, VALUE *argv, VALUE obj) { double a, b, epsilon = 1e-10; switch (argc) { case 3: epsilon = NUM2DBL(argv[2]); /* no break, do next */ case 2: a = NUM2DBL(argv[0]); b = NUM2DBL(argv[1]); break; default: rb_raise(rb_eArgError, "wrong number of arguments"); break; } return INT2FIX(gsl_fcmp(a, b, epsilon)); }
static VALUE rb_gsl_equal(int argc, VALUE *argv, VALUE obj) { double a, b, epsilon = 1e-10; int retval; switch (argc) { case 3: epsilon = NUM2DBL(argv[2]); /* no break, do next */ case 2: a = NUM2DBL(argv[0]); b = NUM2DBL(argv[1]); break; default: rb_raise(rb_eArgError, "wrong number of arguments"); break; } retval = gsl_fcmp(a, b, epsilon); if (retval == 0) return Qtrue; else return Qfalse; }
void test_manip(const size_t M, const size_t N, const double density, const gsl_rng *r) { int status; gsl_spmatrix *tri, *ccs, *crs, *test; gsl_matrix *dense, *denseDivRows, *denseDivCols; double sum, sumDense; gsl_vector *v; gsl_vector *denseRowSum, *denseColSum; size_t i, j; tri = create_random_sparse(M, N, density, r); dense = gsl_matrix_alloc(M, N); gsl_spmatrix_sp2d(dense, tri); /** Get row sum and col sum aswell as divided matrices for dense */ denseDivRows = gsl_matrix_calloc(M, N); denseDivCols = gsl_matrix_calloc(M, N); denseRowSum = gsl_vector_calloc(M); denseColSum = gsl_vector_calloc(N); sumDense = 0.; for (i = 0; i < M; i++) { for (j = 0; j < N; j++) { denseRowSum->data[i * denseRowSum->stride] += gsl_matrix_get(dense, i, j); denseColSum->data[j * denseColSum->stride] += gsl_matrix_get(dense, i, j); sumDense += gsl_matrix_get(dense, i, j); } } for (i = 0; i < M; i++) { for (j = 0; j < N; j++) { if (gsl_pow_2(denseRowSum->data[i * denseRowSum->stride]) > 1.e-12) { gsl_matrix_set(denseDivRows, i, j, gsl_matrix_get(dense, i, j) / denseRowSum->data[i * denseRowSum->stride]); } else { gsl_matrix_set(denseDivRows, i, j, gsl_matrix_get(dense, i, j)); } if (gsl_pow_2(denseColSum->data[j * denseColSum->stride]) > 1.e-12) { gsl_matrix_set(denseDivCols, i, j, gsl_matrix_get(dense, i, j) / denseColSum->data[j * denseColSum->stride]); } else { gsl_matrix_set(denseDivCols, i, j, gsl_matrix_get(dense, i, j)); } } } // Compress ccs = gsl_spmatrix_compress(tri, GSL_SPMATRIX_CCS); crs = gsl_spmatrix_compress(tri, GSL_SPMATRIX_CRS); /** TOTAL SUM */ /** Triplet */ sum = gsl_spmatrix_get_sum(tri); status = !(sum == sumDense); gsl_test(status, "test_manip: M=%zu N=%zu _get != _get_sum triplet", M, N); /** CCS */ sum = gsl_spmatrix_get_sum(ccs); status = !(sum == sumDense); gsl_test(status, "test_manip: M=%zu N=%zu _get != _get_sum CCS", M, N); /** CRS */ sum = gsl_spmatrix_get_sum(crs); status = !(sum == sumDense); gsl_test(status, "test_manip: M=%zu N=%zu _get != _get_sum CRS", M, N); /** COLUMN SUM AND DIVIDE */ /** Triplet */ /* Sum */ v = gsl_vector_alloc(M); gsl_spmatrix_get_rowsum(v, tri); status = 0; for (i = 0; i < M; i++) if (v->data[i * v->stride] != denseRowSum->data[i * denseRowSum->stride]) status = 1; gsl_test(status, "test_manip: M=%zu N=%zu _get != _get_rowsum triplet", M, N); /* Div */ test = gsl_spmatrix_alloc_nzmax(crs->size1, crs->size2, 0, GSL_SPMATRIX_TRIPLET); gsl_spmatrix_memcpy(test, tri); gsl_spmatrix_div_rows(test, v); status = 0; for (i = 0; i < M; i++) { for (j = 0; j < N; j++) { if (gsl_matrix_get(denseDivRows, i, j) != gsl_spmatrix_get(test, i, j)) status = 1; } } gsl_test(status, "test_manip: M=%zu N=%zu _get != _div_rows triplet", M, N); gsl_vector_free(v); gsl_spmatrix_free(test); /** CCS */ /* Sum */ v = gsl_vector_alloc(M); gsl_spmatrix_get_rowsum(v, ccs); status = 0; for (i = 0; i < M; i++) if (v->data[i * v->stride] != denseRowSum->data[i * denseRowSum->stride]) status = 1; gsl_test(status, "test_manip: M=%zu N=%zu _get != _get_rowsum CCS", M, N); /* Div */ test = gsl_spmatrix_alloc_nzmax(ccs->size1, ccs->size2, 0, GSL_SPMATRIX_CCS); gsl_spmatrix_memcpy(test, ccs); gsl_spmatrix_div_rows(test, v); status = 0; for (i = 0; i < M; i++) { for (j = 0; j < N; j++) { if (gsl_matrix_get(denseDivRows, i, j) != gsl_spmatrix_get(test, i, j)) status = 1; } } gsl_test(status, "test_manip: M=%zu N=%zu _get != _div_rows CCS", M, N); gsl_vector_free(v); gsl_spmatrix_free(test); /* CRS */ /* Sum */ v = gsl_vector_alloc(M); gsl_spmatrix_get_rowsum(v, crs); status = 0; for (i = 0; i < M; i++) if (v->data[i * v->stride] != denseRowSum->data[i * denseRowSum->stride]) status = 1; gsl_test(status, "test_manip: M=%zu N=%zu _get != _get_rowsum CRS", M, N); /* Div */ test = gsl_spmatrix_alloc_nzmax(crs->size1, crs->size2, 0, GSL_SPMATRIX_CRS); gsl_spmatrix_memcpy(test, crs); gsl_spmatrix_div_rows(test, v); status = 0; for (i = 0; i < M; i++) { for (j = 0; j < N; j++) { if (gsl_matrix_get(denseDivRows, i, j) != gsl_spmatrix_get(test, i, j)) status = 1; } } gsl_test(status, "test_manip: M=%zu N=%zu _get != _div_rows CRS", M, N); gsl_vector_free(v); gsl_spmatrix_free(test); /** COLUMN SUM AND DIVIDE */ /** Triplet */ /* Sum */ v = gsl_vector_alloc(N); gsl_spmatrix_get_colsum(v, tri); status = 0; for (j = 0; j < N; j++) if (v->data[j * v->stride] != denseColSum->data[j * denseColSum->stride]) status = 1; gsl_test(status, "test_manip: M=%zu N=%zu _get != _get_colsum triplet", M, N); /* Div */ test = gsl_spmatrix_alloc_nzmax(tri->size1, tri->size2, 0, GSL_SPMATRIX_TRIPLET); gsl_spmatrix_memcpy(test, tri); gsl_spmatrix_div_cols(test, v); status = 0; for (i = 0; i < M; i++) { for (j = 0; j < N; j++) { if (gsl_fcmp(gsl_matrix_get(denseDivCols, i, j), gsl_spmatrix_get(test, i, j), 1.e-12)) { fprintf(stdout, "mismatch: (%zu, %zu) %lf != %lf\n", i, j, gsl_matrix_get(denseDivCols, i, j), gsl_spmatrix_get(test, i, j)); status = 1; } } } gsl_test(status, "test_manip: M=%zu N=%zu _get != _div_cols triplet", M, N); gsl_vector_free(v); gsl_spmatrix_free(test); /** CCS */ /** Sum */ v = gsl_vector_alloc(N); gsl_spmatrix_get_colsum(v, ccs); status = 0; for (j = 0; j < N; j++) if (v->data[j * v->stride] != denseColSum->data[j * denseColSum->stride]) status = 1; gsl_test(status, "test_manip: M=%zu N=%zu _get != _get_colsum CCS", M, N); /** Div */ test = gsl_spmatrix_alloc_nzmax(ccs->size1, ccs->size2, 0, GSL_SPMATRIX_CCS); gsl_spmatrix_memcpy(test, ccs); gsl_spmatrix_div_cols(test, v); status = 0; for (i = 0; i < M; i++) { for (j = 0; j < N; j++) { if (gsl_matrix_get(denseDivCols, i, j) != gsl_spmatrix_get(test, i, j)) status = 1; } } gsl_test(status, "test_manip: M=%zu N=%zu _get != _div_cols CCS", M, N); gsl_vector_free(v); gsl_spmatrix_free(test); /** CRS */ /* Sum */ v = gsl_vector_alloc(N); gsl_spmatrix_get_colsum(v, crs); status = 0; for (j = 0; j < N; j++) if (v->data[j * v->stride] != denseColSum->data[j * denseColSum->stride]) status = 1; gsl_test(status, "test_manip: M=%zu N=%zu _get != _get_colsum CRS", M, N); /* Div */ test = gsl_spmatrix_alloc_nzmax(crs->size1, crs->size2, 0, GSL_SPMATRIX_CRS); gsl_spmatrix_memcpy(test, crs); gsl_spmatrix_div_cols(test, v); status = 0; for (i = 0; i < M; i++) { for (j = 0; j < N; j++) { if (gsl_matrix_get(denseDivCols, i, j) != gsl_spmatrix_get(test, i, j)) status = 1; } } gsl_test(status, "test_manip: M=%zu N=%zu _get != _div_cols CRS", M, N); gsl_vector_free(v); gsl_spmatrix_free(test); /** Free */ gsl_spmatrix_free(tri); gsl_spmatrix_free(ccs); gsl_spmatrix_free(crs); gsl_matrix_free(dense); gsl_matrix_free(denseDivRows); gsl_matrix_free(denseDivCols); gsl_vector_free(denseRowSum); gsl_vector_free(denseColSum); return; }
int main (int argc, char *argv []) { if(populate_env_variable(REF_ERROR_CODES_FILE, "L2_ERROR_CODES_FILE")) { printf("\nUnable to populate [REF_ERROR_CODES_FILE] variable with corresponding environment variable. Routine will proceed without error handling\n"); } if (argc != 8) { if(populate_env_variable(LOR_BLURB_FILE, "L2_LOR_BLURB_FILE")) { RETURN_FLAG = 1; } else { print_file(LOR_BLURB_FILE); } write_key_to_file(ERROR_CODES_FILE, REF_ERROR_CODES_FILE, "L2STATRE", -1, "Status flag for L2 lorebin routine", ERROR_CODES_FILE_WRITE_ACCESS); return 1; } else { // *********************************************************************** // Redefine routine input parameters char *input_f = strdup(argv[1]); double start_wav = strtod(argv[2], NULL); double end_wav = strtod(argv[3], NULL); char *interpolation_type = strdup(argv[4]); double dispersion = strtod(argv[5], NULL); int conserve_flux = strtol(argv[6], NULL, 0); char *output_f = strdup(argv[7]); // *********************************************************************** // Open input file (ARG 1), get parameters and perform any data format // checks fitsfile *input_f_ptr; int input_f_maxdim = 2; int input_f_status = 0, input_f_bitpix, input_f_naxis; long input_f_naxes [2] = {1,1}; if(!fits_open_file(&input_f_ptr, input_f, READONLY, &input_f_status)) { if(!populate_img_parameters(input_f, input_f_ptr, input_f_maxdim, &input_f_bitpix, &input_f_naxis, input_f_naxes, &input_f_status, "INPUT FRAME")) { if (input_f_naxis != 2) { // any data format checks here write_key_to_file(ERROR_CODES_FILE, REF_ERROR_CODES_FILE, "L2STATRE", -2, "Status flag for L2 lorebin routine", ERROR_CODES_FILE_WRITE_ACCESS); free(input_f); free(interpolation_type); free(output_f); if(fits_close_file(input_f_ptr, &input_f_status)) fits_report_error (stdout, input_f_status); return 1; } } else { write_key_to_file(ERROR_CODES_FILE, REF_ERROR_CODES_FILE, "L2STATRE", -3, "Status flag for L2 lorebin routine", ERROR_CODES_FILE_WRITE_ACCESS); fits_report_error(stdout, input_f_status); free(input_f); free(interpolation_type); free(output_f); if(fits_close_file(input_f_ptr, &input_f_status)) fits_report_error (stdout, input_f_status); return 1; } } else { write_key_to_file(ERROR_CODES_FILE, REF_ERROR_CODES_FILE, "L2STATRE", -4, "Status flag for L2 lorebin routine", ERROR_CODES_FILE_WRITE_ACCESS); fits_report_error(stdout, input_f_status); free(input_f); free(interpolation_type); free(output_f); return 1; } // *********************************************************************** // Set the range limits using input fits file (ARG 1) int cut_x [2] = {1, input_f_naxes[0]}; int cut_y [2] = {1, input_f_naxes[1]}; // *********************************************************************** // Set parameters used when reading data from input fits file (ARG 1) long fpixel [2] = {cut_x[0], cut_y[0]}; long nxelements = (cut_x[1] - cut_x[0]) + 1; long nyelements = (cut_y[1] - cut_y[0]) + 1; // *********************************************************************** // Create arrays to store pixel values from input fits file (ARG 1) double input_f_pixels [nxelements]; // *********************************************************************** // Open [LOARCFIT_OUTPUTF_WAVFITS_FILE] dispersion solutions file FILE *dispersion_solutions_f; if (!check_file_exists(LOARCFIT_OUTPUTF_WAVFITS_FILE)) { dispersion_solutions_f = fopen(LOARCFIT_OUTPUTF_WAVFITS_FILE , "r"); } else { write_key_to_file(ERROR_CODES_FILE, REF_ERROR_CODES_FILE, "L2STATRE", -5, "Status flag for L2 lorebin routine", ERROR_CODES_FILE_WRITE_ACCESS); free(input_f); free(interpolation_type); free(output_f); if(fits_close_file(input_f_ptr, &input_f_status)) fits_report_error (stdout, input_f_status); return 1; } // *********************************************************************** // Find some [LOARCFIT_OUTPUTF_WAVFITS_FILE] file details char input_string [500]; bool find_polynomialorder_comment = FALSE; int polynomial_order; char search_string_1 [20] = "# Polynomial Order:\0"; // this is the comment to be found from the [LOARCFIT_OUTPUTF_WAVFITS_FILE] file while(!feof(dispersion_solutions_f)) { memset(input_string, '\0', sizeof(char)*500); fgets(input_string, 500, dispersion_solutions_f); if (strncmp(input_string, search_string_1, strlen(search_string_1)) == 0) { sscanf(input_string, "%*[^\t]%d", &polynomial_order); // read all data up to tab as string ([^\t]), but do not store (*) find_polynomialorder_comment = TRUE; break; } } if (find_polynomialorder_comment == FALSE) { // error check - didn't find the comment in the [LOARCFIT_OUTPUTF_WAVFITS_FILE] file write_key_to_file(ERROR_CODES_FILE, REF_ERROR_CODES_FILE, "L2STATRE", -6, "Status flag for L2 lorebin routine", ERROR_CODES_FILE_WRITE_ACCESS); free(input_f); free(interpolation_type); free(output_f); fclose(dispersion_solutions_f); if(fits_close_file(input_f_ptr, &input_f_status)) fits_report_error (stdout, input_f_status); return 1; } // *********************************************************************** // Rewind and extract coefficients from [LOARCFIT_OUTPUTF_WAVFITS_FILE] // file rewind(dispersion_solutions_f); int token_index; // this variable will hold which token we're dealing with int coeff_index; // this variable will hold which coefficient we're dealing with double this_coeff; double this_chisquared; char *token; double coeffs [polynomial_order+1]; memset(coeffs, 0, sizeof(double)*(polynomial_order+1)); while(!feof(dispersion_solutions_f)) { memset(input_string, '\0', sizeof(char)*500); fgets(input_string, 500, dispersion_solutions_f); token_index = 0; coeff_index = 0; if (strtol(&input_string[0], NULL, 0) > 0) { // check the line begins with a positive number // *********************************************************************** // String tokenisation loop: // // 1. init calls strtok() loading the function with input_string // 2. terminate when token is null // 3. we keep assigning tokens of input_string to token until termination by calling strtok with a NULL first argument // // n.b. searching for tab or newline separators ('\t' and '\n') for (token=strtok(input_string, "\t\n"); token !=NULL; token = strtok(NULL, "\t\n")) { if (token_index == 0) { } else if ((token_index >= 1) && (token_index <= polynomial_order+1)) { // coeff token this_coeff = strtod(token, NULL); // printf("%d\t%e\n", coeff_index, this_coeff); // DEBUG coeffs[coeff_index] = this_coeff; coeff_index++; } else if (token_index == polynomial_order+2) { // chisquared token this_chisquared = strtod(token, NULL); //printf("%f\n", this_chisquared); // DEBUG } token_index++; } } } // *********************************************************************** // Find wavelength extremities from [LOARCFIT_OUTPUTF_WAVFITS_FILE] file // and ensure the input constraints [start_wav] (ARG 2) and [end_wav] // (ARG 3) don't lie outside these boundaries double smallest_wav, largest_wav; int ii; for (ii=0; ii<=polynomial_order; ii++) { smallest_wav += coeffs[ii]*pow(0+INDEXING_CORRECTION, ii); largest_wav += coeffs[ii]*pow((cut_x[1]-1)+INDEXING_CORRECTION, ii); } // *********************************************************************** // Need to find pixel indexes for starting/ending wavelength positions double this_element_wav; int first_element_index, last_element_index; int jj; for (ii=0; ii<nxelements; ii++) { this_element_wav = 0.0; for (jj=0; jj<=polynomial_order; jj++) { this_element_wav += coeffs[jj]*pow(ii,jj); } if (this_element_wav >= start_wav) { // the current index, ii, represents the first pixel with a wavelength >= start_wav. Comparing doubles but accuracy isn't a necessity so don't need gsl_fcmp function break; } first_element_index = ii; } // printf("%d\t%f\n", ii, this_element_wav); // DEBUG for (ii=nxelements; ii>=0; ii--) { this_element_wav = 0.0; for (jj=0; jj<=polynomial_order; jj++) { this_element_wav += coeffs[jj]*pow(ii,jj); } if (this_element_wav <= end_wav) { // the current index, ii, represents the first pixel with a wavelength <= end_wav. Comparing doubles but accuracy isn't a necessity so don't need gsl_fcmp function break; } last_element_index = ii; } // printf("%d\t%f\n", ii, this_element_wav); // DEBUG printf("\nWavelength boundaries"); printf("\n---------------------\n"); printf("\nInherent minimum wavelength:\t%.2f Å", smallest_wav); printf("\nInherent maximum wavelength:\t%.2f Å\n", largest_wav); if (start_wav < smallest_wav) { // Comparing doubles but accuracy isn't a necessity so don't need gsl_fcmp function write_key_to_file(ERROR_CODES_FILE, REF_ERROR_CODES_FILE, "L2STATRE", -7, "Status flag for L2 lorebin routine", ERROR_CODES_FILE_WRITE_ACCESS); free(input_f); free(interpolation_type); free(output_f); fclose(dispersion_solutions_f); if(fits_close_file(input_f_ptr, &input_f_status)) fits_report_error (stdout, input_f_status); return 1; } else if (end_wav > largest_wav) { // Comparing doubles but accuracy isn't a necessity so don't need gsl_fcmp function write_key_to_file(ERROR_CODES_FILE, REF_ERROR_CODES_FILE, "L2STATRE", -8, "Status flag for L2 lorebin routine", ERROR_CODES_FILE_WRITE_ACCESS); free(input_f); free(interpolation_type); free(output_f); fclose(dispersion_solutions_f); if(fits_close_file(input_f_ptr, &input_f_status)) fits_report_error (stdout, input_f_status); return 1; } // *********************************************************************** // Set the bin wavelengths int num_bins = 0; if (!gsl_fcmp((end_wav-start_wav)/dispersion, rint((end_wav-start_wav)/dispersion), 1e-5)) { // check to see if nearest integer is within tolerance value num_bins = rint((end_wav-start_wav)/dispersion) + 1; // if TRUE, round } else { num_bins = floor((end_wav-start_wav)/dispersion) + 1; // if FALSE, floor } // printf("%d\n", num_bins); // DEBUG double bin_wavelengths [num_bins]; memset(bin_wavelengths, 0, sizeof(double)*num_bins); for (ii=0; ii<num_bins; ii++) { bin_wavelengths[ii] = start_wav + dispersion*ii; // printf("%f\n", bin_wavelengths[ii]); // DEBUG } // printf("%f\t%f\n", bin_wavelengths[0], bin_wavelengths[num_bins-1]); // DEBUG // REBIN INPUT FRAME (ARG 1) AND CONSERVE FLUX IF APPLICABLE // *********************************************************************** // 1. Open input frame int this_row_index; double x_wav [nxelements]; double output_frame_values [nyelements][num_bins]; memset(output_frame_values, 0, sizeof(double)*nyelements*num_bins); double output_f_pixels [num_bins]; memset(output_f_pixels, 0, sizeof(double)*(num_bins)); double this_pre_rebin_row_flux, this_post_rebin_row_flux; double conservation_factor; for (fpixel[1] = cut_y[0]; fpixel[1] <= cut_y[1]; fpixel[1]++) { this_row_index = fpixel[1] - 1; memset(input_f_pixels, 0, sizeof(double)*nxelements); if(!fits_read_pix(input_f_ptr, IMG_READ_ACCURACY, fpixel, nxelements, NULL, input_f_pixels, NULL, &input_f_status)) { // 2. Calculate pre-rebin total fluxes this_pre_rebin_row_flux = 0.0; for (ii=first_element_index; ii<=last_element_index; ii++) { this_pre_rebin_row_flux += input_f_pixels[ii]; } // 3. Create pixel-wavelength translation array and perform interpolation memset(x_wav, 0, sizeof(double)*nxelements); for (ii=0; ii<nxelements; ii++) { for (jj=0; jj<=polynomial_order; jj++) { x_wav[ii] += coeffs[jj]*pow(ii+INDEXING_CORRECTION,jj); } // printf("%d\t%f\n", ii, x_wav[ii]); // DEBUG } // for (ii=0; ii< nxelements; ii++) printf("\n%f\t%f", x_wav[ii], input_f_pixels[ii]); // DEBUG if (interpolate(interpolation_type, x_wav, input_f_pixels, nxelements, bin_wavelengths[0], bin_wavelengths[num_bins-1], dispersion, output_f_pixels)) { write_key_to_file(ERROR_CODES_FILE, REF_ERROR_CODES_FILE, "L2STATRE", -9, "Status flag for L2 lorebin routine", ERROR_CODES_FILE_WRITE_ACCESS); free(input_f); free(interpolation_type); free(output_f); fclose(dispersion_solutions_f); if(fits_close_file(input_f_ptr, &input_f_status)) fits_report_error (stdout, input_f_status); return 1; } // 4. Calculate post-rebin total fluxes this_post_rebin_row_flux = 0.0; for (ii=0; ii<num_bins; ii++) { this_post_rebin_row_flux += output_f_pixels[ii]; } // 5. Conserve flux if applicable conservation_factor = this_pre_rebin_row_flux/this_post_rebin_row_flux; // printf("%f\t%f\t%f\n", this_pre_rebin_row_flux, this_post_rebin_row_flux, conservation_factor); // DEBUG for (ii=0; ii<num_bins; ii++) { if (conserve_flux == TRUE) { output_frame_values[this_row_index][ii] = output_f_pixels[ii]*conservation_factor; } else { output_frame_values[this_row_index][ii] = output_f_pixels[ii]; } } } else { write_key_to_file(ERROR_CODES_FILE, REF_ERROR_CODES_FILE, "L2STATRE", -10, "Status flag for L2 lorebin routine", ERROR_CODES_FILE_WRITE_ACCESS); fits_report_error(stdout, input_f_status); free(input_f); free(interpolation_type); free(output_f); fclose(dispersion_solutions_f); if(fits_close_file(input_f_ptr, &input_f_status)) fits_report_error (stdout, input_f_status); return 1; } } // 6. Create [LOREBIN_OUTPUTF_REBIN_WAVFITS_FILE] output file and print // a few parameters FILE *outputfile; outputfile = fopen(LOREBIN_OUTPUTF_REBIN_WAVFITS_FILE, FILE_WRITE_ACCESS); if (!outputfile) { write_key_to_file(ERROR_CODES_FILE, REF_ERROR_CODES_FILE, "L2STATRE", -11, "Status flag for L2 frrebin routine", ERROR_CODES_FILE_WRITE_ACCESS); free(input_f); free(interpolation_type); free(output_f); fclose(dispersion_solutions_f); if(fits_close_file(input_f_ptr, &input_f_status)) fits_report_error (stdout, input_f_status); return 1; } char timestr [80]; memset(timestr, '\0', sizeof(char)*80); find_time(timestr); fprintf(outputfile, "#### %s ####\n\n", LOREBIN_OUTPUTF_REBIN_WAVFITS_FILE); fprintf(outputfile, "# Rebinning wavelength fit parameters.\n\n"); fprintf(outputfile, "# Run Datetime:\t\t%s\n\n", timestr); fprintf(outputfile, "# Target Filename:\t%s\n\n", input_f); fprintf(outputfile, "# Starting Wavelength:\t%.2f\n", bin_wavelengths[0]); fprintf(outputfile, "# Dispersion:\t\t%.2f\n", dispersion); fprintf(outputfile, "%d", EOF); // 7. Write these values to the [ADDITIONAL_KEYS_FILE] file write_additional_key_to_file_str(ADDITIONAL_KEYS_FILE, "LSS_CALIBRATION", "CTYPE1", "Wavelength", "Type of co-ordinate on axis 1", ADDITIONAL_KEYS_FILE_WRITE_ACCESS); write_additional_key_to_file_str(ADDITIONAL_KEYS_FILE, "LSS_CALIBRATION", "CUNIT1", "Angstroms", "Units for axis 1", ADDITIONAL_KEYS_FILE_WRITE_ACCESS); write_additional_key_to_file_dbl(ADDITIONAL_KEYS_FILE, "LSS_CALIBRATION", "CRVAL1", bin_wavelengths[0], "[pixel] Value at ref. pixel on axis 1", ADDITIONAL_KEYS_FILE_WRITE_ACCESS); write_additional_key_to_file_dbl(ADDITIONAL_KEYS_FILE, "LSS_CALIBRATION", "CDELT1", dispersion, "[pixel] Pixel scale on axis 1", ADDITIONAL_KEYS_FILE_WRITE_ACCESS); write_additional_key_to_file_dbl(ADDITIONAL_KEYS_FILE, "LSS_CALIBRATION", "CRPIX1", 1.0, "[pixel] Reference pixel on axis 1", ADDITIONAL_KEYS_FILE_WRITE_ACCESS); write_additional_key_to_file_str(ADDITIONAL_KEYS_FILE, "LSS_CALIBRATION", "CTYPE2", "a2", "Type of co-ordinate on axis 2", ADDITIONAL_KEYS_FILE_WRITE_ACCESS); write_additional_key_to_file_str(ADDITIONAL_KEYS_FILE, "LSS_CALIBRATION", "CUNIT2", "Pixels", "Units for axis 2", ADDITIONAL_KEYS_FILE_WRITE_ACCESS); write_additional_key_to_file_dbl(ADDITIONAL_KEYS_FILE, "LSS_CALIBRATION", "CRVAL2", 1, "[pixel] Value at ref. pixel on axis 2", ADDITIONAL_KEYS_FILE_WRITE_ACCESS); write_additional_key_to_file_dbl(ADDITIONAL_KEYS_FILE, "LSS_CALIBRATION", "CDELT2", 1, "[pixel] Pixel scale on axis 2", ADDITIONAL_KEYS_FILE_WRITE_ACCESS); write_additional_key_to_file_dbl(ADDITIONAL_KEYS_FILE, "LSS_CALIBRATION", "CRPIX2", 1, "[pixel] Reference pixel on axis 2", ADDITIONAL_KEYS_FILE_WRITE_ACCESS); write_additional_key_to_file_str(ADDITIONAL_KEYS_FILE, "SPEC_CALIBRATION", "CTYPE1", "Wavelength", "Type of co-ordinate on axis 1", ADDITIONAL_KEYS_FILE_WRITE_ACCESS); write_additional_key_to_file_str(ADDITIONAL_KEYS_FILE, "SPEC_CALIBRATION", "CUNIT1", "Angstroms", "Units for axis 1", ADDITIONAL_KEYS_FILE_WRITE_ACCESS); write_additional_key_to_file_dbl(ADDITIONAL_KEYS_FILE, "SPEC_CALIBRATION", "CRVAL1", bin_wavelengths[0], "[pixel] Value at ref. pixel on axis 1", ADDITIONAL_KEYS_FILE_WRITE_ACCESS); write_additional_key_to_file_dbl(ADDITIONAL_KEYS_FILE, "SPEC_CALIBRATION", "CDELT1", dispersion, "[pixel] Pixel scale on axis 1", ADDITIONAL_KEYS_FILE_WRITE_ACCESS); write_additional_key_to_file_dbl(ADDITIONAL_KEYS_FILE, "SPEC_CALIBRATION", "CRPIX1", 1.0, "[pixel] Reference pixel on axis 1", ADDITIONAL_KEYS_FILE_WRITE_ACCESS); write_additional_key_to_file_str(ADDITIONAL_KEYS_FILE, "SPEC_CALIBRATION", "CTYPE2", "a2", "Type of co-ordinate on axis 2", ADDITIONAL_KEYS_FILE_WRITE_ACCESS); write_additional_key_to_file_str(ADDITIONAL_KEYS_FILE, "SPEC_CALIBRATION", "CUNIT2", "Pixels", "Units for axis 2", ADDITIONAL_KEYS_FILE_WRITE_ACCESS); write_additional_key_to_file_dbl(ADDITIONAL_KEYS_FILE, "SPEC_CALIBRATION", "CRVAL2", 1, "[pixel] Value at ref. pixel on axis 2", ADDITIONAL_KEYS_FILE_WRITE_ACCESS); write_additional_key_to_file_dbl(ADDITIONAL_KEYS_FILE, "SPEC_CALIBRATION", "CDELT2", 1, "[pixel] Pixel scale on axis 2", ADDITIONAL_KEYS_FILE_WRITE_ACCESS); write_additional_key_to_file_dbl(ADDITIONAL_KEYS_FILE, "SPEC_CALIBRATION", "CRPIX2", 1, "[pixel] Reference pixel on axis 2", ADDITIONAL_KEYS_FILE_WRITE_ACCESS); // *********************************************************************** // Set output frame parameters fitsfile *output_f_ptr; int output_f_status = 0; long output_f_naxes [2] = {num_bins,nyelements}; long output_f_fpixel = 1; // *********************************************************************** // Create [output_frame_values_1D] array to hold the output data in the // correct format double output_frame_values_1D [num_bins*nyelements]; memset(output_frame_values_1D, 0, sizeof(double)*num_bins*nyelements); int kk; for (ii=0; ii<nyelements; ii++) { jj = ii * num_bins; for (kk=0; kk<num_bins; kk++) { output_frame_values_1D[jj] = output_frame_values[ii][kk]; jj++; } } // *********************************************************************** // Create and write [output_frame_values_1D] to output file (ARG 5) if (!fits_create_file(&output_f_ptr, output_f, &output_f_status)) { if (!fits_create_img(output_f_ptr, INTERMEDIATE_IMG_ACCURACY[0], 2, output_f_naxes, &output_f_status)) { if (!fits_write_img(output_f_ptr, INTERMEDIATE_IMG_ACCURACY[1], output_f_fpixel, num_bins * nyelements, output_frame_values_1D, &output_f_status)) { } else { write_key_to_file(ERROR_CODES_FILE, REF_ERROR_CODES_FILE, "L2STATRE", -12, "Status flag for L2 lorebin routine", ERROR_CODES_FILE_WRITE_ACCESS); fits_report_error(stdout, output_f_status); free(input_f); free(interpolation_type); free(output_f); fclose(dispersion_solutions_f); fclose(outputfile); if(fits_close_file(input_f_ptr, &input_f_status)) fits_report_error (stdout, input_f_status); if(fits_close_file(output_f_ptr, &output_f_status)); return 1; } } else { write_key_to_file(ERROR_CODES_FILE, REF_ERROR_CODES_FILE, "L2STATRE", -13, "Status flag for L2 lorebin routine", ERROR_CODES_FILE_WRITE_ACCESS); fits_report_error(stdout, output_f_status); free(input_f); free(interpolation_type); free(output_f); fclose(dispersion_solutions_f); fclose(outputfile); if(fits_close_file(input_f_ptr, &input_f_status)) fits_report_error (stdout, input_f_status); if(fits_close_file(output_f_ptr, &output_f_status)); return 1; } } else { write_key_to_file(ERROR_CODES_FILE, REF_ERROR_CODES_FILE, "L2STATRE", -14, "Status flag for L2 lorebin routine", ERROR_CODES_FILE_WRITE_ACCESS); fits_report_error(stdout, output_f_status); free(input_f); free(interpolation_type); free(output_f); fclose(dispersion_solutions_f); fclose(outputfile); if(fits_close_file(input_f_ptr, &input_f_status)) fits_report_error (stdout, input_f_status); return 1; } // *********************************************************************** // Clean up heap memory free(input_f); free(interpolation_type); free(output_f); // *********************************************************************** // Close input file (ARG 1), output file (ARG 7) and // [FRARCFIT_OUTPUTF_WAVFITS_FILE] file if (fclose(dispersion_solutions_f)) { write_key_to_file(ERROR_CODES_FILE, REF_ERROR_CODES_FILE, "L2STATRE", -15, "Status flag for L2 lorebin routine", ERROR_CODES_FILE_WRITE_ACCESS); fclose(outputfile); if(fits_close_file(input_f_ptr, &input_f_status)) fits_report_error (stdout, input_f_status); if(fits_close_file(output_f_ptr, &output_f_status)); return 1; } if (fclose(outputfile)) { write_key_to_file(ERROR_CODES_FILE, REF_ERROR_CODES_FILE, "L2STATRE", -16, "Status flag for L2 lorebin routine", ERROR_CODES_FILE_WRITE_ACCESS); if(fits_close_file(input_f_ptr, &input_f_status)) fits_report_error (stdout, input_f_status); if(fits_close_file(output_f_ptr, &output_f_status)); return 1; } if(fits_close_file(input_f_ptr, &input_f_status)) { write_key_to_file(ERROR_CODES_FILE, REF_ERROR_CODES_FILE, "L2STATRE", -17, "Status flag for L2 lorebin routine", ERROR_CODES_FILE_WRITE_ACCESS); fits_report_error (stdout, input_f_status); if(fits_close_file(output_f_ptr, &output_f_status)); return 1; } if(fits_close_file(output_f_ptr, &output_f_status)) { write_key_to_file(ERROR_CODES_FILE, REF_ERROR_CODES_FILE, "L2STATRE", -18, "Status flag for L2 lorebin routine", ERROR_CODES_FILE_WRITE_ACCESS); fits_report_error (stdout, output_f_status); return 1; } // *********************************************************************** // Write success to [ERROR_CODES_FILE] write_key_to_file(ERROR_CODES_FILE, REF_ERROR_CODES_FILE, "L2STATRE", RETURN_FLAG, "Status flag for L2 lorebin routine", ERROR_CODES_FILE_WRITE_ACCESS); return 0; } }
/* Compares real parts of a and b and returns nonzero if they are not * approximately equal and Re(a) < Re(b); otherwise returns Im(a) < Im(b). */ static INLINE_DECL int complex_less(gsl_complex a, gsl_complex b) { return gsl_fcmp(GSL_REAL(a), GSL_REAL(b), GSL_DBL_EPSILON) == 0 ? GSL_IMAG(a) < GSL_IMAG(b) : GSL_REAL(a) < GSL_REAL(b); }
int main (void) { double y, y_expected; int e, e_expected; gsl_ieee_env_setup (); /* Test for expm1 */ y = gsl_expm1 (0.0); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(0.0)"); y = gsl_expm1 (1e-10); y_expected = 1.000000000050000000002e-10; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(1e-10)"); y = gsl_expm1 (-1e-10); y_expected = -9.999999999500000000017e-11; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(-1e-10)"); y = gsl_expm1 (0.1); y_expected = 0.1051709180756476248117078264902; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(0.1)"); y = gsl_expm1 (-0.1); y_expected = -0.09516258196404042683575094055356; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(-0.1)"); y = gsl_expm1 (10.0); y_expected = 22025.465794806716516957900645284; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(10.0)"); y = gsl_expm1 (-10.0); y_expected = -0.99995460007023751514846440848444; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(-10.0)"); /* Test for log1p */ y = gsl_log1p (0.0); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_log1p(0.0)"); y = gsl_log1p (1e-10); y_expected = 9.9999999995000000000333333333308e-11; gsl_test_rel (y, y_expected, 1e-15, "gsl_log1p(1e-10)"); y = gsl_log1p (0.1); y_expected = 0.095310179804324860043952123280765; gsl_test_rel (y, y_expected, 1e-15, "gsl_log1p(0.1)"); y = gsl_log1p (10.0); y_expected = 2.3978952727983705440619435779651; gsl_test_rel (y, y_expected, 1e-15, "gsl_log1p(10.0)"); /* Test for gsl_hypot */ y = gsl_hypot (0.0, 0.0); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(0.0, 0.0)"); y = gsl_hypot (1e-10, 1e-10); y_expected = 1.414213562373095048801688e-10; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e-10, 1e-10)"); y = gsl_hypot (1e-38, 1e-38); y_expected = 1.414213562373095048801688e-38; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e-38, 1e-38)"); y = gsl_hypot (1e-10, -1.0); y_expected = 1.000000000000000000005; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e-10, -1)"); y = gsl_hypot (-1.0, 1e-10); y_expected = 1.000000000000000000005; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(-1, 1e-10)"); y = gsl_hypot (1e307, 1e301); y_expected = 1.000000000000499999999999e307; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e307, 1e301)"); y = gsl_hypot (1e301, 1e307); y_expected = 1.000000000000499999999999e307; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e301, 1e307)"); y = gsl_hypot (1e307, 1e307); y_expected = 1.414213562373095048801688e307; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e307, 1e307)"); /* Test for acosh */ y = gsl_acosh (1.0); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_acosh(1.0)"); y = gsl_acosh (1.1); y_expected = 4.435682543851151891329110663525e-1; gsl_test_rel (y, y_expected, 1e-15, "gsl_acosh(1.1)"); y = gsl_acosh (10.0); y_expected = 2.9932228461263808979126677137742e0; gsl_test_rel (y, y_expected, 1e-15, "gsl_acosh(10.0)"); y = gsl_acosh (1e10); y_expected = 2.3718998110500402149594646668302e1; gsl_test_rel (y, y_expected, 1e-15, "gsl_acosh(1e10)"); /* Test for asinh */ y = gsl_asinh (0.0); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(0.0)"); y = gsl_asinh (1e-10); y_expected = 9.9999999999999999999833333333346e-11; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(1e-10)"); y = gsl_asinh (-1e-10); y_expected = -9.9999999999999999999833333333346e-11; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(1e-10)"); y = gsl_asinh (0.1); y_expected = 9.983407889920756332730312470477e-2; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(0.1)"); y = gsl_asinh (-0.1); y_expected = -9.983407889920756332730312470477e-2; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(-0.1)"); y = gsl_asinh (1.0); y_expected = 8.8137358701954302523260932497979e-1; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(1.0)"); y = gsl_asinh (-1.0); y_expected = -8.8137358701954302523260932497979e-1; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(-1.0)"); y = gsl_asinh (10.0); y_expected = 2.9982229502979697388465955375965e0; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(10)"); y = gsl_asinh (-10.0); y_expected = -2.9982229502979697388465955375965e0; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(-10)"); y = gsl_asinh (1e10); y_expected = 2.3718998110500402149599646668302e1; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(1e10)"); y = gsl_asinh (-1e10); y_expected = -2.3718998110500402149599646668302e1; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(-1e10)"); /* Test for atanh */ y = gsl_atanh (0.0); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(0.0)"); y = gsl_atanh (1e-20); y_expected = 1e-20; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(1e-20)"); y = gsl_atanh (-1e-20); y_expected = -1e-20; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(-1e-20)"); y = gsl_atanh (0.1); y_expected = 1.0033534773107558063572655206004e-1; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(0.1)"); y = gsl_atanh (-0.1); y_expected = -1.0033534773107558063572655206004e-1; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(-0.1)"); y = gsl_atanh (0.9); y_expected = 1.4722194895832202300045137159439e0; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(0.9)"); y = gsl_atanh (-0.9); y_expected = -1.4722194895832202300045137159439e0; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(0.9)"); /* Test for pow_int */ y = gsl_pow_2 (-3.14); y_expected = pow (-3.14, 2.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_2(-3.14)"); y = gsl_pow_3 (-3.14); y_expected = pow (-3.14, 3.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_3(-3.14)"); y = gsl_pow_4 (-3.14); y_expected = pow (-3.14, 4.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_4(-3.14)"); y = gsl_pow_5 (-3.14); y_expected = pow (-3.14, 5.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_5(-3.14)"); y = gsl_pow_6 (-3.14); y_expected = pow (-3.14, 6.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_6(-3.14)"); y = gsl_pow_7 (-3.14); y_expected = pow (-3.14, 7.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_7(-3.14)"); y = gsl_pow_8 (-3.14); y_expected = pow (-3.14, 8.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_8(-3.14)"); y = gsl_pow_9 (-3.14); y_expected = pow (-3.14, 9.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_9(-3.14)"); { int n; for (n = -9; n < 10; n++) { y = gsl_pow_int (-3.14, n); y_expected = pow (-3.14, n); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_n(-3.14,%d)", n); } } /* Test for ldexp */ y = gsl_ldexp (M_PI, -2); y_expected = M_PI_4; gsl_test_rel (y, y_expected, 1e-15, "gsl_ldexp(pi,-2)"); y = gsl_ldexp (1.0, 2); y_expected = 4.000000; gsl_test_rel (y, y_expected, 1e-15, "gsl_ldexp(1.0,2)"); y = gsl_ldexp (0.0, 2); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_ldexp(0.0,2)"); /* Test for frexp */ y = gsl_frexp (M_PI, &e); y_expected = M_PI_4; e_expected = 2; gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(pi) fraction"); gsl_test_int (e, e_expected, "gsl_frexp(pi) exponent"); y = gsl_frexp (2.0, &e); y_expected = 0.5; e_expected = 2; gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(2.0) fraction"); gsl_test_int (e, e_expected, "gsl_frexp(2.0) exponent"); y = gsl_frexp (1.0 / 4.0, &e); y_expected = 0.5; e_expected = -1; gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(0.25) fraction"); gsl_test_int (e, e_expected, "gsl_frexp(0.25) exponent"); y = gsl_frexp (1.0 / 4.0 - 4.0 * GSL_DBL_EPSILON, &e); y_expected = 0.999999999999996447; e_expected = -2; gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(0.25-eps) fraction"); gsl_test_int (e, e_expected, "gsl_frexp(0.25-eps) exponent"); /* Test for approximate floating point comparison */ { double x, y; int i; x = M_PI; y = 22.0 / 7.0; /* test the basic function */ for (i = 0; i < 10; i++) { double tol = pow (10, -i); int res = gsl_fcmp (x, y, tol); gsl_test_int (res, -(i >= 4), "gsl_fcmp(%.5f,%.5f,%g)", x, y, tol); } for (i = 0; i < 10; i++) { double tol = pow (10, -i); int res = gsl_fcmp (y, x, tol); gsl_test_int (res, (i >= 4), "gsl_fcmp(%.5f,%.5f,%g)", y, x, tol); } } #if HAVE_IEEE_COMPARISONS /* Test for isinf, isnan, finite */ { double zero, one, inf, nan; int s; zero = 0.0; one = 1.0; inf = exp (1.0e10); nan = inf / inf; s = gsl_isinf (zero); gsl_test_int (s, 0, "gsl_isinf(0)"); s = gsl_isinf (one); gsl_test_int (s, 0, "gsl_isinf(1)"); s = gsl_isinf (inf); gsl_test_int (s, 1, "gsl_isinf(inf)"); s = gsl_isinf (-inf); gsl_test_int (s, -1, "gsl_isinf(-inf)"); s = gsl_isinf (nan); gsl_test_int (s, 0, "gsl_isinf(nan)"); s = gsl_isnan (zero); gsl_test_int (s, 0, "gsl_isnan(0)"); s = gsl_isnan (one); gsl_test_int (s, 0, "gsl_isnan(1)"); s = gsl_isnan (inf); gsl_test_int (s, 0, "gsl_isnan(inf)"); s = gsl_isnan (nan); gsl_test_int (s, 1, "gsl_isnan(nan)"); s = gsl_finite (zero); gsl_test_int (s, 1, "gsl_finite(0)"); s = gsl_finite (one); gsl_test_int (s, 1, "gsl_finite(1)"); s = gsl_finite (inf); gsl_test_int (s, 0, "gsl_finite(inf)"); s = gsl_finite (nan); gsl_test_int (s, 0, "gsl_finite(nan)"); } #endif { double x = gsl_fdiv (2.0, 3.0); gsl_test_rel (x, 2.0 / 3.0, 4 * GSL_DBL_EPSILON, "gsl_fdiv(2,3)"); } exit (gsl_test_summary ()); }
bool approximatelyEqual(REAL8 a, REAL8 b, REAL8 epsilon) { return !gsl_fcmp(a, b, epsilon); // gsl_fcmp() returns 0 if the numbers a, b are approximately equal to a relative accuracy epsilon. }
int main (void) { double y, y_expected; int e, e_expected; gsl_ieee_env_setup (); /* Test for expm1 */ y = gsl_expm1 (0.0); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(0.0)"); y = gsl_expm1 (1e-10); y_expected = 1.000000000050000000002e-10; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(1e-10)"); y = gsl_expm1 (-1e-10); y_expected = -9.999999999500000000017e-11; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(-1e-10)"); y = gsl_expm1 (0.1); y_expected = 0.1051709180756476248117078264902; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(0.1)"); y = gsl_expm1 (-0.1); y_expected = -0.09516258196404042683575094055356; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(-0.1)"); y = gsl_expm1 (10.0); y_expected = 22025.465794806716516957900645284; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(10.0)"); y = gsl_expm1 (-10.0); y_expected = -0.99995460007023751514846440848444; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(-10.0)"); /* Test for log1p */ y = gsl_log1p (0.0); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_log1p(0.0)"); y = gsl_log1p (1e-10); y_expected = 9.9999999995000000000333333333308e-11; gsl_test_rel (y, y_expected, 1e-15, "gsl_log1p(1e-10)"); y = gsl_log1p (0.1); y_expected = 0.095310179804324860043952123280765; gsl_test_rel (y, y_expected, 1e-15, "gsl_log1p(0.1)"); y = gsl_log1p (10.0); y_expected = 2.3978952727983705440619435779651; gsl_test_rel (y, y_expected, 1e-15, "gsl_log1p(10.0)"); /* Test for gsl_hypot */ y = gsl_hypot (0.0, 0.0); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(0.0, 0.0)"); y = gsl_hypot (1e-10, 1e-10); y_expected = 1.414213562373095048801688e-10; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e-10, 1e-10)"); y = gsl_hypot (1e-38, 1e-38); y_expected = 1.414213562373095048801688e-38; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e-38, 1e-38)"); y = gsl_hypot (1e-10, -1.0); y_expected = 1.000000000000000000005; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e-10, -1)"); y = gsl_hypot (-1.0, 1e-10); y_expected = 1.000000000000000000005; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(-1, 1e-10)"); y = gsl_hypot (1e307, 1e301); y_expected = 1.000000000000499999999999e307; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e307, 1e301)"); y = gsl_hypot (1e301, 1e307); y_expected = 1.000000000000499999999999e307; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e301, 1e307)"); y = gsl_hypot (1e307, 1e307); y_expected = 1.414213562373095048801688e307; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e307, 1e307)"); /* Test +-Inf, finite */ y = gsl_hypot (GSL_POSINF, 1.2); y_expected = GSL_POSINF; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(GSL_POSINF, 1.2)"); y = gsl_hypot (GSL_NEGINF, 1.2); y_expected = GSL_POSINF; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(GSL_NEGINF, 1.2)"); y = gsl_hypot (1.2, GSL_POSINF); y_expected = GSL_POSINF; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1.2, GSL_POSINF)"); y = gsl_hypot (1.2, GSL_NEGINF); y_expected = GSL_POSINF; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1.2, GSL_NEGINF)"); /* Test NaN, finite */ y = gsl_hypot (GSL_NAN, 1.2); y_expected = GSL_NAN; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(GSL_NAN, 1.2)"); y = gsl_hypot (1.2, GSL_NAN); y_expected = GSL_NAN; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1.2, GSL_NAN)"); /* Test NaN, NaN */ y = gsl_hypot (GSL_NAN, GSL_NAN); y_expected = GSL_NAN; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(GSL_NAN, GSL_NAN)"); /* Test +Inf, NaN */ y = gsl_hypot (GSL_POSINF, GSL_NAN); y_expected = GSL_POSINF; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(GSL_POSINF, GSL_NAN)"); /* Test -Inf, NaN */ y = gsl_hypot (GSL_NEGINF, GSL_NAN); y_expected = GSL_POSINF; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(GSL_NEGINF, GSL_NAN)"); /* Test NaN, +Inf */ y = gsl_hypot (GSL_NAN, GSL_POSINF); y_expected = GSL_POSINF; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(GSL_NAN, GSL_POSINF)"); /* Test NaN, -Inf */ y = gsl_hypot (GSL_NAN, GSL_NEGINF); y_expected = GSL_POSINF; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(GSL_NAN, GSL_NEGINF)"); /* Test for gsl_hypot3 */ y = gsl_hypot3 (0.0, 0.0, 0.0); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot3(0.0, 0.0, 0.0)"); y = gsl_hypot3 (1e-10, 1e-10, 1e-10); y_expected = 1.732050807568877293527446e-10; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot3(1e-10, 1e-10, 1e-10)"); y = gsl_hypot3 (1e-38, 1e-38, 1e-38); y_expected = 1.732050807568877293527446e-38; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot3(1e-38, 1e-38, 1e-38)"); y = gsl_hypot3 (1e-10, 1e-10, -1.0); y_expected = 1.000000000000000000099; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot3(1e-10, 1e-10, -1)"); y = gsl_hypot3 (1e-10, -1.0, 1e-10); y_expected = 1.000000000000000000099; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot3(1e-10, -1, 1e-10)"); y = gsl_hypot3 (-1.0, 1e-10, 1e-10); y_expected = 1.000000000000000000099; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot3(-1, 1e-10, 1e-10)"); y = gsl_hypot3 (1e307, 1e301, 1e301); y_expected = 1.0000000000009999999999995e307; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot3(1e307, 1e301, 1e301)"); y = gsl_hypot3 (1e307, 1e307, 1e307); y_expected = 1.732050807568877293527446e307; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot3(1e307, 1e307, 1e307)"); y = gsl_hypot3 (1e307, 1e-307, 1e-307); y_expected = 1.0e307; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot3(1e307, 1e-307, 1e-307)"); /* Test for acosh */ y = gsl_acosh (1.0); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_acosh(1.0)"); y = gsl_acosh (1.1); y_expected = 4.435682543851151891329110663525e-1; gsl_test_rel (y, y_expected, 1e-15, "gsl_acosh(1.1)"); y = gsl_acosh (10.0); y_expected = 2.9932228461263808979126677137742e0; gsl_test_rel (y, y_expected, 1e-15, "gsl_acosh(10.0)"); y = gsl_acosh (1e10); y_expected = 2.3718998110500402149594646668302e1; gsl_test_rel (y, y_expected, 1e-15, "gsl_acosh(1e10)"); /* Test for asinh */ y = gsl_asinh (0.0); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(0.0)"); y = gsl_asinh (1e-10); y_expected = 9.9999999999999999999833333333346e-11; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(1e-10)"); y = gsl_asinh (-1e-10); y_expected = -9.9999999999999999999833333333346e-11; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(1e-10)"); y = gsl_asinh (0.1); y_expected = 9.983407889920756332730312470477e-2; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(0.1)"); y = gsl_asinh (-0.1); y_expected = -9.983407889920756332730312470477e-2; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(-0.1)"); y = gsl_asinh (1.0); y_expected = 8.8137358701954302523260932497979e-1; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(1.0)"); y = gsl_asinh (-1.0); y_expected = -8.8137358701954302523260932497979e-1; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(-1.0)"); y = gsl_asinh (10.0); y_expected = 2.9982229502979697388465955375965e0; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(10)"); y = gsl_asinh (-10.0); y_expected = -2.9982229502979697388465955375965e0; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(-10)"); y = gsl_asinh (1e10); y_expected = 2.3718998110500402149599646668302e1; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(1e10)"); y = gsl_asinh (-1e10); y_expected = -2.3718998110500402149599646668302e1; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(-1e10)"); /* Test for atanh */ y = gsl_atanh (0.0); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(0.0)"); y = gsl_atanh (1e-20); y_expected = 1e-20; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(1e-20)"); y = gsl_atanh (-1e-20); y_expected = -1e-20; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(-1e-20)"); y = gsl_atanh (0.1); y_expected = 1.0033534773107558063572655206004e-1; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(0.1)"); y = gsl_atanh (-0.1); y_expected = -1.0033534773107558063572655206004e-1; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(-0.1)"); y = gsl_atanh (0.9); y_expected = 1.4722194895832202300045137159439e0; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(0.9)"); y = gsl_atanh (-0.9); y_expected = -1.4722194895832202300045137159439e0; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(0.9)"); /* Test for pow_int */ y = gsl_pow_2 (-3.14); y_expected = pow (-3.14, 2.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_2(-3.14)"); y = gsl_pow_3 (-3.14); y_expected = pow (-3.14, 3.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_3(-3.14)"); y = gsl_pow_4 (-3.14); y_expected = pow (-3.14, 4.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_4(-3.14)"); y = gsl_pow_5 (-3.14); y_expected = pow (-3.14, 5.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_5(-3.14)"); y = gsl_pow_6 (-3.14); y_expected = pow (-3.14, 6.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_6(-3.14)"); y = gsl_pow_7 (-3.14); y_expected = pow (-3.14, 7.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_7(-3.14)"); y = gsl_pow_8 (-3.14); y_expected = pow (-3.14, 8.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_8(-3.14)"); y = gsl_pow_9 (-3.14); y_expected = pow (-3.14, 9.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_9(-3.14)"); { int n; for (n = -9; n < 10; n++) { y = gsl_pow_int (-3.14, n); y_expected = pow (-3.14, n); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_int(-3.14,%d)", n); } } { unsigned int n; for (n = 0; n < 10; n++) { y = gsl_pow_uint (-3.14, n); y_expected = pow (-3.14, n); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_uint(-3.14,%d)", n); } } /* Test case for n at INT_MAX, INT_MIN */ { double u = 1.0000001; int n = INT_MAX; y = gsl_pow_int (u, n); y_expected = pow (u, n); gsl_test_rel (y, y_expected, 1e-6, "gsl_pow_int(%.7f,%d)", u, n); n = INT_MIN; y = gsl_pow_int (u, n); y_expected = pow (u, n); gsl_test_rel (y, y_expected, 1e-6, "gsl_pow_int(%.7f,%d)", u, n); } /* Test for ldexp */ y = gsl_ldexp (M_PI, -2); y_expected = M_PI_4; gsl_test_rel (y, y_expected, 1e-15, "gsl_ldexp(pi,-2)"); y = gsl_ldexp (1.0, 2); y_expected = 4.000000; gsl_test_rel (y, y_expected, 1e-15, "gsl_ldexp(1.0,2)"); y = gsl_ldexp (0.0, 2); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_ldexp(0.0,2)"); y = gsl_ldexp (9.999999999999998890e-01, 1024); y_expected = GSL_DBL_MAX; gsl_test_rel (y, y_expected, 1e-15, "gsl_ldexp DBL_MAX"); y = gsl_ldexp (1e308, -2000); y_expected = 8.7098098162172166755761e-295; gsl_test_rel (y, y_expected, 1e-15, "gsl_ldexp(1e308,-2000)"); y = gsl_ldexp (GSL_DBL_MIN, 2000); y_expected = 2.554675596204441378334779940e294; gsl_test_rel (y, y_expected, 1e-15, "gsl_ldexp(DBL_MIN,2000)"); /* Test subnormals */ { int i = 0; volatile double x = GSL_DBL_MIN; y_expected = 2.554675596204441378334779940e294; x /= 2; while (x > 0) { i++ ; y = gsl_ldexp (x, 2000 + i); gsl_test_rel (y, y_expected, 1e-15, "gsl_ldexp(DBL_MIN/2**%d,%d)",i,2000+i); x /= 2; } } /* Test for frexp */ y = gsl_frexp (0.0, &e); y_expected = 0; e_expected = 0; gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(0) fraction"); gsl_test_int (e, e_expected, "gsl_frexp(0) exponent"); y = gsl_frexp (M_PI, &e); y_expected = M_PI_4; e_expected = 2; gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(pi) fraction"); gsl_test_int (e, e_expected, "gsl_frexp(pi) exponent"); y = gsl_frexp (2.0, &e); y_expected = 0.5; e_expected = 2; gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(2.0) fraction"); gsl_test_int (e, e_expected, "gsl_frexp(2.0) exponent"); y = gsl_frexp (1.0 / 4.0, &e); y_expected = 0.5; e_expected = -1; gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(0.25) fraction"); gsl_test_int (e, e_expected, "gsl_frexp(0.25) exponent"); y = gsl_frexp (1.0 / 4.0 - 4.0 * GSL_DBL_EPSILON, &e); y_expected = 0.999999999999996447; e_expected = -2; gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(0.25-eps) fraction"); gsl_test_int (e, e_expected, "gsl_frexp(0.25-eps) exponent"); y = gsl_frexp (GSL_DBL_MAX, &e); y_expected = 9.999999999999998890e-01; e_expected = 1024; gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(DBL_MAX) fraction"); gsl_test_int (e, e_expected, "gsl_frexp(DBL_MAX) exponent"); y = gsl_frexp (-GSL_DBL_MAX, &e); y_expected = -9.999999999999998890e-01; e_expected = 1024; gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(-DBL_MAX) fraction"); gsl_test_int (e, e_expected, "gsl_frexp(-DBL_MAX) exponent"); y = gsl_frexp (GSL_DBL_MIN, &e); y_expected = 0.5; e_expected = -1021; gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(DBL_MIN) fraction"); gsl_test_int (e, e_expected, "gsl_frexp(DBL_MIN) exponent"); y = gsl_frexp (-GSL_DBL_MIN, &e); y_expected = -0.5; e_expected = -1021; gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(-DBL_MIN) fraction"); gsl_test_int (e, e_expected, "gsl_frexp(-DBL_MIN) exponent"); /* Test subnormals */ { int i = 0; volatile double x = GSL_DBL_MIN; y_expected = 0.5; e_expected = -1021; x /= 2; while (x > 0) { e_expected--; i++ ; y = gsl_frexp (x, &e); gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(DBL_MIN/2**%d) fraction",i); gsl_test_int (e, e_expected, "gsl_frexp(DBL_MIN/2**%d) exponent", i); x /= 2; } } /* Test for approximate floating point comparison */ { double x, y; int i; x = M_PI; y = 22.0 / 7.0; /* test the basic function */ for (i = 0; i < 10; i++) { double tol = pow (10, -i); int res = gsl_fcmp (x, y, tol); gsl_test_int (res, -(i >= 4), "gsl_fcmp(%.5f,%.5f,%g)", x, y, tol); } for (i = 0; i < 10; i++) { double tol = pow (10, -i); int res = gsl_fcmp (y, x, tol); gsl_test_int (res, (i >= 4), "gsl_fcmp(%.5f,%.5f,%g)", y, x, tol); } } #if HAVE_IEEE_COMPARISONS /* Test for isinf, isnan, finite */ { double zero, one, inf, nan; int s; zero = 0.0; one = 1.0; inf = exp (1.0e10); nan = inf / inf; s = gsl_isinf (zero); gsl_test_int (s, 0, "gsl_isinf(0)"); s = gsl_isinf (one); gsl_test_int (s, 0, "gsl_isinf(1)"); s = gsl_isinf (inf); gsl_test_int (s, 1, "gsl_isinf(inf)"); s = gsl_isinf (-inf); gsl_test_int (s, -1, "gsl_isinf(-inf)"); s = gsl_isinf (nan); gsl_test_int (s, 0, "gsl_isinf(nan)"); s = gsl_isnan (zero); gsl_test_int (s, 0, "gsl_isnan(0)"); s = gsl_isnan (one); gsl_test_int (s, 0, "gsl_isnan(1)"); s = gsl_isnan (inf); gsl_test_int (s, 0, "gsl_isnan(inf)"); s = gsl_isnan (-inf); gsl_test_int (s, 0, "gsl_isnan(-inf)"); s = gsl_isnan (nan); gsl_test_int (s, 1, "gsl_isnan(nan)"); s = gsl_finite (zero); gsl_test_int (s, 1, "gsl_finite(0)"); s = gsl_finite (one); gsl_test_int (s, 1, "gsl_finite(1)"); s = gsl_finite (inf); gsl_test_int (s, 0, "gsl_finite(inf)"); s = gsl_finite (-inf); gsl_test_int (s, 0, "gsl_finite(-inf)"); s = gsl_finite (nan); gsl_test_int (s, 0, "gsl_finite(nan)"); } #endif { double x = gsl_fdiv (2.0, 3.0); gsl_test_rel (x, 2.0 / 3.0, 4 * GSL_DBL_EPSILON, "gsl_fdiv(2,3)"); } /* Test constants in gsl_math.h */ { double x = log(M_E); gsl_test_rel (x, 1.0, 4 * GSL_DBL_EPSILON, "ln(M_E)"); } { double x=pow(2.0,M_LOG2E); gsl_test_rel (x, exp(1.0), 4 * GSL_DBL_EPSILON, "2^M_LOG2E"); } { double x=pow(10.0,M_LOG10E); gsl_test_rel (x, exp(1.0), 4 * GSL_DBL_EPSILON, "10^M_LOG10E"); } { double x=pow(M_SQRT2, 2.0); gsl_test_rel (x, 2.0, 4 * GSL_DBL_EPSILON, "M_SQRT2^2"); } { double x=pow(M_SQRT1_2, 2.0); gsl_test_rel (x, 1.0/2.0, 4 * GSL_DBL_EPSILON, "M_SQRT1_2"); } { double x=pow(M_SQRT3, 2.0); gsl_test_rel (x, 3.0, 4 * GSL_DBL_EPSILON, "M_SQRT3^2"); } { double x = M_PI; gsl_test_rel (x, 3.1415926535897932384626433832795, 4 * GSL_DBL_EPSILON, "M_PI"); } { double x = 2 * M_PI_2; gsl_test_rel (x, M_PI, 4 * GSL_DBL_EPSILON, "2*M_PI_2"); } { double x = 4 * M_PI_4; gsl_test_rel (x, M_PI, 4 * GSL_DBL_EPSILON, "4*M_PI_4"); } { double x = pow(M_SQRTPI, 2.0); gsl_test_rel (x, M_PI, 4 * GSL_DBL_EPSILON, "M_SQRTPI^2"); } { double x = pow(M_2_SQRTPI, 2.0); gsl_test_rel (x, 4/M_PI, 4 * GSL_DBL_EPSILON, "M_SQRTPI^2"); } { double x = M_1_PI; gsl_test_rel (x, 1/M_PI, 4 * GSL_DBL_EPSILON, "M_1_SQRTPI"); } { double x = M_2_PI; gsl_test_rel (x, 2.0/M_PI, 4 * GSL_DBL_EPSILON, "M_2_PI"); } { double x = exp(M_LN10); gsl_test_rel (x, 10, 4 * GSL_DBL_EPSILON, "exp(M_LN10)"); } { double x = exp(M_LN2); gsl_test_rel (x, 2, 4 * GSL_DBL_EPSILON, "exp(M_LN2)"); } { double x = exp(M_LNPI); gsl_test_rel (x, M_PI, 4 * GSL_DBL_EPSILON, "exp(M_LNPI)"); } { double x = M_EULER; gsl_test_rel (x, 0.5772156649015328606065120900824, 4 * GSL_DBL_EPSILON, "M_EULER"); } exit (gsl_test_summary ()); }
/** * C++ version of gsl_fcmp(). Test if x1 and x2 are approximately equal to a relative * accuracy epsilon. * @param x1 A real value. * @param x2 A real value. * @param epsilon A positive real value. * @return 0 if x1 and x2 are approximately equal; 1 if x1 > x2; -1 if x1 < x2. */ inline int fcmp( double const x1, double const x2, double const epsilon ){ return gsl_fcmp( x1, x2, epsilon ); }
/** * Comparison function for two multiAM vectors, return success or failure for given tolerance. * we compare avg() and max of |a1_i - a2_i|^2 and |b1_i - b2_i|^2 respectively, * and error in |A1 - A2|, |B1 - B2|, |C1 - C2|. * These numbers are typically ~ O(1), so we simply compare these absolute errors to the tolerance. * */ int XLALCompareMultiAMCoeffs ( MultiAMCoeffs *multiAM1, MultiAMCoeffs *multiAM2, REAL8 tolerance ) { /* check input */ if ( !multiAM1 || !multiAM2 || tolerance <= 0 ) { XLALPrintError ("%s: invalid NULL input or non-positive tolerance\n", __func__ ); XLAL_ERROR ( XLAL_EINVAL ); } UINT4 numDet = multiAM1->length; if ( numDet != multiAM2->length ) { XLALPrintError ("%s: number of detectors differ multiAM1 = %d, multiAM2 = %d\n", __func__, multiAM1->length, multiAM2->length ); XLAL_ERROR ( XLAL_EFAILED ); } UINT4 X; REAL8 maxerr_ab = 0, avgerr_ab = 0; UINT4 numTerms = 0; for ( X=0; X < numDet; X ++ ) { UINT4 numSteps = multiAM1->data[X]->a->length; if ( numSteps != multiAM2->data[X]->a->length ) { XLALPrintError ("%s: number of timesteps differ multiAM1[%d]->a = %d, multiAM2[%d]->a = %d\n",__func__, X, multiAM1->data[X]->a->length, X, multiAM2->data[X]->a->length ); XLAL_ERROR ( XLAL_EFAILED ); } if ( numSteps != multiAM1->data[X]->b->length || numSteps != multiAM2->data[X]->b->length) { XLALPrintError ("%s: number of timesteps differ multiAM1[%d]->b = %d, multiAM2[%d]->b = %d\n",__func__, X, multiAM1->data[X]->b->length, X, multiAM2->data[X]->b->length ); XLAL_ERROR ( XLAL_EFAILED ); } UINT4 i; for ( i=0; i < numSteps; i ++ ) { REAL8 err_a = fabs ( multiAM1->data[X]->a->data[i] - multiAM2->data[X]->a->data[i] ); REAL8 err_b = fabs ( multiAM1->data[X]->b->data[i] - multiAM2->data[X]->b->data[i] ); if ( err_a > maxerr_ab ) maxerr_ab = err_a; if ( err_b > maxerr_ab ) maxerr_ab = err_b; avgerr_ab += err_a + err_b; numTerms += 1; } /* for i < numSteps */ } /* for X < numDet */ avgerr_ab /= (2.0 * numTerms); /* now compute absolute maximal error in AntennaPattern matrix terms */ AntennaPatternMatrix *Mmunu1 = &multiAM1->Mmunu; AntennaPatternMatrix *Mmunu2 = &multiAM2->Mmunu; REAL8 maxxerr_Ad = 0, maxxerr_Bd = 0, maxxerr_Cd = 0, maxxerr_Dd = 0; REAL8 err; err = fabs ( Mmunu1->Ad - Mmunu2->Ad ); if ( err > maxxerr_Ad ) maxxerr_Ad = err; err = fabs ( Mmunu1->Bd - Mmunu2->Bd ); if ( err > maxxerr_Bd ) maxxerr_Bd = err; err = fabs ( Mmunu1->Cd - Mmunu2->Cd ); if ( err > maxxerr_Cd ) maxxerr_Cd = err; err = fabs ( Mmunu1->Dd - Mmunu2->Dd ); if ( err > maxxerr_Dd ) maxxerr_Dd = err; UINT4 failed = 0; /* special treatment for Sinv_Tsft: independent of AM-functions, should agree to within numerics */ double eps = 1e-15; if ( gsl_fcmp ( Mmunu1->Sinv_Tsft, Mmunu2->Sinv_Tsft, eps ) ) { XLALPrintError ("%s: Sinv_Tsft differs by more than %g relative error\n", __func__, eps ); failed ++; } else XLALPrintInfo ("%s: Sinv_Tsft 1 = %g, 2 = %g, 1-2 = %g\n", __func__, Mmunu1->Sinv_Tsft, Mmunu2->Sinv_Tsft, Mmunu1->Sinv_Tsft - Mmunu2->Sinv_Tsft ); /* ----- compare matrix elements A,B,C -------------------- */ /* Mmunu = {A,B,C} are sums of N terms a^2, b^2, a*b, each with small numerical errors * we therefore need to relax the tolerance from a,b,c by a factor of sqrt(N): */ REAL8 tolerance_Mmunu = tolerance * sqrt ( 1.0 * numTerms ); XLALPrintError ("%s: tolerances tol(a,b,c)=%g, tol(Mmunu) = %g\n", __func__, tolerance, tolerance_Mmunu ); if ( maxxerr_Ad > tolerance_Mmunu ) { XLALPrintError ("%s: maximal difference in Ad is %g, which exceeds the tolerance %g\n", __func__, maxxerr_Ad, tolerance_Mmunu ); failed ++; } else XLALPrintInfo ("%s: maxxerr_Ad = %g (< %g)\n", __func__, maxxerr_Ad, tolerance_Mmunu); if ( maxxerr_Bd > tolerance_Mmunu ) { XLALPrintError ("%s: maximal difference in Bd is %g, which exceeds the tolerance %g\n", __func__, maxxerr_Bd, tolerance_Mmunu ); failed ++; } else XLALPrintInfo ("%s: maxxerr_Bd = %g (< %g)\n", __func__, maxxerr_Bd, tolerance_Mmunu); if ( maxxerr_Cd > tolerance_Mmunu ) { XLALPrintError ("%s: maximal difference in Cd is %g, which exceeds the tolerance %g\n", __func__, maxxerr_Cd, tolerance_Mmunu ); failed ++; } else XLALPrintInfo ("%s: maxxerr_Cd = %g (< %g)\n", __func__, maxxerr_Cd, tolerance_Mmunu); /* matrix can be quite ill-conditioned, so the error on Dd is very hard to constrain. * in principle for random-parameters this can go arbitrarly badly, so we don't use * any constraints in this test to avoid spurious test-failures */ XLALPrintError ("%s: maxxerr_Dd = %g (%g)\n", __func__, maxxerr_Dd, tolerance_Mmunu); /* ----- compare individual a,b,c errors -------------------- */ if ( maxerr_ab > tolerance ) { XLALPrintError ("%s: maximal difference in {a, b} coefficients is %g, which exceeds the tolerance %g\n", __func__, maxerr_ab, tolerance ); failed ++; } else XLALPrintInfo ("%s: maxerr_ab = %g (< %g)\n", __func__, maxerr_ab, tolerance); if ( avgerr_ab > tolerance ) { XLALPrintError ("%s: average difference in {a, b} coefficients is %g, which exceeds the tolerance %g\n", __func__, avgerr_ab, tolerance ); failed ++; } else XLALPrintInfo ("%s: avgerr_ab = %g (< %g)\n", __func__, avgerr_ab, tolerance); return failed; } /* XLALCompareMultiAMCoeffs() */