ruby-lapack 1.6 → 1.7

data/ext/dgbtrs.c

@@ -1,111 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID dgbtrs_(char* trans, integer* n, integer* kl, integer* ku, integer* nrhs, doublereal* ab, integer* ldab, integer* ipiv, doublereal* b, integer* ldb, integer* info);
-
-
-static VALUE
-rblapack_dgbtrs(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_trans;
-  char trans; 
-  VALUE rblapack_kl;
-  integer kl; 
-  VALUE rblapack_ku;
-  integer ku; 
-  VALUE rblapack_ab;
-  doublereal *ab; 
-  VALUE rblapack_ipiv;
-  integer *ipiv; 
-  VALUE rblapack_b;
-  doublereal *b; 
-  VALUE rblapack_info;
-  integer info; 
-  VALUE rblapack_b_out__;
-  doublereal *b_out__;
-
-  integer ldab;
-  integer n;
-  integer ldb;
-  integer nrhs;
-
-  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  info, b = NumRu::Lapack.dgbtrs( trans, kl, ku, ab, ipiv, b, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE DGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO )\n\n*  Purpose\n*  =======\n*\n*  DGBTRS solves a system of linear equations\n*     A * X = B  or  A' * X = B\n*  with a general band matrix A using the LU factorization computed\n*  by DGBTRF.\n*\n\n*  Arguments\n*  =========\n*\n*  TRANS   (input) CHARACTER*1\n*          Specifies the form of the system of equations.\n*          = 'N':  A * X = B  (No transpose)\n*          = 'T':  A'* X = B  (Transpose)\n*          = 'C':  A'* X = B  (Conjugate transpose = Transpose)\n*\n*  N       (input) INTEGER\n*          The order of the matrix A.  N >= 0.\n*\n*  KL      (input) INTEGER\n*          The number of subdiagonals within the band of A.  KL >= 0.\n*\n*  KU      (input) INTEGER\n*          The number of superdiagonals within the band of A.  KU >= 0.\n*\n*  NRHS    (input) INTEGER\n*          The number of right hand sides, i.e., the number of columns\n*          of the matrix B.  NRHS >= 0.\n*\n*  AB      (input) DOUBLE PRECISION array, dimension (LDAB,N)\n*          Details of the LU factorization of the band matrix A, as\n*          computed by DGBTRF.  U is stored as an upper triangular band\n*          matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, and\n*          the multipliers used during the factorization are stored in\n*          rows KL+KU+2 to 2*KL+KU+1.\n*\n*  LDAB    (input) INTEGER\n*          The leading dimension of the array AB.  LDAB >= 2*KL+KU+1.\n*\n*  IPIV    (input) INTEGER array, dimension (N)\n*          The pivot indices; for 1 <= i <= N, row i of the matrix was\n*          interchanged with row IPIV(i).\n*\n*  B       (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)\n*          On entry, the right hand side matrix B.\n*          On exit, the solution matrix X.\n*\n*  LDB     (input) INTEGER\n*          The leading dimension of the array B.  LDB >= max(1,N).\n*\n*  INFO    (output) INTEGER\n*          = 0:  successful exit\n*          < 0: if INFO = -i, the i-th argument had an illegal value\n*\n\n*  =====================================================================\n*\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  info, b = NumRu::Lapack.dgbtrs( trans, kl, ku, ab, ipiv, b, [:usage => usage, :help => help])\n");
-      return Qnil;
-    } 
-  } else
-    rblapack_options = Qnil;
-  if (argc != 6 && argc != 6)
-    rb_raise(rb_eArgError,"wrong number of arguments (%d for 6)", argc);
-  rblapack_trans = argv[0];
-  rblapack_kl = argv[1];
-  rblapack_ku = argv[2];
-  rblapack_ab = argv[3];
-  rblapack_ipiv = argv[4];
-  rblapack_b = argv[5];
-  if (argc == 6) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  trans = StringValueCStr(rblapack_trans)[0];
-  ku = NUM2INT(rblapack_ku);
-  if (!NA_IsNArray(rblapack_ipiv))
-    rb_raise(rb_eArgError, "ipiv (5th argument) must be NArray");
-  if (NA_RANK(rblapack_ipiv) != 1)
-    rb_raise(rb_eArgError, "rank of ipiv (5th argument) must be %d", 1);
-  n = NA_SHAPE0(rblapack_ipiv);
-  if (NA_TYPE(rblapack_ipiv) != NA_LINT)
-    rblapack_ipiv = na_change_type(rblapack_ipiv, NA_LINT);
-  ipiv = NA_PTR_TYPE(rblapack_ipiv, integer*);
-  kl = NUM2INT(rblapack_kl);
-  if (!NA_IsNArray(rblapack_b))
-    rb_raise(rb_eArgError, "b (6th argument) must be NArray");
-  if (NA_RANK(rblapack_b) != 2)
-    rb_raise(rb_eArgError, "rank of b (6th argument) must be %d", 2);
-  ldb = NA_SHAPE0(rblapack_b);
-  nrhs = NA_SHAPE1(rblapack_b);
-  if (NA_TYPE(rblapack_b) != NA_DFLOAT)
-    rblapack_b = na_change_type(rblapack_b, NA_DFLOAT);
-  b = NA_PTR_TYPE(rblapack_b, doublereal*);
-  if (!NA_IsNArray(rblapack_ab))
-    rb_raise(rb_eArgError, "ab (4th argument) must be NArray");
-  if (NA_RANK(rblapack_ab) != 2)
-    rb_raise(rb_eArgError, "rank of ab (4th argument) must be %d", 2);
-  ldab = NA_SHAPE0(rblapack_ab);
-  if (NA_SHAPE1(rblapack_ab) != n)
-    rb_raise(rb_eRuntimeError, "shape 1 of ab must be the same as shape 0 of ipiv");
-  if (NA_TYPE(rblapack_ab) != NA_DFLOAT)
-    rblapack_ab = na_change_type(rblapack_ab, NA_DFLOAT);
-  ab = NA_PTR_TYPE(rblapack_ab, doublereal*);
-  {
-    int shape[2];
-    shape[0] = ldb;
-    shape[1] = nrhs;
-    rblapack_b_out__ = na_make_object(NA_DFLOAT, 2, shape, cNArray);
-  }
-  b_out__ = NA_PTR_TYPE(rblapack_b_out__, doublereal*);
-  MEMCPY(b_out__, b, doublereal, NA_TOTAL(rblapack_b));
-  rblapack_b = rblapack_b_out__;
-  b = b_out__;
-
-  dgbtrs_(&trans, &n, &kl, &ku, &nrhs, ab, &ldab, ipiv, b, &ldb, &info);
-
-  rblapack_info = INT2NUM(info);
-  return rb_ary_new3(2, rblapack_info, rblapack_b);
-}
-
-void
-init_lapack_dgbtrs(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "dgbtrs", rblapack_dgbtrs, -1);
-}

data/ext/dgebak.c

@@ -1,101 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID dgebak_(char* job, char* side, integer* n, integer* ilo, integer* ihi, doublereal* scale, integer* m, doublereal* v, integer* ldv, integer* info);
-
-
-static VALUE
-rblapack_dgebak(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_job;
-  char job; 
-  VALUE rblapack_side;
-  char side; 
-  VALUE rblapack_ilo;
-  integer ilo; 
-  VALUE rblapack_ihi;
-  integer ihi; 
-  VALUE rblapack_scale;
-  doublereal *scale; 
-  VALUE rblapack_v;
-  doublereal *v; 
-  VALUE rblapack_info;
-  integer info; 
-  VALUE rblapack_v_out__;
-  doublereal *v_out__;
-
-  integer n;
-  integer ldv;
-  integer m;
-
-  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  info, v = NumRu::Lapack.dgebak( job, side, ilo, ihi, scale, v, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE DGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO )\n\n*  Purpose\n*  =======\n*\n*  DGEBAK forms the right or left eigenvectors of a real general matrix\n*  by backward transformation on the computed eigenvectors of the\n*  balanced matrix output by DGEBAL.\n*\n\n*  Arguments\n*  =========\n*\n*  JOB     (input) CHARACTER*1\n*          Specifies the type of backward transformation required:\n*          = 'N', do nothing, return immediately;\n*          = 'P', do backward transformation for permutation only;\n*          = 'S', do backward transformation for scaling only;\n*          = 'B', do backward transformations for both permutation and\n*                 scaling.\n*          JOB must be the same as the argument JOB supplied to DGEBAL.\n*\n*  SIDE    (input) CHARACTER*1\n*          = 'R':  V contains right eigenvectors;\n*          = 'L':  V contains left eigenvectors.\n*\n*  N       (input) INTEGER\n*          The number of rows of the matrix V.  N >= 0.\n*\n*  ILO     (input) INTEGER\n*  IHI     (input) INTEGER\n*          The integers ILO and IHI determined by DGEBAL.\n*          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.\n*\n*  SCALE   (input) DOUBLE PRECISION array, dimension (N)\n*          Details of the permutation and scaling factors, as returned\n*          by DGEBAL.\n*\n*  M       (input) INTEGER\n*          The number of columns of the matrix V.  M >= 0.\n*\n*  V       (input/output) DOUBLE PRECISION array, dimension (LDV,M)\n*          On entry, the matrix of right or left eigenvectors to be\n*          transformed, as returned by DHSEIN or DTREVC.\n*          On exit, V is overwritten by the transformed eigenvectors.\n*\n*  LDV     (input) INTEGER\n*          The leading dimension of the array V. LDV >= max(1,N).\n*\n*  INFO    (output) INTEGER\n*          = 0:  successful exit\n*          < 0:  if INFO = -i, the i-th argument had an illegal value.\n*\n\n*  =====================================================================\n*\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  info, v = NumRu::Lapack.dgebak( job, side, ilo, ihi, scale, v, [:usage => usage, :help => help])\n");
-      return Qnil;
-    } 
-  } else
-    rblapack_options = Qnil;
-  if (argc != 6 && argc != 6)
-    rb_raise(rb_eArgError,"wrong number of arguments (%d for 6)", argc);
-  rblapack_job = argv[0];
-  rblapack_side = argv[1];
-  rblapack_ilo = argv[2];
-  rblapack_ihi = argv[3];
-  rblapack_scale = argv[4];
-  rblapack_v = argv[5];
-  if (argc == 6) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  job = StringValueCStr(rblapack_job)[0];
-  ilo = NUM2INT(rblapack_ilo);
-  if (!NA_IsNArray(rblapack_scale))
-    rb_raise(rb_eArgError, "scale (5th argument) must be NArray");
-  if (NA_RANK(rblapack_scale) != 1)
-    rb_raise(rb_eArgError, "rank of scale (5th argument) must be %d", 1);
-  n = NA_SHAPE0(rblapack_scale);
-  if (NA_TYPE(rblapack_scale) != NA_DFLOAT)
-    rblapack_scale = na_change_type(rblapack_scale, NA_DFLOAT);
-  scale = NA_PTR_TYPE(rblapack_scale, doublereal*);
-  side = StringValueCStr(rblapack_side)[0];
-  if (!NA_IsNArray(rblapack_v))
-    rb_raise(rb_eArgError, "v (6th argument) must be NArray");
-  if (NA_RANK(rblapack_v) != 2)
-    rb_raise(rb_eArgError, "rank of v (6th argument) must be %d", 2);
-  ldv = NA_SHAPE0(rblapack_v);
-  m = NA_SHAPE1(rblapack_v);
-  if (NA_TYPE(rblapack_v) != NA_DFLOAT)
-    rblapack_v = na_change_type(rblapack_v, NA_DFLOAT);
-  v = NA_PTR_TYPE(rblapack_v, doublereal*);
-  ihi = NUM2INT(rblapack_ihi);
-  {
-    int shape[2];
-    shape[0] = ldv;
-    shape[1] = m;
-    rblapack_v_out__ = na_make_object(NA_DFLOAT, 2, shape, cNArray);
-  }
-  v_out__ = NA_PTR_TYPE(rblapack_v_out__, doublereal*);
-  MEMCPY(v_out__, v, doublereal, NA_TOTAL(rblapack_v));
-  rblapack_v = rblapack_v_out__;
-  v = v_out__;
-
-  dgebak_(&job, &side, &n, &ilo, &ihi, scale, &m, v, &ldv, &info);
-
-  rblapack_info = INT2NUM(info);
-  return rb_ary_new3(2, rblapack_info, rblapack_v);
-}
-
-void
-init_lapack_dgebak(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "dgebak", rblapack_dgebak, -1);
-}

data/ext/dgebal.c

@@ -1,91 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID dgebal_(char* job, integer* n, doublereal* a, integer* lda, integer* ilo, integer* ihi, doublereal* scale, integer* info);
-
-
-static VALUE
-rblapack_dgebal(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_job;
-  char job; 
-  VALUE rblapack_a;
-  doublereal *a; 
-  VALUE rblapack_ilo;
-  integer ilo; 
-  VALUE rblapack_ihi;
-  integer ihi; 
-  VALUE rblapack_scale;
-  doublereal *scale; 
-  VALUE rblapack_info;
-  integer info; 
-  VALUE rblapack_a_out__;
-  doublereal *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  ilo, ihi, scale, info, a = NumRu::Lapack.dgebal( job, a, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE DGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO )\n\n*  Purpose\n*  =======\n*\n*  DGEBAL balances a general real matrix A.  This involves, first,\n*  permuting A by a similarity transformation to isolate eigenvalues\n*  in the first 1 to ILO-1 and last IHI+1 to N elements on the\n*  diagonal; and second, applying a diagonal similarity transformation\n*  to rows and columns ILO to IHI to make the rows and columns as\n*  close in norm as possible.  Both steps are optional.\n*\n*  Balancing may reduce the 1-norm of the matrix, and improve the\n*  accuracy of the computed eigenvalues and/or eigenvectors.\n*\n\n*  Arguments\n*  =========\n*\n*  JOB     (input) CHARACTER*1\n*          Specifies the operations to be performed on A:\n*          = 'N':  none:  simply set ILO = 1, IHI = N, SCALE(I) = 1.0\n*                  for i = 1,...,N;\n*          = 'P':  permute only;\n*          = 'S':  scale only;\n*          = 'B':  both permute and scale.\n*\n*  N       (input) INTEGER\n*          The order of the matrix A.  N >= 0.\n*\n*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)\n*          On entry, the input matrix A.\n*          On exit,  A is overwritten by the balanced matrix.\n*          If JOB = 'N', A is not referenced.\n*          See Further Details.\n*\n*  LDA     (input) INTEGER\n*          The leading dimension of the array A.  LDA >= max(1,N).\n*\n*  ILO     (output) INTEGER\n*  IHI     (output) INTEGER\n*          ILO and IHI are set to integers such that on exit\n*          A(i,j) = 0 if i > j and j = 1,...,ILO-1 or I = IHI+1,...,N.\n*          If JOB = 'N' or 'S', ILO = 1 and IHI = N.\n*\n*  SCALE   (output) DOUBLE PRECISION array, dimension (N)\n*          Details of the permutations and scaling factors applied to\n*          A.  If P(j) is the index of the row and column interchanged\n*          with row and column j and D(j) is the scaling factor\n*          applied to row and column j, then\n*          SCALE(j) = P(j)    for j = 1,...,ILO-1\n*                   = D(j)    for j = ILO,...,IHI\n*                   = P(j)    for j = IHI+1,...,N.\n*          The order in which the interchanges are made is N to IHI+1,\n*          then 1 to ILO-1.\n*\n*  INFO    (output) INTEGER\n*          = 0:  successful exit.\n*          < 0:  if INFO = -i, the i-th argument had an illegal value.\n*\n\n*  Further Details\n*  ===============\n*\n*  The permutations consist of row and column interchanges which put\n*  the matrix in the form\n*\n*             ( T1   X   Y  )\n*     P A P = (  0   B   Z  )\n*             (  0   0   T2 )\n*\n*  where T1 and T2 are upper triangular matrices whose eigenvalues lie\n*  along the diagonal.  The column indices ILO and IHI mark the starting\n*  and ending columns of the submatrix B. Balancing consists of applying\n*  a diagonal similarity transformation inv(D) * B * D to make the\n*  1-norms of each row of B and its corresponding column nearly equal.\n*  The output matrix is\n*\n*     ( T1     X*D          Y    )\n*     (  0  inv(D)*B*D  inv(D)*Z ).\n*     (  0      0           T2   )\n*\n*  Information about the permutations P and the diagonal matrix D is\n*  returned in the vector SCALE.\n*\n*  This subroutine is based on the EISPACK routine BALANC.\n*\n*  Modified by Tzu-Yi Chen, Computer Science Division, University of\n*    California at Berkeley, USA\n*\n*  =====================================================================\n*\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  ilo, ihi, scale, info, a = NumRu::Lapack.dgebal( job, a, [: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_job = argv[0];
-  rblapack_a = argv[1];
-  if (argc == 2) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  job = StringValueCStr(rblapack_job)[0];
-  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);
-  n = NA_SHAPE1(rblapack_a);
-  if (NA_TYPE(rblapack_a) != NA_DFLOAT)
-    rblapack_a = na_change_type(rblapack_a, NA_DFLOAT);
-  a = NA_PTR_TYPE(rblapack_a, doublereal*);
-  {
-    int shape[1];
-    shape[0] = n;
-    rblapack_scale = na_make_object(NA_DFLOAT, 1, shape, cNArray);
-  }
-  scale = NA_PTR_TYPE(rblapack_scale, doublereal*);
-  {
-    int shape[2];
-    shape[0] = lda;
-    shape[1] = n;
-    rblapack_a_out__ = na_make_object(NA_DFLOAT, 2, shape, cNArray);
-  }
-  a_out__ = NA_PTR_TYPE(rblapack_a_out__, doublereal*);
-  MEMCPY(a_out__, a, doublereal, NA_TOTAL(rblapack_a));
-  rblapack_a = rblapack_a_out__;
-  a = a_out__;
-
-  dgebal_(&job, &n, a, &lda, &ilo, &ihi, scale, &info);
-
-  rblapack_ilo = INT2NUM(ilo);
-  rblapack_ihi = INT2NUM(ihi);
-  rblapack_info = INT2NUM(info);
-  return rb_ary_new3(5, rblapack_ilo, rblapack_ihi, rblapack_scale, rblapack_info, rblapack_a);
-}
-
-void
-init_lapack_dgebal(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "dgebal", rblapack_dgebal, -1);
-}

data/ext/dgebd2.c

@@ -1,112 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID dgebd2_(integer* m, integer* n, doublereal* a, integer* lda, doublereal* d, doublereal* e, doublereal* tauq, doublereal* taup, doublereal* work, integer* info);
-
-
-static VALUE
-rblapack_dgebd2(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_m;
-  integer m; 
-  VALUE rblapack_a;
-  doublereal *a; 
-  VALUE rblapack_d;
-  doublereal *d; 
-  VALUE rblapack_e;
-  doublereal *e; 
-  VALUE rblapack_tauq;
-  doublereal *tauq; 
-  VALUE rblapack_taup;
-  doublereal *taup; 
-  VALUE rblapack_info;
-  integer info; 
-  VALUE rblapack_a_out__;
-  doublereal *a_out__;
-  doublereal *work;
-
-  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  d, e, tauq, taup, info, a = NumRu::Lapack.dgebd2( m, a, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )\n\n*  Purpose\n*  =======\n*\n*  DGEBD2 reduces a real general m by n matrix A to upper or lower\n*  bidiagonal form B by an orthogonal transformation: Q' * A * P = B.\n*\n*  If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal.\n*\n\n*  Arguments\n*  =========\n*\n*  M       (input) INTEGER\n*          The number of rows in the matrix A.  M >= 0.\n*\n*  N       (input) INTEGER\n*          The number of columns in the matrix A.  N >= 0.\n*\n*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)\n*          On entry, the m by n general matrix to be reduced.\n*          On exit,\n*          if m >= n, the diagonal and the first superdiagonal are\n*            overwritten with the upper bidiagonal matrix B; the\n*            elements below the diagonal, with the array TAUQ, represent\n*            the orthogonal matrix Q as a product of elementary\n*            reflectors, and the elements above the first superdiagonal,\n*            with the array TAUP, represent the orthogonal matrix P as\n*            a product of elementary reflectors;\n*          if m < n, the diagonal and the first subdiagonal are\n*            overwritten with the lower bidiagonal matrix B; the\n*            elements below the first subdiagonal, with the array TAUQ,\n*            represent the orthogonal matrix Q as a product of\n*            elementary reflectors, and the elements above the diagonal,\n*            with the array TAUP, represent the orthogonal matrix P as\n*            a product of elementary reflectors.\n*          See Further Details.\n*\n*  LDA     (input) INTEGER\n*          The leading dimension of the array A.  LDA >= max(1,M).\n*\n*  D       (output) DOUBLE PRECISION array, dimension (min(M,N))\n*          The diagonal elements of the bidiagonal matrix B:\n*          D(i) = A(i,i).\n*\n*  E       (output) DOUBLE PRECISION array, dimension (min(M,N)-1)\n*          The off-diagonal elements of the bidiagonal matrix B:\n*          if m >= n, E(i) = A(i,i+1) for i = 1,2,...,n-1;\n*          if m < n, E(i) = A(i+1,i) for i = 1,2,...,m-1.\n*\n*  TAUQ    (output) DOUBLE PRECISION array dimension (min(M,N))\n*          The scalar factors of the elementary reflectors which\n*          represent the orthogonal matrix Q. See Further Details.\n*\n*  TAUP    (output) DOUBLE PRECISION array, dimension (min(M,N))\n*          The scalar factors of the elementary reflectors which\n*          represent the orthogonal matrix P. See Further Details.\n*\n*  WORK    (workspace) DOUBLE PRECISION array, dimension (max(M,N))\n*\n*  INFO    (output) INTEGER\n*          = 0: successful exit.\n*          < 0: if INFO = -i, the i-th argument had an illegal value.\n*\n\n*  Further Details\n*  ===============\n*\n*  The matrices Q and P are represented as products of elementary\n*  reflectors:\n*\n*  If m >= n,\n*\n*     Q = H(1) H(2) . . . H(n)  and  P = G(1) G(2) . . . G(n-1)\n*\n*  Each H(i) and G(i) has the form:\n*\n*     H(i) = I - tauq * v * v'  and G(i) = I - taup * u * u'\n*\n*  where tauq and taup are real scalars, and v and u are real vectors;\n*  v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in A(i+1:m,i);\n*  u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in A(i,i+2:n);\n*  tauq is stored in TAUQ(i) and taup in TAUP(i).\n*\n*  If m < n,\n*\n*     Q = H(1) H(2) . . . H(m-1)  and  P = G(1) G(2) . . . G(m)\n*\n*  Each H(i) and G(i) has the form:\n*\n*     H(i) = I - tauq * v * v'  and G(i) = I - taup * u * u'\n*\n*  where tauq and taup are real scalars, and v and u are real vectors;\n*  v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i);\n*  u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n);\n*  tauq is stored in TAUQ(i) and taup in TAUP(i).\n*\n*  The contents of A on exit are illustrated by the following examples:\n*\n*  m = 6 and n = 5 (m > n):          m = 5 and n = 6 (m < n):\n*\n*    (  d   e   u1  u1  u1 )           (  d   u1  u1  u1  u1  u1 )\n*    (  v1  d   e   u2  u2 )           (  e   d   u2  u2  u2  u2 )\n*    (  v1  v2  d   e   u3 )           (  v1  e   d   u3  u3  u3 )\n*    (  v1  v2  v3  d   e  )           (  v1  v2  e   d   u4  u4 )\n*    (  v1  v2  v3  v4  d  )           (  v1  v2  v3  e   d   u5 )\n*    (  v1  v2  v3  v4  v5 )\n*\n*  where d and e denote diagonal and off-diagonal elements of B, vi\n*  denotes an element of the vector defining H(i), and ui an element of\n*  the vector defining G(i).\n*\n*  =====================================================================\n*\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  d, e, tauq, taup, info, a = NumRu::Lapack.dgebd2( m, a, [: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_m = argv[0];
-  rblapack_a = argv[1];
-  if (argc == 2) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  m = NUM2INT(rblapack_m);
-  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);
-  n = NA_SHAPE1(rblapack_a);
-  if (NA_TYPE(rblapack_a) != NA_DFLOAT)
-    rblapack_a = na_change_type(rblapack_a, NA_DFLOAT);
-  a = NA_PTR_TYPE(rblapack_a, doublereal*);
-  {
-    int shape[1];
-    shape[0] = MIN(m,n);
-    rblapack_d = na_make_object(NA_DFLOAT, 1, shape, cNArray);
-  }
-  d = NA_PTR_TYPE(rblapack_d, doublereal*);
-  {
-    int shape[1];
-    shape[0] = MIN(m,n)-1;
-    rblapack_e = na_make_object(NA_DFLOAT, 1, shape, cNArray);
-  }
-  e = NA_PTR_TYPE(rblapack_e, doublereal*);
-  {
-    int shape[1];
-    shape[0] = MIN(m,n);
-    rblapack_tauq = na_make_object(NA_DFLOAT, 1, shape, cNArray);
-  }
-  tauq = NA_PTR_TYPE(rblapack_tauq, doublereal*);
-  {
-    int shape[1];
-    shape[0] = MIN(m,n);
-    rblapack_taup = na_make_object(NA_DFLOAT, 1, shape, cNArray);
-  }
-  taup = NA_PTR_TYPE(rblapack_taup, doublereal*);
-  {
-    int shape[2];
-    shape[0] = lda;
-    shape[1] = n;
-    rblapack_a_out__ = na_make_object(NA_DFLOAT, 2, shape, cNArray);
-  }
-  a_out__ = NA_PTR_TYPE(rblapack_a_out__, doublereal*);
-  MEMCPY(a_out__, a, doublereal, NA_TOTAL(rblapack_a));
-  rblapack_a = rblapack_a_out__;
-  a = a_out__;
-  work = ALLOC_N(doublereal, (MAX(m,n)));
-
-  dgebd2_(&m, &n, a, &lda, d, e, tauq, taup, work, &info);
-
-  free(work);
-  rblapack_info = INT2NUM(info);
-  return rb_ary_new3(6, rblapack_d, rblapack_e, rblapack_tauq, rblapack_taup, rblapack_info, rblapack_a);
-}
-
-void
-init_lapack_dgebd2(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "dgebd2", rblapack_dgebd2, -1);
-}

data/ext/dgebrd.c

@@ -1,127 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID dgebrd_(integer* m, integer* n, doublereal* a, integer* lda, doublereal* d, doublereal* e, doublereal* tauq, doublereal* taup, doublereal* work, integer* lwork, integer* info);
-
-
-static VALUE
-rblapack_dgebrd(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_m;
-  integer m; 
-  VALUE rblapack_a;
-  doublereal *a; 
-  VALUE rblapack_lwork;
-  integer lwork; 
-  VALUE rblapack_d;
-  doublereal *d; 
-  VALUE rblapack_e;
-  doublereal *e; 
-  VALUE rblapack_tauq;
-  doublereal *tauq; 
-  VALUE rblapack_taup;
-  doublereal *taup; 
-  VALUE rblapack_work;
-  doublereal *work; 
-  VALUE rblapack_info;
-  integer info; 
-  VALUE rblapack_a_out__;
-  doublereal *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  d, e, tauq, taup, work, info, a = NumRu::Lapack.dgebrd( m, a, [:lwork => lwork, :usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE DGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, INFO )\n\n*  Purpose\n*  =======\n*\n*  DGEBRD reduces a general real M-by-N matrix A to upper or lower\n*  bidiagonal form B by an orthogonal transformation: Q**T * A * P = B.\n*\n*  If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal.\n*\n\n*  Arguments\n*  =========\n*\n*  M       (input) INTEGER\n*          The number of rows in the matrix A.  M >= 0.\n*\n*  N       (input) INTEGER\n*          The number of columns in the matrix A.  N >= 0.\n*\n*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)\n*          On entry, the M-by-N general matrix to be reduced.\n*          On exit,\n*          if m >= n, the diagonal and the first superdiagonal are\n*            overwritten with the upper bidiagonal matrix B; the\n*            elements below the diagonal, with the array TAUQ, represent\n*            the orthogonal matrix Q as a product of elementary\n*            reflectors, and the elements above the first superdiagonal,\n*            with the array TAUP, represent the orthogonal matrix P as\n*            a product of elementary reflectors;\n*          if m < n, the diagonal and the first subdiagonal are\n*            overwritten with the lower bidiagonal matrix B; the\n*            elements below the first subdiagonal, with the array TAUQ,\n*            represent the orthogonal matrix Q as a product of\n*            elementary reflectors, and the elements above the diagonal,\n*            with the array TAUP, represent the orthogonal matrix P as\n*            a product of elementary reflectors.\n*          See Further Details.\n*\n*  LDA     (input) INTEGER\n*          The leading dimension of the array A.  LDA >= max(1,M).\n*\n*  D       (output) DOUBLE PRECISION array, dimension (min(M,N))\n*          The diagonal elements of the bidiagonal matrix B:\n*          D(i) = A(i,i).\n*\n*  E       (output) DOUBLE PRECISION array, dimension (min(M,N)-1)\n*          The off-diagonal elements of the bidiagonal matrix B:\n*          if m >= n, E(i) = A(i,i+1) for i = 1,2,...,n-1;\n*          if m < n, E(i) = A(i+1,i) for i = 1,2,...,m-1.\n*\n*  TAUQ    (output) DOUBLE PRECISION array dimension (min(M,N))\n*          The scalar factors of the elementary reflectors which\n*          represent the orthogonal matrix Q. See Further Details.\n*\n*  TAUP    (output) DOUBLE PRECISION array, dimension (min(M,N))\n*          The scalar factors of the elementary reflectors which\n*          represent the orthogonal matrix P. See Further Details.\n*\n*  WORK    (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))\n*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.\n*\n*  LWORK   (input) INTEGER\n*          The length of the array WORK.  LWORK >= max(1,M,N).\n*          For optimum performance LWORK >= (M+N)*NB, where NB\n*          is the optimal blocksize.\n*\n*          If LWORK = -1, then a workspace query is assumed; the routine\n*          only calculates the optimal size of the WORK array, returns\n*          this value as the first entry of the WORK array, and no error\n*          message related to LWORK is issued by XERBLA.\n*\n*  INFO    (output) INTEGER\n*          = 0:  successful exit\n*          < 0:  if INFO = -i, the i-th argument had an illegal value.\n*\n\n*  Further Details\n*  ===============\n*\n*  The matrices Q and P are represented as products of elementary\n*  reflectors:\n*\n*  If m >= n,\n*\n*     Q = H(1) H(2) . . . H(n)  and  P = G(1) G(2) . . . G(n-1)\n*\n*  Each H(i) and G(i) has the form:\n*\n*     H(i) = I - tauq * v * v'  and G(i) = I - taup * u * u'\n*\n*  where tauq and taup are real scalars, and v and u are real vectors;\n*  v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in A(i+1:m,i);\n*  u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in A(i,i+2:n);\n*  tauq is stored in TAUQ(i) and taup in TAUP(i).\n*\n*  If m < n,\n*\n*     Q = H(1) H(2) . . . H(m-1)  and  P = G(1) G(2) . . . G(m)\n*\n*  Each H(i) and G(i) has the form:\n*\n*     H(i) = I - tauq * v * v'  and G(i) = I - taup * u * u'\n*\n*  where tauq and taup are real scalars, and v and u are real vectors;\n*  v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i);\n*  u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n);\n*  tauq is stored in TAUQ(i) and taup in TAUP(i).\n*\n*  The contents of A on exit are illustrated by the following examples:\n*\n*  m = 6 and n = 5 (m > n):          m = 5 and n = 6 (m < n):\n*\n*    (  d   e   u1  u1  u1 )           (  d   u1  u1  u1  u1  u1 )\n*    (  v1  d   e   u2  u2 )           (  e   d   u2  u2  u2  u2 )\n*    (  v1  v2  d   e   u3 )           (  v1  e   d   u3  u3  u3 )\n*    (  v1  v2  v3  d   e  )           (  v1  v2  e   d   u4  u4 )\n*    (  v1  v2  v3  v4  d  )           (  v1  v2  v3  e   d   u5 )\n*    (  v1  v2  v3  v4  v5 )\n*\n*  where d and e denote diagonal and off-diagonal elements of B, vi\n*  denotes an element of the vector defining H(i), and ui an element of\n*  the vector defining G(i).\n*\n*  =====================================================================\n*\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  d, e, tauq, taup, work, info, a = NumRu::Lapack.dgebrd( m, a, [:lwork => lwork, :usage => usage, :help => help])\n");
-      return Qnil;
-    } 
-  } else
-    rblapack_options = Qnil;
-  if (argc != 2 && argc != 3)
-    rb_raise(rb_eArgError,"wrong number of arguments (%d for 2)", argc);
-  rblapack_m = argv[0];
-  rblapack_a = argv[1];
-  if (argc == 3) {
-    rblapack_lwork = argv[2];
-  } else if (rblapack_options != Qnil) {
-    rblapack_lwork = rb_hash_aref(rblapack_options, ID2SYM(rb_intern("lwork")));
-  } else {
-    rblapack_lwork = Qnil;
-  }
-
-  m = NUM2INT(rblapack_m);
-  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);
-  n = NA_SHAPE1(rblapack_a);
-  if (NA_TYPE(rblapack_a) != NA_DFLOAT)
-    rblapack_a = na_change_type(rblapack_a, NA_DFLOAT);
-  a = NA_PTR_TYPE(rblapack_a, doublereal*);
-  if (rblapack_lwork == Qnil)
-    lwork = MAX(m,n);
-  else {
-    lwork = NUM2INT(rblapack_lwork);
-  }
-  {
-    int shape[1];
-    shape[0] = MIN(m,n);
-    rblapack_d = na_make_object(NA_DFLOAT, 1, shape, cNArray);
-  }
-  d = NA_PTR_TYPE(rblapack_d, doublereal*);
-  {
-    int shape[1];
-    shape[0] = MIN(m,n)-1;
-    rblapack_e = na_make_object(NA_DFLOAT, 1, shape, cNArray);
-  }
-  e = NA_PTR_TYPE(rblapack_e, doublereal*);
-  {
-    int shape[1];
-    shape[0] = MIN(m,n);
-    rblapack_tauq = na_make_object(NA_DFLOAT, 1, shape, cNArray);
-  }
-  tauq = NA_PTR_TYPE(rblapack_tauq, doublereal*);
-  {
-    int shape[1];
-    shape[0] = MIN(m,n);
-    rblapack_taup = na_make_object(NA_DFLOAT, 1, shape, cNArray);
-  }
-  taup = NA_PTR_TYPE(rblapack_taup, doublereal*);
-  {
-    int shape[1];
-    shape[0] = MAX(1,lwork);
-    rblapack_work = na_make_object(NA_DFLOAT, 1, shape, cNArray);
-  }
-  work = NA_PTR_TYPE(rblapack_work, doublereal*);
-  {
-    int shape[2];
-    shape[0] = lda;
-    shape[1] = n;
-    rblapack_a_out__ = na_make_object(NA_DFLOAT, 2, shape, cNArray);
-  }
-  a_out__ = NA_PTR_TYPE(rblapack_a_out__, doublereal*);
-  MEMCPY(a_out__, a, doublereal, NA_TOTAL(rblapack_a));
-  rblapack_a = rblapack_a_out__;
-  a = a_out__;
-
-  dgebrd_(&m, &n, a, &lda, d, e, tauq, taup, work, &lwork, &info);
-
-  rblapack_info = INT2NUM(info);
-  return rb_ary_new3(7, rblapack_d, rblapack_e, rblapack_tauq, rblapack_taup, rblapack_work, rblapack_info, rblapack_a);
-}
-
-void
-init_lapack_dgebrd(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "dgebrd", rblapack_dgebrd, -1);
-}