// Copyright (c) 2005 - 2009 Marc de Kamps, Dave Harrison
// All rights reserved.
//
// Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
//
//    * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
//    * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation
//      and/or other materials provided with the distribution.
//    * Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software
//      without specific prior written permission.
//
// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
// WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY
// DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
// USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
// NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
//
//      If you use this software in work leading to a scientific publication, you should cite
//      the 'currently valid reference', which can be found at http://miind.sourceforge.net
#ifndef _CODE_LIBS_NUMTOOLSLIB_INTERPOLATION_INCLUDE_GUARD
#define _CODE_LIBS_NUMTOOLSLIB_INTERPOLATION_INCLUDE_GUARD
// Date:   9-02-2009
// Author: Dave Harrison

#include <valarray>
#include <utility>
#include <gsl/gsl_interp.h>

namespace NumtoolsLib
{
    //! Define types of interpolation
    enum InterpType
    {
        INTERP_LINEAR,
        INTERP_CSPLINE,
        INTERP_AKIMA
    };

    class Interpolator
    {
        public:
            /*!
             Interpolator object to wrap GSL interpolation functions
             interp_type Type of Interpolation to use: INTERP_LINEAR/_CSPLINE/_AKIMA
             xs Array of x values
             ys array of y values
             Throws NumtoolsException on GSL error
             */
            Interpolator(const InterpType interp_type, const std::valarray<double>& xs,
                    const std::valarray<double>& ys);

            ~Interpolator();

            /*!
             Retrieve an interpolated y value for position x
             Throws NumtoolsLibException on error
             */
            double InterpValue(const double x);

        private:
            //! The accelerator object
            gsl_interp_accel*		_acc;
            //! The interpolation object
            gsl_interp*				_interp;
            //! The x values
            std::valarray<double>& _x;
            //! The y values
            std::valarray<double>& _y;
            //! The size of the x & y arrays
            const size_t			_size;
    };
}

#endif // include guard


// Copyright 2012 Jesse Windle - jesse.windle@gmail.com

// 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, see
// <http://www.gnu.org/licenses/>.

/*********************************************************************

  This class wraps GSL's random number generator and random
  distribution functions into a class.  We use the Mersenne Twister
  for random number generation since it has a large period, which is
  what we want for MCMC simulation.

  When compiling include -lgsl -lcblas -llapack .

*********************************************************************/

#ifndef __BASICRNG__
#define __BASICRNG__

#include <stdio.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_randist.h>
#include <gsl/gsl_cdf.h>
#include <gsl/gsl_sf.h>

#include <iostream>
#include <fstream>
#include <ctime>
#include <string>
#include <cmath>

using std::string;
using std::ofstream;
using std::ifstream;

//////////////////////////////////////////////////////////////////////
			      // RNG //
//////////////////////////////////////////////////////////////////////

class BasicRNG {

 protected:

  gsl_rng * r;

 public:

  // Constructors and destructors.
  BasicRNG(unsigned long seed);

  virtual ~BasicRNG()
    { gsl_rng_free (r); }

  // Assignment=
  BasicRNG& operator=(const BasicRNG& rng);

  // Read / Write / Set
  bool read (const string& filename);
  bool write(const string& filename);
  void set(unsigned long seed);

  // Get rng -- be careful.  Needed for other random variates.
  gsl_rng* getrng() { return r; }

  // Random variates.
  double unif  ();                             // Uniform
  double expon_mean(double mean);     // Exponential
  double expon_rate(double rate);                  // Exponential
  double chisq (double df);                    // Chisq
  double norm  (double sd);                    // Normal
  double norm  (double mean , double sd);      // Normal
  double gamma_scale (double shape, double scale); // Gamma_Scale
  double gamma_rate  (double shape, double rate);  // Gamma_Rate
  double igamma(double shape, double scale);   // Inv-Gamma
  double flat  (double a=0  , double b=1  );   // Flat
  double beta  (double a=1.0, double b=1.0);   // Beta

  int bern  (double p);                     // Bernoulli

  // CDF
  static double p_norm (double x, int use_log=0);
  static double p_gamma_rate(double x, double shape, double rate, int use_log=0);

  // Density
  static double d_beta(double x, double a, double b);

  // Utility
  static double Gamma (double x, int use_log=0);

}; // BasicRNG

#endif

////////////////////////////////////////////////////////////////////////////////
				 // APPENDIX //
////////////////////////////////////////////////////////////////////////////////

// If you make everything inline within the same translation unit then that
// function will not be callable from anohter translation unit.  You can see
// that the function is missing by using the nm command.


/**
 *
 * @file core_ssetvar.c
 *
 *  PLASMA core_blas kernel
 *  PLASMA is a software package provided by Univ. of Tennessee,
 *  Univ. of California Berkeley and Univ. of Colorado Denver
 *
 * @version 2.6.0
 * @author Mark Gates
 * @date 2010-11-15
 * @generated s Tue Jan  7 11:44:49 2014
 *
 **/
#include <lapacke.h>
#include "common.h"

/***************************************************************************//**
 *
 * @ingroup CORE_float
 *
 * CORE_ssetvar sets a single variable, x := alpha.
 *
 *******************************************************************************
 *
 * @param[in] alpha
 *         Scalar to set x to, passed by pointer so it can depend on runtime value.
 *
 * @param[out] x
 *         On exit, x = alpha.
 *
 ******************************************************************************/
#if defined(PLASMA_HAVE_WEAK)
#pragma weak CORE_ssetvar = PCORE_ssetvar
#define CORE_ssetvar PCORE_ssetvar
#endif
void CORE_ssetvar(const float *alpha, float *x)
{
    *x = *alpha;
}


/**
 *
 * @file core_dsetvar.c
 *
 *  PLASMA core_blas kernel
 *  PLASMA is a software package provided by Univ. of Tennessee,
 *  Univ. of California Berkeley and Univ. of Colorado Denver
 *
 * @version 2.6.0
 * @author Mark Gates
 * @date 2010-11-15
 * @generated d Tue Jan  7 11:44:49 2014
 *
 **/
#include <lapacke.h>
#include "common.h"

/***************************************************************************//**
 *
 * @ingroup CORE_double
 *
 * CORE_dsetvar sets a single variable, x := alpha.
 *
 *******************************************************************************
 *
 * @param[in] alpha
 *         Scalar to set x to, passed by pointer so it can depend on runtime value.
 *
 * @param[out] x
 *         On exit, x = alpha.
 *
 ******************************************************************************/
#if defined(PLASMA_HAVE_WEAK)
#pragma weak CORE_dsetvar = PCORE_dsetvar
#define CORE_dsetvar PCORE_dsetvar
#endif
void CORE_dsetvar(const double *alpha, double *x)
{
    *x = *alpha;
}


/*
* -----------------------------------------------------------------
*  Utilities Library --- util_lib.h
*  Version: 1.6180
*  Date: Feb 19, 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 miscelaneous
*  functions witch have a lot of applications.
* -----------------------------------------------------------------
*/

#ifndef __UTIL_LIB_H__
#define __UTIL_LIB_H__

#include <time.h>

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

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

int gsl_fprint_vector(FILE* file,
                      gsl_vector *v);

int gsl_print_vector(gsl_vector *v);

int gsl_print_matrix_line(unsigned int i,
                          gsl_matrix *M);

int gsl_print_matrix_column(unsigned int j,
                            gsl_matrix *M);

int gsl_print_matrix(gsl_matrix *M);

int gsl_rand_vector(gsl_rng *r,
                    gsl_vector *v);

int gsl_rand_matrix(gsl_rng *r,
                    gsl_matrix *M);

int gsl_diagonal_matrix(gsl_vector *v,
                        gsl_matrix *D);

void util_time_used(clock_t cpu_start,
                    clock_t cpu_end,
			        time_t wall_start,
                    time_t wall_end);

#endif /* __UTIL_LIB_H__ */


/**
 *
 * @file qwrapper_zlacpy.c
 *
 *  PLASMA core_blas quark wrapper
 *  PLASMA is a software package provided by Univ. of Tennessee,
 *  Univ. of California Berkeley and Univ. of Colorado Denver
 *
 * @version 2.6.0
 * @author Julien Langou
 * @author Henricus Bouwmeester
 * @author Mathieu Faverge
 * @date 2010-11-15
 * @precisions normal z -> c d s
 *
 **/
#include <lapacke.h>
#include "common.h"

/***************************************************************************//**
 *
 **/
void QUARK_CORE_zlacpy(Quark *quark, Quark_Task_Flags *task_flags,
                       PLASMA_enum uplo, int m, int n, int nb,
                       const PLASMA_Complex64_t *A, int lda,
                       PLASMA_Complex64_t *B, int ldb)
{
    DAG_CORE_LACPY;
    QUARK_Insert_Task(quark, CORE_zlacpy_quark, task_flags,
        sizeof(PLASMA_enum),                &uplo,  VALUE,
        sizeof(int),                        &m,     VALUE,
        sizeof(int),                        &n,     VALUE,
        sizeof(PLASMA_Complex64_t)*nb*nb,    A,             INPUT,
        sizeof(int),                        &lda,   VALUE,
        sizeof(PLASMA_Complex64_t)*nb*nb,    B,             OUTPUT,
        sizeof(int),                        &ldb,   VALUE,
        0);
}

/***************************************************************************//**
 *
 **/
#if defined(PLASMA_HAVE_WEAK)
#pragma weak CORE_zlacpy_quark = PCORE_zlacpy_quark
#define CORE_zlacpy_quark PCORE_zlacpy_quark
#endif
void CORE_zlacpy_quark(Quark *quark)
{
    PLASMA_enum uplo;
    int M;
    int N;
    const PLASMA_Complex64_t *A;
    int LDA;
    PLASMA_Complex64_t *B;
    int LDB;

    quark_unpack_args_7(quark, uplo, M, N, A, LDA, B, LDB);
    LAPACKE_zlacpy_work(
        LAPACK_COL_MAJOR,
        lapack_const(uplo),
        M, N, A, LDA, B, LDB);
}

/***************************************************************************//**
 *
 **/
void QUARK_CORE_zlacpy_f1(Quark *quark, Quark_Task_Flags *task_flags,
                          PLASMA_enum uplo, int m, int n, int nb,
                          const PLASMA_Complex64_t *A, int lda,
                          PLASMA_Complex64_t *B, int ldb,
                          PLASMA_Complex64_t *fake1, int szefake1, int flag1)
{
    DAG_CORE_LACPY;
    if ( fake1 == B ) {
        QUARK_Insert_Task(quark, CORE_zlacpy_quark, task_flags,
            sizeof(PLASMA_enum),                &uplo,  VALUE,
            sizeof(int),                        &m,     VALUE,
            sizeof(int),                        &n,     VALUE,
            sizeof(PLASMA_Complex64_t)*nb*nb,    A,             INPUT,
            sizeof(int),                        &lda,   VALUE,
            sizeof(PLASMA_Complex64_t)*nb*nb,    B,             OUTPUT | flag1,
            sizeof(int),                        &ldb,   VALUE,
            0);
    }
    else {
        QUARK_Insert_Task(quark, CORE_zlacpy_f1_quark, task_flags,
            sizeof(PLASMA_enum),                &uplo,  VALUE,
            sizeof(int),                        &m,     VALUE,
            sizeof(int),                        &n,     VALUE,
            sizeof(PLASMA_Complex64_t)*nb*nb,    A,             INPUT,
            sizeof(int),                        &lda,   VALUE,
            sizeof(PLASMA_Complex64_t)*nb*nb,    B,             OUTPUT,
            sizeof(int),                        &ldb,   VALUE,
            sizeof(PLASMA_Complex64_t)*szefake1, fake1,         flag1,
            0);
    }
}

/***************************************************************************//**
 *
 **/
#if defined(PLASMA_HAVE_WEAK)
#pragma weak CORE_zlacpy_f1_quark = PCORE_zlacpy_f1_quark
#define CORE_zlacpy_f1_quark PCORE_zlacpy_f1_quark
#endif
void CORE_zlacpy_f1_quark(Quark *quark)
{
    PLASMA_enum uplo;
    int M;
    int N;
    const PLASMA_Complex64_t *A;
    int LDA;
    PLASMA_Complex64_t *B;
    int LDB;
    void *fake1;

    quark_unpack_args_8(quark, uplo, M, N, A, LDA, B, LDB, fake1);
    LAPACKE_zlacpy_work(
        LAPACK_COL_MAJOR,
        lapack_const(uplo),
        M, N, A, LDA, B, LDB);
}


/**
 *
 * @file core_zsetvar.c
 *
 *  PLASMA core_blas kernel
 *  PLASMA is a software package provided by Univ. of Tennessee,
 *  Univ. of California Berkeley and Univ. of Colorado Denver
 *
 * @version 2.6.0
 * @author Mark Gates
 * @date 2010-11-15
 * @precisions normal z -> c d s
 *
 **/
#include <lapacke.h>
#include "common.h"

/***************************************************************************//**
 *
 * @ingroup CORE_PLASMA_Complex64_t
 *
 * CORE_zsetvar sets a single variable, x := alpha.
 *
 *******************************************************************************
 *
 * @param[in] alpha
 *         Scalar to set x to, passed by pointer so it can depend on runtime value.
 *
 * @param[out] x
 *         On exit, x = alpha.
 *
 ******************************************************************************/
#if defined(PLASMA_HAVE_WEAK)
#pragma weak CORE_zsetvar = PCORE_zsetvar
#define CORE_zsetvar PCORE_zsetvar
#endif
void CORE_zsetvar(const PLASMA_Complex64_t *alpha, PLASMA_Complex64_t *x)
{
    *x = *alpha;
}


/**
 *
 * @file core_csetvar.c
 *
 *  PLASMA core_blas kernel
 *  PLASMA is a software package provided by Univ. of Tennessee,
 *  Univ. of California Berkeley and Univ. of Colorado Denver
 *
 * @version 2.6.0
 * @author Mark Gates
 * @date 2010-11-15
 * @generated c Tue Jan  7 11:44:49 2014
 *
 **/
#include <lapacke.h>
#include "common.h"

/***************************************************************************//**
 *
 * @ingroup CORE_PLASMA_Complex32_t
 *
 * CORE_csetvar sets a single variable, x := alpha.
 *
 *******************************************************************************
 *
 * @param[in] alpha
 *         Scalar to set x to, passed by pointer so it can depend on runtime value.
 *
 * @param[out] x
 *         On exit, x = alpha.
 *
 ******************************************************************************/
#if defined(PLASMA_HAVE_WEAK)
#pragma weak CORE_csetvar = PCORE_csetvar
#define CORE_csetvar PCORE_csetvar
#endif
void CORE_csetvar(const PLASMA_Complex32_t *alpha, PLASMA_Complex32_t *x)
{
    *x = *alpha;
}


/*
 *  specialfunctionsmodule.h
 *
 *  This file is part of NEST.
 *
 *  Copyright (C) 2004 The NEST Initiative
 *
 *  NEST 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.
 *
 *  NEST 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 NEST.  If not, see <http://www.gnu.org/licenses/>.
 *
 */

#ifndef SPECIALFUNCTIONSMODULE_H
#define SPECIALFUNCTIONSMODULE_H
/*
    SLI Module implementing functions from the GNU Science Library.
    The GSL is available from sources.redhat.com/gsl.
*/

/*
    NOTE: Special functions are available only if the GSL is installed.
          If no GSL is available, calling special functions will result
          in a SLI error message.  HEP 2002-09-19.
*/

// Generated includes:
#include "config.h"

// Includes from sli:
#include "slifunction.h"
#include "slimodule.h"

#ifdef HAVE_GSL
// External include:
#include <gsl/gsl_integration.h>
#endif

// NOTE: all gsl headers are included in specialfunctionsmodule.cc

class SpecialFunctionsModule : public SLIModule
{

  // Part 1: Methods pertaining to the module ----------------------

public:
  SpecialFunctionsModule( void ){};
  // ~SpecialFunctionsModule(void);

  // The Module is registered by a call to this Function:
  void init( SLIInterpreter* );

  // This function will return the name of our module:
  const std::string name( void ) const;

  // Part 2: Classes for the implemented functions -----------------

public:
  /**
   * Classes which implement the GSL Funktions.
   * These must be public, since we want to export
   * objects of these.
   */
  class GammaIncFunction : public SLIFunction
  {
  public:
    GammaIncFunction()
    {
    }
    void execute( SLIInterpreter* ) const;
  };
  class LambertW0Function : public SLIFunction
  {
  public:
    LambertW0Function()
    {
    }
    void execute( SLIInterpreter* ) const;
  };
  class LambertWm1Function : public SLIFunction
  {
  public:
    LambertWm1Function()
    {
    }
    void execute( SLIInterpreter* ) const;
  };

  class ErfFunction : public SLIFunction
  {
  public:
    ErfFunction()
    {
    }
    void execute( SLIInterpreter* ) const;
  };

  class ErfcFunction : public SLIFunction
  {
  public:
    ErfcFunction()
    {
    }
    void execute( SLIInterpreter* ) const;
  };

  class GaussDiskConvFunction : public SLIFunction
  {
  public:
    void execute( SLIInterpreter* ) const;

    // need constructor and destructor to set up integration workspace
    GaussDiskConvFunction( void );
    ~GaussDiskConvFunction( void );

  private:
    // quadrature parameters, see GSL Reference
    static const int MAX_QUAD_SIZE;
    static const double QUAD_ERR_LIM;
    static const double QUAD_ERR_SCALE;

// integration workspace
#ifdef HAVE_GSL
    gsl_integration_workspace* w_;

    /**
     * Integrand function.
     * @note This function must be static with C linkage so that it can
     *       be passed to the GSL. Alternatively, one could define it
     *       outside the class.
     */
    static double f_( double, void* );
    static gsl_function F_; // GSL wrapper struct for it
#endif
  };

  // Part 3: One instatiation of each new function class -----------

public:
  const GammaIncFunction gammaincfunction;
  const LambertW0Function lambertw0function;
  const LambertWm1Function lambertwm1function;
  const ErfFunction erffunction;
  const ErfcFunction erfcfunction;
  const GaussDiskConvFunction gaussdiskconvfunction;

  // Part 3b: Internal variables
private:
};

// Part 4: Documentation for all functions -------------------------

/* BeginDocumentation

Name: Gammainc - incomplete gamma function

Synopsis: x a Gammainc -> result

Description: Computes the incomplete Gamma function
             int(t^(a-1)*exp(-t), t=0..x) / Gamma(a)

Parameters:  x      (double): upper limit of integration
             a      (double): order of Gamma function

Examples: 2.2 1.5 Gammainc -> 0.778615

Author: H E Plesser

FirstVersion: 2001-07-26

Remarks: This is the incomplete Gamma function P(a,x) defined as no. 6.5.1
         in Abramowitz&Stegun.  Requires the GSL.

References: http://sources.redhat.com/gsl/ref
*/

/* BeginDocumentation

Name: Erf - error function

Synopsis: x Erf -> result

Description: Computes the error function
             erf(x) = 2/sqrt(pi) int_0^x dt exp(-t^2)

Parameters:  x (double): error function argument

Examples: 0.5 erf -> 0.5205

Author: H E Plesser

FirstVersion: 2001-07-30

Remarks: Requires the GSL.

References: http://sources.redhat.com/gsl/ref

SeeAlso: Erfc
*/

/* BeginDocumentation

Name: Erfc - complementary error function

Synopsis: x Erfc -> result

Description: Computes the error function
             erfc(x) = 1 - erf(x) = 2/sqrt(pi) int_x^inf dt exp(-t^2)

Parameters:  x (double): error function argument

Examples: 0.5 erfc -> 0.4795

Author: H E Plesser

FirstVersion: 2001-07-30

Remarks: Requires the GSL.

References: http://sources.redhat.com/gsl/ref

SeeAlso: Erf
*/

/* BeginDocumentation

Name:GaussDiskConv - Convolution of a Gaussian with an excentric disk

Synopsis:R r0 GaussDiskConv -> result

Description:Computes the convolution of an excentric normalized Gaussian
with a disk

       C[R, r0] = IInt[ disk(rvec; R) * Gauss(rvec - r_0vec) d^2rvec ]
                = 2 Int[ r Exp[-r0^2-r^2] I_0[2 r r_0] dr, r=0..R]

Parameters:R   radius of the disk, centered at origin
r0  distance of Gaussian center from origin

Examples:SLI ] 3.2 2.3 GaussDiskConv =
0.873191

Author:H E Plesser

FirstVersion: 2002-07-12

Remarks:This integral is needed to compute the response of a DOG model to
 excentric light spots, see [1].  For technicalities, see [2].  Requires GSL.

References: [1] G. T. Einevoll and P. Heggelund, Vis Neurosci 17:871-885 (2000).
 [2] Hans E. Plesser, Convolution of an Excentric Gaussian with a Disk,
     Technical Report, arken.nlh.no/~itfhep, 2002

*/

#endif


/******************************************************************************
 * gsl_sprng.h: rewrite of gsl-sprng.h to use sprng streams                   *
 * Author: Yan Y. Liu <yanliu@illinois.edu>                                   *
 * Date: 2014/08/17                                                           *
 * Copyright and license of this source file are specified in LICENSE.TXT     *
 * under the root directory of this software package.                         *
 ******************************************************************************/

/*
 * gsl-sprng.h: rewrite of gsl-sprng.h to use sprng streams
 *
 * This header file is based on  Darren Wilkinson's version for simple interface,
 * which does not use streams. We also refer to IceCube's C++ extension based on
 * sprng 4.0.
 *
 * Darren Wilkinson  http://www.staff.ncl.ac.uk/d.j.wilkinson/
 * IceCube project: http://icecube.wisc.edu/
 *
 * To use, just add the line:
 * #include "gsl-sprng.h"
 * immediately after the line:
 * #include <gsl/gsl_rng.h>
 * near the start of your code.
 * Make sure you alloc the rng on each processor. If you wish to
 * set a seed, you should set it to be the same on each processor.
 */

#ifndef GSL_SPRNG_H
#define GSL_SPRNG_H

#define USE_MPI
#include "sprng.h"

/***************************/
/* gsl definition of sprng */
/***************************/

typedef struct
{
    int streamnum;
    int nstreams;
    int seed;
    int *stream;
} gsl_sprng_state_t;

/* seed is gsl_rng_default_seed
 * either 0 by default or GSL_RNG_SEED environment variable
 */
void sprng_set(void * vstate, unsigned long int seed);
/* the get() function to get integer random number */
unsigned long sprng_get(void * vstate);
/* the get() function to get double random number */
double sprng_get_double(void * vstate);

/***************************/
/*      gsl_sprng API      */
/***************************/
/* replace all gsl_rng_* func with corresponding one below */

/* initialize gsl_rng */
gsl_rng *gsl_sprng_alloc (int streamnum, int nstreams, int seed, int * stream);
/* finalize gsl_rng */
void gsl_sprng_free (gsl_rng * r);
/* print out gsl_rng stream info for debug purpose */
void gsl_sprng_print (gsl_rng * r);
/* load gsl_rng from a file */
int gsl_sprng_fread (char * fpath, gsl_rng * r);
/* store gsl_rng to a file */
int gsl_sprng_fwrite (char * fpath, const gsl_rng * r);
#endif


/* Siconos-Numerics, Copyright INRIA 2005-2018.
 * Siconos is a program dedicated to modeling, simulation and control
 * of non smooth dynamical systems.
 * Siconos is a 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 of the License, or
 * (at your option) any later version.
 * Siconos 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 Siconos; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
 *
 * Contact: Vincent ACARY, siconos-team@lists.gforge.inria.fr
 */

#ifndef SiconosBlas_H
#define SiconosBlas_H
#include "SiconosConfig.h"

#if defined(__cplusplus)
extern "C"
{
#endif

// tells include-what-you-use to keep this file
// and not to suggest cblas.h or alike.
// IWYU pragma: begin_exports
#if defined(HAS_MKL_CBLAS)
#include <mkl_cblas.h>
#elif defined(HAS_MATLAB_BLAS)
#include <blas.h>
#define cblas_daxpy daxpy
#define cblas_dcopy dcopy
#define cblas_ddot ddot
#define cblas_dgemm dgemm
#define cblas_dgemv dgemv
#define cblas_dnrm2 dnrm2
#define cblas_dscal dscal
#else
#include <cblas.h>
#endif
// IWYU pragma: end_exports

#ifdef __cplusplus
}
#undef restrict
#define restrict __restrict
#endif

static inline double* NMD_row_rmajor(double* restrict mat, unsigned ncols, unsigned rindx)
{
  return &mat[rindx*ncols];
}

static inline void NMD_copycol_rmajor(int nrows, double* col, double* restrict mat, int ncols, unsigned cindx)
{
  cblas_dcopy(nrows, col, 1, &mat[cindx], ncols);
}

static inline void NMD_dense_gemv(int nrows, int ncols, double alpha, double* restrict mat, double* restrict y, double beta, double* restrict x)
{
  cblas_dgemv(CblasColMajor, CblasTrans, ncols, nrows, alpha, mat, ncols, y, 1, beta, x, 1);
}

#endif // SiconosBlas_H


#include <petsc.h>

#undef __FUNCT__
#define __FUNCT__ "main"
int main(int argc,char **args)
{

  PetscErrorCode ierr;

  PetscInitialize(&argc,&args,(char*)0,(char*)0);

  ierr = PetscPrintf(PETSC_COMM_WORLD," === Hello from Petsc! ===\n");CHKERRQ(ierr);

  ierr = PetscFinalize();

  return 0;
}


/* bcls.c
   $Revision: 282 $ $Date: 2006-12-17 17:38:00 -0800 (Sun, 17 Dec 2006) $

   ---------------------------------------------------------------------
   This file is part of BCLS (Bound-Constrained Least Squares).

   Copyright (C) 2006 Michael P. Friedlander, Department of Computer
   Science, University of British Columbia, Canada. All rights
   reserved. E-mail: <mpf@cs.ubc.ca>.

   BCLS 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.

   BCLS 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 BCLS; if not, write to the Free Software
   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301
   USA
   ---------------------------------------------------------------------
*/
/*!
  \file
  BCLS user-callable library routines.
*/

#include <cblas.h>
#include <stdlib.h>
#include <stdio.h>
#include <float.h>
#include <math.h>
#include <assert.h>
#include <setjmp.h>

#include "bcls.h"
#include "bclib.h"
#include "bcsolver.h"
#include "bcversion.h"

/*!

  \brief Malloc wrapper.  Private to this file.

  Pointer to the newly allocated memory,
  or NULL if malloc returned an eror.

  \param[in]  len   Number of elements needed
  \param[in]  size  Memory needed for each element.
  \param[in]  who   Short character description of the memory needed.

  \return Pointer to the newly allocated memory.

*/
static void *
xmalloc (int len, size_t size, char * who)
{
    register void *value = malloc(len * size);
    if (value == NULL)
	fprintf( stderr, "Not enough memory to allocate %s.\n", who );
    return value;
}

/*!

  \brief Create a BCLS problem instance.

  This routine create a BCLS problem.  It *must* be called before any
  other BCLS routine.  It will create and initialize a new BCLS
  problem with enough space to accomodate the specified problem.  The
  problem is then initialized using bcls_init_prob.

  In order to re-initialize the BCLS problem instance, but not
  deallocate memory that's already sufficient for an equal or smaller
  size problem, use bcls_init_prob.

  \param[in] mmax  Maximum number of rows    in any A.
  \param[in] nmax  Maximum number of columns in any A.

  \return Return a pointer to a new BCLS problem.  If the return is
  NULL, then the initialization failed.

*/
BCLS *
bcls_create_prob( int mmax, int nmax )
{
    int mnmax = imax( nmax, mmax );

    assert( mmax > 0 && nmax > 0 );

    // Allocate the problem.
    BCLS *ls = (BCLS *)xmalloc(1, sizeof(BCLS), "ls" );

    // Check if the problem has been successfully allocated.
    if (ls == NULL) {
	fprintf( stderr, "XXX Could not allocate a BCLS problem.\n");
	return ls;
    }

    // -----------------------------------------------------------------
    // Allocate workspace vectors large enough to accomdate the problem.
    // -----------------------------------------------------------------

    // Record the maximum alloted workspace.
    ls->mmax = mmax;
    ls->nmax = nmax;

    // Residual: r(m+n).
    ls->r = (double *)xmalloc( mmax+nmax, sizeof(double), "r" );
    if (ls->r == NULL) goto error;

    // Gradient: g(n).
    ls->g = (double *)xmalloc( nmax, sizeof(double), "g" );
    if (ls->g == NULL) goto error;

    // Search direction, full space: dx(n).
    ls->dx = (double *)xmalloc( nmax, sizeof(double), "dx" );
    if (ls->dx == NULL) goto error;

    // Search direction, subspace: dxFree(n).
    ls->dxFree = (double *)xmalloc( nmax, sizeof(double), "dxFree" );
    if (ls->dxFree == NULL) goto error;

    // Step to each breakpoint: aBreak(n).
    ls->aBreak = (double *)xmalloc( nmax, sizeof(double), "aBreak" );
    if (ls->aBreak == NULL) goto error;

    // Indices of each breakpoint: iBreak(n).
    ls->iBreak = (int *)xmalloc( nmax, sizeof(int), "iBreak" );
    if (ls->iBreak == NULL) goto error;

    // Variable indices: ix(n).
    ls->ix = (int *)xmalloc( nmax, sizeof(int), "ix" );
    if (ls->ix == NULL) goto error;

    // Workspace: wrk_v( max(n, m) ).
    ls->wrk_u = (double *)xmalloc( mnmax, sizeof(double), "wrk_u" );
    if (ls->wrk_u == NULL) goto error;

    // Workspace: wrk_v( max(n, m) ).
    ls->wrk_v = (double *)xmalloc( mnmax, sizeof(double), "wrk_v" );
    if (ls->wrk_v == NULL) goto error;

    // Workspace: wrk_w( max(n, m) ).
    ls->wrk_w = (double *)xmalloc( mnmax, sizeof(double), "wrk_w" );
    if (ls->wrk_w == NULL) goto error;

    // -----------------------------------------------------------------
    // Initialize this new problem instance.
    // -----------------------------------------------------------------
    bcls_init_prob( ls );

    // -----------------------------------------------------------------
    // Exits.
    // -----------------------------------------------------------------

    // Successfull exit.
    return ls;

 error:
    // Unsuccessful exit.
    bcls_free_prob( ls );
    return ls;
}

/*!

  \brief Initialize a BCLS problem.

  Initialize a BCLS problem.  You can call this routine to "reset" a
  BCLS problem, i.e., reset all parameter values.  Note that it is
  automatically called by bcls_create_prob.

  \param[in,out] ls  BCLS problem context.

*/
void
bcls_init_prob( BCLS *ls )
{
    // Some quick error checking.
    assert( ls->mmax > 0 && ls->nmax > 0 );

    // Check if the problem has been successfully allocated.
    if (ls == NULL) {
	fprintf( stderr, "XXX The BCLS problem is NULL.\n");
	return;
    }

    // Initialize the problem structure.
    ls->print_info    =  NULL;
    ls->print_hook    =  NULL;
    ls->fault_info    =  NULL;
    ls->fault_hook    =  NULL;
    ls->Aprod         =  NULL;
    ls->Usolve        =  NULL;
    ls->CallBack      =  NULL;
    ls->UsrWrk        =  NULL;
    ls->anorm         =  NULL;
    ls->print_level   =  1;
    ls->proj_search   =  BCLS_PROJ_SEARCH_EXACT;
    ls->newton_step   =  BCLS_NEWTON_STEP_LSQR;
    ls->minor_file    =  NULL;
    ls->itnMaj        =  0;
    ls->itnMajLim     =  5  * (ls->nmax);
    ls->itnMin        =  0;
    ls->itnMinLim     =  10 * (ls->nmax);
    ls->nAprodT       =  0;
    ls->nAprodF       =  0;
    ls->nAprod1       =  0;
    ls->nUsolve       =  0;
    ls->m             =  0;
    ls->n             =  0;
    ls->unconstrained =  0;
    ls->damp          =  0.0;
    ls->damp_min      =  1.0e-4;
    ls->exit          =  BCLS_EXIT_UNDEF;
    ls->soln_rNorm    = -1.0;
    ls->soln_dInf     =  0.0;
    ls->soln_jInf     = -1;
    ls->soln_stat     =  BCLS_SOLN_UNDEF;
    ls->optTol        =  1.0e-6;
    ls->conlim        =  1.0 / ( 10.0 * sqrt( DBL_EPSILON ) );
    ls->mu            =  1.0e-2;
    ls->backtrack     =  1.0e-1;
    ls->backtrack_limit = 10;

    // Initialize timers.
    bcls_timer( &(ls->stopwatch[BCLS_TIMER_TOTAL] ),  BCLS_TIMER_INIT );
    ls->stopwatch[BCLS_TIMER_TOTAL].name = "Total time";

    bcls_timer( &(ls->stopwatch[BCLS_TIMER_APROD] ),  BCLS_TIMER_INIT );
    ls->stopwatch[BCLS_TIMER_APROD].name = "Total time for Aprod";

    bcls_timer( &(ls->stopwatch[BCLS_TIMER_USOLVE] ),  BCLS_TIMER_INIT );
    ls->stopwatch[BCLS_TIMER_USOLVE].name = "Total time for Usolve";

    bcls_timer( &(ls->stopwatch[BCLS_TIMER_LSQR] ),  BCLS_TIMER_INIT );
    ls->stopwatch[BCLS_TIMER_LSQR].name = "Total time for LSQR";

    // Initialize constants.
    ls->eps         = DBL_EPSILON;
    ls->eps2        = pow( DBL_EPSILON, 0.50 );
    ls->eps3        = pow( DBL_EPSILON, 0.75 );
    ls->epsx        = ls->eps3;
    ls->epsfixed    = DBL_EPSILON;
    ls->BigNum      = BCLS_INFINITY;

    return;
}

/*!

  \brief Free and reinitialize all resources in an existing BCLS problem.

  \return
  - 0: no errors
  - 1: the BCLS problem is NULL (ie, does not exist).

*/
int
bcls_free_prob( BCLS *ls )
{
    // Report an error if it's already NULL.
    if (ls == NULL) return 1;

    // Deallocate the workspace.
    assert( ls->r       != NULL ); free( ls->r       );
    assert( ls->g       != NULL ); free( ls->g       );
    assert( ls->dx      != NULL ); free( ls->dx      );
    assert( ls->dxFree  != NULL ); free( ls->dxFree  );
    assert( ls->aBreak  != NULL ); free( ls->aBreak  );
    assert( ls->iBreak  != NULL ); free( ls->iBreak  );
    assert( ls->ix      != NULL ); free( ls->ix      );
    assert( ls->wrk_u   != NULL ); free( ls->wrk_u   );
    assert( ls->wrk_v   != NULL ); free( ls->wrk_v   );
    assert( ls->wrk_w   != NULL ); free( ls->wrk_w   );

    // Deallocate the BCLS problem.
    free( ls );

    return 0;
}

/*!

  \brief Install a print-hook routine.

  This routine installs a user-defined print-hook routine.

  The parameter info is a transit pointer passed to the hook routine.

  The parameter hook is an entry point to the user-defined print-hook
  routine. This routine is called by the routine "print" every time an
  informative message should be output. The routine "print" passes to
  the hook routine the transit pointer info and the character string
  msg, which contains the message. If the hook routine returns zero,
  the routine print prints the message in an usual way. Otherwise, if
  the hook routine returns non-zero, the message is not printed.

  In order to uninstall the hook routine the parameter hook should be
  specified as NULL (in this case the parameter info is ignored).

  \param[in,out] ls    BCLS problem context.
  \param[in]     info  Transit pointer passed to the hook routine.
  \param[in]     hook  Pointer to the print-hook routine.

*/
void
bcls_set_print_hook( BCLS *ls,
		     void *info,
		     int (*hook)(void *info, char *msg))
{
    ls->print_info = info;
    ls->print_hook = hook;
    return;
}

/*!

  \brief Install a fault-hook routine.

  This routine installs a user-defined fault-hook routine.

  The parameter info is a transit pointer passed to the hook routine.

  The parameter "hook" is an entry point to the user-defined
  fault-hook routine. This routine is called by the routine
  "bcls_fault" every time an error message should be output. The
  routine "bcls_fault" passes to the hook routine the transit pointer
  info and the character string msg, which contains the message. If
  the hook routine returns zero, the routine print prints the message
  in an usual way. Otherwise, if the hook routine returns non-zero,
  the message is not printed.

  In order to uninstall the hook routine the parameter hook should be
  specified as NULL (in this case the parameter info is ignored).

  \param[in,out] ls    BCLS problem context.
  \param[in]     info  Transit pointer passed to the hook routine.
  \param[in]     hook  Pointer to the fault-hook routine.

*/
void
bcls_set_fault_hook( BCLS *ls,
		     void *info,
		     int (*hook)(void *info, char *msg))
{
    ls->fault_info = info;
    ls->fault_hook = hook;
    return;
}

/*!

  \brief Give BCLS access to set of column weights.

  Define a set of column weights.  BCLS will use these to scale the
  steepest-descent steps.

  \param[in,out] ls     BCLS problem context.
  \param[in]     anorm  Array of columns norms of A.

*/
void
bcls_set_anorm( BCLS *ls,
                double anorm[] )
{
    ls->anorm = anorm;
    return;
}

/*!

  \brief Install a user-defined preconditioning routine.

  Replace each subproblem
  \f[
  \def\minimize{\displaystyle\mathop{\hbox{minimize}}}
  \minimize_x \| Ax - b \|
  \f]
  with
  \f[
  \def\minimize{\displaystyle\mathop{\hbox{minimize}}}
  \minimize_y \| AU^{-1}y - b \|
  \quad\mbox{with}\quad
  Ux = y.
  \f]

  \param[in,out]  ls     BCLS problem context.
  \param[in]      Usolve Pointer to the user's preconditioning routine.

*/
void
bcls_set_usolve( BCLS *ls,
                 int (*Usolve)( int mode, int m, int n, int nix,
                                int ix[], double v[], double w[],
                                void *UsrWrk ) )
{
    assert( Usolve != NULL );
    ls->Usolve = Usolve;
    return;
}

/*!

  \brief Compute the column norms of A.

  Compute the columns norms of A.  Each column of A is generated by
  multiplying A by a unit vector.  The two-norm squared of each
  column is stored in aprod.

  This routine must be called *after* bcls_create_prob.  (As with any
  other BCLS routine.)

  \param[in]      ls      BCLS problem context.
  \param[in]      m       Number of rows in A.
  \param[in]      n       Number of columns in A.
  \param[in]      Aprod   User's matrix-product routine.
  \param[in,out]  UsrWrk  Pointer to user's workspace (could be NULL).
  \param[out]     anorm   Vector of column norms of A.

  \return Returns any error codes returned by the user's aprod
  routine.

*/
int
bcls_compute_anorm( BCLS *ls, int n, int m,
                    int (*Aprod)
                    ( int mode, int m, int n, int nix,
                      int ix[], double x[], double y[], void *UsrWrk ),
                    void *UsrWrk,
                    double anorm[] )
{
    // Make sure that the problem instance has been created.
    assert( ls    != NULL );
    assert( anorm != NULL );

    int j;
    int err;
    const int mode = 1;         // Always:  aj = A*ej.
    const int nix  = 1;         // Only one column is ever needed.
    int    *ix = ls->ix;
    double *e  = ls->wrk_u;
    double *aj = ls->wrk_v;

    bcls_dload( n, 1.0, e, 1 );

    for (j = 0; j < n; j++) {

        // Multiply A times the jth unit vector.
        ix[0] = j;

        // aj <- A * ej.
        err = Aprod( mode, m, n, nix, ix, e, aj, UsrWrk );

        // Exit if Aprod returned an error.
        if (err) break;

        // Compute the norm of aj and store it in anorm.
        anorm[j] = cblas_dnrm2( m, aj, 1 );

        // Make sure that the column norm is too small.
        anorm[j] = fmax( BCLS_MIN_COLUMN_NORM, anorm[j] );
    }

    return err;
}

/*!

  \brief Load the problem into the BCLS data structure.

  The routiens loads the complete problem description into a BCLS
  problem instance.  No work is really being done: only the various
  structure elements are being set to point to the right places.

  \param[in,out]  ls      BCLS problem context.
  \param[in]      m       Number of rows in A.  Note: m <= mmax.
  \param[in]      n       Number of columns in A.  Note: n <= nmax.
  \param[in]      Aprod   Hook to user's matrix-vector product routine.
  \param[in,out]  UsrWrk  Transit pointer passed directly to Aprod/Usolve.
  \param[in]      damp    Regularization parameter.
  \param[in,out]  x       The starting point.
  \param[in]      b       The RHS vector.
  \param[in]      c       Defines a linear term (set to NULL if one doesn't exist).
  \param[in]      bl      Lower bounds on x.
  \param[in]      bu      Upper bounds on x.

*/
void
bcls_set_problem_data( BCLS *ls, int m, int n,
		       int (*Aprod)( int mode, int m, int n, int nix,
				     int ix[], double x[], double y[],
				     void *UsrWrk ),
		       void *UsrWrk, double damp,
		       double x[], double b[], double c[],
		       double bl[], double bu[] )
{
    assert( m <= ls->mmax );
    assert( n <= ls->nmax );

    assert( Aprod  != NULL ); ls->Aprod  = Aprod;
    assert( m      >= 0    ); ls->m      = m;
    assert( n      >= 0    ); ls->n      = n;
                              ls->UsrWrk = UsrWrk;
    assert( damp   >= 0.0  ); ls->damp   = damp;
    assert( x      != NULL ); ls->x      = x;
    assert( b      != NULL ); ls->b      = b;
                              ls->c      = c;
    assert( bl     != NULL ); ls->bl     = bl;
    assert( bu     != NULL ); ls->bu     = bu;

    return;
}

/*!

  \brief Return an exit message.

  \param[in] flag  The code of the error.

  \return Error messsage.

*/
char *
bcls_exit_msg( int flag )
{
    char *msg;

    if      (flag==BCLS_EXIT_CNVGD)  msg="Optimal solution found";
    else if (flag==BCLS_EXIT_MAJOR)  msg="Too many major iterations";
    else if (flag==BCLS_EXIT_MINOR)  msg="Too many minor iterations";
    else if (flag==BCLS_EXIT_UNBND)  msg="Found direction of infinite descent";
    else if (flag==BCLS_EXIT_INFEA)  msg="Bounds are inconsistent";
    else if (flag==BCLS_EXIT_APROD)  msg="Aprod requested immediate exit";
    else if (flag==BCLS_EXIT_USOLVE) msg="Usolve requested immediate exit";
    else if (flag==BCLS_EXIT_CALLBK) msg="CallBack requested immediate exit";
    else                             msg="Undefined exit";

    return msg;
}

/*!

  \brief Solve the current problem instance.

  \return
   -  #BCLS_EXIT_CNVGD (0) - Successful exit.  Found an optimal solution.
   -  #BCLS_EXIT_MAJOR     - Too many major iterations.
   -  #BCLS_EXIT_MINOR     - Too many inner iterations.
   -  #BCLS_EXIT_UNBND     - Found direction of infinite descent.
   -  #BCLS_EXIT_INFEA     - Bounds are inconsistent.
   -  #BCLS_EXIT_APROD     - Aprod  requested immediate exit.
   -  #BCLS_EXIT_USOLVE    - Usolve requested immediate exit.

*/
int
bcls_solve_prob( BCLS *ls )
{
    int err;
    int jpInf;
    const int preconditioning = ls->Usolve != NULL;
    double pInf, timeTot;
    double bNorm;  // Norm of the RHS (or 1.0, which ever is bigger).
    BCLS_timer watch;

    // Print the banner.
    //PRINT1(" ----------------------------------------------------\n");
    //PRINT1(" BCLS -- Bound-Constrained Least Squares, Version %s\n",
    //      bcls_version_info() );
    //PRINT1(" Compiled on %s\n",  bcls_compilation_info() );
    //PRINT1(" ----------------------------------------------------\n");

    // -----------------------------------------------------------------
    // Print parameters and diagnostic information.
    // -----------------------------------------------------------------
    bcls_print_params( ls );

    // Examine the bounds and print a summary about them.
    // Also check if the problem is feasible!
    err = bcls_examine_bnds( ls, ls->n, ls->bl, ls->bu );
    if (err) {
	ls->exit = err;
        goto direct_exit;
    }

    // Set the return for longjmp.  First call to setjmp returns 0.
    err = setjmp(ls->jmp_env);
    if (err) {
        ls->exit = err;
        goto direct_exit;
    }

    // Compute and print some statistics about the column scales.
    bcls_examine_column_scales( ls, ls->anorm );

    // Print a log header.
    //    PRINT1("\n %5s  %5s    %9s  %9s  %11s  %9s %7s %7s %7s\n",
    //	   "Major","Minor","Residual","xNorm","Optimal",
    //	   ls->newton_step == BCLS_NEWTON_STEP_LSQR
    //	   ? "LSQR" : "CGLS",
    //	   "nSteps", "Free", "OptFac");

    // -----------------------------------------------------------------
    // Call the BCLS solver.
    // -----------------------------------------------------------------
    bcls_timer( &(ls->stopwatch[BCLS_TIMER_TOTAL]), BCLS_TIMER_START );

    bcls_solver( ls, ls->m, ls->n, &bNorm,
		 ls->x, ls->b, ls->c, ls->bl, ls->bu, ls->r, ls->g,
		 ls->dx, ls->dxFree, ls->ix,
		 ls->aBreak, ls->iBreak, ls->anorm );

    bcls_timer( &(ls->stopwatch[BCLS_TIMER_TOTAL]), BCLS_TIMER_STOP );

    // =================================================================
    // Exits.
    // =================================================================
 direct_exit:
    // -----------------------------------------------------------------
    // Check feasibility and print a solution summary (iterations, etc.)
    // -----------------------------------------------------------------
    bcls_primal_inf( ls->n, ls->x, ls->bl, ls->bu, &pInf, &jpInf );

    //PRINT1("\n");
    //    PRINT1(" BCLS Exit %4d -- %s\n",ls->exit, bcls_exit_msg(ls->exit));
    //PRINT1("\n");
    //PRINT1(" No. of iterations      %8d %7s", ls->itnMin, "");
    //PRINT1(" Objective value       %17.9e\n", ls->soln_obj  );
    //PRINT1(" No. of major iterations%8d %7s", ls->itnMaj, "");
    //PRINT1(" Optimality           (%7d) %8.1e\n",
    //	   ls->soln_jInf,ls->soln_dInf);
    //PRINT1(" No. of calls to Aprod  %8d", ls->nAprodT);

    //if (ls->proj_search == BCLS_PROJ_SEARCH_EXACT)
    //   PRINT1(" (%5d)", ls->nAprod1 );
    //else
    //  PRINT1("  %5s ", "");
    // PRINT1(" Norm of RHS            %16.1e\n", bNorm);
    // if (pInf > ls->eps)
    //  PRINT1(" Feasibility          (%7d) %7.1e\n", jpInf, pInf);
    //if (preconditioning)
    //  PRINT1(" No. of calls to Usolve %8d\n", ls->nUsolve);
    //PRINT1("\n");

    // -----------------------------------------------------------------
    // Print timing statistics.
    // -----------------------------------------------------------------
    //timeTot = fmax(ls->eps,ls->stopwatch[BCLS_TIMER_TOTAL].total);

    //watch   = ls->stopwatch[BCLS_TIMER_TOTAL];
    //timeTot = fmax(1e-6, watch.total); // Safeguard against timeTot = 0.

    //PRINT1(" %-25s %5.1f (%4.2f) secs\n",
    //	   watch.name, watch.total, 1.0 );

    //watch = ls->stopwatch[BCLS_TIMER_LSQR];
    //PRINT1(" %-25s %5.1f (%4.2f) secs\n",
    //	   watch.name, watch.total, watch.total / timeTot );

    //    watch = ls->stopwatch[BCLS_TIMER_APROD];
    //PRINT1(" %-25s %5.1f (%4.2f) secs\n",
    //	   watch.name, watch.total, watch.total / timeTot );

    // Only print time for Usolve is user provided this routine.
    //if (preconditioning) {
      //  watch = ls->stopwatch[BCLS_TIMER_USOLVE];
      //PRINT1(" %-25s %5.1f (%4.2f) secs\n",
      //       watch.name, watch.total, watch.total / timeTot );
    //}

    return (ls->exit + err);
}


/* bst/gsl_bst.h
 *
 * Copyright (C) 2018, 2019 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.
 */

#ifndef __GSL_BST_H__
#define __GSL_BST_H__

#include <gsl/gsl_math.h>
#include <gsl/gsl_bst_avl.h>
#include <gsl/gsl_bst_rb.h>
#include <gsl/gsl_bst_types.h>

#undef __BEGIN_DECLS
#undef __END_DECLS
#ifdef __cplusplus
# define __BEGIN_DECLS extern "C" {
# define __END_DECLS }
#else
# define __BEGIN_DECLS /* empty */
# define __END_DECLS /* empty */
#endif

__BEGIN_DECLS

/* type of binary search tree */
typedef struct
{
  const char *name;
  const size_t node_size;
  int    (*init)(const gsl_bst_allocator * allocator,
                 gsl_bst_cmp_function * compare, void * params, void * vtable);
  size_t (*nodes) (const void * vtable);
  void * (*insert) (void * item, void * vtable);
  void * (*find) (const void *item, const void * vtable);
  void * (*remove) (const void *item, void * vtable);
  int    (*empty) (void * vtable);
  int    (*trav_init) (void * vtrav, const void * vtable);
  void * (*trav_first) (void * vtrav, const void * vtable);
  void * (*trav_last) (void * vtrav, const void * vtable);
  void * (*trav_find) (const void * item, void * vtrav, const void * vtable);
  void * (*trav_insert) (void * item, void * vtrav, void * vtable);
  void * (*trav_copy) (void * vtrav, const void * vsrc);
  void * (*trav_next) (void * vtrav);
  void * (*trav_prev) (void * vtrav);
  void * (*trav_cur) (const void * vtrav);
  void * (*trav_replace) (void * vtrav, void * new_item);
} gsl_bst_type;

typedef struct
{
  const gsl_bst_type * type;    /* binary search tree type */
  union
    {
      gsl_bst_avl_table avl_table;
      gsl_bst_rb_table rb_table;
    } table;
} gsl_bst_workspace;

typedef struct
{
  const gsl_bst_type * type;    /* binary search tree type */
  union
    {
      gsl_bst_avl_traverser avl_trav;
      gsl_bst_rb_traverser rb_trav;
    } trav_data;
} gsl_bst_trav;

/* tree types */
GSL_VAR const gsl_bst_type * gsl_bst_avl;
GSL_VAR const gsl_bst_type * gsl_bst_rb;

/*
 * Prototypes
 */

gsl_bst_workspace * gsl_bst_alloc(const gsl_bst_type * T, const gsl_bst_allocator * allocator,
                                  gsl_bst_cmp_function * compare, void * params);
void gsl_bst_free(gsl_bst_workspace * w);
int gsl_bst_empty(gsl_bst_workspace * w);
void * gsl_bst_insert(void * item, gsl_bst_workspace * w);
void * gsl_bst_find(const void * item, const gsl_bst_workspace * w);
void * gsl_bst_remove(const void * item, gsl_bst_workspace * w);
size_t gsl_bst_nodes(const gsl_bst_workspace * w);
size_t gsl_bst_node_size(const gsl_bst_workspace * w);
const char * gsl_bst_name(const gsl_bst_workspace * w);

int gsl_bst_trav_init(gsl_bst_trav * trav, const gsl_bst_workspace * w);
void * gsl_bst_trav_first(gsl_bst_trav * trav, const gsl_bst_workspace * w);
void * gsl_bst_trav_last (gsl_bst_trav * trav, const gsl_bst_workspace * w);
void * gsl_bst_trav_find (const void * item, gsl_bst_trav * trav, const gsl_bst_workspace * w);
void * gsl_bst_trav_insert (void * item, gsl_bst_trav * trav, gsl_bst_workspace * w);
void * gsl_bst_trav_copy(gsl_bst_trav * dest, const gsl_bst_trav * src);
void * gsl_bst_trav_next(gsl_bst_trav * trav);
void * gsl_bst_trav_prev(gsl_bst_trav * trav);
void * gsl_bst_trav_cur(const gsl_bst_trav * trav);
void * gsl_bst_trav_replace (gsl_bst_trav * trav, void * new_item);

__END_DECLS

#endif /* __GSL_BST_H__ */


/*
* -----------------------------------------------------------------
*  util_lib.h
*  Utilities Library
*  Version: 2.0
*  Last Update: Nov 3, 2019
*
*  Programmer: Americo Barbosa da Cunha Junior
*              americo.cunhajr@gmail.com
* -----------------------------------------------------------------
*  Copyright (c) 2010-2019, Americo Barbosa da Cunha Junior
*  All rights reserved.
* -----------------------------------------------------------------
*  This is the header file for UTIL_LIB module, a computational
*  library with routines for miscelaneous applications.
* -----------------------------------------------------------------
*/

#ifndef __UTIL_LIB_H__
#define __UTIL_LIB_H__

#include <time.h>

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

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

int gsl_fprint_vector(FILE* file,
                      gsl_vector *v);

int gsl_print_vector(gsl_vector *v);

int gsl_print_matrix_line(unsigned int i,
                          gsl_matrix *M);

int gsl_print_matrix_column(unsigned int j,
                            gsl_matrix *M);

int gsl_print_matrix(gsl_matrix *M);

int gsl_rand_vector(gsl_rng *r,
                    gsl_vector *v);

int gsl_rand_matrix(gsl_rng *r,
                    gsl_matrix *M);

int gsl_diagonal_matrix(gsl_vector *v,
                        gsl_matrix *D);

void util_time_used(clock_t cpu_start,
                    clock_t cpu_end,
                    time_t wall_start,
                    time_t wall_end);

#endif /* __UTIL_LIB_H__ */


#ifndef GSLUtility_h
#define GSLUtility_h
/** This is free and unencumbered software released into the public domain.
The authors of ISIS do not claim copyright on the contents of this file.
For more details about the LICENSE terms and the AUTHORS, you will
find files of those names at the top level of this repository. **/

/* SPDX-License-Identifier: CC0-1.0 */

#include <iostream>
#include <sstream>
#include <string>
#include <vector>
#include <algorithm>

#include <QString>

#include <tnt/tnt_array1d.h>
#include <tnt/tnt_array1d_utils.h>
#include <tnt/tnt_array2d.h>
#include <tnt/tnt_array2d_utils.h>

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

//  Some GSL optimization on by default, off if DEBUG or SAFE_GSL is defined
#ifndef DEBUG
#ifndef SAFE_GSL
#define GSL_RANGE_CHECK_OFF 1
#endif
#endif

#include "IException.h"

namespace Isis {
  namespace GSL {

    /**
     * @brief GSLUtility Provides top level interface to the GNU GSL
     *
     * Provides GSL setup and interface utilities.  This object is provided for
     * convenience of GSL vector and matrix manipulation as well as better
     * management of GSL error handling.
     *
     * Without setting up GSL error handling, the GSL will abort when certain
     * errors occur.  This singleton object, an object where there is never more
     * than one instance, an error handler is established that captures GSL errors
     * and formats them into ISIS exceptions.
     *
     * There are many convenience methods provided for manipulation of GSL vectors
     * and matrixs.  Motivation for this is to address element access and
     * efficient parameter and copy mechanisms (provided by the TNT library).
     *
     * There are some compile options on by default that help optimize the GSL.
     * When the compile time DEBUG macro is set, range checking is turned on.
     * Inline functions are also turned on by default unless the DEBUG macro is
     * set. In addition, an additional compile time macro called SAFE_GSL is
     * provided to emulate the DEBUG behavior, but does not invoke additional
     * DEBUG behavior/side effects.
     *
     * See http://www.gnu.org/software/gsl/ for additional details on the GNU
     * Scientific Library.
     *
     * @ingroup Utility
     * @author 2008-05-06 Kris Becker
     * @internal
     *   @history 2009-08-20 Kris Becker Completed documentation
     */
    class GSLUtility {
      public:
        typedef TNT::Array1D<double> GSLVector;
        typedef TNT::Array2D<double> GSLMatrix;

        static GSLUtility *getInstance();

        /** Tests if status is success */
        inline bool success(int status) const {
          return (status == GSL_SUCCESS);
        }

        /**
         * @brief Returns GSL specific error text
         *
         * @param gsl_errno GSL error number
         * @return QString Textual context of GSL error
         */
        inline QString status(int gsl_errno) const {
          return (QString(gsl_strerror(gsl_errno)));
        }

        void check(int gsl_status, const char *src = __FILE__, int line = __LINE__)
        const;

        size_t Rows(const gsl_matrix *m) const;
        size_t Columns(const gsl_matrix *m) const;

        size_t Rows(const GSLMatrix &m) const;
        size_t Columns(const GSLMatrix &m) const;

        size_t size(const gsl_vector *v) const;
        size_t size(const gsl_matrix *m) const;

        gsl_vector *vector(size_t n, bool zero = false) const;
        gsl_matrix *matrix(size_t n1, size_t n2, bool zero = false) const;
        gsl_matrix *identity(size_t n1, size_t n2) const;
        void setIdentity(gsl_matrix *m) const;

        void free(gsl_vector *v) const;
        void free(gsl_matrix *m) const;

        GSLVector gslToGSL(const gsl_vector *v) const;
        GSLMatrix gslToGSL(const gsl_matrix *m) const;
        gsl_vector *GSLTogsl(const GSLVector &v, gsl_vector *gv = 0) const;
        gsl_matrix *GSLTogsl(const GSLMatrix &m, gsl_matrix *gm = 0) const;

      private:
        //  Private Constructor/Destructor makes this a singleton
        GSLUtility();
        ~GSLUtility() { }

        static GSLUtility *_instance;  //!< Singleton self-reference pointer

        static void handler(const char *reason, const char *file, int line,
                            int gsl_errno);

    };

  } // namespace GSL
}     // namespace Isis
#endif


#ifndef ARRAY_H
#define ARRAY_H

#include <cstdarg>
#include <cstdio>
#include <cstdlib>
#include <cassert>
#include <iostream>
#include <algorithm>
#include <charm++.h>
#if CMK_HAS_CBLAS
#include <cblas.h>
#endif

namespace CharjArray {
  class Range {
  public:
    int size, start, stop;
    Range() {}
    Range(int size_) : size(size_), start(0), stop(size) {}
    Range(int start_, int stop_) :
    size(stop_ - start_), start(start_), stop(stop_) {
      assert(stop >= start);
    }
    void pup(PUP::er& p) {
        p | size;
        p | start;
        p | stop;
    }
  };

  template<int dims>
  class Domain {
  public:
    Range ranges[dims];

    Domain() {}

    Domain(Range ranges_[]) {
      for (int i = 0; i < dims; i++)
	ranges[i] = ranges_[i];
    }

    Domain(Range range) {
      ranges[0] = range;
    }

    Domain(Range range1, Range range2) {
      // TODO: fix Charj generator so it uses the array
      ranges[0] = range1;
      ranges[1] = range2;
    }

    int size() const {
      int total = 0;

      for (int i = 0; i < dims; i++)
	if (total == 0)
	  total = ranges[i].size;
	else
	  total *= ranges[i].size;

      return total;
    }

    void pup(PUP::er& p) {
        for (int i=0; i<dims; ++i) p | ranges[i];
    }
  };

  template<int dims>
  class RowMajor {
  public:
    static int access(const int i, const Domain<dims> &d) {
      return i - d.ranges[0].start;
    }
    static int access(const int i, const int j, const Domain<dims> &d) {
      return (i - d.ranges[0].start) * d.ranges[1].size + j -
        d.ranges[1].start;
    }
    // Generic access method, not used right now.
    // static int access(const int *i, const Domain<dims> &d) {
    //   int off = i[0];
    //   int dimoff = 1;
    //   for (int j = ndims-1; j > 0; --j) {
    //     dimoff *= d.ranges[j].size;
    //     off += dimoff * (i[j] - d.ranges[j].start);
    //   }
    //   return off;
    // }
  };

  template<int dims>
  class ColMajor {
  public:
    static int access(const int i, const Domain<dims> &d) {
      return i - d.ranges[0].start;
    }
    static int access(const int i, const int j, const Domain<dims> &d) {
      return (j - d.ranges[1].start) * d.ranges[1].size + i -
        d.ranges[0].start;
    }
  };

  template<class type, int dims = 1, class atype = RowMajor<dims> >
  class Array {
  private:
    Domain<dims> domain;
    type *block;
    int ref_cout;
    bool did_init;
    Array* ref_parent;

  public:
    Array(Domain<dims> domain_) : ref_parent(0), did_init(false) {
      init(domain_);
    }

    Array(type **block_) : did_init(false) {
      block = *block_;
    }

    Array(type& block_) : did_init(false) {
      block = &block_;
    }

    Array() : ref_parent(0), did_init(false) {

    }

    Array(Array* parent, Domain<dims> domain_)
        : ref_parent(parent), did_init(false) {
      domain = domain_;
      block = parent->block;
    }

    void init(Domain<dims> &domain_) {
      domain = domain_;
      //if (atype == ROW_MAJOR)
      block = new type[domain.size()];
      //printf("Array: allocating memory, size=%d, base pointer=%p\n",
      //       domain.size(), block);
      did_init = true;
    }

    type* raw() { return block; }

    ~Array() {
      if (did_init) delete[] block;
    }

    /*type* operator[] (const Domain<dims> &domain) {
      return block[domain.ranges[0].size];
      }*/

    type& operator[] (const int i) {
      return block[atype::access(i, domain)];
    }

    const type& operator[] (const int i) const {
      return block[atype::access(i, domain)];
    }

    type& access(const int i) {
      return this->operator[](i);
    }

    type& access(const int i, const int j) {
      //printf("Array: accessing, index (%d,%d), offset=%d, base pointer=%p\n",
      //i, j, atype::access(i, j, domain), block);
      return block[atype::access(i, j, domain)];
    }

    type& access(const int i, const Range r) {
      Domain<1> d(r);
      //printf("Array: accessing subrange, size = %d, range (%d,%d), base pointer=%p\n",
      //d.size(), r.start, r.stop, block);
      type* buf = new type[d.size()];
      for (int j = 0; j < d.size(); j++) {
        //printf("Array: copying element (%d,%d), base pointer=%p\n", i, j, block);
        buf[j] = block[atype::access(i, j, domain)];
      }
      return *buf;
    }

    const type& access(const int i, const int j) const {
      return block[atype::access(i, j, domain)];
    }

    Array<type, dims, atype>* operator[] (const Domain<dims> &domain) {
      return new Array<type, dims, atype>(this, domain);
    }

    int size() const {
      return domain.size();
    }

    int size(int dim) const {
      return domain.ranges[dim].size;
    }

    void pup(PUP::er& p) {
        p | domain;
        if (p.isUnpacking()) {
            block = new type[domain.size()];
        }
        PUParray(p, block, domain.size());
    }

    void fill(const type &t) {
      for (int i = 0; i < domain.size(); ++i)
	block[i] = t;
    }

    /// Do these arrays have the same shape and contents?
    bool operator==(const Array &rhs) const
    {
      for (int i = 0; i < dims; ++i)
	if (this->size(i) != rhs.size(i))
	  return false;

      for (int i = 0; i < this->size(); ++i)
	if (this->block[i] != rhs.block[i])
	  return false;

      return true;
    }
    bool operator!=(const Array &rhs) const
    {
      return !(*this == rhs);
    }
  };

  /**
     A local Matrix class for various sorts of linear-algebra work.

     Indexed from 0, to reflect the C-heritage of Charj.
   */
  template <typename V, class atype = RowMajor<2> >
  class Matrix : public Array<V, 2, atype>
  {
  public:
    Matrix() { }
    /// A square matrix
    Matrix(unsigned int n) : Array<V,2,atype>(Domain<2>(n,n)) { }

    /// A identity matrix
    static Matrix* ident(int n)
    {
      Matrix *ret = new Matrix(n);
      ret->fill(0);

      for (int i = 0; i < n; ++i)
	ret->access(i,i) = 1;

      return ret;
    }
  };

  template <typename T, class atype = RowMajor<1> >
  class Vector : public Array<T, 1, atype>
  {
  public:
    Vector() { }
    Vector(unsigned int n) : Array<T, 1, atype>(Range(n)) { }
  };

  /// Compute the inner (dot) product v1^T * v2
  // To compute v1^H * v2, call as dot(v1.C(), v2)
  template<typename T, class atype1, class atype2>
  T dot(const Vector<T, atype1> *pv1, const Vector<T, atype2> *pv2)
  {
    const Vector<T, atype1> &v1 = *pv1, &v2 = *pv2;
    assert(v1.size() == v2.size());
    // XXX: This default initialization worries me some, since it
    // won't necessarily be an additive identity for all T. - Phil
    T ret = T();
    int size = v1.size();
    for (int i = 0; i < size; ++i)
      ret += v1[i] * v2[i];
    return ret;
  }
#if CMK_HAS_CBLAS
  template <>
  float dot<float, RowMajor<1>, RowMajor<1> >(const Vector<float, RowMajor<1> > *pv1,
					      const Vector<float, RowMajor<1> > *pv2)
  {
    const Vector<float, RowMajor<1> > &v1 = *pv1, &v2 = *pv2;
    assert(v1.size() == v2.size());
    return cblas_sdot(v1.size(), &(v1[0]), 1, &(v2[0]), 1);
  }
  template <>
  double dot<double, RowMajor<1>, RowMajor<1> >(const Vector<double, RowMajor<1> > *pv1,
						const Vector<double, RowMajor<1> > *pv2)
  {
    const Vector<double, RowMajor<1> > &v1 = *pv1, &v2 = *pv2;
    assert(v1.size() == v2.size());
    return cblas_ddot(v1.size(), &(v1[0]), 1, &(v2[0]), 1);
  }
#endif

  /// Computer the 1-norm of the given vector
  template<typename T, class atype>
    T norm1(const Vector<T, atype> *pv)
  {
    const Vector<T, atype> &v = *pv;
    // XXX: See comment about additive identity in dot(), above
    T ret = T();
    int size = v.size();
    for (int i = 0; i < size; ++i)
      ret += v[i];
    return ret;
  }

  /// Compute the Euclidean (2) norm of the given vector
  template<typename T, class atype>
    T norm2(const Vector<T, atype> *pv)
  {
    const Vector<T, atype> &v = *pv;
    // XXX: See comment about additive identity in dot(), above
    T ret = T();
    int size = v.size();
    for (int i = 0; i < size; ++i)
      ret += v[i] * v[i];
    return sqrt(ret);
  }
#if CMK_HAS_CBLAS
  template<>
    float norm2<float, RowMajor<1> >(const Vector<float, RowMajor<1> > *pv)
  {
    const Vector<float, RowMajor<1> > &v = *pv;
    return cblas_snrm2(v.size(), &(v[0]), 1);
  }
  template<>
    double norm2<double, RowMajor<1> >(const Vector<double, RowMajor<1> > *pv)
  {
    const Vector<double, RowMajor<1> > &v = *pv;
    return cblas_dnrm2(v.size(), &(v[0]), 1);
  }
#endif

  /// Compute the infinity (max) norm of the given vector
  // Will fail on zero-length vectors
  template<typename T, class atype>
    T normI(const Vector<T, atype> *pv)
  {
    const Vector<T, atype> &v = *pv;
    T ret = v[0];
    int size = v.size();
    for (int i = 1; i < size; ++i)
      ret = max(ret, v[i]);
    return ret;
  }

  /// Scale a vector by some constant
  template<typename T, typename U, class atype>
    void scale(const T &t, Vector<U, atype> *pv)
  {
    const Vector<T, atype> &v = *pv;
    int size = v.size();
    for (int i = 0; i < size; ++i)
      v[i] = t * v[i];
  }
#if CMK_HAS_CBLAS
  template<>
    void scale<float, float, RowMajor<1> >(const float &t,
					   Vector<float, RowMajor<1> > *pv)
  {
    Vector<float, RowMajor<1> > &v = *pv;
    cblas_sscal(v.size(), t, &(v[0]), 1);
  }
  template<>
    void scale<double, double, RowMajor<1> >(const double &t,
					     Vector<double, RowMajor<1> > *pv)
  {
    Vector<double, RowMajor<1> > &v = *pv;
    cblas_dscal(v.size(), t, &(v[0]), 1);
  }
#endif

  /// Add one vector to a scaled version of another
  template<typename T, typename U, class atype>
    void axpy(const T &a, const Vector<U, atype> *px, Vector<U, atype> *py)
  {
    Vector<T, atype> &x = *px;
    const Vector<T, atype> &y = *py;
    int size = x.size();
    assert(size == y.size());
    for (int i = 0; i < size; ++i)
      x[i] = a * x[i] + y[i];
  }
#if CMK_HAS_CBLAS
  template<>
    void axpy<float, float, RowMajor<1> >(const float &a,
					  const Vector<float, RowMajor<1> > *px,
					  Vector<float, RowMajor<1> > *py)
  {
    const Vector<float, RowMajor<1> > &x = *px;
    Vector<float, RowMajor<1> > &y = *py;
    int size = x.size();
    assert(size == y.size());
    cblas_saxpy(size, a, &(x[0]), 1, &(y[0]), 1);
  }
  template<>
    void axpy<double, double, RowMajor<1> >(const double &a,
					  const Vector<double, RowMajor<1> > *px,
					  Vector<double, RowMajor<1> > *py)
  {
    const Vector<double, RowMajor<1> > &x = *px;
    Vector<double, RowMajor<1> > &y = *py;
    int size = x.size();
    assert(size == y.size());
    cblas_daxpy(size, a, &(x[0]), 1, &(y[0]), 1);
  }
#endif
}

#endif


#ifndef AMICI_VECTOR_H
#define AMICI_VECTOR_H

#include <vector>
#include <type_traits>

#include <amici/exception.h>

#include <nvector/nvector_serial.h>

#include <gsl/gsl-lite.hpp>

namespace amici {

/** Since const N_Vector is not what we want */
using const_N_Vector =
    std::add_const_t<typename std::remove_pointer_t<N_Vector>> *;

inline const realtype* N_VGetArrayPointerConst(const_N_Vector x) {
    return N_VGetArrayPointer(const_cast<N_Vector>(x));
}

/** AmiVector class provides a generic interface to the NVector_Serial struct */
class AmiVector {
  public:
    /**
     * @brief Default constructor
     */
    AmiVector() = default;

    /** Creates an std::vector<realtype> and attaches the
     * data pointer to a newly created N_Vector_Serial.
     * Using N_VMake_Serial ensures that the N_Vector
     * module does not try to deallocate the data vector
     * when calling N_VDestroy_Serial
     * @brief empty constructor
     * @param length number of elements in vector
     */
    explicit AmiVector(const long int length)
        : vec_(static_cast<decltype(vec_)::size_type>(length), 0.0),
          nvec_(N_VMake_Serial(length, vec_.data())) {}

    /** Moves data from std::vector and constructs an nvec that points to the
     * data
     * @brief constructor from std::vector,
     * @param rvec vector from which the data will be moved
     */
    explicit AmiVector(std::vector<realtype> rvec)
        : vec_(std::move(rvec)),
          nvec_(N_VMake_Serial(static_cast<long int>(vec_.size()), vec_.data())) {}

    /** Copy data from gsl::span and constructs a vector
     * @brief constructor from gsl::span,
     * @param rvec vector from which the data will be copied
     */
    explicit AmiVector(gsl::span<realtype> rvec)
        : AmiVector(std::vector<realtype>(rvec.begin(), rvec.end())) {}

    /**
     * @brief copy constructor
     * @param vold vector from which the data will be copied
     */
    AmiVector(const AmiVector &vold) : vec_(vold.vec_) {
        nvec_ =
            N_VMake_Serial(static_cast<long int>(vold.vec_.size()), vec_.data());
    }

    /**
     * @brief move constructor
     * @param other vector from which the data will be moved
     */
    AmiVector(AmiVector&& other) noexcept : nvec_(nullptr) {
        vec_ = std::move(other.vec_);
        synchroniseNVector();
    }

    /**
     * @brief destructor
     */
    ~AmiVector();

    /**
     * @brief copy assignment operator
     * @param other right hand side
     * @return left hand side
     */
    AmiVector &operator=(AmiVector const &other);

    /**
     * @brief operator *= (element-wise multiplication)
     * @param multiplier multiplier
     * @return result
     */
    AmiVector &operator*=(AmiVector const& multiplier) {
        N_VProd(getNVector(),
               const_cast<N_Vector>(multiplier.getNVector()),
               getNVector());
        return *this;
    }

    /**
     * @brief operator /= (element-wise division)
     * @param divisor divisor
     * @return result
     */
    AmiVector &operator/=(AmiVector const& divisor) {
        N_VDiv(getNVector(),
               const_cast<N_Vector>(divisor.getNVector()),
               getNVector());
        return *this;
    }

    /**
     * @brief Returns an iterator that points to the first element of the
     * vector.
     * @return iterator that points to the first element
     */
    auto begin() { return vec_.begin(); }

    /**
     * @brief Returns an iterator that points to one element after the last
     * element of the vector.
     * @return iterator that points to one element after the last element
     */
    auto end() { return vec_.end(); }

    /**
     * @brief data accessor
     * @return pointer to data array
     */
    realtype *data();

    /**
     * @brief const data accessor
     * @return const pointer to data array
     */
    const realtype *data() const;

    /**
     * @brief N_Vector accessor
     * @return N_Vector
     */
    N_Vector getNVector();

    /**
     * @brief N_Vector accessor
     * @return N_Vector
     */
    const_N_Vector getNVector() const;

    /**
     * @brief Vector accessor
     * @return Vector
     */
    std::vector<realtype> const &getVector() const;

    /**
     * @brief returns the length of the vector
     * @return length
     */
    int getLength() const;

    /**
     * @brief fills vector with zero values
     */
    void zero();

    /**
     * @brief changes the sign of data elements
     */
    void minus();

    /**
     * @brief sets all data elements to a specific value
     * @param val value for data elements
     */
    void set(realtype val);

    /**
     * @brief accessor to data elements of the vector
     * @param pos index of element
     * @return element
     */
    realtype &operator[](int pos);
    /**
     * @brief accessor to data elements of the vector
     * @param pos index of element
     * @return element
     */
    realtype &at(int pos);

    /**
     * @brief accessor to data elements of the vector
     * @param pos index of element
     * @return element
     */
    const realtype &at(int pos) const;

    /**
     * @brief copies data from another AmiVector
     * @param other data source
     */
    void copy(const AmiVector &other);

    /**
     * @brief Take absolute value (in-place)
     */
    void abs() {
        N_VAbs(getNVector(), getNVector());
    };

  private:
    /** main data storage */
    std::vector<realtype> vec_;

    /** N_Vector, will be synchronized such that it points to data in vec */
    N_Vector nvec_ {nullptr};

    /**
     * @brief reconstructs nvec such that data pointer points to vec data array
     */
    void synchroniseNVector();
};

/**
 * @brief AmiVectorArray class.
 *
 * Provides a generic interface to arrays of NVector_Serial structs
 */
class AmiVectorArray {
  public:
    /**
     * @brief Default constructor
     */
    AmiVectorArray() = default;

    /**
     * Creates an std::vector<realype> and attaches the
     * data pointer to a newly created N_VectorArray
     * using CloneVectorArrayEmpty ensures that the N_Vector
     * module does not try to deallocate the data vector
     * when calling N_VDestroyVectorArray_Serial
     * @brief empty constructor
     * @param length_inner length of vectors
     * @param length_outer number of vectors
     */
    AmiVectorArray(long int length_inner, long int length_outer);

    /**
     * @brief copy constructor
     * @param vaold object to copy from
     */
    AmiVectorArray(const AmiVectorArray &vaold);

    ~AmiVectorArray() = default;

    /**
     * @brief copy assignment operator
     * @param other right hand side
     * @return left hand side
     */
    AmiVectorArray &operator=(AmiVectorArray const &other);

    /**
     * @brief accessor to data of AmiVector elements
     * @param pos index of AmiVector
     * @return pointer to data array
     */
    realtype *data(int pos);

    /**
     * @brief const accessor to data of AmiVector elements
     * @param pos index of AmiVector
     * @return const pointer to data array
     */
    const realtype *data(int pos) const;

    /**
     * @brief accessor to elements of AmiVector elements
     * @param ipos inner index in AmiVector
     * @param jpos outer index in AmiVectorArray
     * @return element
     */
    realtype &at(int ipos, int jpos);

    /**
     * @brief const accessor to elements of AmiVector elements
     * @param ipos inner index in AmiVector
     * @param jpos outer index in AmiVectorArray
     * @return element
     */
    const realtype &at(int ipos, int jpos) const;

    /**
     * @brief accessor to NVectorArray
     * @return N_VectorArray
     */
    N_Vector *getNVectorArray();

    /**
     * @brief accessor to NVector element
     * @param pos index of corresponding AmiVector
     * @return N_Vector
     */
    N_Vector getNVector(int pos);

    /**
     * @brief const accessor to NVector element
     * @param pos index of corresponding AmiVector
     * @return N_Vector
     */
    const_N_Vector getNVector(int pos) const;

    /**
     * @brief accessor to AmiVector elements
     * @param pos index of AmiVector
     * @return AmiVector
     */
    AmiVector &operator[](int pos);

    /**
     * @brief const accessor to AmiVector elements
     * @param pos index of AmiVector
     * @return const AmiVector
     */
    const AmiVector &operator[](int pos) const;

    /**
     * @brief length of AmiVectorArray
     * @return length
     */
    int getLength() const;

    /**
     * @brief set every AmiVector in AmiVectorArray to zero
     */
    void zero();

    /**
     * @brief flattens the AmiVectorArray to a vector in row-major format
     * @param vec vector into which the AmiVectorArray will be flattened. Must
     * have length equal to number of elements.
     */
    void flatten_to_vector(std::vector<realtype> &vec) const;

    /**
     * @brief copies data from another AmiVectorArray
     * @param other data source
     */
    void copy(const AmiVectorArray &other);

  private:
    /** main data storage */
    std::vector<AmiVector> vec_array_;

    /**
     * N_Vector array, will be synchronized such that it points to
     * respective elements in the vec_array
     */
    std::vector<N_Vector> nvec_array_;
};

/**
 * @brief Computes z = a*x + b*y
 * @param a coefficient for x
 * @param x a vector
 * @param b coefficient for y
 * @param y another vector with same size as x
 * @param z result vector of same size as x and y
 */
inline void linearSum(realtype a, AmiVector const& x, realtype b,
               AmiVector const& y, AmiVector& z) {
    N_VLinearSum(a, const_cast<N_Vector>(x.getNVector()),
                 b, const_cast<N_Vector>(y.getNVector()),
                 z.getNVector());
}

/**
 * @brief Compute dot product of x and y
 * @param x vector
 * @param y vector
 * @return dot product of x and y
 */
inline realtype dotProd(AmiVector const& x, AmiVector const& y) {
    return N_VDotProd(const_cast<N_Vector>(x.getNVector()),
                      const_cast<N_Vector>(y.getNVector()));
}

} // namespace amici

namespace gsl {
/**
 * @brief Create span from N_Vector
 * @param nv
 * @return
 */
inline span<realtype> make_span(N_Vector nv)
{
    return span<realtype>(N_VGetArrayPointer(nv), N_VGetLength_Serial(nv));
}
} // namespace gsl

#endif /* AMICI_VECTOR_H */


#ifndef UTIL_GSL_CONVERTER_H
#define UTIL_GSL_CONVERTER_H

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

namespace gsl {

inline
gsl_vector* convert_vec(const arma::vec & vector) {

  gsl_vector * gsl_vec = gsl_vector_alloc(vector.n_elem);

#pragma omp parallel for
  for(arma::uword i=0; i<vector.n_elem; i++) {
    gsl_vector_set(gsl_vec, i, vector(i));
  }

  return gsl_vec;
}

inline
arma::vec convert_vec(const gsl_vector * gsl_vec) {

  arma::vec arma_vec(gsl_vec->size);

#pragma omp parallel for
  for(arma::uword i=0; i<arma_vec.n_elem; i++) {
    arma_vec(i) = gsl_vector_get(gsl_vec, i);
  }

  return arma_vec;
}

inline
gsl_matrix* convert_mat(const arma::mat & mat) {

  gsl_matrix * gsl_mat = gsl_matrix_alloc(mat.n_rows, mat.n_cols);

#pragma omp parallel for
  for(arma::uword i=0; i<mat.n_rows; i++) {
    for(arma::uword j=0; j<mat.n_cols; j++) {
     gsl_matrix_set(gsl_mat, i, j, mat(i,j));
    }
  }

  return gsl_mat;
}

inline
arma::mat convert_mat(const gsl_matrix * gsl_mat) {

  arma::mat arma_mat(gsl_mat->size1, gsl_mat->size2);

#pragma omp parallel for
  for(arma::uword i=0; i<arma_mat.n_rows; i++) {
    for(arma::uword j=0; j<arma_mat.n_cols; j++) {
      arma_mat(i,j) = gsl_matrix_get(gsl_mat, i, j);
    }
  }

  return arma_mat;
}

}

#endif //UTIL_GSL_CONVERTER_H


/**
 *
 * @file qwrapper_dlaswp.c
 *
 *  PLASMA core_blas quark wrapper
 *  PLASMA is a software package provided by Univ. of Tennessee,
 *  Univ. of California Berkeley and Univ. of Colorado Denver
 *
 * @version 2.6.0
 * @author Mathieu Faverge
 * @date 2010-11-15
 * @generated d Tue Jan  7 11:44:58 2014
 *
 **/
#include <lapacke.h>
#include "common.h"

/***************************************************************************//**
 *
 **/
void QUARK_CORE_dlaswp(Quark *quark, Quark_Task_Flags *task_flags,
                       int n, double *A, int lda,
                       int i1,  int i2, const int *ipiv, int inc)
{
    DAG_CORE_LASWP;
    QUARK_Insert_Task(
        quark, CORE_dlaswp_quark, task_flags,
        sizeof(int),                      &n,    VALUE,
        sizeof(double)*lda*n,  A,        INOUT | LOCALITY,
        sizeof(int),                      &lda,  VALUE,
        sizeof(int),                      &i1,   VALUE,
        sizeof(int),                      &i2,   VALUE,
        sizeof(int)*n,                     ipiv,     INPUT,
        sizeof(int),                      &inc,  VALUE,
        0);
}

/***************************************************************************//**
 *
 **/
#if defined(PLASMA_HAVE_WEAK)
#pragma weak CORE_dlaswp_quark = PCORE_dlaswp_quark
#define CORE_dlaswp_quark PCORE_dlaswp_quark
#endif
void CORE_dlaswp_quark(Quark *quark)
{
    int n, lda, i1, i2, inc;
    int *ipiv;
    double *A;

    quark_unpack_args_7(quark, n, A, lda, i1, i2, ipiv, inc);
    LAPACKE_dlaswp_work(LAPACK_COL_MAJOR, n, A, lda, i1, i2, ipiv, inc );
}

/***************************************************************************//**
 *
 **/
void QUARK_CORE_dlaswp_f2(Quark *quark, Quark_Task_Flags *task_flags,
                          int n, double *A, int lda,
                          int i1,  int i2, const int *ipiv, int inc,
                          double *fake1, int szefake1, int flag1,
                          double *fake2, int szefake2, int flag2)
{
    DAG_CORE_LASWP;
    QUARK_Insert_Task(
        quark, CORE_dlaswp_f2_quark, task_flags,
        sizeof(int),                        &n,     VALUE,
        sizeof(double)*lda*n,    A,         INOUT | LOCALITY,
        sizeof(int),                        &lda,   VALUE,
        sizeof(int),                        &i1,    VALUE,
        sizeof(int),                        &i2,    VALUE,
        sizeof(int)*n,                       ipiv,      INPUT,
        sizeof(int),                        &inc,   VALUE,
        sizeof(double)*szefake1, fake1,     flag1,
        sizeof(double)*szefake2, fake2,     flag2,
        0);
}

/***************************************************************************//**
 *
 **/
#if defined(PLASMA_HAVE_WEAK)
#pragma weak CORE_dlaswp_f2_quark = PCORE_dlaswp_f2_quark
#define CORE_dlaswp_f2_quark PCORE_dlaswp_f2_quark
#endif
void CORE_dlaswp_f2_quark(Quark* quark)
{
    int n, lda, i1, i2, inc;
    int *ipiv;
    double *A;
    void *fake1, *fake2;

    quark_unpack_args_9(quark, n, A, lda, i1, i2, ipiv, inc, fake1, fake2);
    LAPACKE_dlaswp_work(LAPACK_COL_MAJOR, n, A, lda, i1, i2, ipiv, inc );
}

/***************************************************************************//**
 *
 **/
void QUARK_CORE_dlaswp_ontile(Quark *quark, Quark_Task_Flags *task_flags,
                              PLASMA_desc descA, double *Aij,
                              int i1,  int i2, const int *ipiv, int inc, double *fakepanel)
{
    DAG_CORE_LASWP;
    if (fakepanel == Aij) {
        QUARK_Insert_Task(
            quark, CORE_dlaswp_ontile_quark, task_flags,
            sizeof(PLASMA_desc),              &descA,     VALUE,
            sizeof(double)*1,      Aij,           INOUT | LOCALITY,
            sizeof(int),                      &i1,        VALUE,
            sizeof(int),                      &i2,        VALUE,
            sizeof(int)*(i2-i1+1)*abs(inc),   ipiv,           INPUT,
            sizeof(int),                      &inc,       VALUE,
            sizeof(double)*1,      fakepanel,     SCRATCH,
            0);
    } else {
        QUARK_Insert_Task(
            quark, CORE_dlaswp_ontile_quark, task_flags,
            sizeof(PLASMA_desc),              &descA,     VALUE,
            sizeof(double)*1,      Aij,           INOUT | LOCALITY,
            sizeof(int),                      &i1,        VALUE,
            sizeof(int),                      &i2,        VALUE,
            sizeof(int)*(i2-i1+1)*abs(inc),   ipiv,           INPUT,
            sizeof(int),                      &inc,       VALUE,
            sizeof(double)*1,      fakepanel,     INOUT,
            0);
    }
}

/***************************************************************************//**
 *
 **/
#if defined(PLASMA_HAVE_WEAK)
#pragma weak CORE_dlaswp_ontile_quark = PCORE_dlaswp_ontile_quark
#define CORE_dlaswp_ontile_quark PCORE_dlaswp_ontile_quark
#endif
void CORE_dlaswp_ontile_quark(Quark *quark)
{
    int i1, i2, inc;
    int *ipiv;
    double *A, *fake;
    PLASMA_desc descA;

    quark_unpack_args_7(quark, descA, A, i1, i2, ipiv, inc, fake);
    CORE_dlaswp_ontile(descA, i1, i2, ipiv, inc);
}

/***************************************************************************//**
 *
 **/
void QUARK_CORE_dlaswp_ontile_f2(Quark *quark, Quark_Task_Flags *task_flags,
                                 PLASMA_desc descA, double *Aij,
                                 int i1,  int i2, const int *ipiv, int inc,
                                 double *fake1, int szefake1, int flag1,
                                 double *fake2, int szefake2, int flag2)
{
    DAG_CORE_LASWP;
    QUARK_Insert_Task(
        quark, CORE_dlaswp_ontile_f2_quark, task_flags,
        sizeof(PLASMA_desc),                &descA, VALUE,
        sizeof(double)*1,        Aij,       INOUT | LOCALITY,
        sizeof(int),                        &i1,    VALUE,
        sizeof(int),                        &i2,    VALUE,
        sizeof(int)*(i2-i1+1)*abs(inc),      ipiv,      INPUT,
        sizeof(int),                        &inc,   VALUE,
        sizeof(double)*szefake1, fake1, flag1,
        sizeof(double)*szefake2, fake2, flag2,
        0);
}

/***************************************************************************//**
 *
 **/
#if defined(PLASMA_HAVE_WEAK)
#pragma weak CORE_dlaswp_ontile_f2_quark = PCORE_dlaswp_ontile_f2_quark
#define CORE_dlaswp_ontile_f2_quark PCORE_dlaswp_ontile_f2_quark
#endif
void CORE_dlaswp_ontile_f2_quark(Quark *quark)
{
    int i1, i2, inc;
    int *ipiv;
    double *A;
    PLASMA_desc descA;
    void *fake1, *fake2;

    quark_unpack_args_8(quark, descA, A, i1, i2, ipiv, inc, fake1, fake2);
    CORE_dlaswp_ontile(descA, i1, i2, ipiv, inc);
}

/***************************************************************************//**
 *
 **/
void QUARK_CORE_dswptr_ontile(Quark *quark, Quark_Task_Flags *task_flags,
                              PLASMA_desc descA, double *Aij,
                              int i1,  int i2, const int *ipiv, int inc,
                              const double *Akk, int ldak)
{
    DAG_CORE_TRSM;
    QUARK_Insert_Task(
        quark, CORE_dswptr_ontile_quark, task_flags,
        sizeof(PLASMA_desc),              &descA, VALUE,
        sizeof(double)*1,      Aij,       INOUT | LOCALITY,
        sizeof(int),                      &i1,    VALUE,
        sizeof(int),                      &i2,    VALUE,
        sizeof(int)*(i2-i1+1)*abs(inc),    ipiv,      INPUT,
        sizeof(int),                      &inc,   VALUE,
        sizeof(double)*ldak,   Akk,       INPUT,
        sizeof(int),                      &ldak,  VALUE,
        0);
}

/***************************************************************************//**
 *
 **/
#if defined(PLASMA_HAVE_WEAK)
#pragma weak CORE_dswptr_ontile_quark = PCORE_dswptr_ontile_quark
#define CORE_dswptr_ontile_quark PCORE_dswptr_ontile_quark
#endif
void CORE_dswptr_ontile_quark(Quark *quark)
{
    int i1, i2, inc, ldak;
    int *ipiv;
    double *A, *Akk;
    PLASMA_desc descA;

    quark_unpack_args_8(quark, descA, A, i1, i2, ipiv, inc, Akk, ldak);
    CORE_dswptr_ontile(descA, i1, i2, ipiv, inc, Akk, ldak);
}

/***************************************************************************//**
 *
 **/
void QUARK_CORE_dlaswpc_ontile(Quark *quark, Quark_Task_Flags *task_flags,
                              PLASMA_desc descA, double *Aij,
                              int i1,  int i2, const int *ipiv, int inc, double *fakepanel)
{
    DAG_CORE_LASWP;
    if (fakepanel == Aij) {
        QUARK_Insert_Task(
            quark, CORE_dlaswpc_ontile_quark, task_flags,
            sizeof(PLASMA_desc),              &descA,     VALUE,
            sizeof(double)*1,      Aij,           INOUT | LOCALITY,
            sizeof(int),                      &i1,        VALUE,
            sizeof(int),                      &i2,        VALUE,
            sizeof(int)*(i2-i1+1)*abs(inc),   ipiv,           INPUT,
            sizeof(int),                      &inc,       VALUE,
            sizeof(double)*1,      fakepanel,     SCRATCH,
            0);
    } else {
        QUARK_Insert_Task(
            quark, CORE_dlaswpc_ontile_quark, task_flags,
            sizeof(PLASMA_desc),              &descA,     VALUE,
            sizeof(double)*1,      Aij,           INOUT | LOCALITY,
            sizeof(int),                      &i1,        VALUE,
            sizeof(int),                      &i2,        VALUE,
            sizeof(int)*(i2-i1+1)*abs(inc),   ipiv,           INPUT,
            sizeof(int),                      &inc,       VALUE,
            sizeof(double)*1,      fakepanel,     INOUT,
            0);
    }
}

/***************************************************************************//**
 *
 **/
#if defined(PLASMA_HAVE_WEAK)
#pragma weak CORE_dlaswpc_ontile_quark = PCORE_dlaswpc_ontile_quark
#define CORE_dlaswpc_ontile_quark PCORE_dlaswpc_ontile_quark
#endif
void CORE_dlaswpc_ontile_quark(Quark *quark)
{
    int i1, i2, inc;
    int *ipiv;
    double *A, *fake;
    PLASMA_desc descA;

    quark_unpack_args_7(quark, descA, A, i1, i2, ipiv, inc, fake);
    CORE_dlaswpc_ontile(descA, i1, i2, ipiv, inc);
}