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

#include <config.h>
#include <stdlib.h>
#include <gsl/gsl_rng.h>

/* This is a combined multiple recursive generator. The sequence is,

   z_n = (x_n - y_n) mod m1

   where the two underlying generators x and y are,

   x_n = (a_{1} x_{n-1} + a_{2} x_{n-2} + a_{3} x_{n-3}) mod m1
   y_n = (b_{1} y_{n-1} + b_{2} y_{n-2} + b_{3} y_{n-3}) mod m2

   with coefficients a11 ... a23,

   a_{1} = 0,     a_{2} = 63308, a_{3} = -183326
   b_{1} = 86098, b_{2} = 0,     b_{3} = -539608

   and moduli m1, m2,

   m1 = 2^31 - 1 = 2147483647
   m2 = 2^31 - 2000169 = 2145483479

   We initialize the generator with

   x_1 = s_1 MOD m1, x_2 = s_2 MOD m1, x_3 = s_3 MOD m1
   y_1 = s_4 MOD m2, y_2 = s_5 MOD m2, y_3 = s_6 MOD m2

   where s_n = (69069 * s_{n-1}) mod 2^32 and s_0 = s is the
   user-supplied seed.

   NOTE: According to the paper the initial values for x_n must lie in
   the range 0 <= x_n <= (m1 - 1) and the initial values for y_n must
   lie in the range 0 <= y_n <= (m2 - 1), with at least one non-zero
   value -- our seeding procedure satisfies these constraints.

   We then use 7 iterations of the generator to "warm up" the internal
   state.

   The theoretical value of z_{10008} is 719452880. The subscript 10008
   means (1) seed the generator with s=1, (2) do the seven warm-up
   iterations that are part of the seeding process, (3) then do 10000
   actual iterations.

   The period of this generator is about 2^205.

   From: P. L'Ecuyer, "Combined Multiple Recursive Random Number
   Generators," Operations Research, 44, 5 (1996), 816--822.

   This is available on the net from L'Ecuyer's home page,

   http://www.iro.umontreal.ca/~lecuyer/myftp/papers/combmrg.ps
   ftp://ftp.iro.umontreal.ca/pub/simulation/lecuyer/papers/combmrg.ps */

static inline unsigned long int cmrg_get (void *vstate);
static double cmrg_get_double (void *vstate);
static void cmrg_set (void *state, unsigned long int s);

static const long int m1 = 2147483647, m2 = 2145483479;

static const long int a2 = 63308, qa2 = 33921, ra2 = 12979;
static const long int a3 = -183326, qa3 = 11714, ra3 = 2883;
static const long int b1 = 86098, qb1 = 24919, rb1 = 7417;
static const long int b3 = -539608, qb3 = 3976, rb3 = 2071;

typedef struct
  {
    long int x1, x2, x3;	/* first component */
    long int y1, y2, y3;	/* second component */
  }
cmrg_state_t;

static inline unsigned long int
cmrg_get (void *vstate)
{
  cmrg_state_t *state = (cmrg_state_t *) vstate;

  /* Component 1 */

  {
    long int h3 = state->x3 / qa3;
    long int p3 = -a3 * (state->x3 - h3 * qa3) - h3 * ra3;

    long int h2 = state->x2 / qa2;
    long int p2 = a2 * (state->x2 - h2 * qa2) - h2 * ra2;

    if (p3 < 0)
      p3 += m1;
    if (p2 < 0)
      p2 += m1;

    state->x3 = state->x2;
    state->x2 = state->x1;
    state->x1 = p2 - p3;
    if (state->x1 < 0)
      state->x1 += m1;
  }

  /* Component 2 */

  {
    long int h3 = state->y3 / qb3;
    long int p3 = -b3 * (state->y3 - h3 * qb3) - h3 * rb3;

    long int h1 = state->y1 / qb1;
    long int p1 = b1 * (state->y1 - h1 * qb1) - h1 * rb1;

    if (p3 < 0)
      p3 += m2;
    if (p1 < 0)
      p1 += m2;

    state->y3 = state->y2;
    state->y2 = state->y1;
    state->y1 = p1 - p3;
    if (state->y1 < 0)
      state->y1 += m2;
  }

  if (state->x1 < state->y1)
    return (state->x1 - state->y1 + m1);
  else
    return (state->x1 - state->y1);
}

static double
cmrg_get_double (void *vstate)
{
  return cmrg_get (vstate) / 2147483647.0 ;
}

static void
cmrg_set (void *vstate, unsigned long int s)
{
  /* An entirely adhoc way of seeding! This does **not** come from
     L'Ecuyer et al */

  cmrg_state_t *state = (cmrg_state_t *) vstate;

  if (s == 0)
    s = 1;	/* default seed is 1 */

#define LCG(n) ((69069 * n) & 0xffffffffUL)
  s = LCG (s);
  state->x1 = s % m1;
  s = LCG (s);
  state->x2 = s % m1;
  s = LCG (s);
  state->x3 = s % m1;

  s = LCG (s);
  state->y1 = s % m2;
  s = LCG (s);
  state->y2 = s % m2;
  s = LCG (s);
  state->y3 = s % m2;

  /* "warm it up" */
  cmrg_get (state);
  cmrg_get (state);
  cmrg_get (state);
  cmrg_get (state);
  cmrg_get (state);
  cmrg_get (state);
  cmrg_get (state);
}

static const gsl_rng_type cmrg_type =
{"cmrg",			/* name */
 2147483646,			/* RAND_MAX */
 0,			        /* RAND_MIN */
 sizeof (cmrg_state_t),
 &cmrg_set,
 &cmrg_get,
 &cmrg_get_double};

const gsl_rng_type *gsl_rng_cmrg = &cmrg_type;


/*
** random swap functions
**
** M. Kuhlmann, MPI-KYB, Sept 2015
**/

#include <viaio/Vlib.h>
#include <stdio.h>
#include <string.h>
#include <math.h>
#include <stdlib.h>

#include <gsl/gsl_matrix.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_randist.h>
#include <gsl/gsl_combination.h>

/* binomial coefficient, n choose k */
double binom (int n,int k)
{
  double prod,ix,nx,kx;
  int i;
  nx = (double)n;
  kx = (double)k;

  prod = ix = 1;
  for (i=1; i<=k; i++) {
    prod *= (nx-kx+ix)/ix;
    ix++;
  }
  return prod;
}

double factorial(int n) {
  int i;
  double ix = 1;
  double prod = 1;
  for (i=1; i<=n; i++) {
    prod *= ix;
    ix++;
  }
  return prod;
}

char **enumerate_swaps(int n)
{
  size_t i,j,num,b;

  long maxiter = (size_t) gsl_pow_int(2.0,(int)n);

  char **swaps = (char **)VCalloc(maxiter,sizeof(char *));
  for(i = 0; i < maxiter; i++)
    swaps[i] = (char *)VCalloc(n,sizeof(char));

  /* generate swap table */
  for (i=0; i<maxiter; i++) {
    /* decimal to binary */
    j = 0;
    num = i;
    while(num > 0)
    {
      b=num%2;
      swaps[i][j] = b;
      num=num/2;
      j++;
    }
  }

  return swaps;
}

char **randomSwaps(long maxiter,int n,unsigned long int seed)
{
  size_t i,j;

  char **swaps = (char **)VCalloc(maxiter,sizeof(char *));
  for(i = 0; i < maxiter; i++)
    swaps[i] = (char *)VCalloc(n,sizeof(char));

  gsl_rng_env_setup();
  const gsl_rng_type *T = gsl_rng_default;
  gsl_rng *rx = gsl_rng_alloc(T);
  gsl_rng_set(rx,(unsigned long int)seed);

  for(i = 0; i < maxiter; i++)
    for(j = 0; j < n; j++)
      swaps[i][j] = gsl_ran_bernoulli(rx, 0.5);

  return swaps;
}

char **randomSwaps_noduplicates(long maxiter,int n,unsigned long int seed)
{
  size_t iter,i,j;

  /* if number of maxiter exceeds number of all possible combinations */
  if(maxiter > (size_t) gsl_pow_int(2.0,(int)n))
    VError("Error: Number of iterations larger than possible permutations!");

  gsl_rng_env_setup();
  const gsl_rng_type *T = gsl_rng_default;
  gsl_rng *rx = gsl_rng_alloc(T);
  gsl_rng_set(rx,(unsigned long int)seed);

  char **swaps = (char **)VCalloc(maxiter,sizeof(char *));
  for(i = 0; i < maxiter; i++)
    swaps[i] = (char *)VCalloc(n,sizeof(char));

  /* generate swap table */
  iter = 0;
  while (iter < maxiter) {
    for (j=0; j<n; j++)
      swaps[iter][j] = gsl_ran_bernoulli(rx,0.5);
    /* check if already there */
    /* decrementing iter will result in overwriting the swaps */
    /* since there are no duplicates in can only be decremented once */
    for (j=0; j<iter; j++)
      if (memcmp(swaps[iter],swaps[j],n*sizeof(char)) == 0)
	iter--;
    iter++;
  }

  return swaps;
}

/*
 * shuffle blocks; needed for permutation_test
 */
int **randomBlocks(long int maxiter, int nimages, int block_size, unsigned long int seed)
{
  int nblocks = nimages/block_size;
  int i,j,iter;

  /* ini with real order */
  int **table = (int **)VCalloc(maxiter,sizeof(int*));
  for(i = 0; i < maxiter; i++)
  {
    table[i] = (int *)VCalloc(2*nimages,sizeof(int));
    for(j = 0; j < nimages; j++)
    {
      table[i][2*j] = j;
      table[i][2*j+1] = j+nimages;
    }
  }

  /* each row of table has order: 0, nimages, 1, nimages+1, ... */
  /* shuffle blocks of size 2*block_size */
  gsl_rng_env_setup();
  const gsl_rng_type *T = gsl_rng_default;
  gsl_rng *rx = gsl_rng_alloc(T);
  gsl_rng_set(rx,(unsigned long int)seed);

  for (iter=0; iter<maxiter; iter++)
    for (j=0; j<nblocks; j++)
      gsl_ran_shuffle(rx, (void *)&table[iter][j*2*block_size], 2*block_size, sizeof(int));
  return table;
}
/*
 * shuffle blocks; needed for permutation_test
 * maxiter is the number of random permutations
 * nimages is the number of images in one condition (2*nimages in total)
 * block_size is the size of the permutation blocks
 */
int **randomBlocks_noduplicates(long int maxiter, int nimages, int block_size, unsigned long int seed)
{
  int nblocks = nimages/block_size;
  int i,j,iter;

  /* ini with real order */
  int **table = (int **)VCalloc(maxiter,sizeof(int*));
  for(i = 0; i < maxiter; i++)
  {
    table[i] = (int *)VCalloc(2*nimages,sizeof(int));
    for(j = 0; j < nimages; j++)
    {
      table[i][2*j] = j;
      table[i][2*j+1] = j+nimages;
    }
  }

  /* each row of table has order: 0, nimages, 1, nimages+1, ... */
  /* shuffle blocks of size 2*block_size */
  gsl_rng_env_setup();
  const gsl_rng_type *T = gsl_rng_default;
  gsl_rng *rx = gsl_rng_alloc(T);
  gsl_rng_set(rx,(unsigned long int)seed);

  iter = 0;
  while (iter < maxiter) {
    /* shuffle */
    for (j = 0; j<nblocks; j++)
      gsl_ran_shuffle(rx, (void *)&table[iter][j*2*block_size], 2*block_size, sizeof(int));

    /* sort for one side */
    int k, l, m;
    int index = 0;
    int temp = 0;
    for (m = 0; m < nblocks; m++) {
      for (k = 0; k < block_size-1; k++) {
	index = k;
	for (l = k+1; l < block_size; l++) {
	  if (table[iter][m*2*block_size+2*index] < table[iter][m*2*block_size+2*l])
	    index = l;
	}
	/* swap pairs 'k' and 'index' */
	temp = table[iter][m*2*block_size+2*k];
	table[iter][m*2*block_size+2*k] = table[iter][m*2*block_size+2*index];
	table[iter][m*2*block_size+2*index] = temp;
	temp = table[iter][m*2*block_size+2*k+1];
	table[iter][m*2*block_size+2*k+1] = table[iter][m*2*block_size+2*index+1];
	table[iter][m*2*block_size+2*index+1] = temp;
      }
    }

    /*
     * decrementing iter will result in overwriting the last swaps row
     * since there are no duplicates it can only be decremented once
     */
    for(j=0; j<iter; j++)
      if (memcmp(table[iter],table[j],2*nimages*sizeof(int)) == 0)
	iter--;
    iter++;
  }
  return table;
}


// demo3d.c

#include <stdio.h>
#include <stdlib.h>
#include <stdint.h>
#include <time.h>
#include <string.h>
#include <assert.h>
#include <stdbool.h>
#include <math.h>
#include <gsl/gsl_math.h>

#define SDL_MAIN_HANDLED
#include <SDL2/SDL.h>

#include "libvecdisp.h"

int main(int argc, char * argv[]) {
	VECDISP_T ret;

	// Init
	ret = vecdisp_init();
	assert(ret == VECDISP_SUCCESS);
	ret = vecdisp_out_init();
	assert(ret == VECDISP_SUCCESS);

	SDL_GameController * controller_p0 = NULL, * controller_p1 = NULL;
	int controller_cnt = 0;

	SDL_Init( SDL_INIT_GAMECONTROLLER );
	SDL_GameControllerEventState(SDL_ENABLE);

	vecdisp_shape_t * shape_cube3d = vecdisp_shape_create(VECDISP_SHAPE_LINES, NULL, 0 );

	// format: {x, y, z}, x = horizontal, y = vertical, z = depth
	double cube3d[][3] = {
		{ -1, -1, -1 },
		{ 1, -1, -1 },
		{ 1, -1, -1 },
		{ 1, 1, -1 },
		{ 1, 1, -1 },
		{ -1, 1, -1 },
		{ -1, 1, -1 },
		{ -1, -1, -1 },
		{ -1, -1, -1 },
		{ -1, -1, 1 },
		{ -1, 1, -1 },
		{ -1, 1, 1 },
		{ 1, 1, -1 },
		{ 1, 1, 1 },
		{ 1, -1, -1 },
		{ 1, -1, 1 },
		{ -1, -1, 1 },
		{ 1, -1, 1 },
		{ 1, -1, 1 },
		{ 1, 1, 1 },
		{ 1, 1, 1 },
		{ -1, 1, 1 },
		{ -1, 1, 1 },
		{ -1, -1, 1 },
	 };
	for(int i = 0; i < 24; i++) {
		uint16_t data[2] = {0,0};
		vecdisp_shape_data_add(shape_cube3d, &data, 1 );

	}
	printf("%i\n", shape_cube3d->data_len);

	double rotx = 0, roty = 0, rotz = 0;
	double sqrt_3 = sqrt(3);
	double sqrt_6 = sqrt(6);

	// main loop
	SDL_Event event;
	bool quit = false;
	while( quit == false ) {
		while( SDL_PollEvent(&event) != 0 ) {
			switch (event.type) {
			case SDL_QUIT:
				quit = true;
				break;
			case SDL_CONTROLLERDEVICEADDED:
				if(controller_p0 == NULL) {
					controller_p0 = SDL_GameControllerOpen(event.cdevice.which);
					printf("adding Controller p0\n");
					controller_cnt++;
				}
				else if(controller_p1 == NULL) {
					controller_p1 = SDL_GameControllerOpen(event.cdevice.which);
					printf("adding Controller p1\n");
					controller_cnt++;
				}
				else {
					printf("Only two controllers allowed.\n");
				}
				break;
			case SDL_CONTROLLERDEVICEREMOVED:
				if (event.cdevice.which == SDL_JoystickInstanceID(SDL_GameControllerGetJoystick(controller_p0) ) )  {
					SDL_GameControllerClose(controller_p0);
					printf("freeing controller_p0\n");
					controller_p0 = NULL;
					controller_cnt--;
				}
				else if (event.cdevice.which == SDL_JoystickInstanceID(SDL_GameControllerGetJoystick(controller_p1) ) )  {
					SDL_GameControllerClose(controller_p1);
					printf("freeing controller_p1\n");
					controller_p1 = NULL;
					controller_cnt--;
				}
				break;
			case SDL_CONTROLLERBUTTONDOWN:
				switch (event.cbutton.button) {
				case SDL_CONTROLLER_BUTTON_BACK:
					if(event.cbutton.state == 1) {
						SDL_Event user_quit_event;
						user_quit_event.type = SDL_QUIT;
						SDL_PushEvent( &user_quit_event );
					}
					break;
				}
				break;
			case SDL_KEYDOWN:
				switch (event.key.keysym.sym) {
				case SDLK_q: {
					SDL_Event user_quit_event;
					user_quit_event.type = SDL_QUIT;
					SDL_PushEvent( &user_quit_event );
					break;
					}
				}
				break;
			}
		}

		rotx += 0.00004;
		roty += 0.00002;
		rotz += 0.00001;
		if( rotx >= M_PI ) rotx -= M_PI;
		if( roty >= M_PI ) roty -= M_PI;
		if( rotz >= M_PI ) rotz -= M_PI;

		for(int i = 0; i < 24; i++) {
			double c[3];
			cube3d[i][0] = cos(rotx) * cube3d[i][0] - sin(rotx) * cube3d[i][1]; // Rotation around X Axis
			cube3d[i][1] = sin(rotx) * cube3d[i][0] + cos(rotx) * cube3d[i][1];
			cube3d[i][2] = 1 * cube3d[i][2];

			cube3d[i][0] = cos(roty) * cube3d[i][0] - sin(roty) * cube3d[i][2]; // Rotation around Y Axis
			cube3d[i][1] = 1 * cube3d[i][1];
			cube3d[i][2] = cos(roty) * cube3d[i][2] + sin(roty) * cube3d[i][0];

			cube3d[i][0] = 1 * cube3d[i][0]; // Rotation around Z Axis
			cube3d[i][1] = cos(rotz) * cube3d[i][1] - sin(rotz) * cube3d[i][2]; // Rotation around Z Axis
			cube3d[i][2] = cos(rotz) * cube3d[i][2] + sin(rotz) * cube3d[i][1];

			c[0] = ( sqrt(3) * cube3d[i][0] + (-1) * sqrt_3 * cube3d[i][2] ) / sqrt_6;
			c[1] = ( 1 * cube3d[i][0] + 2 * cube3d[i][1] + 1 * cube3d[i][2] ) / sqrt_6;

			shape_cube3d->data[i][0] =  lround((DRAW_RES / 4) * c[0] + (DRAW_RES / 2));
			shape_cube3d->data[i][1] = lround((DRAW_RES / 4) * c[1] + (DRAW_RES / 2));
		}

		vecdisp_draw_shape( shape_cube3d, 0, 0, DRAW_RES - 1, DRAW_RES - 1, DRAW_BRTNS_BRIGHT);
		vecdisp_dbg_showfps();
		vecdisp_draw_update();
	}

	// cleaning up
	vecdisp_shape_destroy(shape_cube3d);
	SDL_QuitSubSystem( SDL_INIT_EVERYTHING );
	vecdisp_out_end();
	vecdisp_end();
	return 0;
}


#include <stdio.h>
#include <math.h>
#include <gsl/gsl_randist.h>

int
main (void)
{
  double x;
  const gsl_rng_type * T;
  gsl_rng * r;

  gsl_rng_env_setup ();

  T = gsl_rng_default;
  r = gsl_rng_alloc (T);

  for (x = 0.1; x < 2; x+= 0.1)
    {
      double y0 = exp (x);
      double sigma = 0.1 * y0;
      double dy = gsl_ran_gaussian (r, sigma);

      printf ("%g %g %g\n", x, y0 + dy, sigma);
    }

  gsl_rng_free(r);

  return 0;
}


/* See compilation notes in simple_cplx.c*/
#include <complex.h> //nice names for C's complex types
#include <gsl/gsl_vector.h> //gsl_vector_complex

gsl_vector_complex *cvec_dot_gslcplx(gsl_vector_complex *v, gsl_complex x);
gsl_vector_complex *vec_dot_gslcplx(gsl_vector *v, gsl_complex x);
gsl_vector_complex *cvec_dot_c(gsl_vector_complex *v, complex double x);
gsl_vector_complex *vec_dot_c(gsl_vector *v, complex double x);
void gsl_vector_complex_print(gsl_vector_complex *v);

#define gsl_cplx_from_c99(x) (gsl_complex){.dat= {creal(x), cimag(x)}}

complex double ddot (complex double x, complex double y);

#define dot(x,y)  _Generic((x),                                 \
                    gsl_vector*: dot_given_vec(y),              \
                    gsl_vector_complex*: dot_given_cplx_vec(y), \
                    default: ddot)((x),(y))

#define dot_given_vec(y) _Generic((y),                          \
                        gsl_complex: vec_dot_gslcplx,           \
                        default: vec_dot_c)

#define dot_given_cplx_vec(y) _Generic((y),                     \
                        gsl_complex: cvec_dot_gslcplx,          \
                        default: cvec_dot_c)


/*************************************************************************************************************
Calculate shear Gaussian + non-Gaussian covariance using CosmoLike.
Gaussian, super-sample and connected non-Gaussian contributions can each be switched on and off independently.
This loops over all combinations of z bins, saving each to disk separately.

Provide two command line arguments:
  1. Path to ini file with all the configuration (see the example_input/example.ini).
  2. Index of the first power spectrum, spec1_idx. This will then iterate over all spec2_idx <= spec1_idx.
**************************************************************************************************************/

#include <string.h>

#include <gsl/gsl_deriv.h>
#include <gsl/gsl_linalg.h>
#include <gsl/gsl_sf_expint.h>

// CosmoLike includes (std & GSL includes must be above here)
#include <cosmolike_core/theory/structs.c>
#include <cosmolike_core/theory/basics.c>
#include <cosmolike_core/theory/recompute.c>
#include <cosmolike_core/theory/cosmo3D.c>
#include <cosmolike_core/theory/redshift_spline.c>
#include <cosmolike_core/theory/cosmo2D_fourier.c>
#include <cosmolike_core/theory/halo.c>
#include <cosmolike_core/theory/covariances_3D.c>
#include <cosmolike_core/theory/covariances_fourier.c>
#include <covs/init.c>

// Cl covariance params
typedef struct {
    int lmin;
    int lmax;
    char ell_str[200];
    char output_dir[200];
    int do_g;
    int do_ss;
    int do_cng;
} clcov_par;
clcov_par clcov_params = {.lmin = 2, .lmax = -1, .ell_str = "NULL", .do_g = 0, .do_ss = 0, .do_cng = 0};

// Set Cl covariance params from ini file
void set_clcov_parameters(char *paramfile, int output)
{
  char line[256];
  int iline=0;

  FILE* input = fopen(paramfile, "r");
  while(fgets(line, 256, input) != NULL) {
    char name[128], val[128];
    iline++;
    if(line[0] == '#') continue;
    sscanf(line, "%128s : %128s", name, val);

    if(strcmp(name, "lmin") == 0) {
      sscanf(val, "%d", &clcov_params.lmin);
      if(output == 1) printf("lmin %d \n", clcov_params.lmin);
    } else if(strcmp(name, "lmax") == 0) {
      sscanf(val, "%d", &clcov_params.lmax);
      if(output == 1) printf("lmax %d \n", clcov_params.lmax);
    } else if(strcmp(name, "output_dir") == 0) {
      sprintf(clcov_params.output_dir, "%s", val);
      if(output == 1) printf("output_dir %s \n", clcov_params.output_dir);
    } else if(strcmp(name, "c_footprint_file") == 0) {
      sprintf(covparams.C_FOOTPRINT_FILE, "%s", val);
      if(output == 1) printf("c_footprint_file %s \n", covparams.C_FOOTPRINT_FILE);
    } else if(strcmp(name, "ell") == 0) {
      sprintf(clcov_params.ell_str, "%s", val);
      if(output == 1) printf("ell_str %s \n", clcov_params.ell_str);
    } else if(strcmp(name, "do_g") == 0) {
      sscanf(val, "%d", &clcov_params.do_g);
      if(output == 1) printf("do_g %d \n", clcov_params.do_g);
    } else if(strcmp(name, "do_ss") == 0) {
      sscanf(val, "%d", &clcov_params.do_ss);
      if(output == 1) printf("do_ss %d \n", clcov_params.do_ss);
    } else if(strcmp(name, "do_cng") == 0) {
      sscanf(val, "%d", &clcov_params.do_cng);
      if(output == 1) printf("do_cng %d \n", clcov_params.do_cng);
    }
  }
}

// 2D version of numpy savetxt. Use header = "0" for no header
int savetxt_2d(char *path, double **array, int n_row, int n_col, char *header) {

    FILE *file = fopen(path, "w");

    if (strncmp(header, "0", 2) != 0) fprintf(file, "# %s\n", header);

    for (int i = 0; i < n_row; i++) {
      printf("Saving %d / %d ... \r", i + 1, n_row);
      for (int j = 0; j < n_col; j++) {
        fprintf(file, "%.10e", array[i][j]);
        if (j < n_col - 1) {
          fprintf(file, " ");
        }
      }
      fprintf(file, "\n");
    }

    fclose(file);
    return 0;
}

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

  if (argc != 3){
    fprintf(stderr, "Syntax: %s config_file spec1_idx\n", argv[0]);
    exit(1);
  }

  setbuf(stdout, NULL);

  // Set this to 1 to output details about inputs for diagnostics
  int output = 1;

  // Set cosmo, survey and Cl covariance params from ini file
  char *inifile = argv[1];
  set_cosmological_parameters(inifile, output);
  set_survey_parameters(inifile, output);
  covparams.full_tomo = 1;
  set_clcov_parameters(inifile, output);
  init_source_sample(redshift.shear_REDSHIFT_FILE, tomo.shear_Nbin);
  init_lens_sample(redshift.clustering_REDSHIFT_FILE, tomo.clustering_Nbin);

  // Determine which contributions to include
  char cov_str[9] = "";
  printf("Including Gaussian contribution: ");
  if (clcov_params.do_g) {
    printf("yes \n");
    sprintf(cov_str, "%sg_", cov_str);
  } else printf("no \n");
  printf("Including super-sample contribution: ");
  if (clcov_params.do_ss) {
    printf("yes \n");
    sprintf(cov_str, "%sss_", cov_str);
  } else printf("no \n");
  printf("Including connected non-Gaussian contribution: ");
  if (clcov_params.do_cng) {
    printf("yes \n");
    sprintf(cov_str, "%scng_", cov_str);
  } else printf("no \n");
  covparams.ssc = clcov_params.do_ss;
  covparams.cng = clcov_params.do_cng;

  // Obtain the number of z bins from config
  int n_zbin;
  if (tomo.shear_Nbin != tomo.clustering_Nbin) error("tomo.shear_Nbin != tomo.clustering_Nbin");
  else n_zbin = tomo.shear_Nbin;

  // Determine ells, either from the list provided in the config or the provided lmin and lmax
  // Do this in 2 steps: first determine the number of ells, then the ells themselves
  int n_ell;
  if (strcmp(clcov_params.ell_str, "NULL") == 0) {
    if (clcov_params.lmax < clcov_params.lmin) error("lmax < lmin, make sure lmax is provided");
    n_ell = clcov_params.lmax - clcov_params.lmin + 1;
  }
  else { // Count the number of commas + 1
    n_ell = 1;
    const char *remaining_str = clcov_params.ell_str;
    while ((remaining_str = strstr(remaining_str, ",")))
    {
      n_ell++;
      remaining_str++;
    }
  }
  int ell[n_ell];
  if (strcmp(clcov_params.ell_str, "NULL") == 0) {
    for (int l = clcov_params.lmin; l <= clcov_params.lmax; l++) {
      ell[l - clcov_params.lmin] = l;
    }
  }
  else {
    char* rem_str = calloc(strlen(clcov_params.ell_str) + 1, sizeof(char));
    strcpy(rem_str, clcov_params.ell_str);
    int l_idx = 0;
    char *token = strtok(rem_str, ",");
    while (token != NULL) {
      ell[l_idx] = strtol(token, NULL, 10);
      token = strtok(NULL, ",");
      l_idx++;
    }
  }

  // Prepare a string about the ells to go in the header of the output text files
  char ell_header_str[200];
  if (strcmp(clcov_params.ell_str, "NULL") == 0) {
    sprintf(ell_header_str, "lmin %d, lmax %d", clcov_params.lmin, clcov_params.lmax);
  } else {
    sprintf(ell_header_str, "ell: %s", clcov_params.ell_str);
  }
  printf("%s \n", ell_header_str);

  // Generate list of power spectra within the shear data vector
  // Rows are the different spectra, cols are: z1, z2
  int n_spectra_sametype = n_zbin * (n_zbin + 1) / 2;
  int spectra_sametype[n_spectra_sametype][2];
  int spec_idx = 0;
  for (int diag = 0; diag < n_zbin; diag++) {
    for (int row = 0; row < n_zbin - diag; row++) {
      spectra_sametype[spec_idx][0] = row;
      spectra_sametype[spec_idx][1] = row + diag;
      spec_idx++;
    }
  }

  // Read in the provided spec1_idx and check it is allowed
  int spec1_idx = atoi(argv[2]);
  if (spec1_idx < 0 || spec1_idx >= n_spectra_sametype) {
    error("spec1_idx provided is not valid");
  } else {
    printf("Requested spec1_idx is %d \n", spec1_idx);
  }

  // Common variables for the covariance blocks
  int z1, z2, z3, z4, l1, l2;
  double cov;
  char save_path[250];
  char header[250];

  // Shear-shear covariance (symmetric so only do spec2_idx <= spec1_idx)
  for (int spec2_idx = 0; spec2_idx <= spec1_idx; spec2_idx++) {

    // Allocate memory for the block and fill with nans
    double** cov_shear_shear = (double**) malloc(n_ell * sizeof(double*));
    for (int i = 0; i < n_ell; i++) cov_shear_shear[i] = (double*) malloc(n_ell * sizeof(double));
    for (int l1_idx = 0; l1_idx < n_ell; l1_idx++) {
      for (int l2_idx = 0; l2_idx < n_ell; l2_idx++) {
        cov_shear_shear[l1_idx][l2_idx] = NAN;
      }
    }

    // Loop over all combinations of (l1, l2), unless the two spectra are the same in which case only need l2 <= l1
    for (int l1_idx = 0; l1_idx < n_ell; l1_idx++) {
      printf("spec2_idx %d / %d, l1_idx %d / %d \n", spec2_idx, spec1_idx, l1_idx, n_ell);
      int l2_idx_max;
      if (spec2_idx == spec1_idx) {
        l2_idx_max = l1_idx;
      } else {
        l2_idx_max = n_ell - 1;
      }
      for (int l2_idx = 0; l2_idx <= l2_idx_max; l2_idx++) {
        l1 = ell[l1_idx];
        l2 = ell[l2_idx];
        z1 = spectra_sametype[spec1_idx][0];
        z2 = spectra_sametype[spec1_idx][1];
        z3 = spectra_sametype[spec2_idx][0];
        z4 = spectra_sametype[spec2_idx][1];
        cov = 0.0;
        if (clcov_params.do_g) cov += cov_G_shear_shear_tomo(l1, l2, z1, z2, z3, z4);
        if (clcov_params.do_ss || clcov_params.do_cng) cov += cov_NG_shear_shear_tomo(l1, l2, z1, z2, z3, z4);
        cov_shear_shear[l1_idx][l2_idx] = cov;
        if (spec2_idx == spec1_idx) {
          cov_shear_shear[l2_idx][l1_idx] = cov;
        }
      }
    }

    // Save block to disk and free memory
    sprintf(save_path, "%s/cov_%sspec1_%d_spec2_%d.txt", clcov_params.output_dir, cov_str, spec1_idx, spec2_idx);
    sprintf(header, "cov_shear_shear for spec_idx %d and %d with do_g=%d, do_ss=%d, do_cng=%d, %s",
            spec1_idx, spec2_idx, clcov_params.do_g, clcov_params.do_ss, clcov_params.do_cng, ell_header_str);
    if (savetxt_2d(save_path, cov_shear_shear, n_ell, n_ell, header) == 0) printf("\nSaved %s\n", save_path);
    for (int i = 0; i < n_ell; i++) free(cov_shear_shear[i]);
    free(cov_shear_shear);

  } // next spec2_idx for this fixed spec1_idx

  printf("Done \n");
  return 0;
}


#include <stdio.h>
#include <stdlib.h>
#include <sys/time.h>
#include <assert.h>
#include <math.h>

#if  __INTEL_COMPILER
#include "mkl.h"
#else
#include <gsl/gsl_cblas.h>
#endif

#include "defs.h"
#include "utils.h"
#include "progressbar.h"

long naive(const double * restrict x1, const double * restrict y1, const int N, double * restrict d)
{
	long numcomputed=0;

	for(int i=0;i<N;i++) {
		for(int j=0;j<N;j++) {
			double *dist = d + i*N + j;
			const double *y0 = (const double *) &y1[j*NDIM];
			const double *x0 = (const double *) &x1[i*NDIM];
			const double dx = x0[0] - y0[0];
			const double dy = x0[1] - y0[1];
			const double dz = x0[2] - y0[2];
#ifndef SQRT_DIST
			*dist = dx*dx + dy*dy + dz*dz;
#else
			*dist = sqrt(dx*dx + dy*dy + dz*dz);
#endif
		}
 		numcomputed+=N;
	}

	return numcomputed;
}

long chunked(const double * restrict x1, const double * restrict y1, const int N, double * restrict d)
{
	long numcomputed = 0;
	const int block_size = 16;
	for(int i=0;i<N;i+=block_size) {
		const int block_size1 = (N-i) > block_size ? block_size:(N-i);
		for(int j=0;j<N;j+=block_size) {
			const int block_size2 = (N-j) > block_size ? block_size:(N-j);
			for(int ii=0;ii<block_size1;ii++) {
				const long index = (i+ii)*(long) N + j;
				double *dist = (double *) &d[index];
				for(int jj=0;jj<block_size2;jj++) {
					const double *y0 = (const double *) (&y1[(j+jj)*NDIM]);
					const double *x0 = (const double *) (&x1[(i+ii)*NDIM]);
					const double dx = x0[0] - y0[0];
					const double dy = x0[1] - y0[1];
					const double dz = x0[2] - y0[2];
					const double sqr_ds = dx*dx + dy*dy + dz*dz;
#ifndef SQRT_DIST
					dist[jj] = sqr_ds;
#else
					dist[jj] = sqrt(sqr_ds);
#endif
				}
				numcomputed += block_size2;
			}
		}
	}

	return numcomputed;
}

long compiler_vectorized_chunked(const double * restrict x1, const double * restrict y1, const int N, double * restrict d)
{
	long numcomputed = 0;
	const int block_size = 4;
	for(int i=0;i<N;i++) {
		int j;
		for(j=0;j<=(N-block_size);j+=block_size){
			double *dist = &d[i*N + j];
			for(int jj=0;jj<block_size;jj++) {
				const double *y0 = (const double *) (&y1[(j+jj)*NDIM]);
				const double *x0 = (const double *) (&x1[i*NDIM]);
				const double dx = x0[0] - y0[0];
				const double dy = x0[1] - y0[1];
				const double dz = x0[2] - y0[2];
				dist[jj] = dx*dx + dy*dy + dz*dz;
			}
			numcomputed+=block_size;
		}
		double *dist = (double *) &d[i*N + j];
		for(int jj=0;j<N;jj++,j++) {
			const double *y0 = (const double *) (&y1[j*NDIM]);
			const double *x0 = (const double *) (&x1[i*NDIM]);
			const double dx = x0[0] - y0[0];
			const double dy = x0[1] - y0[1];
			const double dz = x0[2] - y0[2];
			dist[jj] = dx*dx + dy*dy + dz*dz;
			numcomputed++;
		}
	}

#ifdef SQRT_DIST
	for(long index=0;index<numcomputed;index++){
		d[index] = sqrt(d[index]);
	}
#endif

	return numcomputed;
}

long blas_computed(const double * restrict x1, const double * restrict y1, const int N, double * restrict d)
{
	long numcomputed = (long) N * (long) N;
	const double alpha = -2.0;
	/* struct timeval t0,t1; */
	/* gettimeofday(&t0,NULL); */
	cblas_dgemm(CblasRowMajor,CblasNoTrans, CblasTrans,
							N, N, NDIM,
							alpha, x1, NDIM , y1, NDIM, 0.0, d, N);
	/* gettimeofday(&t1,NULL); */
	/* printf(" \t\t cblas_time = %6.2lf ms\n",1e3*(t1.tv_sec-t0.tv_sec) + 1e-3*(t1.tv_usec - t0.tv_usec)); */
	double *x0 = (double *) x1;
	for(int i=0;i<N;i++){
		const double sqr_x0_norm = x0[0]*x0[0] + x0[1]*x0[1] + x0[2]*x0[2];
		for(int j=0;j<N;j++) {
			const double *y0 = (const double *) &y1[j*NDIM];
			const double sqr_y0_norm = y0[0]*y0[0] + y0[1]*y0[1] + y0[2]*y0[2];
			double *dist = (double *) &d[i*N + j];
			*dist += (sqr_x0_norm + sqr_y0_norm);

#ifdef SQRT_DIST
			*dist = sqrt(*dist);
#endif
		}
		x0 += NDIM;
	}
	return numcomputed;
}

long check_result(double *dist, const double *x, const double *y, const int N)
{
	int bad=0;
	int numbadprinted=0;
	for(int i=0;i<N;i++) {
		for(int j=0;j<N;j++) {
			const double *tmp_x = (const double *) &(x[i*NDIM]);
			const double *tmp_y = (const double *) &(y[j*NDIM]);
			double sqr_ds = 0.0;
			for(int k=0;k<NDIM;k++) {
				const double dx = tmp_x[k] - tmp_y[k];
				sqr_ds += dx*dx;
			}
			const long index = i*(long) N + j;
			const double this_dist = dist[index];

#ifdef SQRT_DIST
			const double d = sqrt(sqr_ds);
#else
			const double d = sqr_ds;
#endif

			if(fabs(d - this_dist) > 1e-8) {
				if(numbadprinted < 20) {
					fprintf(stderr,"i = %d j = %d d = %0.8lf this_dist = %0.8lf \n",i,j,d,this_dist);
					numbadprinted++;
				}
				bad++;
			}
		}
	}

	return bad;
}

int main(int argc, char **argv)
{
	int numpart = 0;
	if(argc > 1 ) {
		numpart = atoi(argv[1]);
	} else {
		numpart = NELEMENTS;
	}

	const size_t numbytes = NDIM*numpart;
	double *x = calloc(sizeof(*x), numbytes);
	double *y = calloc(sizeof(*y), numbytes);
	const long totnpairs = (long) numpart * (long) numpart;
	double *dist = calloc(sizeof(*dist), totnpairs);
	assert(x != NULL && y != NULL && dist != NULL && "memory allocation failed");
  const char allfunction_names[][MAXLEN] = {"naive","chunked","compiler_vectorized_chunked","blas_computed"};
	const int ntests = sizeof(allfunction_names)/(sizeof(char)*MAXLEN);
	long (*allfunctions[]) (const double * restrict, const double * restrict, const int, double * restrict)      = {naive, chunked,compiler_vectorized_chunked,blas_computed};

	srand(seed);

	double function_best_mean_time[ntests],function_sigma_time[ntests],function_best_time_in_ms[ntests],function_best_mcycles[ntests];
	int function_niterations[ntests];
	for(int i=0;i<ntests;i++) {
		function_best_mean_time[i] = 1e16;
		function_sigma_time[i] = 0.0;
		function_best_time_in_ms[i] = 1e16;
		function_best_mcycles[i] = 1e16;
	}
#ifndef SQRT_DIST
	const long totflop = (long) numpart * (long) numpart * (8);
#else
	const long totflop = (long) numpart * (long) numpart * (8 + 10); //some hand-wavy thing saying that sqrt is 10 flop
#endif

	if(clustered_data == 0) {
		fill_array(x, numpart);
		fill_array(y, numpart);
	} else {
		assert(numpart <= max_galaxy_in_source_file && "Clustered data does not contain enough galaxies..please reduce numpart in defs.h");
		assert(NDIM == 3 && "Clustered galaxy data contains *exactly* 3 spatial dimensions");
		read_ascii(x, numpart, source_galaxy_file);
		read_ascii(y, numpart, source_galaxy_file);
	}

	const int64_t totniterations = repeat*ntests*(int64_t) max_niterations;
	int64_t numdone = 0;
	int interrupted=0;

	fprintf(stderr,"# Running benchmarks with N = %05d particles\n",numpart);
	init_my_progressbar(totniterations, &interrupted);
	for(int irep=0;irep<repeat;irep++) {
		for(int i=0;i<ntests;i++) {
			struct timeval t0,t1;
			double sum_x=0.0, sum_sqr_x=0.0;

			//warm-up
			gettimeofday(&t0,NULL);
			long ncomputed = (allfunctions[i]) (x, y, numpart, dist);
			gettimeofday(&t1,NULL);

			//check-result
			long numbad = check_result(dist, x, y, numpart);
			if(numbad != 0 || ncomputed != totnpairs) {
				fprintf(stderr,"ERROR: In function `%s' Number of incorrectly calculated distances = %ld out of a total of (%ld) possible pairs. Npairs computed = %ld\n", allfunction_names[i],numbad, totnpairs, ncomputed);
				goto cleanup;
			}

			double best_time_in_ms=1e16, best_time_in_megacycles=1e16;
			uint64_t start_cycles, end_cycles;
			const int64_t numdone_before_iter_loop = numdone;
			for(int iter=0;iter<max_niterations;iter++) {
				gettimeofday(&t0,NULL);
				start_cycles = rdtsc();
				(allfunctions[i]) (x, y, numpart, dist);
				end_cycles = rdtsc();
				gettimeofday(&t1,NULL);

				numdone++;
				my_progressbar(numdone,&interrupted);

				const double this_time_in_ms = 1e3*(t1.tv_sec-t0.tv_sec) +  1e-3*(t1.tv_usec - t0.tv_usec);
				if(this_time_in_ms < best_time_in_ms) best_time_in_ms = this_time_in_ms;
				const double this_time_in_megacycles = (end_cycles - start_cycles)/(1024.*1024.);
				if(this_time_in_megacycles < best_time_in_megacycles) best_time_in_megacycles = this_time_in_megacycles;

				sum_sqr_x += this_time_in_ms*this_time_in_ms;
				sum_x     += this_time_in_ms;

				if(max_niterations <= 10) {
					printf("     %-35s  %0.2lf \n",allfunction_names[i], this_time_in_ms);
				}

				if(best_time_in_ms < function_best_time_in_ms[i]) {
					function_best_time_in_ms[i] = best_time_in_ms;
				}

				if(best_time_in_megacycles < function_best_mcycles[i]) {
					function_best_mcycles[i] = best_time_in_megacycles;
				}

				const double mean_time  = sum_x/(iter+1.0);
				const double sigma_time = sqrt(sum_sqr_x/(iter+1.0) - mean_time*mean_time);
				if(mean_time < function_best_mean_time[i]) {
					function_best_mean_time[i] = mean_time;
				}
				function_niterations[i] = iter + 1;
				function_sigma_time[i] = sigma_time;

        //If the std.dev is small compared to typical runtime and
				//the code has run for more than XXX milli-seconds, then break
				if(sigma_time/mean_time < convergence_ratio && sum_x >= 300 && iter >= 5) {
					numdone = numdone_before_iter_loop + max_niterations;
					break;
				}
			}
		}//i loop over ntests
	}//irep loop over nrepeats
  finish_myprogressbar(&interrupted);

	printf("#######################################################\n");
	printf("##  Function                            Time (ms)      \n");
	printf("#######################################################\n");
	for(int i=0;i<ntests;i++) {
		const double mean_time = function_best_mean_time[i];
		const double sigma_time = function_sigma_time[i];
		const double gflops = (double) totflop/(1e-3*mean_time)/1e9;
		const double best_time_in_ms = function_best_time_in_ms[i];
		const double best_time_in_megacycles = function_best_mcycles[i];
		const int actual_niterations = function_niterations[i];
		printf(ANSI_COLOR_RED "# %-35s  %6.2lf +- %5.2lf " ANSI_COLOR_GREEN " (best -- %6.2lf ms, %6.2lf Mcycles) " ANSI_COLOR_RESET "," ANSI_COLOR_BLUE " %5.2lf GFlops [%04d iterations]" ANSI_COLOR_RESET "\n",
					 allfunction_names[i], mean_time, sigma_time, best_time_in_ms, best_time_in_megacycles, gflops, actual_niterations);

	}

cleanup:
	{
		free((void *) x);free((void *) y);free((void *) dist);
		exit(EXIT_FAILURE);
	}

	exit(EXIT_SUCCESS);
}


////////////////////////////////////////////////////////////////////////
/// \class OscProb::PMNS_Sterile
///
/// \brief Implementation of oscillations of neutrinos in matter in a
///        N-neutrino framework.
///
/// This class implements neutrino oscillations for any number of
/// neutrino falvours. The extra flavours above 3 are treated as
/// sterile neutrinos, i.e. it implements a 3+N model. One can also
/// run a 2-neutrino model in principle, but an analytical solution
/// would be feasible and more efficient in that case.
///
/// The eigensystem solution is performed by GSL, which makes it slower
/// than the PMNS_Fast class, which only works for 3 neutrinos.
///
/// \author coelho\@lal.in2p3.fr
////////////////////////////////////////////////////////////////////////

#ifndef PMNS_STERILE_H
#define PMNS_STERILE_H
#include "PMNS_Base.h"

#include <gsl/gsl_eigen.h>

namespace OscProb {
  class PMNS_Sterile : public PMNS_Base {
    public:

    PMNS_Sterile(int NumNus); ///< Constructor
    virtual ~PMNS_Sterile();  ///< Destructor

  protected:

    /// Solve the full Hamiltonian for eigenvectors and eigenvalues
    virtual void SolveHam();

    gsl_vector* fEvalGSL;             ///< Stores the GSL eigenvalues
    gsl_matrix_complex* fEvecGSL;     ///< Stores the GSL eigenvectors
    gsl_matrix_complex* H_GSL;        ///< The Hamiltonian to be solved by GSL
    gsl_eigen_hermv_workspace* W_GSL; ///< Allocates memory for GSL solution

  };
}
#endif
////////////////////////////////////////////////////////////////////////


static char help[] =
"Solves a structured-grid Stokes problem with DMDA and SNES using finite elements: Q^2-P^-1.\n"
"FIXME: START OVER\n"
"\n\n";

#include <petsc.h>

typedef struct {
  double u;
  double v;
  double p;
} Field;

typedef struct {
  DM        da;
  Vec       xexact;
  double    L,     // length of domain in x direction
            H,     // length of domain in y direction
            g1,    // signed component of gravity in x-direction
            g2,    // signed component of gravity in y-direction
            mu;    // viscosity
} AppCtx;

extern PetscErrorCode FormExactSolution(AppCtx*);
extern PetscErrorCode FormFunctionLocal(DMDALocalInfo*,Field**,Field**,AppCtx*);
//extern PetscErrorCode FormJacobianLocal(DMDALocalInfo*,Field**,Mat,Mat,AppCtx*);

int main(int argc,char **argv)
{
  PetscErrorCode ierr;
  AppCtx         user;                         /* user-defined work context */
  SNES           snes;                         /* nonlinear solver */
  Vec            x;                            /* solution vector */

  PetscInitialize(&argc,&argv,(char*)0,help);

  const double rg = 1000.0 * 9.81, // = rho g; scale for body force;
                                      //     kg / (m^2 s^2);  weight of water
                  theta = PETSC_PI / 9.0; // 20 degrees
  user.L     = 1.0;
  user.H     = 1.0;
  user.g1    = rg * sin(theta);
  user.g2    = - rg * cos(theta);
  user.nu    = 0.25;  // Pa s;  typical dynamic viscosity of motor oil
  user.ppeps = 1.0;

// FIXME START OVER

  PetscBool doerror = PETSC_FALSE, exactinit = PETSC_FALSE;
  ierr = PetscOptionsBegin(PETSC_COMM_WORLD, "stokes_", "options for stokes", ""); CHKERRQ(ierr);
  FIXME
  ierr = PetscOptionsEnd(); CHKERRQ(ierr);

  ierr = DMDACreate2d(PETSC_COMM_WORLD,
                      FIXME); CHKERRQ(ierr);
  ierr = DMSetFromOptions(user.da); CHKERRQ(ierr);
  ierr = DMSetUp(user.da); CHKERRQ(ierr);
  ierr = DMDASetUniformCoordinates(user.da, 0.0, user.H, 0.0, user.L, -1.0, -1.0); CHKERRQ(ierr);
  ierr = DMSetApplicationContext(user.da,&user); CHKERRQ(ierr);
  ierr = DMCreateGlobalVector(user.da,&x); CHKERRQ(ierr);

  ierr = DMDASetFieldName(user.da,0,"u"); CHKERRQ(ierr);
  ierr = DMDASetFieldName(user.da,1,"v"); CHKERRQ(ierr);
  ierr = DMDASetFieldName(user.da,2,"p"); CHKERRQ(ierr);

  FIXME

  SNESDestroy(&snes);  DMDestroy(&user.da);
  return PetscFinalize();
}

PetscErrorCode FormExactSolution(AppCtx* user) {
  PetscErrorCode ierr;
  DMDALocalInfo  info;
  int       i,j;
  double      hy, y;
  Field          **ax;

  ierr = DMDAGetLocalInfo(user->da,&info); CHKERRQ(ierr);
  hy = user->H / (double)(info.my - 1);
  ierr = DMDAVecGetArray(user->da,user->xexact,&ax); CHKERRQ(ierr);
  for (j = info.ys; j < info.ys+info.ym; j++) {
    y = hy * (double)j;
    for (i = info.xs; i < info.xs+info.xm; i++) {
      ax[j][i].u = (user->g1 / user->nu) * y * (user->H - y/2.0);
      ax[j][i].v = 0.0;
      ax[j][i].p = - user->g2 * (user->H - y);
    }
  }
  ierr = DMDAVecRestoreArray(user->da,user->xexact,&ax); CHKERRQ(ierr);
  return 0;
}


/* tsqr.c
 *
 * Copyright (C) 2015, 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.
 */

/*
 * This module implements the sequential TSQR algorithm
 * described in
 *
 * [1] Demmel, J., Grigori, L., Hoemmen, M. F., and Langou, J.
 *     "Communication-optimal parallel and sequential QR and LU factorizations",
 *     UCB Technical Report No. UCB/EECS-2008-89, 2008.
 *
 * The algorithm operates on a tall least squares system:
 *
 * [ A_1 ] x = [ b_1 ]
 * [ A_2 ]     [ b_2 ]
 * [ ... ]     [ ... ]
 * [ A_k ]     [ b_k ]
 *
 * as follows:
 *
 * 1. Initialize
 *    a. [Q_1,R_1] = qr(A_1)
 *    b. z_1 = Q_1^T b_1
 * 2. Loop i = 2:k
 *    a. [Q_i,R_i] = qr( [ R_{i-1} ; A_i ] )
 *    b. z_i = Q_i^T [ z_{i-1} ; b_i ]
 * 3. Output:
 *    a. R = R_k
 *    b. Q^T b = z_k
 *
 * Step 2(a) is optimized to take advantage
 * of the sparse structure of the matrix
 */

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

typedef struct
{
  size_t p;             /* number of columns of LS matrix */
  int nblocks;          /* number of blocks processed */
  double rnorm;         /* || b - A x || residual norm */
  int svd;              /* SVD of R factor has been computed */

  gsl_matrix *T;        /* block reflector matrix, p-by-p */
  gsl_matrix *R;        /* R factor, p-by-p */
  gsl_vector *QTb;      /* [ Q^T b ; b_i ], size p-by-1 */
  gsl_vector *work;     /* workspace, size p */
  gsl_vector *work3;    /* workspace, size 3*p */

  gsl_multifit_linear_workspace * multifit_workspace_p;
} tsqr_state_t;

static void *tsqr_alloc(const size_t p);
static void tsqr_free(void *vstate);
static int tsqr_reset(void *vstate);
static int tsqr_accumulate(gsl_matrix * A, gsl_vector * b,
                           void * vstate);
static int tsqr_solve(const double lambda, gsl_vector * x,
                      double * rnorm, double * snorm,
                      void * vstate);
static int tsqr_rcond(double * rcond, void * vstate);
static int tsqr_lcurve(gsl_vector * reg_param, gsl_vector * rho,
                       gsl_vector * eta, void * vstate);
static const gsl_matrix * tsqr_R(const void * vstate);
static const gsl_vector * tsqr_QTb(const void * vstate);
static int tsqr_svd(tsqr_state_t * state);

/*
tsqr_alloc()
  Allocate workspace for solving large linear least squares
problems using the TSQR approach

Inputs: p - number of columns of LS matrix

Return: pointer to workspace
*/

static void *
tsqr_alloc(const size_t p)
{
  tsqr_state_t *state;

  if (p == 0)
    {
      GSL_ERROR_NULL("p must be a positive integer",
                     GSL_EINVAL);
    }

  state = calloc(1, sizeof(tsqr_state_t));
  if (!state)
    {
      GSL_ERROR_NULL("failed to allocate tsqr state", GSL_ENOMEM);
    }

  state->p = p;
  state->nblocks = 0;
  state->rnorm = 0.0;

  state->R = gsl_matrix_alloc(p, p);
  if (state->R == NULL)
    {
      tsqr_free(state);
      GSL_ERROR_NULL("failed to allocate R matrix", GSL_ENOMEM);
    }

  state->QTb = gsl_vector_alloc(p);
  if (state->QTb == NULL)
    {
      tsqr_free(state);
      GSL_ERROR_NULL("failed to allocate QTb vector", GSL_ENOMEM);
    }

  state->T = gsl_matrix_alloc(p, p);
  if (state->T == NULL)
    {
      tsqr_free(state);
      GSL_ERROR_NULL("failed to allocate T matrix", GSL_ENOMEM);
    }

  state->work = gsl_vector_alloc(p);
  if (state->work == NULL)
    {
      tsqr_free(state);
      GSL_ERROR_NULL("failed to allocate workspace vector", GSL_ENOMEM);
    }

  state->work3 = gsl_vector_alloc(3 * p);
  if (state->work3 == NULL)
    {
      tsqr_free(state);
      GSL_ERROR_NULL("failed to allocate work3 vector", GSL_ENOMEM);
    }

  state->multifit_workspace_p = gsl_multifit_linear_alloc(p, p);
  if (state->multifit_workspace_p == NULL)
    {
      tsqr_free(state);
      GSL_ERROR_NULL("failed to allocate multifit workspace", GSL_ENOMEM);
    }

  return state;
}

static void
tsqr_free(void *vstate)
{
  tsqr_state_t *state = (tsqr_state_t *) vstate;

  if (state->R)
    gsl_matrix_free(state->R);

  if (state->QTb)
    gsl_vector_free(state->QTb);

  if (state->T)
    gsl_matrix_free(state->T);

  if (state->work)
    gsl_vector_free(state->work);

  if (state->work3)
    gsl_vector_free(state->work3);

  if (state->multifit_workspace_p)
    gsl_multifit_linear_free(state->multifit_workspace_p);

  free(state);
}

static int
tsqr_reset(void *vstate)
{
  tsqr_state_t *state = (tsqr_state_t *) vstate;

  gsl_matrix_set_zero(state->R);
  gsl_vector_set_zero(state->QTb);
  state->nblocks = 0;
  state->rnorm = 0.0;
  state->svd = 0;

  return GSL_SUCCESS;
}

/*
tsqr_accumulate()
  Add a new block of rows to the QR system

Inputs: A      - new block of rows, n-by-p
        b      - new rhs vector n-by-1
        vstate - workspace

Return: success/error

Notes:
1) On output, the upper triangular portion of state->R(1:p,1:p)
contains current R matrix

2) state->QTb(1:p) contains current Q^T b vector

3) A and b are destroyed
*/

static int
tsqr_accumulate(gsl_matrix * A, gsl_vector * b, void * vstate)
{
  tsqr_state_t *state = (tsqr_state_t *) vstate;
  const size_t n = A->size1;
  const size_t p = A->size2;

  if (p != state->p)
    {
      GSL_ERROR("columns of A do not match workspace", GSL_EBADLEN);
    }
  else if (n != b->size)
    {
      GSL_ERROR("A and b have different numbers of rows", GSL_EBADLEN);
    }
  else if (state->nblocks == 0 && n < p)
    {
      GSL_ERROR ("n must be >= p", GSL_EBADLEN);
    }
  else if (state->nblocks == 0)
    {
      int status;
      gsl_matrix_view R = gsl_matrix_submatrix(A, 0, 0, p, p);
      gsl_vector_view QTb = gsl_vector_subvector(state->QTb, 0, p);
      gsl_vector_view b1 = gsl_vector_subvector(b, 0, p);

      /* this is the first matrix block A_1, compute its (dense) QR decomposition */

      /* compute QR decomposition of A */
      status = gsl_linalg_QR_decomp_r(A, state->T);
      if (status)
        return status;

      /* store upper triangular R factor in state->R */
      gsl_matrix_tricpy(CblasUpper, CblasNonUnit, state->R, &R.matrix);

      /* compute Q^T b and keep the first p elements */
      gsl_linalg_QR_QTvec_r(A, state->T, b, state->work);
      gsl_vector_memcpy(&QTb.vector, &b1.vector);

      if (n > p)
        {
          gsl_vector_view b2 = gsl_vector_subvector(b, p, n - p);
          state->rnorm = gsl_blas_dnrm2(&b2.vector);
        }
      else
        state->rnorm = 0.0;

      state->nblocks = 1;

      return GSL_SUCCESS;
    }
  else
    {
      int status;

      /* compute QR decomposition of [ R_{i-1} ; A_i ], accounting for
       * sparse structure */
      status = gsl_linalg_QR_UR_decomp(state->R, A, state->T);
      if (status)
        return status;

      /*
       * Compute:
       *
       * Q^T [ QTb_{i-1} ] = [ QTb_{i-1} - w ]
       *     [    b_i    ]   [  b_i - V~ w   ]
       *
       * where:
       *
       * w = T^T (QTb_{i-1} + V~^T b_i)
       *
       *       p
       * V = [ I  ] p
       *     [ V~ ] n
       */
      gsl_vector_memcpy(state->work, state->QTb);
      gsl_blas_dgemv(CblasTrans, 1.0, A, b, 1.0, state->work);                     /* w := w + V~^T b */
      gsl_blas_dtrmv(CblasUpper, CblasTrans, CblasNonUnit, state->T, state->work); /* w := T^T w */
      gsl_vector_sub(state->QTb, state->work);                                     /* QTb := QTb - w */

      /* update residual norm */
      gsl_blas_dgemv(CblasNoTrans, -1.0, A, state->work, 1.0, b);                  /* b := b - V~ w */
      state->rnorm = gsl_hypot(state->rnorm, gsl_blas_dnrm2(b));

      return GSL_SUCCESS;
    }
}

/*
tsqr_solve()
  Solve the least squares system:

chi^2 = || QTb - R x ||^2 + lambda^2 || x ||^2

using the SVD of R

Inputs: lambda - regularization parameter
        x      - (output) solution vector p-by-1
        rnorm  - (output) residual norm ||b - A x||
        snorm  - (output) solution norm ||x||
        vstate - workspace

Return: success/error
*/

static int
tsqr_solve(const double lambda, gsl_vector * x,
           double * rnorm, double * snorm,
           void * vstate)
{
  tsqr_state_t *state = (tsqr_state_t *) vstate;

  if (x->size != state->p)
    {
      GSL_ERROR ("solution vector does not match workspace", GSL_EBADLEN);
    }
  else if (lambda < 0.0)
    {
      GSL_ERROR ("regularization parameter should be non-negative", GSL_EINVAL);
    }
  else
    {
      if (lambda == 0.0)
        {
          /* solve: R x = Q^T b */
          gsl_vector_memcpy(x, state->QTb);
          gsl_blas_dtrsv(CblasUpper, CblasNoTrans, CblasNonUnit, state->R, x);
          *rnorm = state->rnorm;
          *snorm = gsl_blas_dnrm2(x);
        }
      else
        {
          int status;

          /* compute SVD of R if not already computed */
          if (state->svd == 0)
            {
              status = tsqr_svd(state);
              if (status)
                return status;
            }

          status = gsl_multifit_linear_solve(lambda, state->R, state->QTb, x, rnorm, snorm,
                                             state->multifit_workspace_p);
          if (status)
            return status;

          *rnorm = gsl_hypot(*rnorm, state->rnorm);
        }

      return GSL_SUCCESS;
    }
}

/*
tsqr_lcurve()
  Compute L-curve of least squares system

Inputs: reg_param - (output) vector of regularization parameters
        rho       - (output) vector of residual norms
        eta       - (output) vector of solution norms
        vstate    - workspace

Return: success/error
*/

static int
tsqr_lcurve(gsl_vector * reg_param, gsl_vector * rho,
            gsl_vector * eta, void * vstate)
{
  tsqr_state_t *state = (tsqr_state_t *) vstate;
  int status;
  size_t i;

  /* compute SVD of R if not already computed */
  if (state->svd == 0)
    {
      status = tsqr_svd(state);
      if (status)
        return status;
    }

  status = gsl_multifit_linear_lcurve(state->QTb, reg_param, rho, eta,
                                      state->multifit_workspace_p);

  /* now add contribution to rnorm from Q2 factor */
  for (i = 0; i < rho->size; ++i)
    {
      double *rhoi = gsl_vector_ptr(rho, i);
      *rhoi = gsl_hypot(*rhoi, state->rnorm);
    }

  return status;
}

static const gsl_matrix *
tsqr_R(const void * vstate)
{
  const tsqr_state_t *state = (const tsqr_state_t *) vstate;
  return state->R;
}

static const gsl_vector *
tsqr_QTb(const void * vstate)
{
  const tsqr_state_t *state = (const tsqr_state_t *) vstate;
  return state->QTb;
}

static int
tsqr_rcond(double * rcond, void * vstate)
{
  tsqr_state_t *state = (tsqr_state_t *) vstate;
  return gsl_linalg_tri_rcond(CblasUpper, state->R, rcond, state->work3);
}

/*
tsqr_svd()
  Compute the SVD of the upper triangular
R factor. This allows us to compute the upper/lower
bounds on the regularization parameter and compute
the matrix reciprocal condition number.

Inputs: state - workspace

Return: success/error
*/

static int
tsqr_svd(tsqr_state_t * state)
{
  int status;

  status = gsl_multifit_linear_svd(state->R, state->multifit_workspace_p);
  if (status)
    {
      GSL_ERROR("error computing SVD of R", status);
    }

  state->svd = 1;

  return GSL_SUCCESS;
}

static const gsl_multilarge_linear_type tsqr_type =
{
  "tsqr",
  tsqr_alloc,
  tsqr_reset,
  tsqr_accumulate,
  tsqr_solve,
  tsqr_rcond,
  tsqr_lcurve,
  tsqr_R,
  tsqr_QTb,
  tsqr_free
};

const gsl_multilarge_linear_type * gsl_multilarge_linear_tsqr = &tsqr_type;


#include <stdio.h>
#include <gsl/gsl_sf_bessel.h>

int
main (void)
{
  double x = 5.0;
  double expected = -0.17759677131433830434739701;

  double y = gsl_sf_bessel_J0 (x);

  printf ("J0(5.0) = %.18f\n", y);
  printf ("exact   = %.18f\n", expected);
  return 0;
}


/* examples/C/ssmfe/hermitian.c - Example code for SPRAL_SSMFE package */
/* Hermitian operator example */
#include "spral.h"
#include <math.h>
#include <stdlib.h>
#include <stdio.h>
#include <cblas.h>

/* central differences for i d/dx */
void apply_idx(int n, int m, const double complex *x_ptr, double complex *y_ptr) {
   const double complex (*x)[n] = (const double complex (*)[n]) x_ptr;
   double complex (*y)[n] = (double complex (*)[n]) y_ptr;
   for(int j=0; j<m; j++) {
      for(int i=0; i<n; i++) {
         int il = (i==0)   ? n-1 : i-1;
         int ir = (i==n-1) ? 0   : i+1;
         y[j][i] = _Complex_I * (x[j][ir] - x[j][il]);
      }
   }
}

/* main routine */
int main(void) {
   const int n   = 80;                 /* problem size */
   const int nep = 5;                  /* eigenpairs wanted */

   double lambda[nep];                 /* eigenvalues */
   double complex X[nep][n];           /* eigenvectors */
   struct spral_ssmfe_rciz rci;        /* reverse communication data */
   struct spral_ssmfe_options options; /* options */
   void *keep;                         /* private data */
   struct spral_ssmfe_inform inform;   /* information */

   /* Initialize options to default values */
   spral_ssmfe_default_options(&options);

   rci.job = 0; keep = NULL;
   while(true) { /* reverse communication loop */
      spral_ssmfe_standard_double_complex(&rci, nep, nep, lambda, n,
         &X[0][0], n, &keep, &options, &inform);
      switch ( rci.job ) {
      case 1:
         apply_idx(n, rci.nx, rci.x, rci.y);
         break;
      case 2:
         // No preconditioning
         break;
      default:
         goto finished;
      }
   }
finished:
   printf("%d eigenpairs converged in %d iterations\n", inform.left, inform.iteration);
   for(int i=0; i<inform.left; i++)
      printf(" lambda[%1d] = %13.7e\n", i, lambda[i]);
   spral_ssmfe_free_double_complex(&keep, &inform);

   /* Success */
   return 0;
}


#pragma once
//! \file This file defines some C APIs to trigger CBLAS methods.
#include "cinn/runtime/cinn_runtime.h"

#ifdef CINN_WITH_MKL_CBLAS
#include <mkl_cblas.h>
#else
#include <cblas.h>
#endif

// define some C APIs
extern "C" {

/**
 * \brief Do GEMM on buffer A and B and write result to buffer C.
 * We pass the \param M, \param N, \param K although the shape can retrieve from cinn_buffer_t because the size of a
 * matrix not equals the shape of a buffer it is stored.
 * @param alpha The scaling factor of the product of A and B
 * @param M Number of the rows of A
 * @param N the number of the columns in both B and C
 * @param K the number of columns of A
 * @param ta whether to transpose A
 * @param tb whether to transpose B
 * @param lda The size of the first dimension of A
 * @param ldb The size of the first dimension of B
 * @param ldc The size of the first dimension of C
 * @param beta The scaling factor of C
 * @param A The matrix A
 * @param B The matrix B
 * @param C The output matrix
 */
void cinn_cpu_mkl_gemm_fp32(float alpha,
                            int M,
                            int N,
                            int K,
                            bool ta,
                            bool tb,
                            int lda,
                            int ldb,
                            int ldc,
                            float beta,
                            cinn_buffer_t* A,
                            cinn_buffer_t* B,
                            cinn_buffer_t* C);
}  // extern "C"


// Copyright (c) 2017, Lawrence Livermore National Security, LLC. Produced at
// the Lawrence Livermore National Laboratory. LLNL-CODE-734707. All Rights
// reserved. See files LICENSE and NOTICE for details.
//
// This file is part of CEED, a collection of benchmarks, miniapps, software
// libraries and APIs for efficient high-order finite element and spectral
// element discretizations for exascale applications. For more information and
// source code availability see http://github.com/ceed.
//
// The CEED research is supported by the Exascale Computing Project 17-SC-20-SC,
// a collaborative effort of two U.S. Department of Energy organizations (Office
// of Science and the National Nuclear Security Administration) responsible for
// the planning and preparation of a capable exascale ecosystem, including
// software, applications, hardware, advanced system engineering and early
// testbed platforms, in support of the nation's exascale computing imperative.

//                        libCEED + PETSc Example: CEED BPs 3-6 with Multigrid
//
// This example demonstrates a simple usage of libCEED with PETSc to solve the
// CEED BP benchmark problems, see http://ceed.exascaleproject.org/bps.
//
// The code uses higher level communication protocols in DMPlex.
//
// Build with:
//
//     make multigrid [PETSC_DIR=</path/to/petsc>] [CEED_DIR=</path/to/libceed>]
//
// Sample runs:
//
//     multigrid -problem bp3
//     multigrid -problem bp4
//     multigrid -problem bp5 -ceed /cpu/self
//     multigrid -problem bp6 -ceed /gpu/cuda
//
//TESTARGS -ceed {ceed_resource} -test -problem bp3 -degree 3

/// @file
/// CEED BPs 1-6 multigrid example using PETSc
const char help[] = "Solve CEED BPs using p-multigrid with PETSc and DMPlex\n";

#include <stdbool.h>
#include <string.h>
#include <ceed.h>
#include <petsc.h>
#include <petscdmplex.h>
#include <petscksp.h>
#include <petscsys.h>

#include "bps.h"
#include "include/bpsproblemdata.h"
#include "include/petscmacros.h"
#include "include/petscutils.h"
#include "include/matops.h"
#include "include/structs.h"
#include "include/libceedsetup.h"

#if PETSC_VERSION_LT(3,12,0)
#ifdef PETSC_HAVE_CUDA
#include <petsccuda.h>
// Note: With PETSc prior to version 3.12.0, providing the source path to
//       include 'cublas_v2.h' will be needed to use 'petsccuda.h'.
#endif
#endif

int main(int argc, char **argv) {
  PetscInt ierr;
  MPI_Comm comm;
  char filename[PETSC_MAX_PATH_LEN],
       ceed_resource[PETSC_MAX_PATH_LEN] = "/cpu/self";
  double my_rt_start, my_rt, rt_min, rt_max;
  PetscInt degree = 3, q_extra, *l_size, *xl_size, *g_size, dim = 3, fine_level,
           mesh_elem[3] = {3, 3, 3}, num_comp_u = 1, num_levels = degree, *level_degrees;
  PetscScalar *r;
  PetscScalar eps = 1.0;
  PetscBool test_mode, benchmark_mode, read_mesh, write_solution;
  PetscLogStage solve_stage;
  DM  *dm, dm_orig;
  SNES snes_dummy;
  KSP ksp;
  PC pc;
  Mat *mat_O, *mat_pr, mat_coarse;
  Vec *X, *X_loc, *mult, rhs, rhs_loc;
  PetscMemType mem_type;
  UserO *user_O;
  UserProlongRestr *user_pr;
  Ceed ceed;
  CeedData *ceed_data;
  CeedVector rhs_ceed, target;
  CeedQFunction qf_error, qf_restrict, qf_prolong;
  CeedOperator op_error;
  BPType bp_choice;
  CoarsenType coarsen;

  ierr = PetscInitialize(&argc, &argv, NULL, help);
  if (ierr) return ierr;
  comm = PETSC_COMM_WORLD;

  // Parse command line options
  ierr = PetscOptionsBegin(comm, NULL, "CEED BPs in PETSc", NULL); CHKERRQ(ierr);
  bp_choice = CEED_BP3;
  ierr = PetscOptionsEnum("-problem",
                          "CEED benchmark problem to solve", NULL,
                          bp_types, (PetscEnum)bp_choice, (PetscEnum *)&bp_choice,
                          NULL); CHKERRQ(ierr);
  num_comp_u = bp_options[bp_choice].num_comp_u;
  test_mode = PETSC_FALSE;
  ierr = PetscOptionsBool("-test",
                          "Testing mode (do not print unless error is large)",
                          NULL, test_mode, &test_mode, NULL); CHKERRQ(ierr);
  benchmark_mode = PETSC_FALSE;
  ierr = PetscOptionsBool("-benchmark",
                          "Benchmarking mode (prints benchmark statistics)",
                          NULL, benchmark_mode, &benchmark_mode, NULL);
  CHKERRQ(ierr);
  write_solution = PETSC_FALSE;
  ierr = PetscOptionsBool("-write_solution",
                          "Write solution for visualization",
                          NULL, write_solution, &write_solution, NULL);
  CHKERRQ(ierr);
  ierr = PetscOptionsScalar("-eps",
                            "Epsilon parameter for Kershaw mesh transformation",
                            NULL, eps, &eps, NULL);
  if (eps > 1 || eps <= 0) SETERRQ1(PETSC_COMM_WORLD, PETSC_ERR_ARG_OUTOFRANGE,
                                      "-eps %D must be (0,1]", eps);
  degree = test_mode ? 3 : 2;
  ierr = PetscOptionsInt("-degree", "Polynomial degree of tensor product basis",
                         NULL, degree, &degree, NULL); CHKERRQ(ierr);
  if (degree < 1) SETERRQ1(PETSC_COMM_WORLD, PETSC_ERR_ARG_OUTOFRANGE,
                             "-degree %D must be at least 1", degree);
  q_extra = bp_options[bp_choice].q_extra;
  ierr = PetscOptionsInt("-q_extra", "Number of extra quadrature points",
                         NULL, q_extra, &q_extra, NULL); CHKERRQ(ierr);
  ierr = PetscOptionsString("-ceed", "CEED resource specifier",
                            NULL, ceed_resource, ceed_resource,
                            sizeof(ceed_resource), NULL); CHKERRQ(ierr);
  coarsen = COARSEN_UNIFORM;
  ierr = PetscOptionsEnum("-coarsen",
                          "Coarsening strategy to use", NULL,
                          coarsen_types, (PetscEnum)coarsen,
                          (PetscEnum *)&coarsen, NULL); CHKERRQ(ierr);
  read_mesh = PETSC_FALSE;
  ierr = PetscOptionsString("-mesh", "Read mesh from file", NULL,
                            filename, filename, sizeof(filename), &read_mesh);
  CHKERRQ(ierr);
  if (!read_mesh) {
    PetscInt tmp = dim;
    ierr = PetscOptionsIntArray("-cells","Number of cells per dimension", NULL,
                                mesh_elem, &tmp, NULL); CHKERRQ(ierr);
  }
  ierr = PetscOptionsEnd(); CHKERRQ(ierr);

  // Set up libCEED
  CeedInit(ceed_resource, &ceed);
  CeedMemType mem_type_backend;
  CeedGetPreferredMemType(ceed, &mem_type_backend);

  // Setup DM
  if (read_mesh) {
    ierr = DMPlexCreateFromFile(PETSC_COMM_WORLD, filename, PETSC_TRUE, &dm_orig);
    CHKERRQ(ierr);
  } else {
    ierr = DMPlexCreateBoxMesh(PETSC_COMM_WORLD, dim, PETSC_FALSE, mesh_elem, NULL,
                               NULL, NULL, PETSC_TRUE, &dm_orig); CHKERRQ(ierr);
  }

  {
    DM dm_dist = NULL;
    PetscPartitioner part;

    ierr = DMPlexGetPartitioner(dm_orig, &part); CHKERRQ(ierr);
    ierr = PetscPartitionerSetFromOptions(part); CHKERRQ(ierr);
    ierr = DMPlexDistribute(dm_orig, 0, NULL, &dm_dist); CHKERRQ(ierr);
    if (dm_dist) {
      ierr = DMDestroy(&dm_orig); CHKERRQ(ierr);
      dm_orig = dm_dist;
    }
  }

  // Apply Kershaw mesh transformation
  ierr = Kershaw(dm_orig, eps); CHKERRQ(ierr);

  VecType vec_type;
  switch (mem_type_backend) {
  case CEED_MEM_HOST: vec_type = VECSTANDARD; break;
  case CEED_MEM_DEVICE: {
    const char *resolved;
    CeedGetResource(ceed, &resolved);
    if (strstr(resolved, "/gpu/cuda")) vec_type = VECCUDA;
    else if (strstr(resolved, "/gpu/hip/occa"))
      vec_type = VECSTANDARD; // https://github.com/CEED/libCEED/issues/678
    else if (strstr(resolved, "/gpu/hip")) vec_type = VECHIP;
    else vec_type = VECSTANDARD;
  }
  }
  ierr = DMSetVecType(dm_orig, vec_type); CHKERRQ(ierr);
  ierr = DMSetFromOptions(dm_orig); CHKERRQ(ierr);

  // Allocate arrays for PETSc objects for each level
  switch (coarsen) {
  case COARSEN_UNIFORM:
    num_levels = degree;
    break;
  case COARSEN_LOGARITHMIC:
    num_levels = ceil(log(degree)/log(2)) + 1;
    break;
  }
  ierr = PetscMalloc1(num_levels, &level_degrees); CHKERRQ(ierr);
  fine_level = num_levels - 1;

  switch (coarsen) {
  case COARSEN_UNIFORM:
    for (int i=0; i<num_levels; i++) level_degrees[i] = i + 1;
    break;
  case COARSEN_LOGARITHMIC:
    for (int i=0; i<num_levels - 1; i++) level_degrees[i] = pow(2,i);
    level_degrees[fine_level] = degree;
    break;
  }
  ierr = PetscMalloc1(num_levels, &dm); CHKERRQ(ierr);
  ierr = PetscMalloc1(num_levels, &X); CHKERRQ(ierr);
  ierr = PetscMalloc1(num_levels, &X_loc); CHKERRQ(ierr);
  ierr = PetscMalloc1(num_levels, &mult); CHKERRQ(ierr);
  ierr = PetscMalloc1(num_levels, &user_O); CHKERRQ(ierr);
  ierr = PetscMalloc1(num_levels, &user_pr); CHKERRQ(ierr);
  ierr = PetscMalloc1(num_levels, &mat_O); CHKERRQ(ierr);
  ierr = PetscMalloc1(num_levels, &mat_pr); CHKERRQ(ierr);
  ierr = PetscMalloc1(num_levels, &l_size); CHKERRQ(ierr);
  ierr = PetscMalloc1(num_levels, &xl_size); CHKERRQ(ierr);
  ierr = PetscMalloc1(num_levels, &g_size); CHKERRQ(ierr);

  // Setup DM and Operator Mat Shells for each level
  for (CeedInt i=0; i<num_levels; i++) {
    // Create DM
    ierr = DMClone(dm_orig, &dm[i]); CHKERRQ(ierr);
    ierr = DMGetVecType(dm_orig, &vec_type); CHKERRQ(ierr);
    ierr = DMSetVecType(dm[i], vec_type); CHKERRQ(ierr);
    PetscInt dim;
    ierr = DMGetDimension(dm[i], &dim); CHKERRQ(ierr);
    ierr = SetupDMByDegree(dm[i], level_degrees[i], num_comp_u, dim,
                           bp_options[bp_choice].enforce_bc, bp_options[bp_choice].bc_func);
    CHKERRQ(ierr);

    // Create vectors
    ierr = DMCreateGlobalVector(dm[i], &X[i]); CHKERRQ(ierr);
    ierr = VecGetLocalSize(X[i], &l_size[i]); CHKERRQ(ierr);
    ierr = VecGetSize(X[i], &g_size[i]); CHKERRQ(ierr);
    ierr = DMCreateLocalVector(dm[i], &X_loc[i]); CHKERRQ(ierr);
    ierr = VecGetSize(X_loc[i], &xl_size[i]); CHKERRQ(ierr);

    // Operator
    ierr = PetscMalloc1(1, &user_O[i]); CHKERRQ(ierr);
    ierr = MatCreateShell(comm, l_size[i], l_size[i], g_size[i], g_size[i],
                          user_O[i], &mat_O[i]); CHKERRQ(ierr);
    ierr = MatShellSetOperation(mat_O[i], MATOP_MULT,
                                (void(*)(void))MatMult_Ceed); CHKERRQ(ierr);
    ierr = MatShellSetOperation(mat_O[i], MATOP_GET_DIAGONAL,
                                (void(*)(void))MatGetDiag); CHKERRQ(ierr);
    ierr = MatShellSetVecType(mat_O[i], vec_type); CHKERRQ(ierr);

    // Level transfers
    if (i > 0) {
      // Interp
      ierr = PetscMalloc1(1, &user_pr[i]); CHKERRQ(ierr);
      ierr = MatCreateShell(comm, l_size[i], l_size[i-1], g_size[i], g_size[i-1],
                            user_pr[i], &mat_pr[i]); CHKERRQ(ierr);
      ierr = MatShellSetOperation(mat_pr[i], MATOP_MULT,
                                  (void(*)(void))MatMult_Prolong);
      CHKERRQ(ierr);
      ierr = MatShellSetOperation(mat_pr[i], MATOP_MULT_TRANSPOSE,
                                  (void(*)(void))MatMult_Restrict);
      CHKERRQ(ierr);
      ierr = MatShellSetVecType(mat_pr[i], vec_type); CHKERRQ(ierr);
    }
  }
  ierr = VecDuplicate(X[fine_level], &rhs); CHKERRQ(ierr);

  // Print global grid information
  if (!test_mode) {
    PetscInt P = degree + 1, Q = P + q_extra;

    const char *used_resource;
    CeedGetResource(ceed, &used_resource);

    ierr = VecGetType(X[0], &vec_type); CHKERRQ(ierr);

    ierr = PetscPrintf(comm,
                       "\n-- CEED Benchmark Problem %d -- libCEED + PETSc + PCMG --\n"
                       "  PETSc:\n"
                       "    PETSc Vec Type                     : %s\n"
                       "  libCEED:\n"
                       "    libCEED Backend                    : %s\n"
                       "    libCEED Backend MemType            : %s\n"
                       "  Mesh:\n"
                       "    Number of 1D Basis Nodes (p)       : %d\n"
                       "    Number of 1D Quadrature Points (q) : %d\n"
                       "    Global Nodes                       : %D\n"
                       "    Owned Nodes                        : %D\n"
                       "    DoF per node                       : %D\n"
                       "  Multigrid:\n"
                       "    Number of Levels                   : %d\n",
                       bp_choice+1, vec_type, used_resource,
                       CeedMemTypes[mem_type_backend],
                       P, Q, g_size[fine_level]/num_comp_u, l_size[fine_level]/num_comp_u,
                       num_comp_u, num_levels); CHKERRQ(ierr);
  }

  // Create RHS vector
  ierr = VecDuplicate(X_loc[fine_level], &rhs_loc); CHKERRQ(ierr);
  ierr = VecZeroEntries(rhs_loc); CHKERRQ(ierr);
  ierr = VecGetArrayAndMemType(rhs_loc, &r, &mem_type); CHKERRQ(ierr);
  CeedVectorCreate(ceed, xl_size[fine_level], &rhs_ceed);
  CeedVectorSetArray(rhs_ceed, MemTypeP2C(mem_type), CEED_USE_POINTER, r);

  // Set up libCEED operators on each level
  ierr = PetscMalloc1(num_levels, &ceed_data); CHKERRQ(ierr);
  for (int i=0; i<num_levels; i++) {
    // Print level information
    if (!test_mode && (i == 0 || i == fine_level)) {
      ierr = PetscPrintf(comm,"    Level %D (%s):\n"
                         "      Number of 1D Basis Nodes (p)     : %d\n"
                         "      Global Nodes                     : %D\n"
                         "      Owned Nodes                      : %D\n",
                         i, (i? "fine" : "coarse"), level_degrees[i] + 1,
                         g_size[i]/num_comp_u, l_size[i]/num_comp_u); CHKERRQ(ierr);
    }
    ierr = PetscMalloc1(1, &ceed_data[i]); CHKERRQ(ierr);
    ierr = SetupLibceedByDegree(dm[i], ceed, level_degrees[i], dim, q_extra,
                                dim, num_comp_u, g_size[i], xl_size[i], bp_options[bp_choice],
                                ceed_data[i], i==(fine_level), rhs_ceed, &target);
    CHKERRQ(ierr);
  }

  // Gather RHS
  CeedVectorTakeArray(rhs_ceed, MemTypeP2C(mem_type), NULL);
  ierr = VecRestoreArrayAndMemType(rhs_loc, &r); CHKERRQ(ierr);
  ierr = VecZeroEntries(rhs); CHKERRQ(ierr);
  ierr = DMLocalToGlobal(dm[fine_level], rhs_loc, ADD_VALUES, rhs); CHKERRQ(ierr);
  CeedVectorDestroy(&rhs_ceed);

  // Create the restriction/interpolation QFunction
  CeedQFunctionCreateIdentity(ceed, num_comp_u, CEED_EVAL_NONE, CEED_EVAL_INTERP,
                              &qf_restrict);
  CeedQFunctionCreateIdentity(ceed, num_comp_u, CEED_EVAL_INTERP, CEED_EVAL_NONE,
                              &qf_prolong);

  // Set up libCEED level transfer operators
  ierr = CeedLevelTransferSetup(ceed, num_levels, num_comp_u, ceed_data,
                                level_degrees,
                                qf_restrict, qf_prolong); CHKERRQ(ierr);

  // Create the error QFunction
  CeedQFunctionCreateInterior(ceed, 1, bp_options[bp_choice].error,
                              bp_options[bp_choice].error_loc, &qf_error);
  CeedQFunctionAddInput(qf_error, "u", num_comp_u, CEED_EVAL_INTERP);
  CeedQFunctionAddInput(qf_error, "true_soln", num_comp_u, CEED_EVAL_NONE);
  CeedQFunctionAddOutput(qf_error, "error", num_comp_u, CEED_EVAL_NONE);

  // Create the error operator
  CeedOperatorCreate(ceed, qf_error, CEED_QFUNCTION_NONE, CEED_QFUNCTION_NONE,
                     &op_error);
  CeedOperatorSetField(op_error, "u", ceed_data[fine_level]->elem_restr_u,
                       ceed_data[fine_level]->basis_u, CEED_VECTOR_ACTIVE);
  CeedOperatorSetField(op_error, "true_soln",
                       ceed_data[fine_level]->elem_restr_u_i,
                       CEED_BASIS_COLLOCATED, target);
  CeedOperatorSetField(op_error, "error", ceed_data[fine_level]->elem_restr_u_i,
                       CEED_BASIS_COLLOCATED, CEED_VECTOR_ACTIVE);

  // Calculate multiplicity
  for (int i=0; i<num_levels; i++) {
    PetscScalar *x;

    // CEED vector
    ierr = VecZeroEntries(X_loc[i]); CHKERRQ(ierr);
    ierr = VecGetArray(X_loc[i], &x); CHKERRQ(ierr);
    CeedVectorSetArray(ceed_data[i]->x_ceed, CEED_MEM_HOST, CEED_USE_POINTER, x);

    // Multiplicity
    CeedElemRestrictionGetMultiplicity(ceed_data[i]->elem_restr_u,
                                       ceed_data[i]->x_ceed);
    CeedVectorSyncArray(ceed_data[i]->x_ceed, CEED_MEM_HOST);

    // Restore vector
    ierr = VecRestoreArray(X_loc[i], &x); CHKERRQ(ierr);

    // Creat mult vector
    ierr = VecDuplicate(X_loc[i], &mult[i]); CHKERRQ(ierr);

    // Local-to-global
    ierr = VecZeroEntries(X[i]); CHKERRQ(ierr);
    ierr = DMLocalToGlobal(dm[i], X_loc[i], ADD_VALUES, X[i]);
    CHKERRQ(ierr);
    ierr = VecZeroEntries(X_loc[i]); CHKERRQ(ierr);

    // Global-to-local
    ierr = DMGlobalToLocal(dm[i], X[i], INSERT_VALUES, mult[i]);
    CHKERRQ(ierr);
    ierr = VecZeroEntries(X[i]); CHKERRQ(ierr);

    // Multiplicity scaling
    ierr = VecReciprocal(mult[i]);
  }

  // Set up Mat
  for (int i=0; i<num_levels; i++) {
    // User Operator
    user_O[i]->comm = comm;
    user_O[i]->dm = dm[i];
    user_O[i]->X_loc = X_loc[i];
    ierr = VecDuplicate(X_loc[i], &user_O[i]->Y_loc); CHKERRQ(ierr);
    user_O[i]->x_ceed = ceed_data[i]->x_ceed;
    user_O[i]->y_ceed = ceed_data[i]->y_ceed;
    user_O[i]->op = ceed_data[i]->op_apply;
    user_O[i]->ceed = ceed;

    if (i > 0) {
      // Prolongation/Restriction Operator
      user_pr[i]->comm = comm;
      user_pr[i]->dmf = dm[i];
      user_pr[i]->dmc = dm[i-1];
      user_pr[i]->loc_vec_c = X_loc[i-1];
      user_pr[i]->loc_vec_f = user_O[i]->Y_loc;
      user_pr[i]->mult_vec = mult[i];
      user_pr[i]->ceed_vec_c = user_O[i-1]->x_ceed;
      user_pr[i]->ceed_vec_f = user_O[i]->y_ceed;
      user_pr[i]->op_prolong = ceed_data[i]->op_prolong;
      user_pr[i]->op_restrict = ceed_data[i]->op_restrict;
      user_pr[i]->ceed = ceed;
    }
  }

  // Setup dummy SNES for AMG coarse solve
  ierr = SNESCreate(comm, &snes_dummy); CHKERRQ(ierr);
  ierr = SNESSetDM(snes_dummy, dm[0]); CHKERRQ(ierr);
  ierr = SNESSetSolution(snes_dummy, X[0]); CHKERRQ(ierr);

  // -- Jacobian matrix
  ierr = DMSetMatType(dm[0], MATAIJ); CHKERRQ(ierr);
  ierr = DMCreateMatrix(dm[0], &mat_coarse); CHKERRQ(ierr);
  ierr = SNESSetJacobian(snes_dummy, mat_coarse, mat_coarse, NULL,
                         NULL); CHKERRQ(ierr);

  // -- Residual evaluation function
  ierr = SNESSetFunction(snes_dummy, X[0], FormResidual_Ceed,
                         user_O[0]); CHKERRQ(ierr);

  // -- Form Jacobian
  ierr = SNESComputeJacobianDefaultColor(snes_dummy, X[0], mat_O[0],
                                         mat_coarse, NULL); CHKERRQ(ierr);

  // Set up KSP
  ierr = KSPCreate(comm, &ksp); CHKERRQ(ierr);
  {
    ierr = KSPSetType(ksp, KSPCG); CHKERRQ(ierr);
    ierr = KSPSetNormType(ksp, KSP_NORM_NATURAL); CHKERRQ(ierr);
    ierr = KSPSetTolerances(ksp, 1e-10, PETSC_DEFAULT, PETSC_DEFAULT,
                            PETSC_DEFAULT); CHKERRQ(ierr);
  }
  ierr = KSPSetFromOptions(ksp); CHKERRQ(ierr);
  ierr = KSPSetOperators(ksp, mat_O[fine_level], mat_O[fine_level]);
  CHKERRQ(ierr);

  // Set up PCMG
  ierr = KSPGetPC(ksp, &pc); CHKERRQ(ierr);
  PCMGCycleType pcmg_cycle_type = PC_MG_CYCLE_V;
  {
    ierr = PCSetType(pc, PCMG); CHKERRQ(ierr);

    // PCMG levels
    ierr = PCMGSetLevels(pc, num_levels, NULL); CHKERRQ(ierr);
    for (int i=0; i<num_levels; i++) {
      // Smoother
      KSP smoother;
      PC smoother_pc;
      ierr = PCMGGetSmoother(pc, i, &smoother); CHKERRQ(ierr);
      ierr = KSPSetType(smoother, KSPCHEBYSHEV); CHKERRQ(ierr);
      ierr = KSPChebyshevEstEigSet(smoother, 0, 0.1, 0, 1.1); CHKERRQ(ierr);
      ierr = KSPChebyshevEstEigSetUseNoisy(smoother, PETSC_TRUE); CHKERRQ(ierr);
      ierr = KSPSetOperators(smoother, mat_O[i], mat_O[i]); CHKERRQ(ierr);
      ierr = KSPGetPC(smoother, &smoother_pc); CHKERRQ(ierr);
      ierr = PCSetType(smoother_pc, PCJACOBI); CHKERRQ(ierr);
      ierr = PCJacobiSetType(smoother_pc, PC_JACOBI_DIAGONAL); CHKERRQ(ierr);

      // Work vector
      if (i < num_levels - 1) {
        ierr = PCMGSetX(pc, i, X[i]); CHKERRQ(ierr);
      }

      // Level transfers
      if (i > 0) {
        // Interpolation
        ierr = PCMGSetInterpolation(pc, i, mat_pr[i]); CHKERRQ(ierr);
      }

      // Coarse solve
      KSP coarse;
      PC coarse_pc;
      ierr = PCMGGetCoarseSolve(pc, &coarse); CHKERRQ(ierr);
      ierr = KSPSetType(coarse, KSPPREONLY); CHKERRQ(ierr);
      ierr = KSPSetOperators(coarse, mat_coarse, mat_coarse); CHKERRQ(ierr);

      ierr = KSPGetPC(coarse, &coarse_pc); CHKERRQ(ierr);
      ierr = PCSetType(coarse_pc, PCGAMG); CHKERRQ(ierr);

      ierr = KSPSetOptionsPrefix(coarse, "coarse_"); CHKERRQ(ierr);
      ierr = PCSetOptionsPrefix(coarse_pc, "coarse_"); CHKERRQ(ierr);
      ierr = KSPSetFromOptions(coarse); CHKERRQ(ierr);
      ierr = PCSetFromOptions(coarse_pc); CHKERRQ(ierr);
    }

    // PCMG options
    ierr = PCMGSetType(pc, PC_MG_MULTIPLICATIVE); CHKERRQ(ierr);
    ierr = PCMGSetNumberSmooth(pc, 3); CHKERRQ(ierr);
    ierr = PCMGSetCycleType(pc, pcmg_cycle_type); CHKERRQ(ierr);
  }

  // First run, if benchmarking
  if (benchmark_mode) {
    ierr = KSPSetTolerances(ksp, 1e-10, PETSC_DEFAULT, PETSC_DEFAULT, 1);
    CHKERRQ(ierr);
    ierr = VecZeroEntries(X[fine_level]); CHKERRQ(ierr);
    my_rt_start = MPI_Wtime();
    ierr = KSPSolve(ksp, rhs, X[fine_level]); CHKERRQ(ierr);
    my_rt = MPI_Wtime() - my_rt_start;
    ierr = MPI_Allreduce(MPI_IN_PLACE, &my_rt, 1, MPI_DOUBLE, MPI_MIN, comm);
    CHKERRQ(ierr);
    // Set maxits based on first iteration timing
    if (my_rt > 0.02) {
      ierr = KSPSetTolerances(ksp, 1e-10, PETSC_DEFAULT, PETSC_DEFAULT, 5);
      CHKERRQ(ierr);
    } else {
      ierr = KSPSetTolerances(ksp, 1e-10, PETSC_DEFAULT, PETSC_DEFAULT, 20);
      CHKERRQ(ierr);
    }
  }

  // Timed solve
  ierr = VecZeroEntries(X[fine_level]); CHKERRQ(ierr);
  ierr = PetscBarrier((PetscObject)ksp); CHKERRQ(ierr);

  // -- Performance logging
  ierr = PetscLogStageRegister("Solve Stage", &solve_stage); CHKERRQ(ierr);
  ierr = PetscLogStagePush(solve_stage); CHKERRQ(ierr);

  // -- Solve
  my_rt_start = MPI_Wtime();
  ierr = KSPSolve(ksp, rhs, X[fine_level]); CHKERRQ(ierr);
  my_rt = MPI_Wtime() - my_rt_start;

  // -- Performance logging
  ierr = PetscLogStagePop();

  // Output results
  {
    KSPType ksp_type;
    PCMGType pcmg_type;
    KSPConvergedReason reason;
    PetscReal rnorm;
    PetscInt its;
    ierr = KSPGetType(ksp, &ksp_type); CHKERRQ(ierr);
    ierr = KSPGetConvergedReason(ksp, &reason); CHKERRQ(ierr);
    ierr = KSPGetIterationNumber(ksp, &its); CHKERRQ(ierr);
    ierr = KSPGetResidualNorm(ksp, &rnorm); CHKERRQ(ierr);
    ierr = PCMGGetType(pc, &pcmg_type); CHKERRQ(ierr);
    if (!test_mode || reason < 0 || rnorm > 1e-8) {
      ierr = PetscPrintf(comm,
                         "  KSP:\n"
                         "    KSP Type                           : %s\n"
                         "    KSP Convergence                    : %s\n"
                         "    Total KSP Iterations               : %D\n"
                         "    Final rnorm                        : %e\n",
                         ksp_type, KSPConvergedReasons[reason], its,
                         (double)rnorm); CHKERRQ(ierr);
      ierr = PetscPrintf(comm,
                         "  PCMG:\n"
                         "    PCMG Type                          : %s\n"
                         "    PCMG Cycle Type                    : %s\n",
                         PCMGTypes[pcmg_type],
                         PCMGCycleTypes[pcmg_cycle_type]); CHKERRQ(ierr);
    }
    if (!test_mode) {
      ierr = PetscPrintf(comm,"  Performance:\n"); CHKERRQ(ierr);
    }
    {
      PetscReal max_error;
      ierr = ComputeErrorMax(user_O[fine_level], op_error, X[fine_level], target,
                             &max_error); CHKERRQ(ierr);
      PetscReal tol = 5e-2;
      if (!test_mode || max_error > tol) {
        ierr = MPI_Allreduce(&my_rt, &rt_min, 1, MPI_DOUBLE, MPI_MIN, comm);
        CHKERRQ(ierr);
        ierr = MPI_Allreduce(&my_rt, &rt_max, 1, MPI_DOUBLE, MPI_MAX, comm);
        CHKERRQ(ierr);
        ierr = PetscPrintf(comm,
                           "    Pointwise Error (max)              : %e\n"
                           "    CG Solve Time                      : %g (%g) sec\n",
                           (double)max_error, rt_max, rt_min); CHKERRQ(ierr);
      }
    }
    if (benchmark_mode && (!test_mode)) {
      ierr = PetscPrintf(comm,
                         "    DoFs/Sec in CG                     : %g (%g) million\n",
                         1e-6*g_size[fine_level]*its/rt_max,
                         1e-6*g_size[fine_level]*its/rt_min);
      CHKERRQ(ierr);
    }
  }

  if (write_solution) {
    PetscViewer vtk_viewer_soln;

    ierr = PetscViewerCreate(comm, &vtk_viewer_soln); CHKERRQ(ierr);
    ierr = PetscViewerSetType(vtk_viewer_soln, PETSCVIEWERVTK); CHKERRQ(ierr);
    ierr = PetscViewerFileSetName(vtk_viewer_soln, "solution.vtu"); CHKERRQ(ierr);
    ierr = VecView(X[fine_level], vtk_viewer_soln); CHKERRQ(ierr);
    ierr = PetscViewerDestroy(&vtk_viewer_soln); CHKERRQ(ierr);
  }

  // Cleanup
  for (int i=0; i<num_levels; i++) {
    ierr = VecDestroy(&X[i]); CHKERRQ(ierr);
    ierr = VecDestroy(&X_loc[i]); CHKERRQ(ierr);
    ierr = VecDestroy(&mult[i]); CHKERRQ(ierr);
    ierr = VecDestroy(&user_O[i]->Y_loc); CHKERRQ(ierr);
    ierr = MatDestroy(&mat_O[i]); CHKERRQ(ierr);
    ierr = PetscFree(user_O[i]); CHKERRQ(ierr);
    if (i > 0) {
      ierr = MatDestroy(&mat_pr[i]); CHKERRQ(ierr);
      ierr = PetscFree(user_pr[i]); CHKERRQ(ierr);
    }
    ierr = CeedDataDestroy(i, ceed_data[i]); CHKERRQ(ierr);
    ierr = DMDestroy(&dm[i]); CHKERRQ(ierr);
  }
  ierr = PetscFree(level_degrees); CHKERRQ(ierr);
  ierr = PetscFree(dm); CHKERRQ(ierr);
  ierr = PetscFree(X); CHKERRQ(ierr);
  ierr = PetscFree(X_loc); CHKERRQ(ierr);
  ierr = PetscFree(mult); CHKERRQ(ierr);
  ierr = PetscFree(mat_O); CHKERRQ(ierr);
  ierr = PetscFree(mat_pr); CHKERRQ(ierr);
  ierr = PetscFree(ceed_data); CHKERRQ(ierr);
  ierr = PetscFree(user_O); CHKERRQ(ierr);
  ierr = PetscFree(user_pr); CHKERRQ(ierr);
  ierr = PetscFree(l_size); CHKERRQ(ierr);
  ierr = PetscFree(xl_size); CHKERRQ(ierr);
  ierr = PetscFree(g_size); CHKERRQ(ierr);
  ierr = VecDestroy(&rhs); CHKERRQ(ierr);
  ierr = VecDestroy(&rhs_loc); CHKERRQ(ierr);
  ierr = MatDestroy(&mat_coarse); CHKERRQ(ierr);
  ierr = KSPDestroy(&ksp); CHKERRQ(ierr);
  ierr = SNESDestroy(&snes_dummy); CHKERRQ(ierr);
  ierr = DMDestroy(&dm_orig); CHKERRQ(ierr);
  CeedVectorDestroy(&target);
  CeedQFunctionDestroy(&qf_error);
  CeedQFunctionDestroy(&qf_restrict);
  CeedQFunctionDestroy(&qf_prolong);
  CeedOperatorDestroy(&op_error);
  CeedDestroy(&ceed);
  return PetscFinalize();
}


/* integration/exponential.c
 *
 * Copyright (C) 2017 Konrad Griessinger, 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.
 */

/*
 * The code in this module is based on IQPACK, specifically the LGPL
 * implementation found in HERMITE_RULE:
 * https://people.sc.fsu.edu/~jburkardt/c_src/hermite_rule/hermite_rule.html
 */

#include <stdio.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_integration.h>
#include <gsl/gsl_sf_gamma.h>

static int
exponential_check(const size_t n, const gsl_integration_fixed_params * params)
{
  (void) n;

  if (fabs(params->b - params->a) <= GSL_DBL_EPSILON)
    {
      GSL_ERROR("|b - a| too small", GSL_EDOM);
    }
  else if (params->a >= params->b)
    {
      GSL_ERROR("lower integration limit must be smaller than upper limit", GSL_EDOM);
    }
  else if (params->alpha <= -1.0)
    {
      GSL_ERROR("alpha must be > -1", GSL_EDOM);
    }
  else
    {
      return GSL_SUCCESS;
    }
}

static int
exponential_init(const size_t n, double * diag, double * subdiag, gsl_integration_fixed_params * params)
{
  size_t i;
  double a2i = params->alpha;

  /* construct the diagonal and subdiagonal elements of Jacobi matrix */
  for (i = 1; i <= n; i++)
    {
      diag[i-1] = 0.0;
      a2i += 2.0;
      subdiag[i-1] = (i + params->alpha*(i%2))/sqrt( a2i*a2i - 1.0 );
    }

  params->zemu = 2.0/(params->alpha + 1.0);
  params->shft = 0.5*(params->b + params->a);
  params->slp = 0.5*(params->b - params->a);
  params->al = params->alpha;
  params->be = 0.0;

  return GSL_SUCCESS;
}

static const gsl_integration_fixed_type exponential_type =
{
  exponential_check,
  exponential_init
};

const gsl_integration_fixed_type *gsl_integration_fixed_exponential = &exponential_type;


#ifndef MESH_H
#define MESH_H
#define EIGEN_SUPERLU_SUPPORT

#include <iostream>
#include <iomanip>
#include <cmath>
#include <vector>
#include <chrono>
#include <armadillo>
#include <petsc.h>
#include "../TPLs/yaml-cpp/include/yaml-cpp/yaml.h"
#include "../TPLs/eigen-git-mirror/Eigen/Eigen"
#include "../TPLs/eigen-git-mirror/Eigen/IterativeLinearSolvers"
#include "../TPLs/eigen-git-mirror/unsupported/Eigen/IterativeSolvers"
#include "../TPLs/eigen-git-mirror/Eigen/SuperLUSupport"

using namespace std;

class WriteData; // forward declaration

class qdCell
{

	public:
	qdCell();
	//number of ordinates on this quadrature level
  	int cFIndex=0,nFIndex=0,sFIndex=0,eFIndex=0,wFIndex=0;
        int nCIndex=0,sCIndex=0,eCIndex=0,wCIndex=0;

};

class quadLevel
{
	public:
	quadLevel(vector< vector<double> > myQuad,\
  		vector<double> myAlpha,\
  		vector<double> myTau,\
                int myStartIndex);
	//number of ordinates on this quadrature level
  	int nOrd;
	//quadrature set
  	vector< vector<double> > quad;
        //difference coefficients
  	vector<double> alpha;
	//factor for linear interpolation of half angles
        vector<double> tau;
	//index of each ordinate in angular flux matrices
	vector<int> ordIdx;

};

class Mesh
{
	public:
	Mesh(YAML::Node * myInput);
  	int n,nAngles,nR,nZ;
        int state = 1;
        double dz,dr,drCorner,dzCorner,Z,R,dt,T,totalWeight;
        bool verbose = false, petsc = false, verbose_keff_only = false;
  	vector< vector<double> > quadSet;
  	vector< vector<double> > alpha;
        vector< vector<double> > tau;
        vector< vector<double> > cellVol;
        vector< vector<double> > cellVSA;
        vector<double> dts;
        vector<double> ts;
        vector<bool> outputOnStep;
        arma::rowvec dzs,dzsCorner;
        arma::rowvec drs,drsCorner;
	arma::rowvec rEdge;
	arma::rowvec zEdge;
        arma::rowvec rCent;
        arma::rowvec zCent;
	arma::rowvec rCornerEdge;
	arma::rowvec zCornerEdge;
        arma::rowvec rCornerCent;
        arma::rowvec zCornerCent;
        arma::rowvec rVWCornerCent;
        vector<quadLevel> quadrature;
	vector<qdCell> qdCells;
        Eigen::MatrixXd volume;
        string outputDir = "mesh/";
        WriteData * output;

        // Recirculation loop parameters
        double dzCornerRecirc,recircZ;
        int nZrecirc;
	arma::rowvec zCornerEdgeRecirc,dzsCornerRecirc;
        arma::rowvec zCornerCentRecirc;

        // Functions
  	vector<int> getQDCellIndices(int iR, int iZ);
  	vector<double> getGeoParams(int iR, int iZ);
  	vector<double> getRecircGeoParams(int iR, int iZ);
  	void advanceOneTimeStep();
  	void calcQuadSet();
        void writeVars();
	void printQuadSet();
        void checkOptionalParams();

        private:
	vector<double> mu;
  	vector< vector<double> > ordinates;
  	void calcMu();
	void calcAlpha();
        void calcTau();
        void calcSpatialMesh();
        void calcQDCellIndices(int nCornersR,int nCornersZ);
        void addLevels();
 	void calcNumAnglesTotalWeight();
 	void calcTimeMesh();
  	void calcRecircMesh();
	int quad_index(int p,int q);
	int low_quad_index(int p,int q);
	int getQDCellIndex(int iR,int iZ);
	YAML::Node * input;
};

typedef Eigen::Array<bool,Eigen::Dynamic,1> VectorXb;

#endif


#ifndef ComplexMatrix_h
#define ComplexMatrix_h
#include <cmath>
#include <complex>
#include <iostream>
#include <fstream>
#include <iomanip>

#ifndef NOBLAS
    extern "C" {
        #include <cblas.h>
    }

//    #ifdef SINGLEPRECISION
//        #define phi_hemm  cblas_chemm
//        #define phi_symm  cblas_csymm
//        #define phi_her   cblas_cher
//        #define phi_gerc  cblas_cgerc
//        #define phi_copy  cblas_ccopy
//        #define phi_axpy  cblas_caxpy
//        #define phi_dotc_sub cblas_cdotc_sub
//        #define phi_dotu_sub cblas_cdotu_sub
//        #define phi_scal  cblas_zscal
//        #define phi_hemv  cblas_chemv
//        #define phi_gemv  cblas_cgemv
//    #else
//        #define phi_hemm  cblas_zhemm
//        #define phi_symm  cblas_zsymm
//        #define phi_her   cblas_zher
//        #define phi_gerc  cblas_zgerc
//        #define phi_copy  cblas_zcopy
//        #define phi_axpy  cblas_zaxpy
//        #define phi_dotc_sub cblas_zdotc_sub
//        #define phi_dotu_sub cblas_zdotu_sub
//        #define phi_scal  cblas_zscal
//        #define phi_hemv  cblas_zhemv
//        #define phi_gemv  cblas_zgemv
//    #endif

#else

    #ifndef CBLAS_ENUM_DEFINED_H
        #define CBLAS_ENUM_DEFINED_H
        enum CBLAS_ORDER {CblasRowMajor=101, CblasColMajor=102 };
        enum CBLAS_TRANSPOSE {CblasNoTrans=111, CblasTrans=112, CblasConjTrans=113,
                         AtlasConj=114};
        enum CBLAS_UPLO  {CblasUpper=121, CblasLower=122};
        enum CBLAS_DIAG  {CblasNonUnit=131, CblasUnit=132};
        enum CBLAS_SIDE  {CblasLeft=141, CblasRight=142};
    #endif

#endif

using namespace std;

#ifdef SINGLEPRECISION
typedef float Float;
typedef complex<float> Complex;
#else
typedef double Float;
typedef complex<double> Complex;
#endif

struct Index2D {
    int i;
    int j;
};

//#ifdef NOBLAS
void phi_gemm(const int N, const Complex *alpha, const Complex *A,
              const Complex *B, const Complex *beta, Complex *C);

void phi_hemm(const enum CBLAS_SIDE Side, const int N, const Complex *alpha, const Complex *A,
                 const Complex *B, const Complex *beta, Complex *C);

void phi_symm(const enum CBLAS_SIDE Side, const int N, const Complex *alpha, const Complex *A,
                 const Complex *B, const Complex *beta, Complex *C);

void phi_her(const int N, const Float alpha, const Complex *X,
                Complex *A);

void phi_gerc(const int N, const Complex *alpha, const Complex *X,
                 const Complex *Y, Complex *A);

void phi_copy(const int N, const Complex *X, const int incX,
                 Complex *Y, const int incY);

void phi_axpy(const int N, const Complex *alpha, const Complex *X,
                 const int incX, Complex *Y, const int incY);

void phi_dotc_sub(const int N, const Complex *X, const int incX,
                       const Complex *Y, const int incY, Complex *dotc);

void phi_dotu_sub(const int N, const Complex *X, const int incX,
                       const Complex *Y, const int incY, Complex *dotu);

void phi_scal(const int N, const Complex *alpha, Complex *X, const int incX);

void phi_hemv(const int N, const Complex *alpha, const Complex *A,
                 const Complex *X, const Complex *beta, Complex *Y);

void phi_gemv(const int N, const Complex *alpha, const Complex *A,
                 const Complex *X, const Complex *beta, Complex *Y);

//#endif

//Equal size square matrices only
Complex * outerProduct(const Complex *,const Complex *, const int);

Complex * toLiouville(const Complex *,const int);

void printMatrix(const Complex *, const int);

void printMatrix(const Complex *, const Index2D *, const int);

void writeMatrixToFile(const Complex *, const int, ofstream &);

#endif


/*! \file SpecialFunctions.h
 *  \brief header file defining several special functions
    This is a work in progress as generally can always call gsl for most of the functions.
 */

#ifndef SPECIALFUNCTIONS_H
#define SPECIALFUNCTIONS_H

#include <iostream>
#include <complex>
#include <Precision.h>
#include <cmath>
#include <gsl/gsl_sf.h>

using namespace std;
namespace Math
{

    //factorial
    int Factorial(int k);
    //Gamma function not yet idependently implemented (using just gsl but if want arbitrary precision must
	//implement at some point.
	//complete gamma function
	//Double_t GammaFunc(Double_t a);
	//Calculates the normalized (regularized) upper incomplete gamma function (upper integral).
	//Double_t GammaFunc(Double_t a, Double_t x);

	//Again same issue with Gamma Functions, not yet implemented for arbitrary precision
    //calculates spherical harmonics
    //Double_t SphericalHarmonic(Double_t theta, Double_t phi, int l, int m);
    //just real component
    //Double_t SphericalHarmonicR(Double_t theta, Double_t phi, int l, int m);
    //just imaginary component
    //Double_t SphericalHarmonicI(Double_t theta, Double_t phi, int l, int m);

}

#endif


#ifndef __FFT_DECON_OPERATOR_H__
#define __FFT_DECON_OPERATOR_H__
#include <string>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_fft_complex.h>
#include "mspass/seismic/TimeWindow.h"
#include "mspass/utility/Metadata.h"
#include "mspass/seismic/CoreTimeSeries.h"
#include "mspass/algorithms/deconvolution/ComplexArray.h"
namespace mspass::algorithms::deconvolution{
/*! \brief Object to hold components needed in all fft based decon algorithms.

The fft based algorithms implemented here us the GNU Scientific Library
prime factorization fft algorithm.  Those methods require initialization
given length of the fft to load and store the factorization data.  This
object holds these for all such methods and recomputes them only when
needed for efficiency.  */
class FFTDeconOperator
{
public:
    FFTDeconOperator();
    FFTDeconOperator(const mspass::utility::Metadata& md);
    FFTDeconOperator(const FFTDeconOperator& parent);
    ~FFTDeconOperator();
    FFTDeconOperator& operator=(const FFTDeconOperator& parent);
    void changeparameter(const mspass::utility::Metadata& md);
    void change_size(const int nfft_new);
    void change_shift(const int shift) {
        sample_shift=shift;
    };
    int get_size(){return nfft;};
    int get_shift(){return sample_shift;};
    int operator_size() {
        return static_cast<int>(nfft);
    };
    int operator_shift() {
        return sample_shift;
    };
    double df(const double dt){
        double period;
        period=static_cast<double>(nfft)*dt;
        return 1.0/period;
    };
    /*! \brief Return inverse wavelet for Fourier methods.

    This is a helper to be used by the inverse_wavelet method for all
    Fourier based deconvolution methods.   It avoids repetitious code that
    would be required otherwise.  inverse_wavelet methods are only
    wrappers for this generic method.  See documentation for inverse_wavelet
    for description of tshift and t0parent.  */
    mspass::seismic::CoreTimeSeries FourierInverse(const ComplexArray& winv, const ComplexArray& sw,
   	const double dt, const double t0parent);

protected:
    int nfft;
    int sample_shift;
    gsl_fft_complex_wavetable *wavetable;
    gsl_fft_complex_workspace *workspace;
    ComplexArray winv;
};

/* This helper is best referenced here */

/*! \brief Circular buffer procedure.

 In the Fourier world circular vectors are an important thing
 to deal with because the fft is intimately connected with circlular
 things.   This routine can be used, for example, to time shift the
 time domain version of a signal after it was processed with an fft.

 \param d - is the input vector to be shifted
 \param i0 - is the wrap point.   On exit sample i0 of d will be sample 0.
   (Warning - this is C convention sample number)
*/

std::vector<double>  circular_shift(const std::vector<double>& d,const int i0);
/*! Derive fft length from a time window.

All deconvlution methods using an fft need to define nfft based on the
length of the working time series.   This procedure returns the size from
an input window and sample interval. */
int ComputeFFTLength(const mspass::seismic::TimeWindow w, const double dt);
/*! Derive fft length using parameters in a metadata object.

This procedure is basically a higher level version of the function of
the same name with a time window and sample interval argument.
This procedure extracts these using three parameter keys to extract
the real numbers form md:  deconvolution_data_window_start,
decon_window_end, and target dt. */
int ComputeFFTLength(const mspass::utility::Metadata& md);
/*! Returns next power of 2 larger than n.
 *
 * Some FFT implementations require the size of the input data vector be a power
 * of 2.  This routine can be used to define a buffer size satisfying that constraint.*/
extern "C" {
    unsigned int nextPowerOf2(unsigned int n);
}
}
#endif