/* * $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_vrfnb(obj, rx, ry, n, jx, jy, jz, rfnb) VALUE obj, rx, ry, n, jx, jy, jz, rfnb; { real *i_rx; real *i_ry; real *o_rz; integer i_n; integer i_jx; integer i_jy; integer i_jz; real i_rfnb; VALUE rz; 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(ry) == T_FLOAT) { ry = rb_Array(ry); } /* if ((TYPE(ry) != T_ARRAY) && (rb_obj_is_kind_of(ry, 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(jz) != T_BIGNUM) || (TYPE(jz) != T_FIXNUM)) { jz = rb_funcall(jz, rb_intern("to_i"), 0); } if (TYPE(rfnb) != T_FLOAT) { rfnb = rb_funcall(rfnb, rb_intern("to_f"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_jz = NUM2INT(jz); i_rfnb = (real)NUM2DBL(rfnb); i_rx = dcl_obj2crealary(rx); i_ry = dcl_obj2crealary(ry); o_rz= ALLOCA_N(real, i_jz*(i_n-1)+1); vrfnb_(i_rx, i_ry, o_rz, &i_n, &i_jx, &i_jy, &i_jz, &i_rfnb); {int array_shape[1] = {i_jz*(i_n-1)+1}; rz = dcl_crealary2obj(o_rz, i_jz*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(i_rx); dcl_freecrealary(i_ry); return rz; } static VALUE dcl_vrfnb0(obj, rx, ry, n, jx, jy, jz, rfnb) VALUE obj, rx, ry, n, jx, jy, jz, rfnb; { real *i_rx; real *i_ry; real *o_rz; integer i_n; integer i_jx; integer i_jy; integer i_jz; real i_rfnb; VALUE rz; 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(ry) == T_FLOAT) { ry = rb_Array(ry); } /* if ((TYPE(ry) != T_ARRAY) && (rb_obj_is_kind_of(ry, 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(jz) != T_BIGNUM) || (TYPE(jz) != T_FIXNUM)) { jz = rb_funcall(jz, rb_intern("to_i"), 0); } if (TYPE(rfnb) != T_FLOAT) { rfnb = rb_funcall(rfnb, rb_intern("to_f"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_jz = NUM2INT(jz); i_rfnb = (real)NUM2DBL(rfnb); i_rx = dcl_obj2crealary(rx); i_ry = dcl_obj2crealary(ry); o_rz= ALLOCA_N(real, i_jz*(i_n-1)+1); vrfnb0_(i_rx, i_ry, o_rz, &i_n, &i_jx, &i_jy, &i_jz, &i_rfnb); {int array_shape[1] = {i_jz*(i_n-1)+1}; rz = dcl_crealary2obj(o_rz, i_jz*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(i_rx); dcl_freecrealary(i_ry); return rz; } static VALUE dcl_vrfnb1(obj, rx, ry, n, jx, jy, jz, rfnb) VALUE obj, rx, ry, n, jx, jy, jz, rfnb; { real *i_rx; real *i_ry; real *o_rz; integer i_n; integer i_jx; integer i_jy; integer i_jz; real i_rfnb; VALUE rz; 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(ry) == T_FLOAT) { ry = rb_Array(ry); } /* if ((TYPE(ry) != T_ARRAY) && (rb_obj_is_kind_of(ry, 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(jz) != T_BIGNUM) || (TYPE(jz) != T_FIXNUM)) { jz = rb_funcall(jz, rb_intern("to_i"), 0); } if (TYPE(rfnb) != T_FLOAT) { rfnb = rb_funcall(rfnb, rb_intern("to_f"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_jz = NUM2INT(jz); i_rfnb = (real)NUM2DBL(rfnb); i_rx = dcl_obj2crealary(rx); i_ry = dcl_obj2crealary(ry); o_rz= ALLOCA_N(real, i_jz*(i_n-1)+1); vrfnb1_(i_rx, i_ry, o_rz, &i_n, &i_jx, &i_jy, &i_jz, &i_rfnb); {int array_shape[1] = {i_jz*(i_n-1)+1}; rz = dcl_crealary2obj(o_rz, i_jz*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(i_rx); dcl_freecrealary(i_ry); return rz; } static VALUE dcl_vradd(obj, rx, ry, n, jx, jy, jz) VALUE obj, rx, ry, n, jx, jy, jz; { real *i_rx; real *i_ry; real *o_rz; integer i_n; integer i_jx; integer i_jy; integer i_jz; VALUE rz; 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(ry) == T_FLOAT) { ry = rb_Array(ry); } /* if ((TYPE(ry) != T_ARRAY) && (rb_obj_is_kind_of(ry, 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(jz) != T_BIGNUM) || (TYPE(jz) != T_FIXNUM)) { jz = rb_funcall(jz, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_jz = NUM2INT(jz); i_rx = dcl_obj2crealary(rx); i_ry = dcl_obj2crealary(ry); o_rz= ALLOCA_N(real, i_jz*(i_n-1)+1); vradd_(i_rx, i_ry, o_rz, &i_n, &i_jx, &i_jy, &i_jz); {int array_shape[1] = {i_jz*(i_n-1)+1}; rz = dcl_crealary2obj(o_rz, i_jz*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(i_rx); dcl_freecrealary(i_ry); return rz; } static VALUE dcl_vradd0(obj, rx, ry, n, jx, jy, jz) VALUE obj, rx, ry, n, jx, jy, jz; { real *i_rx; real *i_ry; real *o_rz; integer i_n; integer i_jx; integer i_jy; integer i_jz; VALUE rz; 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(ry) == T_FLOAT) { ry = rb_Array(ry); } /* if ((TYPE(ry) != T_ARRAY) && (rb_obj_is_kind_of(ry, 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(jz) != T_BIGNUM) || (TYPE(jz) != T_FIXNUM)) { jz = rb_funcall(jz, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_jz = NUM2INT(jz); i_rx = dcl_obj2crealary(rx); i_ry = dcl_obj2crealary(ry); o_rz= ALLOCA_N(real, i_jz*(i_n-1)+1); vradd0_(i_rx, i_ry, o_rz, &i_n, &i_jx, &i_jy, &i_jz); {int array_shape[1] = {i_jz*(i_n-1)+1}; rz = dcl_crealary2obj(o_rz, i_jz*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(i_rx); dcl_freecrealary(i_ry); return rz; } static VALUE dcl_vradd1(obj, rx, ry, n, jx, jy, jz) VALUE obj, rx, ry, n, jx, jy, jz; { real *i_rx; real *i_ry; real *o_rz; integer i_n; integer i_jx; integer i_jy; integer i_jz; VALUE rz; 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(ry) == T_FLOAT) { ry = rb_Array(ry); } /* if ((TYPE(ry) != T_ARRAY) && (rb_obj_is_kind_of(ry, 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(jz) != T_BIGNUM) || (TYPE(jz) != T_FIXNUM)) { jz = rb_funcall(jz, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_jz = NUM2INT(jz); i_rx = dcl_obj2crealary(rx); i_ry = dcl_obj2crealary(ry); o_rz= ALLOCA_N(real, i_jz*(i_n-1)+1); vradd1_(i_rx, i_ry, o_rz, &i_n, &i_jx, &i_jy, &i_jz); {int array_shape[1] = {i_jz*(i_n-1)+1}; rz = dcl_crealary2obj(o_rz, i_jz*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(i_rx); dcl_freecrealary(i_ry); return rz; } static VALUE dcl_vrsub(obj, rx, ry, n, jx, jy, jz) VALUE obj, rx, ry, n, jx, jy, jz; { real *i_rx; real *i_ry; real *o_rz; integer i_n; integer i_jx; integer i_jy; integer i_jz; VALUE rz; 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(ry) == T_FLOAT) { ry = rb_Array(ry); } /* if ((TYPE(ry) != T_ARRAY) && (rb_obj_is_kind_of(ry, 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(jz) != T_BIGNUM) || (TYPE(jz) != T_FIXNUM)) { jz = rb_funcall(jz, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_jz = NUM2INT(jz); i_rx = dcl_obj2crealary(rx); i_ry = dcl_obj2crealary(ry); o_rz= ALLOCA_N(real, i_jz*(i_n-1)+1); vrsub_(i_rx, i_ry, o_rz, &i_n, &i_jx, &i_jy, &i_jz); {int array_shape[1] = {i_jz*(i_n-1)+1}; rz = dcl_crealary2obj(o_rz, i_jz*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(i_rx); dcl_freecrealary(i_ry); return rz; } static VALUE dcl_vrsub0(obj, rx, ry, n, jx, jy, jz) VALUE obj, rx, ry, n, jx, jy, jz; { real *i_rx; real *i_ry; real *o_rz; integer i_n; integer i_jx; integer i_jy; integer i_jz; VALUE rz; 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(ry) == T_FLOAT) { ry = rb_Array(ry); } /* if ((TYPE(ry) != T_ARRAY) && (rb_obj_is_kind_of(ry, 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(jz) != T_BIGNUM) || (TYPE(jz) != T_FIXNUM)) { jz = rb_funcall(jz, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_jz = NUM2INT(jz); i_rx = dcl_obj2crealary(rx); i_ry = dcl_obj2crealary(ry); o_rz= ALLOCA_N(real, i_jz*(i_n-1)+1); vrsub0_(i_rx, i_ry, o_rz, &i_n, &i_jx, &i_jy, &i_jz); {int array_shape[1] = {i_jz*(i_n-1)+1}; rz = dcl_crealary2obj(o_rz, i_jz*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(i_rx); dcl_freecrealary(i_ry); return rz; } static VALUE dcl_vrsub1(obj, rx, ry, n, jx, jy, jz) VALUE obj, rx, ry, n, jx, jy, jz; { real *i_rx; real *i_ry; real *o_rz; integer i_n; integer i_jx; integer i_jy; integer i_jz; VALUE rz; 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(ry) == T_FLOAT) { ry = rb_Array(ry); } /* if ((TYPE(ry) != T_ARRAY) && (rb_obj_is_kind_of(ry, 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(jz) != T_BIGNUM) || (TYPE(jz) != T_FIXNUM)) { jz = rb_funcall(jz, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_jz = NUM2INT(jz); i_rx = dcl_obj2crealary(rx); i_ry = dcl_obj2crealary(ry); o_rz= ALLOCA_N(real, i_jz*(i_n-1)+1); vrsub1_(i_rx, i_ry, o_rz, &i_n, &i_jx, &i_jy, &i_jz); {int array_shape[1] = {i_jz*(i_n-1)+1}; rz = dcl_crealary2obj(o_rz, i_jz*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(i_rx); dcl_freecrealary(i_ry); return rz; } static VALUE dcl_vrmlt(obj, rx, ry, n, jx, jy, jz) VALUE obj, rx, ry, n, jx, jy, jz; { real *i_rx; real *i_ry; real *o_rz; integer i_n; integer i_jx; integer i_jy; integer i_jz; VALUE rz; 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(ry) == T_FLOAT) { ry = rb_Array(ry); } /* if ((TYPE(ry) != T_ARRAY) && (rb_obj_is_kind_of(ry, 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(jz) != T_BIGNUM) || (TYPE(jz) != T_FIXNUM)) { jz = rb_funcall(jz, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_jz = NUM2INT(jz); i_rx = dcl_obj2crealary(rx); i_ry = dcl_obj2crealary(ry); o_rz= ALLOCA_N(real, i_jz*(i_n-1)+1); vrmlt_(i_rx, i_ry, o_rz, &i_n, &i_jx, &i_jy, &i_jz); {int array_shape[1] = {i_jz*(i_n-1)+1}; rz = dcl_crealary2obj(o_rz, i_jz*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(i_rx); dcl_freecrealary(i_ry); return rz; } static VALUE dcl_vrmlt0(obj, rx, ry, n, jx, jy, jz) VALUE obj, rx, ry, n, jx, jy, jz; { real *i_rx; real *i_ry; real *o_rz; integer i_n; integer i_jx; integer i_jy; integer i_jz; VALUE rz; 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(ry) == T_FLOAT) { ry = rb_Array(ry); } /* if ((TYPE(ry) != T_ARRAY) && (rb_obj_is_kind_of(ry, 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(jz) != T_BIGNUM) || (TYPE(jz) != T_FIXNUM)) { jz = rb_funcall(jz, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_jz = NUM2INT(jz); i_rx = dcl_obj2crealary(rx); i_ry = dcl_obj2crealary(ry); o_rz= ALLOCA_N(real, i_jz*(i_n-1)+1); vrmlt0_(i_rx, i_ry, o_rz, &i_n, &i_jx, &i_jy, &i_jz); {int array_shape[1] = {i_jz*(i_n-1)+1}; rz = dcl_crealary2obj(o_rz, i_jz*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(i_rx); dcl_freecrealary(i_ry); return rz; } static VALUE dcl_vrmlt1(obj, rx, ry, n, jx, jy, jz) VALUE obj, rx, ry, n, jx, jy, jz; { real *i_rx; real *i_ry; real *o_rz; integer i_n; integer i_jx; integer i_jy; integer i_jz; VALUE rz; 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(ry) == T_FLOAT) { ry = rb_Array(ry); } /* if ((TYPE(ry) != T_ARRAY) && (rb_obj_is_kind_of(ry, 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(jz) != T_BIGNUM) || (TYPE(jz) != T_FIXNUM)) { jz = rb_funcall(jz, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_jz = NUM2INT(jz); i_rx = dcl_obj2crealary(rx); i_ry = dcl_obj2crealary(ry); o_rz= ALLOCA_N(real, i_jz*(i_n-1)+1); vrmlt1_(i_rx, i_ry, o_rz, &i_n, &i_jx, &i_jy, &i_jz); {int array_shape[1] = {i_jz*(i_n-1)+1}; rz = dcl_crealary2obj(o_rz, i_jz*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(i_rx); dcl_freecrealary(i_ry); return rz; } static VALUE dcl_vrdiv(obj, rx, ry, n, jx, jy, jz) VALUE obj, rx, ry, n, jx, jy, jz; { real *i_rx; real *i_ry; real *o_rz; integer i_n; integer i_jx; integer i_jy; integer i_jz; VALUE rz; 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(ry) == T_FLOAT) { ry = rb_Array(ry); } /* if ((TYPE(ry) != T_ARRAY) && (rb_obj_is_kind_of(ry, 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(jz) != T_BIGNUM) || (TYPE(jz) != T_FIXNUM)) { jz = rb_funcall(jz, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_jz = NUM2INT(jz); i_rx = dcl_obj2crealary(rx); i_ry = dcl_obj2crealary(ry); o_rz= ALLOCA_N(real, i_jz*(i_n-1)+1); vrdiv_(i_rx, i_ry, o_rz, &i_n, &i_jx, &i_jy, &i_jz); {int array_shape[1] = {i_jz*(i_n-1)+1}; rz = dcl_crealary2obj(o_rz, i_jz*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(i_rx); dcl_freecrealary(i_ry); return rz; } static VALUE dcl_vrdiv0(obj, rx, ry, n, jx, jy, jz) VALUE obj, rx, ry, n, jx, jy, jz; { real *i_rx; real *i_ry; real *o_rz; integer i_n; integer i_jx; integer i_jy; integer i_jz; VALUE rz; 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(ry) == T_FLOAT) { ry = rb_Array(ry); } /* if ((TYPE(ry) != T_ARRAY) && (rb_obj_is_kind_of(ry, 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(jz) != T_BIGNUM) || (TYPE(jz) != T_FIXNUM)) { jz = rb_funcall(jz, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_jz = NUM2INT(jz); i_rx = dcl_obj2crealary(rx); i_ry = dcl_obj2crealary(ry); o_rz= ALLOCA_N(real, i_jz*(i_n-1)+1); vrdiv0_(i_rx, i_ry, o_rz, &i_n, &i_jx, &i_jy, &i_jz); {int array_shape[1] = {i_jz*(i_n-1)+1}; rz = dcl_crealary2obj(o_rz, i_jz*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(i_rx); dcl_freecrealary(i_ry); return rz; } static VALUE dcl_vrdiv1(obj, rx, ry, n, jx, jy, jz) VALUE obj, rx, ry, n, jx, jy, jz; { real *i_rx; real *i_ry; real *o_rz; integer i_n; integer i_jx; integer i_jy; integer i_jz; VALUE rz; 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(ry) == T_FLOAT) { ry = rb_Array(ry); } /* if ((TYPE(ry) != T_ARRAY) && (rb_obj_is_kind_of(ry, 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(jz) != T_BIGNUM) || (TYPE(jz) != T_FIXNUM)) { jz = rb_funcall(jz, rb_intern("to_i"), 0); } i_n = NUM2INT(n); i_jx = NUM2INT(jx); i_jy = NUM2INT(jy); i_jz = NUM2INT(jz); i_rx = dcl_obj2crealary(rx); i_ry = dcl_obj2crealary(ry); o_rz= ALLOCA_N(real, i_jz*(i_n-1)+1); vrdiv1_(i_rx, i_ry, o_rz, &i_n, &i_jx, &i_jy, &i_jz); {int array_shape[1] = {i_jz*(i_n-1)+1}; rz = dcl_crealary2obj(o_rz, i_jz*(i_n-1)+1, 1, array_shape); } dcl_freecrealary(i_rx); dcl_freecrealary(i_ry); return rz; } void init_math1_vrblib(mDCL) VALUE mDCL; { rb_define_module_function(mDCL, "vrfnb", dcl_vrfnb, 7); rb_define_module_function(mDCL, "vrfnb0", dcl_vrfnb0, 7); rb_define_module_function(mDCL, "vrfnb1", dcl_vrfnb1, 7); rb_define_module_function(mDCL, "vradd", dcl_vradd, 6); rb_define_module_function(mDCL, "vradd0", dcl_vradd0, 6); rb_define_module_function(mDCL, "vradd1", dcl_vradd1, 6); rb_define_module_function(mDCL, "vrsub", dcl_vrsub, 6); rb_define_module_function(mDCL, "vrsub0", dcl_vrsub0, 6); rb_define_module_function(mDCL, "vrsub1", dcl_vrsub1, 6); rb_define_module_function(mDCL, "vrmlt", dcl_vrmlt, 6); rb_define_module_function(mDCL, "vrmlt0", dcl_vrmlt0, 6); rb_define_module_function(mDCL, "vrmlt1", dcl_vrmlt1, 6); rb_define_module_function(mDCL, "vrdiv", dcl_vrdiv, 6); rb_define_module_function(mDCL, "vrdiv0", dcl_vrdiv0, 6); rb_define_module_function(mDCL, "vrdiv1", dcl_vrdiv1, 6); }