/*******************************************************************************
 * ALBERTA:  an Adaptive multi Level finite element toolbox using
 *           Bisectioning refinement and Error control by Residual
 *           Techniques for scientific Applications
 *
 * file:     estimator_dowb.c
 *
 * description: residual error estimator for elliptic and parabolic
 * problems, the ugly block-matrix version for systems with
 * DIM_OF_WORLD many equations.
 *
 *******************************************************************************
 *
 *  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
 *             Universitaet Freiburg
 *             Hermann-Herder-Strasse 10
 *             79104 Freiburg, Germany
 *
 *  http://www.alberta-fem.de
 *
 *  (c) by A. Schmidt and K.G. Siebert (1996-2003),
 *         C.-J. Heine (2006-2009).
 *
 ******************************************************************************/

/* Coefficient matrix is a tensor, the principal part of the operator is
 *
 * \partial_i a_{ij}^{kl}\partial_j psi^l
 *
 * Symmetric gradient: needed for "stress boundary conditions", we need
 * as boundary term
 *
 * \int_\Gamma \phi^k (a_{ij}^{kl} + a_{kj}^{il}) \partial_j\psi^l \nu_i
 *
 * This term is generated (int. by parts) from the divergence like
 * term
 *
 * \int_\Omega \phi^k a_{kj}^{il}\partial_{ij} \psi^l
 *
 * For the common case of the Laplace operator the two terms collapse
 * into the usual symmetric gradient and the usual \grad\div\psi term.
 */

#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_dow(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().
 */

union Aunion {
  const REAL_DD (*real_dd)[DIM_OF_WORLD];
  const REAL_D  (*real_d)[DIM_OF_WORLD];
  const REAL    (*real)[DIM_OF_WORLD];
};

struct est_dowb_data
{
  REAL (*element_est_fct)(const EL_INFO *el_info, struct est_dowb_data *data);

  const DOF_REAL_VEC_D *uh;
  const DOF_REAL_VEC_D *uh_old;
  const BAS_FCTS     *bas_fcts;
  PARAMETRIC         *parametric;

  union Aunion       A;

  MATENT_TYPE        A_type; /* dowb_full, _diag, _scal */
  MATENT_TYPE        A_blocktype; /* type of the blocks */

  bool               sym_grad; /* symmetric gradient formulation */

  const REAL         *(*f_lower_order)(REAL_D result,
				       const EL_INFO *el_info,
				       const QUAD *quad,
				       int qp,
				       const REAL_D uh_qp,
				       const REAL_DD grduh_qp,
				       REAL time);
  FLAGS              f_flags;
  /* Difference to targeted Neumann boundary counditions*/
  const REAL         *(*gn)(REAL_D result,
			    const EL_INFO *el_info,
			    const QUAD *quad,
			    int qp,
			    const REAL_D uh_qp,
			    const REAL_D normal,
			    REAL time);
  FLAGS              gn_flags;

  BNDRY_FLAGS        dirichlet_bndry;

  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_D    *uh_el;          /* vector for storing uh on el         */
  EL_REAL_VEC_D    *uh_neigh;       /* vector for storing uh neigh         */
  EL_REAL_VEC_D    *uh_old_el;      /* vector for storing old uh on el     */

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

 /* for easy clean-up and efficient _AND_ convenient allocation */
  SCRATCH_MEM      scratch;
  
  REAL             time, inv_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_dow(const EL_INFO *el_info, const void *est_handle)
{
  struct est_dowb_data *data = (struct est_dowb_data *)est_handle;
  
  return data->element_est_fct(el_info, data);
}

void element_est_dow_finish(const EL_INFO *el_info,
			    REAL est_el, const void *est_handle)
{
  struct est_dowb_data *data = (struct est_dowb_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_D *element_est_uh_dow(const void *est_handle)
{
  struct est_dowb_data *data = (struct est_dowb_data *)est_handle;

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

const REAL_DD *element_est_grd_uh_dow(const void *est_handle)
{
  struct est_dowb_data *data = (struct est_dowb_data *)est_handle;

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

const EL_REAL_VEC_D *element_est_uh_loc_dow(const void *est_handle)
{
  struct est_dowb_data *data = (struct est_dowb_data *)est_handle;

  return data->uh_el;
}

const EL_REAL_VEC_D *element_est_uh_old_loc_dow(const void *est_handle)
{
  struct est_dowb_data *data = (struct est_dowb_data *)est_handle;

  return data->uh_old_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 */
  }
}

/*******************************************************************************
 * 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_dow(const EL_INFO *el_info,
			       const EL_GEOM_CACHE *elgc,
			       bool el_param,
			       const PARAMETRIC *parametric,
			       REAL_D res_qp[],
			       struct est_dowb_data *data)
{
  int                 dim = el_info->mesh->dim;
  REAL                val, det_sum, h2;
  int                 iq, i, j, k, l;
  const QUAD_FAST     *quad_fast = data->quad_fast;
  const QUAD          *quad = quad_fast->quad;
  const QUAD_EL_CACHE *qelc = NULL;
  REAL_D              tmp;
  REAL_DD             *D2qi;

  if (el_param) {
    if (data->quad_fast->bas_fcts->degree > 1) {
      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_dow_at_qp(data->D2_uh_qp,
			    quad_fast,
			    (const REAL_BD *)qelc->param.Lambda,
			    (const REAL_BDD *)qelc->param.DLambda,
			    data->uh_el);
    } else {
      qelc = fill_quad_el_cache(el_info, quad_fast->quad,
				FILL_EL_QUAD_DET|FILL_EL_QUAD_LAMBDA);
    }
    if (data->f_flags & INIT_UH) {
      uh_dow_at_qp(data->uh_qp, quad_fast, data->uh_el);
    }
    if (data->f_flags & INIT_GRD_UH) {
      param_grd_uh_dow_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_dow_at_qp(data->D2_uh_qp,
		      quad_fast, (const REAL_D *)elgc->Lambda, data->uh_el);
    }
    if (data->f_flags & INIT_UH) {
      uh_dow_at_qp(data->uh_qp, quad_fast, data->uh_el);
    }
    if (data->f_flags & INIT_GRD_UH) {
      grd_uh_dow_at_qp(data->grd_uh_qp,
		       quad_fast, (const REAL_D *)elgc->Lambda, data->uh_el);
    }
  }

  for (iq = 0; iq < quad->n_points; iq++) {
    
    if (data->f_lower_order) {
      REAL_D lo;
      
      data->f_lower_order(lo, el_info, quad, iq,
			  data->uh_qp[iq], (const REAL_D *)data->grd_uh_qp[iq],
			  data->time);
      AXPY_DOW(1.0, lo, res_qp[iq]);
    }

    if (quad_fast->bas_fcts->degree > 1) {
      /* Optimize for diagonal and scalar matrices. */
      D2qi = data->D2_uh_qp[iq];
      switch (data->A_type) {	
      case MATENT_REAL_DD:
	/* A[i][j] is what is to be applied to \partial_{ij}u.
	 * Now D2_u is an array consisting of the Hesse matrices of
	 * the components of u. So we would want a block Hesse matrix
	 * consisting of REAL_D's to use MV_DOW stuff, but we do not
	 * have that.
	 */
#undef MAT_BODY
#define MAT_BODY(F, CC, C, S, TYPE)					\
	for (i = 0; i < DIM_OF_WORLD; i++) {				\
	  for (k = 0; k < DIM_OF_WORLD; k++) {				\
	    tmp[k] = D2qi[k][i][i];					\
	  }								\
	  F##GEMV_DOW(-1.0, CC data->A.S[i][i], tmp, 1.0, res_qp[iq]);	\
	  for (j = i+1; j < DIM_OF_WORLD; j++) {			\
	    for (k = 0; k < DIM_OF_WORLD; k++) {			\
	      tmp[k] = D2qi[k][i][j];					\
	    }								\
	    F##GEMV_DOW(-1.0, CC data->A.S[i][j], tmp, 1.0, res_qp[iq]); \
	    F##GEMV_DOW(-1.0, CC data->A.S[j][i], tmp, 1.0, res_qp[iq]); \
	  }								\
	}
      MAT_EMIT_BODY_SWITCH(data->A_blocktype);
      if (data->sym_grad) {
	/* weak formulation uses the symmetric gradient, this
	 * results in an additional divergence term.
	 *
	 * -\partial_j(\partial_i a_{lj}^{ik}v_k)
	 * =
	 * -1/2 (a_{lj}^{ik}\partial_i\partial_j v_k
	 *      +
	 *      a_{li}^{jk}\partial_i\partial_j v_k)
	 */
	switch (data->A_blocktype) {	
	case MATENT_REAL_DD:
	  for (l = 0; l < DIM_OF_WORLD; l++) {	    
	    for (i = 0; i < DIM_OF_WORLD; i++) {
	      for (k = 0; k < DIM_OF_WORLD; k++) {
		res_qp[iq][l] -=
		  data->A.real_dd[l][i][i][k]*D2qi[k][i][i];
	      }
	      for (j = i+1; j < DIM_OF_WORLD; j++) {
		for (k = 0; k < DIM_OF_WORLD; k++) {
		  res_qp[iq][l] -=
		    (data->A.real_dd[l][j][i][k] + data->A.real_dd[l][i][j][k])
		    *
		    D2qi[k][i][j];
		}
	      }
	    }
	  }
	  break;
	case MATENT_REAL_D:
	  /* Diagonal w.r.t. A[i][j][k][l] == A[i][j][l][k] */
	  for (l = 0; l < DIM_OF_WORLD; l++) {	    
	    for (i = 0; i < DIM_OF_WORLD; i++) {
	      res_qp[iq][l] -= data->A.real_d[l][i][i]*D2qi[i][i][i];
	      for (j = i+1; j < DIM_OF_WORLD; j++) {
		res_qp[iq][l] -=
		  data->A.real_d[l][j][i]*D2qi[i][i][j]
		  +
		  data->A.real_d[l][i][j]*D2qi[j][i][j];
	      }
	    }
	  }
	  break;
	case MATENT_REAL:
	  for (l = 0; l < DIM_OF_WORLD; l++) { 
	    for (i = 0; i < DIM_OF_WORLD; i++) {
	      res_qp[iq][l] -= data->A.real[l][i]*D2qi[i][i][i];
	      for (j = i+1; j < DIM_OF_WORLD; j++) {
		res_qp[iq][l] -=
		  data->A.real[l][j]*D2qi[i][i][j]
		  +
		  data->A.real[l][i]*D2qi[j][i][j];
	      }
	    }
	  }
	  break;
	default:
	  ERROR_EXIT("Unknown or invalid MATENT_TYPE: %d\n", data->A_blocktype);
	}
      }
      break;
      case MATENT_REAL_D:
#undef MAT_BODY
#define MAT_BODY(F, CC, C, S, TYPE)					\
	for (i = 0; i < DIM_OF_WORLD; i++) {				\
	  for (k = 0; k < DIM_OF_WORLD; k++) {				\
	    tmp[k] = D2qi[k][i][i];					\
	  }								\
	  F##GEMV_DOW(-1.0, CC data->A.S[i][i], tmp, 1.0, res_qp[iq]);	\
	}
      MAT_EMIT_BODY_SWITCH(data->A_blocktype);
      if (data->sym_grad) {
	/* weak formulation uses the symmetric gradient, this result
	 * in an additional divergence term.
	 *
	 * Only the diagonal blocks are non-zero here, so:
	 *
	 * -\partial_j(\partial_i a_{lj}^{ik}v_k)
	 * =
	 * -a_{ll}^{ik}\partial_l\partial_i v_k
	 */
	switch (data->A_blocktype) {
	case MATENT_REAL_DD:
	  for (l = 0; l < DIM_OF_WORLD; l++) {
	    for (k = 0; k < DIM_OF_WORLD; k++) {
	      res_qp[iq][l] -= data->A.real_dd[l][l][l][k] * D2qi[k][l][l];
	    }
	    for (i = l+1; i < DIM_OF_WORLD; i++) {
	      for (k = 0; k < DIM_OF_WORLD; k++) {
		res_qp[iq][l] -= data->A.real_dd[l][l][i][k] * D2qi[k][i][l];
		res_qp[iq][l] -= data->A.real_dd[i][i][l][k] * D2qi[k][i][l];
	      }
	    }
	  }
	  break;
	case MATENT_REAL_D:
	  for (l = 0; l < DIM_OF_WORLD; l++) {
	    res_qp[iq][l] -= data->A.real_d[l][l][l] * D2qi[l][l][l];
	    for (i = l+1; i < DIM_OF_WORLD; i++) {
	      res_qp[iq][l] -= data->A.real_d[l][l][i] * D2qi[i][i][l];
	      res_qp[iq][i] -= data->A.real_d[i][i][l] * D2qi[l][i][l];
	    }
	  }
	  break;
	case MATENT_REAL:
	  for (l = 0; l < DIM_OF_WORLD; l++) {
	    res_qp[iq][l] -= data->A.real[l][l] * D2qi[l][l][l];
	    for (i = l+1; i < DIM_OF_WORLD; i++) {
	      res_qp[iq][l] -= data->A.real[l][l] * D2qi[i][i][l];
	      res_qp[iq][i] -= data->A.real[i][i] * D2qi[l][i][l];
	    }
	  }
	  break;
	default:
	  ERROR_EXIT("Unknown or invalid MATENT_TYPE: %d\n", data->A_blocktype);
	}
      } /* sym_grad */
      break;
      case MATENT_REAL:
	/* Probably the most often used stuff */
#undef MAT_BODY
#define MAT_BODY(F, CC, C, S, TYPE)					\
	for (i = 0; i < DIM_OF_WORLD; i++) {				\
	  for (k = 0; k < DIM_OF_WORLD; k++) {				\
	    tmp[k] = D2qi[k][i][i];					\
	  }								\
	  F##GEMV_DOW(-1.0, CC data->A.S[0][0], tmp, 1.0, res_qp[iq]);	\
	}
      MAT_EMIT_BODY_SWITCH(data->A_blocktype);
      if (data->sym_grad) {
	/* weak formulation uses the symmetric gradient, this result
	 * in an additional divergence term.
	 *
	 * Only blocks on the diagonal, all block are equal.
	 *
	 * - a_{lj}^{ik}\partial_i\partial_j v_k
	 * =
	 * - a_{ll}^{ik}\partial_i\partial_l v_k
	 * =
	 * - a_{00}^{ik}\partial_i\partial_l v_k
	 *
	 */
	switch (data->A_blocktype) {
	case MATENT_REAL_DD:
	  for (l = 0; l < DIM_OF_WORLD; l++) {
	    for (k = 0; k < DIM_OF_WORLD; k++) {
	      res_qp[iq][l] -= data->A.real_dd[0][0][l][k] * D2qi[k][l][l];
	    }
	    for (i = l+1; i < DIM_OF_WORLD; i++) {
	      for (k = 0; k < DIM_OF_WORLD; k++) {
		res_qp[iq][l] -= data->A.real_dd[0][0][i][k]*D2qi[k][i][l];
		res_qp[iq][i] -= data->A.real_dd[0][0][l][k]*D2qi[k][i][l];
	      }
	    }
	  }
	  break;
	case MATENT_REAL_D:
	  for (l = 0; l < DIM_OF_WORLD; l++) {
	    res_qp[iq][l] -= data->A.real_d[0][0][l] * D2qi[l][l][l];
	    for (i = l+1; i < DIM_OF_WORLD; i++) {
	      for (k = 0; k < DIM_OF_WORLD; k++) {
		res_qp[iq][l] -= data->A.real_d[0][0][i]*D2qi[i][i][l];
		res_qp[iq][i] -= data->A.real_d[0][0][l]*D2qi[l][i][l];
	      }
	    }
	  }
	  break;
	case MATENT_REAL:
	  for (l = 0; l < DIM_OF_WORLD; l++) {
	    res_qp[iq][l] -= data->A.real[0][0] * D2qi[l][l][l];
	    for (i = l+1; i < DIM_OF_WORLD; i++) {
	      for (k = 0; k < DIM_OF_WORLD; k++) {
		res_qp[iq][l] -= data->A.real[0][0]*D2qi[i][i][l];
		res_qp[iq][i] -= data->A.real[0][0]*D2qi[l][i][l];
	      }
	    }
	  }
	  break;
	default:
	  ERROR_EXIT("Unknown or invalid MATENT_TYPE: %d\n", data->A_blocktype);
	}
      } /* sym_grad */
      break;
      default:
	ERROR_EXIT("Unknown or invalid MATENT_TYPE: %d\n", data->A_type);
      }
    }
  }

  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] * NRM2_DOW(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] * NRM2_DOW(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_d_cd0(const EL_INFO *el_info, int wall,
				   const EL_GEOM_CACHE *elgc,
				   bool el_param,
				   const PARAMETRIC *parametric,
				   struct est_dowb_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, j, k, iq;
  REAL_DD grd_uh_el[el_qf->quad->n_points_max];
  REAL_DD 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;
  REAL_DD Adiff;
  REAL_D  tmp;
  bool    neigh_param;

  if (el_param) {
    qelc = fill_quad_el_cache(el_info, el_qf->quad, 0U);
    param_grd_uh_dow_at_qp(grd_uh_el,
			   el_qf, (const REAL_BD *)qelc->param.Lambda,
			   data->uh_el);
  } else {
    grd_uh_dow_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_d(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_dow_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_dow_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 */
  switch (data->A_type) {
  case MATENT_REAL_DD:
    for (iq = 0; iq < el_qf->n_points; iq++) {
      MSET_DOW(0.0, Adiff);
#undef MAT_BODY
#define MAT_BODY(F, CC, C, S, TYPE)					\
      for (j = 0; j < DIM_OF_WORLD; j++) {				\
	for (k = 0; k < DIM_OF_WORLD; k++) {				\
	  tmp[k] = grd_uh_el[iq][k][j] - grd_uh_neigh[iq][k][j];	\
	}								\
	for (i = 0; i < DIM_OF_WORLD; i++) {				\
	  F##V_DOW(CC data->A.S[i][j], tmp, Adiff[i]);			\
	}								\
      }
      MAT_EMIT_BODY_SWITCH(data->A_blocktype);
      if (data->sym_grad) {
	MAXTPY_DOW(1.0, (const REAL_D *)Adiff, Adiff);
      }
      jump[iq] = MSCP_DOW((const REAL_D *)Adiff, (const REAL_D *)Adiff);
    }
    break;
  case MATENT_REAL_D:
    for (iq = 0; iq < el_qf->n_points; iq++) {
      MSET_DOW(0.0, Adiff);
#undef MAT_BODY
#define MAT_BODY(F, CC, C, S, TYPE)					\
      for (i = 0; i < DIM_OF_WORLD; i++) {				\
	for (k = 0; k < DIM_OF_WORLD; k++) {				\
	  tmp[k] = grd_uh_el[iq][k][i] - grd_uh_neigh[iq][k][i];	\
	}								\
	F##V_DOW(CC data->A.S[i][i], tmp, Adiff[i]);			\
      }
      MAT_EMIT_BODY_SWITCH(data->A_blocktype);
      if (data->sym_grad) {
	MAXTPY_DOW(1.0, (const REAL_D *)Adiff, Adiff);
      }
      jump[iq] = MSCP_DOW((const REAL_D *)Adiff, (const REAL_D *)Adiff);
    }
    break;
  case MATENT_REAL:
    for (iq = 0; iq < el_qf->n_points; iq++) {
      MSET_DOW(0.0, Adiff);
#undef MAT_BODY
#define MAT_BODY(F, CC, C, S, TYPE)					\
      for (i = 0; i < DIM_OF_WORLD; i++) {				\
	for (k = 0; k < DIM_OF_WORLD; k++) {				\
	  tmp[k] = grd_uh_el[iq][k][i] - grd_uh_neigh[iq][k][i];	\
	}								\
	F##V_DOW(CC data->A.S[0][0], tmp, Adiff[i]);			\
      }
      MAT_EMIT_BODY_SWITCH(data->A_blocktype);
      if (data->sym_grad) {
	MAXTPY_DOW(1.0, (const REAL_D *)Adiff, Adiff);
      }
      jump[iq] = MSCP_DOW((const REAL_D *)Adiff, (const REAL_D *)Adiff);
    }
    break;
  default:
    ERROR_EXIT("Unknown or invalid MATENT_TYPE: %d\n", data->A_type);
  }
  
  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;
  }
}

FORCE_INLINE_ATTR
static inline void normal_grd_param_dow(REAL_D result[],
					union Aunion A,
					MATENT_TYPE A_type,
					MATENT_TYPE A_blocktype,
					bool sym_grad,
					const REAL_D normals[],
					const REAL_DD grd[], int nqp)
{
  int i, j, k, iq;
  REAL_DD Atmp;
  REAL_D tmp;

  switch (A_type) {
  case MATENT_REAL_DD:
    for (iq = 0; iq < nqp; iq++) {
      MSET_DOW(0.0, Atmp);
#undef MAT_BODY
#define MAT_BODY(F, CC, C, S, TYPE)		\
      for (j = 0; j < DIM_OF_WORLD; j++) {	\
	for (k = 0; k < DIM_OF_WORLD; k++) {	\
	  tmp[k] = grd[iq][k][j];		\
	}					\
	for (i = 0; i < DIM_OF_WORLD; i++) {	\
	  F##V_DOW(CC A.S[i][j], tmp, Atmp[i]);	\
	}					\
      }
      MAT_EMIT_BODY_SWITCH(A_blocktype);
      if (sym_grad) {
	MAXTPY_DOW(1.0, (const REAL_D *)Atmp, Atmp);
      }
      SET_DOW(0.0, result[iq]);
      MTV_DOW((const REAL_D *)Atmp, normals[iq], result[iq]);
    }
    break;
  case MATENT_REAL_D:
    for (iq = 0; iq < nqp; iq++) {
      MSET_DOW(0.0, Atmp);
#undef MAT_BODY
#define MAT_BODY(F, CC, C, S, TYPE)		\
      for (i = 0; i < DIM_OF_WORLD; i++) {	\
	for (k = 0; k < DIM_OF_WORLD; k++) {	\
	  tmp[k] = grd[iq][k][i];		\
	}					\
	F##V_DOW(CC A.S[i][i], tmp, Atmp[i]);	\
      }
      MAT_EMIT_BODY_SWITCH(A_blocktype);
      if (sym_grad) {
	MAXTPY_DOW(1.0, (const REAL_D *)Atmp, Atmp);
      }
      SET_DOW(0.0, result[iq]);
      MTV_DOW((const REAL_D *)Atmp, normals[iq], result[iq]);
    }
    break;
  case MATENT_REAL:
    for (iq = 0; iq < nqp; iq++) {
      MSET_DOW(0.0, Atmp);
#undef MAT_BODY
#define MAT_BODY(F, CC, C, S, TYPE)		\
      for (i = 0; i < DIM_OF_WORLD; i++) {	\
	for (k = 0; k < DIM_OF_WORLD; k++) {	\
	  tmp[k] = grd[iq][k][i];		\
	}					\
	F##V_DOW(CC A.S[0][0], tmp, Atmp[i]);	\
      }
      MAT_EMIT_BODY_SWITCH(A_blocktype);
      if (sym_grad) {
	MAXTPY_DOW(1.0, (const REAL_D *)Atmp, Atmp);
      }
      SET_DOW(0.0, result[iq]);
      MTV_DOW((const REAL_D *)Atmp, normals[iq], result[iq]);
    }
    break;
  default:
    ERROR_EXIT("Unknown or invalid MATENT_TYPE: %d\n", A_type);
  }
}

FORCE_INLINE_ATTR
static inline void normal_grd_straight_dow(REAL_D result[],
					   union Aunion A,
					   MATENT_TYPE A_type,
					   MATENT_TYPE A_blocktype,
					   bool sym_grad,
					   const REAL_D normal,
					   const REAL_DD grd[], int nqp)
{
  int i, j, k, iq;
  REAL_DD Atmp;
  REAL_D tmp;

  switch (A_type) {
  case MATENT_REAL_DD:
    for (iq = 0; iq < nqp; iq++) {
      MSET_DOW(0.0, Atmp);
#undef MAT_BODY
#define MAT_BODY(F, CC, C, S, TYPE)		\
      for (j = 0; j < DIM_OF_WORLD; j++) {	\
	for (k = 0; k < DIM_OF_WORLD; k++) {	\
	  tmp[k] = grd[iq][k][j];		\
	}					\
	for (i = 0; i < DIM_OF_WORLD; i++) {	\
	  F##V_DOW(CC A.S[i][j], tmp, Atmp[i]);	\
	}					\
      }
      MAT_EMIT_BODY_SWITCH(A_blocktype);
      if (sym_grad) {
	MAXTPY_DOW(1.0, (const REAL_D *)Atmp, Atmp);
      }
      SET_DOW(0.0, result[iq]);
      MTV_DOW((const REAL_D *)Atmp, normal, result[iq]);
    }
    break;
  case MATENT_REAL_D:
    for (iq = 0; iq < nqp; iq++) {
      MSET_DOW(0.0, Atmp);
#undef MAT_BODY
#define MAT_BODY(F, CC, C, S, TYPE)		\
      for (i = 0; i < DIM_OF_WORLD; i++) {	\
	for (k = 0; k < DIM_OF_WORLD; k++) {	\
	  tmp[k] = grd[iq][k][i];		\
	}					\
	F##V_DOW(CC A.S[i][i], tmp, Atmp[i]);	\
      }
      MAT_EMIT_BODY_SWITCH(A_blocktype);
      if (sym_grad) {
	MAXTPY_DOW(1.0, (const REAL_D *)Atmp, Atmp);
      }
      SET_DOW(0.0, result[iq]);
      MTV_DOW((const REAL_D *)Atmp, normal, result[iq]);
    }
    break;
  case MATENT_REAL:
    for (iq = 0; iq < nqp; iq++) {
      MSET_DOW(0.0, Atmp);
#undef MAT_BODY
#define MAT_BODY(F, CC, C, S, TYPE)		\
      for (i = 0; i < DIM_OF_WORLD; i++) {	\
	for (k = 0; k < DIM_OF_WORLD; k++) {	\
	  tmp[k] = grd[iq][k][i];		\
	}					\
	F##V_DOW(CC A.S[0][0], tmp, Atmp[i]);	\
      }
      MAT_EMIT_BODY_SWITCH(A_blocktype);
      if (sym_grad) {
	MAXTPY_DOW(1.0, (const REAL_D *)Atmp, Atmp);
      }
      SET_DOW(0.0, result[iq]);
      MTV_DOW((const REAL_D *)Atmp, normal, result[iq]);
    }
    break;
  default:
    ERROR_EXIT("Unknown or invalid MATENT_TYPE: %d\n", A_type);
  }
}

FORCE_INLINE_ATTR
static inline REAL jump_res2_d_cdN(const EL_INFO *el_info, int wall,
				   const EL_GEOM_CACHE *elgc,
				   bool el_param,
				   const PARAMETRIC *parametric,
				   struct est_dowb_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_D  ngrd_uh_el[el_qf->quad->n_points_max];
  REAL_D  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_d(data->uh_neigh, neigh, data->uh);
  
  if (el_param) {
    REAL_DD grd_uh_el[el_qf->quad->n_points_max];

    qelc = fill_quad_el_cache(el_info, el_qf->quad, 0U);
    param_grd_uh_dow_at_qp(grd_uh_el,
			   el_qf, (const REAL_BD *)qelc->param.Lambda,
			   data->uh_el);

    normal_grd_param_dow(
      ngrd_uh_el, data->A, data->A_type, data->A_blocktype, data->sym_grad,
      (const REAL_D *)qelc->param.wall_normal,
      (const REAL_DD *)grd_uh_el, el_qf->n_points);
  } else {
    REAL_DD grd_uh_el[el_qf->quad->n_points_max];

    grd_uh_dow_at_qp(grd_uh_el,
		     el_qf, (const REAL_D *)elgc->Lambda, data->uh_el);

    normal_grd_straight_dow(
      ngrd_uh_el, data->A, data->A_type, data->A_blocktype, data->sym_grad,
      elgc->wall_normal[wall],
      (const REAL_DD *)grd_uh_el, el_qf->n_points);
  }

  if (neigh_param) {
    REAL_D wall_normal_neigh[el_qf->quad->n_points_max];
    REAL_DD 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_dow_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_dow(ngrd_uh_neigh,
			 data->A, data->A_type, data->A_blocktype, data->sym_grad,
			 (const REAL_D *)wall_normal_neigh,
			 (const REAL_DD *)grd_uh_neigh, el_qf->n_points);
    if (!el_param) {
      wall_det = elgc->wall_det[wall];
    }
  } else {
    REAL_D wall_normal_neigh;
    REAL_DD grd_uh_neigh[el_qf->quad->n_points_max];

    det_neigh = el_grd_lambda(neigh_info, Lambda_neigh[0]);
    grd_uh_dow_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_dow(
      ngrd_uh_neigh, data->A, data->A_type, data->A_blocktype, data->sym_grad,
      wall_normal_neigh, (const REAL_DD *)grd_uh_neigh,
      el_qf->n_points);
  }

  /* now eval the jump at all quadrature nodes
   *
   * NOTE: "ngrd_el _+_ ngrd_neigh" is correct.
   */
  for (iq = 0; iq < el_qf->n_points; iq++) {
    REAL_D tmp;
    
    AXPBY_DOW(1.0, ngrd_uh_el[iq], 1.0, ngrd_uh_neigh[iq], tmp);

    jump[iq] = NRM2_DOW(tmp);
  }

  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_dow(const EL_INFO *el_info, int wall,
				    const EL_GEOM_CACHE *elgc,
				    bool el_param,
				    const PARAMETRIC *parametric,
				    struct est_dowb_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_DD grd_uh_el[el_qf->quad->n_points_max];
  REAL_DD A_grd_uh[el_qf->quad->n_points_max];
  int     i, j, k, iq, dim = el_info->mesh->dim;
  REAL_D  n_A_grd_uh;
  REAL    val, h2;
  REAL_D  tmp;

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

  for (iq = 0; iq < el_qf->n_points; iq++) {
    MSET_DOW(0, A_grd_uh[iq]);
    switch (data->A_type) {
    case MATENT_REAL_DD:
#undef MAT_BODY
#define MAT_BODY(F, CC, C, S, TYPE)				\
      for (j = 0; j < DIM_OF_WORLD; j++) {			\
	for (k = 0; k < DIM_OF_WORLD; k++) {			\
	  tmp[k] = grd_uh_el[iq][k][j];				\
	}							\
	for (i = 0; i < DIM_OF_WORLD; i++) {			\
	  F##V_DOW(CC data->A.S[i][j], tmp, A_grd_uh[iq][i]);	\
	}							\
      }
    MAT_EMIT_BODY_SWITCH(data->A_blocktype);
    break;
    case MATENT_REAL_D:
#undef MAT_BODY
#define MAT_BODY(F, CC, C, S, TYPE)				\
      for (i = 0; i < DIM_OF_WORLD; i++) {			\
	for (k = 0; k < DIM_OF_WORLD; k++) {			\
	  tmp[k] = grd_uh_el[iq][k][i];				\
	}							\
	F##V_DOW(CC data->A.S[i][i], tmp, A_grd_uh[iq][i]);	\
      }
    MAT_EMIT_BODY_SWITCH(data->A_blocktype);
    break;
    case MATENT_REAL:
#undef MAT_BODY
#define MAT_BODY(F, CC, C, S, TYPE)				\
      for (i = 0; i < DIM_OF_WORLD; i++) {			\
	for (k = 0; k < DIM_OF_WORLD; k++) {			\
	  tmp[k] = grd_uh_el[iq][k][i];				\
	}							\
	F##V_DOW(CC data->A.S[0][0], tmp, A_grd_uh[iq][i]);	\
      }
    MAT_EMIT_BODY_SWITCH(data->A_blocktype);
    break;
    default:
      ERROR_EXIT("Unknown or invalid MATENT_TYPE: %d\n", data->A_type);
    }
    if (data->sym_grad) {
      MAXTPY_DOW(1.0, (const REAL_D *)A_grd_uh[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++) {
      SET_DOW(0.0, n_A_grd_uh);
      MTV_DOW((const REAL_D *)A_grd_uh[iq],
	      qelc->param.wall_normal[iq], n_A_grd_uh);
      if (data->gn) {
	REAL_D uh_qp;
	
	if (data->gn_flags & INIT_UH) {
	  eval_uh_dow_fast(uh_qp, data->uh_el, el_qf, iq);
	}
	AXPY_DOW(-1.0, 
		 data->gn(NULL, el_info, el_qf->quad, iq,
			  uh_qp, qelc->param.wall_normal[iq], data->time),
		 n_A_grd_uh);
      }
      val += qelc->param.wall_det[iq]*el_qf->w[iq] * NRM2_DOW(n_A_grd_uh);
      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++) {
      SET_DOW(0.0, n_A_grd_uh);
      MTV_DOW((const REAL_D *)A_grd_uh[iq],
	      elgc->wall_normal[wall], n_A_grd_uh);
      if (data->gn) {
	REAL_D uh_qp;
	
	if (data->gn_flags & INIT_UH) {
	  eval_uh_dow_fast(uh_qp, data->uh_el, el_qf, iq);
	}
	AXPY_DOW(-1.0, 
		 data->gn(NULL, el_info, el_qf->quad, iq,
			  uh_qp, elgc->wall_normal[wall], data->time),
		 n_A_grd_uh);
      }
      val += el_qf->w[iq] * NRM2_DOW(n_A_grd_uh);
    }
    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_dow(const EL_INFO *el_info,
				 const EL_GEOM_CACHE *elgc,
				 bool el_param,
				 const PARAMETRIC *parametric,
				 struct est_dowb_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 ||
	  wall_trafo(el_info, 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_d_cdN(el_info, wall, elgc, el_param, parametric, data)
	: jump_res2_d_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))) {
      wall_est +=
	neumann_res2_dow(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_dow_fct(const EL_INFO *el_info,
				      const PARAMETRIC *parametric,
				      struct est_dowb_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) {
    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_d(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 && qf_tag != INIT_EL_TAG_NULL) {
    REAL_D 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_dow(el_info, elgc, el_param, parametric, res_qp, data);
  }

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

FLATTEN_ATTR
static REAL ellipt_est_dow_fct_noparam(const EL_INFO *el_info,
				       struct est_dowb_data *data)
{
  return ellipt_est_dow_fct(el_info, NULL, data);
}

FLATTEN_ATTR
static REAL ellipt_est_dow_fct_param(const EL_INFO *el_info,
				     struct est_dowb_data *data)
{
  return ellipt_est_dow_fct(el_info, el_info->mesh->parametric, data);
}

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

const void *ellipt_est_dow_init(const DOF_REAL_VEC_D *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 void *A,
				MATENT_TYPE A_type,
				MATENT_TYPE A_blocktype,
				bool sym_grad,
				const BNDRY_FLAGS dirichlet_bndry,
				const REAL *(*f)(REAL_D result,
						 const EL_INFO *el_info,
						 const QUAD *quad,
						 int qp,
						 const REAL_D uh_qp,
						 const REAL_DD grduh_qp),
				FLAGS f_flags,
				const REAL *(*gn)(REAL_D result,
						  const EL_INFO *el_info,
						  const QUAD *quad,
						  int qp,
						  const REAL_D uh_qp,
						  const REAL_D normal),
				FLAGS gn_flags)
{
  FUNCNAME("ellipt_est_dow_init");
  struct est_dowb_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_dowb_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.real_dd  = (const REAL_DD (*)[DIM_OF_WORLD])A; /* data->A is a union ... */

  data->A_type      = A_type;
  data->A_blocktype = A_blocktype;

  if (dirichlet_bndry) {
    BNDRY_FLAGS_CPY(data->dirichlet_bndry, dirichlet_bndry);
  } else {
    BNDRY_FLAGS_INIT(data->dirichlet_bndry);
  }

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

  data->sym_grad = sym_grad;

  INIT_OBJECT(data->bas_fcts);

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

  if (gn) {
    data->gn = (const REAL *(*)(REAL_D result,
				const EL_INFO *el_info,
				const QUAD *quad,
				int qp,
				const REAL_D 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_d(uh->fe_space->bas_fcts);
  data->uh_neigh  = get_el_real_vec_d(uh->fe_space->bas_fcts);

  data->uh_qp     = EST_ALLOC(data, quad->n_points_max, REAL_D);
  data->grd_uh_qp = EST_ALLOC(data, quad->n_points_max, REAL_DD);
  data->D2_uh_qp  = EST_ALLOC(data, quad->n_points_max, REAL_DDD);
  
  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) {
    /* 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_dow_fct_param : ellipt_est_dow_fct_noparam;

  return (const void *)data;
}

REAL ellipt_est_dow_finish(ADAPT_STAT *adapt, const void *est_handle)
{
  struct est_dowb_data *data = (struct est_dowb_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_d(data->uh_el);
  free_el_real_vec_d(data->uh_neigh);
  free_el_real_vec_d(data->uh_old_el);

  SCRATCH_MEM_ZAP(data->scratch);

  return est_sum;
}

REAL ellipt_est_dow(const DOF_REAL_VEC_D *uh, ADAPT_STAT *adapt,
		    REAL *(*rw_est)(EL *), REAL *(*rw_estc)(EL *),
		    int degree,
		    NORM norm,
		    REAL C[3],
		    const void *A, MATENT_TYPE A_type, MATENT_TYPE A_blocktype,
		    bool sym_grad,
		    const BNDRY_FLAGS dirichlet_bndry,
		    const REAL *(*f)(REAL_D result,
				     const EL_INFO *el_info,
				     const QUAD *quad,
				     int qp,
				     const REAL_D uh_qp,
				     const REAL_DD grd_uh_qp),
		    FLAGS f_flags,
		    const REAL *(*gn)(REAL_D result,
				      const EL_INFO *el_info,
				      const QUAD *quad,
				      int qp,
				      const REAL_D 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_dow_init(uh, adapt, rw_est, rw_estc, quad, wall_quad,
				   norm, C,
				   A, A_type, A_blocktype,
				   sym_grad, 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_dow(el_info, est_handle);
    
#if 0
    /* Applications may want to add additional terms here: */
    uh_qp = element_est_uh_dow(est_handle);
    grd_uh_qp = element_est_grd_uh_dow(est_handle);
    est_el += stuff;
#endif

    element_est_dow_finish(el_info, est_el, est_handle);    

  } TRAVERSE_NEXT();
  
  return ellipt_est_dow_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_dow(const EL_INFO *el_info,
				    const EL_GEOM_CACHE *elgc,
				    bool el_param,
				    const PARAMETRIC *parametric,
				    struct est_dowb_data *data)
{
  REAL            val;
  int             iq;
  const REAL_D    *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_D res_qp[quad->n_points_max];

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

  if (data->C3) {
    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++) {
	AXPBY_DOW(1.0, uh_qp[iq], -1.0, uh_old_qp[iq], res_qp[iq]);
	val    += quad->w[iq] * qelc->param.det[iq] * NRM2_DOW(res_qp[iq]);
	if (data->C0 > 0.0) {
	  SCAL_DOW(data->inv_timestep, res_qp[iq]);
	}
      }
    } else {
      fill_el_geom_cache(el_info, FILL_EL_DET);
      for (iq = 0; iq < quad->n_points; iq++) {
	AXPBY_DOW(1.0, uh_qp[iq], -1.0, uh_old_qp[iq], res_qp[iq]);
	val    += quad->w[iq] * NRM2_DOW(res_qp[iq]);
	if (data->C0 > 0.0) {
	  SCAL_DOW(data->inv_timestep, res_qp[iq]);
	}
      }
      val *= elgc->det;
    }
    data->est_t_sum += data->C3*val;
  } else if (data->C0 > 0.0) {
    for (iq = 0; iq < quad->n_points; iq++) {
      AXPBY_DOW(1.0, uh_qp[iq], -1.0, uh_old_qp[iq], res_qp[iq]);
      if (data->C0 > 0.0) {
	SCAL_DOW(data->inv_timestep, res_qp[iq]);
      }
    }
  }
  
  if (data->C0 <= 0.0) {
    return 0.0;
  }
  
  return el_res2_dow(el_info, elgc, el_param, parametric, res_qp, data);
}

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

FORCE_INLINE_ATTR
static inline REAL heat_est_dow_fct(const EL_INFO *el_info,
				    const PARAMETRIC *parametric,
				    struct est_dowb_data *data)
{
  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, quad_fast);
  if (data->C1) {
    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_d(data->uh_el, el, data->uh);
  fill_el_real_vec_d(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 || data->C3) && qf_tag != INIT_EL_TAG_NULL) {
    est_el += heat_el_res2_dow(el_info, elgc, el_param, parametric, data);
  }

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

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

  return est_el;
}

FLATTEN_ATTR
static REAL heat_est_dow_fct_noparam(const EL_INFO *el_info,
				     struct est_dowb_data *data)
{
  return heat_est_dow_fct(el_info, NULL, data);
}

FLATTEN_ATTR
static REAL heat_est_dow_fct_param(const EL_INFO *el_info,
				   struct est_dowb_data *data)
{
  return heat_est_dow_fct(el_info, el_info->mesh->parametric, data);
}

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

const void *heat_est_dow_init(const DOF_REAL_VEC_D *uh,
			      const DOF_REAL_VEC_D *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 void *A,
			      MATENT_TYPE A_type,
			      MATENT_TYPE A_blocktype,
			      bool sym_grad,
			      const BNDRY_FLAGS dirichlet_bndry,
			      const REAL *(*f)(REAL_D result,
					       const EL_INFO *el_info,
					       const QUAD *quad,
					       int qp,
					       const REAL_D uh_qp,
					       const REAL_DD grduh_qp,
					       REAL time),
			      FLAGS f_flags,
			      const REAL *(*gn)(REAL_D result,
						const EL_INFO *el_info,
						const QUAD *quad,
						int qp,
						const REAL_D uh_qp,
						const REAL_D normal,
						REAL time),
			      FLAGS gn_flags)
{
  FUNCNAME("heat_est_dow_init");
  struct est_dowb_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_dowb_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.real_dd   = (const REAL_DD (*)[DIM_OF_WORLD])A; /* data->A is a union ... */
  data->A_type      = A_type;
  data->A_blocktype = A_blocktype;

  if (dirichlet_bndry) {
    BNDRY_FLAGS_CPY(data->dirichlet_bndry, dirichlet_bndry);
  } else {
    BNDRY_FLAGS_INIT(data->dirichlet_bndry);
  }

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

  data->sym_grad = sym_grad;

  INIT_OBJECT(data->bas_fcts);

  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_d(uh->fe_space->bas_fcts);
  data->uh_neigh  = get_el_real_vec_d(uh->fe_space->bas_fcts);
  data->uh_old_el = get_el_real_vec_d(uh->fe_space->bas_fcts);

  data->uh_qp     = EST_ALLOC(data, quad->n_points_max, REAL_D);
  data->uh_old_qp = EST_ALLOC(data, quad->n_points_max, REAL_D);
  data->grd_uh_qp = EST_ALLOC(data, quad->n_points_max, REAL_DD);
  data->D2_uh_qp  = EST_ALLOC(data, quad->n_points_max, REAL_DDD);

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

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

  if(dim > 1) {
    /* 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;

  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) {
    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));
    /* We need a vertex index to orient walls. */
    get_vertex_admin(mesh, ADM_PERIODIC);
  }

  data->time = adapt->time;
  data->inv_timestep = 1.0 / 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_dow_fct_param : heat_est_dow_fct_noparam;

  return (const void *)data;
}

REAL heat_est_dow_finish(ADAPT_INSTAT *adapt, const void *est_handle)
{
  struct est_dowb_data *data = (struct est_dowb_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_d(data->uh_el);
  free_el_real_vec_d(data->uh_neigh);
  free_el_real_vec_d(data->uh_old_el);

  SCRATCH_MEM_ZAP(data->scratch);

  return est_t_sum;
}

REAL heat_est_dow(const DOF_REAL_VEC_D *uh,
		  const DOF_REAL_VEC_D *uh_old,
		  ADAPT_INSTAT *adapt,
		  REAL *(*rw_est)(EL *), REAL *(*rw_estc)(EL *),
		  int degree,
		  REAL C[4],
		  const void *A,
		  MATENT_TYPE A_type, MATENT_TYPE A_blocktype,
		  bool sym_grad,
		  const BNDRY_FLAGS dirichlet_bndry,
		  const REAL *(*f)(REAL_D result,
				   const EL_INFO *el_info,
				   const QUAD *quad,
				   int qp,
				   const REAL_D uh_qp,
				   const REAL_DD grduh_qp,
				   REAL time),
		  FLAGS f_flags,
		  const REAL *(*gn_diff)(REAL_D result,
					 const EL_INFO *el_info,
					 const QUAD *quad,
					 int qp,
					 const REAL_D 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_dow_init(uh, uh_old, adapt, rw_est, rw_estc,
				 quad, wall_quad, C,
				 A, A_type, A_blocktype, sym_grad,
				 dirichlet_bndry,
				 f, f_flags, gn_diff, 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_dow(el_info, est_handle);
    
#if 0
    /* Applications may want to add additional terms here: not _here_,
     * but in their own programs.
     */
    uh_qp = element_est_uh_dow(est_handle);
    grd_uh_qp = element_est_grd_uh_dow(est_handle);
    est_el += stuff;
#endif

    element_est_dow_finish(el_info, est_el, est_handle);    

  } TRAVERSE_NEXT();

  return heat_est_dow_finish(adapt, est_handle);
}
