/*
ODE: a program to get optime Runge-Kutta and multi-steps methods.

Copyright 2011-2019, Javier Burguete Tolosa.

Redistribution and use in source and binary forms, with or without modification,
are permitted provided that the following conditions are met:

	1. Redistributions of source code must retain the above copyright notice,
		this list of conditions and the following disclaimer.

	2. Redistributions in binary form must reproduce the above copyright notice,
		this list of conditions and the following disclaimer in the
		documentation and/or other materials provided with the distribution.

THIS SOFTWARE IS PROVIDED BY Javier Burguete Tolosa ``AS IS'' AND ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT
SHALL Javier Burguete Tolosa OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/

/**
 * \file rk.c
 * \brief Source file with common variables and functions to optimize
 *   Runge-Kutta methods.
 * \author Javier Burguete Tolosa.
 * \copyright Copyright 2011-2019.
 */
#define _GNU_SOURCE
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <float.h>
#include <math.h>
#include <libxml/parser.h>
#include <glib.h>
#include <libintl.h>
#include <gsl/gsl_rng.h>
#if HAVE_MPI
#include <mpi.h>
#endif
#include "config.h"
#include "utils.h"
#include "optimize.h"
#include "rk.h"
#include "rk_2_2.h"
#include "rk_3_2.h"
#include "rk_3_3.h"
#include "rk_4_2.h"
#include "rk_4_3.h"
#include "rk_4_4.h"
#include "rk_5_2.h"
#include "rk_5_3.h"
#include "rk_5_4.h"
#include "rk_6_2.h"
#include "rk_6_3.h"
#include "rk_6_4.h"

#define DEBUG_RK 0              ///< macro to debug.

/**
 * Function to print the t-b Runge-Kutta coefficients.
 */
void
rk_print_tb (Optimize * tb,     ///< Optimize struct.
             char *label,       ///< label.
             FILE * file)       ///< file.
{
  long double *x;
  unsigned int i, j, k;
  x = tb->coefficient;
  fprintf (file, "%s: t1=%.19Le\n", label, x[0]);
  for (i = 2, k = 0; i <= tb->nsteps; ++i)
    {
      fprintf (file, "%s: t%u=%.19Le\n", label, i, x[++k]);
      for (j = 0; j < i; ++j)
        fprintf (file, "%s: b%u%u=%.19Le\n", label, i, j, x[++k]);
    }
}

/**
 * Function to print the e Runge-Kutta coefficients.
 */
void
rk_print_e (Optimize * tb,      ///< Optimize struct.
            char *label,        ///< label.
            FILE * file)        ///< file.
{
  long double *x;
  unsigned int i, k, nsteps;
  x = tb->coefficient;
  nsteps = tb->nsteps;
  k = (nsteps + 2) * (nsteps + 1) / 2 - 2;
  for (i = 0; i < nsteps - 1; ++i)
    fprintf (file, "%s: e%u%u=%.19Le\n", label, nsteps, i, x[k++]);
}

/**
 * Function to print in a maxima file the Runge-Kutta coefficients.
 */
static void
rk_print (RK * rk,              ///< RK struct.
          FILE * file)          ///< file.
{
  Optimize *tb, *ac;
  long double *x, *y;
  unsigned int i, j, k, l, nsteps;
  tb = rk->tb;
  ac = rk->ac;
  x = tb->coefficient;
  y = ac->coefficient;
  fprintf (file, "t1:%.19Le;\n", x[0]);
  nsteps = tb->nsteps;
  for (i = 2, k = l = 0; i <= nsteps; ++i)
    {
      fprintf (file, "t%u:%.19Le;\n", i, x[++k]);
      for (j = 0; j < i; ++j)
        fprintf (file, "b%u%u:%.19Le;\n", i, j, x[++k]);
      if (!rk->strong)
        continue;
      for (j = 0; j < i; ++j)
        fprintf (file, "a%u%u:%.19Le;\n", i, j, y[l++]);
      for (j = 0; j < i; ++j)
        fprintf (file, "c%u%u:%.19Le;\n", i, j, y[l++]);
    }
  if (rk->pair)
    for (i = 0; i < nsteps - 1; ++i)
      fprintf (file, "e%u%u:%.19Le;\n", nsteps, i, x[++k]);
}

/**
 * Function to print a maxima format file to check the accuracy order of the
 * Runge-Kutta simple stable methods.
 */
static void
rk_print_maxima (FILE * file,   ///< file.
                 unsigned int nsteps,   ///< steps number.
                 unsigned int ncoefficients,    ///< coefficients number.
                 unsigned int order,    ///< accuracy order.
                 char label)    ///< coefficient label.
{
  unsigned int i, j, k, l;
  // b_{ij}=1 (1st order)
  for (i = 0; i < ncoefficients; ++i)
    fprintf (file, "%c%u%u+", label, nsteps, i);
  fprintf (file, "-1;\n");
  // b_{ij}t_j=1/2 (2nd order)
  for (i = 1; i < ncoefficients; ++i)
    fprintf (file, "%c%u%u*t%u+", label, nsteps, i, i);
  fprintf (file, "-1/2;\n");
  if (order < 2)
    return;
  // b_{ij}t_j^2=1/3 (3rd order)
  for (i = 1; i < ncoefficients; ++i)
    fprintf (file, "%c%u%u*t%u^2+", label, nsteps, i, i);
  fprintf (file, "-1/3;\n");
  if (order < 3)
    return;
  // b_{ij}b_{jk}t_k=1/6 (3rd order)
  for (i = 2; i < ncoefficients; ++i)
    {
      fprintf (file, "%c%u%u*(", label, nsteps, i);
      for (j = 1; j < i; ++j)
        fprintf (file, "b%u%u*t%u+", i, j, j);
      fprintf (file, "0)+");
    }
  fprintf (file, "-1/6;\n");
  // b_{ij}t_j^3=1/4 (4th order)
  for (i = 1; i < ncoefficients; ++i)
    fprintf (file, "%c%u%u*t%u^3+", label, nsteps, i, i);
  fprintf (file, "-1/4;\n");
  if (order < 4)
    return;
  // b_{ij}b_{jk}b_{kl}t_l=1/24 (4th order)
  for (i = 3; i < ncoefficients; ++i)
    {
      fprintf (file, "%c%u%u*(", label, nsteps, i);
      for (j = 2; j < i; ++j)
        {
          fprintf (file, "b%u%u*(", i, j);
          for (k = 1; k < j; ++k)
            fprintf (file, "b%u%u*t%u+", j, k, k);
          fprintf (file, "0)+");
        }
      fprintf (file, "0)+");
    }
  fprintf (file, "-1/24;\n");
  // b_{ij}b_{jk}t_k^2=1/12 (4th order)
  for (i = 2; i < ncoefficients; ++i)
    {
      fprintf (file, "%c%u%u*(", label, nsteps, i);
      for (j = 1; j < i; ++j)
        fprintf (file, "b%u%u*t%u^2+", i, j, j);
      fprintf (file, "0)+");
    }
  fprintf (file, "-1/12;\n");
  // b_{ij}t_jb_{jk}t_k=1/8 (4th order)
  for (i = 2; i < ncoefficients; ++i)
    {
      fprintf (file, "%c%u%u*t%u*(", label, nsteps, i, i);
      for (j = 1; j < i; ++j)
        fprintf (file, "b%u%u*t%u+", i, j, j);
      fprintf (file, "0)+");
    }
  fprintf (file, "-1/8;\n");
  // b_{ij}t_j^4=1/5 (5th order)
  for (i = 1; i < ncoefficients; ++i)
    fprintf (file, "%c%u%u*t%u^4+", label, nsteps, i, i);
  fprintf (file, "-1/5;\n");
  if (order < 5)
    return;
  // b_{ij}t_j^2b_{jk}t_k^2=1/10 (5th order)
  for (i = 2; i < ncoefficients; ++i)
    {
      fprintf (file, "%c%u%u*t%u^2*(", label, nsteps, i, i);
      for (j = 1; j < i; ++j)
        fprintf (file, "b%u%u*t%u+", i, j, j);
      fprintf (file, "0)+");
    }
  fprintf (file, "-1/10;\n");
  // b_{ij}b_{jk}t_k^3=1/20 (5th order)
  for (i = 2; i < ncoefficients; ++i)
    {
      fprintf (file, "%c%u%u*(", label, nsteps, i);
      for (j = 1; j < i; ++j)
        fprintf (file, "b%u%u*t%u^3+", i, j, j);
      fprintf (file, "0)+");
    }
  fprintf (file, "-1/20;\n");
  // b_{ij}(b_{jk}t_k)^2=1/20 (5th order)
  for (i = 2; i < ncoefficients; ++i)
    {
      fprintf (file, "%c%u%u*(", label, nsteps, i);
      for (j = 1; j < i; ++j)
        fprintf (file, "b%u%u*t%u+", i, j, j);
      fprintf (file, "0)^2+");
    }
  fprintf (file, "-1/20;\n");
  // b_{ij}t_jb_{jk}t_k^2=1/15 (5th order)
  for (i = 2; i < ncoefficients; ++i)
    {
      fprintf (file, "%c%u%u*t%u*(", label, nsteps, i, i);
      for (j = 1; j < i; ++j)
        fprintf (file, "b%u%u*t%u^2+", i, j, j);
      fprintf (file, "0)+");
    }
  fprintf (file, "-1/8;\n");
  // b_{ij}t_jb_{jk}b_{kl}t_l=1/24 (5th order)
  for (i = 3; i < ncoefficients; ++i)
    {
      fprintf (file, "%c%u%u*t%u*(", label, nsteps, i, i);
      for (j = 2; j < i; ++j)
        {
          fprintf (file, "b%u%u*(", i, j);
          for (k = 1; k < j; ++k)
            fprintf (file, "b%u%u*t%u+", j, k, k);
          fprintf (file, "0)+");
        }
      fprintf (file, "0)+");
    }
  fprintf (file, "-7/120;\n");
  // b_{ij}b_{jk}b_{kl}t_l^2=1/60 (5th order)
  for (i = 3; i < ncoefficients; ++i)
    {
      fprintf (file, "%c%u%u*(", label, nsteps, i);
      for (j = 2; j < i; ++j)
        {
          fprintf (file, "b%u%u*(", i, j);
          for (k = 1; k < j; ++k)
            fprintf (file, "b%u%u*t%u^2+", j, k, k);
          fprintf (file, "0)+");
        }
      fprintf (file, "0)+");
    }
  fprintf (file, "-1/60;\n");
  // b_{ij}b_{jk}b_{kl}b_{lm}t_m=1/120 (5th order)
  for (i = 4; i < ncoefficients; ++i)
    {
      fprintf (file, "%c%u%u*(", label, nsteps, i);
      for (j = 3; j < i; ++j)
        {
          fprintf (file, "b%u%u*(", i, j);
          for (k = 2; k < j; ++k)
            {
              fprintf (file, "b%u%u*(", j, k);
              for (l = 1; l < k; ++l)
                fprintf (file, "b%u%u*t%u+", k, l, l);
              fprintf (file, "0)+");
            }
          fprintf (file, "0)+");
        }
      fprintf (file, "0)+");
    }
  fprintf (file, "-1/120;\n");
  // b_{ij}t_j^5=1/6 (6th order)
  for (i = 1; i < ncoefficients; ++i)
    fprintf (file, "%c%u%u*t%u^5+", label, nsteps, i, i);
  fprintf (file, "-1/6;\n");
}

/**
 * Function to print in a maxima file the a-c Runge-Kutta equations.
 */
static void
ac_print_maxima (FILE * file,   ///< file.
                 unsigned int nsteps)   ///< steps number.
{
  unsigned int i, j, k;
  for (i = 2; i <= nsteps; ++i)
    {
      // a_{i,j}=1
      for (j = 0; j < i; ++j)
        fprintf (file, "a%u%u+", i, j);
      fprintf (file, "-1;\n");
      // a_{i0}c_{i0}+a_{ij}b_{j0}=b_{i0}
      fprintf (file, "a%u0*c%u0+a%u1*t1+", i, i, i);
      for (j = 2; j < i; ++j)
        fprintf (file, "a%u%u*b%u0+", i, j, j);
      fprintf (file, "-b%u0;\n", i);
      // a_{ij}c_{ij}+a_{ik}b_{kj}=b_{ij}
      for (j = 1; j < i; ++j)
        {
          fprintf (file, "a%u%u*c%u%u+", i, j, i, j);
          for (k = j; ++k < i;)
            fprintf (file, "a%u%u*b%u%u+", i, k, k, j);
          fprintf (file, "-b%u%u;\n", i, j);
        }
    }
}

/**
 * Function to get \f$a_{ij}\f$ and \f$c_{ij}\f$ coefficients of the Runge-Kutta
 * 2nd step.
 */
static int
rk_ac_2 (RK * rk)               ///< RK struct.
{
  long double *tb, *ac, *r;
  register long double ac0;
#if DEBUG_RK
  fprintf (stderr, "rk_ac_2: start\n");
#endif
  tb = rk->tb->coefficient;
  ac = rk->ac->coefficient;
  r = rk->ac->random_data;
  c21 (ac) = r[0];
  a21 (ac) = b21 (tb) / c21 (ac);
  a20 (ac) = 1.L - a21 (ac);
  ac0 = b20 (tb) - a21 (ac) * t1 (tb);
  c20 (ac) = fabsl (ac0) < LDBL_EPSILON ? 0.L : ac0 / a20 (ac);
#if DEBUG_RK
  fprintf (stderr, "rk_ac_2: a20=%Lg c20=%Lg\n", a20 (ac), c20 (ac));
  fprintf (stderr, "rk_ac_2: a21=%Lg c21=%Lg\n", a21 (ac), c21 (ac));
  fprintf (stderr, "rk_ac_2: end\n");
#endif
  if (isnan (c20 (ac)) || isnan (a21 (ac)))
    return 0;
  return 1;
}

/**
 * Function to get \f$a_{ij}\f$ and \f$c_{ij}\f$ coefficients of the Runge-Kutta
 * 3rd step.
 */
static int
rk_ac_3 (RK * rk)               ///< RK struct.
{
  long double *tb, *ac, *r;
  register long double ac0;
#if DEBUG_RK
  fprintf (stderr, "rk_ac_3: start\n");
#endif
  if (!rk_ac_2 (rk))
    {
#if DEBUG_RK
      fprintf (stderr, "rk_ac_3: end\n");
#endif
      return 0;
    }
  tb = rk->tb->coefficient;
  ac = rk->ac->coefficient;
  r = rk->ac->random_data;
  c31 (ac) = r[1];
  c32 (ac) = r[2];
  a32 (ac) = b32 (tb) / c32 (ac);
  ac0 = b31 (tb) - a32 (ac) * b21 (tb);
  a31 (ac) = fabsl (ac0) < LDBL_EPSILON ? 0.L : ac0 / c31 (ac);
  a30 (ac) = 1.L - a31 (ac) - a32 (ac);
  ac0 = b30 (tb) - a31 (ac) * t1 (tb) - a32 (ac) * b20 (tb);
  c30 (ac) = fabsl (ac0) < LDBL_EPSILON ? 0.L : ac0 / a30 (ac);
#if DEBUG_RK
  fprintf (stderr, "rk_ac_3: a30=%Lg c30=%Lg\n", a30 (ac), c30 (ac));
  fprintf (stderr, "rk_ac_3: a31=%Lg c31=%Lg\n", a31 (ac), c31 (ac));
  fprintf (stderr, "rk_ac_3: a32=%Lg c32=%Lg\n", a32 (ac), c32 (ac));
  fprintf (stderr, "rk_ac_3: end\n");
#endif
  if (isnan (c30 (ac)) || isnan (a31 (ac)) || isnan (a32 (ac)))
    return 0;
  return 1;
}

/**
 * Function to get \f$a_{ij}\f$ and \f$c_{ij}\f$ coefficients of the Runge-Kutta
 * 4th step.
 */
static int
rk_ac_4 (RK * rk)               ///< RK struct.
{
  long double *tb, *ac, *r;
  register long double ac0;
#if DEBUG_RK
  fprintf (stderr, "rk_ac_4: start\n");
#endif
  if (!rk_ac_3 (rk))
    {
#if DEBUG_RK
      fprintf (stderr, "rk_ac_4: end\n");
#endif
      return 0;
    }
  tb = rk->tb->coefficient;
  ac = rk->ac->coefficient;
  r = rk->ac->random_data;
  c41 (ac) = r[3];
  c42 (ac) = r[4];
  c43 (ac) = r[5];
  a43 (ac) = b43 (tb) / c43 (ac);
  ac0 = b42 (tb) - a43 (ac) * b32 (tb);
  a42 (ac) = fabsl (ac0) < LDBL_EPSILON ? 0.L : ac0 / c42 (ac);
  ac0 = b41 (tb) - a42 (ac) * b21 (tb) - a43 (ac) * b31 (tb);
  a41 (ac) = fabsl (ac0) < LDBL_EPSILON ? 0.L : ac0 / c41 (ac);
  a40 (ac) = 1.L - a41 (ac) - a42 (ac) - a43 (ac);
  ac0 = b40 (tb) - a41 (ac) * t1 (tb) - a42 (ac) * b20 (tb)
    - a43 (ac) * b30 (tb);
  c40 (ac) = fabsl (ac0) < LDBL_EPSILON ? 0.L : ac0 / a40 (ac);
#if DEBUG_RK
  fprintf (stderr, "rk_ac_4: a40=%Lg c40=%Lg\n", a40 (ac), c40 (ac));
  fprintf (stderr, "rk_ac_4: a41=%Lg c41=%Lg\n", a41 (ac), c41 (ac));
  fprintf (stderr, "rk_ac_4: a42=%Lg c42=%Lg\n", a42 (ac), c42 (ac));
  fprintf (stderr, "rk_ac_4: a43=%Lg c43=%Lg\n", a43 (ac), c43 (ac));
  fprintf (stderr, "rk_ac_4: end\n");
#endif
  if (isnan (c40 (ac)) || isnan (a41 (ac)) || isnan (a42 (ac))
      || isnan (a43 (ac)))
    return 0;
  return 1;
}

/**
 * Function to get \f$a_{ij}\f$ and \f$c_{ij}\f$ coefficients of the Runge-Kutta
 * 5th step.
 */
static int
rk_ac_5 (RK * rk)               ///< RK struct.
{
  long double *tb, *ac, *r;
  register long double ac0;
#if DEBUG_RK
  fprintf (stderr, "rk_ac_5: start\n");
#endif
  if (!rk_ac_4 (rk))
    {
#if DEBUG_RK
      fprintf (stderr, "rk_ac_5: end\n");
#endif
      return 0;
    }
  tb = rk->tb->coefficient;
  ac = rk->ac->coefficient;
  r = rk->ac->random_data;
  c51 (ac) = r[6];
  c52 (ac) = r[7];
  c53 (ac) = r[8];
  c54 (ac) = r[9];
  a54 (ac) = b54 (tb) / c54 (ac);
  ac0 = b53 (tb) - a54 (ac) * b43 (tb);
  a53 (ac) = fabsl (ac0) < LDBL_EPSILON ? 0.L : ac0 / c53 (ac);
  ac0 = b52 (tb) - a53 (ac) * b32 (tb) - a54 (ac) * b42 (tb);
  a52 (ac) = fabsl (ac0) < LDBL_EPSILON ? 0.L : ac0 / c52 (ac);
  ac0 = b51 (tb) - a52 (ac) * b21 (tb) - a53 (ac) * b31 (tb)
    - a54 (ac) * b41 (tb);
  a51 (ac) = fabsl (ac0) < LDBL_EPSILON ? 0.L : ac0 / c51 (ac);
  a50 (ac) = 1.L - a51 (ac) - a52 (ac) - a53 (ac) - a54 (ac);
  ac0 = b50 (tb) - a51 (ac) * t1 (tb) - a52 (ac) * b20 (tb)
    - a53 (ac) * b30 (tb) - a54 (ac) * b40 (tb);
  c50 (ac) = fabsl (ac0) < LDBL_EPSILON ? 0.L : ac0 / a50 (ac);
#if DEBUG_RK
  fprintf (stderr, "rk_ac_5: a50=%Lg c50=%Lg\n", a50 (ac), c50 (ac));
  fprintf (stderr, "rk_ac_5: a51=%Lg c51=%Lg\n", a51 (ac), c51 (ac));
  fprintf (stderr, "rk_ac_5: a52=%Lg c52=%Lg\n", a52 (ac), c52 (ac));
  fprintf (stderr, "rk_ac_5: a53=%Lg c53=%Lg\n", a53 (ac), c53 (ac));
  fprintf (stderr, "rk_ac_5: a54=%Lg c54=%Lg\n", a54 (ac), c54 (ac));
  fprintf (stderr, "rk_ac_5: end\n");
#endif
  if (isnan (c50 (ac)) || isnan (a51 (ac)) || isnan (a52 (ac))
      || isnan (a53 (ac)) || isnan (a54 (ac)))
    return 0;
  return 1;
}

/**
 * Function to get \f$a_{ij}\f$ and \f$c_{ij}\f$ coefficients of the Runge-Kutta
 * 6th step.
 */
static int
rk_ac_6 (RK * rk)               ///< RK struct.
{
  long double *tb, *ac, *r;
  register long double ac0;
#if DEBUG_RK
  fprintf (stderr, "rk_ac_6: start\n");
#endif
  if (!rk_ac_5 (rk))
    {
#if DEBUG_RK
      fprintf (stderr, "rk_ac_6: end\n");
#endif
      return 0;
    }
  tb = rk->tb->coefficient;
  ac = rk->ac->coefficient;
  r = rk->ac->random_data;
  c61 (ac) = r[10];
  c62 (ac) = r[11];
  c63 (ac) = r[12];
  c64 (ac) = r[13];
  c65 (ac) = r[14];
  a65 (ac) = b65 (tb) / c65 (ac);
  ac0 = b64 (tb) - a65 (ac) * b54 (tb);
  a64 (ac) = fabsl (ac0) < LDBL_EPSILON ? 0.L : ac0 / c64 (ac);
  ac0 = b63 (tb) - a64 (ac) * b43 (tb) - a65 (ac) * b53 (tb);
  a63 (ac) = fabsl (ac0) < LDBL_EPSILON ? 0.L : ac0 / c63 (ac);
  ac0 = b62 (tb) - a63 (ac) * b32 (tb) - a64 (ac) * b42 (tb)
    - a65 (ac) * b52 (tb);
  a62 (ac) = fabsl (ac0) < LDBL_EPSILON ? 0.L : ac0 / c62 (ac);
  ac0 = b61 (tb) - a62 (ac) * b21 (tb) - a63 (ac) * b31 (tb)
    - a64 (ac) * b41 (tb) - a65 (ac) * b51 (tb);
  a61 (ac) = fabsl (ac0) < LDBL_EPSILON ? 0.L : ac0 / c61 (ac);
  a60 (ac) = 1.L - a61 (ac) - a62 (ac) - a63 (ac) - a64 (ac) - a65 (ac);
  ac0 = b60 (tb) - a61 (ac) * t1 (tb) - a62 (ac) * b20 (tb)
    - a63 (ac) * b30 (tb) - a64 (ac) * b40 (tb) - a65 (ac) * b50 (tb);
  c60 (ac) = fabsl (ac0) < LDBL_EPSILON ? 0.L : ac0 / a60 (ac);
#if DEBUG_RK
  fprintf (stderr, "rk_ac_6: a60=%Lg c60=%Lg\n", a60 (ac), c60 (ac));
  fprintf (stderr, "rk_ac_6: a61=%Lg c61=%Lg\n", a61 (ac), c61 (ac));
  fprintf (stderr, "rk_ac_6: a62=%Lg c62=%Lg\n", a62 (ac), c62 (ac));
  fprintf (stderr, "rk_ac_6: a63=%Lg c63=%Lg\n", a63 (ac), c63 (ac));
  fprintf (stderr, "rk_ac_6: a64=%Lg c64=%Lg\n", a64 (ac), c64 (ac));
  fprintf (stderr, "rk_ac_6: a65=%Lg c65=%Lg\n", a65 (ac), c65 (ac));
  fprintf (stderr, "rk_ac_6: end\n");
#endif
  if (isnan (c60 (ac)) || isnan (a61 (ac)) || isnan (a62 (ac))
      || isnan (a63 (ac)) || isnan (a64 (ac)) || isnan (a65 (ac)))
    return 0;
  return 1;
}

/**
 * Function to get the objective function of 2 steps Runge-Kutta methods.
 *
 * \return objective function value.
 */
static long double
rk_objective_ac_2 (RK * rk)     ///< RK struct.
{
  long double *tb, *ac;
  long double k;
#if DEBUG_RK
  fprintf (stderr, "rk_objective ac_2: start\n");
#endif
  tb = rk->tb->coefficient;
  ac = rk->ac->coefficient;
  k = fminl (0.L, a20 (ac));
  if (a21 (ac) < 0.L)
    k += a21 (ac);
  if (k < 0.L)
    {
      k = 20.L - k;
      goto end;
    }
  k = fminl (0.L, c20 (ac));
  if (c21 (ac) < 0.L)
    k += c21 (ac);
  if (k < 0.L)
    {
      k = 10.L - k;
      goto end;
    }
  k = 1.L / rk_cfl_2 (tb, ac);
end:
#if DEBUG_RK
  fprintf (stderr, "rk_objective ac_2: objective=%Lg\n", k);
  fprintf (stderr, "rk_objective ac_2: end\n");
#endif
  return k;
}

/**
 * Function to get the objective function of 3 steps Runge-Kutta methods.
 *
 * \return objective function value.
 */
static long double
rk_objective_ac_3 (RK * rk)     ///< RK struct.
{
  long double *tb, *ac;
  long double k;
#if DEBUG_RK
  fprintf (stderr, "rk_objective ac_3: start\n");
#endif
  tb = rk->tb->coefficient;
  ac = rk->ac->coefficient;
  k = fminl (0.L, a20 (ac));
  if (a21 (ac) < 0.L)
    k += a21 (ac);
  if (a30 (ac) < 0.L)
    k += a30 (ac);
  if (a31 (ac) < 0.L)
    k += a31 (ac);
  if (a32 (ac) < 0.L)
    k += a32 (ac);
  if (k < 0.L)
    {
      k = 20.L - k;
      goto end;
    }
  k = fminl (0.L, c20 (ac));
  if (c21 (ac) < 0.L)
    k += c21 (ac);
  if (c30 (ac) < 0.L)
    k += c30 (ac);
  if (c31 (ac) < 0.L)
    k += c31 (ac);
  if (c32 (ac) < 0.L)
    k += c32 (ac);
  if (k < 0.L)
    {
      k = 10.L - k;
      goto end;
    }
  k = 1.L / rk_cfl_3 (tb, ac);
end:
#if DEBUG_RK
  fprintf (stderr, "rk_objective ac_3: objective=%Lg\n", k);
  fprintf (stderr, "rk_objective ac_3: end\n");
#endif
  return k;
}

/**
 * Function to get the objective function of 4 steps Runge-Kutta methods.
 *
 * \return objective function value.
 */
static long double
rk_objective_ac_4 (RK * rk)     ///< RK struct.
{
  long double *tb, *ac;
  long double k;
#if DEBUG_RK
  fprintf (stderr, "rk_objective ac_4: start\n");
#endif
  tb = rk->tb->coefficient;
  ac = rk->ac->coefficient;
  k = fminl (0.L, a20 (ac));
  if (a21 (ac) < 0.L)
    k += a21 (ac);
  if (a30 (ac) < 0.L)
    k += a30 (ac);
  if (a31 (ac) < 0.L)
    k += a31 (ac);
  if (a32 (ac) < 0.L)
    k += a32 (ac);
  if (a40 (ac) < 0.L)
    k += a40 (ac);
  if (a41 (ac) < 0.L)
    k += a41 (ac);
  if (a42 (ac) < 0.L)
    k += a42 (ac);
  if (a43 (ac) < 0.L)
    k += a43 (ac);
  if (k < 0.L)
    {
      k = 20.L - k;
      goto end;
    }
  k = fminl (0.L, c20 (ac));
  if (c21 (ac) < 0.L)
    k += c21 (ac);
  if (c30 (ac) < 0.L)
    k += c30 (ac);
  if (c31 (ac) < 0.L)
    k += c31 (ac);
  if (c32 (ac) < 0.L)
    k += c32 (ac);
  if (c40 (ac) < 0.L)
    k += c40 (ac);
  if (c41 (ac) < 0.L)
    k += c41 (ac);
  if (c42 (ac) < 0.L)
    k += c42 (ac);
  if (c43 (ac) < 0.L)
    k += c43 (ac);
  if (k < 0.L)
    {
      k = 10.L - k;
      goto end;
    }
  k = 1.L / rk_cfl_4 (tb, ac);
end:
#if DEBUG_RK
  fprintf (stderr, "rk_objective ac_4: objective=%Lg\n", k);
  fprintf (stderr, "rk_objective ac_4: end\n");
#endif
  return k;
}

/**
 * Function to get the objective function of 5 steps Runge-Kutta methods.
 *
 * \return objective function value.
 */
static long double
rk_objective_ac_5 (RK * rk)     ///< RK struct.
{
  long double *tb, *ac;
  long double k;
#if DEBUG_RK
  fprintf (stderr, "rk_objective ac_5: start\n");
#endif
  tb = rk->tb->coefficient;
  ac = rk->ac->coefficient;
  k = fminl (0.L, a20 (ac));
  if (a21 (ac) < 0.L)
    k += a21 (ac);
  if (a30 (ac) < 0.L)
    k += a30 (ac);
  if (a31 (ac) < 0.L)
    k += a31 (ac);
  if (a32 (ac) < 0.L)
    k += a32 (ac);
  if (a40 (ac) < 0.L)
    k += a40 (ac);
  if (a41 (ac) < 0.L)
    k += a41 (ac);
  if (a42 (ac) < 0.L)
    k += a42 (ac);
  if (a43 (ac) < 0.L)
    k += a43 (ac);
  if (a50 (ac) < 0.L)
    k += a50 (ac);
  if (a51 (ac) < 0.L)
    k += a51 (ac);
  if (a52 (ac) < 0.L)
    k += a52 (ac);
  if (a53 (ac) < 0.L)
    k += a53 (ac);
  if (a54 (ac) < 0.L)
    k += a54 (ac);
  if (k < 0.L)
    {
      k = 20.L - k;
      goto end;
    }
  k = fminl (0.L, c20 (ac));
  if (c21 (ac) < 0.L)
    k += c21 (ac);
  if (c30 (ac) < 0.L)
    k += c30 (ac);
  if (c31 (ac) < 0.L)
    k += c31 (ac);
  if (c32 (ac) < 0.L)
    k += c32 (ac);
  if (c40 (ac) < 0.L)
    k += c40 (ac);
  if (c41 (ac) < 0.L)
    k += c41 (ac);
  if (c42 (ac) < 0.L)
    k += c42 (ac);
  if (c43 (ac) < 0.L)
    k += c43 (ac);
  if (c50 (ac) < 0.L)
    k += c50 (ac);
  if (c51 (ac) < 0.L)
    k += c51 (ac);
  if (c52 (ac) < 0.L)
    k += c52 (ac);
  if (c53 (ac) < 0.L)
    k += c53 (ac);
  if (c54 (ac) < 0.L)
    k += c54 (ac);
  if (k < 0.L)
    {
      k = 10.L - k;
      goto end;
    }
  k = 1.L / rk_cfl_5 (tb, ac);
end:
#if DEBUG_RK
  fprintf (stderr, "rk_objective ac_5: objective=%Lg\n", k);
  fprintf (stderr, "rk_objective ac_5: end\n");
#endif
  return k;
}

/**
 * Function to get the objective function of 6 steps Runge-Kutta methods.
 *
 * \return objective function value.
 */
static long double
rk_objective_ac_6 (RK * rk)     ///< RK struct.
{
  long double *tb, *ac;
  long double k;
#if DEBUG_RK
  fprintf (stderr, "rk_objective ac_6: start\n");
#endif
  tb = rk->tb->coefficient;
  ac = rk->ac->coefficient;
  k = fminl (0.L, a20 (ac));
  if (a21 (ac) < 0.L)
    k += a21 (ac);
  if (a30 (ac) < 0.L)
    k += a30 (ac);
  if (a31 (ac) < 0.L)
    k += a31 (ac);
  if (a32 (ac) < 0.L)
    k += a32 (ac);
  if (a40 (ac) < 0.L)
    k += a40 (ac);
  if (a41 (ac) < 0.L)
    k += a41 (ac);
  if (a42 (ac) < 0.L)
    k += a42 (ac);
  if (a43 (ac) < 0.L)
    k += a43 (ac);
  if (a50 (ac) < 0.L)
    k += a50 (ac);
  if (a51 (ac) < 0.L)
    k += a51 (ac);
  if (a52 (ac) < 0.L)
    k += a52 (ac);
  if (a53 (ac) < 0.L)
    k += a53 (ac);
  if (a54 (ac) < 0.L)
    k += a54 (ac);
  if (a60 (ac) < 0.L)
    k += a60 (ac);
  if (a61 (ac) < 0.L)
    k += a61 (ac);
  if (a62 (ac) < 0.L)
    k += a62 (ac);
  if (a63 (ac) < 0.L)
    k += a63 (ac);
  if (a64 (ac) < 0.L)
    k += a64 (ac);
  if (a65 (ac) < 0.L)
    k += a65 (ac);
  if (k < 0.L)
    {
      k = 20.L - k;
      goto end;
    }
  k = fminl (0.L, c20 (ac));
  if (c21 (ac) < 0.L)
    k += c21 (ac);
  if (c30 (ac) < 0.L)
    k += c30 (ac);
  if (c31 (ac) < 0.L)
    k += c31 (ac);
  if (c32 (ac) < 0.L)
    k += c32 (ac);
  if (c40 (ac) < 0.L)
    k += c40 (ac);
  if (c41 (ac) < 0.L)
    k += c41 (ac);
  if (c42 (ac) < 0.L)
    k += c42 (ac);
  if (c43 (ac) < 0.L)
    k += c43 (ac);
  if (c50 (ac) < 0.L)
    k += c50 (ac);
  if (c51 (ac) < 0.L)
    k += c51 (ac);
  if (c52 (ac) < 0.L)
    k += c52 (ac);
  if (c53 (ac) < 0.L)
    k += c53 (ac);
  if (c54 (ac) < 0.L)
    k += c54 (ac);
  if (c60 (ac) < 0.L)
    k += c60 (ac);
  if (c61 (ac) < 0.L)
    k += c61 (ac);
  if (c62 (ac) < 0.L)
    k += c62 (ac);
  if (c63 (ac) < 0.L)
    k += c63 (ac);
  if (c64 (ac) < 0.L)
    k += c64 (ac);
  if (c65 (ac) < 0.L)
    k += c65 (ac);
  if (k < 0.L)
    {
      k = 10.L - k;
      goto end;
    }
  k = 1.L / rk_cfl_6 (tb, ac);
end:
#if DEBUG_RK
  fprintf (stderr, "rk_objective ac_6: objective=%Lg\n", k);
  fprintf (stderr, "rk_objective ac_6: end\n");
#endif
  return k;
}

/**
 * Function to init required variables on a RK struct data.
 */
static inline void
rk_init (RK * rk,               ///< RK struct.
         gsl_rng * rng,         ///< GSL pseudo-random number generator struct.
         unsigned int thread)   ///< thread number.
{
  optimize_init (rk->tb, rng, thread);
  if (rk->strong)
    optimize_init (rk->ac0, rng, 0);
}

/**
 * Function to free the memory allocated by a RK struct.
 */
static inline void
rk_delete (RK * rk)             ///< RK struct.
{
  if (rk->strong)
    optimize_delete (rk->ac0);
  optimize_delete (rk->tb);
}

/**
 * Function to perform every optimization step for the a-c Runge-Kutta
 * coefficients.
 */
static inline void
rk_step_ac (RK * rk)            ///< RK struct.
{
  Optimize *tb, *ac;
  long double *is, *vo, *vo2;
  long double o, o2, v, f;
  unsigned long long int ii, nsimulations;
  unsigned int i, j, k, n, nfree;

#if DEBUG_RK
  fprintf (stderr, "rk_step_ac: start\n");
#endif

  // save optimal values
#if DEBUG_RK
  fprintf (stderr, "rk_step_ac: save optimal values\n");
#endif
  tb = rk->tb;
  ac = rk->ac;
  nfree = ac->nfree;
  o2 = INFINITY;
  vo = (long double *) alloca (nfree * sizeof (long double));
  vo2 = (long double *) alloca (nfree * sizeof (long double));
  memcpy (vo, ac->value_optimal, nfree * sizeof (long double));

  // optimzation algorithm sampling
#if DEBUG_RK
  fprintf (stderr, "rk_step_ac: optimization algorithm sampling\n");
  fprintf (stderr, "rk_step_ac: nsimulations=%Lu nclimbings=%u nfree=%u\n",
           ac->nsimulations, ac->nclimbings, ac->nfree);
#endif
  nsimulations = ac->nsimulations;
  for (ii = 0L; ii < nsimulations; ++ii)
    {

      // random freedom degrees
#if DEBUG_RK
      fprintf (stderr, "rk_step_ac: random freedom degrees\n");
#endif
      optimize_generate_freedom (ac, ii);

      // method coefficients
#if DEBUG_RK
      fprintf (stderr, "rk_step_ac: method coefficients\n");
#endif
      if (!ac->method ((Optimize *) rk))
        o = INFINITY;
      else
        o = ac->objective ((Optimize *) rk);
#if DEBUG_RK
      fprintf (stderr, "rk_step_ac: objective=%Lg o2=%Lg\n", o, o2);
#endif
      if (o < o2)
        {
          o2 = o;
          memcpy (vo, ac->random_data, nfree * sizeof (long double));
        }
      if (file_variables)
        {
          g_mutex_lock (mutex);
          print_variables (tb->random_data, tb->nfree, file_variables);
          print_variables (ac->random_data, nfree, file_variables);
          fprintf (file_variables, "%.19Le\n", o);
          g_mutex_unlock (mutex);
        }
    }

  // array of intervals to climb around the optimal
#if DEBUG_RK
  fprintf (stderr,
           "rk_step_ac: array of intervals to climb around the optimal\n");
  fprintf (stderr, "rk_step_ac: nclimbings=%u climbing_factor=%Lg\n",
           ac->nclimbings, ac->climbing_factor);
#endif
  is = (long double *) alloca (nfree * sizeof (long double));
  for (j = 0; j < nfree; ++j)
    is[j] = ac->interval0[j] * ac->climbing_factor;
#if DEBUG_RK
  for (j = 0; j < nfree; ++j)
    fprintf (stderr, "rk_step_ac: i=%u is=%Lg\n", j, is[j]);
#endif

  // hill climbing algorithm bucle
#if DEBUG_RK
  fprintf (stderr, "rk_step_ac: hill climbing algorithm bucle\n");
#endif
  memcpy (vo2, vo, nfree * sizeof (long double));
  memcpy (ac->random_data, vo, nfree * sizeof (long double));
  n = ac->nclimbings;
  for (i = 0; i < n; ++i)
    {
#if DEBUG_RK
      for (j = 0; j < nfree; ++j)
        fprintf (stderr, "rk_step_ac: j=%u is=%Lg\n", j, is[j]);
#endif
      for (j = k = 0; j < nfree; ++j)
        {
          v = vo[j];
          ac->random_data[j] = v + is[j];
#if DEBUG_RK
          fprintf (stderr, "rk_step_ac: j=%u random=%Lg\n", j,
                   ac->random_data[j]);
#endif
          if (!ac->method ((Optimize *) rk))
            o = INFINITY;
          else
            o = ac->objective ((Optimize *) rk);
#if DEBUG_RK
          fprintf (stderr, "rk_step_ac: k=%u objective=%Lg o2=%Lg\n", k, o, o2);
#endif
          if (o < o2)
            {
              k = 1;
              o2 = o;
              memcpy (vo2, ac->random_data, nfree * sizeof (long double));
            }
          if (file_variables)
            {
              g_mutex_lock (mutex);
              print_variables (tb->random_data, tb->nfree, file_variables);
              print_variables (ac->random_data, nfree, file_variables);
              fprintf (file_variables, "%.19Le\n", o);
              g_mutex_unlock (mutex);
            }
          ac->random_data[j] = fmaxl (0.L, v - is[j]);
          if (!ac->method ((Optimize *) rk))
            o = INFINITY;
          else
            o = ac->objective ((Optimize *) rk);
#if DEBUG_RK
          fprintf (stderr, "rk_step_ac: k=%u objective=%Lg o2=%Lg\n", k, o, o2);
#endif
          if (o < o2)
            {
              k = 1;
              o2 = o;
              memcpy (vo2, ac->random_data, nfree * sizeof (long double));
            }
          if (file_variables)
            {
              g_mutex_lock (mutex);
              print_variables (tb->random_data, tb->nfree, file_variables);
              print_variables (ac->random_data, nfree, file_variables);
              fprintf (file_variables, "%.19Le\n", o);
              g_mutex_unlock (mutex);
            }
          ac->random_data[j] = v;
        }

      // update optimal values and increase or reduce intervals if converging or
      // not
      if (!k)
        f = 0.5L;
      else
        {
          f = 1.2L;
          memcpy (vo, vo2, nfree * sizeof (long double));
        }
      for (j = 0; j < nfree; ++j)
        is[j] *= f;
    }

  // update optimal values
#if DEBUG_RK
  fprintf (stderr, "rk_step_ac: update optimal values\n");
  fprintf (stderr, "rk_step_ac: optimal=%Lg o2=%Lg\n", *ac->optimal, o2);
#endif
  if (o2 < *ac->optimal)
    {
      *ac->optimal = o2;
      memcpy (ac->value_optimal, vo2, nfree * sizeof (long double));
    }

#if DEBUG_RK
  fprintf (stderr, "rk_step_ac: end\n");
#endif
}

/**
 * Function to do the optimization bucle for the a-c Runge-Kutta coefficients.
 */
void
rk_bucle_ac (RK * rk)           ///< RK struct.
{
  Optimize *tb, *ac, *ac0;
  long double *vo;
  long double optimal;
  unsigned int i, nfree;

#if DEBUG_RK
  fprintf (stderr, "rk_bucle_ac: start\n");
#endif

  tb = rk->tb;
  ac = rk->ac;
  ac0 = rk->ac0;
  nfree = ac0->nfree;
  vo = (long double *) alloca (nfree * sizeof (long double));

  // Init some parameters
#if DEBUG_RK
  fprintf (stderr, "rk_bucle_ac: nfree=%u optimal=%Lg\n", nfree, *tb->optimal);
#endif
  *ac0->optimal = optimal = *tb->optimal;
  for (i = 0; i < nfree; ++i)
    vo[i] = ac0->minimum[i] + 0.5L * ac0->interval[i];
  memcpy (ac, ac0, sizeof (Optimize));
  ac->optimal = &optimal;
  ac->value_optimal = vo;
  optimize_init (ac, ac0->rng, 0);
#if DEBUG_RK
  for (i = 0; i < tb->nfree; ++i)
    fprintf (stderr, "rk_bucle_ac: i=%u random=%Lg\n", i, tb->random_data[i]);
  for (i = 0; i < nfree; ++i)
    fprintf (stderr, "rk_bucle_ac: i=%u minimum=%Lg interval=%Lg type=%u\n",
             i, ac->minimum[i], ac->interval[i], ac->random_type[i]);
#endif

  // Iterate
#if DEBUG_RK
  fprintf (stderr, "rk_bucle_ac: iterate\n");
#endif
  for (i = 0; i < ac->niterations; ++i)
    {

      // Optimization step
      rk_step_ac (rk);

      // Updating coefficient intervals to converge
      optimize_converge (ac);

      // Iterate
#if DEBUG_RK
      fprintf (stderr, "Iteration ac %u\n", i);
#endif
    }

  // Check and save optimal
  if (optimal < *ac0->optimal)
    {
#if DEBUG_RK
      fprintf (stderr, "rk_bucle_ac: optimal=%Lg\n", *ac0->optimal);
#endif
      g_mutex_lock (mutex);
      *ac0->optimal = optimal;
      memcpy (ac0->value_optimal, vo, nfree * sizeof (long double));
      g_mutex_unlock (mutex);
#if DEBUG_RK
      fprintf (stderr, "rk_bucle_ac: optimal=%Lg\n", *ac0->optimal);
      for (i = 0; i < ac0->nfree; ++i)
        fprintf (stderr, "rk_bucle_ac: vo%u=%Lg\n", i, ac0->value_optimal[i]);
#endif
    }

  // Free memory
  optimize_delete (ac);

#if DEBUG_RK
  fprintf (stderr, "rk_bucle_ac: end\n");
#endif
}

/**
 * Function to perform every optimization step for the t-b Runge-Kutta
 * coefficients.
 */
static inline void
rk_step_tb (RK * rk)            ///< RK struct.
{
  Optimize *tb;
  long double *is, *vo;
  long double o, v, f;
  unsigned long long int ii, nrandom;
  unsigned int b, i, j, k, n, nfree;

#if DEBUG_RK
  fprintf (stderr, "rk_step_tb: start\n");
#endif

  // save optimal values
#if DEBUG_RK
  fprintf (stderr, "rk_step_tb: save optimal values\n");
#endif
  tb = rk->tb;
  nfree = tb->nfree;
  vo = (long double *) alloca (nfree * sizeof (long double));
  b = (file_variables && !rk->strong) ? 1 : 0;

  // optimization algorithm sampling
#if DEBUG_RK
  fprintf (stderr, "rk_step_tb: optimization algorithm sampling\n");
  fprintf (stderr, "rk_step_tb: nsimulations=%Lu nclimbings=%u\n",
           tb->nsimulations, tb->nclimbings);
#endif
  ii = tb->nsimulations * (rank * nthreads + tb->thread) / (nnodes * nthreads);
  nrandom = tb->nsimulations * (rank * nthreads + tb->thread + 1)
    / (nnodes * nthreads);
  for (; ii < nrandom; ++ii)
    {

      // random freedom degrees
#if DEBUG_RK
      fprintf (stderr, "rk_step_tb: random freedom degrees\n");
#endif
      optimize_generate_freedom (tb, ii);

      // method coefficients
#if DEBUG_RK
      fprintf (stderr, "rk_step_tb: method coefficients\n");
#endif
      if (!tb->method (tb))
        o = INFINITY;
      else
        o = tb->objective (tb);
      if (o < *tb->optimal)
        {
          g_mutex_lock (mutex);
          *tb->optimal = o;
          memcpy (tb->value_optimal, tb->random_data,
                  nfree * sizeof (long double));
          g_mutex_unlock (mutex);
        }
      if (b)
        {
          g_mutex_lock (mutex);
          print_variables (tb->random_data, nfree, file_variables);
          fprintf (file_variables, "%.19Le\n", o);
          g_mutex_unlock (mutex);
        }
    }

  // array of intervals to climb around the optimal
#if DEBUG_RK
  fprintf (stderr,
           "rk_step_tb: array of intervals to climb around the optimal\n");
#endif
  is = (long double *) alloca (nfree * sizeof (long double));
  for (j = 0; j < nfree; ++j)
    is[j] = tb->interval0[j] * tb->climbing_factor;

  // hill climbing algorithm bucle
#if DEBUG_RK
  fprintf (stderr, "rk_step_tb: hill climbing algorithm bucle\n");
#endif
  memcpy (tb->random_data, tb->value_optimal, nfree * sizeof (long double));
  memcpy (vo, tb->value_optimal, nfree * sizeof (long double));
  n = tb->nclimbings;
  for (i = 0; i < n; ++i)
    {
      for (j = k = 0; j < nfree; ++j)
        {
          v = vo[j];
          tb->random_data[j] = v + is[j];
          if (!tb->method (tb))
            o = INFINITY;
          else
            o = tb->objective (tb);
          if (o < *tb->optimal)
            {
              k = 1;
              g_mutex_lock (mutex);
              *tb->optimal = o;
              memcpy (tb->value_optimal, tb->random_data,
                      nfree * sizeof (long double));
              g_mutex_unlock (mutex);
            }
          if (b)
            {
              g_mutex_lock (mutex);
              print_variables (tb->random_data, nfree, file_variables);
              fprintf (file_variables, "%.19Le\n", o);
              g_mutex_unlock (mutex);
            }
          tb->random_data[j] = fmaxl (0.L, v - is[j]);
          if (!tb->method (tb))
            o = INFINITY;
          else
            o = tb->objective (tb);
          if (o < *tb->optimal)
            {
              k = 1;
              g_mutex_lock (mutex);
              *tb->optimal = o;
              memcpy (tb->value_optimal, tb->random_data,
                      nfree * sizeof (long double));
              g_mutex_unlock (mutex);
            }
          if (b)
            {
              g_mutex_lock (mutex);
              print_variables (tb->random_data, nfree, file_variables);
              fprintf (file_variables, "%.19Le\n", o);
              g_mutex_unlock (mutex);
            }
          tb->random_data[j] = v;
        }

      // increase or reduce intervals if converging or not
      if (!k)
        f = 0.5L;
      else
        {
          f = 1.2L;
          memcpy (vo, tb->value_optimal, nfree * sizeof (long double));
        }
      for (j = 0; j < nfree; ++j)
        is[j] *= f;
    }
#if DEBUG_RK
  fprintf (stderr, "rk_step_tb: end\n");
#endif
}

/**
 * Function to do the optimization bucle.
 */
static inline void
rk_bucle_tb (RK * rk)           ///< RK struct.
{
  GThread *thread[nthreads];
  Optimize *tb, *ac;
#if HAVE_MPI
  long double *vo;
  MPI_Status status;
#endif
  unsigned int i, j, nfree, nfree2, strong;

#if DEBUG_RK
  fprintf (stderr, "rk_bucle_tb: start\n");
#endif

  // Allocate local array of optimal values
#if DEBUG_RK
  fprintf (stderr, "rk_bucle_tb: allocate local array of optimal values\n");
#endif
  tb = rk->tb;
  nfree = tb->nfree;
  strong = rk->strong;
  if (strong)
    {
      ac = rk->ac0;
      nfree2 = ac->nfree;
    }
  else
    nfree2 = 0;
#if HAVE_MPI
  vo = (long double *) alloca ((1 + nfree + nfree2) * sizeof (long double));
#endif

  // Init some parameters
#if DEBUG_RK
  fprintf (stderr, "rk_bucle_tb: init some parameters\n");
  fprintf (stderr, "rk_bucle_tb: nfree=%u\n", nfree);
#endif
  *tb->optimal = INFINITY;
  for (i = 0; i < nfree; ++i)
    tb->value_optimal[i] = tb->minimum[i] + 0.5L * tb->interval[i];
  if (strong)
    for (i = 0; i < nfree2; ++i)
      ac->value_optimal[i] = ac->minimum[i] + 0.5L * ac->interval[i];

  // Iterate
#if DEBUG_RK
  fprintf (stderr, "rk_bucle_tb: iterate\n");
#endif
  for (i = 0; i < tb->niterations; ++i)
    {

      // Optimization step parallelized for every node by GThreads
      if (nthreads > 1)
        {
          for (j = 0; j < nthreads; ++j)
            thread[j]
              = g_thread_new (NULL,
                              (GThreadFunc) (void (*)(void)) rk_step_tb,
                              (void *) (rk + j));
          for (j = 0; j < nthreads; ++j)
            g_thread_join (thread[j]);
        }
      else
        rk_step_tb (rk);

#if HAVE_MPI
      if (rank > 0)
        {

          // Secondary nodes send the optimal coefficients to the master node
          vo[0] = *tb->optimal;
          memcpy (vo + 1, tb->value_optimal, nfree * sizeof (long double));
          if (strong)
            memcpy (vo + 1 + nfree, ac->value_optimal,
                    nfree2 * sizeof (long double));
          MPI_Send (vo, 1 + nfree + nfree2, MPI_LONG_DOUBLE, 0, 1,
                    MPI_COMM_WORLD);

          // Secondary nodes receive the optimal coefficients
          MPI_Recv (vo, 1 + nfree + nfree2, MPI_LONG_DOUBLE, 0, 1,
                    MPI_COMM_WORLD, &status);
          *tb->optimal = *ac->optimal = vo[0];
          memcpy (tb->value_optimal, vo + 1, nfree * sizeof (long double));
          if (strong)
            memcpy (ac->value_optimal, vo + 1 + nfree,
                    nfree2 * sizeof (long double));
        }
      else
        {
          printf ("rank=%d optimal=%.19Le\n", rank, *tb->optimal);

          for (j = 1; j < nnodes; ++j)
            {

              // Master node receives the optimal coefficients obtained by
              // secondary nodes
              MPI_Recv (vo, 1 + nfree + nfree2, MPI_LONG_DOUBLE, j, 1,
                        MPI_COMM_WORLD, &status);

              // Master node selects the optimal coefficients
              if (vo[0] < *tb->optimal)
                {
                  *tb->optimal = *ac->optimal = vo[0];
                  memcpy (tb->value_optimal, vo + 1,
                          nfree * sizeof (long double));
                  if (strong)
                    memcpy (ac->value_optimal, vo + 1 + nfree,
                            nfree2 * sizeof (long double));
                }
            }

          // Master node sends the optimal coefficients to secondary nodes
          vo[0] = *tb->optimal;
          memcpy (vo + 1, tb->value_optimal, nfree * sizeof (long double));
          if (strong)
            memcpy (vo + 1 + nfree, ac->value_optimal,
                    nfree2 * sizeof (long double));
          for (j = 1; j < nnodes; ++i)
            MPI_Send (vo, 1 + nfree + nfree2, MPI_LONG_DOUBLE, j, 1,
                      MPI_COMM_WORLD);
        }

#endif

      // Print the optimal coefficients
#if DEBUG_RK
      optimize_print_random (tb, stderr);
      if (strong)
        optimize_print_random (ac, stderr);
      fprintf (stderr, "optimal=%.19Le\n", *tb->optimal);
#endif

      // Updating coefficient intervals to converge
      optimize_converge (tb);

      // Iterate
      printf ("Iteration %u Optimal %.19Le\n", i, *tb->optimal);
    }

#if DEBUG_RK
  fprintf (stderr, "rk_bucle_tb: end\n");
#endif
}

/**
 * Function to select the Runge-Kutta method.
 *
 * \return 1 on success, 0 on error.
 */
static inline int
rk_select (RK * rk,             ///< RK struct.
           unsigned int nsteps, ///< steps number.
           unsigned int order)  ///< accuracy order.
{
  static int (*tb_method[7][6]) (Optimize *) =
  {
    {
    NULL, NULL, NULL, NULL, NULL, NULL},
    {
    NULL, NULL, NULL, NULL, NULL, NULL},
    {
    NULL, NULL, &rk_tb_2_2, NULL, NULL, NULL},
    {
    NULL, NULL, &rk_tb_3_2, &rk_tb_3_3, NULL, NULL},
    {
    NULL, NULL, &rk_tb_4_2, &rk_tb_4_3, &rk_tb_4_4, NULL},
    {
    NULL, NULL, &rk_tb_5_2, &rk_tb_5_3, &rk_tb_5_4, NULL},
    {
    NULL, NULL, &rk_tb_6_2, &rk_tb_6_3, &rk_tb_6_4, NULL}
  };
  static int (*tb_method_t[7][6]) (Optimize *) =
  {
    {
    NULL, NULL, NULL, NULL, NULL, NULL},
    {
    NULL, NULL, NULL, NULL, NULL, NULL},
    {
    NULL, NULL, &rk_tb_2_2t, NULL, NULL, NULL},
    {
    NULL, NULL, &rk_tb_3_2t, &rk_tb_3_3t, NULL, NULL},
    {
    NULL, NULL, &rk_tb_4_2t, &rk_tb_4_3t, &rk_tb_4_4t, NULL},
    {
    NULL, NULL, &rk_tb_5_2t, &rk_tb_5_3t, &rk_tb_5_4t, NULL},
    {
    NULL, NULL, &rk_tb_6_2t, &rk_tb_6_3t, &rk_tb_6_4t, NULL}
  };
  static int (*tb_method_p[7][6]) (Optimize *) =
  {
    {
    NULL, NULL, NULL, NULL, NULL, NULL},
    {
    NULL, NULL, NULL, NULL, NULL, NULL},
    {
    NULL, NULL, &rk_tb_2_2p, NULL, NULL, NULL},
    {
    NULL, NULL, &rk_tb_3_2p, &rk_tb_3_3p, NULL, NULL},
    {
    NULL, NULL, &rk_tb_4_2p, &rk_tb_4_3p, NULL, NULL},
    {
    NULL, NULL, &rk_tb_5_2p, &rk_tb_5_3p, &rk_tb_5_4p, NULL},
    {
    NULL, NULL, &rk_tb_6_2p, &rk_tb_6_3p, &rk_tb_6_4p, NULL}
  };
  static int (*tb_method_tp[7][6]) (Optimize *) =
  {
    {
    NULL, NULL, NULL, NULL, NULL, NULL},
    {
    NULL, NULL, NULL, NULL, NULL, NULL},
    {
    NULL, NULL, &rk_tb_2_2tp, NULL, NULL, NULL},
    {
    NULL, NULL, &rk_tb_3_2tp, &rk_tb_3_3tp, NULL, NULL},
    {
    NULL, NULL, &rk_tb_4_2tp, &rk_tb_4_3tp, NULL, NULL},
    {
    NULL, NULL, &rk_tb_5_2tp, &rk_tb_5_3tp, &rk_tb_5_4tp, NULL},
    {
    NULL, NULL, &rk_tb_6_2tp, &rk_tb_6_3tp, &rk_tb_6_4tp, NULL}
  };
  static long double (*tb_objective[7][6]) (RK *) =
  {
    {
    NULL, NULL, NULL, NULL, NULL, NULL},
    {
    NULL, NULL, &rk_objective_tb_2_2, NULL, NULL, NULL},
    {
    NULL, NULL, &rk_objective_tb_2_2, NULL, NULL, NULL},
    {
    NULL, NULL, &rk_objective_tb_3_2, &rk_objective_tb_3_3, NULL, NULL},
    {
    NULL, NULL, &rk_objective_tb_4_2, &rk_objective_tb_4_3,
        &rk_objective_tb_4_4, NULL},
    {
    NULL, NULL, &rk_objective_tb_5_2, &rk_objective_tb_5_3,
        &rk_objective_tb_5_4, NULL},
    {
    NULL, NULL, &rk_objective_tb_6_2, &rk_objective_tb_6_3,
        &rk_objective_tb_6_4, NULL}
  };
  static long double (*tb_objective_t[7][6]) (RK *) =
  {
    {
    NULL, NULL, NULL, NULL, NULL, NULL},
    {
    NULL, NULL, &rk_objective_tb_2_2t, NULL, NULL, NULL},
    {
    NULL, NULL, &rk_objective_tb_2_2t, NULL, NULL, NULL},
    {
    NULL, NULL, &rk_objective_tb_3_2t, &rk_objective_tb_3_3t, NULL, NULL},
    {
    NULL, NULL, &rk_objective_tb_4_2t, &rk_objective_tb_4_3t,
        &rk_objective_tb_4_4t, NULL},
    {
    NULL, NULL, &rk_objective_tb_5_2t, &rk_objective_tb_5_3t,
        &rk_objective_tb_5_4t, NULL},
    {
    NULL, NULL, &rk_objective_tb_6_2t, &rk_objective_tb_6_3t,
        &rk_objective_tb_6_4t, NULL}
  };
  static long double (*tb_objective_p[7][6]) (RK *) =
  {
    {
    NULL, NULL, NULL, NULL, NULL, NULL},
    {
    NULL, NULL, NULL, NULL, NULL, NULL},
    {
    NULL, NULL, &rk_objective_tb_2_2, NULL, NULL, NULL},
    {
    NULL, NULL, &rk_objective_tb_3_2, &rk_objective_tb_3_3p, NULL, NULL},
    {
    NULL, NULL, &rk_objective_tb_4_2, &rk_objective_tb_4_3p, NULL, NULL},
    {
    NULL, NULL, &rk_objective_tb_5_2, &rk_objective_tb_5_3p,
        &rk_objective_tb_5_4p, NULL},
    {
    NULL, NULL, &rk_objective_tb_6_2, &rk_objective_tb_6_3p,
        &rk_objective_tb_6_4p, NULL}
  };
  static long double (*tb_objective_tp[7][6]) (RK *) =
  {
    {
    NULL, NULL, NULL, NULL, NULL, NULL},
    {
    NULL, NULL, NULL, NULL, NULL, NULL},
    {
    NULL, NULL, &rk_objective_tb_2_2t, NULL, NULL, NULL},
    {
    NULL, NULL, &rk_objective_tb_3_2t, &rk_objective_tb_3_3tp, NULL, NULL},
    {
    NULL, NULL, &rk_objective_tb_4_2t, &rk_objective_tb_4_3tp, NULL, NULL},
    {
    NULL, NULL, &rk_objective_tb_5_2t, &rk_objective_tb_5_3tp,
        &rk_objective_tb_5_4tp, NULL},
    {
    NULL, NULL, &rk_objective_tb_6_2t, &rk_objective_tb_6_3tp,
        &rk_objective_tb_6_4tp, NULL}
  };
  static int (*ac_method[7]) (RK *) =
  {
  NULL, NULL, &rk_ac_2, &rk_ac_3, &rk_ac_4, &rk_ac_5, &rk_ac_6};
  static long double (*ac_objective[7]) (RK * rk) =
  {
  NULL, NULL, &rk_objective_ac_2, &rk_objective_ac_3, &rk_objective_ac_4,
      &rk_objective_ac_5, &rk_objective_ac_6};
  const unsigned int nequations[6] = { 0, 1, 2, 4, 8, 16 };
  Optimize *tb, *ac;
#if DEBUG_RK
  fprintf (stderr, "rk_select: start\n");
#endif
  tb = rk->tb;
  ac = rk->ac;
  tb->nsteps = nsteps;
  tb->order = order;
  tb->size = nsteps * (nsteps + 3) / 2 - 1;
  tb->nfree = tb->size - nsteps + 1 - nequations[order];
  if (rk->pair)
    {
      tb->size += nsteps - 1;
      if (rk->time_accuracy)
        {
          tb->method = tb_method_tp[nsteps][order];
          tb->objective = (OptimizeObjective) tb_objective_tp[nsteps][order];
        }
      else
        {
          tb->method = tb_method_p[nsteps][order];
          tb->objective = (OptimizeObjective) tb_objective_p[nsteps][order];
        }
    }
  else
    {
      if (rk->time_accuracy)
        {
          tb->method = tb_method_t[nsteps][order];
          tb->objective = (OptimizeObjective) tb_objective_t[nsteps][order];
        }
      else
        {
          tb->method = tb_method[nsteps][order];
          tb->objective = (OptimizeObjective) tb_objective[nsteps][order];
        }
    }
  if (!tb->method)
    goto exit_on_error;
  if (rk->time_accuracy)
    {
      --tb->nfree;
      if (rk->pair)
        switch (nsteps)
          {
          case 5:
            switch (order)
              {
              case 4:
                --tb->nfree;
              }
            break;
          case 6:
            switch (order)
              {
              case 4:
                --tb->nfree;
              }
            break;
          }
    }
  tb->minimum0
    = (long double *) g_slice_alloc (tb->nfree * sizeof (long double));
  tb->interval0
    = (long double *) g_slice_alloc (tb->nfree * sizeof (long double));
  tb->random_type
    = (unsigned int *) g_slice_alloc (tb->nfree * sizeof (unsigned int));
  if (rk->strong)
    {
      ac = rk->ac0;
      ac->size = nsteps * (nsteps + 1) - 2;
      ac->nfree = nsteps * (nsteps - 1) / 2;
      ac->minimum0
        = (long double *) g_slice_alloc (ac->nfree * sizeof (long double));
      ac->interval0
        = (long double *) g_slice_alloc (ac->nfree * sizeof (long double));
      ac->random_type
        = (unsigned int *) g_slice_alloc (ac->nfree * sizeof (unsigned int));
      ac->method = (OptimizeMethod) ac_method[nsteps];
      if (!ac->method)
        goto exit_on_error;
      ac->objective = (OptimizeObjective) ac_objective[nsteps];
    }

#if DEBUG_RK
  fprintf (stderr, "rk_select: end\n");
#endif
  return 1;

exit_on_error:
  error_message = g_strdup (_("Unknown method"));
#if DEBUG_RK
  fprintf (stderr, "rk_select: end\n");
#endif
  return 0;
}

/**
 * Function to read the Runge-Kutta method data on a XML node.
 *
 * \return 1 on success, 0 on error.
 */
int
rk_run (xmlNode * node,         ///< XML node.
        gsl_rng ** rng)         ///< array of gsl_rng structs.
{
  RK rk[nthreads];
  char filename[64];
  Optimize *tb, *ac;
  gchar *buffer;
  xmlChar *prop;
  FILE *file;
  long double *value_optimal, *value_optimal2;
  long double optimal, optimal2;
  int code;
  unsigned int i, j, nsteps, order, nfree, nfree2;

#if DEBUG_RK
  fprintf (stderr, "rk_run: start\n");
#endif

  tb = rk->tb;
  nsteps = xml_node_get_uint (node, XML_STEPS, &code);
  if (code)
    {
      error_message = g_strdup (_("Bad steps number"));
      goto exit_on_error;
    }
  order = xml_node_get_uint (node, XML_ORDER, &code);
  if (code)
    {
      error_message = g_strdup (_("Bad order"));
      goto exit_on_error;
    }
  prop = xmlGetProp (node, XML_STRONG);
  if (!prop || !xmlStrcmp (prop, XML_NO))
    rk->strong = 0;
  else if (!xmlStrcmp (prop, XML_YES))
    rk->strong = 1;
  else
    {
      error_message = g_strdup (_("Bad strong stability"));
      goto exit_on_error;
    }
  xmlFree (prop);
  prop = xmlGetProp (node, XML_PAIR);
  if (!prop || !xmlStrcmp (prop, XML_NO))
    rk->pair = 0;
  else if (!xmlStrcmp (prop, XML_YES))
    rk->pair = 1;
  else
    {
      error_message = g_strdup (_("Bad pair"));
      goto exit_on_error;
    }
  xmlFree (prop);
  prop = xmlGetProp (node, XML_TIME_ACCURACY);
  if (!prop || !xmlStrcmp (prop, XML_NO))
    rk->time_accuracy = 0;
  else if (!xmlStrcmp (prop, XML_YES))
    rk->time_accuracy = 1;
  else
    {
      error_message = g_strdup (_("Bad time accuracy"));
      goto exit_on_error;
    }
  xmlFree (prop);
  if (!rk_select (rk, nsteps, order))
    goto exit_on_error;
  if (!optimize_read (tb, node))
    goto exit_on_error;
  nfree = tb->nfree;
  value_optimal = (long double *) g_slice_alloc (nfree * sizeof (long double));
  optimize_create (tb, &optimal, value_optimal);
  node = node->children;
  for (i = 0; i < nfree; ++i, node = node->next)
    if (!read_variable (node, tb->minimum0, tb->interval0, tb->random_type, i))
      goto exit_on_error;
  if (rk->strong)
    {
      ac = rk->ac0;
      if (!node)
        {
          error_message = g_strdup (_("No a-c coefficients data"));
          goto exit_on_error;
        }
      if (xmlStrcmp (node->name, XML_AC))
        {
          error_message = g_strdup (_("Bad a-c coefficients XML node"));
          goto exit_on_error;
        }
      if (!optimize_read (ac, node))
        {
          buffer = error_message;
          error_message
            = g_strconcat (_("a-c coefficients"), ":\n", error_message, NULL);
          g_free (buffer);
          goto exit_on_error;
        }
      nfree2 = ac->nfree;
      value_optimal2
        = (long double *) g_slice_alloc (nfree2 * sizeof (long double));
      optimize_create (ac, &optimal2, value_optimal2);
      for (i = 0; i < nfree2; ++i)
        {
          node = node->next;
          if (!read_variable (node, ac->minimum0, ac->interval0,
                              ac->random_type, i))
            goto exit_on_error;
        }
    }
  for (i = 1; i < nthreads; ++i)
    memcpy (rk + i, rk, sizeof (RK));
  j = rank * nthreads;
  for (i = 0; i < nthreads; ++i)
    rk_init (rk + i, rng[j + i], i);

  // Method bucle
  printf ("Optimize bucle\n");
  rk_bucle_tb (rk);

  // Print the optimal coefficients
  printf ("Print the optimal coefficients\n");
  memcpy (tb->random_data, tb->value_optimal, nfree * sizeof (long double));
  code = tb->method (tb);
  if (rk->strong)
    {
      memcpy (ac->random_data, ac->value_optimal,
              nfree2 * sizeof (long double));
      memcpy (rk->ac, ac, sizeof (Optimize));
      code = ac->method ((Optimize *) rk);
    }
  snprintf (filename, 64, "rk-%u-%u-%u-%u-%u.mc",
            nsteps, order, rk->time_accuracy, rk->pair, rk->strong);
  file = fopen (filename, "w");
  print_maxima_precision (file);
  rk_print (rk, file);
  rk_print_maxima (file, nsteps, nsteps, order, 'b');
  if (rk->pair)
    rk_print_maxima (file, nsteps, nsteps - 1, order - 1, 'e');
  if (rk->strong)
    ac_print_maxima (file, nsteps);
  fclose (file);
  snprintf (filename, 64, "sed -i 's/e+/b+/g' rk-%u-%u-%u-%u-%u.mc",
            nsteps, order, rk->time_accuracy, rk->pair, rk->strong);
  code = system (filename);
  snprintf (filename, 64, "sed -i 's/e-/b-/g' rk-%u-%u-%u-%u-%u.mc",
            nsteps, order, rk->time_accuracy, rk->pair, rk->strong);
  code = system (filename);

  // Free memory
  if (rk->strong)
    {
      g_slice_free1 (nfree2 * sizeof (unsigned int), ac->random_type);
      g_slice_free1 (nfree2 * sizeof (long double), ac->interval0);
      g_slice_free1 (nfree2 * sizeof (long double), ac->minimum0);
      g_slice_free1 (nfree2 * sizeof (long double), value_optimal2);
    }
  for (i = 0; i < nthreads; ++i)
    rk_delete (rk + i);
  g_slice_free1 (nfree * sizeof (unsigned int), tb->random_type);
  g_slice_free1 (nfree * sizeof (long double), tb->interval0);
  g_slice_free1 (nfree * sizeof (long double), tb->minimum0);
  g_slice_free1 (nfree * sizeof (long double), value_optimal);

#if DEBUG_RK
  fprintf (stderr, "rk_run: end\n");
#endif
  return 1;

exit_on_error:
  buffer = error_message;
  error_message = g_strconcat ("Runge-Kutta:\n", buffer, NULL);
  g_free (buffer);
#if DEBUG_RK
  fprintf (stderr, "rk_run: end\n");
#endif
  return 0;
}


#include <stdio.h>
#include <stdlib.h>
#include <errno.h>
#include <mpi.h>
#include <cblas.h>
#include "utils.h"

#ifndef MATRIX_SIZE
#define MATRIX_SIZE 128
#pragma message "Using default matrix size"
#endif
#define MIN_BUFF_SIZE MATRIX_SIZE*MATRIX_SIZE*sizeof(double)
#ifndef REUSE_BUFFER
#define REUSE_BUFFER 1
#endif
#if REUSE_BUFFER
#pragma message "Using the same buffers for communications and computations"
#else
#pragma message "Using different buffers for communications and computations"
#endif
#define MAX_NAME_SIZE 100
#define NB_RUNS 10

static void *my_send_buffer;
static void *my_recv_buffer;
static void *aux_buffer;
static double *matrix_A, *matrix_B, *matrix_C;
static int op_id = 0;

FILE *open_file(const char *dir_name, const char *file_prefix){
    char* filename= malloc(MAX_NAME_SIZE*sizeof(char));
    int my_rank;
    MPI_Comm_rank(MPI_COMM_WORLD, &my_rank);
    sprintf(filename, "%s/%s_%d.csv", dir_name, file_prefix, my_rank);
    FILE *file = fopen(filename, "w");
    if(!file) {
        perror("open_file");
        fprintf(stderr, "Maybe directory %s does not exist?\n", dir_name);
        exit(errno);
    }
    free(filename);
    MPI_Barrier(MPI_COMM_WORLD);
    return file;
}

void send_msg(int size, int dst, FILE *file, int args[], int nb_args, unsigned long long base_time) {
    unsigned long long start_time=get_time();
    MPI_Send(my_send_buffer, size, MPI_CHAR, dst, 0, MPI_COMM_WORLD);
    unsigned long long total_time=get_time()-start_time;
    print_in_file(file, "MPI_Send", args, nb_args, start_time-base_time, total_time);
}

void recv_msg(int size, int src, FILE *file, int args[], int nb_args, unsigned long long base_time, int busy_waiting) {
    int flag = 0;
    // Meanwhile we are waiting for a message to be there, we call dgemm
    while(busy_waiting & !flag) {
        cblas_dgemm(CblasColMajor, CblasNoTrans, CblasTrans, MATRIX_SIZE, MATRIX_SIZE, MATRIX_SIZE, 1., matrix_A,
                MATRIX_SIZE, matrix_B, MATRIX_SIZE, 1., matrix_C, MATRIX_SIZE);
        MPI_Iprobe(src, 0, MPI_COMM_WORLD, &flag, MPI_STATUS_IGNORE);
    }
    unsigned long long start_time=get_time();
    MPI_Recv(my_recv_buffer, size, MPI_CHAR, src, 0, MPI_COMM_WORLD, MPI_STATUS_IGNORE);
    unsigned long long total_time=get_time()-start_time;
    print_in_file(file, "MPI_Recv", args, nb_args, start_time-base_time, total_time);
}

void get_ring(FILE *file, int size, int nb_it, unsigned long long base_time) {
    static int my_rank = -1;
    static int nb_ranks = -1;
    if(my_rank < 0) {
        MPI_Comm_rank(MPI_COMM_WORLD, &my_rank);
        MPI_Comm_size(MPI_COMM_WORLD, &nb_ranks);
    }
    for(int i=0; i<nb_it; i++) {
        int args[] = {my_rank, size, op_id++};
        int recv_from = (my_rank-1+nb_ranks)%nb_ranks;
        int send_to = (my_rank+1)%nb_ranks;
// I am the root of the broadcast, I send
        if(my_rank == 0) {
            send_msg(size, send_to, file, args, sizeof(args)/sizeof(args[0]), base_time);
        }
// I receive
        recv_msg(size, recv_from, file, args, sizeof(args)/sizeof(args[0]), base_time, 1);
// I am *not* the root of the broadcast, I send
        if(my_rank != 0) {
            send_msg(size, send_to, file, args, sizeof(args)/sizeof(args[0]), base_time);
        }
    }
}

void get_ringrong(FILE *file, int size, int nb_it, unsigned long long base_time) {
    static int my_rank = -1;
    static int nb_ranks = -1;
    if(my_rank < 0) {
        MPI_Comm_rank(MPI_COMM_WORLD, &my_rank);
        MPI_Comm_size(MPI_COMM_WORLD, &nb_ranks);
    }
    for(int i=0; i<nb_it; i++) {
        int args[] = {my_rank, size, op_id++};
        int prev = (my_rank-1+nb_ranks)%nb_ranks;
        int next = (my_rank+1)%nb_ranks;
        if(my_rank == 0) {
            send_msg(size, next, file, args, sizeof(args)/sizeof(args[0]), base_time);
            recv_msg(size, next, file, args, sizeof(args)/sizeof(args[0]), base_time, 0);
            recv_msg(size, prev, file, args, sizeof(args)/sizeof(args[0]), base_time, 1);
            send_msg(size, prev, file, args, sizeof(args)/sizeof(args[0]), base_time);
        }
        else {
            recv_msg(size, prev, file, args, sizeof(args)/sizeof(args[0]), base_time, 1);
            send_msg(size, prev, file, args, sizeof(args)/sizeof(args[0]), base_time);
            send_msg(size, next, file, args, sizeof(args)/sizeof(args[0]), base_time);
            recv_msg(size, next, file, args, sizeof(args)/sizeof(args[0]), base_time, 0);
        }
    }
}

static const char *names[] = {"Ring", "RingRong", NULL};
static const void (*functions[])(FILE*, int, int, unsigned long long) = {get_ring, get_ringrong};

void test_op(FILE *result_file, experiment_t *exp, int nb_runs, unsigned long long base_time) {
    functions[exp->op_id](result_file, exp->sizes[0], nb_runs, base_time);
}

void *allocate_buffer(int size) {
    if(size < MIN_BUFF_SIZE)
        size = MIN_BUFF_SIZE;
    char *buffer = (void*)malloc(size);
    if(buffer == NULL){
        fprintf(stderr, "Can't allocate memory (%g GB), decrease max size of the messages \n",
            size*1e-9);
        perror("malloc");
        exit(1);
    }
    for(int i = 0; i < size; i++) {
        buffer[i] = rand();
    }
    return(buffer);
}

int main(int argc, char *argv[]) {
    printf("Matrix size: %d\n", MATRIX_SIZE);
    if(argc != 3) {
        fprintf(stderr, "Syntax: %s <input_file> <output_directory>\n");
        exit(1);
    }
    const char *input = argv[1];
    const char *output = argv[2];
    MPI_Init(&argc, &argv);

    int nb_exp, largest_size;
    experiment_t *experiments = parse_experiment_file(names, input, &nb_exp, &largest_size, -1, (int)1e9, 1);
    FILE *result_file = open_file(output, "result");
    my_recv_buffer = allocate_buffer(largest_size);
    my_send_buffer = allocate_buffer(largest_size);
    aux_buffer = allocate_buffer(largest_size);
#if REUSE_BUFFER
    matrix_A = my_recv_buffer;
    matrix_B = my_send_buffer;
    matrix_C = aux_buffer;
#else
    matrix_A = allocate_buffer(MIN_BUFF_SIZE);
    matrix_B = allocate_buffer(MIN_BUFF_SIZE);
    matrix_C = allocate_buffer(MIN_BUFF_SIZE);
#endif

    MPI_Barrier(MPI_COMM_WORLD);
    unsigned long long base_time=get_time();
    for(int j = 0; j < nb_exp; j++) {
        test_op(result_file, &experiments[j], NB_RUNS, base_time);
    }
    MPI_Finalize();

    fflush(result_file);
    fclose(result_file);
    free(experiments);
    free(my_recv_buffer);
    free(my_send_buffer);
    free(aux_buffer);
#if REUSE_BUFFER
#else
    free(matrix_A);
    free(matrix_B);
    free(matrix_C);
#endif
    return 0;
}


/**************************************************************************/
/* Common definitions for the c vader routines                            */
/**************************************************************************/

/**************************************************************************/
/* General note on naming conventions: arrays without subscripts have     */
/* indices that range from 0 to nr-1, with no ghost zones, and are cell-  */
/* centered. Arrays with _h are edge centered and have indices that run   */
/* from 0 to nr. Arrays with _g are cell-centered with one ghost zone,    */
/* and have indices that go from 0 to nr+1; indices 0 and nr are the      */
/* ghost zones.                                                           */
/**************************************************************************/

#ifndef _vader_common_h_
#define _vader_common_h_

#include <gsl/gsl_vector.h>
#include <float.h>
#include <stdbool.h>
#include <time.h>

/* Slope limit parameter */
#define SLOPELIMIT  0.1

/* Descriptor for a grid */
typedef struct {
  unsigned long nr;            /* Number of real cells */
  bool linear;                 /* Is this a linear or logarithmic grid? */
  double *r_g, *r_h;           /* Cell center, edge locations */
  double *dr_g;                /* Cell sizes / log sizes */
  double *area;                /* Area of a zone */
  double *vphi_g, *vphi_h;     /* Rotation curve */
  double *beta_g, *beta_h;     /* Logarithmic index of rotation curve */
  double *psiEff_g, *psiEff_h; /* Effective gravitational potential */
  double *g_h;                 /* Factor appearing in derivatives */
} grid;

/* Workspace for calculations */
typedef struct {
  double *pres_g, *presNew_g, *colNew, *colTmp;
  double *alpha_g, *hint_g, *hintL_g, *hintR_g;
  double *ppmwksp_g;
  double *fmLast_h, *fmNew_h;
  double *ftLast_h, *feLast_h;
  double *massSrcLast, *massSrcNew, *intEnSrc;
  double *eIntTmp, *eIntNew;
  double *gammaLast, *deltaLast, *gammaNew, *deltaNew;
  double *mSrc, *eSrc;
  gsl_vector *ud_g, *ld_g, *diag_g, *rhs_g, *presTmp_g;
#if AA_M > 0
  double *colHist, *presHist, *eIntHist;
  double *colResid, *presResid, *eIntResid;
  gsl_vector *constraint;
#endif
} wksp;

/* Pressure boundary condition types */
typedef enum { FIXED_MASS_FLUX, FIXED_TORQUE_FLUX, FIXED_TORQUE }
  pres_bc_type;

/* Enthalpy boundary condition types */
typedef enum { FIXED_ENTHALPY_VALUE, FIXED_ENTHALPY_GRADIENT }
  enth_bc_type;

/* IO status indicators */
typedef enum { GOOD_IO, IO_ERROR, ALLOCATION_ERROR } iostatus;

/* Startup status indicators */
typedef enum { GOOD_START, RESTART_ERROR, MEMORY_ERROR, FIRST_DT_ERROR }
  setup_status;

/* Simulation status indicators */
typedef enum { RUNNING, NORMAL_EXIT, ZENO_ERROR, TOO_MANY_STEPS }
  status;

/* Macros used various places in code */
#define SQR(x) ((x)*(x))
#define LARGE DBL_MAX
#define SMALL DBL_MIN

#endif
/* end _vader_common_h_ */


/* -*- c++ -*- */
/*
 * Copyright 2015 Free Software Foundation, Inc.
 *
 * This is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published
 * by the Free Software Foundation; either version 3, or (at your
 * option) any later version.
 *
 * This software 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 software; see the file COPYING.  If not, write to
 * the Free Software Foundation, Inc., 51 Franklin Street,
 * Boston, MA 02110-1301, USA.
 */

#ifndef INCLUDED_ldpc_G_matrix_impl_H
#define INCLUDED_ldpc_G_matrix_impl_H

#include <gsl/gsl_randist.h>
#include <gsl/gsl_permutation.h>
#include <gsl/gsl_linalg.h>
#include <gsl/gsl_blas.h>

#include "fec_mtrx_impl.h"
#include <gnuradio/fec/ldpc_G_matrix.h>
#include <gnuradio/fec/ldpc_H_matrix.h>
#include <gnuradio/logger.h>

namespace gr {
  namespace fec {
    namespace code {
      /*!
       * \brief Class for storing H or G matrix
       * \ingroup error_coding_blk
       *
       * \details
       * This class stores a GSL matrix variable, specifically
       * either a:
       *
       * 1) Generator matrix, G, in the standard format G = [I P],
       *    where I is an identity matrix and P is the parity
       *    submatrix.
       *
       * or
       *
       * 2) Parity matrix, H, in the standard format H = [P' I],
       *    where P' is the transpose of the parity submatrix and I
       *    is an identity matrix.
       *
       * This variable can used by the ldpc_gen_mtrx_encoder and
       * ldpc_bit_flip_decoder classes.
       */
      class ldpc_G_matrix_impl
        : public fec_mtrx_impl, public ldpc_G_matrix
      {
      private:
        // GSL matrix structure for transpose of G
        gsl_matrix *d_G_transp_ptr;

        gsl_matrix *d_H_obj;

        //! Get the generator matrix (used during encoding)
        const gsl_matrix *G_transpose() const;

        gr::logger_ptr d_logger;
        gr::logger_ptr d_debug_logger;

      public:
        ldpc_G_matrix_impl(const std::string filename);

        void encode(unsigned char *outbuffer,
                    const unsigned char *inbuffer) const;

        void decode(unsigned char *outbuffer,
                    const float *inbuffer,
                    unsigned int frame_size,
                    unsigned int max_iterations) const;

        unsigned int n() const { return fec_mtrx_impl::n(); }

        unsigned int k() const { return fec_mtrx_impl::k(); }

        gsl_matrix* generate_H();

        gr::fec::code::fec_mtrx_sptr get_base_sptr();

        /*!
         * \brief Destructor
         * \details
         * Calls the gsl_matrix_free function to free memory.
         */
        virtual ~ldpc_G_matrix_impl();
      };

    }
  }
}

#endif /* INCLUDED_ldpc_G_matrix_impl_H */


// This is a plugin program that serves mainly as an example of how
// analysis programs for ssv should be written, and gives people
// something to cut and paste from.  It computes and prints histogram
// information about the tiles it analyzes.

#include <stdlib.h>

#include <glib.h>
#include <gsl/gsl_histogram.h>

#include <float_image.h>

// As specified in the analysis interface provided by ssv, the first
// argument (after argv[0], the invocation name) is the number of
// tiles being passed into the analysis plugin.  The second and
// succeeding arguments are also as as described in the output
// produced by 'ssv --help'.
#define TILE_COUNT_ARGUMENT_POSITION 1

// This type describes the information that we get passed for each
// tile.
typedef struct {
  GString *base_name;
  size_t width, height;
  GString *file_name;
  FloatImage *tile;
} tile_spec_type;

int
main (int argc, char **argv)
{
  char *prog_name = argv[0];
  prog_name = prog_name;   // You might use this for reporting errors.

  // How many image tiles are we getting passed?
  int tile_count = atoi (argv[TILE_COUNT_ARGUMENT_POSITION]);

  // Print a string showing how we were invoked.
  GString *invocation = g_string_new ("");
  int ii;
  for ( ii = 0 ; ii < argc ; ii++ ) {
    g_string_append_printf (invocation, "%s ", argv[ii]);
  }
  g_print ("\nRunning analysis program '%s'...\n", invocation->str);
  g_string_free (invocation, TRUE);

  // Read the argument into an array of tile_spec_type structures.
  GPtrArray *tile_specs = g_ptr_array_new ();
  int current_arg = TILE_COUNT_ARGUMENT_POSITION + 1;
  for ( ii = 0 ; ii < tile_count ; ii++ ) {
    tile_spec_type *cs = g_new (tile_spec_type, 1); // Current spec.
    cs->base_name = g_string_new (argv[current_arg++]);
    cs->width = atoi (argv[current_arg++]);
    cs->height = atoi (argv[current_arg++]);
    cs->file_name = g_string_new (argv[current_arg++]);
    cs->tile = float_image_new_from_file (cs->width, cs->height,
					  cs->file_name->str, 0,
					  FLOAT_IMAGE_BYTE_ORDER_BIG_ENDIAN);
    g_ptr_array_add (tile_specs, cs);
  }

  g_print ("\nGot %d total structures to process.\n", tile_count);

  // Compute and print histograms and other information for each tile.
  for ( ii = 0 ; ii < tile_specs->len ; ii++ ) {
    // Current tile spec.
    tile_spec_type *cs = g_ptr_array_index (tile_specs, ii);
    g_print ("\nTile from image %s\n", cs->base_name->str);
    g_print ("Width: %llu\n", (long long unsigned int) cs->width);
    g_print ("Height: %llu\n", (long long unsigned int) cs->height);
    if ( cs->width == 0 || cs->height == 0 ) {
      g_print ("Tile of zero area, nothing to analyze.\n");
    }
    else {
      g_print ("Histogram:\n");
      const size_t bin_count = 20;
      gsl_histogram *hg = gsl_histogram_alloc (bin_count);
      // The test data I use is from an originally byte-valued image; if
      // you have a different sort of image a histogram covering only
      // this data region may be pretty dull.
      gsl_histogram_set_ranges_uniform (hg, 0.0, 255.0);
      guint jj, kk;
      for ( jj = 0 ; jj < cs->width ; jj++ ) {
	for ( kk = 0 ; kk < cs->height ; kk++ ) {
	  float pv = float_image_get_pixel (cs->tile, jj, kk);
	  gsl_histogram_increment (hg, pv);
	}
      }
      g_print ("  Range Start     Range End    Occurences\n");
      g_print ("-----------------------------------------\n");
      gsl_histogram_fprintf (stdout, hg, "%13.2f", "%13.0f");
      gsl_histogram_free (hg);
    }
    g_print ("\n");
  }

  // Free the tile specifications array.
  for ( ii = 0 ; ii < tile_specs->len ; ii++ ) {
    tile_spec_type *cs = g_ptr_array_index (tile_specs, ii);
    float_image_free (cs->tile);
    g_string_free (cs->file_name, TRUE);
    g_string_free (cs->base_name, TRUE);
    g_free (cs);
  }
  g_ptr_array_free (tile_specs, TRUE);

  exit (EXIT_SUCCESS);
}


/*
 *  Copyright 2014 NVIDIA Corporation
 *
 *  Licensed under the Apache License, Version 2.0 (the "License");
 *  you may not use this file except in compliance with the License.
 *  You may obtain a copy of the License at
 *
 *      http://www.apache.org/licenses/LICENSE-2.0
 *
 *  Unless required by applicable law or agreed to in writing, software
 *  distributed under the License is distributed on an "AS IS" BASIS,
 *  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 *  See the License for the specific language governing permissions and
 *  limitations under the License.
 */

/* include the ATLAS headers */

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

/* choose precision to train and classify.  Only float and double are
 * currently suppored
 */

typedef float floatType_t;

/* macro to convert 2d coords to 1d offset */

#define INDX(row,col,ld) (((col) * (ld)) + (row))

/* macros for max/min to combine with argmin */

#define MYMAX(val,array,i,index) \
if( array[i] > val ) \
{ \
  val = array[i]; \
  index = i; \
} \

#define MYMIN(val,array,i,index) \
if( array[i] < val ) \
{ \
  val = array[i]; \
  index = i; \
} \

/* macro to clip values from min to max */

#define CLIP(val,min,max) \
if( (val) < (min) ) val = (min); \
else if( (val) > (max) ) val = (max);

/* hardcoded constants for training and test set size and feature
 * vector size
 */

#define FEATURE_VECTOR_SIZE (1899)
#define TRAINING_SET_SIZE (4000)
#define TEST_SET_SIZE (1000)

/* CUDA debugging */

#ifdef DEBUG
#define CUDA_CALL(F)  if( (F) != cudaSuccess ) \
  {printf("Error %s at %s:%d\n", cudaGetErrorString(cudaGetLastError()), \
   __FILE__,__LINE__); exit(-1);}
#define CUDA_CHECK()  if( (cudaPeekAtLastError()) != cudaSuccess ) \
  {printf("Error %s at %s:%d\n", cudaGetErrorString(cudaGetLastError()), \
   __FILE__,__LINE__-1); exit(-1);}
#else
#define CUDA_CALL(F) (F)
#define CUDA_CHECK()
#endif

/* function defs */

void readMatrixFromFile( char *, int *, const int, const int );

void calculateBI( floatType_t const *,
                  floatType_t const *,
                  floatType_t const *,
                  int ,
                  floatType_t *, floatType_t *,
                  int *, int *,
                  floatType_t const );

void svmTrain( floatType_t const *, floatType_t const *, floatType_t const,
               const int, const int,
               const floatType_t, floatType_t * );

void svmPredict( floatType_t const *, floatType_t const *,
                 int const, int const, int * );


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

/* Author:  G. Jungman */

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

#include "error.h"

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

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

/* based on SLATEC bk0(), bk0e() */

/* chebyshev expansions

 series for bk0        on the interval  0.	    to  4.00000d+00
					with weighted error   3.57e-19
					 log weighted error  18.45
			       significant figures required  17.99
				    decimal places required  18.97

 series for ak0        on the interval  1.25000d-01 to  5.00000d-01
					with weighted error   5.34e-17
					 log weighted error  16.27
			       significant figures required  14.92
				    decimal places required  16.89

 series for ak02       on the interval  0.	    to  1.25000d-01
					with weighted error   2.34e-17
					 log weighted error  16.63
			       significant figures required  14.67
				    decimal places required  17.20
*/

static double bk0_data[11] = {
  -0.03532739323390276872,
   0.3442898999246284869,
   0.03597993651536150163,
   0.00126461541144692592,
   0.00002286212103119451,
   0.00000025347910790261,
   0.00000000190451637722,
   0.00000000001034969525,
   0.00000000000004259816,
   0.00000000000000013744,
   0.00000000000000000035
};
static cheb_series bk0_cs = {
  bk0_data,
  10,
  -1, 1,
  10
};

static double ak0_data[17] = {
  -0.07643947903327941,
  -0.02235652605699819,
   0.00077341811546938,
  -0.00004281006688886,
   0.00000308170017386,
  -0.00000026393672220,
   0.00000002563713036,
  -0.00000000274270554,
   0.00000000031694296,
  -0.00000000003902353,
   0.00000000000506804,
  -0.00000000000068895,
   0.00000000000009744,
  -0.00000000000001427,
   0.00000000000000215,
  -0.00000000000000033,
   0.00000000000000005
};
static cheb_series ak0_cs = {
  ak0_data,
  16,
  -1, 1,
  10
};

static double ak02_data[14] = {
  -0.01201869826307592,
  -0.00917485269102569,
   0.00014445509317750,
  -0.00000401361417543,
   0.00000015678318108,
  -0.00000000777011043,
   0.00000000046111825,
  -0.00000000003158592,
   0.00000000000243501,
  -0.00000000000020743,
   0.00000000000001925,
  -0.00000000000000192,
   0.00000000000000020,
  -0.00000000000000002
};
static cheb_series ak02_cs = {
  ak02_data,
  13,
  -1, 1,
  8
};

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

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

  if(x <= 0.0) {
    DOMAIN_ERROR(result);
  }
  else if(x <= 2.0) {
    const double lx = log(x);
    const double ex = exp(x);
    int stat_I0;
    gsl_sf_result I0;
    gsl_sf_result c;
    cheb_eval_e(&bk0_cs, 0.5*x*x-1.0, &c);
    stat_I0 = gsl_sf_bessel_I0_e(x, &I0);
    result->val  = ex * ((-lx+M_LN2)*I0.val - 0.25 + c.val);
    result->err  = ex * ((M_LN2+fabs(lx))*I0.err + c.err);
    result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
    return stat_I0;
  }
  else if(x <= 8.0) {
    const double sx = sqrt(x);
    gsl_sf_result c;
    cheb_eval_e(&ak0_cs, (16.0/x-5.0)/3.0, &c);
    result->val  = (1.25 + c.val) / sx;
    result->err  = c.err / sx;
    result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
    return GSL_SUCCESS;
  }
  else {
    const double sx = sqrt(x);
    gsl_sf_result c;
    cheb_eval_e(&ak02_cs, 16.0/x-1.0, &c);
    result->val  = (1.25 + c.val) / sx;
    result->err  = (c.err + GSL_DBL_EPSILON) / sx;
    result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
    return GSL_SUCCESS;
  }
}

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

  if(x <= 0.0) {
    DOMAIN_ERROR(result);
  }
  else if(x <= 2.0) {
    const double lx = log(x);
    int stat_I0;
    gsl_sf_result I0;
    gsl_sf_result c;
    cheb_eval_e(&bk0_cs, 0.5*x*x-1.0, &c);
    stat_I0 = gsl_sf_bessel_I0_e(x, &I0);
    result->val  = (-lx+M_LN2)*I0.val - 0.25 + c.val;
    result->err  = (fabs(lx) + M_LN2) * I0.err + c.err;
    result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
    return stat_I0;
  }
  else {
    gsl_sf_result K0_scaled;
    int stat_K0 = gsl_sf_bessel_K0_scaled_e(x, &K0_scaled);
    int stat_e  = gsl_sf_exp_mult_err_e(-x, GSL_DBL_EPSILON*fabs(x),
                                           K0_scaled.val, K0_scaled.err,
					   result);
    return GSL_ERROR_SELECT_2(stat_e, stat_K0);
  }
}

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

#include "eval.h"

double gsl_sf_bessel_K0_scaled(const double x)
{
  EVAL_RESULT(gsl_sf_bessel_K0_scaled_e(x, &result));
}

double gsl_sf_bessel_K0(const double x)
{
  EVAL_RESULT(gsl_sf_bessel_K0_e(x, &result));
}


/* Copyright (c) 2011-2012, Jérémy Fix. All rights reserved. */

/* Redistribution and use in source and binary forms, with or without */
/* modification, are permitted provided that the following conditions are met: */

/* * Redistributions of source code must retain the above copyright notice, */
/* this list of conditions and the following disclaimer. */
/* * Redistributions in binary form must reproduce the above copyright notice, */
/* this list of conditions and the following disclaimer in the documentation */
/* and/or other materials provided with the distribution. */
/* * None of the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. */

/* THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS "AS IS" AND */
/* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED */
/* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE */
/* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE */
/* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL */
/* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR */
/* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER */
/* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, */
/* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE */
/* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */

#ifndef UKF_PARAMETER_SCALAR_H
#define UKF_PARAMETER_SCALAR_H

#include <gsl/gsl_linalg.h> // For the Cholesky decomposition
#include <gsl/gsl_math.h>
#include <gsl/gsl_blas.h>

#include "ukf_types.h"
#include "ukf_math.h"

namespace ukf
{
    /**
      * @short UKF for parameter estimation.
      * The notations follow "Sigma-Point Kalman Filters for Probabilistic Inference in Dynamic State-Space Models",p93, PhD, van Der Merwe
      */
    namespace parameter
    {
        /**
         * @short Allocation of the vectors/matrices and initialization
         *
         */
        inline void ukf_scalar_init(ukf_param &p, ukf_scalar_state &s)
        {
            // Init the lambda
            p.lambda = p.alpha * p.alpha * (p.n + p.kpa) - p.n;
            p.gamma = sqrt(p.n + p.lambda);
            p.nbSamples = 2 * p.n + 1;

            // Init the matrices used to iterate
            s.Kk = gsl_vector_alloc(p.n); // Kalman gain
            gsl_vector_set_zero(s.Kk);

            s.Kk_mat = gsl_matrix_alloc(p.n,1);
            gsl_matrix_set_zero(s.Kk_mat);

            s.Kk_mat_T = gsl_matrix_alloc(1,p.n);
            gsl_matrix_set_zero(s.Kk_mat_T);

            s.Pwdk = gsl_vector_alloc(p.n); // Covariance of the parameters and output
            gsl_vector_set_zero(s.Pwdk);

            // Whatever the type of evolution noise, its covariance is set to evolution_noise
            s.Prrk = gsl_matrix_alloc(p.n,p.n);
            p.evolution_noise->init(p,s);

            s.Peek = p.observation_noise; // Covariance of the observation noise

            s.Pddk = 0.0; // Covariance of the output

            s.w = gsl_vector_alloc(p.n); // Parameter vector
            gsl_vector_set_zero(s.w);

            s.wk = gsl_vector_alloc(p.n); // Vector holding one sigma point
            gsl_vector_set_zero(s.wk);

            s.Pk = gsl_matrix_alloc(p.n,p.n); // Covariance matrix
            gsl_matrix_set_identity(s.Pk);
            gsl_matrix_scale(s.Pk,p.prior_pi);

            s.Sk = gsl_matrix_alloc(p.n,p.n); // Matrix holding the cholesky decomposition of Pk
            // Initialize Sk to the cholesky decomposition of Pk
            gsl_matrix_memcpy(s.Sk, s.Pk);
            gsl_linalg_cholesky_decomp(s.Sk);
            // Set all the elements of Lpi strictly above the diagonal to zero
            for(int k = 0 ; k < p.n ; k++)
                for(int j = 0 ; j < k ; j++)
                    gsl_matrix_set(s.Sk,j,k,0.0);

            s.cSk = gsl_vector_alloc(p.n); // Vector holding one column of Lpi
            gsl_vector_set_zero(s.cSk);

            s.wm  = gsl_vector_alloc(p.nbSamples); // Weights used to compute the mean of the sigma points images
            s.wc = gsl_vector_alloc(p.nbSamples); // Weights used to update the covariance matrices

            // Set the weights
            gsl_vector_set(s.wm, 0, p.lambda / (p.n + p.lambda));
            gsl_vector_set(s.wc, 0, p.lambda / (p.n + p.lambda) + (1.0 - p.alpha*p.alpha + p.beta));
            for(int j = 1 ; j < p.nbSamples; j ++)
            {
                gsl_vector_set(s.wm, j, 1.0 / (2.0 * (p.n + p.lambda)));
                gsl_vector_set(s.wc, j, 1.0 / (2.0 * (p.n + p.lambda)));
            }

            s.dk = gsl_vector_alloc(p.nbSamples); // Holds the image of the sigma points
            gsl_vector_set_zero(s.dk);

            s.d_mean = 0; // Holds the mean of the sigma points images

            s.sigmaPoints = gsl_matrix_alloc(p.n,p.nbSamples); // Holds the sigma points in the columns
            gsl_matrix_set_zero(s.sigmaPoints);

            s.temp_n = gsl_vector_alloc(p.n);
            gsl_vector_set_zero(s.temp_n);

            s.temp_n_n = gsl_matrix_alloc(p.n,p.n);
            gsl_matrix_set_zero(s.temp_n_n);
        }

        /**
         * @short Free of memory allocation
         *
         */
        inline void ukf_scalar_free(ukf_param &p, ukf_scalar_state &s)
        {
            gsl_vector_free(s.Kk);
            gsl_matrix_free(s.Kk_mat);
            gsl_matrix_free(s.Kk_mat_T);
            gsl_vector_free(s.Pwdk);
            gsl_matrix_free(s.Prrk);

            gsl_vector_free(s.w);
            gsl_vector_free(s.wk);

            gsl_matrix_free(s.Pk);
            gsl_matrix_free(s.Sk);
            gsl_vector_free(s.cSk);

            gsl_vector_free(s.wm);
            gsl_vector_free(s.wc);

            gsl_vector_free(s.dk);

            gsl_matrix_free(s.sigmaPoints);

            gsl_vector_free(s.temp_n);
            gsl_matrix_free(s.temp_n_n);
        }

        /**
         * @short Iteration for UKF for parameter estimation, in case of a scalar output
         *
         */
	template<typename GFUNC>
        void ukf_scalar_iterate(ukf_param &p, ukf_scalar_state &s,
				       GFUNC g,
				       gsl_vector * xk, double dk)
        {
            // Here, we implement the UKF for parameter estimation in the scalar case
            // The notations follow p93 of the PhD thesis of Van Der Merwe, "Sigma-Point Kalman Filters for Probabilistic Inference in Dynamic State-Space Models"

            // ************************************************** //
            // ************ Time update equations    ************ //
            // ************************************************** //
            // Add the evolution noise to the parameter covariance Eq 3.137
            gsl_matrix_add(s.Pk, s.Prrk);

            // ************************************************** //
            // ************ Compute the sigma points ************ //
            // ************************************************** //
            // Equations 3.138
            // w_k^j = w_(k-1)  <-- this is here denoted s.w
            // w_k^j = w_(k-1) + gamma Sk_j for 1 <= j <= n
            // w_k^j = w_(k-1) - gamma Sk_j for n+1 <= j <= 2n

            // Perform a cholesky decomposition of Pk
            gsl_matrix_memcpy(s.Sk, s.Pk);
            gsl_linalg_cholesky_decomp(s.Sk);
            // Set all the elements of Lpi strictly above the diagonal to zero
            for(int k = 0 ; k < p.n ; k++)
                for(int j = 0 ; j < k ; j++)
                    gsl_matrix_set(s.Sk,j,k,0.0);

            gsl_matrix_set_col(s.sigmaPoints,0, s.w);
            for(int j = 1 ; j < p.n+1 ; ++j)
                for(int i = 0 ; i < p.n ; ++i)
                    gsl_matrix_set(s.sigmaPoints, i, j, gsl_vector_get(s.w, i) + p.gamma * gsl_matrix_get(s.Sk,i,j-1));

            for(int j = p.n+1 ; j < p.nbSamples ; ++j)
                for(int i = 0 ; i < p.n ; ++i)
                    gsl_matrix_set(s.sigmaPoints, i, j, gsl_vector_get(s.w, i) - p.gamma * gsl_matrix_get(s.Sk,i,j-(p.n+1)));

            // ************************************************** //
            // ***** Compute the images of the sigma points ***** //
            // ************************************************** //

            // Compute the images of the sigma points
            // and the mean of the yj
            s.d_mean = 0.0;
            gsl_vector_set_zero(s.dk);
            for(int j = 0 ; j < p.nbSamples ; j++)
            {
                // Equation 3.139
                gsl_matrix_get_col(s.wk, s.sigmaPoints,j);
                s.dk->data[j] = g(s.wk,xk);

                // Update the mean : y_mean = sum_[j=0..2n] wm_j y_j
                // Equation 3.140
                s.d_mean += s.wm->data[j] * s.dk->data[j];
            }

            // ************************************************** //
            // ************** Update the statistics ************* //
            // ************************************************** //

            gsl_vector_set_zero(s.Pwdk);
            // The covariance of the output is initialized with the observation noise covariance
            // Eq 3.142
            s.Pddk = s.Peek;
            for(int j = 0 ; j < p.nbSamples ; j++)
            {
                // Eq 3.142
                s.Pddk += s.wc->data[j] * gsl_pow_2(s.dk->data[j] - s.d_mean);
                // Eq 3.143
                for(int i = 0 ; i < p.n ; ++i)
                {
                    s.Pwdk->data[i] = s.Pwdk->data[i] + s.wc->data[j] * (gsl_matrix_get(s.sigmaPoints,i,j) - s.w->data[i]) * (s.dk->data[j] - s.d_mean) ;
                }
            }

            // ************************************************** //
            // ******* Kalman gain and parameters update ******** //
            // ************************************************** //

            //if(s.Pddk == 0.0)
            //    printf("[Error] Output covariance is null !");
            // May not occur as soon as the observation noise covariance is set != 0.0

            // Eq. 3.144
            for(int i = 0 ; i < p.n ; ++i)
                s.Kk->data[i] = s.Pwdk->data[i] / s.Pddk;

            // Eq 3.145
            // wk = w_(k-1) + Kk * (dk - d_mean)
            s.ino_dk = dk - s.d_mean;
            for(int i = 0 ; i < p.n ; ++i)
                s.w->data[i] = s.w->data[i] + s.Kk->data[i] * s.ino_dk;

            // Eq. 3.146
            // Pk = P_(k-1) - Pddk . Kk Kk^T
            for(int i = 0 ; i < p.n ; ++i)
            {
                gsl_matrix_set(s.Kk_mat, i, 0, s.Kk->data[i]);
                gsl_matrix_set(s.Kk_mat_T, 0, i, s.Kk->data[i]);
            }
            gsl_blas_dgemm(CblasNoTrans,CblasNoTrans,-s.Pddk, s.Kk_mat, s.Kk_mat_T,1.0,s.Pk);

            // Update of the evolution noise
            p.evolution_noise->updateEvolutionNoise(p,s);
        }

        /**
        * @short Evaluation of the output from the sigma points
        *
        */
        void ukf_scalar_evaluate(ukf_param &p, ukf_scalar_state &s,
				 double(*g)(gsl_vector*, gsl_vector*),
				 gsl_vector * xk, double &dk)
        {
            // ************************************************** //
            // ************ Compute the sigma points ************ //
            // ************************************************** //

            // 1- Compute the cholesky decomposition of Pk
            gsl_matrix_memcpy(s.temp_n_n, s.Pk);
            gsl_linalg_cholesky_decomp(s.temp_n_n);

            // 2 - Set all the elements of Sk_temp strictly above the diagonal to zero
            for(int k = 0 ; k < p.n ; k++)
                for(int j = 0 ; j < k ; j++)
                    gsl_matrix_set(s.temp_n_n,j,k,0.0);
            // Now Sk_temp is a lower triangular matrix containing the cholesky decomposition of Pk

            // 3- Compute the sigma points
            // Equations 3.138
            // w_k^j = w_(k-1)  <-- this is here denoted s.w
            // w_k^j = w_(k-1) + gamma Sk_j for 1 <= j <= n
            // w_k^j = w_(k-1) - gamma Sk_j for n+1 <= j <= 2n
            gsl_matrix_set_col(s.sigmaPoints,0, s.w);
            for(int j = 1 ; j < p.n+1 ; j++)
                for(int i = 0 ; i < p.n ; ++i)
                    gsl_matrix_set(s.sigmaPoints, i, j, gsl_vector_get(s.w, i) + p.gamma * gsl_matrix_get(s.temp_n_n,i,j-1));

            for(int j = p.n+1 ; j < p.nbSamples ; j++)
                for(int i = 0 ; i < p.n ; ++i)
                    gsl_matrix_set(s.sigmaPoints, i, j, gsl_vector_get(s.w, i) - p.gamma * gsl_matrix_get(s.temp_n_n,i,j-(p.n+1)));

            // ************************************************** //
            // ***** Compute the images of the sigma points ***** //
            // ************************************************** //

            // Compute the images of the sigma points
            // and their mean
            dk = 0.0;
            for(int j = 0 ; j < p.nbSamples ; j++)
            {
                gsl_matrix_get_col(s.wk, s.sigmaPoints,j);
                // Update the mean : d_mean = sum_[j=0..2n] w_j y_j
                dk += gsl_vector_get(s.wm,j) * g(s.wk,xk);
            }
        }

    } // parameter
} // ukf

#endif // UKF_PARAMETER_SCALAR_H


#ifndef __MATH_FUNCTINS_H__
#define __MATH_FUNCTINS_H__

#include <stdint.h>
#include <cmath>  // for std::fabs and std::signbit
#include <cblas.h>
#include <cudnn.h>
#include <cublas_v2.h>
#include <cuda.h>
#include <cuda_runtime.h>
#include <curand.h>
#include <driver_types.h>  // cuda driver types
#include <algorithm>

#include <glog/logging.h>
#define PERMUTELAYER_ORDERNUM 4
#define BLOCK 512
//
// CUDA macros
//

// CUDA: various checks for different function calls.
#define CUDA_CHECK(condition) \
  /* Code block avoids redefinition of cudaError_t error */ \
  do { \
    cudaError_t error = condition; \
    CHECK_EQ(error, cudaSuccess) << " " << cudaGetErrorString(error); \
  } while (0)

#define CUBLAS_CHECK(condition) \
  do { \
    cublasStatus_t status = condition; \
    CHECK_EQ(status, CUBLAS_STATUS_SUCCESS) << " " \
      << cublasGetErrorString(status); \
  } while (0)

#define CURAND_CHECK(condition) \
  do { \
    curandStatus_t status = condition; \
    CHECK_EQ(status, CURAND_STATUS_SUCCESS) << " " \
      << curandGetErrorString(status); \
  } while (0)

// CUDA: grid stride looping
#define CUDA_KERNEL_LOOP(i, n) \
  for (int i = blockIdx.x * blockDim.x + threadIdx.x; \
       i < (n); \
       i += blockDim.x * gridDim.x)

// CUDA: check for error after kernel execution and exit loudly if there is one.
#define CUDA_POST_KERNEL_CHECK CUDA_CHECK(cudaPeekAtLastError())

// CUDA: library error reporting.
const char* cublasGetErrorString(cublasStatus_t error);
const char* curandGetErrorString(curandStatus_t error);

// CUDA: use 512 threads per block
const int TENSORRT_CUDA_NUM_THREADS = 256;

// CUDA: number of blocks for threads.
inline int TENSORRT_GET_BLOCKS(const int N) {
  return (N + TENSORRT_CUDA_NUM_THREADS - 1) / TENSORRT_CUDA_NUM_THREADS;
}

/*
 * function: X[i] = alpha,initialize X with constant alpha
 *
 */
template <typename Dtype>
void tensorrt_gpu_set(const int N, const Dtype alpha, Dtype *X);

/*
 * function: y[index] = pow(a[index], alpha)
 *@params n: the dims of matrix a
 *@params a: matrix
 *@params y: vector
 */
template <typename Dtype>
void tensorrt_gpu_powx(const int n, const Dtype* a, const Dtype alpha, Dtype* y);

/*
 *function:y = alpha*A*x + beta*y;
 *@params handle: handle
 *@params TransA: transpose flag
 *@params M: the rows of A
 *@params N: the cols of A
 *@params alpha: the coefficient of A*x
 *@params A: matrix [M x N]
 *@params x: vector x
 *@params beta: the coefficient of y
 *@params y: vector y
 */
template <typename Dtype>
void tensorrt_gpu_gemv(cublasHandle_t handle,const CBLAS_TRANSPOSE TransA, const int M, const int N,
    const Dtype alpha, const Dtype* A, const Dtype* x, const Dtype beta,
    Dtype* y);

template <typename Dtype>
void tensorrt_gpu_divbsx(const int nthreads, const Dtype* A,
    const Dtype* v, const int rows, const int cols, const CBLAS_TRANSPOSE trans,
    Dtype* B);

template <typename Dtype>
void tensorrt_gpu_mulbsx(const int nthreads, const Dtype* A,
    const Dtype* v, const int rows, const int cols, const CBLAS_TRANSPOSE trans,
    Dtype* B);
cudaError_t tensorrt_gpu_permute(const int nthreads,float* const  bottom_data,const bool forward,
	const int* permute_order,const int* old_steps,const int* new_steps,const int num_axes,float* const top_data,cudaStream_t stream);

cudaError_t SoftmaxLayer(const float *bottom_data, int count, int channels, int outer_num_, int inner_num_, float *scale_data, float *top_data, cudaStream_t stream);

cudaError_t ConcatLayer(int nthreads, const float *bottom_data, bool kForward, int num_concats_, int concat_input_size_, int top_concat_axis, int bottom_concat_axis, int offset_concat_axis, float *top_data, cudaStream_t stream);

//cudaError_t cudaSoftmax(int n, int channels,  float* x, float*y, cudaStream_t stream);

//virtual void Forward_gpu(const vector<Blob<Dtype>*>& bottom,const vector<Blob<Dtype>*>& top);
cudaError_t cudaSoftmax_caffe(int count,int channels,float* x,float* y, cudaStream_t stream);

cudaError_t cudaDetectionOutput_caffe( int bottom0_count,
                                       int bottom1_count,
                                       float* loc_data,
                                       float* bottom1,
                                       float* prior_data,
                                       float* bottom3,
                                       float* bottom4,
                                       float* y,
                                       cudaStream_t stream);

#endif


#pragma once

#ifndef __GREEK_LETTERS_H__
#define __GREEK_LETTERS_H__

#include <cstring>
#include <string>

#include <gsl/gsl_math.h>

#include "../../Utils/BinarySearch.h"

constexpr const int numGreekLetters = 49;
constexpr const char* greekLetterNames[numGreekLetters] = {
	"Alpha", "Beta", "Chi", "Delta", "Epsilon", "Eta", "Gamma", "Iota", "Kappa", "Lambda",
	"Mu", "Nu", "Omega", "Omicron", "Phi", "Pi", "Psi", "Rho", "Sigma", "Tau", "Theta",
	"Upsilon", "Xi", "Zeta", "alpha", "beta", "chi", "delta", "epsilon", "eta", "gamma",
	"iota", "kappa", "lambda", "mu", "nu", "omega", "omicron", "phi", "pi", "psi", "rho",
	"sigma", "tau", "theta", "upsilon", "vphi", "xi", "zeta"
};
constexpr const int shortestGreekLetterName = 2;
constexpr const int longestGreekLetterName = 7;
constexpr const int greekLetterLength = 2;
const std::string greekLetters[numGreekLetters] = {
	u8"\u0391", u8"\u0392", u8"\u03A7", u8"\u0394", u8"\u0395", u8"\u0397", u8"\u0393",
	u8"\u0399", u8"\u039A", u8"\u039B", u8"\u039C", u8"\u039D", u8"\u03A9", u8"\u039F",
	u8"\u03A6", u8"\u03A0", u8"\u03A8", u8"\u03A1", u8"\u03A3", u8"\u03A4", u8"\u0398",
	u8"\u03A5", u8"\u039E", u8"\u0396", u8"\u03B1", u8"\u03B2", u8"\u03C7", u8"\u03B4",
	u8"\u03B5", u8"\u03B7", u8"\u03B3", u8"\u03B9", u8"\u03BA", u8"\u03BB", u8"\u03BC",
	u8"\u03BD", u8"\u03C9", u8"\u03BF", u8"\u03C6", u8"\u03C0", u8"\u03C8", u8"\u03C1",
	u8"\u03C3", u8"\u03C4", u8"\u03B8", u8"\u03C5", u8"\u03d5", u8"\u03BE", u8"\u03B6"
};

/*
Returns index of the constant in the constants array.

Uses binary search under the hood to search for the index.

Parameters
----------
name: The name of the constantaddMissingRParens
The index or -1 if the provided name is not a constant.
*/
CONSTEXPR_BINARY_SEARCH(getGreekLetterNameIndex, greekLetterNames, numGreekLetters)

static int getGreekLetterIndex(const std::string& name){
    if (name.size() <= greekLetterLength){
        for (int i = 0; i < numGreekLetters; ++i){
            if (name == greekLetters[i]){
                return i;
            }
        }
    }
    return getGreekLetterNameIndex(name.c_str());
}

#endif // __GREEK_LETTERS_H__