ruby-dcl 1.8.1 → 1.8.2

data/ext/numru/misc2_tmpack.c

@@ -0,0 +1,1200 @@
+/*
+ * $Id$
+ */
+
+#include <stdio.h>
+#include "ruby.h"
+#include "narray.h"
+#include "cdcl.h"
+
+/* for compatibility with ruby 1.6 */
+#ifndef StringValuePtr
+#define StringValuePtr(s) STR2CSTR(s)
+#endif
+
+#define DFLT_SIZE 32
+
+#ifndef NARRAY_BIGMEM
+typedef int    na_shape_t;
+#endif
+
+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 *, na_shape_t, int, na_shape_t *);
+extern VALUE dcl_crealary2obj(real *, na_shape_t, int, na_shape_t *);
+/* extern VALUE dcl_ccomplexary2obj(complex *, int, char *); */
+extern VALUE dcl_clogicalary2obj(logical *, na_shape_t, int, na_shape_t *);
+
+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 real */
+/* fnclib */
+extern real rd2r_(real *);
+extern real rr2d_(real *);
+extern real rexp_(real *, integer *, integer *);
+extern real rfpi_(void);
+extern real rmod_(real *, real *);
+/* gnmlib */
+extern real rgnlt_(real *);
+extern real rgnle_(real *);
+extern real rgngt_(real *);
+extern real rgnge_(real *);
+/* rfalib */
+extern real rmax_(real *, integer *, integer *);
+extern real rmin_(real *, integer *, integer *);
+extern real rsum_(real *, integer *, integer *);
+extern real rave_(real *, integer *, integer *);
+extern real rvar_(real *, integer *, integer *);
+extern real rstd_(real *, integer *, integer *);
+extern real rrms_(real *, integer *, integer *);
+extern real ramp_(real *, integer *, integer *);
+/* rfblib */
+extern real rprd_(real *, real *, integer *, integer *, integer *);
+extern real rcov_(real *, real *, integer *, integer *, integer *);
+extern real rcor_(real *, real *, integer *, integer *, integer *);
+
+
+extern VALUE mDCL;
+
+#if DCLVER >= 730
+
+static VALUE
+dcl_tmiget(obj, cp)
+    VALUE obj, cp;
+{
+    char *i_cp;
+    integer o_ipara;
+    VALUE ipara;
+
+    if (TYPE(cp) != T_STRING) {
+      cp = rb_funcall(cp, rb_intern("to_str"), 0);
+    }
+
+    i_cp = StringValuePtr(cp);
+
+
+    tmiget__(i_cp, &o_ipara, (ftnlen)strlen(i_cp));
+
+    ipara = INT2NUM(o_ipara);
+
+
+    return ipara;
+
+}
+
+static VALUE
+dcl_tmiset(obj, cp, ipara)
+    VALUE obj, cp, ipara;
+{
+    char *i_cp;
+    integer i_ipara;
+
+    if (TYPE(cp) != T_STRING) {
+      cp = rb_funcall(cp, rb_intern("to_str"), 0);
+    }
+    if ((TYPE(ipara) != T_BIGNUM) || (TYPE(ipara) != T_FIXNUM)) {
+      ipara = rb_funcall(ipara, rb_intern("to_i"), 0);
+    }
+
+    i_cp = StringValuePtr(cp);
+    i_ipara = NUM2INT(ipara);
+
+
+    tmiset__(i_cp, &i_ipara, (ftnlen)strlen(i_cp));
+
+    return Qnil;
+
+}
+
+static VALUE
+dcl_tmistx(obj, cp, ipara)
+    VALUE obj, cp, ipara;
+{
+    char *i_cp;
+    integer i_ipara;
+
+    if (TYPE(cp) != T_STRING) {
+      cp = rb_funcall(cp, rb_intern("to_str"), 0);
+    }
+    if ((TYPE(ipara) != T_BIGNUM) || (TYPE(ipara) != T_FIXNUM)) {
+      ipara = rb_funcall(ipara, rb_intern("to_i"), 0);
+    }
+
+    i_cp = StringValuePtr(cp);
+    i_ipara = NUM2INT(ipara);
+
+
+    tmistx__(i_cp, &i_ipara, (ftnlen)strlen(i_cp));
+
+    return Qnil;
+
+}
+
+static VALUE
+dcl_tmiqnp(obj)
+    VALUE obj;
+{
+    integer o_ncp;
+    VALUE ncp;
+
+    tmiqnp__(&o_ncp);
+
+    ncp = INT2NUM(o_ncp);
+
+
+    return ncp;
+
+}
+
+static VALUE
+dcl_tmiqid(obj, cp)
+    VALUE obj, cp;
+{
+    char *i_cp;
+    integer o_idx;
+    VALUE idx;
+
+    if (TYPE(cp) != T_STRING) {
+      cp = rb_funcall(cp, rb_intern("to_str"), 0);
+    }
+
+    i_cp = StringValuePtr(cp);
+
+
+    tmiqid__(i_cp, &o_idx, (ftnlen)strlen(i_cp));
+
+    idx = INT2NUM(o_idx);
+
+
+    return idx;
+
+}
+
+static VALUE
+dcl_tmiqcp(obj, idx)
+    VALUE obj, idx;
+{
+    integer i_idx;
+    char *o_cp;
+    VALUE cp;
+
+    if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
+      idx = rb_funcall(idx, rb_intern("to_i"), 0);
+    }
+
+    i_idx = NUM2INT(idx);
+
+    o_cp= ALLOCA_N(char, (DFLT_SIZE+1));
+    memset(o_cp, '\0', DFLT_SIZE+1);
+
+    tmiqcp__(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
+
+    cp = rb_str_new2(o_cp);
+
+
+    return cp;
+
+}
+
+static VALUE
+dcl_tmiqcl(obj, idx)
+    VALUE obj, idx;
+{
+    integer i_idx;
+    char *o_cp;
+    VALUE cp;
+
+    if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
+      idx = rb_funcall(idx, rb_intern("to_i"), 0);
+    }
+
+    i_idx = NUM2INT(idx);
+
+    o_cp= ALLOCA_N(char, (DFLT_SIZE+1));
+    memset(o_cp, '\0', DFLT_SIZE+1);
+
+    tmiqcl__(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
+
+    cp = rb_str_new2(o_cp);
+
+
+    return cp;
+
+}
+
+static VALUE
+dcl_tmiqvl(obj, idx)
+    VALUE obj, idx;
+{
+    integer i_idx;
+    integer o_ipara;
+    VALUE ipara;
+
+    if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
+      idx = rb_funcall(idx, rb_intern("to_i"), 0);
+    }
+
+    i_idx = NUM2INT(idx);
+
+
+    tmiqvl__(&i_idx, &o_ipara);
+
+    ipara = INT2NUM(o_ipara);
+
+
+    return ipara;
+
+}
+
+static VALUE
+dcl_tmisvl(obj, idx, ipara)
+    VALUE obj, idx, ipara;
+{
+    integer i_idx;
+    integer i_ipara;
+
+    if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
+      idx = rb_funcall(idx, rb_intern("to_i"), 0);
+    }
+    if ((TYPE(ipara) != T_BIGNUM) || (TYPE(ipara) != T_FIXNUM)) {
+      ipara = rb_funcall(ipara, rb_intern("to_i"), 0);
+    }
+
+    i_idx = NUM2INT(idx);
+    i_ipara = NUM2INT(ipara);
+
+
+    tmisvl__(&i_idx, &i_ipara);
+
+    return Qnil;
+
+}
+
+static VALUE
+dcl_tmiqin(obj, cp)
+    VALUE obj, cp;
+{
+    char *i_cp;
+    integer o_in;
+    VALUE in;
+
+    if (TYPE(cp) != T_STRING) {
+      cp = rb_funcall(cp, rb_intern("to_str"), 0);
+    }
+
+    i_cp = StringValuePtr(cp);
+
+
+    tmiqin__(i_cp, &o_in, (ftnlen)strlen(i_cp));
+
+    in = INT2NUM(o_in);
+
+
+    return in;
+
+}
+
+static VALUE
+dcl_tmlget(obj, cp)
+    VALUE obj, cp;
+{
+    char *i_cp;
+    logical o_lpara;
+    VALUE lpara;
+
+    if (TYPE(cp) != T_STRING) {
+      cp = rb_funcall(cp, rb_intern("to_str"), 0);
+    }
+
+    i_cp = StringValuePtr(cp);
+
+
+    tmlget__(i_cp, &o_lpara, (ftnlen)strlen(i_cp));
+
+    lpara = (o_lpara == FALSE_) ? Qfalse : Qtrue;
+
+
+    return lpara;
+
+}
+
+static VALUE
+dcl_tmlset(obj, cp, lpara)
+    VALUE obj, cp, lpara;
+{
+    char *i_cp;
+    logical i_lpara;
+
+    if (TYPE(cp) != T_STRING) {
+      cp = rb_funcall(cp, rb_intern("to_str"), 0);
+    }
+
+    i_cp = StringValuePtr(cp);
+    i_lpara = ((lpara == Qnil)||(lpara == Qfalse)) ? FALSE_ : TRUE_;
+
+
+    tmlset__(i_cp, &i_lpara, (ftnlen)strlen(i_cp));
+
+    return Qnil;
+
+}
+
+static VALUE
+dcl_tmlstx(obj, cp, lpara)
+    VALUE obj, cp, lpara;
+{
+    char *i_cp;
+    logical i_lpara;
+
+    if (TYPE(cp) != T_STRING) {
+      cp = rb_funcall(cp, rb_intern("to_str"), 0);
+    }
+
+    i_cp = StringValuePtr(cp);
+    i_lpara = ((lpara == Qnil)||(lpara == Qfalse)) ? FALSE_ : TRUE_;
+
+
+    tmlstx__(i_cp, &i_lpara, (ftnlen)strlen(i_cp));
+
+    return Qnil;
+
+}
+
+static VALUE
+dcl_tmlqnp(obj)
+    VALUE obj;
+{
+    integer o_ncp;
+    VALUE ncp;
+
+    tmlqnp__(&o_ncp);
+
+    ncp = INT2NUM(o_ncp);
+
+
+    return ncp;
+
+}
+
+static VALUE
+dcl_tmlqid(obj, cp)
+    VALUE obj, cp;
+{
+    char *i_cp;
+    integer o_idx;
+    VALUE idx;
+
+    if (TYPE(cp) != T_STRING) {
+      cp = rb_funcall(cp, rb_intern("to_str"), 0);
+    }
+
+    i_cp = StringValuePtr(cp);
+
+
+    tmlqid__(i_cp, &o_idx, (ftnlen)strlen(i_cp));
+
+    idx = INT2NUM(o_idx);
+
+
+    return idx;
+
+}
+
+static VALUE
+dcl_tmlqcp(obj, idx)
+    VALUE obj, idx;
+{
+    integer i_idx;
+    char *o_cp;
+    VALUE cp;
+
+    if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
+      idx = rb_funcall(idx, rb_intern("to_i"), 0);
+    }
+
+    i_idx = NUM2INT(idx);
+
+    o_cp= ALLOCA_N(char, (DFLT_SIZE+1));
+    memset(o_cp, '\0', DFLT_SIZE+1);
+
+    tmlqcp__(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
+
+    cp = rb_str_new2(o_cp);
+
+
+    return cp;
+
+}
+
+static VALUE
+dcl_tmlqcl(obj, idx)
+    VALUE obj, idx;
+{
+    integer i_idx;
+    char *o_cp;
+    VALUE cp;
+
+    if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
+      idx = rb_funcall(idx, rb_intern("to_i"), 0);
+    }
+
+    i_idx = NUM2INT(idx);
+
+    o_cp= ALLOCA_N(char, (DFLT_SIZE+1));
+    memset(o_cp, '\0', DFLT_SIZE+1);
+
+    tmlqcl__(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
+
+    cp = rb_str_new2(o_cp);
+
+
+    return cp;
+
+}
+
+static VALUE
+dcl_tmlqvl(obj, idx)
+    VALUE obj, idx;
+{
+    integer i_idx;
+    logical o_lpara;
+    VALUE lpara;
+
+    if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
+      idx = rb_funcall(idx, rb_intern("to_i"), 0);
+    }
+
+    i_idx = NUM2INT(idx);
+
+
+    tmlqvl__(&i_idx, &o_lpara);
+
+    lpara = (o_lpara == FALSE_) ? Qfalse : Qtrue;
+
+
+    return lpara;
+
+}
+
+static VALUE
+dcl_tmlsvl(obj, idx, lpara)
+    VALUE obj, idx, lpara;
+{
+    integer i_idx;
+    logical i_lpara;
+
+    if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
+      idx = rb_funcall(idx, rb_intern("to_i"), 0);
+    }
+
+    i_idx = NUM2INT(idx);
+    i_lpara = ((lpara == Qnil)||(lpara == Qfalse)) ? FALSE_ : TRUE_;
+
+
+    tmlsvl__(&i_idx, &i_lpara);
+
+    return Qnil;
+
+}
+
+static VALUE
+dcl_tmlqin(obj, cp)
+    VALUE obj, cp;
+{
+    char *i_cp;
+    integer o_in;
+    VALUE in;
+
+    if (TYPE(cp) != T_STRING) {
+      cp = rb_funcall(cp, rb_intern("to_str"), 0);
+    }
+
+    i_cp = StringValuePtr(cp);
+
+
+    tmlqin__(i_cp, &o_in, (ftnlen)strlen(i_cp));
+
+    in = INT2NUM(o_in);
+
+
+    return in;
+
+}
+
+static VALUE
+dcl_tmpqnp(obj)
+    VALUE obj;
+{
+    integer o_ncp;
+    VALUE ncp;
+
+    tmpqnp__(&o_ncp);
+
+    ncp = INT2NUM(o_ncp);
+
+
+    return ncp;
+
+}
+
+static VALUE
+dcl_tmpqid(obj, cp)
+    VALUE obj, cp;
+{
+    char *i_cp;
+    integer o_idx;
+    VALUE idx;
+
+    if (TYPE(cp) != T_STRING) {
+      cp = rb_funcall(cp, rb_intern("to_str"), 0);
+    }
+
+    i_cp = StringValuePtr(cp);
+
+
+    tmpqid__(i_cp, &o_idx, (ftnlen)strlen(i_cp));
+
+    idx = INT2NUM(o_idx);
+
+
+    return idx;
+
+}
+
+static VALUE
+dcl_tmpqcp(obj, idx)
+    VALUE obj, idx;
+{
+    integer i_idx;
+    char *o_cp;
+    VALUE cp;
+
+    if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
+      idx = rb_funcall(idx, rb_intern("to_i"), 0);
+    }
+
+    i_idx = NUM2INT(idx);
+
+    o_cp= ALLOCA_N(char, (DFLT_SIZE+1));
+    memset(o_cp, '\0', DFLT_SIZE+1);
+
+    tmpqcp__(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
+
+    cp = rb_str_new2(o_cp);
+
+
+    return cp;
+
+}
+
+static VALUE
+dcl_tmpqcl(obj, idx)
+    VALUE obj, idx;
+{
+    integer i_idx;
+    char *o_cp;
+    VALUE cp;
+
+    if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
+      idx = rb_funcall(idx, rb_intern("to_i"), 0);
+    }
+
+    i_idx = NUM2INT(idx);
+
+    o_cp= ALLOCA_N(char, (DFLT_SIZE+1));
+    memset(o_cp, '\0', DFLT_SIZE+1);
+
+    tmpqcl__(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
+
+    cp = rb_str_new2(o_cp);
+
+
+    return cp;
+
+}
+
+static VALUE
+dcl_tmpqit(obj, idx)
+    VALUE obj, idx;
+{
+    integer i_idx;
+    integer o_itp;
+    VALUE itp;
+
+    if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
+      idx = rb_funcall(idx, rb_intern("to_i"), 0);
+    }
+
+    i_idx = NUM2INT(idx);
+
+
+    tmpqit__(&i_idx, &o_itp);
+
+    itp = INT2NUM(o_itp);
+
+
+    return itp;
+
+}
+
+static VALUE
+dcl_tmpqvl(obj, idx)
+    VALUE obj, idx;
+{
+    integer i_idx;
+    integer o_ipara;
+    VALUE ipara;
+
+    if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
+      idx = rb_funcall(idx, rb_intern("to_i"), 0);
+    }
+
+    i_idx = NUM2INT(idx);
+
+
+    tmpqvl__(&i_idx, &o_ipara);
+
+    ipara = INT2NUM(o_ipara);
+
+
+    return ipara;
+
+}
+
+static VALUE
+dcl_tmpsvl(obj, idx, ipara)
+    VALUE obj, idx, ipara;
+{
+    integer i_idx;
+    integer i_ipara;
+
+    if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
+      idx = rb_funcall(idx, rb_intern("to_i"), 0);
+    }
+    if ((TYPE(ipara) != T_BIGNUM) || (TYPE(ipara) != T_FIXNUM)) {
+      ipara = rb_funcall(ipara, rb_intern("to_i"), 0);
+    }
+
+    i_idx = NUM2INT(idx);
+    i_ipara = NUM2INT(ipara);
+
+
+    tmpsvl__(&i_idx, &i_ipara);
+
+    return Qnil;
+
+}
+
+static VALUE
+dcl_tmpqin(obj, cp)
+    VALUE obj, cp;
+{
+    char *i_cp;
+    integer o_in;
+    VALUE in;
+
+    if (TYPE(cp) != T_STRING) {
+      cp = rb_funcall(cp, rb_intern("to_str"), 0);
+    }
+
+    i_cp = StringValuePtr(cp);
+
+
+    tmpqin__(i_cp, &o_in, (ftnlen)strlen(i_cp));
+
+    in = INT2NUM(o_in);
+
+
+    return in;
+
+}
+
+static VALUE
+dcl_tmrget(obj, cp)
+    VALUE obj, cp;
+{
+    char *i_cp;
+    real o_rpara;
+    VALUE rpara;
+
+    if (TYPE(cp) != T_STRING) {
+      cp = rb_funcall(cp, rb_intern("to_str"), 0);
+    }
+
+    i_cp = StringValuePtr(cp);
+
+
+    tmrget__(i_cp, &o_rpara, (ftnlen)strlen(i_cp));
+
+    rpara = rb_float_new((double)o_rpara);
+
+
+    return rpara;
+
+}
+
+static VALUE
+dcl_tmrset(obj, cp, rpara)
+    VALUE obj, cp, rpara;
+{
+    char *i_cp;
+    real i_rpara;
+
+    if (TYPE(cp) != T_STRING) {
+      cp = rb_funcall(cp, rb_intern("to_str"), 0);
+    }
+    if (TYPE(rpara) != T_FLOAT) {
+      rpara = rb_funcall(rpara, rb_intern("to_f"), 0);
+    }
+
+    i_cp = StringValuePtr(cp);
+    i_rpara = (real)NUM2DBL(rpara);
+
+
+    tmrset__(i_cp, &i_rpara, (ftnlen)strlen(i_cp));
+
+    return Qnil;
+
+}
+
+static VALUE
+dcl_tmrstx(obj, cp, rpara)
+    VALUE obj, cp, rpara;
+{
+    char *i_cp;
+    real i_rpara;
+
+    if (TYPE(cp) != T_STRING) {
+      cp = rb_funcall(cp, rb_intern("to_str"), 0);
+    }
+    if (TYPE(rpara) != T_FLOAT) {
+      rpara = rb_funcall(rpara, rb_intern("to_f"), 0);
+    }
+
+    i_cp = StringValuePtr(cp);
+    i_rpara = (real)NUM2DBL(rpara);
+
+
+    tmrstx__(i_cp, &i_rpara, (ftnlen)strlen(i_cp));
+
+    return Qnil;
+
+}
+
+static VALUE
+dcl_tmrqnp(obj)
+    VALUE obj;
+{
+    integer o_ncp;
+    VALUE ncp;
+
+    tmrqnp__(&o_ncp);
+
+    ncp = INT2NUM(o_ncp);
+
+
+    return ncp;
+
+}
+
+static VALUE
+dcl_tmrqid(obj, cp)
+    VALUE obj, cp;
+{
+    char *i_cp;
+    integer o_idx;
+    VALUE idx;
+
+    if (TYPE(cp) != T_STRING) {
+      cp = rb_funcall(cp, rb_intern("to_str"), 0);
+    }
+
+    i_cp = StringValuePtr(cp);
+
+
+    tmrqid__(i_cp, &o_idx, (ftnlen)strlen(i_cp));
+
+    idx = INT2NUM(o_idx);
+
+
+    return idx;
+
+}
+
+static VALUE
+dcl_tmrqcp(obj, idx)
+    VALUE obj, idx;
+{
+    integer i_idx;
+    char *o_cp;
+    VALUE cp;
+
+    if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
+      idx = rb_funcall(idx, rb_intern("to_i"), 0);
+    }
+
+    i_idx = NUM2INT(idx);
+
+    o_cp= ALLOCA_N(char, (DFLT_SIZE+1));
+    memset(o_cp, '\0', DFLT_SIZE+1);
+
+    tmrqcp__(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
+
+    cp = rb_str_new2(o_cp);
+
+
+    return cp;
+
+}
+
+static VALUE
+dcl_tmrqcl(obj, idx)
+    VALUE obj, idx;
+{
+    integer i_idx;
+    char *o_cp;
+    VALUE cp;
+
+    if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
+      idx = rb_funcall(idx, rb_intern("to_i"), 0);
+    }
+
+    i_idx = NUM2INT(idx);
+
+    o_cp= ALLOCA_N(char, (DFLT_SIZE+1));
+    memset(o_cp, '\0', DFLT_SIZE+1);
+
+    tmrqcl__(&i_idx, o_cp, (ftnlen)DFLT_SIZE);
+
+    cp = rb_str_new2(o_cp);
+
+
+    return cp;
+
+}
+
+static VALUE
+dcl_tmrqvl(obj, idx)
+    VALUE obj, idx;
+{
+    integer i_idx;
+    real o_rpara;
+    VALUE rpara;
+
+    if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
+      idx = rb_funcall(idx, rb_intern("to_i"), 0);
+    }
+
+    i_idx = NUM2INT(idx);
+
+
+    tmrqvl__(&i_idx, &o_rpara);
+
+    rpara = rb_float_new((double)o_rpara);
+
+
+    return rpara;
+
+}
+
+static VALUE
+dcl_tmrsvl(obj, idx, rpara)
+    VALUE obj, idx, rpara;
+{
+    integer i_idx;
+    real i_rpara;
+
+    if ((TYPE(idx) != T_BIGNUM) || (TYPE(idx) != T_FIXNUM)) {
+      idx = rb_funcall(idx, rb_intern("to_i"), 0);
+    }
+    if (TYPE(rpara) != T_FLOAT) {
+      rpara = rb_funcall(rpara, rb_intern("to_f"), 0);
+    }
+
+    i_idx = NUM2INT(idx);
+    i_rpara = (real)NUM2DBL(rpara);
+
+
+    tmrsvl__(&i_idx, &i_rpara);
+
+    return Qnil;
+
+}
+
+static VALUE
+dcl_tmrqin(obj, cp)
+    VALUE obj, cp;
+{
+    char *i_cp;
+    integer o_in;
+    VALUE in;
+
+    if (TYPE(cp) != T_STRING) {
+      cp = rb_funcall(cp, rb_intern("to_str"), 0);
+    }
+
+    i_cp = StringValuePtr(cp);
+
+
+    tmrqin__(i_cp, &o_in, (ftnlen)strlen(i_cp));
+
+    in = INT2NUM(o_in);
+
+
+    return in;
+
+}
+
+static VALUE
+dcl_tmstla(obj, r, t, u, v, nx, ny)
+    VALUE obj, r, t, u, v, nx, ny;
+{
+    real *i_r;
+    real *i_t;
+    real *i_u;
+    real *i_v;
+    integer i_nx;
+    integer i_ny;
+
+    if (TYPE(r) == T_FLOAT) {
+      r = rb_Array(r);
+    }
+    /* if ((TYPE(r) != T_ARRAY) && 
+           (rb_obj_is_kind_of(r, cNArray) != Qtrue)) {
+         rb_raise(rb_eTypeError, "invalid type");
+       }  -- no check since obj2c*ary will do that */
+    if (TYPE(t) == T_FLOAT) {
+      t = rb_Array(t);
+    }
+    /* if ((TYPE(t) != T_ARRAY) && 
+           (rb_obj_is_kind_of(t, cNArray) != Qtrue)) {
+         rb_raise(rb_eTypeError, "invalid type");
+       }  -- no check since obj2c*ary will do that */
+    if (TYPE(u) == T_FLOAT) {
+      u = rb_Array(u);
+    }
+    /* if ((TYPE(u) != T_ARRAY) && 
+           (rb_obj_is_kind_of(u, cNArray) != Qtrue)) {
+         rb_raise(rb_eTypeError, "invalid type");
+       }  -- no check since obj2c*ary will do that */
+    if (TYPE(v) == T_FLOAT) {
+      v = rb_Array(v);
+    }
+    /* if ((TYPE(v) != T_ARRAY) && 
+           (rb_obj_is_kind_of(v, cNArray) != Qtrue)) {
+         rb_raise(rb_eTypeError, "invalid type");
+       }  -- no check since obj2c*ary will do that */
+    if ((TYPE(nx) != T_BIGNUM) || (TYPE(nx) != T_FIXNUM)) {
+      nx = rb_funcall(nx, rb_intern("to_i"), 0);
+    }
+    if ((TYPE(ny) != T_BIGNUM) || (TYPE(ny) != T_FIXNUM)) {
+      ny = rb_funcall(ny, rb_intern("to_i"), 0);
+    }
+
+    i_nx = NUM2INT(nx);
+    i_ny = NUM2INT(ny);
+    i_r = dcl_obj2crealary(r);
+    i_t = dcl_obj2crealary(t);
+    i_u = dcl_obj2crealary(u);
+    i_v = dcl_obj2crealary(v);
+
+
+    tmstla__(i_r, i_t, i_u, i_v, &i_nx, &i_ny);
+
+    dcl_freecrealary(i_r);
+    dcl_freecrealary(i_t);
+    dcl_freecrealary(i_u);
+    dcl_freecrealary(i_v);
+
+    return Qnil;
+
+}
+
+static VALUE
+dcl_tmstlc(obj, x, y, u, v, nx, ny)
+    VALUE obj, x, y, u, v, nx, ny;
+{
+    real *i_x;
+    real *i_y;
+    real *i_u;
+    real *i_v;
+    integer i_nx;
+    integer i_ny;
+
+    if (TYPE(x) == T_FLOAT) {
+      x = rb_Array(x);
+    }
+    /* if ((TYPE(x) != T_ARRAY) && 
+           (rb_obj_is_kind_of(x, cNArray) != Qtrue)) {
+         rb_raise(rb_eTypeError, "invalid type");
+       }  -- no check since obj2c*ary will do that */
+    if (TYPE(y) == T_FLOAT) {
+      y = rb_Array(y);
+    }
+    /* if ((TYPE(y) != T_ARRAY) && 
+           (rb_obj_is_kind_of(y, cNArray) != Qtrue)) {
+         rb_raise(rb_eTypeError, "invalid type");
+       }  -- no check since obj2c*ary will do that */
+    if (TYPE(u) == T_FLOAT) {
+      u = rb_Array(u);
+    }
+    /* if ((TYPE(u) != T_ARRAY) && 
+           (rb_obj_is_kind_of(u, cNArray) != Qtrue)) {
+         rb_raise(rb_eTypeError, "invalid type");
+       }  -- no check since obj2c*ary will do that */
+    if (TYPE(v) == T_FLOAT) {
+      v = rb_Array(v);
+    }
+    /* if ((TYPE(v) != T_ARRAY) && 
+           (rb_obj_is_kind_of(v, cNArray) != Qtrue)) {
+         rb_raise(rb_eTypeError, "invalid type");
+       }  -- no check since obj2c*ary will do that */
+    if ((TYPE(nx) != T_BIGNUM) || (TYPE(nx) != T_FIXNUM)) {
+      nx = rb_funcall(nx, rb_intern("to_i"), 0);
+    }
+    if ((TYPE(ny) != T_BIGNUM) || (TYPE(ny) != T_FIXNUM)) {
+      ny = rb_funcall(ny, rb_intern("to_i"), 0);
+    }
+
+    i_nx = NUM2INT(nx);
+    i_ny = NUM2INT(ny);
+    i_x = dcl_obj2crealary(x);
+    i_y = dcl_obj2crealary(y);
+    i_u = dcl_obj2crealary(u);
+    i_v = dcl_obj2crealary(v);
+
+
+    tmstlc__(i_x, i_y, i_u, i_v, &i_nx, &i_ny);
+
+    dcl_freecrealary(i_x);
+    dcl_freecrealary(i_y);
+    dcl_freecrealary(i_u);
+    dcl_freecrealary(i_v);
+
+    return Qnil;
+
+}
+
+static VALUE
+dcl_tmstls(obj, l, t, u, v, nx, ny)
+    VALUE obj, l, t, u, v, nx, ny;
+{
+    real *i_l;
+    real *i_t;
+    real *i_u;
+    real *i_v;
+    integer i_nx;
+    integer i_ny;
+
+    if (TYPE(l) == T_FLOAT) {
+      l = rb_Array(l);
+    }
+    /* if ((TYPE(l) != T_ARRAY) && 
+           (rb_obj_is_kind_of(l, cNArray) != Qtrue)) {
+         rb_raise(rb_eTypeError, "invalid type");
+       }  -- no check since obj2c*ary will do that */
+    if (TYPE(t) == T_FLOAT) {
+      t = rb_Array(t);
+    }
+    /* if ((TYPE(t) != T_ARRAY) && 
+           (rb_obj_is_kind_of(t, cNArray) != Qtrue)) {
+         rb_raise(rb_eTypeError, "invalid type");
+       }  -- no check since obj2c*ary will do that */
+    if (TYPE(u) == T_FLOAT) {
+      u = rb_Array(u);
+    }
+    /* if ((TYPE(u) != T_ARRAY) && 
+           (rb_obj_is_kind_of(u, cNArray) != Qtrue)) {
+         rb_raise(rb_eTypeError, "invalid type");
+       }  -- no check since obj2c*ary will do that */
+    if (TYPE(v) == T_FLOAT) {
+      v = rb_Array(v);
+    }
+    /* if ((TYPE(v) != T_ARRAY) && 
+           (rb_obj_is_kind_of(v, cNArray) != Qtrue)) {
+         rb_raise(rb_eTypeError, "invalid type");
+       }  -- no check since obj2c*ary will do that */
+    if ((TYPE(nx) != T_BIGNUM) || (TYPE(nx) != T_FIXNUM)) {
+      nx = rb_funcall(nx, rb_intern("to_i"), 0);
+    }
+    if ((TYPE(ny) != T_BIGNUM) || (TYPE(ny) != T_FIXNUM)) {
+      ny = rb_funcall(ny, rb_intern("to_i"), 0);
+    }
+
+    i_nx = NUM2INT(nx);
+    i_ny = NUM2INT(ny);
+    i_l = dcl_obj2crealary(l);
+    i_t = dcl_obj2crealary(t);
+    i_u = dcl_obj2crealary(u);
+    i_v = dcl_obj2crealary(v);
+
+
+    tmstls__(i_l, i_t, i_u, i_v, &i_nx, &i_ny);
+
+    dcl_freecrealary(i_l);
+    dcl_freecrealary(i_t);
+    dcl_freecrealary(i_u);
+    dcl_freecrealary(i_v);
+
+    return Qnil;
+
+}
+
+#endif
+void
+init_misc2_tmpack(mDCL)
+VALUE mDCL;
+{
+#if DCLVER >= 730
+    rb_define_module_function(mDCL, "tmiget", dcl_tmiget, 1);
+    rb_define_module_function(mDCL, "tmiset", dcl_tmiset, 2);
+    rb_define_module_function(mDCL, "tmistx", dcl_tmistx, 2);
+    rb_define_module_function(mDCL, "tmiqnp", dcl_tmiqnp, 0);
+    rb_define_module_function(mDCL, "tmiqid", dcl_tmiqid, 1);
+    rb_define_module_function(mDCL, "tmiqcp", dcl_tmiqcp, 1);
+    rb_define_module_function(mDCL, "tmiqcl", dcl_tmiqcl, 1);
+    rb_define_module_function(mDCL, "tmiqvl", dcl_tmiqvl, 1);
+    rb_define_module_function(mDCL, "tmisvl", dcl_tmisvl, 2);
+    rb_define_module_function(mDCL, "tmiqin", dcl_tmiqin, 1);
+    rb_define_module_function(mDCL, "tmlget", dcl_tmlget, 1);
+    rb_define_module_function(mDCL, "tmlset", dcl_tmlset, 2);
+    rb_define_module_function(mDCL, "tmlstx", dcl_tmlstx, 2);
+    rb_define_module_function(mDCL, "tmlqnp", dcl_tmlqnp, 0);
+    rb_define_module_function(mDCL, "tmlqid", dcl_tmlqid, 1);
+    rb_define_module_function(mDCL, "tmlqcp", dcl_tmlqcp, 1);
+    rb_define_module_function(mDCL, "tmlqcl", dcl_tmlqcl, 1);
+    rb_define_module_function(mDCL, "tmlqvl", dcl_tmlqvl, 1);
+    rb_define_module_function(mDCL, "tmlsvl", dcl_tmlsvl, 2);
+    rb_define_module_function(mDCL, "tmlqin", dcl_tmlqin, 1);
+    rb_define_module_function(mDCL, "tmpqnp", dcl_tmpqnp, 0);
+    rb_define_module_function(mDCL, "tmpqid", dcl_tmpqid, 1);
+    rb_define_module_function(mDCL, "tmpqcp", dcl_tmpqcp, 1);
+    rb_define_module_function(mDCL, "tmpqcl", dcl_tmpqcl, 1);
+    rb_define_module_function(mDCL, "tmpqit", dcl_tmpqit, 1);
+    rb_define_module_function(mDCL, "tmpqvl", dcl_tmpqvl, 1);
+    rb_define_module_function(mDCL, "tmpsvl", dcl_tmpsvl, 2);
+    rb_define_module_function(mDCL, "tmpqin", dcl_tmpqin, 1);
+    rb_define_module_function(mDCL, "tmrget", dcl_tmrget, 1);
+    rb_define_module_function(mDCL, "tmrset", dcl_tmrset, 2);
+    rb_define_module_function(mDCL, "tmrstx", dcl_tmrstx, 2);
+    rb_define_module_function(mDCL, "tmrqnp", dcl_tmrqnp, 0);
+    rb_define_module_function(mDCL, "tmrqid", dcl_tmrqid, 1);
+    rb_define_module_function(mDCL, "tmrqcp", dcl_tmrqcp, 1);
+    rb_define_module_function(mDCL, "tmrqcl", dcl_tmrqcl, 1);
+    rb_define_module_function(mDCL, "tmrqvl", dcl_tmrqvl, 1);
+    rb_define_module_function(mDCL, "tmrsvl", dcl_tmrsvl, 2);
+    rb_define_module_function(mDCL, "tmrqin", dcl_tmrqin, 1);
+    rb_define_module_function(mDCL, "tmstla", dcl_tmstla, 6);
+    rb_define_module_function(mDCL, "tmstlc", dcl_tmstlc, 6);
+    rb_define_module_function(mDCL, "tmstls", dcl_tmstls, 6);
+#endif
+}