ruby-lapack 1.6 → 1.7

data/ext/ztgsna.c

@@ -1,164 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID ztgsna_(char* job, char* howmny, logical* select, integer* n, doublecomplex* a, integer* lda, doublecomplex* b, integer* ldb, doublecomplex* vl, integer* ldvl, doublecomplex* vr, integer* ldvr, doublereal* s, doublereal* dif, integer* mm, integer* m, doublecomplex* work, integer* lwork, integer* iwork, integer* info);
-
-
-static VALUE
-rblapack_ztgsna(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_job;
-  char job; 
-  VALUE rblapack_howmny;
-  char howmny; 
-  VALUE rblapack_select;
-  logical *select; 
-  VALUE rblapack_a;
-  doublecomplex *a; 
-  VALUE rblapack_b;
-  doublecomplex *b; 
-  VALUE rblapack_vl;
-  doublecomplex *vl; 
-  VALUE rblapack_vr;
-  doublecomplex *vr; 
-  VALUE rblapack_lwork;
-  integer lwork; 
-  VALUE rblapack_s;
-  doublereal *s; 
-  VALUE rblapack_dif;
-  doublereal *dif; 
-  VALUE rblapack_m;
-  integer m; 
-  VALUE rblapack_work;
-  doublecomplex *work; 
-  VALUE rblapack_info;
-  integer info; 
-  integer *iwork;
-
-  integer n;
-  integer lda;
-  integer ldb;
-  integer ldvl;
-  integer ldvr;
-  integer mm;
-
-  VALUE rblapack_options;
-  if (argc > 0 && TYPE(argv[argc-1]) == T_HASH) {
-    argc--;
-    rblapack_options = argv[argc];
-    if (rb_hash_aref(rblapack_options, sHelp) == Qtrue) {
-      printf("%s\n", "USAGE:\n  s, dif, m, work, info = NumRu::Lapack.ztgsna( job, howmny, select, a, b, vl, vr, [:lwork => lwork, :usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE ZTGSNA( JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, LDVL, VR, LDVR, S, DIF, MM, M, WORK, LWORK, IWORK, INFO )\n\n*  Purpose\n*  =======\n*\n*  ZTGSNA estimates reciprocal condition numbers for specified\n*  eigenvalues and/or eigenvectors of a matrix pair (A, B).\n*\n*  (A, B) must be in generalized Schur canonical form, that is, A and\n*  B are both upper triangular.\n*\n\n*  Arguments\n*  =========\n*\n*  JOB     (input) CHARACTER*1\n*          Specifies whether condition numbers are required for\n*          eigenvalues (S) or eigenvectors (DIF):\n*          = 'E': for eigenvalues only (S);\n*          = 'V': for eigenvectors only (DIF);\n*          = 'B': for both eigenvalues and eigenvectors (S and DIF).\n*\n*  HOWMNY  (input) CHARACTER*1\n*          = 'A': compute condition numbers for all eigenpairs;\n*          = 'S': compute condition numbers for selected eigenpairs\n*                 specified by the array SELECT.\n*\n*  SELECT  (input) LOGICAL array, dimension (N)\n*          If HOWMNY = 'S', SELECT specifies the eigenpairs for which\n*          condition numbers are required. To select condition numbers\n*          for the corresponding j-th eigenvalue and/or eigenvector,\n*          SELECT(j) must be set to .TRUE..\n*          If HOWMNY = 'A', SELECT is not referenced.\n*\n*  N       (input) INTEGER\n*          The order of the square matrix pair (A, B). N >= 0.\n*\n*  A       (input) COMPLEX*16 array, dimension (LDA,N)\n*          The upper triangular matrix A in the pair (A,B).\n*\n*  LDA     (input) INTEGER\n*          The leading dimension of the array A. LDA >= max(1,N).\n*\n*  B       (input) COMPLEX*16 array, dimension (LDB,N)\n*          The upper triangular matrix B in the pair (A, B).\n*\n*  LDB     (input) INTEGER\n*          The leading dimension of the array B. LDB >= max(1,N).\n*\n*  VL      (input) COMPLEX*16 array, dimension (LDVL,M)\n*          IF JOB = 'E' or 'B', VL must contain left eigenvectors of\n*          (A, B), corresponding to the eigenpairs specified by HOWMNY\n*          and SELECT.  The eigenvectors must be stored in consecutive\n*          columns of VL, as returned by ZTGEVC.\n*          If JOB = 'V', VL is not referenced.\n*\n*  LDVL    (input) INTEGER\n*          The leading dimension of the array VL. LDVL >= 1; and\n*          If JOB = 'E' or 'B', LDVL >= N.\n*\n*  VR      (input) COMPLEX*16 array, dimension (LDVR,M)\n*          IF JOB = 'E' or 'B', VR must contain right eigenvectors of\n*          (A, B), corresponding to the eigenpairs specified by HOWMNY\n*          and SELECT.  The eigenvectors must be stored in consecutive\n*          columns of VR, as returned by ZTGEVC.\n*          If JOB = 'V', VR is not referenced.\n*\n*  LDVR    (input) INTEGER\n*          The leading dimension of the array VR. LDVR >= 1;\n*          If JOB = 'E' or 'B', LDVR >= N.\n*\n*  S       (output) DOUBLE PRECISION array, dimension (MM)\n*          If JOB = 'E' or 'B', the reciprocal condition numbers of the\n*          selected eigenvalues, stored in consecutive elements of the\n*          array.\n*          If JOB = 'V', S is not referenced.\n*\n*  DIF     (output) DOUBLE PRECISION array, dimension (MM)\n*          If JOB = 'V' or 'B', the estimated reciprocal condition\n*          numbers of the selected eigenvectors, stored in consecutive\n*          elements of the array.\n*          If the eigenvalues cannot be reordered to compute DIF(j),\n*          DIF(j) is set to 0; this can only occur when the true value\n*          would be very small anyway.\n*          For each eigenvalue/vector specified by SELECT, DIF stores\n*          a Frobenius norm-based estimate of Difl.\n*          If JOB = 'E', DIF is not referenced.\n*\n*  MM      (input) INTEGER\n*          The number of elements in the arrays S and DIF. MM >= M.\n*\n*  M       (output) INTEGER\n*          The number of elements of the arrays S and DIF used to store\n*          the specified condition numbers; for each selected eigenvalue\n*          one element is used. If HOWMNY = 'A', M is set to N.\n*\n*  WORK    (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))\n*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.\n*\n*  LWORK  (input) INTEGER\n*          The dimension of the array WORK. LWORK >= max(1,N).\n*          If JOB = 'V' or 'B', LWORK >= max(1,2*N*N).\n*\n*  IWORK   (workspace) INTEGER array, dimension (N+2)\n*          If JOB = 'E', IWORK is not referenced.\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 reciprocal of the condition number of the i-th generalized\n*  eigenvalue w = (a, b) is defined as\n*\n*          S(I) = (|v'Au|**2 + |v'Bu|**2)**(1/2) / (norm(u)*norm(v))\n*\n*  where u and v are the right and left eigenvectors of (A, B)\n*  corresponding to w; |z| denotes the absolute value of the complex\n*  number, and norm(u) denotes the 2-norm of the vector u. The pair\n*  (a, b) corresponds to an eigenvalue w = a/b (= v'Au/v'Bu) of the\n*  matrix pair (A, B). If both a and b equal zero, then (A,B) is\n*  singular and S(I) = -1 is returned.\n*\n*  An approximate error bound on the chordal distance between the i-th\n*  computed generalized eigenvalue w and the corresponding exact\n*  eigenvalue lambda is\n*\n*          chord(w, lambda) <=   EPS * norm(A, B) / S(I),\n*\n*  where EPS is the machine precision.\n*\n*  The reciprocal of the condition number of the right eigenvector u\n*  and left eigenvector v corresponding to the generalized eigenvalue w\n*  is defined as follows. Suppose\n*\n*                   (A, B) = ( a   *  ) ( b  *  )  1\n*                            ( 0  A22 ),( 0 B22 )  n-1\n*                              1  n-1     1 n-1\n*\n*  Then the reciprocal condition number DIF(I) is\n*\n*          Difl[(a, b), (A22, B22)]  = sigma-min( Zl )\n*\n*  where sigma-min(Zl) denotes the smallest singular value of\n*\n*         Zl = [ kron(a, In-1) -kron(1, A22) ]\n*              [ kron(b, In-1) -kron(1, B22) ].\n*\n*  Here In-1 is the identity matrix of size n-1 and X' is the conjugate\n*  transpose of X. kron(X, Y) is the Kronecker product between the\n*  matrices X and Y.\n*\n*  We approximate the smallest singular value of Zl with an upper\n*  bound. This is done by ZLATDF.\n*\n*  An approximate error bound for a computed eigenvector VL(i) or\n*  VR(i) is given by\n*\n*                      EPS * norm(A, B) / DIF(i).\n*\n*  See ref. [2-3] for more details and further references.\n*\n*  Based on contributions by\n*     Bo Kagstrom and Peter Poromaa, Department of Computing Science,\n*     Umea University, S-901 87 Umea, Sweden.\n*\n*  References\n*  ==========\n*\n*  [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the\n*      Generalized Real Schur Form of a Regular Matrix Pair (A, B), in\n*      M.S. Moonen et al (eds), Linear Algebra for Large Scale and\n*      Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.\n*\n*  [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified\n*      Eigenvalues of a Regular Matrix Pair (A, B) and Condition\n*      Estimation: Theory, Algorithms and Software, Report\n*      UMINF - 94.04, Department of Computing Science, Umea University,\n*      S-901 87 Umea, Sweden, 1994. Also as LAPACK Working Note 87.\n*      To appear in Numerical Algorithms, 1996.\n*\n*  [3] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software\n*      for Solving the Generalized Sylvester Equation and Estimating the\n*      Separation between Regular Matrix Pairs, Report UMINF - 93.23,\n*      Department of Computing Science, Umea University, S-901 87 Umea,\n*      Sweden, December 1993, Revised April 1994, Also as LAPACK Working\n*      Note 75.\n*      To appear in ACM Trans. on Math. Software, Vol 22, No 1, 1996.\n*\n*  =====================================================================\n*\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  s, dif, m, work, info = NumRu::Lapack.ztgsna( job, howmny, select, a, b, vl, vr, [:lwork => lwork, :usage => usage, :help => help])\n");
-      return Qnil;
-    } 
-  } else
-    rblapack_options = Qnil;
-  if (argc != 7 && argc != 8)
-    rb_raise(rb_eArgError,"wrong number of arguments (%d for 7)", argc);
-  rblapack_job = argv[0];
-  rblapack_howmny = argv[1];
-  rblapack_select = argv[2];
-  rblapack_a = argv[3];
-  rblapack_b = argv[4];
-  rblapack_vl = argv[5];
-  rblapack_vr = argv[6];
-  if (argc == 8) {
-    rblapack_lwork = argv[7];
-  } else if (rblapack_options != Qnil) {
-    rblapack_lwork = rb_hash_aref(rblapack_options, ID2SYM(rb_intern("lwork")));
-  } else {
-    rblapack_lwork = Qnil;
-  }
-
-  job = StringValueCStr(rblapack_job)[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);
-  n = NA_SHAPE0(rblapack_select);
-  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_b))
-    rb_raise(rb_eArgError, "b (5th argument) must be NArray");
-  if (NA_RANK(rblapack_b) != 2)
-    rb_raise(rb_eArgError, "rank of b (5th argument) must be %d", 2);
-  ldb = NA_SHAPE0(rblapack_b);
-  if (NA_SHAPE1(rblapack_b) != n)
-    rb_raise(rb_eRuntimeError, "shape 1 of b must be the same as shape 0 of select");
-  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_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);
-  m = NA_SHAPE1(rblapack_vr);
-  if (NA_TYPE(rblapack_vr) != NA_DCOMPLEX)
-    rblapack_vr = na_change_type(rblapack_vr, NA_DCOMPLEX);
-  vr = NA_PTR_TYPE(rblapack_vr, doublecomplex*);
-  howmny = StringValueCStr(rblapack_howmny)[0];
-  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);
-  if (NA_SHAPE1(rblapack_vl) != m)
-    rb_raise(rb_eRuntimeError, "shape 1 of vl must be the same as shape 1 of vr");
-  if (NA_TYPE(rblapack_vl) != NA_DCOMPLEX)
-    rblapack_vl = na_change_type(rblapack_vl, NA_DCOMPLEX);
-  vl = NA_PTR_TYPE(rblapack_vl, doublecomplex*);
-  mm = m;
-  if (!NA_IsNArray(rblapack_a))
-    rb_raise(rb_eArgError, "a (4th argument) must be NArray");
-  if (NA_RANK(rblapack_a) != 2)
-    rb_raise(rb_eArgError, "rank of a (4th 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 select");
-  if (NA_TYPE(rblapack_a) != NA_DCOMPLEX)
-    rblapack_a = na_change_type(rblapack_a, NA_DCOMPLEX);
-  a = NA_PTR_TYPE(rblapack_a, doublecomplex*);
-  if (rblapack_lwork == Qnil)
-    lwork = (lsame_(&job,"V")||lsame_(&job,"B")) ? 2*n*n : n;
-  else {
-    lwork = NUM2INT(rblapack_lwork);
-  }
-  {
-    int shape[1];
-    shape[0] = mm;
-    rblapack_s = na_make_object(NA_DFLOAT, 1, shape, cNArray);
-  }
-  s = NA_PTR_TYPE(rblapack_s, doublereal*);
-  {
-    int shape[1];
-    shape[0] = mm;
-    rblapack_dif = na_make_object(NA_DFLOAT, 1, shape, cNArray);
-  }
-  dif = NA_PTR_TYPE(rblapack_dif, doublereal*);
-  {
-    int shape[1];
-    shape[0] = MAX(1,lwork);
-    rblapack_work = na_make_object(NA_DCOMPLEX, 1, shape, cNArray);
-  }
-  work = NA_PTR_TYPE(rblapack_work, doublecomplex*);
-  iwork = ALLOC_N(integer, (lsame_(&job,"E") ? 0 : n+2));
-
-  ztgsna_(&job, &howmny, select, &n, a, &lda, b, &ldb, vl, &ldvl, vr, &ldvr, s, dif, &mm, &m, work, &lwork, iwork, &info);
-
-  free(iwork);
-  rblapack_m = INT2NUM(m);
-  rblapack_info = INT2NUM(info);
-  return rb_ary_new3(5, rblapack_s, rblapack_dif, rblapack_m, rblapack_work, rblapack_info);
-}
-
-void
-init_lapack_ztgsna(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "ztgsna", rblapack_ztgsna, -1);
-}

data/ext/ztgsy2.c

@@ -1,176 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID ztgsy2_(char* trans, integer* ijob, integer* m, integer* n, doublecomplex* a, integer* lda, doublecomplex* b, integer* ldb, doublecomplex* c, integer* ldc, doublecomplex* d, integer* ldd, doublecomplex* e, integer* lde, doublecomplex* f, integer* ldf, doublereal* scale, doublereal* rdsum, doublereal* rdscal, integer* info);
-
-
-static VALUE
-rblapack_ztgsy2(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_trans;
-  char trans; 
-  VALUE rblapack_ijob;
-  integer ijob; 
-  VALUE rblapack_a;
-  doublecomplex *a; 
-  VALUE rblapack_b;
-  doublecomplex *b; 
-  VALUE rblapack_c;
-  doublecomplex *c; 
-  VALUE rblapack_d;
-  doublecomplex *d; 
-  VALUE rblapack_e;
-  doublecomplex *e; 
-  VALUE rblapack_f;
-  doublecomplex *f; 
-  VALUE rblapack_rdsum;
-  doublereal rdsum; 
-  VALUE rblapack_rdscal;
-  doublereal rdscal; 
-  VALUE rblapack_scale;
-  doublereal scale; 
-  VALUE rblapack_info;
-  integer info; 
-  VALUE rblapack_c_out__;
-  doublecomplex *c_out__;
-  VALUE rblapack_f_out__;
-  doublecomplex *f_out__;
-
-  integer lda;
-  integer m;
-  integer ldb;
-  integer n;
-  integer ldc;
-  integer ldd;
-  integer lde;
-  integer ldf;
-
-  VALUE rblapack_options;
-  if (argc > 0 && TYPE(argv[argc-1]) == T_HASH) {
-    argc--;
-    rblapack_options = argv[argc];
-    if (rb_hash_aref(rblapack_options, sHelp) == Qtrue) {
-      printf("%s\n", "USAGE:\n  scale, info, c, f, rdsum, rdscal = NumRu::Lapack.ztgsy2( trans, ijob, a, b, c, d, e, f, rdsum, rdscal, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE ZTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, LDD, E, LDE, F, LDF, SCALE, RDSUM, RDSCAL, INFO )\n\n*  Purpose\n*  =======\n*\n*  ZTGSY2 solves the generalized Sylvester equation\n*\n*              A * R - L * B = scale *   C               (1)\n*              D * R - L * E = scale * F\n*\n*  using Level 1 and 2 BLAS, where R and L are unknown M-by-N matrices,\n*  (A, D), (B, E) and (C, F) are given matrix pairs of size M-by-M,\n*  N-by-N and M-by-N, respectively. A, B, D and E are upper triangular\n*  (i.e., (A,D) and (B,E) in generalized Schur form).\n*\n*  The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1 is an output\n*  scaling factor chosen to avoid overflow.\n*\n*  In matrix notation solving equation (1) corresponds to solve\n*  Zx = scale * b, where Z is defined as\n*\n*         Z = [ kron(In, A)  -kron(B', Im) ]             (2)\n*             [ kron(In, D)  -kron(E', Im) ],\n*\n*  Ik is the identity matrix of size k and X' is the transpose of X.\n*  kron(X, Y) is the Kronecker product between the matrices X and Y.\n*\n*  If TRANS = 'C', y in the conjugate transposed system Z'y = scale*b\n*  is solved for, which is equivalent to solve for R and L in\n*\n*              A' * R  + D' * L   = scale *  C           (3)\n*              R  * B' + L  * E'  = scale * -F\n*\n*  This case is used to compute an estimate of Dif[(A, D), (B, E)] =\n*  = sigma_min(Z) using reverse communicaton with ZLACON.\n*\n*  ZTGSY2 also (IJOB >= 1) contributes to the computation in ZTGSYL\n*  of an upper bound on the separation between to matrix pairs. Then\n*  the input (A, D), (B, E) are sub-pencils of two matrix pairs in\n*  ZTGSYL.\n*\n\n*  Arguments\n*  =========\n*\n*  TRANS   (input) CHARACTER*1\n*          = 'N', solve the generalized Sylvester equation (1).\n*          = 'T': solve the 'transposed' system (3).\n*\n*  IJOB    (input) INTEGER\n*          Specifies what kind of functionality to be performed.\n*          =0: solve (1) only.\n*          =1: A contribution from this subsystem to a Frobenius\n*              norm-based estimate of the separation between two matrix\n*              pairs is computed. (look ahead strategy is used).\n*          =2: A contribution from this subsystem to a Frobenius\n*              norm-based estimate of the separation between two matrix\n*              pairs is computed. (DGECON on sub-systems is used.)\n*          Not referenced if TRANS = 'T'.\n*\n*  M       (input) INTEGER\n*          On entry, M specifies the order of A and D, and the row\n*          dimension of C, F, R and L.\n*\n*  N       (input) INTEGER\n*          On entry, N specifies the order of B and E, and the column\n*          dimension of C, F, R and L.\n*\n*  A       (input) COMPLEX*16 array, dimension (LDA, M)\n*          On entry, A contains an upper triangular matrix.\n*\n*  LDA     (input) INTEGER\n*          The leading dimension of the matrix A. LDA >= max(1, M).\n*\n*  B       (input) COMPLEX*16 array, dimension (LDB, N)\n*          On entry, B contains an upper triangular matrix.\n*\n*  LDB     (input) INTEGER\n*          The leading dimension of the matrix B. LDB >= max(1, N).\n*\n*  C       (input/output) COMPLEX*16 array, dimension (LDC, N)\n*          On entry, C contains the right-hand-side of the first matrix\n*          equation in (1).\n*          On exit, if IJOB = 0, C has been overwritten by the solution\n*          R.\n*\n*  LDC     (input) INTEGER\n*          The leading dimension of the matrix C. LDC >= max(1, M).\n*\n*  D       (input) COMPLEX*16 array, dimension (LDD, M)\n*          On entry, D contains an upper triangular matrix.\n*\n*  LDD     (input) INTEGER\n*          The leading dimension of the matrix D. LDD >= max(1, M).\n*\n*  E       (input) COMPLEX*16 array, dimension (LDE, N)\n*          On entry, E contains an upper triangular matrix.\n*\n*  LDE     (input) INTEGER\n*          The leading dimension of the matrix E. LDE >= max(1, N).\n*\n*  F       (input/output) COMPLEX*16 array, dimension (LDF, N)\n*          On entry, F contains the right-hand-side of the second matrix\n*          equation in (1).\n*          On exit, if IJOB = 0, F has been overwritten by the solution\n*          L.\n*\n*  LDF     (input) INTEGER\n*          The leading dimension of the matrix F. LDF >= max(1, M).\n*\n*  SCALE   (output) DOUBLE PRECISION\n*          On exit, 0 <= SCALE <= 1. If 0 < SCALE < 1, the solutions\n*          R and L (C and F on entry) will hold the solutions to a\n*          slightly perturbed system but the input matrices A, B, D and\n*          E have not been changed. If SCALE = 0, R and L will hold the\n*          solutions to the homogeneous system with C = F = 0.\n*          Normally, SCALE = 1.\n*\n*  RDSUM   (input/output) DOUBLE PRECISION\n*          On entry, the sum of squares of computed contributions to\n*          the Dif-estimate under computation by ZTGSYL, where the\n*          scaling factor RDSCAL (see below) has been factored out.\n*          On exit, the corresponding sum of squares updated with the\n*          contributions from the current sub-system.\n*          If TRANS = 'T' RDSUM is not touched.\n*          NOTE: RDSUM only makes sense when ZTGSY2 is called by\n*          ZTGSYL.\n*\n*  RDSCAL  (input/output) DOUBLE PRECISION\n*          On entry, scaling factor used to prevent overflow in RDSUM.\n*          On exit, RDSCAL is updated w.r.t. the current contributions\n*          in RDSUM.\n*          If TRANS = 'T', RDSCAL is not touched.\n*          NOTE: RDSCAL only makes sense when ZTGSY2 is called by\n*          ZTGSYL.\n*\n*  INFO    (output) INTEGER\n*          On exit, if INFO is set to\n*            =0: Successful exit\n*            <0: If INFO = -i, input argument number i is illegal.\n*            >0: The matrix pairs (A, D) and (B, E) have common or very\n*                close eigenvalues.\n*\n\n*  Further Details\n*  ===============\n*\n*  Based on contributions by\n*     Bo Kagstrom and Peter Poromaa, Department of Computing Science,\n*     Umea University, S-901 87 Umea, Sweden.\n*\n*  =====================================================================\n*\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  scale, info, c, f, rdsum, rdscal = NumRu::Lapack.ztgsy2( trans, ijob, a, b, c, d, e, f, rdsum, rdscal, [:usage => usage, :help => help])\n");
-      return Qnil;
-    } 
-  } else
-    rblapack_options = Qnil;
-  if (argc != 10 && argc != 10)
-    rb_raise(rb_eArgError,"wrong number of arguments (%d for 10)", argc);
-  rblapack_trans = argv[0];
-  rblapack_ijob = argv[1];
-  rblapack_a = argv[2];
-  rblapack_b = argv[3];
-  rblapack_c = argv[4];
-  rblapack_d = argv[5];
-  rblapack_e = argv[6];
-  rblapack_f = argv[7];
-  rblapack_rdsum = argv[8];
-  rblapack_rdscal = argv[9];
-  if (argc == 10) {
-  } else if (rblapack_options != Qnil) {
-  } else {
-  }
-
-  trans = StringValueCStr(rblapack_trans)[0];
-  if (!NA_IsNArray(rblapack_a))
-    rb_raise(rb_eArgError, "a (3th argument) must be NArray");
-  if (NA_RANK(rblapack_a) != 2)
-    rb_raise(rb_eArgError, "rank of a (3th argument) must be %d", 2);
-  lda = NA_SHAPE0(rblapack_a);
-  m = 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*);
-  if (!NA_IsNArray(rblapack_c))
-    rb_raise(rb_eArgError, "c (5th argument) must be NArray");
-  if (NA_RANK(rblapack_c) != 2)
-    rb_raise(rb_eArgError, "rank of c (5th argument) must be %d", 2);
-  ldc = NA_SHAPE0(rblapack_c);
-  n = NA_SHAPE1(rblapack_c);
-  if (NA_TYPE(rblapack_c) != NA_DCOMPLEX)
-    rblapack_c = na_change_type(rblapack_c, NA_DCOMPLEX);
-  c = NA_PTR_TYPE(rblapack_c, doublecomplex*);
-  if (!NA_IsNArray(rblapack_e))
-    rb_raise(rb_eArgError, "e (7th argument) must be NArray");
-  if (NA_RANK(rblapack_e) != 2)
-    rb_raise(rb_eArgError, "rank of e (7th argument) must be %d", 2);
-  lde = NA_SHAPE0(rblapack_e);
-  if (NA_SHAPE1(rblapack_e) != n)
-    rb_raise(rb_eRuntimeError, "shape 1 of e must be the same as shape 1 of c");
-  if (NA_TYPE(rblapack_e) != NA_DCOMPLEX)
-    rblapack_e = na_change_type(rblapack_e, NA_DCOMPLEX);
-  e = NA_PTR_TYPE(rblapack_e, doublecomplex*);
-  rdsum = NUM2DBL(rblapack_rdsum);
-  ijob = NUM2INT(rblapack_ijob);
-  if (!NA_IsNArray(rblapack_d))
-    rb_raise(rb_eArgError, "d (6th argument) must be NArray");
-  if (NA_RANK(rblapack_d) != 2)
-    rb_raise(rb_eArgError, "rank of d (6th argument) must be %d", 2);
-  ldd = NA_SHAPE0(rblapack_d);
-  if (NA_SHAPE1(rblapack_d) != m)
-    rb_raise(rb_eRuntimeError, "shape 1 of d must be the same as shape 1 of a");
-  if (NA_TYPE(rblapack_d) != NA_DCOMPLEX)
-    rblapack_d = na_change_type(rblapack_d, NA_DCOMPLEX);
-  d = NA_PTR_TYPE(rblapack_d, doublecomplex*);
-  rdscal = NUM2DBL(rblapack_rdscal);
-  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);
-  if (NA_SHAPE1(rblapack_b) != n)
-    rb_raise(rb_eRuntimeError, "shape 1 of b must be the same as shape 1 of c");
-  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_f))
-    rb_raise(rb_eArgError, "f (8th argument) must be NArray");
-  if (NA_RANK(rblapack_f) != 2)
-    rb_raise(rb_eArgError, "rank of f (8th argument) must be %d", 2);
-  ldf = NA_SHAPE0(rblapack_f);
-  if (NA_SHAPE1(rblapack_f) != n)
-    rb_raise(rb_eRuntimeError, "shape 1 of f must be the same as shape 1 of c");
-  if (NA_TYPE(rblapack_f) != NA_DCOMPLEX)
-    rblapack_f = na_change_type(rblapack_f, NA_DCOMPLEX);
-  f = NA_PTR_TYPE(rblapack_f, doublecomplex*);
-  {
-    int shape[2];
-    shape[0] = ldc;
-    shape[1] = n;
-    rblapack_c_out__ = na_make_object(NA_DCOMPLEX, 2, shape, cNArray);
-  }
-  c_out__ = NA_PTR_TYPE(rblapack_c_out__, doublecomplex*);
-  MEMCPY(c_out__, c, doublecomplex, NA_TOTAL(rblapack_c));
-  rblapack_c = rblapack_c_out__;
-  c = c_out__;
-  {
-    int shape[2];
-    shape[0] = ldf;
-    shape[1] = n;
-    rblapack_f_out__ = na_make_object(NA_DCOMPLEX, 2, shape, cNArray);
-  }
-  f_out__ = NA_PTR_TYPE(rblapack_f_out__, doublecomplex*);
-  MEMCPY(f_out__, f, doublecomplex, NA_TOTAL(rblapack_f));
-  rblapack_f = rblapack_f_out__;
-  f = f_out__;
-
-  ztgsy2_(&trans, &ijob, &m, &n, a, &lda, b, &ldb, c, &ldc, d, &ldd, e, &lde, f, &ldf, &scale, &rdsum, &rdscal, &info);
-
-  rblapack_scale = rb_float_new((double)scale);
-  rblapack_info = INT2NUM(info);
-  rblapack_rdsum = rb_float_new((double)rdsum);
-  rblapack_rdscal = rb_float_new((double)rdscal);
-  return rb_ary_new3(6, rblapack_scale, rblapack_info, rblapack_c, rblapack_f, rblapack_rdsum, rblapack_rdscal);
-}
-
-void
-init_lapack_ztgsy2(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "ztgsy2", rblapack_ztgsy2, -1);
-}

data/ext/ztgsyl.c

@@ -1,190 +0,0 @@
-#include "rb_lapack.h"
-
-extern VOID ztgsyl_(char* trans, integer* ijob, integer* m, integer* n, doublecomplex* a, integer* lda, doublecomplex* b, integer* ldb, doublecomplex* c, integer* ldc, doublecomplex* d, integer* ldd, doublecomplex* e, integer* lde, doublecomplex* f, integer* ldf, doublereal* scale, doublereal* dif, doublecomplex* work, integer* lwork, integer* iwork, integer* info);
-
-
-static VALUE
-rblapack_ztgsyl(int argc, VALUE *argv, VALUE self){
-  VALUE rblapack_trans;
-  char trans; 
-  VALUE rblapack_ijob;
-  integer ijob; 
-  VALUE rblapack_a;
-  doublecomplex *a; 
-  VALUE rblapack_b;
-  doublecomplex *b; 
-  VALUE rblapack_c;
-  doublecomplex *c; 
-  VALUE rblapack_d;
-  doublecomplex *d; 
-  VALUE rblapack_e;
-  doublecomplex *e; 
-  VALUE rblapack_f;
-  doublecomplex *f; 
-  VALUE rblapack_lwork;
-  integer lwork; 
-  VALUE rblapack_scale;
-  doublereal scale; 
-  VALUE rblapack_dif;
-  doublereal dif; 
-  VALUE rblapack_work;
-  doublecomplex *work; 
-  VALUE rblapack_info;
-  integer info; 
-  VALUE rblapack_c_out__;
-  doublecomplex *c_out__;
-  VALUE rblapack_f_out__;
-  doublecomplex *f_out__;
-  integer *iwork;
-
-  integer lda;
-  integer m;
-  integer ldb;
-  integer n;
-  integer ldc;
-  integer ldd;
-  integer lde;
-  integer ldf;
-
-  VALUE rblapack_options;
-  if (argc > 0 && TYPE(argv[argc-1]) == T_HASH) {
-    argc--;
-    rblapack_options = argv[argc];
-    if (rb_hash_aref(rblapack_options, sHelp) == Qtrue) {
-      printf("%s\n", "USAGE:\n  scale, dif, work, info, c, f = NumRu::Lapack.ztgsyl( trans, ijob, a, b, c, d, e, f, [:lwork => lwork, :usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE ZTGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, LDD, E, LDE, F, LDF, SCALE, DIF, WORK, LWORK, IWORK, INFO )\n\n*  Purpose\n*  =======\n*\n*  ZTGSYL solves the generalized Sylvester equation:\n*\n*              A * R - L * B = scale * C            (1)\n*              D * R - L * E = scale * F\n*\n*  where R and L are unknown m-by-n matrices, (A, D), (B, E) and\n*  (C, F) are given matrix pairs of size m-by-m, n-by-n and m-by-n,\n*  respectively, with complex entries. A, B, D and E are upper\n*  triangular (i.e., (A,D) and (B,E) in generalized Schur form).\n*\n*  The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1\n*  is an output scaling factor chosen to avoid overflow.\n*\n*  In matrix notation (1) is equivalent to solve Zx = scale*b, where Z\n*  is defined as\n*\n*         Z = [ kron(In, A)  -kron(B', Im) ]        (2)\n*             [ kron(In, D)  -kron(E', Im) ],\n*\n*  Here Ix is the identity matrix of size x and X' is the conjugate\n*  transpose of X. Kron(X, Y) is the Kronecker product between the\n*  matrices X and Y.\n*\n*  If TRANS = 'C', y in the conjugate transposed system Z'*y = scale*b\n*  is solved for, which is equivalent to solve for R and L in\n*\n*              A' * R + D' * L = scale * C           (3)\n*              R * B' + L * E' = scale * -F\n*\n*  This case (TRANS = 'C') is used to compute an one-norm-based estimate\n*  of Dif[(A,D), (B,E)], the separation between the matrix pairs (A,D)\n*  and (B,E), using ZLACON.\n*\n*  If IJOB >= 1, ZTGSYL computes a Frobenius norm-based estimate of\n*  Dif[(A,D),(B,E)]. That is, the reciprocal of a lower bound on the\n*  reciprocal of the smallest singular value of Z.\n*\n*  This is a level-3 BLAS algorithm.\n*\n\n*  Arguments\n*  =========\n*\n*  TRANS   (input) CHARACTER*1\n*          = 'N': solve the generalized sylvester equation (1).\n*          = 'C': solve the \"conjugate transposed\" system (3).\n*\n*  IJOB    (input) INTEGER\n*          Specifies what kind of functionality to be performed.\n*          =0: solve (1) only.\n*          =1: The functionality of 0 and 3.\n*          =2: The functionality of 0 and 4.\n*          =3: Only an estimate of Dif[(A,D), (B,E)] is computed.\n*              (look ahead strategy is used).\n*          =4: Only an estimate of Dif[(A,D), (B,E)] is computed.\n*              (ZGECON on sub-systems is used).\n*          Not referenced if TRANS = 'C'.\n*\n*  M       (input) INTEGER\n*          The order of the matrices A and D, and the row dimension of\n*          the matrices C, F, R and L.\n*\n*  N       (input) INTEGER\n*          The order of the matrices B and E, and the column dimension\n*          of the matrices C, F, R and L.\n*\n*  A       (input) COMPLEX*16 array, dimension (LDA, M)\n*          The upper triangular matrix A.\n*\n*  LDA     (input) INTEGER\n*          The leading dimension of the array A. LDA >= max(1, M).\n*\n*  B       (input) COMPLEX*16 array, dimension (LDB, N)\n*          The upper triangular matrix B.\n*\n*  LDB     (input) INTEGER\n*          The leading dimension of the array B. LDB >= max(1, N).\n*\n*  C       (input/output) COMPLEX*16 array, dimension (LDC, N)\n*          On entry, C contains the right-hand-side of the first matrix\n*          equation in (1) or (3).\n*          On exit, if IJOB = 0, 1 or 2, C has been overwritten by\n*          the solution R. If IJOB = 3 or 4 and TRANS = 'N', C holds R,\n*          the solution achieved during the computation of the\n*          Dif-estimate.\n*\n*  LDC     (input) INTEGER\n*          The leading dimension of the array C. LDC >= max(1, M).\n*\n*  D       (input) COMPLEX*16 array, dimension (LDD, M)\n*          The upper triangular matrix D.\n*\n*  LDD     (input) INTEGER\n*          The leading dimension of the array D. LDD >= max(1, M).\n*\n*  E       (input) COMPLEX*16 array, dimension (LDE, N)\n*          The upper triangular matrix E.\n*\n*  LDE     (input) INTEGER\n*          The leading dimension of the array E. LDE >= max(1, N).\n*\n*  F       (input/output) COMPLEX*16 array, dimension (LDF, N)\n*          On entry, F contains the right-hand-side of the second matrix\n*          equation in (1) or (3).\n*          On exit, if IJOB = 0, 1 or 2, F has been overwritten by\n*          the solution L. If IJOB = 3 or 4 and TRANS = 'N', F holds L,\n*          the solution achieved during the computation of the\n*          Dif-estimate.\n*\n*  LDF     (input) INTEGER\n*          The leading dimension of the array F. LDF >= max(1, M).\n*\n*  DIF     (output) DOUBLE PRECISION\n*          On exit DIF is the reciprocal of a lower bound of the\n*          reciprocal of the Dif-function, i.e. DIF is an upper bound of\n*          Dif[(A,D), (B,E)] = sigma-min(Z), where Z as in (2).\n*          IF IJOB = 0 or TRANS = 'C', DIF is not referenced.\n*\n*  SCALE   (output) DOUBLE PRECISION\n*          On exit SCALE is the scaling factor in (1) or (3).\n*          If 0 < SCALE < 1, C and F hold the solutions R and L, resp.,\n*          to a slightly perturbed system but the input matrices A, B,\n*          D and E have not been changed. If SCALE = 0, R and L will\n*          hold the solutions to the homogenious system with C = F = 0.\n*\n*  WORK    (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))\n*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.\n*\n*  LWORK   (input) INTEGER\n*          The dimension of the array WORK. LWORK > = 1.\n*          If IJOB = 1 or 2 and TRANS = 'N', LWORK >= max(1,2*M*N).\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*  IWORK   (workspace) INTEGER array, dimension (M+N+2)\n*\n*  INFO    (output) INTEGER\n*            =0: successful exit\n*            <0: If INFO = -i, the i-th argument had an illegal value.\n*            >0: (A, D) and (B, E) have common or very close\n*                eigenvalues.\n*\n\n*  Further Details\n*  ===============\n*\n*  Based on contributions by\n*     Bo Kagstrom and Peter Poromaa, Department of Computing Science,\n*     Umea University, S-901 87 Umea, Sweden.\n*\n*  [1] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software\n*      for Solving the Generalized Sylvester Equation and Estimating the\n*      Separation between Regular Matrix Pairs, Report UMINF - 93.23,\n*      Department of Computing Science, Umea University, S-901 87 Umea,\n*      Sweden, December 1993, Revised April 1994, Also as LAPACK Working\n*      Note 75.  To appear in ACM Trans. on Math. Software, Vol 22,\n*      No 1, 1996.\n*\n*  [2] B. Kagstrom, A Perturbation Analysis of the Generalized Sylvester\n*      Equation (AR - LB, DR - LE ) = (C, F), SIAM J. Matrix Anal.\n*      Appl., 15(4):1045-1060, 1994.\n*\n*  [3] B. Kagstrom and L. Westin, Generalized Schur Methods with\n*      Condition Estimators for Solving the Generalized Sylvester\n*      Equation, IEEE Transactions on Automatic Control, Vol. 34, No. 7,\n*      July 1989, pp 745-751.\n*\n*  =====================================================================\n*  Replaced various illegal calls to CCOPY by calls to CLASET.\n*  Sven Hammarling, 1/5/02.\n*\n\n");
-      return Qnil;
-    }
-    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
-      printf("%s\n", "USAGE:\n  scale, dif, work, info, c, f = NumRu::Lapack.ztgsyl( trans, ijob, a, b, c, d, e, f, [:lwork => lwork, :usage => usage, :help => help])\n");
-      return Qnil;
-    } 
-  } else
-    rblapack_options = Qnil;
-  if (argc != 8 && argc != 9)
-    rb_raise(rb_eArgError,"wrong number of arguments (%d for 8)", argc);
-  rblapack_trans = argv[0];
-  rblapack_ijob = argv[1];
-  rblapack_a = argv[2];
-  rblapack_b = argv[3];
-  rblapack_c = argv[4];
-  rblapack_d = argv[5];
-  rblapack_e = argv[6];
-  rblapack_f = argv[7];
-  if (argc == 9) {
-    rblapack_lwork = argv[8];
-  } else if (rblapack_options != Qnil) {
-    rblapack_lwork = rb_hash_aref(rblapack_options, ID2SYM(rb_intern("lwork")));
-  } else {
-    rblapack_lwork = Qnil;
-  }
-
-  trans = StringValueCStr(rblapack_trans)[0];
-  if (!NA_IsNArray(rblapack_a))
-    rb_raise(rb_eArgError, "a (3th argument) must be NArray");
-  if (NA_RANK(rblapack_a) != 2)
-    rb_raise(rb_eArgError, "rank of a (3th argument) must be %d", 2);
-  lda = NA_SHAPE0(rblapack_a);
-  m = 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*);
-  if (!NA_IsNArray(rblapack_c))
-    rb_raise(rb_eArgError, "c (5th argument) must be NArray");
-  if (NA_RANK(rblapack_c) != 2)
-    rb_raise(rb_eArgError, "rank of c (5th argument) must be %d", 2);
-  ldc = NA_SHAPE0(rblapack_c);
-  n = NA_SHAPE1(rblapack_c);
-  if (NA_TYPE(rblapack_c) != NA_DCOMPLEX)
-    rblapack_c = na_change_type(rblapack_c, NA_DCOMPLEX);
-  c = NA_PTR_TYPE(rblapack_c, doublecomplex*);
-  if (!NA_IsNArray(rblapack_e))
-    rb_raise(rb_eArgError, "e (7th argument) must be NArray");
-  if (NA_RANK(rblapack_e) != 2)
-    rb_raise(rb_eArgError, "rank of e (7th argument) must be %d", 2);
-  lde = NA_SHAPE0(rblapack_e);
-  if (NA_SHAPE1(rblapack_e) != n)
-    rb_raise(rb_eRuntimeError, "shape 1 of e must be the same as shape 1 of c");
-  if (NA_TYPE(rblapack_e) != NA_DCOMPLEX)
-    rblapack_e = na_change_type(rblapack_e, NA_DCOMPLEX);
-  e = NA_PTR_TYPE(rblapack_e, doublecomplex*);
-  ijob = NUM2INT(rblapack_ijob);
-  if (!NA_IsNArray(rblapack_d))
-    rb_raise(rb_eArgError, "d (6th argument) must be NArray");
-  if (NA_RANK(rblapack_d) != 2)
-    rb_raise(rb_eArgError, "rank of d (6th argument) must be %d", 2);
-  ldd = NA_SHAPE0(rblapack_d);
-  if (NA_SHAPE1(rblapack_d) != m)
-    rb_raise(rb_eRuntimeError, "shape 1 of d must be the same as shape 1 of a");
-  if (NA_TYPE(rblapack_d) != NA_DCOMPLEX)
-    rblapack_d = na_change_type(rblapack_d, NA_DCOMPLEX);
-  d = NA_PTR_TYPE(rblapack_d, doublecomplex*);
-  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);
-  if (NA_SHAPE1(rblapack_b) != n)
-    rb_raise(rb_eRuntimeError, "shape 1 of b must be the same as shape 1 of c");
-  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_f))
-    rb_raise(rb_eArgError, "f (8th argument) must be NArray");
-  if (NA_RANK(rblapack_f) != 2)
-    rb_raise(rb_eArgError, "rank of f (8th argument) must be %d", 2);
-  ldf = NA_SHAPE0(rblapack_f);
-  if (NA_SHAPE1(rblapack_f) != n)
-    rb_raise(rb_eRuntimeError, "shape 1 of f must be the same as shape 1 of c");
-  if (NA_TYPE(rblapack_f) != NA_DCOMPLEX)
-    rblapack_f = na_change_type(rblapack_f, NA_DCOMPLEX);
-  f = NA_PTR_TYPE(rblapack_f, doublecomplex*);
-  if (rblapack_lwork == Qnil)
-    lwork = ((ijob==1||ijob==2)&&lsame_(&trans,"N")) ? 2*m*n : 1;
-  else {
-    lwork = NUM2INT(rblapack_lwork);
-  }
-  {
-    int shape[1];
-    shape[0] = MAX(1,lwork);
-    rblapack_work = na_make_object(NA_DCOMPLEX, 1, shape, cNArray);
-  }
-  work = NA_PTR_TYPE(rblapack_work, doublecomplex*);
-  {
-    int shape[2];
-    shape[0] = ldc;
-    shape[1] = n;
-    rblapack_c_out__ = na_make_object(NA_DCOMPLEX, 2, shape, cNArray);
-  }
-  c_out__ = NA_PTR_TYPE(rblapack_c_out__, doublecomplex*);
-  MEMCPY(c_out__, c, doublecomplex, NA_TOTAL(rblapack_c));
-  rblapack_c = rblapack_c_out__;
-  c = c_out__;
-  {
-    int shape[2];
-    shape[0] = ldf;
-    shape[1] = n;
-    rblapack_f_out__ = na_make_object(NA_DCOMPLEX, 2, shape, cNArray);
-  }
-  f_out__ = NA_PTR_TYPE(rblapack_f_out__, doublecomplex*);
-  MEMCPY(f_out__, f, doublecomplex, NA_TOTAL(rblapack_f));
-  rblapack_f = rblapack_f_out__;
-  f = f_out__;
-  iwork = ALLOC_N(integer, (m+n+2));
-
-  ztgsyl_(&trans, &ijob, &m, &n, a, &lda, b, &ldb, c, &ldc, d, &ldd, e, &lde, f, &ldf, &scale, &dif, work, &lwork, iwork, &info);
-
-  free(iwork);
-  rblapack_scale = rb_float_new((double)scale);
-  rblapack_dif = rb_float_new((double)dif);
-  rblapack_info = INT2NUM(info);
-  return rb_ary_new3(6, rblapack_scale, rblapack_dif, rblapack_work, rblapack_info, rblapack_c, rblapack_f);
-}
-
-void
-init_lapack_ztgsyl(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
-  sHelp = sH;
-  sUsage = sU;
-  rblapack_ZERO = zero;
-
-  rb_define_module_function(mLapack, "ztgsyl", rblapack_ztgsyl, -1);
-}