/* Tridiagonal Systems */
CAMLprim value ml_gsl_linalg_solve_symm_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_tridiag(&v_DIAG, &v_E, &v_B, &v_X);
return Val_unit;
}
/*
# mrs jest niestabilna numerycznie
# rozwiązanie przykładowego problemu
# cu' - u" = x^2 - rownanie dyfuzji-konwekcji
# xe(0,1); u(0)=u(1)=0;
# arg1 = liczba podzialow; arg2 = stala konwekcji c
*/
int main(int argc, char *argv[]){
unsigned n;
double c;
if(argc<3){
printf("\nWymagane dwa argumenty: liczba podzialow; stala konwekcji c\n");
return 1;
} else {
int i=atoi(argv[1]);
c=atof(argv[2]);
if( i<2 ){
printf("\nNie mozna dzielic na mniej niz dwa elementy\n");
return 2;
}
n=i;
}
/*
macierz wspolczynników w mrs jest trójdiagonalna
przy obranych warunkach poczatkowych jest ponadto
symetryczna wzgledem obu diagonal
*/
const unsigned N =n+1;
gsl_vector* diag = gsl_vector_alloc( N-2 );
//analitycznie uzyskana wartosc
gsl_vector_set_all (diag, 2*n*n);
gsl_vector* offdiag = gsl_vector_alloc( N-3 );
//analitycznie uzyskana wartosc
gsl_vector_set_all (offdiag, (c/2)*n-n*n);
gsl_vector* f = gsl_vector_alloc( N-2 );
//wypelnienie probkowanymi wartosciami funkcji x^2
int i=N-2;
double h = 1.0/n;
while(i--){
gsl_vector_set (f,i, (i*h+h) * (i*h+h) );
}
gsl_vector* x = gsl_vector_alloc( N-2 );
//solver dedykowany do trojdiagonalej symetrycznej
//macierzy wspolczynnikow
// - mniejsza zlozonosc O(n^2)
gsl_linalg_solve_symm_tridiag (diag,offdiag,f,x);
//plik tymczasowy dla gnuplot
FILE* out = fopen("out_0.tmp","w");
i=N-2;
//warunek brzegowy #1
fprintf(out,"%f\t%f\n",1.0,0.0);
while(i--){
fprintf(out,"%f\t%f\n",i*h+h,gsl_vector_get (x,i));
}
//warunek brzegowy #2
fprintf(out,"%f\t%f",0.0,0.0);
gsl_vector_free(diag);
gsl_vector_free(offdiag);
return 0;
}
/* natural spline calculation
* see [Engeln-Mullges + Uhlig, p. 254]
*/
static int
cspline_init (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 - 1; /* linear system is sys_size x sys_size */
state->c[0] = 0.0;
state->c[max_index] = 0.0;
for (i = 0; i < sys_size; 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);
}
if (sys_size == 1)
{
state->c[1] = state->g[0] / state->diag[0];
return GSL_SUCCESS;
}
else
{
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 - 1);
gsl_vector_view solution_vec = gsl_vector_view_array ((state->c) + 1, sys_size);
int status = gsl_linalg_solve_symm_tridiag(&diag_vec.vector,
&offdiag_vec.vector,
&g_vec.vector,
&solution_vec.vector);
return status;
}
}
/**
* C++ version of gsl_linalg_solve_symm_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_tridiag( vector const& diag, vector const& offdiag, vector const& b,
vector& x ){
return gsl_linalg_solve_symm_tridiag( diag.get(), offdiag.get(), b.get(), x.get() ); }
int main_gsl_quad() {
// Na postawie N i K bede ustalal jak wiele moze byc przedzialów,
// Ustalilem recznie, na wyczucie.
//
int DEEP = (int)( log(2.0E7 / N) );
// printf("%d\n", DEEP);
int DLIMIT = Pow(2,DEEP);
double result1, result2, diff1, diff2;
double result3, result4, diff3, diff4;
F = gsl_vector_alloc((int)N); // Macierz G jest trojdiagonalna symetryczna
G1 = gsl_vector_alloc((int)N); // wiec mozna ja opisac jedynie poprzez 2
G2 = gsl_vector_alloc((int)N-1); // wektory- diagonali i poddiagonali.
X = gsl_vector_alloc((int)N); //
for (int i = 0; i < N; ++i)
gsl_vector_set(G1, i, 2*(i-1.0)/h);
for (int i = 0; i < N-1; ++i)
gsl_vector_set(G2, i, -(2.0*i+1.0)/2.0/h);
workspace = gsl_integration_workspace_alloc(LIMIT);
if ( K > 20 ) {
DLIMIT = (int) log10(sqrt(5*K))*DLIMIT;
DEEP = (int) log2(DLIMIT);
}
DLIMIT *= 4;
DEEP *= 4;
table = gsl_integration_qawo_table_alloc(K*PI, h, GSL_INTEG_SINE, DEEP);
fun.function = &f2q_sin;
// printf("%d %d\n", DEEP, DLIMIT);
// Mamy doczynienia z funkcja oscylujaca, uzyjmy wiec specjalnych
// kwadratur GSLa, oddzielnie dla sinus oddzielnie dla cosinus,
//
for (f2qi = 1; f2qi <= N; ++f2qi) { // sinus
fisign = 1;
if ( f2qi < 2 ) // wartosci na siebie nachodza
gsl_integration_qawo(&fun, (f2qi-1)*h, 0.0E0, EPSILON, DLIMIT, workspace, table, &result1, &diff1);
else result1 = -result3;
fisign = -1;
gsl_integration_qawo(&fun, (f2qi )*h, 0.0E0, EPSILON, DLIMIT, workspace, table, &result3, &diff3);
gsl_vector_set(F, f2qi-1, result1+result3);
// if( f2qi % 1000 == 0 ) { printf("%d \r", f2qi); fflush(stdout); }
}
gsl_integration_qawo_table_free(table);
table = gsl_integration_qawo_table_alloc(K*PI, h, GSL_INTEG_COSINE, DEEP);
fun.function = &f2q_cos;
for (f2qi = 1; f2qi <= N; ++f2qi) { // cosinus
fisign = 1;
if ( f2qi < 2 ) // wartosci na siebie nachodza
gsl_integration_qawo(&fun, (f2qi-1)*h, 0.0E0, EPSILON, DLIMIT, workspace, table, &result2, &diff2);
else result2 = -result4;
fisign = -1;
gsl_integration_qawo(&fun, (f2qi )*h, 0.0E0, EPSILON, DLIMIT, workspace, table, &result4, &diff4);
gsl_vector_set(F, f2qi-1, result1+result3+gsl_vector_get(F, f2qi-1));
// if( f2qi % 1000 == 0 ) { printf("%d \r", f2qi); fflush(stdout); }
}
gsl_integration_qawo_table_free(table);
// Mamy F wiec znajdujemy X (h*), rozwiazujac uklad Gh=F
// gdzie G symetryczna trojdiagonalna,
//
// fprintf(stderr,"2 quad done.\n");
gsl_linalg_solve_symm_tridiag(G1,G2,F,X);
// for (int i = 0; i < N; ++i)
// fprintf(stderr,"h[%d] = %.15e\n",i,gsl_vector_get(X,i));
fprintf(stderr,"2 linalg done.\n");
return 0;
}
static int init(void * vstate, const double xa[], const double ya[], size_t size)
{
struct state_t * state = (struct state_t *) vstate;
switch (size)
{
case 2:
{
double A[16];
double x[4];
double b[4];
/* Set up the system */
{
int i;
double h = xa[1] - xa[0];
for (i=0; i<16; i++)
A[i] = 0.0;
/* Zeroth-order, all points have the same value */
/* a = y0 */
A[0*4+0] = 1.0;
b[0] = ya[0];
/* a, b, c, d = y1 */
A[1*4+0] = 1.0;
A[1*4+1] = h;
A[1*4+2] = h*h;
A[1*4+3] = h*h*h;
b[1] = ya[1];
/* The last two equations depend on the endpoint types */
if (state->ltype == BT_INTERP_SLOPE)
{
/* b = alpha */
A[2*4+1] = 1.0;
b[2] = state->alpha;
}
else /* state->ltype == WAM_INTERP_NATURAL */
{
/* c = 0 */
A[2*4+2] = 2.0;
b[2] = 0.0;
}
if (state->rtype == BT_INTERP_SLOPE)
{
/* b, c, d = beta */
A[3*4+1] = 1.0;
A[3*4+2] = 2*h;
A[3*4+3] = 3*h*h;
b[3] = state->beta;
}
else /* state->ltype == WAM_INTERP_NATURAL */
{
/* c, d = 0 */
A[3*4+2] = 2.0;
A[3*4+3] = 6*h;
b[3] = 0.0;
}
}
/* Solve the system */
{
gsl_matrix_view A_view = gsl_matrix_view_array(A,4,4);
gsl_vector_view b_view = gsl_vector_view_array(b,4);
gsl_vector_view x_view = gsl_vector_view_array(x,4);
gsl_permutation * p = gsl_permutation_alloc(4);
int s;
gsl_linalg_LU_decomp( &A_view.matrix, p, &s);
gsl_linalg_LU_solve( &A_view.matrix, p, &b_view.vector, &x_view.vector );
gsl_permutation_free(p);
}
/* Save the solved values */
state->s_2p->a = x[0];
state->s_2p->b = x[1];
state->s_2p->c = x[2];
state->s_2p->d = x[3];
} break;
case 3:
{
double A[64];
double x[8];
double b[8];
/* Set up the system */
{
int i;
double hL = xa[1] - xa[0];
double hR = xa[2] - xa[1];
for (i=0; i<64; i++)
A[i] = 0.0;
/* Zeroth-order, all points have the same value */
/* aL = y0 */
A[0*8+0] = 1.0;
b[0] = ya[0];
/* aL, bL, cL, dL = y1 */
A[1*8+0] = 1.0;
A[1*8+1] = hL;
A[1*8+2] = hL*hL;
A[1*8+3] = hL*hL*hL;
b[1] = ya[1];
/* aR = y1 */
A[2*8+4] = 1.0;
b[2] = ya[1];
/* aR, bR, cR, dR = y2 */
A[3*8+4] = 1.0;
A[3*8+5] = hR;
A[3*8+6] = hR*hR;
A[3*8+7] = hR*hR*hR;
b[3] = ya[2];
/* First-order, the slopes are the same at the midpoint */
/* bL, cL, dL, -bR = 0 */
A[4*8+1] = 1.0;
A[4*8+2] = 2*hL;
A[4*8+3] = 3*hL*hL;
A[4*8+5] = -1.0;
b[4] = 0.0;
/* Second-order, the concavity is the same at the midpoint */
/* cL, dL, -cR = 0 */
A[5*8+2] = 2.0;
A[5*8+3] = 6*hL;
A[5*8+6] = -2.0;
b[5] = 0.0;
/* The last two equations depend on the endpoint types */
if (state->ltype == BT_INTERP_SLOPE)
{
/* bL = alpha */
A[6*8+1] = 1.0;
b[6] = state->alpha;
}
else /* state->ltype == WAM_INTERP_NATURAL */
{
/* cL = 0 */
A[6*8+2] = 2.0;
b[6] = 0.0;
}
if (state->rtype == BT_INTERP_SLOPE)
{
/* bR, cR, dR = beta */
A[7*8+5] = 1.0;
A[7*8+6] = 2*hR;
A[7*8+7] = 3*hR*hR;
b[7] = state->beta;
}
else /* state->rtype == WAM_INTERP_NATURAL */
{
/* cR, dR = 0 */
A[7*8+6] = 2.0;
A[7*8+7] = 6*hL;
b[7] = 0.0;
}
}
/* Solve the system */
{
gsl_matrix_view A_view = gsl_matrix_view_array(A,8,8);
gsl_vector_view b_view = gsl_vector_view_array(b,8);
gsl_vector_view x_view = gsl_vector_view_array(x,8);
gsl_permutation * p = gsl_permutation_alloc(8);
int s;
gsl_linalg_LU_decomp( &A_view.matrix, p, &s);
gsl_linalg_LU_solve( &A_view.matrix, p, &b_view.vector, &x_view.vector );
gsl_permutation_free(p);
}
/* Save the solved values */
state->s_3p->aL = x[0];
state->s_3p->bL = x[1];
state->s_3p->cL = x[2];
state->s_3p->dL = x[3];
state->s_3p->aR = x[4];
state->s_3p->bR = x[5];
state->s_3p->cR = x[6];
state->s_3p->dR = x[7];
} break;
default:
{
/* spline calculation with natural boundary conditions
* or with defined first and/or last derivatives
* see [Engeln-Mullges + Uhlig, p. 258]
*/
/* Note - this is mostly duplication. Oh well. */
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 - 1; /* linear system is sys_size x sys_size */
/* Note - moved outer c setting to below */
/* Set up the system for the inner c's */
for (i = 0; i < sys_size; 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->cstate->offdiag[i] = h_ip1;
/* added in here ######### */
if (state->ltype == BT_INTERP_SLOPE && i==0)
{
state->cstate->diag[i] = 1.5 * h_i + 2.0 * h_ip1;
state->cstate->g[i] = 3.0 * (ydiff_ip1 * g_ip1 - 0.5 * ( 3.0*(ydiff_i*g_i) - state->alpha ) );
continue;
}
if (state->rtype == BT_INTERP_SLOPE && i == sys_size-1)
{
state->cstate->diag[i] = 2.0 * h_i + 1.5 * h_ip1;
state->cstate->g[i] = 3.0 * ( 0.5 * ( 3.0*(ydiff_ip1*g_ip1) - state->beta ) - ydiff_i * g_i );
continue;
}
/* ####################### */
state->cstate->diag[i] = 2.0 * (h_ip1 + h_i);
state->cstate->g[i] = 3.0 * (ydiff_ip1 * g_ip1 - ydiff_i * g_i);
}
/* Solve the system for the inner c's */
{
gsl_vector_view g_vec = gsl_vector_view_array(state->cstate->g, sys_size);
gsl_vector_view diag_vec = gsl_vector_view_array(state->cstate->diag, sys_size);
gsl_vector_view offdiag_vec = gsl_vector_view_array(state->cstate->offdiag, sys_size - 1);
gsl_vector_view solution_vec = gsl_vector_view_array ((state->cstate->c) + 1, sys_size);
int status = gsl_linalg_solve_symm_tridiag(&diag_vec.vector,
&offdiag_vec.vector,
&g_vec.vector,
&solution_vec.vector);
if (status != GSL_SUCCESS) return status;
}
/* Set the outer c's. */
if (state->ltype == BT_INTERP_SLOPE)
{
const double h_0 = xa[1] - xa[0];
const double ydiff_0 = ya[1] - ya[0];
state->cstate->c[0] = 1.0/(2.0*h_0) * ( (3.0/h_0)*ydiff_0 - 3.0*state->alpha - state->cstate->c[1]*h_0 );
}
else
state->cstate->c[0] = 0.0;
if (state->rtype == BT_INTERP_SLOPE)
{
const double h_nm1 = xa[max_index] - xa[max_index-1];
const double ydiff_nm1 = ya[max_index] - ya[max_index-1];
state->cstate->c[max_index] = - 1.0/(2.0*h_nm1) * ( (3.0/h_nm1)*ydiff_nm1 - 3.0*state->beta + state->cstate->c[max_index-1]*h_nm1 );
}
else
state->cstate->c[max_index] = 0.0;
} break;
}
return GSL_SUCCESS;
}
int main_rect() {
double result1=0, result2=0, diff1=0, diff2=0;
double result3=0, result4=0, diff3=0, diff4=0;
F = gsl_vector_alloc((int)N); // Macierz G jest trojdiagonalna symetryczna
G1 = gsl_vector_alloc((int)N); // wiec mozna ja opisac jedynie poprzez 2
G2 = gsl_vector_alloc((int)N-1); // wektory- diagonali i poddiagonali.
X = gsl_vector_alloc((int)N); //
for (int i = 0; i < N; ++i)
gsl_vector_set(G1, i, 2*(i-1.0)/h);
for (int i = 0; i < N-1; ++i)
gsl_vector_set(G2, i, -(2.0*i+1.0)/2.0/h);
workspace = gsl_integration_workspace_alloc(LIMIT);
for (f1qi = 1; f1qi <= N; ++f1qi) { // na dwie tury,
fisign = 1;
if (f1qi < 2) {
result1 = 0;
for (double i = ((double)f1qi-1.0)*h + h/M/2.0; i < ((double)f1qi)*h; i += h/M)
result1 += f1q(i,0)*h/M;
} else result1 = -result2;
gsl_vector_set(F, f1qi-1, result1);
fisign = -1;
result2 = 0;
for (double i = ((double)f1qi)*h + h/M/2.0; i < ((double)f1qi+1)*h; i += h/M)
result2 += f1q(i,0)*h/M;
gsl_vector_set(F, f1qi-1, result1 +result2);
if( f1qi % 1000 == 0 ) { printf("%d \r", f2qi); fflush(stdout); }
}
fprintf(stderr,"1 qad done.\n");
gsl_linalg_solve_symm_tridiag(G1,G2,F,X);
// for (int i = 0; i < N; ++i)
// fprintf(stderr,"h[%d] = %e\n",i,gsl_vector_get(X,i));
fprintf(stderr,"1 linalg done.\n");
for (f2qi = 1; f2qi <= N; ++f2qi) { // sinus
fisign = 1;
if (f2qi < 2) { // wartosci na siebie nachodza
result1 = 0;
for (double i = ((double)f2qi-1.0)*h + h/M/2.0; i < ((double)f2qi)*h; i += h/M)
result1 += f2q(i,0)*h/M;
} else result1 = -result3;
fisign = -1;
result2 = 0;
for (double i = ((double)f2qi)*h + h/M/2.0; i < ((double)f2qi+1)*h; i += h/M)
result2 += f2q(i,0)*h/M;
gsl_vector_set(F, f2qi-1, result2+result1);
if( f2qi % 1000 == 0 ) { printf("%d \r", f2qi); fflush(stdout); }
}
fprintf(stderr,"2 quad done.\n");
gsl_linalg_solve_symm_tridiag(G1,G2,F,X);
// for (int i = 0; i < N; ++i)
// fprintf(stderr,"h[%d] = %.15e\n",i,gsl_vector_get(X,i));
fprintf(stderr,"2 linalg done.\n");
gsl_integration_workspace_free(workspace);
gsl_vector_free(F);
gsl_vector_free(G1);
gsl_vector_free(G2);
gsl_vector_free(X);
return 0;
}
