ruby-dcl 1.6.2

data/misc1_fmtlib.c

@@ -0,0 +1,99 @@
+/*
+ * $Id: p_header,v 1.2 2011-02-23 17:47:10 koshiro Exp $
+ */
+
+#include <stdio.h>
+#include "ruby.h"
+#include "libtinyf2c.h"
+#include "narray.h"
+
+/* for compatibility with ruby 1.6 */
+#ifndef StringValuePtr
+#define StringValuePtr(s) STR2CSTR(s)
+#endif
+
+#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 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;
+
+static VALUE
+dcl_chval(obj, cfmt, val)
+    VALUE obj, cfmt, val;
+{
+    char *i_cfmt;
+    real i_val;
+    char *o_cval;
+    VALUE cval;
+
+    if (TYPE(cfmt) != T_STRING) {
+      cfmt = rb_funcall(cfmt, rb_intern("to_str"), 0);
+    }
+    if (TYPE(val) != T_FLOAT) {
+      val = rb_funcall(val, rb_intern("to_f"), 0);
+    }
+
+    i_cfmt = StringValuePtr(cfmt);
+    i_val = (real)NUM2DBL(val);
+
+    o_cval= ALLOCA_N(char, (DFLT_SIZE+1));
+    memset(o_cval, '\0', DFLT_SIZE+1);
+
+    chval_(i_cfmt, &i_val, o_cval, (ftnlen)strlen(i_cfmt), (ftnlen)DFLT_SIZE);
+
+    cval = rb_str_new2(o_cval);
+
+
+    return cval;
+
+}
+void
+init_misc1_fmtlib(mDCL)
+VALUE mDCL;
+{
+    rb_define_module_function(mDCL, "chval", dcl_chval, 2);
+}

data/misc1_misclib.c

@@ -0,0 +1,118 @@
+/*
+ * $Id: p_header,v 1.2 2011-02-23 17:47:10 koshiro Exp $
+ */
+
+#include <stdio.h>
+#include "ruby.h"
+#include "libtinyf2c.h"
+#include "narray.h"
+
+/* for compatibility with ruby 1.6 */
+#ifndef StringValuePtr
+#define StringValuePtr(s) STR2CSTR(s)
+#endif
+
+#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 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;
+
+static VALUE
+dcl_cns(obj, ins)
+    VALUE obj, ins;
+{
+    integer i_ins;
+    char *o_rtn_val;
+    VALUE rtn_val;
+
+    if ((TYPE(ins) != T_BIGNUM) || (TYPE(ins) != T_FIXNUM)) {
+      ins = rb_funcall(ins, rb_intern("to_i"), 0);
+    }
+
+    i_ins = NUM2INT(ins);
+
+    o_rtn_val= ALLOCA_N(char, (2));
+    memset(o_rtn_val, '\0', 2);
+
+    cns_(o_rtn_val, (ftnlen)1, &i_ins);
+
+    rtn_val = rb_str_new2(o_rtn_val);
+
+
+    return rtn_val;
+
+}
+
+static VALUE
+dcl_cdblk(obj, chr)
+    VALUE obj, chr;
+{
+    char *io_chr;
+
+    if (TYPE(chr) != T_STRING) {
+      chr = rb_funcall(chr, rb_intern("to_str"), 0);
+    }
+
+    io_chr = ALLOCA_N(char, strlen(StringValuePtr(chr))+1);
+    strcpy(io_chr, StringValuePtr(chr));
+
+
+    cdblk_(io_chr, (ftnlen)strlen(io_chr));
+
+    chr = rb_str_new2(io_chr);
+
+
+    return chr;
+
+}
+void
+init_misc1_misclib(mDCL)
+VALUE mDCL;
+{
+    rb_define_module_function(mDCL, "cns", dcl_cns, 1);
+    rb_define_module_function(mDCL, "cdblk", dcl_cdblk, 1);
+}

data/misc1_randlib.c

@@ -0,0 +1,142 @@
+/*
+ * $Id: p_header,v 1.2 2011-02-23 17:47:10 koshiro Exp $
+ */
+
+#include <stdio.h>
+#include "ruby.h"
+#include "libtinyf2c.h"
+#include "narray.h"
+
+/* for compatibility with ruby 1.6 */
+#ifndef StringValuePtr
+#define StringValuePtr(s) STR2CSTR(s)
+#endif
+
+#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 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;
+
+static VALUE
+dcl_rngu1(obj, iseed)
+    VALUE obj, iseed;
+{
+    integer io_iseed;
+    real o_rtn_val;
+    VALUE rtn_val;
+
+    if ((TYPE(iseed) != T_BIGNUM) || (TYPE(iseed) != T_FIXNUM)) {
+      iseed = rb_funcall(iseed, rb_intern("to_i"), 0);
+    }
+
+    io_iseed = NUM2INT(iseed);
+
+
+    o_rtn_val = rngu1_(&io_iseed);
+
+    rtn_val = rb_float_new((double)o_rtn_val);
+
+
+    return rtn_val;
+
+}
+
+static VALUE
+dcl_rngu2(obj, iseed)
+    VALUE obj, iseed;
+{
+    integer io_iseed;
+    real o_rtn_val;
+    VALUE rtn_val;
+
+    if ((TYPE(iseed) != T_BIGNUM) || (TYPE(iseed) != T_FIXNUM)) {
+      iseed = rb_funcall(iseed, rb_intern("to_i"), 0);
+    }
+
+    io_iseed = NUM2INT(iseed);
+
+
+    o_rtn_val = rngu2_(&io_iseed);
+
+    rtn_val = rb_float_new((double)o_rtn_val);
+
+
+    return rtn_val;
+
+}
+
+static VALUE
+dcl_rngu3(obj, iseed)
+    VALUE obj, iseed;
+{
+    integer io_iseed;
+    real o_rtn_val;
+    VALUE rtn_val;
+
+    if ((TYPE(iseed) != T_BIGNUM) || (TYPE(iseed) != T_FIXNUM)) {
+      iseed = rb_funcall(iseed, rb_intern("to_i"), 0);
+    }
+
+    io_iseed = NUM2INT(iseed);
+
+
+    o_rtn_val = rngu3_(&io_iseed);
+
+    rtn_val = rb_float_new((double)o_rtn_val);
+
+
+    return rtn_val;
+
+}
+void
+init_misc1_randlib(mDCL)
+VALUE mDCL;
+{
+    rb_define_module_function(mDCL, "rngu1", dcl_rngu1, 1);
+    rb_define_module_function(mDCL, "rngu2", dcl_rngu2, 1);
+    rb_define_module_function(mDCL, "rngu3", dcl_rngu3, 1);
+}

data/misc1_timelib.c

@@ -0,0 +1,380 @@
+/*
+ * $Id: p_header,v 1.2 2011-02-23 17:47:10 koshiro Exp $
+ */
+
+#include <stdio.h>
+#include "ruby.h"
+#include "libtinyf2c.h"
+#include "narray.h"
+
+/* for compatibility with ruby 1.6 */
+#ifndef StringValuePtr
+#define StringValuePtr(s) STR2CSTR(s)
+#endif
+
+#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 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;
+
+static VALUE
+dcl_time12(obj, itime)
+    VALUE obj, itime;
+{
+    integer i_itime;
+    integer o_itt;
+    VALUE itt;
+
+    if ((TYPE(itime) != T_BIGNUM) || (TYPE(itime) != T_FIXNUM)) {
+      itime = rb_funcall(itime, rb_intern("to_i"), 0);
+    }
+
+    i_itime = NUM2INT(itime);
+
+
+    time12_(&i_itime, &o_itt);
+
+    itt = INT2NUM(o_itt);
+
+
+    return itt;
+
+}
+
+static VALUE
+dcl_time13(obj, itime)
+    VALUE obj, itime;
+{
+    integer i_itime;
+    integer o_ih;
+    integer o_im;
+    integer o_is;
+    VALUE ih;
+    VALUE im;
+    VALUE is;
+
+    if ((TYPE(itime) != T_BIGNUM) || (TYPE(itime) != T_FIXNUM)) {
+      itime = rb_funcall(itime, rb_intern("to_i"), 0);
+    }
+
+    i_itime = NUM2INT(itime);
+
+
+    time13_(&i_itime, &o_ih, &o_im, &o_is);
+
+    ih = INT2NUM(o_ih);
+    im = INT2NUM(o_im);
+    is = INT2NUM(o_is);
+
+
+    return rb_ary_new3(3, ih, im, is);
+
+}
+
+static VALUE
+dcl_time21(obj, itt)
+    VALUE obj, itt;
+{
+    integer o_itime;
+    integer i_itt;
+    VALUE itime;
+
+    if ((TYPE(itt) != T_BIGNUM) || (TYPE(itt) != T_FIXNUM)) {
+      itt = rb_funcall(itt, rb_intern("to_i"), 0);
+    }
+
+    i_itt = NUM2INT(itt);
+
+
+    time21_(&o_itime, &i_itt);
+
+    itime = INT2NUM(o_itime);
+
+
+    return itime;
+
+}
+
+static VALUE
+dcl_time23(obj, itt)
+    VALUE obj, itt;
+{
+    integer o_ih;
+    integer o_im;
+    integer o_is;
+    integer i_itt;
+    VALUE ih;
+    VALUE im;
+    VALUE is;
+
+    if ((TYPE(itt) != T_BIGNUM) || (TYPE(itt) != T_FIXNUM)) {
+      itt = rb_funcall(itt, rb_intern("to_i"), 0);
+    }
+
+    i_itt = NUM2INT(itt);
+
+
+    time23_(&o_ih, &o_im, &o_is, &i_itt);
+
+    ih = INT2NUM(o_ih);
+    im = INT2NUM(o_im);
+    is = INT2NUM(o_is);
+
+
+    return rb_ary_new3(3, ih, im, is);
+
+}
+
+static VALUE
+dcl_time31(obj, ih, im, is)
+    VALUE obj, ih, im, is;
+{
+    integer o_itime;
+    integer i_ih;
+    integer i_im;
+    integer i_is;
+    VALUE itime;
+
+    if ((TYPE(ih) != T_BIGNUM) || (TYPE(ih) != T_FIXNUM)) {
+      ih = rb_funcall(ih, 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(is) != T_BIGNUM) || (TYPE(is) != T_FIXNUM)) {
+      is = rb_funcall(is, rb_intern("to_i"), 0);
+    }
+
+    i_ih = NUM2INT(ih);
+    i_im = NUM2INT(im);
+    i_is = NUM2INT(is);
+
+
+    time31_(&o_itime, &i_ih, &i_im, &i_is);
+
+    itime = INT2NUM(o_itime);
+
+
+    return itime;
+
+}
+
+static VALUE
+dcl_time32(obj, ih, im, is)
+    VALUE obj, ih, im, is;
+{
+    integer i_ih;
+    integer i_im;
+    integer i_is;
+    integer o_itt;
+    VALUE itt;
+
+    if ((TYPE(ih) != T_BIGNUM) || (TYPE(ih) != T_FIXNUM)) {
+      ih = rb_funcall(ih, 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(is) != T_BIGNUM) || (TYPE(is) != T_FIXNUM)) {
+      is = rb_funcall(is, rb_intern("to_i"), 0);
+    }
+
+    i_ih = NUM2INT(ih);
+    i_im = NUM2INT(im);
+    i_is = NUM2INT(is);
+
+
+    time32_(&i_ih, &i_im, &i_is, &o_itt);
+
+    itt = INT2NUM(o_itt);
+
+
+    return itt;
+
+}
+
+static VALUE
+dcl_timec1(obj, cform, itime)
+    VALUE obj, cform, itime;
+{
+    char *io_cform;
+    integer i_itime;
+
+    if (TYPE(cform) != T_STRING) {
+      cform = rb_funcall(cform, rb_intern("to_str"), 0);
+    }
+    if ((TYPE(itime) != T_BIGNUM) || (TYPE(itime) != T_FIXNUM)) {
+      itime = rb_funcall(itime, rb_intern("to_i"), 0);
+    }
+
+    io_cform = ALLOCA_N(char, strlen(StringValuePtr(cform))+1);
+    strcpy(io_cform, StringValuePtr(cform));
+    i_itime = NUM2INT(itime);
+
+
+    timec1_(io_cform, &i_itime, (ftnlen)strlen(io_cform));
+
+    cform = rb_str_new2(io_cform);
+
+
+    return cform;
+
+}
+
+static VALUE
+dcl_timec2(obj, cform, itt)
+    VALUE obj, cform, itt;
+{
+    char *io_cform;
+    integer i_itt;
+
+    if (TYPE(cform) != T_STRING) {
+      cform = rb_funcall(cform, rb_intern("to_str"), 0);
+    }
+    if ((TYPE(itt) != T_BIGNUM) || (TYPE(itt) != T_FIXNUM)) {
+      itt = rb_funcall(itt, rb_intern("to_i"), 0);
+    }
+
+    io_cform = ALLOCA_N(char, strlen(StringValuePtr(cform))+1);
+    strcpy(io_cform, StringValuePtr(cform));
+    i_itt = NUM2INT(itt);
+
+
+    timec2_(io_cform, &i_itt, (ftnlen)strlen(io_cform));
+
+    cform = rb_str_new2(io_cform);
+
+
+    return cform;
+
+}
+
+static VALUE
+dcl_timec3(obj, cform, ih, im, is)
+    VALUE obj, cform, ih, im, is;
+{
+    char *io_cform;
+    integer i_ih;
+    integer i_im;
+    integer i_is;
+
+    if (TYPE(cform) != T_STRING) {
+      cform = rb_funcall(cform, rb_intern("to_str"), 0);
+    }
+    if ((TYPE(ih) != T_BIGNUM) || (TYPE(ih) != T_FIXNUM)) {
+      ih = rb_funcall(ih, 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(is) != T_BIGNUM) || (TYPE(is) != T_FIXNUM)) {
+      is = rb_funcall(is, rb_intern("to_i"), 0);
+    }
+
+    io_cform = ALLOCA_N(char, strlen(StringValuePtr(cform))+1);
+    strcpy(io_cform, StringValuePtr(cform));
+    i_ih = NUM2INT(ih);
+    i_im = NUM2INT(im);
+    i_is = NUM2INT(is);
+
+
+    timec3_(io_cform, &i_ih, &i_im, &i_is, (ftnlen)strlen(io_cform));
+
+    cform = rb_str_new2(io_cform);
+
+
+    return cform;
+
+}
+
+static VALUE
+dcl_timeq1(obj)
+    VALUE obj;
+{
+    integer o_itime;
+    VALUE itime;
+
+    timeq1_(&o_itime);
+
+    itime = INT2NUM(o_itime);
+
+
+    return itime;
+
+}
+
+static VALUE
+dcl_timeq2(obj)
+    VALUE obj;
+{
+    integer o_itt;
+    VALUE itt;
+
+    timeq2_(&o_itt);
+
+    itt = INT2NUM(o_itt);
+
+
+    return itt;
+
+}
+void
+init_misc1_timelib(mDCL)
+VALUE mDCL;
+{
+    rb_define_module_function(mDCL, "time12", dcl_time12, 1);
+    rb_define_module_function(mDCL, "time13", dcl_time13, 1);
+    rb_define_module_function(mDCL, "time21", dcl_time21, 1);
+    rb_define_module_function(mDCL, "time23", dcl_time23, 1);
+    rb_define_module_function(mDCL, "time31", dcl_time31, 3);
+    rb_define_module_function(mDCL, "time32", dcl_time32, 3);
+    rb_define_module_function(mDCL, "timec1", dcl_timec1, 2);
+    rb_define_module_function(mDCL, "timec2", dcl_timec2, 2);
+    rb_define_module_function(mDCL, "timec3", dcl_timec3, 4);
+    rb_define_module_function(mDCL, "timeq1", dcl_timeq1, 0);
+    rb_define_module_function(mDCL, "timeq2", dcl_timeq2, 0);
+}