ruby-lapack 1.6 → 1.7

data/ext/claqsy.c

@@ -1,97 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID claqsy_(char* uplo, integer* n, complex* a, integer* lda, real* s, real* scond, real* amax, char* equed);
-
-
-static VALUE
-rblapack_claqsy(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_uplo;
-  char uplo; 
-  VALUE rblapack_a;
-  complex *a; 
-  VALUE rblapack_s;
-  real *s; 
-  VALUE rblapack_scond;
-  real scond; 
-  VALUE rblapack_amax;
-  real amax; 
-  VALUE rblapack_equed;
-  char equed; 
-  VALUE rblapack_a_out__;
-  complex *a_out__;
-
-  integer lda;
-  integer n;
-
-  VALUE rblapack_options;
-  if (argc > 0 && TYPE(argv[argc-1]) == T_HASH) {
-    argc--;
-    rblapack_options = argv[argc];
-    if (rb_hash_aref(rblapack_options, sHelp) == Qtrue) {
-      printf("%s\n", "USAGE:\n  equed, a = NumRu::Lapack.claqsy( uplo, a, s, scond, amax, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE CLAQSY( UPLO, N, A, LDA, S, SCOND, AMAX, EQUED )\n\n*  Purpose\n*  =======\n*\n*  CLAQSY equilibrates a symmetric matrix A using the scaling factors\n*  in the vector S.\n*\n\n*  Arguments\n*  =========\n*\n*  UPLO    (input) CHARACTER*1\n*          Specifies whether the upper or lower triangular part of the\n*          symmetric matrix A is stored.\n*          = 'U':  Upper triangular\n*          = 'L':  Lower triangular\n*\n*  N       (input) INTEGER\n*          The order of the matrix A.  N >= 0.\n*\n*  A       (input/output) COMPLEX array, dimension (LDA,N)\n*          On entry, the symmetric matrix A.  If UPLO = 'U', the leading\n*          n by n upper triangular part of A contains the upper\n*          triangular part of the matrix A, and the strictly lower\n*          triangular part of A is not referenced.  If UPLO = 'L', the\n*          leading n by n lower triangular part of A contains the lower\n*          triangular part of the matrix A, and the strictly upper\n*          triangular part of A is not referenced.\n*\n*          On exit, if EQUED = 'Y', the equilibrated matrix:\n*          diag(S) * A * diag(S).\n*\n*  LDA     (input) INTEGER\n*          The leading dimension of the array A.  LDA >= max(N,1).\n*\n*  S       (input) REAL array, dimension (N)\n*          The scale factors for A.\n*\n*  SCOND   (input) REAL\n*          Ratio of the smallest S(i) to the largest S(i).\n*\n*  AMAX    (input) REAL\n*          Absolute value of largest matrix entry.\n*\n*  EQUED   (output) CHARACTER*1\n*          Specifies whether or not equilibration was done.\n*          = 'N':  No equilibration.\n*          = 'Y':  Equilibration was done, i.e., A has been replaced by\n*                  diag(S) * A * diag(S).\n*\n*  Internal Parameters\n*  ===================\n*\n*  THRESH is a threshold value used to decide if scaling should be done\n*  based on the ratio of the scaling factors.  If SCOND < THRESH,\n*  scaling is done.\n*\n*  LARGE and SMALL are threshold values used to decide if scaling should\n*  be done based on the absolute size of the largest matrix element.\n*  If AMAX > LARGE or AMAX < SMALL, scaling is done.\n*\n\n*  =====================================================================\n*\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  equed, a = NumRu::Lapack.claqsy( uplo, a, s, scond, amax, [:usage => usage, :help => help])\n");
-      return Qnil;
-    } 
-  } else
-    rblapack_options = Qnil;
-  if (argc != 5 && argc != 5)
-    rb_raise(rb_eArgError,"wrong number of arguments (%d for 5)", argc);
-  rblapack_uplo = argv[0];
-  rblapack_a = argv[1];
-  rblapack_s = argv[2];
-  rblapack_scond = argv[3];
-  rblapack_amax = argv[4];
-  if (argc == 5) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  uplo = StringValueCStr(rblapack_uplo)[0];
-  if (!NA_IsNArray(rblapack_s))
-    rb_raise(rb_eArgError, "s (3th argument) must be NArray");
-  if (NA_RANK(rblapack_s) != 1)
-    rb_raise(rb_eArgError, "rank of s (3th argument) must be %d", 1);
-  n = NA_SHAPE0(rblapack_s);
-  if (NA_TYPE(rblapack_s) != NA_SFLOAT)
-    rblapack_s = na_change_type(rblapack_s, NA_SFLOAT);
-  s = NA_PTR_TYPE(rblapack_s, real*);
-  amax = (real)NUM2DBL(rblapack_amax);
-  if (!NA_IsNArray(rblapack_a))
-    rb_raise(rb_eArgError, "a (2th argument) must be NArray");
-  if (NA_RANK(rblapack_a) != 2)
-    rb_raise(rb_eArgError, "rank of a (2th argument) must be %d", 2);
-  lda = NA_SHAPE0(rblapack_a);
-  if (NA_SHAPE1(rblapack_a) != n)
-    rb_raise(rb_eRuntimeError, "shape 1 of a must be the same as shape 0 of s");
-  if (NA_TYPE(rblapack_a) != NA_SCOMPLEX)
-    rblapack_a = na_change_type(rblapack_a, NA_SCOMPLEX);
-  a = NA_PTR_TYPE(rblapack_a, complex*);
-  scond = (real)NUM2DBL(rblapack_scond);
-  {
-    int shape[2];
-    shape[0] = lda;
-    shape[1] = n;
-    rblapack_a_out__ = na_make_object(NA_SCOMPLEX, 2, shape, cNArray);
-  }
-  a_out__ = NA_PTR_TYPE(rblapack_a_out__, complex*);
-  MEMCPY(a_out__, a, complex, NA_TOTAL(rblapack_a));
-  rblapack_a = rblapack_a_out__;
-  a = a_out__;
-
-  claqsy_(&uplo, &n, a, &lda, s, &scond, &amax, &equed);
-
-  rblapack_equed = rb_str_new(&equed,1);
-  return rb_ary_new3(2, rblapack_equed, rblapack_a);
-}
-
-void
-init_lapack_claqsy(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "claqsy", rblapack_claqsy, -1);
-}

data/ext/clar1v.c

@@ -1,173 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID clar1v_(integer* n, integer* b1, integer* bn, real* lambda, real* d, real* l, real* ld, real* lld, real* pivmin, real* gaptol, complex* z, logical* wantnc, integer* negcnt, real* ztz, real* mingma, integer* r, integer* isuppz, real* nrminv, real* resid, real* rqcorr, real* work);
-
-
-static VALUE
-rblapack_clar1v(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_b1;
-  integer b1; 
-  VALUE rblapack_bn;
-  integer bn; 
-  VALUE rblapack_lambda;
-  real lambda; 
-  VALUE rblapack_d;
-  real *d; 
-  VALUE rblapack_l;
-  real *l; 
-  VALUE rblapack_ld;
-  real *ld; 
-  VALUE rblapack_lld;
-  real *lld; 
-  VALUE rblapack_pivmin;
-  real pivmin; 
-  VALUE rblapack_gaptol;
-  real gaptol; 
-  VALUE rblapack_z;
-  complex *z; 
-  VALUE rblapack_wantnc;
-  logical wantnc; 
-  VALUE rblapack_r;
-  integer r; 
-  VALUE rblapack_negcnt;
-  integer negcnt; 
-  VALUE rblapack_ztz;
-  real ztz; 
-  VALUE rblapack_mingma;
-  real mingma; 
-  VALUE rblapack_isuppz;
-  integer *isuppz; 
-  VALUE rblapack_nrminv;
-  real nrminv; 
-  VALUE rblapack_resid;
-  real resid; 
-  VALUE rblapack_rqcorr;
-  real rqcorr; 
-  VALUE rblapack_z_out__;
-  complex *z_out__;
-  real *work;
-
-  integer n;
-
-  VALUE rblapack_options;
-  if (argc > 0 && TYPE(argv[argc-1]) == T_HASH) {
-    argc--;
-    rblapack_options = argv[argc];
-    if (rb_hash_aref(rblapack_options, sHelp) == Qtrue) {
-      printf("%s\n", "USAGE:\n  negcnt, ztz, mingma, isuppz, nrminv, resid, rqcorr, z, r = NumRu::Lapack.clar1v( b1, bn, lambda, d, l, ld, lld, pivmin, gaptol, z, wantnc, r, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE CLAR1V( N, B1, BN, LAMBDA, D, L, LD, LLD, PIVMIN, GAPTOL, Z, WANTNC, NEGCNT, ZTZ, MINGMA, R, ISUPPZ, NRMINV, RESID, RQCORR, WORK )\n\n*  Purpose\n*  =======\n*\n*  CLAR1V computes the (scaled) r-th column of the inverse of\n*  the sumbmatrix in rows B1 through BN of the tridiagonal matrix\n*  L D L^T - sigma I. When sigma is close to an eigenvalue, the\n*  computed vector is an accurate eigenvector. Usually, r corresponds\n*  to the index where the eigenvector is largest in magnitude.\n*  The following steps accomplish this computation :\n*  (a) Stationary qd transform,  L D L^T - sigma I = L(+) D(+) L(+)^T,\n*  (b) Progressive qd transform, L D L^T - sigma I = U(-) D(-) U(-)^T,\n*  (c) Computation of the diagonal elements of the inverse of\n*      L D L^T - sigma I by combining the above transforms, and choosing\n*      r as the index where the diagonal of the inverse is (one of the)\n*      largest in magnitude.\n*  (d) Computation of the (scaled) r-th column of the inverse using the\n*      twisted factorization obtained by combining the top part of the\n*      the stationary and the bottom part of the progressive transform.\n*\n\n*  Arguments\n*  =========\n*\n*  N        (input) INTEGER\n*           The order of the matrix L D L^T.\n*\n*  B1       (input) INTEGER\n*           First index of the submatrix of L D L^T.\n*\n*  BN       (input) INTEGER\n*           Last index of the submatrix of L D L^T.\n*\n*  LAMBDA    (input) REAL            \n*           The shift. In order to compute an accurate eigenvector,\n*           LAMBDA should be a good approximation to an eigenvalue\n*           of L D L^T.\n*\n*  L        (input) REAL             array, dimension (N-1)\n*           The (n-1) subdiagonal elements of the unit bidiagonal matrix\n*           L, in elements 1 to N-1.\n*\n*  D        (input) REAL             array, dimension (N)\n*           The n diagonal elements of the diagonal matrix D.\n*\n*  LD       (input) REAL             array, dimension (N-1)\n*           The n-1 elements L(i)*D(i).\n*\n*  LLD      (input) REAL             array, dimension (N-1)\n*           The n-1 elements L(i)*L(i)*D(i).\n*\n*  PIVMIN   (input) REAL            \n*           The minimum pivot in the Sturm sequence.\n*\n*  GAPTOL   (input) REAL            \n*           Tolerance that indicates when eigenvector entries are negligible\n*           w.r.t. their contribution to the residual.\n*\n*  Z        (input/output) COMPLEX          array, dimension (N)\n*           On input, all entries of Z must be set to 0.\n*           On output, Z contains the (scaled) r-th column of the\n*           inverse. The scaling is such that Z(R) equals 1.\n*\n*  WANTNC   (input) LOGICAL\n*           Specifies whether NEGCNT has to be computed.\n*\n*  NEGCNT   (output) INTEGER\n*           If WANTNC is .TRUE. then NEGCNT = the number of pivots < pivmin\n*           in the  matrix factorization L D L^T, and NEGCNT = -1 otherwise.\n*\n*  ZTZ      (output) REAL            \n*           The square of the 2-norm of Z.\n*\n*  MINGMA   (output) REAL            \n*           The reciprocal of the largest (in magnitude) diagonal\n*           element of the inverse of L D L^T - sigma I.\n*\n*  R        (input/output) INTEGER\n*           The twist index for the twisted factorization used to\n*           compute Z.\n*           On input, 0 <= R <= N. If R is input as 0, R is set to\n*           the index where (L D L^T - sigma I)^{-1} is largest\n*           in magnitude. If 1 <= R <= N, R is unchanged.\n*           On output, R contains the twist index used to compute Z.\n*           Ideally, R designates the position of the maximum entry in the\n*           eigenvector.\n*\n*  ISUPPZ   (output) INTEGER array, dimension (2)\n*           The support of the vector in Z, i.e., the vector Z is\n*           nonzero only in elements ISUPPZ(1) through ISUPPZ( 2 ).\n*\n*  NRMINV   (output) REAL            \n*           NRMINV = 1/SQRT( ZTZ )\n*\n*  RESID    (output) REAL            \n*           The residual of the FP vector.\n*           RESID = ABS( MINGMA )/SQRT( ZTZ )\n*\n*  RQCORR   (output) REAL            \n*           The Rayleigh Quotient correction to LAMBDA.\n*           RQCORR = MINGMA*TMP\n*\n*  WORK     (workspace) REAL             array, dimension (4*N)\n*\n\n*  Further Details\n*  ===============\n*\n*  Based on contributions by\n*     Beresford Parlett, University of California, Berkeley, USA\n*     Jim Demmel, University of California, Berkeley, USA\n*     Inderjit Dhillon, University of Texas, Austin, USA\n*     Osni Marques, LBNL/NERSC, USA\n*     Christof Voemel, University of California, Berkeley, USA\n*\n*  =====================================================================\n*\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  negcnt, ztz, mingma, isuppz, nrminv, resid, rqcorr, z, r = NumRu::Lapack.clar1v( b1, bn, lambda, d, l, ld, lld, pivmin, gaptol, z, wantnc, r, [:usage => usage, :help => help])\n");
-      return Qnil;
-    } 
-  } else
-    rblapack_options = Qnil;
-  if (argc != 12 && argc != 12)
-    rb_raise(rb_eArgError,"wrong number of arguments (%d for 12)", argc);
-  rblapack_b1 = argv[0];
-  rblapack_bn = argv[1];
-  rblapack_lambda = argv[2];
-  rblapack_d = argv[3];
-  rblapack_l = argv[4];
-  rblapack_ld = argv[5];
-  rblapack_lld = argv[6];
-  rblapack_pivmin = argv[7];
-  rblapack_gaptol = argv[8];
-  rblapack_z = argv[9];
-  rblapack_wantnc = argv[10];
-  rblapack_r = argv[11];
-  if (argc == 12) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  b1 = NUM2INT(rblapack_b1);
-  lambda = (real)NUM2DBL(rblapack_lambda);
-  pivmin = (real)NUM2DBL(rblapack_pivmin);
-  if (!NA_IsNArray(rblapack_z))
-    rb_raise(rb_eArgError, "z (10th argument) must be NArray");
-  if (NA_RANK(rblapack_z) != 1)
-    rb_raise(rb_eArgError, "rank of z (10th argument) must be %d", 1);
-  n = NA_SHAPE0(rblapack_z);
-  if (NA_TYPE(rblapack_z) != NA_SCOMPLEX)
-    rblapack_z = na_change_type(rblapack_z, NA_SCOMPLEX);
-  z = NA_PTR_TYPE(rblapack_z, complex*);
-  r = NUM2INT(rblapack_r);
-  bn = NUM2INT(rblapack_bn);
-  gaptol = (real)NUM2DBL(rblapack_gaptol);
-  if (!NA_IsNArray(rblapack_d))
-    rb_raise(rb_eArgError, "d (4th argument) must be NArray");
-  if (NA_RANK(rblapack_d) != 1)
-    rb_raise(rb_eArgError, "rank of d (4th argument) must be %d", 1);
-  if (NA_SHAPE0(rblapack_d) != n)
-    rb_raise(rb_eRuntimeError, "shape 0 of d must be the same as shape 0 of z");
-  if (NA_TYPE(rblapack_d) != NA_SFLOAT)
-    rblapack_d = na_change_type(rblapack_d, NA_SFLOAT);
-  d = NA_PTR_TYPE(rblapack_d, real*);
-  if (!NA_IsNArray(rblapack_ld))
-    rb_raise(rb_eArgError, "ld (6th argument) must be NArray");
-  if (NA_RANK(rblapack_ld) != 1)
-    rb_raise(rb_eArgError, "rank of ld (6th argument) must be %d", 1);
-  if (NA_SHAPE0(rblapack_ld) != (n-1))
-    rb_raise(rb_eRuntimeError, "shape 0 of ld must be %d", n-1);
-  if (NA_TYPE(rblapack_ld) != NA_SFLOAT)
-    rblapack_ld = na_change_type(rblapack_ld, NA_SFLOAT);
-  ld = NA_PTR_TYPE(rblapack_ld, real*);
-  wantnc = (rblapack_wantnc == Qtrue);
-  if (!NA_IsNArray(rblapack_l))
-    rb_raise(rb_eArgError, "l (5th argument) must be NArray");
-  if (NA_RANK(rblapack_l) != 1)
-    rb_raise(rb_eArgError, "rank of l (5th argument) must be %d", 1);
-  if (NA_SHAPE0(rblapack_l) != (n-1))
-    rb_raise(rb_eRuntimeError, "shape 0 of l must be %d", n-1);
-  if (NA_TYPE(rblapack_l) != NA_SFLOAT)
-    rblapack_l = na_change_type(rblapack_l, NA_SFLOAT);
-  l = NA_PTR_TYPE(rblapack_l, real*);
-  if (!NA_IsNArray(rblapack_lld))
-    rb_raise(rb_eArgError, "lld (7th argument) must be NArray");
-  if (NA_RANK(rblapack_lld) != 1)
-    rb_raise(rb_eArgError, "rank of lld (7th argument) must be %d", 1);
-  if (NA_SHAPE0(rblapack_lld) != (n-1))
-    rb_raise(rb_eRuntimeError, "shape 0 of lld must be %d", n-1);
-  if (NA_TYPE(rblapack_lld) != NA_SFLOAT)
-    rblapack_lld = na_change_type(rblapack_lld, NA_SFLOAT);
-  lld = NA_PTR_TYPE(rblapack_lld, real*);
-  {
-    int shape[1];
-    shape[0] = 2;
-    rblapack_isuppz = na_make_object(NA_LINT, 1, shape, cNArray);
-  }
-  isuppz = NA_PTR_TYPE(rblapack_isuppz, integer*);
-  {
-    int shape[1];
-    shape[0] = n;
-    rblapack_z_out__ = na_make_object(NA_SCOMPLEX, 1, shape, cNArray);
-  }
-  z_out__ = NA_PTR_TYPE(rblapack_z_out__, complex*);
-  MEMCPY(z_out__, z, complex, NA_TOTAL(rblapack_z));
-  rblapack_z = rblapack_z_out__;
-  z = z_out__;
-  work = ALLOC_N(real, (4*n));
-
-  clar1v_(&n, &b1, &bn, &lambda, d, l, ld, lld, &pivmin, &gaptol, z, &wantnc, &negcnt, &ztz, &mingma, &r, isuppz, &nrminv, &resid, &rqcorr, work);
-
-  free(work);
-  rblapack_negcnt = INT2NUM(negcnt);
-  rblapack_ztz = rb_float_new((double)ztz);
-  rblapack_mingma = rb_float_new((double)mingma);
-  rblapack_nrminv = rb_float_new((double)nrminv);
-  rblapack_resid = rb_float_new((double)resid);
-  rblapack_rqcorr = rb_float_new((double)rqcorr);
-  rblapack_r = INT2NUM(r);
-  return rb_ary_new3(9, rblapack_negcnt, rblapack_ztz, rblapack_mingma, rblapack_isuppz, rblapack_nrminv, rblapack_resid, rblapack_rqcorr, rblapack_z, rblapack_r);
-}
-
-void
-init_lapack_clar1v(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "clar1v", rblapack_clar1v, -1);
-}

data/ext/clar2v.c

@@ -1,149 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID clar2v_(integer* n, complex* x, complex* y, complex* z, integer* incx, real* c, complex* s, integer* incc);
-
-
-static VALUE
-rblapack_clar2v(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_n;
-  integer n; 
-  VALUE rblapack_x;
-  complex *x; 
-  VALUE rblapack_y;
-  complex *y; 
-  VALUE rblapack_z;
-  complex *z; 
-  VALUE rblapack_incx;
-  integer incx; 
-  VALUE rblapack_c;
-  real *c; 
-  VALUE rblapack_s;
-  complex *s; 
-  VALUE rblapack_incc;
-  integer incc; 
-  VALUE rblapack_x_out__;
-  complex *x_out__;
-  VALUE rblapack_y_out__;
-  complex *y_out__;
-  VALUE rblapack_z_out__;
-  complex *z_out__;
-
-
-  VALUE rblapack_options;
-  if (argc > 0 && TYPE(argv[argc-1]) == T_HASH) {
-    argc--;
-    rblapack_options = argv[argc];
-    if (rb_hash_aref(rblapack_options, sHelp) == Qtrue) {
-      printf("%s\n", "USAGE:\n  x, y, z = NumRu::Lapack.clar2v( n, x, y, z, incx, c, s, incc, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE CLAR2V( N, X, Y, Z, INCX, C, S, INCC )\n\n*  Purpose\n*  =======\n*\n*  CLAR2V applies a vector of complex plane rotations with real cosines\n*  from both sides to a sequence of 2-by-2 complex Hermitian matrices,\n*  defined by the elements of the vectors x, y and z. For i = 1,2,...,n\n*\n*     (       x(i)  z(i) ) :=\n*     ( conjg(z(i)) y(i) )\n*\n*       (  c(i) conjg(s(i)) ) (       x(i)  z(i) ) ( c(i) -conjg(s(i)) )\n*       ( -s(i)       c(i)  ) ( conjg(z(i)) y(i) ) ( s(i)        c(i)  )\n*\n\n*  Arguments\n*  =========\n*\n*  N       (input) INTEGER\n*          The number of plane rotations to be applied.\n*\n*  X       (input/output) COMPLEX array, dimension (1+(N-1)*INCX)\n*          The vector x; the elements of x are assumed to be real.\n*\n*  Y       (input/output) COMPLEX array, dimension (1+(N-1)*INCX)\n*          The vector y; the elements of y are assumed to be real.\n*\n*  Z       (input/output) COMPLEX array, dimension (1+(N-1)*INCX)\n*          The vector z.\n*\n*  INCX    (input) INTEGER\n*          The increment between elements of X, Y and Z. INCX > 0.\n*\n*  C       (input) REAL array, dimension (1+(N-1)*INCC)\n*          The cosines of the plane rotations.\n*\n*  S       (input) COMPLEX array, dimension (1+(N-1)*INCC)\n*          The sines of the plane rotations.\n*\n*  INCC    (input) INTEGER\n*          The increment between elements of C and S. INCC > 0.\n*\n\n*  =====================================================================\n*\n*     .. Local Scalars ..\n      INTEGER            I, IC, IX\n      REAL               CI, SII, SIR, T1I, T1R, T5, T6, XI, YI, ZII,\n     $                   ZIR\n      COMPLEX            SI, T2, T3, T4, ZI\n*     ..\n*     .. Intrinsic Functions ..\n      INTRINSIC          AIMAG, CMPLX, CONJG, REAL\n*     ..\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  x, y, z = NumRu::Lapack.clar2v( n, x, y, z, incx, c, s, incc, [:usage => usage, :help => help])\n");
-      return Qnil;
-    } 
-  } else
-    rblapack_options = Qnil;
-  if (argc != 8 && argc != 8)
-    rb_raise(rb_eArgError,"wrong number of arguments (%d for 8)", argc);
-  rblapack_n = argv[0];
-  rblapack_x = argv[1];
-  rblapack_y = argv[2];
-  rblapack_z = argv[3];
-  rblapack_incx = argv[4];
-  rblapack_c = argv[5];
-  rblapack_s = argv[6];
-  rblapack_incc = argv[7];
-  if (argc == 8) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  n = NUM2INT(rblapack_n);
-  incx = NUM2INT(rblapack_incx);
-  incc = NUM2INT(rblapack_incc);
-  if (!NA_IsNArray(rblapack_x))
-    rb_raise(rb_eArgError, "x (2th argument) must be NArray");
-  if (NA_RANK(rblapack_x) != 1)
-    rb_raise(rb_eArgError, "rank of x (2th argument) must be %d", 1);
-  if (NA_SHAPE0(rblapack_x) != (1+(n-1)*incx))
-    rb_raise(rb_eRuntimeError, "shape 0 of x must be %d", 1+(n-1)*incx);
-  if (NA_TYPE(rblapack_x) != NA_SCOMPLEX)
-    rblapack_x = na_change_type(rblapack_x, NA_SCOMPLEX);
-  x = NA_PTR_TYPE(rblapack_x, complex*);
-  if (!NA_IsNArray(rblapack_z))
-    rb_raise(rb_eArgError, "z (4th argument) must be NArray");
-  if (NA_RANK(rblapack_z) != 1)
-    rb_raise(rb_eArgError, "rank of z (4th argument) must be %d", 1);
-  if (NA_SHAPE0(rblapack_z) != (1+(n-1)*incx))
-    rb_raise(rb_eRuntimeError, "shape 0 of z must be %d", 1+(n-1)*incx);
-  if (NA_TYPE(rblapack_z) != NA_SCOMPLEX)
-    rblapack_z = na_change_type(rblapack_z, NA_SCOMPLEX);
-  z = NA_PTR_TYPE(rblapack_z, complex*);
-  if (!NA_IsNArray(rblapack_s))
-    rb_raise(rb_eArgError, "s (7th argument) must be NArray");
-  if (NA_RANK(rblapack_s) != 1)
-    rb_raise(rb_eArgError, "rank of s (7th argument) must be %d", 1);
-  if (NA_SHAPE0(rblapack_s) != (1+(n-1)*incc))
-    rb_raise(rb_eRuntimeError, "shape 0 of s must be %d", 1+(n-1)*incc);
-  if (NA_TYPE(rblapack_s) != NA_SCOMPLEX)
-    rblapack_s = na_change_type(rblapack_s, NA_SCOMPLEX);
-  s = NA_PTR_TYPE(rblapack_s, complex*);
-  if (!NA_IsNArray(rblapack_y))
-    rb_raise(rb_eArgError, "y (3th argument) must be NArray");
-  if (NA_RANK(rblapack_y) != 1)
-    rb_raise(rb_eArgError, "rank of y (3th argument) must be %d", 1);
-  if (NA_SHAPE0(rblapack_y) != (1+(n-1)*incx))
-    rb_raise(rb_eRuntimeError, "shape 0 of y must be %d", 1+(n-1)*incx);
-  if (NA_TYPE(rblapack_y) != NA_SCOMPLEX)
-    rblapack_y = na_change_type(rblapack_y, NA_SCOMPLEX);
-  y = NA_PTR_TYPE(rblapack_y, complex*);
-  if (!NA_IsNArray(rblapack_c))
-    rb_raise(rb_eArgError, "c (6th argument) must be NArray");
-  if (NA_RANK(rblapack_c) != 1)
-    rb_raise(rb_eArgError, "rank of c (6th argument) must be %d", 1);
-  if (NA_SHAPE0(rblapack_c) != (1+(n-1)*incc))
-    rb_raise(rb_eRuntimeError, "shape 0 of c must be %d", 1+(n-1)*incc);
-  if (NA_TYPE(rblapack_c) != NA_SFLOAT)
-    rblapack_c = na_change_type(rblapack_c, NA_SFLOAT);
-  c = NA_PTR_TYPE(rblapack_c, real*);
-  {
-    int shape[1];
-    shape[0] = 1+(n-1)*incx;
-    rblapack_x_out__ = na_make_object(NA_SCOMPLEX, 1, shape, cNArray);
-  }
-  x_out__ = NA_PTR_TYPE(rblapack_x_out__, complex*);
-  MEMCPY(x_out__, x, complex, NA_TOTAL(rblapack_x));
-  rblapack_x = rblapack_x_out__;
-  x = x_out__;
-  {
-    int shape[1];
-    shape[0] = 1+(n-1)*incx;
-    rblapack_y_out__ = na_make_object(NA_SCOMPLEX, 1, shape, cNArray);
-  }
-  y_out__ = NA_PTR_TYPE(rblapack_y_out__, complex*);
-  MEMCPY(y_out__, y, complex, NA_TOTAL(rblapack_y));
-  rblapack_y = rblapack_y_out__;
-  y = y_out__;
-  {
-    int shape[1];
-    shape[0] = 1+(n-1)*incx;
-    rblapack_z_out__ = na_make_object(NA_SCOMPLEX, 1, shape, cNArray);
-  }
-  z_out__ = NA_PTR_TYPE(rblapack_z_out__, complex*);
-  MEMCPY(z_out__, z, complex, NA_TOTAL(rblapack_z));
-  rblapack_z = rblapack_z_out__;
-  z = z_out__;
-
-  clar2v_(&n, x, y, z, &incx, c, s, &incc);
-
-  return rb_ary_new3(3, rblapack_x, rblapack_y, rblapack_z);
-}
-
-void
-init_lapack_clar2v(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "clar2v", rblapack_clar2v, -1);
-}

data/ext/clarcm.c

@@ -1,86 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID clarcm_(integer* m, integer* n, real* a, integer* lda, complex* b, integer* ldb, complex* c, integer* ldc, real* rwork);
-
-
-static VALUE
-rblapack_clarcm(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_a;
-  real *a; 
-  VALUE rblapack_b;
-  complex *b; 
-  VALUE rblapack_c;
-  complex *c; 
-  real *rwork;
-
-  integer lda;
-  integer m;
-  integer ldb;
-  integer n;
-  integer ldc;
-
-  VALUE rblapack_options;
-  if (argc > 0 && TYPE(argv[argc-1]) == T_HASH) {
-    argc--;
-    rblapack_options = argv[argc];
-    if (rb_hash_aref(rblapack_options, sHelp) == Qtrue) {
-      printf("%s\n", "USAGE:\n  c = NumRu::Lapack.clarcm( a, b, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE CLARCM( M, N, A, LDA, B, LDB, C, LDC, RWORK )\n\n*  Purpose\n*  =======\n*\n*  CLARCM performs a very simple matrix-matrix multiplication:\n*           C := A * B,\n*  where A is M by M and real; B is M by N and complex;\n*  C is M by N and complex.\n*\n\n*  Arguments\n*  =========\n*\n*  M       (input) INTEGER\n*          The number of rows of the matrix A and of the matrix C.\n*          M >= 0.\n*\n*  N       (input) INTEGER\n*          The number of columns and rows of the matrix B and\n*          the number of columns of the matrix C.\n*          N >= 0.\n*\n*  A       (input) REAL array, dimension (LDA, M)\n*          A contains the M by M matrix A.\n*\n*  LDA     (input) INTEGER\n*          The leading dimension of the array A. LDA >=max(1,M).\n*\n*  B       (input) REAL array, dimension (LDB, N)\n*          B contains the M by N matrix B.\n*\n*  LDB     (input) INTEGER\n*          The leading dimension of the array B. LDB >=max(1,M).\n*\n*  C       (input) COMPLEX array, dimension (LDC, N)\n*          C contains the M by N matrix C.\n*\n*  LDC     (input) INTEGER\n*          The leading dimension of the array C. LDC >=max(1,M).\n*\n*  RWORK   (workspace) REAL array, dimension (2*M*N)\n*\n\n*  =====================================================================\n*\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  c = NumRu::Lapack.clarcm( a, b, [:usage => usage, :help => help])\n");
-      return Qnil;
-    } 
-  } else
-    rblapack_options = Qnil;
-  if (argc != 2 && argc != 2)
-    rb_raise(rb_eArgError,"wrong number of arguments (%d for 2)", argc);
-  rblapack_a = argv[0];
-  rblapack_b = argv[1];
-  if (argc == 2) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  if (!NA_IsNArray(rblapack_a))
-    rb_raise(rb_eArgError, "a (1th argument) must be NArray");
-  if (NA_RANK(rblapack_a) != 2)
-    rb_raise(rb_eArgError, "rank of a (1th argument) must be %d", 2);
-  lda = NA_SHAPE0(rblapack_a);
-  m = NA_SHAPE1(rblapack_a);
-  if (NA_TYPE(rblapack_a) != NA_SFLOAT)
-    rblapack_a = na_change_type(rblapack_a, NA_SFLOAT);
-  a = NA_PTR_TYPE(rblapack_a, real*);
-  ldc = MAX(1,m);
-  if (!NA_IsNArray(rblapack_b))
-    rb_raise(rb_eArgError, "b (2th argument) must be NArray");
-  if (NA_RANK(rblapack_b) != 2)
-    rb_raise(rb_eArgError, "rank of b (2th argument) must be %d", 2);
-  ldb = NA_SHAPE0(rblapack_b);
-  n = NA_SHAPE1(rblapack_b);
-  if (NA_TYPE(rblapack_b) != NA_SCOMPLEX)
-    rblapack_b = na_change_type(rblapack_b, NA_SCOMPLEX);
-  b = NA_PTR_TYPE(rblapack_b, complex*);
-  {
-    int shape[2];
-    shape[0] = ldc;
-    shape[1] = n;
-    rblapack_c = na_make_object(NA_SCOMPLEX, 2, shape, cNArray);
-  }
-  c = NA_PTR_TYPE(rblapack_c, complex*);
-  rwork = ALLOC_N(real, (2*m*n));
-
-  clarcm_(&m, &n, a, &lda, b, &ldb, c, &ldc, rwork);
-
-  free(rwork);
-  return rblapack_c;
-}
-
-void
-init_lapack_clarcm(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "clarcm", rblapack_clarcm, -1);
-}