ruby-lapack 1.7 → 1.7.1

data/ext/zgbtf2.c

@@ -0,0 +1,93 @@
+#include "rb_lapack.h"
+
+extern VOID zgbtf2_(integer* m, integer* n, integer* kl, integer* ku, doublecomplex* ab, integer* ldab, integer* ipiv, integer* info);
+
+
+static VALUE
+rblapack_zgbtf2(int argc, VALUE *argv, VALUE self){
+  VALUE rblapack_m;
+  integer m; 
+  VALUE rblapack_kl;
+  integer kl; 
+  VALUE rblapack_ku;
+  integer ku; 
+  VALUE rblapack_ab;
+  doublecomplex *ab; 
+  VALUE rblapack_ipiv;
+  integer *ipiv; 
+  VALUE rblapack_info;
+  integer info; 
+  VALUE rblapack_ab_out__;
+  doublecomplex *ab_out__;
+
+  integer ldab;
+  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, ab = NumRu::Lapack.zgbtf2( m, kl, ku, ab, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE ZGBTF2( M, N, KL, KU, AB, LDAB, IPIV, INFO )\n\n*  Purpose\n*  =======\n*\n*  ZGBTF2 computes an LU factorization of a complex m-by-n band matrix\n*  A using partial pivoting with row interchanges.\n*\n*  This is the unblocked version of the algorithm, calling Level 2 BLAS.\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*  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*  AB      (input/output) COMPLEX*16 array, dimension (LDAB,N)\n*          On entry, the matrix A in band storage, in rows KL+1 to\n*          2*KL+KU+1; rows 1 to KL of the array need not be set.\n*          The j-th column of A is stored in the j-th column of the\n*          array AB as follows:\n*          AB(kl+ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)\n*\n*          On exit, details of the factorization: U is stored as an\n*          upper triangular band matrix with KL+KU superdiagonals in\n*          rows 1 to KL+KU+1, and the multipliers used during the\n*          factorization are stored in rows KL+KU+2 to 2*KL+KU+1.\n*          See below for further details.\n*\n*  LDAB    (input) INTEGER\n*          The leading dimension of the array AB.  LDAB >= 2*KL+KU+1.\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*  Further Details\n*  ===============\n*\n*  The band storage scheme is illustrated by the following example, when\n*  M = N = 6, KL = 2, KU = 1:\n*\n*  On entry:                       On exit:\n*\n*      *    *    *    +    +    +       *    *    *   u14  u25  u36\n*      *    *    +    +    +    +       *    *   u13  u24  u35  u46\n*      *   a12  a23  a34  a45  a56      *   u12  u23  u34  u45  u56\n*     a11  a22  a33  a44  a55  a66     u11  u22  u33  u44  u55  u66\n*     a21  a32  a43  a54  a65   *      m21  m32  m43  m54  m65   *\n*     a31  a42  a53  a64   *    *      m31  m42  m53  m64   *    *\n*\n*  Array elements marked * are not used by the routine; elements marked\n*  + need not be set on entry, but are required by the routine to store\n*  elements of U, because of fill-in resulting from the row\n*  interchanges.\n*\n*  =====================================================================\n*\n\n");
+      return Qnil;
+    }
+    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
+      printf("%s\n", "USAGE:\n  ipiv, info, ab = NumRu::Lapack.zgbtf2( m, kl, ku, ab, [: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_m = argv[0];
+  rblapack_kl = argv[1];
+  rblapack_ku = argv[2];
+  rblapack_ab = argv[3];
+  if (argc == 4) {
+  } else if (rblapack_options != Qnil) {
+  } else {
+  }
+
+  m = NUM2INT(rblapack_m);
+  ku = NUM2INT(rblapack_ku);
+  kl = NUM2INT(rblapack_kl);
+  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);
+  n = NA_SHAPE1(rblapack_ab);
+  if (NA_TYPE(rblapack_ab) != NA_DCOMPLEX)
+    rblapack_ab = na_change_type(rblapack_ab, NA_DCOMPLEX);
+  ab = NA_PTR_TYPE(rblapack_ab, doublecomplex*);
+  {
+    na_shape_t shape[1];
+    shape[0] = MIN(m,n);
+    rblapack_ipiv = na_make_object(NA_LINT, 1, shape, cNArray);
+  }
+  ipiv = NA_PTR_TYPE(rblapack_ipiv, integer*);
+  {
+    na_shape_t shape[2];
+    shape[0] = ldab;
+    shape[1] = n;
+    rblapack_ab_out__ = na_make_object(NA_DCOMPLEX, 2, shape, cNArray);
+  }
+  ab_out__ = NA_PTR_TYPE(rblapack_ab_out__, doublecomplex*);
+  MEMCPY(ab_out__, ab, doublecomplex, NA_TOTAL(rblapack_ab));
+  rblapack_ab = rblapack_ab_out__;
+  ab = ab_out__;
+
+  zgbtf2_(&m, &n, &kl, &ku, ab, &ldab, ipiv, &info);
+
+  rblapack_info = INT2NUM(info);
+  return rb_ary_new3(3, rblapack_ipiv, rblapack_info, rblapack_ab);
+}
+
+void
+init_lapack_zgbtf2(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
+  sHelp = sH;
+  sUsage = sU;
+  rblapack_ZERO = zero;
+
+  rb_define_module_function(mLapack, "zgbtf2", rblapack_zgbtf2, -1);
+}

data/ext/zgbtrf.c

@@ -0,0 +1,93 @@
+#include "rb_lapack.h"
+
+extern VOID zgbtrf_(integer* m, integer* n, integer* kl, integer* ku, doublecomplex* ab, integer* ldab, integer* ipiv, integer* info);
+
+
+static VALUE
+rblapack_zgbtrf(int argc, VALUE *argv, VALUE self){
+  VALUE rblapack_m;
+  integer m; 
+  VALUE rblapack_kl;
+  integer kl; 
+  VALUE rblapack_ku;
+  integer ku; 
+  VALUE rblapack_ab;
+  doublecomplex *ab; 
+  VALUE rblapack_ipiv;
+  integer *ipiv; 
+  VALUE rblapack_info;
+  integer info; 
+  VALUE rblapack_ab_out__;
+  doublecomplex *ab_out__;
+
+  integer ldab;
+  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, ab = NumRu::Lapack.zgbtrf( m, kl, ku, ab, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE ZGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO )\n\n*  Purpose\n*  =======\n*\n*  ZGBTRF computes an LU factorization of a complex m-by-n band matrix A\n*  using partial pivoting with row interchanges.\n*\n*  This is the blocked version of the algorithm, calling Level 3 BLAS.\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*  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*  AB      (input/output) COMPLEX*16 array, dimension (LDAB,N)\n*          On entry, the matrix A in band storage, in rows KL+1 to\n*          2*KL+KU+1; rows 1 to KL of the array need not be set.\n*          The j-th column of A is stored in the j-th column of the\n*          array AB as follows:\n*          AB(kl+ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)\n*\n*          On exit, details of the factorization: U is stored as an\n*          upper triangular band matrix with KL+KU superdiagonals in\n*          rows 1 to KL+KU+1, and the multipliers used during the\n*          factorization are stored in rows KL+KU+2 to 2*KL+KU+1.\n*          See below for further details.\n*\n*  LDAB    (input) INTEGER\n*          The leading dimension of the array AB.  LDAB >= 2*KL+KU+1.\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*  Further Details\n*  ===============\n*\n*  The band storage scheme is illustrated by the following example, when\n*  M = N = 6, KL = 2, KU = 1:\n*\n*  On entry:                       On exit:\n*\n*      *    *    *    +    +    +       *    *    *   u14  u25  u36\n*      *    *    +    +    +    +       *    *   u13  u24  u35  u46\n*      *   a12  a23  a34  a45  a56      *   u12  u23  u34  u45  u56\n*     a11  a22  a33  a44  a55  a66     u11  u22  u33  u44  u55  u66\n*     a21  a32  a43  a54  a65   *      m21  m32  m43  m54  m65   *\n*     a31  a42  a53  a64   *    *      m31  m42  m53  m64   *    *\n*\n*  Array elements marked * are not used by the routine; elements marked\n*  + need not be set on entry, but are required by the routine to store\n*  elements of U because of fill-in resulting from the row interchanges.\n*\n*  =====================================================================\n*\n\n");
+      return Qnil;
+    }
+    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
+      printf("%s\n", "USAGE:\n  ipiv, info, ab = NumRu::Lapack.zgbtrf( m, kl, ku, ab, [: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_m = argv[0];
+  rblapack_kl = argv[1];
+  rblapack_ku = argv[2];
+  rblapack_ab = argv[3];
+  if (argc == 4) {
+  } else if (rblapack_options != Qnil) {
+  } else {
+  }
+
+  m = NUM2INT(rblapack_m);
+  ku = NUM2INT(rblapack_ku);
+  kl = NUM2INT(rblapack_kl);
+  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);
+  n = NA_SHAPE1(rblapack_ab);
+  if (NA_TYPE(rblapack_ab) != NA_DCOMPLEX)
+    rblapack_ab = na_change_type(rblapack_ab, NA_DCOMPLEX);
+  ab = NA_PTR_TYPE(rblapack_ab, doublecomplex*);
+  {
+    na_shape_t shape[1];
+    shape[0] = MIN(m,n);
+    rblapack_ipiv = na_make_object(NA_LINT, 1, shape, cNArray);
+  }
+  ipiv = NA_PTR_TYPE(rblapack_ipiv, integer*);
+  {
+    na_shape_t shape[2];
+    shape[0] = ldab;
+    shape[1] = n;
+    rblapack_ab_out__ = na_make_object(NA_DCOMPLEX, 2, shape, cNArray);
+  }
+  ab_out__ = NA_PTR_TYPE(rblapack_ab_out__, doublecomplex*);
+  MEMCPY(ab_out__, ab, doublecomplex, NA_TOTAL(rblapack_ab));
+  rblapack_ab = rblapack_ab_out__;
+  ab = ab_out__;
+
+  zgbtrf_(&m, &n, &kl, &ku, ab, &ldab, ipiv, &info);
+
+  rblapack_info = INT2NUM(info);
+  return rb_ary_new3(3, rblapack_ipiv, rblapack_info, rblapack_ab);
+}
+
+void
+init_lapack_zgbtrf(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
+  sHelp = sH;
+  sUsage = sU;
+  rblapack_ZERO = zero;
+
+  rb_define_module_function(mLapack, "zgbtrf", rblapack_zgbtrf, -1);
+}

data/ext/zgbtrs.c

@@ -0,0 +1,111 @@
+#include "rb_lapack.h"
+
+extern VOID zgbtrs_(char* trans, integer* n, integer* kl, integer* ku, integer* nrhs, doublecomplex* ab, integer* ldab, integer* ipiv, doublecomplex* b, integer* ldb, integer* info);
+
+
+static VALUE
+rblapack_zgbtrs(int argc, VALUE *argv, VALUE self){
+  VALUE rblapack_trans;
+  char trans; 
+  VALUE rblapack_kl;
+  integer kl; 
+  VALUE rblapack_ku;
+  integer ku; 
+  VALUE rblapack_ab;
+  doublecomplex *ab; 
+  VALUE rblapack_ipiv;
+  integer *ipiv; 
+  VALUE rblapack_b;
+  doublecomplex *b; 
+  VALUE rblapack_info;
+  integer info; 
+  VALUE rblapack_b_out__;
+  doublecomplex *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.zgbtrs( trans, kl, ku, ab, ipiv, b, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE ZGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO )\n\n*  Purpose\n*  =======\n*\n*  ZGBTRS solves a system of linear equations\n*     A * X = B,  A**T * X = B,  or  A**H * X = B\n*  with a general band matrix A using the LU factorization computed\n*  by ZGBTRF.\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**T * X = B  (Transpose)\n*          = 'C':  A**H * X = B  (Conjugate 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) COMPLEX*16 array, dimension (LDAB,N)\n*          Details of the LU factorization of the band matrix A, as\n*          computed by ZGBTRF.  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) COMPLEX*16 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.zgbtrs( 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_DCOMPLEX)
+    rblapack_b = na_change_type(rblapack_b, NA_DCOMPLEX);
+  b = NA_PTR_TYPE(rblapack_b, doublecomplex*);
+  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_DCOMPLEX)
+    rblapack_ab = na_change_type(rblapack_ab, NA_DCOMPLEX);
+  ab = NA_PTR_TYPE(rblapack_ab, doublecomplex*);
+  {
+    na_shape_t shape[2];
+    shape[0] = ldb;
+    shape[1] = nrhs;
+    rblapack_b_out__ = na_make_object(NA_DCOMPLEX, 2, shape, cNArray);
+  }
+  b_out__ = NA_PTR_TYPE(rblapack_b_out__, doublecomplex*);
+  MEMCPY(b_out__, b, doublecomplex, NA_TOTAL(rblapack_b));
+  rblapack_b = rblapack_b_out__;
+  b = b_out__;
+
+  zgbtrs_(&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_zgbtrs(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
+  sHelp = sH;
+  sUsage = sU;
+  rblapack_ZERO = zero;
+
+  rb_define_module_function(mLapack, "zgbtrs", rblapack_zgbtrs, -1);
+}

data/ext/zgebak.c

@@ -0,0 +1,101 @@
+#include "rb_lapack.h"
+
+extern VOID zgebak_(char* job, char* side, integer* n, integer* ilo, integer* ihi, doublereal* scale, integer* m, doublecomplex* v, integer* ldv, integer* info);
+
+
+static VALUE
+rblapack_zgebak(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;
+  doublecomplex *v; 
+  VALUE rblapack_info;
+  integer info; 
+  VALUE rblapack_v_out__;
+  doublecomplex *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.zgebak( job, side, ilo, ihi, scale, v, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE ZGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO )\n\n*  Purpose\n*  =======\n*\n*  ZGEBAK forms the right or left eigenvectors of a complex general\n*  matrix by backward transformation on the computed eigenvectors of the\n*  balanced matrix output by ZGEBAL.\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 ZGEBAL.\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 ZGEBAL.\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 ZGEBAL.\n*\n*  M       (input) INTEGER\n*          The number of columns of the matrix V.  M >= 0.\n*\n*  V       (input/output) COMPLEX*16 array, dimension (LDV,M)\n*          On entry, the matrix of right or left eigenvectors to be\n*          transformed, as returned by ZHSEIN or ZTREVC.\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.zgebak( 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_DCOMPLEX)
+    rblapack_v = na_change_type(rblapack_v, NA_DCOMPLEX);
+  v = NA_PTR_TYPE(rblapack_v, doublecomplex*);
+  ihi = NUM2INT(rblapack_ihi);
+  {
+    na_shape_t shape[2];
+    shape[0] = ldv;
+    shape[1] = m;
+    rblapack_v_out__ = na_make_object(NA_DCOMPLEX, 2, shape, cNArray);
+  }
+  v_out__ = NA_PTR_TYPE(rblapack_v_out__, doublecomplex*);
+  MEMCPY(v_out__, v, doublecomplex, NA_TOTAL(rblapack_v));
+  rblapack_v = rblapack_v_out__;
+  v = v_out__;
+
+  zgebak_(&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_zgebak(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
+  sHelp = sH;
+  sUsage = sU;
+  rblapack_ZERO = zero;
+
+  rb_define_module_function(mLapack, "zgebak", rblapack_zgebak, -1);
+}

data/ext/zgebal.c

@@ -0,0 +1,91 @@
+#include "rb_lapack.h"
+
+extern VOID zgebal_(char* job, integer* n, doublecomplex* a, integer* lda, integer* ilo, integer* ihi, doublereal* scale, integer* info);
+
+
+static VALUE
+rblapack_zgebal(int argc, VALUE *argv, VALUE self){
+  VALUE rblapack_job;
+  char job; 
+  VALUE rblapack_a;
+  doublecomplex *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__;
+  doublecomplex *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.zgebal( job, a, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE ZGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO )\n\n*  Purpose\n*  =======\n*\n*  ZGEBAL balances a general complex 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) COMPLEX*16 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 CBAL.\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.zgebal( 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_DCOMPLEX)
+    rblapack_a = na_change_type(rblapack_a, NA_DCOMPLEX);
+  a = NA_PTR_TYPE(rblapack_a, doublecomplex*);
+  {
+    na_shape_t shape[1];
+    shape[0] = n;
+    rblapack_scale = na_make_object(NA_DFLOAT, 1, shape, cNArray);
+  }
+  scale = NA_PTR_TYPE(rblapack_scale, doublereal*);
+  {
+    na_shape_t shape[2];
+    shape[0] = lda;
+    shape[1] = n;
+    rblapack_a_out__ = na_make_object(NA_DCOMPLEX, 2, shape, cNArray);
+  }
+  a_out__ = NA_PTR_TYPE(rblapack_a_out__, doublecomplex*);
+  MEMCPY(a_out__, a, doublecomplex, NA_TOTAL(rblapack_a));
+  rblapack_a = rblapack_a_out__;
+  a = a_out__;
+
+  zgebal_(&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_zgebal(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
+  sHelp = sH;
+  sUsage = sU;
+  rblapack_ZERO = zero;
+
+  rb_define_module_function(mLapack, "zgebal", rblapack_zgebal, -1);
+}