/* 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; }