static VALUE rb_cqp_data_set_Q(VALUE obj, VALUE mm)
{
gsl_cqp_data *d;
gsl_matrix *m;
Data_Get_Struct(obj, gsl_cqp_data, d);
CHECK_MATRIX(mm);
Data_Get_Struct(mm, gsl_matrix, m);
d->Q = m;
return Qtrue;
}
static VALUE rb_gsl_blas_dsyrk(VALUE obj, VALUE u, VALUE t, VALUE a, VALUE aa,
VALUE b, VALUE cc)
{
gsl_matrix *A = NULL, *C = NULL;
double alpha, beta;
CBLAS_UPLO_t Uplo;
CBLAS_TRANSPOSE_t Trans;
CHECK_FIXNUM(u); CHECK_FIXNUM(t);
Need_Float(a); Need_Float(b);
CHECK_MATRIX(aa); CHECK_MATRIX(cc);
Uplo = FIX2INT(u);
Trans = FIX2INT(t);
alpha = NUM2DBL(a);
beta = NUM2DBL(b);
Data_Get_Struct(aa, gsl_matrix, A);
Data_Get_Struct(cc, gsl_matrix, C);
gsl_blas_dsyrk(Uplo, Trans, alpha, A, beta, C);
return cc;
}
static VALUE rb_gsl_blas_dsyrk2(VALUE obj, VALUE u, VALUE t, VALUE a, VALUE aa,
VALUE b, VALUE cc)
{
gsl_matrix *A = NULL, *C = NULL, *Cnew = NULL;
double alpha, beta;
CBLAS_UPLO_t Uplo;
CBLAS_TRANSPOSE_t Trans;
CHECK_FIXNUM(u); CHECK_FIXNUM(t);
Need_Float(a); Need_Float(b);
CHECK_MATRIX(aa); CHECK_MATRIX(cc);
Uplo = FIX2INT(u);
Trans = FIX2INT(t);
alpha = NUM2DBL(a);
beta = NUM2DBL(b);
Data_Get_Struct(aa, gsl_matrix, A);
Data_Get_Struct(cc, gsl_matrix, C);
Cnew = gsl_matrix_alloc(C->size1, C->size2);
gsl_matrix_memcpy(Cnew, C);
gsl_blas_dsyrk(Uplo, Trans, alpha, A, beta, Cnew);
return Data_Wrap_Struct(cgsl_matrix, 0, gsl_matrix_free, Cnew);
}
static VALUE rb_gsl_blas_dtrsm(VALUE obj, VALUE s, VALUE u, VALUE ta,
VALUE d, VALUE a, VALUE aa, VALUE bb)
{
gsl_matrix *A = NULL, *B = NULL;
double alpha;
CBLAS_SIDE_t Side;
CBLAS_UPLO_t Uplo;
CBLAS_TRANSPOSE_t TransA;
CBLAS_DIAG_t Diag;
CHECK_FIXNUM(s); CHECK_FIXNUM(u); CHECK_FIXNUM(ta); CHECK_FIXNUM(d);
Need_Float(a);
CHECK_MATRIX(aa); CHECK_MATRIX(bb);
Side = FIX2INT(s);
Uplo = FIX2INT(u);
TransA = FIX2INT(ta);
Diag = FIX2INT(d);
alpha = NUM2DBL(a);
Data_Get_Struct(aa, gsl_matrix, A);
Data_Get_Struct(bb, gsl_matrix, B);
gsl_blas_dtrsm(Side, Uplo, TransA, Diag, alpha, A, B);
return bb;
}
static VALUE rb_gsl_linalg_complex_LU_svx(int argc, VALUE *argv, VALUE obj)
{
gsl_matrix_complex *m = NULL, *mtmp = NULL;
gsl_permutation *p = NULL;
gsl_vector_complex *x = NULL;
int flagm = 0, itmp, signum;
switch (TYPE(obj)) {
case T_MODULE:
case T_CLASS:
case T_OBJECT:
CHECK_MATRIX(argv[0]);
Data_Get_Struct(argv[0], gsl_matrix_complex, m);
if (CLASS_OF(argv[0]) != cgsl_matrix_complex_LU) {
flagm = 1;
mtmp = gsl_matrix_complex_alloc(m->size1, m->size2);
gsl_matrix_complex_memcpy(mtmp, m);
} else {
mtmp = m;
}
itmp = 1;
break;
default:
Data_Get_Struct(obj, gsl_matrix_complex, m);
if (CLASS_OF(obj) != cgsl_matrix_complex_LU) {
flagm = 1;
mtmp = gsl_matrix_complex_alloc(m->size1, m->size2);
gsl_matrix_complex_memcpy(mtmp, m);
} else {
mtmp = m;
}
itmp = 0;
}
if (flagm == 1) {
if (itmp != argc-1) rb_raise(rb_eArgError, "Usage: m.LU_solve(b)");
Data_Get_Struct(argv[itmp], gsl_vector_complex, x);
p = gsl_permutation_alloc(x->size);
gsl_linalg_complex_LU_decomp(mtmp, p, &signum);
} else {
Data_Get_Struct(argv[itmp], gsl_permutation, p);
itmp++;
Data_Get_Struct(argv[itmp], gsl_vector_complex, x);
itmp++;
}
gsl_linalg_complex_LU_svx(mtmp, p, x);
if (flagm == 1) {
gsl_matrix_complex_free(mtmp);
gsl_permutation_free(p);
}
return argv[argc-1];
}
static VALUE rb_gsl_blas_dtrsm2(VALUE obj, VALUE s, VALUE u, VALUE ta,
VALUE d, VALUE a, VALUE aa, VALUE bb)
{
gsl_matrix *A = NULL, *B = NULL, *Bnew = NULL;
double alpha;
CBLAS_SIDE_t Side;
CBLAS_UPLO_t Uplo;
CBLAS_TRANSPOSE_t TransA;
CBLAS_DIAG_t Diag;
CHECK_FIXNUM(s); CHECK_FIXNUM(u); CHECK_FIXNUM(ta); CHECK_FIXNUM(d);
Need_Float(a);
CHECK_MATRIX(aa); CHECK_MATRIX(bb);
Side = FIX2INT(s);
Uplo = FIX2INT(u);
TransA = FIX2INT(ta);
Diag = FIX2INT(d);
alpha = NUM2DBL(a);
Data_Get_Struct(aa, gsl_matrix, A);
Data_Get_Struct(bb, gsl_matrix, B);
Bnew = gsl_matrix_alloc(B->size1, B->size2);
gsl_matrix_memcpy(Bnew, B);
gsl_blas_dtrsm(Side, Uplo, TransA, Diag, alpha, A, Bnew);
return Data_Wrap_Struct(cgsl_matrix, 0, gsl_matrix_free, Bnew);
}
static VALUE rb_gsl_multifit_ndlinear_est(int argc, VALUE *argv, VALUE obj)
{
gsl_multifit_ndlinear_workspace *w;
gsl_vector *x = NULL, *c = NULL;
gsl_matrix *cov = NULL;
double y, yerr;
int argc2;
switch (TYPE(obj)) {
case T_MODULE:
case T_CLASS:
case T_OBJECT:
if (!rb_obj_is_kind_of(argv[argc-1], cWorkspace)) {
rb_raise(rb_eTypeError, "Wrong argument type %s (GSL::MultiFit::Ndlinear::Workspace expected)",
rb_class2name(CLASS_OF(argv[argc-1])));
}
Data_Get_Struct(argv[argc-1], gsl_multifit_ndlinear_workspace, w);
argc2 = argc-1;
break;
default:
Data_Get_Struct(obj, gsl_multifit_ndlinear_workspace, w);
argc2 = argc;
}
switch (argc2) {
case 3:
CHECK_VECTOR(argv[0]);
CHECK_VECTOR(argv[1]);
CHECK_MATRIX(argv[2]);
Data_Get_Struct(argv[0], gsl_vector, x);
Data_Get_Struct(argv[1], gsl_vector, c);
Data_Get_Struct(argv[2], gsl_matrix, cov);
break;
default:
rb_raise(rb_eArgError, "Wrong number of arguments.");
}
gsl_multifit_ndlinear_est(x, c, cov, &y, &yerr, w);
return rb_ary_new3(2, rb_float_new(y), rb_float_new(yerr));
}
static VALUE rb_gsl_linalg_complex_LU_solve(int argc, VALUE *argv, VALUE obj)
{
gsl_matrix_complex *m = NULL, *mtmp = NULL;
gsl_permutation *p = NULL;
gsl_vector_complex *b = NULL, *x = NULL;
int flagm = 0, flagx = 0, itmp, signum;
switch (TYPE(obj)) {
case T_MODULE:
case T_CLASS:
case T_OBJECT:
if (argc < 2 || argc > 4)
rb_raise(rb_eArgError, "Usage: solve(m, b), solve(m, b, x), solve(lu, p, b), solve(lu, p, b, x)");
CHECK_MATRIX(argv[0]);
Data_Get_Struct(argv[0], gsl_matrix_complex, m);
if (CLASS_OF(argv[0]) != cgsl_matrix_complex_LU) {
flagm = 1;
mtmp = gsl_matrix_complex_alloc(m->size1, m->size2);
gsl_matrix_complex_memcpy(mtmp, m);
} else {
mtmp = m;
}
itmp = 1;
break;
default:
if (argc < 1 || argc > 3)
rb_raise(rb_eArgError, "Usage: LU_solve(b), LU_solve(p, b), LU_solve(b, x), solve(p, b, x)");
Data_Get_Struct(obj, gsl_matrix_complex, m);
if (CLASS_OF(obj) != cgsl_matrix_complex_LU) {
flagm = 1;
mtmp = gsl_matrix_complex_alloc(m->size1, m->size2);
gsl_matrix_complex_memcpy(mtmp, m);
} else {
mtmp = m;
}
itmp = 0;
}
if (flagm == 1) {
if (itmp != argc-1) rb_raise(rb_eArgError, "Usage: m.LU_solve(b)");
Data_Get_Struct(argv[itmp], gsl_vector_complex, b);
x = gsl_vector_complex_alloc(b->size);
p = gsl_permutation_alloc(b->size);
gsl_linalg_complex_LU_decomp(mtmp, p, &signum);
} else {
Data_Get_Struct(argv[itmp], gsl_permutation, p);
itmp++;
Data_Get_Struct(argv[itmp], gsl_vector_complex, b);
itmp++;
if (itmp == argc-1) {
Data_Get_Struct(argv[itmp], gsl_vector_complex, x);
flagx = 1;
} else {
x = gsl_vector_complex_alloc(m->size1);
}
}
gsl_linalg_complex_LU_solve(mtmp, p, b, x);
if (flagm == 1) {
gsl_matrix_complex_free(mtmp);
gsl_permutation_free(p);
}
if (flagx == 0) return Data_Wrap_Struct(cgsl_vector_complex, 0, gsl_vector_complex_free, x);
else return argv[argc-1];
}
static void
do_direct_scrolling (struct frame *frame, struct glyph_matrix *current_matrix,
struct matrix_elt *cost_matrix, int window_size,
int unchanged_at_top)
{
struct matrix_elt *p;
int i, j;
USE_SAFE_ALLOCA;
/* A queue of deletions and insertions to be performed. */
struct alt_queue { int count, pos, window; };
struct alt_queue *queue_start;
SAFE_NALLOCA (queue_start, 1, window_size);
struct alt_queue *queue = queue_start;
/* True if a terminal window has been set with set_terminal_window. */
bool terminal_window_p = 0;
/* If true, a write has been selected, allowing either an insert or a
delete to be selected next. If false, a delete cannot be selected
unless j < i, and an insert cannot be selected unless i < j.
This corresponds to a similar restriction (with the ordering
reversed) in calculate_direct_scrolling, which is intended to
ensure that lines marked as inserted will be blank. */
bool write_follows_p = 1;
/* For each row in the new matrix what row of the old matrix it is. */
int *copy_from;
SAFE_NALLOCA (copy_from, 1, window_size);
/* Non-zero for each row in the new matrix that is retained from the
old matrix. Lines not retained are empty. */
char *retained_p = SAFE_ALLOCA (window_size);
memset (retained_p, 0, window_size * sizeof (char));
/* Perform some sanity checks when GLYPH_DEBUG is on. */
CHECK_MATRIX (current_matrix);
/* We are working on the line range UNCHANGED_AT_TOP ...
UNCHANGED_AT_TOP + WINDOW_SIZE (not including) in CURRENT_MATRIX.
We step through lines in this range from the end to the start. I
is an index into new lines, j an index into old lines. The cost
matrix determines what to do for ranges of indices.
If i is decremented without also decrementing j, this corresponds
to inserting empty lines in the result. If j is decremented
without also decrementing i, this corresponds to omitting these
lines in the new rows, i.e. rows are deleted. */
i = j = window_size;
while (i > 0 || j > 0)
{
p = cost_matrix + i * (window_size + 1) + j;
if (p->insertcost < p->writecost
&& p->insertcost < p->deletecost
&& (write_follows_p || i < j))
{
/* Insert is cheaper than deleting or writing lines. Leave
a hole in the result display that will be filled with
empty lines when the queue is emptied. */
queue->count = 0;
queue->window = i;
queue->pos = i - p->insertcount;
++queue;
i -= p->insertcount;
write_follows_p = 0;
}
else if (p->deletecost < p->writecost
&& (write_follows_p || i > j))
{
/* Deleting lines is cheaper. By decrementing J, omit
deletecount lines from the original. */
write_follows_p = 0;
j -= p->deletecount;
}
else
{
/* One or more lines should be written. In the direct
scrolling method we do this by scrolling the lines to the
place they belong. */
int n_to_write = p->writecount;
write_follows_p = 1;
eassert (n_to_write > 0);
if (i > j)
{
/* Immediately insert lines */
set_terminal_window (frame, i + unchanged_at_top);
terminal_window_p = 1;
ins_del_lines (frame, j - n_to_write + unchanged_at_top, i - j);
}
else if (i < j)
{
/* Queue the deletion of a group of lines */
queue->pos = i - n_to_write + unchanged_at_top;
queue->window = j + unchanged_at_top;
queue->count = i - j;
++queue;
}
while (n_to_write > 0)
{
--i, --j, --n_to_write;
copy_from[i] = j;
retained_p[j] = 1;
}
}
}
/* Do queued operations. */
if (queue > queue_start)
{
int next = -1;
do
{
--queue;
if (queue->count)
{
set_terminal_window (frame, queue->window);
terminal_window_p = 1;
ins_del_lines (frame, queue->pos, queue->count);
}
else
{
for (j = queue->window - 1; j >= queue->pos; --j)
{
while (retained_p[++next])
;
copy_from[j] = next;
}
}
}
while (queue > queue_start);
}
/* Now, for each row I in the range of rows we are working on,
copy_from[i] gives the original line to copy to I, and
retained_p[copy_from[i]] is zero if line I in the new display is
empty. */
mirrored_line_dance (current_matrix, unchanged_at_top, window_size,
copy_from, retained_p);
if (terminal_window_p)
set_terminal_window (frame, 0);
SAFE_FREE ();
}
static void
do_scrolling (struct frame *frame, struct glyph_matrix *current_matrix,
struct matrix_elt *matrix, int window_size,
int unchanged_at_top)
{
struct matrix_elt *p;
int i, j, k;
USE_SAFE_ALLOCA;
/* True if we have set a terminal window with set_terminal_window. */
bool terminal_window_p = 0;
/* A queue for line insertions to be done. */
struct queue { int count, pos; };
struct queue *queue_start;
SAFE_NALLOCA (queue_start, 1, current_matrix->nrows);
struct queue *queue = queue_start;
char *retained_p = SAFE_ALLOCA (window_size);
int *copy_from;
SAFE_NALLOCA (copy_from, 1, window_size);
/* Zero means line is empty. */
memset (retained_p, 0, window_size * sizeof (char));
for (k = 0; k < window_size; ++k)
copy_from[k] = -1;
#ifdef GLYPH_DEBUG
# define CHECK_BOUNDS \
do \
{ \
int ck; \
for (ck = 0; ck < window_size; ++ck) \
eassert (copy_from[ck] == -1 \
|| (copy_from[ck] >= 0 && copy_from[ck] < window_size)); \
} \
while (0);
#endif
/* When j is advanced, this corresponds to deleted lines.
When i is advanced, this corresponds to inserted lines. */
i = j = window_size;
while (i > 0 || j > 0)
{
p = matrix + i * (window_size + 1) + j;
if (p->insertcost < p->writecost && p->insertcost < p->deletecost)
{
/* Insert should be done at vpos i-1, plus maybe some before.
Queue the screen operation to be performed. */
queue->count = p->insertcount;
queue->pos = i + unchanged_at_top - p->insertcount;
++queue;
/* By incrementing I, we leave room in the result rows
for the empty rows opened up. */
i -= p->insertcount;
}
else if (p->deletecost < p->writecost)
{
/* Old line at vpos j-1, and maybe some before it, should be
deleted. By decrementing J, we skip some lines in the
temp_rows which is equivalent to omitting these lines in
the result rows, thus deleting them. */
j -= p->deletecount;
/* Set the terminal window, if not done already. */
if (! terminal_window_p)
{
set_terminal_window (frame, window_size + unchanged_at_top);
terminal_window_p = 1;
}
/* Delete lines on the terminal. */
ins_del_lines (frame, j + unchanged_at_top, - p->deletecount);
}
else
{
/* Best thing done here is no insert or delete, i.e. a write. */
--i, --j;
eassert (i >= 0 && i < window_size);
eassert (j >= 0 && j < window_size);
copy_from[i] = j;
retained_p[j] = 1;
#ifdef GLYPH_DEBUG
CHECK_BOUNDS;
#endif
}
}
/* Now do all insertions queued above. */
if (queue > queue_start)
{
int next = -1;
/* Set the terminal window if not yet done. */
if (!terminal_window_p)
{
set_terminal_window (frame, window_size + unchanged_at_top);
terminal_window_p = 1;
}
do
{
--queue;
/* Do the deletion on the terminal. */
ins_del_lines (frame, queue->pos, queue->count);
/* All lines in the range deleted become empty in the glyph
matrix. Assign to them glyph rows that are not retained.
K is the starting position of the deleted range relative
to the window we are working in. */
k = queue->pos - unchanged_at_top;
for (j = 0; j < queue->count; ++j)
{
/* Find the next row not retained. */
while (retained_p[++next])
;
/* Record that this row is to be used for the empty
glyph row j. */
copy_from[k + j] = next;
}
}
while (queue > queue_start);
}
for (k = 0; k < window_size; ++k)
eassert (copy_from[k] >= 0 && copy_from[k] < window_size);
/* Perform the row swizzling. */
mirrored_line_dance (current_matrix, unchanged_at_top, window_size,
copy_from, retained_p);
/* Some sanity checks if GLYPH_DEBUG is defined. */
CHECK_MATRIX (current_matrix);
if (terminal_window_p)
set_terminal_window (frame, 0);
SAFE_FREE ();
}
static VALUE rb_gsl_math_eval2(double (*func)(const double, const double), VALUE xx,
VALUE yy)
{
VALUE x, y, ary;
size_t i, j, size;
gsl_vector *v = NULL, *v2 = NULL, *vnew = NULL;
gsl_matrix *m = NULL, *m2 = NULL, *mnew = NULL;
if (CLASS_OF(xx) == rb_cRange) xx = rb_gsl_range2ary(xx);
switch (TYPE(xx)) {
case T_FIXNUM:
case T_BIGNUM:
case T_FLOAT:
Need_Float(yy);
return rb_float_new((*func)(NUM2DBL(xx), NUM2DBL(yy)));
break;
case T_ARRAY:
Check_Type(yy, T_ARRAY);
size = RARRAY_LEN(xx);
// if (size != RARRAY(yy)->len) rb_raise(rb_eRuntimeError, "array sizes are different.");
if ((int) size != RARRAY_LEN(yy)) rb_raise(rb_eRuntimeError, "array sizes are different.");
ary = rb_ary_new2(size);
for (i = 0; i < size; i++) {
x = rb_ary_entry(xx, i);
y = rb_ary_entry(yy, i);
Need_Float(x); Need_Float(y);
// rb_ary_store(ary, i, rb_float_new((*func)(RFLOAT(x)->value, RFLOAT(y)->value)));
rb_ary_store(ary, i, rb_float_new((*func)(NUM2DBL(x), NUM2DBL(y))));
}
return ary;
break;
default:
#ifdef HAVE_NARRAY_H
if (NA_IsNArray(xx)) {
struct NARRAY *nax, *nay;
double *ptr1, *ptr2, *ptr3;
GetNArray(xx, nax);
GetNArray(yy, nay);
ptr1 = (double*) nax->ptr;
ptr2 = (double*) nay->ptr;
size = nax->total;
ary = na_make_object(NA_DFLOAT, nax->rank, nax->shape, CLASS_OF(xx));
ptr3 = NA_PTR_TYPE(ary, double*);
for (i = 0; i < size; i++) ptr3[i] = (*func)(ptr1[i], ptr2[i]);
return ary;
}
#endif
if (VECTOR_P(xx)) {
CHECK_VECTOR(yy);
Data_Get_Struct(xx, gsl_vector, v);
Data_Get_Struct(yy, gsl_vector, v2);
vnew = gsl_vector_alloc(v->size);
for (i = 0; i < v->size; i++) {
gsl_vector_set(vnew, i, (*func)(gsl_vector_get(v, i), gsl_vector_get(v2, i)));
}
return Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, vnew);
} else if (MATRIX_P(xx)) {
CHECK_MATRIX(yy);
Data_Get_Struct(xx, gsl_matrix, m);
Data_Get_Struct(yy, gsl_matrix, m2);
mnew = gsl_matrix_alloc(m->size1, m->size2);
for (i = 0; i < m->size1; i++) {
for (j = 0; j < m->size2; j++) {
gsl_matrix_set(mnew, i, j, (*func)(gsl_matrix_get(m, i, j), gsl_matrix_get(m2, i, j)));
}
}
return Data_Wrap_Struct(cgsl_matrix, 0, gsl_matrix_free, mnew);
} else {
rb_raise(rb_eTypeError,
"wrong argument type %s "
"(Array or Vector or Matrix expected)", rb_class2name(CLASS_OF(xx)));
}
break;
}
/* never reach here */
return Qnil;
}
static VALUE rb_gsl_blas_dsymm(int argc, VALUE *argv, VALUE obj)
{
gsl_matrix *A = NULL, *B = NULL, *C = NULL;
double alpha, beta;
CBLAS_SIDE_t Side;
CBLAS_UPLO_t Uplo;
int flag = 0;
switch (argc) {
case 2:
CHECK_MATRIX(argv[0]);
CHECK_MATRIX(argv[1]);
Data_Get_Struct(argv[0], gsl_matrix, A);
Data_Get_Struct(argv[1], gsl_matrix, B);
C = gsl_matrix_calloc(A->size1, B->size2);
alpha = 1.0;
beta = 0.0;
Side = CblasLeft; Uplo = CblasUpper;
flag = 1;
break;
case 5:
CHECK_FIXNUM(argv[0]);
CHECK_FIXNUM(argv[1]);
Need_Float(argv[2]);
CHECK_MATRIX(argv[3]);
CHECK_MATRIX(argv[4]);
Side = FIX2INT(argv[0]);
Uplo = FIX2INT(argv[1]);
alpha = NUM2DBL(argv[2]);
Data_Get_Struct(argv[3], gsl_matrix, A);
Data_Get_Struct(argv[4], gsl_matrix, B);
C = gsl_matrix_calloc(A->size1, B->size2);
beta = 0.0;
flag = 1;
break;
case 6:
CHECK_FIXNUM(argv[0]);
CHECK_FIXNUM(argv[1]);
Need_Float(argv[2]);
CHECK_MATRIX(argv[3]);
CHECK_MATRIX(argv[4]);
Need_Float(argv[5]);
CHECK_MATRIX(argv[6]);
Side = FIX2INT(argv[0]);
Uplo = FIX2INT(argv[1]);
alpha = NUM2DBL(argv[2]);
Data_Get_Struct(argv[3], gsl_matrix, A);
Data_Get_Struct(argv[4], gsl_matrix, B);
beta = NUM2DBL(argv[5]);
C = gsl_matrix_calloc(A->size1, B->size2);
flag = 1;
break;
case 7:
CHECK_FIXNUM(argv[0]);
CHECK_FIXNUM(argv[1]);
Need_Float(argv[2]);
CHECK_MATRIX(argv[3]);
CHECK_MATRIX(argv[4]);
Need_Float(argv[5]);
CHECK_MATRIX(argv[6]);
Side = FIX2INT(argv[0]);
Uplo = FIX2INT(argv[1]);
alpha = NUM2DBL(argv[2]);
Data_Get_Struct(argv[3], gsl_matrix, A);
Data_Get_Struct(argv[4], gsl_matrix, B);
beta = NUM2DBL(argv[5]);
Data_Get_Struct(argv[6], gsl_matrix, C);
break;
default:
rb_raise(rb_eArgError, "wrong number of arguments (%d for 2 or 7)", argc);
break;
}
gsl_blas_dsymm(Side, Uplo, alpha, A, B, beta, C);
if (flag == 1) return Data_Wrap_Struct(cgsl_matrix, 0, gsl_matrix_free, C);
else return argv[6];
}
static VALUE rb_gsl_blas_dgemm(int argc, VALUE *argv, VALUE obj)
{
gsl_matrix *A = NULL, *B = NULL, *C = NULL;
double alpha, beta;
CBLAS_TRANSPOSE_t TransA, TransB;
int flag = 0;
switch (argc) {
case 2:
CHECK_MATRIX(argv[0]);
CHECK_MATRIX(argv[1]);
Data_Get_Struct(argv[0], gsl_matrix, A);
Data_Get_Struct(argv[1], gsl_matrix, B);
C = gsl_matrix_calloc(A->size1, B->size2);
alpha = 1.0;
beta = 0.0;
TransA = CblasNoTrans; TransB = CblasNoTrans;
flag = 1;
break;
case 5:
CHECK_FIXNUM(argv[0]);
CHECK_FIXNUM(argv[1]);
Need_Float(argv[2]);
CHECK_MATRIX(argv[3]);
CHECK_MATRIX(argv[4]);
TransA = FIX2INT(argv[0]);
TransB = FIX2INT(argv[1]);
alpha = NUM2DBL(argv[2]);
Data_Get_Struct(argv[3], gsl_matrix, A);
Data_Get_Struct(argv[4], gsl_matrix, B);
C = gsl_matrix_calloc(A->size1, B->size2);
beta = 0.0;
flag = 1;
break;
case 6:
CHECK_FIXNUM(argv[0]);
CHECK_FIXNUM(argv[1]);
Need_Float(argv[2]);
CHECK_MATRIX(argv[3]);
CHECK_MATRIX(argv[4]);
Need_Float(argv[5]);
TransA = FIX2INT(argv[0]);
TransB = FIX2INT(argv[1]);
alpha = NUM2DBL(argv[2]);
Data_Get_Struct(argv[3], gsl_matrix, A);
Data_Get_Struct(argv[4], gsl_matrix, B);
beta = NUM2DBL(argv[5]);
C = gsl_matrix_calloc(A->size1, B->size2);
flag = 1;
break;
case 7:
CHECK_FIXNUM(argv[0]);
CHECK_FIXNUM(argv[1]);
Need_Float(argv[2]);
CHECK_MATRIX(argv[3]);
CHECK_MATRIX(argv[4]);
Need_Float(argv[5]);
CHECK_MATRIX(argv[6]);
TransA = FIX2INT(argv[0]);
TransB = FIX2INT(argv[1]);
alpha = NUM2DBL(argv[2]);
Data_Get_Struct(argv[3], gsl_matrix, A);
Data_Get_Struct(argv[4], gsl_matrix, B);
beta = NUM2DBL(argv[5]);
Data_Get_Struct(argv[6], gsl_matrix, C);
break;
default:
rb_raise(rb_eArgError, "wrong number of arguments (%d for 2, 5, 6, or 7)", argc);
break;
}
gsl_blas_dgemm(TransA, TransB, alpha, A, B, beta, C);
if (flag == 1) return Data_Wrap_Struct(cgsl_matrix, 0, gsl_matrix_free, C);
else return argv[6];
}
