/* * $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_vrfna(obj, rx, n, jx, jy, rfna) VALUE obj, rx, n, jx, jy, rfna; { real *i_rx; real *o_ry; integer i_n; integer i_jx; integer i_jy; real i_rfna; VALUE ry; if (TYPE(rx) == T_FLOAT) { rx = rb_Array(rx); } /* if ((TYPE(rx) != T_ARRAY) && (rb_obj_is_kind_of(rx, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if ((TYPE(jy) != T_BIGNUM) || (TYPE(jy) != T_FIXNUM)) { jy = rb_funcall(jy, rb_intern("to_i"), 0); } if (TYPE(rfna) != T_FLOAT) { rfna = rb_funcall(rfna, rb_intern("to_f"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_rfna = (real)NUM2DBL(rfna); i_rx = dcl_obj2crealary(rx); o_ry= ALLOCA_N(real, i_jy*(i_n-1)+1); vrfna_(i_rx, o_ry, &i_n, &i_jx, &i_jy, &i_rfna); {int array_shape[1] = {i_jy*(i_n-1)+1}; ry = dcl_crealary2obj(o_ry, i_jy*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(i_rx); return ry; } static VALUE dcl_vrfna0(obj, rx, n, jx, jy, rfna) VALUE obj, rx, n, jx, jy, rfna; { real *i_rx; real *o_ry; integer i_n; integer i_jx; integer i_jy; real i_rfna; VALUE ry; if (TYPE(rx) == T_FLOAT) { rx = rb_Array(rx); } /* if ((TYPE(rx) != T_ARRAY) && (rb_obj_is_kind_of(rx, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if ((TYPE(jy) != T_BIGNUM) || (TYPE(jy) != T_FIXNUM)) { jy = rb_funcall(jy, rb_intern("to_i"), 0); } if (TYPE(rfna) != T_FLOAT) { rfna = rb_funcall(rfna, rb_intern("to_f"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_rfna = (real)NUM2DBL(rfna); i_rx = dcl_obj2crealary(rx); o_ry= ALLOCA_N(real, i_jy*(i_n-1)+1); vrfna0_(i_rx, o_ry, &i_n, &i_jx, &i_jy, &i_rfna); {int array_shape[1] = {i_jy*(i_n-1)+1}; ry = dcl_crealary2obj(o_ry, i_jy*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(i_rx); return ry; } static VALUE dcl_vrfna1(obj, rx, n, jx, jy, rfna) VALUE obj, rx, n, jx, jy, rfna; { real *i_rx; real *o_ry; integer i_n; integer i_jx; integer i_jy; real i_rfna; VALUE ry; if (TYPE(rx) == T_FLOAT) { rx = rb_Array(rx); } /* if ((TYPE(rx) != T_ARRAY) && (rb_obj_is_kind_of(rx, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if ((TYPE(jy) != T_BIGNUM) || (TYPE(jy) != T_FIXNUM)) { jy = rb_funcall(jy, rb_intern("to_i"), 0); } if (TYPE(rfna) != T_FLOAT) { rfna = rb_funcall(rfna, rb_intern("to_f"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_rfna = (real)NUM2DBL(rfna); i_rx = dcl_obj2crealary(rx); o_ry= ALLOCA_N(real, i_jy*(i_n-1)+1); vrfna1_(i_rx, o_ry, &i_n, &i_jx, &i_jy, &i_rfna); {int array_shape[1] = {i_jy*(i_n-1)+1}; ry = dcl_crealary2obj(o_ry, i_jy*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(i_rx); return ry; } static VALUE dcl_vrinc(obj, rx, n, jx, jy, rr) VALUE obj, rx, n, jx, jy, rr; { real *i_rx; real *o_ry; integer i_n; integer i_jx; integer i_jy; real i_rr; VALUE ry; if (TYPE(rx) == T_FLOAT) { rx = rb_Array(rx); } /* if ((TYPE(rx) != T_ARRAY) && (rb_obj_is_kind_of(rx, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if ((TYPE(jy) != T_BIGNUM) || (TYPE(jy) != T_FIXNUM)) { jy = rb_funcall(jy, rb_intern("to_i"), 0); } if (TYPE(rr) != T_FLOAT) { rr = rb_funcall(rr, rb_intern("to_f"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_rr = (real)NUM2DBL(rr); i_rx = dcl_obj2crealary(rx); o_ry= ALLOCA_N(real, i_jy*(i_n-1)+1); vrinc_(i_rx, o_ry, &i_n, &i_jx, &i_jy, &i_rr); {int array_shape[1] = {i_jy*(i_n-1)+1}; ry = dcl_crealary2obj(o_ry, i_jy*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(i_rx); return ry; } static VALUE dcl_vrinc0(obj, rx, n, jx, jy, rr) VALUE obj, rx, n, jx, jy, rr; { real *i_rx; real *o_ry; integer i_n; integer i_jx; integer i_jy; real i_rr; VALUE ry; if (TYPE(rx) == T_FLOAT) { rx = rb_Array(rx); } /* if ((TYPE(rx) != T_ARRAY) && (rb_obj_is_kind_of(rx, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if ((TYPE(jy) != T_BIGNUM) || (TYPE(jy) != T_FIXNUM)) { jy = rb_funcall(jy, rb_intern("to_i"), 0); } if (TYPE(rr) != T_FLOAT) { rr = rb_funcall(rr, rb_intern("to_f"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_rr = (real)NUM2DBL(rr); i_rx = dcl_obj2crealary(rx); o_ry= ALLOCA_N(real, i_jy*(i_n-1)+1); vrinc0_(i_rx, o_ry, &i_n, &i_jx, &i_jy, &i_rr); {int array_shape[1] = {i_jy*(i_n-1)+1}; ry = dcl_crealary2obj(o_ry, i_jy*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(i_rx); return ry; } static VALUE dcl_vrinc1(obj, rx, n, jx, jy, rr) VALUE obj, rx, n, jx, jy, rr; { real *i_rx; real *o_ry; integer i_n; integer i_jx; integer i_jy; real i_rr; VALUE ry; if (TYPE(rx) == T_FLOAT) { rx = rb_Array(rx); } /* if ((TYPE(rx) != T_ARRAY) && (rb_obj_is_kind_of(rx, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if ((TYPE(jy) != T_BIGNUM) || (TYPE(jy) != T_FIXNUM)) { jy = rb_funcall(jy, rb_intern("to_i"), 0); } if (TYPE(rr) != T_FLOAT) { rr = rb_funcall(rr, rb_intern("to_f"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_rr = (real)NUM2DBL(rr); i_rx = dcl_obj2crealary(rx); o_ry= ALLOCA_N(real, i_jy*(i_n-1)+1); vrinc1_(i_rx, o_ry, &i_n, &i_jx, &i_jy, &i_rr); {int array_shape[1] = {i_jy*(i_n-1)+1}; ry = dcl_crealary2obj(o_ry, i_jy*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(i_rx); return ry; } static VALUE dcl_vrfct(obj, rx, n, jx, jy, rr) VALUE obj, rx, n, jx, jy, rr; { real *i_rx; real *o_ry; integer i_n; integer i_jx; integer i_jy; real i_rr; VALUE ry; if (TYPE(rx) == T_FLOAT) { rx = rb_Array(rx); } /* if ((TYPE(rx) != T_ARRAY) && (rb_obj_is_kind_of(rx, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if ((TYPE(jy) != T_BIGNUM) || (TYPE(jy) != T_FIXNUM)) { jy = rb_funcall(jy, rb_intern("to_i"), 0); } if (TYPE(rr) != T_FLOAT) { rr = rb_funcall(rr, rb_intern("to_f"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_rr = (real)NUM2DBL(rr); i_rx = dcl_obj2crealary(rx); o_ry= ALLOCA_N(real, i_jy*(i_n-1)+1); vrfct_(i_rx, o_ry, &i_n, &i_jx, &i_jy, &i_rr); {int array_shape[1] = {i_jy*(i_n-1)+1}; ry = dcl_crealary2obj(o_ry, i_jy*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(i_rx); return ry; } static VALUE dcl_vrfct0(obj, rx, n, jx, jy, rr) VALUE obj, rx, n, jx, jy, rr; { real *i_rx; real *o_ry; integer i_n; integer i_jx; integer i_jy; real i_rr; VALUE ry; if (TYPE(rx) == T_FLOAT) { rx = rb_Array(rx); } /* if ((TYPE(rx) != T_ARRAY) && (rb_obj_is_kind_of(rx, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if ((TYPE(jy) != T_BIGNUM) || (TYPE(jy) != T_FIXNUM)) { jy = rb_funcall(jy, rb_intern("to_i"), 0); } if (TYPE(rr) != T_FLOAT) { rr = rb_funcall(rr, rb_intern("to_f"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_rr = (real)NUM2DBL(rr); i_rx = dcl_obj2crealary(rx); o_ry= ALLOCA_N(real, i_jy*(i_n-1)+1); vrfct0_(i_rx, o_ry, &i_n, &i_jx, &i_jy, &i_rr); {int array_shape[1] = {i_jy*(i_n-1)+1}; ry = dcl_crealary2obj(o_ry, i_jy*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(i_rx); return ry; } static VALUE dcl_vrfct1(obj, rx, n, jx, jy, rr) VALUE obj, rx, n, jx, jy, rr; { real *i_rx; real *o_ry; integer i_n; integer i_jx; integer i_jy; real i_rr; VALUE ry; if (TYPE(rx) == T_FLOAT) { rx = rb_Array(rx); } /* if ((TYPE(rx) != T_ARRAY) && (rb_obj_is_kind_of(rx, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if ((TYPE(jy) != T_BIGNUM) || (TYPE(jy) != T_FIXNUM)) { jy = rb_funcall(jy, rb_intern("to_i"), 0); } if (TYPE(rr) != T_FLOAT) { rr = rb_funcall(rr, rb_intern("to_f"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_rr = (real)NUM2DBL(rr); i_rx = dcl_obj2crealary(rx); o_ry= ALLOCA_N(real, i_jy*(i_n-1)+1); vrfct1_(i_rx, o_ry, &i_n, &i_jx, &i_jy, &i_rr); {int array_shape[1] = {i_jy*(i_n-1)+1}; ry = dcl_crealary2obj(o_ry, i_jy*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(i_rx); return ry; } static VALUE dcl_vrcon(obj, rx, n, jx, jy, rr) VALUE obj, rx, n, jx, jy, rr; { real *i_rx; real *o_ry; integer i_n; integer i_jx; integer i_jy; real i_rr; VALUE ry; if (TYPE(rx) == T_FLOAT) { rx = rb_Array(rx); } /* if ((TYPE(rx) != T_ARRAY) && (rb_obj_is_kind_of(rx, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if ((TYPE(jy) != T_BIGNUM) || (TYPE(jy) != T_FIXNUM)) { jy = rb_funcall(jy, rb_intern("to_i"), 0); } if (TYPE(rr) != T_FLOAT) { rr = rb_funcall(rr, rb_intern("to_f"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_rr = (real)NUM2DBL(rr); i_rx = dcl_obj2crealary(rx); o_ry= ALLOCA_N(real, i_jy*(i_n-1)+1); vrcon_(i_rx, o_ry, &i_n, &i_jx, &i_jy, &i_rr); {int array_shape[1] = {i_jy*(i_n-1)+1}; ry = dcl_crealary2obj(o_ry, i_jy*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(i_rx); return ry; } static VALUE dcl_vrcon0(obj, rx, n, jx, jy, rr) VALUE obj, rx, n, jx, jy, rr; { real *i_rx; real *o_ry; integer i_n; integer i_jx; integer i_jy; real i_rr; VALUE ry; if (TYPE(rx) == T_FLOAT) { rx = rb_Array(rx); } /* if ((TYPE(rx) != T_ARRAY) && (rb_obj_is_kind_of(rx, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if ((TYPE(jy) != T_BIGNUM) || (TYPE(jy) != T_FIXNUM)) { jy = rb_funcall(jy, rb_intern("to_i"), 0); } if (TYPE(rr) != T_FLOAT) { rr = rb_funcall(rr, rb_intern("to_f"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_rr = (real)NUM2DBL(rr); i_rx = dcl_obj2crealary(rx); o_ry= ALLOCA_N(real, i_jy*(i_n-1)+1); vrcon0_(i_rx, o_ry, &i_n, &i_jx, &i_jy, &i_rr); {int array_shape[1] = {i_jy*(i_n-1)+1}; ry = dcl_crealary2obj(o_ry, i_jy*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(i_rx); return ry; } static VALUE dcl_vrcon1(obj, rx, n, jx, jy, rr) VALUE obj, rx, n, jx, jy, rr; { real *i_rx; real *o_ry; integer i_n; integer i_jx; integer i_jy; real i_rr; VALUE ry; if (TYPE(rx) == T_FLOAT) { rx = rb_Array(rx); } /* if ((TYPE(rx) != T_ARRAY) && (rb_obj_is_kind_of(rx, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if ((TYPE(jy) != T_BIGNUM) || (TYPE(jy) != T_FIXNUM)) { jy = rb_funcall(jy, rb_intern("to_i"), 0); } if (TYPE(rr) != T_FLOAT) { rr = rb_funcall(rr, rb_intern("to_f"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_rr = (real)NUM2DBL(rr); i_rx = dcl_obj2crealary(rx); o_ry= ALLOCA_N(real, i_jy*(i_n-1)+1); vrcon1_(i_rx, o_ry, &i_n, &i_jx, &i_jy, &i_rr); {int array_shape[1] = {i_jy*(i_n-1)+1}; ry = dcl_crealary2obj(o_ry, i_jy*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(i_rx); return ry; } static VALUE dcl_vrset(obj, rx, n, jx, jy) VALUE obj, rx, n, jx, jy; { real *i_rx; real *o_ry; integer i_n; integer i_jx; integer i_jy; VALUE ry; if (TYPE(rx) == T_FLOAT) { rx = rb_Array(rx); } /* if ((TYPE(rx) != T_ARRAY) && (rb_obj_is_kind_of(rx, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if ((TYPE(jy) != T_BIGNUM) || (TYPE(jy) != T_FIXNUM)) { jy = rb_funcall(jy, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_rx = dcl_obj2crealary(rx); o_ry= ALLOCA_N(real, i_jy*(i_n-1)+1); vrset_(i_rx, o_ry, &i_n, &i_jx, &i_jy); {int array_shape[1] = {i_jy*(i_n-1)+1}; ry = dcl_crealary2obj(o_ry, i_jy*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(i_rx); return ry; } static VALUE dcl_radd(obj, rx, n, jx, rr) VALUE obj, rx, n, jx, rr; { real *io_rx; integer i_n; integer i_jx; real i_rr; if (TYPE(rx) == T_FLOAT) { rx = rb_Array(rx); } /* if ((TYPE(rx) != T_ARRAY) && (rb_obj_is_kind_of(rx, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if (TYPE(rr) != T_FLOAT) { rr = rb_funcall(rr, rb_intern("to_f"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_rr = (real)NUM2DBL(rr); io_rx = dcl_obj2crealary(rx); radd_(io_rx, &i_n, &i_jx, &i_rr); {int array_shape[1] = {i_jx*(i_n-1)+1}; rx = dcl_crealary2obj(io_rx, i_jx*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(io_rx); return rx; } static VALUE dcl_radd0(obj, rx, n, jx, rr) VALUE obj, rx, n, jx, rr; { real *io_rx; integer i_n; integer i_jx; real i_rr; if (TYPE(rx) == T_FLOAT) { rx = rb_Array(rx); } /* if ((TYPE(rx) != T_ARRAY) && (rb_obj_is_kind_of(rx, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if (TYPE(rr) != T_FLOAT) { rr = rb_funcall(rr, rb_intern("to_f"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_rr = (real)NUM2DBL(rr); io_rx = dcl_obj2crealary(rx); radd0_(io_rx, &i_n, &i_jx, &i_rr); {int array_shape[1] = {i_jx*(i_n-1)+1}; rx = dcl_crealary2obj(io_rx, i_jx*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(io_rx); return rx; } static VALUE dcl_radd1(obj, rx, n, jx, rr) VALUE obj, rx, n, jx, rr; { real *io_rx; integer i_n; integer i_jx; real i_rr; if (TYPE(rx) == T_FLOAT) { rx = rb_Array(rx); } /* if ((TYPE(rx) != T_ARRAY) && (rb_obj_is_kind_of(rx, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if (TYPE(rr) != T_FLOAT) { rr = rb_funcall(rr, rb_intern("to_f"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_rr = (real)NUM2DBL(rr); io_rx = dcl_obj2crealary(rx); radd1_(io_rx, &i_n, &i_jx, &i_rr); {int array_shape[1] = {i_jx*(i_n-1)+1}; rx = dcl_crealary2obj(io_rx, i_jx*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(io_rx); return rx; } static VALUE dcl_rmlt(obj, rx, n, jx, rr) VALUE obj, rx, n, jx, rr; { real *io_rx; integer i_n; integer i_jx; real i_rr; if (TYPE(rx) == T_FLOAT) { rx = rb_Array(rx); } /* if ((TYPE(rx) != T_ARRAY) && (rb_obj_is_kind_of(rx, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if (TYPE(rr) != T_FLOAT) { rr = rb_funcall(rr, rb_intern("to_f"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_rr = (real)NUM2DBL(rr); io_rx = dcl_obj2crealary(rx); rmlt_(io_rx, &i_n, &i_jx, &i_rr); {int array_shape[1] = {i_jx*(i_n-1)+1}; rx = dcl_crealary2obj(io_rx, i_jx*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(io_rx); return rx; } static VALUE dcl_rmlt0(obj, rx, n, jx, rr) VALUE obj, rx, n, jx, rr; { real *io_rx; integer i_n; integer i_jx; real i_rr; if (TYPE(rx) == T_FLOAT) { rx = rb_Array(rx); } /* if ((TYPE(rx) != T_ARRAY) && (rb_obj_is_kind_of(rx, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if (TYPE(rr) != T_FLOAT) { rr = rb_funcall(rr, rb_intern("to_f"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_rr = (real)NUM2DBL(rr); io_rx = dcl_obj2crealary(rx); rmlt0_(io_rx, &i_n, &i_jx, &i_rr); {int array_shape[1] = {i_jx*(i_n-1)+1}; rx = dcl_crealary2obj(io_rx, i_jx*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(io_rx); return rx; } static VALUE dcl_rmlt1(obj, rx, n, jx, rr) VALUE obj, rx, n, jx, rr; { real *io_rx; integer i_n; integer i_jx; real i_rr; if (TYPE(rx) == T_FLOAT) { rx = rb_Array(rx); } /* if ((TYPE(rx) != T_ARRAY) && (rb_obj_is_kind_of(rx, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if (TYPE(rr) != T_FLOAT) { rr = rb_funcall(rr, rb_intern("to_f"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_rr = (real)NUM2DBL(rr); io_rx = dcl_obj2crealary(rx); rmlt1_(io_rx, &i_n, &i_jx, &i_rr); {int array_shape[1] = {i_jx*(i_n-1)+1}; rx = dcl_crealary2obj(io_rx, i_jx*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(io_rx); return rx; } static VALUE dcl_rset(obj, rx, n, jx, rr) VALUE obj, rx, n, jx, rr; { real *io_rx; integer i_n; integer i_jx; real i_rr; if (TYPE(rx) == T_FLOAT) { rx = rb_Array(rx); } /* if ((TYPE(rx) != T_ARRAY) && (rb_obj_is_kind_of(rx, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if (TYPE(rr) != T_FLOAT) { rr = rb_funcall(rr, rb_intern("to_f"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_rr = (real)NUM2DBL(rr); io_rx = dcl_obj2crealary(rx); rset_(io_rx, &i_n, &i_jx, &i_rr); {int array_shape[1] = {i_jx*(i_n-1)+1}; rx = dcl_crealary2obj(io_rx, i_jx*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(io_rx); return rx; } static VALUE dcl_rset0(obj, rx, n, jx, rr) VALUE obj, rx, n, jx, rr; { real *io_rx; integer i_n; integer i_jx; real i_rr; if (TYPE(rx) == T_FLOAT) { rx = rb_Array(rx); } /* if ((TYPE(rx) != T_ARRAY) && (rb_obj_is_kind_of(rx, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if (TYPE(rr) != T_FLOAT) { rr = rb_funcall(rr, rb_intern("to_f"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_rr = (real)NUM2DBL(rr); io_rx = dcl_obj2crealary(rx); rset0_(io_rx, &i_n, &i_jx, &i_rr); {int array_shape[1] = {i_jx*(i_n-1)+1}; rx = dcl_crealary2obj(io_rx, i_jx*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(io_rx); return rx; } static VALUE dcl_rset1(obj, rx, n, jx, rr) VALUE obj, rx, n, jx, rr; { real *io_rx; integer i_n; integer i_jx; real i_rr; if (TYPE(rx) == T_FLOAT) { rx = rb_Array(rx); } /* if ((TYPE(rx) != T_ARRAY) && (rb_obj_is_kind_of(rx, cNArray) != Qtrue)) { rb_raise(rb_eTypeError, "invalid type"); } -- no check since obj2c*ary will do that */ if ((TYPE(n) != T_BIGNUM) || (TYPE(n) != T_FIXNUM)) { n = rb_funcall(n, rb_intern("to_i"), 0); } if ((TYPE(jx) != T_BIGNUM) || (TYPE(jx) != T_FIXNUM)) { jx = rb_funcall(jx, rb_intern("to_i"), 0); } if (TYPE(rr) != T_FLOAT) { rr = rb_funcall(rr, rb_intern("to_f"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_rr = (real)NUM2DBL(rr); io_rx = dcl_obj2crealary(rx); rset1_(io_rx, &i_n, &i_jx, &i_rr); {int array_shape[1] = {i_jx*(i_n-1)+1}; rx = dcl_crealary2obj(io_rx, i_jx*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(io_rx); return rx; } void init_math1_vralib(mDCL) VALUE mDCL; { rb_define_module_function(mDCL, "vrfna", dcl_vrfna, 5); rb_define_module_function(mDCL, "vrfna0", dcl_vrfna0, 5); rb_define_module_function(mDCL, "vrfna1", dcl_vrfna1, 5); rb_define_module_function(mDCL, "vrinc", dcl_vrinc, 5); rb_define_module_function(mDCL, "vrinc0", dcl_vrinc0, 5); rb_define_module_function(mDCL, "vrinc1", dcl_vrinc1, 5); rb_define_module_function(mDCL, "vrfct", dcl_vrfct, 5); rb_define_module_function(mDCL, "vrfct0", dcl_vrfct0, 5); rb_define_module_function(mDCL, "vrfct1", dcl_vrfct1, 5); rb_define_module_function(mDCL, "vrcon", dcl_vrcon, 5); rb_define_module_function(mDCL, "vrcon0", dcl_vrcon0, 5); rb_define_module_function(mDCL, "vrcon1", dcl_vrcon1, 5); rb_define_module_function(mDCL, "vrset", dcl_vrset, 4); rb_define_module_function(mDCL, "radd", dcl_radd, 4); rb_define_module_function(mDCL, "radd0", dcl_radd0, 4); rb_define_module_function(mDCL, "radd1", dcl_radd1, 4); rb_define_module_function(mDCL, "rmlt", dcl_rmlt, 4); rb_define_module_function(mDCL, "rmlt0", dcl_rmlt0, 4); rb_define_module_function(mDCL, "rmlt1", dcl_rmlt1, 4); rb_define_module_function(mDCL, "rset", dcl_rset, 4); rb_define_module_function(mDCL, "rset0", dcl_rset0, 4); rb_define_module_function(mDCL, "rset1", dcl_rset1, 4); }