#include <Advent/Advent.h>
#include <DayConfig.h>
#include <Input.h>
#include <cblas.h>
#include <stdint.h>
#include <stdlib.h>
#include <string.h>
#include <unicode/ustdio.h>
#include <unicode/ustring.h>

enum
{
  OXY = 0,
  CO2,
};

typedef struct
{
  size_t oxy;
  size_t co2;
} Part2Count;

typedef struct
{
  bool highlight;
  size_t highlightWhich;
} PrintBinArrayOptions;

static void PrintHelp(void);
static void PrintVersion(void);
static void PrintBinArray(const char* array, size_t count, PrintBinArrayOptions options);
static uint64_t BinToI64(const char* bin, size_t count);

int main(int argc, char** argv)
{
  CommandLineCommand command;
  if (Advent_ParseCommandLine(argc, argv, &command))
  {
    switch (command)
    {
    case COMMAND_LINE_COMMAND_PRINT_HELP:
      PrintHelp();
      return 0;
    case COMMAND_LINE_COMMAND_PRINT_HELP_ERROR:
      PrintHelp();
      return 1;
    case COMMAND_LINE_COMMAND_PRINT_VERSION:
      PrintVersion();
      return 0;
    default:
      fprintf(stderr, "Unknown command\n");
      return 2;
    }
  }

  UChar* unicodeInput = malloc((inputText_size + 1) * sizeof(UChar));
  int32_t unicodeInputSize = 0;
  UErrorCode errorCode = U_ZERO_ERROR;
  u_strFromUTF8(unicodeInput, (int32_t)(inputText_size + 1), &unicodeInputSize, (const char*)inputText,
                (int32_t)inputText_size, &errorCode);
  if (errorCode != U_ZERO_ERROR)
  {
    fprintf(stderr, "Unicode error: %s\n", u_errorName(errorCode));
    return 3;
  }

  char** matrix = NULL;
  size_t m = 0;
  size_t n = 0;
  size_t cap = 0;
  size_t rowCap = 0;

  size_t width = 0;

  U_STRING_DECL(delim, "\r\n", 2);
  UChar* saveptr;
  for (UChar* iter = u_strtok_r(unicodeInput, delim, &saveptr); iter != NULL; iter = u_strtok_r(NULL, delim, &saveptr))
  {
    if (m == cap)
    {
      cap = cap ? cap * 2 : 1;
      char** newMatrix = realloc(matrix, cap * sizeof(char*));
      matrix = newMatrix;
      memset(&matrix[m], 0, (cap - m) * sizeof(char*));
    }
    char* row = malloc(rowCap * sizeof(char));
    matrix[m] = row;
    size_t i = 0;
    while (true)
    {
      UChar32 ci;
      U16_NEXT(iter, i, -1, ci);
      if (ci == 0)
      {
        break;
      }
      if (ci == '0' || ci == '1')
      {
        if (i > n)
        {
          if (n == rowCap)
          {
            rowCap = rowCap ? rowCap * 2 : 1;
            for (size_t i = 0; i < m; i++)
            {
              char* row = realloc(matrix[i], rowCap * sizeof(char));
              matrix[i] = row;
            }
          }
          ++n;
        }
        matrix[m][i - 1] = (char)ci;
      }
    }
    ++m;
  }

  char** transposed = malloc(n * sizeof(char*));
  for (size_t i = 0; i < n; ++i)
  {
    transposed[i] = malloc(m * sizeof(char));
    for (size_t j = 0; j < m; ++j)
    {
      transposed[i][j] = matrix[j][i];
    }
  }

  // calculate!
  size_t** counts = malloc(n * sizeof(size_t*));
  uint64_t gamma = 0;
  uint64_t epsilon = 0;
  for (size_t i = 0; i < n; ++i)
  {
    counts[i] = calloc(2, sizeof(size_t));
    for (size_t j = 0; j < m; ++j)
    {
      // NIT: This assumes that the matrix is a rectangle!
      // If there are ANY missing elements, this will likely segfault due to
      // out-of-bounds array access.
      counts[i][transposed[i][j] - '0']++;
    }
    gamma <<= 1;
    gamma |= counts[i][1] > counts[i][0];
    epsilon <<= 1;
    epsilon |= counts[i][0] > counts[i][1];
  }

  printf("%lu\n", gamma * epsilon);

  Part2Count** p2counts = malloc(n * sizeof(Part2Count*));
  for (size_t i = 0; i < n; ++i)
  {
    p2counts[i] = calloc(2, sizeof(Part2Count));
  }
  bool** keep = malloc(m * sizeof(bool*));
  for (size_t i = 0; i < m; ++i)
  {
    keep[i] = malloc(2 * sizeof(bool));
    keep[i][OXY] = true;
    keep[i][CO2] = true;
  }
  size_t oxy = 0;
  size_t co2 = 0;
  for (size_t i = 0; i < n; ++i)
  {
    memset(p2counts[i], 0, 2 * sizeof(Part2Count));
    for (size_t j = 0; j < m; ++j)
    {
      if (keep[j][OXY])
      {
        p2counts[i][transposed[i][j] - '0'].oxy++;
      }
      if (keep[j][CO2])
      {
        p2counts[i][transposed[i][j] - '0'].co2++;
      }
    }
    bool selector = p2counts[i][0].oxy > p2counts[i][1].oxy;
    // filter out 1's for OXY, 0's for CO2
    size_t keptOxy = SIZE_MAX;
    size_t keptCo2 = SIZE_MAX;
    for (size_t j = 0; j < m; ++j)
    {
      if (keep[j][OXY])
      {
        if (transposed[i][j] == (p2counts[i][0].oxy > p2counts[i][1].oxy ? '1' : '0'))
        {
          keep[j][OXY] = false;
        }
        else if (keptOxy == SIZE_MAX)
        {
          keptOxy = j;
        }
      }
      if (keep[j][CO2])
      {
        if (transposed[i][j] == (p2counts[i][0].co2 > p2counts[i][1].co2 ? '0' : '1'))
        {
          keep[j][CO2] = false;
        }
        else if (keptCo2 == SIZE_MAX)
        {
          keptCo2 = j;
        }
      }
    }
    if (keptOxy != SIZE_MAX)
    {
      oxy = keptOxy;
    }
    if (keptCo2 != SIZE_MAX)
    {
      co2 = keptCo2;
    }
  }

  printf("Filtering complete\n");
  printf("OXY: index %lu\n", oxy);
  printf("OXY: ");
  PrintBinArray(matrix[oxy], n, (PrintBinArrayOptions){0});
  printf(" (as array)\n");
  printf("OXY: %lu (as decimal)\n", BinToI64(matrix[oxy], n));
  printf("CO2: index %lu\n", co2);
  printf("CO2: ");
  PrintBinArray(matrix[co2], n, (PrintBinArrayOptions){0});
  printf(" (as array)\n");
  printf("CO2: %lu (as decimal)\n", BinToI64(matrix[co2], n));
  printf("Part 2: %lu\n", BinToI64(matrix[oxy], n) * BinToI64(matrix[co2], n));

  for (size_t i = 0; i < m; ++i)
  {
    free(keep[i]);
  }
  free(keep);
  for (size_t i = 0; i < n; ++i)
  {
    free(p2counts[i]);
  }
  free(p2counts);

  for (size_t i = 0; i < m; ++i)
  {
    free(matrix[i]);
  }
  free(matrix);
  for (size_t i = 0; i < n; ++i)
  {
    free(transposed[i]);
    free(counts[i]);
  }
  free(transposed);
  free(counts);
  free(unicodeInput);
}

static void PrintHelp(void)
{
  PrintVersion();
  printf("Usage: %s [options]\n", ADVENT_DAY_NAME);
  puts("Options:");
  puts(" -h,--help    Print this help message");
  puts(" -V,--version Print the program version");
}

static void PrintVersion(void)
{
  printf("%s v%s\n", ADVENT_DAY_NAME, PROJECT_VERSION);
}

static void PrintBinArray(const char* array, size_t count, PrintBinArrayOptions options)
{
  for (size_t i = 0; i < count; ++i)
  {
    if (options.highlight && options.highlightWhich == i)
    {
      putchar('{');
    }
    putchar(array[i]);
    if (options.highlight && options.highlightWhich == i)
    {
      putchar('}');
    }
  }
}

static uint64_t BinToI64(const char* bin, size_t count)
{
  char* str = malloc(count + 1);
  memcpy(str, bin, count);
  str[count] = '\0';
  uint64_t result = strtoul(str, NULL, 2);
  free(str);
  return result;
}


/*
  Template for applications of single array GSL functions
*/

#include <stdio.h>

#ifdef SINGLE_ARG
# include <stdlib.h>
#endif

#include <gsl/gsl_statistics_double.h>

#ifdef SORT_DATA
# include <gsl/gsl_sort.h>
#endif

#include "y.tab.h"
#include "double_matrix.h"

#define SINGLE_STEP 1

Double_Matrix *data = NULL;

int
main(int argc, char *argv[]) {
	size_t i = 0;
#ifdef SINGLE_ARG
	char *endptr = NULL;
	double arg;
#endif

#ifdef SINGLE_ARG
	if (2 != argc) {
		fprintf(stderr, "Argument required.\n");
		return 1;
	}

	arg = strtod(argv[1], &endptr);

	if (0 == arg && endptr == argv[ 1 ]) {
		fprintf(stderr, "Argument (%s) is not a valid number\n", argv[1]);
		return 1;
	}
#endif

	data = double_matrix_new();

	yyparse();

	for (i = 0; i < double_matrix_width(data); i++) {
#ifdef SORT_DATA
		gsl_sort(double_matrix_col_mut_data(data, i), SINGLE_STEP, double_matrix_depth(data));
#endif

		if (0 != i)
			printf( " " );

		printf("%.10g",
			FUNC_NAME(double_matrix_col_data(data, i), SINGLE_STEP, double_matrix_depth(data)
#ifdef SINGLE_ARG
		    , arg
#endif
			)
		);
	}

	printf("\n");

	double_matrix_free(data);

	return 0;
}


/**
 */

#ifndef _DISP_CONF_H
#define _DISP_CONF_H
#include <gsl/gsl_vector.h>
#include "aXe_grism.h"

/**
 * A structure to contain the coefficient of a 2D
 * polynomial that can be used to compute the given
 * coefficient of the polynomial dispersion relation
 * as at a particular i.j location in the image
 */
typedef struct
{
  gsl_vector *pol; /* A vector containing the 2D polynomial coefficients */
  int for_grism;   /* If true, pol is of form sum(a_i x^i, i=0..order)
                      otherwise, it is of form sum(a_i 1/x^i, i=0..order) */
  d_point cpoint;  /* The detector location at which this structure
                      was computed */
  int ID;          /* The ID of the beam for which this coefficient
                      is defined */
  char file[MAXCHAR];
}
dispstruct;

typedef struct
{
  char file[MAXCHAR];

  int ID;
  int for_grism;

  int n_order;
  gsl_vector **all_coeffs;
}
global_disp;

extern float
get_beam_mmag_extract (char *filename, int beamID);

extern float
get_beam_mmag_mark (char *filename, int beamID);

extern int
get_beam_disp_norder (char *filename, int beamID);

extern gsl_vector *
get_beam_disp_order (char *filename, const int for_grism,
                                 int beamID, int order);

extern float
get_disp_coeff_at_pos (char *filename, const int for_grism, int beamID,
                             int order, d_point p);

extern gsl_vector *
get_disp_coeffs_at_pos (char *filename, const int for_grism,
                                    int beamID, d_point p);
extern void
free_dispstruct(dispstruct *p);

extern dispstruct *
get_dispersion_at_pos (char *filename, int beamID, d_point p);

extern void
dispstruct_fprintf (FILE * file, dispstruct * disp);

extern dispstruct *
get_dispstruct_at_pos (char *filename, const int for_grism,
                                   int beamID, d_point p);

extern int
check_for_grism (char *filename, int beamID);

extern int
check_disp_coeff (char *filename,const int for_grism,int beamID,int order);

extern gsl_vector *
get_prange (char *filename, int beamID);

extern global_disp *
get_global_disp(char *filename, const int for_grism, int beamID);

extern gsl_vector *
get_calvector_from_gdisp(const global_disp *gdisp, const d_point p);

extern double
get_2Ddep_value(const gsl_vector *coeffs, const d_point p);

extern void
print_global_disp(const global_disp *gdisp);

extern int
check_disp_order(const gsl_vector *tmp, const int beamID, const int order);

extern void
free_global_disp(global_disp *gdisp);

#endif


#include <stdio.h>
#include <stdlib.h>
#include <gsl/gsl_rng.h>
#include <math.h>
#include <time.h>
#include <stdbool.h>
#include "bb_smc.h"

/* ==========================================================
Last update: 1.5.20 -- v2.0

ABC-SMC (parallel version)
Author: Marco Esposito
=========================================================== */

// =========== Define some constants =============
#define size_data 50

#define a0 0.5
#define b0 0.5
#define std_ker 0.3
#define striding_size 1
#define n 20
// =====================================

// ARGUMENT NUMBER 1: time at which the simulation starts
// ARGUMENT NUMBER 2: seed
// ARGUMENT NUMBER 3: number of particles to consider
// for the simulation (lesser for shorter runs)

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

	if (argc != 4) {

		printf("argc = %d\n", argc);
		printf("Usage: %s\n", argv[0]);
		printf("      %s [parameters] \n", argv[0]);
		exit(1);

	}

	/* ==================== VARIABLES DECLARATION ======================== */
	int time = atoi(argv[1]);
	int seed = atoi(argv[2]);
	int n_particles = atoi(argv[3]);

	double theta_star;
	double theta;
	double weight;
	double epsilon_t;
	int status;

	double* weights;
	weights = malloc((n_particles) * sizeof(double));

	int sample_accepted;
	/* ==================================================================== */

	/* ============== IMPORT DATA =========== */
	int y[size_data];
	status = import_data_BB(y, size_data);
	if (status == 1) {
		printf("Data not found\n");
		exit(1);
	}
	double mean_y = mean_int(y, size_data);
	// printf("(MAIN) -- mean_y: %f\n", mean_y);
	/* ======================================== */

	/* =========== READ THRESHOLD ============ */
	status = read_threshold(&epsilon_t, time);
	if (status == 1) {
		printf("Threshold not found\n");
		exit(1);
	}
	/* ======================================== */

	/* ================== set up GSL RNG =================== */
	gsl_rng *r = gsl_rng_alloc(gsl_rng_mt19937);
	gsl_rng_set (r, seed+101); // set seed
	/* ===================================================== */

	sample_accepted = 1;

	/* =========================================================== */
	/* ================= START THE ABC ROUND ===================== */
	/* =========================================================== */
	while (sample_accepted == 1) {

		// Select particle
		status = select_particle(weights, &theta, time, n_particles, r);
		if (status == 1) {
			printf("File with particles at time %d, %d particles not present\n", time, n_particles);
			exit(1);
		}

		// Perturb the parameter
		status = ker_perturb(&theta_star, r, theta, a0, b0, std_ker);
		if (status == 1) {
			continue;
		}

		// - If the distance function is too large, start over
		// - If all the conditions are fulfilled, the sample is accepted
		sample_accepted = verify_par_BB(theta_star, mean_y, r, size_data, n, epsilon_t, time, seed);
		if (sample_accepted == 1) {
			continue;
		}

	} //END OF ABC ROUND (WHILE LOOP) -- PARTICLE WAS ACCEPTED

	calculate_weight_BB(&weight, weights, theta, theta_star, n_particles, a0, b0, std_ker);

	write_particles_BB(theta_star, time, seed, striding_size, weight);

	free(weights);

	return 0; //return of main

} //End of the program


/* examples/C/ssmfe/precond_expert.c */
/* Laplacian on a square grid (using SPRAL_SSMFE_EXPERT routines) */
#include "spral.h"
#include <stdlib.h>
#include <stdio.h>
#include <cblas.h>
#include <math.h>

/* Header that implements Laplacian and preconditioners */
#include "laplace2d.h"
#include "ldltf.h"

int test_core(void);
int test_core_d(int, int);
int test_core_z(int, int);
int test_expert(void);
int test_expert_d(int);
int test_expert_z(int);
int test_ssmfe(void);
int test_ssmfe_d(int);
int test_ssmfe_z(int);

void zdcopy( int n, double complex* x, double* y );
void dzcopy( int n, double* y, double complex* x );
void vector_operations_d
  ( struct spral_ssmfe_rcid rci,
    int n, int m, int kw, int ind[m],
    double W[kw][m][n],
    double rr[3][2*m][2*m],
    double U[m]);

void vector_operations_z
  ( struct spral_ssmfe_rciz rci,
    int n, int m, int kw, int ind[m],
    double complex W[kw][m][n],
    double complex rr[3][2*m][2*m],
    double complex U[m]);

int main(void) {

  int errors = 0;
  int err;

  fprintf(stdout, "testing ssmfe_core...\n");
  err = test_core();
  errors += err;
  fprintf(stdout, "%d errors\n", err);

  fprintf(stdout, "testing ssmfe_expert...\n");
  err = test_expert();
  errors += err;
  fprintf(stdout, "%d errors\n", err);

  fprintf(stdout, "testing ssmfe...\n");
  err = test_ssmfe();
  errors += err;
  fprintf(stdout, "%d errors\n", err);

  fprintf(stdout, "=============================\n");
  fprintf(stdout, "Total number of errors = %d\n", errors);

  return errors;
}

int test_core(void) {

  int errors = 0;
  int err;

  fprintf(stdout, "testing standard_double...");
  err = test_core_d(0, 0);
  if ( err != 0 )
    fprintf(stdout, "%d errors\n", err);
  else
    fprintf(stdout, "ok\n");
  errors += err;

  fprintf(stdout, "testing generalized_double...");
  err = test_core_d(1, 0);
  if ( err != 0 )
    fprintf(stdout, "%d errors\n", err);
  else
    fprintf(stdout, "ok\n");
  errors += err;

  fprintf(stdout, "testing largest_double...");
  err = test_core_d(0, 1);
  if ( err != 0 )
    fprintf(stdout, "%d errors\n", err);
  else
    fprintf(stdout, "ok\n");
  errors += err;

  fprintf(stdout, "testing standard_double_complex...");
  err = test_core_z(0, 0);
  if ( err != 0 )
    fprintf(stdout, "%d errors\n", err);
  else
    fprintf(stdout, "ok\n");
  errors += err;

  fprintf(stdout, "testing generalized_double_complex...");
  err = test_core_z(1, 0);
  if ( err != 0 )
    fprintf(stdout, "%d errors\n", err);
  else
    fprintf(stdout, "ok\n");
  errors += err;

  fprintf(stdout, "testing largest_double_complex...");
  err = test_core_z(0, 1);
  if ( err != 0 )
    fprintf(stdout, "%d errors\n", err);
  else
    fprintf(stdout, "ok\n");
  errors += err;

  return errors;

}

int test_core_d(int problem, int largest) {
   const int ngrid = 20;          /* grid points along each side */
   const int n     = ngrid*ngrid; /* problem size */
   const int nep   = 5;           /* eigenpairs wanted */
   const int m     = 3;           /* dimension of the iterated subspace */

   const int ncon_x = 5;
   const double lambda_x[] = { /* expected eigenvalues */
      4.4676695e-02,
      1.1119274e-01,
      1.1119274e-01,
      1.7770878e-01,
      2.2040061e-01
   };
   const double lambda_lx[] = { /* expected eigenvalues in 'largest' mode */
      -7.9553233,
      -7.8888073,
      -7.8888073,
      -7.8222912,
      -7.7795994
   };
   int errors;

   int state = SPRAL_RANDOM_INITIAL_SEED; /* PRNG state */

   int ind[m];                    /* permutation index */
   double lambda[n];              /* eigenvalues storage */
   double X[n][n];                /* eigenvectors storage */
   /* Work arrays */
   double lmd[m];
   double rr[3][2*m][2*m];
   double W[8][m][n];
   double U[m][n];
   double V[m];

   /* Derived types */
   struct spral_ssmfe_rcid rci;            /* reverse communication data */
   struct spral_ssmfe_core_options options;/* options */
   void *keep;                             /* private data */
   struct spral_ssmfe_inform inform;       /* information */

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

   /* Initialize W to lin indep vectors by randomizing */
   for(int i=0; i<n; i++)
   for(int j=0; j<m; j++)
      W[0][j][i] = spral_random_real(&state, true);

   int ncon = 0;   /* number of converged eigenpairs */
   rci.job = 0; keep = NULL;
   while(true) { /* reverse communication loop */
      if ( largest != 0 )
        spral_ssmfe_largest_double(&rci, problem, nep, m, lmd,
           &rr[0][0][0], ind, &keep, &options, &inform);
      else
        spral_ssmfe_double(&rci, problem, nep, 0, m, lmd,
           &rr[0][0][0], ind, &keep, &options, &inform);
      switch ( rci.job ) {
      case 1:
         apply_laplacian(
            ngrid, ngrid, rci.nx, &W[rci.kx][rci.jx][0], &W[rci.ky][rci.jy][0]
            );
         if ( largest != 0 )
            cblas_dscal( n*rci.nx, -1.0, &W[rci.ky][rci.jy][0], 1 );
         break;
      case 2:
         if ( largest != 0 )
            cblas_dcopy(
               n*rci.nx, &W[rci.kx][rci.jx][0], 1, &W[rci.ky][rci.jy][0], 1
               );
         else
            apply_gauss_seidel_step (
               ngrid, ngrid, rci.nx, &W[rci.kx][rci.jx][0], &W[rci.ky][rci.jy][0]
               );
         break;
      case 3:
         cblas_dcopy(
            n*rci.nx, &W[rci.kx][rci.jx][0], 1, &W[rci.ky][rci.jy][0], 1
            );
         break;
      case 4:
         for ( int i = 0; i < m; i++ ) {
            if ( inform.converged[i] != 0 )
               continue;
            if ( inform.err_X[i] > 0 && inform.err_X[i] < 1e-6 )
               inform.converged[i] = 1;
         }
         break;
      case 5:
         if ( rci.i < 0 ) continue;
         for(int k=0; k<rci.nx; k++) {
           int j = ncon + k;
           lambda[j] = lmd[rci.jx + k];
           cblas_dcopy( n, &W[0][rci.jx + k][0], 1, &X[j][0], 1 );
         }
         ncon += rci.nx;
         if ( ncon >= nep || inform.iteration > 300 )
            goto finished;
         break;
      case 11:
      case 12:
      case 13:
      case 14:
      case 15:
      case 16:
      case 17:
        vector_operations_d( rci, n, m, 8, ind, W, rr, V );
         break;
      case 21: // Fall through to 22
      case 22:
         if( ncon > 0 ) {
            cblas_dgemm(
               CblasColMajor, CblasTrans, CblasNoTrans, ncon, rci.nx, n,
               1.0, &X[0][0], n, &W[rci.ky][rci.jy][0], n, 0.0, &U[0][0], n
               );
            cblas_dgemm(
               CblasColMajor, CblasNoTrans, CblasNoTrans, n, rci.nx, ncon,
               -1.0, &X[0][0], n, &U[0][0], n, 1.0, &W[rci.kx][rci.jx][0], n
               );
            if ( problem != 0 )
              cblas_dgemm(
                 CblasColMajor, CblasNoTrans, CblasNoTrans, n, rci.nx, ncon,
                 -1.0, &X[0][0], n, &U[0][0], n, 1.0, &W[rci.ky][rci.jy][0], n
                 );
         }
         break;
      case 999:
         if( rci.k == 0 ) {
            if( rci.jx > 1 ) {
               for(int j=0; j<rci.jx; j++)
               for(int i=0; i<n; i++)
                  W[0][j][i] = spral_random_real(&state, true);
            }
         }
         break;
      default:
         goto finished;
      }
   }
finished:
   errors = 0;
   if ( inform.flag != 0 ) errors++;
   if ( ncon != ncon_x ) errors++;
   if ( largest != 0 ) {
     for ( int i = 0; i < ncon && i < ncon_x; i++ )
        if ( fabs(lambda[i] - lambda_lx[i]) > 1e-6 ) errors++;
   }
   else {
     for ( int i = 0; i < ncon && i < ncon_x; i++ )
        if ( fabs(lambda[i] - lambda_x[i]) > 1e-6 ) errors++;
   }
   spral_ssmfe_core_free(&keep, &inform);

   return errors;
}

int test_core_z(int problem, int largest) {
   const int ngrid = 20;          /* grid points along each side */
   const int n     = ngrid*ngrid; /* problem size */
   const int nep   = 5;           /* eigenpairs wanted */
   const int m     = 3;           /* dimension of the iterated subspace */

   const int ncon_x = 5;       /* expected number of converged eigenpairs */
   const double lambda_x[] = { /* expected eigenvalues */
      4.4676695e-02,
      1.1119274e-01,
      1.1119274e-01,
      1.7770878e-01,
      2.2040061e-01
   };
   const double lambda_lx[] = { /* expected eigenvalues in 'largest' mode */
      -7.9553233,
      -7.8888073,
      -7.8888073,
      -7.8222912,
      -7.7795994
   };

   const double complex ZERO = 0.0;
   const double complex ONE = 1.0;
   const double complex MINUS_ONE = -1.0;

   int errors;

   int state = SPRAL_RANDOM_INITIAL_SEED; /* PRNG state */

   int ind[m];                    /* permutation index */
   double lambda[n];              /* eigenvalues storage */
   double complex X[n][n];                /* eigenvectors storage */
   /* Work arrays */
   double lmd[m];
   double complex rr[3][2*m][2*m];
   double complex W[8][m][n];
   double complex U[m][n];
   double complex V[m];

   /* Derived types */
   struct spral_ssmfe_rciz rci;            /* reverse communication data */
   struct spral_ssmfe_core_options options;/* options */
   void *keep;                             /* private data */
   struct spral_ssmfe_inform inform;       /* information */

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

   /* Initialize W to lin indep vectors by randomizing */
   for(int i=0; i<n; i++)
   for(int j=0; j<m; j++)
      W[0][j][i] = spral_random_real(&state, true);

   int ncon = 0;   /* number of converged eigenpairs */
   rci.job = 0; keep = NULL;
   while(true) { /* reverse communication loop */
      if ( largest != 0 )
        spral_ssmfe_largest_double_complex(&rci, problem, nep, m, lmd,
           &rr[0][0][0], ind, &keep, &options, &inform);
      else
        spral_ssmfe_double_complex(&rci, problem, nep, 0, m, lmd,
           &rr[0][0][0], ind, &keep, &options, &inform);
      switch ( rci.job ) {
      case 1:
         apply_laplacian_z(
            ngrid, ngrid, rci.nx, &W[rci.kx][rci.jx][0], &W[rci.ky][rci.jy][0]
            );
         if ( largest != 0 )
            cblas_zscal( n*rci.nx, &MINUS_ONE, &W[rci.ky][rci.jy][0], 1 );
         break;
      case 2:
         if ( largest != 0 )
            cblas_zcopy(
               n*rci.nx, &W[rci.kx][rci.jx][0], 1, &W[rci.ky][rci.jy][0], 1
               );
         else
            apply_gauss_seidel_step_z (
               ngrid, ngrid, rci.nx, &W[rci.kx][rci.jx][0], &W[rci.ky][rci.jy][0]
               );
         break;
      case 3:
         cblas_zcopy(
            n*rci.nx, &W[rci.kx][rci.jx][0], 1, &W[rci.ky][rci.jy][0], 1
            );
         break;
      case 4:
         for ( int i = 0; i < m; i++ ) {
            if ( inform.converged[i] != 0 )
               continue;
            if ( inform.err_X[i] > 0 && inform.err_X[i] < 1e-6 )
               inform.converged[i] = 1;
         }
         break;
      case 5:
         if ( rci.i < 0 ) continue;
         for(int k=0; k<rci.nx; k++) {
           int j = ncon + k;
           lambda[j] = lmd[rci.jx + k];
           cblas_zcopy( n, &W[0][rci.jx + k][0], 1, &X[j][0], 1 );
         }
         ncon += rci.nx;
         if ( ncon >= nep || inform.iteration > 300 )
            goto finished;
         break;
      case 11:
      case 12:
      case 13:
      case 14:
      case 15:
      case 16:
      case 17:
        vector_operations_z( rci, n, m, 8, ind, W, rr, V );
         break;
      case 21: // Fall through to 22
      case 22:
         if( ncon > 0 ) {
            cblas_zgemm(
               CblasColMajor, CblasTrans, CblasNoTrans, ncon, rci.nx, n,
               &ONE, &X[0][0], n, &W[rci.ky][rci.jy][0], n, &ZERO, &U[0][0], n
               );
            cblas_zgemm(
               CblasColMajor, CblasNoTrans, CblasNoTrans, n, rci.nx, ncon,
               &MINUS_ONE, &X[0][0], n, &U[0][0], n, &ONE,
               &W[rci.kx][rci.jx][0], n
               );
            if ( problem != 0 )
              cblas_zgemm(
                 CblasColMajor, CblasNoTrans, CblasNoTrans, n, rci.nx, ncon,
                 &MINUS_ONE, &X[0][0], n, &U[0][0], n, &ONE,
                 &W[rci.ky][rci.jy][0], n
                 );
         }
         break;
      case 999:
         if( rci.k == 0 ) {
            if( rci.jx > 1 ) {
               for(int j=0; j<rci.jx; j++)
               for(int i=0; i<n; i++)
                  W[0][j][i] = spral_random_real(&state, true);
            }
         }
         break;
      default:
         goto finished;
      }
   }
finished:
   errors = 0;
   if ( inform.flag != 0 ) errors++;
   if ( ncon != ncon_x ) errors++;
   if ( largest != 0 ) {
     for ( int i = 0; i < ncon && i < ncon_x; i++ )
        if ( fabs(lambda[i] - lambda_lx[i]) > 1e-6 ) errors++;
   }
   else {
     for ( int i = 0; i < ncon && i < ncon_x; i++ )
        if ( fabs(lambda[i] - lambda_x[i]) > 1e-6 ) errors++;
   }
   spral_ssmfe_core_free(&keep, &inform);

   return errors;
}

int test_expert(void) {

  int errors = 0;
  int err;

  fprintf(stdout, "testing standard_double...");
  err = test_expert_d(0);
  if ( err != 0 )
    fprintf(stdout, "%d errors\n", err);
  else
    fprintf(stdout, "ok\n");
  errors += err;

  fprintf(stdout, "testing generalized_double...");
  err = test_expert_d(1);
  if ( err != 0 )
    fprintf(stdout, "%d errors\n", err);
  else
    fprintf(stdout, "ok\n");
  errors += err;

  fprintf(stdout, "testing standard_shift_double...");
  err = test_expert_d(2);
  if ( err != 0 )
    fprintf(stdout, "%d errors\n", err);
  else
    fprintf(stdout, "ok\n");
  errors += err;

  fprintf(stdout, "testing generalized_shift_double...");
  err = test_expert_d(3);
  if ( err != 0 )
    fprintf(stdout, "%d errors\n", err);
  else
    fprintf(stdout, "ok\n");
  errors += err;

  fprintf(stdout, "testing buckling_double...");
  err = test_expert_d(4);
  if ( err != 0 )
    fprintf(stdout, "%d errors\n", err);
  else
    fprintf(stdout, "ok\n");
  errors += err;

  fprintf(stdout, "testing standard_double_complex...");
  err = test_expert_z(0);
  if ( err != 0 )
    fprintf(stdout, "%d errors\n", err);
  else
    fprintf(stdout, "ok\n");
  errors += err;

  fprintf(stdout, "testing generalized_double_complex...");
  err = test_expert_z(1);
  if ( err != 0 )
    fprintf(stdout, "%d errors\n", err);
  else
    fprintf(stdout, "ok\n");
  errors += err;

  fprintf(stdout, "testing standard_shift_double_complex...");
  err = test_expert_z(2);
  if ( err != 0 )
    fprintf(stdout, "%d errors\n", err);
  else
    fprintf(stdout, "ok\n");
  errors += err;

  fprintf(stdout, "testing generalized_shift_double_complex...");
  err = test_expert_z(3);
  if ( err != 0 )
    fprintf(stdout, "%d errors\n", err);
  else
    fprintf(stdout, "ok\n");
  errors += err;

  fprintf(stdout, "testing buckling_double_complex...");
  err = test_expert_z(4);
  if ( err != 0 )
    fprintf(stdout, "%d errors\n", err);
  else
    fprintf(stdout, "ok\n");
  errors += err;

  return errors;
}

int test_expert_d(int problem) {

   const int ngrid = 20;          /* grid points along each side */
   const int n     = ngrid*ngrid; /* problem size */
   const int m     = 3;           /* dimension of the iterated subspace */

   const int ncon_x = 6;
   const double lambda_x[] = {
      4.4676695e-02,
      1.1119274e-01,
      1.1119274e-01,
      1.7770878e-01,
      2.2040061e-01,
      2.2040061e-01
   };
   const double lambda_six[] = {
      9.5108266e-01,
      9.5108266e-01,
      8.8141871e-01,
      8.8141871e-01,
      8.4187478e-01,
      8.4187478e-01
   };

   int errors;
   int nep = 5;

   int state = SPRAL_RANDOM_INITIAL_SEED; /* PRNG state */

   int ind[m];                 /* permutation index */
   int ipiv[n];               /* LDLT pivot index */
   double sigma;              /* shift */
   double A[n][n];            /* matrix */
   double LDLT[n][n];         /* factors */
   double lambda[n];          /* eigenvalues */
   double X[n][n];            /* eigenvectors */
   /* Work arrays */
   double work[n][n];         /* work array for dsytrf */
   double rr[3][2*m][2*m];
   double W[8][m][n];
   double U[m][n];
   double V[m];

   /* Derived types */
   struct spral_ssmfe_rcid rci;            /* reverse communication data */
   struct spral_ssmfe_options options;     /* options */
   void *keep;                             /* private data */
   struct spral_ssmfe_inform inform;       /* information */

   if ( problem > 1 ) {
     sigma = 1.0;
     set_laplacian_matrix(ngrid, ngrid, n, A);
     for(int j=0; j<n; j++)
     for(int i=0; i<n; i++)
        LDLT[j][i] = (i==j) ? A[j][i] - sigma
                            : A[j][i];
     cwrap_dsytrf('L', n, &LDLT[0][0], n, ipiv, &work[0][0], n*n);
     int i = num_neg_D(n, n, LDLT, ipiv);   /* all evalues to left of sigma */
     if ( i < nep ) nep = i;
   }

   /* Initialize options to default values */
   spral_ssmfe_default_options(&options);
   /* gap between the last converged eigenvalue and the rest of the spectrum
    * must be at least 0.1 times average gap between computed eigenvalues */
   options.left_gap = -0.1;
   /* block size is small, convergence may be slow, allow more iterations */
   options.max_iterations = 300;

   /* Initialize W to lin indep vectors by randomizing */
   for(int i=0; i<n; i++)
   for(int j=0; j<m; j++)
      W[0][j][i] = spral_random_real(&state, true);

   int ncon = 0;   /* number of converged eigenpairs */
   rci.job = 0; keep = NULL;
   while(true) { /* reverse communication loop */
      switch ( problem ) {
      case 0:
        spral_ssmfe_expert_standard_double(&rci, nep, n, lambda,
           m, &rr[0][0][0], ind, &keep, &options, &inform);
        break;
      case 1:
        spral_ssmfe_expert_generalized_double(&rci, nep, n, lambda,
           m, &rr[0][0][0], ind, &keep, &options, &inform);
        break;
      case 2:
        spral_ssmfe_expert_standard_shift_double(&rci, sigma, nep, 0, n, lambda,
           m, &rr[0][0][0], ind, &keep, &options, &inform);
        break;
      case 3:
        spral_ssmfe_expert_generalized_shift_double(
           &rci, sigma, nep, 0, n, lambda,
           m, &rr[0][0][0], ind, &keep, &options, &inform);
        break;
      case 4:
        spral_ssmfe_expert_buckling_double(
           &rci, sigma, nep, 0, n, lambda,
           m, &rr[0][0][0], ind, &keep, &options, &inform);
        break;
      }
      switch ( rci.job ) {
      case 1:
         if ( problem < 4 )
           apply_laplacian(
              ngrid, ngrid, rci.nx, &W[rci.kx][rci.jx][0], &W[rci.ky][rci.jy][0]
              );
         else
           cblas_dcopy
              ( n*rci.nx, &W[rci.kx][rci.jx][0], 1, &W[rci.ky][rci.jy][0], 1 );
         break;
      case 2:
         if ( problem < 2 )
           apply_gauss_seidel_step (
              ngrid, ngrid, rci.nx, &W[rci.kx][rci.jx][0], &W[rci.ky][rci.jy][0]
              );
         else
            cblas_dcopy
               ( n*rci.nx, &W[rci.kx][rci.jx][0], 1, &W[rci.ky][rci.jy][0], 1 );
         break;
      case 3:
         if ( problem < 4 )
           cblas_dcopy
              ( n*rci.nx, &W[rci.kx][rci.jx][0], 1, &W[rci.ky][rci.jy][0], 1 );
         else
           apply_laplacian(
              ngrid, ngrid, rci.nx, &W[rci.kx][rci.jx][0], &W[rci.ky][rci.jy][0]
              );
         break;
      case 5:
         if ( rci.i < 0 ) continue;
         for(int k=0; k<rci.nx; k++) {
           int j = ncon + k;
           cblas_dcopy( n, &W[0][rci.jx+k][0], 1, &X[j][0], 1 );
         }
         ncon += rci.nx;
         break;
      case 9:
         cblas_dcopy(
            n*rci.nx, &W[rci.kx][rci.jx][0], 1, &W[rci.ky][rci.jy][0], 1
            );
         cwrap_dsytrs(
            'L', n, rci.nx, &LDLT[0][0], n, ipiv, &W[rci.ky][rci.jy][0], n
            );
         break;
      case 11:
      case 12:
      case 13:
      case 14:
      case 15:
      case 16:
      case 17:
        vector_operations_d( rci, n, m, 8, ind, W, rr, V );
         break;
      case 21: // Fall through to 22
      case 22:
         if( ncon > 0 ) {
            cblas_dgemm(
               CblasColMajor, CblasTrans, CblasNoTrans, ncon, rci.nx, n,
               1.0, &X[0][0], n, &W[rci.ky][rci.jy][0], n, 0.0, &U[0][0], n
               );
            cblas_dgemm(
               CblasColMajor, CblasNoTrans, CblasNoTrans, n, rci.nx, ncon,
               -1.0, &X[0][0], n, &U[0][0], n, 1.0, &W[rci.kx][rci.jx][0], n
               );
            if ( problem == 1 || problem == 3 )
              cblas_dgemm(
                 CblasColMajor, CblasNoTrans, CblasNoTrans, n, rci.nx, ncon,
                 -1.0, &X[0][0], n, &U[0][0], n, 1.0, &W[rci.ky][rci.jy][0], n
                 );
            else if ( problem == 4 )
               apply_laplacian(
                  ngrid, ngrid, rci.nx, &W[rci.kx][rci.jx][0],
                  &W[rci.ky][rci.jy][0]
                  );
         }
         break;
      case 999:
         if( rci.k == 0 ) {
            if( rci.jx > 1 ) {
               for(int j=0; j<rci.jx; j++)
               for(int i=0; i<n; i++)
                  W[0][j][i] = spral_random_real(&state, true);
            }
         }
         break;
      default:
         goto finished;
      }
   }
finished:
   errors = 0;
   if ( inform.flag != 0 ) errors++;
   if ( ncon != ncon_x ) errors++;
   if ( problem < 2 ) {
     for ( int i = 0; i < ncon && i < ncon_x; i++ )
        if ( fabs(lambda[i] - lambda_x[i]) > 1e-6 ) errors++;
   }
   else {
     for ( int i = 0; i < ncon && i < ncon_x; i++ )
        if ( fabs(lambda[i] - lambda_six[i]) > 1e-6 ) errors++;
   }
   spral_ssmfe_expert_free(&keep, &inform);

   return errors;
}

int test_expert_z(int problem) {

   const int ngrid = 20;          /* grid points along each side */
   const int n     = ngrid*ngrid; /* problem size */
   const int m     = 3;           /* dimension of the iterated subspace */

   const int ncon_x = 6;
   const double lambda_x[] = {
      4.4676695e-02,
      1.1119274e-01,
      1.1119274e-01,
      1.7770878e-01,
      2.2040061e-01,
      2.2040061e-01
   };
   const double lambda_six[] = {
      9.5108266e-01,
      9.5108266e-01,
      8.8141871e-01,
      8.8141871e-01,
      8.4187478e-01,
      8.4187478e-01
   };

   const double complex ZERO = 0.0;
   const double complex ONE = 1.0;
   const double complex NONE = -1.0;

   int errors;
   int nep = 5;

   int state = SPRAL_RANDOM_INITIAL_SEED; /* PRNG state */

   int ind[m];                    /* permutation index */
   int ipiv[n];                   /* LDLT pivot index */
   double sigma;                  /* shift */
   double lambda[n];              /* eigenvalues */
   double complex X[n][n];        /* eigenvectors */
   /* Work arrays */
   double B[n][n];
   double LDLT[n][n];
   double work[n][n];
   double complex rr[3][2*m][2*m];
   double complex W[8][m][n];
   double complex U[m][n];
   double complex V[m];

   /* Derived types */
   struct spral_ssmfe_rciz rci;            /* reverse communication data */
   struct spral_ssmfe_options options;     /* options */
   void *keep;                             /* private data */
   struct spral_ssmfe_inform inform;       /* information */

   if ( problem > 1 ) {
     sigma = 1.0;
//     set_laplacian_matrix_z(ngrid, ngrid, n, A);
     set_laplacian_matrix(ngrid, ngrid, n, B);
     for(int j=0; j<n; j++)
     for(int i=0; i<n; i++)
        LDLT[j][i] = (i==j) ? B[j][i] - sigma
                            : B[j][i];
//        LDLT[j][i] = (i==j) ? A[j][i] - sigma
//                            : A[j][i];
     cwrap_dsytrf('L', n, &LDLT[0][0], n, ipiv, &work[0][0], n*n);
   }

   /* Initialize options to default values */
   spral_ssmfe_default_options(&options);
   /* gap between the last converged eigenvalue and the rest of the spectrum
    * must be at least 0.1 times average gap between computed eigenvalues */
   options.left_gap = -0.1;
   /* block size is small, convergence may be slow, allow more iterations */
   options.max_iterations = 200;

   /* Initialize W to lin indep vectors by randomizing */
   for(int i=0; i<n; i++)
   for(int j=0; j<m; j++)
      W[0][j][i] = spral_random_real(&state, true);

   int ncon = 0;   /* number of converged eigenpairs */
   rci.job = 0; keep = NULL;
   while(true) { /* reverse communication loop */
      switch ( problem ) {
      case 0:
        spral_ssmfe_expert_standard_double_complex(&rci, nep, n, lambda,
           m, &rr[0][0][0], ind, &keep, &options, &inform);
        break;
      case 1:
        spral_ssmfe_expert_generalized_double_complex(&rci, nep, n, lambda,
           m, &rr[0][0][0], ind, &keep, &options, &inform);
        break;
      case 2:
        spral_ssmfe_expert_standard_shift_double_complex(
           &rci, sigma, nep, 0, n, lambda,
           m, &rr[0][0][0], ind, &keep, &options, &inform);
        break;
      case 3:
        spral_ssmfe_expert_generalized_shift_double_complex(
           &rci, sigma, nep, 0, n, lambda,
           m, &rr[0][0][0], ind, &keep, &options, &inform);
        break;
      case 4:
        spral_ssmfe_expert_buckling_double_complex(
           &rci, sigma, nep, 0, n, lambda,
           m, &rr[0][0][0], ind, &keep, &options, &inform);
        break;
      }
      switch ( rci.job ) {
      case 1:
         if ( problem < 4 )
           apply_laplacian_z(
              ngrid, ngrid, rci.nx, &W[rci.kx][rci.jx][0], &W[rci.ky][rci.jy][0]
              );
         else
            cblas_zcopy
               ( n*rci.nx, &W[rci.kx][rci.jx][0], 1, &W[rci.ky][rci.jy][0], 1 );
         break;
      case 2:
         if ( problem < 2 )
            apply_gauss_seidel_step_z (
               ngrid, ngrid, rci.nx, &W[rci.kx][rci.jx][0], &W[rci.ky][rci.jy][0]
               );
         else
            cblas_zcopy
               ( n*rci.nx, &W[rci.kx][rci.jx][0], 1, &W[rci.ky][rci.jy][0], 1 );
         break;
      case 3:
         if ( problem < 4 )
           cblas_zcopy
              ( n*rci.nx, &W[rci.kx][rci.jx][0], 1, &W[rci.ky][rci.jy][0], 1 );
         else
           apply_laplacian_z(
              ngrid, ngrid, rci.nx, &W[rci.kx][rci.jx][0], &W[rci.ky][rci.jy][0]
              );
         break;
      case 5:
         if ( rci.i < 0 ) continue;
         for(int k=0; k<rci.nx; k++) {
           int j = ncon + k;
           cblas_zcopy( n, &W[0][rci.jx+k][0], 1, &X[j][0], 1 );
         }
         ncon += rci.nx;
         break;
      case 9:
         for(int i=0; i<n; i++)
           for(int j=0; j<rci.nx; j++)
              work[j][i] = W[rci.kx][rci.jx + j][i];
         cwrap_dsytrs(
            'L', n, rci.nx, &LDLT[0][0], n, ipiv, &work[0][0], n
            );
         for(int i=0; i<n; i++)
           for(int j=0; j<rci.nx; j++)
              W[rci.ky][rci.jy + j][i] = work[j][i];
         break;
      case 11:
      case 12:
      case 13:
      case 14:
      case 15:
      case 16:
      case 17:
        vector_operations_z( rci, n, m, 8, ind, W, rr, V );
         break;
      case 21: // Fall through to 22
      case 22:
         if( ncon > 0 ) {
            cblas_zgemm(
               CblasColMajor, CblasTrans, CblasNoTrans, ncon, rci.nx, n,
               &ONE, &X[0][0], n, &W[rci.ky][rci.jy][0], n, &ZERO, &U[0][0], n
               );
            cblas_zgemm(
               CblasColMajor, CblasNoTrans, CblasNoTrans, n, rci.nx, ncon,
               &NONE, &X[0][0], n, &U[0][0], n, &ONE, &W[rci.kx][rci.jx][0], n
               );
            if ( problem == 1 || problem == 3 )
              cblas_zgemm(
                 CblasColMajor, CblasNoTrans, CblasNoTrans, n, rci.nx, ncon,
                 &NONE, &X[0][0], n, &U[0][0], n, &ONE, &W[rci.ky][rci.jy][0], n
                 );
            else if ( problem == 4 )
               apply_laplacian_z(
                  ngrid, ngrid, rci.nx, &W[rci.kx][rci.jx][0],
                  &W[rci.ky][rci.jy][0]
                  );
         }
         break;
      case 999:
         if( rci.k == 0 ) {
            if( rci.jx > 1 ) {
               for(int j=0; j<rci.jx; j++)
               for(int i=0; i<n; i++)
                  W[0][j][i] = spral_random_real(&state, true);
            }
         }
         break;
      default:
         goto finished;
      }
   }
finished:
   errors = 0;
   if ( inform.flag != 0 ) errors++;
   if ( ncon != ncon_x ) errors++;
   if ( problem < 2 ) {
     for ( int i = 0; i < ncon && i < ncon_x; i++ )
        if ( fabs(lambda[i] - lambda_x[i]) > 1e-6 ) errors++;
   }
   else {
     for ( int i = 0; i < ncon && i < ncon_x; i++ )
        if ( fabs(lambda[i] - lambda_six[i]) > 1e-6 ) errors++;
   }
   spral_ssmfe_expert_free(&keep, &inform);

   return errors;
}

int test_ssmfe(void) {

  int errors = 0;
  int err;

  fprintf(stdout, "testing standard_double...");
  err = test_ssmfe_d(0);
  if ( err != 0 )
    fprintf(stdout, "%d errors\n", err);
  else
    fprintf(stdout, "ok\n");
  errors += err;

  fprintf(stdout, "testing generalized_double...");
  err = test_ssmfe_d(1);
  if ( err != 0 )
    fprintf(stdout, "%d errors\n", err);
  else
    fprintf(stdout, "ok\n");
  errors += err;

  fprintf(stdout, "testing standard_shift_double...");
  err = test_ssmfe_d(2);
  if ( err != 0 )
    fprintf(stdout, "%d errors\n", err);
  else
    fprintf(stdout, "ok\n");
  errors += err;

  fprintf(stdout, "testing generalized_shift_double...");
  err = test_ssmfe_d(3);
  if ( err != 0 )
    fprintf(stdout, "%d errors\n", err);
  else
    fprintf(stdout, "ok\n");
  errors += err;

  fprintf(stdout, "testing buckling_double...");
  err = test_ssmfe_d(4);
  if ( err != 0 )
    fprintf(stdout, "%d errors\n", err);
  else
    fprintf(stdout, "ok\n");
  errors += err;

  fprintf(stdout, "testing standard_double_complex...");
  err = test_ssmfe_z(0);
  if ( err != 0 )
    fprintf(stdout, "%d errors\n", err);
  else
    fprintf(stdout, "ok\n");
  errors += err;

  fprintf(stdout, "testing generalized_double_complex...");
  err = test_ssmfe_z(1);
  if ( err != 0 )
    fprintf(stdout, "%d errors\n", err);
  else
    fprintf(stdout, "ok\n");
  errors += err;

  fprintf(stdout, "testing standard_shift_double_complex...");
  err = test_ssmfe_z(2);
  if ( err != 0 )
    fprintf(stdout, "%d errors\n", err);
  else
    fprintf(stdout, "ok\n");
  errors += err;

  fprintf(stdout, "testing generalized_shift_double_complex...");
  err = test_ssmfe_z(3);
  if ( err != 0 )
    fprintf(stdout, "%d errors\n", err);
  else
    fprintf(stdout, "ok\n");
  errors += err;

  fprintf(stdout, "testing buckling_double_complex...");
  err = test_ssmfe_z(4);
  if ( err != 0 )
    fprintf(stdout, "%d errors\n", err);
  else
    fprintf(stdout, "ok\n");
  errors += err;

  return errors;
}

int test_ssmfe_d(int problem) {

   const int m   = 20;     /* grid points along each side */
   const int n   = m*m;    /* problem size */

   const int ncon_x = 6;
   const double sigma = 1.0;  /* shift */
   const double lambda_x[] = {
      4.4676695e-02,
      1.1119274e-01,
      1.1119274e-01,
      1.7770878e-01,
      2.2040061e-01,
      2.2040061e-01
   };
   const double lambda_six[] = {
      8.4187478e-01,
      8.4187478e-01,
      8.8141871e-01,
      8.8141871e-01,
      9.5108266e-01,
      9.5108266e-01
   };

   int errors;
   int nep = 5;

   int ipiv[n];                           /* LDLT pivot index */

   double lambda[n];                  /* eigenvalues */
   double X[n][n];                    /* eigenvectors */
   double A[n][n];                        /* matrix */
   double LDLT[n][n];                     /* factors */
   double work[n][n];                     /* work array for dsytrf */

   struct spral_ssmfe_rcid rci;           /* reverse communication data */
   struct spral_ssmfe_options options;    /* options */
   void *keep;                            /* private data */
   struct spral_ssmfe_inform inform;      /* information */

   if ( problem > 1 ) {
     set_laplacian_matrix( m, m, n, A );
     for(int j=0; j<n; j++)
     for(int i=0; i<n; i++)
        LDLT[j][i] = (i==j) ? A[j][i] - sigma
                            : A[j][i];
     cwrap_dsytrf( 'L', n, &LDLT[0][0], n, ipiv, &work[0][0], n*n );
   }

   /* Initialize options to default values */
   spral_ssmfe_default_options(&options);
   /* gap between the last converged eigenvalue and the rest of the spectrum
    * must be at least 0.1 times average gap between computed eigenvalues */
   options.left_gap = -0.1;

   rci.job = 0; keep = NULL;
   while(true) { /* reverse communication loop */
      switch ( problem ) {
      case 0:
         spral_ssmfe_standard_double( &rci, nep, 2*nep, lambda, n, &X[0][0], n,
            &keep, &options, &inform );
         break;
      case 1:
         spral_ssmfe_standard_double( &rci, nep, 2*nep, lambda, n, &X[0][0], n,
            &keep, &options, &inform );
         break;
      case 2:
         spral_ssmfe_standard_shift_double( &rci, sigma, nep, 0, n, lambda,
            n, &X[0][0], n, &keep, &options, &inform );
         break;
      case 3:
         spral_ssmfe_generalized_shift_double( &rci, sigma, nep, 0, n, lambda,
            n, &X[0][0], n, &keep, &options, &inform );
         break;
      case 4:
         spral_ssmfe_buckling_double( &rci, sigma, nep, 0, n, lambda,
            n, &X[0][0], n, &keep, &options, &inform );
         break;
      }
      switch ( rci.job ) {
      case 1:
         if ( problem < 4 )
            apply_laplacian(m, m, rci.nx, rci.x, rci.y);
         else
            cblas_dcopy( n*rci.nx, rci.x, 1, rci.y, 1 );
         break;
      case 2:
         if ( problem < 2 )
            apply_gauss_seidel_step(m, m, rci.nx, rci.x, rci.y);
         break;
      case 3:
         if ( problem < 4 )
            cblas_dcopy( n*rci.nx, rci.x, 1, rci.y, 1 );
         else
            apply_laplacian(m, m, rci.nx, rci.x, rci.y);
         break;
      case 9:
         cblas_dcopy( n*rci.nx, rci.x, 1, rci.y, 1 );
         cwrap_dsytrs( 'L', n, rci.nx, &LDLT[0][0], n, ipiv, rci.y, n );
         break;
      default:
         goto finished;
      }
   }
finished:
   errors = 0;
   if ( inform.flag != 0 ) errors++;
   if ( inform.left != ncon_x ) errors++;
   if ( problem < 2 ) {
     for ( int i = 0; i < inform.left && i < ncon_x; i++ )
        if ( fabs(lambda[i] - lambda_x[i]) > 1e-6 ) errors++;
   }
   else {
     for ( int i = 0; i < inform.left && i < ncon_x; i++ )
        if ( fabs(lambda[i] - lambda_six[i]) > 1e-6 ) errors++;
   }
   spral_ssmfe_free_double(&keep, &inform);
   return errors;
}

int test_ssmfe_z(int problem) {

   const int m   = 20;     /* grid points along each side */
   const int n   = m*m;    /* problem size */

   const int ncon_x = 6;
   const double sigma = 1.0;  /* shift */
   const double lambda_x[] = {
      4.4676695e-02,
      1.1119274e-01,
      1.1119274e-01,
      1.7770878e-01,
      2.2040061e-01,
      2.2040061e-01
   };
   const double lambda_six[] = {
      8.4187478e-01,
      8.4187478e-01,
      8.8141871e-01,
      8.8141871e-01,
      9.5108266e-01,
      9.5108266e-01
   };

   int errors;
   int nep = 5;

   int ipiv[n];                           /* LDLT pivot index */

   double lambda[n];                  /* eigenvalues */
   double complex X[n][n];                    /* eigenvectors */
   double A[n][n];                        /* matrix */
   double LDLT[n][n];                     /* factors */
   double work[n][n];                     /* work array for dsytrf */

   struct spral_ssmfe_rciz rci;           /* reverse communication data */
   struct spral_ssmfe_options options;    /* options */
   void *keep;                            /* private data */
   struct spral_ssmfe_inform inform;      /* information */

   if ( problem > 1 ) {
     set_laplacian_matrix( m, m, n, A );
     for(int j=0; j<n; j++)
     for(int i=0; i<n; i++)
        LDLT[j][i] = (i==j) ? A[j][i] - sigma
                            : A[j][i];
     cwrap_dsytrf( 'L', n, &LDLT[0][0], n, ipiv, &work[0][0], n*n );
   }

   /* Initialize options to default values */
   spral_ssmfe_default_options(&options);
   /* gap between the last converged eigenvalue and the rest of the spectrum
    * must be at least 0.1 times average gap between computed eigenvalues */
   options.left_gap = -0.1;

   rci.job = 0; keep = NULL;
   while(true) { /* reverse communication loop */
      switch ( problem ) {
      case 0:
         spral_ssmfe_standard_double_complex(
            &rci, nep, 2*nep, lambda, n, &X[0][0], n,
            &keep, &options, &inform );
         break;
      case 1:
         spral_ssmfe_standard_double_complex(
            &rci, nep, 2*nep, lambda, n, &X[0][0], n,
            &keep, &options, &inform );
         break;
      case 2:
         spral_ssmfe_standard_shift_double_complex(
            &rci, sigma, nep, 0, n, lambda,
            n, &X[0][0], n, &keep, &options, &inform );
         break;
      case 3:
         spral_ssmfe_generalized_shift_double_complex(
            &rci, sigma, nep, 0, n, lambda,
            n, &X[0][0], n, &keep, &options, &inform );
         break;
      case 4:
         spral_ssmfe_buckling_double_complex(
            &rci, sigma, nep, 0, n, lambda,
            n, &X[0][0], n, &keep, &options, &inform );
         break;
      }
      switch ( rci.job ) {
      case 1:
         if ( problem < 4 )
            apply_laplacian_z( m, m, rci.nx, rci.x, rci.y );
         else
            cblas_zcopy( n*rci.nx, rci.x, 1, rci.y, 1 );
         break;
      case 2:
         if ( problem < 2 )
            apply_gauss_seidel_step_z( m, m, rci.nx, rci.x, rci.y );
         break;
      case 3:
         if ( problem < 4 )
            cblas_zcopy( n*rci.nx, rci.x, 1, rci.y, 1 );
         else
            apply_laplacian_z( m, m, rci.nx, rci.x, rci.y );
         break;
      case 9:
         zdcopy( n*rci.nx, rci.x, &work[0][0] );
         cwrap_dsytrs( 'L', n, rci.nx, &LDLT[0][0], n, ipiv, &work[0][0], n );
         dzcopy( n*rci.nx, &work[0][0], rci.y );
         break;
      default:
         goto finished;
      }
   }
finished:
   errors = 0;
   if ( inform.flag != 0 ) errors++;
   if ( inform.left != ncon_x ) errors++;
   if ( problem < 2 ) {
     for ( int i = 0; i < inform.left && i < ncon_x; i++ )
        if ( fabs(lambda[i] - lambda_x[i]) > 1e-6 ) errors++;
   }
   else {
     for ( int i = 0; i < inform.left && i < ncon_x; i++ )
        if ( fabs(lambda[i] - lambda_six[i]) > 1e-6 ) errors++;
   }
   if ( problem == -2 ) {
   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);
   return errors;
}

void zdcopy( int n, double complex* x, double* y ) {
   for ( int i = 0; i < n; i++ )
      y[i] = x[i];
}

void dzcopy( int n, double* x, double complex* y ) {
   for ( int i = 0; i < n; i++ )
      y[i] = x[i];
}

void vector_operations_d
  ( struct spral_ssmfe_rcid rci,
    int n, int m, int kw, int ind[m],
    double W[kw][m][n],
    double rr[3][2*m][2*m],
    double U[m]) {

   switch ( rci.job ) {
      case 11:
         if ( rci.i == 0 ) {
            if ( rci.kx != rci.ky || rci.jx > rci.jy ) {
               cblas_dcopy(
                  n*rci.nx, &W[rci.kx][rci.jx][0], 1, &W[rci.ky][rci.jy][0], 1
                  );
            } else if ( rci.jx < rci.jy ) {
               for(int j=rci.nx-1; j>=0; j--)
                  cblas_dcopy(
                     n, &W[rci.kx][rci.jx+j][0], 1, &W[rci.ky][rci.jy+j][0], 1
                     );
            }
         } else {
            for(int i=0; i<n; i++) {
               for(int j=0; j<rci.nx; j++)
                  U[j] = W[rci.kx][ind[j]][i];
               for(int j=0; j<rci.nx; j++)
                  W[rci.kx][j][i] = U[j];
               if(rci.ky != rci.kx) {
                  for(int j=0; j<rci.nx; j++)
                    U[j] = W[rci.ky][ind[j]][i];
                  for(int j=0; j<rci.nx; j++)
                    W[rci.ky][j][i] = U[j];
               }
            }
         }
         break;
      case 12:
         for(int i=0; i<rci.nx; i++)
           rr[rci.k][rci.j+i][rci.i+i] =
             cblas_ddot(
                n, &W[rci.kx][rci.jx+i][0], 1, &W[rci.ky][rci.jy+i][0], 1
                );
         break;
      case 13:
         for(int i=0; i<rci.nx; i++) {
            if( rci.kx == rci.ky ) {
               double s = cblas_dnrm2(n, &W[rci.kx][rci.jx+i][0], 1);
               if( s > 0 )
                  cblas_dscal(n, 1/s, &W[rci.kx][rci.jx+i][0], 1);
            } else {
               double s = sqrt(fabs(cblas_ddot(
                  n, &W[rci.kx][rci.jx+i][0], 1, &W[rci.ky][rci.jy+i][0], 1)
                  ));
               if ( s > 0 ) {
                  cblas_dscal(n, 1/s, &W[rci.kx][rci.jx+i][0], 1);
                  cblas_dscal(n, 1/s, &W[rci.ky][rci.jy+i][0], 1);
               } else {
                  for(int j=0; j<n; j++)
                     W[rci.ky][rci.jy+i][j] = 0.0;
               }
            }
         }
         break;
      case 14:
         for(int i=0; i<rci.nx; i++) {
           double s = -rr[rci.k][rci.j+i][rci.i+i];
           cblas_daxpy(
              n, s, &W[rci.kx][rci.jx+i][0], 1, &W[rci.ky][rci.jy+i][0], 1
              );
         }
         break;
      case 15:
         if ( rci.nx > 0 && rci.ny > 0 )
            cblas_dgemm(
               CblasColMajor, CblasTrans, CblasNoTrans, rci.nx, rci.ny, n,
               rci.alpha, &W[rci.kx][rci.jx][0], n, &W[rci.ky][rci.jy][0], n,
               rci.beta, &rr[rci.k][rci.j][rci.i], 2*m
               );
         break;
      case 16: // Fall through to 17
      case 17:
         if( rci.job == 17 ) {
            cblas_dgemm(
               CblasColMajor, CblasNoTrans, CblasNoTrans, n, rci.ny, rci.nx,
               1.0, &W[rci.kx][rci.jx][0], n, &rr[rci.k][rci.j][rci.i], 2*m,
               0.0, &W[rci.ky][rci.jy][0], n
               );
            cblas_dcopy(
               n*rci.ny, &W[rci.ky][rci.jy][0], 1, &W[rci.kx][rci.jx][0], 1
               );
         } else {
            cblas_dgemm(
               CblasColMajor, CblasNoTrans, CblasNoTrans, n, rci.ny, rci.nx,
               rci.alpha, &W[rci.kx][rci.jx][0], n, &rr[rci.k][rci.j][rci.i],
               2*m, rci.beta, &W[rci.ky][rci.jy][0], n
               );
         }
         break;
   }
}

void vector_operations_z
  ( struct spral_ssmfe_rciz rci,
    int n, int m, int kw, int ind[m],
    double complex W[kw][m][n],
    double complex rr[3][2*m][2*m],
    double complex U[m]) {

   const double complex ZERO = 0.0;
   const double complex ONE = 1.0;

   double complex z;

    switch ( rci.job ) {
    case 11:
       if ( rci.i == 0 ) {
          if ( rci.kx != rci.ky || rci.jx > rci.jy ) {
             cblas_zcopy(
                n*rci.nx, &W[rci.kx][rci.jx][0], 1, &W[rci.ky][rci.jy][0], 1
                );
          } else if ( rci.jx < rci.jy ) {
             for(int j=rci.nx-1; j>=0; j--)
                cblas_zcopy(
                   n, &W[rci.kx][rci.jx+j][0], 1, &W[rci.ky][rci.jy+j][0], 1
                   );
          }
       } else {
          for(int i=0; i<n; i++) {
             for(int j=0; j<rci.nx; j++)
                U[j] = W[rci.kx][ind[j]][i];
             for(int j=0; j<rci.nx; j++)
                W[rci.kx][j][i] = U[j];
             if(rci.ky != rci.kx) {
                for(int j=0; j<rci.nx; j++)
                  U[j] = W[rci.ky][ind[j]][i];
                for(int j=0; j<rci.nx; j++)
                  W[rci.ky][j][i] = U[j];
             }
          }
       }
       break;
    case 12:
       for(int i=0; i<rci.nx; i++) {
          cblas_zdotc_sub(
              n, &W[rci.kx][rci.jx+i][0], 1, &W[rci.ky][rci.jy+i][0], 1, &z
              );
          rr[rci.k][rci.j+i][rci.i+i] = z;
       }
       break;
    case 13:
       for(int i=0; i<rci.nx; i++) {
          if( rci.kx == rci.ky ) {
             double s = cblas_dznrm2(n, &W[rci.kx][rci.jx+i][0], 1);
             if( s > 0 ) {
                z = ONE/s;
                cblas_zscal(n, &z, &W[rci.kx][rci.jx+i][0], 1);
             }
          } else {
             cblas_zdotc_sub(
                n, &W[rci.kx][rci.jx+i][0], 1, &W[rci.ky][rci.jy+i][0], 1, &z
                );
             double s = sqrt(fabs(z));
             if ( s > 0 ) {
                z = ONE/s;
                cblas_zscal(n, &z, &W[rci.kx][rci.jx+i][0], 1);
                cblas_zscal(n, &z, &W[rci.ky][rci.jy+i][0], 1);
             } else {
                for(int j=0; j<n; j++)
                   W[rci.ky][rci.jy+i][j] = 0.0;
             }
          }
       }
       break;
    case 14:
       for(int i=0; i<rci.nx; i++) {
         double s = -rr[rci.k][rci.j+i][rci.i+i];
         z = s;
         cblas_zaxpy(
            n, &z, &W[rci.kx][rci.jx+i][0], 1, &W[rci.ky][rci.jy+i][0], 1
            );
       }
       break;
    case 15:
       if ( rci.nx > 0 && rci.ny > 0 )
          cblas_zgemm(
             CblasColMajor, CblasTrans, CblasNoTrans, rci.nx, rci.ny, n,
             &rci.alpha, &W[rci.kx][rci.jx][0], n, &W[rci.ky][rci.jy][0], n,
             &rci.beta, &rr[rci.k][rci.j][rci.i], 2*m
             );
       break;
    case 16: // Fall through to 17
    case 17:
       if( rci.job == 17 ) {
          cblas_zgemm(
             CblasColMajor, CblasNoTrans, CblasNoTrans, n, rci.ny, rci.nx,
             &ONE, &W[rci.kx][rci.jx][0], n, &rr[rci.k][rci.j][rci.i], 2*m,
             &ZERO, &W[rci.ky][rci.jy][0], n
             );
          cblas_zcopy(
             n*rci.ny, &W[rci.ky][rci.jy][0], 1, &W[rci.kx][rci.jx][0], 1
             );
       } else {
          cblas_zgemm(
             CblasColMajor, CblasNoTrans, CblasNoTrans, n, rci.ny, rci.nx,
             &rci.alpha, &W[rci.kx][rci.jx][0], n, &rr[rci.k][rci.j][rci.i],
             2*m, &rci.beta, &W[rci.ky][rci.jy][0], n
             );
       }
       break;
     }
}


/**
 *
 * @file
 *
 *  PLASMA core_blas kernel
 *  PLASMA is a software package provided by Univ. of Tennessee,
 *  Univ. of California Berkeley and Univ. of Colorado Denver
 *
 * @version 2.7.1
 * @author Mathieu Faverge
 * @date 2010-11-15
 **/
/*
 * @precisions normal z -> c d s
 */
#include <cblas.h>
#include "dplasma.h"
#include "dplasma_cores.h"
#include "dplasma_zcores.h"

/**
 ******************************************************************************
 *
 * @ingroup parsec_complex64
 *
 *  dplasma_core_ztradd adds to matrices together as in PBLAS pztradd.
 *
 *       B <- alpha * op(A)  + beta * B
 *
 *******************************************************************************
 *
 * @param[in] uplo
 *          Specifies the shape of A and B matrices:
 *          = PlasmaUpperLower: A and B are general matrices.
 *          = PlasmaUpper: op(A) and B are upper trapezoidal matrices.
 *          = PlasmaLower: op(A) and B are lower trapezoidal matrices.
 *
 * @param[in] trans
 *          Specifies whether the matrix A is non-transposed, transposed, or
 *          conjugate transposed
 *          = PlasmaNoTrans:   op(A) = A
 *          = PlasmaTrans:     op(A) = A'
 *          = PlasmaConjTrans: op(A) = conj(A')
 *
 * @param[in] M
 *          Number of rows of the matrices A and B.
 *
 * @param[in] N
 *          Number of columns of the matrices A and B.
 *
 * @param[in] alpha
 *          Scalar factor of A.
 *
 * @param[in] A
 *          Matrix of size LDA-by-N.
 *
 * @param[in] LDA
 *          Leading dimension of the array A. LDA >= max(1,M)
 *
 * @param[in] beta
 *          Scalar factor of B.
 *
 * @param[in,out] B
 *          Matrix of size LDB-by-N.
 *          On exit, B = alpha * op(A) + beta * B
 *
 * @param[in] LDB
 *          Leading dimension of the array B. LDB >= max(1,M)
 *
 *******************************************************************************
 *
 * @return
 *          \retval PLASMA_SUCCESS successful exit
 *          \retval <0 if -i, the i-th argument had an illegal value
 *
 ******************************************************************************/
int dplasma_core_ztradd(PLASMA_enum uplo, PLASMA_enum trans, int M, int N,
                              parsec_complex64_t  alpha,
                        const parsec_complex64_t *A, int LDA,
                              parsec_complex64_t  beta,
                              parsec_complex64_t *B, int LDB)
{
    static parsec_complex64_t zone = (parsec_complex64_t)1.;
    int j;

    if (uplo == PlasmaUpperLower){
        return dplasma_core_zgeadd( trans, M, N, alpha, A, LDA, beta, B, LDB );
    }

    if ((uplo != PlasmaUpper) &&
        (uplo != PlasmaLower))
    {
        dplasma_error("dplasma_core_ztradd", "illegal value of trans");
        return -1;
    }

    if ((trans != PlasmaNoTrans) &&
        (trans != PlasmaTrans)   &&
        (trans != PlasmaConjTrans))
    {
        dplasma_error("dplasma_core_ztradd", "illegal value of trans");
        return -2;
    }

    if (M < 0) {
        dplasma_error("dplasma_core_ztradd", "Illegal value of M");
        return -3;
    }
    if (N < 0) {
        dplasma_error("dplasma_core_ztradd", "Illegal value of N");
        return -4;
    }
    if ( ((trans == PlasmaNoTrans) && (LDA < dplasma_imax(1,M)) && (M > 0)) ||
         ((trans != PlasmaNoTrans) && (LDA < dplasma_imax(1,N)) && (N > 0)) )
    {
        dplasma_error("dplasma_core_ztradd", "Illegal value of LDA");
        return -7;
    }
    if ( (LDB < dplasma_imax(1,M)) && (M > 0) ) {
        dplasma_error("dplasma_core_ztradd", "Illegal value of LDB");
        return -9;
    }

    if (uplo == PlasmaLower) {
        switch( trans ) {
#if defined(PRECISION_z) || defined(PRECISION_c)
        case PlasmaConjTrans:
            for (j=0; j<N; j++, M--, A+=LDA+1, B+=LDB+1) {
                for(int i=0; i<M; i++) {
                    B[i] = beta * B[i] + alpha * conj(A[LDA*i]);
                }
            }
            break;
#endif /* defined(PRECISION_z) || defined(PRECISION_c) */

        case PlasmaTrans:
            for (j=0; j<N; j++, M--, A+=LDA+1, B+=LDB+1) {
                if (beta != zone) {
                    cblas_zscal(M, CBLAS_SADDR(beta), B, 1);
                }
                cblas_zaxpy(M, CBLAS_SADDR(alpha), A, LDA, B, 1);
            }
            break;

        case PlasmaNoTrans:
        default:
            for (j=0; j<N; j++, M--, A+=LDA+1, B+=LDB+1) {
                if (beta != zone) {
                    cblas_zscal(M, CBLAS_SADDR(beta), B, 1);
                }
                cblas_zaxpy(M, CBLAS_SADDR(alpha), A, 1, B, 1);
            }
        }
    }
    else {
        switch( trans ) {
#if defined(PRECISION_z) || defined(PRECISION_c)
        case PlasmaConjTrans:
            for (j=0; j<N; j++, A++, B+=LDB) {
                for(int i=0; i<=j; i++) {
                    B[i] = beta * B[i] + alpha * conj(A[LDA*i]);
                }
            }
            break;
#endif /* defined(PRECISION_z) || defined(PRECISION_c) */

        case PlasmaTrans:
            for (j=0; j<N; j++, A++, B+=LDB) {
                if (beta != zone) {
                    cblas_zscal(j+1, CBLAS_SADDR(beta), B, 1);
                }
                cblas_zaxpy(j+1, CBLAS_SADDR(alpha), A, LDA, B, 1);
            }
            break;

        case PlasmaNoTrans:
        default:
            for (j=0; j<N; j++, A+=LDA, B+=LDB) {
                if (beta != zone) {
                    cblas_zscal(j+1, CBLAS_SADDR(beta), B, 1);
                }
                cblas_zaxpy(j+1, CBLAS_SADDR(alpha), A, 1, B, 1);
            }
        }
    }

    return 0;
}


#include <pthread.h>
#include <stdlib.h>
#include <cblas.h>

#include "tasks.h"

void update_task_seq(void *ptr)
{
    struct update_task_arg *arg = (struct update_task_arg*) ptr;

    int nrows = arg->nrows;
    int ncols = arg->ncols;
    int nrhs  = arg->nrhs;
    double *L = arg->L;
    int ldL   = arg->ldL;
    double *X = arg->X;
    int ldX   = arg->ldX;
    double *B = arg->B;
    int ldB   = arg->ldB;

    // Allocate temporary storage W.
    int ldW = nrows;
    double *W = (double*) malloc(sizeof(*W) * ldW * nrhs);

    // Compute W := L * X.
    cblas_dgemm(CblasColMajor, CblasNoTrans, CblasNoTrans,
                nrows, nrhs, ncols,
                1.0, L, ldL,
                     X, ldX,
                0.0, W, ldW);

    // Acquire lock.
    pthread_mutex_lock(arg->Block);

    // Update B := B - W.
#define B(i,j) B[(i) + (j) * ldB]
#define W(i,j) W[(i) + (j) * ldW]
    for (int j = 0; j < nrhs; ++j) {
        for (int i = 0; i < nrows; ++i) {
            B(i,j) -= W(i,j);
        }
    }
#undef B
#undef W

    // Release lock.
    pthread_mutex_unlock(arg->Block);

    // Free temporary storage.
    free(W);
}