/**
* This function implements the stability criterion of Mardling, 2008a for coplanar,
* three body systems.
* @param alle A matrix of _all_ elements in hierarchical coordinates, as
* returned by K_getAllElements_jacobi (or supplied by the user).
*
* @return One of T_INAPPLICABLE, T_STABLE or T_UNSTABLE. The routine returns T_INAPPLICABLE
* if one of the following is true: (1) the system contains more of three bodies (returns
* T_STABLE if two-body system); (2) the mass conditions for which n:1 resonances dominate
* (m_2/m_1 > 0.01 && m_2/m_1 > 0.01 or m_2/m1 > 0.05 || m_3/m_1 > 0.05). The routine returns
* T_UNSTABLE if the stability criterion (E_n < 0 and E_(n+1) < 0) is satisfied,
* T_STABLE otherwise.
*/
int K_isMstable_coplanar(const gsl_matrix* alle) {
if (MROWS(alle) > 3)
return T_INAPPLICABLE;
if (MROWS(alle) == 2)
return T_STABLE;
double m_1 = MSUN_TO_MJUP(MGET(alle, 0, MASS));
double m_2 = MGET(alle, 1, MASS);
double m_3 = MGET(alle, 2, MASS);
// outside mass criterion
if ((m_2 / m_1 < 0.01 || m_3 / m_1 < 0.01) && (m_2 / m_1 < 0.05 && m_3 / m_1 < 0.05))
return T_INAPPLICABLE;
// Elements of inner and outer binary
double P_i = MGET(alle, 1, PER);
double P_o = MGET(alle, 2, PER);
double sigma = P_o/P_i;
double n = floor(sigma);
double E_n = K_E_n(alle, n, sigma);
double E_n1 = K_E_n(alle, n+1, sigma);
if (E_n < 0 && E_n1 < 0)
return T_UNSTABLE;
else
return T_STABLE;
}
int multiply_matrix_vector (MATRIX const *m, VECTOR const *v, VECTOR *r)
/*****************************************************************************
Returns the VECTOR-MATRIX product of m and v in r.
******************************************************************************/
{
if (! (MV_COMPAT_DIM (*m, *v)))
{
printf ("ERROR (multiply_matrix_vector): MATRIX and VECTOR dimensions incompatible!\n");
print_matrix ("MATRIX:", m);
print_vector ("VECTOR:", v);
return -1; /*added 1996-07*/
}
else
{
int i, j;
float datum;
VELEMENTS (*r) = MROWS (*m);
for (i = 0; i < MROWS (*m); i++)
{
datum = 0;
for (j = 0; j < VELEMENTS (*v); j++)
datum = datum + MDATA (*m, i, j) * VDATA (*v, j);
VDATA (*r, i) = datum;
}
}
return 1;
}
int determinant (MATRIX const *m, float *result)
/*****************************************************************************
******************************************************************************/
{
if (!M_SQUARE (*m))
{
printf ("ERROR (determinant): MATRIX must be square!\n");
print_matrix ("MATRIX:", m);
return -1;
}
else
{
if (MROWS (*m) == 1)
*result = MDATA (*m, 0, 0);
else if (MROWS (*m) == 2)
*result = cross_product (m, 0, 0, 1, 1);
else
*result = MDATA (*m, 0, 0) * cross_product (m, 1, 1, 2, 2)
- MDATA (*m, 0, 1) * cross_product (m, 1, 0, 2, 2)
+ MDATA (*m, 0, 2) * cross_product (m, 1, 0, 2, 1);
return 1;
}
}
int inverse_matrix (MATRIX const *m, MATRIX *n)
/*****************************************************************************
******************************************************************************/
{
if (!M_SQUARE (*m))
{
printf ("ERROR (inverse_matrix): MATRIX must be square!\n");
print_matrix ("MATRIX:", m);
n->cols=0; n->rows=0;
return -1;
}
else
{
float det;
int res;
res = determinant (m,&det);
if (res == -1)
{
printf ("ERROR (inverse_matrix): singular MATRIX!\n");
print_matrix ("MATRIX:", m);
return -1;
}
else
{
initialize_matrix (n, MROWS (*m), MCOLS (*m));
if (MROWS (*m) == 1)
{
MDATA (*n, 0, 0) = 1 / det ;
}
else if (MROWS (*m) == 2)
{
MDATA (*n, 0, 0) = MDATA (*m, 1, 1) / det ;
MDATA (*n, 0, 1) = -MDATA (*m, 0, 1) / det ;
MDATA (*n, 1, 0) = -MDATA (*m, 1, 0) / det ;
MDATA (*n, 1, 1) = MDATA (*m, 0, 0) / det ;
}
else
{
MDATA (*n, 0, 0) = cross_product (m, 1, 1, 2, 2) / det ;
MDATA (*n, 0, 1) = -cross_product (m, 0, 1, 2, 2) / det ;
MDATA (*n, 0, 2) = cross_product (m, 0, 1, 1, 2) / det ;
MDATA (*n, 1, 0) = -cross_product (m, 1, 0, 2, 2) / det ;
MDATA (*n, 1, 1) = cross_product (m, 0, 0, 2, 2) / det ;
MDATA (*n, 1, 2) = -cross_product (m, 0, 0, 1, 2) / det ;
MDATA (*n, 2, 0) = cross_product (m, 1, 0, 2, 1) / det ;
MDATA (*n, 2, 1) = -cross_product (m, 0, 0, 2, 1) / det ;
MDATA (*n, 2, 2) = cross_product (m, 0, 0, 1, 1) / det ;
}
}
}
return 1;
}
/**
* Get a summary statistic for the orbital elements; for instance,
* the median value calculated over all the elements of the list.
* @param kl List
* @param what Can be one of: STAT_MEAN, STAT_MEDIAN, STAT_STDDEV, STAT_MAD.
* Summary statistic is calculated correctly for angle parameters.
* @return A matrix whose entries are the summary statistic for the
* corresponding orbital element.
*/
gsl_matrix* KL_getElementsStats(const ok_list* kl, const int what) {
int npl = MROWS(kl->kernels[0]->elements);
if (npl == 0)
return NULL;
gsl_vector* v = gsl_vector_alloc(kl->size);
gsl_matrix* m = gsl_matrix_alloc(npl, ALL_ELEMENTS_SIZE);
gsl_matrix_set_all(m, 0.);
for (int i = 0; i < npl; i++)
for (int j = 0; j < ALL_ELEMENTS_SIZE; j++) {
for (int n = 0; n < kl->size; n++) {
VSET(v, n, MGET(kl->kernels[n]->elements, i, j));
}
switch (what) {
case STAT_MEAN:
if (j == MA || j == LOP || j == INC || j == NODE || j == TRUEANOMALY)
MSET(m, i, j, ok_average_angle(v->data, v->size, false));
else
MSET(m, i, j, gsl_stats_mean(v->data, 1, v->size));
break;
case STAT_STDDEV:
if (j == MA || j == LOP || j == INC || j == NODE || j == TRUEANOMALY) {
MSET(m, i, j, ok_stddev_angle(v->data, v->size, false));
}
else
MSET(m, i, j, gsl_stats_sd(v->data, 1, v->size));
break;
case STAT_MEDIAN:
if (j == MA || j == LOP || j == INC || j == NODE || j == TRUEANOMALY)
MSET(m, i, j, ok_median_angle(v->data, v->size, false));
else {
gsl_sort_vector(v);
MSET(m, i, j, gsl_stats_median_from_sorted_data(v->data, 1, v->size));
}
break;
case STAT_MAD:
if (j == MA || j == LOP || j == INC || j == NODE || j == TRUEANOMALY) {
double med = ok_median_angle(v->data, v->size, false);
MSET(m, i, j, 1.4826 * ok_mad_angle(v->data, v->size, med, false));
} else {
gsl_sort_vector(v);
double med = gsl_stats_median_from_sorted_data(v->data, 1, v->size);
MSET(m, i, j, 1.4826 * ok_mad(v->data, v->size, med));
}
break;
default:
// percentiles
gsl_sort_vector(v);
MSET(m, i, j, gsl_stats_quantile_from_sorted_data(v->data, 1, v->size, (double)(what)/100.));
};
}
gsl_vector_free(v);
return m;
}
int
M_MatrixResize_SP(void *pA, Uint m, Uint n)
{
M_MatrixSP *A=pA;
MROWS(A) = m;
MCOLS(A) = n;
/* no resizing of sparse matrices */
return 0;
}
void initialize_matrix (MATRIX *m, int rows, int cols)
/*****************************************************************************
Initializes a MATRIX to dimensions (rows, cols) and content zeros.
******************************************************************************/
{
MROWS (*m) = rows;
MCOLS (*m) = cols;
{
int i, j;
for (i = 0; i < MROWS (*m); i++)
for (j = 0; j < MCOLS (*m); j++)
MDATA (*m, i, j) = 0;
}
}
double K_getRVLine(ok_kernel* k, int row, int col) {
static gsl_matrix* rvline = NULL;
static double tolerance[1] = {1e-3};
static int target_points = 600;
if (row < 0) {
int samples = col;
if (rvline != NULL) {
gsl_matrix_free(rvline);
rvline = NULL;
}
if (k->ndata == 0)
return -1;
double** comp = K_getCompiled(k);
gsl_matrix* rvline_full = K_integrateStellarVelocity(k, comp[0][0],
comp[k->ndata - 1][0],
samples,
NULL, NULL);
int fac = 1;
rvline = ok_resample_curve(rvline_full,
0, 1, 1, target_points, 100, tolerance, 0, false);
if (MROWS(rvline) > 1.5 * target_points) {
gsl_matrix_free(rvline);
rvline = ok_resample_curve(rvline_full,
0, 1, 0.2, target_points, 100, tolerance, 0, false);
fac = -1;
}
gsl_matrix_free(rvline_full);
return fac * (int) MROWS(rvline);
} else {
if (rvline == NULL)
return INVALID_NUMBER;
else
return MGET(rvline, row, col);
}
}
void print_matrix (char *message, MATRIX const *m)
/*****************************************************************************
Print to stdout the contents of MATRIX m.
******************************************************************************/
{
int i, j;
printf ("%s\n",message);
printf("%d %d \n",MROWS (*m),MCOLS (*m));
if ((MROWS (*m) <= MAX_ROWS) && (MCOLS (*m) <= MAX_COLS))
for (i = 0; i < MROWS (*m); i++)
{
for (j = 0; j < MCOLS (*m); j++)
printf ("%10.5f ", MDATA (*m, i, j));
printf ("\n");
}
else printf ("Dimension incorrecta!");
printf ("\n");
}
MATRIX create_matrix (int rows, int cols)
/*****************************************************************************
Creates a MATRIX of dimensions (rows, cols) and initializaes it to zeros.
******************************************************************************/
{
MATRIX m;
MROWS (m) = rows;
MCOLS (m) = cols;
{
int i, j;
for (i = 0; i < MROWS (m); i++)
for (j = 0; j < MCOLS (m); j++)
MDATA (m, i, j) = 0;
}
return m;
}
void *
M_MatrixNew_SP(Uint m, Uint n)
{
M_MatrixSP *A;
int error;
A = Malloc(sizeof(M_MatrixSP));
MMATRIX(A)->ops = &mMatOps_SP;
A->d = spCreate(0, 0, &error);
MROWS(A) = m;
MCOLS(A) = n;
return (A);
}
double K_getPhasedRVLine(ok_kernel* k, int planet, int row, int column) {
static gsl_matrix* phasedRVLine = NULL;
if (planet >= 1) {
if (k->ndata == 0)
return -1;
int np = K_getNplanets(k);
double masses[np + 1];
double periods[np + 1];
for (int i = 1; i <= np; i++) {
masses[i] = K_getElement(k, i, MASS);
periods[i] = K_getElement(k, i, PER);
if (i != planet) {
K_setElement(k, i, MASS, 0.);
K_setElement(k, i, PER, 10000.);
}
};
double period = K_getElement(k, planet, PER);
int samples = -row;
if (phasedRVLine != NULL) {
gsl_matrix_free(phasedRVLine);
phasedRVLine = NULL;
}
double** comp = K_getCompiled(k);
phasedRVLine = K_integrateStellarVelocity(k, comp[0][0],
comp[k->ndata - 1][0],
samples,
NULL, NULL);
double mint = MGET(phasedRVLine, 0, T_TIME);
for (int i = 0; i < MROWS(phasedRVLine); i++) {
double t = fmod((MGET(phasedRVLine, i, 0) - mint), period);
MSET(phasedRVLine, i, 0, t);
}
ok_sort_matrix(phasedRVLine, 0);
for (int i = 1; i <= np; i++) {
K_setElement(k, i, MASS, masses[i]);
K_setElement(k, i, PER, periods[i]);
}
return 1;
} else {
return MGET(phasedRVLine, row, column);
}
}
double K_getPhasedDataForPlanet(ok_kernel* k, int planet, int row, int column) {
static gsl_matrix* phased_data = NULL;
if (planet >= 1) {
if (phased_data != NULL) {
gsl_matrix_free(phased_data);
phased_data = NULL;
}
double chi2 = k->chi2;
double rms = k->rms;
double jitter = k->jitter;
double chi2_rvs = k->chi2_rvs;
planet = MIN(planet, K_getNplanets(k));
double mass = K_getElement(k, planet, MASS);
double period = K_getElement(k, planet, PER);
K_setElement(k, planet, MASS, 0);
K_calculate(k);
phased_data = K_getCompiledDataMatrix(k);
double mint = MGET(phased_data, 0, T_TIME);
for (int i = 0; i < MROWS(phased_data); i++) {
double t = fmod((MGET(phased_data, i, T_TIME) - mint), period);
double v = MGET(phased_data, i, T_SVAL) - MGET(phased_data, i, T_PRED);
MSET(phased_data, i, T_TIME, t);
MSET(phased_data, i, T_VAL, v);
}
ok_sort_matrix(phased_data, T_TIME);
K_setElement(k, planet, MASS, mass);
K_calculate(k);
k->chi2 = chi2;
k->rms = rms;
k->jitter = jitter;
k->chi2_rvs = chi2_rvs;
return 1;
} else {
return MGET(phased_data, row, column);
}
}
void KL_fprintf(const ok_list* kl, FILE* out, const char* fmt, const char* lfmt) {
lfmt = (lfmt != NULL ? lfmt : "%10s%d");
int np = MROWS(kl->kernels[0]->elements)-1;
int vo = PARAMS_SIZE;
fprintf(out, "# Planets = %d\n", np);
fprintf(out, "# Trials = %d\n", kl->size);
fprintf(out, "# Mstar = %e\n", K_getMstar(kl->prototype));
fprintf(out, "# Epoch = %e\n", K_getEpoch(kl->prototype));
for (int i = 0; i < ALL_ELEMENTS_SIZE; i++)
for (int j = 1; j <= np; j++)
fprintf(out, lfmt, ok_all_orb_labels[i], j);
for (int i = 0; i < vo; i++)
fprintf(out, lfmt, "PARAM", i);
fprintf(out, "\n");
for (int m = 0; m < kl->size; m++) {
gsl_matrix* ae = kl->kernels[m]->elements;
for (int i = 0; i < ALL_ELEMENTS_SIZE; i++)
for (int j = 1; j <= np; j++)
fprintf(out, fmt, MGET(ae, j, i));
for (int i = 0; i < vo; i++)
fprintf(out, fmt, VGET(kl->kernels[m]->params, i));
fprintf(out, fmt, kl->kernels[m]->merit);
fprintf(out, fmt, kl->kernels[m]->merit_pr);
fprintf(out, fmt, kl->kernels[m]->merit_li);
fprintf(out, fmt, kl->kernels[m]->tag);
fprintf(out, " \n");
}
}
int KL_getNplanets(const ok_list* kl) {
return MROWS(kl->kernels[0]->elements)-1;
}
double K_getPeriodogramAt(ok_kernel* k, int row, int col) {
static int length;
static int samples = 15000;
static double Pmin = 1.;
static double Pmax = 20000.;
static ok_periodogram_workspace* p = NULL;
static gsl_matrix* ps = NULL;
static const int top_freqs = 10;
static double* top = NULL;
static double tolerance[1] = {1e-3};
if (p == NULL) {
p = (ok_periodogram_workspace*) malloc(sizeof (ok_periodogram_workspace));
p->buf = NULL;
p->per = NULL;
p->calc_z_fap = true;
}
if (row == JS_PS_GET_TOP_PERIODS) {
return top[col];
} else if (row == JS_PS_GET_TOP_POWERS) {
return top[col + top_freqs];
} else if (row == JS_PS_GET_TOP_FAPS) {
return top[col + 2 * top_freqs];
} else if (row == JS_PS_SET_PMIN) {
Pmin = (double) col;
return 0;
} else if (row == JS_PS_SET_PMAX) {
Pmax = (double) col;
return 0;
} else if (row == JS_PS_SETUP) {
if (ps != NULL) {
gsl_matrix_free(ps);
ps = NULL;
}
if (top == NULL)
top = (double*) malloc(top_freqs * 3 * sizeof (double));
gsl_matrix* data = K_getCompiledDataMatrix(k);
for (int i = 0; i < MROWS(data); i++)
MSET(data, i, T_SVAL, MGET(data, i, T_SVAL) - MGET(data, i, T_PRED));
gsl_matrix* ret = ok_periodogram_ls(data, samples, Pmin, Pmax,
0, T_TIME, T_SVAL, T_ERR, p);
ps = ok_resample_curve(ret, 0, 1, 0.1, 800,
100, tolerance, 0, true);
length = MROWS(ps);
ok_sort_matrix(ret, PS_Z);
double dt = 0.5;
int idx = MROWS(ret);
int i = 0;
while (idx > 0 && i < top_freqs) {
idx--;
bool skip = false;
for (int n = 0; n < i; n++)
if (fabs(top[n] - MGET(ret, idx, PS_TIME)) < dt)
skip = true;
if (!skip) {
top[i] = MGET(ret, idx, PS_TIME);
top[i + top_freqs] = MGET(ret, idx, PS_Z);
top[i + 2 * top_freqs] = MGET(ret, idx, PS_FAP);
i++;
}
}
gsl_matrix_free(data);
return (double) length;
} else if (row == JS_PS_GET_FAPS_LEVELS) {
if (p == NULL || ps == NULL)
return 0;
if (col == 1)
return p->z_fap_1;
else if (col == 2)
return p->z_fap_2;
else if (col == 3)
return p->z_fap_3;
else
return 0.;
} else {
if (ps == NULL)
return 0;
return MGET(ps, row, col);
}
}
/**
* Computes the Lomb-Scargle periodogram of the matrix "data". "data" should contain at least three
* columns: time, measurement and measurement error. The periodogram is calculated in "samples" intervals
* between "Pmin" and "Pmax", spaced logarithmically.
*
* The function returns a matrix of "samples" rows and several columns, including period, power (z) and
* an estimation of the upper bound for the false alarm probability. The estimation is calculated using
* the method of Baluev, 2008 (Baluev08). The column PS_Z_LS contains the unnormalized LS periodogram
* (z = 1/2 * (Chi^2_0 - Chi^2_SC)), while the column PS_Z contains z_1 = 1/2 * N_H * z / Chi^2_0 (z_1 in Baluev08).
* The FAP upper bound is estimated as ~ tau(z_1). (Another estimate of the FAP can be calculated by
* estimating the indep. frequencies through your own algorithm, or using the ok_periodogram_boot routine.)
*
* @param data Input data containing the data; each row containing (t_i, x_i, sigma_i)
* @param samples Number of frequencies sampled
* @param Pmin Minimum period sampled
* @param Pmax Maximum period sampled
* @param method Method to compute periodogram (ignored)
* @param timecol Time column (e.g. 0) in the matrix data
* @param valcol Value column (e.g. 1) in the matrix data
* @param sigmacol Sigma column (e.g. 2) in the matrix data
* @param p If not NULL, it is used to return additional info for the periodogram and reuse matrices to save space/speed. If you pass
* a value different than NULL, you are responsible for deallocating the workspace and its fields. p->buf is an array of
* gsl_matrix*, sized the same as the value of omp_get_max_threads().
* @return A matrix containing: {PS_TIME, PS_Z, PS_FAP, PS_Z_LS} (period, power, FAP upper limit, unnormalized
* LS power). You are responsible for deallocating it.
*/
gsl_matrix* ok_periodogram_ls(const gsl_matrix* data, const unsigned int samples, const double Pmin, const double Pmax, const int method,
unsigned int timecol, unsigned int valcol, unsigned int sigcol, ok_periodogram_workspace* p) {
gsl_matrix* ret = NULL;
gsl_matrix* buf = NULL;
gsl_vector* bufv = gsl_vector_alloc(data->size1);
int ndata = data->size1;
// If no pre-allocated buffers are passed through p, or p is null,
// allocate those buffers.
if (p != NULL) {
if (p->per != NULL && MROWS(p->per) == samples && MCOLS(p->per) == PS_SIZE)
ret = p->per;
if (p->buf != NULL && MROWS(p->buf) == ndata && MCOLS(p->per) == 5)
ret = p->buf;
}
ret = (ret != NULL ? ret : gsl_matrix_alloc(samples, PS_SIZE));
buf = (buf != NULL ? buf : gsl_matrix_alloc(ndata, 5));
double fmin = 1. / Pmax;
double fmax = 1. / Pmin;
double df = (fmax - fmin) / (double) samples;
gsl_matrix_get_col(bufv, data, timecol);
double W = 2. * M_PI * gsl_stats_sd(bufv->data, 1, ndata) / Pmin;
gsl_matrix_get_col(bufv, data, valcol);
double avg = gsl_stats_mean(bufv->data, 1, ndata);
double z1_max = 0.;
double xa[ndata];
// pre-calculate cdf, sdf
for (int i = 0; i < ndata; i++) {
double t = MGET(data, i, timecol) - MGET(data, 0, timecol);
MSET(buf, i, BUF_CDF, cos(2 * M_PI * df * t));
MSET(buf, i, BUF_SDF, sin(2 * M_PI * df * t));
MSET(buf, i, BUF_C, cos(2 * M_PI * fmin * t));
MSET(buf, i, BUF_S, sin(2 * M_PI * fmin * t));
MSET(buf, i, BUF_SIG, 1. / (MGET(data, i, sigcol) * MGET(data, i, sigcol)));
xa[i] = MGET(data, i, valcol) - avg;
}
// Calculate periodogram by looping over all angular frequencies
for (int i = 0; i < samples; i++) {
// Current frequency
double f = fmin + df * i;
double w = 2 * M_PI*f;
// Calculate tau(w)
double s_2wt = 0.;
double c_2wt = 0.;
for (int j = 0; j < ndata; j++) {
double cos_wt = C(j);
double sin_wt = S(j);
c_2wt += (1. - 2. * sin_wt * sin_wt) * SIG(j);
s_2wt += (2. * sin_wt * cos_wt) * SIG(j);
}
double tau = atan2(s_2wt, c_2wt) / (2. * w);
double numa = 0.;
double numb = 0.;
double dena = 0.;
double denb = 0.;
double numa_w = 0.;
double numb_w = 0.;
double dena_w = 0.;
double denb_w = 0.;
double coswtau = cos(w * tau);
double sinwtau = sin(w * tau);
double chi2_h = 0.;
double chi2_h_w = 0;
for (int j = 0; j < ndata; j++) {
double sig = SIG(j);
const double cos_wt = C(j);
const double sin_wt = S(j);
double cos_wdf = CDF(j);
double sin_wdf = SDF(j);
double c = cos_wt * coswtau + sin_wt * sinwtau;
double s = sin_wt * coswtau - cos_wt * sinwtau;
double x = xa[j];
MSET(buf, j, BUF_C, cos_wt * cos_wdf - sin_wt * sin_wdf);
MSET(buf, j, BUF_S, sin_wt * cos_wdf + cos_wt * sin_wdf);
numa += x * c * sig;
numb += x * s * sig;
dena += c * c * sig;
denb += s * s * sig;
chi2_h += x * x * sig;
numa_w += c;
numb_w += s;
dena_w += c*c;
denb_w += s*s;
chi2_h_w += 1;
}
double z = 0.5 * (numa * numa / dena + numb * numb / denb);
double z_1 = z * ndata / chi2_h;
double w_1 = 0.5 * (numa_w * numa_w / dena_w + numb_w * numb_w / denb_w) * ndata / chi2_h_w;
double fap_single = pow(1. - 2. * z_1 / (double) ndata, 0.5 * (double) (ndata - 3.));
double tau_z = W * fap_single * sqrt(z_1);
MSET(ret, samples - i - 1, PS_TIME, 1. / f);
MSET(ret, samples - i - 1, PS_Z, z_1);
MSET(ret, samples - i - 1, PS_Z_LS, z);
MSET(ret, samples - i - 1, PS_FAP, MIN(fap_single + tau_z, 1.));
MSET(ret, samples - i - 1, PS_TAU, tau);
MSET(ret, samples - i - 1, PS_WIN, w_1);
z1_max = MAX(z1_max, z_1);
}
if (p != NULL && p->calc_z_fap) {
gsl_root_fsolver * s = gsl_root_fsolver_alloc(gsl_root_fsolver_brent);
double pars[3];
pars[0] = ndata;
pars[1] = W;
pars[2] = 0.;
gsl_function F;
F.function = _baluev_tau;
F.params = pars;
double zz = z1_max;
while (_baluev_tau(zz, pars) > 1e-3)
zz *= 2;
p->z_fap_3 = _find_z(s, &F, 1e-3, 0.1, zz);
p->z_fap_2 = _find_z(s, &F, 1e-2, 0.1, p->z_fap_3);
p->z_fap_1 = _find_z(s, &F, 1e-1, 0.1, p->z_fap_2);
gsl_root_fsolver_free(s);
p->calc_z_fap = false;
}
if (p == NULL) {
gsl_matrix_free(buf);
} else {
p->per = ret;
p->buf = buf;
p->zmax = z1_max;
};
gsl_vector_free(bufv);
return ret;
}