/*--------------------------------------------------------------------------*/
/* ALBERTA:  an Adaptive multi Level finite element toolbox using           */
/*           Bisectioning refinement and Error control by Residual          */
/*           Techniques for scientific Applications                         */
/*                                                                          */
/* file:     error.c                                                        */
/*                                                                          */
/* description:  routines for computing different types of errors           */
/*                                                                          */
/*--------------------------------------------------------------------------*/
/*                                                                          */
/*  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                                    */
/*                                                                          */
/*  http://www.mathematik.uni-freiburg.de/IAM/ALBERTA                       */
/*                                                                          */
/*  (c) by A. Schmidt and K.G. Siebert (1996-2003)                          */
/*         C.-J. Heine (2006-2007)                                          */
/*                                                                          */
/*--------------------------------------------------------------------------*/

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

#include "alberta.h"

/*--------------------------------------------------------------------------*/
/*  max error at the quadrature points :-)))                                */
/*--------------------------------------------------------------------------*/

/*--------------------------------------------------------------------------*/
/*  max error at the quadrutare points of quadrature formula of degree      */
/*  of the continous function u and discrete function uh                    */
/*--------------------------------------------------------------------------*/

static REAL _AI_max_err_at_qp(FCT_AT_X u,
			      LOC_FCT_AT_QP u_loc, void *ud, FLAGS fill_flag,
			      const DOF_REAL_VEC *uh,
			      const QUAD *quad)
{
  FUNCNAME("_AI_max_err_at_qp");
  const FE_SPACE *fe_space;
  const BAS_FCTS *bas_fcts;
  const QUAD_FAST *quad_fast;
  REAL max_err;
  PARAMETRIC *parametric;
  
  if (!u && !u_loc) {
    ERROR("no function u specified; doing nothing\n");
    return(-1.0);
  }
  if (!uh || !(fe_space = uh->fe_space)) {
    ERROR("no discrete function or no fe_space for it; doing nothing\n");
    return(-1.0);
  }
  if (!uh->vec) {
    ERROR("no coefficient vector at discrete solution ; doing nothing\n");
    return(-1.0);
  }
  if (!(bas_fcts = fe_space->bas_fcts)) {
    ERROR("no basis functions at discrete solution ; doing nothing\n");
    return(-1.0);
  }
  if (!quad)
    quad = get_quadrature(bas_fcts->dim, 2*bas_fcts->degree-2);

  quad_fast = get_quad_fast(bas_fcts, quad, INIT_PHI);

  INIT_OBJECT(quad_fast); /* reset to default state */

  max_err = 0.0;
  parametric = fe_space->mesh->parametric;

  fill_flag |= quad_fast->fill_flags;
  TRAVERSE_FIRST(fe_space->mesh, -1, fill_flag|CALL_LEAF_EL|FILL_COORDS) {
    int        i;
    REAL       err;
    const EL_REAL_VEC *uh_el;
    const REAL *u_vec, *uh_vec;

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

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

    if (u) {
      u_vec = fx_at_qp(NULL, el_info, quad_fast->quad, u);
    } else {
      u_vec = f_loc_at_qp(NULL, el_info, quad_fast->quad, u_loc, ud);
    }

    uh_el  = fill_el_real_vec(NULL, el_info->el, uh);
    uh_vec = uh_at_qp(NULL, quad_fast, uh_el);

    for (i = 0; i < quad_fast->n_points; i++) {
      err = fabs(u_vec[i] - uh_vec[i]);
      max_err = MAX(max_err, err);
    }
  } TRAVERSE_NEXT();

  return max_err;
}

REAL max_err_at_qp(FCT_AT_X u, const DOF_REAL_VEC *uh, const QUAD *quad)
{
  return _AI_max_err_at_qp(u, NULL, NULL, 0, uh, quad);
}

REAL max_err_at_qp_loc(LOC_FCT_AT_QP u_loc, void *ud, FLAGS fill_flag,
		       const DOF_REAL_VEC *uh,
		       const QUAD *quad)
{
  return _AI_max_err_at_qp(NULL, u_loc, ud, fill_flag, uh, quad);
}

/*--------------------------------------------------------------------------*/
/*  max error at the vertices of the grid :-)))                             */
/*--------------------------------------------------------------------------*/

static const REAL_B vl[N_VERTICES_LIMIT] = {
  INIT_BARY_3D(1,0,0,0),
  INIT_BARY_3D(0,1,0,0),
  INIT_BARY_3D(0,0,1,0),
  INIT_BARY_3D(0,0,0,1)
};

REAL max_err_at_vert(FCT_AT_X u, const DOF_REAL_VEC *uh)
{
  FUNCNAME("max_err_at_vert");
  const FE_SPACE *fe_space;
  const BAS_FCTS *bas_fcts;
  FLAGS fill_flags;
  REAL max_err;
  int dim;
  PARAMETRIC *parametric;

  if (!u) {
    ERROR("no function u specified; doing nothing\n");
    return(-1.0);
  }
  if (!uh || !(fe_space = uh->fe_space)) {
    ERROR("no discrete function or no fe_space for it; doing nothing\n");
    return(-1.0);
  }
  if (!uh->vec) {
    ERROR("no coefficient vector at discrete solution ; doing nothing\n");
    return(-1.0);
  }
  if (!(bas_fcts = fe_space->bas_fcts)) {
    ERROR("no basis functions at discrete solution ; doing nothing\n");
    return(-1.0);
  }

  max_err = 0.0;
  dim = fe_space->mesh->dim;
  parametric = fe_space->mesh->parametric;

  fill_flags = FILL_COORDS|CALL_LEAF_EL|bas_fcts->fill_flags;
  TRAVERSE_FIRST(fe_space->mesh, -1, fill_flags) {
    int        i;
    REAL       err;
    const EL_REAL_VEC *uh_el;
    REAL_D     pcoords[N_VERTICES_MAX];
    REAL_D     *coords;

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

    if (parametric) {
      parametric->init_element(el_info, parametric);
      parametric->coord_to_world(el_info,
				 NULL, N_VERTICES(dim), (const REAL_B *)vl,
				 pcoords);
      coords = pcoords;
    } else {
      coords = (REAL_D *)el_info->coord;
    }

    uh_el = fill_el_real_vec(NULL, el_info->el, uh);
    for (i = 0; i < N_VERTICES(dim); i++) {
      err = fabs(u(coords[i]) - eval_uh(vl[i], uh_el, bas_fcts));
      max_err = MAX(max_err, err);
    }
  } TRAVERSE_NEXT();

  return max_err;
}

REAL max_err_at_vert_loc(LOC_FCT_AT_QP u_at_qp,
			 void *ud, FLAGS fill_flag,
			 const DOF_REAL_VEC *uh)
{
  FUNCNAME("max_err_at_vert_loc");
  const FE_SPACE *fe_space;
  const BAS_FCTS *bas_fcts;
  const QUAD     *qlump;
  REAL max_err;
  int dim;

  if (!u_at_qp) {
    ERROR("no function u specified; doing nothing\n");
    return -1.0;
  }
  if (!uh || !(fe_space = uh->fe_space)) {
    ERROR("no discrete function or no fe_space for it; doing nothing\n");
    return -1.0;
  }
  if (!uh->vec) {
    ERROR("no coefficient vector at discrete solution ; doing nothing\n");
    return -1.0;
  }
  if (!(bas_fcts = fe_space->bas_fcts)) {
    ERROR("no basis functions at discrete solution ; doing nothing\n");
    return -1.0;
  }

  dim = fe_space->mesh->dim;
  qlump = get_lumping_quadrature(dim);

  max_err = 0.0;
  fill_flag |= bas_fcts->fill_flags;
  TRAVERSE_FIRST(fe_space->mesh, -1, fill_flag|CALL_LEAF_EL) {
    int        i;
    REAL       err;
    const EL_REAL_VEC *uh_el;

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

    uh_el = fill_el_real_vec(NULL, el_info->el, uh);
    for (i = 0; i < N_VERTICES(dim); i++) {
      err = fabs(u_at_qp(el_info, qlump, i, ud)
		 -
		 eval_uh(vl[i], uh_el, bas_fcts));
      max_err = MAX(max_err, err);
    }
  } TRAVERSE_NEXT();

  return max_err;
}

/*--------------------------------------------------------------------------*/
/*  L2 error on the mesh                                                    */
/*--------------------------------------------------------------------------*/
static REAL _AI_L2_err(FCT_AT_X weight, FCT_AT_X u,
		       LOC_FCT_AT_QP u_loc, void *ud, FLAGS fill_flag,
		       const DOF_REAL_VEC *uh,
		       const QUAD *quad,
		       bool rel_err, bool mean_value_adjust,
		       REAL *(*rw_err_el)(EL *el), REAL *max_l2_err2)
{
  FUNCNAME("_AI_L2_err");
  const FE_SPACE  *fe_space;
  const BAS_FCTS  *bas_fcts;
  const QUAD_FAST *quad_fast;
  REAL max_err, l2_err_2, l2_norm2;  
  REAL mv_offset;

  if (!u && !u_loc) {
    ERROR("no function u specified; doing nothing\n");
    return 0.0;
  }
  if (!uh || !(fe_space = uh->fe_space)) {
    ERROR("no discrete function or no fe_space for it; doing nothing\n");
    return(0.0);
  }
  if (!uh->vec) {
    ERROR("no coefficient vector at discrete solution ; doing nothing\n");
    return 0.0;
  }
  if (!(bas_fcts = fe_space->bas_fcts)) {
    ERROR("no basis functions at discrete solution ; doing nothing\n");
    return(0.0);
  }
  if (!quad) {
    quad = get_quadrature(fe_space->mesh->dim, 2*fe_space->bas_fcts->degree);
  }
  quad_fast = get_quad_fast(bas_fcts, quad, INIT_PHI);

  INIT_OBJECT(quad_fast);

  if (mean_value_adjust) {
    if (u) {
      mv_offset = mean_value(fe_space->mesh, u, uh, quad);
    } else {
      mv_offset =
	mean_value_loc(fe_space->mesh, u_loc, ud, fill_flag, uh, quad);
    }
  } else {
    mv_offset = 0.0;
  }

  max_err = l2_err_2 = l2_norm2 = 0.0;
  
  {
    PARAMETRIC *parametric = fe_space->mesh->parametric;
    int is_parametric = false;
    int dim = fe_space->mesh->dim;
    REAL dets[quad->n_points_max];
    REAL u_vec[quad->n_points_max];
    REAL w_vec[quad->n_points_max];
    REAL uh_vec[quad->n_points_max];
    const EL_REAL_VEC *uh_el;
    REAL det;

    fill_flag |= quad_fast->fill_flags;
    TRAVERSE_FIRST(fe_space->mesh, -1, fill_flag|CALL_LEAF_EL|FILL_COORDS) {
      int  i;
      REAL l2_err_el, norm_el;

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

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

      if (u) {
	fx_at_qp(u_vec, el_info, quad_fast->quad, u);
      } else {
	f_loc_at_qp(u_vec, el_info, quad_fast->quad, u_loc, ud);
      }
      uh_el = fill_el_real_vec(NULL, el_info->el, uh);
      uh_at_qp(uh_vec, quad_fast, uh_el);
      if (weight) {
	fx_at_qp(w_vec, el_info, quad_fast->quad, weight);
	for (i = 0; i < quad_fast->n_points; i++) {
	  uh_vec[i] = quad_fast->w[i] *
	    SQR(u_vec[i] - uh_vec[i] - mv_offset) * w_vec[i];
	  u_vec[i]  = quad_fast->w[i] * SQR(u_vec[i]) * w_vec[i];
	}
      } else {
	for (i = 0; i < quad_fast->n_points; i++) {
	  uh_vec[i] = quad_fast->w[i] * SQR(u_vec[i] - uh_vec[i] - mv_offset);
	  u_vec[i]  = quad_fast->w[i] * SQR(u_vec[i]);
	}
      }
      

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

	for (i = 0; i < quad_fast->n_points; i++) {
	  l2_err_el += dets[i] * uh_vec[i];
	}
      
	if (rel_err) {
	  for (i = 0; i < quad_fast->n_points; i++) {
	    l2_norm2 += dets[i] * u_vec[i];
	  }
	}
      } else {
	det = el_det_dim(dim, el_info);

	for (i = 0; i < quad_fast->n_points; i++) {
	  l2_err_el += uh_vec[i];
	}
	l2_err_el *= det;

	if (rel_err) {
	  norm_el = 0.0;
	  for (i = 0; i < quad_fast->n_points; i++) {
	    norm_el += u_vec[i];
	  }
	  l2_norm2 += det * norm_el;
	}
      }

      l2_err_2 += l2_err_el;
      max_err = MAX(max_err, l2_err_el);

      if (rw_err_el) {
	*rw_err_el(el_info->el) = l2_err_el;
      }
    } TRAVERSE_NEXT();
  }
  
  if (rel_err) {
    REAL rel_norm2 = l2_norm2 + 1.e-15;
    if (rw_err_el) {
      TRAVERSE_FIRST(fe_space->mesh, -1, CALL_LEAF_EL) {
	REAL *l2_err_el_p = rw_err_el(el_info->el);
	*l2_err_el_p /= rel_norm2;
      } TRAVERSE_NEXT();
    }
    l2_err_2 /= rel_norm2;
 } 

  if (max_l2_err2) {
    *max_l2_err2 = max_err;
  }

  return sqrt(l2_err_2);
}

REAL L2_err(FCT_AT_X u, const DOF_REAL_VEC *uh,
	    const QUAD *quad,
	    bool rel_err, bool mean_value_adjust,
	    REAL *(*rw_err_el)(EL *el), REAL *max_l2_err2)
{
  return _AI_L2_err(NULL,  u, NULL, NULL, 0,
		    uh, quad, rel_err, mean_value_adjust,
		    rw_err_el,  max_l2_err2);
}

REAL L2_err_loc(LOC_FCT_AT_QP u_loc, void *ud, FLAGS fill_flag,
		const DOF_REAL_VEC *uh,
		const QUAD *quad,
		bool rel_err, bool mean_value_adjust,
		REAL *(*rw_err_el)(EL *el), REAL *max_l2_err2)
{
  return _AI_L2_err(NULL, NULL, u_loc, ud, fill_flag,
		    uh, quad, rel_err, mean_value_adjust,
		    rw_err_el,  max_l2_err2);
}

REAL L2_err_weighted(FCT_AT_X weight, FCT_AT_X u, const DOF_REAL_VEC *uh,
		     const QUAD *quad,
		     bool rel_err, bool mean_value_adjust,
		     REAL *(*rw_err_el)(EL *el), REAL *max_l2_err2)
{
  return _AI_L2_err(weight, u, NULL, NULL, 0,
		    uh, quad, rel_err, mean_value_adjust,
		    rw_err_el,  max_l2_err2);
}

/*--------------------------------------------------------------------------*/
/*  H1 error on the mesh                                                    */
/*--------------------------------------------------------------------------*/

static REAL _AI_H1_err(FCT_AT_X weight, GRD_FCT_AT_X grd_u,
		       GRD_LOC_FCT_AT_QP grd_u_loc, void *ud, FLAGS fill_flag,
		       const DOF_REAL_VEC *uh, 
		       const QUAD *quad, bool rel_err, REAL *(*rw_err_el)(EL *),
		       REAL *max_el_err2)
{
  FUNCNAME("H1_err");
  MESH            *mesh;
  const FE_SPACE  *fe_space;
  const BAS_FCTS  *bas_fcts;
  const QUAD_FAST *quad_fast;
  REAL max_err, rel_norm2, h1_err_2, h1_norm2;
  
  if (!grd_u && !grd_u_loc) {
    ERROR("no gradient function grd_u specified; doing nothing\n");
    return 0.0;
  }
  if (!uh || !(fe_space = uh->fe_space)) {
    ERROR("no discrete function or no fe_space for it; doing nothing\n");
    return 0.0;
  }
  if (!uh->vec) {
    ERROR("no coefficient vector at discrete solution ; doing nothing\n");
    return 0.0;
  }
  if (!(bas_fcts = fe_space->bas_fcts)) {
    ERROR("no basis functions at discrete solution ; doing nothing\n");
    return 0.0;
  }

  mesh = fe_space->mesh;

  if (!quad) {
    quad = get_quadrature(fe_space->mesh->dim, 2*fe_space->bas_fcts->degree-2);
  }
  quad_fast = get_quad_fast(bas_fcts, quad, INIT_GRD_PHI);

  INIT_OBJECT(quad_fast);

  max_err = h1_err_2 = h1_norm2 = 0.0;
  {
    PARAMETRIC *parametric = fe_space->mesh->parametric;
    int     is_parametric = false;
    int     dim = mesh->dim;
    REAL_D  grdu_vec[quad->n_points_max];
    REAL_D  grduh_vec[quad->n_points_max];
    REAL    w_vec[quad->n_points_max];
    const EL_REAL_VEC *uh_el;
    const REAL_BD *Lambdas;
    const REAL    *dets;

    fill_flag |= quad_fast->fill_flags;
    TRAVERSE_FIRST(mesh, -1, CALL_LEAF_EL|FILL_COORDS|fill_flag) {
      int qp;
      REAL h1_err_el;

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

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

      uh_el = fill_el_real_vec(NULL, el_info->el, uh);

      h1_err_el = 0.0;
      if (is_parametric) {
	const QUAD_EL_CACHE *qelc =
	  fill_quad_el_cache(el_info, quad_fast->quad, FILL_EL_QUAD_LAMBDA);

	Lambdas = (const REAL_BD *)qelc->param.Lambda;
	dets    = (const REAL *)qelc->param.det;
	
	param_grd_uh_at_qp(grduh_vec, quad_fast, Lambdas, uh_el);
	if (grd_u) {
	  grd_fx_at_qp(grdu_vec, el_info, quad_fast->quad, grd_u);
	  if (dim != DIM_OF_WORLD) {
	    /* Transform the gradients to tangential gradient
	     * w.r.t. to the discrete surface. At least this prevents
	     * us from comparing apples and pears. FIXME. cH.
	     *
	     * The transformation is implemented by multiplying the
	     * Jacobians of the barycentric co-ordinates w.r.t. the
	     * Cartesian co-ordinates and vice-versa.
	     */
	    REAL_B grd_bar;
	    const REAL_D *grd_world;
	    
	    fill_quad_el_cache(
	      el_info, quad_fast->quad, FILL_EL_QUAD_GRD_WORLD);

	    for (qp = 0; qp < quad_fast->n_points; qp++) {
	      grd_world = (const REAL_D *)qelc->param.grd_world[qp];
	      GRAD_BAR(dim, grd_world, grdu_vec[qp], grd_bar);
	      GRAD_DOW(dim, (const REAL_D *)Lambdas[qp], grd_bar,
		       grdu_vec[qp]);
	    }
	  }
	} else {
	  param_grd_f_loc_at_qp(grdu_vec,
				el_info, quad, Lambdas, grd_u_loc, ud);
	}

	if (weight) {
	  fx_at_qp(w_vec, el_info, quad_fast->quad, weight);
	  for (qp = 0; qp < quad_fast->n_points; qp++) {
	    h1_err_el +=
	      dets[qp] * quad_fast->w[qp]*DST2_DOW(grdu_vec[qp], grduh_vec[qp])
	      * w_vec[qp];
	  }
	  if (rel_err) {
	    for (qp = 0; qp < quad_fast->n_points; qp++) {
	      h1_norm2 += dets[qp] * quad_fast->w[qp]*NRM2_DOW(grdu_vec[qp])
		* w_vec[qp];
	    }
	  }
	} else {
	  for (qp = 0; qp < quad_fast->n_points; qp++) {
	    h1_err_el +=
	      dets[qp] * quad_fast->w[qp]*DST2_DOW(grdu_vec[qp], grduh_vec[qp]);
	  }
	
	  if (rel_err) {
	    for (qp = 0; qp < quad_fast->n_points; qp++) {
	      h1_norm2 += dets[qp] * quad_fast->w[qp]*NRM2_DOW(grdu_vec[qp]);
	    }
	  }
	}
	
      } else {
	const EL_GEOM_CACHE *elgc = fill_el_geom_cache(el_info, FILL_EL_LAMBDA);

	grd_uh_at_qp(grduh_vec, quad_fast, (const REAL_D *)elgc->Lambda, uh_el);
	if (grd_u) {
	  grd_fx_at_qp(grdu_vec, el_info, quad_fast->quad, grd_u);
	  if (dim != DIM_OF_WORLD) {
	    REAL_B grd_bar;
	    
	    for (qp = 0; qp < quad_fast->n_points; qp++) {
	      GRAD_BAR(dim, (const REAL_D *)el_info->coord, grdu_vec[qp],
		       grd_bar);
	      GRAD_DOW(dim, (const REAL_D *)elgc->Lambda, grd_bar,
		       grdu_vec[qp]);
	    }	    
	  }
	} else {
	  grd_f_loc_at_qp(grdu_vec, el_info, quad, (const REAL_D *)elgc->Lambda,
			  grd_u_loc, ud);
	}
	if (weight) {
	  fx_at_qp(w_vec, el_info, quad_fast->quad, weight);
	  for (qp = 0; qp < quad_fast->n_points; qp++) {
	    h1_err_el += quad_fast->w[qp]*
	      DST2_DOW(grdu_vec[qp], grduh_vec[qp]) * w_vec[qp];
	  }
	  
	  h1_err_el *= elgc->det;
	  
	  if (rel_err) {
	    REAL norm_el = 0.0;
	    for (qp = 0; qp < quad_fast->n_points; qp++) {
	      norm_el += quad_fast->w[qp] * NRM2_DOW(grdu_vec[qp]) * w_vec[qp];
	    }
	    h1_norm2 += elgc->det*norm_el;
	  }
	  
	} else {
	  for (qp = 0; qp < quad_fast->n_points; qp++) {
	    h1_err_el += quad_fast->w[qp]*DST2_DOW(grdu_vec[qp], grduh_vec[qp]);
	  }
	  
	  h1_err_el *= elgc->det;
	  
	  if (rel_err) {
	    REAL norm_el = 0.0;
	    
	    for (qp = 0; qp < quad_fast->n_points; qp++) {
	      norm_el += quad_fast->w[qp] * NRM2_DOW(grdu_vec[qp]);
	    }
	    h1_norm2 += elgc->det*norm_el;
	  }
	}
      }
      
      h1_err_2 += h1_err_el;
      max_err = MAX(max_err, h1_err_el);
      
      if (rw_err_el) {
	*(*rw_err_el)(el_info->el) = h1_err_el;
      }
      
    } TRAVERSE_NEXT();
  }
  
  if (rel_err) {
    rel_norm2 = h1_norm2+1.e-15;
    if (rw_err_el) {
      TRAVERSE_FIRST(fe_space->mesh, -1, CALL_LEAF_EL) {
	REAL *h1_err_el_p = rw_err_el(el_info->el);
	*h1_err_el_p /= rel_norm2;
      } TRAVERSE_NEXT();
    }
    h1_err_2 /= rel_norm2;
    max_err /= rel_norm2;
  }
  
  if (max_el_err2) *max_el_err2 = max_err;
  
  return sqrt(h1_err_2);
}

REAL H1_err(GRD_FCT_AT_X grd_u, const DOF_REAL_VEC *uh, 
	    const QUAD *quad, bool rel_err, REAL *(*rw_err_el)(EL *),
	    REAL *max_el_err2)
{
  return _AI_H1_err(NULL, grd_u, NULL, NULL, 0,
		    uh, quad, rel_err, rw_err_el, max_el_err2);
}

REAL H1_err_loc(GRD_LOC_FCT_AT_QP grd_u_loc,
		void *ud, FLAGS fill_flag,
		const DOF_REAL_VEC *uh, 
		const QUAD *quad, bool rel_err, REAL *(*rw_err_el)(EL *),
		REAL *max_el_err2)
{
  return _AI_H1_err(NULL, NULL, grd_u_loc, ud, fill_flag,
		    uh, quad, rel_err, rw_err_el, max_el_err2);
}

REAL H1_err_weighted(FCT_AT_X weight, GRD_FCT_AT_X grd_u,
		     const DOF_REAL_VEC *uh, const QUAD *quad,
		     bool rel_err, REAL *(*rw_err_el)(EL *),
		     REAL *max_el_err2)
{
  return _AI_H1_err(weight, grd_u, NULL, NULL, 0,
		    uh, quad, rel_err, rw_err_el, max_el_err2);
}

/*--------------------------------------------------------------------------*/
/*  and now, the error functions for _d :-)))                               */
/*--------------------------------------------------------------------------*/

/*--------------------------------------------------------------------------*/
/*  max error at the quadrature points :-)))                                */
/*--------------------------------------------------------------------------*/

/*--------------------------------------------------------------------------*/
/*  max error at the quadrutare points of quadrature formula of degree      */
/*  of the continous function u and discrete function uh                    */
/*--------------------------------------------------------------------------*/

static REAL _AI_max_err_dow_at_qp(FCT_D_AT_X u, LOC_FCT_D_AT_QP u_loc,
				  void *ud, FLAGS fill_flag,
				  const DOF_REAL_VEC_D *uh,
				  const QUAD *quad)
{
  FUNCNAME("_AI_max_err_d_at_qp");
  const FE_SPACE *fe_space;
  const BAS_FCTS *bas_fcts;
  const QUAD_FAST *quad_fast;
  REAL max_err;
  PARAMETRIC *parametric;
  
  if (!u && !u_loc) {
    ERROR("no function u specified; doing nothing\n");
    return -1.0;
  }
  if (!uh || !(fe_space = uh->fe_space)) {
    ERROR("no discrete function or no fe_space for it; doing nothing\n");
    return -1.0;
  }
  if (!uh->vec) {
    ERROR("no coefficient vector at discrete solution ; doing nothing\n");
    return -1.0;
  }
  if (fe_space->rdim != DIM_OF_WORLD) {
    ERROR_EXIT("Called for scalar finite element space.\n");
    return -1.0;
  }
  if (!(bas_fcts = fe_space->bas_fcts)) {
    ERROR("no basis functions at discrete solution ; doing nothing\n");
    return -1.0;
  }
  if (!quad)
    quad = get_quadrature(bas_fcts->dim, 2*bas_fcts->degree-2);

  quad_fast = get_quad_fast(bas_fcts, quad, INIT_PHI);

  INIT_OBJECT(quad_fast);

  max_err = 0.0;
  parametric = fe_space->mesh->parametric;

  fill_flag |= quad_fast->fill_flags;
  TRAVERSE_FIRST(fe_space->mesh, -1, fill_flag|CALL_LEAF_EL|FILL_COORDS) {
    int          qp;
    REAL         err;
    const REAL_D *u_vec, *uh_vec;
    const EL_REAL_VEC_D *uh_el;

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

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

    if (u) {
      u_vec = fx_d_at_qp(NULL, el_info, quad_fast->quad, u);
    } else {
      u_vec = f_loc_d_at_qp(NULL, el_info, quad_fast->quad, u_loc, ud);
    }
    
    uh_el  = fill_el_real_vec_d(NULL, el_info->el, uh);
    uh_vec = uh_dow_at_qp(NULL, quad_fast, uh_el);

    for (qp = 0; qp < quad_fast->n_points; qp++) {
      err = DST2_DOW(u_vec[qp], uh_vec[qp]);
      max_err = MAX(max_err, err);
    }
  } TRAVERSE_NEXT();

  return sqrt(max_err);
}

REAL max_err_dow_at_qp(FCT_D_AT_X u,
		       const DOF_REAL_VEC_D *uh,
		       const QUAD *quad)
{
  return _AI_max_err_dow_at_qp(u, NULL, NULL, 0, uh, quad);
}

REAL max_err_dow_at_qp_loc(LOC_FCT_D_AT_QP u_loc,
			   void *ud, FLAGS fill_flag,
			   const DOF_REAL_VEC_D *uh,
			   const QUAD *quad)
{
  return _AI_max_err_dow_at_qp(NULL, u_loc, ud, fill_flag, uh, quad);
}

/*--------------------------------------------------------------------------*/
/*  max error at the vertices of the grid :-)))                             */
/*--------------------------------------------------------------------------*/

REAL max_err_dow_at_vert(FCT_D_AT_X u, const DOF_REAL_VEC_D *uh)
{
  FUNCNAME("max_err_d_at_vert");
  const FE_SPACE *fe_space;
  const BAS_FCTS *bas_fcts;
  FLAGS fill_flag;
  REAL max_err;
  int dim;
  PARAMETRIC *parametric;

  if (!u) {
    ERROR("no function u specified; doing nothing\n");
    return(-1.0);
  }
  if (!uh || !(fe_space = uh->fe_space)) {
    ERROR("no discrete function or no fe_space for it; doing nothing\n");
    return(-1.0);
  }
  if (fe_space->rdim != DIM_OF_WORLD) {
    ERROR_EXIT("Called for scalar finite element space.\n");
    return -1.0;
  }
  if (!uh->vec) {
    ERROR("no coefficient vector at discrete solution ; doing nothing\n");
    return(-1.0);
  }
  if (!(bas_fcts = fe_space->bas_fcts)) {
    ERROR("no basis functions at discrete solution ; doing nothing\n");
    return(-1.0);
  }

  max_err = 0.0;
  dim = fe_space->mesh->dim;
  parametric = fe_space->mesh->parametric;

  fill_flag = FILL_COORDS|CALL_LEAF_EL;
  TRAVERSE_FIRST(fe_space->mesh, -1, fill_flag) {
    int          i;
    REAL         err;
    const EL_REAL_VEC_D *uh_el;
    REAL_D       pcoords[N_VERTICES_MAX];
    REAL_D       *coords;

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

    if (parametric) {
      parametric->init_element(el_info, parametric);
      parametric->coord_to_world(el_info,
				 NULL, N_VERTICES(dim), (const REAL_B *)vl,
				 pcoords);
      coords = pcoords;
    } else {
      coords = (REAL_D *)el_info->coord;
    }

    uh_el = fill_el_real_vec_d(NULL, el_info->el, uh);
    for (i = 0; i < N_VERTICES(dim); i++) {
      err = DST2_DOW(u(coords[i], NULL),
		     eval_uh_dow(NULL, vl[i], uh_el, bas_fcts));
      max_err = MAX(max_err, err);
    }
  } TRAVERSE_NEXT();

  return sqrt(max_err);  
}

REAL max_err_dow_at_vert_loc(LOC_FCT_D_AT_QP u_at_qp,
			     void *ud, FLAGS fill_flag,
			     const DOF_REAL_VEC_D *uh)
{
  FUNCNAME("max_err_d_at_vert");
  const FE_SPACE *fe_space;
  const BAS_FCTS *bas_fcts;
  const QUAD     *qlump;
  REAL max_err;
  int dim;

  if (!u_at_qp) {
    ERROR("no function u specified; doing nothing\n");
    return(-1.0);
  }
  if (!uh || !(fe_space = uh->fe_space)) {
    ERROR("no discrete function or no fe_space for it; doing nothing\n");
    return(-1.0);
  }
  if (fe_space->rdim != DIM_OF_WORLD) {
    ERROR_EXIT("Called for scalar finite element space.\n");
    return -1.0;
  }
  if (!uh->vec) {
    ERROR("no coefficient vector at discrete solution ; doing nothing\n");
    return(-1.0);
  }
  if (!(bas_fcts = fe_space->bas_fcts)) {
    ERROR("no basis functions at discrete solution ; doing nothing\n");
    return(-1.0);
  }

  dim = fe_space->mesh->dim;
  qlump = get_lumping_quadrature(dim);

  max_err = 0.0;

  fill_flag |= bas_fcts->fill_flags;
  TRAVERSE_FIRST(fe_space->mesh, -1, fill_flag|CALL_LEAF_EL) {
    int          i;
    REAL         err;
    const EL_REAL_VEC_D *uh_el;

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

    uh_el = fill_el_real_vec_d(NULL, el_info->el, uh);
    for (i = 0; i < N_VERTICES(dim); i++) {
      err = DST2_DOW(u_at_qp(NULL, el_info, qlump, i, ud),
		     eval_uh_dow(NULL, vl[i], uh_el, bas_fcts));
      max_err = MAX(max_err, err);
    }
  } TRAVERSE_NEXT();

  return sqrt(max_err);  
}

/*--------------------------------------------------------------------------*/
/*  L2_d error on the mesh                                                  */
/*--------------------------------------------------------------------------*/

static REAL _AI_L2_err_dow(FCT_AT_X weight, FCT_D_AT_X u, LOC_FCT_D_AT_QP u_loc,
			   void *ud, FLAGS fill_flag,
			   const DOF_REAL_VEC_D *uh,
			   const QUAD *quad,
			   bool rel_err, bool mean_value_adjust,
			   REAL *(*rw_err_el)(EL *el), REAL *max_l2_err2)
{
  FUNCNAME("L2_err");
  const FE_SPACE  *fe_space;
  const BAS_FCTS  *bas_fcts;
  const QUAD_FAST *quad_fast;
  REAL max_err, l2_err_2, l2_norm2;  
  REAL_D mv_offset;

  if (!u && !u_loc) {
    ERROR("no function u specified; doing nothing\n");
    return 0.0;
  }
  if (!uh || !(fe_space = uh->fe_space)) {
    ERROR("no discrete function or no fe_space for it; doing nothing\n");
    return(0.0);
  }
  if (fe_space->rdim != DIM_OF_WORLD) {
    ERROR_EXIT("Called for scalar finite element space.\n");
    return -1.0;
  }
  if (!uh->vec) {
    ERROR("no coefficient vector at discrete solution ; doing nothing\n");
    return 0.0;
  }
  if (!(bas_fcts = fe_space->bas_fcts)) {
    ERROR("no basis functions at discrete solution ; doing nothing\n");
    return(0.0);
  }
  if (!quad)
    quad = get_quadrature(fe_space->mesh->dim, 2*fe_space->bas_fcts->degree);
  quad_fast = get_quad_fast(bas_fcts, quad, INIT_PHI);

  INIT_OBJECT(quad_fast);

  if (mean_value_adjust) {
    if (u) {
      mean_value_dow(fe_space->mesh, u, uh, quad, mv_offset);
    } else {
      mean_value_loc_dow(
	mv_offset, fe_space->mesh, u_loc, ud, fill_flag, uh, quad);
    }
  }

  max_err = l2_err_2 = l2_norm2 = 0.0;
  
  {
    PARAMETRIC *parametric = fe_space->mesh->parametric;
    int    is_parametric = false;
    int    dim = fe_space->mesh->dim;
    REAL   dets[quad->n_points_max];
    REAL_D u_vec[quad->n_points_max];
    REAL_D uh_vec[quad->n_points_max];
    REAL   w_vec[quad->n_points_max];
    const EL_REAL_VEC_D *uh_el;
    REAL   det;

    fill_flag |= quad_fast->fill_flags;
    TRAVERSE_FIRST(fe_space->mesh, -1, fill_flag|CALL_LEAF_EL|FILL_COORDS) {
      int  qp;
      REAL l2_err_el, norm_el;

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

      if (parametric) {
	is_parametric = parametric->init_element(el_info, parametric);
      }
      
      if (u) {
	fx_d_at_qp(u_vec, el_info, quad_fast->quad, u);
      } else {
	f_loc_d_at_qp(u_vec, el_info, quad_fast->quad, u_loc, ud);
      }
      uh_el = fill_el_real_vec_d(NULL, el_info->el, uh);
      uh_dow_at_qp(uh_vec, quad_fast, uh_el);

      if (weight) {
	fx_at_qp(w_vec, el_info, quad_fast->quad, weight);
	
	for (qp = 0; qp < quad_fast->n_points; qp++) {
	  AXPY_DOW(-1.0, u_vec[qp], uh_vec[qp]);
	  if (mean_value_adjust) {
	    AXPY_DOW(-1.0, mv_offset, uh_vec[qp]);
	  }
	  uh_vec[qp][0] = quad_fast->w[qp] * NRM2_DOW(uh_vec[qp]) * w_vec[qp];
	  u_vec[qp][0]  = quad_fast->w[qp] * NRM2_DOW(u_vec[qp]) * w_vec[qp];
	}
      } else {
	for (qp = 0; qp < quad_fast->n_points; qp++) {
	  AXPY_DOW(-1.0, u_vec[qp], uh_vec[qp]);
	  if (mean_value_adjust) {
	    AXPY_DOW(-1.0, mv_offset, uh_vec[qp]);
	  }
	  uh_vec[qp][0] = quad_fast->w[qp] * NRM2_DOW(uh_vec[qp]);
	  u_vec[qp][0]  = quad_fast->w[qp] * NRM2_DOW(u_vec[qp]);
	}
      }
      
      l2_err_el = 0.0;
      if (is_parametric) {
	parametric->det(el_info, quad_fast->quad, 0, NULL, dets);

	for (qp = 0; qp < quad_fast->n_points; qp++) {
	  l2_err_el += dets[qp] * uh_vec[qp][0];
	}
      
	if (rel_err) {
	  for (qp = 0; qp < quad_fast->n_points; qp++) {
	    l2_norm2 += dets[qp] * u_vec[qp][0];
	  }
	}
      } else {
	det = el_det_dim(dim, el_info);

	for (qp = 0; qp < quad_fast->n_points; qp++) {
	  l2_err_el += uh_vec[qp][0];
	}
	l2_err_el *= det;

	if (rel_err) {
	  norm_el = 0.0;
	  for (qp = 0; qp < quad_fast->n_points; qp++) {
	    norm_el += u_vec[qp][0];
	  }
	  l2_norm2 += det * norm_el;
	}
      }

      l2_err_2 += l2_err_el;
      max_err = MAX(max_err, l2_err_el);

      if (rw_err_el) {
	*rw_err_el(el_info->el) = l2_err_el;
      }
    } TRAVERSE_NEXT();
  }
  
  if (rel_err) {
    REAL rel_norm2 = l2_norm2 + 1.e-15;
    if (rw_err_el) {
      TRAVERSE_FIRST(fe_space->mesh, -1, CALL_LEAF_EL) {
	REAL *l2_err_el_p = rw_err_el(el_info->el);
	*l2_err_el_p /= rel_norm2;
      } TRAVERSE_NEXT();
      l2_err_2 /= rel_norm2;
    }
  }

  if (max_l2_err2) {
    *max_l2_err2 = max_err;
  }

  return sqrt(l2_err_2);
}

__FLATTEN_ATTRIBUTE__
REAL L2_err_dow(FCT_D_AT_X u,
		const DOF_REAL_VEC_D *uh,
		const QUAD *quad,
		bool rel_err, bool mean_value_adjust,
		REAL *(*rw_err_el)(EL *el), REAL *max_l2_err2)
{
  return _AI_L2_err_dow(NULL, u, NULL, NULL, 0,
			uh, quad, rel_err, mean_value_adjust,
			rw_err_el, max_l2_err2);
}

__FLATTEN_ATTRIBUTE__
REAL L2_err_loc_dow(LOC_FCT_D_AT_QP u_loc,
		    void *ud, FLAGS fill_flag,
		    const DOF_REAL_VEC_D *uh,
		    const QUAD *quad,
		    bool rel_err, bool mean_value_adjust,
		    REAL *(*rw_err_el)(EL *el), REAL *max_l2_err2)
{
  return _AI_L2_err_dow(NULL, NULL, u_loc, ud, fill_flag, uh, quad,
			rel_err, mean_value_adjust,
			rw_err_el, max_l2_err2);
}

__FLATTEN_ATTRIBUTE__
REAL L2_err_dow_weighted(FCT_AT_X weight, FCT_D_AT_X u,
			 const DOF_REAL_VEC_D *uh,
			 const QUAD *quad,
			 bool rel_err, bool mean_value_adjust,
			 REAL *(*rw_err_el)(EL *el), REAL *max_l2_err2)
{
  return _AI_L2_err_dow(weight, u, NULL, NULL, 0,
			uh, quad, rel_err, mean_value_adjust,
			rw_err_el, max_l2_err2);
}



/*--------------------------------------------------------------------------*/
/*  H1_d error on the mesh                                                  */
/*--------------------------------------------------------------------------*/

static REAL _AI_H1_err_dow(FCT_AT_X weight, GRD_FCT_D_AT_X grd_u,
			   GRD_LOC_FCT_D_AT_QP grd_u_loc,
			   void *ud, FLAGS fill_flag,
			   const DOF_REAL_VEC_D *uh, const QUAD *quad,
			   bool rel_err,
			   REAL *(*rw_err_el)(EL *), REAL *max_el_err2)
{
  FUNCNAME("H1_err_d");
  const FE_SPACE  *fe_space;
  const BAS_FCTS  *bas_fcts;
  const QUAD_FAST *quad_fast;
  REAL max_err, rel_norm2, h1_err_2, h1_norm2;
  
  if (!grd_u && !grd_u_loc) {
    ERROR("no gradient function grd_u specified; doing nothing\n");
    return 0.0;
  }
  if (!uh || !(fe_space = uh->fe_space)) {
    ERROR("no discrete function or no fe_space for it; doing nothing\n");
    return 0.0;
  }
  if (fe_space->rdim != DIM_OF_WORLD) {
    ERROR_EXIT("Called for scalar finite element space.\n");
    return -1.0;
  }
  if (!uh->vec) {
    ERROR("no coefficient vector at discrete solution ; doing nothing\n");
    return 0.0;
  }
  if (!(bas_fcts = fe_space->bas_fcts)) {
    ERROR("no basis functions at discrete solution ; doing nothing\n");
    return 0.0;
  }
  if (!quad) {
    quad = get_quadrature(fe_space->mesh->dim, 2*fe_space->bas_fcts->degree-2);
  }
  quad_fast = get_quad_fast(bas_fcts, quad, INIT_GRD_PHI);

  INIT_OBJECT(quad_fast);

  max_err = h1_err_2 = h1_norm2 = 0.0;
  {
    PARAMETRIC *parametric = fe_space->mesh->parametric;
    int        is_parametric = false;
    int        dim = fe_space->mesh->dim;
    REAL_DD    grdu_vec[quad->n_points_max];
    REAL_DD    grduh_vec[quad->n_points_max];
    REAL       w_vec[quad->n_points_max];
    const EL_REAL_VEC_D *uh_el;
    const REAL_BD *Lambdas;
    const REAL    *dets;

    fill_flag |= quad_fast->fill_flags;
    TRAVERSE_FIRST(fe_space->mesh, -1, fill_flag|CALL_LEAF_EL|FILL_COORDS) {
      int  qp;
      REAL h1_err_el;

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

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

      uh_el = fill_el_real_vec_d(NULL, el_info->el, uh);

      h1_err_el = 0.0;
      if (is_parametric) {
	const QUAD_EL_CACHE *qelc =
	  fill_quad_el_cache(el_info, quad_fast->quad, FILL_EL_QUAD_LAMBDA);

	Lambdas = (const REAL_BD *)qelc->param.Lambda;
	dets    = (const REAL *)qelc->param.det;

	param_grd_uh_dow_at_qp(grduh_vec,
			       quad_fast,
			       (const REAL_BD *)Lambdas,
			       uh_el);
	if (grd_u) {
	  grd_fx_d_at_qp(grdu_vec, el_info, quad_fast->quad, grd_u);
	  if (dim != DIM_OF_WORLD) {
	    /* Transform the gradients to tangential gradient
	     * w.r.t. to the discrete surface. At least this prevents
	     * us from comparing apples and pears. FIXME. cH.
	     *
	     * The transformation is implemented by multiplying the
	     * Jacobians of the barycentric co-ordinates w.r.t. the
	     * Cartesian co-ordinates and vice-versa.
	     */
	    REAL_DB grd_bar;
	    const REAL_D *grd_world;
	    
	    fill_quad_el_cache(
	      el_info, quad_fast->quad, FILL_EL_QUAD_GRD_WORLD);

	    for (qp = 0; qp < quad_fast->n_points; qp++) {
	      grd_world = (const REAL_D *)qelc->param.grd_world[qp];
	      MGRAD_BAR(dim, grd_world, (const REAL_D *)grdu_vec[qp], grd_bar);
	      MGRAD_DOW(dim, (const REAL_D *)Lambdas[qp],
			(const REAL_B *)grd_bar, grdu_vec[qp]);
	    }
	  }
	} else {
	  param_grd_f_loc_d_at_qp(grdu_vec, el_info, quad_fast->quad, Lambdas,
				  grd_u_loc, ud);
	}
	if (weight) {
	  fx_at_qp(w_vec, el_info, quad_fast->quad, weight);
	  
	  for (qp = 0; qp < quad_fast->n_points; qp++) {
	    h1_err_el +=
	      dets[qp]
	      * quad_fast->w[qp]
	      * MDST2_DOW((const REAL_D *)grdu_vec[qp],
			  (const REAL_D *)grduh_vec[qp]) * w_vec[qp];
	  }
	  
	  if (rel_err) {
	    for (qp = 0; qp < quad_fast->n_points; qp++) {
	      h1_norm2 +=
		dets[qp]
		* quad_fast->w[qp]
		* MNRM2_DOW((const REAL_D *)grdu_vec[qp]) * w_vec[qp];
	    }
	  }
	} else {
	  for (qp = 0; qp < quad_fast->n_points; qp++) {
	    h1_err_el +=
	      dets[qp]
	      * quad_fast->w[qp]
	      * MDST2_DOW((const REAL_D *)grdu_vec[qp],
			  (const REAL_D *)grduh_vec[qp]);
	  }
	  
	  if (rel_err) {
	    for (qp = 0; qp < quad_fast->n_points; qp++) {
	      h1_norm2 +=
		dets[qp]
		* quad_fast->w[qp]
		* MNRM2_DOW((const REAL_D *)grdu_vec[qp]);
	    }
	  }
	}
	
      } else {
	const EL_GEOM_CACHE *elgc = fill_el_geom_cache(el_info, FILL_EL_LAMBDA);
	
	grd_uh_dow_at_qp(grduh_vec,
			 quad_fast,
			 (const REAL_D *)elgc->Lambda,
			 uh_el);
	if (grd_u) {
	  grd_fx_d_at_qp(grdu_vec, el_info, quad_fast->quad, grd_u);
	  if (dim != DIM_OF_WORLD) {
	    REAL_DB grd_bar;
	    
	    for (qp = 0; qp < quad_fast->n_points; qp++) {
	      MGRAD_BAR(dim, (const REAL_D *)el_info->coord,
			(const REAL_D *)grdu_vec[qp],
			grd_bar);
	      MGRAD_DOW(dim, (const REAL_D *)elgc->Lambda,
			(const REAL_B *)grd_bar, grdu_vec[qp]);
	    }	    
	  }
	} else {
	  grd_f_loc_d_at_qp(grdu_vec,
			    el_info, quad_fast->quad,
			    (const REAL_D *)elgc->Lambda,
			    grd_u_loc, ud);
	}
	if (weight) {
	  fx_at_qp(w_vec, el_info, quad_fast->quad, weight);
	  
	  for (qp = 0; qp < quad_fast->n_points; qp++) {
	    h1_err_el +=
	      quad_fast->w[qp]
	      * MDST2_DOW((const REAL_D *)grdu_vec[qp],
			  (const REAL_D *)grduh_vec[qp]) * w_vec[qp];
	  }
	  
	  h1_err_el *= elgc->det;
	  
	  if (rel_err) {
	    REAL norm_el = 0.0;
	    for (qp = 0; qp < quad_fast->n_points; qp++) {
	      norm_el +=
		quad_fast->w[qp] * MNRM2_DOW((const REAL_D *)grdu_vec[qp]) *
		w_vec[qp];
	    }
	    h1_norm2 += elgc->det*norm_el;
	  }
	} else {
	  for (qp = 0; qp < quad_fast->n_points; qp++) {
	    h1_err_el +=
	      quad_fast->w[qp]
	      * MDST2_DOW((const REAL_D *)grdu_vec[qp],
			  (const REAL_D *)grduh_vec[qp]);
	  }
	  
	  h1_err_el *= elgc->det;
	  
	  if (rel_err) {
	    REAL norm_el = 0.0;
	    for (qp = 0; qp < quad_fast->n_points; qp++) {
	      norm_el +=
		quad_fast->w[qp] * MNRM2_DOW((const REAL_D *)grdu_vec[qp]);
	    }
	    h1_norm2 += elgc->det*norm_el;
	  }
	}
	
      }
      
      h1_err_2 += h1_err_el;
      max_err = MAX(max_err, h1_err_el);

      if (rw_err_el) *(*rw_err_el)(el_info->el) = h1_err_el;

    } TRAVERSE_NEXT();
  }

  if (rel_err)
  {
    rel_norm2 = h1_norm2+1.e-15;
    if (rw_err_el) {
      TRAVERSE_FIRST(fe_space->mesh, -1, CALL_LEAF_EL) {
	REAL *h1_err_el_p = rw_err_el(el_info->el);
	*h1_err_el_p /= rel_norm2;
      } TRAVERSE_NEXT();
    }
    h1_err_2 /= rel_norm2;
    max_err /= rel_norm2;
  }

  if (max_el_err2) *max_el_err2 = max_err;

  return sqrt(h1_err_2);
}

__FLATTEN_ATTRIBUTE__
REAL H1_err_dow(GRD_FCT_D_AT_X grd_u, const DOF_REAL_VEC_D *uh,
		const QUAD *quad,
		bool rel_err, REAL *(*rw_err_el)(EL *), REAL *max_el_err2)
{
  return _AI_H1_err_dow(NULL, grd_u, NULL, NULL, 0, uh, quad,
			rel_err, rw_err_el, max_el_err2);
}

__FLATTEN_ATTRIBUTE__
REAL H1_err_loc_dow(GRD_LOC_FCT_D_AT_QP grd_u_loc, void *ud, FLAGS fill_flag,
		    const DOF_REAL_VEC_D *uh, const QUAD *quad,
		    bool rel_err, 
		    REAL *(*rw_err_el)(EL *), REAL *max_el_err2)
{
  return _AI_H1_err_dow(NULL, NULL, grd_u_loc, ud, fill_flag, uh, quad,
			rel_err, rw_err_el, max_el_err2);
}

__FLATTEN_ATTRIBUTE__
REAL H1_err_dow_weighted(FCT_AT_X weight, GRD_FCT_D_AT_X grd_u,
			 const DOF_REAL_VEC_D *uh,
			 const QUAD *quad,
			 bool rel_err, REAL *(*rw_err_el)(EL *),
			 REAL *max_el_err2)
{
  return _AI_H1_err_dow(weight, grd_u, NULL, NULL, 0, uh, quad,
			rel_err, rw_err_el, max_el_err2);
}

/* same as H1_err(), but for the deformation tensor */

static REAL _AI_deform_err(FCT_AT_X weight, GRD_FCT_D_AT_X grd_u,
			   GRD_LOC_FCT_D_AT_QP grd_u_loc,
			   void *ud, FLAGS fill_flag,
			   const DOF_REAL_VEC_D *uh, const QUAD *quad,
			   bool rel_err,
			   REAL *(*rw_err_el)(EL *), REAL *max_el_err2)
{
  FUNCNAME("H1_err_d");
  const FE_SPACE  *fe_space;
  const BAS_FCTS  *bas_fcts;
  const QUAD_FAST *quad_fast;
  REAL max_err, rel_norm2, h1_err_2, h1_norm2;
  
  if (!grd_u && !grd_u_loc) {
    ERROR("no gradient function grd_u specified; doing nothing\n");
    return 0.0;
  }
  if (!uh || !(fe_space = uh->fe_space)) {
    ERROR("no discrete function or no fe_space for it; doing nothing\n");
    return 0.0;
  }
  if (fe_space->rdim != DIM_OF_WORLD) {
    ERROR_EXIT("Called for scalar finite element space.\n");
    return -1.0;
  }
  if (!uh->vec) {
    ERROR("no coefficient vector at discrete solution ; doing nothing\n");
    return 0.0;
  }
  if (!(bas_fcts = fe_space->bas_fcts)) {
    ERROR("no basis functions at discrete solution ; doing nothing\n");
    return 0.0;
  }
  if (!quad) {
    quad = get_quadrature(fe_space->mesh->dim, 2*fe_space->bas_fcts->degree-2);
  }
  quad_fast = get_quad_fast(bas_fcts, quad, INIT_GRD_PHI);

  INIT_OBJECT(quad_fast);

  max_err = h1_err_2 = h1_norm2 = 0.0;
  {
    PARAMETRIC *parametric = fe_space->mesh->parametric;
    int        is_parametric = false;
    int        dim = fe_space->mesh->dim;
    REAL_DD    grdu_vec[quad->n_points_max];
    REAL_DD    grduh_vec[quad->n_points_max];
    REAL       w_vec[quad->n_points_max];
    const EL_REAL_VEC_D *uh_el;
    const REAL_BD *Lambdas;
    const REAL    *dets;

    fill_flag |= quad_fast->fill_flags;
    TRAVERSE_FIRST(fe_space->mesh, -1, fill_flag|CALL_LEAF_EL|FILL_COORDS) {
      int  qp, i, j;
      REAL h1_err_el;

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

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

      uh_el = fill_el_real_vec_d(NULL, el_info->el, uh);

      h1_err_el = 0.0;
      if (is_parametric) {
	const QUAD_EL_CACHE *qelc =
	  fill_quad_el_cache(el_info, quad_fast->quad, FILL_EL_QUAD_LAMBDA);

	Lambdas = (const REAL_BD *)qelc->param.Lambda;
	dets    = (const REAL *)qelc->param.det;

	param_grd_uh_dow_at_qp(grduh_vec,
			       quad_fast,
			       (const REAL_BD *)Lambdas,
			       uh_el);
	if (grd_u) {
	  grd_fx_d_at_qp(grdu_vec, el_info, quad_fast->quad, grd_u);
	  if (dim != DIM_OF_WORLD) {
	    /* Transform the gradients to tangential gradient
	     * w.r.t. to the discrete surface. At least this prevents
	     * us from comparing apples and pears. FIXME. cH.
	     *
	     * The transformation is implemented by multiplying the
	     * Jacobians of the barycentric co-ordinates w.r.t. the
	     * Cartesian co-ordinates and vice-versa.
	     */
	    REAL_DB grd_bar;
	    const REAL_D *grd_world;
	    
	    fill_quad_el_cache(
	      el_info, quad_fast->quad, FILL_EL_QUAD_GRD_WORLD);

	    for (qp = 0; qp < quad_fast->n_points; qp++) {
	      grd_world = (const REAL_D *)qelc->param.grd_world[qp];
	      MGRAD_BAR(dim, grd_world, (const REAL_D *)grdu_vec[qp], grd_bar);
	      MGRAD_DOW(dim, (const REAL_D *)Lambdas[qp],
			(const REAL_B *)grd_bar, grdu_vec[qp]);
	    }
	  }
	} else {
	  param_grd_f_loc_d_at_qp(grdu_vec, el_info, quad_fast->quad, Lambdas,
				  grd_u_loc, ud);
	}
	if (weight) {
	  fx_at_qp(w_vec, el_info, quad_fast->quad, weight);
	  
	  for (qp = 0; qp < quad_fast->n_points; qp++) {
	    /* symmetrize */
	    for (i = 0; i < DIM_OF_WORLD; i++) {
	      grdu_vec[qp][i][i] *= 2.0;
	      grduh_vec[qp][i][i] *= 2.0;
	      for (j = i+1; j < DIM_OF_WORLD; j++) {
		grdu_vec[qp][i][j]  += grdu_vec[qp][j][i];
		grdu_vec[qp][j][i]  += grdu_vec[qp][i][j];
		grduh_vec[qp][i][j] += grduh_vec[qp][j][i];
		grduh_vec[qp][j][i] += grduh_vec[qp][i][j];
	      }
	    }
	    h1_err_el +=
	      dets[qp]
	      * quad_fast->w[qp]
	      * MDST2_DOW((const REAL_D *)grdu_vec[qp],
			  (const REAL_D *)grduh_vec[qp]) * w_vec[qp];
	  }
	  
	  if (rel_err) {
	    for (qp = 0; qp < quad_fast->n_points; qp++) {
	      h1_norm2 +=
		dets[qp]
		* quad_fast->w[qp]
		* MNRM2_DOW((const REAL_D *)grdu_vec[qp]) * w_vec[qp];
	    }
	  }
	} else {
	  for (qp = 0; qp < quad_fast->n_points; qp++) {
	    /* symmetrize */
	    for (i = 0; i < DIM_OF_WORLD; i++) {
	      grdu_vec[qp][i][i] *= 2.0;
	      grduh_vec[qp][i][i] *= 2.0;
	      for (j = i+1; j < DIM_OF_WORLD; j++) {
		grdu_vec[qp][i][j]  += grdu_vec[qp][j][i];
		grdu_vec[qp][j][i]  += grdu_vec[qp][i][j];
		grduh_vec[qp][i][j] += grduh_vec[qp][j][i];
		grduh_vec[qp][j][i] += grduh_vec[qp][i][j];
	      }
	    }
	    h1_err_el +=
	      dets[qp]
	      * quad_fast->w[qp]
	      * MDST2_DOW((const REAL_D *)grdu_vec[qp],
			  (const REAL_D *)grduh_vec[qp]);
	  }
	  
	  if (rel_err) {
	    for (qp = 0; qp < quad_fast->n_points; qp++) {
	      h1_norm2 +=
		dets[qp]
		* quad_fast->w[qp]
		* MNRM2_DOW((const REAL_D *)grdu_vec[qp]);
	    }
	  }
	}
	
      } else {
	const EL_GEOM_CACHE *elgc = fill_el_geom_cache(el_info, FILL_EL_LAMBDA);
	
	grd_uh_dow_at_qp(grduh_vec,
			 quad_fast,
			 (const REAL_D *)elgc->Lambda,
			 uh_el);
	if (grd_u) {
	  grd_fx_d_at_qp(grdu_vec, el_info, quad_fast->quad, grd_u);
	  if (dim != DIM_OF_WORLD) {
	    REAL_DB grd_bar;
	    
	    for (qp = 0; qp < quad_fast->n_points; qp++) {
	      MGRAD_BAR(dim, (const REAL_D *)el_info->coord,
			(const REAL_D *)grdu_vec[qp],
			grd_bar);
	      MGRAD_DOW(dim, (const REAL_D *)elgc->Lambda,
			(const REAL_B *)grd_bar, grdu_vec[qp]);
	    }	    
	  }
	} else {
	  grd_f_loc_d_at_qp(grdu_vec,
			    el_info, quad_fast->quad,
			    (const REAL_D *)elgc->Lambda,
			    grd_u_loc, ud);
	}
	if (weight) {
	  fx_at_qp(w_vec, el_info, quad_fast->quad, weight);
	  
	  for (qp = 0; qp < quad_fast->n_points; qp++) {
	    /* symmetrize */
	    for (i = 0; i < DIM_OF_WORLD; i++) {
	      grdu_vec[qp][i][i] *= 2.0;
	      grduh_vec[qp][i][i] *= 2.0;
	      for (j = i+1; j < DIM_OF_WORLD; j++) {
		grdu_vec[qp][i][j]  += grdu_vec[qp][j][i];
		grdu_vec[qp][j][i]  += grdu_vec[qp][i][j];
		grduh_vec[qp][i][j] += grduh_vec[qp][j][i];
		grduh_vec[qp][j][i] += grduh_vec[qp][i][j];
	      }
	    }
	    h1_err_el +=
	      quad_fast->w[qp]
	      * MDST2_DOW((const REAL_D *)grdu_vec[qp],
			  (const REAL_D *)grduh_vec[qp]) * w_vec[qp];
	  }
	  
	  h1_err_el *= elgc->det;
	  
	  if (rel_err) {
	    REAL norm_el = 0.0;
	    for (qp = 0; qp < quad_fast->n_points; qp++) {
	      norm_el +=
		quad_fast->w[qp] * MNRM2_DOW((const REAL_D *)grdu_vec[qp]) *
		w_vec[qp];
	    }
	    h1_norm2 += elgc->det*norm_el;
	  }
	} else {
	  for (qp = 0; qp < quad_fast->n_points; qp++) {
	    /* symmetrize */
	    for (i = 0; i < DIM_OF_WORLD; i++) {
	      grdu_vec[qp][i][i] *= 2.0;
	      grduh_vec[qp][i][i] *= 2.0;
	      for (j = i+1; j < DIM_OF_WORLD; j++) {
		grdu_vec[qp][i][j]  += grdu_vec[qp][j][i];
		grdu_vec[qp][j][i]  += grdu_vec[qp][i][j];
		grduh_vec[qp][i][j] += grduh_vec[qp][j][i];
		grduh_vec[qp][j][i] += grduh_vec[qp][i][j];
	      }
	    }
	    h1_err_el +=
	      quad_fast->w[qp]
	      * MDST2_DOW((const REAL_D *)grdu_vec[qp],
			  (const REAL_D *)grduh_vec[qp]);
	  }
	  
	  h1_err_el *= elgc->det;
	  
	  if (rel_err) {
	    REAL norm_el = 0.0;
	    for (qp = 0; qp < quad_fast->n_points; qp++) {
	      norm_el +=
		quad_fast->w[qp] * MNRM2_DOW((const REAL_D *)grdu_vec[qp]);
	    }
	    h1_norm2 += elgc->det*norm_el;
	  }
	}
	
      }
      
      h1_err_2 += h1_err_el;
      max_err = MAX(max_err, h1_err_el);

      if (rw_err_el) *(*rw_err_el)(el_info->el) = h1_err_el;

    } TRAVERSE_NEXT();
  }

  if (rel_err)
  {
    rel_norm2 = h1_norm2+1.e-15;
    if (rw_err_el) {
      TRAVERSE_FIRST(fe_space->mesh, -1, CALL_LEAF_EL) {
	REAL *h1_err_el_p = rw_err_el(el_info->el);
	*h1_err_el_p /= rel_norm2;
      } TRAVERSE_NEXT();
    }
    h1_err_2 /= rel_norm2;
    max_err /= rel_norm2;
  }

  if (max_el_err2) *max_el_err2 = max_err;

  return sqrt(h1_err_2);
}

__FLATTEN_ATTRIBUTE__
REAL deform_err(GRD_FCT_D_AT_X grd_u, const DOF_REAL_VEC_D *uh,
		const QUAD *quad,
		bool rel_err, REAL *(*rw_err_el)(EL *), REAL *max_el_err2)
{
  return _AI_deform_err(NULL, grd_u, NULL, NULL, 0, uh, quad,
			rel_err, rw_err_el, max_el_err2);
}

__FLATTEN_ATTRIBUTE__
REAL deform_err_loc(GRD_LOC_FCT_D_AT_QP grd_u_loc, void *ud, FLAGS fill_flag,
		    const DOF_REAL_VEC_D *uh, const QUAD *quad,
		    bool rel_err, 
		    REAL *(*rw_err_el)(EL *), REAL *max_el_err2)
{
  return _AI_deform_err(NULL, NULL, grd_u_loc, ud, fill_flag, uh, quad,
			rel_err, rw_err_el, max_el_err2);
}

__FLATTEN_ATTRIBUTE__
REAL deform_err_weighted(FCT_AT_X weight, GRD_FCT_D_AT_X grd_u,
			 const DOF_REAL_VEC_D *uh,
			 const QUAD *quad,
			 bool rel_err, REAL *(*rw_err_el)(EL *),
			 REAL *max_el_err2)
{
  return _AI_deform_err(weight, grd_u, NULL, NULL, 0, uh, quad,
			rel_err, rw_err_el, max_el_err2);
}

