// GetDP - Copyright (C) 1997-2022 P. Dular and C. Geuzaine, University of Liege
//
// See the LICENSE.txt file for license information. Please report all
// issues on https://gitlab.onelab.info/getdp/getdp/issues.

#include <math.h>
#include "ProData.h"
#include "F.h"
#include "MallocUtils.h"
#include "Message.h"

extern struct CurrentData Current;

/* ------------------------------------------------------------------------ */
/*  Interpolation                                                           */
/* ------------------------------------------------------------------------ */

void F_InterpolationLinear(F_ARG)
{
  int N, up, lo;
  double xp, yp = 0., *x, *y, a;
  struct FunctionActive *D;

  if(!Fct->Active) Fi_InitListXY(Fct, A, V);

  D = Fct->Active;
  N = D->Case.Interpolation.NbrPoint;
  x = D->Case.Interpolation.x;
  y = D->Case.Interpolation.y;

  xp = A->Val[0];

  if(xp < x[0]) {
    Message::Error("Bad argument for linear interpolation (%g < %g)", xp, x[0]);
  }
  else if(xp > x[N - 1]) {
    a = (y[N - 1] - y[N - 2]) / (x[N - 1] - x[N - 2]);
    yp = y[N - 1] + (xp - x[N - 1]) * a;
  }
  else {
    up = 0;
    while(x[++up] < xp) {};
    lo = up - 1;
    a = (y[up] - y[lo]) / (x[up] - x[lo]);
    yp = y[up] + (xp - x[up]) * a;
  }

  // Using interpolation function also in multi-harmonic case
  // Input is scalar, output is also scalar, rest of Val is set to zero...
  // Not very elegant, but was already done like that for NbrHar=2...
  // Should we add here a warning?
  // Message::Warning("Function 'Interpolation' interpolates only real values,
  // i.e. result is a real scalar");
  V->Val[0] = yp;
  if(Current.NbrHar != 1) {
    V->Val[MAX_DIM] = 0.;
    for(int k = 2; k < std::min(NBR_MAX_HARMONIC, Current.NbrHar); k += 2)
      V->Val[MAX_DIM * k] = V->Val[MAX_DIM * (k + 1)] = 0.;
  }

  /*
  if (Current.NbrHar == 1)
    V->Val[0] = yp ;
  else if (Current.NbrHar == 2) {
    V->Val[0] = yp ;
    V->Val[1] = 0. ;
  }
  else {
    Message::Error("Function 'Interpolation' not valid for Complex");
  }
  */

  V->Type = SCALAR;
}

void F_dInterpolationLinear(F_ARG)
{
  int N, up, lo;
  double xp, dyp = 0., *x, *y;
  struct FunctionActive *D;

  if(!Fct->Active) Fi_InitListXY(Fct, A, V);

  D = Fct->Active;
  N = D->Case.Interpolation.NbrPoint;
  x = D->Case.Interpolation.x;
  y = D->Case.Interpolation.y;

  xp = A->Val[0];

  if(xp < x[0]) {
    Message::Error("Bad argument for linear Interpolation (%g < %g)", xp, x[0]);
  }
  else if(xp > x[N - 1]) {
    dyp = (y[N - 1] - y[N - 2]) / (x[N - 1] - x[N - 2]);
  }
  else {
    up = 0;
    while(x[++up] < xp) {};
    lo = up - 1;
    dyp = (y[up] - y[lo]) / (x[up] - x[lo]);
  }

  // Allowing interpolation of a real in multi-harmonic case (to change...)
  V->Val[0] = dyp;
  if(Current.NbrHar != 1) {
    V->Val[MAX_DIM] = 0.;
    for(int k = 2; k < std::min(NBR_MAX_HARMONIC, Current.NbrHar); k += 2)
      V->Val[MAX_DIM * k] = V->Val[MAX_DIM * (k + 1)] = 0.;
  }

  /*
  if (Current.NbrHar == 1)
    V->Val[0] = dyp ;
  else if (Current.NbrHar == 2) {
    V->Val[0] = dyp ;
    V->Val[1] = 0. ;
  }
  else {
    Message::Error("Function 'dInterpolation' not valid for Complex");
  }
  */
  V->Type = SCALAR;
}

void F_dInterpolationLinear2(F_ARG)
{
  int N, up, lo;
  double xp, yp = 0., *x, *y, a;
  struct FunctionActive *D;

  if(!Fct->Active) {
    Fi_InitListXY(Fct, A, V);
    Fi_InitListXY2(Fct, A, V);
  }

  D = Fct->Active;
  N = D->Case.Interpolation.NbrPoint;
  x = D->Case.Interpolation.xc;
  y = D->Case.Interpolation.yc;

  xp = A->Val[0];

  if(xp < x[0]) {
    Message::Error("Bad argument for linear interpolation (%g < %g)", xp, x[0]);
  }
  else if(xp > x[N - 1]) {
    a = (y[N - 1] - y[N - 2]) / (x[N - 1] - x[N - 2]);
    yp = y[N - 1] + (xp - x[N - 1]) * a;
  }
  else {
    up = 0;
    while(x[++up] < xp) {};
    lo = up - 1;
    a = (y[up] - y[lo]) / (x[up] - x[lo]);
    yp = y[up] + (xp - x[up]) * a;
  }

  // Allowing interpolation of a real in multi-harmonic case (to change...)
  V->Val[0] = yp;
  if(Current.NbrHar != 1) {
    V->Val[MAX_DIM] = 0.;
    for(int k = 2; k < std::min(NBR_MAX_HARMONIC, Current.NbrHar); k += 2)
      V->Val[MAX_DIM * k] = V->Val[MAX_DIM * (k + 1)] = 0.;
  }
  /*
  if (Current.NbrHar == 1)
    V->Val[0] = yp ;
  else if (Current.NbrHar == 2) {
    V->Val[0] = yp ;
    V->Val[1] = 0. ;
  }
  else {
    Message::Error("Function 'dInterpolation' not valid for Complex");
  }
  */

  V->Type = SCALAR;
}

void F_InterpolationAkima(F_ARG)
{
  // Third order interpolation with slope control
  int N, up, lo;
  double xp, yp = 0., *x, *y, a, a2, a3;
  struct FunctionActive *D;

  if(!Fct->Active) {
    Fi_InitListXY(Fct, A, V);
    Fi_InitAkima(Fct, A, V);
  }

  D = Fct->Active;
  N = D->Case.Interpolation.NbrPoint;
  x = D->Case.Interpolation.x;
  y = D->Case.Interpolation.y;

  xp = A->Val[0];

  if(xp < x[0]) {
    Message::Error("Bad argument for linear interpolation (%g < %g)", xp, x[0]);
  }
  else if(xp > x[N - 1]) {
    a = (y[N - 1] - y[N - 2]) / (x[N - 1] - x[N - 2]);
    yp = y[N - 1] + (xp - x[N - 1]) * a;
  }
  else {
    up = 0;
    while(x[++up] < xp) {};
    lo = up - 1;
    a = xp - x[lo];
    a2 = a * a;
    a3 = a2 * a;
    yp = y[lo] + D->Case.Interpolation.bi[lo] * a +
         D->Case.Interpolation.ci[lo] * a2 + D->Case.Interpolation.di[lo] * a3;
  }

  // Allowing interpolation of a real in multi-harmonic case (to change...)
  V->Val[0] = yp;
  if(Current.NbrHar != 1) {
    V->Val[MAX_DIM] = 0.;
    for(int k = 2; k < std::min(NBR_MAX_HARMONIC, Current.NbrHar); k += 2)
      V->Val[MAX_DIM * k] = V->Val[MAX_DIM * (k + 1)] = 0.;
  }

  /*
  if (Current.NbrHar == 1)
    V->Val[0] = yp ;
  else if (Current.NbrHar == 2) {
    V->Val[0] = yp ;
    V->Val[1] = 0. ;
  }
  else {
    Message::Error("Function 'InterpolationAkima' not valid for Complex");
  }
  */

  V->Type = SCALAR;
}

void F_dInterpolationAkima(F_ARG)
{
  int N, up, lo;
  double xp, dyp = 0., *x, *y, a, a2;
  struct FunctionActive *D;

  if(!Fct->Active) {
    Fi_InitListXY(Fct, A, V);
    Fi_InitAkima(Fct, A, V);
  }

  D = Fct->Active;
  N = D->Case.Interpolation.NbrPoint;
  x = D->Case.Interpolation.x;
  y = D->Case.Interpolation.y;

  xp = A->Val[0];

  if(xp < x[0]) {
    Message::Error("Bad argument for linear interpolation (%g < %g)", xp, x[0]);
  }
  else if(xp > x[N - 1]) {
    dyp = (y[N - 1] - y[N - 2]) / (x[N - 1] - x[N - 2]);
  }
  else {
    up = 0;
    while(x[++up] < xp) {};
    lo = up - 1;
    a = xp - x[lo];
    a2 = a * a;
    dyp = D->Case.Interpolation.bi[lo] + D->Case.Interpolation.ci[lo] * 2. * a +
          D->Case.Interpolation.di[lo] * 3. * a2;
  }

  // Extension to multi-harmonic case (to change...)
  V->Val[0] = dyp;
  if(Current.NbrHar != 1) {
    V->Val[MAX_DIM] = 0.;
    for(int k = 2; k < std::min(NBR_MAX_HARMONIC, Current.NbrHar); k += 2)
      V->Val[MAX_DIM * k] = V->Val[MAX_DIM * (k + 1)] = 0.;
  }
  /*
  if (Current.NbrHar == 1)
    V->Val[0] = dyp ;
  else if (Current.NbrHar == 2) {
    V->Val[0] = dyp ;
    V->Val[1] = 0. ;
  }
  else {
    Message::Error("Function 'dInterpolationAkima' not valid for Complex");
  }
  */
  V->Type = SCALAR;
}

bool Fi_InterpolationBilinear(double *x, double *y, double *M, int NL, int NC,
                              double xp, double yp, double *zp)
{
  double a11, a12, a21, a22;
  int i, j;

  // Interpolate point (xp,yp) in a regular grid
  // x[i] <= xp < x[i+1]
  // y[j] <= yp < y[j+1]

  *zp = 0.0;

  // When (xp,yp) lays outside the boundaries of the table:
  // the nearest border is taken
  if(xp < x[0])
    xp = x[0];
  else if(xp > x[NL - 1])
    xp = x[NL - 1];
  for(i = 0; i < NL - 1; ++i)
    if(x[i + 1] >= xp && xp >= x[i]) break;
  i = (i >= NL) ? NL - 1 : i;

  if(yp < y[0])
    yp = y[0];
  else if(yp > y[NC - 1])
    yp = y[NC - 1];
  for(j = 0; j < NC - 1; ++j)
    if(y[j + 1] >= yp && yp >= y[j]) break;
  j = (j >= NC) ? NC - 1 : j;

  a11 = M[i + NL * j];
  a21 = M[(i + 1) + NL * j];
  a12 = M[i + NL * (j + 1)];
  a22 = M[(i + 1) + NL * (j + 1)];

  *zp =
    1 / ((x[i + 1] - x[i]) * (y[j + 1] - y[j])) *
    (a11 * (x[i + 1] - xp) * (y[j + 1] - yp) +
     a21 * (-x[i] + xp) * (y[j + 1] - yp) +
     a12 * (x[i + 1] - xp) * (-y[j] + yp) + a22 * (-x[i] + xp) * (-y[j] + yp));

  return true;
}

bool Fi_dInterpolationBilinear(double *x, double *y, double *M, int NL, int NC,
                               double xp, double yp, double *dzp_dx,
                               double *dzp_dy)
{
  double a11, a12, a21, a22;
  int i, j;

  // When (xp,yp) lays outside the boundaries of the table:
  // the nearest border is taken
  if(xp < x[0])
    xp = x[0];
  else if(xp > x[NL - 1])
    xp = x[NL - 1];
  for(i = 0; i < NL - 1; ++i)
    if(x[i + 1] >= xp && xp >= x[i]) break;
  i = (i >= NL) ? NL - 1 : i;

  if(yp < y[0])
    yp = y[0];
  else if(yp > y[NC - 1])
    yp = y[NC - 1];
  for(j = 0; j < NC - 1; ++j)
    if(y[j + 1] >= yp && yp >= y[j]) break;
  j = (j >= NC) ? NC - 1 : j;

  a11 = M[i + NL * j];
  a21 = M[(i + 1) + NL * j];
  a12 = M[i + NL * (j + 1)];
  a22 = M[(i + 1) + NL * (j + 1)];

  *dzp_dx = 1 / ((x[i + 1] - x[i]) * (y[j + 1] - y[j])) *
            ((a21 - a11) * (y[j + 1] - yp) + (a22 - a12) * (-y[j] + yp));

  *dzp_dy = 1 / ((x[i + 1] - x[i]) * (y[j + 1] - y[j])) *
            ((a12 - a11) * (x[i + 1] - xp) + (a22 - a21) * (-x[i] + xp));

  return true;
}

bool Fi_InterpolationTrilinear(double *x, double *y, double *z, double *M,
                               int NX, int NY, int NZ, double xp, double yp,
                               double zp, double *vp)
{
  /*
   *
   *       a122  **************************** a222
   *           * |                        * *
   *         *   |                      *   *
   *       *     |                    *     *
   *     **************************** a212  *
   *     * a112  |                  *       *
   *     *       |                  *       *
   *     *       |                  *       *
   *     *       |                  *       *
   *     *       |                  *       *
   *     *       |                  *       *
   *     *       |                  *       *
   *     *       |                  *       *
   *     *       |                  *       *
   *     *  a121 -------------------*-------* a221
   *     *     /                    *     *
   *     *   /                      *   *
   *     * /                        * *
   *     ****************************
   *    a111                       a211
   */

  double a111, a121, a211, a221, a112, a122, a212, a222;
  int i, j, k;

  // Interpolate point (xp,yp,zp) in a regular grid
  // x[i] <= xp < x[i+1]
  // y[j] <= yp < y[j+1]
  // z[k] <= zp < z[k+1]

  *vp = 0.0;

  // When (xp,yp,zp) lays outside the boundaries of the table:
  // the nearest border is taken
  if(xp < x[0])
    xp = x[0];
  else if(xp > x[NX - 1])
    xp = x[NX - 1];
  for(i = 0; i < NX - 1; ++i)
    if(x[i + 1] >= xp && xp >= x[i]) break;
  i = (i >= NX) ? NX - 1 : i;

  if(yp < y[0])
    yp = y[0];
  else if(yp > y[NY - 1])
    yp = y[NY - 1];
  for(j = 0; j < NY - 1; ++j)
    if(y[j + 1] >= yp && yp >= y[j]) break;
  j = (j >= NY) ? NY - 1 : j;

  if(zp < z[0])
    zp = z[0];
  else if(zp > z[NZ - 1])
    zp = z[NZ - 1];
  for(k = 0; k < NZ - 1; ++k)
    if(z[k + 1] >= zp && zp >= z[k]) break;
  k = (k >= NZ) ? NZ - 1 : k;

  a111 = M[i + NX * j + NX * NY * k];
  a211 = M[(1 + i) + NX * j + NX * NY * k];
  a121 = M[i + NX * (1 + j) + NX * NY * k];
  a221 = M[(1 + i) + NX * (1 + j) + NX * NY * k];

  a112 = M[i + NX * j + NX * NY * (k + 1)];
  a212 = M[(1 + i) + NX * j + NX * NY * (k + 1)];
  a122 = M[i + NX * (1 + j) + NX * NY * (k + 1)];
  a222 = M[(1 + i) + NX * (1 + j) + NX * NY * (k + 1)];

  double xd, yd, zd;
  xd = (xp - x[i]) / (x[i + 1] - x[i]);
  yd = (yp - y[j]) / (y[j + 1] - y[j]);
  zd = (zp - z[k]) / (z[k + 1] - z[k]);

  double a11, a12, a21, a22;
  a11 = a111 * (1 - xd) + a211 * xd;
  a12 = a112 * (1 - xd) + a212 * xd;
  a21 = a121 * (1 - xd) + a221 * xd;
  a22 = a122 * (1 - xd) + a222 * xd;

  double a1, a2;
  a1 = a11 * (1 - yd) + a21 * yd;
  a2 = a12 * (1 - yd) + a22 * yd;

  *vp = a1 * (1 - zd) + a2 * zd;

  return true;
}

bool Fi_dInterpolationTrilinear(double *x, double *y, double *z, double *M,
                                int NX, int NY, int NZ, double xp, double yp,
                                double zp, double *dvp_dx, double *dvp_dy,
                                double *dvp_dz)
{
  /*
   *
   *       a122  **************************** a222
   *           * |                        * *
   *         *   |                      *   *
   *       *     |                    *     *
   *     **************************** a212  *
   *     * a112  |                  *       *
   *     *       |                  *       *
   *     *       |                  *       *
   *     *       |                  *       *
   *     *       |                  *       *
   *     *       |                  *       *
   *     *       |                  *       *
   *     *       |                  *       *
   *     *       |                  *       *
   *     *  a121 -------------------*-------* a221
   *     *     /                    *     *
   *     *   /                      *   *
   *     * /                        * *
   *     ****************************
   *    a111                       a211
   */

  double a111, a121, a211, a221, a112, a122, a212, a222;
  int i, j, k;

  // Interpolate point (xp,yp,zp) in a regular grid
  // x[i] <= xp < x[i+1]
  // y[j] <= yp < y[j+1]
  // z[k] <= zp < z[k+1]

  *dvp_dx = 0.0;
  *dvp_dy = 0.0;
  *dvp_dz = 0.0;

  // When (xp,yp,zp) lays outside the boundaries of the table:
  // the nearest border is taken
  if(xp < x[0])
    xp = x[0];
  else if(xp > x[NX - 1])
    xp = x[NX - 1];
  for(i = 0; i < NX - 1; ++i)
    if(x[i + 1] >= xp && xp >= x[i]) break;
  i = (i >= NX) ? NX - 1 : i;

  if(yp < y[0])
    yp = y[0];
  else if(yp > y[NY - 1])
    yp = y[NY - 1];
  for(j = 0; j < NY - 1; ++j)
    if(y[j + 1] >= yp && yp >= y[j]) break;
  j = (j >= NY) ? NY - 1 : j;

  if(zp < z[0])
    zp = z[0];
  else if(zp > z[NZ - 1])
    zp = z[NZ - 1];
  for(k = 0; k < NZ - 1; ++k)
    if(z[k + 1] >= zp && zp >= z[j]) break;
  k = (k >= NZ) ? NZ - 1 : k;

  a111 = M[i + NX * j + NX * NY * k];
  a211 = M[(1 + i) + NX * j + NX * NY * k];
  a121 = M[i + NX * (1 + j) + NX * NY * k];
  a221 = M[(1 + i) + NX * (1 + j) + NX * NY * k];

  a112 = M[i + NX * j + NX * NY * (k + 1)];
  a212 = M[(1 + i) + NX * j + NX * NY * (k + 1)];
  a122 = M[i + NX * (1 + j) + NX * NY * (k + 1)];
  a222 = M[(1 + i) + NX * (1 + j) + NX * NY * (k + 1)];

  double xd, yd, zd;
  xd = (xp - x[i]) / (x[i + 1] - x[i]);
  yd = (yp - y[j]) / (y[j + 1] - y[j]);
  zd = (zp - z[k]) / (z[k + 1] - z[k]);

  double dxd, dyd, dzd;
  dxd = 1. / (x[i + 1] - x[i]);
  dyd = 1. / (y[j + 1] - y[j]);
  dzd = 1. / (z[k + 1] - z[k]);

  double a11, a12, a21, a22, dxa11, dxa12, dxa21, dxa22;
  a11 = a111 * (1 - xd) + a211 * xd;
  a12 = a112 * (1 - xd) + a212 * xd;
  a21 = a121 * (1 - xd) + a221 * xd;
  a22 = a122 * (1 - xd) + a222 * xd;
  dxa11 = -a111 * dxd + a211 * dxd;
  dxa12 = -a112 * dxd + a212 * dxd;
  dxa21 = -a121 * dxd + a221 * dxd;
  dxa22 = -a122 * dxd + a222 * dxd;

  double a1, a2, dya1, dya2, dxa1, dxa2;
  a1 = a11 * (1 - yd) + a21 * yd;
  a2 = a12 * (1 - yd) + a22 * yd;
  dya1 = -a11 * dyd + a21 * dyd;
  dya2 = -a12 * dyd + a22 * dyd;
  dxa1 = dxa11 * (1 - yd) + dxa21 * yd;
  dxa2 = dxa12 * (1 - yd) + dxa22 * yd;

  *dvp_dx = dxa1 * (1 - zd) + dxa2 * zd;
  *dvp_dy = dya1 * (1 - zd) + dya2 * zd;
  *dvp_dz = -a1 * dzd + a2 * dzd;

  return true;
}

void F_InterpolationBilinear(F_ARG)
{
  /*
      It performs a bilinear interpolation at point (xp,yp) based
      on a two-dimensional table (sorted grid).

      Input parameters:
      NL  Number of lines
      NC  Number of columns
      x   values (ascending order) linked to the NL lines of the table
      y   values (ascending order) linked to the NC columns of the table
      M   Matrix M(x,y) = M[x+NL*y]

      xp  x coordinate of interpolation point
      yp  y coordinate of interpolation point

      R. Scorretti
  */

  int NL, NC;
  double xp, yp, zp = 0., *x, *y, *M;
  struct FunctionActive *D;

  if((A + 0)->Type != SCALAR || (A + 1)->Type != SCALAR)
    Message::Error("Two Scalar arguments required!");

  if(!Fct->Active) Fi_InitListMatrix(Fct, A, V);

  D = Fct->Active;
  NL = D->Case.ListMatrix.NbrLines;
  NC = D->Case.ListMatrix.NbrColumns;

  x = D->Case.ListMatrix.x;
  y = D->Case.ListMatrix.y;
  M = D->Case.ListMatrix.data;

  xp = (A + 0)->Val[0];
  yp = (A + 1)->Val[0];

  bool IsInGrid = Fi_InterpolationBilinear(x, y, M, NL, NC, xp, yp, &zp);
  if(!IsInGrid)
    Message::Error("Extrapolation not allowed (xp=%g ; yp=%g)", xp, yp);

  V->Type = SCALAR;
  V->Val[0] = zp;
}

void F_dInterpolationBilinear(F_ARG)
{
  /*
      It delivers the derivative of the bilinear interpolation at point (xp, yp)
      based on a two-dimensional table (sorted grid).

      Input parameters:
      NL  Number of lines
      NC  Number of columns
      x   values (ascending order) linked to the NL lines of the table
      y   values (ascending order) linked to the NC columns of the table
      M   Matrix M(x,y) = M[x+NL*y]

      xp  x coordinate of interpolation point
      yp  y coordinate of interpolation point

  */

  int NL, NC;
  double xp, yp, dzp_dx = 0., dzp_dy = 0., *x, *y, *M;
  struct FunctionActive *D;

  if((A + 0)->Type != SCALAR || (A + 1)->Type != SCALAR)
    Message::Error("Two Scalar arguments required!");

  if(!Fct->Active) Fi_InitListMatrix(Fct, A, V);

  D = Fct->Active;
  NL = D->Case.ListMatrix.NbrLines;
  NC = D->Case.ListMatrix.NbrColumns;

  x = D->Case.ListMatrix.x;
  y = D->Case.ListMatrix.y;
  M = D->Case.ListMatrix.data;

  xp = (A + 0)->Val[0];
  yp = (A + 1)->Val[0];

  bool IsInGrid =
    Fi_dInterpolationBilinear(x, y, M, NL, NC, xp, yp, &dzp_dx, &dzp_dy);
  if(!IsInGrid)
    Message::Error("Extrapolation not allowed (xp=%g ; yp=%g)", xp, yp);

  V->Type = VECTOR;
  V->Val[0] = dzp_dx;
  V->Val[1] = dzp_dy;
  V->Val[2] = 0.;
}

void F_InterpolationTrilinear(F_ARG)
{
  /*
     It performs a trilinear interpolation at point (xp,yp,zp) based
     on a three-dimensional table (sorted grid).

     Input parameters:
     NX  Number of lines X
     NY  Number of lines Y
     NZ  Number of lines Z
     x   values (ascending order) linked to the NX lines of the table
     y   values (ascending order) linked to the NY lines of the table
     z   values (ascending order) linked to the NZ lines of the table
     M   Matrix M(x,y,z) = M[x+NX*y+NX*NY*z]

     xp  x coordinate of interpolation point
     yp  y coordinate of interpolation point
     zp  z coordinate of interpolation point

     A. Royer
  */

  int NX, NY, NZ;
  double xp, yp, zp, vp = 0., *x, *y, *z, *M;
  struct FunctionActive *D;

  if((A + 0)->Type != SCALAR || (A + 1)->Type != SCALAR ||
     (A + 2)->Type != SCALAR)
    Message::Error("Three Scalar arguments required!");

  if(!Fct->Active) Fi_InitListMatrix3D(Fct, A, V);

  D = Fct->Active;
  NX = D->Case.ListMatrix3D.NbrLinesX;
  NY = D->Case.ListMatrix3D.NbrLinesY;
  NZ = D->Case.ListMatrix3D.NbrLinesZ;

  x = D->Case.ListMatrix3D.x;
  y = D->Case.ListMatrix3D.y;
  z = D->Case.ListMatrix3D.z;
  M = D->Case.ListMatrix3D.data;

  xp = (A + 0)->Val[0];
  yp = (A + 1)->Val[0];
  zp = (A + 2)->Val[0];

  bool IsInGrid =
    Fi_InterpolationTrilinear(x, y, z, M, NX, NY, NZ, xp, yp, zp, &vp);
  if(!IsInGrid)
    Message::Error("Extrapolation not allowed (xp=%g ; yp=%g, zp=%g)", xp, yp,
                   zp);

  V->Type = SCALAR;
  V->Val[0] = vp;
}

void F_dInterpolationTrilinear(F_ARG)
{
  /*
     It delivers the derivative of the bilinear interpolation at point (xp, yp,
     zp) based on a three-dimensional table (sorted grid).

     Input parameters:
     NX  Number of lines X
     NY  Number of lines Y
     NZ  Number of lines Z
     x   values (ascending order) linked to the NX lines of the table
     y   values (ascending order) linked to the NY lines of the table
     z   values (ascending order) linked to the NZ lines of the table
     M   Matrix M(x,y,z) = M[x+NX*y+NX*NY*z]

     xp  x coordinate of interpolation point
     yp  y coordinate of interpolation point
     zp  z coordinate of interpolation point

     A. Royer
  */

  int NX, NY, NZ;
  double xp, yp, zp, dvp_dx = 0., dvp_dy = 0., dvp_dz = 0., *x, *y, *z, *M;
  struct FunctionActive *D;

  if((A + 0)->Type != SCALAR || (A + 1)->Type != SCALAR ||
     (A + 2)->Type != SCALAR)
    Message::Error("Three Scalar arguments required!");

  if(!Fct->Active) Fi_InitListMatrix3D(Fct, A, V);

  D = Fct->Active;
  NX = D->Case.ListMatrix3D.NbrLinesX;
  NY = D->Case.ListMatrix3D.NbrLinesY;
  NZ = D->Case.ListMatrix3D.NbrLinesZ;

  x = D->Case.ListMatrix3D.x;
  y = D->Case.ListMatrix3D.y;
  z = D->Case.ListMatrix3D.z;
  M = D->Case.ListMatrix3D.data;

  xp = (A + 0)->Val[0];
  yp = (A + 1)->Val[0];
  zp = (A + 2)->Val[0];

  bool IsInGrid = Fi_dInterpolationTrilinear(x, y, z, M, NX, NY, NZ, xp, yp, zp,
                                             &dvp_dx, &dvp_dy, &dvp_dz);
  if(!IsInGrid)
    Message::Error("Extrapolation not allowed (xp=%g ; yp=%g, zp=%g)", xp, yp,
                   zp);

  V->Type = VECTOR;
  V->Val[0] = dvp_dx;
  V->Val[1] = dvp_dy;
  V->Val[2] = dvp_dz;
}

void Fi_InitListMatrix(F_ARG)
{
  int i = 0, k, NL, NC, sz;
  struct FunctionActive *D;

  /*
    The original table structure:
          |  y(1)         y(2)         ...     y(NC)
    ------+--------------------------------------------
    x(1)  |  data(1)    data(NL+1)     ...      .
    x(2)  |  data(2)    data(NL+2)              .
    .     .             .              .
    .     .             .
    x(NL) |  data(NL)   data(2*NL)  ...     data(NL*NC)

    is furnished with the following format:
    [ NL, NC, x(1..NL), y(1..NC), data(1..NL*NC) ]

    R. Scorretti
 */

  D = Fct->Active =
    (struct FunctionActive *)Malloc(sizeof(struct FunctionActive));

  NL = Fct->Para[i++];
  NC = Fct->Para[i++];

  sz = 2 + NL + NC + NL * NC; // expected size of list matrix
  if(Fct->NbrParameters != sz)
    Message::Error("Bad size of input data (expected = %d ; found = %d). "
                   "List with format: x(NbrLines=%d), y(NbrColumns=%d), "
                   "matrix(NbrLines*NbrColumns=%d)",
                   sz, Fct->NbrParameters, NL, NC, NL * NC);

  // Initialize structure and allocate memory
  D->Case.ListMatrix.NbrLines = NL;
  D->Case.ListMatrix.NbrColumns = NC;
  D->Case.ListMatrix.x = (double *)malloc(sizeof(double) * NL);
  D->Case.ListMatrix.y = (double *)malloc(sizeof(double) * NC);
  D->Case.ListMatrix.data = (double *)malloc(sizeof(double) * NL * NC);

  // Assign values
  for(k = 0; k < NL; ++k) D->Case.ListMatrix.x[k] = Fct->Para[i++];
  for(k = 0; k < NC; ++k) D->Case.ListMatrix.y[k] = Fct->Para[i++];
  for(k = 0; k < NL * NC; ++k) D->Case.ListMatrix.data[k] = Fct->Para[i++];
}

void Fi_InitListMatrix3D(F_ARG)
{
  int i = 0, k, NX, NY, NZ, sz;
  struct FunctionActive *D;

  /*
     The original table structure data(i,j,k) is furnished with the following
     format: [ NX, NY, NZ, x(1..NX), y(1..NY), y(1..NZ), data(1..NX*NY*NZ) ]

     A. Royer
  */

  D = Fct->Active =
    (struct FunctionActive *)Malloc(sizeof(struct FunctionActive));

  NX = Fct->Para[i++];
  NY = Fct->Para[i++];
  NZ = Fct->Para[i++];

  sz = 3 + NX + NY + NZ + NX * NY * NZ; // expected size of list matrix
  if(Fct->NbrParameters != sz)
    Message::Error(
      "Bad size of input data (expected = %d ; found = %d). "
      "List with format: x(NbrLines=%d), y(NbrLines=%d), z(NbrLines=%d), "
      "matrix(NbrLinesX*NbrLinesY*NbrLinesZ=%d)",
      sz, Fct->NbrParameters, NX, NY, NZ, NX * NY * NZ);

  // Initialize structure and allocate memory
  D->Case.ListMatrix3D.NbrLinesX = NX;
  D->Case.ListMatrix3D.NbrLinesY = NY;
  D->Case.ListMatrix3D.NbrLinesZ = NZ;
  D->Case.ListMatrix3D.x = (double *)malloc(sizeof(double) * NX);
  D->Case.ListMatrix3D.y = (double *)malloc(sizeof(double) * NY);
  D->Case.ListMatrix3D.z = (double *)malloc(sizeof(double) * NZ);
  D->Case.ListMatrix3D.data = (double *)malloc(sizeof(double) * NX * NY * NZ);

  // Assign values
  for(k = 0; k < NX; ++k) D->Case.ListMatrix3D.x[k] = Fct->Para[i++];
  for(k = 0; k < NY; ++k) D->Case.ListMatrix3D.y[k] = Fct->Para[i++];
  for(k = 0; k < NZ; ++k) D->Case.ListMatrix3D.z[k] = Fct->Para[i++];
  for(k = 0; k < NX * NY * NZ; ++k)
    D->Case.ListMatrix3D.data[k] = Fct->Para[i++];
}

void Fi_InitListX(F_ARG)
{
  int i, N;
  double *x;
  struct FunctionActive *D;

  D = Fct->Active =
    (struct FunctionActive *)Malloc(sizeof(struct FunctionActive));
  N = D->Case.Interpolation.NbrPoint = Fct->NbrParameters;
  x = D->Case.Interpolation.x = (double *)Malloc(sizeof(double) * N);

  for(i = 0; i < N; i++) x[i] = Fct->Para[i];
}

void Fi_InitListXY(F_ARG)
{
  int i, N;
  double *x, *y;
  struct FunctionActive *D;

  D = Fct->Active =
    (struct FunctionActive *)Malloc(sizeof(struct FunctionActive));
  N = D->Case.Interpolation.NbrPoint = Fct->NbrParameters / 2;
  x = D->Case.Interpolation.x = (double *)Malloc(sizeof(double) * N);
  y = D->Case.Interpolation.y = (double *)Malloc(sizeof(double) * N);

  for(i = 0; i < N; i++) {
    x[i] = Fct->Para[i * 2];
    y[i] = Fct->Para[i * 2 + 1];
  }
}

void Fi_InitListXY2(F_ARG)
{
  int i, N;
  double *x, *y, *xc, *yc;
  struct FunctionActive *D;

  D = Fct->Active;
  N = D->Case.Interpolation.NbrPoint;
  x = D->Case.Interpolation.x;
  y = D->Case.Interpolation.y;
  xc = D->Case.Interpolation.xc = (double *)Malloc(sizeof(double) * N);
  yc = D->Case.Interpolation.yc = (double *)Malloc(sizeof(double) * N);

  xc[0] = 0.;
  yc[0] = (x[1] * y[1] - x[0] * y[0]) / (x[1] * x[1] - x[0] * x[0]);

  for(i = 1; i < N; i++) {
    xc[i] = 0.5 * (x[i] + x[i - 1]);
    yc[i] =
      (x[i] * y[i] - x[i - 1] * y[i - 1]) / (x[i] * x[i] - x[i - 1] * x[i - 1]);

    /*
    xc[i] = x[i] ;
    yc[i] = (y[i]-y[i-1]) / (x[i]-x[i-1]) ;
    */
  }
}

void Fi_InitAkima(F_ARG)
{
  int i, N;
  double *x, *y, *mi, *bi, *ci, *di, a;
  struct FunctionActive *D;

  D = Fct->Active;
  N = D->Case.Interpolation.NbrPoint;
  x = D->Case.Interpolation.x;
  y = D->Case.Interpolation.y;
  mi = D->Case.Interpolation.mi = (double *)Malloc(sizeof(double) * (N + 4));
  mi += 2;
  bi = D->Case.Interpolation.bi = (double *)Malloc(sizeof(double) * N);
  ci = D->Case.Interpolation.ci = (double *)Malloc(sizeof(double) * N);
  di = D->Case.Interpolation.di = (double *)Malloc(sizeof(double) * N);

  for(i = 0; i < N - 1; i++) mi[i] = (y[i + 1] - y[i]) / (x[i + 1] - x[i]);
  mi[N - 1] = 2. * mi[N - 2] - mi[N - 3];
  mi[N] = 2. * mi[N - 1] - mi[N - 2];
  mi[-1] = 2. * mi[0] - mi[1];
  mi[-2] = 2. * mi[-1] - mi[0];

  for(i = 0; i < N; i++)
    if((a = fabs(mi[i + 1] - mi[i]) + fabs(mi[i - 1] - mi[i - 2])) > 1.e-30)
      bi[i] = (fabs(mi[i + 1] - mi[i]) * mi[i - 1] +
               fabs(mi[i - 1] - mi[i - 2]) * mi[i]) /
              a;
    else
      bi[i] = (mi[i] + mi[i - 1]) / 2.;

  for(i = 0; i < N - 1; i++) {
    a = (x[i + 1] - x[i]);
    ci[i] = (3. * mi[i] - 2. * bi[i] - bi[i + 1]) / a;
    di[i] = (bi[i] + bi[i + 1] - 2. * mi[i]) / (a * a);
  }
}

struct IntDouble {
  int Int;
  double Double;
};
struct IntVector {
  int Int;
  double Double[3];
};

void F_ValueFromIndex(F_ARG)
{
  struct FunctionActive *D;
  struct IntDouble *IntDouble_P;

  if(!Fct->Active) Fi_InitValueFromIndex(Fct, A, V);

  D = Fct->Active;

  if(List_Nbr(D->Case.ValueFromIndex.Table)) {
    IntDouble_P = (struct IntDouble *)List_PQuery(D->Case.ValueFromIndex.Table,
                                                  &Current.NumEntity, fcmp_int);
    if(IntDouble_P) {
      V->Val[0] = IntDouble_P->Double;
      V->Type = SCALAR;
      return;
    }
  }

  Message::Warning("Unknown entity index %d in ValueFromIndex table",
                   Current.NumEntity);
  V->Val[0] = 0.;
  V->Type = SCALAR;
}

void F_VectorFromIndex(F_ARG)
{
  struct FunctionActive *D;
  struct IntVector *IntVector_P;

  if(!Fct->Active) Fi_InitVectorFromIndex(Fct, A, V);

  D = Fct->Active;

  if(List_Nbr(D->Case.ValueFromIndex.Table)) {
    IntVector_P = (struct IntVector *)List_PQuery(D->Case.ValueFromIndex.Table,
                                                  &Current.NumEntity, fcmp_int);
    if(IntVector_P) {
      V->Val[0] = IntVector_P->Double[0];
      V->Val[1] = IntVector_P->Double[1];
      V->Val[2] = IntVector_P->Double[2];
      V->Type = VECTOR;
      return;
    }
  }
  Message::Warning("Unknown entity index %d in VectorFromIndex table",
                   Current.NumEntity);
  V->Val[0] = 0.;
  V->Val[1] = 0.;
  V->Val[2] = 0.;
  V->Type = VECTOR;
}

void Fi_InitValueFromIndex(F_ARG)
{
  int i, N;
  struct IntDouble IntDouble_s;
  struct FunctionActive *D;

  if((Fct->NbrParameters)) {
    N = (int)Fct->Para[0];
    D = Fct->Active =
      (struct FunctionActive *)Malloc(sizeof(struct FunctionActive));
    D->Case.ValueFromIndex.Table =
      List_Create(N + 1, 1, sizeof(struct IntDouble));
    for(i = 0; i < N; i++) {
      IntDouble_s.Int = (int)(Fct->Para[i * 2 + 1] + 0.1);
      IntDouble_s.Double = Fct->Para[i * 2 + 2];
      List_Add(D->Case.ValueFromIndex.Table, &IntDouble_s);
    }
  }
  else {
    D = Fct->Active =
      (struct FunctionActive *)Malloc(sizeof(struct FunctionActive));
    D->Case.ValueFromIndex.Table = NULL;
  }
}

void Fi_InitVectorFromIndex(F_ARG)
{
  int i, N;
  struct IntVector IntVector_s;
  struct FunctionActive *D;

  if((Fct->NbrParameters)) {
    N = (int)Fct->Para[0];
    D = Fct->Active =
      (struct FunctionActive *)Malloc(sizeof(struct FunctionActive));
    D->Case.ValueFromIndex.Table =
      List_Create(N, 1, sizeof(struct IntVector[3]));
    for(i = 0; i < N; i++) {
      IntVector_s.Int = (int)(Fct->Para[i * 4 + 1] + 0.1);
      IntVector_s.Double[0] = Fct->Para[i * 4 + 2];
      IntVector_s.Double[1] = Fct->Para[i * 4 + 3];
      IntVector_s.Double[2] = Fct->Para[i * 4 + 4];
      List_Add(D->Case.ValueFromIndex.Table, &IntVector_s);
    }
  }
  else {
    D = Fct->Active =
      (struct FunctionActive *)Malloc(sizeof(struct FunctionActive));
    D->Case.ValueFromIndex.Table = NULL;
  }
}
