/* Author: G. Jungman
 */
#include <config.h>
#include <gsl/gsl_ieee_utils.h>

#include "gsl_qrng.h"

int test_sobol(void)
{
  int status = 0;
  double v[3];
  /* int i; */

  /* test in dimension 2 */
  gsl_qrng * g = gsl_qrng_alloc(gsl_qrng_sobol, 2);
  gsl_qrng_get(g, v);
  gsl_qrng_get(g, v);
  gsl_qrng_get(g, v);
  status += ( v[0] != 0.25 || v[1] != 0.75 );
  gsl_qrng_get(g, v);
  status += ( v[0] != 0.375 || v[1] != 0.375 );
  gsl_qrng_free(g);

  /* test in dimension 3 */
  g = gsl_qrng_alloc(gsl_qrng_sobol, 3);
  gsl_qrng_get(g, v);
  gsl_qrng_get(g, v);
  gsl_qrng_get(g, v);
  status += ( v[0] != 0.25 || v[1] != 0.75 || v[2] != 0.25 );
  gsl_qrng_get(g, v);
  status += ( v[0] != 0.375 || v[1] != 0.375 || v[2] != 0.625 );
  gsl_qrng_free(g);

  return status;
}

int test_nied2(void)
{
  int status = 0;
  double v[3];
  /* int i; */

  /* test in dimension 2 */
  gsl_qrng * g = gsl_qrng_alloc(gsl_qrng_niederreiter_2, 2);
  gsl_qrng_get(g, v);
  gsl_qrng_get(g, v);
  gsl_qrng_get(g, v);
  status += ( v[0] != 0.75 || v[1] != 0.25 );
  gsl_qrng_get(g, v);
  status += ( v[0] != 0.25 || v[1] != 0.75 );
  gsl_qrng_get(g, v);
  gsl_qrng_get(g, v);
  gsl_qrng_get(g, v);
  status += ( v[0] != 0.625 || v[1] != 0.125 );
  gsl_qrng_free(g);

  /* test in dimension 3 */
  g = gsl_qrng_alloc(gsl_qrng_niederreiter_2, 3);
  gsl_qrng_get(g, v);
  gsl_qrng_get(g, v);
  gsl_qrng_get(g, v);
  status += ( v[0] != 0.75 || v[1] != 0.25 || v[2] != 0.3125 );
  gsl_qrng_get(g, v);
  status += ( v[0] != 0.25 || v[1] != 0.75 || v[2] != 0.5625 );
  gsl_qrng_get(g, v);
  gsl_qrng_get(g, v);
  gsl_qrng_get(g, v);
  status += ( v[0] != 0.625 || v[1] != 0.125 || v[2] != 0.6875 );
  gsl_qrng_free(g);

  return status;
}

int main()
{
  int status = 0;

  gsl_ieee_env_setup ();

  status += test_sobol();
  status += test_nied2();

  return status;
}


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

#include <config.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_movstat.h>
#include <gsl/gsl_sort.h>
#include <gsl/gsl_statistics.h>

typedef double qqracc_type_t;
typedef qqracc_type_t ringbuf_type_t;

#include "ringbuf.c"

typedef struct
{
  qqracc_type_t *window; /* linear array for current window */
  ringbuf *rbuf;         /* ring buffer storing current window */
} qqracc_state_t;

static size_t
qqracc_size(const size_t n)
{
  size_t size = 0;

  size += sizeof(qqracc_state_t);
  size += n * sizeof(qqracc_type_t);
  size += ringbuf_size(n);

  return size;
}

static int
qqracc_init(const size_t n, void * vstate)
{
  qqracc_state_t * state = (qqracc_state_t *) vstate;

  state->window = (qqracc_type_t *) ((unsigned char *) vstate + sizeof(qqracc_state_t));
  state->rbuf = (ringbuf *) ((unsigned char *) state->window + n * sizeof(qqracc_type_t));

  ringbuf_init(n, state->rbuf);

  return GSL_SUCCESS;
}

static int
qqracc_insert(const qqracc_type_t x, void * vstate)
{
  qqracc_state_t * state = (qqracc_state_t *) vstate;

  /* add new element to ring buffer */
  ringbuf_insert(x, state->rbuf);

  return GSL_SUCCESS;
}

static int
qqracc_delete(void * vstate)
{
  qqracc_state_t * state = (qqracc_state_t *) vstate;

  if (!ringbuf_is_empty(state->rbuf))
    ringbuf_pop_back(state->rbuf);

  return GSL_SUCCESS;
}

/* FIXME XXX: this is inefficient - could be improved by maintaining a sorted ring buffer */
static int
qqracc_get(void * params, qqracc_type_t * result, const void * vstate)
{
  const qqracc_state_t * state = (const qqracc_state_t *) vstate;
  double q = *(double *) params;
  size_t n = ringbuf_copy(state->window, state->rbuf);
  double quant1, quant2;

  gsl_sort(state->window, 1, n);

  /* compute q-quantile and (1-q)-quantile */
  quant1 = gsl_stats_quantile_from_sorted_data(state->window, 1, n, q);
  quant2 = gsl_stats_quantile_from_sorted_data(state->window, 1, n, 1.0 - q);

  /* compute q-quantile range */
  *result = quant2 - quant1;

  return GSL_SUCCESS;
}

static const gsl_movstat_accum qqr_accum_type =
{
  qqracc_size,
  qqracc_init,
  qqracc_insert,
  qqracc_delete,
  qqracc_get
};

const gsl_movstat_accum *gsl_movstat_accum_qqr = &qqr_accum_type;


#include <gsl/gsl_math.h>
#include <gsl/gsl_cblas.h>
#include "cblas.h"

void
cblas_sscal (const int N, const float alpha, float *X, const int incX)
{
#define BASE float
#include "source_scal_r.h"
#undef BASE
}


/*
* This file contains functions used to call sequential MKL/BLAS/LAPACK routines
*
* Authors : Sebastien Cayrols
*         : Olivier Tissot
* Email   : sebastien.cayrols@[(gmail.com) | (inria.fr)]
*         : olivier.tissot@inria.fr
*/

/******************************************************************************/
/*                                  INCLUDE                                   */
/******************************************************************************/
/* STD */
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <math.h>
/* MKL/LAPACK */
#ifdef LAPACKEACTIVATE
  #include <lapacke.h>
  #include <cblas.h>
#endif
/* MPI */
#include <mpi.h>
/* CPaLAMeM */
//#include "cpalamem_macro.h"
#undef TIMERACTIVATE
#include "cplm_utils.h"
#include "cplm_timing.h"
#include "cplm_matcsr.h"
#include "cplm_kernels.h"
#include "cplm_QS.h"
//#include "cpalamem_instrumentation.h"
/******************************************************************************/

/******************************************************************************/
/*                                    CODE                                    */
/******************************************************************************/

int CPLM_MatDenseKernelCholesky(CPLM_Mat_Dense_t* C_io)
{
CPLM_PUSH
CPLM_BEGIN_TIME
  int ierr          = 0;
  int matrix_layout = 0;
  int order         = 0;
  int lda           = 0;
  char uplo         = 0;

  CPLM_ASSERT(C_io       !=  NULL);
  CPLM_ASSERT(C_io->val  !=  NULL);

  matrix_layout = (C_io->info.stor_type == ROW_MAJOR) ? LAPACK_ROW_MAJOR
    : LAPACK_COL_MAJOR;
  uplo          = 'U';
  order         = C_io->info.n;
  lda           = C_io->info.lda;

  ierr = LAPACKE_dpotrf(  matrix_layout,
                          uplo,
                          order,
                          C_io->val,
                          lda);CPLM_CHKERR(ierr);
  if (ierr > 0)
  {
    CPLM_Abort("The matrix is not SPD!");
  }

CPLM_END_TIME
CPLM_POP
  return ierr;
}

//TODO Remove malloc and explain why H
int CPLM_MatDenseKernelQR( CPLM_Mat_Dense_t*  A_io,
                      CPLM_Mat_Dense_t*  H_io,
                      int           index_i,
                      int           index_j) //to be verified
{
CPLM_PUSH
CPLM_BEGIN_TIME
  int ierr          = 0;
  int matrix_layout = -1;
  double *tau = NULL;

  tau = malloc(A_io->info.N*sizeof(double));
  CPLM_ASSERT(tau       !=  NULL);

  matrix_layout = (A_io->info.stor_type == ROW_MAJOR) ? LAPACK_ROW_MAJOR
    : LAPACK_COL_MAJOR;

  ierr = LAPACKE_dgeqrf(  matrix_layout,
                          A_io->info.M,
                          A_io->info.N,
                          A_io->val,
                          A_io->info.lda,
                          tau);CPLM_CHKERR(ierr);

  if(H_io->val != NULL)//[Q] why test on val and not on H alone?
  {
    ierr = CPLM_MatDenseTriangularFillBlock( A_io,
                                        H_io,
                                        index_i,
                                        index_j,
                                        A_io->info.N);CPLM_CHKERR(ierr);
  }

  ierr = LAPACKE_dorgqr(  matrix_layout,
                          A_io->info.M,
                          A_io->info.N,
                          A_io->info.N,
                          A_io->val,
                          A_io->info.lda,
                          tau);CPLM_CHKERR(ierr);
  free(tau);
CPLM_END_TIME
CPLM_POP
  return ierr;
}

int CPLM_MatDenseKernelLowerTriangularLeftSolve(CPLM_Mat_Dense_t* L, CPLM_Mat_Dense_t* B)
{
CPLM_PUSH
CPLM_BEGIN_TIME
  int ierr          = 0;
  int matrix_layout = 0;
  int m             = 0;
  int nrhs          = 0;
  char uplo  = 'L'; // L is lower triangular
  char trans = 'N'; // No transpose, no conjugacy
  char diag  = 'N'; // No unitary

  CPLM_ASSERT(L      !=  NULL);
  CPLM_ASSERT(L->val !=  NULL);
  CPLM_ASSERT(B      !=  NULL);
  CPLM_ASSERT(B->val !=  NULL);

  matrix_layout = (L->info.stor_type == ROW_MAJOR) ? LAPACK_ROW_MAJOR
    : LAPACK_COL_MAJOR;
  m             = B->info.m;
  nrhs          = B->info.n;

  ierr = LAPACKE_dtrtrs(matrix_layout,
                        uplo,
                        trans,
                        diag,
                        m,
                        nrhs,
                        L->val,
                        L->info.lda,
                        B->val,
                        B->info.lda);CPLM_CHKERR(ierr);
CPLM_END_TIME
CPLM_POP
  return ierr;
}

int CPLM_MatDenseKernelUpperTriangularLeftSolve(CPLM_Mat_Dense_t* R, CPLM_Mat_Dense_t* B)
{
CPLM_PUSH
CPLM_BEGIN_TIME
  int ierr          = 0;
  int matrix_layout = -1;
  int m             = 0;
  int nrhs          = 0;
  char uplo  = 'U'; // R is upper triangular
  char trans = 'N'; // No transpose, no conjugacy
  char diag  = 'N'; // No unitary

  CPLM_ASSERT(R      !=  NULL);
  CPLM_ASSERT(R->val !=  NULL);
  CPLM_ASSERT(B      !=  NULL);
  CPLM_ASSERT(B->val !=  NULL);

  matrix_layout = (R->info.stor_type == ROW_MAJOR) ? LAPACK_ROW_MAJOR
    : LAPACK_COL_MAJOR;
  m             = B->info.m;
  nrhs          = B->info.n;

  ierr = LAPACKE_dtrtrs(matrix_layout,
                        uplo,
                        trans,
                        diag,
                        m,
                        nrhs,
                        R->val,
                        R->info.lda,
                        B->val,
                        B->info.lda);CPLM_CHKERR(ierr);
CPLM_END_TIME
CPLM_POP
  return ierr;
}

//#ifdef MKLACTIVATE

//B is triangular
int CPLM_MatDenseDtrmm(CPLM_Mat_Dense_t *A_in ,
                  CPLM_Mat_Dense_t *B_io ,
                  char        side  ,
                  char        uplo  ,
                  char        trans ,
                  char        diag)
{
CPLM_PUSH
  int ierr          = 0;
  CBLAS_LAYOUT matrix_layout = -1;
  CBLAS_DIAG  blasDiag = CblasNonUnit;
  CBLAS_SIDE blasSide = CblasLeft;
  CBLAS_UPLO blasUPLO = CblasUpper;
  CBLAS_TRANSPOSE blasTrans = CblasTrans;

  CPLM_ASSERT(A_in->val != NULL);
  CPLM_ASSERT(B_io->val != NULL);

  blasDiag = (diag == 'U') ? CblasUnit : CblasNonUnit;
  blasSide = (side == 'R') ? CblasRight : CblasLeft;
  blasUPLO = (uplo == 'L') ? CblasLower : CblasUpper;
  blasTrans = (trans == 'T') ? CblasTrans : CblasNoTrans;

  matrix_layout = (A_in->info.stor_type == ROW_MAJOR) ? CblasRowMajor
    : CblasColMajor;

  cblas_dtrmm(matrix_layout,
      blasSide,
      blasUPLO,
      blasTrans,
      blasDiag,
      A_in->info.m,
      A_in->info.n,
      1.0,
      A_in->val,
      A_in->info.lda,
      B_io->val,
      B_io->info.lda);
CPLM_POP
  return ierr;
}
//#else
//  #ifdef LAPACKEACTIVATE
//  int CPLM_MatDenseDtrmm(CPLM_Mat_Dense_t *A_in ,
//                    CPLM_Mat_Dense_t *B_io ,
//                    char        side  ,
//                    char        uplo  ,
//                    char        trans ,
//                    char        diag)
//  {
//  CPLM_PUSH
//    int ierr = 0;
//
//    CPLM_ASSERT(A_in->val != NULL);
//    CPLM_ASSERT(B_io->val != NULL);
//
//    if(A_in->info.stor_type == ROW_MAJOR)
//    {
//      CPLM_Abort("Do not call trmm with row major");
//    }
//
//    dtrmm(
//        side,
//        uplo,
//        trans,
//        diag,
//        A_in->info.m,
//        A_in->info.n,
//        1.0,
//        A_in->val,
//        A_in->info.lda,
//        B_io->val,
//        B_io->info.lda);
//  CPLM_POP
//    return ierr;
//  }
//  #endif
//#endif

// C=alpha A^{transa} * B^{transb} + beta C
int CPLM_MatDenseKernelMatMult(CPLM_Mat_Dense_t*      A,
                          char              ptransa,
                          CPLM_Mat_Dense_t*      B,
                          char              ptransb,
                          CPLM_Mat_Dense_t*      C,
                          double            alpha,
                          double            beta)
{
CPLM_PUSH
CPLM_BEGIN_TIME
  int ierr = 0;
  CBLAS_TRANSPOSE transa;
  CBLAS_TRANSPOSE transb;
  // Allocate memory if needed
  if (C->val == NULL)
  {
    int Crow, Ccol, CrowGlob, CcolGlob;
    CrowGlob = (ptransa == 'N') ? A->info.M : A->info.N;
    Crow     = (ptransa == 'N') ? A->info.m : A->info.n;
    CcolGlob = (ptransb == 'N') ? B->info.N : B->info.M;
    Ccol     = (ptransb == 'N') ? B->info.n : B->info.m;
    ierr = CPLM_MatDenseSetInfo(C,
                           CrowGlob,
                           CcolGlob,
                           Crow,
                           Ccol,
                           A->info.stor_type); // We use A storage type but this
                                               // is arbitrary
    CPLM_CHKERR(ierr);
    ierr = CPLM_MatDenseMalloc(C);
    CPLM_CHKERR(ierr);
  }

  transa = (ptransa == 'N') ?  CblasNoTrans : CblasTrans;
  transb = (ptransb == 'N') ?  CblasNoTrans : CblasTrans;

  // BLAS parameters
  CBLAS_LAYOUT layout = (A->info.stor_type == ROW_MAJOR) ? CblasRowMajor
    : CblasColMajor;
  int nbColOpA = (transa == CblasNoTrans) ? A->info.n : A->info.m;

  cblas_dgemm (layout,
               transa,
               transb,
               C->info.m,
               C->info.n,
               nbColOpA,
               alpha,
               A->val,
               A->info.lda,
               B->val,
               B->info.lda,
               beta,
               C->val,
               C->info.lda);CPLM_CHKERR(ierr);

CPLM_END_TIME
CPLM_POP
  return ierr;

}

int CPLM_MatDenseKernelUpperTriangularRightSolve(CPLM_Mat_Dense_t* R, CPLM_Mat_Dense_t* B)
{
CPLM_PUSH
CPLM_BEGIN_TIME
  int ierr = 0;
  CBLAS_LAYOUT matrix_layout = -1;
#ifdef MKLACTIVATE
  MKL_INT m    = 0;
  MKL_INT nrhs = 0;
#elif defined(LAPACKEACTIVATE)
  int m    = 0;
  int nrhs = 0;
#endif
  double alpha = 1e0;

  CPLM_ASSERT(R      !=  NULL);
  CPLM_ASSERT(R->val !=  NULL);
  CPLM_ASSERT(B      !=  NULL);
  CPLM_ASSERT(B->val !=  NULL);

  matrix_layout = (R->info.stor_type == ROW_MAJOR) ? CblasRowMajor
    : CblasColMajor;
  m             = B->info.m;
  nrhs          = B->info.n;

  cblas_dtrsm(matrix_layout,
              CblasRight,
              CblasUpper,
              CblasNoTrans,
              CblasNonUnit,
              m,
              nrhs,
              alpha,
              R->val,
              R->info.lda,
              B->val,
              B->info.lda);
CPLM_END_TIME
CPLM_POP
  return ierr;
}

// y = beta*y + alpha*A*x
int CPLM_MatDenseKernelMatVec(CPLM_Mat_Dense_t* A_in,
                              double*           x_in,
                              double*           y_io,
                              double            alpha,
                              double            beta)
{
CPLM_PUSH
CPLM_BEGIN_TIME
  int ierr = 0;
  CBLAS_LAYOUT layout = -1;

  CPLM_ASSERT(A_in       !=  NULL);
  CPLM_ASSERT(x_in       !=  NULL);
  CPLM_ASSERT(y_io       !=  NULL);
  CPLM_ASSERT(A_in->val  !=  NULL);

  /* if (*y_io == NULL) */
  /* { */
  /*   y_io = malloc(A_in->info.m*sizeof(double)); */
  /* } */

  // BLAS parameters
  layout = (A_in->info.stor_type == ROW_MAJOR) ? CblasRowMajor : CblasColMajor;

  cblas_dgemv(layout,
              CblasNoTrans,
              A_in->info.m,
              A_in->info.n,
              alpha,
              A_in->val,
              A_in->info.lda,
              x_in,
              1,             // increment for the elements of x
              beta,
              y_io,
              1);            // increment of the elements of y
CPLM_END_TIME
CPLM_POP
  return ierr;
}

int CPLM_MatDenseKernelSumColumns(CPLM_Mat_Dense_t* A_in, double* sumCol)
{
CPLM_PUSH
CPLM_BEGIN_TIME
  int ierr = 0;
  CPLM_ASSERT(A_in->val != NULL);
  CPLM_ASSERT(sumCol != NULL);

  double* ones = (double*) malloc(A_in->info.n*sizeof(double));
  for (int i = 0; i < A_in->info.n; ++i)
    ones[i] = 1.E0;

  ierr = CPLM_MatDenseKernelMatVec(A_in, ones, sumCol, 1.0, 0.0);CPLM_CHKERR(ierr);

  if (ones != NULL) free(ones);
CPLM_END_TIME
CPLM_POP
  return ierr;
}

#ifdef MKLACTIVATE
// C = A + B using mkl
int CPLM_MatDenseKernelMatAdd(CPLM_Mat_Dense_t* A_in,
                         CPLM_Mat_Dense_t* B_in,
                         CPLM_Mat_Dense_t* C_out,
                         double       alpha,
                         double       beta)
{
CPLM_PUSH
CPLM_BEGIN_TIME

  int ierr = 0;
  char ordering = 0;
  char transa   = 0;
  char transb   = 0;

  if(!CPLM_MatDenseIsSameLocalInfo(A_in,B_in))
  {
    CPLM_MatDensePrintfInfo("A info",A_in);
    CPLM_MatDensePrintfInfo("B info",B_in);
    CPLM_Abort("A and B do not have the same structure");
  }

  // Allocate memory if needed
  if(C_out->val == NULL)
  {
    ierr = CPLM_MatDenseInit(C_out, A_in->info);CPLM_CHKERR(ierr);
    ierr = CPLM_MatDenseMalloc(C_out);CPLM_CHKERR(ierr);
  }

  // BLAS parameters
  ordering = (A_in->info.stor_type == ROW_MAJOR) ? 'R' : 'C';
  transa = 'N';
  transb = 'N';

  mkl_domatadd (ordering,
                transa,
                transb,
                A_in->info.m,
                A_in->info.n,
                alpha,
                A_in->val,
                A_in->info.lda,
                beta,
                B_in->val,
                B_in->info.lda,
                C_out->val,
                C_out->info.lda);
CPLM_END_TIME
CPLM_POP
  return ierr;
}

int CPLM_MatCSRKernelMatDenseMult(CPLM_Mat_CSR_t    *A_in,
                             CPLM_Mat_Dense_t  *B_in,
                             CPLM_Mat_Dense_t  *C_io,
                             double       alpha,
                             double       beta)
{
CPLM_PUSH
CPLM_BEGIN_TIME
CPLM_OPEN_TIMER
  int ierr = 0;
  char matdescra[6];
  char trans  = 'N';

  CPLM_ASSERT(A_in       !=  NULL);
  CPLM_ASSERT(B_in       !=  NULL);
  CPLM_ASSERT(C_io       !=  NULL);
  CPLM_ASSERT(A_in->val  != NULL);
  CPLM_ASSERT(B_in->val  != NULL);

  matdescra[0]  = 'G';
  matdescra[1]  = 'L';//ignored if G
  matdescra[2]  = 'N';//ignored if G
  matdescra[3]  = 'C';

  if(C_io->val == NULL)
  {
    ierr = CPLM_MatDenseSetInfo(C_io,
                          A_in->info.m,
                          B_in->info.n,
                          A_in->info.m,
                          B_in->info.n,
                          B_in->info.stor_type);CPLM_CHKERR(ierr);
    ierr = CPLM_MatDenseMalloc(C_io);CPLM_CHKERR(ierr);
  }

#ifdef DEBUG
  CPLM_MatCSRPrintf2D("M1",A_in);
  CPLM_MatDensePrintf2D("* M2",B_in);
#endif
CPLM_TIC(step1, "ConvertTo1BasedIndexing")
  // If COL_MAJOR we need to use 1-base indexes (don't ask why...)
  if (B_in->info.stor_type == COL_MAJOR)
  {
    matdescra[3]  = 'F';
    CPLM_MatCSRConvertTo1BasedIndexing(A_in);
  }
CPLM_TAC(step1)
CPLM_TIC(step2, "Call SpBLAS")
  mkl_dcsrmm(&trans,
             &A_in->info.m,
             &B_in->info.n,
             &A_in->info.n,
             &alpha,
             matdescra,
             A_in->val,
             A_in->colInd,
             A_in->rowPtr,
             &(A_in->rowPtr[1]),
             B_in->val,
             &(B_in->info.lda),
             &beta,
             C_io->val,
             &C_io->info.lda);
CPLM_TAC(step2)
  // Back to 0-base indexes :)
CPLM_TIC(step3, "ConvertTo0BasedIndexing")
  if (B_in->info.stor_type == COL_MAJOR)
  {
    CPLM_MatCSRConvertTo0BasedIndexing(A_in);
  }
CPLM_TAC(step3)

#ifdef DEBUG
  CPLM_MatDensePrintf2D("= ",C_io);
#endif

CPLM_CLOSE_TIMER
CPLM_END_TIME
CPLM_POP
  return ierr;
}

int CPLM_MatCSRKernelGenMatDenseMult(double      *val_in,
                                int         *colInd_in,
                                int         *rowPtrB_in,
                                int         *rowPtrE_in,
                                int          nrowA_in,
                                int          ncolA_in,
                                CPLM_Mat_Dense_t *B_in,
                                CPLM_Mat_Dense_t *C_io,
                                double       alpha,
                                double       beta)
{
CPLM_PUSH
CPLM_BEGIN_TIME
CPLM_OPEN_TIMER
  int ierr = 0;
  char matdescra[6];

  matdescra[0]  = 'G';
  matdescra[1]  = 'L';//ignored if G
  matdescra[2]  = 'N';//ignored if G
  char trans  = 'N';

  CPLM_ASSERT(C_io->val != NULL);

  if (B_in->info.stor_type == COL_MAJOR)
    matdescra[3] = 'F';
  else
    matdescra[3]  = 'C';

CPLM_TIC(step1, "Call SpBLAS")
  mkl_dcsrmm(&trans,
             &nrowA_in,
             &B_in->info.n,
             &ncolA_in,
             &alpha,
             matdescra,
             val_in,
             colInd_in,
             rowPtrB_in,
             rowPtrE_in,
             B_in->val,
             &B_in->info.lda,
             &beta,
             C_io->val,
             &C_io->info.lda);
CPLM_TAC(step1)

CPLM_CLOSE_TIMER
CPLM_END_TIME
CPLM_POP
  return ierr;
}

void CPLM_MatCSRPARDISOSetParameters(MKL_INT* iparam_io)
{
CPLM_PUSH
  CPLM_ASSERT(iparam_io != NULL);

  memset(iparam_io,0,64*sizeof(MKL_INT));

  iparam_io[0]  = 1; // Non standard solver
  iparam_io[1]  = 2; // Metis permutation to reduce fill-in
  iparam_io[4]  = 0; // Return Metis permutation
  iparam_io[9] = 13; // Pivot perturbation
  iparam_io[24] = 0; // Sequential forward and backward solve
  iparam_io[26] = 0; // Check A
  iparam_io[34] = 1; // C-style array indexing (starts from 0)
  //  iparam_io[17] = -1;
  //  iparam_io[18] = -1;
CPLM_POP
}

int CPLM_MatCSRPARDISOFree(CPLM_Mat_CSR_t*  A_in,
                      _MKL_DSS_HANDLE_t       pardisoHandle_io,
                      MKL_INT*    iparam_in,
                      MKL_INT     mtype_in)
{
CPLM_PUSH
  MKL_INT maxfct  = 1;
  MKL_INT mnum    = 1;
  MKL_INT phase   = -1;
  MKL_INT n       = A_in->info.m;
  MKL_INT nrhs    = 0;
  MKL_INT msglvl  = 0;
  MKL_INT error   = 0;
  MKL_INT iDummy  = -1;
  double dDummy = -1e0;

  pardiso(pardisoHandle_io,
          &maxfct,
          &mnum,
          &mtype_in,
          &phase,
          &n,
          &dDummy,
          A_in->rowPtr,
          A_in->colInd,
          &iDummy,
          &nrhs,
          iparam_in,
          &msglvl,
          &dDummy, // b: not needed here
          &dDummy, // x: not needed here
          &error);

CPLM_POP
  return error;
}

int CPLM_MatCSRPARDISOFactorization( CPLM_Mat_CSR_t*  A_in,
                                _MKL_DSS_HANDLE_t       pardisoHandle_out,
                                MKL_INT*    iparam_in,
                                MKL_INT     mtype_in,
                                MKL_INT*    perm_out)
{
CPLM_PUSH
CPLM_BEGIN_TIME
  MKL_INT maxfct  = 1;
  MKL_INT mnum    = 1;
  MKL_INT phase   = 12;
  MKL_INT n       = A_in->info.m;
  MKL_INT nrhs    = 0;
  MKL_INT msglvl  = 0;
  MKL_INT error   = 0;
  double dDummy = -1e0;

  CPLM_ASSERT(A_in               !=  NULL);
  CPLM_ASSERT(A_in->val          !=  NULL);
  CPLM_ASSERT(pardisoHandle_out  !=  NULL);
  CPLM_ASSERT(iparam_in          !=  NULL);
  //  CPLM_ASSERT(perm_out           !=  NULL);

  pardiso(pardisoHandle_out,
          &maxfct,
          &mnum,
          &mtype_in,
          &phase,
          &n,
          A_in->val,
          A_in->rowPtr,
          A_in->colInd,
          perm_out, // the permutation returned by PARDISO
          &nrhs,
          iparam_in,
          &msglvl,
          &dDummy,  // b: not needed here
          &dDummy,  // x: not needed here
          &error);

CPLM_END_TIME
CPLM_POP
  return error;
}

int CPLM_MatCSRPARDISOGeneralSolve(CPLM_Mat_CSR_t*    A_in,
                              CPLM_Mat_Dense_t*  B_in,
                              CPLM_Mat_Dense_t*  X_out,
                              MKL_INT       phase,
                              _MKL_DSS_HANDLE_t         pardisoHandle_in,
                              MKL_INT*      iparam_in,
                              MKL_INT       mtype_in,
                              MKL_INT*      perm_in)
{
CPLM_PUSH
CPLM_BEGIN_TIME

  int ierr = 0;
  MKL_INT maxfct  = 1;
  MKL_INT mnum    = 1;
  MKL_INT n       = 0;
  MKL_INT nrhs    = 0;
  MKL_INT msglvl  = 0;
  MKL_INT error   = 0;

  CPLM_ASSERT(A_in               !=  NULL);
  CPLM_ASSERT(B_in               !=  NULL);
  CPLM_ASSERT(X_out              !=  NULL);
  CPLM_ASSERT(A_in->val          !=  NULL);
  CPLM_ASSERT(B_in->val          !=  NULL);
  CPLM_ASSERT(pardisoHandle_in   !=  NULL);
  CPLM_ASSERT(iparam_in          !=  NULL);
  //  CPLM_ASSERT(perm_in            !=  NULL);

  if (X_out->val == NULL)
  {
    X_out->info = B_in->info;
    ierr = CPLM_MatDenseMalloc(X_out);CPLM_CHKERR(ierr);
  }
  else if (!CPLM_MatDenseIsSameLocalInfo(X_out,B_in))
  {
    X_out->info = B_in->info;
    ierr = CPLM_MatDenseRealloc(X_out);CPLM_CHKERR(ierr);
  }

  n       = (MKL_INT) A_in->info.m;
  nrhs    = (MKL_INT) B_in->info.n;

  pardiso(pardisoHandle_in,
          &maxfct,
          &mnum,
          &mtype_in,
          &phase,
          &n,
          A_in->val,
          A_in->rowPtr,
          A_in->colInd,
          perm_in,
          &nrhs,
          iparam_in,
          &msglvl,
          B_in->val,
          X_out->val,
          &error);

CPLM_END_TIME
CPLM_POP
  return error || ierr;
}

int CPLM_MatCSRPARDISOSolve( CPLM_Mat_CSR_t*    A_in,
                        CPLM_Mat_Dense_t*  B_in,
                        CPLM_Mat_Dense_t*  X_out,
                        _MKL_DSS_HANDLE_t         pardisoHandle_in,
                        MKL_INT*      iparam_in,
                        MKL_INT       mtype_in,
                        MKL_INT*      perm_in)
{
CPLM_PUSH
  MKL_INT phase = 33;
  int ierr = CPLM_MatCSRPARDISOGeneralSolve( A_in,
                                        B_in,
                                        X_out,
                                        phase,
                                        pardisoHandle_in,
                                        iparam_in,
                                        mtype_in,
                                        perm_in);
CPLM_POP
  return ierr;
}

int CPLM_MatCSRPARDISOSolveForward(CPLM_Mat_CSR_t*    A_in,
                              CPLM_Mat_Dense_t*  B_in,
                              CPLM_Mat_Dense_t*  X_out,
                              _MKL_DSS_HANDLE_t         pardisoHandle_in,
                              MKL_INT*      iparam_in,
                              MKL_INT       mtype_in,
                              MKL_INT*      perm_in)
{
CPLM_PUSH
  MKL_INT phase = 331;
  int ierr = CPLM_MatCSRPARDISOGeneralSolve( A_in,
                                        B_in,
                                        X_out,
                                        phase,
                                        pardisoHandle_in,
                                        iparam_in,
                                        mtype_in,
                                        perm_in);
  if (ierr != 0)
  {
    CPLM_Abort("PARDISO Solve forward");
  }
CPLM_POP
  return ierr;
}

int CPLM_MatCSRPARDISOSolveBackward( CPLM_Mat_CSR_t*    A_in,
                                CPLM_Mat_Dense_t*  B_in,
                                CPLM_Mat_Dense_t*  X_out,
                                _MKL_DSS_HANDLE_t         pardisoHandle_in,
                                MKL_INT*      iparam_in,
                                MKL_INT       mtype_in,
                                MKL_INT*      perm_in)
{
CPLM_PUSH
  MKL_INT phase = 333;
  int ierr = CPLM_MatCSRPARDISOGeneralSolve( A_in,
                                        B_in,
                                        X_out,
                                        phase,
                                        pardisoHandle_in,
                                        iparam_in,
                                        mtype_in,
                                        perm_in);
  if (ierr != 0)
  {
    CPLM_Abort("PARDISO Solve backward");
  }
CPLM_POP
  return ierr;
}
#endif

int CPLM_MatDenseNorm(CPLM_Mat_Dense_t *A_in, const char type, double *norm)
{
  CPLM_PUSH
  int ierr = 0;
  int major  = (A_in->info.stor_type == COL_MAJOR) ? LAPACK_COL_MAJOR
    : LAPACK_ROW_MAJOR;

  *norm = LAPACKE_dlange(major,
      type,
      A_in->info.m,
      A_in->info.n,
      A_in->val,
      A_in->info.lda);

  CPLM_POP
  return ierr;
}

int CPLM_MatDenseMatDotProd(CPLM_Mat_Dense_t* A, CPLM_Mat_Dense_t* B, CPLM_Mat_Dense_t* C, MPI_Comm comm)
{
CPLM_PUSH
CPLM_BEGIN_TIME
  int ierr = 0;
  // Do local dot product
  ierr = CPLM_MatDenseKernelMatDotProd(A, B, C);

  // Sum local dot products in place (no mem alloc needed)
  ierr = MPI_Allreduce(MPI_IN_PLACE, C->val, C->info.nval, MPI_DOUBLE, MPI_SUM, comm);CPLM_checkMPIERR(ierr,"MatDenseMatDotProd::MPI_Allreduce");
CPLM_END_TIME
CPLM_POP
  return ierr;
}

/******************************************************************************/
/******************************************************************************/
/******************************************************************************/
/*                                  HANDLER                                   */
/******************************************************************************/
/*
void CPLM_MatDenseSVDHandler(int ierr)
{

  if (ierr > 0)
  {
    CPLM_eprintf("the eigensolver did not converge!");
  }
  else if (ierr < 0)
  {
    CPLM_eprintf("parameter %d has an illegal value!", -ierr + 1);
  }

}
*/


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

#include <config.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_movstat.h>
#include <gsl/gsl_sort.h>
#include <gsl/gsl_statistics.h>

typedef double qnacc_type_t;
typedef qnacc_type_t ringbuf_type_t;

#include "ringbuf.c"

typedef struct
{
  qnacc_type_t *window; /* linear array for current window */
  qnacc_type_t *work;   /* workspace, length 3*n */
  int *work_int;        /* integer workspace, length 5*n */
  ringbuf *rbuf;        /* ring buffer storing current window */
} qnacc_state_t;

static size_t
qnacc_size(const size_t n)
{
  size_t size = 0;

  size += sizeof(qnacc_state_t);
  size += n * sizeof(qnacc_type_t);     /* window */
  size += 3 * n * sizeof(qnacc_type_t); /* work */
  size += 5 * n * sizeof(int);          /* work_int */
  size += ringbuf_size(n);

  return size;
}

static int
qnacc_init(const size_t n, void * vstate)
{
  qnacc_state_t * state = (qnacc_state_t *) vstate;

  state->window = (qnacc_type_t *) ((unsigned char *) vstate + sizeof(qnacc_state_t));
  state->work = (qnacc_type_t *) ((unsigned char *) state->window + n * sizeof(qnacc_type_t));
  state->work_int = (int *) ((unsigned char *) state->work + 3 * n * sizeof(qnacc_type_t));
  state->rbuf = (ringbuf *) ((unsigned char *) state->work_int + 5 * n * sizeof(int));

  ringbuf_init(n, state->rbuf);

  return GSL_SUCCESS;
}

static int
qnacc_insert(const qnacc_type_t x, void * vstate)
{
  qnacc_state_t * state = (qnacc_state_t *) vstate;

  /* add new element to ring buffer */
  ringbuf_insert(x, state->rbuf);

  return GSL_SUCCESS;
}

static int
qnacc_delete(void * vstate)
{
  qnacc_state_t * state = (qnacc_state_t *) vstate;

  if (!ringbuf_is_empty(state->rbuf))
    ringbuf_pop_back(state->rbuf);

  return GSL_SUCCESS;
}

/* FIXME XXX: this is inefficient - could be improved by maintaining a sorted ring buffer */
static int
qnacc_get(void * params, qnacc_type_t * result, const void * vstate)
{
  const qnacc_state_t * state = (const qnacc_state_t *) vstate;
  size_t n = ringbuf_copy(state->window, state->rbuf);

  (void) params;

  gsl_sort(state->window, 1, n);
  *result = gsl_stats_Qn_from_sorted_data(state->window, 1, n, state->work, state->work_int);

  return GSL_SUCCESS;
}

static const gsl_movstat_accum qn_accum_type =
{
  qnacc_size,
  qnacc_init,
  qnacc_insert,
  qnacc_delete,
  qnacc_get
};

const gsl_movstat_accum *gsl_movstat_accum_Qn = &qn_accum_type;