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