double ANACalculatorCoplanarTriple::I(const double qx, const double qz, double & err)
{
static double result, abserr;
m_qx = qx;
m_qz = qz;
err = 0.0;
/*here integration over x is performed*/
for(size_t i = 0; i < m_sampling; ++i)
{
result = 0.0;
abserr = 0.0;
prepare(m_z1[i]);
//gsl_integration_qawo_table_set(m_qawo_table, m_frequency, 1, GSL_INTEG_COSINE);
//gsl_integration_qawf (&m_function, m_a, m_epsabs, m_limit, m_workspace, m_cyclic_workspace, m_qawo_table, &result, &abserr);
gsl_integration_qagiu (&m_function, m_a, m_epsabs, 1.e-6, m_limit, m_workspace, &result, &abserr);
m_integrand_values[i] = 2 * result * m_scale;
err += 2 * abserr;
//std::cout << m_z1[i] << "\t" << m_integrand_values[i] << std::endl;
}
/*here integration over z1 is performed*/
//double gsl_interp_eval_integ (const gsl_interp * interp, const double xa[], const double ya[], double a, double b, gsl_interp_accel * acc)
gsl_interp_init (m_interp, m_z1, m_integrand_values, m_sampling);
result = gsl_interp_eval_integ (m_interp, m_z1, m_integrand_values, m_z1[0], m_z1[m_sampling-1], m_accel);
return result;
}
TransformationModelInterpolated::TransformationModelInterpolated(
const TransformationModel::DataPoints & data, const Param & params)
{
params_ = params;
Param defaults;
getDefaultParameters(defaults);
params_.setDefaults(defaults);
// need monotonically increasing x values (can't have the same value twice):
map<DoubleReal, vector<DoubleReal> > mapping;
for (TransformationModel::DataPoints::const_iterator it = data.begin();
it != data.end(); ++it)
{
mapping[it->first].push_back(it->second);
}
size_ = mapping.size();
x_.resize(size_);
y_.resize(size_);
size_t i = 0;
for (map<DoubleReal, vector<DoubleReal> >::const_iterator it =
mapping.begin(); it != mapping.end(); ++it, ++i)
{
x_[i] = it->first;
// use average y value:
y_[i] = accumulate(it->second.begin(), it->second.end(), 0.0) /
it->second.size();
}
String interpolation_type = params_.getValue("interpolation_type");
const gsl_interp_type * type;
if (interpolation_type == "linear")
type = gsl_interp_linear;
else if (interpolation_type == "polynomial")
type = gsl_interp_polynomial;
else if (interpolation_type == "cspline")
type = gsl_interp_cspline;
else if (interpolation_type == "akima")
type = gsl_interp_akima;
else
{
throw Exception::IllegalArgument(__FILE__, __LINE__, __PRETTY_FUNCTION__, "unknown/unsupported interpolation type '" + interpolation_type + "'");
}
size_t min_size = type->min_size;
if (size_ < min_size)
{
throw Exception::IllegalArgument(__FILE__, __LINE__, __PRETTY_FUNCTION__, "'" + interpolation_type + "' interpolation model needs at least " + String(min_size) + " data points (with unique x values)");
}
interp_ = gsl_interp_alloc(type, size_);
acc_ = gsl_interp_accel_alloc();
double * x_start = &(x_[0]), * y_start = &(y_[0]);
gsl_interp_init(interp_, x_start, y_start, size_);
// linear model for extrapolation:
TransformationModel::DataPoints lm_data(2);
lm_data[0] = make_pair(x_[0], y_[0]);
lm_data[1] = make_pair(x_[size_ - 1], y_[size_ - 1]);
lm_ = new TransformationModelLinear(lm_data, Param());
}
static VALUE rb_gsl_interp_new(int argc, VALUE *argv, VALUE klass)
{
rb_gsl_interp *sp = NULL;
const gsl_interp_type *T = NULL;
double *ptrx = NULL, *ptry = NULL;
size_t sizex = 0, sizey = 0, size = 0, stride = 1;
int i;
for (i = 0; i < argc; i++) {
switch (TYPE(argv[i])) {
case T_STRING:
T = get_interp_type(argv[i]);
break;
case T_FIXNUM:
if (T) size = FIX2INT(argv[i]);
else T = get_interp_type(argv[i]);
break;
default:
if (ptrx == NULL) {
ptrx = get_vector_ptr(argv[i], &stride, &sizex);
} else {
ptry = get_vector_ptr(argv[i], &stride, &sizey);
size = GSL_MIN_INT(sizex, sizey);
}
break;
}
}
if (size == 0) rb_raise(rb_eRuntimeError, "interp size is not given.");
sp = ALLOC(rb_gsl_interp);
if (T == NULL) T = gsl_interp_cspline;
sp->p = gsl_interp_alloc(T, size);
sp->a = gsl_interp_accel_alloc();
if (ptrx && ptry) gsl_interp_init(sp->p, ptrx, ptry, size);
return Data_Wrap_Struct(klass, 0, rb_gsl_interp_free, sp);
}
void smoothing_integrate(smoothing_params ¶ms, int n) {
int n_int = 2*n;
params.acc_y = gsl_interp_accel_alloc();
params.int_y = gsl_interp_alloc(gsl_interp_linear, n);
params.n = n;
gsl_interp_init(params.int_y, params.arr_x, params.arr_y, n);
/* setup integration workspace */
gsl_integration_workspace *w = gsl_integration_workspace_alloc(n_int);
gsl_function F;
F.function = &smoothing_integrand;
F.params = ¶ms;
double eps_abs = 0.0, eps_rel = 0.01;
double result, error;
gsl_set_error_handler_off();
for (int i = 0; i < n; i++) {
params.x = params.arr_x[i];
params.h = 0.1; //0.1*params.x + 1.0e-4;
gsl_integration_qag(&F,
params.x - 2*params.h, params.x + 2*params.h,
eps_abs, eps_rel,
n_int, 1,
w, &result, &error);
params.smoothed_y[i] = result;
}
gsl_integration_workspace_free(w);
gsl_interp_accel_free(params.acc_y);
gsl_interp_free(params.int_y);
}
/**
* The function fills the flux information from a point in
* a fluxcube structure into the flux part of a direct object.
*
* @param fcube - the fluxcube structure
* @param point - the position to take the flux from
* @param actdir - the direct object to update
*
*/
void fill_fluxvalues(const flux_cube *fcube, const px_point point,
dirobject *actdir, const int inter_type)
{
energy_distrib *sed;
double *sed_wavs;
double *sed_flux;
int i;
int iact;
sed = (energy_distrib*) malloc(sizeof(energy_distrib));
sed_wavs = (double*) malloc(fcube->n_fimage*sizeof(double));
sed_flux = (double*) malloc(fcube->n_fimage*sizeof(double));
if (actdir->SED)
free_enerdist (actdir->SED);
// go over each fluximage in the fluxcube structure
for (i=0; i < fcube->n_fimage; i++)
{
// determine the index of the next fluximage
iact = gsl_vector_int_get(fcube->fimage_order, i);
// transfer the wavelength and flux from the fluxcube
sed_wavs[i] = fcube->fluxims[iact]->wavelength;
sed_flux[i] = gsl_matrix_get(fcube->fluxims[iact]->flux, point.x, point.y);
}
sed->npoints = fcube->n_fimage;
sed->wavelength = sed_wavs ;
sed->flux = sed_flux;
if (fcube->n_fimage > 1)
{
if (inter_type == 2)
sed->interp = gsl_interp_alloc (gsl_interp_polynomial, (size_t)fcube->n_fimage);
else if (inter_type == 3)
sed->interp = gsl_interp_alloc (gsl_interp_cspline, (size_t)fcube->n_fimage);
else
sed->interp = gsl_interp_alloc (gsl_interp_linear, (size_t)fcube->n_fimage);
sed->accel = gsl_interp_accel_alloc ();
gsl_interp_init (sed->interp, sed->wavelength, sed->flux, (size_t)sed->npoints);
}
else
{
sed->interp = NULL;
sed->accel= NULL;
}
// transfer the SED;
// announce the SED
actdir->SED = sed;
actdir->bb_sed = 1;
}
// -----------------------------------------------------------------------------
void hand_anim_chg(int p, double x, double y)
{
DEBUGLOGB;
if( p >= 0 && p < g_curvePtsN )
{
g_curvePtsX[p] = x;
g_curvePtsY[p] = y;
#ifdef _USEGSL
#ifdef _USEGSL_STATIC
if( g_curveTerp )
gsl_interp_init(g_curveTerp, g_curvePtsX, g_curvePtsY, g_curvePtsN);
if( g_curveAccl )
gsl_interp_accel_reset(g_curveAccl);
#else // _USEGSL_STATIC
if( g_pLLibok )
{
if( g_curveTerp )
g_gsl_interp_init(g_curveTerp, g_curvePtsX, g_curvePtsY, g_curvePtsN);
if( g_curveAccl )
g_gsl_interp_accel_reset(g_curveAccl);
}
else
{
g_curvePtsS[0] = 0;
for( int i = 1; i < g_curvePtsN; i++ )
{
g_curvePtsS[i] =
(g_curvePtsY[i] - g_curvePtsY[i-1])/(g_curvePtsX[i] - g_curvePtsX[i-1]);
}
}
#endif // _USEGSL_STATIC
#else // _USEGSL
#ifdef _USESPLINE
csp::set_points(g_curve, g_curvePtsX, g_curvePtsY, g_curvePtsN);
#else
g_curvePtsS[0] = 0;
for( int i = 1; i < g_curvePtsN; i++ )
{
g_curvePtsS[i] =
(g_curvePtsY[i] - g_curvePtsY[i-1])/(g_curvePtsX[i] - g_curvePtsX[i-1]);
}
#endif // _USESPLINE
#endif // _USEGSL
}
DEBUGLOGE;
}
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);
}
void csinterp(double x[], double y[], double nx[], double ny[], int m, int n) {
int i;
gsl_interp *workspace;
/* type of Interpolation: Cubic Spline */
workspace = gsl_interp_alloc(gsl_interp_cspline, m);
gsl_interp_init(workspace, x, y, m); /* Initialize worksp */
for(i = 0; i < n; i++)
ny[i] = gsl_interp_eval(workspace, x, y, nx[i], NULL);
gsl_interp_free(workspace); /* free memory */
}
static VALUE rb_gsl_interp_init(VALUE obj, VALUE xxa, VALUE yya)
{
rb_gsl_interp *rgi = NULL;
double *ptrx = NULL, *ptry = NULL;
size_t size, stride;
ptrx = get_vector_ptr(xxa, &stride, &size);
ptry = get_vector_ptr(yya, &stride, &size);
Data_Get_Struct(obj, rb_gsl_interp, rgi);
gsl_interp_init(rgi->p, ptrx, ptry, size);
return obj;
}
void NonlinearProperty::initialize()
{
if (m_strain.size() > 2) {
if (m_interp)
gsl_interp_free(m_interp);
m_interp = gsl_interp_alloc(gsl_interp_cspline, m_strain.size());
gsl_interp_init(m_interp, m_strain.data(), m_varied.data(), m_strain.size());
gsl_interp_accel_reset(m_acc);
}
}
MfCumulative::MfCumulative(Sigma* const s, const double a) :
n(1001)
{
M_array= (double*) malloc(sizeof(double)*n*2); assert(M_array);
nM_array= M_array + n;
rho_m= cosmology_rho_m();
const double z= 1.0/a - 1.0;
MF* const mf= mf_alloc();
mf_set_redshift(mf, a);
const double D= growth_D(a);
MfcParams params;
params.mf= mf;
params.s= s;
params.D= D;
gsl_integration_cquad_workspace* const w=
gsl_integration_cquad_workspace_alloc(100);
gsl_function F;
F.function= &integrand_n_cumulative;
F.params= (void*) ¶ms;
const double logMmin= log(s->M_min);
const double logMmax= log(s->M_max);
const double nu_min= delta_c*s->sinv_min;
const double nu_max= delta_c*s->sinv_max;
for(int i=0; i<n; ++i) {
double MM= exp(logMmin + (n-i-1)*(logMmax - logMmin)/(n-1));
M_array[i]= MM;
double nu= delta_c/D*s->sigma0_inv(MM); assert(nu >= nu_min);
double result;
gsl_integration_cquad(&F, 1.0e-8, nu_max, 1.0e-5, 1.0e-5, w, &result, 0, 0);
nM_array[i]= result;
}
nM_max= nM_array[n-1];
interp= gsl_interp_alloc(gsl_interp_cspline, n);
acc= gsl_interp_accel_alloc();
//gsl_interp_init(interp, M_array, nM_array, n);
gsl_interp_init(interp, nM_array, M_array, n);
gsl_integration_cquad_workspace_free(w);
mf_free(mf);
}
int
gsl_spline_init (gsl_spline * spline, const double x_array[], const double y_array[], size_t size)
{
if (size != spline->size)
{
GSL_ERROR ("data must match size of spline object", GSL_EINVAL);
}
memcpy (spline->x, x_array, size * sizeof(double));
memcpy (spline->y, y_array, size * sizeof(double));
{
int status = gsl_interp_init (spline->interp, x_array, y_array, size);
return status;
}
}
int findzofA(double Gmu, double alpha)
{
double lnz_min = log(1e-20), lnz_max = log(1e10), dlnz =0.05;
size_t numz = floor( (lnz_max - lnz_min)/dlnz );
int i,j;
cs_cosmo_functions_t cosmofns;
double *fz,*z;
double a;
gsl_interp *zofa_interp;
gsl_interp_accel *acc_zofa = gsl_interp_accel_alloc();
cosmofns = XLALCSCosmoFunctionsAlloc( exp( lnz_min ), dlnz, numz );
zofa_interp = gsl_interp_alloc (gsl_interp_linear, cosmofns.n);
fz = calloc( cosmofns.n, sizeof( *fz ) );
z = calloc( cosmofns.n, sizeof( *z ) );
/* first compute the function that relates A and z */
/* invert order; b/c fz is a monotonically decreasing func of z */
j=0;
for ( i = cosmofns.n-1 ; i >= 0; i-- )
{
z[j]=cosmofns.z[i];
fz[j] = pow(cosmofns.phit[i],2.0/3.0) * pow(1+z[j],-1.0/3.0) / cosmofns.phiA[i];
j=j+1;
}
gsl_interp_init (zofa_interp, fz, z, cosmofns.n);
/* now compute the amplitudes (suitably multiplied) that are equal to fz for some z*/
for ( j = 0; j < Namp; j++ )
{
a = amp[j] * pow(H0,-1.0/3.0) * pow(alpha,-2.0/3.0) / Gmu;
zofA[j] = gsl_interp_eval (zofa_interp, fz, z, a, acc_zofa );
/* fprintf(stdout,"%e %e %e\n", amp[j],a, zofA[j]); */
}
XLALCSCosmoFunctionsFree( cosmofns );
free(fz);
free(z);
gsl_interp_free (zofa_interp);
gsl_interp_accel_free(acc_zofa);
return 0;
}
// ctor
zintrp_t(
std::array<blitz::Array<double, 1>,2> &&data,
const params_t ¶ms
)
: data(std::move(data)), params(params)
{
gslerr_init();
if (data[0].size() != data[1].size())
throw std::runtime_error("arrays not of same size!");
accl = gsl_interp_accel_alloc();
intp = gsl_interp_alloc(gsl_interp_cspline_periodic, data[0].size());
int status;
status = gsl_interp_init(intp, data[0].data(), data[1].data(), data[0].size());
assert(status == GSL_SUCCESS);
}
static int
test_interp (
const xy_table * data_table,
const gsl_interp_type * T,
xy_table * test_table,
xy_table * test_d_table,
xy_table * test_i_table
)
{
int status = 0;
size_t i;
gsl_interp_accel *a = gsl_interp_accel_alloc ();
gsl_interp *interp = gsl_interp_alloc (T, data_table->n);
gsl_interp_init (interp, data_table->x, data_table->y, data_table->n);
for (i = 0; i < test_table->n; i++)
{
double x = test_table->x[i];
double y;
double deriv;
double integ;
double diff_y, diff_deriv, diff_integ;
gsl_interp_eval_e (interp, data_table->x, data_table->y, x, a, &y);
gsl_interp_eval_deriv_e (interp, data_table->x, data_table->y, x, a, &deriv);
gsl_interp_eval_integ_e (interp, data_table->x, data_table->y, 0.0, x, a, &integ);
diff_y = y - test_table->y[i];
diff_deriv = deriv - test_d_table->y[i];
diff_integ = integ - test_i_table->y[i];
if (fabs (diff_y) > 1.e-10 || fabs(diff_deriv) > 1.0e-10 || fabs(diff_integ) > 1.0e-10) {
status++;
}
}
gsl_interp_accel_free (a);
gsl_interp_free (interp);
return status;
}
pdf_redshift::pdf_redshift(std::valarray< double >& zSampling, std::valarray< double >& pdz)
{
// Allocate arrays to store pdf samples
nPoints = zSampling.size();
x = (double*) malloc(sizeof(double) * nPoints);
y = (double*) malloc(sizeof(double) * nPoints);
// Copy array data
for(int i =0; i < nPoints; i++){
x[i] = zSampling[i];
y[i] = pdz[i];
}
interpolator = gsl_interp_alloc(gsl_interp_cspline, nPoints);
accelerator = gsl_interp_accel_alloc();
gsl_interp_init(interpolator, x, y, nPoints);
// Compute normalization factor
normalizationFactor = 1.0 / gsl_interp_eval_integ(interpolator, x, y, x[0], x[nPoints-1], accelerator);
}
// -----------------------------------------------------------------------------
// -----------------------------------------------------------------------------
void hand_anim_set(const double* xs, const double* ys, int n)
{
DEBUGLOGB;
DEBUGLOGP("xs is %s, ys is %s, n is %d\n", xs ? "valid" : "NOT valid", ys ? "valid" : "NOT valid", n);
if( n > g_curvePtsM )
n = g_curvePtsM;
g_curvePtsN = n;
if( n && (xs || ys) )
{
for( int i = 0; i < n; i++ )
{
if( xs ) g_curvePtsX[i] = xs[i];
if( ys ) g_curvePtsY[i] = ys[i];
}
#ifdef _USEGSL
#ifdef _USEGSL_STATIC
if( g_curveTerp )
{
gsl_interp_free(g_curveTerp);
g_curveTerp = NULL;
}
g_curveTerp = gsl_interp_alloc(g_curveType, g_curvePtsN);
if( g_curveTerp )
gsl_interp_init(g_curveTerp, g_curvePtsX, g_curvePtsY, g_curvePtsN);
if( g_curveAccl )
gsl_interp_accel_reset(g_curveAccl);
#else // _USEGSL_STATIC
if( g_pLLibok )
{
if( g_curveTerp )
{
g_gsl_interp_free(g_curveTerp);
g_curveTerp = NULL;
}
g_curveTerp = g_gsl_interp_alloc(g_curveType, g_curvePtsN);
if( g_curveTerp )
g_gsl_interp_init(g_curveTerp, g_curvePtsX, g_curvePtsY, g_curvePtsN);
if( g_curveAccl )
g_gsl_interp_accel_reset(g_curveAccl);
}
else
{
g_curvePtsS[0] = 0;
for( int i = 1; i < g_curvePtsN; i++ )
{
g_curvePtsS[i] =
(g_curvePtsY[i] - g_curvePtsY[i-1])/(g_curvePtsX[i] - g_curvePtsX[i-1]);
}
}
#endif // _USEGSL_STATIC
#else // _USEGSL
#ifdef _USESPLINE
csp::set_points(g_curve, g_curvePtsX, g_curvePtsY, g_curvePtsN);
#else
g_curvePtsS[0] = 0;
for( int i = 1; i < g_curvePtsN; i++ )
{
g_curvePtsS[i] =
(g_curvePtsY[i] - g_curvePtsY[i-1])/(g_curvePtsX[i] - g_curvePtsX[i-1]);
}
#endif // _USESPLINE
#endif // _USEGSL
}
DEBUGLOGE;
}
static void
prepare_interp(struct disp_sample_table *dt)
{
gsl_interp_init(dt->interp_n, wavelength_array(dt), n_array(dt), dt->len);
gsl_interp_init(dt->interp_k, wavelength_array(dt), k_array(dt), dt->len);
}
/* \fcnfh
Interpolates 'src' into 'res' according to the new dimensions, first
interpolates the second dimension and then the first. The result is
added to whatever it is already existent in 'res'
Return: 0 on success */
int
bicubicinterpolate(double **res, /* target array [t1][t2] */
double **src, /* Source array [x1][x2] */
double *x1, /* Source first array */
long nx1, /* Size of x1 */
double *x2, /* Source second array */
long nx2, /* Size of x2 */
double *t1, /* Requested fisrt array */
long nt1, /* Size of t1 */
double *t2, /* Requested second array */
long nt2){ /* Size of t2 */
long i, j; /* Auxiliary for indices */
/* First and last values of source arrays: */
double fx1=x1[0], fx2=x2[0], lx1=x1[nx1-1], lx2=x2[nx2-1];
long lj=nt2, fj=0;
long li=nt1, fi=0;
#ifndef _USE_GSL
#error We cannot spline interpolate without GSL to obtain CIA opacities
#endif
/* Return if sampling regions don't match: */
if(t1[0]>lx1 || t1[nt1-1]<fx1 || t2[0]>lx2 || t2[nt2-1]<fx2)
return 0;
/* Find indices where requested array values are within source boundaries
(i.e., do not extrapolate): */
while(t1[fi++]<fx1);
fi--;
for(i=0; i<li; i++)
if(t1[i]>lx1)
li = i;
while(t2[fj++]<fx2);
fj--;
for(j=0; j<lj; j++)
if(t2[j]>lx2)
lj = j;
double **f2 = (double **)malloc(nt2 *sizeof(double *));
f2[0] = (double *)malloc(nt2*nx1*sizeof(double ));
for(i=1; i<nt2; i++)
f2[i] = f2[0] + i*nx1;
gsl_interp_accel *acc;
gsl_interp *spl;
for(i=0; i<nx1; i++){
acc = gsl_interp_accel_alloc();
spl = gsl_interp_alloc(gsl_interp_cspline, nx2);
gsl_interp_init(spl, x2, src[i], nx2);
for(j=fj; j<lj; j++)
f2[j][i] = gsl_interp_eval(spl, x2, src[i], t2[j], acc);
gsl_interp_free(spl);
gsl_interp_accel_free(acc);
}
for(j=fj; j<lj; j++){
acc = gsl_interp_accel_alloc();
spl = gsl_interp_alloc(gsl_interp_cspline, nx1);
gsl_interp_init(spl, x1, f2[j], nx1);
for(i=fi; i<li; i++)
res[i][j] += gsl_interp_eval(spl, x1, f2[j], t1[i], acc);
gsl_interp_free(spl);
gsl_interp_accel_free(acc);
}
free(f2[0]);
free(f2);
return 0;
}
/* \fcnfh
Computes optical depth at a given impact parameter, note that b needs
to be given in units of 'rad' and the result needs to be multiplied by
the units 'rad' to be real.
There is no ray bending, refr=constant.
It can take nrad values of 1 or bigger. However, if 2 is given then
'ex' and 'rad' need to have a referenceable element at position
-1; i.e. rad[-1] and ex[-1] need to exist.
@returns $\frac{tau}{units_{rad}}$ returns optical depth divided by units
of 'rad'
*/
static PREC_RES
totaltau1(PREC_RES b, /* impact parameter */
PREC_RES *rad, /* Equispaced radius array */
PREC_RES refr, /* refractivity index */
PREC_RES *ex, /* extinction[rad] */
long nrad) /* number of radii elements */
{
int rs;
int i;
PREC_RES res;
PREC_RES x3[3],r3[3];
//Look for closest approach radius
PREC_RES r0=b/refr;
//get bin value 'rs' such that r0 is between rad[rs] inclusive
//and rad[rs+1] exclusive.
//If we are looking at the outmost layer, then return
if((rs=binsearch(rad,0,nrad-1,r0))==-5)
return 0;
//If some other error occurred
else if(rs<0)
transiterror(TERR_CRITICAL,
"Closest approach value(%g) is outside sampled radius\n"
"range(%g - %g)\n"
,r0,rad[0],rad[nrad-1]);
//advance the extinction and radius arrays such that the zeroeth
//element now is the closest sample to the minimum approach from below
//it.
rad+=rs;
ex+=rs;
nrad-=rs;
//By parabolic fitting, interpolate the value of extinction at the
//radius of minimum approach and store it in the sample that
//corresponded to the closest from below. Store such value and radius,
//which are to be replaced before returning (\lin{tmpex})
const PREC_RES tmpex=*ex;
const PREC_RES tmprad=*rad;
if(nrad==2) *ex=interp_parab(rad-1,ex-1,r0);
else *ex=interp_parab(rad,ex,r0);
*rad=r0;
if(nrad==2){
x3[0]=ex[0];
x3[2]=ex[1];
x3[1]=(ex[1]+ex[0])/2.0;
r3[0]=rad[0];
r3[2]=rad[1];
r3[1]=(rad[0]+rad[1])/2.0;
*rad=tmprad;
*ex=tmpex;
rad=r3;
ex=x3;
nrad++;
}
const PREC_RES dr=rad[1]-rad[0];
//Now convert to s spacing, i.e. distance along the path. Radius needs
//to be equispaced.
PREC_RES s[nrad];
const PREC_RES Dr=rad[2]-rad[1];
const PREC_RES cte=dr*(dr + 2*r0);
s[0]=0;
for(i=1 ; i<nrad ; i++)
s[i]=sqrt(cte + (i-1)*Dr*(2.0*(r0+dr) + (i-1)*Dr) );
//Integrate!\par
//Use spline if GSL is available along with at least 3 points
#ifdef _USE_GSL
gsl_interp_accel *acc = gsl_interp_accel_alloc ();
gsl_interp *spl=gsl_interp_alloc(gsl_interp_cspline,nrad);
gsl_interp_init(spl,s,ex,nrad);
res=gsl_interp_eval_integ(spl,s,ex,0,s[nrad-1],acc);
gsl_interp_free(spl);
gsl_interp_accel_free (acc);
#else
#error non equispaced integration is not implemented without GSL
#endif /* _USE_GSL */
//replace original value of extinction
//\linelabel{tmpex}
*ex=tmpex;
*rad=tmprad;
//return
return 2*(res);
}
int main()
{
std::ifstream ifs;
ifs.open("halo_mod.dat", std::ifstream::in);
double E_p_array[1000];
double prob_array[1000];
int i = 0;
while(ifs.good() && i < 1000)
{
double E_p;
double prob;
ifs >> E_p >> prob;
if(!ifs.good())
{
break;
}
if(i > 0 && E_p <= E_p_array[i-1])
{
continue;
}
E_p_array[i] = E_p;
prob_array[i] = prob;
i++;
}
std::cout << i << std::endl;
gsl_interp* interp = gsl_interp_alloc(gsl_interp_linear, i);
double E_p_min = E_p_array[0];
double E_p_max = E_p_array[i-1];
gsl_interp_init(interp, E_p_array, prob_array, i);
gsl_interp_accel* accel = gsl_interp_accel_alloc();
double integral_value = gsl_interp_eval_integ(interp, E_p_array, prob_array, E_p_min, E_p_max, accel);
std::cout << integral_value << std::endl;
for(int j = 0; j < i; j++)
{
prob_array[i] = prob_array[i] / integral_value;
}
gsl_integration_workspace* w;
w = gsl_integration_workspace_alloc(10000);
param_struct params;
params.N = i;
params.interp = interp;
params.accel = accel;
params.E_p_array = E_p_array;
params.prob_array = prob_array;
params.E_p_min = E_p_min;
params.E_p_max = E_p_max;
gsl_function f;
f.function = &integral;
f.params = ¶ms;
/*for(int j = 0; j < i; j++)
{
double result;
double error;
double E_p = E_p_array[j];
params.E_p = E_p;
gsl_integration_qag(&f, -3.0 * sigma, 3.0 * sigma, 1e-8, 1e-8, 10000, GSL_INTEG_GAUSS51, w, &result, &error);
double prob = result * 0.02893 + (1.0 - 0.02893) * gaussian(E_p - 7.878);
std::cout << E_p << " " << prob << std::endl;
}*/
gsl_integration_workspace_free(w);
gsl_interp_accel_free(accel);
gsl_interp_free(interp);
return 0;
}
/* DEF */
static PREC_RES
eclipse_intens(struct transit *tr, /* Transit structure */
PREC_RES *tau, /* Optical depth array */
PREC_RES w, /* Current wavenumber value */
long last, /* Index where tau == toomuch */
double toomuch, /* Maximum optical depth calculated */
prop_samp *rad){ /* Radius array */
/* FINDME: toomuch is not needed as a parameter */
/* General variables: */
PREC_RES res; /* Result */
PREC_ATM *temp = tr->atm.t; /* Temperatures */
PREC_RES angle = tr->angles[tr->angleIndex] * DEGREES;
/* Takes sampling properties for wavenumber from tr: */
prop_samp *wn = &tr->wns;
/* Wavenumber units factor to cgs: */
double wfct = wn->fct;
/* Radius parameter variables: */
long rnn = rad->n;
long i;
/* Blackbody function at each layer: */
PREC_RES B[rnn];
/* Integration parts: */
PREC_RES tauInteg[rnn], /* Integrand function */
tauIV[rnn]; /* Tau integration variable */
/* Integrate for each of the planet's layer starting from the
outermost until the closest layer.
The order is opposite since tau starts from the top and
radius array starts from the bottom. */
/* Planck function (erg/s/sr/cm) for wavenumbers:
B_\nu = 2 h {\bar\nu}^3 c^2 \frac{1}
{\exp(\frac{h \bar \nu c}{k_B T})-1} */
for(i=0; i <= last; i++){
tauIV[i] = tau[i];
B[i] = (2.0 * H * w * w * w * wfct * wfct * wfct * LS * LS)
/ (exp(H * w * wfct * LS / (KB * temp[rnn-1-i])) - 1.0);
tauInteg[i] = B[i] * exp(-tau[i]/ cos(angle));
}
/* Added 0 at the end when tau reach toomuch, so the spline looks nice */
/* Add all other layers to be 0. */
for(; i<rnn; i++){
tauInteg[i] = 0;
/* Geometric progression is used to provide enough elements
for integral to work. It does not change the final outcome/result. */
tauIV[i] = tauIV[i-1] + 1;
}
/* Adding additional 0 layer, plus the last represent number of elements
is -1, so we need to add one more. 2 in total. */
last += 2;
/* If atmosphere is transparent, and at last level tau has not reached
tau.toomuch, last is set to max number of layers (rnn, instead of rnn-1
because we added 2 on the previous step). The code requests never
to go over it. */
if(last > rnn)
last = rnn;
/* Checks if we have enough radii to do spline, at least 3: */
if(last < 3)
transiterror(TERR_CRITICAL, "Less than 3 items (%i given) for radial "
"integration.\n", last);
/* Integrate along tau up to tau = toomuch: */
#ifdef _USE_GSL
gsl_interp_accel *acc = gsl_interp_accel_alloc();
gsl_interp *spl = gsl_interp_alloc(gsl_interp_cspline, last);
gsl_interp_init(spl, tauIV, tauInteg, last);
res = gsl_interp_eval_integ(spl, tauIV, tauInteg,
tauIV[0], tauIV[last-1], acc);
gsl_interp_free(spl);
gsl_interp_accel_free (acc);
#else
# error computation of modulation() without GSL is not implemented
#endif
/* GSL is stupid. I will use a trapezoidal rule for integration instead
(when I want to run the code in safety mode): */
//res = integ_trapz(tauIV, tauInteg, last);
//if (fabs(w-2877.00) <= 0.5){
// transitprint(1, 2, "\nI(w=%.10g) = %.10g\n", w, res);
// for (i=0; i<last; i++)
// transitprint(1, 2, " tau: %.10e int:%.10e\n", tauIV[i], tauInteg[i]);
// double res2 = integ_trapz(tauIV, tauInteg, last-1);
// transitprint(1,2, "Trapezoidal integration: %.10e\n", res2);
//}
//if (res < 0){
//if (fabs(w-1844.59) <= 0.005){
// double res2 = integ_trapz(tauIV, tauInteg, last-1);
// transitprint(1,2, "Trapezoidal integration: %.10e\n", res2);
// transitprint(1, 2, "\nI(w=%.10g) = %.10g\n", w, res);
// for (i=0; i<last; i++)
// transitprint(1, 2, " tau: %.10e int:%.10g\n", tauIV[i], tauInteg[i]);
//}
return res/cos(angle);
}
PowerSpec_Tabulated::PowerSpec_Tabulated(const std::string& FileWithTransfer, const std::string & FileWithInputSpectrum, double Omega, double OmegaLambda, double OmegaBaryon, double OmegaNu,
double InputSpectrum_UnitLength_in_cm, double UnitLength_in_cm, bool no_gas, bool combined_neutrinos)
{
//Set up conversion factor between internal units and CAMB units
scale = (InputSpectrum_UnitLength_in_cm / UnitLength_in_cm);
std::vector<double> kmatter_vector;
std::vector<double> pmatter_vector;
std::fstream matpow;
matpow.open(FileWithInputSpectrum, std::fstream::in);
if ( ! matpow.is_open() ) {
std::cerr<<"Can't open matter power spectrum in file: "<< FileWithInputSpectrum<<std::endl;
exit(17);
}
/* define matter array */
while ( matpow.good() ) {
double ktmp,ptmp;
//Discard comments
if (matpow.get() == '#')
matpow.ignore(std::numeric_limits<std::streamsize>::max(),'\n');
else
matpow.unget();
matpow >> ktmp;
matpow >> ptmp;
if (!matpow.good() )
break;
kmatter_vector.push_back(ktmp);
pmatter_vector.push_back(ptmp);
}
std::cerr<<"Found "<<pmatter_vector.size()<<" rows in input spectrum table: "<<FileWithInputSpectrum<<std::endl;
matpow.close();
//Allocate arrays for the gsl interpolation (which must be raw arrays, unfortunately)
//Then allocate the interpolation objects
kmatter_table = new double[kmatter_vector.size()];
pmatter_table = new double[pmatter_vector.size()];
assert(kmatter_vector.size() == pmatter_vector.size());
//Copy over the k values and convert Fourier convention
for (size_t i=0; i<kmatter_vector.size(); i++) {
kmatter_table[i] = log10(kmatter_vector[i]);
pmatter_table[i] = log10(pmatter_vector[i]/pow(2*M_PI,3));
if(i >0 && kmatter_table[i] <= kmatter_table[i-1]) {
std::cerr<<"Matter power table is not increasing in k: i = "<<i<<", k = "<<kmatter_table[i]<<" <= "<<kmatter_table[i-1]<<std::endl;
exit(48);
}
}
//Set up the interpolation structures for the matter power
pmat_interp = gsl_interp_alloc(gsl_interp_cspline,kmatter_vector.size());
pmat_interp_accel = gsl_interp_accel_alloc();
//Initialise the interpolator; same k values for each one, different T values.
gsl_interp_init(pmat_interp,kmatter_table, pmatter_table,pmatter_vector.size());
NPowerTable = pmatter_vector.size();
std::fstream transfer;
transfer.open(FileWithTransfer, std::fstream::in);
if ( ! transfer.is_open() ) {
std::cerr<<"Can't open transfer function in file: "<< FileWithTransfer<<std::endl;
exit(17);
}
//Temporary arrays which can be resized so we don't have to read the file twice
std::vector<double> ktransfer_vector;
std::vector<double> transfer_vector[N_TYPES_TAB];
while ( transfer.good() ) {
double T_b, dummy, T_nu, T_nu2,T_tot, T_cdm, T_dmb;
double k;
//Discard comments
if (transfer.get() == '#')
transfer.ignore(std::numeric_limits<std::streamsize>::max(),'\n');
else
transfer.unget();
//Read the row.
transfer >> k;
transfer >> T_cdm;
transfer >> T_b;
//radiation
transfer >> dummy;
//massless neutrinos
transfer >> T_nu2;
//massive neutrinos
transfer >> T_nu;
transfer >> T_tot;
//DM+baryons
transfer >> T_dmb;
//Ignore the rest of the line
transfer.ignore(std::numeric_limits<std::streamsize>::max(), '\n');
if ( ! transfer.good() )
break;
/* The dark matter may incorporate other particle types as well, eg,
* fake neutrinos, or baryons.
* NOTE that CAMB defines T_tot = (T_CDM M_CDM + T_b M_b +T_nu M_nu) / (M_CDM + M_b +M_nu)
* HOWEVER, when relativistic (ie, in the early universe), neutrinos will redshift
* like radiation. The CAMB transfer function takes this into account when calculating T_tot,
* so instead of summing the transfer functions, use the total transfer function and
* optionally subtract the baryons.
* We want to incorporate neutrinos into the dark matter if we are changing the transfer function,
* but not if we are using the full kspace method. */
if(combined_neutrinos){
T_cdm = T_tot;
/*If we have separate gas particles, subtract
* the baryon transfer function */
if(!no_gas){
T_cdm = (Omega*T_tot - T_b*OmegaBaryon)/(Omega-OmegaBaryon);
}
}
/*Add baryons to the CDM if there are no gas particles*/
else if(no_gas){
T_cdm = T_dmb;
}
/*This should be equivalent to the above in almost all cases,
* but perhaps we want to see the effect of changing only the ICs in CAMB for the neutrinos.*/
if(no_gas && OmegaNu == 0){
T_cdm = T_tot;
}
//Assign transfer functions to structures as T_s/T_t^2
ktransfer_vector.push_back(k);
transfer_vector[0].push_back(pow(T_b/T_tot,2));
transfer_vector[1].push_back(pow(T_cdm/T_tot,2));
transfer_vector[2].push_back(pow(T_nu/T_tot,2));
transfer_vector[3].push_back(pow(T_nu2/T_tot,2));
}
transfer.close();
//Allocate arrays for the gsl interpolation (which must be raw arrays, unfortunately)
//Then allocate the interpolation objects
ktransfer_table = new double[ktransfer_vector.size()];
//Copy over the k values
for (size_t i=0; i<ktransfer_vector.size(); i++) {
ktransfer_table[i] = log10(ktransfer_vector[i]);
if(i >0 && ktransfer_table[i] <= ktransfer_table[i-1]) {
std::cerr<<"Transfer table is not increasing in k: i = "<<i<<", k = "<<ktransfer_table[i]<<" <= "<<ktransfer_table[i-1]<<std::endl;
exit(48);
}
}
for(int type=0; type < N_TYPES_TAB; type++){
//Check everything is the same size
assert( ktransfer_vector.size() == transfer_vector[type].size() );
transfer_table[type] = new double[transfer_vector[type].size()];
//Copy data from the temporary vectors to the statically sized C-arrays
for (size_t i=0; i<transfer_vector[type].size(); i++) {
//Make sure we do not take log(0)
transfer_table[type][i] = transfer_vector[type][i];
}
//Set up the interpolation structures
trans_interp[type] = gsl_interp_alloc(gsl_interp_cspline,transfer_vector[type].size());
trans_interp_accel[type] = gsl_interp_accel_alloc();
//Initialise the interpolator; same k values for each one, different T values.
//Size asserted to be the same.
gsl_interp_init(trans_interp[type],ktransfer_table, transfer_table[type],transfer_vector[type].size());
}
//Store the size of the arrays
NTransferTable = ktransfer_vector.size();
}
/* Take in an array of cdbs */
int cdb_read_aggregate_records(cdb_t **cdbs, int num_cdbs, cdb_request_t *request,
uint64_t *driver_num_recs, cdb_record_t **records, cdb_range_t *range) {
uint64_t i = 0;
int ret = CDB_SUCCESS;
cdb_record_t *driver_records = NULL;
*driver_num_recs = 0;
if (cdbs[0] == NULL) {
return CDB_ESANITY;
}
/* The first cdb is the driver */
ret = _cdb_read_records(cdbs[0], request, driver_num_recs, &driver_records);
if (ret != CDB_SUCCESS) {
fprintf(stderr, "Bailed on: %s\n", cdbs[0]->filename);
free(driver_records);
return ret;
}
if ((*records = calloc(*driver_num_recs, RECORD_SIZE)) == NULL) {
free(driver_records);
return CDB_ENOMEM;
}
if (*driver_num_recs <= 1) {
free(driver_records);
return CDB_EINTERPD;
}
double *driver_x_values = calloc(*driver_num_recs, sizeof(double));
double *driver_y_values = calloc(*driver_num_recs, sizeof(double));
double *follower_x_values = calloc(*driver_num_recs, sizeof(double));
double *follower_y_values = calloc(*driver_num_recs, sizeof(double));
for (i = 0; i < *driver_num_recs; i++) {
(*records)[i].time = driver_x_values[i] = driver_records[i].time;
(*records)[i].value = driver_y_values[i] = driver_records[i].value;
}
/* initialize and allocate the gsl objects */
gsl_interp_accel *accel = gsl_interp_accel_alloc();
gsl_interp *interp = gsl_interp_alloc(gsl_interp_linear, *driver_num_recs);
/* Allows 0.0 to be returned as a valid yi */
gsl_set_error_handler_off();
gsl_interp_init(interp, driver_x_values, driver_y_values, *driver_num_recs);
for (i = 1; i < num_cdbs; i++) {
uint64_t j = 0;
uint64_t follower_num_recs = 0;
cdb_record_t *follower_records = NULL;
ret = _cdb_read_records(cdbs[i], request, &follower_num_recs, &follower_records);
/* Just bail, free all allocations below and let the error bubble up */
if (follower_num_recs != 0) {
for (j = 0; j < *driver_num_recs; j++) {
/* Check for out of bounds */
if (j >= follower_num_recs) {
break;
}
follower_x_values[j] = follower_records[j].time;
follower_y_values[j] = follower_records[j].value;
}
for (j = 0; j < *driver_num_recs; j++) {
double yi = gsl_interp_eval(interp, follower_x_values, follower_y_values, driver_x_values[j], accel);
if (isnormal(yi)) {
(*records)[j].value += yi;
}
}
}
ret = CDB_SUCCESS;
free(follower_records);
}
if (ret == CDB_SUCCESS && *driver_num_recs > 0) {
/* Compute all the statistics for this range */
range->start_time = request->start;
range->end_time = request->end;
_compute_statistics(range, driver_num_recs, *records);
}
free(driver_x_values);
free(driver_y_values);
free(follower_x_values);
free(follower_y_values);
gsl_interp_free(interp);
gsl_interp_accel_free(accel);
free(driver_records);
return ret;
}
/**
* Function: load_SED_from_fitsext
* The function creates a energy distribution from the data stored
* in a fits file extension. The data must be stored in the columns
* "wavelength" and "flux".
*
* Parameters:
* @param spectral_models_file - pathname to the spectral models file
* @param s_models - pointer to the fits file extension
*
* Returns:
* @return sed - the energy distribution created
*/
energy_distrib *
load_SED_from_fitsext(const char spectral_models_file[], fitsfile *s_models)
{
int f_status=0;
int anynul;
long nrows=0;
int colnum1;
int colnum2;
energy_distrib *sed;
double *sed_wavs;
double *sed_flux;
// allocate memory for the energy distribution
sed = (energy_distrib *) malloc(sizeof(energy_distrib));
// get number of rows
fits_get_num_rows (s_models, &nrows, &f_status);
if (f_status) {
ffrprt (stderr, f_status);
aXe_message (aXe_M_FATAL, __FILE__, __LINE__,
"load_SED_from_fitsext: "
"Could not determine the number of rows in"
" table %s",spectral_models_file);
}
// allocate memory for the data
sed_wavs = (double *) malloc(nrows*sizeof(double));
if (!sed_wavs) {
aXe_message (aXe_M_ERROR, __FILE__, __LINE__,
"Memory allocation failed");
}
sed_flux = (double *) malloc(nrows*sizeof(double));
if (!sed_flux) {
aXe_message (aXe_M_ERROR, __FILE__, __LINE__,
"Memory allocation failed");
}
// get the column number for the wavelength
fits_get_colnum (s_models, CASEINSEN, "WAV_NM", &colnum1, &f_status);
if (f_status)
{
ffrprt (stderr, f_status);
aXe_message (aXe_M_FATAL, __FILE__, __LINE__,
"create_interp_ftable: "
"Could not determine column %s in "
" table %s", "WAV_NM", spectral_models_file);
}
// read the wavelength
fits_read_col (s_models, TDOUBLE, colnum1, 1, 1, nrows, NULL, sed_wavs,
&anynul, &f_status);
if (f_status)
{
ffrprt (stderr, f_status);
aXe_message (aXe_M_FATAL, __FILE__, __LINE__,
"load_SED_from_fitsext: "
"Could not read content of WAVELENGTH column "
" from BINARY table %s", spectral_models_file);
}
// get the column number for the flux
fits_get_colnum (s_models, CASEINSEN, "FLUX", &colnum2, &f_status);
if (f_status)
{
ffrprt (stderr, f_status);
aXe_message (aXe_M_FATAL, __FILE__, __LINE__,
"create_interp_ftable: "
"Could not determine column %s in "
" table %s", "FLUX", spectral_models_file);
}
// read the flux column
fits_read_col (s_models, TDOUBLE, colnum2, 1, 1, nrows, NULL, sed_flux,
&anynul, &f_status);
if (f_status)
{
ffrprt (stderr, f_status);
aXe_message (aXe_M_FATAL, __FILE__, __LINE__,
"load_SED_from_fitsext: "
"Could not read content of FLUX column "
" from BINARY table %s", spectral_models_file);
}
// transfer the vector and length information
// to the SED object
sed->npoints = nrows;
sed->wavelength = sed_wavs ;
sed->flux = sed_flux;
// allocate some structures for the interpolator
sed->interp = gsl_interp_alloc (SMODEL_INTERP_TYPE, (size_t)sed->npoints );
sed->accel = gsl_interp_accel_alloc ();
// initialize the iterpolator
gsl_interp_init (sed->interp, sed->wavelength, sed->flux, (size_t)sed->npoints);
// return the energy distribution
return sed;
}
static LALSimNeutronStarEOS *eos_alloc_tabular(double *pdat, double *edat,
size_t ndat)
{
LALSimNeutronStarEOS *eos;
LALSimNeutronStarEOSDataTabular *data;
size_t i;
double *hdat;
double *rhodat;
double integrand_im1, integrand_i, integral;
eos = LALCalloc(1, sizeof(*eos));
data = LALCalloc(1, sizeof(*data));
eos->datatype = LALSIM_NEUTRON_STAR_EOS_DATA_TYPE_TABULAR;
eos->data.tabular = data;
/* setup function pointers */
eos->free = eos_free_tabular;
eos->e_of_p = eos_e_of_p_tabular;
eos->h_of_p = eos_h_of_p_tabular;
eos->e_of_h = eos_e_of_h_tabular;
eos->p_of_h = eos_p_of_h_tabular;
eos->rho_of_h = eos_rho_of_h_tabular;
eos->dedp_of_p = eos_dedp_of_p_tabular;
eos->v_of_h = eos_v_of_h_tabular;
/* compute pseudo-enthalpy h from dhdp */
/* Integrate in log space:
dhdp = 1 / [e(p) + p]
h(p) = h(p0) + \int_p0^p dhdp dp
h(p) = h(p0) + \int_ln(p0)^ln(p) exp[ln(p) + ln(dhdp)] dln(p)
*/
double * integrand;
double * log_pdat;
log_pdat = XLALCalloc(ndat-1, sizeof(*log_pdat));
integrand = LALMalloc((ndat-1) * sizeof(*integrand));
for (i = 0; i < ndat-1; ++i) {
log_pdat[i] = log(pdat[i+1]);
integrand[i] = exp(log_pdat[i] + log(1.0 / (edat[i+1] + pdat[i+1])));
}
gsl_interp_accel * dhdp_of_p_acc_temp = gsl_interp_accel_alloc();
gsl_interp * dhdp_of_p_interp_temp = gsl_interp_alloc(gsl_interp_linear, ndat-1);
gsl_interp_init(dhdp_of_p_interp_temp, log_pdat, integrand, ndat-1);
hdat = LALMalloc(ndat * sizeof(*hdat));
hdat[0] = 0.0;
// Do first point by hand
hdat[1] = hdat[0] + 0.5 * (1./(pdat[1]+edat[1])) * (pdat[1] - pdat[0]);
for (i = 1; i < ndat-1; ++i) {
hdat[i+1] = gsl_interp_eval_integ(dhdp_of_p_interp_temp, log_pdat, integrand,
log_pdat[0], log_pdat[i], dhdp_of_p_acc_temp);
}
gsl_interp_free(dhdp_of_p_interp_temp);
gsl_interp_accel_free(dhdp_of_p_acc_temp);
LALFree(log_pdat);
LALFree(integrand);
/*!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! */
/* CALCULATION OF RHO CURRENTLY RETURNS GARBAGE */
/*!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! */
/* compute rest-mass density by integrating (trapezoid rule) */
/* rho_i = rho_{i-1} exp(int_{e_{i-1}}^{e_i} de/(e+p)) */
rhodat = LALMalloc(ndat * sizeof(*hdat));
rhodat[0] = 0.0;
rhodat[1] = edat[1]; /* essentially the same at low density */
integrand_im1 = 1.0 / (edat[1] + pdat[1]);
for (i = 2; i < ndat; i++) {
integrand_i = 1.0 / (edat[i] + pdat[i]);
integral =
0.5 * (integrand_im1 + integrand_i) * (edat[i] - edat[i - 1]);
integrand_im1 = integrand_i;
rhodat[i] = rhodat[i - 1] * exp(integral);
}
data->hdat = hdat;
data->pdat = pdat;
data->edat = edat;
data->rhodat = rhodat;
data->ndat = ndat;
eos->pmax = data->pdat[ndat - 1];
eos->hmax = data->hdat[ndat - 1];
/* setup interpolation tables */
data->e_of_p_acc = gsl_interp_accel_alloc();
data->h_of_p_acc = gsl_interp_accel_alloc();
data->e_of_h_acc = gsl_interp_accel_alloc();
data->p_of_h_acc = gsl_interp_accel_alloc();
data->rho_of_h_acc = gsl_interp_accel_alloc();
data->e_of_p_interp = gsl_interp_alloc(gsl_interp_cspline, ndat);
data->h_of_p_interp = gsl_interp_alloc(gsl_interp_cspline, ndat);
data->e_of_h_interp = gsl_interp_alloc(gsl_interp_cspline, ndat);
data->p_of_h_interp = gsl_interp_alloc(gsl_interp_cspline, ndat);
data->rho_of_h_interp = gsl_interp_alloc(gsl_interp_cspline, ndat);
gsl_interp_init(data->e_of_p_interp, pdat, edat, ndat);
gsl_interp_init(data->h_of_p_interp, pdat, hdat, ndat);
gsl_interp_init(data->e_of_h_interp, hdat, edat, ndat);
gsl_interp_init(data->p_of_h_interp, hdat, pdat, ndat);
gsl_interp_init(data->rho_of_h_interp, hdat, rhodat, ndat);
eos->hMinAcausal =
eos_min_acausal_pseudo_enthalpy_tabular(eos->hmax, eos);
// printf("%e\n", XLALSimNeutronStarEOSEnergyDensityOfPressureGeometerized(eos->pmax, eos));
//
// printf("datatype = %d\n", eos->datatype);
// printf("pmax = %e\n", eos->pmax);
// printf("hmax = %e\n", eos->hmax);
// printf("hMinAcausal = %e\n", eos->hMinAcausal);
return eos;
}
static PyObject *cs_gamma_findzofA(PyObject *self, PyObject *args)
{
PyArrayObject *Numpy_amp;
PyObject *Numpy_zofA;
double Gmu, alpha, *zofA, *amp;
unsigned long int Namp;
(void)self; /* silence unused parameter warning */
double z_min = 1e-20, z_max = 1e10;
double dlnz = 0.05;
unsigned numz = floor( (log(z_max) - log(z_min)) / dlnz );
unsigned long int i;
cs_cosmo_functions_t cosmofns;
double *fz,*z;
double a;
gsl_interp *zofa_interp;
gsl_interp_accel *acc_zofa = gsl_interp_accel_alloc();
if (!PyArg_ParseTuple(args, "ddO!", &Gmu, &alpha, &PyArray_Type, &Numpy_amp))
return NULL;
Numpy_amp = PyArray_GETCONTIGUOUS(Numpy_amp);
if(!Numpy_amp)
return NULL;
Namp = PyArray_DIM(Numpy_amp, 0);
amp = PyArray_DATA(Numpy_amp);
{
npy_intp dims[1] = {Namp};
Numpy_zofA = PyArray_SimpleNew(1, dims, NPY_DOUBLE);
}
zofA = PyArray_DATA((PyArrayObject *) Numpy_zofA);
cosmofns = XLALCSCosmoFunctionsAlloc( z_min, dlnz, numz );
zofa_interp = gsl_interp_alloc (gsl_interp_linear, cosmofns.n);
fz = calloc( cosmofns.n, sizeof( *fz ) );
z = calloc( cosmofns.n, sizeof( *z ) );
/* first compute the function that relates A and z */
/* invert order; b/c fz is a monotonically decreasing func of z */
for ( i = cosmofns.n ; i > 0; i-- )
{
unsigned long int j = cosmofns.n - i;
z[j] = cosmofns.z[i-1];
fz[j] = pow(cosmofns.phit[i-1], 2.0/3.0) * pow(1+z[j], -1.0/3.0) / cosmofns.phiA[i-1];
}
gsl_interp_init (zofa_interp, fz, z, cosmofns.n);
/* now compute the amplitudes (suitably multiplied) that are equal to fz for some z*/
for ( i = 0; i < Namp; i++ )
{
a = amp[i] * pow(H0,-1.0/3.0) * pow(alpha,-2.0/3.0) / Gmu;
/* evaluate z(fz) at fz=a */
zofA[i] = gsl_interp_eval (zofa_interp, fz, z, a, acc_zofa );
if(gsl_isnan(zofA[i])) {
Py_DECREF(Numpy_zofA);
Numpy_zofA = NULL;
break;
}
}
XLALCSCosmoFunctionsFree( cosmofns );
Py_DECREF(Numpy_amp);
free(fz);
free(z);
gsl_interp_free (zofa_interp);
gsl_interp_accel_free(acc_zofa);
return Numpy_zofA;
}
/* \fcnfh
Computes most basic modulation scheme, obtained when there is no limb
darkening or emitted flux.
@returns modulation obtained
*/
static PREC_RES
modulation1 (PREC_RES *tau,
long last, /* Index of the last poisition it has to
be at least 1 */
double toomuch,
prop_samp *ip, /* Order is descending */
struct geometry *sg)
{
//general variables
PREC_RES res;
double srad=sg->starrad*sg->starradfct;
//Impact parameter variables
long ipn=ip->n;
long ipn1=ipn-1;
long i;
const PREC_RES maxtau=tau[last]>toomuch?tau[last]:toomuch;
PREC_RES rinteg[ipn],ipv[ipn];
//this function calculates 1 minus the ratio of in-transit over out-of-transit
//expresion for the simplest case, which is given by (INVALID
//EXPRESSION FOLLOWING!!)
//\[
//M_{\lambda}^{(0)}=
//\frac{1}{\pi R_M^2}\int_{R<R_M}\ee^{-\tau( b,\xi)} R \dd R\dd\phi
//\]\par
//Let's integrate; for each of the planet's layer starting from the
//outermost until the closest layer
for(i=0;i<=last;i++){
ipv[ipn1-i] = ip->v[i] * ip->fct;
rinteg[ipn1-i] = exp(-tau[i]) * ipv[ipn1-i];
}
//fill one more lower part bin with 0. Only two to have a nice ending
//spline and not unnecessary values.
last+=1;
if(last>ipn1) last=ipn1;
for(;i<=last;i++){
ipv[ipn1-i] = ip->v[i] * ip->fct;
rinteg[ipn1-i] = 0;
}
//increment last to represent number of elements now, check that we
//have enough.
last++;
if(last<3)
transiterror(TERR_CRITICAL,
"Condition failed, less than 3 items (only %i) for radial\n"
"integration.\n"
,last);
//integrate in radii
#ifdef _USE_GSL
gsl_interp_accel *acc = gsl_interp_accel_alloc ();
gsl_interp *spl=gsl_interp_alloc( gsl_interp_cspline, last );
gsl_interp_init( spl, ipv+ipn-last, rinteg+ipn-last, last );
res = gsl_interp_eval_integ( spl, ipv+ipn-last, rinteg+ipn-last,
ipv[ipn-last], ipv[ipn1], acc );
gsl_interp_free(spl);
gsl_interp_accel_free (acc);
//or err without GSL
#else
# error computation of modulation() without GSL is not implemented
#endif
/* TD: Add real unblocked area of the star, considering geometry */
//substract the total area blocked by the planet. This is from the
//following
//\begin{align}
//1-M=&1-\frac{\int_0^{r_p}\int\ee^{-\tau}\dd \theta r\dd r
// +\int_{r_p}^{R_s}\dd A}
// {\pi R_s^2}\\%
// =&-\frac{\int_0^{r_p}\int\ee^{-\tau}\dd \theta r\dd r
// +Area_{planet}}
// {\pi R_s^2}
// =&-\frac{2\int_0^{r_p}\ee^{-\tau}r\dd r
// +r_p^2}
// {\pi R_s^2}
//\end{align}
res = ipv[ipn1] * ipv[ipn1] - 2.0 * res ;
//If the planet is going to be transparent with its maximum optical
//depth given by toomuch then
if(sg->transpplanet)
res -= exp(-maxtau) * ipv[ipn-last] * ipv[ipn-last];
//normalize by the planet
res *= 1.0 / srad / srad;
return res;
}
void gamma_spline_reset (GammaSpline *gs, GList * const sd, int mp, int np, gboolean sort) {
int q=0;
int NB = model->total_bands;
int m,n;
GList * iter = sd;
const int N = g_list_length(iter);
MatrixElement *firstme = (MatrixElement *) iter->data;
size_t ind[NB];
if (sort) {
gsl_sort_index (ind, firstme->energies, 1, NB);
m=ind[mp];
n=ind[np]; // this breaks the 14 band model!
}
else {
m=mp;
n=np;
}
double *en = double_array_calloc(N);
while (iter) {
MatrixElement *me = (MatrixElement *) iter->data;
gs->k[q]=me->kc;
en[q]=(me->energies[n] - me->energies[m])*3e5/1240.7;
gs->Wxr[q]=creal(me->Wx[m+n*NB]);
gs->Wxi[q]=cimag(me->Wx[m+n*NB]);
gs->Wyr[q]=creal(me->Wy[m+n*NB]);
gs->Wyi[q]=cimag(me->Wy[m+n*NB]);
gs->Wzr[q]=creal(me->Wz[m+n*NB]);
gs->Wzi[q]=cimag(me->Wz[m+n*NB]);
iter=g_list_next(iter);
q++;
}
gsl_interp * en_spline;
gsl_interp_accel * en_accel;
en_spline = gsl_interp_alloc(gsl_interp_akima,N);
en_accel = gsl_interp_accel_alloc();
q=gsl_interp_init(en_spline,gs->k,en,N);
gsl_interp_accel_reset (en_accel);
if (m!=n) {
gs->phi[0]=0;
for (q=1;q<N;q++) {
gs->phi[q]=gs->phi[q-1]+2*M_PI*gsl_interp_eval_integ (en_spline, gs->k, en, gs->k[q-1], gs->k[q], en_accel);
}
}
else {
for (q=0;q<N;q++) {
gs->phi[q]=0;
}
}
d_free(en);
gsl_interp_free(en_spline);
gsl_interp_accel_free(en_accel);
q=gsl_interp_init(gs->phi_spline,gs->k,gs->phi,N);
gsl_interp_accel_reset (gs->phi_accel);
q=gsl_interp_init(gs->wx_spline_re,gs->k,gs->Wxr,N);
gsl_interp_accel_reset (gs->w_accel);
q=gsl_interp_init(gs->wx_spline_im,gs->k,gs->Wxi,N);
q=gsl_interp_init(gs->wy_spline_re,gs->k,gs->Wyr,N);
q=gsl_interp_init(gs->wy_spline_im,gs->k,gs->Wyi,N);
q=gsl_interp_init(gs->wz_spline_re,gs->k,gs->Wzr,N);
q=gsl_interp_init(gs->wz_spline_im,gs->k,gs->Wzi,N);
}
real mmas::compute_stellar_energy(usm &model) {
int gsl_status;
n_shells = model.get_num_shells();
arr_mass = new double[n_shells+1];
arr_radius = new double[n_shells+1];
arr_temp = new double[n_shells+1];
arr_dens = new double[n_shells+1];
arr_m_mu = new double[n_shells+1];
for (int i = 0; i < n_shells; i++) {
mass_shell &shell = model.get_shell(i);
if (i > 0 && shell.mass <= arr_mass[i-1]){
n_shells = i;
break;
}
arr_mass[i+1] = shell.mass;
arr_radius[i+1] = shell.radius;
arr_temp[i+1] = shell.temperature;
arr_dens[i+1] = shell.density;
arr_m_mu[i+1] = shell.mean_mu;
// fprintf(stderr, "m= %lg: r= %lg, t= %lg, rho= %lg, mu= %lg\n",
// shell.mass, shell.radius, shell.temperature, shell.density, shell.mean_mu);
}
arr_mass[0] = 0.0;
arr_radius[0] = 0.0;
arr_temp[0] = arr_temp[1];
arr_dens[0] = arr_dens[1];
arr_m_mu[0] = arr_m_mu[1];
// fprintf(stderr,"radius\n");
acc_radius = gsl_interp_accel_alloc();
interp_radius = gsl_interp_alloc(gsl_interp_linear, n_shells+1);
gsl_status = gsl_interp_init(interp_radius, arr_mass, arr_radius, n_shells+1);
if (gsl_status != GSL_SUCCESS) return -1e99;
// fprintf(stderr,"temp\n");
acc_temp = gsl_interp_accel_alloc();
interp_temp = gsl_interp_alloc(gsl_interp_linear, n_shells+1);
gsl_status = gsl_interp_init(interp_temp, arr_mass, arr_temp, n_shells+1);
if (gsl_status != GSL_SUCCESS) return -1e99;
// fprintf(stderr,"dens\n");
acc_dens = gsl_interp_accel_alloc();
interp_dens = gsl_interp_alloc(gsl_interp_linear, n_shells+1);
gsl_status = gsl_interp_init(interp_dens, arr_mass, arr_dens, n_shells+1);
if (gsl_status != GSL_SUCCESS) return -1e99;
// fprintf(stderr,"mu\n");
acc_m_mu = gsl_interp_accel_alloc();
interp_m_mu = gsl_interp_alloc(gsl_interp_linear, n_shells+1);
gsl_status = gsl_interp_init(interp_m_mu, arr_mass, arr_m_mu, n_shells+1);
if (gsl_status != GSL_SUCCESS) return -1e99;
int n_limit = 2*n_shells;
gsl_integration_workspace *w = gsl_integration_workspace_alloc(n_limit);
double result, error;
gsl_function F;
F.function = &integrand;
double eps_rel = 1.0e-2;
double eps_abs = 0.0;
double m_0 = 0.0;
double m_1 = model.get_shell(n_shells-1).mass;
gsl_integration_qag(&F,
m_0, m_1,
eps_abs, eps_rel,
n_limit, 1,
w, &result, &error);
gsl_integration_workspace_free(w);
gsl_interp_accel_free(acc_radius);
gsl_interp_free(interp_radius);
gsl_interp_accel_free(acc_temp);
gsl_interp_free(interp_temp);
gsl_interp_accel_free(acc_dens);
gsl_interp_free(interp_dens);
gsl_interp_accel_free(acc_m_mu);
gsl_interp_free(interp_m_mu);
delete arr_mass;
delete arr_radius;
delete arr_temp;
delete arr_dens;
delete arr_m_mu;
return result;
}
