CAMLprim value ml_gsl_linalg_solve_symm_cyc_tridiag(value DIAG, value E, value B, value X)
{
_DECLARE_VECTOR4(DIAG, E, B, X);
_CONVERT_VECTOR4(DIAG, E, B, X);
gsl_linalg_solve_symm_cyc_tridiag(&v_DIAG, &v_E, &v_B, &v_X);
return Val_unit;
}
/**
* C++ version of gsl_linalg_solve_symm_cyc_tridiag().
* @param diag A vector of diagonal elements
* @param offdiag Off-diagonal vector (one element shorte than @c diag)
* @param b A vector
* @param x A vector
* @return Error code on failure
*/
inline int solve_symm_cyc_tridiag( vector const& diag, vector const& offdiag,
vector const& b, vector& x ){
return gsl_linalg_solve_symm_cyc_tridiag( diag.get(), offdiag.get(), b.get(), x.get() ); }
/* periodic spline calculation
* see [Engeln-Mullges + Uhlig, p. 256]
*/
static int
cspline_init_periodic (void * vstate, const double xa[], const double ya[],
size_t size)
{
cspline_state_t *state = (cspline_state_t *) vstate;
size_t i;
size_t num_points = size;
size_t max_index = num_points - 1; /* Engeln-Mullges + Uhlig "n" */
size_t sys_size = max_index; /* linear system is sys_size x sys_size */
if (sys_size == 2) {
/* solve 2x2 system */
const double h0 = xa[1] - xa[0];
const double h1 = xa[2] - xa[1];
const double A = 2.0*(h0 + h1);
const double B = h0 + h1;
double g[2];
double det;
g[0] = 3.0 * ((ya[2] - ya[1]) / h1 - (ya[1] - ya[0]) / h0);
g[1] = 3.0 * ((ya[1] - ya[2]) / h0 - (ya[2] - ya[1]) / h1);
det = 3.0 * (h0 + h1) * (h0 + h1);
state->c[1] = ( A * g[0] - B * g[1])/det;
state->c[2] = (-B * g[0] + A * g[1])/det;
state->c[0] = state->c[2];
return GSL_SUCCESS;
} else {
for (i = 0; i < sys_size-1; i++) {
const double h_i = xa[i + 1] - xa[i];
const double h_ip1 = xa[i + 2] - xa[i + 1];
const double ydiff_i = ya[i + 1] - ya[i];
const double ydiff_ip1 = ya[i + 2] - ya[i + 1];
const double g_i = (h_i != 0.0) ? 1.0 / h_i : 0.0;
const double g_ip1 = (h_ip1 != 0.0) ? 1.0 / h_ip1 : 0.0;
state->offdiag[i] = h_ip1;
state->diag[i] = 2.0 * (h_ip1 + h_i);
state->g[i] = 3.0 * (ydiff_ip1 * g_ip1 - ydiff_i * g_i);
}
i = sys_size - 1;
{
const double h_i = xa[i + 1] - xa[i];
const double h_ip1 = xa[1] - xa[0];
const double ydiff_i = ya[i + 1] - ya[i];
const double ydiff_ip1 = ya[1] - ya[0];
const double g_i = (h_i != 0.0) ? 1.0 / h_i : 0.0;
const double g_ip1 = (h_ip1 != 0.0) ? 1.0 / h_ip1 : 0.0;
state->offdiag[i] = h_ip1;
state->diag[i] = 2.0 * (h_ip1 + h_i);
state->g[i] = 3.0 * (ydiff_ip1 * g_ip1 - ydiff_i * g_i);
}
{
gsl_vector_view g_vec = gsl_vector_view_array(state->g, sys_size);
gsl_vector_view diag_vec = gsl_vector_view_array(state->diag, sys_size);
gsl_vector_view offdiag_vec = gsl_vector_view_array(state->offdiag, sys_size);
gsl_vector_view solution_vec = gsl_vector_view_array ((state->c) + 1, sys_size);
int status = gsl_linalg_solve_symm_cyc_tridiag(&diag_vec.vector,
&offdiag_vec.vector,
&g_vec.vector,
&solution_vec.vector);
state->c[0] = state->c[max_index];
return status;
}
}
}
