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;
}
}
