/*******************************************************************************
 * ALBERTA:  an Adaptive multi Level finite element toolbox using
 *           Bisectioning refinement and Error control by Residual
 *           Techniques for scientific Applications
 *
 * file:     estimator.c
 *
 * description:  residual error estimator for elliptic and parabolic problems
 *
 *******************************************************************************
 *
 *  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 (1998-2009)
 *
 ******************************************************************************/

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

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

 /* If needed the estimators can be supplemented by additional
  * per-element contributions as needed. The general structure is like
  * follows:
  */
#if 0
{
  const void *est_handle;
  EST_EL_CACHE_D *el_cache;
  REAL est_el;
  
  est_handle = estimator_init(...);
  TRAVERSE_FIRST(mesh, -1, fill_flags) {
    est_el = est_el_d(el_info, est_handle);
#if needed
    est_el += /* additional stuff */;
#endif
    est_el_d_finish(est_el, est_handle);
  } TRAVERSE_NEXT();

  estimate = estimator_finish(..., est_handle)
    }
#endif

/* In order to reuse the code for the jump and element residuals we
 * use one data structure for both, ellipt_est() and head_est().
 */
struct est_data
{
  REAL (*element_est_fct)(const EL_INFO *el_info, struct est_data *data);

  const DOF_REAL_VEC *uh, *uh_old;
  const BAS_FCTS     *bas_fcts;
  PARAMETRIC         *parametric;

  const REAL_D       (*A);
  int                is_diag;

  /* Lower-order terms + rhs */
  REAL               (*f_lower_order)(const EL_INFO *el_info,
				      const QUAD *quad,
				      int qp,
				      REAL uh_qp,
				      const REAL_D grduh_qp,
				      REAL time);
  FLAGS              f_flags; /* FILL_UH and/or FILL_GRD_UH */
  
  /* Difference to targeted Neumann boundary counditions*/
  REAL               (*gn)(const EL_INFO *el_info,
			   const QUAD *quad,
			   int qp,
			   REAL uh_qp,
			   const REAL_D normal,
			   REAL time);
  FLAGS              gn_flags;

  BNDRY_FLAGS        dirichlet_bndry; /* classification for Dirichlet 
				       * boundary.
				       */

  NORM               norm;            /* estimated norm: H1_NORM/L2_NORM */

  const QUAD_FAST      *quad_fast;
  const WALL_QUAD_FAST *wall_quad_fast; /* wall integration */

  REAL             *(*rw_est)(EL *);
  REAL             *(*rw_estc)(EL *);

  EL_REAL_VEC      *uh_el;          /* vector for storing uh on el */
  EL_REAL_VEC      *uh_neigh;       /* vector for storing uh on neighbour */
  EL_REAL_VEC      *uh_old_el;      /* vector for storing uh on el */

  REAL             *uh_qp;
  REAL             *uh_old_qp;
  REAL_D           *grd_uh_qp;
  REAL_DD          *D2_uh_qp;

 /* for easy clean-up and efficient _AND_ convenient allocation */
  SCRATCH_MEM      scratch;

  REAL             time, timestep;

  REAL             C0, C1, C2, C3;  /* interior, jump, coarsen, time coefs */
  REAL             est_sum;
  REAL             est_max;
  REAL             est_t_sum;
};

#define EST_ALLOC(data, n, t)				\
  (t *)SCRATCH_MEM_ALLOC((data)->scratch, (n), t)

REAL element_est(const EL_INFO *el_info, const void *est_handle)
{
  struct est_data *data = (struct est_data *)est_handle;
  
  return data->element_est_fct(el_info, data);
}

void element_est_finish(const EL_INFO *el_info,
			REAL est_el, const void *est_handle)
{
  struct est_data *data = (struct est_data *)est_handle;

  /* if rw_est, write indicator to element */
  if (data->rw_est) *data->rw_est(el_info->el) = est_el;

  data->est_sum += est_el;
  data->est_max = MAX(data->est_max, est_el);

  el_info->el->mark = 0; /* all contributions are computed! */
}

const REAL *element_est_uh(const void *est_handle)
{
  struct est_data *data = (struct est_data *)est_handle;

  return data->uh_qp;
}

const REAL_D *element_est_grd_uh(const void *est_handle)
{
  struct est_data *data = (struct est_data *)est_handle;

  return (const REAL_D *)data->grd_uh_qp;
}

const EL_REAL_VEC *element_est_uh_loc(const void *est_handle)
{
  struct est_data *data = (struct est_data *)est_handle;

  return data->uh_old_el;
}

const EL_REAL_VEC *element_est_uh_old_loc(const void *est_handle)
{
  struct est_data *data = (struct est_data *)est_handle;

  return data->uh_el;
}

static inline REAL h2_from_det(int dim, REAL det)
{
  FUNCNAME("h2_from_det");

  switch(dim) {
  case 1:
    return det*det;
  case 2:
    return det;
  case 3:
    return pow(det, 2.0/3.0);
  default:
    ERROR_EXIT("Illegal dim!\n");
    return 0.0; /* shut up the compiler */
  }
}

static inline bool is_diag_matrix(const REAL_DD A)
{
  int i,j ;

  for (i = 0; i < DIM_OF_WORLD; i++)
    for (j = i+1; j < DIM_OF_WORLD; j++)
      if (ABS(A[i][j]) > 1.e-25 || ABS(A[j][i]) > 1.e-25)
	return false;

  return true;
}

/*******************************************************************************
 * element residual:  C0*h_S^2*||-div A nabla u^h + r||_L^2(S)  (H^1)
 *                    C0*h_S^4*||-div A nabla u^h + r||_L^2(S)  (L^2)
 ******************************************************************************/
FORCE_INLINE_ATTR
static inline REAL el_res2(const EL_INFO *el_info,
			   const EL_GEOM_CACHE *elgc,
			   bool el_param,
			   const PARAMETRIC *parametric,
			   REAL res_qp[],
			   struct est_data *data)
{
  int                 dim = el_info->mesh->dim;
  REAL                val, det_sum, h2;
  int                 iq, i, j;
  const QUAD_FAST     *quad_fast = data->quad_fast;
  const QUAD          *quad = quad_fast->quad;
  const QUAD_EL_CACHE *qelc = NULL;

  if (el_param) {
    qelc = fill_quad_el_cache(el_info, quad_fast->quad,
			      FILL_EL_QUAD_DET|
			      FILL_EL_QUAD_LAMBDA|
			      FILL_EL_QUAD_DLAMBDA);
    param_D2_uh_at_qp(data->D2_uh_qp,
		      quad_fast,
		      (const REAL_BD *)qelc->param.Lambda,
		      (const REAL_BDD *)qelc->param.DLambda,
		      data->uh_el);
    if (data->f_flags & INIT_UH) {
      uh_at_qp(data->uh_qp, quad_fast, data->uh_el);
    }
    if (data->f_flags & INIT_GRD_UH) {
      param_grd_uh_at_qp(data->grd_uh_qp,
			 quad_fast,
			 (const REAL_BD *)qelc->param.Lambda, data->uh_el);
    }
  } else {
    fill_el_geom_cache(el_info, FILL_EL_DET|FILL_EL_LAMBDA);
    if (quad_fast->bas_fcts->degree > 1) {
      D2_uh_at_qp(data->D2_uh_qp, quad_fast,
		  (const REAL_D *)elgc->Lambda, data->uh_el);
    }
    if (data->f_flags & INIT_UH) {
      uh_at_qp(data->uh_qp, quad_fast, data->uh_el);
    }
    if (data->f_flags & INIT_GRD_UH) {
      grd_uh_at_qp(data->grd_uh_qp, 
		   quad_fast, (const REAL_D *)elgc->Lambda, data->uh_el);
    }
  }

  /* res_qp may already contain other contribution, e.g. the
   * difference quotient w.r.t. to the time variable.
   */
  for (iq = 0; iq < quad->n_points; iq++) {
    if (data->f_lower_order) {
      res_qp[iq] += data->f_lower_order(el_info, quad, iq,
					data->uh_qp[iq], data->grd_uh_qp[iq],
					data->time);
    }

    if (quad_fast->bas_fcts->degree > 1) {
      if (data->is_diag) {
	for (i = 0; i < DIM_OF_WORLD; i++) {
	  res_qp[iq] -= data->A[i][i]*data->D2_uh_qp[iq][i][i];
	}
      } else {
	for (i = 0; i < DIM_OF_WORLD; i++) {
	  for (j = 0; j < DIM_OF_WORLD; j++) {
	    res_qp[iq] -= data->A[i][j]*data->D2_uh_qp[iq][i][j];
	  }
	}
      }
    }
    res_qp[iq] = SQR(res_qp[iq]);
  }

  val = 0.0;
  if (el_param) {
    det_sum = 0.0;
    for (iq = 0; iq < quad->n_points; iq++) {
      val     += qelc->param.det[iq] * quad->w[iq] * res_qp[iq];
      det_sum += qelc->param.det[iq] * quad->w[iq];
    }
    det_sum *= (REAL)DIM_FAC(dim);
  } else {
    for (iq = 0; iq < quad->n_points; iq++) {
      val += quad->w[iq] * res_qp[iq];
    }
    val     *= elgc->det;
    det_sum  = elgc->det;
  }
  
  h2 = h2_from_det(dim, det_sum);

  if (data->norm == L2_NORM) {
    val = data->C0*SQR(h2)*val;
  } else {
    val = data->C0*h2*val;
  }

  return val;
}

/*******************************************************************************
 *  wall residuals:  C1*h_S*||[A(u_h)]||_L^2(Gamma)^2          (H^1)
 *                   C1*h_S^3*||[A(u_h)]||_L^2(Gamma)^2    (L^2)
 *
 *  Since det_S = C*det_Gamma*h_S we use for det_Gamma*h_S the term
 *  0.5(det_S + det_S')
 *
 ******************************************************************************/

/* This is the version for mesh->dim == DIM_OF_WORLD. We assume
 * continuous Finite Elements here, so the jump of the tangential
 * derivatives is zero. This means that we simply can use jump of the
 * entire gradient. This spares the computation of the co-normal and
 * several other FLOPs.
 *
 * We nevertheless support parametric meshes, but the co-dimension is
 * assumed to be zero here.
 *
 * We also assume here that the mesh does not carry a periodic
 * structure (or u_h is non-periodic, respectively). Otherwise we have
 * to compute the jump of the normal derivative if the
 * wall-transformations consist of more than mere translations.
 */
FORCE_INLINE_ATTR
static inline REAL jump_res2_cd0(const EL_INFO *el_info, int wall,
				 const EL_GEOM_CACHE *elgc,
				 bool el_param,
				 const PARAMETRIC *parametric,
				 struct est_data *data)
{
  const WALL_QUAD_FAST *wqfast   = data->wall_quad_fast;
  int opp_v                      = el_info->opp_vertex[wall];
  const QUAD_FAST *el_qf         = wqfast->quad_fast[wall];
  const QUAD_FAST *neigh_qf      = get_neigh_quad_fast(el_info, wqfast, wall);
  const QUAD_EL_CACHE *qelc      = NULL;
  EL_INFO neigh_info[1];
  int     dim = el_info->mesh->dim;
  EL      *neigh = el_info->neigh[wall];
  int     i, iq;
  REAL_D  grd_uh_el[el_qf->quad->n_points_max];
  REAL_D  grd_uh_neigh[el_qf->quad->n_points_max];
  REAL    jump[el_qf->quad->n_points_max];
  REAL_BD Lambda_neigh[el_qf->quad->n_points_max];
  REAL    val, h2, det, det_neigh = 0.0, wall_det = 0.0, wall_vol;
  bool    neigh_param;

  if (el_param) {
    qelc = fill_quad_el_cache(el_info, el_qf->quad, 0U);
    param_grd_uh_at_qp(grd_uh_el,
		       el_qf, (const REAL_BD *)qelc->param.Lambda, data->uh_el);
  } else {
    grd_uh_at_qp(grd_uh_el, el_qf, (const REAL_D *)elgc->Lambda, data->uh_el);
  }

  fill_neigh_el_info(neigh_info, el_info, wall, elgc->rel_orientation[wall]);

  /* Call the parametric initializer before calling the quad-fast 
   * initializer.
   */
  neigh_param = parametric && parametric->init_element(neigh_info, parametric);
    
  if (INIT_ELEMENT(neigh_info, neigh_qf) == INIT_EL_TAG_NULL) {
    /* should not happen, actually, if so: perhaps the corresponding
     * wall should be handled by neumann_res2(). FIXME.
     */
    return 0.0;
  }

  fill_el_real_vec(data->uh_neigh, neigh, data->uh);

  if (neigh_param) {
    parametric->grd_lambda(neigh_info, neigh_qf->quad,
			   -1, NULL, Lambda_neigh, NULL, NULL);
    param_grd_uh_at_qp(grd_uh_neigh,
		       neigh_qf, (const REAL_BD *)Lambda_neigh, data->uh_neigh);

    if (!el_param) {
      wall_det = elgc->wall_det[wall];
    }
  } else {
    det_neigh = el_grd_lambda(neigh_info, Lambda_neigh[0]);
    grd_uh_at_qp(grd_uh_neigh,
		 neigh_qf, (const REAL_D *)Lambda_neigh[0], data->uh_neigh);
    if (parametric) {
      wall_det = get_wall_normal_dim(dim, neigh_info, opp_v, NULL);
    }
  }

  /* now eval the jump at all quadrature nodes */
  for (iq = 0; iq < el_qf->n_points; iq++) {
    REAL_D diff, Adiff;
    
    AXPBY_DOW(1.0, grd_uh_el[iq], -1.0, grd_uh_neigh[iq], diff);
    if (data->is_diag) {
      jump[iq] = 0.0;
      for (i = 0; i < DIM_OF_WORLD; i++) {
	jump[iq] += SQR(data->A[i][i]*diff[i]);
      }
    } else {
      SET_DOW(0.0, Adiff);
      MV_DOW(data->A, diff, Adiff);
      jump[iq] = SCP_DOW(Adiff, Adiff);
    }
  }

  val = 0.0;
  if (parametric) {
    if (el_param && neigh_param) {
      /* only if both elements are parametric the dets can vary over the wall */
      wall_vol = 0.0;
      for (iq = 0; iq < el_qf->n_points; iq++) {
	val  += qelc->param.wall_det[iq]*el_qf->w[iq]*jump[iq];
	wall_vol += qelc->param.wall_det[iq]*el_qf->w[iq];
      }
      h2 = h2_from_det(dim-1, wall_vol*(REAL)DIM_FAC(dim-1));
      val *= sqrt(h2);
    } else {
      /* Either one of the neighbours is parametric, so we cannot take
       * the mean-value of both dets -- _or_ none of the two elements
       * is parametric, so taking the mean of the two dets would yield
       * different constants for parametric and non-parametric
       * elements.
       */
      wall_vol = 0.0;
      for (iq = 0; iq < el_qf->n_points; iq++) {
	val      += el_qf->w[iq]*jump[iq];
	wall_vol += el_qf->w[iq];
      }
      wall_vol *= wall_det;
      h2 = h2_from_det(dim-1, wall_vol*(REAL)DIM_FAC(dim-1));
      val *= sqrt(h2) * wall_det;
    }
  } else {
    for (iq = 0; iq < el_qf->n_points; iq++) {
      val += el_qf->w[iq]*jump[iq];
    }
    val *= (det = 0.5*(elgc->det + det_neigh));
    h2 = h2_from_det(dim, det);
  }

  if (data->norm == L2_NORM) {
    return data->C1 * h2 * val;
  } else {
    return data->C1 * val;
  }
}

/* little helper function which computes the normal component of
 * A\nabla u_h over a curved wall.
 */
static inline void normal_grd_param(REAL result[],
				    const REAL_DD A, bool is_diag,
				    const REAL_D normals[],
				    const REAL_D grd[], int nqp)
{
  int i, j, iq;

  for (iq = 0; iq < nqp; iq++) {
    result[iq] = 0.0;
    if (is_diag) {
      for (i = 0; i < DIM_OF_WORLD; i++) {
	result[iq] += normals[iq][i]*A[i][i]*grd[iq][i];
      }
    } else {
      for (i = 0; i < DIM_OF_WORLD; i++) {
	for (j = 0; j < DIM_OF_WORLD; j++) {
	  result[iq] += normals[iq][i]*A[i][j]*grd[iq][j];
	}
      }
    }
  }
}

/* little helper function which computes the normal component of
 * A\nabla u_h over a straight wall (i.e. \nu=\const)
 */
static inline void normal_grd_straight(REAL result[],
				       const REAL_DD A, bool is_diag,
				       const REAL_D normal,
				       const REAL_D grd[], int nqp)
{
  int i, j, iq;

  for (iq = 0; iq < nqp; iq++) {
    result[iq] = 0.0;
    if (is_diag) {
      for (i = 0; i < DIM_OF_WORLD; i++) {
	result[iq] += normal[i]*A[i][i]*grd[iq][i];
      }
    } else {
      for (i = 0; i < DIM_OF_WORLD; i++) {
	for (j = 0; j < DIM_OF_WORLD; j++) {
	  result[iq] += normal[i]*A[i][j]*grd[iq][j];
	}
      }
    }
  }
}

/* The version for arbitrary co-dimension and periodic meshes. In this
 * case we really need to compute the jump of the normal
 * derivatives. So we need to compute both co-normals, on the element
 * and on the neighbour.
 *
 * We support affine and parametric (curved) meshes here.
 *
 * Taking only the jump of the normal derivatives means that the
 * geometry approximation does not enter here.
 */
FORCE_INLINE_ATTR
static inline REAL jump_res2_cdN(const EL_INFO *el_info, int wall,
				 const EL_GEOM_CACHE *elgc,
				 bool el_param,
				 const PARAMETRIC *parametric,
				 struct est_data *data)
{
  const WALL_QUAD_FAST *wqfast   = data->wall_quad_fast;
  int opp_v                      = el_info->opp_vertex[wall];
  const QUAD_FAST *el_qf         = wqfast->quad_fast[wall];
  const QUAD_FAST *neigh_qf      = get_neigh_quad_fast(el_info, wqfast, wall);
  const QUAD_EL_CACHE *qelc      = NULL;
  EL_INFO neigh_info[1];
  int     dim = el_info->mesh->dim;
  EL      *neigh = el_info->neigh[wall];
  int     iq;
  REAL    ngrd_uh_el[el_qf->quad->n_points_max];
  REAL    ngrd_uh_neigh[el_qf->quad->n_points_max];
  REAL    jump[el_qf->quad->n_points_max];
  REAL_BD Lambda_neigh[el_qf->quad->n_points_max];
  REAL    val, h2, det, det_neigh = 0.0, wall_det = 0.0, wall_vol;
  bool    neigh_param;

  fill_neigh_el_info(neigh_info, el_info, wall, elgc->rel_orientation[wall]);

  /* Call the parametric initializer before calling the quad-fast 
   * initializer.
   */
  neigh_param = parametric && parametric->init_element(neigh_info, parametric);
    
  if (INIT_ELEMENT(neigh_info, neigh_qf) == INIT_EL_TAG_NULL) {
    /* should not happen, actually, if so: perhaps the corresponding
     * wall should be handled by neumann_res2(). FIXME.
     */
    return 0.0;
  }

  fill_el_real_vec(data->uh_neigh, neigh, data->uh);

  if (el_param) {
    REAL_D grd_uh_el[el_qf->quad->n_points_max];

    qelc = fill_quad_el_cache(el_info, el_qf->quad, 0U);
    param_grd_uh_at_qp(grd_uh_el,
		       el_qf, (const REAL_BD *)qelc->param.Lambda, data->uh_el);
    normal_grd_param(ngrd_uh_el, data->A, data->is_diag,
		     (const REAL_D *)qelc->param.wall_normal,
		     (const REAL_D *)grd_uh_el, el_qf->n_points);
  } else {
    REAL_D grd_uh_el[el_qf->quad->n_points_max];

    grd_uh_at_qp(grd_uh_el,
		 el_qf, (const REAL_D *)elgc->Lambda, data->uh_el);
    normal_grd_straight(ngrd_uh_el, data->A, data->is_diag,
			elgc->wall_normal[wall],
			(const REAL_D *)grd_uh_el, el_qf->n_points);
  }

  if (neigh_param) {
    REAL_D wall_normal_neigh[el_qf->quad->n_points_max];
    REAL_D grd_uh_neigh[el_qf->quad->n_points_max];

    parametric->grd_lambda(neigh_info, neigh_qf->quad,
			   -1, NULL, Lambda_neigh, NULL, NULL);
    param_grd_uh_at_qp(grd_uh_neigh,
		       neigh_qf, (const REAL_BD *)Lambda_neigh, data->uh_neigh);
    parametric->wall_normal(neigh_info, opp_v, neigh_qf->quad, -1, NULL,
			    wall_normal_neigh, NULL, NULL, NULL);
    normal_grd_param(ngrd_uh_neigh, data->A, data->is_diag,
		     (const REAL_D *)wall_normal_neigh,
		     (const REAL_D *)grd_uh_neigh, el_qf->n_points);
    if (!el_param) {
      wall_det = elgc->wall_det[wall];
    }
  } else {
    REAL_D wall_normal_neigh;
    REAL_D grd_uh_neigh[el_qf->quad->n_points_max];

    det_neigh = el_grd_lambda(neigh_info, Lambda_neigh[0]);
    grd_uh_at_qp(grd_uh_neigh,
		 neigh_qf, (const REAL_D *)Lambda_neigh[0], data->uh_neigh);
    wall_det = get_wall_normal_dim(dim, neigh_info, opp_v, wall_normal_neigh);
    normal_grd_straight(ngrd_uh_neigh, data->A, data->is_diag,
			wall_normal_neigh, (const REAL_D *)grd_uh_neigh,
			el_qf->n_points);
  }

  /* now eval the jump at all quadrature nodes
   *
   * NOTE: "+" is correct.
   */
  for (iq = 0; iq < el_qf->n_points; iq++) {
    jump[iq] = SQR(ngrd_uh_el[iq] + ngrd_uh_neigh[iq]);
  }

  val = 0.0;
  if (parametric) {
    if (el_param && neigh_param) {
      /* only if both elements are parametric the dets can vary over the wall */
      wall_vol = 0.0;
      for (iq = 0; iq < el_qf->n_points; iq++) {
	val  += qelc->param.wall_det[iq]*el_qf->w[iq]*jump[iq];
	wall_vol += qelc->param.wall_det[iq]*el_qf->w[iq];
      }
      h2 = h2_from_det(dim-1, wall_vol*(REAL)DIM_FAC(dim-1));
      val *= sqrt(h2);
    } else {
      /* Either one of the neighbours is parametric, so we cannot take
       * the mean-value of both dets -- _or_ none of the two elements
       * is parametric, so taking the mean of the two dets would yield
       * different constants for parametric and non-parametric
       * elements.
       */
      wall_vol = 0.0;
      for (iq = 0; iq < el_qf->n_points; iq++) {
	val      += el_qf->w[iq]*jump[iq];
	wall_vol += el_qf->w[iq];
      }
      wall_vol *= wall_det;
      h2 = h2_from_det(dim-1, wall_vol*(REAL)DIM_FAC(dim-1));
      val *= sqrt(h2) * wall_det;
    }
  } else {
    for (iq = 0; iq < el_qf->n_points; iq++) {
      val += el_qf->w[iq]*jump[iq];
    }
    val *= (det = 0.5*(elgc->det + det_neigh));
    h2 = h2_from_det(dim, det);
  }

  if (data->norm == L2_NORM) {
    return data->C1 * h2 * val;
  } else {
    return data->C1 * val;
  }
}

/*******************************************************************************
 *  neuman residual:  C1*h_S*||A(u_h).normal||_L^2(Gamma)^2    (H^1)
 *                    C1*h_S^3*||A(u_h).normal]||_L^2(Gamma)^2 (L^2)
 *
 *  Since det_S = C*det_Gamma*h_S we use for det_Gamma*h_S the term
 *  det_S
 ******************************************************************************/
FORCE_INLINE_ATTR
static inline REAL neumann_res2(const EL_INFO *el_info, int wall,
				const EL_GEOM_CACHE *elgc,
				bool el_param,
				const PARAMETRIC *parametric,
				struct est_data *data)
{
  const WALL_QUAD_FAST *wqfast = data->wall_quad_fast;
  const QUAD_FAST      *el_qf  = wqfast->quad_fast[wall];
  const QUAD_EL_CACHE  *qelc   = NULL;
  REAL_D grd_uh_el[el_qf->quad->n_points_max];
  REAL_D A_grd_uh[el_qf->quad->n_points_max];
  int    i, iq, dim = el_info->mesh->dim;
  REAL   val, h2;

  if (el_param) {
    qelc = fill_quad_el_cache(el_info, el_qf->quad, 0U);
    param_grd_uh_at_qp(grd_uh_el,
		       el_qf, (const REAL_BD *)qelc->param.Lambda, data->uh_el);
  } else {
    grd_uh_at_qp(grd_uh_el,
		 el_qf, (const REAL_D *)elgc->Lambda, data->uh_el);
  }

  for (iq = 0; iq < el_qf->n_points; iq++) {
    if (data->is_diag) {
      for (i = 0; i < DIM_OF_WORLD; i++) {
	A_grd_uh[iq][i] = data->A[i][i]*grd_uh_el[iq][i];
      }
    } else {
      SET_DOW(0.0, A_grd_uh[iq]);
      MV_DOW(data->A, grd_uh_el[iq], A_grd_uh[iq]);
    }
  }
  
  val = 0.0;
  if (el_param) {
    REAL wall_vol = 0.0;
    
    for (iq = 0; iq < el_qf->n_points; iq++) {
      REAL valqp = SCP_DOW(qelc->param.wall_normal[iq], A_grd_uh[iq]);

      if (data->gn) {
	REAL uh_qp = 0.0;
      
	if (data->gn_flags & INIT_UH) {
	  uh_qp = eval_uh_fast(data->uh_el, el_qf, iq);
	}
	valqp -= data->gn(el_info, el_qf->quad, iq,
			  uh_qp, qelc->param.wall_normal[iq], data->time);
      }

      val += qelc->param.wall_det[iq]*el_qf->w[iq] * SQR(valqp);

      wall_vol += qelc->param.wall_det[iq]*el_qf->w[iq];
    }
    h2 = h2_from_det(dim-1, wall_vol*(REAL)DIM_FAC(dim-1));
    val *= sqrt(h2);
  } else {
    for (iq = 0; iq < el_qf->n_points; iq++) {
      REAL valqp = SCP_DOW(elgc->wall_normal[wall], A_grd_uh[iq]);
      if (data->gn) {
	REAL uh_qp = 0.0;
	if (data->gn_flags & INIT_UH) {
	  uh_qp = eval_uh_fast(data->uh_el, el_qf, iq);
	}
	valqp -= data->gn(el_info, el_qf->quad, iq,
			  uh_qp, elgc->wall_normal[wall], data->time);
      }
      val += el_qf->w[iq] * SQR(valqp);
    }
    val *= elgc->det;
    h2 = h2_from_det(dim, elgc->det);
  }

  if (data->norm == L2_NORM) {
    return data->C1*h2*val;
  } else {
    return data->C1*val;
  }
}

/* Jump and Neumann residuals.
 *
 * if rw_est is NULL, compute jump for both neighbouring elements only
 * this allows correct computation of est_max if rw_est is not NULL,
 * compute jump only once for each edge/wall if neigh->mark: estimate
 * not computed on neighbour.
 */
FORCE_INLINE_ATTR
static inline REAL wall_res2(const EL_INFO *el_info,
			     const EL_GEOM_CACHE *elgc,
			     bool el_param,
			     const PARAMETRIC *parametric,
			     struct est_data *data)
{
  const WALL_QUAD_FAST *wqfast = data->wall_quad_fast;
  const QUAD_FAST      *el_bqf;
  int walls[N_WALLS_MAX];
  bool slow[N_WALLS_MAX];
  int n_walls;
  EL *neigh;
  REAL wall_est;
  int wall, wi, dim = el_info->mesh->dim;
  FLAGS all_wall_flags;

  /* First round: fill the geometry caches for this element. Once we
   * have done so we can wildly call element-initializers for the
   * neighbour elements because the information for this element is
   * still present in the caches.
   */

  if (el_param) {
    all_wall_flags = FILL_EL_QUAD_LAMBDA;
    all_wall_flags |= (dim != DIM_OF_WORLD)
      ? FILL_EL_QUAD_WALL_NORMAL : FILL_EL_QUAD_WALL_DET;
  } else {
    all_wall_flags = FILL_EL_DET|FILL_EL_LAMBDA;
  }
  
  wall_est = 0.0;
  n_walls = 0;
  for (wall = 0; wall < N_NEIGH(dim); wall++) {

    if ((neigh = el_info->neigh[wall]) != NULL &&
	data->rw_est && neigh->mark == 0) {
      continue; /* already computed on neighbour */
    }

    if (BNDRY_FLAGS_IS_AT_BNDRY(data->dirichlet_bndry,
				wall_bound(el_info, wall))) {
      continue; /* Dirichlet boundary */
    }

    fill_el_geom_cache(el_info, FILL_EL_WALL_REL_ORIENTATION(wall));
    el_bqf = wqfast->quad_fast[wall];
    if (INIT_ELEMENT(el_info, el_bqf) == INIT_EL_TAG_NULL) {
      continue;
    }

    walls[n_walls++] = wall;
    slow[wall] = false;
    if (el_param) {
      FLAGS wall_flags = all_wall_flags;

      if (neigh == NULL || wall_trafo(el_info, wall) != NULL) {
	wall_flags |= FILL_EL_QUAD_WALL_NORMAL;
      }
      slow[wall] = wall_flags & FILL_EL_QUAD_WALL_NORMAL;
      
      fill_quad_el_cache(el_info, el_bqf->quad, wall_flags);
    } else {
      if (dim != DIM_OF_WORLD || neigh == NULL /* ||
	  ((el_info->fill_flags & FILL_WALL_TRAFOS) &&
	  el_info->wall_trafo[wall] != NULL) */) {
	all_wall_flags |= FILL_EL_WALL_NORMAL(wall);
      } else if (parametric) {
	all_wall_flags |= FILL_EL_WALL_DET(wall);
      }
      slow[wall] = all_wall_flags & FILL_EL_WALL_NORMAL(wall);
    }
  }
  
  if (!el_param) {
    fill_el_geom_cache(el_info, all_wall_flags);
  }

  /* Now loop again; jump_res2() and neumann_res2() may now access
   * any kind of initializer on neighbour elements.
   */
  for (wi = 0; wi < n_walls; wi++) {
    wall = walls[wi];
    if ((neigh = el_info->neigh[wall])) {
      REAL est = slow[wall]
	? jump_res2_cdN(el_info, wall, elgc, el_param, parametric, data)
	: jump_res2_cd0(el_info, wall, elgc, el_param, parametric, data);

      wall_est += est;
      /* if rw_est, add neighbour contribution to neigbour indicator */
      if (data->rw_est) {
	*data->rw_est(neigh) += est;
      }
    } else if (!BNDRY_FLAGS_IS_AT_BNDRY(data->dirichlet_bndry,
					wall_bound(el_info, wall))) {
      /* For the estimator "Neumann" rather means "not Dirichlet" */
      wall_est += neumann_res2(el_info, wall, elgc, el_param, parametric, data);
    }
  }

  return wall_est;
}

/*******************************************************************************
 *  residual type estimator for quasi linear elliptic problem:
 *   -\div A \nabla u + f(.,u,\nabla u) = 0
 ******************************************************************************/
FORCE_INLINE_ATTR
static inline REAL ellipt_est_fct(const EL_INFO *el_info,
				  const PARAMETRIC *parametric,
				  struct est_data *data)
{
  /* FUNCNAME("ellipt_est_fct"); */
  EL            *el = el_info->el;
  REAL          est_el;
  INIT_EL_TAG   qf_tag;
  INIT_EL_TAG   bqf_tag;
  const EL_GEOM_CACHE *elgc;
  const QUAD_FAST *quad_fast = data->quad_fast;
  bool el_param;
  U_CHAR quad_flags;

  qf_tag  = INIT_ELEMENT(el_info, data->quad_fast);
  if (data->C1 > 0.0) {
    bqf_tag = INIT_ELEMENT(el_info, data->wall_quad_fast);
  } else {
    bqf_tag = INIT_EL_TAG_NULL;
  }

  if (qf_tag == INIT_EL_TAG_NULL && bqf_tag == INIT_EL_TAG_NULL) {
    return 0.0; /* nothing to do */
  }

  /* if rw_est, then there might already be contributions from jumps */
  est_el = data->rw_est ? *data->rw_est(el) : 0.0;

  fill_el_real_vec(data->uh_el, el, data->uh);

  el_param = parametric && parametric->init_element(el_info, parametric);

  if (el_param) {
    quad_flags = INIT_D2_PHI|INIT_GRD_PHI;
  } else if (data->bas_fcts->degree > 1) {
    quad_flags = INIT_D2_PHI;
  } else {
    quad_flags = 0;
  }
  
  if ((quad_fast->init_flag & quad_flags) != quad_flags) {
    /* For curved elements we _ALWAYS_ need the 2nd derivatives */
    data->quad_fast = quad_fast = get_quad_fast(
      data->bas_fcts, quad_fast->quad, quad_fast->init_flag|quad_flags);
    qf_tag = INIT_ELEMENT(el_info, quad_fast);
  }

  elgc = fill_el_geom_cache(el_info, 0U);

  /* element residuals */
  if (data->C0 > 0.0 && qf_tag != INIT_EL_TAG_NULL) {
    REAL res_qp[quad_fast->n_points_max];

    memset(res_qp, 0, sizeof(res_qp)); /* fix this if ever FP 0 != 0 */
    est_el += el_res2(el_info, elgc, el_param, parametric, res_qp,data);
  }

  /* wall residuals */
  if (bqf_tag != INIT_EL_TAG_NULL) {
    est_el += wall_res2(el_info, elgc, el_param, parametric, data);
  }
  
  return est_el;
}

FLATTEN_ATTR
static REAL ellipt_est_fct_noparam(const EL_INFO *el_info,
				   struct est_data *data)
{
  return ellipt_est_fct(el_info, NULL, data);
}

FLATTEN_ATTR
static REAL ellipt_est_fct_param(const EL_INFO *el_info,
				 struct est_data *data)
{
  return ellipt_est_fct(el_info, el_info->mesh->parametric, data);
}

/******************************************************************************/

const void *ellipt_est_init(const DOF_REAL_VEC *uh, ADAPT_STAT *adapt,
			    REAL *(*rw_est)(EL *), REAL *(*rw_estc)(EL *),
			    const QUAD *quad,
			    const WALL_QUAD *wall_quad,
			    NORM norm,
			    REAL C[3],
			    const REAL_DD A,
			    const BNDRY_FLAGS dirichlet_bndry,
			    REAL (*f)(const EL_INFO *el_info,
				      const QUAD *quad,
				      int qp,
				      REAL uh_qp,
				      const REAL_D grduh_qp),
			    FLAGS f_flags,
			    REAL (*gn)(const EL_INFO *el_info,
				       const QUAD *quad,
				       int qp,
				       REAL uh_qp,
				       const REAL_D normal),
			    FLAGS gn_flags)
{
  FUNCNAME("ellipt_est_init");
  struct est_data *data;
  int    degree, dim;
  MESH   *mesh;
  FLAGS  qf_flags = 0;
  SCRATCH_MEM scratch;

  if (!uh) {
    MSG("no discrete solution; doing nothing\n");
    return NULL;
  }
  
  SCRATCH_MEM_INIT(scratch);
  data = SCRATCH_MEM_CALLOC(scratch, 1, struct est_data);
  SCRATCH_MEM_CPY(data->scratch, scratch);

  mesh = uh->fe_space->mesh;
  dim = mesh->dim;

  data->uh         = uh;
  data->bas_fcts   = uh->fe_space->bas_fcts;
  data->parametric = mesh->parametric;
  data->A          = A;
  if (dirichlet_bndry) {
    BNDRY_FLAGS_CPY(data->dirichlet_bndry, dirichlet_bndry);
  } else {
    BNDRY_FLAGS_INIT(data->dirichlet_bndry);
  }

  INIT_OBJECT(data->bas_fcts);

  data->is_diag = is_diag_matrix(A);

  if (!data->is_diag && mesh->dim < DIM_OF_WORLD) {
    WARNING("Non-diagonal (in fact: non-scalar) constant coefficient "
	    "matrices will not work in general on manifolds.");
  }

  if (f) {
    data->f_lower_order = (REAL (*)(const EL_INFO *el_info,
				    const QUAD *quad,
				    int iq,
				    REAL uh_qp,
				    const REAL_D grduh_qp,
				    REAL time))f;
    data->f_flags = f_flags;
  }

  if (gn) {
    data->gn = (REAL (*)(const EL_INFO *el_info,
			 const QUAD *quad,
			 int qp, REAL uh_qp,
			 const REAL_D normal,
			 REAL time))gn;
    data->gn_flags = gn_flags;
  }

  if (quad == NULL) {
    degree = 2*data->bas_fcts->degree;
    quad = get_quadrature(dim, degree);
  } else {
    INIT_OBJECT(quad);
  }

  data->uh_el     = get_el_real_vec(uh->fe_space->bas_fcts);
  data->uh_neigh  = get_el_real_vec(uh->fe_space->bas_fcts);
  
  data->uh_qp     = EST_ALLOC(data, quad->n_points_max, REAL);
  data->grd_uh_qp = EST_ALLOC(data, quad->n_points_max, REAL_D);
  data->D2_uh_qp  = EST_ALLOC(data, quad->n_points_max, REAL_DD);
  
  if (f_flags & INIT_UH) {
    qf_flags |= INIT_PHI;
  }
  if (f_flags & INIT_GRD_UH) {
    qf_flags |= INIT_GRD_PHI;
  }

  /* INIT_D2_PHI on demand in est_fct() */
  data->quad_fast = get_quad_fast(data->bas_fcts, quad, qf_flags);
  
  if (C) {
    data->C0 = C[0] > 1.e-25 ? SQR(C[0]) : 0.0;
    data->C1 = C[1] > 1.e-25 ? SQR(C[1]) : 0.0;
    data->C2 = C[2] > 1.e-25 ? SQR(C[2]) : 0.0;
  } else {
    data->C0 = data->C1 = data->C2 = 1.0;
  }

  if (dim == 1) {
    data->C1 = 0.0;
  }

  if (data->C1 > 0.0) {
    /* We need a vertex index to orient walls. */
    get_vertex_admin(mesh, ADM_PERIODIC);
    if (wall_quad == NULL) {
      degree = 2*data->bas_fcts->degree;
      wall_quad = get_wall_quad(dim, degree);
    }
    data->wall_quad_fast =
      get_wall_quad_fast(data->bas_fcts, wall_quad,
			 INIT_GRD_PHI
			 | (gn && (gn_flags & INIT_UH) ? INIT_PHI : 0));
  }

  data->rw_est  = rw_est;
  data->rw_estc = rw_estc;

  data->norm = norm;

  if (rw_est) { /****  clear error indicators   ******************************/
    TRAVERSE_FIRST(mesh, -1, CALL_LEAF_EL) {
      el_info->el->mark = 1;
      if (rw_est)  *rw_est(el_info->el)  = 0.0;
      if (rw_estc) *rw_estc(el_info->el) = 0.0;
    } TRAVERSE_NEXT();
  }

  data->est_sum = data->est_max = 0.0;

  data->element_est_fct =
    mesh->parametric ? ellipt_est_fct_param : ellipt_est_fct_noparam;

  return (const void *)data;
}

REAL ellipt_est_finish(ADAPT_STAT *adapt, const void *est_handle)
{
  struct est_data *data = (struct est_data *)est_handle;
  REAL est_sum;

  data->est_sum = sqrt(data->est_sum);
  if (adapt) {
    adapt->err_sum = data->est_sum;
    adapt->err_max = data->est_max;
  }

  est_sum = data->est_sum;
  
  free_el_real_vec(data->uh_el);
  free_el_real_vec(data->uh_neigh);

  SCRATCH_MEM_ZAP(data->scratch);

  return est_sum;
}

REAL ellipt_est(const DOF_REAL_VEC *uh,
		ADAPT_STAT *adapt,
		REAL *(*rw_est)(EL *), REAL *(*rw_estc)(EL *),
		int degree,
		NORM norm,
		REAL C[3],
		const REAL_DD A,
		const BNDRY_FLAGS dirichlet_bndry,
		REAL (*f)(const EL_INFO *el_info,
			  const QUAD *quad,
			  int qp,
			  REAL uh_qp,
			  const REAL_D grduh_qp),
		FLAGS f_flags,
		REAL (*gn)(const EL_INFO *el_info,
			   const QUAD *quad,
			   int qp,
			   REAL uh_qp,
			   const REAL_D normal),
		FLAGS gn_flags)
{
  const void *est_handle;
  MESH *mesh = uh->fe_space->mesh;
  FLAGS fill_flags;
  REAL est_el;
  const QUAD *quad = NULL;
  const WALL_QUAD *wall_quad = NULL;

  if (degree >= 0) {
    int dim = uh->fe_space->mesh->dim;
    
    quad = get_quadrature(dim, degree);
    if (C[1] != 0.0) {
      wall_quad = get_wall_quad(dim, degree);
    }
  }
  
  est_handle = ellipt_est_init(uh, adapt, rw_est, rw_estc, quad, wall_quad,
			       norm, C, A, dirichlet_bndry,
			       f, f_flags, gn, gn_flags);

  if (mesh->dim == 1) {
    fill_flags = FILL_COORDS|CALL_LEAF_EL;
  } else {
    fill_flags =
      FILL_NEIGH|FILL_COORDS|FILL_OPP_COORDS|FILL_MACRO_WALLS|CALL_LEAF_EL;
  }

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

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

    est_el = element_est(el_info, est_handle);
    
#if 0
    uh_qp = element_est_uh(est_handle);
    grd_uh_qp = element_est_grd_uh(est_handle);
    est_el += stuff;
#endif

    element_est_finish(el_info, est_el, est_handle);    

  } TRAVERSE_NEXT();
  
  return ellipt_est_finish(adapt, est_handle);
}

/*******************************************************************************
 *
 * error estimator for (nonlinear) heat equation:
 *              u_t - div A grad u + f(x,t,u,grad u) = 0
 *
 * eta_h = C[0]*||h^2 ((U - Uold)/tau - div A grad U + f(x,t,U,grad U))||
 *           + C[1]*|||h^1.5 [A grad U]|||
 * eta_c = C[2]*||(Uold - Uold_coarse)/tau||
 * eta_t = C[3]*||U - Uold||
 *
 * heat_est() return value is the TIME DISCRETIZATION ESTIMATE, eta_t
 *
 ******************************************************************************/

/*******************************************************************************
 * element residual:  C0*h_S^2*|| U_t -div A nabla u^h + r ||_L^2(S)
 *******************************************************************************
 * time residual:  C3*|| U - Uold ||_L^2(S)
 ******************************************************************************/
FORCE_INLINE_ATTR
static inline REAL heat_el_res2(const EL_INFO *el_info,
				const EL_GEOM_CACHE *elgc,
				bool el_param,
				const PARAMETRIC *parametric,
				struct est_data *data)
{
  REAL            val;
  int             iq;
  const REAL      *uh_qp = NULL, *uh_old_qp = NULL;
  const QUAD_FAST *quad_fast = data->quad_fast;
  const QUAD      *quad = quad_fast->quad;
  const QUAD_EL_CACHE *qelc;
  REAL res_qp[quad->n_points_max];

  uh_old_qp = uh_at_qp(data->uh_old_qp, quad_fast, data->uh_old_el);
  uh_qp     = uh_at_qp(data->uh_qp, quad_fast, data->uh_el);

  if (data->C3 > 0.0) {
    val = 0.0;
    if (el_param) {
      qelc = fill_quad_el_cache(el_info, quad_fast->quad, FILL_EL_QUAD_DET);
      for (iq = 0; iq < quad->n_points; iq++) {
	res_qp[iq]  = uh_qp[iq] - uh_old_qp[iq];
	val        += quad->w[iq] * qelc->param.det[iq] * SQR(res_qp[iq]);
	if (data->C0 > 0.0) {
	  res_qp[iq] /= data->timestep;
	}
      }
    } else {
      fill_el_geom_cache(el_info, FILL_EL_DET);
      for (iq = 0; iq < quad->n_points; iq++) {
	res_qp[iq]  = uh_qp[iq] - uh_old_qp[iq];
	val        += quad->w[iq] * SQR(res_qp[iq]);
	if (data->C0 > 0.0) {
	  res_qp[iq] /= data->timestep;
	}
      }
      val *= elgc->det;
    }
    data->est_t_sum += data->C3*val;
  } else if (data->C0 > 0.0) { /* we still need (uh - uh_old) / tau */
    for (iq = 0; iq < quad->n_points; iq++) {
      res_qp[iq] = (uh_qp[iq] - uh_old_qp[iq]) / data->timestep;
    }
  }

  if (data->C0 <= 0.0) {
    return 0.0;
  }
  
  return el_res2(el_info, elgc, el_param, parametric, res_qp, data);
}

/******************************************************************************/

FORCE_INLINE_ATTR
static inline REAL heat_est_fct(const EL_INFO *el_info,
				const PARAMETRIC *parametric,
				void *vdata)
{
  struct est_data *data = (struct est_data *)vdata;
  EL           *el = el_info->el;
  REAL         est_el;
  INIT_EL_TAG  qf_tag;
  INIT_EL_TAG  wqf_tag;
  const EL_GEOM_CACHE *elgc;
  const QUAD_FAST *quad_fast = data->quad_fast;
  bool el_param;
  U_CHAR quad_flags;

  qf_tag  = INIT_ELEMENT(el_info, quad_fast);
  if (data->C1 > 0.0) {
    wqf_tag = INIT_ELEMENT(el_info, data->wall_quad_fast);
  } else {
    wqf_tag = INIT_EL_TAG_NULL;
  }

  if (qf_tag == INIT_EL_TAG_NULL && wqf_tag == INIT_EL_TAG_NULL) {
    return 0.0; /* nothing to do */
  }

  /* if rw_est, then there might already be contributions from jumps */
  est_el = data->rw_est ? *data->rw_est(el) : 0.0;

  fill_el_real_vec(data->uh_el, el, data->uh);
  fill_el_real_vec(data->uh_old_el, el, data->uh_old);

  el_param = parametric && parametric->init_element(el_info, parametric);

  if (el_param) {
    quad_flags = INIT_D2_PHI|INIT_GRD_PHI;
  } else if (data->bas_fcts->degree > 1) {
    quad_flags = INIT_D2_PHI;
  } else {
    quad_flags = 0;
  }
  
  if ((quad_fast->init_flag & quad_flags) != quad_flags) {
    /* For curved elements we _ALWAYS_ need the 2nd derivatives */
    data->quad_fast = quad_fast = get_quad_fast(
      data->bas_fcts, quad_fast->quad, quad_fast->init_flag|quad_flags);
    qf_tag = INIT_ELEMENT(el_info, quad_fast);
  }

  elgc = fill_el_geom_cache(el_info, 0U);

  /* element and time residual  */
  if ((data->C0 > 0.0 || data->C3 > 0.0) && qf_tag != INIT_EL_TAG_NULL) {
    est_el += heat_el_res2(el_info, elgc, el_param, parametric, data);
  }

  /* wall residuals */
  if (wqf_tag != INIT_EL_TAG_NULL) {
    est_el += wall_res2(el_info, elgc, el_param, parametric, data);
  }

#if 0
  /* if rw_estc, calculate coarsening error estimate */
  if (data->rw_estc && data->C2 > 0.0) {
    *(*data->rw_estc)(el) = heat_estc_el(el_info, det, data);
  }
#endif

  return est_el;
}

FLATTEN_ATTR
static REAL heat_est_fct_noparam(const EL_INFO *el_info, struct est_data *data)
{
  return heat_est_fct(el_info, NULL, data);
}

FLATTEN_ATTR
static REAL heat_est_fct_param(const EL_INFO *el_info, struct est_data *data)
{
  return heat_est_fct(el_info, el_info->mesh->parametric, data);
}

/****************************************************************************/

const void *heat_est_init(const DOF_REAL_VEC *uh,
			  const DOF_REAL_VEC *uh_old,
			  ADAPT_INSTAT *adapt,
			  REAL *(*rw_est)(EL *), REAL *(*rw_estc)(EL *),
			  const QUAD *quad,
			  const WALL_QUAD *wall_quad,
			  REAL C[4],
			  const REAL_DD A,
			  const BNDRY_FLAGS dirichlet_bndry,
			  REAL (*f)(const EL_INFO *el_info,
				    const QUAD *quad,
				    int qp,
				    REAL uh_qp,
				    const REAL_D grduh_qp,
				    REAL time),
			  FLAGS f_flags,
			  REAL (*gn)(const EL_INFO *el_info,
				     const QUAD *quad,
				     int qp,
				     REAL uh_qp,
				     const REAL_D normal,
				     REAL time),
			  FLAGS gn_flags)
{
  FUNCNAME("heat_est_init");
  struct est_data *data;
  int    dim, degree;
  MESH   *mesh;
  FLAGS  qf_flags = INIT_PHI;
  SCRATCH_MEM scratch;

  if (!uh) {
    MSG("no discrete solution; doing nothing\n");
    return NULL;
  }

  if (!uh_old) {
    MSG("no discrete solution from previous timestep; doing nothing\n");
    /* here, initial error could be calculated... */
    return NULL;
  }

  SCRATCH_MEM_INIT(scratch);
  data = SCRATCH_MEM_CALLOC(scratch, 1, struct est_data);
  SCRATCH_MEM_CPY(data->scratch, scratch);

  mesh = uh->fe_space->mesh;
  dim = uh->fe_space->mesh->dim;

  data->uh         = uh;
  data->uh_old     = uh_old;
  data->bas_fcts   = uh->fe_space->bas_fcts;
  data->parametric = mesh->parametric;
  data->A          = A;
  if (dirichlet_bndry) {
    BNDRY_FLAGS_CPY(data->dirichlet_bndry, dirichlet_bndry);
  } else {
    BNDRY_FLAGS_INIT(data->dirichlet_bndry);
  }

  INIT_OBJECT(data->bas_fcts);

  data->is_diag = is_diag_matrix(A);

  if (!data->is_diag && mesh->dim < DIM_OF_WORLD) {
    WARNING("Non-diagonal (in fact: non-scalar) constant coefficient "
	    "matrices will not work in general on manifolds.");
  }

  if (f) {
    data->f_lower_order = f;
    data->f_flags = f_flags & ~INIT_UH; /* uh is computed anyway */
  }

  if (gn) {
    data->gn = gn;
    data->gn_flags = gn_flags;
  }
  
  if (quad == NULL) {
    degree = 2*data->bas_fcts->degree;
    quad = get_quadrature(dim, degree);
  } else {
    INIT_OBJECT(quad);
  }

  data->uh_el     = get_el_real_vec(uh->fe_space->bas_fcts);
  data->uh_neigh  = get_el_real_vec(uh->fe_space->bas_fcts);
  data->uh_old_el = get_el_real_vec(uh->fe_space->bas_fcts);
  data->uh_qp     = EST_ALLOC(data, quad->n_points_max, REAL);
  data->uh_old_qp = EST_ALLOC(data, quad->n_points_max, REAL);
  data->grd_uh_qp = EST_ALLOC(data, quad->n_points_max, REAL_D);
  data->D2_uh_qp  = EST_ALLOC(data, quad->n_points_max, REAL_DD);

  if (f_flags & INIT_GRD_UH) {
    qf_flags |= INIT_GRD_PHI;
  }

  data->quad_fast = get_quad_fast(data->bas_fcts, quad, qf_flags);

  data->rw_est  = rw_est;
  data->rw_estc = rw_estc;

  if (C) {
    data->C0    = C[0] > 1.e-25 ? SQR(C[0]) : 0.0;
    data->C1    = C[1] > 1.e-25 ? SQR(C[1]) : 0.0;
    data->C2    = C[2] > 1.e-25 ? SQR(C[2]) : 0.0;
    data->C3    = C[3] > 1.e-25 ? SQR(C[3]) : 0.0;
  } else {
    data->C0 = data->C1 = data->C2 = data->C3 = 1.0;
  }

  if (dim == 1) {
    data->C1 = 0.0;
  }

  if (data->C1 > 0.0) {
    /* We need vertex indices to orient walls. */
    get_vertex_admin(mesh, ADM_PERIODIC);
    if (wall_quad == NULL) {
      degree = 2*data->bas_fcts->degree;
      wall_quad = get_wall_quad(dim, degree);
    }
    data->wall_quad_fast =
      get_wall_quad_fast(data->bas_fcts, wall_quad,
			 INIT_GRD_PHI
			 | (gn && (gn_flags & INIT_UH) ? INIT_PHI : 0));
  }

  data->time = adapt->time;
  data->timestep = adapt->timestep;

  if (rw_est) { /****  clear error indicators   ******************************/
    TRAVERSE_FIRST(mesh, -1, CALL_LEAF_EL) {
      el_info->el->mark = 1;
      if (rw_est)  *rw_est(el_info->el)  = 0.0;
      if (rw_estc) *rw_estc(el_info->el) = 0.0;
    } TRAVERSE_NEXT();
  }

  data->est_sum = data->est_max = data->est_t_sum = 0.0;

  data->norm = L2_NORM;

  data->element_est_fct =
    mesh->parametric ? heat_est_fct_param : heat_est_fct_noparam;

  return (const void *)data;
}

REAL heat_est_finish(ADAPT_INSTAT *adapt, const void *est_handle)
{
  struct est_data *data = (struct est_data *)est_handle;
  REAL est_t_sum;

  data->est_sum   = sqrt(data->est_sum);
  data->est_t_sum = sqrt(data->est_t_sum);
  if (adapt) {
    adapt->adapt_space->err_sum = data->est_sum;
    adapt->adapt_space->err_max = data->est_max;
    /* adapt->err_t = data->est_t_sum; */
  }

  est_t_sum = data->est_t_sum;
  
  free_el_real_vec(data->uh_el);
  free_el_real_vec(data->uh_neigh);
  free_el_real_vec(data->uh_old_el);

  SCRATCH_MEM_ZAP(data->scratch);

  return est_t_sum;
}

REAL heat_est(const DOF_REAL_VEC *uh,
	      const DOF_REAL_VEC *uh_old,
	      ADAPT_INSTAT *adapt,
	      REAL *(*rw_est)(EL *), REAL *(*rw_estc)(EL *),
	      int degree,
	      REAL C[4],
	      const REAL_DD A,
	      const BNDRY_FLAGS dirichlet_bndry,
	      REAL (*f)(const EL_INFO *el_info,
			const QUAD *quad,
			int qp,
			REAL uh_qp,
			const REAL_D grduh_qp,
			REAL time),
	      FLAGS f_flags,
	      REAL (*gn)(const EL_INFO *el_info,
			 const QUAD *quad,
			 int qp,
			 REAL uh_qp,
			 const REAL_D normal,
			 REAL time),
	      FLAGS gn_flags)
{
  const void *est_handle;
  MESH *mesh = uh->fe_space->mesh;
  FLAGS fill_flags;
  REAL est_el;
  const QUAD *quad = NULL;
  const WALL_QUAD *wall_quad = NULL;

  if (degree >= 0) {
    int dim = uh->fe_space->mesh->dim;

    quad = get_quadrature(dim, degree);
    if (C[1] != 0.0) {
      wall_quad = get_wall_quad(dim, degree);
    }
  }
  
  est_handle = heat_est_init(uh, uh_old, adapt, rw_est, rw_estc,
			     quad, wall_quad, C,
			     A, dirichlet_bndry, f, f_flags, gn, gn_flags);

  if (mesh->dim == 1) {
    fill_flags = FILL_COORDS|CALL_LEAF_EL;
  } else {
    fill_flags =
      FILL_NEIGH|FILL_COORDS|FILL_OPP_COORDS|FILL_MACRO_WALLS|CALL_LEAF_EL;
  }

  if (mesh->is_periodic) {
    if (!(uh->fe_space->admin->flags & ADM_PERIODIC)) {
      fill_flags |= FILL_NON_PERIODIC;
    } else {
      fill_flags |= FILL_MACRO_WALLS;
    }
  }

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

    est_el = element_est(el_info, est_handle);
    
#if 0
    uh_qp = element_est_uh(est_handle);
    grd_uh_qp = element_est_grd_uh(est_handle);
    est_el += stuff;
#endif

    element_est_finish(el_info, est_el, est_handle);    

  } TRAVERSE_NEXT();

  return heat_est_finish(adapt, est_handle);
}

