#include "rb_lapack.h"

extern VOID dlasy2_(logical* ltranl, logical* ltranr, integer* isgn, integer* n1, integer* n2, doublereal* tl, integer* ldtl, doublereal* tr, integer* ldtr, doublereal* b, integer* ldb, doublereal* scale, doublereal* x, integer* ldx, doublereal* xnorm, integer* info);


static VALUE
rblapack_dlasy2(int argc, VALUE *argv, VALUE self){
  VALUE rblapack_ltranl;
  logical ltranl; 
  VALUE rblapack_ltranr;
  logical ltranr; 
  VALUE rblapack_isgn;
  integer isgn; 
  VALUE rblapack_n1;
  integer n1; 
  VALUE rblapack_n2;
  integer n2; 
  VALUE rblapack_tl;
  doublereal *tl; 
  VALUE rblapack_tr;
  doublereal *tr; 
  VALUE rblapack_b;
  doublereal *b; 
  VALUE rblapack_scale;
  doublereal scale; 
  VALUE rblapack_x;
  doublereal *x; 
  VALUE rblapack_xnorm;
  doublereal xnorm; 
  VALUE rblapack_info;
  integer info; 

  integer ldtl;
  integer ldtr;
  integer ldb;
  integer ldx;

  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, x, xnorm, info = NumRu::Lapack.dlasy2( ltranl, ltranr, isgn, n1, n2, tl, tr, b, [:usage => usage, :help => help])\n\n\nFORTRAN MANUAL\n      SUBROUTINE DLASY2( LTRANL, LTRANR, ISGN, N1, N2, TL, LDTL, TR, LDTR, B, LDB, SCALE, X, LDX, XNORM, INFO )\n\n*  Purpose\n*  =======\n*\n*  DLASY2 solves for the N1 by N2 matrix X, 1 <= N1,N2 <= 2, in\n*\n*         op(TL)*X + ISGN*X*op(TR) = SCALE*B,\n*\n*  where TL is N1 by N1, TR is N2 by N2, B is N1 by N2, and ISGN = 1 or\n*  -1.  op(T) = T or T', where T' denotes the transpose of T.\n*\n\n*  Arguments\n*  =========\n*\n*  LTRANL  (input) LOGICAL\n*          On entry, LTRANL specifies the op(TL):\n*             = .FALSE., op(TL) = TL,\n*             = .TRUE., op(TL) = TL'.\n*\n*  LTRANR  (input) LOGICAL\n*          On entry, LTRANR specifies the op(TR):\n*            = .FALSE., op(TR) = TR,\n*            = .TRUE., op(TR) = TR'.\n*\n*  ISGN    (input) INTEGER\n*          On entry, ISGN specifies the sign of the equation\n*          as described before. ISGN may only be 1 or -1.\n*\n*  N1      (input) INTEGER\n*          On entry, N1 specifies the order of matrix TL.\n*          N1 may only be 0, 1 or 2.\n*\n*  N2      (input) INTEGER\n*          On entry, N2 specifies the order of matrix TR.\n*          N2 may only be 0, 1 or 2.\n*\n*  TL      (input) DOUBLE PRECISION array, dimension (LDTL,2)\n*          On entry, TL contains an N1 by N1 matrix.\n*\n*  LDTL    (input) INTEGER\n*          The leading dimension of the matrix TL. LDTL >= max(1,N1).\n*\n*  TR      (input) DOUBLE PRECISION array, dimension (LDTR,2)\n*          On entry, TR contains an N2 by N2 matrix.\n*\n*  LDTR    (input) INTEGER\n*          The leading dimension of the matrix TR. LDTR >= max(1,N2).\n*\n*  B       (input) DOUBLE PRECISION array, dimension (LDB,2)\n*          On entry, the N1 by N2 matrix B contains the right-hand\n*          side of the equation.\n*\n*  LDB     (input) INTEGER\n*          The leading dimension of the matrix B. LDB >= max(1,N1).\n*\n*  SCALE   (output) DOUBLE PRECISION\n*          On exit, SCALE contains the scale factor. SCALE is chosen\n*          less than or equal to 1 to prevent the solution overflowing.\n*\n*  X       (output) DOUBLE PRECISION array, dimension (LDX,2)\n*          On exit, X contains the N1 by N2 solution.\n*\n*  LDX     (input) INTEGER\n*          The leading dimension of the matrix X. LDX >= max(1,N1).\n*\n*  XNORM   (output) DOUBLE PRECISION\n*          On exit, XNORM is the infinity-norm of the solution.\n*\n*  INFO    (output) INTEGER\n*          On exit, INFO is set to\n*             0: successful exit.\n*             1: TL and TR have too close eigenvalues, so TL or\n*                TR is perturbed to get a nonsingular equation.\n*          NOTE: In the interests of speed, this routine does not\n*                check the inputs for errors.\n*\n\n* =====================================================================\n*\n\n");
      return Qnil;
    }
    if (rb_hash_aref(rblapack_options, sUsage) == Qtrue) {
      printf("%s\n", "USAGE:\n  scale, x, xnorm, info = NumRu::Lapack.dlasy2( ltranl, ltranr, isgn, n1, n2, tl, tr, b, [:usage => usage, :help => help])\n");
      return Qnil;
    } 
  } else
    rblapack_options = Qnil;
  if (argc != 8 && argc != 8)
    rb_raise(rb_eArgError,"wrong number of arguments (%d for 8)", argc);
  rblapack_ltranl = argv[0];
  rblapack_ltranr = argv[1];
  rblapack_isgn = argv[2];
  rblapack_n1 = argv[3];
  rblapack_n2 = argv[4];
  rblapack_tl = argv[5];
  rblapack_tr = argv[6];
  rblapack_b = argv[7];
  if (argc == 8) {
  } else if (rblapack_options != Qnil) {
  } else {
  }

  ltranl = (rblapack_ltranl == Qtrue);
  isgn = NUM2INT(rblapack_isgn);
  n2 = NUM2INT(rblapack_n2);
  if (!NA_IsNArray(rblapack_tr))
    rb_raise(rb_eArgError, "tr (7th argument) must be NArray");
  if (NA_RANK(rblapack_tr) != 2)
    rb_raise(rb_eArgError, "rank of tr (7th argument) must be %d", 2);
  ldtr = NA_SHAPE0(rblapack_tr);
  if (NA_SHAPE1(rblapack_tr) != (2))
    rb_raise(rb_eRuntimeError, "shape 1 of tr must be %d", 2);
  if (NA_TYPE(rblapack_tr) != NA_DFLOAT)
    rblapack_tr = na_change_type(rblapack_tr, NA_DFLOAT);
  tr = NA_PTR_TYPE(rblapack_tr, doublereal*);
  ltranr = (rblapack_ltranr == Qtrue);
  if (!NA_IsNArray(rblapack_tl))
    rb_raise(rb_eArgError, "tl (6th argument) must be NArray");
  if (NA_RANK(rblapack_tl) != 2)
    rb_raise(rb_eArgError, "rank of tl (6th argument) must be %d", 2);
  ldtl = NA_SHAPE0(rblapack_tl);
  if (NA_SHAPE1(rblapack_tl) != (2))
    rb_raise(rb_eRuntimeError, "shape 1 of tl must be %d", 2);
  if (NA_TYPE(rblapack_tl) != NA_DFLOAT)
    rblapack_tl = na_change_type(rblapack_tl, NA_DFLOAT);
  tl = NA_PTR_TYPE(rblapack_tl, doublereal*);
  n1 = NUM2INT(rblapack_n1);
  ldx = MAX(1,n1);
  if (!NA_IsNArray(rblapack_b))
    rb_raise(rb_eArgError, "b (8th argument) must be NArray");
  if (NA_RANK(rblapack_b) != 2)
    rb_raise(rb_eArgError, "rank of b (8th argument) must be %d", 2);
  ldb = NA_SHAPE0(rblapack_b);
  if (NA_SHAPE1(rblapack_b) != (2))
    rb_raise(rb_eRuntimeError, "shape 1 of b must be %d", 2);
  if (NA_TYPE(rblapack_b) != NA_DFLOAT)
    rblapack_b = na_change_type(rblapack_b, NA_DFLOAT);
  b = NA_PTR_TYPE(rblapack_b, doublereal*);
  {
    na_shape_t shape[2];
    shape[0] = ldx;
    shape[1] = 2;
    rblapack_x = na_make_object(NA_DFLOAT, 2, shape, cNArray);
  }
  x = NA_PTR_TYPE(rblapack_x, doublereal*);

  dlasy2_(&ltranl, &ltranr, &isgn, &n1, &n2, tl, &ldtl, tr, &ldtr, b, &ldb, &scale, x, &ldx, &xnorm, &info);

  rblapack_scale = rb_float_new((double)scale);
  rblapack_xnorm = rb_float_new((double)xnorm);
  rblapack_info = INT2NUM(info);
  return rb_ary_new3(4, rblapack_scale, rblapack_x, rblapack_xnorm, rblapack_info);
}

void
init_lapack_dlasy2(VALUE mLapack, VALUE sH, VALUE sU, VALUE zero){
  sHelp = sH;
  sUsage = sU;
  rblapack_ZERO = zero;

  rb_define_module_function(mLapack, "dlasy2", rblapack_dlasy2, -1);
}
