ruby-lapack 1.6 → 1.7

data/ext/dgerq2.c

@@ -1,86 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID dgerq2_(integer* m, integer* n, doublereal* a, integer* lda, doublereal* tau, doublereal* work, integer* info);
-
-
-static VALUE
-rblapack_dgerq2(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_a;
-  doublereal *a; 
-  VALUE rblapack_tau;
-  doublereal *tau; 
-  VALUE rblapack_info;
-  integer info; 
-  VALUE rblapack_a_out__;
-  doublereal *a_out__;
-  doublereal *work;
-
-  integer lda;
-  integer n;
-  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  tau, info, a = NumRu::Lapack.dgerq2( a, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE DGERQ2( M, N, A, LDA, TAU, WORK, INFO )\n\n*  Purpose\n*  =======\n*\n*  DGERQ2 computes an RQ factorization of a real m by n matrix A:\n*  A = R * Q.\n*\n\n*  Arguments\n*  =========\n*\n*  M       (input) INTEGER\n*          The number of rows of the matrix A.  M >= 0.\n*\n*  N       (input) INTEGER\n*          The number of columns of the matrix A.  N >= 0.\n*\n*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)\n*          On entry, the m by n matrix A.\n*          On exit, if m <= n, the upper triangle of the subarray\n*          A(1:m,n-m+1:n) contains the m by m upper triangular matrix R;\n*          if m >= n, the elements on and above the (m-n)-th subdiagonal\n*          contain the m by n upper trapezoidal matrix R; the remaining\n*          elements, with the array TAU, represent the orthogonal matrix\n*          Q as a product of elementary reflectors (see Further\n*          Details).\n*\n*  LDA     (input) INTEGER\n*          The leading dimension of the array A.  LDA >= max(1,M).\n*\n*  TAU     (output) DOUBLE PRECISION array, dimension (min(M,N))\n*          The scalar factors of the elementary reflectors (see Further\n*          Details).\n*\n*  WORK    (workspace) DOUBLE PRECISION array, dimension (M)\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 matrix Q is represented as a product of elementary reflectors\n*\n*     Q = H(1) H(2) . . . H(k), where k = min(m,n).\n*\n*  Each H(i) has the form\n*\n*     H(i) = I - tau * v * v'\n*\n*  where tau is a real scalar, and v is a real vector with\n*  v(n-k+i+1:n) = 0 and v(n-k+i) = 1; v(1:n-k+i-1) is stored on exit in\n*  A(m-k+i,1:n-k+i-1), and tau in TAU(i).\n*\n*  =====================================================================\n*\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  tau, info, a = NumRu::Lapack.dgerq2( a, [:usage => usage, :help => help])\n");
-      return Qnil;
-    } 
-  } else
-    rblapack_options = Qnil;
-  if (argc != 1 && argc != 1)
-    rb_raise(rb_eArgError,"wrong number of arguments (%d for 1)", argc);
-  rblapack_a = argv[0];
-  if (argc == 1) {
-  } 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);
-  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*);
-  m = lda;
-  {
-    int shape[1];
-    shape[0] = MIN(m,n);
-    rblapack_tau = na_make_object(NA_DFLOAT, 1, shape, cNArray);
-  }
-  tau = NA_PTR_TYPE(rblapack_tau, 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, (m));
-
-  dgerq2_(&m, &n, a, &lda, tau, work, &info);
-
-  free(work);
-  rblapack_info = INT2NUM(info);
-  return rb_ary_new3(3, rblapack_tau, rblapack_info, rblapack_a);
-}
-
-void
-init_lapack_dgerq2(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "dgerq2", rblapack_dgerq2, -1);
-}

data/ext/dgerqf.c

@@ -1,103 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID dgerqf_(integer* m, integer* n, doublereal* a, integer* lda, doublereal* tau, doublereal* work, integer* lwork, integer* info);
-
-
-static VALUE
-rblapack_dgerqf(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_m;
-  integer m; 
-  VALUE rblapack_a;
-  doublereal *a; 
-  VALUE rblapack_lwork;
-  integer lwork; 
-  VALUE rblapack_tau;
-  doublereal *tau; 
-  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  tau, work, info, a = NumRu::Lapack.dgerqf( m, a, [:lwork => lwork, :usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE DGERQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )\n\n*  Purpose\n*  =======\n*\n*  DGERQF computes an RQ factorization of a real M-by-N matrix A:\n*  A = R * Q.\n*\n\n*  Arguments\n*  =========\n*\n*  M       (input) INTEGER\n*          The number of rows of the matrix A.  M >= 0.\n*\n*  N       (input) INTEGER\n*          The number of columns of the matrix A.  N >= 0.\n*\n*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)\n*          On entry, the M-by-N matrix A.\n*          On exit,\n*          if m <= n, the upper triangle of the subarray\n*          A(1:m,n-m+1:n) contains the M-by-M upper triangular matrix R;\n*          if m >= n, the elements on and above the (m-n)-th subdiagonal\n*          contain the M-by-N upper trapezoidal matrix R;\n*          the remaining elements, with the array TAU, represent the\n*          orthogonal matrix Q as a product of min(m,n) elementary\n*          reflectors (see Further Details).\n*\n*  LDA     (input) INTEGER\n*          The leading dimension of the array A.  LDA >= max(1,M).\n*\n*  TAU     (output) DOUBLE PRECISION array, dimension (min(M,N))\n*          The scalar factors of the elementary reflectors (see Further\n*          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 dimension of the array WORK.  LWORK >= max(1,M).\n*          For optimum performance LWORK >= M*NB, where NB is\n*          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 matrix Q is represented as a product of elementary reflectors\n*\n*     Q = H(1) H(2) . . . H(k), where k = min(m,n).\n*\n*  Each H(i) has the form\n*\n*     H(i) = I - tau * v * v'\n*\n*  where tau is a real scalar, and v is a real vector with\n*  v(n-k+i+1:n) = 0 and v(n-k+i) = 1; v(1:n-k+i-1) is stored on exit in\n*  A(m-k+i,1:n-k+i-1), and tau in TAU(i).\n*\n*  =====================================================================\n*\n*     .. Local Scalars ..\n      LOGICAL            LQUERY\n      INTEGER            I, IB, IINFO, IWS, K, KI, KK, LDWORK, LWKOPT,\n     $                   MU, NB, NBMIN, NU, NX\n*     ..\n*     .. External Subroutines ..\n      EXTERNAL           DGERQ2, DLARFB, DLARFT, XERBLA\n*     ..\n*     .. Intrinsic Functions ..\n      INTRINSIC          MAX, MIN\n*     ..\n*     .. External Functions ..\n      INTEGER            ILAENV\n      EXTERNAL           ILAENV\n*     ..\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  tau, work, info, a = NumRu::Lapack.dgerqf( 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 (rblapack_lwork == Qnil)
-    lwork = m;
-  else {
-    lwork = NUM2INT(rblapack_lwork);
-  }
-  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_tau = na_make_object(NA_DFLOAT, 1, shape, cNArray);
-  }
-  tau = NA_PTR_TYPE(rblapack_tau, 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__;
-
-  dgerqf_(&m, &n, a, &lda, tau, work, &lwork, &info);
-
-  rblapack_info = INT2NUM(info);
-  return rb_ary_new3(4, rblapack_tau, rblapack_work, rblapack_info, rblapack_a);
-}
-
-void
-init_lapack_dgerqf(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "dgerqf", rblapack_dgerqf, -1);
-}

data/ext/dgesc2.c

@@ -1,108 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID dgesc2_(integer* n, doublereal* a, integer* lda, doublereal* rhs, integer* ipiv, integer* jpiv, doublereal* scale);
-
-
-static VALUE
-rblapack_dgesc2(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_a;
-  doublereal *a; 
-  VALUE rblapack_rhs;
-  doublereal *rhs; 
-  VALUE rblapack_ipiv;
-  integer *ipiv; 
-  VALUE rblapack_jpiv;
-  integer *jpiv; 
-  VALUE rblapack_scale;
-  doublereal scale; 
-  VALUE rblapack_rhs_out__;
-  doublereal *rhs_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  scale, rhs = NumRu::Lapack.dgesc2( a, rhs, ipiv, jpiv, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE DGESC2( N, A, LDA, RHS, IPIV, JPIV, SCALE )\n\n*  Purpose\n*  =======\n*\n*  DGESC2 solves a system of linear equations\n*\n*            A * X = scale* RHS\n*\n*  with a general N-by-N matrix A using the LU factorization with\n*  complete pivoting computed by DGETC2.\n*\n\n*  Arguments\n*  =========\n*\n*  N       (input) INTEGER\n*          The order of the matrix A.\n*\n*  A       (input) DOUBLE PRECISION array, dimension (LDA,N)\n*          On entry, the  LU part of the factorization of the n-by-n\n*          matrix A computed by DGETC2:  A = P * L * U * Q\n*\n*  LDA     (input) INTEGER\n*          The leading dimension of the array A.  LDA >= max(1, N).\n*\n*  RHS     (input/output) DOUBLE PRECISION array, dimension (N).\n*          On entry, the right hand side vector b.\n*          On exit, the solution vector X.\n*\n*  IPIV    (input) INTEGER array, dimension (N).\n*          The pivot indices; for 1 <= i <= N, row i of the\n*          matrix has been interchanged with row IPIV(i).\n*\n*  JPIV    (input) INTEGER array, dimension (N).\n*          The pivot indices; for 1 <= j <= N, column j of the\n*          matrix has been interchanged with column JPIV(j).\n*\n*  SCALE   (output) DOUBLE PRECISION\n*          On exit, SCALE contains the scale factor. SCALE is chosen\n*          0 <= SCALE <= 1 to prevent owerflow in the solution.\n*\n\n*  Further Details\n*  ===============\n*\n*  Based on contributions by\n*     Bo Kagstrom and Peter Poromaa, Department of Computing Science,\n*     Umea University, S-901 87 Umea, Sweden.\n*\n*  =====================================================================\n*\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  scale, rhs = NumRu::Lapack.dgesc2( a, rhs, ipiv, jpiv, [:usage => usage, :help => help])\n");
-      return Qnil;
-    } 
-  } else
-    rblapack_options = Qnil;
-  if (argc != 4 && argc != 4)
-    rb_raise(rb_eArgError,"wrong number of arguments (%d for 4)", argc);
-  rblapack_a = argv[0];
-  rblapack_rhs = argv[1];
-  rblapack_ipiv = argv[2];
-  rblapack_jpiv = argv[3];
-  if (argc == 4) {
-  } 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);
-  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 (!NA_IsNArray(rblapack_ipiv))
-    rb_raise(rb_eArgError, "ipiv (3th argument) must be NArray");
-  if (NA_RANK(rblapack_ipiv) != 1)
-    rb_raise(rb_eArgError, "rank of ipiv (3th argument) must be %d", 1);
-  if (NA_SHAPE0(rblapack_ipiv) != n)
-    rb_raise(rb_eRuntimeError, "shape 0 of ipiv must be the same as shape 1 of a");
-  if (NA_TYPE(rblapack_ipiv) != NA_LINT)
-    rblapack_ipiv = na_change_type(rblapack_ipiv, NA_LINT);
-  ipiv = NA_PTR_TYPE(rblapack_ipiv, integer*);
-  if (!NA_IsNArray(rblapack_rhs))
-    rb_raise(rb_eArgError, "rhs (2th argument) must be NArray");
-  if (NA_RANK(rblapack_rhs) != 1)
-    rb_raise(rb_eArgError, "rank of rhs (2th argument) must be %d", 1);
-  if (NA_SHAPE0(rblapack_rhs) != n)
-    rb_raise(rb_eRuntimeError, "shape 0 of rhs must be the same as shape 1 of a");
-  if (NA_TYPE(rblapack_rhs) != NA_DFLOAT)
-    rblapack_rhs = na_change_type(rblapack_rhs, NA_DFLOAT);
-  rhs = NA_PTR_TYPE(rblapack_rhs, doublereal*);
-  if (!NA_IsNArray(rblapack_jpiv))
-    rb_raise(rb_eArgError, "jpiv (4th argument) must be NArray");
-  if (NA_RANK(rblapack_jpiv) != 1)
-    rb_raise(rb_eArgError, "rank of jpiv (4th argument) must be %d", 1);
-  if (NA_SHAPE0(rblapack_jpiv) != n)
-    rb_raise(rb_eRuntimeError, "shape 0 of jpiv must be the same as shape 1 of a");
-  if (NA_TYPE(rblapack_jpiv) != NA_LINT)
-    rblapack_jpiv = na_change_type(rblapack_jpiv, NA_LINT);
-  jpiv = NA_PTR_TYPE(rblapack_jpiv, integer*);
-  {
-    int shape[1];
-    shape[0] = n;
-    rblapack_rhs_out__ = na_make_object(NA_DFLOAT, 1, shape, cNArray);
-  }
-  rhs_out__ = NA_PTR_TYPE(rblapack_rhs_out__, doublereal*);
-  MEMCPY(rhs_out__, rhs, doublereal, NA_TOTAL(rblapack_rhs));
-  rblapack_rhs = rblapack_rhs_out__;
-  rhs = rhs_out__;
-
-  dgesc2_(&n, a, &lda, rhs, ipiv, jpiv, &scale);
-
-  rblapack_scale = rb_float_new((double)scale);
-  return rb_ary_new3(2, rblapack_scale, rblapack_rhs);
-}
-
-void
-init_lapack_dgesc2(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "dgesc2", rblapack_dgesc2, -1);
-}

data/ext/dgesdd.c

@@ -1,132 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID dgesdd_(char* jobz, integer* m, integer* n, doublereal* a, integer* lda, doublereal* s, doublereal* u, integer* ldu, doublereal* vt, integer* ldvt, doublereal* work, integer* lwork, integer* iwork, integer* info);
-
-
-static VALUE
-rblapack_dgesdd(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_jobz;
-  char jobz; 
-  VALUE rblapack_a;
-  doublereal *a; 
-  VALUE rblapack_lwork;
-  integer lwork; 
-  VALUE rblapack_s;
-  doublereal *s; 
-  VALUE rblapack_u;
-  doublereal *u; 
-  VALUE rblapack_vt;
-  doublereal *vt; 
-  VALUE rblapack_work;
-  doublereal *work; 
-  VALUE rblapack_info;
-  integer info; 
-  VALUE rblapack_a_out__;
-  doublereal *a_out__;
-  integer *iwork;
-
-  integer lda;
-  integer n;
-  integer ldu;
-  integer ucol;
-  integer ldvt;
-  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  s, u, vt, work, info, a = NumRu::Lapack.dgesdd( jobz, a, [:lwork => lwork, :usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, IWORK, INFO )\n\n*  Purpose\n*  =======\n*\n*  DGESDD computes the singular value decomposition (SVD) of a real\n*  M-by-N matrix A, optionally computing the left and right singular\n*  vectors.  If singular vectors are desired, it uses a\n*  divide-and-conquer algorithm.\n*\n*  The SVD is written\n*\n*       A = U * SIGMA * transpose(V)\n*\n*  where SIGMA is an M-by-N matrix which is zero except for its\n*  min(m,n) diagonal elements, U is an M-by-M orthogonal matrix, and\n*  V is an N-by-N orthogonal matrix.  The diagonal elements of SIGMA\n*  are the singular values of A; they are real and non-negative, and\n*  are returned in descending order.  The first min(m,n) columns of\n*  U and V are the left and right singular vectors of A.\n*\n*  Note that the routine returns VT = V**T, not V.\n*\n*  The divide and conquer algorithm makes very mild assumptions about\n*  floating point arithmetic. It will work on machines with a guard\n*  digit in add/subtract, or on those binary machines without guard\n*  digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or\n*  Cray-2. It could conceivably fail on hexadecimal or decimal machines\n*  without guard digits, but we know of none.\n*\n\n*  Arguments\n*  =========\n*\n*  JOBZ    (input) CHARACTER*1\n*          Specifies options for computing all or part of the matrix U:\n*          = 'A':  all M columns of U and all N rows of V**T are\n*                  returned in the arrays U and VT;\n*          = 'S':  the first min(M,N) columns of U and the first\n*                  min(M,N) rows of V**T are returned in the arrays U\n*                  and VT;\n*          = 'O':  If M >= N, the first N columns of U are overwritten\n*                  on the array A and all rows of V**T are returned in\n*                  the array VT;\n*                  otherwise, all columns of U are returned in the\n*                  array U and the first M rows of V**T are overwritten\n*                  in the array A;\n*          = 'N':  no columns of U or rows of V**T are computed.\n*\n*  M       (input) INTEGER\n*          The number of rows of the input matrix A.  M >= 0.\n*\n*  N       (input) INTEGER\n*          The number of columns of the input matrix A.  N >= 0.\n*\n*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)\n*          On entry, the M-by-N matrix A.\n*          On exit,\n*          if JOBZ = 'O',  A is overwritten with the first N columns\n*                          of U (the left singular vectors, stored\n*                          columnwise) if M >= N;\n*                          A is overwritten with the first M rows\n*                          of V**T (the right singular vectors, stored\n*                          rowwise) otherwise.\n*          if JOBZ .ne. 'O', the contents of A are destroyed.\n*\n*  LDA     (input) INTEGER\n*          The leading dimension of the array A.  LDA >= max(1,M).\n*\n*  S       (output) DOUBLE PRECISION array, dimension (min(M,N))\n*          The singular values of A, sorted so that S(i) >= S(i+1).\n*\n*  U       (output) DOUBLE PRECISION array, dimension (LDU,UCOL)\n*          UCOL = M if JOBZ = 'A' or JOBZ = 'O' and M < N;\n*          UCOL = min(M,N) if JOBZ = 'S'.\n*          If JOBZ = 'A' or JOBZ = 'O' and M < N, U contains the M-by-M\n*          orthogonal matrix U;\n*          if JOBZ = 'S', U contains the first min(M,N) columns of U\n*          (the left singular vectors, stored columnwise);\n*          if JOBZ = 'O' and M >= N, or JOBZ = 'N', U is not referenced.\n*\n*  LDU     (input) INTEGER\n*          The leading dimension of the array U.  LDU >= 1; if\n*          JOBZ = 'S' or 'A' or JOBZ = 'O' and M < N, LDU >= M.\n*\n*  VT      (output) DOUBLE PRECISION array, dimension (LDVT,N)\n*          If JOBZ = 'A' or JOBZ = 'O' and M >= N, VT contains the\n*          N-by-N orthogonal matrix V**T;\n*          if JOBZ = 'S', VT contains the first min(M,N) rows of\n*          V**T (the right singular vectors, stored rowwise);\n*          if JOBZ = 'O' and M < N, or JOBZ = 'N', VT is not referenced.\n*\n*  LDVT    (input) INTEGER\n*          The leading dimension of the array VT.  LDVT >= 1; if\n*          JOBZ = 'A' or JOBZ = 'O' and M >= N, LDVT >= N;\n*          if JOBZ = 'S', LDVT >= min(M,N).\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 dimension of the array WORK. LWORK >= 1.\n*          If JOBZ = 'N',\n*            LWORK >= 3*min(M,N) + max(max(M,N),7*min(M,N)).\n*          If JOBZ = 'O',\n*            LWORK >= 3*min(M,N) + \n*                     max(max(M,N),5*min(M,N)*min(M,N)+4*min(M,N)).\n*          If JOBZ = 'S' or 'A'\n*            LWORK >= 3*min(M,N) +\n*                     max(max(M,N),4*min(M,N)*min(M,N)+4*min(M,N)).\n*          For good performance, LWORK should generally be larger.\n*          If LWORK = -1 but other input arguments are legal, WORK(1)\n*          returns the optimal LWORK.\n*\n*  IWORK   (workspace) INTEGER array, dimension (8*min(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*          > 0:  DBDSDC did not converge, updating process failed.\n*\n\n*  Further Details\n*  ===============\n*\n*  Based on contributions by\n*     Ming Gu and Huan Ren, 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  s, u, vt, work, info, a = NumRu::Lapack.dgesdd( jobz, 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_jobz = 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;
-  }
-
-  jobz = StringValueCStr(rblapack_jobz)[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*);
-  m = lda;
-  ldvt = ((lsame_(&jobz,"A")) || (((lsame_(&jobz,"O")) && (m >= n)))) ? n : lsame_(&jobz,"S") ? MIN(m,n) : 1;
-  if (rblapack_lwork == Qnil)
-    lwork = lsame_(&jobz,"N") ? 3*MIN(m,n)+MAX(MAX(m,n),7*MIN(m,n)) : lsame_(&jobz,"O") ? 3*MIN(m,n)+MAX(MAX(m,n),5*MIN(m,n)*MIN(m,n)+4*MIN(m,n)) : (lsame_(&jobz,"S")||lsame_(&jobz,"A")) ? 3*MIN(m,n)+MAX(MAX(m,n),4*MIN(m,n)*MIN(m,n)+4*MIN(m,n)) : 0;
-  else {
-    lwork = NUM2INT(rblapack_lwork);
-  }
-  ldu = (lsame_(&jobz,"S") || lsame_(&jobz,"A") || (lsame_(&jobz,"O") && m < n)) ? m : 1;
-  ucol = ((lsame_(&jobz,"A")) || (((lsame_(&jobz,"O")) && (m < n)))) ? m : lsame_(&jobz,"S") ? MIN(m,n) : 0;
-  {
-    int shape[1];
-    shape[0] = MIN(m,n);
-    rblapack_s = na_make_object(NA_DFLOAT, 1, shape, cNArray);
-  }
-  s = NA_PTR_TYPE(rblapack_s, doublereal*);
-  {
-    int shape[2];
-    shape[0] = ldu;
-    shape[1] = ucol;
-    rblapack_u = na_make_object(NA_DFLOAT, 2, shape, cNArray);
-  }
-  u = NA_PTR_TYPE(rblapack_u, doublereal*);
-  {
-    int shape[2];
-    shape[0] = ldvt;
-    shape[1] = n;
-    rblapack_vt = na_make_object(NA_DFLOAT, 2, shape, cNArray);
-  }
-  vt = NA_PTR_TYPE(rblapack_vt, 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__;
-  iwork = ALLOC_N(integer, (8*MIN(m,n)));
-
-  dgesdd_(&jobz, &m, &n, a, &lda, s, u, &ldu, vt, &ldvt, work, &lwork, iwork, &info);
-
-  free(iwork);
-  rblapack_info = INT2NUM(info);
-  return rb_ary_new3(6, rblapack_s, rblapack_u, rblapack_vt, rblapack_work, rblapack_info, rblapack_a);
-}
-
-void
-init_lapack_dgesdd(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "dgesdd", rblapack_dgesdd, -1);
-}

data/ext/dgesv.c

@@ -1,107 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID dgesv_(integer* n, integer* nrhs, doublereal* a, integer* lda, integer* ipiv, doublereal* b, integer* ldb, integer* info);
-
-
-static VALUE
-rblapack_dgesv(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_a;
-  doublereal *a; 
-  VALUE rblapack_b;
-  doublereal *b; 
-  VALUE rblapack_ipiv;
-  integer *ipiv; 
-  VALUE rblapack_info;
-  integer info; 
-  VALUE rblapack_a_out__;
-  doublereal *a_out__;
-  VALUE rblapack_b_out__;
-  doublereal *b_out__;
-
-  integer lda;
-  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  ipiv, info, a, b = NumRu::Lapack.dgesv( a, b, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE DGESV( N, NRHS, A, LDA, IPIV, B, LDB, INFO )\n\n*  Purpose\n*  =======\n*\n*  DGESV computes the solution to a real system of linear equations\n*     A * X = B,\n*  where A is an N-by-N matrix and X and B are N-by-NRHS matrices.\n*\n*  The LU decomposition with partial pivoting and row interchanges is\n*  used to factor A as\n*     A = P * L * U,\n*  where P is a permutation matrix, L is unit lower triangular, and U is\n*  upper triangular.  The factored form of A is then used to solve the\n*  system of equations A * X = B.\n*\n\n*  Arguments\n*  =========\n*\n*  N       (input) INTEGER\n*          The number of linear equations, i.e., the order of the\n*          matrix A.  N >= 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*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)\n*          On entry, the N-by-N coefficient matrix A.\n*          On exit, the factors L and U from the factorization\n*          A = P*L*U; the unit diagonal elements of L are not stored.\n*\n*  LDA     (input) INTEGER\n*          The leading dimension of the array A.  LDA >= max(1,N).\n*\n*  IPIV    (output) INTEGER array, dimension (N)\n*          The pivot indices that define the permutation matrix P;\n*          row i of the matrix was interchanged with row IPIV(i).\n*\n*  B       (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)\n*          On entry, the N-by-NRHS matrix of right hand side matrix B.\n*          On exit, if INFO = 0, the N-by-NRHS 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*          > 0:  if INFO = i, U(i,i) is exactly zero.  The factorization\n*                has been completed, but the factor U is exactly\n*                singular, so the solution could not be computed.\n*\n\n*  =====================================================================\n*\n*     .. External Subroutines ..\n      EXTERNAL           DGETRF, DGETRS, XERBLA\n*     ..\n*     .. Intrinsic Functions ..\n      INTRINSIC          MAX\n*     ..\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  ipiv, info, a, b = NumRu::Lapack.dgesv( 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);
-  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 (!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);
-  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*);
-  {
-    int shape[1];
-    shape[0] = n;
-    rblapack_ipiv = na_make_object(NA_LINT, 1, shape, cNArray);
-  }
-  ipiv = NA_PTR_TYPE(rblapack_ipiv, integer*);
-  {
-    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__;
-  {
-    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__;
-
-  dgesv_(&n, &nrhs, a, &lda, ipiv, b, &ldb, &info);
-
-  rblapack_info = INT2NUM(info);
-  return rb_ary_new3(4, rblapack_ipiv, rblapack_info, rblapack_a, rblapack_b);
-}
-
-void
-init_lapack_dgesv(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "dgesv", rblapack_dgesv, -1);
-}