/*******************************************************************************
 * ALBERTA:  an Adaptive multi Level finite element toolbox using
 *           Bisectioning refinement and Error control by Residual
 *           Techniques for scientific Applications
 *
 * file:     parametric_intern.h
 *
 * description: Some support functions shared between parametric_{1,2,3}d.c
 *
 *******************************************************************************
 *
 *  authors:   Claus-Justus Heine
 *             Abteilung fuer Angewandte Mathematik
 *             Albert-Ludwigs-Universitaet Freiburg
 *             Hermann-Herder-Str. 10
 *             D-79104 Freiburg im Breisgau, Germany
 *
 *  http://www.alberta-fem.de
 *
 *  (c) by C.-J. Heine (2009).
 *
 ******************************************************************************/

/* This file is multiply included by purpose. */

#ifndef MESH_DIM
# error MESH_DIM must be defined before including this file
#endif

/* PN() generates a ParametricName, by attaching a _3d suffix to NAME,
 * PUN() generate a ParametricUpcaseName, by attaching a _3D suffix to
 * NAME.
 */
#define PN(name)  CPP_CONCAT4(name, _, MESH_DIM, d)
#define PUN(name) CPP_CONCAT4(name, _, MESH_DIM, D)

/* In "DD" we store the partial derivative of the basis functions at
 * the quadrature points w.r.t. \lambda_1, \lambda_2 and \lamdba_3,
 * i.e. we parameterise the simplex (tetrahedron) with \lambda_1,
 * \lambda_2 and \lambda_3
 *
 * dDD is for the second derivatives.
 *
 * ddDD is for the third derivatives, needed to provide the 2nd
 * derivatives of the normal field for higher order parameterisations
 * (vector valued basis functions).
 *
 * wall_DD is for co-dimension 1 quadratures.
 */
typedef struct PN(DD_data)
{
  int  n_bas_fcts;
  REAL (*DD)[N_BAS_MAX][MESH_DIM];
  REAL (*dDD)[N_BAS_MAX][MESH_DIM][MESH_DIM];
#if MESH_DIM == 1
  REAL wall_DD[N_BAS_MAX];
#else
  REAL (*wall_DD)[N_BAS_MAX][MESH_DIM];
  REAL (*wall_dDD)[N_BAS_MAX][MESH_DIM][MESH_DIM];
  REAL (*wall_ddDD)[N_BAS_MAX][MESH_DIM][MESH_DIM][MESH_DIM];
#endif
} PUN(DD_DATA);

/* In the presence of INIT_ELEMENT() methods we might need to
 * re-initialize the stuff on a per-element basis. Provide the
 * necessary data.
 */
typedef struct PN(param_quad_metadata)
{
  const QUAD_FAST *quad_fast;
  INIT_EL_TAG     current_qfast_tag;
  INIT_EL_TAG     current_wall_qfast_tag;
  PUN(DD_DATA)    DD_data[2]; /* default/non-default */
} PUN(PARAM_QUAD_METADATA);

typedef REAL          PUN(REAL_D)[MESH_DIM];
typedef PUN(REAL_D)   PUN(REAL_DD)[MESH_DIM];
typedef PUN(REAL_DD)  PUN(REAL_DDD)[MESH_DIM];
typedef PUN(REAL_DDD) PUN(REAL_DDDD)[MESH_DIM];

/* Compute the determinant of a MESH_DIM square matrix */
static inline
REAL PN(par_det)(const PUN(REAL_DD) DtD)
{
#if MESH_DIM == 3
  return 
    + DtD[0][0]*DtD[1][1]*DtD[2][2]
    + DtD[0][1]*DtD[1][2]*DtD[2][0]
    + DtD[0][2]*DtD[1][0]*DtD[2][1]
    - DtD[0][2]*DtD[1][1]*DtD[2][0]
    - DtD[0][1]*DtD[1][0]*DtD[2][2]
    - DtD[0][0]*DtD[1][2]*DtD[2][1];
#elif MESH_DIM == 2
  return DtD[0][0] * DtD[1][1] - DtD[0][1]*DtD[1][0];
#elif MESH_DIM == 1
  return DtD[0][0];
#endif
}

/* Compute the inverse of a MESH_DIM spd matrix */
static inline
void PN(par_syminv)(PUN(REAL_DD) invA, const PUN(REAL_DD) A, REAL det)
{
  REAL det_1 = 1.0 / det;
#if MESH_DIM == 3
  invA[0][0] = ( A[1][1]*A[2][2] - A[1][2]*A[2][1])*det_1;
  invA[1][0] = (-A[0][1]*A[2][2] + A[0][2]*A[2][1])*det_1;
  invA[2][0] = ( A[0][1]*A[1][2] - A[0][2]*A[1][1])*det_1;
  invA[1][1] = ( A[0][0]*A[2][2] - A[0][2]*A[2][0])*det_1;
  invA[2][1] = (-A[0][0]*A[1][2] + A[0][2]*A[1][0])*det_1;
  invA[2][2] = ( A[0][0]*A[1][1] - A[0][1]*A[1][0])*det_1;

  invA[0][1] = invA[1][0];
  invA[0][2] = invA[2][0];
  invA[1][2] = invA[2][1];
#elif MESH_DIM == 2
  invA[0][0] = det_1*A[1][1];
  invA[1][1] = det_1*A[0][0];
  invA[0][1] = invA[1][0] = -det_1*A[0][1];  
#elif MESH_DIM == 1
  invA[0][0] = det_1;
#endif
}

/* A = B * C */
static inline
REAL PN(par_scp)(const PUN(REAL_D) v, const PUN(REAL_D) w)
{
  int alpha;
  REAL res = 0.0;
  
  for (alpha = 0; alpha < MESH_DIM; alpha++) {
    res += v[alpha] * w[alpha];
  } 
  return res;
}

static inline
void PN(DD)(PUN(REAL_D) DD, const REAL_B grd, int o)
{
  int alpha, a;
  for (alpha = 0; alpha < MESH_DIM; alpha++) {
    a = (o + 1 + alpha) % N_LAMBDA(MESH_DIM);
    DD[alpha] = grd[a] - grd[o];
  }
}

static inline
void PN(dDD)(PUN(REAL_DD) dDD, const REAL_BB D2, int o)
{
  int alpha, beta, a, b;
  for (alpha = 0; alpha < MESH_DIM; alpha++) {
    a = (o + 1 + alpha) % N_LAMBDA(MESH_DIM);
    dDD[alpha][alpha] = D2[a][a] - 2.0*D2[o][a] + D2[o][o];
    for (beta = alpha+1; beta < MESH_DIM; beta++) {
      b = (o + 1 + beta) % N_LAMBDA(MESH_DIM);
      dDD[alpha][beta] =
	dDD[beta][alpha] = D2[a][b] - D2[o][a] - D2[o][b] + D2[o][o];
    }
  }
}

#if MESH_DIM > 1
static inline
void PN(ddDD)(PUN(REAL_DDD) ddDD, const REAL_BBB D3, int o)
{
  int alpha, beta, gamma, a, b, c;
  for (alpha = 0; alpha < MESH_DIM; alpha++) {
    a = (o + 1 + alpha) % N_LAMBDA(MESH_DIM);
    ddDD[alpha][alpha][alpha] =
      D3[a][a][a] - 3.0*D3[o][a][a] + 3.0*D3[o][o][a] - D3[o][o][o];
    for (beta = alpha+1; beta < MESH_DIM; beta++) {
      b = (o + 1 + beta) % N_LAMBDA(MESH_DIM);
      ddDD[alpha][beta][beta] =
	ddDD[beta][alpha][beta] =
	ddDD[beta][beta][alpha] =
	(D3[a][b][b]
	 - D3[o][b][b] - 2.0*D3[o][a][b] + 2.0*D3[o][o][b] + D3[o][o][a]
	 - D3[o][o][o]);
      ddDD[alpha][alpha][beta] =
	ddDD[alpha][beta][alpha] =
	ddDD[beta][alpha][alpha] =
	(D3[a][a][b]
	 - D3[o][a][a] - 2.0*D3[o][a][b] + 2.0*D3[o][o][a] + D3[o][o][b]
	 - D3[o][o][o]);
      for (gamma = beta+1; gamma < MESH_DIM; gamma++) {
	c = (o + 1 + gamma) % N_LAMBDA(MESH_DIM);
	ddDD[alpha][beta][gamma] =
	  ddDD[beta][alpha][gamma] =
	  ddDD[gamma][beta][alpha] =
	  ddDD[alpha][gamma][beta] =
	  ddDD[gamma][alpha][beta] =
	  ddDD[beta][gamma][alpha] =
	  (D3[a][b][c]
	   - D3[o][a][b] - D3[o][a][c] - D3[o][b][c]
	   + D3[o][o][a] + D3[o][o][b] + D3[o][o][c]
	   - D3[o][o][o]);
      }
    }
  }
}
#endif

/* Compute the first and seconds derivatives of the basis functions
 * w.r.t. to the co-ordinates system
 *
 * {\lambda_1, \lambda_2, \lambda_3}
 *
 * So vertex 0 is taken as origin.
 */
static inline
void PN(compute_DD_and_dDD)(PUN(DD_DATA) *data, const QUAD_FAST *quad_fast)
{
  const BAS_FCTS *bas_fcts = quad_fast->bas_fcts;
  int            iq, i;

  for (iq = 0; iq < quad_fast->quad->n_points; iq++) {
    for (i = 0; i < bas_fcts->n_bas_fcts; i++) {
      PN(DD)(data->DD[iq][i], quad_fast->grd_phi[iq][i], 0);
      PN(dDD)(data->dDD[iq][i], quad_fast->D2_phi[iq][i], 0);
    }
  }
#if 0
  if (bas_fcts->degree > 2) {
    for (iq = 0; iq < quad_fast->quad->n_points; iq++) {
      for (i = 0; i < bas_fcts->n_bas_fcts; i++) {
	PN(ddDD)(data->ddDD[iq][i], quad_fast->D3_phi[iq][i], 0);
      }
    }
  }
#endif
}

#if MESH_DIM > 1
/* Compute the first and second derivatives of the basis functions
 * with respect to the co-ordinate system
 *
 * {\lambda_i1, \lambda_i2, \lambda_i3}
 *
 * where ik = (wall + k) & N_VERTICES_2D. So vertex number WALL is the
 * origin of the co-ordinate system.
 */
static void PN(compute_wall_DD_dDD_ddDD)(PUN(DD_DATA) *data,
					 int wall,
					 const QUAD_FAST *quad_fast)
{
  const BAS_FCTS *bas_fcts = quad_fast->bas_fcts;
  int            iq, i;

  for (iq = 0; iq < quad_fast->quad->n_points; iq++) {
    for (i = 0; i < bas_fcts->n_bas_fcts; i++) {
      PN(DD)(data->wall_DD[iq][i], quad_fast->grd_phi[iq][i], wall);
      PN(dDD)(data->wall_dDD[iq][i], quad_fast->D2_phi[iq][i], wall);
    }
  }
  if (bas_fcts->degree > 2) {
    for (iq = 0; iq < quad_fast->quad->n_points; iq++) {
      for (i = 0; i < bas_fcts->n_bas_fcts; i++) {
	PN(ddDD)(data->wall_ddDD[iq][i], quad_fast->D3_phi[iq][i], wall);
      }
    }
  }
}
#endif

static void PN(delete_param_quad_metadata)(void *vmd);
#if MESH_DIM == 1
static inline
void compute_wall_DD_1d(DD_DATA_1D *data, int wall, const QUAD_FAST *quad_fast);
#endif

static void PN(alloc_param_quad_metadata)(const QUAD *quad,
					  const BAS_FCTS *bas_fcts)
{
  QUAD_METADATA            *qmd  = (QUAD_METADATA *)quad->metadata;
  PUN(PARAM_QUAD_METADATA) *metadata;
  PUN(DD_DATA)             *data;
  FLAGS                    qf_flags;

  /* generate new meta-data */
  qmd->param_data[bas_fcts->degree] =
    (void *)(metadata = MEM_CALLOC(1, PUN(PARAM_QUAD_METADATA)));
  qmd->delete_param_data = PN(delete_param_quad_metadata);

  qf_flags = INIT_PHI|INIT_GRD_PHI|INIT_D2_PHI;
  if (bas_fcts->degree >= 3) {
    qf_flags = INIT_PHI|INIT_GRD_PHI|INIT_D2_PHI|INIT_D3_PHI;
  }
  metadata->quad_fast = get_quad_fast(bas_fcts, quad, qf_flags);

  /* Storage and values for default case */
  data = &metadata->DD_data[0];
  data->n_bas_fcts = bas_fcts->n_bas_fcts;
  data->DD = (REAL (*)[N_BAS_MAX][MESH_DIM])
    MEM_ALLOC(quad->n_points*sizeof(REAL [N_BAS_MAX][MESH_DIM]), char);
  data->dDD = (REAL (*)[N_BAS_MAX][MESH_DIM][MESH_DIM])
    MEM_ALLOC(quad->n_points
	      *
	      sizeof(REAL [N_BAS_MAX][MESH_DIM][MESH_DIM]), char);
  PN(compute_DD_and_dDD)(data, metadata->quad_fast);
  metadata->current_qfast_tag = INIT_EL_TAG_DFLT;

  if (quad->codim == 1) { /* also allocate stuff for integration over faces */
#if MESH_DIM == 1
    compute_wall_DD_1d(data, quad->subsplx, metadata->quad_fast);
#else
    data->wall_DD = (REAL (*)[N_BAS_MAX][MESH_DIM])
      MEM_ALLOC(quad->n_points*sizeof(REAL [N_BAS_MAX][MESH_DIM]), char);
    data->wall_dDD = (REAL (*)[N_BAS_MAX][MESH_DIM][MESH_DIM])
      MEM_ALLOC(quad->n_points
		*
		sizeof(REAL [N_BAS_MAX][MESH_DIM][MESH_DIM]), char);
    data->wall_ddDD = (REAL (*)[N_BAS_MAX][MESH_DIM][MESH_DIM][MESH_DIM])
      MEM_ALLOC(quad->n_points
		*
		sizeof(REAL [N_BAS_MAX][MESH_DIM][MESH_DIM][MESH_DIM]), char);
    PN(compute_wall_DD_dDD_ddDD)(data, quad->subsplx, metadata->quad_fast);
#endif
    metadata->current_wall_qfast_tag = INIT_EL_TAG_DFLT;
  }

  if (!INIT_ELEMENT_NEEDED(quad)) {
    return;
  }

  /* allocate storage for non-default case, then call us again to
   * possibly recompute the stuff.
   */
  data = &metadata->DD_data[1];
  data->n_bas_fcts = bas_fcts->n_bas_fcts;
  data->DD = (REAL (*)[N_BAS_MAX][MESH_DIM])
    MEM_ALLOC(quad->n_points_max*sizeof(REAL [N_BAS_MAX][MESH_DIM]), char);
  data->dDD = (REAL (*)[N_BAS_MAX][MESH_DIM][MESH_DIM])
    MEM_ALLOC(quad->n_points_max
	      *
	      sizeof(REAL [N_BAS_MAX][MESH_DIM][MESH_DIM]), char);

  metadata->current_qfast_tag = INIT_EL_TAG_NONE;

  if (quad->codim == 1) { /* also allocate stuff for integration over faces */
#if MESH_DIM > 1
    data->wall_DD  =(REAL (*)[N_BAS_MAX][MESH_DIM])
      MEM_ALLOC(quad->n_points_max*sizeof(REAL [N_BAS_MAX][MESH_DIM]), char);
    data->wall_dDD = (REAL (*)[N_BAS_MAX][MESH_DIM][MESH_DIM])
      MEM_ALLOC(quad->n_points_max
		*
		sizeof(REAL [N_BAS_MAX][MESH_DIM][MESH_DIM]), char);
    data->wall_ddDD = (REAL (*)[N_BAS_MAX][MESH_DIM][MESH_DIM][MESH_DIM])
      MEM_ALLOC(quad->n_points_max
		*
		sizeof(REAL [N_BAS_MAX][MESH_DIM][MESH_DIM][MESH_DIM]), char);
#endif
    metadata->current_wall_qfast_tag = INIT_EL_TAG_NONE;
  }
}

static void PN(delete_param_quad_metadata)(void *vmd)
{
  PUN(PARAM_QUAD_METADATA) *metadata = (PUN(PARAM_QUAD_METADATA) *)vmd;
  PUN(DD_DATA)             *data;
  const QUAD               *quad;
  
  if (metadata == NULL) {
    return;
  }
  
  quad     = metadata->quad_fast->quad;
  INIT_OBJECT(metadata->quad_fast);

  data     = &metadata->DD_data[0];

  MEM_FREE(data->DD,
	   quad->n_points * sizeof(REAL [N_BAS_MAX][MESH_DIM]), char);
  MEM_FREE(data->dDD,
	   quad->n_points * sizeof(REAL [N_BAS_MAX][MESH_DIM][MESH_DIM]), char);
#if MESH_DIM > 1
  if (quad->codim == 1) {
    MEM_FREE(data->wall_DD,
	     quad->n_points*sizeof(REAL [N_BAS_MAX][MESH_DIM]), char);
    MEM_FREE(data->wall_dDD,
	     quad->n_points
	     * sizeof(REAL [N_BAS_MAX][MESH_DIM][MESH_DIM]), char);
    MEM_FREE(data->wall_ddDD,
	     quad->n_points
	     * sizeof(REAL [N_BAS_MAX][MESH_DIM][MESH_DIM][MESH_DIM]), char);
  }
#endif

  if (INIT_ELEMENT_NEEDED(quad)) {

    data = &metadata->DD_data[1];

    MEM_FREE(data->DD,
	     quad->n_points_max * sizeof(REAL [N_BAS_MAX][MESH_DIM]), char);
    MEM_FREE(data->dDD,
	     quad->n_points_max * sizeof(REAL [N_BAS_MAX][MESH_DIM][MESH_DIM]),
	     char);
#if MESH_DIM > 1
    if (quad->codim == 1) {
      MEM_FREE(data->wall_DD,
	       quad->n_points_max*sizeof(REAL [N_BAS_MAX][MESH_DIM]), char);
      MEM_FREE(data->wall_dDD,
	       quad->n_points_max*sizeof(REAL [N_BAS_MAX][MESH_DIM][MESH_DIM]),
	       char);
      MEM_FREE(data->wall_ddDD,
	       quad->n_points
	       *
	       sizeof(REAL [N_BAS_MAX][MESH_DIM][MESH_DIM][MESH_DIM]), char);
    }
#endif
  }
  
  MEM_FREE(metadata, 1, PUN(PARAM_QUAD_METADATA));
}

static PUN(DD_DATA) *PN(init_dd_data)(const EL_INFO *el_info,
				      const QUAD *quad, const BAS_FCTS *bas_fcts)
{
  FUNCNAME("init_dd_data_3d");
  QUAD_METADATA          *qmd  = (QUAD_METADATA *)quad->metadata;
  PUN(PARAM_QUAD_METADATA) *metadata;
  PUN(DD_DATA)             *data;
  INIT_EL_TAG            tag;

  DEBUG_TEST_EXIT(bas_fcts->n_bas_fcts <= N_BAS_MAX,
		  "Sorry, only up to %d local DOFs at the moment.\n",
		  N_BAS_MAX);

  DEBUG_TEST_EXIT(quad->dim == MESH_DIM, "Non-matching dimensions.\n");

  DEBUG_TEST_EXIT(bas_fcts->n_bas_fcts
		  ==
		  N_BAS_LAGRANGE(bas_fcts->degree, MESH_DIM),
		  "Are these Lagrange basis functions of degree %d "
		  "for dimension %d?\n",
		  bas_fcts->degree, MESH_DIM);

  metadata = (PUN(PARAM_QUAD_METADATA) *)qmd->param_data[bas_fcts->degree];
  if (metadata != NULL) {
    if (!INIT_ELEMENT_NEEDED(quad)) { /* fast path */
      return &metadata->DD_data[0];
    }
    
    /* slow path */
    tag = INIT_ELEMENT(el_info, metadata->quad_fast);
    
    data = &metadata->DD_data[tag == INIT_EL_TAG_DFLT];
    if (tag == metadata->current_qfast_tag) {
      return data;
    }

    metadata->current_qfast_tag = tag;
    
    if (tag == INIT_EL_TAG_DFLT) {
      return data;
    }
    
    /* need to recompute the stuff */
    PN(compute_DD_and_dDD)(data, metadata->quad_fast);

    return data;
  }

  PN(alloc_param_quad_metadata)(quad, bas_fcts);

  /* call us again, the INIT_EL_TAG_NONE will trigger re-computation
   * of the DD stuff if necessary.
   */
  return PN(init_dd_data)(el_info, quad, bas_fcts);
}

static PUN(DD_DATA) *PN(init_wall_dd_data)(const EL_INFO *el_info,
					   const QUAD *quad,
					   const BAS_FCTS *bas_fcts)
{
  QUAD_METADATA            *qmd  = (QUAD_METADATA *)quad->metadata;
  PUN(PARAM_QUAD_METADATA) *metadata;
  PUN(DD_DATA)             *data;
  INIT_EL_TAG              tag;

  DEBUG_TEST_EXIT(bas_fcts->n_bas_fcts <= N_BAS_MAX,
		  "Sorry, only up to %d local DOFs at the moment.\n",
		  N_BAS_MAX);

  DEBUG_TEST_EXIT(quad->dim == MESH_DIM, "Non-matching dimensions.\n");

  DEBUG_TEST_EXIT(quad->codim == 1, "Co-dimension must be 1.\n");

  DEBUG_TEST_EXIT(bas_fcts->n_bas_fcts
		  ==
		  N_BAS_LAGRANGE(bas_fcts->degree, MESH_DIM),
		  "Are these Lagrange basis functions of degree %d "
		  "for dimension %d?\n",
		  bas_fcts->degree, MESH_DIM);

  metadata = (PUN(PARAM_QUAD_METADATA) *)qmd->param_data[bas_fcts->degree];
  if (metadata != NULL) {

    if (!INIT_ELEMENT_NEEDED(quad)) { /* fast path */
      return &metadata->DD_data[0];
    }
    
    /* slow path */
    tag = INIT_ELEMENT(el_info, metadata->quad_fast);
    
    data = &metadata->DD_data[tag == INIT_EL_TAG_DFLT];
    if (tag == metadata->current_qfast_tag) {
      return data;
    }

    metadata->current_qfast_tag = tag;
    
    if (tag == INIT_EL_TAG_DFLT) {
      return data;
    }
    
    /* need to recompute the stuff */
#if MESH_DIM == 1
    compute_wall_DD_1d(data, quad->subsplx, metadata->quad_fast);
#else
    PN(compute_wall_DD_dDD_ddDD)(data, quad->subsplx, metadata->quad_fast);
#endif
    
    return data;
  }

  /* generate new meta-data */
  PN(alloc_param_quad_metadata)(quad, bas_fcts);
  
  /* call us again, the INIT_EL_TAG_NONE will trigger re-computation
   * of the DD stuff if necessary.
   */
  return PN(init_wall_dd_data)(el_info, quad, bas_fcts);  
}

/*--------------------------------------------------------------------------*/
/*---  compute D^t and D^t D, return det(D^t D)                          ---*/
/*--------------------------------------------------------------------------*/

/* "D" means just the Jacobian of the coordinates w.r.t. \lambda_i, i
 * = 1,2,3. DtD is the metric tensor (\lambda_0 is the origin of the
 * affine co-ordinate system).
 *
 * F gives the mapping from the reference element; it holds the nodal
 * values for each basis function.
 *
 * The return value is the determinant of the metric tensor.
 */
static inline REAL PN(Dt_and_DtD)(REAL_D F[], REAL DD[][MESH_DIM], int n_bas,
				  REAL_D Dt[MESH_DIM],
				  REAL DtD[MESH_DIM][MESH_DIM])
{
  FUNCNAME("Dt_and_DtD_"CPP_STRINGIZE(MESH_DIM)"d");
  int   i, j, n, m;
  REAL  val;

  for (m = 0; m < MESH_DIM; m++) {
    for (n = 0; n < DIM_OF_WORLD; n++) {
      for (Dt[m][n] = i = 0; i < n_bas; i++) {
	Dt[m][n] += F[i][n]*DD[i][m];
      }
    }
  }

  for (i = 0; i < MESH_DIM; i++) {
    DtD[i][i] = NRM2_DOW(Dt[i]);
    for (j = i+1; j < MESH_DIM; j++) {
      DtD[i][j] = DtD[j][i] = SCP_DOW(Dt[i], Dt[j]);
    }
  }

  val = PN(par_det)((const PUN(REAL_D) *)DtD);

  if (val < 0.0) {
    WARNING("val = %e\n", val);
    for (i = 0; i < n_bas; i++)
      PRINT_REAL_VEC("F", F[i], DIM_OF_WORLD);
    WAIT_REALLY;
  }

  return val;
}

/* F[]: coefficient vector for the given Lagrange basis functions.
 *      So it is some local vector valued finite element function.
 * 
 * dDD: second barycentric derivatives for each basis function.
 *
 * Dt:  Jacobian of F (if F is a parameterization, then Dt is the basis
 *      of the tangent space at the given quadrature point).
 *
 * n_bas: you guess what ...
 *
 * dDt: second derivatives of F, i.e. the Hessian of F.
 *
 * dDtD: derivatives of Dt\cdot Dt. If F is a parameterization, then
 *      these are the derivatives of the metric tensor w.r.t. to the
 *      barycentric co-ordinates.
 *
 * This function computes the derivatives w.r.t. to the co-ordinate
 * system with vertex 0 as origin, paramaterized by \lambda_1,
 * \lambda_2, \lambda_DIM (or a permutation if computing data for
 * integration over walls).
 */
static inline void PN(dDt_and_dDtD)(REAL_D F[],
				    REAL dDD[][MESH_DIM][MESH_DIM],
				    REAL_D Dt[MESH_DIM],
				    int n_bas,
				    REAL_D dDt[MESH_DIM][MESH_DIM],
				    REAL dDtD[MESH_DIM][MESH_DIM][MESH_DIM])
{
  int i;
  int alpha, beta, gamma;
  
  for (alpha = 0; alpha < MESH_DIM; alpha++) {
    AXEY_DOW(dDD[0][alpha][alpha], F[0], dDt[alpha][alpha]);
    for (i = 1; i < n_bas; i++) {
      AXPY_DOW(dDD[i][alpha][alpha], F[i], dDt[alpha][alpha]);
    }
    for (beta = alpha+1; beta < MESH_DIM; beta++) {
      AXEY_DOW(dDD[0][alpha][beta], F[0], dDt[alpha][beta]);
      for (i = 1; i < n_bas; i++) {
	AXPY_DOW(dDD[i][alpha][beta], F[i], dDt[alpha][beta]);
      }
      COPY_DOW(dDt[alpha][beta], dDt[beta][alpha]);
    }
  }

  for (alpha = 0; alpha < MESH_DIM; alpha++) {
    for (beta = 0; beta < MESH_DIM; beta++) {
      dDtD[alpha][beta][beta] = 2.0*SCP_DOW(dDt[alpha][beta], Dt[beta]);
      for (gamma = beta+1; gamma < MESH_DIM; gamma++) {
	dDtD[alpha][beta][gamma] = (SCP_DOW(dDt[alpha][beta], Dt[gamma])
				    +
				    SCP_DOW(dDt[alpha][gamma], Dt[beta]));
	dDtD[alpha][gamma][beta] = dDtD[alpha][beta][gamma];
      }
    }
  }
}

#if MESH_DIM > 1
/* F, ddDD, Dt, dDt, dDtD have to be provided; we compute ddDt and
 * ddDtD.
 *
 * ddDt is totally symmetric; ddDtD is symmetric in its index pairs.
 */
static inline
void PN(ddDt_and_ddDtD)(REAL_D F[],
			REAL ddDD[][MESH_DIM][MESH_DIM][MESH_DIM],
			REAL_D Dt[MESH_DIM],
			REAL_D dDt[MESH_DIM][MESH_DIM],
			PUN(REAL_DDD) dDtD,
			int n_bas,
			REAL_D ddDt[MESH_DIM][MESH_DIM][MESH_DIM],
			PUN(REAL_DDDD) ddDtD)
{
  int i, alpha, beta, gamma, delta;
  
  memset(ddDt, 0, MESH_DIM*MESH_DIM*MESH_DIM*sizeof(REAL_D));
  for (alpha = 0; alpha < MESH_DIM; alpha++) {
    for (i = 0; i < n_bas; i++) {
      AXPY_DOW(ddDD[i][alpha][alpha][alpha], F[i], ddDt[alpha][alpha][alpha]);
    }
    for (beta = alpha+1; beta < MESH_DIM; beta++) {
      for (i = 0; i < n_bas; i++) {
	AXPY_DOW(ddDD[i][alpha][alpha][beta], F[i], ddDt[alpha][alpha][beta]);
      }
      COPY_DOW(ddDt[alpha][alpha][beta], ddDt[alpha][beta][alpha]);
      COPY_DOW(ddDt[alpha][alpha][beta], ddDt[beta][alpha][alpha]);
      for (i = 0; i < n_bas; i++) {
	AXPY_DOW(ddDD[i][alpha][beta][beta], F[i], ddDt[alpha][beta][beta]);
      }
      COPY_DOW(ddDt[alpha][beta][beta], ddDt[beta][alpha][beta]);
      COPY_DOW(ddDt[alpha][beta][beta], ddDt[beta][beta][alpha]);
      for (gamma = beta+1; gamma < MESH_DIM; gamma++) {
	for (i = 0; i < n_bas; i++) {
	  AXPY_DOW(ddDD[i][alpha][beta][gamma], F[i], ddDt[alpha][beta][gamma]);
	}
	/* S_3 ... */
	COPY_DOW(ddDt[alpha][beta][gamma], ddDt[beta][alpha][gamma]);
	COPY_DOW(ddDt[alpha][beta][gamma], ddDt[gamma][beta][alpha]);
	COPY_DOW(ddDt[alpha][beta][gamma], ddDt[alpha][gamma][beta]);
	COPY_DOW(ddDt[alpha][beta][gamma], ddDt[beta][gamma][alpha]);
	COPY_DOW(ddDt[alpha][beta][gamma], ddDt[gamma][alpha][beta]);
      }
    }
  }

  /* Now for the second derivatives of the metric tensor ...
   *
   * We could exploit more of the symmetry of the g, but I'm just too
   * lazy right now.
   */
  memset(ddDtD, 0, MESH_DIM*MESH_DIM*MESH_DIM*MESH_DIM*sizeof(REAL));
  for (alpha = 0; alpha < MESH_DIM; alpha++) {
    for (gamma = 0; gamma < MESH_DIM; gamma++) {
      for (i = 0; i < n_bas; i++) {
	/* differentiate g_{\gamma\gamma} w.r.t. alpha-alpha */
	ddDtD[alpha][alpha][gamma][gamma] +=
	  2.0 * SCP_DOW(dDt[alpha][gamma], dDt[alpha][gamma])
	  +
	  2.0 * SCP_DOW(Dt[gamma], ddDt[alpha][alpha][gamma]);
      }
      for (delta = gamma+1; delta < MESH_DIM; delta++) {
	/* differentiate g_{\gamma\delta} w.r.t. alpha-alpha */
	for (i = 0; i < n_bas; i++) {
	  ddDtD[alpha][alpha][gamma][delta] +=
	    2.0 * SCP_DOW(dDt[alpha][gamma], dDt[alpha][delta])
	    +
	    SCP_DOW(Dt[gamma], ddDt[alpha][alpha][delta])
	    +
	    SCP_DOW(Dt[delta], ddDt[alpha][alpha][gamma]);
	}
	ddDtD[alpha][alpha][delta][gamma] = ddDtD[alpha][alpha][gamma][delta];
      }
    }
    for (beta = alpha+1; beta < MESH_DIM; beta++) {
      for (gamma = 0; gamma < MESH_DIM; gamma++) {
	/* differentiate g_{\gamma\gamma} w.r.t. alpha-beta */
	for (i = 0; i < n_bas; i++) {
	  ddDtD[alpha][beta][gamma][gamma] +=
	    2.0 * SCP_DOW(dDt[alpha][gamma], dDt[beta][gamma])
	    +
	    2.0 * SCP_DOW(Dt[gamma], ddDt[alpha][beta][gamma]);
	}
	for (delta = gamma+1; delta < MESH_DIM; delta++) {
	  /* differentiate g_{\gamma\delta} w.r.t. alpha-beta */
	  for (i = 0; i < n_bas; i++) {
	    ddDtD[alpha][beta][gamma][delta] +=
	      SCP_DOW(dDt[alpha][gamma], dDt[beta][delta])
	      +
	      SCP_DOW(dDt[beta][gamma], dDt[alpha][delta])
	      +
	      SCP_DOW(Dt[gamma], ddDt[alpha][beta][delta])
	      +
	      SCP_DOW(Dt[delta], ddDt[beta][alpha][gamma]);
	  }
	  ddDtD[alpha][beta][delta][gamma] = ddDtD[beta][alpha][gamma][delta] =
	    ddDtD[alpha][beta][gamma][delta];
	}
      }
    }
  }
}
#endif

/* The bizarre "mixed" array types are such that grd_Xtr[alpha]
 * defines a direction, a vector field on the given element.
 *
 * Then D2_Xtr[alpha] is the proper Jacobian of that vector-field and
 * D3_Xtr[alpha] is the proper Hessian.
 */
static void
PN(grd_worldY)(const EL_INFO *el_info, const QUAD *quad,
	       int N, const REAL_B lambda[],
	       REAL_BD grd_Xtr[], REAL_BDB D2_Xtr[], REAL_BDBB D3_Xtr[])
{
#if 0
  FUNCNAME("grd_worldY_"CPP_STIRNGIZE(MESH_DIM)"d");
#endif
  int                 iq, bf, alpha, beta, gamma, i;
  const BAS_FCTS      *bas_fcts;
  LAGRANGE_PARAM_DATA *data = 
    ((LAGRANGE_PARAM_DATA *)el_info->mesh->parametric->data);
  REAL_D              *local_coords = data->local_coords;

  /* First of all, check if we are on a parametric simplex.            */
  /* If not, treat this simplex as an affine simplex, even though some */
  /* higher order vertices might be shifted.                           */
  if (data->i_am_affine) {
    PN(grd_world1)(el_info, quad, N, lambda, grd_Xtr, D2_Xtr, D3_Xtr);
    return;
  }

  bas_fcts = data->coords->fe_space->bas_fcts;

  if (quad) {
    N = quad->n_points;
  }

  if (D2_Xtr && bas_fcts->degree < 2) {
    memset(D2_Xtr, 0, N*sizeof(D2_Xtr[0]));
    D2_Xtr = NULL;
  }
  if (D3_Xtr && bas_fcts->degree < 3) {
    memset(D3_Xtr, 0, N*sizeof(D3_Xtr[0]));
    D3_Xtr = NULL;
  }

  if (quad) {
    QUAD_METADATA            *qmd  = (QUAD_METADATA *)quad->metadata;
    PUN(PARAM_QUAD_METADATA) *metadata;
    const QUAD_FAST *qfast;

    PN(init_dd_data)(el_info, quad, bas_fcts);
    metadata = (PUN(PARAM_QUAD_METADATA) *)qmd->param_data[bas_fcts->degree];
    qfast = metadata->quad_fast;

    for (iq = 0; iq < N; iq++) {
      for (alpha = 0; alpha < N_LAMBDA_MAX; alpha++) {
	SET_DOW(0.0, grd_Xtr[iq][alpha]);
	if (alpha < N_LAMBDA(MESH_DIM)) {
	  for (bf = 0; bf < bas_fcts->n_bas_fcts; bf++) {
	    const REAL *grd_phi = qfast->grd_phi[iq][bf];
	    AXPY_DOW(grd_phi[alpha], local_coords[bf], grd_Xtr[iq][alpha]);
	  }
	}
      }
    }

    if (D2_Xtr) {
      memset(D2_Xtr, 0, N * sizeof(D2_Xtr[0]));
      for (iq = 0; iq < N; iq++) {
	for (bf = 0; bf < bas_fcts->n_bas_fcts; bf++) {
	  const REAL_B *D2_phi = qfast->D2_phi[iq][bf];
	  for (alpha = 0; alpha < N_LAMBDA(MESH_DIM); alpha++) {
	    for (i = 0; i < DIM_OF_WORLD; i++) {
	      D2_Xtr[iq][alpha][i][alpha] +=
		D2_phi[alpha][alpha] * local_coords[bf][i];
	    }
	    for (beta = alpha+1; beta < N_LAMBDA(MESH_DIM); beta++) {
	      for (i = 0; i < DIM_OF_WORLD; i++) {
		D2_Xtr[iq][alpha][i][beta] +=
		  D2_phi[alpha][beta] * local_coords[bf][i];
	      }
	    }
	  }
	}
	for (alpha = 0; alpha < N_LAMBDA(MESH_DIM); alpha++) {
	  for (beta = 0; beta < alpha; beta++) {
	    for (i = 0; i < DIM_OF_WORLD; i++) {
	      D2_Xtr[iq][alpha][i][beta] = D2_Xtr[iq][beta][i][alpha];
	    }
	  }
	}
      }
    }

    if (D3_Xtr) {
      memset(D3_Xtr, 0, N * sizeof(D3_Xtr[0]));
      for (iq = 0; iq < N; iq++) {
	for (bf = 0; bf < bas_fcts->n_bas_fcts; bf++) {
	  const REAL_BB *D3_phi = qfast->D3_phi[iq][bf];
	  for (alpha = 0; alpha < N_LAMBDA(MESH_DIM); alpha++) {
	    for (i = 0; i < DIM_OF_WORLD; i++) {
	      D3_Xtr[iq][alpha][i][alpha][alpha] +=
		D3_phi[alpha][alpha][alpha] * local_coords[bf][i];
	    }
	    for (beta = alpha+1; beta < N_LAMBDA(MESH_DIM); beta++) {
	      for (i = 0; i < DIM_OF_WORLD; i++) {
		D3_Xtr[iq][alpha][i][alpha][beta] +=
		  D3_phi[alpha][alpha][beta] * local_coords[bf][i];
	      }
	      for (i = 0; i < DIM_OF_WORLD; i++) {
		D3_Xtr[iq][alpha][i][beta][beta] +=
		  D3_phi[alpha][beta][beta] * local_coords[bf][i];
	      }	      
	      for (gamma = beta+1; gamma < N_LAMBDA(MESH_DIM); gamma++) {
		for (i = 0; i < DIM_OF_WORLD; i++) {
		  D3_Xtr[iq][alpha][i][beta][gamma] +=
		    D3_phi[alpha][beta][gamma] * local_coords[bf][i];
		}
	      }
	    }
	  }
	}
	for (alpha = 0; alpha < N_LAMBDA(MESH_DIM); alpha++) {
	  for (beta = 0; beta < alpha; beta++) {
	    for (i = 0; i < DIM_OF_WORLD; i++) {
	      D3_Xtr[iq][beta][i][alpha][beta] =
		D3_Xtr[iq][alpha][i][beta][beta] =
		D3_Xtr[iq][beta][i][beta][alpha];
	    }
	    for (gamma = 0; gamma < beta; gamma++) {
	      for (i = 0; i < DIM_OF_WORLD; i++) {
		D3_Xtr[iq][alpha][i][beta][gamma] =
		  D3_Xtr[iq][alpha][i][gamma][beta] =
		  D3_Xtr[iq][beta][i][gamma][alpha] =
		  D3_Xtr[iq][beta][i][alpha][gamma] =
		  D3_Xtr[iq][gamma][i][beta][alpha];
	      }
	    }
	  }
	}
      }
    }

  } else {
    const REAL *grd;

    memset(grd_Xtr, 0, sizeof(REAL_BD));
    for (iq = 0; iq < N; iq++) {
      for (bf = 0; bf < bas_fcts->n_bas_fcts; bf++) {
	grd = GRD_PHI(bas_fcts, bf, lambda[iq]);
	for (alpha = 0; alpha < N_LAMBDA(MESH_DIM); alpha++) {
	  AXPY_DOW(grd[alpha], local_coords[bf], grd_Xtr[iq][alpha]);
	}
      }
    }

    if (D2_Xtr) {
      memset(D2_Xtr, 0, N * sizeof(D2_Xtr[0]));
      for (iq = 0; iq < N; iq++) {
	for (bf = 0; bf < bas_fcts->n_bas_fcts; bf++) {
	  const REAL_B *D2_phi = D2_PHI(bas_fcts, bf, lambda[iq]);
	  for (alpha = 0; alpha < N_LAMBDA(MESH_DIM); alpha++) {
	    for (i = 0; i < DIM_OF_WORLD; i++) {
	      D2_Xtr[iq][alpha][i][alpha] +=
		D2_phi[alpha][alpha] * local_coords[bf][i];
	    }
	    for (beta = alpha+1; beta < N_LAMBDA(MESH_DIM); beta++) {
	      for (i = 0; i < DIM_OF_WORLD; i++) {
		D2_Xtr[iq][alpha][i][beta] +=
		  D2_phi[alpha][beta] * local_coords[bf][i];
	      }
	    }
	  }
	}
	for (alpha = 0; alpha < N_LAMBDA(MESH_DIM); alpha++) {
	  for (beta = 0; beta < alpha; beta++) {
	    for (i = 0; i < DIM_OF_WORLD; i++) {
	      D2_Xtr[iq][alpha][i][beta] = D2_Xtr[iq][beta][i][alpha];
	    }
	  }
	}
      }
    }

    if (D3_Xtr) {
      memset(D3_Xtr, 0, N * sizeof(D3_Xtr[0]));
      for (iq = 0; iq < N; iq++) {
	for (bf = 0; bf < bas_fcts->n_bas_fcts; bf++) {
	  const REAL_BB *D3_phi = D3_PHI(bas_fcts, bf, lambda[iq]);
	  for (alpha = 0; alpha < N_LAMBDA(MESH_DIM); alpha++) {
	    for (i = 0; i < DIM_OF_WORLD; i++) {
	      D3_Xtr[iq][alpha][i][alpha][alpha] +=
		D3_phi[alpha][alpha][alpha] * local_coords[bf][i];
	    }
	    for (beta = alpha+1; beta < N_LAMBDA(MESH_DIM); beta++) {
	      for (i = 0; i < DIM_OF_WORLD; i++) {
		D3_Xtr[iq][alpha][i][alpha][beta] +=
		  D3_phi[alpha][alpha][beta] * local_coords[bf][i];
	      }
	      for (i = 0; i < DIM_OF_WORLD; i++) {
		D3_Xtr[iq][alpha][i][beta][beta] +=
		  D3_phi[alpha][beta][beta] * local_coords[bf][i];
	      }
	      for (gamma = beta+1; gamma < N_LAMBDA(MESH_DIM); gamma++) {
		for (i = 0; i < DIM_OF_WORLD; i++) {
		  D3_Xtr[iq][alpha][i][beta][gamma] +=
		    D3_phi[alpha][beta][gamma] * local_coords[bf][i];
		}
	      }
	    }
	  }
	}
	for (alpha = 0; alpha < N_LAMBDA(MESH_DIM); alpha++) {
	  for (beta = 0; beta < alpha; beta++) {
	    for (i = 0; i < DIM_OF_WORLD; i++) {
	      D3_Xtr[iq][beta][i][alpha][beta] =
		D3_Xtr[iq][alpha][i][beta][beta] =
		D3_Xtr[iq][beta][i][beta][alpha];
	    }
	    for (gamma = 0; gamma < beta; gamma++) {
	      for (i = 0; i < DIM_OF_WORLD; i++) {
		D3_Xtr[iq][alpha][i][beta][gamma] =
		  D3_Xtr[iq][alpha][i][gamma][beta] =
		  D3_Xtr[iq][beta][i][gamma][alpha] =
		  D3_Xtr[iq][beta][i][alpha][gamma] =
		  D3_Xtr[iq][gamma][i][beta][alpha];
	      }
	    }
	  }
	}
      }
    }
  }  
}

static void PN(detY)(const EL_INFO *el_info, const QUAD *quad, int N,
		     const REAL_B lambda[], REAL dets[])
{
  /* FUNCNAME("detY_"CPP_STIRNGIZE(MESH_DIM)"d"); */
  REAL                     Dt[MESH_DIM][DIM_OF_WORLD], DtD[MESH_DIM][MESH_DIM];
  int                      iq;
  const BAS_FCTS           *bas_fcts;
  LAGRANGE_PARAM_DATA      *data = 
    ((LAGRANGE_PARAM_DATA *)el_info->mesh->parametric->data);
  REAL_D                   *local_coords = data->local_coords;

  /* First of all, check if we are on a parametric simplex.
   * If not, treat this simplex as an affine simplex, even though some
   * higher order vertices might be shifted.
   */
  if (data->i_am_affine) {
    PN(det1)(el_info, quad, N, lambda, dets);
    return;
  }

  bas_fcts = data->coords->fe_space->bas_fcts;

  if (quad) {
    const PUN(DD_DATA) *dd_data = PN(init_dd_data)(el_info, quad, bas_fcts);

    for (iq = 0; iq < quad->n_points; iq++) {
      dets[iq] = sqrt(PN(Dt_and_DtD)(local_coords, dd_data->DD[iq],
				     dd_data->n_bas_fcts, Dt, DtD));
    }
  } else {
    REAL  DD[N_BAS_MAX][MESH_DIM];
    int   i, n_bas;

    n_bas = bas_fcts->n_bas_fcts;

    for (iq = 0; iq < N; iq++) {
      for (i = 0; i < n_bas; i++) {
	PN(DD)(DD[i], GRD_PHI(bas_fcts, i, lambda[iq]), 0);
      }
      dets[iq] = sqrt(PN(Dt_and_DtD)(local_coords, DD, n_bas, Dt, DtD));
    }
  }

  return;
}

static inline REAL PN(Lambda_iq)(REAL_D *const F,
				 REAL DD[][MESH_DIM],
				 REAL dDD[][MESH_DIM][MESH_DIM],
				 int n_bas,
				 REAL_BD Lambda, REAL_BDD DLambda)
{
  REAL Dt[MESH_DIM][DIM_OF_WORLD], DtD[MESH_DIM][MESH_DIM];
  REAL DtD_1[MESH_DIM][MESH_DIM];
  REAL DFS_1[MESH_DIM][DIM_OF_WORLD] = { { 0.0, }, };
  REAL det;
  int  i, j, n, alpha, beta;

  det = PN(Dt_and_DtD)(F, DD, n_bas, Dt, DtD);

/*--------------------------------------------------------------------------*/
/*--- now, invert DtD                                                    ---*/
/*--------------------------------------------------------------------------*/

  PN(par_syminv)(DtD_1, (const PUN(REAL_D) *)DtD, det);

/*--------------------------------------------------------------------------*/
/*--- compute DF_S^{-1} = (D^t D)^{-1} D^t                               ---*/
/*--------------------------------------------------------------------------*/
  
  for (i = 0; i < MESH_DIM; i++) {
    for (j = 0; j < DIM_OF_WORLD; j++) {
      for (n = 0; n < MESH_DIM; n++) {
	DFS_1[i][j] += DtD_1[i][n]*Dt[n][j];
      }
    }
  }

/*--------------------------------------------------------------------------*/
/*--- finally, \Lambda = \hat\Lambda DF_S^{-1}                           ---*/
/*--------------------------------------------------------------------------*/

  for (n = 0; n < DIM_OF_WORLD; n++) {
    Lambda[0][n] = 0.0;
    for (alpha = 0; alpha < MESH_DIM; alpha++) {
      Lambda[alpha+1][n] = DFS_1[alpha][n];
      Lambda[0][n] -= DFS_1[alpha][n];
    }
  }

  /* Note: we have to clear any excess entries to 0, otherwise
   * eval_grd_uh_fast() and friends will not work.
   */
  for (i = N_LAMBDA(MESH_DIM); i < N_LAMBDA_MAX; i++) {
    SET_DOW(0.0, Lambda[i]);
  }

  /* We have
   *
   * (D^tD) \nabla_x\lambda = \nabla_\lambda x
   *
   * We differentiate this relation w.r.t. to \lambda and get
   *
   * (D^tD)\nabla_\lambda\nabla_x\lambda
   * =
   * \nabla^2_\lambda x - \nabla_x\lambda \nabla_\lambda(D^tD)
   *
   * So finally with g_{\alpha\beta} = D^tD (metric tensor)
   *
   * \nabla_x^2\lambda_\beta
   * =
   * \nabla_x\lambda_\alpha\partial_\alpha(\nabla_x\lambda_\beta)
   * =
   * \nabla_x\lambda_\alpha
   * g^{\beta\gamma}
   * \left(
   *   \partial_\alpha\partial_\gamma x
   *   -
   *   \partial_\alpha g_{\gamma\delta}\nabla_x\lamba_\delta
   * \right),
   *
   * where the symbol \partial_\alpha always denotes the derivative
   * w.r.t. to \lambda_\alpha, \alpha = 1,2,3 (i.e. with \lambda_0 = 1
   * - \sum\lambda_\gamma).
   */
  if (DLambda) {
    REAL_D dDt[MESH_DIM][MESH_DIM];
    REAL   dDtD[MESH_DIM][MESH_DIM][MESH_DIM];
    REAL   tmp1[MESH_DIM][MESH_DIM], tmp2[MESH_DIM][MESH_DIM];
    int l, k, m;

    PN(dDt_and_dDtD)(F, dDD, Dt, n_bas, dDt, dDtD);

    for (n = 0; n < DIM_OF_WORLD; n++) {

      for (m = 0; m < DIM_OF_WORLD; m++) {

	/* inverted product-rule */
	for (l = 0; l < MESH_DIM; l++) {
	  for (k = 0; k < MESH_DIM; k++) {
	    tmp1[l][k] = dDt[l][k][m];
	    for (alpha = 0; alpha < MESH_DIM; alpha++) {
	      tmp1[l][k] -= dDtD[l][k][alpha]*DFS_1[alpha][m];
	    }
	  }
	}

	/* Multiply by (D^tD)^{-1} to get the barycentric derivatives
	 * of \Lambda. We sum intentionally over the second index of
	 * tmp1
	 */
	for (l = 0; l < MESH_DIM; l++) {
	  for (k = 0; k < MESH_DIM; k++) {
	    tmp2[l][k] = PN(par_scp)(DtD_1[l], tmp1[k]);
	  }
	}
	/* Finally multiply by DFS_1 to get the second Cartesian
	 * derivatives of the barycentric coordinates.
	 */

	DLambda[0][n][m] = 0.0;
	for (alpha = 0; alpha < MESH_DIM; alpha++) {
	  DLambda[alpha+1][n][m] = 0.0;
	  for (beta = 0; beta < MESH_DIM; beta++) {
	    DLambda[alpha+1][n][m] += DFS_1[beta][n]*tmp2[alpha][beta];
	  }
	  DLambda[0][n][m] -= DLambda[alpha+1][n][m];
	}
      }
    }

    /* Note: we have to clear any excess entries to 0, otherwise
     * eval_grd_uh_fast() and friends will not work.
     */
    for (i = N_LAMBDA(MESH_DIM); i < N_LAMBDA_MAX; i++) {
      MSET_DOW(0.0, DLambda[i]);
    }

  }

  return sqrt(det);
}

static void PN(grd_lambdaY)(const EL_INFO *el_info, const QUAD *quad,
			    int N, const REAL_B lambda[],
			    REAL_BD Lambda[], REAL_BDD DLambda[], REAL dets[])
{
  /* FUNCNAME("grd_lambdaY_"CPP_STRINGIZE(MESH_DIM)"d"); */
  int                       iq;
  const BAS_FCTS           *bas_fcts;
  LAGRANGE_PARAM_DATA      *data = 
    ((LAGRANGE_PARAM_DATA *)el_info->mesh->parametric->data);
  REAL_D                   *local_coords = data->local_coords;
  REAL                     det;

  /* First of all, check if we are on a parametric simplex.  If not,
   * treat this simplex as an affine simplex, even though some higher
   * order vertices might be shifted.
   */
  if (data->i_am_affine) {
    PN(grd_lambda1)(el_info, quad, N, lambda, Lambda, DLambda, dets);
    return;
  }

  bas_fcts = data->coords->fe_space->bas_fcts;
    
  if (quad) {
    PUN(DD_DATA) *dd_data = PN(init_dd_data)(el_info, quad, bas_fcts);

    /* Note: the comiler can do loop-verioning itself, provided it is
     * clear that the conditions (here: dets == NULL, DLambda == NULL)
     * cannot change inside the loop.
     */
    for (iq = 0; iq < quad->n_points; iq++) {
      det = PN(Lambda_iq)(local_coords,
			  dd_data->DD[iq],
			  DLambda ? dd_data->dDD[iq] : NULL,
			  dd_data->n_bas_fcts, Lambda[iq],
			  DLambda ? DLambda[iq] : NULL);
      if (dets) {
	dets[iq] = det;
      }
    }
  } else {
    REAL  DD[N_BAS_MAX][MESH_DIM];
    REAL  dDD[N_BAS_MAX][MESH_DIM][MESH_DIM];    
    int   i, n_bas;

    n_bas = bas_fcts->n_bas_fcts;

    for (iq = 0; iq < N; iq++) {
      for (i = 0; i < n_bas; i++) {
	PN(DD)(DD[i], GRD_PHI(bas_fcts, i, lambda[iq]), 0);
	if (DLambda) {
	  PN(dDD)(dDD[i], D2_PHI(bas_fcts, i, lambda[iq]), 0);
	}
      }
      
      det = PN(Lambda_iq)(local_coords, DD, DLambda ? dDD : NULL, n_bas,
			  Lambda[iq], DLambda ? DLambda[iq] : NULL);
      if (dets) {
	dets[iq] = det;
      }
    }
  }
}

#if MESH_DIM > 1
/* Given the Jacobian of a non-unit vector-field \nu compute the
 * Jacobian of the unit vector
 *
 * \nu/|\nu|
 *
 * We have
 *
 * |\nu| D_a \nu/|\nu| = D_a\nu - 1/|nu|^2 (\nu\cdot D_a\nu) \nu =: P D_a\nu
 *
 * We store the term 1/|nu|^2(\nu\cdot\nu) in the variabla nuDnu
 * because we need it for the computation of the second derivatives of
 * the unit normal field.
 *
 * The return value is 1/|nu|^2.
 */
static inline
REAL PN(grd_normalize)(REAL_D Dn[MESH_DIM],
		       REAL nuDnu[MESH_DIM],
		       const REAL_D Dnu[MESH_DIM], const REAL_D nu)
{
  int alpha;
  REAL inv_nrm2 = 1.0 / NRM2_DOW(nu);
  
  for (alpha = 0; alpha < MESH_DIM; alpha++) {
    nuDnu[alpha] = inv_nrm2 * SCP_DOW(nu, Dnu[alpha]);
    AXPBY_DOW(1.0, Dnu[alpha], - nuDnu[alpha], nu, Dn[alpha]);
  }

  return inv_nrm2;
}

/* Given the Hessian of non-unit vector-field \nu, and some other
 * data, compute the Hessian of the unit vector field \nu/|\nu|
 *
 * Elementary computations yield the following formular (FIXME):
 *
 * |\nu| D_ab \nu/|\nu| =
 *
 *   1/|nu| ( P D_ab\nu
 *            +
 *            (1/|\nu|^4(\nu.D_a\nu)(\nu.D_b\nu) - 1/|nu|^2 D_a\nu.D_b\nu)\nu
 *            -
 *            1/|\nu|^2(\nu.D_a\nu)D_b\nu
 *            -
 *            1/|\nu|^2(\nu.D_b\nu)D_a\nu)
 *
 * We re-use some terms previously computed by grd_normalize().
 */
static inline
void PN(D2_normalize)(REAL_D D2n[MESH_DIM][MESH_DIM],
		      const REAL_D nu,
		      const REAL_D Dnu[MESH_DIM],
		      const REAL_D D2nu[MESH_DIM][MESH_DIM],
		      REAL inv_nrm2,
		      const REAL nuDnu[MESH_DIM])
{
  int alpha, beta;
  
  for (alpha = 0; alpha < MESH_DIM; alpha++) {
    /* First term: tangential projection of the non-unit stuff */
    AXPBY_DOW(1.0, D2nu[alpha][alpha],
	      -inv_nrm2*SCP_DOW(D2nu[alpha][alpha], nu), nu,
	      D2n[alpha][alpha]);
    /* add the normal component */
    AXPY_DOW(
      nuDnu[alpha]*nuDnu[alpha] - inv_nrm2*SCP_DOW(Dnu[alpha], Dnu[alpha]),
      nu,
      D2n[alpha][alpha]);
    /* Finally add "cross-directions", so to say ... */
    AXPY_DOW(-2.0*nuDnu[alpha], Dnu[alpha], D2n[alpha][alpha]);
    for (beta = alpha+1; beta < MESH_DIM; beta++) {
      /* First term: tangential projection of the non-unit stuff */
      AXPBY_DOW(1.0, D2nu[alpha][beta],
		-inv_nrm2*SCP_DOW(D2nu[alpha][beta], nu), nu,
		D2n[alpha][beta]);
      /* add the normal component */
      AXPY_DOW(
	nuDnu[alpha]*nuDnu[beta] - inv_nrm2*SCP_DOW(Dnu[alpha], Dnu[beta]),
	nu,
	D2n[alpha][beta]);
      /* Finally add "cross-directions", so to say ... */
      AXPY_DOW(-nuDnu[alpha], Dnu[beta], D2n[alpha][beta]);
      AXPY_DOW(-nuDnu[beta], Dnu[alpha], D2n[alpha][beta]);
    }
    /* D2n[beta][alpha] = D2n[alpha][beta]; */
  }
}

/* Computation of the co-normal is really dimension dependent, so we
 * just define the proto-type here and leave the code in
 * parametric_Xd.c.
 */

static inline
REAL PN(wall_normal_iq)(REAL_D *const coords,
			REAL DD[][MESH_DIM],
			REAL dDD[][MESH_DIM][MESH_DIM],
			REAL ddDD[][MESH_DIM][MESH_DIM][MESH_DIM],
			int n_bas, int wall,
			REAL_D normal, REAL_DB grd_normal, REAL_DBB D2_normal);

/* Compute the co-normal for WALL at the barycentric coordinates
 * specified by LAMBDA. LAMBDA are fully fledged barycentric
 * coordinates, i.e. lambda[wall] == 0.0.
 */
static void
PN(wall_normalY)(const EL_INFO *el_info, int wall,
		 const QUAD *quad, int n, const REAL_B lambda[],
		 REAL_D normals[], REAL_DB grd_normals[], REAL_DBB D2_normals[],
		 REAL dets[])
{
  LAGRANGE_PARAM_DATA      *data = 
    ((LAGRANGE_PARAM_DATA *)el_info->mesh->parametric->data);
  REAL_D         *coords = data->local_coords;
  const BAS_FCTS *bas_fcts;
  REAL_D normal;
  int   i, n_bas, iq;

  /* First of all, check if we are on a parametric simplex. If not,
   * treat this simplex as an affine simplex.
   */
  if (data->i_am_affine) {
    PN(wall_normal1)(el_info, wall, quad, n, lambda,
		     normals, grd_normals, D2_normals, dets);
    return;
  }

  bas_fcts = data->coords->fe_space->bas_fcts;

  if (quad) {
    n = quad->n_points;
  }

  if (quad) {
    REAL detsbuffer[quad->n_points];
    const PUN(DD_DATA) *dd_data =
      PN(init_wall_dd_data)(el_info, quad, bas_fcts);

    if (!dets) {
      dets = detsbuffer;
    }

    for (iq = 0; iq < quad->n_points; iq++) {
      dets[iq] = PN(wall_normal_iq)(coords,
				    dd_data->wall_DD[iq],
				    dd_data->wall_dDD[iq],
				    dd_data->wall_ddDD[iq],
				    dd_data->n_bas_fcts,
				    wall,
				    normals ? normals[iq] : normal,
				    grd_normals ? grd_normals[iq] : NULL,
				    D2_normals ? D2_normals[iq] : NULL);
      if (normals) {
	SCAL_DOW(1.0/dets[iq], normals[iq]);
      }
    }
  } else {
    REAL detsbuffer[n];
    REAL DD[N_BAS_MAX][MESH_DIM];
    REAL dDD[N_BAS_MAX][MESH_DIM][MESH_DIM];    
    REAL ddDD[N_BAS_MAX][MESH_DIM][MESH_DIM][MESH_DIM];

    /* The following is in principle Cramer's rule, used to extract one
     * line of grd_lambda (which, of course, just holds the wall-normal)
     */
    n_bas = bas_fcts->n_bas_fcts;

    if (!dets) {
      dets = detsbuffer;
    }

    for (iq = 0; iq < n; iq++) {
      for (i = 0; i < n_bas; i++) {
	PN(DD)(DD[i], GRD_PHI(bas_fcts, i, lambda[iq]), wall);
      }
      if (grd_normals) {
	PN(dDD)(dDD[i], D2_PHI(bas_fcts, i, lambda[iq]), wall);
      }
      if (D2_normals) {
	PN(ddDD)(ddDD[i], D3_PHI(bas_fcts, i, lambda[iq]), wall);
      }

      dets[iq] = PN(wall_normal_iq)(coords, DD, dDD, ddDD, n_bas, wall,
				    normals ? normals[iq] : normal,
				    grd_normals ? grd_normals[iq] : NULL,
				    D2_normals ? D2_normals[iq] : NULL);

      if (normals) {
	SCAL_DOW(1.0/dets[iq], normals[iq]);
      }
    }
  }
}

#endif /* MESH_DIM > 1 */


