/* 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() */
