/* specfunc/expint.c
 *
 * Copyright (C) 1996, 1997, 1998, 1999, 2000 Gerard Jungman
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or (at
 * your option) any later version.
 *
 * This program is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 */

/* Author: G. Jungman */

#include <config.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_errno.h>
#include "gsl_sf_expint.h"

#include "error.h"

#include "chebyshev.h"
#include "cheb_eval.c"

/*-*-*-*-*-*-*-*-*-*-*-* Private Section *-*-*-*-*-*-*-*-*-*-*-*/

/*
 Chebyshev expansions: based on SLATEC e1.f, W. Fullerton

 Series for AE11       on the interval -1.00000D-01 to  0.
					with weighted error   1.76E-17
					 log weighted error  16.75
			       significant figures required  15.70
				    decimal places required  17.55

 Series for AE12       on the interval -2.50000D-01 to -1.00000D-01
					with weighted error   5.83E-17
					 log weighted error  16.23
			       significant figures required  15.76
				    decimal places required  16.93

 Series for E11        on the interval -4.00000D+00 to -1.00000D+00
					with weighted error   1.08E-18
					 log weighted error  17.97
			       significant figures required  19.02
				    decimal places required  18.61

 Series for E12        on the interval -1.00000D+00 to  1.00000D+00
					with weighted error   3.15E-18
					 log weighted error  17.50
			approx significant figures required  15.8
				    decimal places required  18.10

 Series for AE13       on the interval  2.50000D-01 to  1.00000D+00
					with weighted error   2.34E-17
					 log weighted error  16.63
			       significant figures required  16.14
				    decimal places required  17.33

 Series for AE14       on the interval  0.	    to  2.50000D-01
					with weighted error   5.41E-17
					 log weighted error  16.27
			       significant figures required  15.38
				    decimal places required  16.97
*/

static double AE11_data[39] = {
   0.121503239716065790,
  -0.065088778513550150,
   0.004897651357459670,
  -0.000649237843027216,
   0.000093840434587471,
   0.000000420236380882,
  -0.000008113374735904,
   0.000002804247688663,
   0.000000056487164441,
  -0.000000344809174450,
   0.000000058209273578,
   0.000000038711426349,
  -0.000000012453235014,
  -0.000000005118504888,
   0.000000002148771527,
   0.000000000868459898,
  -0.000000000343650105,
  -0.000000000179796603,
   0.000000000047442060,
   0.000000000040423282,
  -0.000000000003543928,
  -0.000000000008853444,
  -0.000000000000960151,
   0.000000000001692921,
   0.000000000000607990,
  -0.000000000000224338,
  -0.000000000000200327,
  -0.000000000000006246,
   0.000000000000045571,
   0.000000000000016383,
  -0.000000000000005561,
  -0.000000000000006074,
  -0.000000000000000862,
   0.000000000000001223,
   0.000000000000000716,
  -0.000000000000000024,
  -0.000000000000000201,
  -0.000000000000000082,
   0.000000000000000017
};
static cheb_series AE11_cs = {
  AE11_data,
  38,
  -1, 1,
  20
};

static double AE12_data[25] = {
   0.582417495134726740,
  -0.158348850905782750,
  -0.006764275590323141,
   0.005125843950185725,
   0.000435232492169391,
  -0.000143613366305483,
  -0.000041801320556301,
  -0.000002713395758640,
   0.000001151381913647,
   0.000000420650022012,
   0.000000066581901391,
   0.000000000662143777,
  -0.000000002844104870,
  -0.000000000940724197,
  -0.000000000177476602,
  -0.000000000015830222,
   0.000000000002905732,
   0.000000000001769356,
   0.000000000000492735,
   0.000000000000093709,
   0.000000000000010707,
  -0.000000000000000537,
  -0.000000000000000716,
  -0.000000000000000244,
  -0.000000000000000058
};
static cheb_series AE12_cs = {
  AE12_data,
  24,
  -1, 1,
  15
};

static double E11_data[19] = {
  -16.11346165557149402600,
    7.79407277874268027690,
   -1.95540581886314195070,
    0.37337293866277945612,
   -0.05692503191092901938,
    0.00721107776966009185,
   -0.00078104901449841593,
    0.00007388093356262168,
   -0.00000620286187580820,
    0.00000046816002303176,
   -0.00000003209288853329,
    0.00000000201519974874,
   -0.00000000011673686816,
    0.00000000000627627066,
   -0.00000000000031481541,
    0.00000000000001479904,
   -0.00000000000000065457,
    0.00000000000000002733,
   -0.00000000000000000108
};
static cheb_series E11_cs = {
  E11_data,
  18,
  -1, 1,
  13
};

static double E12_data[16] = {
  -0.03739021479220279500,
   0.04272398606220957700,
  -0.13031820798497005440,
   0.01441912402469889073,
  -0.00134617078051068022,
   0.00010731029253063780,
  -0.00000742999951611943,
   0.00000045377325690753,
  -0.00000002476417211390,
   0.00000000122076581374,
  -0.00000000005485141480,
   0.00000000000226362142,
  -0.00000000000008635897,
   0.00000000000000306291,
  -0.00000000000000010148,
   0.00000000000000000315
};
static cheb_series E12_cs = {
  E12_data,
  15,
  -1, 1,
  10
};

static double AE13_data[25] = {
  -0.605773246640603460,
  -0.112535243483660900,
   0.013432266247902779,
  -0.001926845187381145,
   0.000309118337720603,
  -0.000053564132129618,
   0.000009827812880247,
  -0.000001885368984916,
   0.000000374943193568,
  -0.000000076823455870,
   0.000000016143270567,
  -0.000000003466802211,
   0.000000000758754209,
  -0.000000000168864333,
   0.000000000038145706,
  -0.000000000008733026,
   0.000000000002023672,
  -0.000000000000474132,
   0.000000000000112211,
  -0.000000000000026804,
   0.000000000000006457,
  -0.000000000000001568,
   0.000000000000000383,
  -0.000000000000000094,
   0.000000000000000023
};
static cheb_series AE13_cs = {
  AE13_data,
  24,
  -1, 1,
  15
};

static double AE14_data[26] = {
  -0.18929180007530170,
  -0.08648117855259871,
   0.00722410154374659,
  -0.00080975594575573,
   0.00010999134432661,
  -0.00001717332998937,
   0.00000298562751447,
  -0.00000056596491457,
   0.00000011526808397,
  -0.00000002495030440,
   0.00000000569232420,
  -0.00000000135995766,
   0.00000000033846628,
  -0.00000000008737853,
   0.00000000002331588,
  -0.00000000000641148,
   0.00000000000181224,
  -0.00000000000052538,
   0.00000000000015592,
  -0.00000000000004729,
   0.00000000000001463,
  -0.00000000000000461,
   0.00000000000000148,
  -0.00000000000000048,
   0.00000000000000016,
  -0.00000000000000005
};
static cheb_series AE14_cs = {
  AE14_data,
  25,
  -1, 1,
  13
};

/*-*-*-*-*-*-*-*-*-*-*-* Functions with Error Codes *-*-*-*-*-*-*-*-*-*-*-*/

int gsl_sf_expint_E1_e(const double x, gsl_sf_result * result)
{
  const double xmaxt = -GSL_LOG_DBL_MIN;      /* XMAXT = -LOG (R1MACH(1)) */
  const double xmax  = xmaxt - log(xmaxt);    /* XMAX = XMAXT - LOG(XMAXT) */

  /* CHECK_POINTER(result) */

  if(x < -xmax) {
    OVERFLOW_ERROR(result);
  }
  else if(x <= -10.0) {
    const double s = exp(-x)/x;
    gsl_sf_result result_c;
    cheb_eval_e(&AE11_cs, 20.0/x+1.0, &result_c);
    result->val  = s * (1.0 + result_c.val);
    result->err  = s * result_c.err;
    result->err += 2.0 * GSL_DBL_EPSILON * (fabs(x) + 1.0) * fabs(result->val);
    return GSL_SUCCESS;
  }
  else if(x <= -4.0) {
    const double s = exp(-x)/x;
    gsl_sf_result result_c;
    cheb_eval_e(&AE12_cs, (40.0/x+7.0)/3.0, &result_c);
    result->val  = s * (1.0 + result_c.val);
    result->err  = s * result_c.err;
    result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
    return GSL_SUCCESS;
  }
  else if(x <= -1.0) {
    const double ln_term = -log(fabs(x));
    gsl_sf_result result_c;
    cheb_eval_e(&E11_cs, (2.0*x+5.0)/3.0, &result_c);
    result->val  = ln_term + result_c.val;
    result->err  = result_c.err + GSL_DBL_EPSILON * fabs(ln_term);
    result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
    return GSL_SUCCESS;
  }
  else if(x == 0.0) {
    DOMAIN_ERROR(result);
  }
  else if(x <= 1.0) {
    const double ln_term = -log(fabs(x));
    gsl_sf_result result_c;
    cheb_eval_e(&E12_cs, x, &result_c);
    result->val  = ln_term - 0.6875 + x + result_c.val;
    result->err  = result_c.err + GSL_DBL_EPSILON * fabs(ln_term);
    result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
    return GSL_SUCCESS;
  }
  else if(x <= 4.0) {
    const double s = exp(-x)/x;
    gsl_sf_result result_c;
    cheb_eval_e(&AE13_cs, (8.0/x-5.0)/3.0, &result_c);
    result->val  = s * (1.0 + result_c.val);
    result->err  = s * result_c.err;
    result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
    return GSL_SUCCESS;
  }
  else if(x <= xmax) {
    const double s = exp(-x)/x;
    gsl_sf_result result_c;
    cheb_eval_e(&AE14_cs, 8.0/x-1.0, &result_c);
    result->val  = s * (1.0 +  result_c.val);
    result->err  = s * (GSL_DBL_EPSILON + result_c.err);
    result->err += 2.0 * (x + 1.0) * GSL_DBL_EPSILON * fabs(result->val);
    return GSL_SUCCESS;
  }
  else {
    UNDERFLOW_ERROR(result);
  }
}

int gsl_sf_expint_E2_e(const double x, gsl_sf_result * result)
{
  const double xmaxt = -GSL_LOG_DBL_MIN;
  const double xmax  = xmaxt - log(xmaxt);

  /* CHECK_POINTER(result) */

  if(x < -xmax) {
    OVERFLOW_ERROR(result);
  }
  else if(x < 100.0) {
    const double ex = exp(-x);
    gsl_sf_result result_E1;
    int stat_E1 = gsl_sf_expint_E1_e(x, &result_E1);
    result->val  = ex - x*result_E1.val;
    result->err  = fabs(x) * (GSL_DBL_EPSILON*ex + result_E1.err);
    result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
    return stat_E1;
  }
  else if(x < xmax) {
    const double c1  = -2.0;
    const double c2  =  6.0;
    const double c3  = -24.0;
    const double c4  =  120.0;
    const double c5  = -720.0;
    const double c6  =  5040.0;
    const double c7  = -40320.0;
    const double c8  =  362880.0;
    const double c9  = -3628800.0;
    const double c10 =  39916800.0;
    const double c11 = -479001600.0;
    const double c12 =  6227020800.0;
    const double c13 = -87178291200.0;
    const double y = 1.0/x;
    const double sum6 = c6+y*(c7+y*(c8+y*(c9+y*(c10+y*(c11+y*(c12+y*c13))))));
    const double sum  = y*(c1+y*(c2+y*(c3+y*(c4+y*(c5+y*sum6)))));
    result->val = exp(-x) * (1.0 + sum)/x;
    result->err = 2.0 * (x + 1.0) * GSL_DBL_EPSILON * result->val;
    return GSL_SUCCESS;
  }
  else {
    UNDERFLOW_ERROR(result);
  }
}

int gsl_sf_expint_Ei_e(const double x, gsl_sf_result * result)
{
  /* CHECK_POINTER(result) */

  {
    int status = gsl_sf_expint_E1_e(-x, result);
    result->val = -result->val;
    return status;
  }
}

#if 0
static double recurse_En(int n, double x, double E1)
{
  int i;
  double En = E1;
  double ex = exp(-x);
  for(i=2; i<=n; i++) {
    En = 1./(i-1) * (ex - x * En);
  }
  return En;
}
#endif

/*-*-*-*-*-*-*-*-*-* Functions w/ Natural Prototypes *-*-*-*-*-*-*-*-*-*-*/

#include "eval.h"

double gsl_sf_expint_E1(const double x)
{
  EVAL_RESULT(gsl_sf_expint_E1_e(x, &result));
}

double gsl_sf_expint_E2(const double x)
{
  EVAL_RESULT(gsl_sf_expint_E2_e(x, &result));
}

double gsl_sf_expint_Ei(const double x)
{
  EVAL_RESULT(gsl_sf_expint_Ei_e(x, &result));
}


// Copyright (c) 2021 Stig Rune Sellevag
//
// This file is distributed under the MIT License. See the accompanying file
// LICENSE.txt or http://www.opensource.org/licenses/mit-license.php for terms
// and conditions.

#ifndef SCILIB_LINALG_LINSOLVE_H
#define SCILIB_LINALG_LINSOLVE_H

#ifdef USE_MKL
#include <mkl.h>
#else
#include <lapacke.h>
#endif

#include <scilib/mdarray.h>
#include <scilib/linalg_impl/lapack_types.h>
#include <experimental/mdspan>
#include <exception>
#include <cassert>
#include <type_traits>

namespace Sci {
namespace Linalg {

// Solve linear system of equations.
template <class Layout>
inline void linsolve(Sci::Matrix_view<double, Layout> a,
                     Sci::Matrix_view<double, Layout> b)
{
    namespace stdex = std::experimental;

    static_assert(a.is_contiguous());
    static_assert(b.is_contiguous());

    assert(a.extent(0) == a.extent(1));
    assert(b.extent(0) == a.extent(1));

    const BLAS_INT n = static_cast<BLAS_INT>(a.extent(1));
    const BLAS_INT nrhs = static_cast<BLAS_INT>(b.extent(1));
    const BLAS_INT lda = n;

    Sci::Vector<BLAS_INT, Layout> ipiv(n);

    auto matrix_layout = LAPACK_ROW_MAJOR;
    BLAS_INT ldb = nrhs;

    if constexpr (std::is_same_v<Layout, stdex::layout_left>) {
        matrix_layout = LAPACK_COL_MAJOR;
        ldb = n;
    }
    BLAS_INT info = LAPACKE_dgesv(matrix_layout, n, nrhs, a.data(), lda,
                                  ipiv.data(), b.data(), ldb);
    if (info != 0) {
        throw std::runtime_error("dgesv: factor U is singular");
    }
}

template <class Layout, class Allocator>
inline void linsolve(Sci::Matrix<double, Layout, Allocator>& a,
                     Sci::Matrix<double, Layout, Allocator>& b)
{
    linsolve(a.view(), b.view());
}

} // namespace Linalg
} // namespace Sci

#endif // SCILIB_LINALG_LINSOLVE_H


#if !defined(compressibleFlow_h)
#define compressibleFlow_h
#include <petsc.h>
#include "fluxDifferencer.h"

typedef enum {RHO, RHOE, RHOU, RHOV, RHOW, TOTAL_COMPRESSIBLE_FLOW_COMPONENTS} CompressibleFlowComponents;
typedef enum {T, VEL, TOTAL_COMPRESSIBLE_AUX_COMPONENTS} CompressibleAuxComponents;

struct _FlowData_CompressibleFlow{
    /*Courant Friedrichs Lewy*/
    PetscReal cfl;
    /* thermal conductivity*/
    PetscReal k;
    /* dynamic viscosity*/
    PetscReal mu;

    /* store method used for flux differencer */
    FluxDifferencerFunction fluxDifferencer;

    // EOS function calls
    PetscErrorCode (*decodeStateFunction)(const PetscReal* yi, PetscInt dim, PetscReal density, PetscReal totalEnergy, const PetscReal* velocity, PetscReal* internalEnergy, PetscReal* a, PetscReal* p, void* ctx);
    void* decodeStateFunctionContext;
    PetscErrorCode (*computeTemperatureFunction)(const PetscReal* yi, PetscInt dim, PetscReal density, PetscReal totalEnergy, const PetscReal* massFlux, PetscReal* T, void* ctx);
    void* computeTemperatureContext;

    PetscBool automaticTimeStepCalculator;
} ;

typedef struct _FlowData_CompressibleFlow* FlowData_CompressibleFlow;

typedef PetscErrorCode (*FVAuxFieldUpdateFunction)(FlowData_CompressibleFlow flowData, PetscReal time, PetscInt dim, const PetscFVCellGeom *cellGeom, const PetscScalar* conservedValues, PetscScalar* auxField);

PETSC_EXTERN PetscErrorCode FVFlowUpdateAuxFieldsFV(DM dm, DM auxDM, PetscReal time, Vec locXVec, Vec locAuxField, PetscInt numberUpdateFunctions, FVAuxFieldUpdateFunction* updateFunctions, FlowData_CompressibleFlow data);
PETSC_EXTERN PetscErrorCode CompressibleFlowDiffusionSourceRHSFunctionLocal(DM dm, DM auxDM, PetscReal time, Vec locXVec, Vec locAuxVec, Vec globFVec, FlowData_CompressibleFlow flowParameters);
PETSC_EXTERN void CompressibleFlowComputeEulerFlux(PetscInt dim, PetscInt Nf, const PetscReal *qp, const PetscReal *area, const PetscReal *xL, const PetscReal *xR, PetscInt numConstants, const PetscScalar constants[], PetscReal *flux, void* ctx);
PETSC_EXTERN PetscErrorCode CompressibleFlowComputeStressTensor(PetscInt dim, PetscReal mu, const PetscReal* gradVelL, const PetscReal * gradVelR, PetscReal* tau);

#endif


/****************************************************************************
 *                                                                          *
 * Copyright (C) 2001 ~ 2016 Neutrino International Inc.                    *
 *                                                                          *
 * Author : Brian Lin <lin.foxman@gmail.com>, Skype: wolfram_lin            *
 *                                                                          *
 * QtFFT acts as an interface between Qt and FFT libraries.                 *
 * Please keep QtFFT as simple as possible.                                 *
 *                                                                          *
 * Qt Version   : 5.4.1                                                     *
 * CIOS Version : 1.6.0                                                     *
 *                                                                          *
 ****************************************************************************/

#ifndef QT_FFT_H
#define QT_FFT_H

#include <QtCore>
#include <QtNetwork>
#include <QtSql>
#ifndef QT_STATIC
#include <QtScript>
#endif

#include <Essentials>

#ifdef QT_QTGMP_LIB
#include <QtGMP>
#endif

#ifdef QT_QTGSL_LIB
#include <QtGSL>
#endif

#ifdef QT_QTCUDA_LIB
#include <QtCUDA>
#endif

extern "C" {

#include <gsl/gsl_wavelet.h>
#include <gsl/gsl_wavelet2d.h>
#include <gsl/gsl_fft.h>
#include <gsl/gsl_fft_complex.h>
#include <gsl/gsl_fft_complex_float.h>
#include <gsl/gsl_fft_halfcomplex.h>
#include <gsl/gsl_fft_halfcomplex_float.h>
#include <gsl/gsl_fft_real.h>
#include <gsl/gsl_fft_real_float.h>
#include <QtFFT/fftw3.h>

}

QT_BEGIN_NAMESPACE

#ifndef QT_STATIC
#    if defined(QT_BUILD_QTFFT_LIB)
#      define Q_FFT_EXPORT Q_DECL_EXPORT
#    else
#      define Q_FFT_EXPORT Q_DECL_IMPORT
#    endif
#else
#    define Q_FFT_EXPORT
#endif

namespace N
{

class Q_FFT_EXPORT Wavelet        ;
class Q_FFT_EXPORT Hankel         ;
class Q_FFT_EXPORT AbstractFFT    ;
class Q_FFT_EXPORT CooleyFFT      ;
class Q_FFT_EXPORT KissFFT        ;
class Q_FFT_EXPORT GSLFFT         ;
class Q_FFT_EXPORT FFTW           ;
class Q_FFT_EXPORT AccelerateFFT  ;

class Q_FFT_EXPORT Wavelet
{
  public:

    gsl_wavelet           * wavelet   ;
    gsl_wavelet_workspace * work      ;
    gsl_wavelet_direction   direction ;

    explicit Wavelet             (void) ;
    virtual ~Wavelet             (void) ;

    bool    allocate             (const gsl_wavelet_type * T,size_t k) ;
    bool    workspace            (size_t n) ;
    QString Name                 (void) ;

    int Transform                (double * data,size_t stride,size_t n) ;
    int TransformForward         (double * data,size_t stride,size_t n) ;
    int TransformInverse         (double * data,size_t stride,size_t n) ;
    int Transform2d              (double * data,size_t tda,size_t size1,size_t size2) ;
    int Transform2dForward       (double * data,size_t tda,size_t size1,size_t size2) ;
    int Transform2dInverse       (double * data,size_t tda,size_t size1,size_t size2) ;
    int TransformMatrix          (gsl_matrix * m) ;
    int TransformMatrixForward   (gsl_matrix * m) ;
    int TransformMatrixInverse   (gsl_matrix * m) ;
    int nsTransform              (double * data,size_t tda,size_t size1,size_t size2) ;
    int nsTransformForward       (double * data,size_t tda,size_t size1,size_t size2) ;
    int nsTransformInverse       (double * data,size_t tda,size_t size1,size_t size2) ;
    int nsTransformMatrix        (gsl_matrix * m) ;
    int nsTransformMatrixForward (gsl_matrix * m) ;
    int nsTransformMatrixInverse (gsl_matrix * m) ;

  protected:

  private:

};

class Q_FFT_EXPORT Hankel
{
  public:

    gsl_dht * hankel ;

    explicit Hankel   (void) ;
    explicit Hankel   (int size) ;
    explicit Hankel   (int size,double nu, double xmax) ;
             Hankel   (const Hankel & hankel) ;
    virtual ~Hankel   (void) ;

    bool   Allocate   (int size) ;
    bool   New        (int size,double nu, double xmax) ;
    int    Initialize (double nu,double xmax) ;
    int    Apply      (double * In,double * Out) ;
    double x          (int n) ;
    double k          (int n) ;

  protected:

  private:

};

class Q_FFT_EXPORT AbstractFFT
{
  public:

    typedef enum         {
      fftForward  = 0    ,
      fftBackward = 1    }
      TransformDirection ;

    TransformDirection direction  ;
    Cpp::ValueTypes    vType      ;
    int                sourceType ; // 0 - Undecided , 1 - Real , 2 - Complex
    int                targetType ; // 0 - Undecided , 1 - Real , 2 - Complex
    int                dimension  ;

    explicit AbstractFFT        (void);
    virtual ~AbstractFFT        (void);

    virtual int  type           (void) const = 0 ;
    virtual bool isSupported    (Cpp::ValueTypes type,int dimension) const = 0 ;
    virtual int  AllocateSource (CUIDs elements,QByteArray & Source) = 0 ;
    virtual int  AllocateTarget (CUIDs elements,QByteArray & Target) = 0 ;
    virtual bool Prepare        (CUIDs        elements        ,
                                 VarArgs    & Paraments       ,
                                 QByteArray & Source          ,
                                 QByteArray & Target    ) = 0 ;
    virtual void Execution      (void) = 0 ;

  protected:

  private:

};

class Q_FFT_EXPORT CooleyFFT : public AbstractFFT
{
  public:

    explicit CooleyFFT          (void) ;
    virtual ~CooleyFFT          (void) ;

    virtual int  type           (void) const ;
    virtual bool isSupported    (Cpp::ValueTypes T,int dimension) const ;
    virtual int  AllocateSource (CUIDs elements,QByteArray & Source) ;
    virtual int  AllocateTarget (CUIDs elements,QByteArray & Target) ;
    virtual bool Prepare        (CUIDs        elements  ,
                                 VarArgs    & Paraments ,
                                 QByteArray & Source    ,
                                 QByteArray & Target  ) ;
    virtual void Execution      (void) ;

  protected:

  private:

};

class Q_FFT_EXPORT KissFFT : public AbstractFFT
{
  public:

    explicit KissFFT            (void) ;
    virtual ~KissFFT            (void) ;

    virtual int  type           (void) const ;
    virtual bool isSupported    (Cpp::ValueTypes T,int dimension) const ;
    virtual int  AllocateSource (CUIDs elements,QByteArray & Source) ;
    virtual int  AllocateTarget (CUIDs elements,QByteArray & Target) ;
    virtual bool Prepare        (CUIDs        elements  ,
                                 VarArgs    & Paraments ,
                                 QByteArray & Source    ,
                                 QByteArray & Target  ) ;
    virtual void Execution      (void) ;

  protected:

  private:

};

class Q_FFT_EXPORT GSLFFT : public AbstractFFT
{
  public:

    explicit GSLFFT             (void) ;
    virtual ~GSLFFT             (void) ;

    virtual int  type           (void) const ;
    virtual bool isSupported    (Cpp::ValueTypes T,int dimension) const ;
    virtual int  AllocateSource (CUIDs elements,QByteArray & Source) ;
    virtual int  AllocateTarget (CUIDs elements,QByteArray & Target) ;
    virtual bool Prepare        (CUIDs        elements  ,
                                 VarArgs    & Paraments ,
                                 QByteArray & Source    ,
                                 QByteArray & Target  ) ;
    virtual void Execution      (void) ;

  protected:

  private:

};

class Q_FFT_EXPORT FFTW : public AbstractFFT
{
  public:

    explicit       FFTW           (void) ;
    virtual       ~FFTW           (void) ;

    virtual int    type           (void) const ;
    virtual bool   isSupported    (Cpp::ValueTypes T,int dimension) const ;
    virtual int    AllocateSource (CUIDs elements,QByteArray & Source) ;
    virtual int    AllocateTarget (CUIDs elements,QByteArray & Target) ;
    virtual bool   Prepare        (CUIDs        elements  ,
                                   VarArgs    & Paraments ,
                                   QByteArray & Source    ,
                                   QByteArray & Target  ) ;
    virtual void   Execution      (void) ;

    void           Cleanup        (void);

    fftw_complex * array          (int size);
    fftw_complex * fromByteArray  (int & size,QByteArray & Array);
    QByteArray     toByteArray    (fftw_complex * complex,int size);
    void           Execute        (const fftw_plan plan);
    void           Destroy        (fftw_plan plan);

    fftw_plan      Frequency      (int N,double * data,fftw_complex * dout,unsigned int flags = FFTW_MEASURE) ;
    void           Retrieve       (int component,int index,int length,double * data,fftw_complex * dout) ;

    void           Execute        (const fftwf_plan plan);
    void           Destroy        (fftwf_plan plan);

    #ifndef DISABLE_FFTW_LDOUBLE
    void           Execute        (const fftwl_plan plan);
    void           Destroy        (fftwl_plan plan);
    #endif

  protected:

    fftw_plan  fftplan  ;
    fftwf_plan fftfplan ;
    #ifndef DISABLE_FFTW_LDOUBLE
    fftwl_plan fftlplan ;
    #endif

  private:

    int fftSize                   (int fft,int length) ;
    int fftSize                   (int fft,CUIDs elements) ;

};

class Q_FFT_EXPORT AccelerateFFT : public AbstractFFT
{ // Apple iPhone OS Accelerate Framework
  public:

    explicit     AccelerateFFT  (void) ;
    virtual     ~AccelerateFFT  (void) ;

    virtual int  type           (void) const ;
    virtual bool isSupported    (Cpp::ValueTypes T,int dimension) const ;
    virtual int  AllocateSource (CUIDs elements,QByteArray & Source) ;
    virtual int  AllocateTarget (CUIDs elements,QByteArray & Target) ;
    virtual bool Prepare        (CUIDs        elements  ,
                                 VarArgs    & Paraments ,
                                 QByteArray & Source    ,
                                 QByteArray & Target  ) ;
    virtual void Execution      (void) ;

  protected:

  private:

};

}

QT_END_NAMESPACE

Q_DECLARE_METATYPE(N::Wavelet)
Q_DECLARE_METATYPE(N::Hankel)
Q_DECLARE_METATYPE(N::CooleyFFT)
Q_DECLARE_METATYPE(N::KissFFT)
Q_DECLARE_METATYPE(N::GSLFFT)
Q_DECLARE_METATYPE(N::FFTW)
Q_DECLARE_METATYPE(N::AccelerateFFT)

Q_DECLARE_INTERFACE(N::AbstractFFT  , "com.neutrino.math.fft" )

#endif


/* linalg/trimult.c
 *
 * Copyright (C) 2019 Patrick Alken
 *
 * This is free software; you can redistribute it and/or modify it
 * under the terms of the GNU General Public License as published by the
 * Free Software Foundation; either version 3, or (at your option) any
 * later version.
 *
 * This source is distributed in the hope that it will be useful, but WITHOUT
 * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
 * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
 * for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 *
 * This module contains code to compute L^T L where L is a lower triangular matrix
 */

#include <config.h>

#include <gsl/gsl_math.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_blas.h>
#include <gsl/gsl_linalg.h>

#include "recurse.h"

static int triangular_multsymm_L2(CBLAS_UPLO_t Uplo, gsl_matrix * T);
static int triangular_multsymm_L3(CBLAS_UPLO_t Uplo, gsl_matrix * T);
static int triangular_mult_L2(CBLAS_UPLO_t Uplo, gsl_matrix * A);
static int triangular_mult_L3(CBLAS_UPLO_t Uplo, gsl_matrix * A);

int
gsl_linalg_tri_LTL(gsl_matrix * L)
{
  return triangular_multsymm_L3(CblasLower, L);
}

int
gsl_linalg_tri_UL(gsl_matrix * LU)
{
  return triangular_mult_L3(CblasUpper, LU);
}

/*
triangular_multsymm_L2()
  Compute L^T L or U U^T

Inputs: Uplo - CblasUpper or CblasLower
        T    - on output the upper (or lower) part of T
               is replaced by L^T L or U U^T

Return: success/error

Notes:
1) Based on LAPACK routine DLAUU2 using Level 2 BLAS
*/

static int
triangular_multsymm_L2(CBLAS_UPLO_t Uplo, gsl_matrix * T)
{
  const size_t N = T->size1;

  if (N != T->size2)
    {
      GSL_ERROR ("matrix must be square", GSL_ENOTSQR);
    }
  else
    {
      gsl_vector_view v1, v2;
      size_t i;

      if (Uplo == CblasUpper)
        {
        }
      else
        {
          for (i = 0; i < N; ++i)
            {
              double Tii = gsl_matrix_get(T, i, i);

              if (i < N - 1)
                {
                  double tmp;

                  v1 = gsl_matrix_subcolumn(T, i, i, N - i);
                  gsl_blas_ddot(&v1.vector, &v1.vector, &tmp);
                  gsl_matrix_set(T, i, i, tmp);

                  if (i > 0)
                    {
                      gsl_matrix_view m = gsl_matrix_submatrix(T, i + 1, 0, N - i - 1, i);

                      v1 = gsl_matrix_subcolumn(T, i, i + 1, N - i - 1);
                      v2 = gsl_matrix_subrow(T, i, 0, i);

                      gsl_blas_dgemv(CblasTrans, 1.0, &m.matrix, &v1.vector, Tii, &v2.vector);
                    }
                }
              else
                {
                  v1 = gsl_matrix_row(T, N - 1);
                  gsl_blas_dscal(Tii, &v1.vector);
                }
            }
        }

      return GSL_SUCCESS;
    }
}

/*
triangular_multsymm_L3()
  Compute L^T L or U U^T

Inputs: Uplo - CblasUpper or CblasLower
        T    - on output the upper (or lower) part of T
               is replaced by L^T L or U U^T

Return: success/error

Notes:
1) Based on ReLAPACK routine DLAUUM using Level 3 BLAS
*/

static int
triangular_multsymm_L3(CBLAS_UPLO_t Uplo, gsl_matrix * T)
{
  const size_t N = T->size1;

  if (N != T->size2)
    {
      GSL_ERROR ("matrix must be square", GSL_ENOTSQR);
    }
  else if (N <= CROSSOVER_TRIMULT)
    {
      return triangular_multsymm_L2(Uplo, T);
    }
  else
    {
      /* partition matrix:
       *
       * T11 T12
       * T21 T22
       *
       * where T11 is N1-by-N1
       */
      int status;
      const size_t N1 = GSL_LINALG_SPLIT(N);
      const size_t N2 = N - N1;
      gsl_matrix_view T11 = gsl_matrix_submatrix(T, 0, 0, N1, N1);
      gsl_matrix_view T12 = gsl_matrix_submatrix(T, 0, N1, N1, N2);
      gsl_matrix_view T21 = gsl_matrix_submatrix(T, N1, 0, N2, N1);
      gsl_matrix_view T22 = gsl_matrix_submatrix(T, N1, N1, N2, N2);

      /* recursion on T11 */
      status = triangular_multsymm_L3(Uplo, &T11.matrix);
      if (status)
        return status;

      if (Uplo == CblasLower)
        {
          /* T11 += T21^T T21 */
          gsl_blas_dsyrk(Uplo, CblasTrans, 1.0, &T21.matrix, 1.0, &T11.matrix);

          /* T21 = T22^T * T21 */
          gsl_blas_dtrmm(CblasLeft, Uplo, CblasTrans, CblasNonUnit, 1.0, &T22.matrix, &T21.matrix);
        }
      else
        {
          /* T11 += T12 T12^T */
          gsl_blas_dsyrk(Uplo, CblasNoTrans, 1.0, &T12.matrix, 1.0, &T11.matrix);

          /* T12 = T12 * T22^T */
          gsl_blas_dtrmm(CblasRight, Uplo, CblasTrans, CblasNonUnit, 1.0, &T22.matrix, &T12.matrix);
        }

      /* recursion on T22 */
      status = triangular_multsymm_L3(Uplo, &T22.matrix);
      if (status)
        return status;

      return GSL_SUCCESS;
    }
}

/*
triangular_mult_L2()
  Compute U L or L U

Inputs: Uplo - CblasUpper or CblasLower (for the first triangular factor)
        A    - on input, matrix in LU format;
               on output, U L or L U

Return: success/error
*/

static int
triangular_mult_L2(CBLAS_UPLO_t Uplo, gsl_matrix * A)
{
  const size_t N = A->size1;

  if (N != A->size2)
    {
      GSL_ERROR ("matrix must be square", GSL_ENOTSQR);
    }
  else
    {
      size_t i;

      /* quick return */
      if (N == 1)
        return GSL_SUCCESS;

      if (Uplo == CblasUpper)
        {
          /* compute U * L and store in A */

          for (i = 0; i < N; ++i)
            {
              double * Aii = gsl_matrix_ptr(A, i, i);
              double Uii = *Aii;

              if (i < N - 1)
                {
                  gsl_vector_view lb = gsl_matrix_subcolumn(A, i, i + 1, N - i - 1);
                  gsl_vector_view ur = gsl_matrix_subrow(A, i, i + 1, N - i - 1);
                  double tmp;

                  gsl_blas_ddot(&lb.vector, &ur.vector, &tmp);
                  *Aii += tmp;

                  if (i > 0)
                    {
                      gsl_matrix_view U_TR = gsl_matrix_submatrix(A, 0, i + 1, i, N - i - 1);
                      gsl_matrix_view L_BL = gsl_matrix_submatrix(A, i + 1, 0, N - i - 1, i);
                      gsl_vector_view ut = gsl_matrix_subcolumn(A, i, 0, i);
                      gsl_vector_view ll = gsl_matrix_subrow(A, i, 0, i);

                      gsl_blas_dgemv(CblasTrans, 1.0, &L_BL.matrix, &ur.vector, Uii, &ll.vector);
                      gsl_blas_dgemv(CblasNoTrans, 1.0, &U_TR.matrix, &lb.vector, 1.0, &ut.vector);
                    }
                }
              else
                {
                  gsl_vector_view v = gsl_matrix_subrow(A, N - 1, 0, N - 1);
                  gsl_blas_dscal(Uii, &v.vector);
                }
            }
        }
      else
        {
        }

      return GSL_SUCCESS;
    }
}

/*
triangular_mult_L3()
  Compute U L or L U

Inputs: Uplo - CblasUpper or CblasLower (for the first triangular factor)
        A    - on input, matrix in LU format;
               on output, U L or L U

Return: success/error
*/

static int
triangular_mult_L3(CBLAS_UPLO_t Uplo, gsl_matrix * A)
{
  const size_t N = A->size1;

  if (N != A->size2)
    {
      GSL_ERROR ("matrix must be square", GSL_ENOTSQR);
    }
  else if (N <= CROSSOVER_TRIMULT)
    {
      return triangular_mult_L2(Uplo, A);
    }
  else
    {
      /* partition matrix:
       *
       * A11 A12
       * A21 A22
       *
       * where A11 is N1-by-N1
       */
      int status;
      const size_t N1 = GSL_LINALG_SPLIT(N);
      const size_t N2 = N - N1;
      gsl_matrix_view A11 = gsl_matrix_submatrix(A, 0, 0, N1, N1);
      gsl_matrix_view A12 = gsl_matrix_submatrix(A, 0, N1, N1, N2);
      gsl_matrix_view A21 = gsl_matrix_submatrix(A, N1, 0, N2, N1);
      gsl_matrix_view A22 = gsl_matrix_submatrix(A, N1, N1, N2, N2);

      /* recursion on A11 */
      status = triangular_mult_L3(Uplo, &A11.matrix);
      if (status)
        return status;

      if (Uplo == CblasLower)
        {
        }
      else
        {
          /* form U * L */

          /* A11 += A12 A21 */
          gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, &A12.matrix, &A21.matrix, 1.0, &A11.matrix);

          /* A12 = A12 * L22 */
          gsl_blas_dtrmm(CblasRight, CblasLower, CblasNoTrans, CblasUnit, 1.0, &A22.matrix, &A12.matrix);

          /* A21 = U22 * A21 */
          gsl_blas_dtrmm(CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, 1.0, &A22.matrix, &A21.matrix);
        }

      /* recursion on A22 */
      status = triangular_mult_L3(Uplo, &A22.matrix);
      if (status)
        return status;

      return GSL_SUCCESS;
    }
}


/*
 *  Player - One Hell of a Robot Server
 *  Copyright (C) 2000  Brian Gerkey   &  Kasper Stoy
 *                      gerkey@usc.edu    kaspers@robotics.usc.edu
 *
 *  This library is free software; you can redistribute it and/or
 *  modify it under the terms of the GNU Lesser General Public
 *  License as published by the Free Software Foundation; either
 *  version 2.1 of the License, or (at your option) any later version.
 *
 *  This library is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 *  Lesser General Public License for more details.
 *
 *  You should have received a copy of the GNU Lesser General Public
 *  License along with this library; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *
 */
/**************************************************************************
 * Desc: Vector functions
 * Author: Andrew Howard
 * Date: 10 Dec 2002
 * CVS: $Id: pf_vector.c 6345 2008-04-17 01:36:39Z gerkey $
 *************************************************************************/

#include <math.h>
//#include <gsl/gsl_matrix.h>
//#include <gsl/gsl_eigen.h>
//#include <gsl/gsl_linalg.h>

#include "amcl/pf/pf_vector.h"
#include "amcl/pf/eig3.h"

// Return a zero vector
pf_vector_t pf_vector_zero()
{
  pf_vector_t c;

  c.v[0] = 0.0;
  c.v[1] = 0.0;
  c.v[2] = 0.0;

  return c;
}

// Check for NAN or INF in any component
int pf_vector_finite(pf_vector_t a)
{
  int i;

  for (i = 0; i < 3; i++)
    if (!isfinite(a.v[i]))
      return 0;

  return 1;
}

// Print a vector
void pf_vector_fprintf(pf_vector_t a, FILE *file, const char *fmt)
{
  int i;

  for (i = 0; i < 3; i++)
  {
    fprintf(file, fmt, a.v[i]);
    fprintf(file, " ");
  }
  fprintf(file, "\n");

  return;
}

// Simple vector addition
pf_vector_t pf_vector_add(pf_vector_t a, pf_vector_t b)
{
  pf_vector_t c;

  c.v[0] = a.v[0] + b.v[0];
  c.v[1] = a.v[1] + b.v[1];
  c.v[2] = a.v[2] + b.v[2];

  return c;
}

// Simple vector subtraction
pf_vector_t pf_vector_sub(pf_vector_t a, pf_vector_t b)
{
  pf_vector_t c;

  c.v[0] = a.v[0] - b.v[0];
  c.v[1] = a.v[1] - b.v[1];
  c.v[2] = a.v[2] - b.v[2];

  return c;
}

// Transform from local to global coords (a + b)
pf_vector_t pf_vector_coord_add(pf_vector_t a, pf_vector_t b)
{
  pf_vector_t c;

  c.v[0] = b.v[0] + a.v[0] * cos(b.v[2]) - a.v[1] * sin(b.v[2]);
  c.v[1] = b.v[1] + a.v[0] * sin(b.v[2]) + a.v[1] * cos(b.v[2]);
  c.v[2] = b.v[2] + a.v[2];
  c.v[2] = atan2(sin(c.v[2]), cos(c.v[2]));

  return c;
}

// Transform from global to local coords (a - b)
pf_vector_t pf_vector_coord_sub(pf_vector_t a, pf_vector_t b)
{
  pf_vector_t c;

  c.v[0] = +(a.v[0] - b.v[0]) * cos(b.v[2]) + (a.v[1] - b.v[1]) * sin(b.v[2]);
  c.v[1] = -(a.v[0] - b.v[0]) * sin(b.v[2]) + (a.v[1] - b.v[1]) * cos(b.v[2]);
  c.v[2] = a.v[2] - b.v[2];
  c.v[2] = atan2(sin(c.v[2]), cos(c.v[2]));

  return c;
}

// Return a zero matrix
pf_matrix_t pf_matrix_zero()
{
  int i, j;
  pf_matrix_t c;

  for (i = 0; i < 3; i++)
    for (j = 0; j < 3; j++)
      c.m[i][j] = 0.0;

  return c;
}

// Check for NAN or INF in any component
int pf_matrix_finite(pf_matrix_t a)
{
  int i, j;

  for (i = 0; i < 3; i++)
    for (j = 0; j < 3; j++)
      if (!isfinite(a.m[i][j]))
        return 0;

  return 1;
}

// Print a matrix
void pf_matrix_fprintf(pf_matrix_t a, FILE *file, const char *fmt)
{
  int i, j;

  for (i = 0; i < 3; i++)
  {
    for (j = 0; j < 3; j++)
    {
      fprintf(file, fmt, a.m[i][j]);
      fprintf(file, " ");
    }
    fprintf(file, "\n");
  }
  return;
}

/*
// Compute the matrix inverse
pf_matrix_t pf_matrix_inverse(pf_matrix_t a, double *det)
{
  double lndet;
  int signum;
  gsl_permutation *p;
  gsl_matrix_view A, Ai;

  pf_matrix_t ai;

  A = gsl_matrix_view_array((double*) a.m, 3, 3);
  Ai = gsl_matrix_view_array((double*) ai.m, 3, 3);

  // Do LU decomposition
  p = gsl_permutation_alloc(3);
  gsl_linalg_LU_decomp(&A.matrix, p, &signum);

  // Check for underflow
  lndet = gsl_linalg_LU_lndet(&A.matrix);
  if (lndet < -1000)
  {
    //printf("underflow in matrix inverse lndet = %f", lndet);
    gsl_matrix_set_zero(&Ai.matrix);
  }
  else
  {
    // Compute inverse
    gsl_linalg_LU_invert(&A.matrix, p, &Ai.matrix);
  }

  gsl_permutation_free(p);

  if (det)
    *det = exp(lndet);

  return ai;
}
*/

// Decompose a covariance matrix [a] into a rotation matrix [r] and a diagonal
// matrix [d] such that a = r d r^T.
void pf_matrix_unitary(pf_matrix_t *r, pf_matrix_t *d, pf_matrix_t a)
{
  int i, j;
  /*
  gsl_matrix *aa;
  gsl_vector *eval;
  gsl_matrix *evec;
  gsl_eigen_symmv_workspace *w;

  aa = gsl_matrix_alloc(3, 3);
  eval = gsl_vector_alloc(3);
  evec = gsl_matrix_alloc(3, 3);
  */

  double aa[3][3];
  double eval[3];
  double evec[3][3];

  for (i = 0; i < 3; i++)
  {
    for (j = 0; j < 3; j++)
    {
      //gsl_matrix_set(aa, i, j, a.m[i][j]);
      aa[i][j] = a.m[i][j];
    }
  }

  // Compute eigenvectors/values
  /*
  w = gsl_eigen_symmv_alloc(3);
  gsl_eigen_symmv(aa, eval, evec, w);
  gsl_eigen_symmv_free(w);
  */

  eigen_decomposition(aa,evec,eval);

  *d = pf_matrix_zero();
  for (i = 0; i < 3; i++)
  {
    //d->m[i][i] = gsl_vector_get(eval, i);
    d->m[i][i] = eval[i];
    for (j = 0; j < 3; j++)
    {
      //r->m[i][j] = gsl_matrix_get(evec, i, j);
      r->m[i][j] = evec[i][j];
    }
  }

  //gsl_matrix_free(evec);
  //gsl_vector_free(eval);
  //gsl_matrix_free(aa);

  return;
}


#include <gsl/gsl_vector.h>
#include <stdio.h>
#include "vector.h"
#include "api.h"

 static void ke_vector_alloc(sml_t* sml) {
	int n = sml_pop_int(sml);
	gsl_vector * v = gsl_vector_alloc(n);
	sml_mem_inc(sml);
	sml_push_vector(sml, v)
}

 static void ke_vector_int_alloc(sml_t* sml) {
	int n = sml_pop_int(sml);
	gsl_vector_int * v = gsl_vector_int_alloc(n);
	sml_mem_inc(sml);
	sml_push_vector_int(sml, v);
}

 static void ke_vector_free(sml_t* sml) {
	token_t * tokp = sml_pop_token(sml);
	void * v = sml_get_ptr(tokp);
	sml_free_ptr(sml, v);
	sml_set_ptr_null(sml,tokp);
}

 static void ke_vector_int_free(sml_t* sml) {
	 token_t * tokp = sml_pop_token(sml);
	 void * v = sml_get_ptr(tokp);
	 sml_free_ptr(sml, v);
	 sml_set_ptr_null(sml,tokp);
}

void ke_vector_get(sml_t* sml) {
	gsl_vector * v = sml_pop_vector(sml);
	int i = sml_pop_int(sml);
	double r = gsl_vector_get(v, i);
	sml_push_real(sml, r);
}

void ke_vector_int_get(sml_t* sml) {
	gsl_vector_int * v = sml_pop_vector_int(sml);
	int idx = sml_pop_int(sml);
	int i = gsl_vector_int_get(v, idx);
	sml_push_int(sml, i);
}

void ke_vector_prop_set(sml_t* sml) {
	double x = sml_pop_real(sml);
	gsl_vector * v = sml_pop_vector(sml);
	int i = sml_pop_int(sml);
	gsl_vector_set(v, i, x);
}

void ke_vector_int_set(sml_t* sml) {
	int x = sml_pop_int(sml);
	int i = sml_pop_int(sml);
	gsl_vector_int * v = sml_pop_vector_int(sml);
	gsl_vector_int_set(v, i, x);
}

void ke_vector_prop_int_set(sml_t* sml) {
	int x = sml_pop_int(sml);
	gsl_vector_int * v = sml_pop_vector_int(sml);
	int i = sml_pop_int(sml);
	gsl_vector_int_set(v,i,x);
}

void ke_vector_set(sml_t* sml) {
	double x = sml_pop_real(sml);
	int i = sml_pop_int(sml);
	gsl_vector * v = sml_pop_vector(sml);
	gsl_vector_set(v,i,x);
}

void ke_vector_put(sml_t* sml) {
	int top = sml_get_top(sml);
	int n = sml_get_args(sml);
	gsl_vector * v = sml_peek_vector(sml, (top - n));
	for (size_t i = 0; i < n - 1; ++i) {
		if (i == v->size) break;
		double x = sml_peek_real(sml, (top - n + i + 1));
		gsl_vector_set(v, i, x);
	}
	top = top - n;
	sml_set_top(sml, top);
}

static void ke_vector_int_put(sml_t* sml) {
	int top = sml_get_top(sml);
	int n = sml_get_args(sml);
	gsl_vector_int * v = sml_peek_vector_int(sml, (top - n));
	for (size_t i = 0; i < n - 1; ++i) {
		if (i == v->size) break;
		int x = sml_peek_int(sml, (top - n + i + 1));
		gsl_vector_int_set(v, i, x);
	}
	top = top - n;
	sml_set_top(sml, top);
}

 static void ke_vector_set_all(sml_t* sml) {
	double x = sml_pop_real(sml);
	gsl_vector * v = sml_pop_vector(sml);
	gsl_vector_set_all(v,x);
}

 static void ke_vector_int_set_all(sml_t* sml) {
	 int x = sml_pop_int(sml);
	 gsl_vector_int * v = sml_pop_vector_int(sml);
	 gsl_vector_int_set_all(v, x);
}

 static void ke_vector_set_zero(sml_t* sml) {
	gsl_vector * v = sml_pop_vector(sml);
	gsl_vector_set_zero(v);
}

 static void ke_vector_int_set_zero(sml_t* sml) {
	 gsl_vector_int * v = sml_pop_vector_int(sml);
	 gsl_vector_int_set_zero(v);
}

 static void ke_vector_set_basis(sml_t* sml) {
	int i = sml_pop_int(sml);
	gsl_vector * v = sml_pop_vector(sml);
	gsl_vector_set_basis(v, i);
}

 static void ke_vector_int_set_basis(sml_t* sml) {
	 int i = sml_pop_int(sml);
	 gsl_vector_int * v = sml_pop_vector_int(sml);
	 gsl_vector_int_set_basis(v, i);
}

 static void ke_vector_add(sml_t* sml) {
	gsl_vector * b = sml_pop_vector(sml);
	gsl_vector * a = sml_pop_vector(sml);
	gsl_vector_add(a,b);
}

 static void ke_vector_int_add(sml_t* sml) {
	gsl_vector_int * b = sml_pop_vector_int(sml);
	gsl_vector_int * a = sml_pop_vector_int(sml);
	gsl_vector_int_add(a, b);
}

 static void ke_vector_sub(sml_t* sml) {
	gsl_vector * b = sml_pop_vector(sml);
	gsl_vector * a = sml_pop_vector(sml);
	gsl_vector_sub(a, b);
}

 static void ke_vector_int_sub(sml_t* sml) {
	gsl_vector_int * b = sml_pop_vector_int(sml);
	gsl_vector_int * a = sml_pop_vector_int(sml);
	gsl_vector_int_sub(a, b);
}

 static void ke_vector_mul(sml_t* sml) {
	gsl_vector * b = sml_pop_vector(sml);
	gsl_vector * a = sml_pop_vector(sml);
	gsl_vector_mul(a, b);
}

 static void ke_vector_int_mul(sml_t* sml) {
	gsl_vector_int * b = sml_pop_vector_int(sml);
	gsl_vector_int * a = sml_pop_vector_int(sml);
	gsl_vector_int_mul(a, b);
 }

 static void ke_vector_div(sml_t* sml) {
	gsl_vector * b = sml_pop_vector(sml);
	gsl_vector * a = sml_pop_vector(sml);
	gsl_vector_div(a, b);
}

 static void ke_vector_int_div(sml_t* sml) {
	gsl_vector_int * b = sml_pop_vector_int(sml);
	gsl_vector_int * a = sml_pop_vector_int(sml);
	gsl_vector_int_div(a, b);
}

 static void ke_vector_scale(sml_t* sml) {
	double x = sml_pop_real(sml);
	gsl_vector * v = sml_pop_vector(sml);
	gsl_vector_scale(v,x);
}

 static void ke_vector_int_scale(sml_t* sml) {
	 double x = sml_pop_real(sml);
	 gsl_vector_int * v = sml_pop_vector_int(sml);
	 gsl_vector_int_scale(v, x);
}

 static void ke_vector_add_constant(sml_t* sml) {
	double x = sml_pop_real(sml);
	gsl_vector * a = sml_pop_vector(sml);
	gsl_vector_add_constant(a,x);
}

 static void ke_vector_int_add_constant(sml_t* sml) {
	 double x = sml_pop_real(sml);
	 gsl_vector_int * a = sml_pop_vector_int(sml);
	 gsl_vector_int_add_constant(a, x);
}

 static void ke_vector_reverse(sml_t* sml) {
	gsl_vector * v = sml_pop_vector(sml);
	gsl_vector_reverse(v);
}

 static void ke_vector_int_reverse(sml_t* sml) {
	gsl_vector_int * v = sml_pop_vector_int(sml);
	gsl_vector_int_reverse(v);
}

 static void ke_vector_swap_elements(sml_t* sml) {
	int j = sml_pop_int(sml);
	int i = sml_pop_int(sml);
	gsl_vector * v = sml_pop_vector(sml);
	gsl_vector_swap_elements(v,i,j);
}

 static void ke_vector_int_swap_elements(sml_t* sml) {
	 int j = sml_pop_int(sml);
	 int i = sml_pop_int(sml);
	 gsl_vector_int * v = sml_pop_vector_int(sml);
	 gsl_vector_int_swap_elements(v, i, j);
}

 static void ke_vector_memcpy(sml_t* sml) {
	gsl_vector * src = sml_pop_vector(sml);
	gsl_vector * dest = sml_pop_vector(sml);
	gsl_vector_memcpy(dest, src);
}

 static void ke_vector_int_memcpy(sml_t* sml) {
	gsl_vector_int * src = sml_pop_vector_int(sml);
	gsl_vector_int * dest = sml_pop_vector_int(sml);
	gsl_vector_int_memcpy(dest, src);
}

 static void ke_vector_swap(sml_t* sml) {
	gsl_vector * w = sml_pop_vector(sml);
	gsl_vector * v = sml_pop_vector(sml);
	gsl_vector_swap(v,w);
}

 static void ke_vector_int_swap(sml_t* sml) {
	gsl_vector_int * w = sml_pop_vector_int(sml);
	gsl_vector_int * v = sml_pop_vector_int(sml);
	gsl_vector_int_swap(v, w);
}

 static void ke_vector_min(sml_t* sml) {
	gsl_vector * v = sml_pop_vector(sml);
	double r = gsl_vector_min(v);
	sml_push_real(sml,r);
}

 static void ke_vector_int_min(sml_t* sml) {
	 gsl_vector_int * v = sml_pop_vector_int(sml);
	 int i = gsl_vector_int_min(v);
	 sml_push_int(sml, i);
}

 static void ke_vector_max(sml_t* sml) {
	gsl_vector * v = sml_pop_vector(sml);
	double r = gsl_vector_max(v);
	sml_push_real(sml, r);
}

 static void ke_vector_int_max(sml_t* sml) {
	gsl_vector_int * v = sml_pop_vector_int(sml);
	int i = gsl_vector_int_max(v);
	sml_push_int(sml, i);
}

 static void ke_vector_isnull(sml_t* sml) {
	gsl_vector * v = sml_pop_vector(sml);
	int i = gsl_vector_isnull(v);
	sml_push_int(sml, i);
}

 static void ke_vector_int_isnull(sml_t* sml) {
	gsl_vector_int * v = sml_pop_vector_int(sml);
	int i = gsl_vector_int_isnull(v);
	sml_push_int(sml, i);
}

 static void ke_vector_ispos(sml_t* sml) {
	gsl_vector * v = sml_pop_vector(sml);
	int i = gsl_vector_ispos(v);
	sml_push_int(sml, i);
}

 static void ke_vector_int_ispos(sml_t* sml) {
	gsl_vector_int * v = sml_pop_vector_int(sml);
	int i = gsl_vector_int_ispos(v);
	sml_push_int(sml, i);
}

 static void ke_vector_isneg(sml_t* sml) {
	gsl_vector * v = sml_pop_vector(sml);
	int i = gsl_vector_isneg(v);
	sml_push_int(sml, i);
}

 static void ke_vector_int_isneg(sml_t* sml) {
	gsl_vector_int * v = sml_pop_vector_int(sml);
	int i = gsl_vector_int_isneg(v);
	sml_push_int(sml, i);
}

 static void ke_vector_isnonneg(sml_t* sml) {
	gsl_vector * v = sml_pop_vector(sml);
	int i = gsl_vector_isnonneg(v);
	sml_push_int(sml, i);
}

 static void ke_vector_int_isnonneg(sml_t* sml) {
	gsl_vector_int * v = sml_pop_vector_int(sml);
	int i = gsl_vector_int_isnonneg(v);
	sml_push_int(sml, i);
}

 static void ke_vector_equal(sml_t* sml) {
	gsl_vector * v = sml_pop_vector(sml);
	gsl_vector * u = sml_pop_vector(sml);
	int i  = gsl_vector_equal(u,v);
	sml_push_int(sml, i);
 }

 static void ke_vector_int_equal(sml_t* sml) {
	gsl_vector_int * v = sml_pop_vector_int(sml);
	gsl_vector_int * u = sml_pop_vector_int(sml);
	int i = gsl_vector_int_equal(u, v);
	sml_push_int(sml, i);
}

 static void ke_vector_fscanf(sml_t* sml) {
	gsl_vector * v = sml_pop_vector(sml);
	char * filename = sml_pop_str(sml);
    FILE * f = fopen(filename, "r");
    gsl_vector_fscanf(f, v);
    fclose(f);
}

 static void ke_vector_int_fscanf(sml_t* sml) {
	gsl_vector_int * v = sml_pop_vector_int(sml);
	char * filename = sml_pop_str(sml);
	FILE * f = fopen(filename, "r");
	gsl_vector_int_fscanf(f, v);
	fclose(f);
}

 static void ke_vector_fprintf(sml_t* sml) {
	gsl_vector * v = sml_pop_vector(sml);
	char * filename = sml_pop_str(sml);
	FILE * f = fopen(filename, "w");
    gsl_vector_fprintf(f, v,"%5g");
    fclose(f);
}

 static void ke_vector_int_fprintf(sml_t* sml) {
	gsl_vector_int * v = sml_pop_vector_int(sml);
	char * filename = sml_pop_str(sml);
	FILE * f = fopen(filename, "w");
	gsl_vector_int_fprintf(f, v, "%5g");
	fclose(f);
}

 static void ke_vector_fread(sml_t* sml) {
	gsl_vector * v = sml_pop_vector(sml);
	char * filename = sml_pop_str(sml);
	FILE * f = fopen(filename, "r");
	gsl_vector_fread(f, v);
	fclose(f);
}

 static void ke_vector_int_fread(sml_t* sml) {
	gsl_vector_int * v = sml_pop_vector_int(sml);
	char * filename = sml_pop_str(sml);
	FILE * f = fopen(filename, "r");
	gsl_vector_int_fread(f, v);
	fclose(f);
}

 static void ke_vector_fwrite(sml_t* sml) {
	gsl_vector * v = sml_pop_vector(sml);
	char * filename = sml_pop_str(sml);
	FILE * f = fopen(filename, "w");
    gsl_vector_fwrite(f, v);
    fclose(f);
}

 static void ke_vector_int_fwrite(sml_t* sml) {
	gsl_vector_int * v = sml_pop_vector_int(sml);
	char * filename = sml_pop_str(sml);
	FILE * f = fopen(filename, "w");
	gsl_vector_int_fwrite(f, v);
	fclose(f);
}

void ke_vector_hash(sml_t* sml) {
    ke_hash_add(sml, (fncp)&ke_vector_alloc, VECTOR);
    ke_hash_add(sml, (fncp)&ke_vector_alloc, VECTOR_ALLOC);
    ke_hash_add(sml, (fncp)&ke_vector_get, VECTOR_GET);
    ke_hash_add(sml, (fncp)&ke_vector_set, VECTOR_SET);
	ke_hash_add(sml, (fncp)&ke_vector_get, VECTOR_SGET);
	ke_hash_add(sml, (fncp)&ke_vector_set, VECTOR_SSET);
	ke_hash_add(sml, (fncp)&ke_vector_put, VECTOR_PUT);
	ke_hash_add(sml, (fncp)&ke_vector_free, VECTOR_FREE);
    ke_hash_add(sml, (fncp)&ke_vector_set_all, VECTOR_SET_ALL);
    ke_hash_add(sml, (fncp)&ke_vector_set_zero, VECTOR_SET_ZERO);
    ke_hash_add(sml, (fncp)&ke_vector_set_basis, VECTOR_SET_BASIS);
    ke_hash_add(sml, (fncp)&ke_vector_add, VECTOR_ADD);
    ke_hash_add(sml, (fncp)&ke_vector_sub, VECTOR_SUB);
    ke_hash_add(sml, (fncp)&ke_vector_mul, VECTOR_MUL);
    ke_hash_add(sml, (fncp)&ke_vector_div, VECTOR_DIV);
    ke_hash_add(sml, (fncp)&ke_vector_scale, VECTOR_SCALE);
    ke_hash_add(sml, (fncp)&ke_vector_add_constant, VECTOR_ADD_CONSTANT);
    ke_hash_add(sml, (fncp)&ke_vector_reverse, VECTOR_REVERSE);
    ke_hash_add(sml, (fncp)&ke_vector_swap_elements, VECTOR_SWAP_ELEMENTS);
    ke_hash_add(sml, (fncp)&ke_vector_memcpy, VECTOR_MEMCPY);
    ke_hash_add(sml, (fncp)&ke_vector_swap, VECTOR_SWAP);
    ke_hash_add(sml, (fncp)&ke_vector_min, VECTOR_MIN);
    ke_hash_add(sml, (fncp)&ke_vector_max, VECTOR_MAX);
    ke_hash_add(sml, (fncp)&ke_vector_isnull, VECTOR_ISNULL);
    ke_hash_add(sml, (fncp)&ke_vector_ispos, VECTOR_ISPOS);
    ke_hash_add(sml, (fncp)&ke_vector_isneg, VECTOR_ISNEG);
    ke_hash_add(sml, (fncp)&ke_vector_isnonneg, VECTOR_ISNONNEG);
    ke_hash_add(sml, (fncp)&ke_vector_equal, VECTOR_EQUAL);
    ke_hash_add(sml, (fncp)&ke_vector_fscanf, VECTOR_FSCANF);
    ke_hash_add(sml, (fncp)&ke_vector_fscanf, VECTOR_SCAN);
    ke_hash_add(sml, (fncp)&ke_vector_fprintf, VECTOR_FPRINTF);
    ke_hash_add(sml, (fncp)&ke_vector_fprintf, VECTOR_PRINT);
    ke_hash_add(sml, (fncp)&ke_vector_fread, VECTOR_FREAD);
    ke_hash_add(sml, (fncp)&ke_vector_fread, VECTOR_READ);
    ke_hash_add(sml, (fncp)&ke_vector_fwrite, VECTOR_FWRITE);
    ke_hash_add(sml, (fncp)&ke_vector_fwrite, VECTOR_WRITE);

	ke_hash_add(sml, (fncp)&ke_vector_int_alloc, VECTOR_INT);
	ke_hash_add(sml, (fncp)&ke_vector_int_alloc, VECTOR_INT_ALLOC);
	ke_hash_add(sml, (fncp)&ke_vector_int_get, VECTOR_INT_GET);
	ke_hash_add(sml, (fncp)&ke_vector_int_set, VECTOR_INT_SET);
	ke_hash_add(sml, (fncp)&ke_vector_int_put, VECTOR_INT_PUT);
	ke_hash_add(sml, (fncp)&ke_vector_int_free, VECTOR_INT_FREE);
	ke_hash_add(sml, (fncp)&ke_vector_int_set_all, VECTOR_INT_SET_ALL);
	ke_hash_add(sml, (fncp)&ke_vector_int_set_zero, VECTOR_INT_SET_ZERO);
	ke_hash_add(sml, (fncp)&ke_vector_int_set_basis, VECTOR_INT_SET_BASIS);
	ke_hash_add(sml, (fncp)&ke_vector_int_add, VECTOR_INT_ADD);
	ke_hash_add(sml, (fncp)&ke_vector_int_sub, VECTOR_INT_SUB);
	ke_hash_add(sml, (fncp)&ke_vector_int_mul, VECTOR_INT_MUL);
	ke_hash_add(sml, (fncp)&ke_vector_int_div, VECTOR_INT_DIV);
	ke_hash_add(sml, (fncp)&ke_vector_int_scale, VECTOR_INT_SCALE);
	ke_hash_add(sml, (fncp)&ke_vector_int_add_constant, VECTOR_INT_ADD_CONSTANT);
	ke_hash_add(sml, (fncp)&ke_vector_int_reverse, VECTOR_INT_REVERSE);
	ke_hash_add(sml, (fncp)&ke_vector_int_swap_elements, VECTOR_INT_SWAP_ELEMENTS);
	ke_hash_add(sml, (fncp)&ke_vector_int_memcpy, VECTOR_INT_MEMCPY);
	ke_hash_add(sml, (fncp)&ke_vector_int_swap, VECTOR_INT_SWAP);
	ke_hash_add(sml, (fncp)&ke_vector_int_min, VECTOR_INT_MIN);
	ke_hash_add(sml, (fncp)&ke_vector_int_max, VECTOR_INT_MAX);
	ke_hash_add(sml, (fncp)&ke_vector_int_isnull, VECTOR_INT_ISNULL);
	ke_hash_add(sml, (fncp)&ke_vector_int_ispos, VECTOR_INT_ISPOS);
	ke_hash_add(sml, (fncp)&ke_vector_int_isneg, VECTOR_INT_ISNEG);
	ke_hash_add(sml, (fncp)&ke_vector_int_isnonneg, VECTOR_INT_ISNONNEG);
	ke_hash_add(sml, (fncp)&ke_vector_int_equal, VECTOR_INT_EQUAL);
	ke_hash_add(sml, (fncp)&ke_vector_int_fscanf, VECTOR_INT_FSCANF);
	ke_hash_add(sml, (fncp)&ke_vector_int_fscanf, VECTOR_INT_SCAN);
	ke_hash_add(sml, (fncp)&ke_vector_int_fprintf, VECTOR_INT_FPRINTF);
	ke_hash_add(sml, (fncp)&ke_vector_int_fprintf, VECTOR_INT_PRINT);
	ke_hash_add(sml, (fncp)&ke_vector_int_fread, VECTOR_INT_FREAD);
	ke_hash_add(sml, (fncp)&ke_vector_int_fread, VECTOR_INT_READ);
	ke_hash_add(sml, (fncp)&ke_vector_int_fwrite, VECTOR_INT_FWRITE);
	ke_hash_add(sml, (fncp)&ke_vector_int_fwrite, VECTOR_INT_WRITE);

}

void ke_vector_print(sml_t* sml, token_t *k) {
    printf("Vector: %s\n", k->name);
    for(size_t i = 0; i < k->obj.vector->size; i++) {
        printf("%d : v:%g\n", (int)i, gsl_vector_get(k->obj.vector, i));
    }
}

void ke_vector_freemem(sml_t* sml,token_t *e) {
    if (e->obj.vector && e->vtype == KEV_VEC) {
        gsl_vector_free(e->obj.vector); ke_dec_memory(sml);
        e->obj.vector = NULL;
    }
}

void ke_vector_int_print(sml_t* sml,token_t *k) {
	printf("Vector: %s\n", k->name);
	for (size_t i = 0; i < k->obj.vector_int->size; i++) {
		printf("%d : v:%d\n", (int)i, gsl_vector_int_get(k->obj.vector_int, i));
	}
}

void ke_vector_int_freemem(sml_t* sml,token_t *e) {
	if (e->obj.vector_int && e->vtype == KEV_VEC_INT) {
		gsl_vector_int_free(e->obj.vector_int); ke_dec_memory(sml);
		e->obj.vector_int = NULL;
	}
}


/**
 *
 * @file testing_ssygst.c
 *
 *  PLASMA testing routines
 *  PLASMA is a software package provided by Univ. of Tennessee,
 *  Univ. of California Berkeley and Univ. of Colorado Denver
 *
 * @version 2.6.0
 * @author Hatem Ltaief
 * @date 2010-11-15
 * @generated s Tue Jan  7 11:45:18 2014
 *
 **/
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <math.h>

#include <plasma.h>
#include <cblas.h>
#include <lapacke.h>
#include <core_blas.h>
#include "testing_smain.h"

#undef COMPLEX
#define REAL

static int check_transformation(int, int, int, float*, float*, int, float*, int, float);
static int check_factorization(int, float*, float*, int, int , float);

int testing_ssygst(int argc, char **argv)
{
    /* Check for number of arguments*/
    if (argc != 3) {
        USAGE("HEGST", "N LDA LDB",
              "   - N    : size of the matrices A and B\n"
              "   - LDA  : leading dimension of the matrix A\n"
              "   - LDB  : leading dimension of the matrix B\n");
        return -1;
    }

    float eps = LAPACKE_slamch_work('e');
    int    N     = atoi(argv[0]);
    int    LDA   = atoi(argv[1]);
    int    LDB   = atoi(argv[2]);
    int    info_transformation, info_factorization;
    int    i, u;
    int    LDAxN = LDA*N;
    int    LDBxN = LDB*N;

    float *A1    = (float *)malloc(LDAxN*sizeof(float));
    float *A2    = (float *)malloc(LDAxN*sizeof(float));
    float *B1    = (float *)malloc(LDBxN*sizeof(float));
    float *B2    = (float *)malloc(LDBxN*sizeof(float));
    float *Ainit = (float *)malloc(LDAxN*sizeof(float));
    float *Binit = (float *)malloc(LDBxN*sizeof(float));

    /* Check if unable to allocate memory */
    if ((!A1)||(!A2)||(!B1)||(!B2)||(!Ainit)||(!Binit)){
        printf("Out of Memory \n ");
        return -2;
    }

    /*----------------------------------------------------------
    *  TESTING SSYGST
    */

    /* Initialize A1 and A2 */
    PLASMA_splgsy(0., N, A1, LDA, 5198);
    LAPACKE_slacpy_work(LAPACK_COL_MAJOR, 'A', N, N, A1, LDA, Ainit, LDA);

    /* Initialize B1 and B2 */
    PLASMA_splgsy((float)N, N, B1, LDB, 4231);
    LAPACKE_slacpy_work(LAPACK_COL_MAJOR, 'A', N, N, B1, LDB, Binit, LDB);

    printf("\n");
    printf("------ TESTS FOR PLASMA SSYGST ROUTINE -------  \n");
    printf("        Size of the Matrix %d by %d\n", N, N);
    printf("\n");
    printf(" The matrices A and B are randomly generated for each test.\n");
    printf("============\n");
    printf(" The relative machine precision (eps) is to be %e \n",eps);
    printf(" Computational tests pass if scaled residuals are less than 60.\n");

    /*----------------------------------------------------------
     *  TESTING SSYGST
     */

    for (i=0; i<3; i++) {
        for (u=0; u<2; u++) {
            memcpy(A2, Ainit, LDAxN*sizeof(float));
            memcpy(B2, Binit, LDBxN*sizeof(float));

            PLASMA_spotrf(uplo[u], N, B2, LDB);
            PLASMA_ssygst(itype[i], uplo[u], N, A2, LDA, B2, LDB);

            /* Check the Cholesky factorization and the transformation */
            info_factorization = check_factorization(N, B1, B2, LDB, uplo[u], eps);
            info_transformation = check_transformation(itype[i], uplo[u], N, A1, A2, LDA, B2, LDB, eps);

            if ( (info_transformation == 0) && (info_factorization == 0) ) {
                printf("***************************************************\n");
                printf(" ---- TESTING SSYGST (%s, %s) ....... PASSED !\n", itypestr[i], uplostr[u]);
                printf("***************************************************\n");
            }
            else {
                printf("************************************************\n");
                printf(" - TESTING SSYGST (%s, %s) ... FAILED !\n", itypestr[i], uplostr[u]);
                printf("************************************************\n");
            }
        }
    }

    free(A1);
    free(A2);
    free(B1);
    free(B2);
    free(Ainit);
    free(Binit);

    return 0;
}
/*------------------------------------------------------------------------
 *  Check the factorization of the matrix A2
 */
static int check_factorization(int N, float *A1, float *A2, int LDA, int uplo, float eps)
{
    float alpha = 1.0;
    float Anorm, Rnorm, result;
    int info_factorization;
    int i,j;

    float *Residual = (float *)malloc(N*N*sizeof(float));
    float *L1       = (float *)malloc(N*N*sizeof(float));
    float *L2       = (float *)malloc(N*N*sizeof(float));
    float *work                 = (float *)malloc(N*sizeof(float));

    memset((void*)L1, 0, N*N*sizeof(float));
    memset((void*)L2, 0, N*N*sizeof(float));

    LAPACKE_slacpy_work(LAPACK_COL_MAJOR,' ', N, N, A1, LDA, Residual, N);

    /* Dealing with L'L or U'U  */
    LAPACKE_slacpy_work(LAPACK_COL_MAJOR, lapack_const(uplo), N, N, A2, LDA, L1, N);
    LAPACKE_slacpy_work(LAPACK_COL_MAJOR, lapack_const(uplo), N, N, A2, LDA, L2, N);
    if (uplo == PlasmaUpper)
       cblas_strmm(CblasColMajor, CblasLeft, (CBLAS_UPLO)uplo, CblasTrans, CblasNonUnit, N, N, (alpha), L1, N, L2, N);
    else
       cblas_strmm(CblasColMajor, CblasRight, (CBLAS_UPLO)uplo, CblasTrans, CblasNonUnit, N, N, (alpha), L1, N, L2, N);

    /* Compute the Residual || A - L'L|| */
    for (i = 0; i < N; i++)
        for (j = 0; j < N; j++)
           Residual[j*N+i] = L2[j*N+i] - Residual[j*N+i];

    Rnorm = LAPACKE_slange_work(LAPACK_COL_MAJOR, lapack_const(PlasmaInfNorm), N, N, Residual, N,   work);
    Anorm = LAPACKE_slange_work(LAPACK_COL_MAJOR, lapack_const(PlasmaInfNorm), N, N, A1,       LDA, work);

    result = Rnorm / ( Anorm * N * eps );
    printf("============\n");
    printf("Checking the Cholesky Factorization \n");
    printf("-- ||L'L-A||_oo/(||A||_oo.N.eps) = %e \n", result);

    if ( isnan(result) || isinf(result) || (result > 60.0) ){
        printf("-- Factorization is suspicious ! \n");
        info_factorization = 1;
    }
    else{
        printf("-- Factorization is CORRECT ! \n");
        info_factorization = 0;
    }

    free(Residual); free(L1); free(L2); free(work);

    return info_factorization;
}

/*------------------------------------------------------------
 *  Check the Transformation to standard eigenvalue problem
 */

static int check_transformation(int itype, int uplo, int N, float *A1, float *A2, int LDA, float *B2, int LDB, float eps)
{
    float alpha = 1.0;
    float Anorm, Rnorm, result;
    int info_transformation;
    int i, j;
    char *str;

    float *Residual = (float *)malloc(N*N*sizeof(float));
    float *Aorig    = (float *)malloc(N*N*sizeof(float));
    float *work                 = (float *)malloc(N*sizeof(float));

    LAPACKE_slacpy_work(LAPACK_COL_MAJOR, 'a',                N, N, A1, LDA, Residual, N);
    LAPACKE_slacpy_work(LAPACK_COL_MAJOR, lapack_const(uplo), N, N, A2, LDA, Aorig,    N);

    /* Rebuild the symmetry of A2 */
    if (uplo == PlasmaLower) {
        for (j = 0; j < N; j++)
            for (i = j+1; i < N; i++)
                Aorig[j+i*N] = (Aorig[i+j*N]);
    } else {
        for (i = 0; i < N; i++)
            for (j = i+1; j < N; j++)
                Aorig[j+i*N] = (Aorig[i+j*N]);
    }

    if (itype == 1) {
        if (uplo == PlasmaLower) {
            str = "L*A2*L'";
            cblas_strmm(CblasColMajor, CblasLeft,  CblasLower, CblasNoTrans,   CblasNonUnit, N, N, (alpha), B2, LDB, Aorig, N);
            cblas_strmm(CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, N, N, (alpha), B2, LDB, Aorig, N);
        }
        else{
            str = "U'*A2*U";
            cblas_strmm(CblasColMajor, CblasLeft,  CblasUpper, CblasTrans, CblasNonUnit, N, N, (alpha), B2, LDB, Aorig, N);
            cblas_strmm(CblasColMajor, CblasRight, CblasUpper, CblasNoTrans,   CblasNonUnit, N, N, (alpha), B2, LDB, Aorig, N);
        }
    }
    else {
        if (uplo == PlasmaLower) {
            str = "inv(L')*A2*inv(L)";
            cblas_strsm(CblasColMajor, CblasLeft,  CblasLower, CblasTrans, CblasNonUnit, N, N, (alpha), B2, LDB, Aorig, N);
            cblas_strsm(CblasColMajor, CblasRight, CblasLower, CblasNoTrans,   CblasNonUnit, N, N, (alpha), B2, LDB, Aorig, N);
        }
        else{
            str = "inv(U)*A2*inv(U')";
            cblas_strsm(CblasColMajor, CblasLeft,  CblasUpper, CblasNoTrans,   CblasNonUnit, N, N, (alpha), B2, LDB, Aorig, N);
            cblas_strsm(CblasColMajor, CblasRight, CblasUpper, CblasTrans, CblasNonUnit, N, N, (alpha), B2, LDB, Aorig, N);

        }
    }

    /* Compute the Residual ( A1 - W ) */
    for (i = 0; i < N; i++)
        for (j = 0; j < N; j++)
            Residual[j*N+i] = Aorig[j*N+i] - Residual[j*N+i];

    Rnorm = LAPACKE_slange_work(LAPACK_COL_MAJOR, lapack_const(PlasmaInfNorm), N, N, Residual, N,   work);
    Anorm = LAPACKE_slange_work(LAPACK_COL_MAJOR, lapack_const(PlasmaInfNorm), N, N, A1,       LDA, work);

    result = Rnorm / (Anorm * N *eps);
    printf("============\n");
    printf("Checking the global transformation \n");
    printf("-- ||A1-%s||_oo/(||A1||_oo.N.eps) = %e \n", str, result );

    if (isnan(result) || isinf(result) || (result > 60.0) ) {
        printf("-- Transformation is suspicious ! \n");
        info_transformation = 1;
    }
    else {
        printf("-- Transformation is CORRECT ! \n");
        info_transformation = 0;
    }

    free(Residual); free(Aorig); free(work);

    return info_transformation;
}


/*
  This file is part of the Astrometry.net suite.
  Copyright 2006-2008 Dustin Lang, Keir Mierle and Sam Roweis.

  The Astrometry.net suite is free software; you can redistribute
  it and/or modify it under the terms of the GNU General Public License
  as published by the Free Software Foundation, version 2.

  The Astrometry.net suite is distributed in the hope that it will be
  useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with the Astrometry.net suite ; if not, write to the Free Software
  Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
*/

#ifndef AN_GSL_UTILS_H
#define AN_GSL_UTILS_H

#include <gsl/gsl_matrix_double.h>
#include <gsl/gsl_vector_double.h>

void gslutils_use_error_system();

/**
 Solves a least-squares matrix equation
 A X_i = B_i

 For NB pairs of X_i, B_i.

 NOTE: THIS DESTROYS A!

 A: MxN matrix
 B: array of NB x length-M vectors
 X: must be an array big enough to hold NB vectors.
   (they will be length-N).
 resids: if non-NULL, must be an array big enough to hold NB vectors
   (they will be length-M).

 The result vectors are freshly allocated and should be freed with gsl_vector_free().
 */
int gslutils_solve_leastsquares(gsl_matrix* A, gsl_vector** B,
                                gsl_vector** X, gsl_vector** resids,
                                int NB);

/**
 Same as above, but using varargs.  There must be exactly 3 * NB additional
 arguments, in the order:

 B0, &X0, &resid0, B1, &X1, &resid1, ...

 ie, the types must be repeating triples of:

 gsl_vector* b, gsl_vector** x, gsl_vector** resid

 */
int gslutils_solve_leastsquares_v(gsl_matrix* A, int NB, ...);

// C = A B
void gslutils_matrix_multiply(gsl_matrix* C, const gsl_matrix* A, const gsl_matrix* B);

int gslutils_invert_3x3(const double* A, double* B);

#endif


#pragma once
#include <vector>
#include <algorithm>

#include <gsl/gsl.h>

#include "utils/linear_algebra.h"

namespace util{
namespace math{

template<typename T, int64_t dim_1>
struct VecLoop_void{
    template<typename OP, typename... Args>
    void operator()(OP const&fun, Args&&... args) const {
        #pragma clang loop vectorize(enable)
        for(int64_t i=0; i<dim_1; ++i){
            fun(i, std::forward<Args>(args)...);
        }
    }
};
template<typename T, int64_t dim_1>
struct VecLoop_vec{
    template<typename OP, typename... Args>
    auto operator()(OP const&fun, Args&&... args) const {
        util::math::Vector<T,dim_1> result{};
        #pragma clang loop vectorize(enable)
        for(int64_t i=0; i<dim_1; ++i){
            result.span[i]=fun(i, std::forward<Args>(args)...);
        }
        return result;
    }
};

template<typename T, int64_t dim_1, int64_t dim_2>
struct MatLoop_mat{
    template<typename OP, typename... Args>
    void operator()(OP const&fun, Args&&... args) const {
        util::math::Matrix<T,dim_1,dim_2> result{};
        for(int64_t i=0; i<dim_1; ++i){
            for(int64_t j=0; j<dim_2; ++j){
                result.span[i][j]=fun(i,j, std::forward<Args>(args)...);
            }
        }
    }
};
template<typename T, int64_t dim_1, int64_t dim_2>
struct MatLoop_void{
    template<typename OP, typename... Args>
    void operator()(OP const&fun, Args&&... args) const {
        for(int64_t i=0; i<dim_1; ++i){
            for(int64_t j=0; j<dim_2; ++j){
                fun(i,j, std::forward<Args>(args)...);
            }
        }
    }
};

}//namespace util::math
}//namespace util

namespace gsl{

auto add_assign_vec=[](int64_t i, auto &out, auto const & x) {
    out[i]+=x[i];
};
auto sub_assign_vec=[](int64_t i, auto &out, auto const & x) {
    out[i]-=x[i];
};
auto mul_assign_vec=[](int64_t i, auto &out, auto x) {
    out[i]*=x;
};

auto add_assign_mat=[](int64_t i,int64_t j, auto &out, auto const & x) {
    out[i][j]+=x[i][j];
};
auto sub_assign_mat=[](int64_t i,int64_t j, auto &out, auto const & x) {
    out[i][j]-=x[i][j];
};
auto mul_assign_mat=[](int64_t i,int64_t j, auto &out, auto x) {
    out[i][j]*=x;
};

template<typename T, int64_t M>
span<T,M>& operator +=(span<T,M>& out, const span<T,M>& x){
    auto vecloop_void=util::math::VecLoop_void<T,M>{};
    vecloop_void(add_assign_vec, out, x);
    return out;
}
template<typename T, int64_t M>
span<T,M>& operator -=(span<T,M>& out, const span<T,M>& x){
    auto vecloop_void=util::math::VecLoop_void<T,M>{};
    vecloop_void(sub_assign_vec, out, x);
    return out;
}
template<typename T, int64_t M>
span<T,M>& operator *=(span<T,M>& out, T x){
    auto vecloop_void=util::math::VecLoop_void<T,M>{};
    vecloop_void(mul_assign_vec, out, x);
    return out;
}

template<typename T, int64_t M, int64_t N>
span<T,M,N>& operator +=(span<T,M,N>& out, const span<T,M,N>& x){
    auto matloop_void=util::math::MatLoop_void<T,M,N>{};
    matloop_void(add_assign_mat, out, x);
    return out;
}
template<typename T, int64_t M, int64_t N>
span<T,M,N>& operator -=(span<T,M,N>& out, const span<T,M,N>& x){
    auto matloop_void=util::math::MatLoop_void<T,M,N>{};
    matloop_void(sub_assign_mat, out, x);
    return out;
}
template<typename T, int64_t M, int64_t N>
span<T,M,N>& operator *=(span<T,M,N>& out, T x){
    auto matloop_void=util::math::MatLoop_void<T,M,N>{};
    matloop_void(mul_assign_mat, out, x);
    return out;
}

auto grad_update_mat=[](int64_t i,int64_t j,
                        auto &param, auto const &grad, auto scale) {
    param[i][j] += scale*grad[i][j];
};
auto grad_update_vec=[](int64_t i,
                        auto &param, auto const &grad, auto scale) {
    param[i] += scale*grad[i];
};
template<typename T, int64_t M, int64_t N>
void grad_update(span<T,M,N>& param, span<T,M,N> const &grad, T scale){
    auto matloop_void=util::math::MatLoop_void<T,M,N>{};
    matloop_void(grad_update_mat, param, grad, scale);
}
template<typename T, int64_t M>
void grad_update(span<T,M>& param, span<T,M> const &grad, T scale){
    auto vecloop_void=util::math::VecLoop_void<T,M>{};
    vecloop_void(grad_update_vec, param, grad, scale);
}

}//namespace gsl


#include <stdio.h>
#include <math.h>
#include <stdlib.h>
#include <gsl/gsl_integration.h>
#include <gsl/gsl_histogram.h>
#include"mpi.h"

const double PI = 3.14159;

double rz(double red);

struct galaxy {
  double x, y, z, d, w;
};

int main (int argc, char **argv) {

  FILE * DD;
  FILE * PP;
  FILE * RR;

  const int Nr = 150;
  const int Nm = 100;
  const double RMIN = 0.0;
  const double RMAX = 150.0;
  const double RSTEP = 1.0;
  const double MSTEP = 0.01;

  const int maxNgal = 40000000;

  int dummy;

  char DDname[400];
  char PPname[400];
  char RRname[400];

  int i;
  int bit;
  int bittot;

  int *n;

  sprintf(DDname,argv[1]);
  sprintf(RRname,argv[2]);
  sprintf(PPname,argv[3]);

  struct galaxy * gald;
  struct galaxy * galr;

  double * DRcount;
  double * DRcount_in_place;
  gald = (struct galaxy*)malloc(maxNgal*sizeof(struct galaxy));
  galr = (struct galaxy*)malloc(maxNgal*sizeof(struct galaxy));
  DRcount = (double*)calloc(Nr*Nm,sizeof(double));
  DRcount_in_place = (double*)calloc(Nr*Nm,sizeof(double));
  struct galaxy * galpd, * galpr;
  galpd = gald;
  galpr = galr;

  DD = fopen(DDname,"r");
  RR = fopen(RRname,"r");

  double ra, dec, red, dist;
  double dd;
  int Nd = 0;
  double weight;
  double ddummy;
  int indexFKP;
  double weightFKP;
  double weight1, weight2, weight3, weight4;
  char line [2000];

  int N = 0;
  double sumW = 0;
  double sumW_in_place = 0;

  for (int i = 0; i < 0; i ++) {
  fgets (line, 2000, DD);
  printf("%s\n", line);
  }
  while (fscanf(DD,"%lf %lf %lf\n",&ra,&dec,&red) != EOF) {
    ra *= PI/180.0;
    dec *= PI/180.0;
    dist = rz(red);
    galpd->x = dist*cos(dec)*cos(ra);
    galpd->y = dist*cos(dec)*sin(ra);
    galpd->z = dist*sin(dec);
    galpd->d = dist;
//    galpd->w = weight1 * weight2;
    galpd++;
    Nd++;
  }
  fclose(DD);

  N = 0;
  for (int i = 0; i < 0; i ++) {
  fgets (line, 2000, RR);
  printf("%s\n", line);
  }
  while (fscanf(RR,"%le %le %le\n",&ra,&dec,&red) != EOF) {
    ra *= PI/180.0;
    dec *= PI/180.0;
    dist = rz(red);
    galpr->x = dist*cos(dec)*cos(ra);
    galpr->y = dist*cos(dec)*sin(ra);
    galpr->z = dist*sin(dec);
    galpr->d = dist;
//    galpr->w = weight1 * weight2;
    galpr++;
    N++;
  }
  fclose(RR);

  MPI_Init (&argc, &argv);
  int numproc;
  int totproc;
  MPI_Comm_rank (MPI_COMM_WORLD, &numproc);
  MPI_Comm_size (MPI_COMM_WORLD, &totproc);

  n = (int *) calloc(totproc + 1, sizeof(int));
  n[0] = 1;
  for (i = 1; i < totproc; i++) {
    n[i] = (int)floor(double(N)/totproc*i);
  }
  n[totproc] = N;
  bit = n[numproc];
  bittot = n[numproc + 1];

  sprintf(PPname, "%s.DR",PPname);
  double mu;
  double d1, d2, d3;
  double x1, y1, z1, x2, y2, z2, gd1, gd2, w1, w2;
  double r2, rat;
  double xb, yb, zb, db2;
  double rr;
  galpd = gald;
  int j;

  for (i = 0; i < Nd; i++) {
    x1 = galpd->x; y1 = galpd->y; z1 = galpd->z; gd1 = galpd->d; //w1 = galpd->w;
    galpr = galr + bit;
    for (j = bit; j < bittot; j++) {
       x2 = galpr->x; y2 = galpr->y; z2 = galpr->z; gd2 = galpr->d; //w2 = galpr->w;
       //sumW += w1*w2;
       sumW += 1.0;
       d1 = x1 - x2;
       d2 = y1 - y2;
       d3 = z1 - z2;
       r2 = d1*d1 + d2*d2 + d3*d3;
       if (r2 > RMAX*RMAX || r2 < RMIN*RMIN) {
	 galpr++;
         continue;
       }
       rat = gd1/gd2;
       xb = x1 + x2*rat;
       yb = y1 + y2*rat;
       zb = z1 + z2*rat;
       db2 = xb*xb + yb*yb + zb*zb;
       mu = fabs((xb*d1 + yb*d2 + zb*d3)/sqrt(r2)/sqrt(db2));
       rr = sqrt(r2);
       int binr = (int)((rr - RMIN)/RSTEP);
       int binm = (int)(mu/MSTEP);
       if (binr >= 0 && binm >= 0 && binr < Nr && binm < Nm){
         int ind = binr + Nr*binm;
//         DRcount[ind] += w1*w2;
         DRcount[ind] += 1.0;
       }
       galpr++;
    }
    galpd++;
  }
  free(gald);
  free(galr);
  free(n);

  MPI_Reduce(DRcount, DRcount_in_place, Nr*Nm, MPI_DOUBLE, MPI_SUM, 0, MPI_COMM_WORLD);
  MPI_Reduce(&sumW, &sumW_in_place, 1, MPI_DOUBLE, MPI_SUM, 0, MPI_COMM_WORLD);
  printf("weighted number = %le %d\n", sumW, numproc);
  if (numproc == 0) {
    PP = fopen(PPname,"w");
    printf("%s\n", PPname);
    fprintf(PP,"# weighted number: %lf\n",sumW_in_place);
    fprintf(PP,"# RBINS: %d\n", Nr);
    fprintf(PP,"# MBINS: %d\n", Nm);
    int k, l;
    for (k = 0; k < Nm; k++) {
      for (l = 0; l < Nr; l++) {
      fprintf(PP,"%lf ",DRcount_in_place[k*Nr + l]);
      }
      fprintf(PP,"\n");
    }
    fclose(PP);
  }

  free(DRcount);
  free(DRcount_in_place);

  MPI_Finalize ();

  return 0;
}

double f (double x, void * p) {
  double Om = 0.310;
  double ff = 2997.92458/sqrt(Om*(1.0 + x)*(1.0 + x)*(1.0 + x) + 1.0 - Om);
  return ff;
}

double rz (double red) {
  gsl_integration_workspace * w = gsl_integration_workspace_alloc(1000);
  double result, error;
  gsl_function F;
  F.function = &f;
  gsl_integration_qags(&F, 0, red, 0, 1e-7, 1000, w, &result, &error);
  gsl_integration_workspace_free (w);
  return result;
}


#ifndef FIT_GSL_H
#define FIT_GSL_H

#include <gsl/gsl_vector.h>
#include <gsl/gsl_matrix.h>

class Fit;

//! Structure for fitting data
struct FitData {
  size_t n;// number of points to be fitted (size of X, Y and sigma arrays)
  size_t p;// number of fit parameters
  double * X;// the data to be fitted (abscissae)
  double * Y; // the data to be fitted (ordinates)
  double * sigma; // the weighting data
  Fit *fitter; //pointer to the fitter object (used only for the NonLinearFit class)
};

int expd3_fdf (const gsl_vector * x, void *params, gsl_vector * f, gsl_matrix * J);
int expd3_df (const gsl_vector * x, void *params, gsl_matrix * J);
int expd3_f (const gsl_vector * x, void *params, gsl_vector * f);
double expd3_d (const gsl_vector * x, void *params);

int expd2_fdf (const gsl_vector * x, void *params, gsl_vector * f, gsl_matrix * J);
int expd2_df (const gsl_vector * x, void *params, gsl_matrix * J);
int expd2_f (const gsl_vector * x, void *params, gsl_vector * f);
double expd2_d (const gsl_vector * x, void *params);

int exp_fdf (const gsl_vector * x, void *params, gsl_vector * f, gsl_matrix * J);
int exp_df (const gsl_vector * x, void *params, gsl_matrix * J);
int exp_f (const gsl_vector * x, void *params, gsl_vector * f);
double exp_d (const gsl_vector * x, void *params);

int boltzmann_fdf (const gsl_vector * x, void *params, gsl_vector * f, gsl_matrix * J);
int boltzmann_df (const gsl_vector * x, void *params, gsl_matrix * J);
int boltzmann_f (const gsl_vector * x, void *params, gsl_vector * f);
double boltzmann_d (const gsl_vector * x, void *params);

int logistic_fdf (const gsl_vector * x, void *params, gsl_vector * f, gsl_matrix * J);
int logistic_df (const gsl_vector * x, void *params, gsl_matrix * J);
int logistic_f (const gsl_vector * x, void *params, gsl_vector * f);
double logistic_d (const gsl_vector * x, void *params);

int gauss_fdf (const gsl_vector * x, void *params, gsl_vector * f, gsl_matrix * J);
int gauss_df (const gsl_vector * x, void *params, gsl_matrix * J);
int gauss_f (const gsl_vector * x, void *params,gsl_vector * f);
double gauss_d (const gsl_vector * x, void *params);

int gauss_multi_peak_f (const gsl_vector * x, void *params, gsl_vector * f);
double gauss_multi_peak_d (const gsl_vector * x, void *params);
int gauss_multi_peak_df (const gsl_vector * x, void *params, gsl_matrix * J);
int gauss_multi_peak_fdf (const gsl_vector * x, void *params, gsl_vector * f, gsl_matrix * J);

int lorentz_multi_peak_f (const gsl_vector * x, void *params, gsl_vector * f);
double lorentz_multi_peak_d (const gsl_vector * x, void *params);
int lorentz_multi_peak_df (const gsl_vector * x, void *params, gsl_matrix * J);
int lorentz_multi_peak_fdf (const gsl_vector * x, void *params, gsl_vector * f, gsl_matrix * J);

int user_f(const gsl_vector * x, void *params, gsl_vector * f);
double user_d(const gsl_vector * x, void *params);
int user_df(const gsl_vector * x, void *params,gsl_matrix * J);
int user_fdf(const gsl_vector * x, void *params,gsl_vector * f, gsl_matrix * J);

#endif


#include <petsc.h>
#include <petscvec.h>
#include <petscmat.h>
#include <petscksp.h>
#include "del2mat.h"

#define DEL2MAT_MULT   ((void(*)(void))Del2Mat_mult)
#define DEL2MAT_DIAG   ((void(*)(void))Del2Mat_diag)

int main(int argc,char **argv)
{
  PetscInt n;
  PetscScalar h;
  Del2Mat shell;
  Mat A;
  Vec x,b;
  KSP ksp;
  PC  pc;
  /* PETSc initialization  */
  PetscInitialize(&argc, &argv, PETSC_NULL, PETSC_NULL);
  /* number of nodes in each direction
   * excluding those at the boundary */
  n = 32;
  h = 1.0/(n+1); /* grid spacing */
  /* setup linear system (shell) matrix */
  MatCreate(PETSC_COMM_SELF, &A);
  MatSetSizes(A, n*n*n, n*n*n, n*n*n, n*n*n);
  MatSetType(A, MATSHELL);
  shell.N = n;
  PetscMalloc((n+2)*(n+2)*(n+2)*sizeof(PetscScalar),&shell.F);
  PetscMemzero(shell.F, (n+2)*(n+2)*(n+2)*sizeof(PetscScalar));
  MatShellSetContext(A, (void**)&shell);
  MatShellSetOperation(A, MATOP_MULT,           DEL2MAT_MULT);
  MatShellSetOperation(A, MATOP_MULT_TRANSPOSE, DEL2MAT_MULT);
  MatShellSetOperation(A, MATOP_GET_DIAGONAL,   DEL2MAT_DIAG);
  MatSetUp(A);
  /* setup linear system vectors */
  MatCreateVecs(A, &x, &b);
  VecSet(x, 0);
  VecSet(b, 1);
  /* setup Krylov linear solver */
  KSPCreate(PETSC_COMM_SELF, &ksp);
  KSPGetPC(ksp, &pc);
  KSPSetType(ksp, KSPCG); /* use conjugate gradients */
  PCSetType(pc, PCNONE);  /* with no preconditioning */
  KSPSetFromOptions(ksp);
  /* iteratively solve linear system of equations A*x=b */
  KSPSetOperators(ksp,A,A);
  KSPSolve(ksp, b, x);
  /* scale solution vector to account for grid spacing */
  VecScale(x, h*h);
  /* free memory and destroy objects */
  PetscFree(shell.F);
  VecDestroy(&x);
  VecDestroy(&b);
  MatDestroy(&A);
  KSPDestroy(&ksp);
  /* finalize PETSc */
  PetscFinalize();
  return 0;
}


/* spmatrix/util.c
 *
 * Copyright (C) 2012, 2013, 2014, 2015, 2016, 2017, 2018 Patrick Alken
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 3 of the License, or (at
 * your option) any later version.
 *
 * This program is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 */

#include <config.h>
#include <stdlib.h>
#include <math.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_spmatrix.h>

/*
gsl_spmatrix_cumsum()

Compute the cumulative sum:

p[j] = Sum_{k=0...j-1} c[k]

0 <= j < n + 1

Alternatively,
p[0] = 0
p[j] = p[j - 1] + c[j - 1]

Inputs: n - length of input array
        c - (input/output) array of size n + 1
            on input, contains the n values c[k]
            on output, contains the n + 1 values p[j]

Return: success or error
*/

void
gsl_spmatrix_cumsum(const size_t n, int * c)
{
  int sum = 0;
  size_t k;

  for (k = 0; k < n; ++k)
    {
      int ck = c[k];
      c[k] = sum;
      sum += ck;
    }

  c[n] = sum;
}


/**
 * @file kjg_gsl.h
 * @brief Augment GSL functions
 */

#ifndef KJG_GSL_H_
#define KJG_GSL_H_

#include <gsl/gsl_matrix.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_rng.h>

/**
 * Prints the matrix tab-delimited
 * @param *stream output file pointer
 * @param *m gsl_matrix to print
 * @param *template character template for fprintf
 */

void kjg_gsl_matrix_fprintf (FILE * stream, gsl_matrix * m,
			     const char *template);

/**
 * Prints the eigenvalues and then eigenvectors below
 * @param *stream output file pointer
 * @param *eval eigenvalues
 * @param *evec eigenvectors
 * @param *template character template for fprintf */

void kjg_gsl_evec_fprintf (FILE * stream,
			   gsl_vector * eval,
			   gsl_matrix * evec, const char *template);

/**
 * Reads a matrix
 * @param *stream input file pointer
 * @param *m matrix to store
 */

void kjg_gsl_matrix_fscanf (FILE * stream, gsl_matrix * m);

/**
 * Reads an evec
 * @param *stream input file pointer
 * @param *eval eigenvalues vector
 * @param *evec eigenvectors matrix
 */

int kjg_gsl_evec_fscanf (FILE * stream, gsl_vector * eval, gsl_matrix * evec);

/**
 * Initializes random number generation.
 */

gsl_rng *kjg_gsl_rng_init ();

/**
 * Initializes the matrix with random unit gaussians
 * @param *m matrix to be set
 * @param *r random number generator
 */

void kjg_gsl_ran_ugaussian_pair (const gsl_rng * r, double x[2]);

/** Fills a matrix with unit Gaussian random variates
 * @param *r random number generator
 * @param *m matrix to be filled
 */

void kjg_gsl_ran_ugaussian_matrix (const gsl_rng * r, gsl_matrix * m);

/**
 * Normalizes the matrix so the Frobenius norm is M*N
 * @param *m matrix to normalize
 * @return if error
 */

int kjg_gsl_matrix_frobenius_normalize (gsl_matrix * m);

/**
 * Calculates the norm of a matrix
 * @param norm type of norm to return, see lapack dlange
 * @param *m matrix to find norm of
 * @return norm
 */

double kjg_gsl_dlange (const char norm, const gsl_matrix * m);

/**
 * Performs the QR decomposition on the matrix and return Q in the matrix
 * @param *m matrix to orthogonalize
 */

void kjg_gsl_matrix_QR (gsl_matrix * m);

/**
 * Calls LAPACK dgeqrf and return R and compacted Q matrix
 * @param *m input matrix
 * @param *tau see LAPACK documentation
 * @return LAPACK return
 */

int kjg_gsl_dgeqrf (gsl_matrix * m, gsl_vector * tau);

/**
 * Calls LAPACK dorgqr to extract Q matrix
 * @param *m matrix with compacted Q and will store unpacked Q
 * @param *tau see LAPACK documentation
 * @return LAPACK return
 */
int kjg_gsl_dorgqr (gsl_matrix * m, gsl_vector * tau);

/**
 * Calls LAPACK dgesvd, keeping u (in m) and s, discarding v^T
 * @param *m input matrix / where u is stored
 * @param *s entries of the diagonal matrix
 * @return LAPACK return
 */
int kjg_gsl_SVD (gsl_matrix * M, gsl_matrix * V, gsl_vector * S);

#endif /* KJG_GSL_H_ */


/*
 *  rand.h
 *  for vbHMM
 *
 *  Created by OKAMOTO Kenji, SAKO Yasushi and RIKEN
 *  Copyright 2011-2018
 *  Cellular Informatics Laboratory, Advance Science Institute, RIKEN, Japan.
 *  All rights reserved.
 *
 *  Last modified on 2018.11.26
 */

#ifndef __vbHmm__rand__
#define __vbHmm__rand__

#include <math.h>
#include <time.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_randist.h>

void initRan();
void freeRan();
double ranInRange(double, double);
double enoise(double);
double gnoise(double);
int randomInteger(int, int);

#endif /* defined(__vbHmm__rand__) */

//


/*
 * author: Achim Gaedke
 * created: May 2001
 * file: pygsl/src/ieeemodule.c
 * $Id: ieeemodule.c,v 1.7 2008/10/25 18:56:35 schnizer Exp $
 *
 */
#include <pygsl/error_helpers.h>
#include <pygsl/general_helpers.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_ieee_utils.h>
#include <gsl/gsl_errno.h>
/*
 * constants definitions
 */

typedef struct {
  char *name;
  int flag;
} const_int_names;

static const_int_names ieeeConsts[] = {
  /* used as precision argument in set_mode*/
  {"single_precision",GSL_IEEE_SINGLE_PRECISION},
  {"double_precision",GSL_IEEE_DOUBLE_PRECISION},
  {"extended_precision",GSL_IEEE_EXTENDED_PRECISION},
  /* used as round argument in set_mode*/
  {"round_to_nearest",GSL_IEEE_ROUND_TO_NEAREST},
  {"round_down",GSL_IEEE_ROUND_DOWN},
  {"round_up",GSL_IEEE_ROUND_UP},
  {"round_to_zero",GSL_IEEE_ROUND_TO_ZERO},
  /* used as exception argument in set_mode*/
  {"mask_invalid",GSL_IEEE_MASK_INVALID},
  {"mask_denormalized",GSL_IEEE_MASK_DENORMALIZED},
  {"mask_division_by_zero",GSL_IEEE_MASK_DIVISION_BY_ZERO},
  {"mask_overflow",GSL_IEEE_MASK_OVERFLOW},
  {"mask_underflow",GSL_IEEE_MASK_UNDERFLOW},
  {"mask_all",GSL_IEEE_MASK_ALL},
  {"trap_inexact",GSL_IEEE_TRAP_INEXACT},
  /* used as type in ieee_*_rep */
  {"type_nan",GSL_IEEE_TYPE_NAN},
  {"type_inf",GSL_IEEE_TYPE_INF},
  {"type_normal",GSL_IEEE_TYPE_NORMAL},
  {"type_denormal",GSL_IEEE_TYPE_DENORMAL},
  {"type_zero",GSL_IEEE_TYPE_ZERO},
  /* sentinel */
  {NULL,0}
};

static void define_const_ints(PyObject* module)
{
  int i=0;

  while (ieeeConsts[i].name!=NULL)
    {
      PyModule_AddIntConstant(module,ieeeConsts[i].name,ieeeConsts[i].flag);
      i++;
    }
  return;
}

/*
 * method definitions
 */

static PyObject*
set_mode(PyObject *self, PyObject *args)
{
  int precision=2;
  int rounding=1;
  int exception_mask=GSL_IEEE_MASK_ALL;
  int flag;
  if (!PyArg_ParseTuple(args, "|iii", &precision, &rounding,  &exception_mask))
    return NULL;

  flag = gsl_ieee_set_mode(precision, rounding, exception_mask);
  if (GSL_SUCCESS != PyGSL_error_flag(flag))
    return NULL;

  Py_INCREF(Py_None);
  return Py_None;
}

static PyObject*
env_setup(PyObject *self, PyObject *args)
{
  gsl_ieee_env_setup();
  Py_INCREF(Py_None);
  return Py_None;
}

static PyObject*
bin_repr(PyObject *self, PyObject *args)
{
  double x;
  gsl_ieee_double_rep r;
  if (!PyArg_ParseTuple(args,"d", &x))
      return NULL;
  gsl_ieee_double_to_rep(&x,&r);
  return Py_BuildValue("(isii)",r.sign,r.mantissa,r.exponent,r.type);
}

static PyObject*
ieee_isnan(PyObject *self, PyObject *arg)
{
     double tmp;
     if(PyGSL_PYFLOAT_TO_DOUBLE(arg, &tmp, NULL) != GSL_SUCCESS)
	  return NULL;
     return PyInt_FromLong(gsl_isnan(tmp));
}

static PyObject*
ieee_isinf(PyObject *self, PyObject *arg)
{
     double tmp;
     if(PyGSL_PYFLOAT_TO_DOUBLE(arg, &tmp, NULL) != GSL_SUCCESS)
	  return NULL;
     return PyInt_FromLong(gsl_isinf(tmp));

}

static PyObject*
ieee_finite(PyObject *self, PyObject *arg)
{
     double tmp;
     if(PyGSL_PYFLOAT_TO_DOUBLE(arg, &tmp, NULL) != GSL_SUCCESS)
	  return NULL;
     return PyInt_FromLong(gsl_finite(tmp));

}

static PyObject* ieee_nan(PyObject *self)
{
  return PyFloat_FromDouble(GSL_NAN);
}

static PyObject* ieee_neginf(PyObject *self)
{
  return PyFloat_FromDouble(GSL_NEGINF);
}

static PyObject* ieee_posinf(PyObject *self)
{
  return PyFloat_FromDouble(GSL_POSINF);
}

/* setup gsl mode and ieee modes from environment variable GSL_IEEE_MODE */

static const char env_setup_doc[] =
"Set the IEEE mode, the GSL library should use, using the GSL_IEEE_MODE\n\
environement variable\n\
You can also use os.environ['GSL_IEEE_MODE']='<desired_behaviour>' to\n\
set the variable\n";

static const char bin_repr_doc[] =
"takes a double and returns its  sign, mantissa, exponent and type\n";

static const char set_mode_doc[] =
"Sets the ieee float handling mode\n\
\tUsage:\n\
\tset_mode(precision, rounding, exception_mask)\n\
Each flag can be a combination of the constants defined in this module\n\
Raises  gsl_NoHardwareSupportError if support is not available.\n\
\n\
WARNING: Use with care! It can abort your programm abnormaly!";

static const char  ieee_nan_doc[] = "Returns not a number\n";
static const char  ieee_neginf_doc[] = "Returns a negative infinite\n";
static const char  ieee_posinf_doc[] = "Returns a positive infinite\n";
static PyMethodDef ieeeMethods[] = {
  {"set_mode", set_mode, METH_VARARGS, (char*)set_mode_doc},
  {"env_setup", env_setup, METH_NOARGS,  (char *)env_setup_doc},
  {"bin_repr", bin_repr, METH_VARARGS, NULL},
  /* tests on special IEEE-FP meanings */
  {"isnan",ieee_isnan,METH_O, NULL},
  {"isinf",ieee_isinf,METH_O, NULL},
  {"finite",ieee_finite,METH_O, NULL},
  /* some special ieee-numbers */
  {"nan",(PyCFunction)ieee_nan, METH_NOARGS, (char *)ieee_nan_doc},
  {"neginf",(PyCFunction)ieee_neginf, METH_NOARGS, (char *)ieee_neginf_doc},
  {"posinf",(PyCFunction)ieee_posinf, METH_NOARGS, (char *)ieee_posinf_doc},
  {NULL,     NULL}        /* Sentinel */
};

DL_EXPORT(void) initieee(void)
{
  PyObject* m;

  m=Py_InitModule("ieee", ieeeMethods);
  init_pygsl();
  define_const_ints(m);

  return;
}


/*
* -----------------------------------------------------------------
*  In Situ Adaptive Tabulation Library --- isat_lib.h
*  Version: 1.6180
*  Date: Feb 25, 2010
* -----------------------------------------------------------------
*  Programmer: Americo Barbosa da Cunha Junior
*              americo.cunhajr@gmail.com
* -----------------------------------------------------------------
*  Copyright (c) 2010 by Americo Barbosa da Cunha Junior
*
*  This program is free software: you can redistribute it and/or
*  modify it under the terms of the GNU General Public License as
*  published by the Free Software Foundation, either version 3 of
*  the License, or (at your option) any later version.
*
*  This program is distributed in the hope that it will be useful,
*  but WITHOUT ANY WARRANTY; without even the implied warranty of
*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
*  GNU General Public License for more details.
*
*  A copy of the GNU General Public License is available in
*  LICENSE.txt or http://www.gnu.org/licenses/.
* -----------------------------------------------------------------
*  This is the header file for a library
*  with the ISAT algorithm.
* -----------------------------------------------------------------
*/

#ifndef __ISAT_LIB_H__
#define __ISAT_LIB_H__

#include <gsl/gsl_blas.h>
#include <gsl/gsl_math.h>

#include "../include/bst_lib.h"

#undef  RTOL
#define RTOL 1.0e-6

#undef  ATOL
#define ATOL 1.0e-9

/*
*------------------------------------------------------------
*   structure of ISAT workspace
*
*   last update: Jul 13, 2010
*------------------------------------------------------------
*/

typedef struct isat_struct
{
    bst_node *root;         /* binary search tree root      */
    unsigned int lf;        /* # of leaves                  */
    unsigned int nd;        /* # of nodes                   */
    unsigned int add;       /* # of adds                    */
    unsigned int grw;       /* # of grows                   */
    unsigned int rtv;       /* # of retrieves               */
    unsigned int dev;       /* # of discarted evaluations   */
    unsigned int hgt;       /* tree height                  */
    unsigned int max_lf;    /* maximum value of tree leaves */
    clock_t time_add;       /* cpu clock spent by additions */
    clock_t time_grw;       /* cpu clock spent by growths   */
    clock_t time_rtv;       /* cpu clock spent by retrieves */
    clock_t time_dev;       /* cpu clock spent by dev       */

} isat_wrk;
/*------------------------------------------------------------*/

/*
*------------------------------------------------------------
* function prototypes
*------------------------------------------------------------
*/

isat_wrk *isat_alloc();

void isat_free(void **isat_bl);

int isat_set(isat_wrk *isat);

void isat_statistics(isat_wrk *isat);

int isat_input(unsigned int *max_lf,
               double *etol,
               double *n0);

void isat_eoa_mtrx(gsl_matrix *A,
                   double etol,
                   double n0,
                   gsl_matrix *L);

double isat_lerror(gsl_vector *Rphi,
                   gsl_vector *Rphi0,
		           gsl_matrix *A,
                   gsl_vector *phi,
                   gsl_vector *phi0);

int isat4(isat_wrk *isat,
          void *thrm_data,
          void *cvode_mem,
          double etol,
          double n0,
          double t0,
          double delta_t,
          gsl_vector *phi,
          gsl_matrix *A,
          gsl_matrix *L,
          gsl_vector *Rphi);

#endif /* __ISAT_LIB_H__ */


/*
 * Copyright (C) 2015  University of Oregon
 *
 * You may distribute under the terms of either the GNU General Public
 * License or the Apache License, as specified in the LICENSE file.
 *
 * For more information, see the LICENSE file.
 */
#ifndef VNMRFDIST_H
#define VNMRFDIST_H

#ifdef VNMR_GPL
#include <gsl/gsl_cdf.h>
#define f_distribution(f,n1,n2) gsl_cdf_fdist_P( (f), (n1), (n2) )

#else

extern double f_distribution(double f, double n1, double n2);
#endif

#endif