/* * $Id: p_header,v 1.4 2000/11/27 01:57:01 keiko Exp $ */ #include #include "ruby.h" #include "libtinyf2c.h" #include "narray.h" #define DFLT_SIZE 32 extern char *dcl_obj2ccharary(VALUE, int, int); extern integer *dcl_obj2cintegerary(VALUE); extern real *dcl_obj2crealary(VALUE); extern complex *dcl_obj2ccomplexary(VALUE); extern logical *dcl_obj2clogicalary(VALUE); extern VALUE dcl_ccharary2obj(char *, int, int); extern VALUE dcl_cintegerary2obj(integer *, int, int, int *); extern VALUE dcl_crealary2obj(real *, int, int, int *); extern VALUE dcl_ccomplexary2obj(complex *, int, char *); extern VALUE dcl_clogicalary2obj(logical *, int, int, int *); extern void dcl_freeccharary(char *); extern void dcl_freecintegerary(integer *); extern void dcl_freecrealary(real *); extern void dcl_freeccomplexary(complex *); extern void dcl_freeclogicalary(logical *); /* for functions which return doublereal */ /* fnclib */ extern doublereal rd2r_(real *); extern doublereal rr2d_(real *); extern doublereal rexp_(real *, integer *, integer *); extern doublereal rfpi_(void); extern doublereal rmod_(real *, real *); /* gnmlib */ extern doublereal rgnlt_(real *); extern doublereal rgnle_(real *); extern doublereal rgngt_(real *); extern doublereal rgnge_(real *); /* rfalib */ extern doublereal rmax_(real *, integer *, integer *); extern doublereal rmin_(real *, integer *, integer *); extern doublereal rsum_(real *, integer *, integer *); extern doublereal rave_(real *, integer *, integer *); extern doublereal rvar_(real *, integer *, integer *); extern doublereal rstd_(real *, integer *, integer *); extern doublereal rrms_(real *, integer *, integer *); extern doublereal ramp_(real *, integer *, integer *); /* rfblib */ extern doublereal rprd_(real *, real *, integer *, integer *, integer *); extern doublereal rcov_(real *, real *, integer *, integer *, integer *); extern doublereal rcor_(real *, real *, integer *, integer *, integer *); extern VALUE mDCL; static VALUE dcl_shtlib(obj) VALUE obj; { shtlib_(); return Qnil; } static VALUE dcl_shtint(obj, mm, jm, im) VALUE obj, mm, jm, im; { integer i_mm; integer i_jm; integer i_im; real *o_work; VALUE work; if ((TYPE(mm) != T_BIGNUM) || (TYPE(mm) != T_FIXNUM)) { mm = rb_funcall(mm, rb_intern("to_i"), 0); } if ((TYPE(jm) != T_BIGNUM) || (TYPE(jm) != T_FIXNUM)) { jm = rb_funcall(jm, rb_intern("to_i"), 0); } if ((TYPE(im) != T_BIGNUM) || (TYPE(im) != T_FIXNUM)) { im = rb_funcall(im, rb_intern("to_i"), 0); } i_mm = NUM2INT(mm); i_jm = NUM2INT(jm); i_im = NUM2INT(im); o_work= ALLOCA_N(real, (i_jm+1)*(4*i_jm+5*i_mm+14)+(i_mm+1)*(i_mm+1)+i_mm+2+6*i_im+15); shtint_(&i_mm, &i_jm, &i_im, o_work); {int array_shape[1] = {(i_jm+1)*(4*i_jm+5*i_mm+14)+(i_mm+1)*(i_mm+1)+i_mm+2+6*i_im+15}; work = dcl_crealary2obj(o_work, (i_jm+1)*(4*i_jm+5*i_mm+14)+(i_mm+1)*(i_mm+1)+i_mm+2+6*i_im+15, 1, array_shape); } return work; } static VALUE dcl_shtlap(obj, mm, ind, a) VALUE obj, mm, ind, a; { integer i_mm; integer i_ind; real *i_a; real *o_b; VALUE b; if ((TYPE(mm) != T_BIGNUM) || (TYPE(mm) != T_FIXNUM)) { mm = rb_funcall(mm, rb_intern("to_i"), 0); } if ((TYPE(ind) != T_BIGNUM) || (TYPE(ind) != T_FIXNUM)) { ind = rb_funcall(ind, rb_intern("to_i"), 0); } if (TYPE(a) == T_FLOAT) { a = rb_Array(a); } /* if ((TYPE(a) != T_ARRAY) && (rb_obj_is_kind_of(a, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ i_mm = NUM2INT(mm); i_ind = NUM2INT(ind); i_a = dcl_obj2crealary(a); o_b= ALLOCA_N(real, (i_mm+1)*(i_mm+1)); shtlap_(&i_mm, &i_ind, i_a, o_b); {int array_shape[1] = {(i_mm+1)*(i_mm+1)}; b = dcl_crealary2obj(o_b, (i_mm+1)*(i_mm+1), 1, array_shape); } dcl_freecrealary(i_a); return b; } static VALUE dcl_shtnml(obj, mm, n, m) VALUE obj, mm, n, m; { integer i_mm; integer i_n; integer i_m; integer o_lr; integer o_li; VALUE lr; VALUE li; if ((TYPE(mm) != T_BIGNUM) || (TYPE(mm) != T_FIXNUM)) { mm = rb_funcall(mm, rb_intern("to_i"), 0); } if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(m) != T_BIGNUM) || (TYPE(m) != T_FIXNUM)) { m = rb_funcall(m, rb_intern("to_i"), 0); } i_mm = NUM2INT(mm); i_n = NUM2INT(n); i_m = NUM2INT(m); shtnml_(&i_mm, &i_n, &i_m, &o_lr, &o_li); lr = INT2NUM(o_lr); li = INT2NUM(o_li); return rb_ary_new3(2, lr, li); } static VALUE dcl_shtfun(obj, mm, jm, m, work) VALUE obj, mm, jm, m, work; { integer i_mm; integer i_jm; integer i_m; real *o_fun; real *i_work; VALUE fun; if ((TYPE(mm) != T_BIGNUM) || (TYPE(mm) != T_FIXNUM)) { mm = rb_funcall(mm, rb_intern("to_i"), 0); } if ((TYPE(jm) != T_BIGNUM) || (TYPE(jm) != T_FIXNUM)) { jm = rb_funcall(jm, rb_intern("to_i"), 0); } if ((TYPE(m) != T_BIGNUM) || (TYPE(m) != T_FIXNUM)) { m = rb_funcall(m, rb_intern("to_i"), 0); } if (TYPE(work) == T_FLOAT) { work = rb_Array(work); } /* if ((TYPE(work) != T_ARRAY) && (rb_obj_is_kind_of(work, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ i_mm = NUM2INT(mm); i_jm = NUM2INT(jm); i_m = NUM2INT(m); i_work = dcl_obj2crealary(work); o_fun= ALLOCA_N(real, ((2*i_jm+1)*(i_mm-i_m+1))); shtfun_(&i_mm, &i_jm, &i_m, o_fun, i_work); {int array_shape[2] = {(2*i_jm+1), (i_mm-i_m+1)}; fun = dcl_crealary2obj(o_fun, ((2*i_jm+1)*(i_mm-i_m+1)), 2, array_shape); } dcl_freecrealary(i_work); return fun; } static VALUE dcl_shtlfw(obj, mm, jm, m, isw, wm, work) VALUE obj, mm, jm, m, isw, wm, work; { integer i_mm; integer i_jm; integer i_m; integer i_isw; real *i_wm; real *o_sm; real *i_work; VALUE sm; if ((TYPE(mm) != T_BIGNUM) || (TYPE(mm) != T_FIXNUM)) { mm = rb_funcall(mm, rb_intern("to_i"), 0); } if ((TYPE(jm) != T_BIGNUM) || (TYPE(jm) != T_FIXNUM)) { jm = rb_funcall(jm, rb_intern("to_i"), 0); } if ((TYPE(m) != T_BIGNUM) || (TYPE(m) != T_FIXNUM)) { m = rb_funcall(m, rb_intern("to_i"), 0); } if ((TYPE(isw) != T_BIGNUM) || (TYPE(isw) != T_FIXNUM)) { isw = rb_funcall(isw, rb_intern("to_i"), 0); } if (TYPE(wm) == T_FLOAT) { wm = rb_Array(wm); } /* if ((TYPE(wm) != T_ARRAY) && (rb_obj_is_kind_of(wm, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(work) == T_FLOAT) { work = rb_Array(work); } /* if ((TYPE(work) != T_ARRAY) && (rb_obj_is_kind_of(work, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ i_mm = NUM2INT(mm); i_jm = NUM2INT(jm); i_m = NUM2INT(m); i_isw = NUM2INT(isw); i_wm = dcl_obj2crealary(wm); i_work = dcl_obj2crealary(work); o_sm= ALLOCA_N(real, (i_mm-i_m+1)); shtlfw_(&i_mm, &i_jm, &i_m, &i_isw, i_wm, o_sm, i_work); {int array_shape[1] = {i_mm-i_m+1}; sm = dcl_crealary2obj(o_sm, (i_mm-i_m+1), 1, array_shape); } dcl_freecrealary(i_wm); dcl_freecrealary(i_work); return sm; } static VALUE dcl_shtlbw(obj, mm, jm, m, isw, sm, work) VALUE obj, mm, jm, m, isw, sm, work; { integer i_mm; integer i_jm; integer i_m; integer i_isw; real *i_sm; real *o_wm; real *i_work; VALUE wm; if ((TYPE(mm) != T_BIGNUM) || (TYPE(mm) != T_FIXNUM)) { mm = rb_funcall(mm, rb_intern("to_i"), 0); } if ((TYPE(jm) != T_BIGNUM) || (TYPE(jm) != T_FIXNUM)) { jm = rb_funcall(jm, rb_intern("to_i"), 0); } if ((TYPE(m) != T_BIGNUM) || (TYPE(m) != T_FIXNUM)) { m = rb_funcall(m, rb_intern("to_i"), 0); } if ((TYPE(isw) != T_BIGNUM) || (TYPE(isw) != T_FIXNUM)) { isw = rb_funcall(isw, rb_intern("to_i"), 0); } if (TYPE(sm) == T_FLOAT) { sm = rb_Array(sm); } /* if ((TYPE(sm) != T_ARRAY) && (rb_obj_is_kind_of(sm, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(work) == T_FLOAT) { work = rb_Array(work); } /* if ((TYPE(work) != T_ARRAY) && (rb_obj_is_kind_of(work, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ i_mm = NUM2INT(mm); i_jm = NUM2INT(jm); i_m = NUM2INT(m); i_isw = NUM2INT(isw); i_sm = dcl_obj2crealary(sm); i_work = dcl_obj2crealary(work); o_wm= ALLOCA_N(real, (2*i_jm+1)); shtlbw_(&i_mm, &i_jm, &i_m, &i_isw, i_sm, o_wm, i_work); {int array_shape[1] = {2*i_jm+1}; wm = dcl_crealary2obj(o_wm, (2*i_jm+1), 1, array_shape); } dcl_freecrealary(i_sm); dcl_freecrealary(i_work); return wm; } static VALUE dcl_shts2w(obj, mm, jm, isw, s, work) VALUE obj, mm, jm, isw, s, work; { integer i_mm; integer i_jm; integer i_isw; real *i_s; real *o_w; real *i_work; VALUE w; if ((TYPE(mm) != T_BIGNUM) || (TYPE(mm) != T_FIXNUM)) { mm = rb_funcall(mm, rb_intern("to_i"), 0); } if ((TYPE(jm) != T_BIGNUM) || (TYPE(jm) != T_FIXNUM)) { jm = rb_funcall(jm, rb_intern("to_i"), 0); } if ((TYPE(isw) != T_BIGNUM) || (TYPE(isw) != T_FIXNUM)) { isw = rb_funcall(isw, rb_intern("to_i"), 0); } if (TYPE(s) == T_FLOAT) { s = rb_Array(s); } /* if ((TYPE(s) != T_ARRAY) && (rb_obj_is_kind_of(s, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(work) == T_FLOAT) { work = rb_Array(work); } /* if ((TYPE(work) != T_ARRAY) && (rb_obj_is_kind_of(work, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ i_mm = NUM2INT(mm); i_jm = NUM2INT(jm); i_isw = NUM2INT(isw); i_s = dcl_obj2crealary(s); i_work = dcl_obj2crealary(work); o_w= ALLOCA_N(real, ((2*i_jm+1)*(2*i_mm+1))); shts2w_(&i_mm, &i_jm, &i_isw, i_s, o_w, i_work); {int array_shape[2] = {(2*i_jm+1), (2*i_mm+1)}; w = dcl_crealary2obj(o_w, ((2*i_jm+1)*(2*i_mm+1)), 2, array_shape); } dcl_freecrealary(i_s); dcl_freecrealary(i_work); return w; } static VALUE dcl_shtswa(obj, mm, jm, isw, m1, m2, s, work) VALUE obj, mm, jm, isw, m1, m2, s, work; { integer i_mm; integer i_jm; integer i_isw; integer i_m1; integer i_m2; real *i_s; real *o_w; real *i_work; VALUE w; if ((TYPE(mm) != T_BIGNUM) || (TYPE(mm) != T_FIXNUM)) { mm = rb_funcall(mm, rb_intern("to_i"), 0); } if ((TYPE(jm) != T_BIGNUM) || (TYPE(jm) != T_FIXNUM)) { jm = rb_funcall(jm, rb_intern("to_i"), 0); } if ((TYPE(isw) != T_BIGNUM) || (TYPE(isw) != T_FIXNUM)) { isw = rb_funcall(isw, rb_intern("to_i"), 0); } if ((TYPE(m1) != T_BIGNUM) || (TYPE(m1) != T_FIXNUM)) { m1 = rb_funcall(m1, rb_intern("to_i"), 0); } if ((TYPE(m2) != T_BIGNUM) || (TYPE(m2) != T_FIXNUM)) { m2 = rb_funcall(m2, rb_intern("to_i"), 0); } if (TYPE(s) == T_FLOAT) { s = rb_Array(s); } /* if ((TYPE(s) != T_ARRAY) && (rb_obj_is_kind_of(s, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(work) == T_FLOAT) { work = rb_Array(work); } /* if ((TYPE(work) != T_ARRAY) && (rb_obj_is_kind_of(work, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ i_mm = NUM2INT(mm); i_jm = NUM2INT(jm); i_isw = NUM2INT(isw); i_m1 = NUM2INT(m1); i_m2 = NUM2INT(m2); i_s = dcl_obj2crealary(s); i_work = dcl_obj2crealary(work); o_w= ALLOCA_N(real, ((2*i_jm+1)*(2*i_mm+1))); shtswa_(&i_mm, &i_jm, &i_isw, &i_m1, &i_m2, i_s, o_w, i_work); {int array_shape[2] = {(2*i_jm+1), (2*i_mm+1)}; w = dcl_crealary2obj(o_w, ((2*i_jm+1)*(2*i_mm+1)), 2, array_shape); } dcl_freecrealary(i_s); dcl_freecrealary(i_work); return w; } static VALUE dcl_shtswz(obj, mm, jm, isw, s, work) VALUE obj, mm, jm, isw, s, work; { integer i_mm; integer i_jm; integer i_isw; real *i_s; real *o_wz; real *i_work; VALUE wz; if ((TYPE(mm) != T_BIGNUM) || (TYPE(mm) != T_FIXNUM)) { mm = rb_funcall(mm, rb_intern("to_i"), 0); } if ((TYPE(jm) != T_BIGNUM) || (TYPE(jm) != T_FIXNUM)) { jm = rb_funcall(jm, rb_intern("to_i"), 0); } if ((TYPE(isw) != T_BIGNUM) || (TYPE(isw) != T_FIXNUM)) { isw = rb_funcall(isw, rb_intern("to_i"), 0); } if (TYPE(s) == T_FLOAT) { s = rb_Array(s); } /* if ((TYPE(s) != T_ARRAY) && (rb_obj_is_kind_of(s, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(work) == T_FLOAT) { work = rb_Array(work); } /* if ((TYPE(work) != T_ARRAY) && (rb_obj_is_kind_of(work, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ i_mm = NUM2INT(mm); i_jm = NUM2INT(jm); i_isw = NUM2INT(isw); i_s = dcl_obj2crealary(s); i_work = dcl_obj2crealary(work); o_wz= ALLOCA_N(real, (2*i_jm+1)); shtswz_(&i_mm, &i_jm, &i_isw, i_s, o_wz, i_work); {int array_shape[1] = {2*i_jm+1}; wz = dcl_crealary2obj(o_wz, (2*i_jm+1), 1, array_shape); } dcl_freecrealary(i_s); dcl_freecrealary(i_work); return wz; } static VALUE dcl_shtswm(obj, mm, jm, m, isw, s, work) VALUE obj, mm, jm, m, isw, s, work; { integer i_mm; integer i_jm; integer i_m; integer i_isw; real *i_s; real *o_wr; real *o_wi; real *i_work; VALUE wr; VALUE wi; if ((TYPE(mm) != T_BIGNUM) || (TYPE(mm) != T_FIXNUM)) { mm = rb_funcall(mm, rb_intern("to_i"), 0); } if ((TYPE(jm) != T_BIGNUM) || (TYPE(jm) != T_FIXNUM)) { jm = rb_funcall(jm, rb_intern("to_i"), 0); } if ((TYPE(m) != T_BIGNUM) || (TYPE(m) != T_FIXNUM)) { m = rb_funcall(m, rb_intern("to_i"), 0); } if ((TYPE(isw) != T_BIGNUM) || (TYPE(isw) != T_FIXNUM)) { isw = rb_funcall(isw, rb_intern("to_i"), 0); } if (TYPE(s) == T_FLOAT) { s = rb_Array(s); } /* if ((TYPE(s) != T_ARRAY) && (rb_obj_is_kind_of(s, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(work) == T_FLOAT) { work = rb_Array(work); } /* if ((TYPE(work) != T_ARRAY) && (rb_obj_is_kind_of(work, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ i_mm = NUM2INT(mm); i_jm = NUM2INT(jm); i_m = NUM2INT(m); i_isw = NUM2INT(isw); i_s = dcl_obj2crealary(s); i_work = dcl_obj2crealary(work); o_wr= ALLOCA_N(real, (2*i_jm+1)); o_wi= ALLOCA_N(real, (2*i_jm+1)); shtswm_(&i_mm, &i_jm, &i_m, &i_isw, i_s, o_wr, o_wi, i_work); {int array_shape[1] = {2*i_jm+1}; wr = dcl_crealary2obj(o_wr, (2*i_jm+1), 1, array_shape); } {int array_shape[1] = {2*i_jm+1}; wi = dcl_crealary2obj(o_wi, (2*i_jm+1), 1, array_shape); } dcl_freecrealary(i_s); dcl_freecrealary(i_work); return rb_ary_new3(2, wr, wi); } static VALUE dcl_shtswj(obj, mm, jm, isw, j, m1, m2, s, work) VALUE obj, mm, jm, isw, j, m1, m2, s, work; { integer i_mm; integer i_jm; integer i_isw; integer i_j; integer i_m1; integer i_m2; real *i_s; real *o_wj; real *i_work; VALUE wj; if ((TYPE(mm) != T_BIGNUM) || (TYPE(mm) != T_FIXNUM)) { mm = rb_funcall(mm, rb_intern("to_i"), 0); } if ((TYPE(jm) != T_BIGNUM) || (TYPE(jm) != T_FIXNUM)) { jm = rb_funcall(jm, rb_intern("to_i"), 0); } if ((TYPE(isw) != T_BIGNUM) || (TYPE(isw) != T_FIXNUM)) { isw = rb_funcall(isw, rb_intern("to_i"), 0); } if ((TYPE(j) != T_BIGNUM) || (TYPE(j) != T_FIXNUM)) { j = rb_funcall(j, rb_intern("to_i"), 0); } if ((TYPE(m1) != T_BIGNUM) || (TYPE(m1) != T_FIXNUM)) { m1 = rb_funcall(m1, rb_intern("to_i"), 0); } if ((TYPE(m2) != T_BIGNUM) || (TYPE(m2) != T_FIXNUM)) { m2 = rb_funcall(m2, rb_intern("to_i"), 0); } if (TYPE(s) == T_FLOAT) { s = rb_Array(s); } /* if ((TYPE(s) != T_ARRAY) && (rb_obj_is_kind_of(s, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(work) == T_FLOAT) { work = rb_Array(work); } /* if ((TYPE(work) != T_ARRAY) && (rb_obj_is_kind_of(work, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ i_mm = NUM2INT(mm); i_jm = NUM2INT(jm); i_isw = NUM2INT(isw); i_j = NUM2INT(j); i_m1 = NUM2INT(m1); i_m2 = NUM2INT(m2); i_s = dcl_obj2crealary(s); i_work = dcl_obj2crealary(work); o_wj= ALLOCA_N(real, (2*i_mm+1)); shtswj_(&i_mm, &i_jm, &i_isw, &i_j, &i_m1, &i_m2, i_s, o_wj, i_work); {int array_shape[1] = {2*i_mm+1}; wj = dcl_crealary2obj(o_wj, (2*i_mm+1), 1, array_shape); } dcl_freecrealary(i_s); dcl_freecrealary(i_work); return wj; } static VALUE dcl_shtw2s(obj, mm, jm, isw, s, work) VALUE obj, mm, jm, isw, s, work; { integer i_mm; integer i_jm; integer i_isw; real *i_s; real *o_w; real *i_work; VALUE w; if ((TYPE(mm) != T_BIGNUM) || (TYPE(mm) != T_FIXNUM)) { mm = rb_funcall(mm, rb_intern("to_i"), 0); } if ((TYPE(jm) != T_BIGNUM) || (TYPE(jm) != T_FIXNUM)) { jm = rb_funcall(jm, rb_intern("to_i"), 0); } if ((TYPE(isw) != T_BIGNUM) || (TYPE(isw) != T_FIXNUM)) { isw = rb_funcall(isw, rb_intern("to_i"), 0); } if (TYPE(s) == T_FLOAT) { s = rb_Array(s); } /* if ((TYPE(s) != T_ARRAY) && (rb_obj_is_kind_of(s, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(work) == T_FLOAT) { work = rb_Array(work); } /* if ((TYPE(work) != T_ARRAY) && (rb_obj_is_kind_of(work, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ i_mm = NUM2INT(mm); i_jm = NUM2INT(jm); i_isw = NUM2INT(isw); i_s = dcl_obj2crealary(s); i_work = dcl_obj2crealary(work); o_w= ALLOCA_N(real, ((i_mm+1)*(i_mm+1))); shtw2s_(&i_mm, &i_jm, &i_isw, i_s, o_w, i_work); {int array_shape[2] = {(i_mm+1), (i_mm+1)}; w = dcl_crealary2obj(o_w, ((i_mm+1)*(i_mm+1)), 2, array_shape); } dcl_freecrealary(i_s); dcl_freecrealary(i_work); return w; } static VALUE dcl_shtw2g(obj, mm, jm, im, w, work) VALUE obj, mm, jm, im, w, work; { integer i_mm; integer i_jm; integer i_im; real *i_w; real *o_g; real *i_work; VALUE g; if ((TYPE(mm) != T_BIGNUM) || (TYPE(mm) != T_FIXNUM)) { mm = rb_funcall(mm, rb_intern("to_i"), 0); } if ((TYPE(jm) != T_BIGNUM) || (TYPE(jm) != T_FIXNUM)) { jm = rb_funcall(jm, rb_intern("to_i"), 0); } if ((TYPE(im) != T_BIGNUM) || (TYPE(im) != T_FIXNUM)) { im = rb_funcall(im, rb_intern("to_i"), 0); } if (TYPE(w) == T_FLOAT) { w = rb_Array(w); } /* if ((TYPE(w) != T_ARRAY) && (rb_obj_is_kind_of(w, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(work) == T_FLOAT) { work = rb_Array(work); } /* if ((TYPE(work) != T_ARRAY) && (rb_obj_is_kind_of(work, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ i_mm = NUM2INT(mm); i_jm = NUM2INT(jm); i_im = NUM2INT(im); i_w = dcl_obj2crealary(w); i_work = dcl_obj2crealary(work); o_g= ALLOCA_N(real, ((2*i_im+1)*(2*i_jm+1))); shtw2g_(&i_mm, &i_jm, &i_im, i_w, o_g, i_work); {int array_shape[2] = {(2*i_im+1), (2*i_jm+1)}; g = dcl_crealary2obj(o_g, ((2*i_im+1)*(2*i_jm+1)), 2, array_shape); } dcl_freecrealary(i_w); dcl_freecrealary(i_work); return g; } static VALUE dcl_shtwga(obj, mm, jm, im, m1, m2, w, work) VALUE obj, mm, jm, im, m1, m2, w, work; { integer i_mm; integer i_jm; integer i_im; integer i_m1; integer i_m2; real *i_w; real *o_g; real *i_work; VALUE g; if ((TYPE(mm) != T_BIGNUM) || (TYPE(mm) != T_FIXNUM)) { mm = rb_funcall(mm, rb_intern("to_i"), 0); } if ((TYPE(jm) != T_BIGNUM) || (TYPE(jm) != T_FIXNUM)) { jm = rb_funcall(jm, rb_intern("to_i"), 0); } if ((TYPE(im) != T_BIGNUM) || (TYPE(im) != T_FIXNUM)) { im = rb_funcall(im, rb_intern("to_i"), 0); } if ((TYPE(m1) != T_BIGNUM) || (TYPE(m1) != T_FIXNUM)) { m1 = rb_funcall(m1, rb_intern("to_i"), 0); } if ((TYPE(m2) != T_BIGNUM) || (TYPE(m2) != T_FIXNUM)) { m2 = rb_funcall(m2, rb_intern("to_i"), 0); } if (TYPE(w) == T_FLOAT) { w = rb_Array(w); } /* if ((TYPE(w) != T_ARRAY) && (rb_obj_is_kind_of(w, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(work) == T_FLOAT) { work = rb_Array(work); } /* if ((TYPE(work) != T_ARRAY) && (rb_obj_is_kind_of(work, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ i_mm = NUM2INT(mm); i_jm = NUM2INT(jm); i_im = NUM2INT(im); i_m1 = NUM2INT(m1); i_m2 = NUM2INT(m2); i_w = dcl_obj2crealary(w); i_work = dcl_obj2crealary(work); o_g= ALLOCA_N(real, ((2*i_im+1)*(2*i_jm+1))); shtwga_(&i_mm, &i_jm, &i_im, &i_m1, &i_m2, i_w, o_g, i_work); {int array_shape[2] = {(2*i_im+1), (2*i_jm+1)}; g = dcl_crealary2obj(o_g, ((2*i_im+1)*(2*i_jm+1)), 2, array_shape); } dcl_freecrealary(i_w); dcl_freecrealary(i_work); return g; } static VALUE dcl_shtwgm(obj, mm, jm, im, m, wr, wi, work) VALUE obj, mm, jm, im, m, wr, wi, work; { integer i_mm; integer i_jm; integer i_im; integer i_m; real *i_wr; real *i_wi; real *o_g; real *i_work; VALUE g; if ((TYPE(mm) != T_BIGNUM) || (TYPE(mm) != T_FIXNUM)) { mm = rb_funcall(mm, rb_intern("to_i"), 0); } if ((TYPE(jm) != T_BIGNUM) || (TYPE(jm) != T_FIXNUM)) { jm = rb_funcall(jm, rb_intern("to_i"), 0); } if ((TYPE(im) != T_BIGNUM) || (TYPE(im) != T_FIXNUM)) { im = rb_funcall(im, rb_intern("to_i"), 0); } if ((TYPE(m) != T_BIGNUM) || (TYPE(m) != T_FIXNUM)) { m = rb_funcall(m, rb_intern("to_i"), 0); } if (TYPE(wr) == T_FLOAT) { wr = rb_Array(wr); } /* if ((TYPE(wr) != T_ARRAY) && (rb_obj_is_kind_of(wr, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(wi) == T_FLOAT) { wi = rb_Array(wi); } /* if ((TYPE(wi) != T_ARRAY) && (rb_obj_is_kind_of(wi, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(work) == T_FLOAT) { work = rb_Array(work); } /* if ((TYPE(work) != T_ARRAY) && (rb_obj_is_kind_of(work, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ i_mm = NUM2INT(mm); i_jm = NUM2INT(jm); i_im = NUM2INT(im); i_m = NUM2INT(m); i_wr = dcl_obj2crealary(wr); i_wi = dcl_obj2crealary(wi); i_work = dcl_obj2crealary(work); o_g= ALLOCA_N(real, ((2*i_im+1)*(2*i_jm+1))); shtwgm_(&i_mm, &i_jm, &i_im, &i_m, i_wr, i_wi, o_g, i_work); {int array_shape[2] = {(2*i_im+1), (2*i_jm+1)}; g = dcl_crealary2obj(o_g, ((2*i_im+1)*(2*i_jm+1)), 2, array_shape); } dcl_freecrealary(i_wr); dcl_freecrealary(i_wi); dcl_freecrealary(i_work); return g; } static VALUE dcl_shtwgz(obj, jm, im, wz) VALUE obj, jm, im, wz; { integer i_jm; integer i_im; real *i_wz; real *o_g; VALUE g; if ((TYPE(jm) != T_BIGNUM) || (TYPE(jm) != T_FIXNUM)) { jm = rb_funcall(jm, rb_intern("to_i"), 0); } if ((TYPE(im) != T_BIGNUM) || (TYPE(im) != T_FIXNUM)) { im = rb_funcall(im, rb_intern("to_i"), 0); } if (TYPE(wz) == T_FLOAT) { wz = rb_Array(wz); } /* if ((TYPE(wz) != T_ARRAY) && (rb_obj_is_kind_of(wz, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ i_jm = NUM2INT(jm); i_im = NUM2INT(im); i_wz = dcl_obj2crealary(wz); o_g= ALLOCA_N(real, ((2*i_im+1)*(2*i_jm+1))); shtwgz_(&i_jm, &i_im, i_wz, o_g); {int array_shape[2] = {(2*i_im+1), (2*i_jm+1)}; g = dcl_crealary2obj(o_g, ((2*i_im+1)*(2*i_jm+1)), 2, array_shape); } dcl_freecrealary(i_wz); return g; } static VALUE dcl_shtwgj(obj, mm, im, m1, m2, wj, work) VALUE obj, mm, im, m1, m2, wj, work; { integer i_mm; integer i_im; integer i_m1; integer i_m2; real *i_wj; real *o_gj; real *i_work; VALUE gj; if ((TYPE(mm) != T_BIGNUM) || (TYPE(mm) != T_FIXNUM)) { mm = rb_funcall(mm, rb_intern("to_i"), 0); } if ((TYPE(im) != T_BIGNUM) || (TYPE(im) != T_FIXNUM)) { im = rb_funcall(im, rb_intern("to_i"), 0); } if ((TYPE(m1) != T_BIGNUM) || (TYPE(m1) != T_FIXNUM)) { m1 = rb_funcall(m1, rb_intern("to_i"), 0); } if ((TYPE(m2) != T_BIGNUM) || (TYPE(m2) != T_FIXNUM)) { m2 = rb_funcall(m2, rb_intern("to_i"), 0); } if (TYPE(wj) == T_FLOAT) { wj = rb_Array(wj); } /* if ((TYPE(wj) != T_ARRAY) && (rb_obj_is_kind_of(wj, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(work) == T_FLOAT) { work = rb_Array(work); } /* if ((TYPE(work) != T_ARRAY) && (rb_obj_is_kind_of(work, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ i_mm = NUM2INT(mm); i_im = NUM2INT(im); i_m1 = NUM2INT(m1); i_m2 = NUM2INT(m2); i_wj = dcl_obj2crealary(wj); i_work = dcl_obj2crealary(work); o_gj= ALLOCA_N(real, (2*i_im+1)); shtwgj_(&i_mm, &i_im, &i_m1, &i_m2, i_wj, o_gj, i_work); {int array_shape[1] = {2*i_im+1}; gj = dcl_crealary2obj(o_gj, (2*i_im+1), 1, array_shape); } dcl_freecrealary(i_wj); dcl_freecrealary(i_work); return gj; } static VALUE dcl_shtg2w(obj, mm, jm, im, g, work) VALUE obj, mm, jm, im, g, work; { integer i_mm; integer i_jm; integer i_im; real *i_g; real *o_w; real *i_work; VALUE w; if ((TYPE(mm) != T_BIGNUM) || (TYPE(mm) != T_FIXNUM)) { mm = rb_funcall(mm, rb_intern("to_i"), 0); } if ((TYPE(jm) != T_BIGNUM) || (TYPE(jm) != T_FIXNUM)) { jm = rb_funcall(jm, rb_intern("to_i"), 0); } if ((TYPE(im) != T_BIGNUM) || (TYPE(im) != T_FIXNUM)) { im = rb_funcall(im, rb_intern("to_i"), 0); } if (TYPE(g) == T_FLOAT) { g = rb_Array(g); } /* if ((TYPE(g) != T_ARRAY) && (rb_obj_is_kind_of(g, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(work) == T_FLOAT) { work = rb_Array(work); } /* if ((TYPE(work) != T_ARRAY) && (rb_obj_is_kind_of(work, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ i_mm = NUM2INT(mm); i_jm = NUM2INT(jm); i_im = NUM2INT(im); i_g = dcl_obj2crealary(g); i_work = dcl_obj2crealary(work); o_w= ALLOCA_N(real, ((2*i_jm+1)*(2*i_mm+1))); shtg2w_(&i_mm, &i_jm, &i_im, i_g, o_w, i_work); {int array_shape[2] = {(2*i_jm+1), (2*i_mm+1)}; w = dcl_crealary2obj(o_w, ((2*i_jm+1)*(2*i_mm+1)), 2, array_shape); } dcl_freecrealary(i_g); dcl_freecrealary(i_work); return w; } static VALUE dcl_shts2g(obj, mm, jm, im, isw, s, work) VALUE obj, mm, jm, im, isw, s, work; { integer i_mm; integer i_jm; integer i_im; integer i_isw; real *i_s; real *o_w; real *o_g; real *i_work; VALUE w; VALUE g; if ((TYPE(mm) != T_BIGNUM) || (TYPE(mm) != T_FIXNUM)) { mm = rb_funcall(mm, rb_intern("to_i"), 0); } if ((TYPE(jm) != T_BIGNUM) || (TYPE(jm) != T_FIXNUM)) { jm = rb_funcall(jm, rb_intern("to_i"), 0); } if ((TYPE(im) != T_BIGNUM) || (TYPE(im) != T_FIXNUM)) { im = rb_funcall(im, rb_intern("to_i"), 0); } if ((TYPE(isw) != T_BIGNUM) || (TYPE(isw) != T_FIXNUM)) { isw = rb_funcall(isw, rb_intern("to_i"), 0); } if (TYPE(s) == T_FLOAT) { s = rb_Array(s); } /* if ((TYPE(s) != T_ARRAY) && (rb_obj_is_kind_of(s, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(work) == T_FLOAT) { work = rb_Array(work); } /* if ((TYPE(work) != T_ARRAY) && (rb_obj_is_kind_of(work, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ i_mm = NUM2INT(mm); i_jm = NUM2INT(jm); i_im = NUM2INT(im); i_isw = NUM2INT(isw); i_s = dcl_obj2crealary(s); i_work = dcl_obj2crealary(work); o_w= ALLOCA_N(real, ((2*i_jm+1)*(2*i_mm+1))); o_g= ALLOCA_N(real, ((2*i_im+1)*(2*i_jm+1))); shts2g_(&i_mm, &i_jm, &i_im, &i_isw, i_s, o_w, o_g, i_work); {int array_shape[2] = {(2*i_jm+1), (2*i_mm+1)}; w = dcl_crealary2obj(o_w, ((2*i_jm+1)*(2*i_mm+1)), 2, array_shape); } {int array_shape[2] = {(2*i_im+1), (2*i_jm+1)}; g = dcl_crealary2obj(o_g, ((2*i_im+1)*(2*i_jm+1)), 2, array_shape); } dcl_freecrealary(i_s); dcl_freecrealary(i_work); return rb_ary_new3(2, w, g); } static VALUE dcl_shtsga(obj, mm, jm, im, isw, m1, m2, s, work) VALUE obj, mm, jm, im, isw, m1, m2, s, work; { integer i_mm; integer i_jm; integer i_im; integer i_isw; integer i_m1; integer i_m2; real *i_s; real *o_w; real *o_g; real *i_work; VALUE w; VALUE g; if ((TYPE(mm) != T_BIGNUM) || (TYPE(mm) != T_FIXNUM)) { mm = rb_funcall(mm, rb_intern("to_i"), 0); } if ((TYPE(jm) != T_BIGNUM) || (TYPE(jm) != T_FIXNUM)) { jm = rb_funcall(jm, rb_intern("to_i"), 0); } if ((TYPE(im) != T_BIGNUM) || (TYPE(im) != T_FIXNUM)) { im = rb_funcall(im, rb_intern("to_i"), 0); } if ((TYPE(isw) != T_BIGNUM) || (TYPE(isw) != T_FIXNUM)) { isw = rb_funcall(isw, rb_intern("to_i"), 0); } if ((TYPE(m1) != T_BIGNUM) || (TYPE(m1) != T_FIXNUM)) { m1 = rb_funcall(m1, rb_intern("to_i"), 0); } if ((TYPE(m2) != T_BIGNUM) || (TYPE(m2) != T_FIXNUM)) { m2 = rb_funcall(m2, rb_intern("to_i"), 0); } if (TYPE(s) == T_FLOAT) { s = rb_Array(s); } /* if ((TYPE(s) != T_ARRAY) && (rb_obj_is_kind_of(s, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(work) == T_FLOAT) { work = rb_Array(work); } /* if ((TYPE(work) != T_ARRAY) && (rb_obj_is_kind_of(work, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ i_mm = NUM2INT(mm); i_jm = NUM2INT(jm); i_im = NUM2INT(im); i_isw = NUM2INT(isw); i_m1 = NUM2INT(m1); i_m2 = NUM2INT(m2); i_s = dcl_obj2crealary(s); i_work = dcl_obj2crealary(work); o_w= ALLOCA_N(real, ((2*i_jm+1)*(2*i_mm+1))); o_g= ALLOCA_N(real, ((2*i_im+1)*(2*i_jm+1))); shtsga_(&i_mm, &i_jm, &i_im, &i_isw, &i_m1, &i_m2, i_s, o_w, o_g, i_work); {int array_shape[2] = {(2*i_jm+1), (2*i_mm+1)}; w = dcl_crealary2obj(o_w, ((2*i_jm+1)*(2*i_mm+1)), 2, array_shape); } {int array_shape[2] = {(2*i_im+1), (2*i_jm+1)}; g = dcl_crealary2obj(o_g, ((2*i_im+1)*(2*i_jm+1)), 2, array_shape); } dcl_freecrealary(i_s); dcl_freecrealary(i_work); return rb_ary_new3(2, w, g); } static VALUE dcl_shtsgz(obj, mm, jm, im, isw, s, work) VALUE obj, mm, jm, im, isw, s, work; { integer i_mm; integer i_jm; integer i_im; integer i_isw; real *i_s; real *o_wz; real *o_g; real *i_work; VALUE wz; VALUE g; if ((TYPE(mm) != T_BIGNUM) || (TYPE(mm) != T_FIXNUM)) { mm = rb_funcall(mm, rb_intern("to_i"), 0); } if ((TYPE(jm) != T_BIGNUM) || (TYPE(jm) != T_FIXNUM)) { jm = rb_funcall(jm, rb_intern("to_i"), 0); } if ((TYPE(im) != T_BIGNUM) || (TYPE(im) != T_FIXNUM)) { im = rb_funcall(im, rb_intern("to_i"), 0); } if ((TYPE(isw) != T_BIGNUM) || (TYPE(isw) != T_FIXNUM)) { isw = rb_funcall(isw, rb_intern("to_i"), 0); } if (TYPE(s) == T_FLOAT) { s = rb_Array(s); } /* if ((TYPE(s) != T_ARRAY) && (rb_obj_is_kind_of(s, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(work) == T_FLOAT) { work = rb_Array(work); } /* if ((TYPE(work) != T_ARRAY) && (rb_obj_is_kind_of(work, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ i_mm = NUM2INT(mm); i_jm = NUM2INT(jm); i_im = NUM2INT(im); i_isw = NUM2INT(isw); i_s = dcl_obj2crealary(s); i_work = dcl_obj2crealary(work); o_wz= ALLOCA_N(real, (2*i_jm+1)); o_g= ALLOCA_N(real, ((2*i_im+1)*(2*i_jm+1))); shtsgz_(&i_mm, &i_jm, &i_im, &i_isw, i_s, o_wz, o_g, i_work); {int array_shape[1] = {2*i_jm+1}; wz = dcl_crealary2obj(o_wz, (2*i_jm+1), 1, array_shape); } {int array_shape[2] = {(2*i_im+1), (2*i_jm+1)}; g = dcl_crealary2obj(o_g, ((2*i_im+1)*(2*i_jm+1)), 2, array_shape); } dcl_freecrealary(i_s); dcl_freecrealary(i_work); return rb_ary_new3(2, wz, g); } static VALUE dcl_shtsgm(obj, mm, jm, im, m, isw, s, work) VALUE obj, mm, jm, im, m, isw, s, work; { integer i_mm; integer i_jm; integer i_im; integer i_m; integer i_isw; real *i_s; real *o_wr; real *o_wi; real *o_g; real *i_work; VALUE wr; VALUE wi; VALUE g; if ((TYPE(mm) != T_BIGNUM) || (TYPE(mm) != T_FIXNUM)) { mm = rb_funcall(mm, rb_intern("to_i"), 0); } if ((TYPE(jm) != T_BIGNUM) || (TYPE(jm) != T_FIXNUM)) { jm = rb_funcall(jm, rb_intern("to_i"), 0); } if ((TYPE(im) != T_BIGNUM) || (TYPE(im) != T_FIXNUM)) { im = rb_funcall(im, rb_intern("to_i"), 0); } if ((TYPE(m) != T_BIGNUM) || (TYPE(m) != T_FIXNUM)) { m = rb_funcall(m, rb_intern("to_i"), 0); } if ((TYPE(isw) != T_BIGNUM) || (TYPE(isw) != T_FIXNUM)) { isw = rb_funcall(isw, rb_intern("to_i"), 0); } if (TYPE(s) == T_FLOAT) { s = rb_Array(s); } /* if ((TYPE(s) != T_ARRAY) && (rb_obj_is_kind_of(s, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(work) == T_FLOAT) { work = rb_Array(work); } /* if ((TYPE(work) != T_ARRAY) && (rb_obj_is_kind_of(work, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ i_mm = NUM2INT(mm); i_jm = NUM2INT(jm); i_im = NUM2INT(im); i_m = NUM2INT(m); i_isw = NUM2INT(isw); i_s = dcl_obj2crealary(s); i_work = dcl_obj2crealary(work); o_wr= ALLOCA_N(real, (2*i_jm+1)); o_wi= ALLOCA_N(real, (2*i_jm+1)); o_g= ALLOCA_N(real, ((2*i_im+1)*(2*i_jm+1))); shtsgm_(&i_mm, &i_jm, &i_im, &i_m, &i_isw, i_s, o_wr, o_wi, o_g, i_work); {int array_shape[1] = {2*i_jm+1}; wr = dcl_crealary2obj(o_wr, (2*i_jm+1), 1, array_shape); } {int array_shape[1] = {2*i_jm+1}; wi = dcl_crealary2obj(o_wi, (2*i_jm+1), 1, array_shape); } {int array_shape[2] = {(2*i_im+1), (2*i_jm+1)}; g = dcl_crealary2obj(o_g, ((2*i_im+1)*(2*i_jm+1)), 2, array_shape); } dcl_freecrealary(i_s); dcl_freecrealary(i_work); return rb_ary_new3(3, wr, wi, g); } static VALUE dcl_shtsgj(obj, mm, jm, im, isw, j, m1, m2, s, work) VALUE obj, mm, jm, im, isw, j, m1, m2, s, work; { integer i_mm; integer i_jm; integer i_im; integer i_isw; integer i_j; integer i_m1; integer i_m2; real *i_s; real *o_wj; real *o_gj; real *i_work; VALUE wj; VALUE gj; if ((TYPE(mm) != T_BIGNUM) || (TYPE(mm) != T_FIXNUM)) { mm = rb_funcall(mm, rb_intern("to_i"), 0); } if ((TYPE(jm) != T_BIGNUM) || (TYPE(jm) != T_FIXNUM)) { jm = rb_funcall(jm, rb_intern("to_i"), 0); } if ((TYPE(im) != T_BIGNUM) || (TYPE(im) != T_FIXNUM)) { im = rb_funcall(im, rb_intern("to_i"), 0); } if ((TYPE(isw) != T_BIGNUM) || (TYPE(isw) != T_FIXNUM)) { isw = rb_funcall(isw, rb_intern("to_i"), 0); } if ((TYPE(j) != T_BIGNUM) || (TYPE(j) != T_FIXNUM)) { j = rb_funcall(j, rb_intern("to_i"), 0); } if ((TYPE(m1) != T_BIGNUM) || (TYPE(m1) != T_FIXNUM)) { m1 = rb_funcall(m1, rb_intern("to_i"), 0); } if ((TYPE(m2) != T_BIGNUM) || (TYPE(m2) != T_FIXNUM)) { m2 = rb_funcall(m2, rb_intern("to_i"), 0); } if (TYPE(s) == T_FLOAT) { s = rb_Array(s); } /* if ((TYPE(s) != T_ARRAY) && (rb_obj_is_kind_of(s, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(work) == T_FLOAT) { work = rb_Array(work); } /* if ((TYPE(work) != T_ARRAY) && (rb_obj_is_kind_of(work, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ i_mm = NUM2INT(mm); i_jm = NUM2INT(jm); i_im = NUM2INT(im); i_isw = NUM2INT(isw); i_j = NUM2INT(j); i_m1 = NUM2INT(m1); i_m2 = NUM2INT(m2); i_s = dcl_obj2crealary(s); i_work = dcl_obj2crealary(work); o_wj= ALLOCA_N(real, (2*i_mm+1)); o_gj= ALLOCA_N(real, (2*i_im+1)); shtsgj_(&i_mm, &i_jm, &i_im, &i_isw, &i_j, &i_m1, &i_m2, i_s, o_wj, o_gj, i_work); {int array_shape[1] = {2*i_mm+1}; wj = dcl_crealary2obj(o_wj, (2*i_mm+1), 1, array_shape); } {int array_shape[1] = {2*i_im+1}; gj = dcl_crealary2obj(o_gj, (2*i_im+1), 1, array_shape); } dcl_freecrealary(i_s); dcl_freecrealary(i_work); return rb_ary_new3(2, wj, gj); } static VALUE dcl_shtg2s(obj, mm, jm, im, isw, g, work) VALUE obj, mm, jm, im, isw, g, work; { integer i_mm; integer i_jm; integer i_im; integer i_isw; real *i_g; real *o_w; real *o_s; real *i_work; VALUE w; VALUE s; if ((TYPE(mm) != T_BIGNUM) || (TYPE(mm) != T_FIXNUM)) { mm = rb_funcall(mm, rb_intern("to_i"), 0); } if ((TYPE(jm) != T_BIGNUM) || (TYPE(jm) != T_FIXNUM)) { jm = rb_funcall(jm, rb_intern("to_i"), 0); } if ((TYPE(im) != T_BIGNUM) || (TYPE(im) != T_FIXNUM)) { im = rb_funcall(im, rb_intern("to_i"), 0); } if ((TYPE(isw) != T_BIGNUM) || (TYPE(isw) != T_FIXNUM)) { isw = rb_funcall(isw, rb_intern("to_i"), 0); } if (TYPE(g) == T_FLOAT) { g = rb_Array(g); } /* if ((TYPE(g) != T_ARRAY) && (rb_obj_is_kind_of(g, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if (TYPE(work) == T_FLOAT) { work = rb_Array(work); } /* if ((TYPE(work) != T_ARRAY) && (rb_obj_is_kind_of(work, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ i_mm = NUM2INT(mm); i_jm = NUM2INT(jm); i_im = NUM2INT(im); i_isw = NUM2INT(isw); i_g = dcl_obj2crealary(g); i_work = dcl_obj2crealary(work); o_w= ALLOCA_N(real, ((2*i_jm+1)*(2*i_mm+1))); o_s= ALLOCA_N(real, (i_mm+1)*(i_mm+1)); shtg2s_(&i_mm, &i_jm, &i_im, &i_isw, i_g, o_w, o_s, i_work); {int array_shape[2] = {(2*i_jm+1), (2*i_mm+1)}; w = dcl_crealary2obj(o_w, ((2*i_jm+1)*(2*i_mm+1)), 2, array_shape); } {int array_shape[1] = {(i_mm+1)*(i_mm+1)}; s = dcl_crealary2obj(o_s, (i_mm+1)*(i_mm+1), 1, array_shape); } dcl_freecrealary(i_g); dcl_freecrealary(i_work); return rb_ary_new3(2, w, s); } void init_math2_shtlib(mDCL) VALUE mDCL; { rb_define_module_function(mDCL, "shtlib", dcl_shtlib, 0); rb_define_module_function(mDCL, "shtint", dcl_shtint, 3); rb_define_module_function(mDCL, "shtlap", dcl_shtlap, 3); rb_define_module_function(mDCL, "shtnml", dcl_shtnml, 3); rb_define_module_function(mDCL, "shtfun", dcl_shtfun, 4); rb_define_module_function(mDCL, "shtlfw", dcl_shtlfw, 6); rb_define_module_function(mDCL, "shtlbw", dcl_shtlbw, 6); rb_define_module_function(mDCL, "shts2w", dcl_shts2w, 5); rb_define_module_function(mDCL, "shtswa", dcl_shtswa, 7); rb_define_module_function(mDCL, "shtswz", dcl_shtswz, 5); rb_define_module_function(mDCL, "shtswm", dcl_shtswm, 6); rb_define_module_function(mDCL, "shtswj", dcl_shtswj, 8); rb_define_module_function(mDCL, "shtw2s", dcl_shtw2s, 5); rb_define_module_function(mDCL, "shtw2g", dcl_shtw2g, 5); rb_define_module_function(mDCL, "shtwga", dcl_shtwga, 7); rb_define_module_function(mDCL, "shtwgm", dcl_shtwgm, 7); rb_define_module_function(mDCL, "shtwgz", dcl_shtwgz, 3); rb_define_module_function(mDCL, "shtwgj", dcl_shtwgj, 6); rb_define_module_function(mDCL, "shtg2w", dcl_shtg2w, 5); rb_define_module_function(mDCL, "shts2g", dcl_shts2g, 6); rb_define_module_function(mDCL, "shtsga", dcl_shtsga, 8); rb_define_module_function(mDCL, "shtsgz", dcl_shtsgz, 6); rb_define_module_function(mDCL, "shtsgm", dcl_shtsgm, 7); rb_define_module_function(mDCL, "shtsgj", dcl_shtsgj, 9); rb_define_module_function(mDCL, "shtg2s", dcl_shtg2s, 6); }