ruby-lapack 1.6 → 1.7

data/ext/sgetrf.c

@@ -1,85 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID sgetrf_(integer* m, integer* n, real* a, integer* lda, integer* ipiv, integer* info);
-
-
-static VALUE
-rblapack_sgetrf(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_m;
-  integer m; 
-  VALUE rblapack_a;
-  real *a; 
-  VALUE rblapack_ipiv;
-  integer *ipiv; 
-  VALUE rblapack_info;
-  integer info; 
-  VALUE rblapack_a_out__;
-  real *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  ipiv, info, a = NumRu::Lapack.sgetrf( m, a, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE SGETRF( M, N, A, LDA, IPIV, INFO )\n\n*  Purpose\n*  =======\n*\n*  SGETRF computes an LU factorization of a general M-by-N matrix A\n*  using partial pivoting with row interchanges.\n*\n*  The factorization has the form\n*     A = P * L * U\n*  where P is a permutation matrix, L is lower triangular with unit\n*  diagonal elements (lower trapezoidal if m > n), and U is upper\n*  triangular (upper trapezoidal if m < n).\n*\n*  This is the right-looking Level 3 BLAS version of the algorithm.\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) REAL array, dimension (LDA,N)\n*          On entry, the M-by-N matrix to be factored.\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,M).\n*\n*  IPIV    (output) INTEGER array, dimension (min(M,N))\n*          The pivot indices; for 1 <= i <= min(M,N), row i of the\n*          matrix was interchanged with row IPIV(i).\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, and division by zero will occur if it is used\n*                to solve a system of equations.\n*\n\n*  =====================================================================\n*\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  ipiv, info, a = NumRu::Lapack.sgetrf( 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_SFLOAT)
-    rblapack_a = na_change_type(rblapack_a, NA_SFLOAT);
-  a = NA_PTR_TYPE(rblapack_a, real*);
-  {
-    int shape[1];
-    shape[0] = MIN(m,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_SFLOAT, 2, shape, cNArray);
-  }
-  a_out__ = NA_PTR_TYPE(rblapack_a_out__, real*);
-  MEMCPY(a_out__, a, real, NA_TOTAL(rblapack_a));
-  rblapack_a = rblapack_a_out__;
-  a = a_out__;
-
-  sgetrf_(&m, &n, a, &lda, ipiv, &info);
-
-  rblapack_info = INT2NUM(info);
-  return rb_ary_new3(3, rblapack_ipiv, rblapack_info, rblapack_a);
-}
-
-void
-init_lapack_sgetrf(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "sgetrf", rblapack_sgetrf, -1);
-}

data/ext/sgetri.c

@@ -1,103 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID sgetri_(integer* n, real* a, integer* lda, integer* ipiv, real* work, integer* lwork, integer* info);
-
-
-static VALUE
-rblapack_sgetri(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_a;
-  real *a; 
-  VALUE rblapack_ipiv;
-  integer *ipiv; 
-  VALUE rblapack_lwork;
-  integer lwork; 
-  VALUE rblapack_work;
-  real *work; 
-  VALUE rblapack_info;
-  integer info; 
-  VALUE rblapack_a_out__;
-  real *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  work, info, a = NumRu::Lapack.sgetri( a, ipiv, [:lwork => lwork, :usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE SGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO )\n\n*  Purpose\n*  =======\n*\n*  SGETRI computes the inverse of a matrix using the LU factorization\n*  computed by SGETRF.\n*\n*  This method inverts U and then computes inv(A) by solving the system\n*  inv(A)*L = inv(U) for inv(A).\n*\n\n*  Arguments\n*  =========\n*\n*  N       (input) INTEGER\n*          The order of the matrix A.  N >= 0.\n*\n*  A       (input/output) REAL array, dimension (LDA,N)\n*          On entry, the factors L and U from the factorization\n*          A = P*L*U as computed by SGETRF.\n*          On exit, if INFO = 0, the inverse of the original matrix A.\n*\n*  LDA     (input) INTEGER\n*          The leading dimension of the array A.  LDA >= max(1,N).\n*\n*  IPIV    (input) INTEGER array, dimension (N)\n*          The pivot indices from SGETRF; for 1<=i<=N, row i of the\n*          matrix was interchanged with row IPIV(i).\n*\n*  WORK    (workspace/output) REAL array, dimension (MAX(1,LWORK))\n*          On exit, if INFO=0, then WORK(1) returns the optimal LWORK.\n*\n*  LWORK   (input) INTEGER\n*          The dimension of the array WORK.  LWORK >= max(1,N).\n*          For optimal performance LWORK >= N*NB, where NB is\n*          the optimal blocksize returned by ILAENV.\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*          > 0:  if INFO = i, U(i,i) is exactly zero; the matrix is\n*                singular and its inverse could not be computed.\n*\n\n*  =====================================================================\n*\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  work, info, a = NumRu::Lapack.sgetri( a, ipiv, [: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_a = argv[0];
-  rblapack_ipiv = 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;
-  }
-
-  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_SFLOAT)
-    rblapack_a = na_change_type(rblapack_a, NA_SFLOAT);
-  a = NA_PTR_TYPE(rblapack_a, real*);
-  if (!NA_IsNArray(rblapack_ipiv))
-    rb_raise(rb_eArgError, "ipiv (2th argument) must be NArray");
-  if (NA_RANK(rblapack_ipiv) != 1)
-    rb_raise(rb_eArgError, "rank of ipiv (2th 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 (rblapack_lwork == Qnil)
-    lwork = n;
-  else {
-    lwork = NUM2INT(rblapack_lwork);
-  }
-  {
-    int shape[1];
-    shape[0] = MAX(1,lwork);
-    rblapack_work = na_make_object(NA_SFLOAT, 1, shape, cNArray);
-  }
-  work = NA_PTR_TYPE(rblapack_work, real*);
-  {
-    int shape[2];
-    shape[0] = lda;
-    shape[1] = n;
-    rblapack_a_out__ = na_make_object(NA_SFLOAT, 2, shape, cNArray);
-  }
-  a_out__ = NA_PTR_TYPE(rblapack_a_out__, real*);
-  MEMCPY(a_out__, a, real, NA_TOTAL(rblapack_a));
-  rblapack_a = rblapack_a_out__;
-  a = a_out__;
-
-  sgetri_(&n, a, &lda, ipiv, work, &lwork, &info);
-
-  rblapack_info = INT2NUM(info);
-  return rb_ary_new3(3, rblapack_work, rblapack_info, rblapack_a);
-}
-
-void
-init_lapack_sgetri(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "sgetri", rblapack_sgetri, -1);
-}

data/ext/sgetrs.c

@@ -1,103 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID sgetrs_(char* trans, integer* n, integer* nrhs, real* a, integer* lda, integer* ipiv, real* b, integer* ldb, integer* info);
-
-
-static VALUE
-rblapack_sgetrs(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_trans;
-  char trans; 
-  VALUE rblapack_a;
-  real *a; 
-  VALUE rblapack_ipiv;
-  integer *ipiv; 
-  VALUE rblapack_b;
-  real *b; 
-  VALUE rblapack_info;
-  integer info; 
-  VALUE rblapack_b_out__;
-  real *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  info, b = NumRu::Lapack.sgetrs( trans, a, ipiv, b, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE SGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO )\n\n*  Purpose\n*  =======\n*\n*  SGETRS solves a system of linear equations\n*     A * X = B  or  A' * X = B\n*  with a general N-by-N matrix A using the LU factorization computed\n*  by SGETRF.\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*  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) REAL array, dimension (LDA,N)\n*          The factors L and U from the factorization A = P*L*U\n*          as computed by SGETRF.\n*\n*  LDA     (input) INTEGER\n*          The leading dimension of the array A.  LDA >= max(1,N).\n*\n*  IPIV    (input) INTEGER array, dimension (N)\n*          The pivot indices from SGETRF; for 1<=i<=N, row i of the\n*          matrix was interchanged with row IPIV(i).\n*\n*  B       (input/output) REAL 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.sgetrs( trans, a, ipiv, b, [: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_trans = argv[0];
-  rblapack_a = argv[1];
-  rblapack_ipiv = argv[2];
-  rblapack_b = argv[3];
-  if (argc == 4) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  trans = StringValueCStr(rblapack_trans)[0];
-  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);
-  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*);
-  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 ipiv");
-  if (NA_TYPE(rblapack_a) != NA_SFLOAT)
-    rblapack_a = na_change_type(rblapack_a, NA_SFLOAT);
-  a = NA_PTR_TYPE(rblapack_a, real*);
-  if (!NA_IsNArray(rblapack_b))
-    rb_raise(rb_eArgError, "b (4th argument) must be NArray");
-  if (NA_RANK(rblapack_b) != 2)
-    rb_raise(rb_eArgError, "rank of b (4th argument) must be %d", 2);
-  ldb = NA_SHAPE0(rblapack_b);
-  nrhs = NA_SHAPE1(rblapack_b);
-  if (NA_TYPE(rblapack_b) != NA_SFLOAT)
-    rblapack_b = na_change_type(rblapack_b, NA_SFLOAT);
-  b = NA_PTR_TYPE(rblapack_b, real*);
-  {
-    int shape[2];
-    shape[0] = ldb;
-    shape[1] = nrhs;
-    rblapack_b_out__ = na_make_object(NA_SFLOAT, 2, shape, cNArray);
-  }
-  b_out__ = NA_PTR_TYPE(rblapack_b_out__, real*);
-  MEMCPY(b_out__, b, real, NA_TOTAL(rblapack_b));
-  rblapack_b = rblapack_b_out__;
-  b = b_out__;
-
-  sgetrs_(&trans, &n, &nrhs, a, &lda, ipiv, b, &ldb, &info);
-
-  rblapack_info = INT2NUM(info);
-  return rb_ary_new3(2, rblapack_info, rblapack_b);
-}
-
-void
-init_lapack_sgetrs(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "sgetrs", rblapack_sgetrs, -1);
-}

data/ext/sggbak.c

@@ -1,113 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID sggbak_(char* job, char* side, integer* n, integer* ilo, integer* ihi, real* lscale, real* rscale, integer* m, real* v, integer* ldv, integer* info);
-
-
-static VALUE
-rblapack_sggbak(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_lscale;
-  real *lscale; 
-  VALUE rblapack_rscale;
-  real *rscale; 
-  VALUE rblapack_v;
-  real *v; 
-  VALUE rblapack_info;
-  integer info; 
-  VALUE rblapack_v_out__;
-  real *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.sggbak( job, side, ilo, ihi, lscale, rscale, v, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE SGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, LDV, INFO )\n\n*  Purpose\n*  =======\n*\n*  SGGBAK forms the right or left eigenvectors of a real generalized\n*  eigenvalue problem A*x = lambda*B*x, by backward transformation on\n*  the computed eigenvectors of the balanced pair of matrices output by\n*  SGGBAL.\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 SGGBAL.\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 SGGBAL.\n*          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.\n*\n*  LSCALE  (input) REAL array, dimension (N)\n*          Details of the permutations and/or scaling factors applied\n*          to the left side of A and B, as returned by SGGBAL.\n*\n*  RSCALE  (input) REAL array, dimension (N)\n*          Details of the permutations and/or scaling factors applied\n*          to the right side of A and B, as returned by SGGBAL.\n*\n*  M       (input) INTEGER\n*          The number of columns of the matrix V.  M >= 0.\n*\n*  V       (input/output) REAL array, dimension (LDV,M)\n*          On entry, the matrix of right or left eigenvectors to be\n*          transformed, as returned by STGEVC.\n*          On exit, V is overwritten by the transformed eigenvectors.\n*\n*  LDV     (input) INTEGER\n*          The leading dimension of the matrix 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*  Further Details\n*  ===============\n*\n*  See R.C. Ward, Balancing the generalized eigenvalue problem,\n*                 SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.\n*\n*  =====================================================================\n*\n*     .. Local Scalars ..\n      LOGICAL            LEFTV, RIGHTV\n      INTEGER            I, K\n*     ..\n*     .. External Functions ..\n      LOGICAL            LSAME\n      EXTERNAL           LSAME\n*     ..\n*     .. External Subroutines ..\n      EXTERNAL           SSCAL, SSWAP, 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  info, v = NumRu::Lapack.sggbak( job, side, ilo, ihi, lscale, rscale, v, [:usage => usage, :help => help])\n");
-      return Qnil;
-    } 
-  } else
-    rblapack_options = Qnil;
-  if (argc != 7 && argc != 7)
-    rb_raise(rb_eArgError,"wrong number of arguments (%d for 7)", argc);
-  rblapack_job = argv[0];
-  rblapack_side = argv[1];
-  rblapack_ilo = argv[2];
-  rblapack_ihi = argv[3];
-  rblapack_lscale = argv[4];
-  rblapack_rscale = argv[5];
-  rblapack_v = argv[6];
-  if (argc == 7) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  job = StringValueCStr(rblapack_job)[0];
-  ilo = NUM2INT(rblapack_ilo);
-  if (!NA_IsNArray(rblapack_lscale))
-    rb_raise(rb_eArgError, "lscale (5th argument) must be NArray");
-  if (NA_RANK(rblapack_lscale) != 1)
-    rb_raise(rb_eArgError, "rank of lscale (5th argument) must be %d", 1);
-  n = NA_SHAPE0(rblapack_lscale);
-  if (NA_TYPE(rblapack_lscale) != NA_SFLOAT)
-    rblapack_lscale = na_change_type(rblapack_lscale, NA_SFLOAT);
-  lscale = NA_PTR_TYPE(rblapack_lscale, real*);
-  if (!NA_IsNArray(rblapack_v))
-    rb_raise(rb_eArgError, "v (7th argument) must be NArray");
-  if (NA_RANK(rblapack_v) != 2)
-    rb_raise(rb_eArgError, "rank of v (7th argument) must be %d", 2);
-  ldv = NA_SHAPE0(rblapack_v);
-  m = NA_SHAPE1(rblapack_v);
-  if (NA_TYPE(rblapack_v) != NA_SFLOAT)
-    rblapack_v = na_change_type(rblapack_v, NA_SFLOAT);
-  v = NA_PTR_TYPE(rblapack_v, real*);
-  side = StringValueCStr(rblapack_side)[0];
-  if (!NA_IsNArray(rblapack_rscale))
-    rb_raise(rb_eArgError, "rscale (6th argument) must be NArray");
-  if (NA_RANK(rblapack_rscale) != 1)
-    rb_raise(rb_eArgError, "rank of rscale (6th argument) must be %d", 1);
-  if (NA_SHAPE0(rblapack_rscale) != n)
-    rb_raise(rb_eRuntimeError, "shape 0 of rscale must be the same as shape 0 of lscale");
-  if (NA_TYPE(rblapack_rscale) != NA_SFLOAT)
-    rblapack_rscale = na_change_type(rblapack_rscale, NA_SFLOAT);
-  rscale = NA_PTR_TYPE(rblapack_rscale, real*);
-  ihi = NUM2INT(rblapack_ihi);
-  {
-    int shape[2];
-    shape[0] = ldv;
-    shape[1] = m;
-    rblapack_v_out__ = na_make_object(NA_SFLOAT, 2, shape, cNArray);
-  }
-  v_out__ = NA_PTR_TYPE(rblapack_v_out__, real*);
-  MEMCPY(v_out__, v, real, NA_TOTAL(rblapack_v));
-  rblapack_v = rblapack_v_out__;
-  v = v_out__;
-
-  sggbak_(&job, &side, &n, &ilo, &ihi, lscale, rscale, &m, v, &ldv, &info);
-
-  rblapack_info = INT2NUM(info);
-  return rb_ary_new3(2, rblapack_info, rblapack_v);
-}
-
-void
-init_lapack_sggbak(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "sggbak", rblapack_sggbak, -1);
-}

data/ext/sggbal.c

@@ -1,128 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID sggbal_(char* job, integer* n, real* a, integer* lda, real* b, integer* ldb, integer* ilo, integer* ihi, real* lscale, real* rscale, real* work, integer* info);
-
-
-static VALUE
-rblapack_sggbal(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_job;
-  char job; 
-  VALUE rblapack_a;
-  real *a; 
-  VALUE rblapack_b;
-  real *b; 
-  VALUE rblapack_ilo;
-  integer ilo; 
-  VALUE rblapack_ihi;
-  integer ihi; 
-  VALUE rblapack_lscale;
-  real *lscale; 
-  VALUE rblapack_rscale;
-  real *rscale; 
-  VALUE rblapack_info;
-  integer info; 
-  VALUE rblapack_a_out__;
-  real *a_out__;
-  VALUE rblapack_b_out__;
-  real *b_out__;
-  real *work;
-
-  integer lda;
-  integer n;
-  integer ldb;
-
-  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, lscale, rscale, info, a, b = NumRu::Lapack.sggbal( job, a, b, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE SGGBAL( JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, WORK, INFO )\n\n*  Purpose\n*  =======\n*\n*  SGGBAL balances a pair of general real matrices (A,B).  This\n*  involves, first, permuting A and B by similarity transformations to\n*  isolate eigenvalues in the first 1 to ILO$-$1 and last IHI+1 to N\n*  elements on the diagonal; and second, applying a diagonal similarity\n*  transformation to rows and columns ILO to IHI to make the rows\n*  and columns as close in norm as possible. Both steps are optional.\n*\n*  Balancing may reduce the 1-norm of the matrices, and improve the\n*  accuracy of the computed eigenvalues and/or eigenvectors in the\n*  generalized eigenvalue problem A*x = lambda*B*x.\n*\n\n*  Arguments\n*  =========\n*\n*  JOB     (input) CHARACTER*1\n*          Specifies the operations to be performed on A and B:\n*          = 'N':  none:  simply set ILO = 1, IHI = N, LSCALE(I) = 1.0\n*                  and RSCALE(I) = 1.0 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 matrices A and B.  N >= 0.\n*\n*  A       (input/output) REAL 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*\n*  LDA     (input) INTEGER\n*          The leading dimension of the array A. LDA >= max(1,N).\n*\n*  B       (input/output) REAL array, dimension (LDB,N)\n*          On entry, the input matrix B.\n*          On exit,  B is overwritten by the balanced matrix.\n*          If JOB = 'N', B is not referenced.\n*\n*  LDB     (input) INTEGER\n*          The leading dimension of the array B. LDB >= 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 and B(i,j) = 0 if i > j and\n*          j = 1,...,ILO-1 or i = IHI+1,...,N.\n*          If JOB = 'N' or 'S', ILO = 1 and IHI = N.\n*\n*  LSCALE  (output) REAL array, dimension (N)\n*          Details of the permutations and scaling factors applied\n*          to the left side of A and B.  If P(j) is the index of the\n*          row interchanged with row j, and D(j)\n*          is the scaling factor applied to row j, then\n*            LSCALE(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*  RSCALE  (output) REAL array, dimension (N)\n*          Details of the permutations and scaling factors applied\n*          to the right side of A and B.  If P(j) is the index of the\n*          column interchanged with column j, and D(j)\n*          is the scaling factor applied to column j, then\n*            LSCALE(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*  WORK    (workspace) REAL array, dimension (lwork)\n*          lwork must be at least max(1,6*N) when JOB = 'S' or 'B', and\n*          at least 1 when JOB = 'N' or 'P'.\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*  See R.C. WARD, Balancing the generalized eigenvalue problem,\n*                 SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.\n*\n*  =====================================================================\n*\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  ilo, ihi, lscale, rscale, info, a, b = NumRu::Lapack.sggbal( job, a, b, [:usage => usage, :help => help])\n");
-      return Qnil;
-    } 
-  } else
-    rblapack_options = Qnil;
-  if (argc != 3 && argc != 3)
-    rb_raise(rb_eArgError,"wrong number of arguments (%d for 3)", argc);
-  rblapack_job = argv[0];
-  rblapack_a = argv[1];
-  rblapack_b = argv[2];
-  if (argc == 3) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  job = StringValueCStr(rblapack_job)[0];
-  if (!NA_IsNArray(rblapack_b))
-    rb_raise(rb_eArgError, "b (3th argument) must be NArray");
-  if (NA_RANK(rblapack_b) != 2)
-    rb_raise(rb_eArgError, "rank of b (3th argument) must be %d", 2);
-  ldb = NA_SHAPE0(rblapack_b);
-  n = NA_SHAPE1(rblapack_b);
-  if (NA_TYPE(rblapack_b) != NA_SFLOAT)
-    rblapack_b = na_change_type(rblapack_b, NA_SFLOAT);
-  b = NA_PTR_TYPE(rblapack_b, real*);
-  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 1 of b");
-  if (NA_TYPE(rblapack_a) != NA_SFLOAT)
-    rblapack_a = na_change_type(rblapack_a, NA_SFLOAT);
-  a = NA_PTR_TYPE(rblapack_a, real*);
-  {
-    int shape[1];
-    shape[0] = n;
-    rblapack_lscale = na_make_object(NA_SFLOAT, 1, shape, cNArray);
-  }
-  lscale = NA_PTR_TYPE(rblapack_lscale, real*);
-  {
-    int shape[1];
-    shape[0] = n;
-    rblapack_rscale = na_make_object(NA_SFLOAT, 1, shape, cNArray);
-  }
-  rscale = NA_PTR_TYPE(rblapack_rscale, real*);
-  {
-    int shape[2];
-    shape[0] = lda;
-    shape[1] = n;
-    rblapack_a_out__ = na_make_object(NA_SFLOAT, 2, shape, cNArray);
-  }
-  a_out__ = NA_PTR_TYPE(rblapack_a_out__, real*);
-  MEMCPY(a_out__, a, real, NA_TOTAL(rblapack_a));
-  rblapack_a = rblapack_a_out__;
-  a = a_out__;
-  {
-    int shape[2];
-    shape[0] = ldb;
-    shape[1] = n;
-    rblapack_b_out__ = na_make_object(NA_SFLOAT, 2, shape, cNArray);
-  }
-  b_out__ = NA_PTR_TYPE(rblapack_b_out__, real*);
-  MEMCPY(b_out__, b, real, NA_TOTAL(rblapack_b));
-  rblapack_b = rblapack_b_out__;
-  b = b_out__;
-  work = ALLOC_N(real, ((lsame_(&job,"S")||lsame_(&job,"B")) ? MAX(1,6*n) : (lsame_(&job,"N")||lsame_(&job,"P")) ? 1 : 0));
-
-  sggbal_(&job, &n, a, &lda, b, &ldb, &ilo, &ihi, lscale, rscale, work, &info);
-
-  free(work);
-  rblapack_ilo = INT2NUM(ilo);
-  rblapack_ihi = INT2NUM(ihi);
-  rblapack_info = INT2NUM(info);
-  return rb_ary_new3(7, rblapack_ilo, rblapack_ihi, rblapack_lscale, rblapack_rscale, rblapack_info, rblapack_a, rblapack_b);
-}
-
-void
-init_lapack_sggbal(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "sggbal", rblapack_sggbal, -1);
-}