ruby-lapack 1.3

data/ext/ctbtrs.c

@@ -0,0 +1,99 @@
+#include "rb_lapack.h"
+
+extern VOID ctbtrs_(char* uplo, char* trans, char* diag, integer* n, integer* kd, integer* nrhs, complex* ab, integer* ldab, complex* b, integer* ldb, integer* info);
+
+
+static VALUE
+rblapack_ctbtrs(int argc, VALUE *argv, VALUE self){
+  VALUE rblapack_uplo;
+  char uplo; 
+  VALUE rblapack_trans;
+  char trans; 
+  VALUE rblapack_diag;
+  char diag; 
+  VALUE rblapack_kd;
+  integer kd; 
+  VALUE rblapack_ab;
+  complex *ab; 
+  VALUE rblapack_b;
+  complex *b; 
+  VALUE rblapack_info;
+  integer info; 
+  VALUE rblapack_b_out__;
+  complex *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.ctbtrs( uplo, trans, diag, kd, ab, b, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE CTBTRS( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, LDB, INFO )\n\n*  Purpose\n*  =======\n*\n*  CTBTRS solves a triangular system of the form\n*\n*     A * X = B,  A**T * X = B,  or  A**H * X = B,\n*\n*  where A is a triangular band matrix of order N, and B is an\n*  N-by-NRHS matrix.  A check is made to verify that A is nonsingular.\n*\n\n*  Arguments\n*  =========\n*\n*  UPLO    (input) CHARACTER*1\n*          = 'U':  A is upper triangular;\n*          = 'L':  A is lower triangular.\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*  DIAG    (input) CHARACTER*1\n*          = 'N':  A is non-unit triangular;\n*          = 'U':  A is unit triangular.\n*\n*  N       (input) INTEGER\n*          The order of the matrix A.  N >= 0.\n*\n*  KD      (input) INTEGER\n*          The number of superdiagonals or subdiagonals of the\n*          triangular band matrix A.  KD >= 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 array, dimension (LDAB,N)\n*          The upper or lower triangular band matrix A, stored in the\n*          first kd+1 rows of AB.  The j-th column of A is stored\n*          in the j-th column of the array AB as follows:\n*          if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;\n*          if UPLO = 'L', AB(1+i-j,j)    = A(i,j) for j<=i<=min(n,j+kd).\n*          If DIAG = 'U', the diagonal elements of A are not referenced\n*          and are assumed to be 1.\n*\n*  LDAB    (input) INTEGER\n*          The leading dimension of the array AB.  LDAB >= KD+1.\n*\n*  B       (input/output) COMPLEX array, dimension (LDB,NRHS)\n*          On entry, the right hand side matrix B.\n*          On exit, if INFO = 0, 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*          > 0:  if INFO = i, the i-th diagonal element of A is zero,\n*                indicating that the matrix is singular and the\n*                solutions X have not been computed.\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.ctbtrs( uplo, trans, diag, kd, ab, 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_uplo = argv[0];
+  rblapack_trans = argv[1];
+  rblapack_diag = argv[2];
+  rblapack_kd = argv[3];
+  rblapack_ab = argv[4];
+  rblapack_b = argv[5];
+  if (argc == 6) {
+  } else if (rblapack_options != Qnil) {
+  } else {
+  }
+
+  if (!NA_IsNArray(rblapack_ab))
+    rb_raise(rb_eArgError, "ab (5th argument) must be NArray");
+  if (NA_RANK(rblapack_ab) != 2)
+    rb_raise(rb_eArgError, "rank of ab (5th argument) must be %d", 2);
+  ldab = NA_SHAPE0(rblapack_ab);
+  n = NA_SHAPE1(rblapack_ab);
+  if (NA_TYPE(rblapack_ab) != NA_SCOMPLEX)
+    rblapack_ab = na_change_type(rblapack_ab, NA_SCOMPLEX);
+  ab = NA_PTR_TYPE(rblapack_ab, complex*);
+  diag = StringValueCStr(rblapack_diag)[0];
+  trans = StringValueCStr(rblapack_trans)[0];
+  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_SCOMPLEX)
+    rblapack_b = na_change_type(rblapack_b, NA_SCOMPLEX);
+  b = NA_PTR_TYPE(rblapack_b, complex*);
+  uplo = StringValueCStr(rblapack_uplo)[0];
+  kd = NUM2INT(rblapack_kd);
+  {
+    int shape[2];
+    shape[0] = ldb;
+    shape[1] = nrhs;
+    rblapack_b_out__ = na_make_object(NA_SCOMPLEX, 2, shape, cNArray);
+  }
+  b_out__ = NA_PTR_TYPE(rblapack_b_out__, complex*);
+  MEMCPY(b_out__, b, complex, NA_TOTAL(rblapack_b));
+  rblapack_b = rblapack_b_out__;
+  b = b_out__;
+
+  ctbtrs_(&uplo, &trans, &diag, &n, &kd, &nrhs, ab, &ldab, b, &ldb, &info);
+
+  rblapack_info = INT2NUM(info);
+  return rb_ary_new3(2, rblapack_info, rblapack_b);
+}
+
+void
+init_lapack_ctbtrs(VALUE mLapack){
+  rb_define_module_function(mLapack, "ctbtrs", rblapack_ctbtrs, -1);
+}

data/ext/ctfsm.c

@@ -0,0 +1,107 @@
+#include "rb_lapack.h"
+
+extern VOID ctfsm_(char* transr, char* side, char* uplo, char* trans, char* diag, integer* m, integer* n, complex* alpha, complex* a, complex* b, integer* ldb);
+
+
+static VALUE
+rblapack_ctfsm(int argc, VALUE *argv, VALUE self){
+  VALUE rblapack_transr;
+  char transr; 
+  VALUE rblapack_side;
+  char side; 
+  VALUE rblapack_uplo;
+  char uplo; 
+  VALUE rblapack_trans;
+  char trans; 
+  VALUE rblapack_diag;
+  char diag; 
+  VALUE rblapack_m;
+  integer m; 
+  VALUE rblapack_alpha;
+  complex alpha; 
+  VALUE rblapack_a;
+  complex *a; 
+  VALUE rblapack_b;
+  complex *b; 
+  VALUE rblapack_b_out__;
+  complex *b_out__;
+
+  integer ldb;
+  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  b = NumRu::Lapack.ctfsm( transr, side, uplo, trans, diag, m, alpha, a, b, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE CTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, B, LDB )\n\n*  Purpose\n*  =======\n*\n*  Level 3 BLAS like routine for A in RFP Format.\n*\n*  CTFSM solves the matrix equation\n*\n*     op( A )*X = alpha*B  or  X*op( A ) = alpha*B\n*\n*  where alpha is a scalar, X and B are m by n matrices, A is a unit, or\n*  non-unit,  upper or lower triangular matrix  and  op( A )  is one  of\n*\n*     op( A ) = A   or   op( A ) = conjg( A' ).\n*\n*  A is in Rectangular Full Packed (RFP) Format.\n*\n*  The matrix X is overwritten on B.\n*\n\n*  Arguments\n*  ==========\n*\n*  TRANSR  (input) CHARACTER*1\n*          = 'N':  The Normal Form of RFP A is stored;\n*          = 'C':  The Conjugate-transpose Form of RFP A is stored.\n*\n*  SIDE    (input) CHARACTER*1\n*           On entry, SIDE specifies whether op( A ) appears on the left\n*           or right of X as follows:\n*\n*              SIDE = 'L' or 'l'   op( A )*X = alpha*B.\n*\n*              SIDE = 'R' or 'r'   X*op( A ) = alpha*B.\n*\n*           Unchanged on exit.\n*\n*  UPLO    (input) CHARACTER*1\n*           On entry, UPLO specifies whether the RFP matrix A came from\n*           an upper or lower triangular matrix as follows:\n*           UPLO = 'U' or 'u' RFP A came from an upper triangular matrix\n*           UPLO = 'L' or 'l' RFP A came from a  lower triangular matrix\n*\n*           Unchanged on exit.\n*\n*  TRANS   (input) CHARACTER*1\n*           On entry, TRANS  specifies the form of op( A ) to be used\n*           in the matrix multiplication as follows:\n*\n*              TRANS  = 'N' or 'n'   op( A ) = A.\n*\n*              TRANS  = 'C' or 'c'   op( A ) = conjg( A' ).\n*\n*           Unchanged on exit.\n*\n*  DIAG    (input) CHARACTER*1\n*           On entry, DIAG specifies whether or not RFP A is unit\n*           triangular as follows:\n*\n*              DIAG = 'U' or 'u'   A is assumed to be unit triangular.\n*\n*              DIAG = 'N' or 'n'   A is not assumed to be unit\n*                                  triangular.\n*\n*           Unchanged on exit.\n*\n*  M       (input) INTEGER\n*           On entry, M specifies the number of rows of B. M must be at\n*           least zero.\n*           Unchanged on exit.\n*\n*  N       (input) INTEGER\n*           On entry, N specifies the number of columns of B.  N must be\n*           at least zero.\n*           Unchanged on exit.\n*\n*  ALPHA   (input) COMPLEX\n*           On entry,  ALPHA specifies the scalar  alpha. When  alpha is\n*           zero then  A is not referenced and  B need not be set before\n*           entry.\n*           Unchanged on exit.\n*\n*  A       (input) COMPLEX array, dimension (N*(N+1)/2)\n*           NT = N*(N+1)/2. On entry, the matrix A in RFP Format.\n*           RFP Format is described by TRANSR, UPLO and N as follows:\n*           If TRANSR='N' then RFP A is (0:N,0:K-1) when N is even;\n*           K=N/2. RFP A is (0:N-1,0:K) when N is odd; K=N/2. If\n*           TRANSR = 'C' then RFP is the Conjugate-transpose of RFP A as\n*           defined when TRANSR = 'N'. The contents of RFP A are defined\n*           by UPLO as follows: If UPLO = 'U' the RFP A contains the NT\n*           elements of upper packed A either in normal or\n*           conjugate-transpose Format. If UPLO = 'L' the RFP A contains\n*           the NT elements of lower packed A either in normal or\n*           conjugate-transpose Format. The LDA of RFP A is (N+1)/2 when\n*           TRANSR = 'C'. When TRANSR is 'N' the LDA is N+1 when N is\n*           even and is N when is odd.\n*           See the Note below for more details. Unchanged on exit.\n*\n*  B       (input/output) COMPLEX array,  dimension (LDB,N)\n*           Before entry,  the leading  m by n part of the array  B must\n*           contain  the  right-hand  side  matrix  B,  and  on exit  is\n*           overwritten by the solution matrix  X.\n*\n*  LDB     (input) INTEGER\n*           On entry, LDB specifies the first dimension of B as declared\n*           in  the  calling  (sub)  program.   LDB  must  be  at  least\n*           max( 1, m ).\n*           Unchanged on exit.\n*\n\n*  Further Details\n*  ===============\n*\n*  We first consider Standard Packed Format when N is even.\n*  We give an example where N = 6.\n*\n*      AP is Upper             AP is Lower\n*\n*   00 01 02 03 04 05       00\n*      11 12 13 14 15       10 11\n*         22 23 24 25       20 21 22\n*            33 34 35       30 31 32 33\n*               44 45       40 41 42 43 44\n*                  55       50 51 52 53 54 55\n*\n*\n*  Let TRANSR = 'N'. RFP holds AP as follows:\n*  For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last\n*  three columns of AP upper. The lower triangle A(4:6,0:2) consists of\n*  conjugate-transpose of the first three columns of AP upper.\n*  For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first\n*  three columns of AP lower. The upper triangle A(0:2,0:2) consists of\n*  conjugate-transpose of the last three columns of AP lower.\n*  To denote conjugate we place -- above the element. This covers the\n*  case N even and TRANSR = 'N'.\n*\n*         RFP A                   RFP A\n*\n*                                -- -- --\n*        03 04 05                33 43 53\n*                                   -- --\n*        13 14 15                00 44 54\n*                                      --\n*        23 24 25                10 11 55\n*\n*        33 34 35                20 21 22\n*        --\n*        00 44 45                30 31 32\n*        -- --\n*        01 11 55                40 41 42\n*        -- -- --\n*        02 12 22                50 51 52\n*\n*  Now let TRANSR = 'C'. RFP A in both UPLO cases is just the conjugate-\n*  transpose of RFP A above. One therefore gets:\n*\n*\n*           RFP A                   RFP A\n*\n*     -- -- -- --                -- -- -- -- -- --\n*     03 13 23 33 00 01 02    33 00 10 20 30 40 50\n*     -- -- -- -- --                -- -- -- -- --\n*     04 14 24 34 44 11 12    43 44 11 21 31 41 51\n*     -- -- -- -- -- --                -- -- -- --\n*     05 15 25 35 45 55 22    53 54 55 22 32 42 52\n*\n*\n*  We next  consider Standard Packed Format when N is odd.\n*  We give an example where N = 5.\n*\n*     AP is Upper                 AP is Lower\n*\n*   00 01 02 03 04              00\n*      11 12 13 14              10 11\n*         22 23 24              20 21 22\n*            33 34              30 31 32 33\n*               44              40 41 42 43 44\n*\n*\n*  Let TRANSR = 'N'. RFP holds AP as follows:\n*  For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last\n*  three columns of AP upper. The lower triangle A(3:4,0:1) consists of\n*  conjugate-transpose of the first two   columns of AP upper.\n*  For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first\n*  three columns of AP lower. The upper triangle A(0:1,1:2) consists of\n*  conjugate-transpose of the last two   columns of AP lower.\n*  To denote conjugate we place -- above the element. This covers the\n*  case N odd  and TRANSR = 'N'.\n*\n*         RFP A                   RFP A\n*\n*                                   -- --\n*        02 03 04                00 33 43\n*                                      --\n*        12 13 14                10 11 44\n*\n*        22 23 24                20 21 22\n*        --\n*        00 33 34                30 31 32\n*        -- --\n*        01 11 44                40 41 42\n*\n*  Now let TRANSR = 'C'. RFP A in both UPLO cases is just the conjugate-\n*  transpose of RFP A above. One therefore gets:\n*\n*\n*           RFP A                   RFP A\n*\n*     -- -- --                   -- -- -- -- -- --\n*     02 12 22 00 01             00 10 20 30 40 50\n*     -- -- -- --                   -- -- -- -- --\n*     03 13 23 33 11             33 11 21 31 41 51\n*     -- -- -- -- --                   -- -- -- --\n*     04 14 24 34 44             43 44 22 32 42 52\n*\n*     ..\n\n");
+      return Qnil;
+    }
+    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
+      printf("%s\n", "USAGE:\n  b = NumRu::Lapack.ctfsm( transr, side, uplo, trans, diag, m, alpha, a, b, [:usage => usage, :help => help])\n");
+      return Qnil;
+    } 
+  } else
+    rblapack_options = Qnil;
+  if (argc != 9 && argc != 9)
+    rb_raise(rb_eArgError,"wrong number of arguments (%d for 9)", argc);
+  rblapack_transr = argv[0];
+  rblapack_side = argv[1];
+  rblapack_uplo = argv[2];
+  rblapack_trans = argv[3];
+  rblapack_diag = argv[4];
+  rblapack_m = argv[5];
+  rblapack_alpha = argv[6];
+  rblapack_a = argv[7];
+  rblapack_b = argv[8];
+  if (argc == 9) {
+  } else if (rblapack_options != Qnil) {
+  } else {
+  }
+
+  side = StringValueCStr(rblapack_side)[0];
+  m = NUM2INT(rblapack_m);
+  alpha.r = (real)NUM2DBL(rb_funcall(rblapack_alpha, rb_intern("real"), 0));
+  alpha.i = (real)NUM2DBL(rb_funcall(rblapack_alpha, rb_intern("imag"), 0));
+  uplo = StringValueCStr(rblapack_uplo)[0];
+  if (!NA_IsNArray(rblapack_b))
+    rb_raise(rb_eArgError, "b (9th argument) must be NArray");
+  if (NA_RANK(rblapack_b) != 2)
+    rb_raise(rb_eArgError, "rank of b (9th argument) must be %d", 2);
+  ldb = NA_SHAPE0(rblapack_b);
+  n = NA_SHAPE1(rblapack_b);
+  if (NA_TYPE(rblapack_b) != NA_SCOMPLEX)
+    rblapack_b = na_change_type(rblapack_b, NA_SCOMPLEX);
+  b = NA_PTR_TYPE(rblapack_b, complex*);
+  trans = StringValueCStr(rblapack_trans)[0];
+  if (!NA_IsNArray(rblapack_a))
+    rb_raise(rb_eArgError, "a (8th argument) must be NArray");
+  if (NA_RANK(rblapack_a) != 1)
+    rb_raise(rb_eArgError, "rank of a (8th argument) must be %d", 1);
+  if (NA_SHAPE0(rblapack_a) != (n*(n+1)/2))
+    rb_raise(rb_eRuntimeError, "shape 0 of a must be %d", n*(n+1)/2);
+  if (NA_TYPE(rblapack_a) != NA_SCOMPLEX)
+    rblapack_a = na_change_type(rblapack_a, NA_SCOMPLEX);
+  a = NA_PTR_TYPE(rblapack_a, complex*);
+  transr = StringValueCStr(rblapack_transr)[0];
+  diag = StringValueCStr(rblapack_diag)[0];
+  {
+    int shape[2];
+    shape[0] = ldb;
+    shape[1] = n;
+    rblapack_b_out__ = na_make_object(NA_SCOMPLEX, 2, shape, cNArray);
+  }
+  b_out__ = NA_PTR_TYPE(rblapack_b_out__, complex*);
+  MEMCPY(b_out__, b, complex, NA_TOTAL(rblapack_b));
+  rblapack_b = rblapack_b_out__;
+  b = b_out__;
+
+  ctfsm_(&transr, &side, &uplo, &trans, &diag, &m, &n, &alpha, a, b, &ldb);
+
+  return rblapack_b;
+}
+
+void
+init_lapack_ctfsm(VALUE mLapack){
+  rb_define_module_function(mLapack, "ctfsm", rblapack_ctfsm, -1);
+}

data/ext/ctftri.c

@@ -0,0 +1,82 @@
+#include "rb_lapack.h"
+
+extern VOID ctftri_(char* transr, char* uplo, char* diag, integer* n, complex* a, integer* info);
+
+
+static VALUE
+rblapack_ctftri(int argc, VALUE *argv, VALUE self){
+  VALUE rblapack_transr;
+  char transr; 
+  VALUE rblapack_uplo;
+  char uplo; 
+  VALUE rblapack_diag;
+  char diag; 
+  VALUE rblapack_n;
+  integer n; 
+  VALUE rblapack_a;
+  complex *a; 
+  VALUE rblapack_info;
+  integer info; 
+  VALUE rblapack_a_out__;
+  complex *a_out__;
+
+
+  VALUE rblapack_options;
+  if (argc > 0 && TYPE(argv[argc-1]) == T_HASH) {
+    argc--;
+    rblapack_options = argv[argc];
+    if (rb_hash_aref(rblapack_options, sHelp) == Qtrue) {
+      printf("%s\n", "USAGE:\n  info, a = NumRu::Lapack.ctftri( transr, uplo, diag, n, a, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE CTFTRI( TRANSR, UPLO, DIAG, N, A, INFO )\n\n*  Purpose\n*  =======\n*\n*  CTFTRI computes the inverse of a triangular matrix A stored in RFP\n*  format.\n*\n*  This is a Level 3 BLAS version of the algorithm.\n*\n\n*  Arguments\n*  =========\n*\n*  TRANSR    (input) CHARACTER*1\n*          = 'N':  The Normal TRANSR of RFP A is stored;\n*          = 'C':  The Conjugate-transpose TRANSR of RFP A is stored.\n*\n*  UPLO    (input) CHARACTER*1\n*          = 'U':  A is upper triangular;\n*          = 'L':  A is lower triangular.\n*\n*  DIAG    (input) CHARACTER*1\n*          = 'N':  A is non-unit triangular;\n*          = 'U':  A is unit triangular.\n*\n*  N       (input) INTEGER\n*          The order of the matrix A.  N >= 0.\n*\n*  A       (input/output) COMPLEX array, dimension ( N*(N+1)/2 );\n*          On entry, the triangular matrix A in RFP format. RFP format\n*          is described by TRANSR, UPLO, and N as follows: If TRANSR =\n*          'N' then RFP A is (0:N,0:k-1) when N is even; k=N/2. RFP A is\n*          (0:N-1,0:k) when N is odd; k=N/2. IF TRANSR = 'C' then RFP is\n*          the Conjugate-transpose of RFP A as defined when\n*          TRANSR = 'N'. The contents of RFP A are defined by UPLO as\n*          follows: If UPLO = 'U' the RFP A contains the nt elements of\n*          upper packed A; If UPLO = 'L' the RFP A contains the nt\n*          elements of lower packed A. The LDA of RFP A is (N+1)/2 when\n*          TRANSR = 'C'. When TRANSR is 'N' the LDA is N+1 when N is\n*          even and N is odd. See the Note below for more details.\n*\n*          On exit, the (triangular) inverse of the original matrix, in\n*          the same storage format.\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, A(i,i) is exactly zero.  The triangular\n*               matrix is singular and its inverse can not be computed.\n*\n\n*  Further Details\n*  ===============\n*\n*  We first consider Standard Packed Format when N is even.\n*  We give an example where N = 6.\n*\n*      AP is Upper             AP is Lower\n*\n*   00 01 02 03 04 05       00\n*      11 12 13 14 15       10 11\n*         22 23 24 25       20 21 22\n*            33 34 35       30 31 32 33\n*               44 45       40 41 42 43 44\n*                  55       50 51 52 53 54 55\n*\n*\n*  Let TRANSR = 'N'. RFP holds AP as follows:\n*  For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last\n*  three columns of AP upper. The lower triangle A(4:6,0:2) consists of\n*  conjugate-transpose of the first three columns of AP upper.\n*  For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first\n*  three columns of AP lower. The upper triangle A(0:2,0:2) consists of\n*  conjugate-transpose of the last three columns of AP lower.\n*  To denote conjugate we place -- above the element. This covers the\n*  case N even and TRANSR = 'N'.\n*\n*         RFP A                   RFP A\n*\n*                                -- -- --\n*        03 04 05                33 43 53\n*                                   -- --\n*        13 14 15                00 44 54\n*                                      --\n*        23 24 25                10 11 55\n*\n*        33 34 35                20 21 22\n*        --\n*        00 44 45                30 31 32\n*        -- --\n*        01 11 55                40 41 42\n*        -- -- --\n*        02 12 22                50 51 52\n*\n*  Now let TRANSR = 'C'. RFP A in both UPLO cases is just the conjugate-\n*  transpose of RFP A above. One therefore gets:\n*\n*\n*           RFP A                   RFP A\n*\n*     -- -- -- --                -- -- -- -- -- --\n*     03 13 23 33 00 01 02    33 00 10 20 30 40 50\n*     -- -- -- -- --                -- -- -- -- --\n*     04 14 24 34 44 11 12    43 44 11 21 31 41 51\n*     -- -- -- -- -- --                -- -- -- --\n*     05 15 25 35 45 55 22    53 54 55 22 32 42 52\n*\n*\n*  We next  consider Standard Packed Format when N is odd.\n*  We give an example where N = 5.\n*\n*     AP is Upper                 AP is Lower\n*\n*   00 01 02 03 04              00\n*      11 12 13 14              10 11\n*         22 23 24              20 21 22\n*            33 34              30 31 32 33\n*               44              40 41 42 43 44\n*\n*\n*  Let TRANSR = 'N'. RFP holds AP as follows:\n*  For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last\n*  three columns of AP upper. The lower triangle A(3:4,0:1) consists of\n*  conjugate-transpose of the first two   columns of AP upper.\n*  For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first\n*  three columns of AP lower. The upper triangle A(0:1,1:2) consists of\n*  conjugate-transpose of the last two   columns of AP lower.\n*  To denote conjugate we place -- above the element. This covers the\n*  case N odd  and TRANSR = 'N'.\n*\n*         RFP A                   RFP A\n*\n*                                   -- --\n*        02 03 04                00 33 43\n*                                      --\n*        12 13 14                10 11 44\n*\n*        22 23 24                20 21 22\n*        --\n*        00 33 34                30 31 32\n*        -- --\n*        01 11 44                40 41 42\n*\n*  Now let TRANSR = 'C'. RFP A in both UPLO cases is just the conjugate-\n*  transpose of RFP A above. One therefore gets:\n*\n*\n*           RFP A                   RFP A\n*\n*     -- -- --                   -- -- -- -- -- --\n*     02 12 22 00 01             00 10 20 30 40 50\n*     -- -- -- --                   -- -- -- -- --\n*     03 13 23 33 11             33 11 21 31 41 51\n*     -- -- -- -- --                   -- -- -- --\n*     04 14 24 34 44             43 44 22 32 42 52\n*\n*  =====================================================================\n*\n\n");
+      return Qnil;
+    }
+    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
+      printf("%s\n", "USAGE:\n  info, a = NumRu::Lapack.ctftri( transr, uplo, diag, n, a, [:usage => usage, :help => help])\n");
+      return Qnil;
+    } 
+  } else
+    rblapack_options = Qnil;
+  if (argc != 5 && argc != 5)
+    rb_raise(rb_eArgError,"wrong number of arguments (%d for 5)", argc);
+  rblapack_transr = argv[0];
+  rblapack_uplo = argv[1];
+  rblapack_diag = argv[2];
+  rblapack_n = argv[3];
+  rblapack_a = argv[4];
+  if (argc == 5) {
+  } else if (rblapack_options != Qnil) {
+  } else {
+  }
+
+  diag = StringValueCStr(rblapack_diag)[0];
+  uplo = StringValueCStr(rblapack_uplo)[0];
+  n = NUM2INT(rblapack_n);
+  if (!NA_IsNArray(rblapack_a))
+    rb_raise(rb_eArgError, "a (5th argument) must be NArray");
+  if (NA_RANK(rblapack_a) != 1)
+    rb_raise(rb_eArgError, "rank of a (5th argument) must be %d", 1);
+  if (NA_SHAPE0(rblapack_a) != (n*(n+1)/2))
+    rb_raise(rb_eRuntimeError, "shape 0 of a must be %d", n*(n+1)/2);
+  if (NA_TYPE(rblapack_a) != NA_SCOMPLEX)
+    rblapack_a = na_change_type(rblapack_a, NA_SCOMPLEX);
+  a = NA_PTR_TYPE(rblapack_a, complex*);
+  transr = StringValueCStr(rblapack_transr)[0];
+  {
+    int shape[1];
+    shape[0] = n*(n+1)/2;
+    rblapack_a_out__ = na_make_object(NA_SCOMPLEX, 1, shape, cNArray);
+  }
+  a_out__ = NA_PTR_TYPE(rblapack_a_out__, complex*);
+  MEMCPY(a_out__, a, complex, NA_TOTAL(rblapack_a));
+  rblapack_a = rblapack_a_out__;
+  a = a_out__;
+
+  ctftri_(&transr, &uplo, &diag, &n, a, &info);
+
+  rblapack_info = INT2NUM(info);
+  return rb_ary_new3(2, rblapack_info, rblapack_a);
+}
+
+void
+init_lapack_ctftri(VALUE mLapack){
+  rb_define_module_function(mLapack, "ctftri", rblapack_ctftri, -1);
+}

data/ext/ctfttp.c

@@ -0,0 +1,75 @@
+#include "rb_lapack.h"
+
+extern VOID ctfttp_(char* transr, char* uplo, integer* n, complex* arf, complex* ap, integer* info);
+
+
+static VALUE
+rblapack_ctfttp(int argc, VALUE *argv, VALUE self){
+  VALUE rblapack_transr;
+  char transr; 
+  VALUE rblapack_uplo;
+  char uplo; 
+  VALUE rblapack_n;
+  integer n; 
+  VALUE rblapack_arf;
+  complex *arf; 
+  VALUE rblapack_ap;
+  complex *ap; 
+  VALUE rblapack_info;
+  integer info; 
+
+
+  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  ap, info = NumRu::Lapack.ctfttp( transr, uplo, n, arf, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE CTFTTP( TRANSR, UPLO, N, ARF, AP, INFO )\n\n*  Purpose\n*  =======\n*\n*  CTFTTP copies a triangular matrix A from rectangular full packed\n*  format (TF) to standard packed format (TP).\n*\n\n*  Arguments\n*  =========\n*\n*  TRANSR   (input) CHARACTER*1\n*          = 'N':  ARF is in Normal format;\n*          = 'C':  ARF is in Conjugate-transpose format;\n*\n*  UPLO    (input) CHARACTER*1\n*          = 'U':  A is upper triangular;\n*          = 'L':  A is lower triangular.\n*\n*  N       (input) INTEGER\n*          The order of the matrix A. N >= 0.\n*\n*  ARF     (input) COMPLEX array, dimension ( N*(N+1)/2 ),\n*          On entry, the upper or lower triangular matrix A stored in\n*          RFP format. For a further discussion see Notes below.\n*\n*  AP      (output) COMPLEX array, dimension ( N*(N+1)/2 ),\n*          On exit, the upper or lower triangular matrix A, packed\n*          columnwise in a linear array. The j-th column of A is stored\n*          in the array AP as follows:\n*          if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;\n*          if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=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*  We first consider Standard Packed Format when N is even.\n*  We give an example where N = 6.\n*\n*      AP is Upper             AP is Lower\n*\n*   00 01 02 03 04 05       00\n*      11 12 13 14 15       10 11\n*         22 23 24 25       20 21 22\n*            33 34 35       30 31 32 33\n*               44 45       40 41 42 43 44\n*                  55       50 51 52 53 54 55\n*\n*\n*  Let TRANSR = 'N'. RFP holds AP as follows:\n*  For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last\n*  three columns of AP upper. The lower triangle A(4:6,0:2) consists of\n*  conjugate-transpose of the first three columns of AP upper.\n*  For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first\n*  three columns of AP lower. The upper triangle A(0:2,0:2) consists of\n*  conjugate-transpose of the last three columns of AP lower.\n*  To denote conjugate we place -- above the element. This covers the\n*  case N even and TRANSR = 'N'.\n*\n*         RFP A                   RFP A\n*\n*                                -- -- --\n*        03 04 05                33 43 53\n*                                   -- --\n*        13 14 15                00 44 54\n*                                      --\n*        23 24 25                10 11 55\n*\n*        33 34 35                20 21 22\n*        --\n*        00 44 45                30 31 32\n*        -- --\n*        01 11 55                40 41 42\n*        -- -- --\n*        02 12 22                50 51 52\n*\n*  Now let TRANSR = 'C'. RFP A in both UPLO cases is just the conjugate-\n*  transpose of RFP A above. One therefore gets:\n*\n*\n*           RFP A                   RFP A\n*\n*     -- -- -- --                -- -- -- -- -- --\n*     03 13 23 33 00 01 02    33 00 10 20 30 40 50\n*     -- -- -- -- --                -- -- -- -- --\n*     04 14 24 34 44 11 12    43 44 11 21 31 41 51\n*     -- -- -- -- -- --                -- -- -- --\n*     05 15 25 35 45 55 22    53 54 55 22 32 42 52\n*\n*\n*  We next  consider Standard Packed Format when N is odd.\n*  We give an example where N = 5.\n*\n*     AP is Upper                 AP is Lower\n*\n*   00 01 02 03 04              00\n*      11 12 13 14              10 11\n*         22 23 24              20 21 22\n*            33 34              30 31 32 33\n*               44              40 41 42 43 44\n*\n*\n*  Let TRANSR = 'N'. RFP holds AP as follows:\n*  For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last\n*  three columns of AP upper. The lower triangle A(3:4,0:1) consists of\n*  conjugate-transpose of the first two   columns of AP upper.\n*  For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first\n*  three columns of AP lower. The upper triangle A(0:1,1:2) consists of\n*  conjugate-transpose of the last two   columns of AP lower.\n*  To denote conjugate we place -- above the element. This covers the\n*  case N odd  and TRANSR = 'N'.\n*\n*         RFP A                   RFP A\n*\n*                                   -- --\n*        02 03 04                00 33 43\n*                                      --\n*        12 13 14                10 11 44\n*\n*        22 23 24                20 21 22\n*        --\n*        00 33 34                30 31 32\n*        -- --\n*        01 11 44                40 41 42\n*\n*  Now let TRANSR = 'C'. RFP A in both UPLO cases is just the conjugate-\n*  transpose of RFP A above. One therefore gets:\n*\n*\n*           RFP A                   RFP A\n*\n*     -- -- --                   -- -- -- -- -- --\n*     02 12 22 00 01             00 10 20 30 40 50\n*     -- -- -- --                   -- -- -- -- --\n*     03 13 23 33 11             33 11 21 31 41 51\n*     -- -- -- -- --                   -- -- -- --\n*     04 14 24 34 44             43 44 22 32 42 52\n*\n*  =====================================================================\n*\n\n");
+      return Qnil;
+    }
+    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
+      printf("%s\n", "USAGE:\n  ap, info = NumRu::Lapack.ctfttp( transr, uplo, n, arf, [: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_transr = argv[0];
+  rblapack_uplo = argv[1];
+  rblapack_n = argv[2];
+  rblapack_arf = argv[3];
+  if (argc == 4) {
+  } else if (rblapack_options != Qnil) {
+  } else {
+  }
+
+  n = NUM2INT(rblapack_n);
+  uplo = StringValueCStr(rblapack_uplo)[0];
+  if (!NA_IsNArray(rblapack_arf))
+    rb_raise(rb_eArgError, "arf (4th argument) must be NArray");
+  if (NA_RANK(rblapack_arf) != 1)
+    rb_raise(rb_eArgError, "rank of arf (4th argument) must be %d", 1);
+  if (NA_SHAPE0(rblapack_arf) != (( n*(n+1)/2 )))
+    rb_raise(rb_eRuntimeError, "shape 0 of arf must be %d", ( n*(n+1)/2 ));
+  if (NA_TYPE(rblapack_arf) != NA_SCOMPLEX)
+    rblapack_arf = na_change_type(rblapack_arf, NA_SCOMPLEX);
+  arf = NA_PTR_TYPE(rblapack_arf, complex*);
+  transr = StringValueCStr(rblapack_transr)[0];
+  {
+    int shape[1];
+    shape[0] = ( n*(n+1)/2 );
+    rblapack_ap = na_make_object(NA_SCOMPLEX, 1, shape, cNArray);
+  }
+  ap = NA_PTR_TYPE(rblapack_ap, complex*);
+
+  ctfttp_(&transr, &uplo, &n, arf, ap, &info);
+
+  rblapack_info = INT2NUM(info);
+  return rb_ary_new3(2, rblapack_ap, rblapack_info);
+}
+
+void
+init_lapack_ctfttp(VALUE mLapack){
+  rb_define_module_function(mLapack, "ctfttp", rblapack_ctfttp, -1);
+}

data/ext/ctfttr.c

@@ -0,0 +1,76 @@
+#include "rb_lapack.h"
+
+extern VOID ctfttr_(char* transr, char* uplo, integer* n, complex* arf, complex* a, integer* lda, integer* info);
+
+
+static VALUE
+rblapack_ctfttr(int argc, VALUE *argv, VALUE self){
+  VALUE rblapack_transr;
+  char transr; 
+  VALUE rblapack_uplo;
+  char uplo; 
+  VALUE rblapack_arf;
+  complex *arf; 
+  VALUE rblapack_a;
+  complex *a; 
+  VALUE rblapack_info;
+  integer info; 
+
+  integer ldarf;
+  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  a, info = NumRu::Lapack.ctfttr( transr, uplo, arf, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE CTFTTR( TRANSR, UPLO, N, ARF, A, LDA, INFO )\n\n*  Purpose\n*  =======\n*\n*  CTFTTR copies a triangular matrix A from rectangular full packed\n*  format (TF) to standard full format (TR).\n*\n\n*  Arguments\n*  =========\n*\n*  TRANSR   (input) CHARACTER*1\n*          = 'N':  ARF is in Normal format;\n*          = 'C':  ARF is in Conjugate-transpose format;\n*\n*  UPLO    (input) CHARACTER*1\n*          = 'U':  A is upper triangular;\n*          = 'L':  A is lower triangular.\n*\n*  N       (input) INTEGER\n*          The order of the matrix A.  N >= 0.\n*\n*  ARF     (input) COMPLEX array, dimension ( N*(N+1)/2 ),\n*          On entry, the upper or lower triangular matrix A stored in\n*          RFP format. For a further discussion see Notes below.\n*\n*  A       (output) COMPLEX array, dimension ( LDA, N ) \n*          On exit, the triangular matrix A.  If UPLO = 'U', the\n*          leading N-by-N upper triangular part of the array A contains\n*          the upper triangular matrix, and the strictly lower\n*          triangular part of A is not referenced.  If UPLO = 'L', the\n*          leading N-by-N lower triangular part of the array A contains\n*          the lower triangular matrix, and the strictly upper\n*          triangular part of A is not referenced.\n*\n*  LDA     (input) INTEGER\n*          The leading dimension of the array A.  LDA >= 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*  We first consider Standard Packed Format when N is even.\n*  We give an example where N = 6.\n*\n*      AP is Upper             AP is Lower\n*\n*   00 01 02 03 04 05       00\n*      11 12 13 14 15       10 11\n*         22 23 24 25       20 21 22\n*            33 34 35       30 31 32 33\n*               44 45       40 41 42 43 44\n*                  55       50 51 52 53 54 55\n*\n*\n*  Let TRANSR = 'N'. RFP holds AP as follows:\n*  For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last\n*  three columns of AP upper. The lower triangle A(4:6,0:2) consists of\n*  conjugate-transpose of the first three columns of AP upper.\n*  For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first\n*  three columns of AP lower. The upper triangle A(0:2,0:2) consists of\n*  conjugate-transpose of the last three columns of AP lower.\n*  To denote conjugate we place -- above the element. This covers the\n*  case N even and TRANSR = 'N'.\n*\n*         RFP A                   RFP A\n*\n*                                -- -- --\n*        03 04 05                33 43 53\n*                                   -- --\n*        13 14 15                00 44 54\n*                                      --\n*        23 24 25                10 11 55\n*\n*        33 34 35                20 21 22\n*        --\n*        00 44 45                30 31 32\n*        -- --\n*        01 11 55                40 41 42\n*        -- -- --\n*        02 12 22                50 51 52\n*\n*  Now let TRANSR = 'C'. RFP A in both UPLO cases is just the conjugate-\n*  transpose of RFP A above. One therefore gets:\n*\n*\n*           RFP A                   RFP A\n*\n*     -- -- -- --                -- -- -- -- -- --\n*     03 13 23 33 00 01 02    33 00 10 20 30 40 50\n*     -- -- -- -- --                -- -- -- -- --\n*     04 14 24 34 44 11 12    43 44 11 21 31 41 51\n*     -- -- -- -- -- --                -- -- -- --\n*     05 15 25 35 45 55 22    53 54 55 22 32 42 52\n*\n*\n*  We next  consider Standard Packed Format when N is odd.\n*  We give an example where N = 5.\n*\n*     AP is Upper                 AP is Lower\n*\n*   00 01 02 03 04              00\n*      11 12 13 14              10 11\n*         22 23 24              20 21 22\n*            33 34              30 31 32 33\n*               44              40 41 42 43 44\n*\n*\n*  Let TRANSR = 'N'. RFP holds AP as follows:\n*  For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last\n*  three columns of AP upper. The lower triangle A(3:4,0:1) consists of\n*  conjugate-transpose of the first two   columns of AP upper.\n*  For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first\n*  three columns of AP lower. The upper triangle A(0:1,1:2) consists of\n*  conjugate-transpose of the last two   columns of AP lower.\n*  To denote conjugate we place -- above the element. This covers the\n*  case N odd  and TRANSR = 'N'.\n*\n*         RFP A                   RFP A\n*\n*                                   -- --\n*        02 03 04                00 33 43\n*                                      --\n*        12 13 14                10 11 44\n*\n*        22 23 24                20 21 22\n*        --\n*        00 33 34                30 31 32\n*        -- --\n*        01 11 44                40 41 42\n*\n*  Now let TRANSR = 'C'. RFP A in both UPLO cases is just the conjugate-\n*  transpose of RFP A above. One therefore gets:\n*\n*\n*           RFP A                   RFP A\n*\n*     -- -- --                   -- -- -- -- -- --\n*     02 12 22 00 01             00 10 20 30 40 50\n*     -- -- -- --                   -- -- -- -- --\n*     03 13 23 33 11             33 11 21 31 41 51\n*     -- -- -- -- --                   -- -- -- --\n*     04 14 24 34 44             43 44 22 32 42 52\n*\n*  =====================================================================\n*\n\n");
+      return Qnil;
+    }
+    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
+      printf("%s\n", "USAGE:\n  a, info = NumRu::Lapack.ctfttr( transr, uplo, arf, [: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_transr = argv[0];
+  rblapack_uplo = argv[1];
+  rblapack_arf = argv[2];
+  if (argc == 3) {
+  } else if (rblapack_options != Qnil) {
+  } else {
+  }
+
+  if (!NA_IsNArray(rblapack_arf))
+    rb_raise(rb_eArgError, "arf (3th argument) must be NArray");
+  if (NA_RANK(rblapack_arf) != 1)
+    rb_raise(rb_eArgError, "rank of arf (3th argument) must be %d", 1);
+  ldarf = NA_SHAPE0(rblapack_arf);
+  if (NA_TYPE(rblapack_arf) != NA_SCOMPLEX)
+    rblapack_arf = na_change_type(rblapack_arf, NA_SCOMPLEX);
+  arf = NA_PTR_TYPE(rblapack_arf, complex*);
+  transr = StringValueCStr(rblapack_transr)[0];
+  n = ((int)sqrtf(ldarf*8+1.0f)-1)/2;
+  uplo = StringValueCStr(rblapack_uplo)[0];
+  lda = MAX(1,n);
+  {
+    int shape[2];
+    shape[0] = lda;
+    shape[1] = n;
+    rblapack_a = na_make_object(NA_SCOMPLEX, 2, shape, cNArray);
+  }
+  a = NA_PTR_TYPE(rblapack_a, complex*);
+
+  ctfttr_(&transr, &uplo, &n, arf, a, &lda, &info);
+
+  rblapack_info = INT2NUM(info);
+  return rb_ary_new3(2, rblapack_a, rblapack_info);
+}
+
+void
+init_lapack_ctfttr(VALUE mLapack){
+  rb_define_module_function(mLapack, "ctfttr", rblapack_ctfttr, -1);
+}

data/ext/ctgevc.c

@@ -0,0 +1,152 @@
+#include "rb_lapack.h"
+
+extern VOID ctgevc_(char* side, char* howmny, logical* select, integer* n, complex* s, integer* lds, complex* p, integer* ldp, complex* vl, integer* ldvl, complex* vr, integer* ldvr, integer* mm, integer* m, complex* work, real* rwork, integer* info);
+
+
+static VALUE
+rblapack_ctgevc(int argc, VALUE *argv, VALUE self){
+  VALUE rblapack_side;
+  char side; 
+  VALUE rblapack_howmny;
+  char howmny; 
+  VALUE rblapack_select;
+  logical *select; 
+  VALUE rblapack_s;
+  complex *s; 
+  VALUE rblapack_p;
+  complex *p; 
+  VALUE rblapack_vl;
+  complex *vl; 
+  VALUE rblapack_vr;
+  complex *vr; 
+  VALUE rblapack_m;
+  integer m; 
+  VALUE rblapack_info;
+  integer info; 
+  VALUE rblapack_vl_out__;
+  complex *vl_out__;
+  VALUE rblapack_vr_out__;
+  complex *vr_out__;
+  complex *work;
+  real *rwork;
+
+  integer n;
+  integer lds;
+  integer ldp;
+  integer ldvl;
+  integer mm;
+  integer ldvr;
+
+  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  m, info, vl, vr = NumRu::Lapack.ctgevc( side, howmny, select, s, p, vl, vr, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE CTGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, LDVL, VR, LDVR, MM, M, WORK, RWORK, INFO )\n\n*  Purpose\n*  =======\n*\n*  CTGEVC computes some or all of the right and/or left eigenvectors of\n*  a pair of complex matrices (S,P), where S and P are upper triangular.\n*  Matrix pairs of this type are produced by the generalized Schur\n*  factorization of a complex matrix pair (A,B):\n*  \n*     A = Q*S*Z**H,  B = Q*P*Z**H\n*  \n*  as computed by CGGHRD + CHGEQZ.\n*  \n*  The right eigenvector x and the left eigenvector y of (S,P)\n*  corresponding to an eigenvalue w are defined by:\n*  \n*     S*x = w*P*x,  (y**H)*S = w*(y**H)*P,\n*  \n*  where y**H denotes the conjugate tranpose of y.\n*  The eigenvalues are not input to this routine, but are computed\n*  directly from the diagonal elements of S and P.\n*  \n*  This routine returns the matrices X and/or Y of right and left\n*  eigenvectors of (S,P), or the products Z*X and/or Q*Y,\n*  where Z and Q are input matrices.\n*  If Q and Z are the unitary factors from the generalized Schur\n*  factorization of a matrix pair (A,B), then Z*X and Q*Y\n*  are the matrices of right and left eigenvectors of (A,B).\n*\n\n*  Arguments\n*  =========\n*\n*  SIDE    (input) CHARACTER*1\n*          = 'R': compute right eigenvectors only;\n*          = 'L': compute left eigenvectors only;\n*          = 'B': compute both right and left eigenvectors.\n*\n*  HOWMNY  (input) CHARACTER*1\n*          = 'A': compute all right and/or left eigenvectors;\n*          = 'B': compute all right and/or left eigenvectors,\n*                 backtransformed by the matrices in VR and/or VL;\n*          = 'S': compute selected right and/or left eigenvectors,\n*                 specified by the logical array SELECT.\n*\n*  SELECT  (input) LOGICAL array, dimension (N)\n*          If HOWMNY='S', SELECT specifies the eigenvectors to be\n*          computed.  The eigenvector corresponding to the j-th\n*          eigenvalue is computed if SELECT(j) = .TRUE..\n*          Not referenced if HOWMNY = 'A' or 'B'.\n*\n*  N       (input) INTEGER\n*          The order of the matrices S and P.  N >= 0.\n*\n*  S       (input) COMPLEX array, dimension (LDS,N)\n*          The upper triangular matrix S from a generalized Schur\n*          factorization, as computed by CHGEQZ.\n*\n*  LDS     (input) INTEGER\n*          The leading dimension of array S.  LDS >= max(1,N).\n*\n*  P       (input) COMPLEX array, dimension (LDP,N)\n*          The upper triangular matrix P from a generalized Schur\n*          factorization, as computed by CHGEQZ.  P must have real\n*          diagonal elements.\n*\n*  LDP     (input) INTEGER\n*          The leading dimension of array P.  LDP >= max(1,N).\n*\n*  VL      (input/output) COMPLEX array, dimension (LDVL,MM)\n*          On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must\n*          contain an N-by-N matrix Q (usually the unitary matrix Q\n*          of left Schur vectors returned by CHGEQZ).\n*          On exit, if SIDE = 'L' or 'B', VL contains:\n*          if HOWMNY = 'A', the matrix Y of left eigenvectors of (S,P);\n*          if HOWMNY = 'B', the matrix Q*Y;\n*          if HOWMNY = 'S', the left eigenvectors of (S,P) specified by\n*                      SELECT, stored consecutively in the columns of\n*                      VL, in the same order as their eigenvalues.\n*          Not referenced if SIDE = 'R'.\n*\n*  LDVL    (input) INTEGER\n*          The leading dimension of array VL.  LDVL >= 1, and if\n*          SIDE = 'L' or 'l' or 'B' or 'b', LDVL >= N.\n*\n*  VR      (input/output) COMPLEX array, dimension (LDVR,MM)\n*          On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must\n*          contain an N-by-N matrix Q (usually the unitary matrix Z\n*          of right Schur vectors returned by CHGEQZ).\n*          On exit, if SIDE = 'R' or 'B', VR contains:\n*          if HOWMNY = 'A', the matrix X of right eigenvectors of (S,P);\n*          if HOWMNY = 'B', the matrix Z*X;\n*          if HOWMNY = 'S', the right eigenvectors of (S,P) specified by\n*                      SELECT, stored consecutively in the columns of\n*                      VR, in the same order as their eigenvalues.\n*          Not referenced if SIDE = 'L'.\n*\n*  LDVR    (input) INTEGER\n*          The leading dimension of the array VR.  LDVR >= 1, and if\n*          SIDE = 'R' or 'B', LDVR >= N.\n*\n*  MM      (input) INTEGER\n*          The number of columns in the arrays VL and/or VR. MM >= M.\n*\n*  M       (output) INTEGER\n*          The number of columns in the arrays VL and/or VR actually\n*          used to store the eigenvectors.  If HOWMNY = 'A' or 'B', M\n*          is set to N.  Each selected eigenvector occupies one column.\n*\n*  WORK    (workspace) COMPLEX array, dimension (2*N)\n*\n*  RWORK   (workspace) REAL array, dimension (2*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  m, info, vl, vr = NumRu::Lapack.ctgevc( side, howmny, select, s, p, vl, vr, [: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_side = argv[0];
+  rblapack_howmny = argv[1];
+  rblapack_select = argv[2];
+  rblapack_s = argv[3];
+  rblapack_p = argv[4];
+  rblapack_vl = argv[5];
+  rblapack_vr = argv[6];
+  if (argc == 7) {
+  } else if (rblapack_options != Qnil) {
+  } else {
+  }
+
+  if (!NA_IsNArray(rblapack_vl))
+    rb_raise(rb_eArgError, "vl (6th argument) must be NArray");
+  if (NA_RANK(rblapack_vl) != 2)
+    rb_raise(rb_eArgError, "rank of vl (6th argument) must be %d", 2);
+  ldvl = NA_SHAPE0(rblapack_vl);
+  mm = NA_SHAPE1(rblapack_vl);
+  if (NA_TYPE(rblapack_vl) != NA_SCOMPLEX)
+    rblapack_vl = na_change_type(rblapack_vl, NA_SCOMPLEX);
+  vl = NA_PTR_TYPE(rblapack_vl, complex*);
+  if (!NA_IsNArray(rblapack_p))
+    rb_raise(rb_eArgError, "p (5th argument) must be NArray");
+  if (NA_RANK(rblapack_p) != 2)
+    rb_raise(rb_eArgError, "rank of p (5th argument) must be %d", 2);
+  ldp = NA_SHAPE0(rblapack_p);
+  n = NA_SHAPE1(rblapack_p);
+  if (NA_TYPE(rblapack_p) != NA_SCOMPLEX)
+    rblapack_p = na_change_type(rblapack_p, NA_SCOMPLEX);
+  p = NA_PTR_TYPE(rblapack_p, complex*);
+  if (!NA_IsNArray(rblapack_s))
+    rb_raise(rb_eArgError, "s (4th argument) must be NArray");
+  if (NA_RANK(rblapack_s) != 2)
+    rb_raise(rb_eArgError, "rank of s (4th argument) must be %d", 2);
+  lds = NA_SHAPE0(rblapack_s);
+  if (NA_SHAPE1(rblapack_s) != n)
+    rb_raise(rb_eRuntimeError, "shape 1 of s must be the same as shape 1 of p");
+  if (NA_TYPE(rblapack_s) != NA_SCOMPLEX)
+    rblapack_s = na_change_type(rblapack_s, NA_SCOMPLEX);
+  s = NA_PTR_TYPE(rblapack_s, complex*);
+  howmny = StringValueCStr(rblapack_howmny)[0];
+  side = StringValueCStr(rblapack_side)[0];
+  if (!NA_IsNArray(rblapack_select))
+    rb_raise(rb_eArgError, "select (3th argument) must be NArray");
+  if (NA_RANK(rblapack_select) != 1)
+    rb_raise(rb_eArgError, "rank of select (3th argument) must be %d", 1);
+  if (NA_SHAPE0(rblapack_select) != n)
+    rb_raise(rb_eRuntimeError, "shape 0 of select must be the same as shape 1 of p");
+  if (NA_TYPE(rblapack_select) != NA_LINT)
+    rblapack_select = na_change_type(rblapack_select, NA_LINT);
+  select = NA_PTR_TYPE(rblapack_select, logical*);
+  if (!NA_IsNArray(rblapack_vr))
+    rb_raise(rb_eArgError, "vr (7th argument) must be NArray");
+  if (NA_RANK(rblapack_vr) != 2)
+    rb_raise(rb_eArgError, "rank of vr (7th argument) must be %d", 2);
+  ldvr = NA_SHAPE0(rblapack_vr);
+  if (NA_SHAPE1(rblapack_vr) != mm)
+    rb_raise(rb_eRuntimeError, "shape 1 of vr must be the same as shape 1 of vl");
+  if (NA_TYPE(rblapack_vr) != NA_SCOMPLEX)
+    rblapack_vr = na_change_type(rblapack_vr, NA_SCOMPLEX);
+  vr = NA_PTR_TYPE(rblapack_vr, complex*);
+  {
+    int shape[2];
+    shape[0] = ldvl;
+    shape[1] = mm;
+    rblapack_vl_out__ = na_make_object(NA_SCOMPLEX, 2, shape, cNArray);
+  }
+  vl_out__ = NA_PTR_TYPE(rblapack_vl_out__, complex*);
+  MEMCPY(vl_out__, vl, complex, NA_TOTAL(rblapack_vl));
+  rblapack_vl = rblapack_vl_out__;
+  vl = vl_out__;
+  {
+    int shape[2];
+    shape[0] = ldvr;
+    shape[1] = mm;
+    rblapack_vr_out__ = na_make_object(NA_SCOMPLEX, 2, shape, cNArray);
+  }
+  vr_out__ = NA_PTR_TYPE(rblapack_vr_out__, complex*);
+  MEMCPY(vr_out__, vr, complex, NA_TOTAL(rblapack_vr));
+  rblapack_vr = rblapack_vr_out__;
+  vr = vr_out__;
+  work = ALLOC_N(complex, (2*n));
+  rwork = ALLOC_N(real, (2*n));
+
+  ctgevc_(&side, &howmny, select, &n, s, &lds, p, &ldp, vl, &ldvl, vr, &ldvr, &mm, &m, work, rwork, &info);
+
+  free(work);
+  free(rwork);
+  rblapack_m = INT2NUM(m);
+  rblapack_info = INT2NUM(info);
+  return rb_ary_new3(4, rblapack_m, rblapack_info, rblapack_vl, rblapack_vr);
+}
+
+void
+init_lapack_ctgevc(VALUE mLapack){
+  rb_define_module_function(mLapack, "ctgevc", rblapack_ctgevc, -1);
+}