double AT_characteristic_single_scattering_angle_single( const double E_MeV_u, const int particle_charge_e, const double target_thickness_cm, const char element_acronym[PARTICLE_NAME_NCHAR]){ double beta = AT_beta_from_E_single( E_MeV_u ); double gamma = AT_gamma_from_E_single( E_MeV_u ); double momentum_kg_m_s = beta*gamma*atomic_mass_unit_MeV_c2*MeV_to_J/c_m_s; int Z = AT_Z_from_element_acronym_single( element_acronym ); double electron_density = AT_electron_density_cm3_from_element_acronym_single( element_acronym ); double chi_c_2 = 4*M_PI*gsl_pow_2(particle_charge_e)*(Z+1)*electron_density*target_thickness_cm*gsl_pow_2((100*fine_structure_constant*Planck_constant_J_s)/(2*M_PI*beta*momentum_kg_m_s)); return sqrt(chi_c_2); }
scalar sasfit_ff_sphere_with_3_shells(scalar q, sasfit_param * param) { scalar F; SASFIT_ASSERT_PTR(param); // assert pointer param is valid SASFIT_CHECK_COND1((q < 0.0), param, "q(%lg) < 0",q); SASFIT_CHECK_COND1((R_CORE < 0.0), param, "R_core(%lg) < 0",R_CORE); // modify condition to your needs SASFIT_CHECK_COND1((T_SH1 < 0.0), param, "t_sh1(%lg) < 0",T_SH1); // modify condition to your needs SASFIT_CHECK_COND1((T_SH2 < 0.0), param, "t_sh2(%lg) < 0",T_SH2); // modify condition to your needs SASFIT_CHECK_COND1((T_SH3 < 0.0), param, "t_sh3(%lg) < 0",T_SH3); // modify condition to your needs // insert your code here F=sasfit_ff_sphere_with_3_shells_f(q,param); return gsl_pow_2(F); }
ANAThreadingLayerHex::ANAThreadingLayerHex(double rho, double b_edge, double b_screw, double rc, double Qx, double Qz, double nu) { double Q, sin2Psi, cos2Psi; Q = sqrt(Qx * Qx + Qz * Qz); sin2Psi = gsl_pow_2(Qz / Q); cos2Psi = 1 - sin2Psi; m_C_screw = M_PI * sin2Psi; m_C1_edge = M_PI * (9 - 16 * nu + 8 * nu * nu) * cos2Psi / (8 * gsl_pow_2(1 - nu)); m_C2_edge = M_PI * (-2 * (3 - 4 * nu)) * cos2Psi / (8 * gsl_pow_2(1 - nu)); m_rho = rho; m_Rc = rc; m_gb2_edge = gsl_pow_2(Q * b_edge / (2 * M_PI)); m_gb2_screw = gsl_pow_2(Q * b_screw / (2 * M_PI)); m_gb_edge = sqrt(m_gb2_edge); m_gb_screw = sqrt(m_gb2_screw); }
double gauss_K(double a, const gsl_vector *A, double b, const gsl_vector *B) { // 归一化系数 《量子化学》中册 P58 (10.4.1b) // A, B 为坐标 double result, norm_2; gsl_vector* v = gsl_vector_alloc(3); gsl_vector_memcpy(v, A); gsl_vector_sub(v, B); norm_2 = gsl_pow_2(gsl_blas_dnrm2(v)); result = exp(-a * b * norm_2 / (a + b)); return result; }
double AT_scattering_angle_distribution_single( const double E_MeV_u, const int particle_charge_e, const double target_thickness_cm, const char element_acronym[PARTICLE_NAME_NCHAR], const double Theta){ double Theta_M = AT_characteristic_multiple_scattering_angle_single( E_MeV_u, particle_charge_e, target_thickness_cm, element_acronym ); double chi_c = AT_characteristic_single_scattering_angle_single( E_MeV_u, particle_charge_e, target_thickness_cm, element_acronym ); double B = AT_reduced_target_thickness_single( E_MeV_u, particle_charge_e, target_thickness_cm, element_acronym ); double red_Theta_pos = Theta/(chi_c*sqrt(B)); double correction0_pos = AT_Moliere_function_f0(red_Theta_pos); double correction1_pos = AT_Moliere_function_f1(red_Theta_pos); double correction2_pos = AT_Moliere_function_f2(red_Theta_pos); double red_Theta_neg = -red_Theta_pos; double correction0_neg = AT_Moliere_function_f0(red_Theta_neg); double correction1_neg = AT_Moliere_function_f1(red_Theta_neg); double correction2_neg = AT_Moliere_function_f2(red_Theta_neg); if(Theta>0){ return (1/(4*M_PI*gsl_pow_2(Theta_M)))*(correction0_pos + correction1_pos/B + correction2_pos/(B*B)); } else{ return (1/(4*M_PI*gsl_pow_2(Theta_M)))*(correction0_neg + correction1_neg/B + correction2_neg/(B*B)); } }
void SecondDerivSmoothedGaussPartials( double x, double s, double ai, double ki, double ci, int n, double &Ji0, double &Ji1, double &Ji2 ) { double f2 = gsl_pow_4 (-n); double f1 = f2 * ai; double xci = x - ci; double a1 = 0.0; double k1 = 0.0; double c1 = 0.0; for (int j=0; j <= 2*n; j++) { int jn = j - n; double fbin = gsl_sf_choose( 2*n, j); double fexp = exp(xci + jn); double fa1 = 2.0 * ki *(-1 + 2.0*ki*gsl_pow_2(xci + jn) ); double fk1 = 2.0 * (-1 + 5.0*ki*gsl_pow_2(xci + jn) - 2.0*gsl_pow_2(ki)*gsl_pow_4(xci+jn) ); double fc1 = 4.0 * gsl_pow_2(ki) * (-3 + 2.0 * ki * gsl_pow_2(xci + jn) ) * (jn - xci); a1 += fbin * fexp * fa1; k1 += fbin * fexp * fk1; c1 += fbin * fexp * fc1; } Ji0 = f2 * a1 / s; Ji1 = f1 * k1 / s; Ji2 = f1 * c1 / s; }
double AT_effective_collision_number_single( const double E_MeV_u, const int particle_charge_e, const double target_thickness_cm, const char element_acronym[PARTICLE_NAME_NCHAR]){ double chi_c = AT_characteristic_single_scattering_angle_single( E_MeV_u, particle_charge_e, target_thickness_cm, element_acronym ); double chi_a = AT_screening_angle_single( E_MeV_u, particle_charge_e, element_acronym ); double exp_b = gsl_pow_2(chi_c)/(1.167*gsl_pow_2(chi_a)); if( exp_b < 1.14 ){ #ifndef NDEBUG printf("Moliere theory cannot be applied because the number of collisions in the target material is too small."); #endif return 0; } else{ return exp_b; } }
int jac (double t, const double y[], double *dfdy, double dfdt[], void *params) { double mu = *(double *) params; gsl_matrix_view dfdy_mat = gsl_matrix_view_array(dfdy, NY, NY); gsl_matrix *m = &dfdy_mat.matrix; gsl_matrix_set (m, 0, 1, 1.0); gsl_matrix_set (m, 1, 0, -1.0 - 2.0*mu*y[0]*y[1]); gsl_matrix_set (m, 1, 1, mu*(1.0 - gsl_pow_2(y[0]))); dfdt[0] = 0.0; dfdt[1] = 0.0; return GSL_SUCCESS; }
int main(){ int len = 3000; gsl_vector *v = gsl_vector_alloc(len); for (double i=0; i< len; i++) gsl_vector_set(v, i, 1./(i+1)); double square; gsl_blas_ddot(v, v, &square); printf("1 + (1/2)^2 + (1/3)^2 + ...= %g\n", square); double pi_over_six = gsl_pow_2(M_PI)/6.; Diff(square, pi_over_six); /* Now using apop_dot, in a few forms. First, vector-as-data dot itself. If one of the inputs is a vector, apop_dot puts the output in a vector-as-data:*/ apop_data *v_as_data = &(apop_data){.vector=v}; apop_data *vdotv = apop_dot(v_as_data, v_as_data); Diff(gsl_vector_get(vdotv->vector, 0), pi_over_six); /* Wrap matrix in an apop_data set. */ gsl_matrix *v_as_matrix = apop_vector_to_matrix(v); apop_data dm = (apop_data){.matrix=v_as_matrix}; // (1 X len) vector dot (len X 1) matrix --- produce a scalar (one item vector). apop_data *mdotv = apop_dot(v_as_data, &dm); double scalarval = apop_data_get(mdotv); Diff(scalarval, pi_over_six); //(len X 1) dot (len X 1) --- bad dimensions. apop_opts.verbose=-1; //don't print an error. apop_data *mdotv2 = apop_dot(&dm, v_as_data); apop_opts.verbose=0; //back to safety. assert(mdotv2->error); // If we want (len X 1) dot (1 X len) --> (len X len), // use apop_vector_to_matrix. apop_data dmr = (apop_data){.matrix=apop_vector_to_matrix(v, .row_col='r')}; apop_data *product_matrix = apop_dot(&dm, &dmr); //The trace is the sum of squares: gsl_vector_view trace = gsl_matrix_diagonal(product_matrix->matrix); double tracesum = apop_sum(&trace.vector); Diff(tracesum, pi_over_six); apop_data_free(product_matrix); gsl_matrix_free(dmr.matrix); }
void setprof(int model, double alpha, double rcut) { int j; double r, x; rdtab[0] = mdtab[0] = vctab[0] = 0.0; for (j = 1; j < NTAB; j++) { r = rcut * pow(((double) j) / (NTAB - 1), 2.0); rdtab[j] = r; x = alpha * r; switch (model) { case -3: mdtab[j] = gsl_pow_4(r / rcut); break; case -2: mdtab[j] = gsl_pow_3(r / rcut); break; case -1: mdtab[j] = gsl_pow_2(r / rcut); break; case 0: mdtab[j] = 1 - exp(-x) - x * exp(-x); break; case 1: mdtab[j] = (2 - 2 * exp(-x) - (2*x + x*x) * exp(-x)) / 2; break; case 2: mdtab[j] = (6 - 6 * exp(-x) - (6*x + 3*x*x + x*x*x) * exp(-x)) / 6; break; default: error("%s: bad choice for model\n", getprog()); } vctab[j] = sqrt(gsp_mass(spheroid, r) / r); } if (model > -1) eprintf("[%s: rcut = %8.4f/alpha M(rcut) = %8.6f*mdisk]\n", getprog(), rdtab[NTAB-1] * alpha, mdtab[NTAB-1]); if ((mdtab[0] == mdtab[1]) || (mdtab[NTAB-2] == mdtab[NTAB-1])) error("%s: disk mass table is degenerate\n", getprog()); rm_spline = gsl_interp_alloc(gsl_interp_akima, NTAB); gsl_interp_init(rm_spline, mdtab, rdtab, NTAB); vr_spline = gsl_interp_alloc(gsl_interp_akima, NTAB); gsl_interp_init(vr_spline, rdtab, vctab, NTAB); }
double bayestar_log_posterior_toa_snr( double ra, double sin_dec, double distance, double u, double twopsi, double gmst, /* Greenwich mean sidereal time in radians. */ int nifos, /* Input: number of detectors. */ const float (**responses)[3], /* Pointers to detector responses. */ const double **locations, /* Pointers to locations of detectors in Cartesian geographic coordinates. */ const double *toas, /* Input: array of times of arrival with arbitrary relative offset. (Make toas[0] == 0.) */ const double *snrs, /* Input: array of SNRs. */ const double *w_toas, /* Input: sum-of-squares weights, (1/TOA variance)^2. */ const double *horizons, /* Distances at which a source would produce an SNR of 1 in each detector. */ int prior_distance_power) /* Use a prior of (distance)^(prior_distance_power) */ { int iifo; const double dec = asin(sin_dec); const double u2 = gsl_pow_2(u); const double u4 = gsl_pow_2(u2); const double costwopsi = cos(twopsi); const double sintwopsi = sin(twopsi); double logp = bayestar_log_posterior_toa(M_PI_2 - dec, ra, gmst, nifos, locations, toas, w_toas); /* Loop over detectors */ for (iifo = 0; iifo < nifos; iifo++) { double Fp, Fx; XLALComputeDetAMResponse(&Fp, &Fx, responses[iifo], ra, dec, 0, gmst); const double FpFx = Fp * Fx; const double FpFp = gsl_pow_2(Fp); const double FxFx = gsl_pow_2(Fx); const double rho2 = 0.125 * ((FpFp + FxFx) * (1 + 6*u2 + u4) - gsl_pow_2(1 - u2) * ((FpFp - FxFx) * costwopsi + 2 * FpFx * sintwopsi)); double residual = snrs[iifo]; /* FIXME: due to roundoff, rhotimesr2 can be very small and * negative rather than simply zero. If this happens, don't accumulate the log-likelihood terms for this detector. */ if (rho2 > 0) residual -= sqrt(rho2) * horizons[iifo] / distance; logp += -0.5 * gsl_pow_2(residual); } if (prior_distance_power != 0) logp += prior_distance_power * log(distance); return logp; }
double AT_KatzModel_inactivation_cross_section_approximation_m2( const double E_MeV_u, const long particle_no, const long material_no, const long rdd_model, const long er_model, const double m_number_of_targets, const double sigma0_m2, const double kappa){ double result = -1.0; double beta = AT_beta_from_E_single(E_MeV_u); double zeff = AT_effective_charge_from_beta_single(beta, AT_Z_from_particle_no_single(particle_no)); double z2kappabeta2 = gsl_pow_2( zeff / beta ) / kappa; double Pi = pow( 1.0 - exp( - z2kappabeta2) , m_number_of_targets); if( rdd_model == RDD_KatzExtTarget && er_model == ER_ButtsKatz ){ double factor = 1; if( Pi > 0.98 ){ factor = AT_KatzModel_KatzExtTarget_ButtsKatz_TrackWidth( z2kappabeta2, m_number_of_targets ); } else { factor = Pi; } result = factor * sigma0_m2; } if( rdd_model == RDD_KatzExtTarget && ((er_model == ER_Waligorski) || (er_model == ER_Edmund)) ){ double factor = 1; if( Pi > 0.98 ){ factor = AT_KatzModel_KatzExtTarget_Zhang_TrackWidth( z2kappabeta2, m_number_of_targets ); } else { factor = Pi; } result = factor * sigma0_m2; } return result; }
void stats(std:: valarray<float> map, float &mean, float &sigma, float &kurt, float &skew) { float sum = map.sum(); int n = map.size(); mean = map.sum()/float(n); std:: valarray <float> maps(n); valarray<float> maps2(n),maps3(n),maps4(n); for(int i=0; i<n; i++) { maps2[i] = gsl_pow_2(map[i] - mean); maps3[i] = gsl_pow_3(map[i] - mean); maps4[i] = gsl_pow_4(map[i] - mean); } sum = maps2.sum(); sigma = sqrt(sum/(float(n)-1.)); sum = maps3.sum(); double mu3 = sum/(float(n)-1.); sum = maps4.sum(); double mu4 = sum/(float(n)-1.); kurt = mu4/gsl_pow_4(sigma) -3; skew = mu3/gsl_pow_3(sigma); }
double d2Nglasma0(double pT, double qT, double phipq, double yp, double yq, double rts) { static struct glasma_params params; params.pT = pT; params.qT = qT; params.yp = yp; params.yq = yq; params.rts = rts; params.phipq = phipq; phiIntKernel.function = &phiKernel; (params.Kernel).function = &doubleKernel; phiIntKernel.params = ¶ms; gsl_integration_qng(&phiIntKernel, -M_PI, M_PI, abserr, relerr,\ &result, &error, &neval); double norm = (Nc*Nc)/gsl_pow_3(Nc*Nc-1.)/(4.*pow(M_PI,10.))/gsl_pow_2(pT* qT)*alpha(pT)*alpha(qT); return norm*result; }
scalar sasfit_ff_gz_dab(scalar z, sasfit_param * param) { scalar u,Gz,G0; SASFIT_ASSERT_PTR(param); // assert pointer param is valid SASFIT_CHECK_COND1((z < 0.0), param, "z(%lg) < 0",z); SASFIT_CHECK_COND1((XI < 0.0), param, "xi(%lg) < 0",XI); // modify condition to your needs // insert your code here u=z/XI; G0=16*M_PI*gsl_pow_4(XI)*ETA*ETA; if (fabs(u)<1e-6) { if (u*u==0) { Gz=G0; } else { Gz=G0*(1+u*u/4.*(2*M_EULER)-1+log(u*u/4.)); } } else { Gz=G0*u*gsl_sf_bessel_K1(u); } return (Gz-G0)*gsl_pow_2(2*M_PI); // not clear yet wy /gsl_pow_2(2*M_PI); is needed }
double d2Nglasma1(double pT, double yp, double yq, double rts) { double sinres, cosres; static struct glasma_params params; params.pT = pT; params.yp = yp; params.yq = yq; params.rts = rts; phiIntKernel.function = &phiKernel; (params.Kernel).function = &cosKernel; phiIntKernel.params = ¶ms; gsl_integration_qng(&phiIntKernel, -M_PI, M_PI, abserr, relerr, &cosres, &error, &neval); (params.Kernel).function = &sinKernel; phiIntKernel.params = ¶ms; gsl_integration_qng(&phiIntKernel, -M_PI, M_PI, abserr, relerr, &sinres, &error, &neval); double norm = (Nc*Nc)/gsl_pow_3(Nc*Nc-1.)/(4.*pow(M_PI,10.))/gsl_pow_2(pT*pT)*alpha(pT)*alpha(pT) ; return norm*(cosres*cosres + sinres*sinres); }
inline typename Plane<T_>::length_type distance(Plane<T_> const& obj, typename Plane<T_>::position_type const& pos) { typedef typename Plane<T_>::length_type length_type; boost::array<length_type, 3> const x_y_z(to_internal(obj, pos)); length_type const dx(subtract(abs(x_y_z[0]), obj.half_extent()[0])); length_type const dy(subtract(abs(x_y_z[1]), obj.half_extent()[1])); if (dx < 0 && dy < 0) { // Projected point of pos is on the plane. // Probably an infinite plane anyway. return x_y_z[2]; } if (dx > 0) { if (dy > 0) { // Far away from plane. return std::sqrt(gsl_pow_2(dx) + gsl_pow_2(dy) + gsl_pow_2(x_y_z[2])); } else { return std::sqrt(gsl_pow_2(dx) + gsl_pow_2(x_y_z[2])); } } else { if (dy > 0) { return std::sqrt(gsl_pow_2(dy) + gsl_pow_2(x_y_z[2])); } else { // Already tested above. return x_y_z[2]; } } }
void integ_mass(bool update) { double *dmdr_tab = (double *) allocate(ntab * sizeof(double)); gsl_spline *spl_dmdr = gsl_spline_alloc(gsl_interp_cspline, ntab); gsl_interp_accel *acc_dmdr = gsl_interp_accel_alloc(); int i, stat; double alpha, mass_int, del_mass, mass_end = mass_tab[ntab - 1]; for (i = 0; i < ntab; i++) dmdr_tab[i] = 4 * M_PI * gsl_pow_2(radius_tab[i]) * density_tab[i]; gsl_spline_init(spl_dmdr, radius_tab, dmdr_tab, ntab); if (radius_tab[0] > 0.0) { alpha = rlog10(density_tab[1] / density_tab[0]) / rlog10(radius_tab[1] / radius_tab[0]); mass_int = (4 * M_PI / (alpha + 3)) * gsl_pow_3(radius_tab[0]) * density_tab[0]; } else mass_int = 0.0; if (update) mass_tab[0] = mass_int; for (i = 1; i < ntab; i++) { stat = gsl_spline_eval_integ_e(spl_dmdr, radius_tab[i-1], radius_tab[i], acc_dmdr, &del_mass); if (stat != 0) error("%s: spline error: %s\n", getprog(), gsl_strerror(stat)); mass_int = mass_int + del_mass; if (update) mass_tab[i] = mass_int; } gsl_interp_accel_free(acc_dmdr); gsl_spline_free(spl_dmdr); free(dmdr_tab); eprintf("[%s: mass[] = %e:%e]\n", getprog(), mass_tab[0], mass_tab[ntab - 1]); if (mass_int < 0.99 * mass_end || mass_int > 1.01 * mass_end) eprintf("[%s: WARNING: final mass = %e integ mass = %e]\n", getprog(), mass_end, mass_int); }
scalar sasfit_sd_gammaSD(scalar x, sasfit_param * param) { scalar k, theta, res; SASFIT_ASSERT_PTR( param ); // MODE = theta*(k-1) // variance = sigma^2 = k*theta^2 theta = 0.5*(sqrt(gsl_pow_2(MODE) + 4.0*gsl_pow_2(SIGMA))-MODE); k = ( gsl_pow_2(MODE) + 2*gsl_pow_2(SIGMA) + MODE*sqrt(gsl_pow_2(MODE) + 4.0*gsl_pow_2(SIGMA)) )/(2.0*gsl_pow_2(SIGMA)); if (x == 0.0) return 0.0; res = (k-1.)*log(x/theta) - x/theta - log(theta) - sasfit_gammaln(k); return N*exp(res); }
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; }
double *bayestar_sky_map_toa_phoa_snr( long *npix, /* Input: number of HEALPix pixels. */ double gmst, /* Greenwich mean sidereal time in radians. */ int nifos, /* Input: number of detectors. */ const float (**responses)[3], /* Pointers to detector responses. */ const double **locations, /* Pointers to locations of detectors in Cartesian geographic coordinates. */ const double *toas, /* Input: array of times of arrival with arbitrary relative offset. (Make toas[0] == 0.) */ const double *phoas, /* Input: array of phases of arrival with arbitrary relative offset. (Make phoas[0] == 0.) */ const double *snrs, /* Input: array of SNRs. */ const double *w_toas, /* Input: sum-of-squares weights, (1/TOA variance)^2. */ const double *w1s, /* Input: first moments of angular frequency. */ const double *w2s, /* Input: second moments of angular frequency. */ const double *horizons, /* Distances at which a source would produce an SNR of 1 in each detector. */ double min_distance, double max_distance, int prior_distance_power) /* Use a prior of (distance)^(prior_distance_power) */ { long nside; long maxpix; long i; double d1[nifos]; double *P; gsl_permutation *pix_perm; double complex exp_i_phoas[nifos]; /* Hold GSL return values for any thread that fails. */ int gsl_errno = GSL_SUCCESS; /* Storage for old GSL error handler. */ gsl_error_handler_t *old_handler; /* Maximum number of subdivisions for adaptive integration. */ static const size_t subdivision_limit = 64; /* Subdivide radial integral where likelihood is this fraction of the maximum, * will be used in solving the quadratic to find the breakpoints */ static const double eta = 0.01; /* Use this many integration steps in 2*psi */ static const int ntwopsi = 16; /* Number of integration steps in cos(inclination) */ static const int nu = 16; /* Number of integration steps in arrival time */ static const int nt = 16; /* Rescale distances so that furthest horizon distance is 1. */ { double d1max; memcpy(d1, horizons, sizeof(d1)); for (d1max = d1[0], i = 1; i < nifos; i ++) if (d1[i] > d1max) d1max = d1[i]; for (i = 0; i < nifos; i ++) d1[i] /= d1max; min_distance /= d1max; max_distance /= d1max; } (void)w2s; /* FIXME: remove unused parameter */ for (i = 0; i < nifos; i ++) exp_i_phoas[i] = exp_i(phoas[i]); /* Evaluate posterior term only first. */ P = bayestar_sky_map_toa_adapt_resolution(&pix_perm, &maxpix, npix, gmst, nifos, locations, toas, w_toas, autoresolution_count_pix_toa_phoa_snr); if (!P) return NULL; /* Determine the lateral HEALPix resolution. */ nside = npix2nside(*npix); /* Zero all pixels that didn't meet the TDOA cut. */ for (i = maxpix; i < *npix; i ++) { long ipix = gsl_permutation_get(pix_perm, i); P[ipix] = -INFINITY; } /* Use our own error handler while in parallel section to avoid concurrent * calls to the GSL error handler, which if provided by the user may not * be threadsafe. */ old_handler = gsl_set_error_handler(my_gsl_error); /* Compute posterior factor for amplitude consistency. */ #pragma omp parallel for firstprivate(gsl_errno) lastprivate(gsl_errno) for (i = 0; i < maxpix; i ++) { /* Cancel further computation if a GSL error condition has occurred. * * Note: if one thread sets gsl_errno, not necessarily all thread will * get the updated value. That's OK, because most failure modes will * cause GSL error conditions on all threads. If we cared to have any * failure on any thread terminate all of the other threads as quickly * as possible, then we would want to insert the following pragma here: * * #pragma omp flush(gsl_errno) * * and likewise before any point where we set gsl_errno. */ if (gsl_errno != GSL_SUCCESS) goto skip; { long ipix = gsl_permutation_get(pix_perm, i); double complex F[nifos]; double theta, phi; int itwopsi, iu, it, iifo; double accum = -INFINITY; double complex exp_i_toaphoa[nifos]; double dtau[nifos], mean_dtau; /* Prepare workspace for adaptive integrator. */ gsl_integration_workspace *workspace = gsl_integration_workspace_alloc(subdivision_limit); /* If the workspace could not be allocated, then record the GSL * error value for later reporting when we leave the parallel * section. Then, skip to the next loop iteration. */ if (!workspace) { gsl_errno = GSL_ENOMEM; goto skip; } /* Look up polar coordinates of this pixel */ pix2ang_ring(nside, ipix, &theta, &phi); toa_errors(dtau, theta, phi, gmst, nifos, locations, toas); for (iifo = 0; iifo < nifos; iifo ++) exp_i_toaphoa[iifo] = exp_i_phoas[iifo] * exp_i(w1s[iifo] * dtau[iifo]); /* Find mean arrival time error */ mean_dtau = gsl_stats_wmean(w_toas, 1, dtau, 1, nifos); /* Look up antenna factors */ for (iifo = 0; iifo < nifos; iifo++) { XLALComputeDetAMResponse( (double *)&F[iifo], /* Type-punned real part */ 1 + (double *)&F[iifo], /* Type-punned imag part */ responses[iifo], phi, M_PI_2 - theta, 0, gmst); F[iifo] *= d1[iifo]; } /* Integrate over 2*psi */ for (itwopsi = 0; itwopsi < ntwopsi; itwopsi++) { const double twopsi = (2 * M_PI / ntwopsi) * itwopsi; const double complex exp_i_twopsi = exp_i(twopsi); /* Integrate over u from u=-1 to u=1. */ for (iu = -nu; iu <= nu; iu++) { const double u = (double)iu / nu; const double u2 = gsl_pow_2(u); double A = 0, B = 0; double breakpoints[5]; int num_breakpoints = 0; double log_offset = -INFINITY; /* The log-likelihood is quadratic in the estimated and true * values of the SNR, and in 1/r. It is of the form A/r^2 + B/r, * where A depends only on the true values of the SNR and is * strictly negative and B depends on both the true values and * the estimates and is strictly positive. * * The middle breakpoint is at the maximum of the log-likelihood, * occurring at 1/r=-B/2A. The lower and upper breakpoints occur * when the likelihood becomes eta times its maximum value. This * occurs when * * A/r^2 + B/r = log(eta) - B^2/4A. * */ /* Perform arrival time integral */ double accum1 = -INFINITY; for (it = -nt/2; it <= nt/2; it++) { const double t = mean_dtau + LAL_REARTH_SI / LAL_C_SI * it / nt; double complex i0arg_complex = 0; for (iifo = 0; iifo < nifos; iifo++) { const double complex tmp = F[iifo] * exp_i_twopsi; /* FIXME: could use - sign here to avoid conj below, but * this probably just sets our sign convention relative to * detection pipeline */ double complex phase_rhotimesr = 0.5 * (1 + u2) * creal(tmp) + I * u * cimag(tmp); const double abs_rhotimesr_2 = cabs2(phase_rhotimesr); const double abs_rhotimesr = sqrt(abs_rhotimesr_2); phase_rhotimesr /= abs_rhotimesr; i0arg_complex += exp_i_toaphoa[iifo] * exp_i(-w1s[iifo] * t) * phase_rhotimesr * gsl_pow_2(snrs[iifo]); } const double i0arg = cabs(i0arg_complex); accum1 = logaddexp(accum1, log(gsl_sf_bessel_I0_scaled(i0arg)) + i0arg - 0.5 * gsl_stats_wtss_m(w_toas, 1, dtau, 1, nifos, t)); } /* Loop over detectors */ for (iifo = 0; iifo < nifos; iifo++) { const double complex tmp = F[iifo] * exp_i_twopsi; /* FIXME: could use - sign here to avoid conj below, but * this probably just sets our sign convention relative to * detection pipeline */ double complex phase_rhotimesr = 0.5 * (1 + u2) * creal(tmp) + I * u * cimag(tmp); const double abs_rhotimesr_2 = cabs2(phase_rhotimesr); const double abs_rhotimesr = sqrt(abs_rhotimesr_2); A += abs_rhotimesr_2; B += abs_rhotimesr * snrs[iifo]; } A *= -0.5; { const double middle_breakpoint = -2 * A / B; const double lower_breakpoint = 1 / (1 / middle_breakpoint + sqrt(log(eta) / A)); const double upper_breakpoint = 1 / (1 / middle_breakpoint - sqrt(log(eta) / A)); breakpoints[num_breakpoints++] = min_distance; if(lower_breakpoint > breakpoints[num_breakpoints-1] && lower_breakpoint < max_distance) breakpoints[num_breakpoints++] = lower_breakpoint; if(middle_breakpoint > breakpoints[num_breakpoints-1] && middle_breakpoint < max_distance) breakpoints[num_breakpoints++] = middle_breakpoint; if(upper_breakpoint > breakpoints[num_breakpoints-1] && upper_breakpoint < max_distance) breakpoints[num_breakpoints++] = upper_breakpoint; breakpoints[num_breakpoints++] = max_distance; } { /* * Set log_offset to the maximum of the logarithm of the * radial integrand evaluated at all of the breakpoints. */ int ibreakpoint; for (ibreakpoint = 0; ibreakpoint < num_breakpoints; ibreakpoint++) { const double new_log_offset = log_radial_integrand( breakpoints[ibreakpoint], A, B, prior_distance_power); if (new_log_offset < INFINITY && new_log_offset > log_offset) log_offset = new_log_offset; } } { /* Perform adaptive integration. Stop when a relative * accuracy of 0.05 has been reached. */ inner_integrand_params integrand_params = {A, B, log_offset, prior_distance_power}; const gsl_function func = {radial_integrand, &integrand_params}; double result, abserr; int ret = gsl_integration_qagp(&func, &breakpoints[0], num_breakpoints, DBL_MIN, 0.05, subdivision_limit, workspace, &result, &abserr); /* If the integrator failed, then record the GSL error * value for later reporting when we leave the parallel * section. Then, break out of the loop. */ if (ret != GSL_SUCCESS) { gsl_errno = ret; gsl_integration_workspace_free(workspace); goto skip; } /* Take the logarithm and put the log-normalization back in. */ result = log(result) + integrand_params.log_offset + accum1; /* Accumulate result. */ accum = logaddexp(accum, result); } } } /* Discard workspace for adaptive integrator. */ gsl_integration_workspace_free(workspace); /* Store log posterior. */ P[ipix] = accum; } skip: /* this statement intentionally left blank */; } /* Restore old error handler. */ gsl_set_error_handler(old_handler); /* Free permutation. */ gsl_permutation_free(pix_perm); /* Check if there was an error in any thread evaluating any pixel. If there * was, raise the error and return. */ if (gsl_errno != GSL_SUCCESS) { free(P); GSL_ERROR_NULL(gsl_strerror(gsl_errno), gsl_errno); } /* Exponentiate and normalize posterior. */ pix_perm = get_pixel_ranks(*npix, P); if (!pix_perm) { free(P); return NULL; } exp_normalize(*npix, P, pix_perm); gsl_permutation_free(pix_perm); return P; }
double *bayestar_sky_map_toa_snr( long *npix, /* Input: number of HEALPix pixels. */ double gmst, /* Greenwich mean sidereal time in radians. */ int nifos, /* Input: number of detectors. */ const float (**responses)[3], /* Pointers to detector responses. */ const double **locations, /* Pointers to locations of detectors in Cartesian geographic coordinates. */ const double *toas, /* Input: array of times of arrival with arbitrary relative offset. (Make toas[0] == 0.) */ const double *snrs, /* Input: array of SNRs. */ const double *w_toas, /* Input: sum-of-squares weights, (1/TOA variance)^2. */ const double *horizons, /* Distances at which a source would produce an SNR of 1 in each detector. */ double min_distance, double max_distance, int prior_distance_power) /* Use a prior of (distance)^(prior_distance_power) */ { long nside; long maxpix; long i; double d1[nifos]; double *P; gsl_permutation *pix_perm; /* Hold GSL return values for any thread that fails. */ int gsl_errno = GSL_SUCCESS; /* Storage for old GSL error handler. */ gsl_error_handler_t *old_handler; /* Maximum number of subdivisions for adaptive integration. */ static const size_t subdivision_limit = 64; /* Subdivide radial integral where likelihood is this fraction of the maximum, * will be used in solving the quadratic to find the breakpoints */ static const double eta = 0.01; /* Use this many integration steps in 2*psi */ static const int ntwopsi = 16; /* Number of integration steps in cos(inclination) */ static const int nu = 16; /* Rescale distances so that furthest horizon distance is 1. */ { double d1max; memcpy(d1, horizons, sizeof(d1)); for (d1max = d1[0], i = 1; i < nifos; i ++) if (d1[i] > d1max) d1max = d1[i]; for (i = 0; i < nifos; i ++) d1[i] /= d1max; min_distance /= d1max; max_distance /= d1max; } /* Evaluate posterior term only first. */ P = bayestar_sky_map_toa_adapt_resolution(&pix_perm, &maxpix, npix, gmst, nifos, locations, toas, w_toas, autoresolution_count_pix_toa_snr); if (!P) return NULL; /* Determine the lateral HEALPix resolution. */ nside = npix2nside(*npix); /* Zero pixels that didn't meet the TDOA cut. */ for (i = 0; i < maxpix; i ++) { long ipix = gsl_permutation_get(pix_perm, i); P[ipix] = log(P[ipix]); } for (; i < *npix; i ++) { long ipix = gsl_permutation_get(pix_perm, i); P[ipix] = -INFINITY; } /* Use our own error handler while in parallel section to avoid concurrent * calls to the GSL error handler, which if provided by the user may not * be threadsafe. */ old_handler = gsl_set_error_handler(my_gsl_error); /* Compute posterior factor for amplitude consistency. */ #pragma omp parallel for firstprivate(gsl_errno) lastprivate(gsl_errno) for (i = 0; i < maxpix; i ++) { /* Cancel further computation if a GSL error condition has occurred. * * Note: if one thread sets gsl_errno, not necessarily all thread will * get the updated value. That's OK, because most failure modes will * cause GSL error conditions on all threads. If we cared to have any * failure on any thread terminate all of the other threads as quickly * as possible, then we would want to insert the following pragma here: * * #pragma omp flush(gsl_errno) * * and likewise before any point where we set gsl_errno. */ if (gsl_errno != GSL_SUCCESS) goto skip; { long ipix = gsl_permutation_get(pix_perm, i); double F[nifos][2]; double theta, phi; int itwopsi, iu, iifo; double accum = -INFINITY; /* Prepare workspace for adaptive integrator. */ gsl_integration_workspace *workspace = gsl_integration_workspace_alloc(subdivision_limit); /* If the workspace could not be allocated, then record the GSL * error value for later reporting when we leave the parallel * section. Then, skip to the next loop iteration. */ if (!workspace) { gsl_errno = GSL_ENOMEM; goto skip; } /* Look up polar coordinates of this pixel */ pix2ang_ring(nside, ipix, &theta, &phi); /* Look up antenna factors */ for (iifo = 0; iifo < nifos; iifo ++) { XLALComputeDetAMResponse(&F[iifo][0], &F[iifo][1], responses[iifo], phi, M_PI_2 - theta, 0, gmst); F[iifo][0] *= d1[iifo]; F[iifo][1] *= d1[iifo]; } /* Integrate over 2*psi */ for (itwopsi = 0; itwopsi < ntwopsi; itwopsi++) { const double twopsi = (2 * M_PI / ntwopsi) * itwopsi; const double costwopsi = cos(twopsi); const double sintwopsi = sin(twopsi); /* Integrate over u; since integrand only depends on u^2 we only * have to go from u=0 to u=1. We want to include u=1, so the upper * limit has to be <= */ for (iu = 0; iu <= nu; iu++) { const double u = (double)iu / nu; const double u2 = gsl_pow_2(u); const double u4 = gsl_pow_2(u2); double A = 0, B = 0; double breakpoints[5]; int num_breakpoints = 0; double log_offset = -INFINITY; /* The log-likelihood is quadratic in the estimated and true * values of the SNR, and in 1/r. It is of the form A/r^2 + B/r, * where A depends only on the true values of the SNR and is * strictly negative and B depends on both the true values and * the estimates and is strictly positive. * * The middle breakpoint is at the maximum of the log-likelihood, * occurring at 1/r=-B/2A. The lower and upper breakpoints occur * when the likelihood becomes eta times its maximum value. This * occurs when * * A/r^2 + B/r = log(eta) - B^2/4A. * */ /* Loop over detectors */ for (iifo = 0; iifo < nifos; iifo++) { const double Fp = F[iifo][0]; /* `plus' antenna factor times r */ const double Fx = F[iifo][1]; /* `cross' antenna factor times r */ const double FpFx = Fp * Fx; const double FpFp = gsl_pow_2(Fp); const double FxFx = gsl_pow_2(Fx); const double rhotimesr2 = 0.125 * ((FpFp + FxFx) * (1 + 6*u2 + u4) - gsl_pow_2(1 - u2) * ((FpFp - FxFx) * costwopsi + 2 * FpFx * sintwopsi)); const double rhotimesr = sqrt(rhotimesr2); /* FIXME: due to roundoff, rhotimesr2 can be very small and * negative rather than simply zero. If this happens, don't accumulate the log-likelihood terms for this detector. */ if (rhotimesr2 > 0) { A += rhotimesr2; B += rhotimesr * snrs[iifo]; } } A *= -0.5; { const double middle_breakpoint = -2 * A / B; const double lower_breakpoint = 1 / (1 / middle_breakpoint + sqrt(log(eta) / A)); const double upper_breakpoint = 1 / (1 / middle_breakpoint - sqrt(log(eta) / A)); breakpoints[num_breakpoints++] = min_distance; if(lower_breakpoint > breakpoints[num_breakpoints-1] && lower_breakpoint < max_distance) breakpoints[num_breakpoints++] = lower_breakpoint; if(middle_breakpoint > breakpoints[num_breakpoints-1] && middle_breakpoint < max_distance) breakpoints[num_breakpoints++] = middle_breakpoint; if(upper_breakpoint > breakpoints[num_breakpoints-1] && upper_breakpoint < max_distance) breakpoints[num_breakpoints++] = upper_breakpoint; breakpoints[num_breakpoints++] = max_distance; } { /* * Set log_offset to the maximum of the logarithm of the * radial integrand evaluated at all of the breakpoints. */ int ibreakpoint; for (ibreakpoint = 0; ibreakpoint < num_breakpoints; ibreakpoint++) { const double new_log_offset = log_radial_integrand( breakpoints[ibreakpoint], A, B, prior_distance_power); if (new_log_offset < INFINITY && new_log_offset > log_offset) log_offset = new_log_offset; } } { /* Perform adaptive integration. Stop when a relative * accuracy of 0.05 has been reached. */ inner_integrand_params integrand_params = {A, B, log_offset, prior_distance_power}; const gsl_function func = {radial_integrand, &integrand_params}; double result, abserr; int ret = gsl_integration_qagp(&func, &breakpoints[0], num_breakpoints, DBL_MIN, 0.05, subdivision_limit, workspace, &result, &abserr); /* If the integrator failed, then record the GSL error * value for later reporting when we leave the parallel * section. Then, break out of the loop. */ if (ret != GSL_SUCCESS) { gsl_errno = ret; gsl_integration_workspace_free(workspace); goto skip; } /* Take the logarithm and put the log-normalization back in. */ result = log(result) + integrand_params.log_offset; /* Accumulate result. */ accum = logaddexp(accum, result); } } } /* Discard workspace for adaptive integrator. */ gsl_integration_workspace_free(workspace); /* Accumulate (log) posterior terms for SNR and TDOA. */ P[ipix] += accum; } skip: /* this statement intentionally left blank */; } /* Restore old error handler. */ gsl_set_error_handler(old_handler); /* Free permutation. */ gsl_permutation_free(pix_perm); /* Check if there was an error in any thread evaluating any pixel. If there * was, raise the error and return. */ if (gsl_errno != GSL_SUCCESS) { free(P); GSL_ERROR_NULL(gsl_strerror(gsl_errno), gsl_errno); } /* Exponentiate and normalize posterior. */ pix_perm = get_pixel_ranks(*npix, P); if (!pix_perm) { free(P); return NULL; } exp_normalize(*npix, P, pix_perm); gsl_permutation_free(pix_perm); return P; }
static double cabs2(double complex z) { return gsl_pow_2(creal(z)) + gsl_pow_2(cimag(z)); }
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 ()); }
int MetaAnalysis(gsl_vector * esVector, gsl_vector * varVector, gsl_vector * metaResultsVector, gsl_combination * comb) { ST_retcode rc; ST_uint4 i, nStudies, subsetLength; ST_double sumOfFixedWeights = 0.0; ST_double sumOfFixedWeights2= 0.0; ST_double sumOfFixedWeightedEffects = 0.0; ST_double sumOfFixedWeightedSquares = 0.0; nStudies = (ST_uint4) esVector->size; subsetLength = gsl_combination_k(comb); /* note the definition of c(i) in the beginning */ if (subsetLength > 1.0) { for(i=0; i< subsetLength ; i++) { sumOfFixedWeights += 1.0 / (gsl_vector_get(varVector, c(i) )); sumOfFixedWeights2 += 1.0 / gsl_pow_2( (gsl_vector_get(varVector, c(i) )) ); sumOfFixedWeightedEffects += gsl_vector_get(esVector, c(i)) / (gsl_vector_get(varVector, c(i))); } /* ES_FEM */ gsl_vector_set(metaResultsVector, 0, sumOfFixedWeightedEffects / sumOfFixedWeights); /* var_FEM*/ gsl_vector_set(metaResultsVector, 1, 1.0 / sumOfFixedWeights); /* df */ gsl_vector_set(metaResultsVector, 4, subsetLength-1.0); /* Q */ for(i=0; i< subsetLength ; i++) { sumOfFixedWeightedSquares += /* see the definition of MARES */ gsl_pow_2(gsl_vector_get(esVector, c(i)) - MARES(0)) / gsl_vector_get(varVector,c(i)); } gsl_vector_set(metaResultsVector, 5, sumOfFixedWeightedSquares); /* I2 */ gsl_vector_set(metaResultsVector, 6, GSL_MAX(0.0, 1.0 - MARES(4) / MARES(5)) ); /****REM****/ /* sets ES_REM var_REM and tau2 */ if ((rc = DL(esVector, varVector, metaResultsVector, comb, sumOfFixedWeights, sumOfFixedWeights2) )) return(rc); } else { gsl_vector_set(metaResultsVector, 2, MARES(0)); gsl_vector_set(metaResultsVector, 3, MARES(1)); gsl_vector_set(metaResultsVector, 5, 0.0); /* Q will set to missing later */ gsl_vector_set(metaResultsVector, 6, 0.0 ); /* I2 will set to missing later */ gsl_vector_set(metaResultsVector, 7, 0.0 ); /* no tau2 */ } return 0; }
int main (void) { double y, y_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 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)"); } { 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 ()); }
static int bundle_method_iterate (void *vstate, gsl_multimin_function_fsdf * fsdf, gsl_vector * x, double * f, gsl_vector * subgradient, gsl_vector * dx, double * eps) { bundle_method_state_t *state = (bundle_method_state_t *) vstate; bundle_element *item; size_t i, debug=0; int status; double tmp_d, t_old, t_int_l; /* local variables */ gsl_vector *y; /* a trial point (the next iteration point by the serios step) */ gsl_vector *sgr_y; /* subgradient at y */ double f_y; /* the function value at y */ gsl_vector *p; /* the aggregate subgradient */ double p_norm, lin_error_p; /* norm of p, the aggregate linear. error */ gsl_vector *tmp_v; /* data for the convex quadratic problem (for the dual problem) */ gsl_vector *q; /* elements of the array are the linearization errors */ gsl_matrix *Q; /* Q=G^T*G (G is matrix which collumns are subgradients) */ gsl_vector *lambda; /* the convex combination coefficients of the subgradients (solution of the dual problem) */ lambda = gsl_vector_alloc(state->bundle_size); if(lambda == 0) { GSL_ERROR_VAL ("failed to allocate workspace", GSL_ENOMEM, 0); } q = gsl_vector_alloc(lambda->size); if(q == 0) { gsl_vector_free(lambda); GSL_ERROR_VAL ("failed to allocate workspace", GSL_ENOMEM, 0); } y = gsl_vector_calloc(x->size); if(y == 0) { gsl_vector_free(q); gsl_vector_free(lambda); GSL_ERROR_VAL ("failed to allocate workspace", GSL_ENOMEM, 0); } sgr_y = gsl_vector_calloc(x->size); if(sgr_y == 0) { gsl_vector_free(y); gsl_vector_free(q); gsl_vector_free(lambda); GSL_ERROR_VAL ("failed to allocate workspace", GSL_ENOMEM, 0); } Q = gsl_matrix_alloc(state->bundle_size, state->bundle_size); if(Q == 0) { gsl_vector_free(sgr_y); gsl_vector_free(y); gsl_vector_free(q); gsl_vector_free(lambda); GSL_ERROR_VAL ("failed to allocate workspace", GSL_ENOMEM, 0); } p = gsl_vector_calloc(x->size); if(p == 0) { gsl_matrix_free(Q); gsl_vector_free(sgr_y); gsl_vector_free(y); gsl_vector_free(q); gsl_vector_free(lambda); GSL_ERROR_VAL ("failed to allocate workspace", GSL_ENOMEM, 0); } tmp_v = gsl_vector_calloc(x->size); if(tmp_v == 0) { gsl_vector_free(p); gsl_matrix_free(Q); gsl_vector_free(sgr_y); gsl_vector_free(y); gsl_vector_free(q); gsl_vector_free(lambda); GSL_ERROR_VAL ("failed to allocate workspace", GSL_ENOMEM, 0); } /* solve the dual problem */ status = build_cqp_data(state, Q, q); status = solve_qp_pdip(Q, q, lambda); gsl_matrix_free(Q); gsl_vector_free(q); /* compute the aggregate subgradient (it is called p in the documantation)*/ /* and the appropriated linearization error */ lin_error_p = 0.0; item = state->head; for(i=0; i<lambda->size; i++) { status = gsl_blas_daxpy(gsl_vector_get(lambda,i), item->sgr, p); lin_error_p += gsl_vector_get(lambda,i)*(item->lin_error); item = item->next; } if(debug) { printf("the dual problem solution:\n"); for(i=0;i<lambda->size;i++) printf("%7.6e ",gsl_vector_get(lambda,i)); printf("\n\n"); printf("the aggregate subgradient: \n"); for(i=0;i<p->size;i++) printf("%.6e ",gsl_vector_get(p,i)); printf("\n"); printf("lin. error for aggr subgradient = %e\n",lin_error_p); } /* the norm of the aggr subgradient */ p_norm = gsl_blas_dnrm2(p); /* search direction dx=-t*p (t is the length of step) */ status = gsl_vector_memcpy(dx,p); status = gsl_vector_scale(dx,-1.0*state->t); /* v =-t*norm(p)^2-alpha_p */ state->v = -gsl_pow_2(p_norm)*(state->t)-lin_error_p; /* the subgradient is the aggegate sungradient */ status = gsl_blas_dcopy(p,subgradient); /* iteration step */ /* y=x+dx */ status = gsl_blas_dcopy(dx,y); status = gsl_blas_daxpy(1.0,x,y); /* function value at y */ f_y = GSL_MULTIMIN_FN_EVAL_F(fsdf, y); state->f_eval++; /* for t-update */ if(!state->fixed_step_length) { t_old = state->t; if(fabs(state->v-(f_y-*f)) < state->rg || state->v-(f_y-*f) > state->rg) t_int_l = state->t_max; else t_int_l = 0.5*t_old*(state->v)/(state->v-(f_y-*f)); } else { t_old = state->t; t_int_l = state->t; } if( f_y-*f <= state->m_ss*state->v ) /* Serious-Step */ { if(debug) printf("\nSerious-Step\n"); /* the relaxation step */ if(state->relaxation) { if(f_y-*f <= state->v*state->m_rel) { double f_z; gsl_vector * z = gsl_vector_alloc(y->size); /* z = y+dx = x+2*dx */ status = gsl_blas_dcopy(x,z); status = gsl_blas_daxpy(2.0,dx,z); f_z = GSL_MULTIMIN_FN_EVAL_F(fsdf, z); state->f_eval++; if(0.5*f_z-f_y+0.5*(*f) > state->rg) state->rel_parameter = GSL_MIN_DBL(-0.5*(-0.5*f_z+2.0*f_y-1.5*(*f))/(0.5*f_z-f_y+0.5*(*f)),1.999); else if (fabs(0.5*f_z-f_y+0.5*(*f)) > state->rg) state->rel_parameter = 1.999; else /* something is wrong */ state->rel_parameter = 1.0; /* save the old iteration point */ status = gsl_blas_dcopy(y,z); /* y = (1-rel_parameter)*x+rel_parameter*y */ gsl_blas_dscal(state->rel_parameter,y); status = gsl_blas_daxpy(1.0-state->rel_parameter,x,y); /* f(y) und sgr_f(y) */ tmp_d = GSL_MULTIMIN_FN_EVAL_F(fsdf, y); state->f_eval++; if(tmp_d > f_y) { /* keep y as the current point */ status = gsl_blas_dcopy(z,y); state->rel_counter++; } else { f_y = tmp_d; /* dx = y-x */ status = gsl_blas_dcopy(y,dx); status = gsl_blas_daxpy(-1.0,x,dx); /* if iteration points bevor and after the rel. step are closly, the rel_step counte will be increased */ /* |1-rel_parameter| <= 0.1*/ if( fabs(1.0-state->rel_parameter) < 0.1) state->rel_counter++; } GSL_MULTIMIN_FN_EVAL_SDF(fsdf, y, sgr_y); state->sgr_eval++; if(state->rel_counter > state->rel_counter_max) state->relaxation = 0; /* */ status = gsl_blas_daxpy(-1.0,y,z); status = gsl_blas_ddot(p, z, &tmp_d); *eps = f_y-*f-(state->v)+tmp_d; gsl_vector_free(z); } else { *eps = f_y-(state->v)-*f; GSL_MULTIMIN_FN_EVAL_SDF(fsdf, y, sgr_y); state->sgr_eval++; } } else { *eps = f_y-(state->v)-*f; GSL_MULTIMIN_FN_EVAL_SDF(fsdf, y, sgr_y); state->sgr_eval++; } /* calculate linearization errors at new iteration point */ item = state->head; for(i=0; i<state->bundle_size; i++) { status = gsl_blas_ddot(item->sgr, dx, &tmp_d); item->lin_error += f_y-*f-tmp_d; item = item->next; } /* linearization error at new iteration point */ status = gsl_blas_ddot(p, dx, &tmp_d); lin_error_p += f_y-*f-tmp_d; /* update the bundle */ status = update_bundle(state, sgr_y, 0.0, lambda, p, lin_error_p, 1); /* adapt the step length */ if(!state->fixed_step_length) { if(f_y-*f <= state->v*state->m_t && state->step_counter > 0) state->t = t_int_l; else if(state->step_counter>3) state->t=2.0*t_old; state->t = GSL_MIN_DBL(GSL_MIN_DBL(state->t,10.0*t_old),state->t_max); /*state->eps_v = GSL_MAX_DBL(state->eps_v,-2.0*state->v);*/ state->step_counter = GSL_MAX_INT(state->step_counter+1,1); if(fabs(state->t-t_old) > state->rg) state->step_counter=1; } /* x=y, f=f(y) */ status = gsl_blas_dcopy(y,x); *f = f_y; } else /* Null-Step */ { if(debug) printf("\nNull-Step\n"); GSL_MULTIMIN_FN_EVAL_SDF(fsdf, y, sgr_y); state->sgr_eval++; /* eps for the eps_subdifferential */ *eps = lin_error_p; /*calculate the liniarization error at y */ status = gsl_blas_ddot(sgr_y,dx,&tmp_d); tmp_d += *f-f_y; /* Bundle update */ status = update_bundle(state, sgr_y, tmp_d, lambda, p, lin_error_p, 0); /* adapt the step length */ if(!state->fixed_step_length) { /*state->eps_v = GSL_MIN_DBL(state->eps_v,lin_error_p);*/ if(tmp_d > GSL_MAX_DBL(p_norm,lin_error_p) && state->step_counter < -1) state->t = t_int_l; else if(state->step_counter < -3) state->t = 0.5*t_old; state->t = GSL_MAX_DBL(GSL_MAX_DBL(0.1*t_old,state->t),state->t_min); state->step_counter = GSL_MIN_INT(state->step_counter-1,-1); if(fabs(state->t-t_old) > state->rg) state->step_counter = -1; } } state->lambda_min = p_norm * state->lm_accuracy; if(debug) { printf("\nthe new bundle:\n"); bundle_out_liste(state); printf("\n\n"); printf("the curent itarationspoint (1 x %d)\n",x->size); for(i=0;i<x->size;i++) printf("%12.6f ",gsl_vector_get(x,i)); printf("\n\n"); printf("functions value at current point: f=%.8f\n",*f); printf("\nstep length t=%.5e\n",state->t); printf("\nstep_counter sc=%d\n",state->step_counter); printf("\naccuracy: v=%.5e\n",state->v); printf("\nlambda_min=%e\n",state->lambda_min); printf("\n"); } gsl_vector_free(lambda); gsl_vector_free(y); gsl_vector_free(sgr_y); gsl_vector_free(p); return GSL_SUCCESS; }
double bayestar_log_posterior_toa_phoa_snr( double ra, double sin_dec, double distance, double u, double twopsi, double t, double gmst, /* Greenwich mean sidereal time in radians. */ int nifos, /* Input: number of detectors. */ const float (**responses)[3], /* Pointers to detector responses. */ const double **locations, /* Pointers to locations of detectors in Cartesian geographic coordinates. */ const double *toas, /* Input: array of times of arrival with arbitrary relative offset. (Make toas[0] == 0.) */ const double *phoas, /* Input: array of times of arrival with arbitrary relative offset. (Make toas[0] == 0.) */ const double *snrs, /* Input: array of SNRs. */ const double *w_toas, /* Input: sum-of-squares weights, (1/TOA variance)^2. */ const double *w1s, /* Input: first moments of angular frequency. */ const double *w2s, /* Input: second moments of angular frequency. */ const double *horizons, /* Distances at which a source would produce an SNR of 1 in each detector. */ int prior_distance_power) /* Use a prior of (distance)^(prior_distance_power) */ { int iifo; const double dec = asin(sin_dec); const double u2 = gsl_pow_2(u); const double complex exp_i_twopsi = exp_i(twopsi); (void)w2s; /* FIXME: remove unused parameter */ /* Compute time of arrival errors */ double dt[nifos]; toa_errors(dt, M_PI_2 - dec, ra, gmst, nifos, locations, toas); { double mean_dt = gsl_stats_wmean(w_toas, 1, dt, 1, nifos); for (iifo = 0; iifo < nifos; iifo++) dt[iifo] += t - mean_dt; } /* Rescale distances so that furthest horizon distance is 1. */ double d1[nifos]; { const double d1max = gsl_stats_max(horizons, 1, nifos); for (iifo = 0; iifo < nifos; iifo ++) d1[iifo] = horizons[iifo] / d1max; distance /= d1max; } double logp = 0; double complex i0arg_complex = 0; double A = 0; double B = 0; /* Loop over detectors */ for (iifo = 0; iifo < nifos; iifo++) { double complex F; XLALComputeDetAMResponse( (double *)&F, /* Type-punned real part */ 1 + (double *)&F, /* Type-punned imag part */ responses[iifo], ra, dec, 0, gmst); F *= d1[iifo]; const double complex tmp = F * exp_i_twopsi; double complex phase_rhotimesr = 0.5 * (1 + u2) * creal(tmp) + I * u * cimag(tmp); const double abs_rhotimesr_2 = cabs2(phase_rhotimesr); const double abs_rhotimesr = sqrt(abs_rhotimesr_2); phase_rhotimesr /= abs_rhotimesr; i0arg_complex += exp_i(phoas[iifo] + w1s[iifo] * dt[iifo]) * phase_rhotimesr * gsl_pow_2(snrs[iifo]); logp += -0.5 * w_toas[iifo] * gsl_pow_2(dt[iifo]); A += abs_rhotimesr_2; B += abs_rhotimesr * snrs[iifo]; } A *= -0.5; const double i0arg = cabs(i0arg_complex); /* Should be equivalent to, but more accurate than: logp += log(gsl_sf_bessel_I0(i0arg)) */ logp += log(gsl_sf_bessel_I0_scaled(i0arg)) + i0arg; logp += log_radial_integrand(distance, A, B, prior_distance_power); return logp; }
void AT_single_impact_local_dose_distrib( const long n, const double E_MeV_u[], const long particle_no[], const double fluence_cm2_or_dose_Gy[], const long material_no, const long rdd_model, const double rdd_parameter[], const long er_model, const long N2, const long n_bins_f1, const double f1_parameters[], const long stopping_power_source_no, double f1_d_Gy[], double f1_dd_Gy[], double frequency_1_Gy_f1[]) { long i, j; /* * Get relative fluence for beam components * Convert dose to fluence if necessary */ double* fluence_cm2 = (double*)calloc(n, sizeof(double)); if(fluence_cm2_or_dose_Gy[0] < 0){ double* dose_Gy = (double*)calloc(n, sizeof(double)); for (i = 0; i < n; i++){ dose_Gy[i] = -1.0 * fluence_cm2_or_dose_Gy[i]; } AT_fluence_cm2_from_dose_Gy( n, E_MeV_u, particle_no, dose_Gy, material_no, stopping_power_source_no, fluence_cm2); free( dose_Gy ); }else{ for (i = 0; i < n; i++){ fluence_cm2[i] = fluence_cm2_or_dose_Gy[i]; } } double* norm_fluence = (double*)calloc(n, sizeof(double)); AT_normalize( n, fluence_cm2, norm_fluence); free( fluence_cm2 ); /* * Prepare single impact local dose distribution histogram */ if(n_bins_f1 > 0){ const double step = AT_N2_to_step(N2); const long histo_type = AT_histo_log; // Find lowest and highest dose (looking at ALL particles) // TODO: redundant, already used in finding number of bins, replace double d_min_f1 = f1_parameters[0*AT_SC_F1_PARAMETERS_SINGLE_LENGTH + 3]; double d_max_f1 = f1_parameters[0*AT_SC_F1_PARAMETERS_SINGLE_LENGTH + 4]; for (i = 1; i < n; i++){ d_min_f1 = GSL_MIN(f1_parameters[i*AT_SC_F1_PARAMETERS_SINGLE_LENGTH + 3], d_min_f1); d_max_f1 = GSL_MAX(f1_parameters[i*AT_SC_F1_PARAMETERS_SINGLE_LENGTH + 4], d_max_f1); } double lowest_left_limit_f1 = d_min_f1; AT_histo_midpoints(n_bins_f1, lowest_left_limit_f1, step, histo_type, f1_d_Gy); AT_histo_bin_widths(n_bins_f1, lowest_left_limit_f1, step, histo_type, f1_dd_Gy); for (i = 0; i < n_bins_f1; i++){ frequency_1_Gy_f1[i] = 0.0; } /* * Fill histogram with single impact distribution(s) from individual components */ // loop over all components (i.e. particles and energies), compute contribution to f1 long n_bins_used = 1; for (i = 0; i < n; i++){ // Find lowest and highest dose for component double d_min_f1_comp = f1_parameters[i*AT_SC_F1_PARAMETERS_SINGLE_LENGTH + 3]; double d_max_f1_comp = f1_parameters[i*AT_SC_F1_PARAMETERS_SINGLE_LENGTH + 4]; // Find position and number of bins for component f1 in overall f1 long lowest_bin_no_comp = AT_histo_bin_no(n_bins_f1, lowest_left_limit_f1, step, histo_type, d_min_f1_comp); long highest_bin_no_comp = AT_histo_bin_no(n_bins_f1, lowest_left_limit_f1, step, histo_type, d_max_f1_comp); long n_bins_f1_comp = highest_bin_no_comp - lowest_bin_no_comp + 1; if (n_bins_f1_comp > 1){ /* * Compute component F1 (accumulated single impact density) * Computation is done with bin limits as sampling points and later differential * f1 will be computed (therefore we need one bin more) * The lowest and highest value for F1 have however to be adjusted as they might * not coincide with the actual min/max values for dose, r, and F1 resp. * They bin widths have to be the same though to assure the integral to be 1 * * At the limits F1 will be set to 0 and 1, resp. This enable to account for all * dose, e.g. also in the core, where many radii have the same dose. This procedure, * however, will only work with monotonously falling RDDs which we can assume for all * realistic cases. */ double* dose_left_limits_Gy_F1_comp = (double*)calloc(n_bins_f1_comp + 1, sizeof(double)); double* r_m_comp = (double*)calloc(n_bins_f1_comp + 1, sizeof(double)); double* F1_comp = (double*)calloc(n_bins_f1_comp + 1, sizeof(double)); // left limit of lowest bin for component double lowest_left_limit_f1_comp = 0.0; AT_histo_left_limit(n_bins_f1, lowest_left_limit_f1, step, histo_type, lowest_bin_no_comp, &lowest_left_limit_f1_comp); // get all left limits AT_histo_left_limits(n_bins_f1_comp + 1, lowest_left_limit_f1_comp, step, histo_type, dose_left_limits_Gy_F1_comp); // compute radius as function of dose (inverse RDD), // but not for lowest and highest value (i.e. 'n_bins_f1_comp - 1' // instead of 'n_bins_f1_comp + 1' and &dose_left_limits_Gy_F1_comp[1] // as entry point instead of dose_left_limits_Gy_F1_comp // exit in case of problems int inverse_RDD_status_code = AT_r_RDD_m ( n_bins_f1_comp - 1, &dose_left_limits_Gy_F1_comp[1], E_MeV_u[i], particle_no[i], material_no, rdd_model, rdd_parameter, er_model, stopping_power_source_no, &r_m_comp[1]); if( inverse_RDD_status_code != 0 ){ #ifndef NDEBUG printf("Problem in evaluating inverse RDD in AT_SC_get_f1, probably wrong combination of ER and RDD used\n"); #endif char rdd_model_name[100]; AT_RDD_name_from_number(rdd_model, rdd_model_name); char er_model_name[100]; getERName( er_model, er_model_name); #ifndef NDEBUG printf("rdd_model: %ld (%s), er_model: %ld (%s)\n", rdd_model, rdd_model_name, er_model, er_model_name); exit(EXIT_FAILURE); #endif } // compute F1 as function of radius // use F1 - 1 instead of F1 to avoid numeric cut-off problems double r_max_m_comp = f1_parameters[i * AT_SC_F1_PARAMETERS_SINGLE_LENGTH + 2]; for (j = 1; j < n_bins_f1_comp; j++){ F1_comp[j] = gsl_pow_2(r_m_comp[j] / r_max_m_comp); } // Set extreme values of F1 F1_comp[0] = 1.0; F1_comp[n_bins_f1_comp] = 0.0; // Write out F1 for debugging FILE* output = fopen("F1_output.csv", "w"); fprintf(output, "bin.no;r.m;d.Gy;F1\n"); for (j = 0; j < n_bins_f1_comp + 1; j++){ fprintf(output, "%ld;%7.6e;%7.6e;%7.6e\n", j, r_m_comp[j], dose_left_limits_Gy_F1_comp[j], F1_comp[j]); } fclose(output); // now compute f1 as the derivative of F1 and add to overall f1 double f1_comp; for (j = 0; j < n_bins_f1_comp; j++){ f1_comp = (F1_comp[j] - F1_comp[j + 1]) / (dose_left_limits_Gy_F1_comp[j + 1] - dose_left_limits_Gy_F1_comp[j]); frequency_1_Gy_f1[lowest_bin_no_comp + j] += norm_fluence[i] * f1_comp; } // adjust the density in first and last bin, because upper limit is not d.max.Gy and lower not d.min.Gy free(dose_left_limits_Gy_F1_comp); free(r_m_comp); free(F1_comp); } else{ // in case of n_bins_df == 1 (all doses fall into single bin, just add a value of 1.0 frequency_1_Gy_f1[lowest_bin_no_comp ] += norm_fluence[i] * 1.0 / f1_dd_Gy[lowest_bin_no_comp]; } // remember highest bin used n_bins_used = GSL_MAX(n_bins_used, highest_bin_no_comp); } // normalize f1 (should be ok anyway but there could be small round-off errors) double f1_norm = 0.0; for (i = 0; i < n_bins_f1; i++){ f1_norm += frequency_1_Gy_f1[i] * f1_dd_Gy[i]; } for (i = 0; i < n_bins_f1; i++){ frequency_1_Gy_f1[i] /= f1_norm; } } // if(f1_d_Gy != NULL) // Write out f1 for debugging FILE* output = fopen("f1_output.csv", "w"); fprintf(output, "bin.no;d.Gy;dd.Gy;f1\n"); for (int j = 0; j < n_bins_f1; j++){ fprintf(output, "%d;%7.6e;%7.6e;%7.6e\n", j, f1_d_Gy[j], f1_dd_Gy[j], frequency_1_Gy_f1[j]); } fclose(output); free( norm_fluence ); }
GPtrArray * nc_de_data_cluster_new (NcDistance *dist, NcmMSet *mset, NcDEDataClusterEntries *de_data_cluster, NcmDataset *dset, NcDataClusterAbundanceId id, NcmRNG *rng) { GPtrArray *ca_array = g_ptr_array_new (); gint filter_type; if (de_data_cluster->filter_type != NULL) { const GEnumValue *filter_type_id = ncm_cfg_get_enum_by_id_name_nick (NCM_TYPE_POWSPEC_FILTER_TYPE, de_data_cluster->filter_type); if (filter_type_id == NULL) { g_message ("DataCluster: Filter type `%s' not found. Use one from the following list:", de_data_cluster->filter_type); ncm_cfg_enum_print_all (NCM_TYPE_POWSPEC_FILTER_TYPE, "Powerspectrum filters"); g_error ("DataCluster: Giving up"); } filter_type = filter_type_id->value; } else filter_type = NCM_POWSPEC_FILTER_TYPE_TOPHAT; if (de_data_cluster->ps_type == NULL) { de_data_cluster->ps_type = g_strdup ("NcPowspecMLTransfer{'transfer' : <{'NcTransferFuncEH', @a{sv} {}}>}"); } if (de_data_cluster->multiplicity_name == NULL) { de_data_cluster->multiplicity_name = g_strdup ("NcMultiplicityFuncTinkerMean"); } if (de_data_cluster->clusterm_ser == NULL) { de_data_cluster->clusterm_ser = g_strdup ("NcClusterMassNodist"); } if (de_data_cluster->clusterz_ser == NULL) { de_data_cluster->clusterz_ser = g_strdup ("NcClusterRedshiftNodist"); } { NcClusterMass *clusterm = nc_cluster_mass_new_from_name (de_data_cluster->clusterm_ser); NcClusterRedshift *clusterz = nc_cluster_redshift_new_from_name (de_data_cluster->clusterz_ser); ncm_mset_set (mset, NCM_MODEL (clusterm)); ncm_mset_set (mset, NCM_MODEL (clusterz)); } { NcmPowspec *ps = NCM_POWSPEC (ncm_serialize_global_from_string (de_data_cluster->ps_type)); NcmPowspecFilter *psf = ncm_powspec_filter_new (ps, filter_type); NcMultiplicityFunc *mulf = nc_multiplicity_func_new_from_name (de_data_cluster->multiplicity_name); NcHaloMassFunction *mfp = nc_halo_mass_function_new (dist, psf, mulf); NcClusterAbundance *cad = nc_cluster_abundance_nodist_new (mfp, NULL); NcDataClusterNCount *ncount = nc_data_cluster_ncount_new (cad); ncm_powspec_clear (&ps); ncm_powspec_filter_clear (&psf); nc_multiplicity_func_free (mulf); nc_cluster_abundance_free (cad); switch (id) { #ifdef NUMCOSMO_HAVE_CFITSIO case NC_DATA_CLUSTER_ABUNDANCE_FIT: { gint i = 0; if (de_data_cluster->cata_file == NULL) g_error ("For --cluster-id 0, you must specify a fit catalog via --catalog file.fit"); while (de_data_cluster->cata_file[i] != NULL) { nc_data_cluster_ncount_catalog_load (ncount, de_data_cluster->cata_file[i]); nc_data_cluster_ncount_true_data (ncount, de_data_cluster->use_true_data); _nc_de_data_cluster_append (de_data_cluster, NCM_DATA (ncount), dset); g_ptr_array_add (ca_array, NCM_DATA (ncount)); if ((i == 0) && (de_data_cluster->save_cata != NULL)) nc_data_cluster_ncount_catalog_save (ncount, de_data_cluster->save_cata, TRUE); i++; } break; } #endif /* HAVE_CONFIG_H */ case NC_DATA_CLUSTER_ABUNDANCE_SAMPLING: { nc_data_cluster_ncount_init_from_sampling (ncount, mset, de_data_cluster->area_survey * gsl_pow_2 (M_PI / 180.0), rng); nc_data_cluster_ncount_true_data (ncount, de_data_cluster->use_true_data); if (de_data_cluster->save_cata != NULL) #ifdef NUMCOSMO_HAVE_CFITSIO nc_data_cluster_ncount_catalog_save (ncount, de_data_cluster->save_cata, TRUE); #else g_error ("darkenergy: cannot save file numcosmo built without support for fits files"); #endif /* HAVE_CONFIG_H */ _nc_de_data_cluster_append (de_data_cluster, NCM_DATA (ncount), dset); g_ptr_array_add (ca_array, NCM_DATA (ncount)); } break; default: g_error ("The option --catalog-id must be between (0,2)."); } nc_halo_mass_function_free (mfp); return ca_array; } }