static void set_sys(int argc, VALUE *argv, gsl_odeiv_system *sys)
{
size_t dimension;
VALUE ary, vjac, dim;
VALUE vparams;
int itmp;
size_t i, j;
if (argc < 2) rb_raise(rb_eArgError, "too few arguments");
CHECK_PROC(argv[0]);
if (sys == NULL) {
sys = ALLOC(gsl_odeiv_system);
sys->function = &calc_func;
sys->jacobian = &calc_jac;
}
if (sys->params == NULL) {
ary = rb_ary_new2(4);
/* (VALUE) sys->params = ary;*/
sys->params = (void *) ary;
} else {
ary = (VALUE) sys->params;
}
rb_ary_store(ary, 1, Qnil); /* function to calc J */
rb_ary_store(ary, 3, Qnil); /* parameters */
itmp = 1;
if (rb_obj_is_kind_of(argv[1], rb_cProc)) {
vjac = argv[1];
itmp = 2;
} else {
vjac = Qnil;
}
if ((dim =argv[itmp++]) == Qnil) dim = argv[itmp++];
switch (argc - itmp) {
case 0:
vparams = Qnil;
break;
case 1:
vparams = argv[itmp];
break;
default:
vparams = rb_ary_new2(argc-itmp);
for (i = itmp, j = 0; i < argc; i++, j++) rb_ary_store(vparams, j, argv[i]);
}
dimension = FIX2INT(dim);
sys->dimension = dimension;
rb_ary_store(ary, 0, argv[0]);
rb_ary_store(ary, 1, vjac);
rb_ary_store(ary, 2, dim);
rb_ary_store(ary, 3, vparams);
}
static VALUE rb_gsl_function_set_f(int argc, VALUE *argv, VALUE obj)
{
gsl_function *F = NULL;
VALUE ary, ary2;
size_t i;
Data_Get_Struct(obj, gsl_function, F);
if (F->params == NULL) {
ary = rb_ary_new2(2);
/* (VALUE) F->params = ary;*/
F->params = (void *) ary;
} else {
ary = (VALUE) F->params;
}
rb_ary_store(ary, 1, Qnil);
switch (argc) {
case 0:
break;
case 1:
CHECK_PROC(argv[0]);
rb_ary_store(ary, 0, argv[0]);
break;
case 2:
CHECK_PROC(argv[0]);
rb_ary_store(ary, 0, argv[0]);
rb_ary_store(ary, 1, argv[1]);
break;
default:
CHECK_PROC(argv[0]);
rb_ary_store(ary, 0, argv[0]);
ary2 = rb_ary_new2(argc-1);
for (i = 1; (int) i < argc; i++) rb_ary_store(ary2, i-1, argv[i]);
rb_ary_store(ary, 1, ary2);
break;
}
if (rb_block_given_p()) rb_ary_store(ary, 0, rb_block_proc());
return obj;
}
static VALUE rb_gsl_function_fdf_set_fdf(VALUE obj, VALUE procfdf)
{
gsl_function_fdf *F = NULL;
VALUE ary;
CHECK_PROC(procfdf);
Data_Get_Struct(obj, gsl_function_fdf, F);
if (F->params == NULL) {
ary = rb_ary_new2(4);
/* (VALUE) F->params = ary;*/
F->params = (void *) ary;
} else {
ary = (VALUE) F->params;
}
rb_ary_store(ary, 2, procfdf);
return obj;
}
static VALUE rb_gsl_odeiv_solver_new(int argc, VALUE *argv, VALUE klass)
{
gsl_odeiv_solver *gos = NULL;
VALUE epsabs, epsrel, ay, adydt;
VALUE dim;
if (argc < 4) rb_raise(rb_eArgError, "too few arguments");
Check_Type(argv[1], T_ARRAY);
CHECK_PROC(argv[2]);
if (rb_obj_is_kind_of(argv[3], rb_cProc) || NIL_P(argv[3])) {
dim = argv[4];
} else {
dim = argv[3];
}
gos = ALLOC(gsl_odeiv_solver);
gos->s = make_step(argv[0], dim);
// switch (RARRAY(argv[1])->len) {
switch (RARRAY_LEN(argv[1])) {
case 2:
epsabs = rb_ary_entry(argv[1], 0);
epsrel = rb_ary_entry(argv[1], 1);
gos->c = make_control_y(epsabs, epsrel);
break;
case 4:
epsabs = rb_ary_entry(argv[1], 0);
epsrel = rb_ary_entry(argv[1], 1);
ay = rb_ary_entry(argv[1], 2);
adydt = rb_ary_entry(argv[1], 3);
gos->c = make_control_standard(epsabs, epsrel, ay, adydt);
break;
default:
rb_raise(rb_eArgError, "size of the argument 1 must be 2 or 4");
break;
}
gos->sys = make_sys(argc - 2, argv + 2);
gos->e = make_evolve(dim);
return Data_Wrap_Struct(klass, gsl_odeiv_solver_mark, rb_gsl_odeiv_solver_free, gos);
// return Data_Wrap_Struct(klass, 0, rb_gsl_odeiv_solver_free, gos);
}
static VALUE rb_gsl_set_error_handler(int argc, VALUE *argv, VALUE module)
{
if (rb_block_given_p()) {
eHandler = RB_GSL_MAKE_PROC;
gsl_set_error_handler(&rb_gsl_my_error_handler);
return Qtrue;
}
switch (argc) {
case 0:
gsl_set_error_handler(&rb_gsl_error_handler);
return Qtrue;
break;
case 1:
CHECK_PROC(argv[0]);
eHandler = argv[0];
gsl_set_error_handler(&rb_gsl_my_error_handler);
return Qtrue;
break;
default:
rb_raise(rb_eArgError, "too many arguments (%d for 0 or 1 Proc)", argc);
break;
}
}
