/*******************************************************************************
 * ALBERTA:  an Adaptive multi Level finite element toolbox using
 *           Bisectioning refinement and Error control by Residual
 *           Techniques for scientific Applications
 *
 * file:     eval.c
 *
 * description: Routines for evaluating fe-functions and derivatives,
 *              the major part, however, is now contained as
 *              inline-functions in evaluate.h
 *
 *******************************************************************************
 *
 *  authors:   Alfred Schmidt
 *             Zentrum fuer Technomathematik
 *             Fachbereich 3 Mathematik/Informatik
 *             Universitaet Bremen
 *             Bibliothekstr. 2
 *             D-28359 Bremen, Germany
 *
 *             Kunibert G. Siebert
 *             Institut fuer Mathematik
 *             Universitaet Augsburg
 *             Universitaetsstr. 14
 *             D-86159 Augsburg, Germany
 *
 *             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 A. Schmidt and K.G. Siebert (1996-2003),
 *         C.-J. Heine (2009)
 *
 ******************************************************************************/

#ifdef HAVE_CONFIG_H
# include "config.h"
#endif

#include "alberta_intern.h"
#include "alberta.h"
#include "evaluate.h"

/*--------------------------------------------------------------------------*/
/*  some routines for evaluation of a finite element function, its gradient */
/*  and second derivatives; all those with _fast use the preevaluated       */
/*  basis functions at that point.                                          */
/*                                                                          */
/*  PLEASE NOTE: The _fast routines rely on zero values in the unused       */
/*  barycentric coordinates and derivatives. This was done to maintain the  */
/*  calling syntax (the routines don't know the space dimension) and to     */
/*  enable loop unrolling with constant index boundaries.                   */
/*--------------------------------------------------------------------------*/

/*--------------------------------------------------------------------------*/
/* calculation H1 or L2 Norm of a finite element function                   */
/*--------------------------------------------------------------------------*/

REAL H1_norm_uh(const QUAD *quad, const DOF_REAL_VEC *u_h)
{
  FUNCNAME("H1_norm_uh");
  const FE_SPACE  *fe_space;
  const BAS_FCTS  *bas_fcts;
  const QUAD_FAST *quad_fast;
  FLAGS           fill_flags;
  REAL            norm, norm2, normT;
  int             deg;

  if (!u_h) {
    ERROR("no DOF vector u_h; returning 0.0\n");
    return 0.0;
  }

  fe_space = u_h->fe_space;
  if (!(bas_fcts = fe_space->bas_fcts)) {
    ERROR("no basis functions; returning 0.0\n");
    return 0.0;
  }
  
  if (!quad) {
    deg = 2*bas_fcts->degree-2;
    quad = get_quadrature(fe_space->mesh->dim, deg);
  }
  quad_fast = get_quad_fast(bas_fcts, quad, INIT_GRD_PHI);

  norm = 0.0;

  /* default initialising of quad_fast,
   * which also initialises quad, bas_fcts
   */
  INIT_OBJECT(quad_fast);
  
  {
    PARAMETRIC *parametric = fe_space->mesh->parametric;
    bool       is_parametric = false;
    REAL_BD    Lambda;
    REAL       det;
    REAL       dets[quad->n_points_max];
    REAL_BD    Lambdas[quad->n_points_max];
    REAL_D     grduh_vec[quad->n_points_max];    

    fill_flags = quad_fast->fill_flags|CALL_LEAF_EL|FILL_COORDS;
    TRAVERSE_FIRST(u_h->fe_space->mesh, -1, fill_flags) {
      const EL_REAL_VEC *uh_loc;
      int        iq;

      if (INIT_ELEMENT(el_info, quad_fast) == INIT_EL_TAG_NULL)
	continue;

      uh_loc = fill_el_real_vec(NULL, el_info->el, u_h);

      if (parametric) {
	is_parametric = parametric->init_element(el_info, parametric);
      }

      normT = 0.0;
      if (is_parametric) {
	parametric->grd_lambda(el_info,
			       quad_fast->quad, 0, NULL, Lambdas, NULL, dets);
	param_grd_uh_at_qp(grduh_vec,
			   quad_fast, (const REAL_BD *)Lambdas, uh_loc);

	for (iq = 0; iq < quad_fast->n_points; iq++) {
	  norm2 = NRM2_DOW(grduh_vec[iq]);
      
	  normT += dets[iq] * quad_fast->w[iq] * norm2;
	}
      } else {
	det = el_grd_lambda(el_info, Lambda);
	grd_uh_at_qp(grduh_vec, quad_fast, (const REAL_D*)Lambda, uh_loc);    
	for (iq = 0; iq < quad_fast->n_points; iq++) {
	  norm2 = NRM2_DOW(grduh_vec[iq]);
      
	  normT += quad_fast->w[iq] * norm2;
	}
	normT *= det;
      }

      norm += normT;

    } TRAVERSE_NEXT();
  }

  return sqrt(norm);
}

REAL L2_norm_uh(const QUAD *quad, const DOF_REAL_VEC *u_h)
{
  FUNCNAME("L2_norm_uh");
  const FE_SPACE  *fe_space;
  const BAS_FCTS  *bas_fcts;
  const QUAD_FAST *quad_fast;
  FLAGS           fill_flags;
  int             deg;
  REAL            norm, normT;

  if (!u_h) {
    ERROR("no DOF vector u_h; returning 0.0\n");
    return 0.0;
  }

  fe_space = u_h->fe_space;
  if (!(bas_fcts = fe_space->bas_fcts)) {
    ERROR("no basis functions; returning 0.0\n");
    return 0.0;
  }
  
  if (!quad) {
    deg = 2*bas_fcts->degree;
    quad = get_quadrature(fe_space->mesh->dim, deg);
  }
  quad_fast = get_quad_fast(bas_fcts, quad, INIT_PHI);

  norm = 0.0;

  /* default initialising of quad_fast
   * which also initialises (default) quad, bas_fcts
   */
  INIT_OBJECT(quad_fast);
  
  {
    PARAMETRIC *parametric = fe_space->mesh->parametric;
    bool is_parametric = false;
    REAL det;
    REAL dets[quad->n_points_max];

    fill_flags = quad_fast->fill_flags|CALL_LEAF_EL|FILL_COORDS;
    TRAVERSE_FIRST(u_h->fe_space->mesh, -1, fill_flags) {
      const EL_REAL_VEC *uh_loc;
      const REAL *uh_vec;
      int        iq;

      if (INIT_ELEMENT(el_info, quad_fast) == INIT_EL_TAG_NULL)
	continue;

      uh_loc = fill_el_real_vec(NULL, el_info->el, u_h);
      uh_vec = uh_at_qp(NULL, quad_fast, uh_loc);

      if (parametric) {
	is_parametric = parametric->init_element(el_info, parametric);
      }

      normT = 0.0;
      if (is_parametric) {
	parametric->det(el_info, quad_fast->quad, 0, NULL, dets);
	for (iq = 0; iq < quad_fast->n_points; iq++) {
	  normT += dets[iq] * quad_fast->w[iq] * SQR(uh_vec[iq]);
	}
      } else {
	det = el_det(el_info);
	for (iq = 0; iq < quad_fast->n_points; iq++) {
	  normT += quad_fast->w[iq]*SQR(uh_vec[iq]);
	}
	normT *= det;
      }

      norm += normT;

    } TRAVERSE_NEXT();
  }

  return sqrt(norm);
}

/* Compute an approximation of the L8-norm by evaluating u_h at the
 * quadrature points of some quadrature formula (twice the degree of
 * uh->bas_fcts per default).
 */
REAL L8_uh_at_qp(REAL *minp, REAL *maxp,
		 const QUAD *quad, const DOF_REAL_VEC *u_h)
{
  FUNCNAME("L8_uh_at_qp");
  const FE_SPACE  *fe_space;
  const BAS_FCTS  *bas_fcts;
  const QUAD_FAST *quad_fast;
  FLAGS           fill_flags;
  int             deg;
  REAL            min, max;

  if (!u_h) {
    ERROR("no DOF vector u_h; returning 0.0\n");
    return 0.0;
  }

  fe_space = u_h->fe_space;
  if (!(bas_fcts = fe_space->bas_fcts)) {
    ERROR("no basis functions; returning 0.0\n");
    return 0.0;
  }
  
  if (!quad) {
    deg = 2*bas_fcts->degree;
    quad = get_quadrature(fe_space->mesh->dim, deg);
  }
  quad_fast = get_quad_fast(bas_fcts, quad, INIT_PHI);

  /* default initialising of quad_fast
   * which also initialises (default) quad, bas_fcts
   */
  INIT_OBJECT(quad_fast);
  
  min = REAL_MAX;
  max = REAL_MIN;
    
  fill_flags = quad_fast->fill_flags|CALL_LEAF_EL;
  TRAVERSE_FIRST(u_h->fe_space->mesh, -1, fill_flags) {
    const EL_REAL_VEC *uh_loc;
    const REAL *uh_vec;
    int        iq;

    if (INIT_ELEMENT(el_info, quad_fast) == INIT_EL_TAG_NULL)
      continue;

    uh_loc = fill_el_real_vec(NULL, el_info->el, u_h);
    uh_vec = uh_at_qp(NULL, quad_fast, uh_loc);

    for (iq = 0; iq < quad_fast->n_points; iq++) {
      if (uh_vec[iq] < min) {
	min = uh_vec[iq];
      } else if (uh_vec[iq] > max) {
	max = uh_vec[iq];
      }
    }

  } TRAVERSE_NEXT();

  if (minp) {
    *minp = min;
  }
  if (maxp) {
    *maxp = max;
  }

  return MAX(fabs(min), fabs(max));
}

/*--------------------------------------------------------------------------*/
/* calculation H1 or L2 Norm of a vector valued finite element function     */
/*--------------------------------------------------------------------------*/

REAL H1_norm_uh_dow(const QUAD *quad, const DOF_REAL_VEC_D *u_h)
{
  FUNCNAME("H1_norm_uh_d");
  const FE_SPACE  *fe_space;
  const BAS_FCTS  *bas_fcts;
  const QUAD_FAST *quad_fast;
  FLAGS           fill_flags;
  REAL            norm, norm2, normT;
  int             deg;

  if (!u_h) {
    ERROR("no DOF vector u_h; returning 0.0\n");
    return 0.0;
  }

  fe_space = u_h->fe_space;
  if (!(bas_fcts = fe_space->bas_fcts)) {
    ERROR("no basis functions; returning 0.0\n");
    return 0.0;
  }
  
  if (!quad) {
    deg = 2*bas_fcts->degree-2;
    quad = get_quadrature(fe_space->mesh->dim, deg);
  }
  quad_fast = get_quad_fast(bas_fcts, quad, INIT_GRD_PHI);

  norm = 0.0;

  /* default initialising of quad_fast,
   * which also initialises quad, bas_fcts
   */
  INIT_OBJECT(quad_fast);
  
  {
    PARAMETRIC *parametric = fe_space->mesh->parametric;
    bool       is_parametric = false;
    REAL_BD    Lambda;
    REAL       det;
    REAL       dets[quad->n_points_max];
    REAL_BD    Lambdas[quad->n_points_max];
    REAL_DD    grduh_vec[quad->n_points_max];    

    fill_flags = quad_fast->fill_flags|CALL_LEAF_EL|FILL_COORDS;
    TRAVERSE_FIRST(u_h->fe_space->mesh, -1, fill_flags) {
      const EL_REAL_VEC_D *uh_loc;
      int        iq;

      if (INIT_ELEMENT(el_info, quad_fast) == INIT_EL_TAG_NULL)
	continue;
      
      uh_loc = fill_el_real_vec_d(NULL, el_info->el, u_h);

      if (parametric) {
	is_parametric = parametric->init_element(el_info, parametric);
      }

      normT = 0.0;
      if (is_parametric) {
	parametric->grd_lambda(el_info,
			       quad_fast->quad, 0, NULL, Lambdas, NULL, dets);
	param_grd_uh_dow_at_qp(grduh_vec,
			       quad_fast, (const REAL_BD *)Lambdas, uh_loc);

	for (iq = 0; iq < quad_fast->n_points; iq++) {
	  norm2 = MNRM2_DOW((const REAL_D *)grduh_vec[iq]);
      
	  normT += dets[iq] * quad_fast->w[iq] * norm2;
	}
      } else {
	det = el_grd_lambda(el_info, Lambda);
	grd_uh_dow_at_qp(grduh_vec, quad_fast, (const REAL_D*)Lambda, uh_loc);
    
	for (iq = 0; iq < quad_fast->n_points; iq++) {
	  norm2 = MNRM2_DOW((const REAL_D *)grduh_vec[iq]);
	  normT += quad_fast->w[iq] * norm2;
	}
	normT *= det;
      }

      norm += normT;

    } TRAVERSE_NEXT();
  }

  return sqrt(norm);
}

REAL L2_norm_uh_dow(const QUAD *quad, const DOF_REAL_VEC_D *u_h)
{
  FUNCNAME("L2_norm_uh_dow");
  const FE_SPACE  *fe_space;
  const BAS_FCTS  *bas_fcts;
  const QUAD_FAST *quad_fast;
  FLAGS           fill_flags;
  int             deg;
  REAL            norm, normT;

  if (!u_h) {
    ERROR("no DOF vector u_h; returning 0.0\n");
    return 0.0;
  }

  fe_space = u_h->fe_space;
  if (!(bas_fcts = fe_space->bas_fcts)) {
    ERROR("no basis functions; returning 0.0\n");
    return 0.0;
  }
  
  if (!quad) {
    deg = 2*bas_fcts->degree;
    quad = get_quadrature(fe_space->mesh->dim, deg);
  }
  quad_fast = get_quad_fast(bas_fcts, quad, INIT_PHI);

  norm = 0.0;

  /* default initialising of quad_fast
   * which also initialises (default) quad, bas_fcts
   */
  INIT_OBJECT(quad_fast);
  
  {
    PARAMETRIC *parametric = fe_space->mesh->parametric;
    bool       is_parametric = false;
    REAL       det;
    REAL       dets[quad->n_points_max];

    fill_flags = quad_fast->fill_flags|CALL_LEAF_EL|FILL_COORDS;
    TRAVERSE_FIRST(u_h->fe_space->mesh, -1, fill_flags) {
      const EL_REAL_VEC_D *uh_loc;
      const REAL_D *uh_vec;
      int          iq;

      if (INIT_ELEMENT(el_info, quad_fast) == INIT_EL_TAG_NULL)
	continue;

      uh_loc = fill_el_real_vec_d(NULL, el_info->el, u_h);
      uh_vec = uh_dow_at_qp(NULL, quad_fast, uh_loc);

      if (parametric) {
	is_parametric = parametric->init_element(el_info, parametric);
      }

      normT = 0.0;
      if (is_parametric) {
	parametric->det(el_info, quad_fast->quad, 0, NULL, dets);

	for (iq = 0; iq < quad_fast->n_points; iq++) {
	  normT += dets[iq] * quad_fast->w[iq] * NRM2_DOW(uh_vec[iq]);
	}
      } else {
	det = el_det(el_info);
	for (iq = 0; iq < quad_fast->n_points; iq++) {
	  normT += quad_fast->w[iq]*NRM2_DOW(uh_vec[iq]);
	}
	normT *= det;
      }

      norm += normT;

    } TRAVERSE_NEXT();
  }

  return sqrt(norm);
}

REAL L8_uh_at_qp_dow(REAL *minp, REAL *maxp,
		     const QUAD *quad, const DOF_REAL_VEC_D *u_h)
{
  FUNCNAME("L2_norm_uh_dow");
  const FE_SPACE  *fe_space;
  const BAS_FCTS  *bas_fcts;
  const QUAD_FAST *quad_fast;
  FLAGS           fill_flags;
  int             deg;
  REAL            min, max;

  if (!u_h) {
    ERROR("no DOF vector u_h; returning 0.0\n");
    return 0.0;
  }

  fe_space = u_h->fe_space;
  if (!(bas_fcts = fe_space->bas_fcts)) {
    ERROR("no basis functions; returning 0.0\n");
    return 0.0;
  }
  
  if (!quad) {
    deg = 2*bas_fcts->degree;
    quad = get_quadrature(fe_space->mesh->dim, deg);
  }
  quad_fast = get_quad_fast(bas_fcts, quad, INIT_PHI);

  /* default initialising of quad_fast
   * which also initialises (default) quad, bas_fcts
   */
  INIT_OBJECT(quad_fast);
  
  min = REAL_MAX;
  max = REAL_MIN;

  fill_flags = quad_fast->fill_flags|CALL_LEAF_EL;
  TRAVERSE_FIRST(u_h->fe_space->mesh, -1, fill_flags) {
    const EL_REAL_VEC_D *uh_loc;
    const REAL_D *uh_vec;
    int          iq;

    if (INIT_ELEMENT(el_info, quad_fast) == INIT_EL_TAG_NULL)
      continue;

    uh_loc = fill_el_real_vec_d(NULL, el_info->el, u_h);
    uh_vec = uh_dow_at_qp(NULL, quad_fast, uh_loc);

    for (iq = 0; iq < quad_fast->n_points; iq++) {
      REAL value = NRM2_DOW(uh_vec[iq]);

      if (value < min) {
	min = value;
      } else if (value > max) {
	max = value;
      }
    }
      
  } TRAVERSE_NEXT();

  min = sqrt(min);
  max = sqrt(max);
  
  if (minp) {
    *minp = min;
  }
  if (maxp) {
    *maxp = max;
  }

  return max;
}

REAL _AI_inter_fct_loc(const EL_INFO *el_info,
		       const QUAD *quad, int iq,
		       void *ud)
{
  REAL (*fct)(const REAL_D x) = *(REAL (**)(const REAL_D x))ud;
  REAL_D world;
  
  coord_to_world(el_info, quad->lambda[iq], world);

  return fct(world);
}

REAL _AI_inter_fct_loc_param(const EL_INFO *el_info,
			     const QUAD *quad, int iq,
			     void *ud)
{
  if ((el_info->fill_flag & FILL_COORDS) == 0) {
    REAL (*fct)(const REAL_D x) = *(REAL (**)(const REAL_D x))ud;
    const PARAMETRIC *parametric = el_info->mesh->parametric;
    REAL_D world;

    parametric->coord_to_world(el_info, NULL, 1, quad->lambda + iq,
			       (REAL_D *)world);
    return fct(world);
  } else {
    return _AI_inter_fct_loc(el_info, quad, iq, ud);
  }
}

static inline void
interpol_el_single(DOF_REAL_VEC *u_h, EL_REAL_VEC *coeff,
		   LOC_FCT_AT_QP fct, void *fct_data,
		   const EL_INFO *el_info, const FE_SPACE *fe_space)
{
  const BAS_FCTS *bas_fcts = fe_space->bas_fcts;
  int n_bas = bas_fcts->n_bas_fcts;
  DOF dofs[n_bas];
  int indices[n_bas];
  REAL val;
  int i, n_indices = 0;

  GET_DOF_INDICES(bas_fcts, el_info->el, fe_space->admin, dofs);
  
  for (i = 0; i < n_bas; i++) {
    if ((val = u_h->vec[dofs[i]]) == HUGE_VAL) {
      indices[n_indices++] = i;
    } else {
      coeff->vec[i] = u_h->vec[dofs[i]];
    }
  }

  if (n_indices == n_bas) {
    INTERPOL(bas_fcts, coeff, el_info, -1, -1, NULL, fct, fct_data);
	
    for (i = 0; i < n_bas; i++) {
      u_h->vec[dofs[i]] = coeff->vec[i];
    }
  } else if (n_indices > 0) {
    INTERPOL(bas_fcts, coeff, el_info, -1, n_indices, indices, fct, fct_data);
	
    for (i = 0; i < n_indices; i++) {
      u_h->vec[dofs[indices[i]]] = coeff->vec[indices[i]];
    }
  }
}

void interpol_loc(DOF_REAL_VEC *vec,
		  LOC_FCT_AT_QP fct, void *fct_data,
		  FLAGS fill_flags)
{
  FUNCNAME("interpol_loc");
  const FE_SPACE   *fe_space, *fe_chain;
  const BAS_FCTS   *bas_fcts;
  const DOF_ADMIN  *admin;
  const PARAMETRIC *parametric;
  EL_REAL_VEC      *vec_loc;

  if (!(fe_chain = fe_space = vec->fe_space)) {
    MSG("no dof admin in vec %s, skipping interpolation\n", NAME(vec));
    return;
  }

  if (!(admin = fe_space->admin)) {
    MSG("no dof admin in fe_space %s, skipping interpolation\n",
	NAME(fe_space));
    return;
  }
  
  if (!fct) {
    MSG("function that should be interpolated only pointer to NULL, ");
    print_msg("skipping interpolation\n");
    return;
  }

  if (!(bas_fcts = fe_space->bas_fcts)) {
    MSG("no basis functions in admin of vec %s, skipping interpolation\n", 
	NAME(vec));
    return;
  }

  if ((bas_fcts->phi_d == NULL && !bas_fcts->interpol)
      ||
      (bas_fcts->phi_d != NULL && !bas_fcts->interpol_dow)) {
    MSG("no function for interpolation on an element available\n");
    MSG("in basis functions of vec %s, skipping interpolation\n", NAME(vec));
    return;
  }
  if (!bas_fcts->get_dof_indices) {
    MSG("no function for getting dof's on an element available\n");
    MSG("in basis functions of vec %s, skipping interpolation\n", NAME(vec));
    return;
  }

  INIT_OBJECT(bas_fcts);

  FOREACH_DOF(fe_space,
	      vec->vec[dof] = HUGE_VAL,
	      vec = CHAIN_NEXT(vec, DOF_REAL_VEC));

  parametric = fe_space->mesh->parametric;
    
  if (!(admin->flags & ADM_PERIODIC)) {
    fill_flags |= FILL_NON_PERIODIC;
  }

  vec_loc = get_el_real_vec(bas_fcts);

  fill_flags |= bas_fcts->fill_flags;
  TRAVERSE_FIRST(fe_space->mesh, -1, CALL_LEAF_EL|fill_flags) {

    if (INIT_ELEMENT(el_info, bas_fcts) == INIT_EL_TAG_NULL) {
      continue;
    }

    if (parametric) {
      parametric->init_element(el_info, parametric);
    }

    CHAIN_DO(fe_space, const FE_SPACE) {
      interpol_el_single(vec, vec_loc, fct, fct_data, el_info, fe_space);
      vec_loc = CHAIN_NEXT(vec_loc, EL_REAL_VEC);
      vec     = CHAIN_NEXT(vec, DOF_REAL_VEC);
    } CHAIN_WHILE(fe_space, const FE_SPACE);

  } TRAVERSE_NEXT();

  free_el_real_vec(vec_loc);

  if (INIT_ELEMENT_NEEDED(bas_fcts)) {
    /* We possibly did not ran over all elementse, initialize any
     * left-over DOFs to 0.0.
     */
    FOREACH_DOF(fe_space,
		if (vec->vec[dof] == HUGE_VAL) {
		  vec->vec[dof] = 0.0;
		},
		vec = CHAIN_NEXT(vec, DOF_REAL_VEC));
  }
  FOREACH_FREE_DOF(fe_space,
		   if (dof < fe_space->admin->size_used) {
		     vec->vec[dof] = 0.0;
		   } else {
		     break;
		   },
		   vec = CHAIN_NEXT(vec, DOF_REAL_VEC));
}

void interpol(FCT_AT_X fct, DOF_REAL_VEC *vec)
{
  if (vec->fe_space->mesh->parametric) {
    interpol_loc(vec, _AI_inter_fct_loc_param, &fct, FILL_COORDS);
  } else {
    interpol_loc(vec, _AI_inter_fct_loc, &fct, FILL_COORDS);
  }
}

const REAL *_AI_inter_fct_loc_d(REAL_D result,
				const EL_INFO *el_info,
				const QUAD *quad, int iq,
				void *ud)
{
  const REAL *(*fct)(const REAL_D x, REAL_D result) =
    *(const REAL *(**)(const REAL_D x, REAL_D result))ud;
  REAL_D world;
  
  coord_to_world(el_info, quad->lambda[iq], world);

  return fct(world, result);
}

const REAL *_AI_inter_fct_loc_d_param(REAL_D result,
				      const EL_INFO *el_info,
				      const QUAD *quad, int iq,
				      void *ud)
{
  if ((el_info->fill_flag & FILL_COORDS) == 0) {
    const REAL *(*fct)(const REAL_D x, REAL_D result) =
      *(const REAL *(**)(const REAL_D x, REAL_D result))ud;
    const PARAMETRIC *parametric = el_info->mesh->parametric;
    REAL_D world;

    parametric->coord_to_world(el_info, NULL, 1, quad->lambda + iq,
			       (REAL_D *)world);
    return fct(world, result);
  } else {
    return _AI_inter_fct_loc_d(result, el_info, quad, iq, ud);
  }
}

static inline void
interpol_el_single_d(DOF_REAL_D_VEC *u_h, EL_REAL_D_VEC *coeff,
		     LOC_FCT_D_AT_QP fct, void *fct_data,
		     const EL_INFO *el_info, const FE_SPACE *fe_space)
{
  const BAS_FCTS *bas_fcts = fe_space->bas_fcts;
  int n_bas = bas_fcts->n_bas_fcts;
  DOF dofs[n_bas];
  int indices[n_bas];
  REAL *val;
  int i, n_indices = 0;

  GET_DOF_INDICES(bas_fcts, el_info->el, fe_space->admin, dofs);
  
  for (i = 0; i < n_bas; i++) {
    if ((val = u_h->vec[dofs[i]])[0] == HUGE_VAL) {
      indices[n_indices++] = i;
    } else {
      COPY_DOW(val, coeff->vec[i]);
    }
  }

  if (n_indices == n_bas) {
    INTERPOL_D(bas_fcts, coeff, el_info, -1, -1, NULL, fct, fct_data);
	
    for (i = 0; i < n_bas; i++) {
      COPY_DOW(coeff->vec[i], u_h->vec[dofs[i]]);
    }
  } else if (n_indices > 0) {
    INTERPOL_D(bas_fcts, coeff, el_info, -1, n_indices, indices, fct, fct_data);
	
    for (i = 0; i < n_indices; i++) {
      COPY_DOW(coeff->vec[indices[i]], u_h->vec[dofs[indices[i]]]);
    }
  }
}

static inline void
interpol_el_single_dow(DOF_REAL_VEC_D *u_h, EL_REAL_VEC_D *coeff,
		       LOC_FCT_D_AT_QP fct, void *fct_data,
		       const EL_INFO *el_info, const FE_SPACE *fe_space)
{
  if (u_h->stride != 1) {
    interpol_el_single_d((DOF_REAL_D_VEC *)u_h, (EL_REAL_D_VEC *)coeff,
			 fct, fct_data, el_info, fe_space);
  } else {
    const BAS_FCTS *bas_fcts = fe_space->bas_fcts;
    int n_bas = bas_fcts->n_bas_fcts;
    DOF dofs[n_bas];
    int indices[n_bas];
    REAL val;
    int i, n_indices = 0;

    GET_DOF_INDICES(bas_fcts, el_info->el, fe_space->admin, dofs);
  
    for (i = 0; i < n_bas; i++) {
      if ((val = u_h->vec[dofs[i]]) == HUGE_VAL) {
	indices[n_indices++] = i;
      } else {
	coeff->vec[i] = val;
      }
    }

    if (n_indices == n_bas) {
      INTERPOL_DOW(bas_fcts, coeff, el_info, -1, -1, NULL, fct, fct_data);
      
      for (i = 0; i < n_bas; i++) {
	u_h->vec[dofs[i]] = coeff->vec[i];
      }
    } else if (n_indices > 0) {
      INTERPOL_DOW(bas_fcts, coeff, el_info, -1,
		   n_indices, indices, fct, fct_data);
      
      for (i = 0; i < n_indices; i++) {
	u_h->vec[dofs[indices[i]]] = coeff->vec[indices[i]];
      }
    }
  }
}

void interpol_loc_dow(DOF_REAL_VEC_D *vec,
		      LOC_FCT_D_AT_QP fct, void *fct_data, FLAGS fill_flags)
{
  FUNCNAME("interpol_loc_dow");
  const FE_SPACE   *fe_space, *fe_chain;
  const BAS_FCTS   *bas_fcts;
  const DOF_ADMIN  *admin;
  const PARAMETRIC *parametric;
  EL_REAL_VEC_D    *vec_loc;

  if (!(fe_chain = fe_space = vec->fe_space)) {
    MSG("no dof admin in vec %s, skipping interpolation\n", NAME(vec));
    return;
  }
  if (fe_space->rdim != DIM_OF_WORLD) {
    ERROR_EXIT("Called for scalar finite element space.\n");
    return;
  }
  if (!(admin = fe_space->admin)) {
    MSG("no dof admin in fe_space %s, skipping interpolation\n",
	NAME(fe_space));
    return;
  }
  
  if (!fct) {
    MSG("function that should be interpolated only pointer to NULL, ");
    print_msg("skipping interpolation\n");
    return;
  }

  if (!(bas_fcts = fe_space->bas_fcts)) {
    MSG("no basis functions in admin of vec %s, skipping interpolation\n", 
	NAME(vec));
    return;
  }

  if ((bas_fcts->phi_d == NULL && !bas_fcts->interpol)
      ||
      (bas_fcts->phi_d != NULL && !bas_fcts->interpol_dow)) {
    MSG("no function for interpolation on an element available\n");
    MSG("in basis functions of vec %s, skipping interpolation\n", NAME(vec));
    return;
  }
  if (!bas_fcts->get_dof_indices) {
    MSG("no function for getting dof's on an element available\n");
    MSG("in basis functions of vec %s, skipping interpolation\n", NAME(vec));
    return;
  }

  INIT_OBJECT(bas_fcts);

  FOREACH_DOF_DOW(fe_space,
		  vec->vec[dof] = HUGE_VAL,
		  ((DOF_REAL_D_VEC *)vec)->vec[dof][0] = HUGE_VAL,
		  vec = CHAIN_NEXT(vec, DOF_REAL_VEC_D));

  parametric = fe_space->mesh->parametric;
    
  if (!(admin->flags & ADM_PERIODIC)) {
    fill_flags |= FILL_NON_PERIODIC;
  }

  vec_loc = get_el_real_vec_d(bas_fcts);

  fill_flags |= bas_fcts->fill_flags;
  TRAVERSE_FIRST(fe_space->mesh, -1, CALL_LEAF_EL|fill_flags) {

    if (INIT_ELEMENT(el_info, bas_fcts) == INIT_EL_TAG_NULL) {
      continue;
    }

    if (parametric) {
      parametric->init_element(el_info, parametric);
    }

    CHAIN_DO(fe_space, const FE_SPACE) {
      interpol_el_single_dow(vec, vec_loc, fct, fct_data, el_info, fe_space);
      vec_loc = CHAIN_NEXT(vec_loc, EL_REAL_VEC_D);
      vec     = CHAIN_NEXT(vec, DOF_REAL_VEC_D);
    } CHAIN_WHILE(fe_space, const FE_SPACE);

  } TRAVERSE_NEXT();

  free_el_real_vec_d(vec_loc);

  if (INIT_ELEMENT_NEEDED(bas_fcts)) {
    /* We possibly did not ran over all elementse, initialize any
     * left-over DOFs to 0.0.
     */
    FOREACH_DOF_DOW(fe_space,
		    if (vec->vec[dof] == HUGE_VAL) {
		      vec->vec[dof] = 0.0;
		    },
		    if (((DOF_REAL_D_VEC *)vec)->vec[dof][0] == HUGE_VAL) {
		      SET_DOW(0.0, ((DOF_REAL_D_VEC *)vec)->vec[dof]);
		    },
		    vec = CHAIN_NEXT(vec, DOF_REAL_VEC_D));
  }
  FOREACH_FREE_DOF_DOW(fe_space,
		       if (dof < fe_space->admin->size_used) {
			 vec->vec[dof] = 0.0;
		       } else {
			 break;
		       },
		       if (dof < fe_space->admin->size_used) {
			 SET_DOW(0.0, ((DOF_REAL_D_VEC *)vec)->vec[dof]);
		       } else {
			 break;
		       },
		       vec = CHAIN_NEXT(vec, DOF_REAL_VEC_D));
}

void interpol_dow(FCT_D_AT_X fct, DOF_REAL_VEC_D *vec)
{
  if (vec->fe_space->mesh->parametric) {
    interpol_loc_dow(vec, _AI_inter_fct_loc_d_param, (void *)&fct, FILL_COORDS);
  } else {
    interpol_loc_dow(vec, _AI_inter_fct_loc_d, (void *)&fct, FILL_COORDS);
  }
}

