double intersection_point()
{
gsl_root_fdfsolver* s;
odesolver_t funcsolver;
gsl_function_fdf fdf =
{.f = &func,
.df = &dfunc,
.fdf = &func_fdf,
.params = &funcsolver};
double x0, x=0.;
ode_alloc(&funcsolver);
s = gsl_root_fdfsolver_alloc(gsl_root_fdfsolver_steffenson);
gsl_root_fdfsolver_set(s, &fdf, x);
int status;
do {
gsl_root_fdfsolver_iterate(s);
x0 = x;
x = gsl_root_fdfsolver_root(s);
status = gsl_root_test_delta(x, x0, 0, 1e-12);
} while(status == GSL_CONTINUE);
double root = gsl_root_fdfsolver_root(s);
gsl_root_fdfsolver_free(s);
ode_free(&funcsolver);
if(status == GSL_SUCCESS)
return root;
else
return -1.;
}
void
test_fdf_e (const gsl_root_fdfsolver_type * T,
const char * description, gsl_function_fdf *fdf,
double root, double correct_root)
{
int status;
size_t iterations = 0;
double prev = 0 ;
gsl_root_fdfsolver * s = gsl_root_fdfsolver_alloc(T);
status = gsl_root_fdfsolver_set (s, fdf, root) ;
gsl_test (status, "%s (set), %s", T->name, description);
do
{
iterations++ ;
prev = gsl_root_fdfsolver_root(s);
gsl_root_fdfsolver_iterate (s);
status = gsl_root_test_delta(gsl_root_fdfsolver_root(s), prev,
EPSABS, EPSREL);
}
while (status == GSL_CONTINUE && iterations < MAX_ITERATIONS);
gsl_test (!status, "%s, %s", gsl_root_fdfsolver_name(s),
description, gsl_root_fdfsolver_root(s) - correct_root);
gsl_root_fdfsolver_free(s);
}
void satellite_free()
{
if(!solver) {
gsl_root_fdfsolver_free(solver);
solver= 0;
}
}
double tsolve_findroot_E(struct Tsolve * theTsolve){
int status;
int iter = 0, max_iter = 100;
const gsl_root_fdfsolver_type *T;
gsl_root_fdfsolver *s;
gsl_function_fdf FDF;
T = gsl_root_fdfsolver_newton;
s = gsl_root_fdfsolver_alloc (T);
FDF.f = &tsolve_E_eq;
FDF.df = &tsolve_E_eq_deriv;
FDF.fdf = &tsolve_E_eq_fdf;
FDF.params = theTsolve;
double Temp0; //store previous iteration value
double Temp = theTsolve->guess; // set initial guess here
gsl_root_fdfsolver_set (s, &FDF, Temp);
do
{
iter++;
status = gsl_root_fdfsolver_iterate (s);
Temp0 = Temp;
Temp = gsl_root_fdfsolver_root (s);
status = gsl_root_test_delta (Temp, Temp0, 0, 1e-12);
}
while (status == GSL_CONTINUE && iter < max_iter);
gsl_root_fdfsolver_free (s);
return(Temp);
}
CAMLprim value ml_gsl_root_fdfsolver_free(value s)
{
struct callback_params *p=Fparams_val(s);
remove_global_root(&(p->closure));
stat_free(p);
gsl_root_fdfsolver_free(FDFsolver_val(s));
return Val_unit;
}
double
fun_root (void *params)
{
int status;
int iter = 0, max_iter = 100;
int i;
const gsl_root_fdfsolver_type *T;
gsl_root_fdfsolver *s;
double x0, x, y;
gsl_function_fdf FDF_ri;
struct fun_root_params *p
= (struct fun_root_params *) params;
FDF_ri.f = &fun_ri;
FDF_ri.df = &fun_ri_deriv;
FDF_ri.fdf = &fun_ri_fdf;
FDF_ri.params = p;
x = p->rf;
T = gsl_root_fdfsolver_secant;
s = gsl_root_fdfsolver_alloc (T);
gsl_root_fdfsolver_set (s, &FDF_ri, x);
do
{
iter++;
status = gsl_root_fdfsolver_iterate (s);
x0 = x;
x = gsl_root_fdfsolver_root (s);
status = gsl_root_test_delta (x, x0, 0, 0.0000001);
// printf ("%5d %10.7f %10.7f\n",
// iter, x, x - x0);
}
while (status == GSL_CONTINUE && iter < max_iter);
// printf ("%5d %10.7f %10.7f %10.7f\n",
// iter, p->rf, x, x - x0);
y = x;
gsl_root_fdfsolver_free (s);
return y;
}
void
test_fdf (const gsl_root_fdfsolver_type * T, const char * description,
gsl_function_fdf *fdf, double root, double correct_root)
{
int status;
size_t iterations = 0;
double prev = 0 ;
gsl_root_fdfsolver * s = gsl_root_fdfsolver_alloc(T);
gsl_root_fdfsolver_set (s, fdf, root) ;
do
{
iterations++ ;
prev = gsl_root_fdfsolver_root(s);
gsl_root_fdfsolver_iterate (s);
status = gsl_root_test_delta(gsl_root_fdfsolver_root(s), prev,
EPSABS, EPSREL);
}
while (status == GSL_CONTINUE && iterations < MAX_ITERATIONS);
gsl_test (status, "%s, %s (%g obs vs %g expected) ",
gsl_root_fdfsolver_name(s), description,
gsl_root_fdfsolver_root(s), correct_root);
if (iterations == MAX_ITERATIONS)
{
gsl_test (GSL_FAILURE, "exceeded maximum number of iterations");
}
/* check the validity of the returned result */
if (!WITHIN_TOL (gsl_root_fdfsolver_root(s), correct_root,
EPSREL, EPSABS))
{
gsl_test (GSL_FAILURE, "incorrect precision (%g obs vs %g expected)",
gsl_root_fdfsolver_root(s), correct_root);
}
gsl_root_fdfsolver_free(s);
}
RunParams *init_params(char *fname_ini)
{
FILE *fi;
int n,ii,stat,ibin;
double *x,*a,*y,dchi;
RunParams *par=param_new();
par->cpar=csm_params_new();
read_parameter_file(fname_ini,par);
csm_unset_gsl_eh();
if(par->has_bg) {
double hub;
csm_background_set(par->cpar,par->om,par->ol,par->ob,par->w0,par->wa,par->h0,D_TCMB);
par->chi_horizon=csm_radial_comoving_distance(par->cpar,0.);
par->chi_kappa=csm_radial_comoving_distance(par->cpar,1./(1+par->z_kappa));
par->chi_isw=csm_radial_comoving_distance(par->cpar,1./(1+par->z_isw));
hub=csm_hubble(par->cpar,1.);
par->prefac_lensing=1.5*hub*hub*par->om;
n=(int)(par->chi_horizon/par->dchi)+1;
dchi=par->chi_horizon/n;
par->dchi=dchi;
x=(double *)my_malloc(n*sizeof(double));
a=(double *)my_malloc(n*sizeof(double));
y=(double *)my_malloc(n*sizeof(double));
for(ii=0;ii<n;ii++)
x[ii]=dchi*ii;
printf("Setting up background splines\n");
//Set chi <-> a correspondence
const gsl_root_fdfsolver_type *T=gsl_root_fdfsolver_newton;
gsl_root_fdfsolver *s=gsl_root_fdfsolver_alloc(T);
double a_old=1.0;
for(ii=0;ii<n;ii++)
a[ii]=a_of_chi(x[ii],par->cpar,&a_old,s);
gsl_root_fdfsolver_free(s);
par->aofchi=spline_init(n,x,a,1.0,0.0);
//Compute redshift
for(ii=0;ii<n;ii++)
y[ii]=1./a[ii]-1;
par->zofchi=spline_init(n,x,y,y[0],y[n-1]);
//Compute hubble scale
for(ii=0;ii<n;ii++)
y[ii]=csm_hubble(par->cpar,a[ii]);
par->hofchi=spline_init(n,x,y,y[0],y[n-1]);
//Compute growth factor
double g0=csm_growth_factor(par->cpar,1.0);
for(ii=0;ii<n;ii++)
y[ii]=csm_growth_factor(par->cpar,a[ii])/g0;
par->gfofchi=spline_init(n,x,y,1.,0.);
//Compute growth rate
for(ii=0;ii<n;ii++)
y[ii]=csm_f_growth(par->cpar,a[ii]);
par->fgofchi=spline_init(n,x,y,y[0],1.);
free(x); free(a); free(y);
}
//Allocate power spectra
if(par->do_nc) {
par->cl_dd=(double *)my_malloc((par->lmax+1)*sizeof(double));
if(par->do_shear) {
par->cl_d1l2=(double *)my_malloc((par->lmax+1)*sizeof(double));
par->cl_d2l1=(double *)my_malloc((par->lmax+1)*sizeof(double));
}
if(par->do_cmblens)
par->cl_dc=(double *)my_malloc((par->lmax+1)*sizeof(double));
if(par->do_isw)
par->cl_di=(double *)my_malloc((par->lmax+1)*sizeof(double));
}
if(par->do_shear) {
par->cl_ll=(double *)my_malloc((par->lmax+1)*sizeof(double));
if(par->do_cmblens)
par->cl_lc=(double *)my_malloc((par->lmax+1)*sizeof(double));
if(par->do_isw)
par->cl_li=(double *)my_malloc((par->lmax+1)*sizeof(double));
}
if(par->do_cmblens) {
par->cl_cc=(double *)my_malloc((par->lmax+1)*sizeof(double));
if(par->do_isw)
par->cl_ci=(double *)my_malloc((par->lmax+1)*sizeof(double));
}
if(par->do_isw)
par->cl_ii=(double *)my_malloc((par->lmax+1)*sizeof(double));
if(par->do_w_theta) {
if(par->do_nc) {
par->wt_dd=(double *)my_malloc(par->n_th*sizeof(double));
if(par->do_shear) {
par->wt_d1l2=(double *)my_malloc(par->n_th*sizeof(double));
par->wt_d2l1=(double *)my_malloc(par->n_th*sizeof(double));
}
if(par->do_cmblens)
par->wt_dc=(double *)my_malloc(par->n_th*sizeof(double));
if(par->do_isw)
par->wt_di=(double *)my_malloc(par->n_th*sizeof(double));
}
if(par->do_shear) {
par->wt_ll_pp=(double *)my_malloc(par->n_th*sizeof(double));
par->wt_ll_mm=(double *)my_malloc(par->n_th*sizeof(double));
if(par->do_cmblens)
par->wt_lc=(double *)my_malloc(par->n_th*sizeof(double));
if(par->do_isw)
par->wt_li=(double *)my_malloc(par->n_th*sizeof(double));
}
if(par->do_cmblens) {
par->wt_cc=(double *)my_malloc(par->n_th*sizeof(double));
if(par->do_isw)
par->wt_ci=(double *)my_malloc(par->n_th*sizeof(double));
}
if(par->do_isw)
par->wt_ii=(double *)my_malloc(par->n_th*sizeof(double));
}
if(par->do_nc || par->do_shear || par->do_cmblens || par->do_isw)
csm_set_linear_pk(par->cpar,par->fname_pk,D_LKMIN,D_LKMAX,0.01,par->ns,par->s8);
if(par->do_nc || par->do_shear) {
par->wind_0=my_malloc(2*sizeof(SplPar *));
for(ibin=0;ibin<2;ibin++) {
printf("Reading window function %s\n",par->fname_window[ibin]);
fi=my_fopen(par->fname_window[ibin],"r");
n=my_linecount(fi); rewind(fi);
//Read unnormalized window
x=(double *)my_malloc(n*sizeof(double));
y=(double *)my_malloc(n*sizeof(double));
for(ii=0;ii<n;ii++) {
stat=fscanf(fi,"%lE %lE",&(x[ii]),&(y[ii]));
if(stat!=2)
report_error(1,"Error reading file, line %d\n",ii+1);
}
fclose(fi);
par->wind_0[ibin]=spline_init(n,x,y,0.,0.);
//Normalize window
double norm,enorm;
gsl_function F;
gsl_integration_workspace *w=gsl_integration_workspace_alloc(1000);
F.function=&speval_bis;
F.params=par->wind_0[ibin];
gsl_integration_qag(&F,x[0],x[n-1],0,1E-4,1000,GSL_INTEG_GAUSS41,w,&norm,&enorm);
gsl_integration_workspace_free(w);
for(ii=0;ii<n;ii++)
y[ii]/=norm;
spline_free(par->wind_0[ibin]);
par->wind_0[ibin]=spline_init(n,x,y,0.,0.);
double zmin,zmax;
double ymax=-1000;
for(ii=0;ii<n;ii++) {
if(y[ii]>ymax)
ymax=y[ii];
}
ii=0;
while(y[ii]<1E-3*ymax)
ii++;
zmin=x[ii];
ii=n-1;
while(y[ii]<1E-3*ymax)
ii--;
zmax=x[ii];
par->chimin_nc[ibin]=csm_radial_comoving_distance(par->cpar,1./(1+zmin));
par->chimax_nc[ibin]=csm_radial_comoving_distance(par->cpar,1./(1+zmax));
#ifdef _DEBUG
printf("%d %lE %lE %lE %lE\n",
ibin,zmin,zmax,par->chimin_nc[ibin],par->chimax_nc[ibin]);
#endif //_DEBUG
free(x); free(y);
}
}
if(par->do_nc) {
if(par->has_dens==1) {
printf("Reading bias function %s\n",par->fname_bias);
fi=my_fopen(par->fname_bias,"r");
n=my_linecount(fi); rewind(fi);
//Read bias
x=(double *)my_malloc(n*sizeof(double));
y=(double *)my_malloc(n*sizeof(double));
for(ii=0;ii<n;ii++) {
stat=fscanf(fi,"%lE %lE",&(x[ii]),&(y[ii]));
if(stat!=2)
report_error(1,"Error reading file, line %d\n",ii+1);
}
fclose(fi);
par->bias=spline_init(n,x,y,y[0],y[n-1]);
free(x); free(y);
}
if(par->has_lensing==1) {
printf("Reading s-bias function %s\n",par->fname_sbias);
fi=my_fopen(par->fname_sbias,"r");
n=my_linecount(fi); rewind(fi);
//Read s-bias
x=(double *)my_malloc(n*sizeof(double));
y=(double *)my_malloc(n*sizeof(double));
for(ii=0;ii<n;ii++) {
stat=fscanf(fi,"%lE %lE",&(x[ii]),&(y[ii]));
if(stat!=2)
report_error(1,"Error reading file, line %d\n",ii+1);
}
fclose(fi);
par->sbias=spline_init(n,x,y,y[0],y[n-1]);
free(x); free(y);
printf("Computing lensing magnification window function\n");
par->wind_M=my_malloc(2*sizeof(SplPar *));
for(ibin=0;ibin<2;ibin++) {
double dchi_here;
double zmax=par->wind_0[ibin]->xf;
double chimax=csm_radial_comoving_distance(par->cpar,1./(1+zmax));
n=(int)(chimax/par->dchi)+1;
dchi_here=chimax/n;
x=(double *)my_malloc(n*sizeof(double));
y=(double *)my_malloc(n*sizeof(double));
#ifdef _HAVE_OMP
#pragma omp parallel default(none) shared(n,x,y,par,dchi_here,ibin)
{
#endif //_HAVE_OMP
int j;
#ifdef _HAVE_OMP
#pragma omp for
#endif //_HAVE_OMP
for(j=0;j<n;j++) {
x[j]=dchi_here*j;
y[j]=window_magnification(x[j],par,ibin);
} //end omp for
#ifdef _HAVE_OMP
} //end omp parallel
#endif //_HAVE_OMP
par->wind_M[ibin]=spline_init(n,x,y,y[0],0);
free(x); free(y);
}
}
}
if(par->do_shear) {
if(par->has_intrinsic_alignment==1) {
printf("Reading IA bias function %s\n",par->fname_abias);
fi=my_fopen(par->fname_abias,"r");
n=my_linecount(fi); rewind(fi);
//Read bias
x=(double *)my_malloc(n*sizeof(double));
y=(double *)my_malloc(n*sizeof(double));
for(ii=0;ii<n;ii++) {
stat=fscanf(fi,"%lE %lE",&(x[ii]),&(y[ii]));
if(stat!=2)
report_error(1,"Error reading file, line %d\n",ii+1);
}
fclose(fi);
par->abias=spline_init(n,x,y,y[0],y[n-1]);
free(x); free(y);
}
printf("Computing lensing window function\n");
par->wind_L=my_malloc(2*sizeof(SplPar *));
for(ibin=0;ibin<2;ibin++) {
double dchi_here;
double zmax=par->wind_0[ibin]->xf;
double chimax=csm_radial_comoving_distance(par->cpar,1./(1+zmax));
n=(int)(chimax/par->dchi)+1;
dchi_here=chimax/n;
x=(double *)my_malloc(n*sizeof(double));
y=(double *)my_malloc(n*sizeof(double));
#ifdef _HAVE_OMP
#pragma omp parallel default(none) shared(n,x,y,par,dchi_here,ibin)
{
#endif //_HAVE_OMP
int j;
#ifdef _HAVE_OMP
#pragma omp for
#endif //_HAVE_OMP
for(j=0;j<n;j++) {
x[j]=dchi_here*j;
y[j]=window_lensing(x[j],par,ibin);
}
#ifdef _HAVE_OMP
} //end omp parallel
#endif //_HAVE_OMP
par->wind_L[ibin]=spline_init(n,x,y,y[0],0);
free(x); free(y);
}
}
#ifdef _DEBUG
print_bg(par);
#endif //_DEBUG
return par;
}