static int get_limit_key_workspace(int argc, VALUE *argv, int argstart,
size_t *limit, int *key,
gsl_integration_workspace **w)
{
int flag = 0;
switch (argc-argstart) {
case 3:
CHECK_FIXNUM(argv[argstart]);
CHECK_FIXNUM(argv[argstart+1]);
CHECK_WORKSPACE(argv[argstart+2]);
*limit = FIX2INT(argv[argstart]);
*key = FIX2INT(argv[argstart+1]);
Data_Get_Struct(argv[argstart+2], gsl_integration_workspace, *w);
flag = 0;
break;
case 1:
CHECK_FIXNUM(argv[argstart]);
*key = FIX2INT(argv[argstart]);
*limit = LIMIT_DEFAULT;
*w = gsl_integration_workspace_alloc(*limit);
flag = 1;
break;
case 2:
if (TYPE(argv[argc-1]) == T_FIXNUM) {
CHECK_FIXNUM(argv[argc-2]);
*limit = FIX2INT(argv[argc-2]);
*key = FIX2INT(argv[argc-1]);
*w = gsl_integration_workspace_alloc(*limit);
flag = 1;
} else {
CHECK_FIXNUM(argv[argc-2]);
CHECK_WORKSPACE(argv[argc-1]);
*key = FIX2INT(argv[argc-2]);
Data_Get_Struct(argv[argc-1], gsl_integration_workspace, *w);
*limit = (*w)->limit;
flag = 0;
}
break;
case 0:
*key = KEY_DEFAULT;
*limit = LIMIT_DEFAULT;
*w = gsl_integration_workspace_alloc(*limit);
flag = 1;
break;
default:
rb_raise(rb_eArgError, "wrong number of arguments");
break;
}
if (*w == NULL) rb_raise(rb_eRuntimeError, "something wrong with workspace");
return flag;
}
static VALUE rb_gsl_integration_qawf(int argc, VALUE *argv, VALUE obj)
{
double a, epsabs = EPSREL_DEFAULT;
double result, abserr;
size_t limit = LIMIT_DEFAULT;
gsl_function *F = NULL;
gsl_integration_workspace *w = NULL, *cw = NULL;
gsl_integration_qawo_table *t = NULL;
int status, intervals, flag = 0, flagt = 0, itmp;
VALUE *vtmp;
switch (TYPE(obj)) {
case T_MODULE: case T_CLASS: case T_OBJECT:
if (argc < 2) rb_raise(rb_eArgError, "too few arguments");
CHECK_FUNCTION(argv[0]);
Data_Get_Struct(argv[0], gsl_function, F);
itmp = 1;
break;
default:
if (argc < 1) rb_raise(rb_eArgError, "too few arguments");
Data_Get_Struct(obj, gsl_function, F);
itmp = 0;
break;
}
Need_Float(argv[itmp]);
a = NUM2DBL(argv[itmp]);
itmp += 1;
if (TYPE(argv[itmp]) == T_FLOAT) {
epsabs = NUM2DBL(argv[itmp]);
itmp += 1;
}
vtmp = argv + itmp;
flagt = get_qawo_table(argv[argc-1], &t);
switch (argc - 1 - itmp) {
case 0:
w = gsl_integration_workspace_alloc(limit);
cw = gsl_integration_workspace_alloc(limit);
flag = 1;
break;
case 1:
CHECK_FIXNUM(vtmp[0]);
limit = FIX2INT(vtmp[0]);
w = gsl_integration_workspace_alloc(limit);
cw = gsl_integration_workspace_alloc(limit);
flag = 1;
break;
case 2:
CHECK_WORKSPACE(vtmp[0]); CHECK_WORKSPACE(vtmp[1]);
Data_Get_Struct(vtmp[0], gsl_integration_workspace, w);
Data_Get_Struct(vtmp[1], gsl_integration_workspace, cw);
flag = 0;
break;
case 3:
CHECK_FIXNUM(vtmp[0]);
CHECK_WORKSPACE(vtmp[1]); CHECK_WORKSPACE(vtmp[2]);
limit = FIX2INT(vtmp[0]);
Data_Get_Struct(vtmp[1], gsl_integration_workspace, w);
Data_Get_Struct(vtmp[2], gsl_integration_workspace, cw);
flag = 0;
break;
default:
rb_raise(rb_eArgError, "wrong number of arguments");
break;
}
status = gsl_integration_qawf(F, a, epsabs, limit, w, cw, t, &result, &abserr);
intervals = w->size;
if (flag == 1) {
gsl_integration_workspace_free(w);
gsl_integration_workspace_free(cw);
}
if (flagt == 1) gsl_integration_qawo_table_free(t);
return rb_ary_new3(4, rb_float_new(result), rb_float_new(abserr),
INT2FIX(intervals), INT2FIX(status));
}
static VALUE rb_gsl_wavelet_transform0(int argc, VALUE *argv, VALUE obj,
int sss)
{
gsl_wavelet *w = NULL;
gsl_vector *v = NULL, *vnew;
gsl_wavelet_direction dir = forward;
gsl_wavelet_workspace *work = NULL;
int itmp, flag = 0;
// local variable "status" declared and set, but never used
//int status;
double *ptr1, *ptr2;
size_t n, stride;
int naflag = 0;
VALUE ary, ret;
#ifdef HAVE_NARRAY_H
struct NARRAY *na1 = NULL;
#endif
switch (TYPE(obj)) {
case T_MODULE:
case T_CLASS:
case T_OBJECT:
if (argc < 2) rb_raise(rb_eArgError, "too few arguments");
CHECK_WAVELET(argv[0]);
if (MATRIX_P(argv[1])) {
return rb_gsl_wavelet2d(argc, argv, obj,
gsl_wavelet2d_transform_matrix, sss);
}
if (VECTOR_P(argv[1])) {
Data_Get_Struct(argv[0], gsl_wavelet, w);
Data_Get_Struct(argv[1], gsl_vector, v);
ret = argv[1];
ptr1 = v->data;
n = v->size;
stride = v->stride;
#ifdef HAVE_NARRAY_H
} else if (NA_IsNArray(argv[1])) {
GetNArray(argv[1], na1);
ret = argv[1];
ptr1 = (double*) na1->ptr;
n = na1->total;
naflag = 1;
stride = 1;
#endif
} else {
rb_raise(rb_eTypeError, "wrong argument type (Vector expected)");
}
itmp = 2;
break;
default:
if (argc < 1) rb_raise(rb_eArgError, "too few arguments");
if (MATRIX_P(argv[0])) {
return rb_gsl_wavelet2d(argc, argv, obj,
gsl_wavelet2d_transform_matrix, sss);
}
if (VECTOR_P(obj)) {
CHECK_WAVELET(argv[0]);
Data_Get_Struct(argv[0], gsl_wavelet, w);
Data_Get_Struct(obj, gsl_vector, v);
ret = obj;
ptr1 = v->data;
n = v->size;
stride = v->stride;
} else if (VECTOR_P(argv[0])) {
CHECK_WAVELET(obj);
Data_Get_Struct(obj, gsl_wavelet, w);
Data_Get_Struct(argv[0], gsl_vector, v);
ret = argv[0];
ptr1 = v->data;
n = v->size;
stride = v->stride;
#ifdef HAVE_NARRAY_H
} else if (NA_IsNArray(obj)) {
CHECK_WAVELET(argv[0]);
Data_Get_Struct(argv[0], gsl_wavelet, w);
GetNArray(obj, na1);
ret = obj;
ptr1 = (double*) na1->ptr;
n = na1->total;
naflag = 1;
stride = 1;
} else if (NA_IsNArray(argv[0])) {
CHECK_WAVELET(obj);
Data_Get_Struct(obj, gsl_wavelet, w);
GetNArray(argv[0], na1);
ret = argv[0];
ptr1 = (double*) na1->ptr;
n = na1->total;
naflag = 1;
stride = 1;
#endif
} else {
rb_raise(rb_eTypeError, "wrong argument type");
}
itmp = 1;
break;
}
switch (argc - itmp) {
case 2:
CHECK_FIXNUM(argv[itmp]);
CHECK_WORKSPACE(argv[itmp+1]);
dir = FIX2INT(argv[itmp]);
Data_Get_Struct(argv[itmp+1], gsl_wavelet_workspace, work);
break;
case 1:
if (TYPE(argv[itmp]) == T_FIXNUM) {
dir = FIX2INT(argv[itmp]);
work = gsl_wavelet_workspace_alloc(v->size);
flag = 1;
} else if (rb_obj_is_kind_of(argv[itmp], cgsl_wavelet_workspace)) {
Data_Get_Struct(argv[itmp], gsl_wavelet_workspace, work);
} else {
rb_raise(rb_eTypeError, "wrong argument type");
}
break;
case 0:
work = gsl_wavelet_workspace_alloc(v->size);
flag = 1;
break;
default:
rb_raise(rb_eArgError, "too many arguments");
break;
}
if (naflag == 0) {
if (sss == RB_GSL_DWT_COPY) {
vnew = gsl_vector_alloc(v->size);
gsl_vector_memcpy(vnew, v);
ary = Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, vnew);
ptr2 = vnew->data;
} else {
ary = ret;
ptr2 = ptr1;
}
} else {
#ifdef HAVE_NARRAY_H
if (sss == RB_GSL_DWT_COPY) {
ary = na_make_object(NA_DFLOAT, na1->rank, na1->shape, cNArray);
ptr2 = NA_PTR_TYPE(ary, double*);
memcpy(ptr2, ptr1, sizeof(double)*n);
} else {
