/*--------------------------------------------------------------------------*/
/* ALBERTA:  an Adaptive multi Level finite element toolbox using           */
/*           Bisectioning refinement and Error control by Residual          */
/*           Techniques for scientific Applications                         */
/*                                                                          */
/* file:     l2scp.c                                                        */
/*                                                                          */
/* description:  compute L2 scalar products of the right hand side and      */
/*               the basis functions of the fe-space                        */
/*               sets Dirichlet boundary values                             */
/*                                                                          */
/*--------------------------------------------------------------------------*/
/*                                                                          */
/*  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).                                         */
/*                                                                          */
/*--------------------------------------------------------------------------*/

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

 /*--------------------------------------------------------------------------*/
 /*  calculates the L2 scalar product of the function f with each basis      */
 /*  function of the mesh belonging to the dof admin of fh; the scalar       */
 /*  products are stored in fh;                                              */
 /*                                                                          */
 /*    fh->vec[j] =  (f, phi_j)_\Omega                                       */
 /*                                                                          */
 /*  where phi_j are the basis functions belonging to fh->fe_space->admin    */
 /*                                                                          */
 /*--------------------------------------------------------------------------*/

static void _AI_L2scp_fct_bas(DOF_REAL_VEC *fh,
			      LOC_FCT_AT_QP f_loc, void *fd, FCT_AT_X f,
			      FLAGS fill_flag,
			      const QUAD *quad)
{
  FUNCNAME("L2scp_fct_bas");
  MESH            *mesh = NULL;
  const QUAD_FAST *quad_fast;
  const FE_SPACE  *fe_space;
  const REAL      *w;
  const REAL_B    *lambda;
  REAL            val, det;
  REAL_D          x;
  int             iq, j, n_phi, dim;
  const BAS_FCTS  *bas_fcts;
  INIT_EL_TAG     tag = INIT_EL_TAG_DFLT;  

  TEST_EXIT(fh, "no DOF_REAL_VEC fh\n");
  if (!f && !f_loc)
    return;

  TEST_EXIT(fh->fe_space, "no fe_space in DOF_REAL_VEC %s\n", NAME(fh));

  GET_STRUCT(mesh, fh->fe_space);

  dim = mesh->dim;

  fe_space = fh->fe_space;
  bas_fcts = fe_space->bas_fcts;

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

  w      = quad_fast->w;
  lambda = quad_fast->quad->lambda;
  n_phi  = bas_fcts->n_bas_fcts;

  fill_flag |= CALL_LEAF_EL|FILL_COORDS;
  if (mesh->is_periodic && !(fh->fe_space->admin->flags & ADM_PERIODIC)) {
    fill_flag |= FILL_NON_PERIODIC;
  }
  fill_flag |= quad_fast->fill_flags;

  {
    PARAMETRIC *parametric = mesh->parametric;
    int        is_parametric = false;
    int        dim = mesh->dim;
    REAL       det_p[quad->n_points_max];
    REAL       wdetf_qp[quad->n_points_max];
    REAL_D     x_p[quad->n_points_max];
    const EL_DOF_VEC *dof;
    
    TRAVERSE_FIRST(mesh, -1, fill_flag) {

      INIT_ELEMENT_SETUP(el_info, quad_fast, tag, continue, {
	  w      = quad_fast->w;
	  lambda = quad_fast->quad->lambda;
	  n_phi  = bas_fcts->n_bas_fcts;
	});

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

      if (is_parametric) {
	parametric->det(el_info, quad, 0, NULL, det_p);
	
	if (f) {
	  parametric->coord_to_world(el_info, quad, 0, NULL, x_p);
	  for (iq = 0; iq < quad->n_points; iq++) {
	    wdetf_qp[iq] = w[iq]*det_p[iq]*f(x_p[iq]);
	  }
	} else {
	  for (iq = 0; iq < quad->n_points; iq++) {
	    wdetf_qp[iq] = w[iq]*det_p[iq]*f_loc(el_info, quad, iq, fd);
	  }
	}
      } else {
	det = el_det_dim(dim, el_info);
	if (f) {
	  for (iq = 0; iq < quad->n_points; iq++) {
	    coord_to_world(el_info, lambda[iq], x);
	    wdetf_qp[iq] = w[iq]*det*f(x);
	  }
	} else {
	  for (iq = 0; iq < quad->n_points; iq++) {
	    wdetf_qp[iq] = w[iq]*det*f_loc(el_info, quad, iq, fd);
	  }
	}
      }

      INIT_ELEMENT(el_info, quad_fast);

      CHAIN_DO(quad_fast, const QUAD_FAST) {
	const BAS_FCTS *bas_fcts;
	const REAL *const*phi;

	bas_fcts = quad_fast->bas_fcts;
	phi      = quad_fast->phi;
	n_phi    = bas_fcts->n_bas_fcts;

	dof = GET_DOF_INDICES(bas_fcts, el_info->el, fh->fe_space->admin, NULL);

	for (j = 0; j < n_phi; j++) {
	  val = 0.0;
	  for (iq = 0; iq < quad->n_points; iq++) {
	    val += phi[iq][j]*wdetf_qp[iq];
	  }
	  fh->vec[dof->vec[j]] += val;
	}
	fh        = CHAIN_NEXT(fh, DOF_REAL_VEC);
      } CHAIN_WHILE(quad_fast, const QUAD_FAST);
    } TRAVERSE_NEXT();
  }
}

__FLATTEN_ATTRIBUTE__
void L2scp_fct_bas(FCT_AT_X f, const QUAD *quad, DOF_REAL_VEC *fh)
{
  _AI_L2scp_fct_bas(fh, NULL, NULL, f, FILL_NOTHING, quad);
}

__FLATTEN_ATTRIBUTE__
void L2scp_fct_bas_loc(DOF_REAL_VEC *fh,
		       LOC_FCT_AT_QP f, void *fd, FLAGS fill_flag,
		       const QUAD *quad)
{
  _AI_L2scp_fct_bas(fh, f, fd, NULL, fill_flag, quad);
}

static void _AI_L2scp_fct_bas_dow(DOF_REAL_VEC_D *fh,
				  FCT_D_AT_X f,
				  LOC_FCT_D_AT_QP f_loc, void *fd,
				  FLAGS fill_flag,
				  const QUAD *quad)
{
  FUNCNAME("L2scp_fct_bas_dow");
  MESH            *mesh = NULL;
  const QUAD_FAST *quad_fast;
  const FE_SPACE  *fe_space;
  REAL_D          x;
  REAL            det;
  const REAL      *w;
  const REAL_B    *lambda;
  REAL_D          val;
  int             iq, j, n_phi, dim, n_points;
  const BAS_FCTS  *bas_fcts;
  INIT_EL_TAG     qtag = INIT_EL_TAG_DFLT;

  TEST_EXIT(fh, "no DOF_REAL_VEC fh\n");
  if (!f && !f_loc)
    return;

  TEST_EXIT(fh->fe_space, "no fe_space in DOF_REAL_D_VEC \"%s\"\n", NAME(fh));

  TEST_EXIT(fh->fe_space->rdim == DIM_OF_WORLD,
	    "Called for scalar finite element space \"%s\".\n",
	    NAME(fh->fe_space));

  GET_STRUCT(mesh, fh->fe_space);

  dim = mesh->dim;

  fe_space = fh->fe_space;
  bas_fcts = fe_space->bas_fcts;

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

  w            = quad->w;
  lambda       = quad->lambda;
  n_points     = quad->n_points;

  fill_flag |= CALL_LEAF_EL|FILL_COORDS;
  if (mesh->is_periodic && !(fh->fe_space->admin->flags & ADM_PERIODIC)) {
    fill_flag |= FILL_NON_PERIODIC;
  }
  fill_flag |= quad_fast->fill_flags;

  {
    PARAMETRIC *parametric = mesh->parametric;
    int        is_parametric = false;
    int        dim = mesh->dim;
    REAL       det_p[quad->n_points_max];
    REAL_D     wdetf_qp[quad->n_points_max];
    REAL_D     x_p[quad->n_points_max];
    const EL_DOF_VEC *dof;
    
    TRAVERSE_FIRST(mesh, -1, fill_flag) {

      INIT_ELEMENT_SETUP(el_info, quad, qtag, continue, {
	  w        = quad->w;
	  n_points = quad->n_points;
	  lambda   = quad->lambda;
	});
      
      if (parametric) {
	is_parametric = parametric->init_element(el_info, parametric);
      }

      if (is_parametric) {
	parametric->det(el_info, quad, -1, NULL, det_p);
	if (f) {
	  parametric->coord_to_world(el_info, quad, -1, NULL, x_p);
	  for (iq = 0; iq < quad->n_points; iq++) {
	    AXEY_DOW(w[iq]*det_p[iq], f(x_p[iq],  wdetf_qp[iq]), wdetf_qp[iq]);
	  }
	} else {
	  for (iq = 0; iq < quad->n_points; iq++) {
	    AXEY_DOW(w[iq]*det_p[iq],
		     f_loc(wdetf_qp[iq], el_info, quad, iq, fd),
		     wdetf_qp[iq]);
	  }
	}
      } else {
	det = el_det_dim(dim, el_info);

	if (f) {
	  for (iq = 0; iq < quad->n_points; iq++) {
	    coord_to_world(el_info, lambda[iq], x);
	    AXEY_DOW(w[iq]*det, f(x,  wdetf_qp[iq]), wdetf_qp[iq]);
	  }
	} else {
	  for (iq = 0; iq < quad->n_points; iq++) {
	    AXEY_DOW(w[iq]*det,
		     f_loc(wdetf_qp[iq], el_info, quad, iq, fd),
		     wdetf_qp[iq]);
	  }
	}
      }

      INIT_ELEMENT(el_info, quad_fast);

      CHAIN_DO(quad_fast, const QUAD_FAST) {
	const BAS_FCTS *bas_fcts;

	bas_fcts = quad_fast->bas_fcts;
	n_phi    = bas_fcts->n_bas_fcts;

	dof = GET_DOF_INDICES(bas_fcts, el_info->el, fh->fe_space->admin, NULL);

	if (fh->stride != 1) {
	  /* Cartesian product space */
	  DOF_REAL_D_VEC *fhd = (DOF_REAL_D_VEC *)fh;

	  for (j = 0; j < n_phi; j++) {
	    REAL_D val = { 0.0, };
	    for (iq = 0; iq < quad->n_points; iq++) {
	      AXPY_DOW(quad_fast->phi[iq][j], wdetf_qp[iq], val);
	    }
	    AXPY_DOW(1.0, val, fhd->vec[dof->vec[j]]);
	  }
	} else {
	  if (bas_fcts->dir_pw_const) {
	    for (j = 0; j < n_phi; j++) {
	      SET_DOW(0.0, val);
	      for (iq = 0; iq < n_points; iq++) {
		AXPY_DOW(quad_fast->phi[iq][j], wdetf_qp[iq], val);
	      }
	      fh->vec[dof->vec[j]] +=
		SCP_DOW(val, PHI_D(quad_fast->bas_fcts, j, NULL));
	    }
	  } else {
	    for (j = 0; j < n_phi; j++) {
	      REAL val = 0.0;
	      for (iq = 0; iq < n_points; iq++) {
		val +=
		  quad_fast->phi[iq][j]
		  *
		  SCP_DOW(wdetf_qp[iq],
			  PHI_D(quad_fast->bas_fcts, j, lambda[iq]));
	      }
	      fh->vec[dof->vec[j]] += val;
	    }
	  }
	}
	fh = CHAIN_NEXT(fh, DOF_REAL_VEC_D);
      } CHAIN_WHILE(quad_fast, const QUAD_FAST);

    } TRAVERSE_NEXT();
  }
}

__FLATTEN_ATTRIBUTE__
void L2scp_fct_bas_dow(FCT_D_AT_X f, const QUAD *quad, DOF_REAL_VEC_D *fh)
{
  _AI_L2scp_fct_bas_dow(fh, f, NULL, NULL, FILL_NOTHING, quad);
}

__FLATTEN_ATTRIBUTE__
void L2scp_fct_bas_loc_dow(DOF_REAL_VEC_D *fh,
			   LOC_FCT_D_AT_QP f, void *fd, FLAGS fill_flag,
			   const QUAD *quad)
{
  _AI_L2scp_fct_bas_dow(fh, NULL, f, fd, fill_flag, quad);
}

static void _AI_H1scp_fct_bas(DOF_REAL_VEC *fh,
			      GRD_FCT_AT_X f,
			      GRD_LOC_FCT_AT_QP f_loc,
			      void *fd /* userdata */,
			      FLAGS fill_flag,
			      const QUAD *quad)
{
  FUNCNAME("H1scp_fct_bas");
  MESH            *mesh = NULL;
  const QUAD_FAST *quad_fast;
  const FE_SPACE  *fe_space;
  const REAL      *w;
  int             iq, j, alpha, n_phi, dim, n_points;
  const BAS_FCTS  *bas_fcts;
  INIT_EL_TAG     qtag = INIT_EL_TAG_DFLT;

  TEST_EXIT(fh, "no DOF_REAL_VEC fh\n");
  if (!f && !f_loc)
    return;

  TEST_EXIT(fh->fe_space, "no fe_space in DOF_REAL_VEC_D \"%s\"\n", NAME(fh));

  TEST_EXIT(fh->fe_space->rdim == 1,
	    "Called for vector valued finite element space \"%s\".\n",
	    NAME(fh->fe_space));

  GET_STRUCT(mesh, fh->fe_space);

  dim = mesh->dim;

  fe_space = fh->fe_space;
  bas_fcts = fe_space->bas_fcts;

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

  w            = quad->w;
  n_points     = quad->n_points;

  fill_flag |= CALL_LEAF_EL|FILL_COORDS;
  if (mesh->is_periodic && !(fh->fe_space->admin->flags & ADM_PERIODIC)) {
    fill_flag |= FILL_NON_PERIODIC;
  }
  fill_flag |= quad_fast->fill_flags;

  {
    PARAMETRIC *parametric = mesh->parametric;
    int        is_parametric = false;
    int        dim = mesh->dim;
    REAL_B     wdetgrdf_qp[quad->n_points_max];
    const EL_DOF_VEC *dof;

    TRAVERSE_FIRST(mesh, -1, fill_flag) {

      INIT_ELEMENT_SETUP(el_info, quad, qtag, continue, {
	  w        = quad->w;
	  n_points = quad->n_points;
	});
      
      if (parametric) {
	is_parametric = parametric->init_element(el_info, parametric);
      }

      if (is_parametric) {
	const QUAD_EL_CACHE *qelc;
    	  
	qelc = fill_quad_el_cache(el_info, quad,
				  FILL_EL_QUAD_DET|FILL_EL_QUAD_LAMBDA);
	if (f) {
	  fill_quad_el_cache(el_info, quad, FILL_EL_QUAD_WORLD);
	  for (iq = 0; iq < quad->n_points; iq++) {
	    REAL_D grd;

	    f(qelc->world[iq], grd);
	    SCAL_DOW(w[iq]*qelc->param.det[iq], grd);
	    for (alpha = 0; alpha < N_LAMBDA(dim); alpha++) {
	      wdetgrdf_qp[iq][alpha] =
		SCP_DOW(grd, qelc->param.Lambda[iq][alpha]);
	    }
	  }
	} else {
	  for (iq = 0; iq < quad->n_points; iq++) {
	    REAL_D grd;

	    f_loc(grd, el_info,
		  (const REAL_D *)qelc->param.Lambda[iq], quad, iq, fd);
	    SCAL_DOW(w[iq]*qelc->param.det[iq], grd);
	    for (alpha = 0; alpha < N_LAMBDA(dim); alpha++) {
	      wdetgrdf_qp[iq][alpha] =
		SCP_DOW(grd, qelc->param.Lambda[iq][alpha]);
	    }
	  }
	}
      } else {
	if (f) {
	  const QUAD_EL_CACHE *qelc;
	  const EL_GEOM_CACHE *elgc;

	  elgc = fill_el_geom_cache(el_info, FILL_EL_DET|FILL_EL_LAMBDA);
	  qelc = fill_quad_el_cache(el_info, quad, FILL_EL_QUAD_WORLD);
	  for (iq = 0; iq < quad->n_points; iq++) {
	    REAL_D grd;
	    
	    f(qelc->world[iq], grd);
	    SCAL_DOW(w[iq]*elgc->det, grd);
	    for (alpha = 0; alpha < N_LAMBDA(dim); alpha++) {
	      wdetgrdf_qp[iq][alpha] =
		SCP_DOW(grd, elgc->Lambda[alpha]);
	    }
	  }
	} else {
	  const EL_GEOM_CACHE *elgc;

	  elgc = fill_el_geom_cache(el_info, FILL_EL_DET|FILL_EL_LAMBDA);
	  for (iq = 0; iq < quad->n_points; iq++) {
	    REAL_D grd;
	    f_loc(grd, el_info, elgc->Lambda, quad, iq, fd);
	    SCAL_DOW(w[iq]*elgc->det, grd);
	    for (alpha = 0; alpha < N_LAMBDA(dim); alpha++) {
	      wdetgrdf_qp[iq][alpha] =
		SCP_DOW(grd, elgc->Lambda[alpha]);
	    }
	  }
	}
      }

      INIT_ELEMENT(el_info, quad_fast);

      CHAIN_DO(quad_fast, const QUAD_FAST) {
	const BAS_FCTS *bas_fcts;
	const REAL_B *const*grd_phi = quad_fast->grd_phi;
	REAL accu;

	bas_fcts = quad_fast->bas_fcts;
	n_phi    = bas_fcts->n_bas_fcts;

	dof = GET_DOF_INDICES(bas_fcts, el_info->el, fh->fe_space->admin, NULL);
        	  
	for (j = 0; j < n_phi; j++) {
	  accu = 0.0;
	  for (iq = 0; iq < n_points; iq++) {
	    accu += SCP_BAR(dim, wdetgrdf_qp[iq], grd_phi[iq][j]);	
	  }
	  fh->vec[dof->vec[j]] += accu;
	}
	fh = CHAIN_NEXT(fh, DOF_REAL_VEC);
      } CHAIN_WHILE(quad_fast, const QUAD_FAST);

    } TRAVERSE_NEXT();
  }
}
__FLATTEN_ATTRIBUTE__
void H1scp_fct_bas(GRD_FCT_AT_X f, const QUAD *quad, DOF_REAL_VEC *fh)
{
  _AI_H1scp_fct_bas(fh, f, NULL,  NULL,FILL_NOTHING, quad);
}

__FLATTEN_ATTRIBUTE__
void H1scp_fct_bas_loc(DOF_REAL_VEC *fh,
		       GRD_LOC_FCT_AT_QP f, void *fd, FLAGS fill_flag,
		       const QUAD *quad)
{
  _AI_H1scp_fct_bas(fh, NULL, f, fd, fill_flag, quad);
}

static void _AI_H1scp_fct_bas_dow(DOF_REAL_VEC_D *fh,
				  GRD_FCT_D_AT_X f,
				  GRD_LOC_FCT_D_AT_QP f_loc,
				  void *fd /* userdata */,
				  FLAGS fill_flag,
				  const QUAD *quad)
{
  FUNCNAME("H1scp_fct_bas_dow");
  MESH            *mesh = NULL;
  const QUAD_FAST *quad_fast;
  const FE_SPACE  *fe_space;
  const REAL      *w;
  int             iq, i, j, alpha, n_phi, dim, n_points;
  const BAS_FCTS  *bas_fcts;
  INIT_EL_TAG     qtag = INIT_EL_TAG_DFLT;

  TEST_EXIT(fh, "no DOF_REAL_VEC fh\n");
  if (!f && !f_loc)
    return;

  TEST_EXIT(fh->fe_space, "no fe_space in DOF_REAL_VEC_D \"%s\"\n", NAME(fh));

  TEST_EXIT(fh->fe_space->rdim == DIM_OF_WORLD,
	    "Called for scalar finite element space \"%s\".\n",
	    NAME(fh->fe_space));

  GET_STRUCT(mesh, fh->fe_space);

  dim = mesh->dim;

  fe_space = fh->fe_space;
  bas_fcts = fe_space->bas_fcts;

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

  w            = quad->w;
  n_points     = quad->n_points;

  fill_flag |= CALL_LEAF_EL|FILL_COORDS;
  if (mesh->is_periodic && !(fh->fe_space->admin->flags & ADM_PERIODIC)) {
    fill_flag |= FILL_NON_PERIODIC;
  }
  fill_flag |= quad_fast->fill_flags;

  {
    PARAMETRIC *parametric = mesh->parametric;
    int        is_parametric = false;
    int        dim = mesh->dim;
    REAL_DB    wdetgrdf_qp[quad->n_points_max];
    const EL_DOF_VEC *dof;

    TRAVERSE_FIRST(mesh, -1, fill_flag) {

      INIT_ELEMENT_SETUP(el_info, quad, qtag, continue, {
	  w        = quad->w;
	  n_points = quad->n_points;
	});
      
      if (parametric) {
	is_parametric = parametric->init_element(el_info, parametric);
      }

      if (is_parametric) {
	const QUAD_EL_CACHE *qelc;
    	  
	qelc = fill_quad_el_cache(el_info, quad,
				  FILL_EL_QUAD_DET|FILL_EL_QUAD_LAMBDA);
	if (f) {
	  fill_quad_el_cache(el_info, quad, FILL_EL_QUAD_WORLD);
	  for (iq = 0; iq < quad->n_points; iq++) {
	    REAL_DD grd;

	    f(qelc->world[iq], grd);
	    MSCAL_DOW(w[iq]*qelc->param.det[iq], grd);
	    for (alpha = 0; alpha < N_LAMBDA(dim); alpha++) {
	      for (i = 0; i < DIM_OF_WORLD; i++) {
		wdetgrdf_qp[iq][i][alpha] =
		  SCP_DOW(grd[i], qelc->param.Lambda[iq][alpha]);
	      }
	    }
	  }
	} else {
	  for (iq = 0; iq < quad->n_points; iq++) {
	    REAL_DD grd;

	    f_loc(grd, el_info,
		  (const REAL_D *)qelc->param.Lambda[iq], quad, iq, fd);
	    MSCAL_DOW(w[iq]*qelc->param.det[iq], grd);
	    for (alpha = 0; alpha < N_LAMBDA(dim); alpha++) {
	      for (i = 0; i < DIM_OF_WORLD; i++) {
		wdetgrdf_qp[iq][i][alpha] =
		  SCP_DOW(grd[i], qelc->param.Lambda[iq][alpha]);
	      }
	    }
	  }
	}
      } else {
	if (f) {
	  const QUAD_EL_CACHE *qelc;
	  const EL_GEOM_CACHE *elgc;

	  elgc = fill_el_geom_cache(el_info, FILL_EL_DET|FILL_EL_LAMBDA);
	  qelc = fill_quad_el_cache(el_info, quad, FILL_EL_QUAD_WORLD);
	  for (iq = 0; iq < quad->n_points; iq++) {
	    REAL_DD grd;
	    
	    f(qelc->world[iq], grd);
	    MSCAL_DOW(w[iq]*elgc->det, grd);
	    for (alpha = 0; alpha < N_LAMBDA(dim); alpha++) {
	      for (i = 0; i < DIM_OF_WORLD; i++) {
		wdetgrdf_qp[iq][i][alpha] =
		  SCP_DOW(grd[i], elgc->Lambda[alpha]);
	      }
	    }
	  }
	} else {
	  const EL_GEOM_CACHE *elgc;

	  elgc = fill_el_geom_cache(el_info, FILL_EL_DET|FILL_EL_LAMBDA);
	  for (iq = 0; iq < quad->n_points; iq++) {
	    REAL_DD grd;
	    f_loc(grd, el_info, elgc->Lambda, quad, iq, fd);
	    MSCAL_DOW(w[iq]*elgc->det, grd);
	    for (alpha = 0; alpha < N_LAMBDA(dim); alpha++) {
	      for (i = 0; i < DIM_OF_WORLD; i++) {
		wdetgrdf_qp[iq][i][alpha] =
		  SCP_DOW(grd[i], elgc->Lambda[alpha]);
	      }
	    }
	  }
	}
      }

      INIT_ELEMENT(el_info, quad_fast);

      CHAIN_DO(quad_fast, const QUAD_FAST) {
	const BAS_FCTS *bas_fcts;
	
	bas_fcts = quad_fast->bas_fcts;
	n_phi    = bas_fcts->n_bas_fcts;

	dof = GET_DOF_INDICES(bas_fcts, el_info->el, fh->fe_space->admin, NULL);

	if (fh->stride != 1) {
	  /* Cartesian product space */
	  DOF_REAL_D_VEC *fhd = (DOF_REAL_D_VEC *)fh;
	  const REAL_B *const*grd_phi = quad_fast->grd_phi;

	  for (j = 0; j < n_phi; j++) {
	    REAL_D val = { 0.0, };
	    for (iq = 0; iq < quad->n_points; iq++) {
	      for (i = 0; i < DIM_OF_WORLD; i++) {
		val[i] += SCP_BAR(dim, grd_phi[iq][j], wdetgrdf_qp[iq][i]);
	      }
	    }
	    AXPY_DOW(1.0, val, fhd->vec[dof->vec[j]]);
	  }
	} else {
	  const REAL_DB *const*grd_phi;
	  REAL accu;
        	  
	  grd_phi = get_quad_fast_grd_phi_dow(quad_fast);
        	  
	  for (j = 0; j < n_phi; j++) {
	    accu = 0.0;	
	    for (iq = 0; iq < n_points; iq++) {
	      for (i = 0; i < DIM_OF_WORLD; i++) {
		accu += SCP_BAR(dim, wdetgrdf_qp[iq][i], grd_phi[iq][j][i]);
	      }
	    }
	    fh->vec[dof->vec[j]] += accu;
	  }
	}
	fh = CHAIN_NEXT(fh, DOF_REAL_VEC_D);
      } CHAIN_WHILE(quad_fast, const QUAD_FAST);

    } TRAVERSE_NEXT();
  }
}

__FLATTEN_ATTRIBUTE__
void H1scp_fct_bas_dow(GRD_FCT_D_AT_X f, const QUAD *quad, DOF_REAL_VEC_D *fh)
{
  _AI_H1scp_fct_bas_dow(fh, f, NULL, NULL, FILL_NOTHING, quad);
}

__FLATTEN_ATTRIBUTE__
void H1scp_fct_bas_loc_dow(DOF_REAL_VEC_D *fh,
			   GRD_LOC_FCT_D_AT_QP f, void *fd, FLAGS fill_flag,
			   const QUAD *quad)
{
  _AI_H1scp_fct_bas_dow(fh, NULL, f, fd, fill_flag, quad);
}

/* Compute the L2 scalar product over the boundary of the domain.
 * Return "true" if not all boundary segments of the mesh belong to
 * the segment specified by "bndry_seg". If "bndry_seg == NULL" then
 * the scalar product is computed over the entire boundary (i.e. over
 * all walls without neighbour).
 */
static bool _AI_bndry_L2scp_fct_bas(DOF_REAL_VEC *fh,
				    LOC_FCT_AT_QP f_loc,
				    void *fd, FLAGS fill_flag,
				    REAL (*f)(const REAL_D x,
					      const REAL_D normal),
				    const BNDRY_FLAGS bndry_seg,
				    const WALL_QUAD *wall_quad)
{
  MESH                 *mesh = NULL;
  const FE_SPACE       *fe_space;
  const BAS_FCTS       *bas_fcts;
  const WALL_QUAD_FAST *wqfast;
  const QUAD_FAST      *qfast;
  REAL                 val;
  int                  iq, not_all = false;

  if (!f && !f_loc) {
    return not_all;
  }
  
  if (!fh) {
    return not_all;
  }

  if (BNDRY_FLAGS_IS_INTERIOR(bndry_seg)) {
    /* nothing to do */
    return not_all;
  }

  fe_space = fh->fe_space;
  bas_fcts = fe_space->bas_fcts;
  mesh     = fe_space->mesh;

  if (wall_quad == NULL) {
    wall_quad = get_wall_quad(mesh->dim, 2*bas_fcts->degree);
  }
  wqfast = get_wall_quad_fast(bas_fcts, wall_quad, INIT_PHI);

  fill_flag |= CALL_LEAF_EL|FILL_COORDS|FILL_MACRO_WALLS;

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

  {
    PARAMETRIC   *parametric = mesh->parametric;
    int          is_parametric = false;
    int          dim = mesh->dim;
    REAL         wdetf_qp[wall_quad->n_points_max];
    const REAL   *w[N_WALLS_MAX];
    int          n_points[N_WALLS_MAX];
    INIT_EL_TAG  wall_tag[N_WALLS_MAX];
    EL_DOF_VEC   *dof;
    int          wall;

    for (wall = 0; wall < N_WALLS(dim); wall++) {
      wall_tag[wall] = INIT_EL_TAG_DFLT;  
      w[wall]        = wqfast->quad_fast[wall]->w;
      n_points[wall] = wall_quad->quad[wall].n_points;
    }

    dof = get_el_dof_vec(bas_fcts);

    TRAVERSE_FIRST(mesh, -1, fill_flag) {
      BNDRY_TYPE wall_bnd;
      int walls[N_WALLS_MAX];
      int n_walls, wnr, wall;

      n_walls = 0;
      for (wnr = 0; wnr < N_WALLS(dim); wnr++) {
	wall_bnd = wall_bound(el_info, wnr);
	if (wall_bnd == INTERIOR) {
	  continue;
	}
	if (bndry_seg == NULL ||
	    BNDRY_FLAGS_IS_AT_BNDRY(bndry_seg, wall_bnd)) {
	  walls[n_walls++] = wnr;
	} else {
	  not_all = true;
	}
      }
      if (n_walls == 0) {
	continue;
      }

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

      /* We assume that it is somewhat likely that we have to do some
       * work here and fetch the local DOF-indices here.
       */
      get_dof_indices(dof, fe_space, el_info->el);

      if (parametric) {
	is_parametric = parametric->init_element(el_info, parametric);
      }
      
      for (wnr = 0; wnr < n_walls; wnr++) {

	wall = walls[wnr];

	INIT_ELEMENT_SETUP(el_info,
			   wqfast->quad_fast[wall], wall_tag[wall], continue, {
			     w[wall]        = wqfast->quad_fast[wall]->w;
			     n_points[wall] = wall_quad->quad[wall].n_points;
			   });

	if (is_parametric) {
	  const QUAD_EL_CACHE *qelc;
	  if (f) {
	    qelc = fill_quad_el_cache(el_info, &wall_quad->quad[wall],
				      FILL_EL_QUAD_WALL_NORMAL|
				      FILL_EL_QUAD_WALL_DET|
				      FILL_EL_QUAD_WORLD);
	    for (iq = 0; iq < n_points[wall]; iq++) {
	      wdetf_qp[iq] = (w[wall][iq]*qelc->param.wall_det[iq]
			      *
			      f(qelc->world[iq], qelc->param.wall_normal[iq]));
	    }
	  } else {
	    qelc = fill_quad_el_cache(el_info, &wall_quad->quad[wall],
				      FILL_EL_QUAD_WALL_NORMAL|
				      FILL_EL_QUAD_WALL_DET);
	    for (iq = 0; iq < n_points[wall]; iq++) {
	      wdetf_qp[iq] =
		w[wall][iq] * qelc->param.wall_det[iq]
		* 
		f_loc(el_info, &wall_quad->quad[wall], iq, fd);
	    }
	  }
	} else {
	  const EL_GEOM_CACHE *elgc =
	    fill_el_geom_cache(el_info, FILL_EL_WALL_DET(wall));
	  if (f) {
	    const QUAD_EL_CACHE *qelc =
	      fill_quad_el_cache(el_info,
				 &wall_quad->quad[wall], FILL_EL_QUAD_WORLD);
	    for (iq = 0; iq < n_points[wall]; iq++) {
	      wdetf_qp[iq] =
		w[wall][iq]*elgc->wall_det[wall]
		*
		f(qelc->world[iq], elgc->wall_normal[wall]);
	    }
	  } else {
	    for (iq = 0; iq < n_points[wall]; iq++) {
	      wdetf_qp[iq] =
		w[wall][iq] * elgc->wall_det[wall]
		*
		f_loc(el_info, &wall_quad->quad[wall], iq, fd);
	    }
	  }
	}
	
	/*****************************/
	qfast = wqfast->quad_fast[wall];
	INIT_ELEMENT(el_info, qfast); /* must be: tag != INIT_EL_TAG_NULL */

	CHAIN_DO(qfast, const QUAD_FAST) {
	  const REAL *const*phi;
	  int n_phi, j_tr;
	  const BAS_FCTS *bas_fcts;
	  
	  bas_fcts = qfast->bas_fcts;
	  n_phi    = bas_fcts->n_trace_bas_fcts[wall];
	  phi      = qfast->phi;
	
	  for (j_tr = 0; j_tr < n_phi; j_tr++) {
	    int j = bas_fcts->trace_dof_map[0][0][wall][j_tr];
	    val = 0.0;
	    for (iq = 0; iq < n_points[wall]; iq++) {
	      val += phi[iq][j]*wdetf_qp[iq];
	    }
	    fh->vec[dof->vec[j]] += val;
	  }

	  fh = CHAIN_NEXT(fh, DOF_REAL_VEC);
	  dof = CHAIN_NEXT(dof, EL_DOF_VEC);
	} CHAIN_WHILE(qfast, const QUAD_FAST);
      }
    } TRAVERSE_NEXT();
    
    free_el_dof_vec(dof);
  }

  return not_all;  
}

bool bndry_L2scp_fct_bas(DOF_REAL_VEC *fh,
			 REAL (*f)(const REAL_D x, const REAL_D normal),
			 const BNDRY_FLAGS scp_segment,
			 const WALL_QUAD *quad)
{
  return
    _AI_bndry_L2scp_fct_bas(fh, NULL, NULL, FILL_NOTHING, f, scp_segment, quad);
}

bool bndry_L2scp_fct_bas_loc(DOF_REAL_VEC *fh,
			     LOC_FCT_AT_QP f, void *fd, FLAGS fill_flag,
			     const BNDRY_FLAGS scp_segment,
			     const WALL_QUAD *quad)
{
  return
    _AI_bndry_L2scp_fct_bas(fh, f, fd, fill_flag, NULL, scp_segment, quad);
}

/* Compute the L2 scalar product over the boundary of the domain. This
 * version is for vector-valued fe-spaces.
 */
static bool
_AI_bndry_L2scp_fct_bas_dow(DOF_REAL_VEC_D *fh,
			    LOC_FCT_D_AT_QP f_loc, void *fd, FLAGS fill_flag,
			    const REAL *(*f)(const REAL_D x,
					     const REAL_D normal,
					     REAL_D result),
			    const BNDRY_FLAGS bndry_seg,
			    const WALL_QUAD *wall_quad)
{
  MESH           *mesh = NULL;
  const FE_SPACE *fe_space;
  const BAS_FCTS *bas_fcts;
  const WALL_QUAD_FAST *wqfast;
  const QUAD_FAST      *qfast; /* for a single wall */
  REAL_D         x, normal;
  REAL           det;
  int            iq, not_all = false;

  if (!f && !f_loc) {
    return not_all;
  }
  
  if (!fh) {
    return not_all;
  }

  if (BNDRY_FLAGS_IS_INTERIOR(bndry_seg)) {
    /* nothing to do */
    return not_all;
  }

  fe_space = fh->fe_space;
  bas_fcts = fe_space->bas_fcts;
  mesh     = fe_space->mesh;

  if (wall_quad == NULL) {
    wall_quad = get_wall_quad(mesh->dim, 2*bas_fcts->degree);
  }
  wqfast = get_wall_quad_fast(bas_fcts, wall_quad, INIT_PHI);

  fill_flag |= CALL_LEAF_EL|FILL_COORDS|FILL_MACRO_WALLS;

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

  {
    PARAMETRIC   *parametric = mesh->parametric;
    int          is_parametric = false;
    int          dim = mesh->dim;    
    REAL_D       normal_p[wall_quad->n_points_max];
    REAL         det_p[wall_quad->n_points_max];
    REAL_D       wdetf_qp[wall_quad->n_points_max];
    REAL_D       x_p[wall_quad->n_points_max];
    const REAL   *w[N_WALLS_MAX];
    const REAL_B *lambda[N_WALLS_MAX];
    int          n_points[N_WALLS_MAX];
    INIT_EL_TAG  wall_tag[N_WALLS_MAX];
    int          wall;
    EL_DOF_VEC   *dof;

    for (wall = 0; wall < N_WALLS(dim); wall++) {
      wall_tag[wall] = INIT_EL_TAG_DFLT;  
      lambda[wall]   = wall_quad->quad[wall].lambda;
      w[wall]        = wqfast->quad_fast[wall]->w;
      n_points[wall] = wall_quad->quad[wall].n_points;
    }

    dof = get_el_dof_vec(bas_fcts);

    TRAVERSE_FIRST(mesh, -1, fill_flag) {
      BNDRY_TYPE wall_bnd;
      int walls[N_WALLS_MAX];
      int n_walls, wnr, wall;

      n_walls = 0;
      for (wnr = 0; wnr < N_WALLS(dim); wnr++) {
	wall_bnd = wall_bound(el_info, wnr);
	if (wall_bnd == INTERIOR) {
	  continue;
	}
	if (bndry_seg == NULL ||
	    BNDRY_FLAGS_IS_AT_BNDRY(bndry_seg, wall_bnd)) {
	  walls[n_walls++] = wnr;
	} else {
	  not_all = true;
	}
      }
      if (n_walls == 0) {
	continue;
      }

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

      /* We assume that it is somewhat likely that we have to do some
       * work here and fetch the local DOF-indices here.
       */
      get_dof_indices(dof, fe_space, el_info->el);

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

      for (wnr = 0; wnr < n_walls; wnr++) {

	wall = walls[wnr];

	INIT_ELEMENT_SETUP(el_info,
			   &wall_quad->quad[wall], wall_tag[wall], continue, {
			     lambda[wall]   = wall_quad->quad[wall].lambda;
			     w[wall]        = wall_quad->quad[wall].w;
			     n_points[wall] = wall_quad->quad[wall].n_points;
			   });

	if (is_parametric) {
	  if (f) {
	    parametric->wall_normal(
	      el_info, wall, &wall_quad->quad[wall], -1, NULL,
	      normal_p, NULL, NULL, det_p);
	    parametric->coord_to_world(el_info,
				       &wall_quad->quad[wall], -1, NULL, x_p);
	    for (iq = 0; iq < n_points[wall]; iq++) {
	      AXEY_DOW(w[wall][iq]*det_p[iq],
		       f(x_p[iq], normal_p[iq], wdetf_qp[iq]),  wdetf_qp[iq]);
	    }
	  } else {
	    const QUAD_EL_CACHE *qelc =
	      fill_quad_el_cache(el_info, &wall_quad->quad[wall],
				 FILL_EL_QUAD_WALL_DET|
				 FILL_EL_QUAD_WALL_NORMAL);
	    for (iq = 0; iq < n_points[wall]; iq++) {
	      f_loc(wdetf_qp[iq], el_info, &wall_quad->quad[wall], iq, fd);
	      SCAL_DOW(w[wall][iq]*qelc->param.wall_det[iq], wdetf_qp[iq]);
	    }
	  }
	} else {
	  if (f) {
	    det = get_wall_normal_dim(dim, el_info, wall, normal);
	    for (iq = 0; iq < n_points[wall]; iq++) {
	      coord_to_world(el_info, lambda[wall][iq], x);
	      AXEY_DOW(w[wall][iq]*det, f(x, normal, wdetf_qp[iq]),
		       wdetf_qp[iq]);
	    }
	  } else {
	    const EL_GEOM_CACHE *elgc =
	      fill_el_geom_cache(el_info,
				 FILL_EL_WALL_DET(wall)|
				 FILL_EL_WALL_NORMAL(wall));
	    for (iq = 0; iq < n_points[wall]; iq++) {
	      f_loc(wdetf_qp[iq], el_info, &wall_quad->quad[wall], iq, fd);
	      SCAL_DOW(w[wall][iq]*elgc->wall_det[wall], wdetf_qp[iq]);
	    }
	  }
	}

	/*****************************/
	qfast = wqfast->quad_fast[wall];
	INIT_ELEMENT(el_info, qfast); /* must be: tag != INIT_EL_TAG_NULL */
	
	CHAIN_DO(qfast, const QUAD_FAST) {
	  const BAS_FCTS *bas_fcts;
	  const REAL_D *const*phi_d;
	  int n_phi, j_tr;
	  
	  bas_fcts = qfast->bas_fcts;
	  n_phi    = bas_fcts->n_trace_bas_fcts[wall];
	  
	  if (fh->stride != 1) {
	    DOF_REAL_D_VEC *fhd = (DOF_REAL_D_VEC *)fh;

	    for (j_tr = 0; j_tr < n_phi; j_tr++) {
	      int j = bas_fcts->trace_dof_map[0][0][wall][j_tr];
	      REAL_D val = { 0.0, };

	      for (iq = 0; iq < n_points[wall]; iq++) {
		AXPY_DOW(qfast->phi[iq][j], wdetf_qp[iq], val);
	      }
	      AXPY_DOW(1.0, val, fhd->vec[dof->vec[j]]);
	    }
	  } else {
	    phi_d = get_quad_fast_phi_dow(qfast);
	    for (j_tr = 0; j_tr < n_phi; j_tr++) {
	      int j = bas_fcts->trace_dof_map[0][0][wall][j_tr];
	      REAL val = 0.0;

	      for (iq = 0; iq < n_points[wall]; iq++) {
		val += SCP_DOW(phi_d[iq][j], wdetf_qp[iq]);
	      }
	      fh->vec[dof->vec[j]] += val;
	    }
	  }
	  
	  dof = CHAIN_NEXT(dof, EL_DOF_VEC);
	  fh  = CHAIN_NEXT(fh, DOF_REAL_VEC_D);

	} CHAIN_WHILE(qfast, const QUAD_FAST);
	
      }
    } TRAVERSE_NEXT();

    free_el_dof_vec(dof);
  }

  return not_all;
}

bool bndry_L2scp_fct_bas_dow(DOF_REAL_VEC_D *fh,
			     const REAL *(*f)(const REAL_D x,
					      const REAL_D normal,
					      REAL_D result),
			     const BNDRY_FLAGS bndry_seg,
			     const WALL_QUAD *quad)
{
  return _AI_bndry_L2scp_fct_bas_dow(fh, NULL, NULL, FILL_NOTHING,
				     f, bndry_seg, quad);
}

bool bndry_L2scp_fct_bas_loc_dow(DOF_REAL_VEC_D *fh,
				 const REAL *(*f_loc)(REAL_D result,
						      const EL_INFO *el_info,
						      const QUAD *quad,
						      int iq,
						      void *fd),
				 void *fd, FLAGS fill_flag,
				 const BNDRY_FLAGS bndry_seg,
				 const WALL_QUAD *quad)
{
  return _AI_bndry_L2scp_fct_bas_dow(fh, f_loc, fd, fill_flag,
				     NULL, bndry_seg, quad);
}

/* Compute the tangential H1 scalar product over the boundary of the
 * domain.  Return "true" if not all boundary segments of the mesh
 * belong to the segment specified by "bndry_seg". If "bndry_seg ==
 * NULL" then the scalar product is computed over the entire boundary
 * (i.e. over all walls without neighbour).
 */
static bool _AI_bndry_H1scp_fct_bas(DOF_REAL_VEC *fh,
				    GRD_LOC_FCT_AT_QP f_loc,
				    void *fd, FLAGS fill_flag,
				    const REAL *(*f)(REAL_D result,
						     const REAL_D x,
						     const REAL_D normal),
				    const BNDRY_FLAGS bndry_seg,
				    const WALL_QUAD *wall_quad)
{
  MESH                 *mesh = NULL;
  const FE_SPACE       *fe_space;
  const BAS_FCTS       *bas_fcts;
  const WALL_QUAD_FAST *wqfast;
  const QUAD_FAST      *qfast;
  REAL                 val;
  int                  iq, not_all = false;

  if (!f && !f_loc) {
    return not_all;
  }
  
  if (!fh) {
    return not_all;
  }

  if (BNDRY_FLAGS_IS_INTERIOR(bndry_seg)) {
    /* nothing to do */
    return not_all;
  }

  fe_space = fh->fe_space;
  bas_fcts = fe_space->bas_fcts;
  mesh     = fe_space->mesh;

  if (wall_quad == NULL) {
    wall_quad = get_wall_quad(mesh->dim, 2*bas_fcts->degree);
  }
  wqfast =
    get_wall_quad_fast(bas_fcts, wall_quad, INIT_GRD_PHI|INIT_TANGENTIAL);

  fill_flag |= CALL_LEAF_EL|FILL_COORDS|FILL_MACRO_WALLS;

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

  {
    PARAMETRIC   *parametric = mesh->parametric;
    int          is_parametric = false;
    int          dim = mesh->dim;
    REAL_B       wdetgrdf_qp[wall_quad->n_points_max];
    const REAL   *w[N_WALLS_MAX];
    int          n_points[N_WALLS_MAX];
    INIT_EL_TAG  wall_tag[N_WALLS_MAX];
    EL_DOF_VEC   *dof;
    int          wall;

    for (wall = 0; wall < N_WALLS(dim); wall++) {
      wall_tag[wall] = INIT_EL_TAG_DFLT;  
      w[wall]        = wqfast->quad_fast[wall]->w;
      n_points[wall] = wall_quad->quad[wall].n_points;
    }

    dof = get_el_dof_vec(bas_fcts);

    TRAVERSE_FIRST(mesh, -1, fill_flag) {
      BNDRY_TYPE wall_bnd;
      int walls[N_WALLS_MAX];
      int n_walls, wnr, wall;

      n_walls = 0;
      for (wnr = 0; wnr < N_WALLS(dim); wnr++) {
	wall_bnd = wall_bound(el_info, wnr);
	if (wall_bnd == INTERIOR) {
	  continue;
	}
	if (bndry_seg == NULL ||
	    BNDRY_FLAGS_IS_AT_BNDRY(bndry_seg, wall_bnd)) {
	  walls[n_walls++] = wnr;
	} else {
	  not_all = true;
	}
      }
      if (n_walls == 0) {
	continue;
      }

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

      /* We assume that it is somewhat likely that we have to do some
       * work here and fetch the local DOF-indices here.
       */
      get_dof_indices(dof, fe_space, el_info->el);

      if (parametric) {
	is_parametric = parametric->init_element(el_info, parametric);
      }
      
      for (wnr = 0; wnr < n_walls; wnr++) {

	wall = walls[wnr];

	INIT_ELEMENT_SETUP(el_info,
			   wqfast->quad_fast[wall], wall_tag[wall], continue, {
			     w[wall]        = wqfast->quad_fast[wall]->w;
			     n_points[wall] = wall_quad->quad[wall].n_points;
			   });

	if (is_parametric) {
	  const QUAD_EL_CACHE *qelc;
	  if (f) {
	    qelc = fill_quad_el_cache(el_info, &wall_quad->quad[wall],
				      FILL_EL_QUAD_LAMBDA|
				      FILL_EL_QUAD_WALL_NORMAL|
				      FILL_EL_QUAD_WALL_DET|
				      FILL_EL_QUAD_WORLD);
	    for (iq = 0; iq < n_points[wall]; iq++) {
	      REAL_D grd;
	      int alpha;

	      f(grd, qelc->world[iq], qelc->param.wall_normal[iq]);
	      /* Project to the tangent space */
	      AXPY_DOW(-SCP_DOW(grd, qelc->param.wall_normal[iq]),
		       qelc->param.wall_normal[iq], grd);
	      SCAL_DOW(w[wall][iq]*qelc->param.wall_det[iq], grd);
	      for (alpha = 0; alpha < wall; alpha++) {
		wdetgrdf_qp[iq][alpha] =
		  SCP_DOW(grd, qelc->param.Lambda[iq][alpha]);
	      }
	      wdetgrdf_qp[iq][alpha++] = 0.0;
	      for (; alpha < N_LAMBDA(dim); alpha++) {
		wdetgrdf_qp[iq][alpha] =
		  SCP_DOW(grd, qelc->param.Lambda[iq][alpha]);
	      }
	    }
	  } else {
	    qelc = fill_quad_el_cache(el_info, &wall_quad->quad[wall],
				      FILL_EL_QUAD_LAMBDA|
				      FILL_EL_QUAD_WALL_NORMAL|
				      FILL_EL_QUAD_WALL_DET);
	    for (iq = 0; iq < n_points[wall]; iq++) {
	      REAL_D grd;
	      int alpha;

	      f_loc(grd, el_info, (const REAL_D *)qelc->param.Lambda[iq],
		    &wall_quad->quad[wall], iq, fd);
	      /* Project to the tangent space */
	      AXPY_DOW(-SCP_DOW(grd, qelc->param.wall_normal[iq]),
		       qelc->param.wall_normal[iq], grd);
	      SCAL_DOW(w[wall][iq] * qelc->param.wall_det[iq], grd);
	      for (alpha = 0; alpha < wall; alpha++) {
		wdetgrdf_qp[iq][alpha] =
		  SCP_DOW(grd, qelc->param.Lambda[iq][alpha]);
	      }
	      wdetgrdf_qp[iq][alpha++] = 0.0;
	      for (; alpha < N_LAMBDA(dim); alpha++) {
		wdetgrdf_qp[iq][alpha] =
		  SCP_DOW(grd, qelc->param.Lambda[iq][alpha]);
	      }
	    }
	  }
	} else { /* non-parametric version */
	  const EL_GEOM_CACHE *elgc =
	    fill_el_geom_cache(el_info,
			       FILL_EL_WALL_NORMAL(wall)|
			       FILL_EL_WALL_DET(wall)|
			       FILL_EL_LAMBDA);
	  if (f) {
	    const QUAD_EL_CACHE *qelc =
	      fill_quad_el_cache(el_info,
				 &wall_quad->quad[wall], FILL_EL_QUAD_WORLD);
	    for (iq = 0; iq < n_points[wall]; iq++) {
	      REAL_D grd;
	      int alpha;
	      
	      f(grd, qelc->world[iq], elgc->wall_normal[wall]);
	      /* Project to the tangent space */
	      AXPY_DOW(-SCP_DOW(grd, elgc->wall_normal[wall]),
		       elgc->wall_normal[wall], grd);
	      SCAL_DOW(w[wall][iq]*elgc->wall_det[wall], grd);
	      for (alpha = 0; alpha < wall; alpha++) {
		wdetgrdf_qp[iq][alpha] = SCP_DOW(grd,  elgc->Lambda[alpha]);
	      }
	      wdetgrdf_qp[iq][alpha++] = 0.0;
	      for (; alpha < N_LAMBDA(dim); alpha++) {
		wdetgrdf_qp[iq][alpha] = SCP_DOW(grd,  elgc->Lambda[alpha]);
	      }
	    }
	  } else {
	    for (iq = 0; iq < n_points[wall]; iq++) {
	      REAL_D grd;
	      int alpha;

	      f_loc(grd, el_info, elgc->Lambda, &wall_quad->quad[wall], iq, fd);
	      /* Project to the tangent space */
	      AXPY_DOW(-SCP_DOW(grd, elgc->wall_normal[wall]),
		       elgc->wall_normal[wall], grd);
	      SCAL_DOW(w[wall][iq]*elgc->wall_det[wall], grd);
	      for (alpha = 0; alpha < wall; alpha++) {
		wdetgrdf_qp[iq][alpha] = SCP_DOW(grd,  elgc->Lambda[alpha]);
	      }
	      wdetgrdf_qp[iq][alpha++] = 0.0;
	      for (; alpha < N_LAMBDA(dim); alpha++) {
		wdetgrdf_qp[iq][alpha] = SCP_DOW(grd,  elgc->Lambda[alpha]);
	      }
	    }
	  }
	}
	
	/*****************************/
	qfast = wqfast->quad_fast[wall];
	INIT_ELEMENT(el_info, qfast); /* must be: tag != INIT_EL_TAG_NULL */

	CHAIN_DO(qfast, const QUAD_FAST) {
	  int n_phi, j_tr;
	  const BAS_FCTS *bas_fcts;
	  const REAL_B *const*grd_phi = qfast->grd_phi;
	  
	  bas_fcts = qfast->bas_fcts;
	  n_phi    = bas_fcts->n_trace_bas_fcts[wall];
	
	  for (j_tr = 0; j_tr < n_phi; j_tr++) {
	    int j = bas_fcts->trace_dof_map[0][0][wall][j_tr];
	    val = 0.0;
	    for (iq = 0; iq < n_points[wall]; iq++) {
	      val += SCP_BAR(dim, grd_phi[iq][j], wdetgrdf_qp[iq]);
	    }
	    fh->vec[dof->vec[j]] += val;
	  }

	  fh = CHAIN_NEXT(fh, DOF_REAL_VEC);
	  dof = CHAIN_NEXT(dof, EL_DOF_VEC);
	} CHAIN_WHILE(qfast, const QUAD_FAST);
      }
    } TRAVERSE_NEXT();
    
    free_el_dof_vec(dof);
  }

  return not_all;  
}

bool bndry_H1scp_fct_bas(DOF_REAL_VEC *fh,
			 const REAL *(*f)(REAL_D result,
					  const REAL_D x, const REAL_D normal),
			 const BNDRY_FLAGS scp_segment,
			 const WALL_QUAD *quad)
{
  return
    _AI_bndry_H1scp_fct_bas(fh, NULL, NULL, FILL_NOTHING, f, scp_segment, quad);
}

bool bndry_H1scp_fct_bas_loc(DOF_REAL_VEC *fh,
			     GRD_LOC_FCT_AT_QP f, void *fd, FLAGS fill_flag,
			     const BNDRY_FLAGS scp_segment,
			     const WALL_QUAD *quad)
{
  return
    _AI_bndry_H1scp_fct_bas(fh, f, fd, fill_flag, NULL, scp_segment, quad);
}

/* Compute the L2 scalar product over the boundary of the domain. This
 * version is for vector-valued fe-spaces.
 */
static bool
_AI_bndry_H1scp_fct_bas_dow(DOF_REAL_VEC_D *fh,
			    GRD_LOC_FCT_D_AT_QP f_loc,
			    void *fd, FLAGS fill_flag,
			    const REAL_D *(*f)(REAL_DD result,
					       const REAL_D x,
					       const REAL_D normal),
			    const BNDRY_FLAGS bndry_seg,
			    const WALL_QUAD *wall_quad)
{
  MESH           *mesh = NULL;
  const FE_SPACE *fe_space;
  const BAS_FCTS *bas_fcts;
  const WALL_QUAD_FAST *wqfast;
  const QUAD_FAST      *qfast; /* for a single wall */
  int            iq, not_all = false;

  if (!f && !f_loc) {
    return not_all;
  }
  
  if (!fh) {
    return not_all;
  }

  if (BNDRY_FLAGS_IS_INTERIOR(bndry_seg)) {
    /* nothing to do */
    return not_all;
  }

  fe_space = fh->fe_space;
  bas_fcts = fe_space->bas_fcts;
  mesh     = fe_space->mesh;

  if (wall_quad == NULL) {
    wall_quad = get_wall_quad(mesh->dim, 2*bas_fcts->degree);
  }
  wqfast =
    get_wall_quad_fast(bas_fcts, wall_quad, INIT_GRD_PHI|INIT_TANGENTIAL);

  fill_flag |= CALL_LEAF_EL|FILL_COORDS|FILL_MACRO_WALLS;

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

  {
    PARAMETRIC   *parametric = mesh->parametric;
    int          is_parametric = false;
    int          dim = mesh->dim;    
    REAL_D       normal_p[wall_quad->n_points_max];
    REAL_DB      wdetgrdf_qp[wall_quad->n_points_max];
    REAL_D       x_p[wall_quad->n_points_max];
    const REAL   *w[N_WALLS_MAX];
    int          n_points[N_WALLS_MAX];
    INIT_EL_TAG  wall_tag[N_WALLS_MAX];
    int          wall;
    EL_DOF_VEC   *dof;

    for (wall = 0; wall < N_WALLS(dim); wall++) {
      wall_tag[wall] = INIT_EL_TAG_DFLT;  
      w[wall]        = wqfast->quad_fast[wall]->w;
      n_points[wall] = wall_quad->quad[wall].n_points;
    }

    dof = get_el_dof_vec(bas_fcts);

    TRAVERSE_FIRST(mesh, -1, fill_flag) {
      BNDRY_TYPE wall_bnd;
      int walls[N_WALLS_MAX];
      int n_walls, wnr, wall;

      n_walls = 0;
      for (wnr = 0; wnr < N_WALLS(dim); wnr++) {
	wall_bnd = wall_bound(el_info, wnr);
	if (wall_bnd == INTERIOR) {
	  continue;
	}
	if (bndry_seg == NULL ||
	    BNDRY_FLAGS_IS_AT_BNDRY(bndry_seg, wall_bnd)) {
	  walls[n_walls++] = wnr;
	} else {
	  not_all = true;
	}
      }
      if (n_walls == 0) {
	continue;
      }

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

      /* We assume that it is somewhat likely that we have to do some
       * work here and fetch the local DOF-indices here.
       */
      get_dof_indices(dof, fe_space, el_info->el);

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

      for (wnr = 0; wnr < n_walls; wnr++) {

	wall = walls[wnr];

	INIT_ELEMENT_SETUP(el_info,
			   &wall_quad->quad[wall], wall_tag[wall], continue, {
			     w[wall]        = wall_quad->quad[wall].w;
			     n_points[wall] = wall_quad->quad[wall].n_points;
			   });

	if (is_parametric) {
	  const QUAD_EL_CACHE *qelc =
	    fill_quad_el_cache(el_info, &wall_quad->quad[wall],
			       FILL_EL_QUAD_LAMBDA|
			       FILL_EL_QUAD_WALL_DET|
			       FILL_EL_QUAD_WALL_NORMAL);
	  if (f) {
	    fill_quad_el_cache(el_info, &wall_quad->quad[wall],
			       FILL_EL_QUAD_WORLD);
	    for (iq = 0; iq < n_points[wall]; iq++) {
	      REAL_DD grd;
	      int alpha, i;

	      f(grd, x_p[iq], normal_p[iq]);
	      /* Project to the tangent space */
	      for (i = 0; i < DIM_OF_WORLD; i++) {
		AXPY_DOW(-SCP_DOW(grd[i], qelc->param.wall_normal[iq]),
			 qelc->param.wall_normal[iq], grd[i]);
	      }
	      MSCAL_DOW(w[wall][iq]*qelc->param.wall_det[iq], grd);
	      for (alpha = 0; alpha < wall; alpha++) {
		for (i = 0; i < DIM_OF_WORLD; i++) {
		  wdetgrdf_qp[iq][i][alpha] =
		    SCP_DOW(grd[i], qelc->param.Lambda[iq][alpha]);
		}
	      }
	      for (i = 0; i < DIM_OF_WORLD; i++) {
		wdetgrdf_qp[iq][i][alpha] = 0.0;
	      }
	      for (++alpha; alpha < N_LAMBDA(dim); alpha++) {
		for (i = 0; i < DIM_OF_WORLD; i++) {
		  wdetgrdf_qp[iq][i][alpha] =
		    SCP_DOW(grd[i], qelc->param.Lambda[iq][alpha]);
		}
	      }
	    }
	  } else {
	    for (iq = 0; iq < n_points[wall]; iq++) {
	      REAL_DD grd;
	      int alpha, i;

	      f_loc(grd, el_info, (const REAL_D *)qelc->param.Lambda[iq],
		    &wall_quad->quad[wall], iq, fd);
	      /* Project to the tangent space */
	      for (i = 0; i < DIM_OF_WORLD; i++) {
		AXPY_DOW(-SCP_DOW(grd[i], qelc->param.wall_normal[iq]),
			 qelc->param.wall_normal[iq], grd[i]);
	      }
	      MSCAL_DOW(w[wall][iq]*qelc->param.wall_det[iq], grd);
	      for (alpha = 0; alpha < wall; alpha++) {
		for (i = 0; i < DIM_OF_WORLD; i++) {
		  wdetgrdf_qp[iq][i][alpha] =
		    SCP_DOW(grd[i], qelc->param.Lambda[iq][alpha]);
		}
	      }
	      for (i = 0; i < DIM_OF_WORLD; i++) {
		wdetgrdf_qp[iq][i][alpha] = 0.0;
	      }
	      for (++alpha; alpha < N_LAMBDA(dim); alpha++) {
		for (i = 0; i < DIM_OF_WORLD; i++) {
		  wdetgrdf_qp[iq][i][alpha] =
		    SCP_DOW(grd[i], qelc->param.Lambda[iq][alpha]);
		}
	      }
	    }
	  }
	} else {
	  const EL_GEOM_CACHE *elgc =
	    fill_el_geom_cache(el_info,
			       FILL_EL_LAMBDA|
			       FILL_EL_WALL_DET(wall)|
			       FILL_EL_WALL_NORMAL(wall));
	  if (f) {
	    const QUAD_EL_CACHE *qelc = 
	      fill_quad_el_cache(el_info, &wall_quad->quad[wall],
				 FILL_EL_QUAD_WORLD);
	    for (iq = 0; iq < n_points[wall]; iq++) {
	      REAL_DD grd;
	      int alpha, i;

	      f(grd, qelc->world[iq], elgc->wall_normal[wall]);
	      /* Project to the tangent space */
	      for (i = 0; i < DIM_OF_WORLD; i++) {
		AXPY_DOW(-SCP_DOW(grd[i], elgc->wall_normal[wall]),
			 elgc->wall_normal[wall], grd[i]);
	      }
	      MSCAL_DOW(w[wall][iq]*elgc->wall_det[wall], grd);
	      for (alpha = 0; alpha < wall; alpha++) {
		for (i = 0; i < DIM_OF_WORLD; i++) {
		  wdetgrdf_qp[iq][i][alpha] =
		    SCP_DOW(grd[i], elgc->Lambda[alpha]);
		}
	      }
	      for (i = 0; i < DIM_OF_WORLD; i++) {
		wdetgrdf_qp[iq][i][alpha] = 0.0;
	      }
	      for (++alpha; alpha < N_LAMBDA(dim); alpha++) {
		for (i = 0; i < DIM_OF_WORLD; i++) {
		  wdetgrdf_qp[iq][i][alpha] =
		    SCP_DOW(grd[i], elgc->Lambda[alpha]);
		}
	      }
	    }
	  } else {
	    for (iq = 0; iq < n_points[wall]; iq++) {
	      REAL_DD grd;
	      int alpha, i;
	      
	      f_loc(grd, el_info, elgc->Lambda, &wall_quad->quad[wall], iq, fd);
	      /* Project to the tangent space */
	      for (i = 0; i < DIM_OF_WORLD; i++) {
		AXPY_DOW(-SCP_DOW(grd[i], elgc->wall_normal[wall]),
			 elgc->wall_normal[wall], grd[i]);
	      }
	      MSCAL_DOW(w[wall][iq]*elgc->wall_det[wall], grd);
	      for (alpha = 0; alpha < wall; alpha++) {
		for (i = 0; i < DIM_OF_WORLD; i++) {
		  wdetgrdf_qp[iq][i][alpha] =
		    SCP_DOW(grd[i], elgc->Lambda[alpha]);
		}
	      }
	      for (i = 0; i < DIM_OF_WORLD; i++) {
		wdetgrdf_qp[iq][i][alpha] = 0.0;
	      }
	      for (++alpha; alpha < N_LAMBDA(dim); alpha++) {
		for (i = 0; i < DIM_OF_WORLD; i++) {
		  wdetgrdf_qp[iq][i][alpha] =
		    SCP_DOW(grd[i], elgc->Lambda[alpha]);
		}
	      }
	    }
	  }
	}

	/*****************************/
	qfast = wqfast->quad_fast[wall];
	INIT_ELEMENT(el_info, qfast); /* must be: tag != INIT_EL_TAG_NULL */
	
	CHAIN_DO(qfast, const QUAD_FAST) {
	  const BAS_FCTS *bas_fcts;
	  int n_phi, j_tr;
	  
	  bas_fcts = qfast->bas_fcts;
	  n_phi    = bas_fcts->n_trace_bas_fcts[wall];
	  
	  if (fh->stride != 1) {
	    DOF_REAL_D_VEC *fhd = (DOF_REAL_D_VEC *)fh;
	    const REAL_B *const*grd_phi = qfast->grd_phi;

	    for (j_tr = 0; j_tr < n_phi; j_tr++) {
	      int j = bas_fcts->trace_dof_map[0][0][wall][j_tr];
	      REAL_D val = { 0.0, };
	      int i;

	      for (iq = 0; iq < n_points[wall]; iq++) {
		for (i = 0; i < DIM_OF_WORLD; i++) {
		  val[i] += SCP_BAR(dim, grd_phi[iq][j], wdetgrdf_qp[iq][i]);
		}
	      }
	      AXPY_DOW(1.0, val, fhd->vec[dof->vec[j]]);
	    }
	  } else {
	    const REAL_DB *const*grd_phi;
        	  
	    grd_phi = get_quad_fast_grd_phi_dow(qfast);
        	  
	    for (j_tr = 0; j_tr < n_phi; j_tr++) {
	      int j = bas_fcts->trace_dof_map[0][0][wall][j_tr];
	      REAL val = 0.0;
	      int i;

	      for (iq = 0; iq < n_points[wall]; iq++) {
		for (i = 0; i < DIM_OF_WORLD; i++) {
		  val += SCP_BAR(dim, wdetgrdf_qp[iq][i], grd_phi[iq][j][i]);
		}
	      }
	      fh->vec[dof->vec[j]] += val;
	    }
	  }
	  
	  dof = CHAIN_NEXT(dof, EL_DOF_VEC);
	  fh  = CHAIN_NEXT(fh, DOF_REAL_VEC_D);

	} CHAIN_WHILE(qfast, const QUAD_FAST);
	
      }
    } TRAVERSE_NEXT();

    free_el_dof_vec(dof);
  }

  return not_all;
}

bool bndry_H1scp_fct_bas_dow(DOF_REAL_VEC_D *fh,
			     const REAL_D *(*f)(REAL_DD result,
						const REAL_D x,
						const REAL_D normal),
			     const BNDRY_FLAGS bndry_seg,
			     const WALL_QUAD *quad)
{
  return _AI_bndry_H1scp_fct_bas_dow(fh, NULL, NULL, FILL_NOTHING,
				     f, bndry_seg, quad);
}

bool bndry_H1scp_fct_bas_loc_dow(DOF_REAL_VEC_D *fh,
				 GRD_LOC_FCT_D_AT_QP f_loc,
				 void *fd, FLAGS fill_flag,
				 const BNDRY_FLAGS bndry_seg,
				 const WALL_QUAD *quad)
{
  return _AI_bndry_H1scp_fct_bas_dow(fh, f_loc, fd, fill_flag,
				     NULL, bndry_seg, quad);
}

/* Compute the L2-scalar-product over the given trace-mesh. fh must
 * belong to the master mesh. quad must belong to the trace mesh.
 */
static void _AI_trace_L2scp_fct_bas(DOF_REAL_VEC *fh,
				    LOC_FCT_AT_QP f_loc,
				    void *fd, FLAGS fill_flag,
				    FCT_AT_X f,
				    MESH *mesh,
				    const QUAD *quad)
{
  FUNCNAME("trace_L2scp_fct_bas");
  const QUAD_FAST *quad_fast;
  const FE_SPACE  *fe_space;
  const REAL      *w;
  REAL            val;
  int             iq, j, n_phi, dim;
  const BAS_FCTS  *bas_fcts;
  INIT_EL_TAG     tag = INIT_EL_TAG_DFLT;  

  TEST_EXIT(fh, "no DOF_REAL_VEC fh\n");
  if (!f && !f_loc)
    return;

  TEST_EXIT(fh->fe_space, "no fe_space in DOF_REAL_VEC %s\n", NAME(fh));
  TEST_EXIT(mesh != NULL && fh->fe_space->mesh == get_master(mesh),
	    "mesh is not a trace mesh of fh->fe_space->mesh\n");

  dim = mesh->dim;

  fe_space = fh->fe_space;
  bas_fcts = fe_space->bas_fcts->trace_bas_fcts;

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

  w      = quad_fast->w;
  n_phi  = bas_fcts->n_bas_fcts;

  fill_flag |= CALL_LEAF_EL|FILL_COORDS|FILL_MASTER_INFO;
  if (mesh->is_periodic && !(fh->fe_space->admin->flags & ADM_PERIODIC)) {
    fill_flag |= FILL_NON_PERIODIC;
  }
  fill_flag |= quad_fast->fill_flags;

  {
    PARAMETRIC *parametric = mesh->parametric;
    int        is_parametric = false;
    REAL       wdetf_qp[quad->n_points_max];
    EL_DOF_VEC *dof = get_el_dof_vec(fe_space->bas_fcts);
    
    TRAVERSE_FIRST(mesh, -1, fill_flag) {

      INIT_ELEMENT_SETUP(el_info, quad_fast, tag, continue, {
	  w      = quad_fast->w;
	  n_phi  = bas_fcts->n_bas_fcts;
	});

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

      if (is_parametric) {
	const QUAD_EL_CACHE *qelc =
	  fill_quad_el_cache(el_info, quad, FILL_EL_QUAD_DET);

	if (f) {
	  fill_quad_el_cache(el_info, quad, FILL_EL_QUAD_WORLD);
	  for (iq = 0; iq < quad->n_points; iq++) {
	    wdetf_qp[iq] = w[iq]*qelc->param.det[iq]*f(qelc->world[iq]);
	  }
	} else {
	  for (iq = 0; iq < quad->n_points; iq++) {
	    wdetf_qp[iq] =
	      w[iq]*qelc->param.det[iq]*f_loc(el_info, quad, iq, fd);
	  }
	}
      } else {
	const EL_GEOM_CACHE *elgc = fill_el_geom_cache(el_info, FILL_EL_DET);
	if (f) {
	  const QUAD_EL_CACHE *qelc =
	    fill_quad_el_cache(el_info, quad, FILL_EL_QUAD_WORLD);
	  for (iq = 0; iq < quad->n_points; iq++) {
	    wdetf_qp[iq] = w[iq]*elgc->det*f(qelc->world[iq]);
	  }
	} else {
	  for (iq = 0; iq < quad->n_points; iq++) {
	    wdetf_qp[iq] = w[iq]*elgc->det*f_loc(el_info, quad, iq, fd);
	  }
	}
      }

      INIT_ELEMENT(el_info, quad_fast);

      /* The following line is the only actual difference to L2scp_fct_bas: */
      get_master_dof_indices(dof, el_info, fe_space);

      CHAIN_DO(quad_fast, const QUAD_FAST) {
	const BAS_FCTS *bas_fcts;
	const REAL *const*phi;

	bas_fcts = quad_fast->bas_fcts;
	phi      = quad_fast->phi;
	n_phi    = bas_fcts->n_bas_fcts;

	for (j = 0; j < n_phi; j++) {
	  val = 0.0;
	  for (iq = 0; iq < quad->n_points; iq++) {
	    val += phi[iq][j]*wdetf_qp[iq];
	  }
	  fh->vec[dof->vec[j]] += val;
	}
	fh  = CHAIN_NEXT(fh, DOF_REAL_VEC);
	dof = CHAIN_NEXT(dof, EL_DOF_VEC);
      } CHAIN_WHILE(quad_fast, const QUAD_FAST);
    } TRAVERSE_NEXT();

    free_el_dof_vec(dof);
  }
}

__FLATTEN_ATTRIBUTE__
void trace_L2scp_fct_bas(DOF_REAL_VEC *fh, FCT_AT_X f,
			 MESH *trace_mesh, const QUAD *quad)
{
  _AI_trace_L2scp_fct_bas(fh, NULL, NULL, FILL_NOTHING, f, trace_mesh, quad);
}

__FLATTEN_ATTRIBUTE__
void trace_L2scp_fct_bas_loc(DOF_REAL_VEC *fh,
			     LOC_FCT_AT_QP f, void *fd, FLAGS fill_flag,
			     MESH *trace_mesh,
			     const QUAD *quad)
{
  _AI_trace_L2scp_fct_bas(fh, f, fd, fill_flag, NULL, trace_mesh, quad);
}

static void _AI_trace_L2scp_fct_bas_dow(DOF_REAL_VEC_D *fh,
					FCT_D_AT_X f,
					LOC_FCT_D_AT_QP f_loc,
					void *fd, FLAGS fill_flag,
					MESH *mesh,
					const QUAD *quad)
{
  FUNCNAME("trace_L2scp_fct_bas_dow");
  const QUAD_FAST *quad_fast;
  const FE_SPACE  *fe_space;
  const REAL      *w;
  const REAL_B    *lambda;
  REAL_D          val;
  int             iq, j, n_phi, dim, n_points;
  const BAS_FCTS  *bas_fcts;
  INIT_EL_TAG     qtag = INIT_EL_TAG_DFLT;

  TEST_EXIT(fh, "no DOF_REAL_VEC fh\n");
  if (!f && !f_loc)
    return;

  TEST_EXIT(fh->fe_space, "no fe_space in DOF_REAL_D_VEC \"%s\"\n", NAME(fh));
  TEST_EXIT(mesh != NULL && fh->fe_space->mesh == get_master(mesh),
	    "mesh is not a trace mesh of fh->fe_space->mesh\n");
  TEST_EXIT(fh->fe_space->rdim == DIM_OF_WORLD,
	    "Called for scalar finite element space \"%s\".\n",
	    NAME(fh->fe_space));

  dim = mesh->dim;

  fe_space = fh->fe_space;
  bas_fcts = fe_space->bas_fcts->trace_bas_fcts;

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

  w            = quad->w;
  lambda       = quad->lambda;
  n_points     = quad->n_points;

  fill_flag |= CALL_LEAF_EL|FILL_COORDS|FILL_MASTER_INFO;
  if (mesh->is_periodic && !(fh->fe_space->admin->flags & ADM_PERIODIC)) {
    fill_flag |= FILL_NON_PERIODIC;
  }
  fill_flag |= quad_fast->fill_flags;

  {
    PARAMETRIC *parametric = mesh->parametric;
    int        is_parametric = false;
    REAL_D     wdetf_qp[quad->n_points_max];
    EL_DOF_VEC *dof = get_el_dof_vec(fe_space->bas_fcts);
    
    TRAVERSE_FIRST(mesh, -1, fill_flag) {

      INIT_ELEMENT_SETUP(el_info, quad, qtag, continue, {
	  w        = quad->w;
	  n_points = quad->n_points;
	  lambda   = quad->lambda;
	});
      
      if (parametric) {
	is_parametric = parametric->init_element(el_info, parametric);
      }

      if (is_parametric) {
	const QUAD_EL_CACHE *qelc =
	  fill_quad_el_cache(el_info, quad, FILL_EL_QUAD_DET);

	if (f) {
	  fill_quad_el_cache(el_info, quad, FILL_EL_QUAD_WORLD);
	  for (iq = 0; iq < quad->n_points; iq++) {
	    AXEY_DOW(w[iq]*qelc->param.det[iq],
		     f(qelc->world[iq],  wdetf_qp[iq]),
		     wdetf_qp[iq]);
	  }
	} else {
	  for (iq = 0; iq < quad->n_points; iq++) {
	    AXEY_DOW(w[iq]*qelc->param.det[iq],
		     f_loc(wdetf_qp[iq], el_info, quad, iq, fd),
		     wdetf_qp[iq]);
	  }
	}
      } else {
	const EL_GEOM_CACHE *elgc = fill_el_geom_cache(el_info, FILL_EL_DET);

	if (f) {
	  const QUAD_EL_CACHE *qelc =
	    fill_quad_el_cache(el_info, quad, FILL_EL_QUAD_WORLD);
	  for (iq = 0; iq < quad->n_points; iq++) {
	    AXEY_DOW(w[iq]*elgc->det,
		     f(qelc->world[iq],  wdetf_qp[iq]),
		     wdetf_qp[iq]);
	  }
	} else {
	  for (iq = 0; iq < quad->n_points; iq++) {
	    AXEY_DOW(w[iq]*elgc->det,
		     f_loc(wdetf_qp[iq], el_info, quad, iq, fd),
		     wdetf_qp[iq]);
	  }
	}
      }

      INIT_ELEMENT(el_info, quad_fast);

      /* The following line is the only actual difference to L2scp_fct_bas: */
      get_master_dof_indices(dof, el_info, fe_space);

      CHAIN_DO(quad_fast, const QUAD_FAST) {
	const BAS_FCTS *bas_fcts;

	bas_fcts = quad_fast->bas_fcts;
	n_phi    = bas_fcts->n_bas_fcts;

	if (fh->stride != 1) {
	  /* Cartesian product space */
	  DOF_REAL_D_VEC *fhd = (DOF_REAL_D_VEC *)fh;

	  for (j = 0; j < n_phi; j++) {
	    REAL_D val = { 0.0, };
	    for (iq = 0; iq < quad->n_points; iq++) {
	      AXPY_DOW(quad_fast->phi[iq][j], wdetf_qp[iq], val);
	    }
	    AXPY_DOW(1.0, val, fhd->vec[dof->vec[j]]);
	  }
	} else {
	  if (bas_fcts->dir_pw_const) {
	    for (j = 0; j < n_phi; j++) {
	      SET_DOW(0.0, val);
	      for (iq = 0; iq < n_points; iq++) {
		AXPY_DOW(quad_fast->phi[iq][j], wdetf_qp[iq], val);
	      }
	      fh->vec[dof->vec[j]] +=
		SCP_DOW(val, PHI_D(quad_fast->bas_fcts, j, NULL));
	    }
	  } else {
	    for (j = 0; j < n_phi; j++) {
	      REAL val = 0.0;
	      for (iq = 0; iq < n_points; iq++) {
		val +=
		  quad_fast->phi[iq][j]
		  *
		  SCP_DOW(wdetf_qp[iq],
			  PHI_D(quad_fast->bas_fcts, j, lambda[iq]));
	      }
	      fh->vec[dof->vec[j]] += val;
	    }
	  }
	}
	fh = CHAIN_NEXT(fh, DOF_REAL_VEC_D);
	dof = CHAIN_NEXT(dof, EL_DOF_VEC);
      } CHAIN_WHILE(quad_fast, const QUAD_FAST);

    } TRAVERSE_NEXT();

    free_el_dof_vec(dof);
  }
}

__FLATTEN_ATTRIBUTE__
void trace_L2scp_fct_bas_dow(DOF_REAL_VEC_D *fh, FCT_D_AT_X f,
			     MESH *trace_mesh,
			     const QUAD *quad)
{
  _AI_trace_L2scp_fct_bas_dow(fh, f, NULL, NULL, FILL_NOTHING,
			      trace_mesh, quad);
}

__FLATTEN_ATTRIBUTE__
void trace_L2scp_fct_bas_loc_dow(DOF_REAL_VEC_D *fh,
				 LOC_FCT_D_AT_QP f, void *fd, FLAGS fill_flag,
				 MESH *trace_mesh,
				 const QUAD *quad)
{
  _AI_trace_L2scp_fct_bas_dow(fh, NULL, f, fd, fill_flag, trace_mesh, quad);
}

/*--------------------------------------------------------------------------*/
/*  sets dirichlet boundary values g() in the vectors fh and uh and fills   */
/*  the vector boundary with the boundary type of the corresponding DOF     */
/*  return true if any Dirichlet nodes were found, false otherwise          */
/*--------------------------------------------------------------------------*/

bool dirichlet_bound_loc(DOF_REAL_VEC *fh, DOF_REAL_VEC *uh,
			 DOF_SCHAR_VEC *bound,
			 const BNDRY_FLAGS dirichlet_segment,
			 LOC_FCT_AT_QP g, void *g_data, FLAGS fill_flags)
{
  FUNCNAME("dirichlet_bound_loc");
  MESH             *mesh = NULL;
  const PARAMETRIC *parametric = NULL;
  int              j, dim;
  const FE_SPACE   *fe_space;
  const BAS_FCTS   *bas_fcts = NULL;
  bool             have_dirichlet = false;
  EL_REAL_VEC      *vec_loc;
  BNDRY_FLAGS      bndry_all;

  if (!fh && !uh && !bound) {
    return false;
  }

  if (dirichlet_segment == NULL) {
    BNDRY_FLAGS_ALL(bndry_all);
    dirichlet_segment = bndry_all;
  }

  if (fh && uh) {
    TEST_EXIT(FE_SPACE_EQ_P(fh->fe_space, uh->fe_space),
	      "fe_spaces in fh and uh differ\n");
  } else if (!uh && fh) {
    uh = fh;
    fh = NULL;
  }

  if (uh == NULL && bound != NULL) {

    fe_space  = bound->fe_space;
    mesh      = fe_space->mesh;
    bas_fcts  = fe_space->bas_fcts;
    dim       = mesh->dim;

    /* Don't forget this: */
    FOREACH_DOF(fe_space,
		bound->vec[dof] = INTERIOR,
		bound = CHAIN_NEXT(bound, DOF_SCHAR_VEC));

    /* If we have a periodic mesh but a non-periodic admin make sure
     * that we use non-periodic boundary information.
     */
    if (mesh->is_periodic && !(bound->fe_space->admin->flags & ADM_PERIODIC)) {
      fill_flags |= FILL_NON_PERIODIC;
    }
    fill_flags |= bas_fcts->fill_flags;

    TRAVERSE_FIRST(mesh, -1, CALL_LEAF_EL|FILL_MACRO_WALLS|fill_flags) {
      int t, o, wall, n_tr_phi;
      const int *trmap;

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

      t = el_info->el_type > 0;
      o = el_info->orientation < 0;

      CHAIN_DO(fe_space, const FE_SPACE) {
	DOF dof[bas_fcts->n_bas_fcts];

	GET_DOF_INDICES(bas_fcts, el_info->el, fe_space->admin, dof);

	for (wall = 0; wall < N_WALLS(dim); wall++) {
	  BNDRY_TYPE btype = wall_bound(el_info, wall);

	  if (btype == INTERIOR) {
	    continue;
	  }

	  /* Boundary conditions are attached to boundary segments,
	   * most elements will be interior elements, and most
	   * boundary elements will only have a single boundary facet,
	   * so in almost all cases we will reach this code path only
	   * once for each element.
	   */
	  n_tr_phi = bas_fcts->n_trace_bas_fcts[wall];
	  trmap = bas_fcts->trace_dof_map[t][o][wall];

	  if (BNDRY_FLAGS_IS_AT_BNDRY(dirichlet_segment, btype)) {
	    /* Mark boundary segment as DIRICHLET */
	    for (j = 0; j < n_tr_phi; j++) {
	      bound->vec[dof[trmap[j]]] = DIRICHLET;
	    }
	    have_dirichlet = true;
	  } else { /* NEUMANN if not already DIRICHLET */
	    for (j = 0; j < n_tr_phi; j++) {
	      if (bound->vec[dof[trmap[j]]] == INTERIOR) {
		bound->vec[dof[trmap[j]]] = NEUMANN;
	      }
	    }
	  }
	}
	bound    = CHAIN_NEXT(bound, DOF_SCHAR_VEC );
	bas_fcts = CHAIN_NEXT(bas_fcts, const BAS_FCTS);	  
      } CHAIN_WHILE(fe_space, const FE_SPACE);
    } TRAVERSE_NEXT();

    return have_dirichlet;
  }

  /* uh != NULL below this point */

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

  /* If we have a periodic mesh but a non-periodic admin make sure
   * that we use non-periodic boundary information.
   */
  if (mesh->is_periodic && !(uh->fe_space->admin->flags & ADM_PERIODIC)) {
    fill_flags |= FILL_NON_PERIODIC;
  }

  if (bound) {
    TEST_EXIT(FE_SPACE_EQ_P(uh->fe_space, bound->fe_space),
	      "uh->fe_space, bound->fe_space differ!\n");
    FOREACH_DOF(fe_space,
		bound->vec[dof] = INTERIOR,
		bound = CHAIN_NEXT(bound, DOF_SCHAR_VEC));
  }

  parametric = mesh->parametric;

  vec_loc = get_el_real_vec(bas_fcts);
  fill_flags |= bas_fcts->fill_flags;

  TRAVERSE_FIRST(mesh, -1, CALL_LEAF_EL|FILL_MACRO_WALLS|fill_flags) {
    int t, o, wall, n_tr_phi;
    const int *trmap;

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

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

    for (wall = 0; wall < N_WALLS(dim); wall++) {
      BNDRY_TYPE btype = wall_bound(el_info, wall);
	
      if (btype == INTERIOR) {
	continue;
      }

      /* Boundary conditions are attached to boundary segments, most
       * elements will be interior elements, and most boundary
       * elements will only have a single boundary facet, so in
       * almost all cases we will reach this code path only once for
       * each element.
       */

      t = el_info->el_type > 0;
      o = el_info->orientation < 0;

      if (!BNDRY_FLAGS_IS_AT_BNDRY(dirichlet_segment, btype)) {
	if (bound) {
	  /* Mark boundary segment as NEUMANN */
	  CHAIN_DO(fe_space, const FE_SPACE) {
	    DOF dofvec[bas_fcts->n_bas_fcts];
	    
	    GET_DOF_INDICES(bas_fcts, el_info->el, fe_space->admin, dofvec);
	    n_tr_phi = bas_fcts->n_trace_bas_fcts[wall];
	    trmap = bas_fcts->trace_dof_map[t][o][wall];
	    for (j = 0; j < n_tr_phi; j++) {
	      DOF dof = dofvec[trmap[j]];
	      if (bound->vec[dof] == INTERIOR) {
		bound->vec[dof] = NEUMANN;
	      }
	    }
	    bound = CHAIN_NEXT(bound, DOF_SCHAR_VEC);
	    bas_fcts = CHAIN_NEXT(bas_fcts, const BAS_FCTS);
	  } CHAIN_WHILE(fe_space, const FE_SPACE);
	}
	continue; /* not on a Dirichlet boundary segment */
      }
	
      have_dirichlet = true;

      /* Otherwise set Dirichlet boundary conditions for this
       * boundary segment. The coefficients returned in "dirichlet"
       * are relative to the trace-dof-mapping for the respective
       * type and orientation of the given wall.
       */

      /* Could wrap this in blas-like inline functions for
       * element-vector -> global-vector updates
       */
      CHAIN_DO(fe_space, const FE_SPACE) {
	DOF dofvec[bas_fcts->n_bas_fcts];

	GET_DOF_INDICES(bas_fcts, el_info->el, fe_space->admin, dofvec);
	n_tr_phi = bas_fcts->n_trace_bas_fcts[wall];
	trmap = bas_fcts->trace_dof_map[t][o][wall];

	if (g) {
	  INTERPOL(bas_fcts, vec_loc, el_info, wall, -1, NULL, g, g_data);
	}
	
	for (j = 0; j < n_tr_phi; j++) {
	  int ib  = trmap[j];
	  DOF dof = dofvec[ib];
	  if (bound) {
	    bound->vec[dof] = DIRICHLET;
	  }
	  uh->vec[dof] = g ? vec_loc->vec[ib] : 0.0;
	  if (fh) {
	    fh->vec[dof] = (bound == NULL || true) ? uh->vec[dof] : 0.0;
	  }
	}
	bas_fcts = CHAIN_NEXT(bas_fcts, const BAS_FCTS);
	uh       = CHAIN_NEXT(uh, DOF_REAL_VEC);
	vec_loc  = CHAIN_NEXT(vec_loc, EL_REAL_VEC);
	fh       = fh ? CHAIN_NEXT(fh, DOF_REAL_VEC) : NULL;
	bound    = bound ? CHAIN_NEXT(bound, DOF_SCHAR_VEC) : NULL;
      } CHAIN_WHILE(fe_space, const FE_SPACE);
    } /* end of loop over the "walls" of this element. */
  } TRAVERSE_NEXT();

  free_el_real_vec(vec_loc);

  return have_dirichlet;
}

bool dirichlet_bound(DOF_REAL_VEC *fh,
		     DOF_REAL_VEC *uh,
		     DOF_SCHAR_VEC *bound,
		     const BNDRY_FLAGS dirichlet_segment,
		     FCT_AT_X g)
{
  const PARAMETRIC *parametric = NULL;

  if (fh) {
    parametric = fh->fe_space->mesh->parametric;
  } else if (uh) {
    parametric = uh->fe_space->mesh->parametric;
  } else if (bound) {
    parametric = bound->fe_space->mesh->parametric;
  }
  if (parametric) {
    return dirichlet_bound_loc(fh, uh, bound, dirichlet_segment,
			       _AI_inter_fct_loc_param, &g, FILL_COORDS);
  } else {
    return dirichlet_bound_loc(fh, uh, bound, dirichlet_segment,
			       _AI_inter_fct_loc, &g, FILL_COORDS);
  }
}

bool dirichlet_bound_loc_dow(DOF_REAL_VEC_D *fh, DOF_REAL_VEC_D *uh,
			     DOF_SCHAR_VEC *bound,
			     const BNDRY_FLAGS dirichlet_segment,
			     LOC_FCT_D_AT_QP g, void *g_data, FLAGS fill_flags)
{
  FUNCNAME("dirichlet_bound_loc_dow");
  MESH             *mesh = NULL;
  const PARAMETRIC *parametric = NULL;
  int              j, dim;
  const FE_SPACE   *fe_space;
  const BAS_FCTS   *bas_fcts = NULL;
  bool             have_dirichlet = false;
  BNDRY_FLAGS      bndry_all;
  EL_REAL_VEC_D    *vec_loc;

  if (!fh && !uh && !bound) {
    return false;
  }

  if (dirichlet_segment == NULL) {
    BNDRY_FLAGS_ALL(bndry_all);
    dirichlet_segment = bndry_all;
  }

  if (fh && uh) {
    TEST_EXIT(FE_SPACE_EQ_P(fh->fe_space, uh->fe_space),
	      "fe_spaces in fh and uh differ\n");
  } else if (!uh && fh) {
    uh = fh;
    fh = NULL;
  }

  if (uh == NULL && bound != NULL) {

    fe_space  = bound->fe_space;
    mesh      = fe_space->mesh;
    bas_fcts  = fe_space->bas_fcts;
    dim       = mesh->dim;

    /* Don't forget this: */
    FOREACH_DOF(fe_space,
		bound->vec[dof] = INTERIOR,
		bound = CHAIN_NEXT(bound, DOF_SCHAR_VEC));

    /* If we have a periodic mesh but a non-periodic admin make sure
     * that we use non-periodic boundary information.
     */
    if (mesh->is_periodic && !(bound->fe_space->admin->flags & ADM_PERIODIC)) {
      fill_flags |= FILL_NON_PERIODIC;
    }

    fill_flags |= bas_fcts->fill_flags;
    TRAVERSE_FIRST(mesh, -1, CALL_LEAF_EL|FILL_MACRO_WALLS|fill_flags) {
      int t, o, wall, n_tr_phi;
      const int *trmap;

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

      t = el_info->el_type > 0;
      o = el_info->orientation < 0;
      CHAIN_DO(fe_space, const FE_SPACE) {
	DOF dof[bas_fcts->n_bas_fcts];
	GET_DOF_INDICES(bas_fcts, el_info->el, fe_space->admin, dof);
	  
	for (wall = 0; wall < N_WALLS(dim); wall++) {
	  BNDRY_TYPE btype = wall_bound(el_info, wall);

	  if (btype == INTERIOR) {
	    continue;
	  }

	  /* Boundary conditions are attached to boundary segments,
	   * most elements will be interior elements, and most
	   * boundary elements will only have a single boundary facet,
	   * so in almost all cases we will reach this code path only
	   * once for each element.
	   */
	  n_tr_phi = bas_fcts->n_trace_bas_fcts[wall];
	  trmap = bas_fcts->trace_dof_map[t][o][wall];

	  if (BNDRY_FLAGS_IS_AT_BNDRY(dirichlet_segment, btype)) {
	    /* Mark boundary segment as DIRICHLET */
	    for (j = 0; j < n_tr_phi; j++) {
	      bound->vec[dof[trmap[j]]] = DIRICHLET;
	    }
	    have_dirichlet = true;
	  } else { /* NEUMANN if not already DIRICHLET */
	    for (j = 0; j < n_tr_phi; j++) {
	      if (bound->vec[dof[trmap[j]]] == INTERIOR) {
		bound->vec[dof[trmap[j]]] = NEUMANN;
	      }
	    }
	  }
	}
	bound    = CHAIN_NEXT(bound, DOF_SCHAR_VEC);
	bas_fcts = CHAIN_NEXT(bas_fcts, const BAS_FCTS);	  
      } CHAIN_WHILE(fe_space, const FE_SPACE);
    } TRAVERSE_NEXT();

    return have_dirichlet;
  }

  /* uh != NULL below this point */

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

  /* If we have a periodic mesh but a non-periodic admin make sure
   * that we use non-periodic boundary information.
   */
  if (mesh->is_periodic && !(uh->fe_space->admin->flags & ADM_PERIODIC)) {
    fill_flags |= FILL_NON_PERIODIC;
  }

  if (bound) {
    TEST_EXIT(FE_SPACE_EQ_P(uh->fe_space, bound->fe_space),
	      "uh->fe_space, bound->fe_space differ!\n");
    FOREACH_DOF(fe_space,
		bound->vec[dof] = INTERIOR,
		bound = CHAIN_NEXT(bound, DOF_SCHAR_VEC));
  }

  parametric = mesh->parametric;

  vec_loc = get_el_real_vec_d(bas_fcts);

  fill_flags |= bas_fcts->fill_flags;
  TRAVERSE_FIRST(mesh, -1, CALL_LEAF_EL|FILL_MACRO_WALLS|fill_flags) {
    int t, o, wall, n_tr_phi;
    const int *trmap;

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

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

    for (wall = 0; wall < N_WALLS(dim); wall++) {
      BNDRY_TYPE btype = wall_bound(el_info, wall);
	
      if (btype == INTERIOR) {
	continue;
      }

      /* Boundary conditions are attached to boundary segments, most
       * elements will be interior elements, and most boundary
       * elements will only have a single boundary facet, so in
       * almost all cases we will reach this code path only once for
       * each element.
       */

      t = el_info->el_type > 0;
      o = el_info->orientation < 0;

      if (!BNDRY_FLAGS_IS_AT_BNDRY(dirichlet_segment, btype)) {
	if (bound) {
	  /* Mark boundary segment as NEUMANN */
	  CHAIN_DO(fe_space, const FE_SPACE) {
	    DOF dofvec[bas_fcts->n_bas_fcts];
	    
	    GET_DOF_INDICES(bas_fcts, el_info->el, fe_space->admin, dofvec);
	    n_tr_phi = bas_fcts->n_trace_bas_fcts[wall];
	    trmap = bas_fcts->trace_dof_map[t][o][wall];
	    for (j = 0; j < n_tr_phi; j++) {
	      DOF dof = dofvec[trmap[j]];
	      if (bound->vec[dof] == INTERIOR) {
		bound->vec[dof] = NEUMANN;
	      }
	    }
	    bound = CHAIN_NEXT(bound, DOF_SCHAR_VEC);
	    bas_fcts = CHAIN_NEXT(bas_fcts, const BAS_FCTS);
	  } CHAIN_WHILE(fe_space, const FE_SPACE);
	}
	continue; /* not on a Dirichlet boundary segment */
      }
	
      have_dirichlet = true;

      /* Otherwise set Dirichlet boundary conditions for this
       * boundary segment. The coefficients returned in "dirichlet"
       * are relative to the trace-dof-mapping for the respective
       * type and orientation of the given wall.
       */

      /* Could wrap this in blas-like inline functions for
       * element-vector -> global-vector updates
       *
       * This following few lines are the only place where this
       * functions differs from its scalar counterpart.
       */
      CHAIN_DO(fe_space, const FE_SPACE) {
	DOF dofvec[bas_fcts->n_bas_fcts];

	GET_DOF_INDICES(bas_fcts, el_info->el, fe_space->admin, dofvec);
	n_tr_phi = bas_fcts->n_trace_bas_fcts[wall];
	trmap = bas_fcts->trace_dof_map[t][o][wall];

	if (uh->stride != 1) {
	  /* quasi-scalar Cartesian product case */
	  DOF_REAL_D_VEC *fhd = (DOF_REAL_D_VEC *)fh;
	  DOF_REAL_D_VEC *uhd = (DOF_REAL_D_VEC *)uh;

	  if (g) {
	    INTERPOL_D(bas_fcts, (EL_REAL_D_VEC *)vec_loc,
		       el_info, wall, -1, NULL, g, g_data);
	  }
	
	  for (j = 0; j < n_tr_phi; j++) {
	    int ib  = trmap[j];
	    DOF dof = dofvec[ib];
	    if (bound) {
	      bound->vec[dof] = DIRICHLET;
	    }
	    if (g) {
	      COPY_DOW(((EL_REAL_D_VEC *)vec_loc)->vec[ib], uhd->vec[dof]);
	    } else {
	      SET_DOW(0.0, uhd->vec[dof]);
	    }
	    if (fh) {
	      if (bound == NULL || true) {
		COPY_DOW(uhd->vec[dof], fhd->vec[dof]);
	      } else {
		SET_DOW(0.0, uhd->vec[dof]);
	      }
	    }
	  }
	  bas_fcts = CHAIN_NEXT(bas_fcts, const BAS_FCTS);
	  uh       = CHAIN_NEXT(uh, DOF_REAL_VEC_D);
	  fh       = fh ? CHAIN_NEXT(fh, DOF_REAL_VEC_D) : NULL;
	  bound    = bound ? CHAIN_NEXT(bound, DOF_SCHAR_VEC) : NULL;
	} else {

	  if (g) {
	    INTERPOL_DOW(bas_fcts, vec_loc, el_info, wall, -1, NULL, g, g_data);
	  }
	
	  for (j = 0; j < n_tr_phi; j++) {
	    int ib  = trmap[j];
	    DOF dof = dofvec[ib];
	    if (bound) {
	      bound->vec[dof] = DIRICHLET;
	    }
	    uh->vec[dof] = g ? vec_loc->vec[ib] : 0.0;
	    if (fh) {
	      fh->vec[dof] = (bound == NULL || true) ? uh->vec[dof] : 0.0;
	    }
	  }
	  bas_fcts = CHAIN_NEXT(bas_fcts, const BAS_FCTS);
	  uh       = CHAIN_NEXT(uh, DOF_REAL_VEC_D);
	  fh       = fh ? CHAIN_NEXT(fh, DOF_REAL_VEC_D) : NULL;
	  bound    = bound ? CHAIN_NEXT(bound, DOF_SCHAR_VEC) : NULL;
	}
	vec_loc = CHAIN_NEXT(vec_loc, EL_REAL_VEC_D);
      } CHAIN_WHILE(fe_space, const FE_SPACE);
    } /* end of loop over the "walls" of this element. */
  } TRAVERSE_NEXT();

  free_el_real_vec_d(vec_loc);

  return have_dirichlet;
}

bool dirichlet_bound_dow(DOF_REAL_VEC_D *fh, DOF_REAL_VEC_D *uh,
			 DOF_SCHAR_VEC *bound,
			 const BNDRY_FLAGS dirichlet_segment,
			 FCT_D_AT_X g)
{
  const PARAMETRIC *parametric = NULL;

  if (fh) {
    parametric = fh->fe_space->mesh->parametric;
  } else if (uh) {
    parametric = uh->fe_space->mesh->parametric;
  } else if (bound) {
    parametric = bound->fe_space->mesh->parametric;
  }
  if (parametric) {
    return dirichlet_bound_loc_dow(fh, uh, bound, dirichlet_segment,
				   _AI_inter_fct_loc_d_param, &g, FILL_COORDS);
  } else {
    return dirichlet_bound_loc_dow(fh, uh, bound, dirichlet_segment,
				   _AI_inter_fct_loc_d, &g, FILL_COORDS);
  }
}

/* Compute the mean value of either a finite element function or a
 * non-discrete function. If both are given return the difference of
 * their mean values (f-fh).
 */
static inline
REAL _AI_mean_value(MESH *mesh,
		    FCT_AT_X f,
		    LOC_FCT_AT_QP f_loc, void *fd, FLAGS fill_flags,
		    const DOF_REAL_VEC *fh,
		    const QUAD *quad)
{
  /*FUNCNAME("mean_value");*/
  const QUAD_FAST   *quad_fast = NULL;
  REAL              accu1, accu2, det;
  int               iq, dim;
  const BAS_FCTS    *bas_fcts = NULL;
  REAL              mean; 
  REAL              meas;

  dim = mesh->dim;

  if (!quad) {
    quad = get_quadrature(dim, fh ? fh->fe_space->bas_fcts->degree : 1);
  }

  if (fh) {
    quad_fast = get_quad_fast(fh->fe_space->bas_fcts, quad, INIT_PHI);
    bas_fcts = fh->fe_space->bas_fcts;
  }

  mean = 0.0;
  meas = 0.0;
  {
    PARAMETRIC  *parametric = mesh->parametric;
    REAL        det_p[quad->n_points_max];
    REAL        fh_vec[quad->n_points_max];
    REAL        f_vec[quad->n_points_max];
    EL_REAL_VEC *fh_loc;
    int         is_parametric = false;
    int         dim = mesh->dim;

    fh_loc = get_el_real_vec(bas_fcts);

    fill_flags |= quad_fast->fill_flags;
    TRAVERSE_FIRST(mesh, -1, CALL_LEAF_EL|FILL_COORDS|fill_flags) {

      if (fh) {
	if (INIT_ELEMENT(el_info, quad_fast) == INIT_EL_TAG_NULL) {
	  continue;
	}
	fill_el_real_vec(fh_loc, el_info->el, fh);
      }

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

      if (f && fh) {
	uh_at_qp(fh_vec, quad_fast, fh_loc);
	fx_at_qp(f_vec, el_info, quad, f);

	for (iq = 0; iq < quad->n_points; iq++) {
	  f_vec[iq] -= fh_vec[iq];
	}
      } else if (f_loc && fh) {
	uh_at_qp(fh_vec, quad_fast, fh_loc);
	f_loc_at_qp(f_vec, el_info, quad, f_loc, fd);

	for (iq = 0; iq < quad->n_points; iq++) {
	  f_vec[iq] -= fh_vec[iq];
	}
      } else if (f) {
	fx_at_qp(f_vec, el_info, quad, f);
      } else if (f_loc) {
	f_loc_at_qp(f_vec, el_info, quad, f_loc, fd);
      } else if (fh) {
	uh_at_qp(f_vec, quad_fast, fh_loc);
      }
      
      if (is_parametric) {
	parametric->det(el_info, quad, 0, NULL, det_p);
	for (iq = 0; iq < quad->n_points; iq++) {
	  mean += quad->w[iq]*det_p[iq]*f_vec[iq];
	  meas += quad->w[iq]*det_p[iq];
	}
      } else {
	det = el_det_dim(dim, el_info);
	accu1 = accu2 = 0.0;
	for (iq = 0; iq < quad->n_points; iq++) {
	  accu1 += quad->w[iq]*f_vec[iq];
	  accu2 += quad->w[iq];
	}
	mean += det*accu1;
	meas += det*accu2;
      }
    } TRAVERSE_NEXT();
  }

  return mean/meas;
}

__FLATTEN_ATTRIBUTE__
REAL mean_value(MESH *mesh,
		REAL (*f)(const REAL_D),
		const DOF_REAL_VEC *fh,
		const QUAD *quad)
{
  return _AI_mean_value(mesh, f, NULL, NULL, FILL_NOTHING, fh, quad);
}

__FLATTEN_ATTRIBUTE__
REAL mean_value_loc(MESH *mesh,
		    REAL (*f_loc)(const EL_INFO *el_info,
				  const QUAD *quad, int iq,
				  void *fd),
		    void *fd, FLAGS fill_flags,
		    const DOF_REAL_VEC *fh,
		    const QUAD *quad)
{
  return _AI_mean_value(mesh, NULL, f_loc, fd, fill_flags, fh, quad);
}
  
static const REAL *
_AI_mean_value_dow(MESH *mesh,
		   FCT_D_AT_X f,
		   LOC_FCT_D_AT_QP f_loc, void *fd, FLAGS fill_flags,
		   const DOF_REAL_VEC_D *fh,
		   const QUAD *quad,
		   REAL_D mean)
{
  /* FUNCNAME("mean_value_dow"); */
  static REAL_D   _mean;
  const QUAD_FAST *quad_fast = NULL;
  REAL            det;
  int             iq, dim = mesh->dim;
  REAL            meas;

  if (!mean) {
    mean = _mean;
  }

  if (!quad) {
    quad = get_quadrature(dim, fh ? fh->fe_space->bas_fcts->degree : 1);
  }

  if (fh) {
    quad_fast = get_quad_fast(fh->fe_space->bas_fcts, quad, INIT_PHI);
  }

  SET_DOW(0.0, mean);
  meas = 0.0;
  {
    PARAMETRIC *parametric = mesh->parametric;
    REAL_D accu1;
    REAL   accu2;    
    REAL   det_p[quad->n_points_max];
    REAL_D fh_vec[quad->n_points_max];
    REAL_D f_vec[quad->n_points_max];
    int    is_parametric = false;
    int    dim = mesh->dim;
    const EL_REAL_VEC_D *fh_loc = NULL;
    
    fill_flags |= quad_fast->fill_flags;
    TRAVERSE_FIRST(mesh, -1, CALL_LEAF_EL|FILL_COORDS|fill_flags) {

      if (fh) {
	if (INIT_ELEMENT(el_info, quad_fast) == INIT_EL_TAG_NULL) {
	  continue;
	}
	fh_loc = fill_el_real_vec_d(NULL, el_info->el, fh);
      }

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

      if (f && fh) {
	uh_dow_at_qp(fh_vec, quad_fast, fh_loc);
	fx_d_at_qp(f_vec, el_info, quad, f);

	for (iq = 0; iq < quad->n_points; iq++) {
	  AXPY_DOW(-1.0, fh_vec[iq], f_vec[iq]);
	}
      } else if (f_loc && fh) {
	uh_dow_at_qp(fh_vec, quad_fast, fh_loc);
	f_loc_d_at_qp(f_vec, el_info, quad, f_loc, fd);

	for (iq = 0; iq < quad->n_points; iq++) {
	  AXPY_DOW(-1.0, fh_vec[iq], f_vec[iq]);
	}
      } else if (f) {
	fx_d_at_qp(f_vec, el_info, quad, f);
      } else if (f_loc) {
	f_loc_d_at_qp(f_vec, el_info, quad, f_loc, fd);
      } else if (fh) {
	uh_dow_at_qp(f_vec, quad_fast, fh_loc);
      }
      
      if (is_parametric) {
	parametric->det(el_info, quad, 0, NULL, det_p);
	for (iq = 0; iq < quad->n_points; iq++) {
	  AXPY_DOW(quad->w[iq]*det_p[iq], f_vec[iq], mean);
	  meas += quad->w[iq]*det_p[iq];
	}
      } else {
	det = el_det_dim(dim, el_info);
	SET_DOW(0.0, accu1);
	accu2 = 0.0;
	for (iq = 0; iq < quad->n_points; iq++) {
	  AXPY_DOW(quad->w[iq], f_vec[iq], accu1);
	  accu2 += quad->w[iq];
	}
	AXPY_DOW(det, accu1, mean);
	meas += det*accu2;
      }
    } TRAVERSE_NEXT();
  }

  AX_DOW(1.0/meas, mean);
  
  return mean;
}

__FLATTEN_ATTRIBUTE__
const REAL *mean_value_dow(MESH *mesh,
			   FCT_D_AT_X f, const DOF_REAL_VEC_D *fh,
			   const QUAD *quad,
			   REAL_D mean)
{
  return _AI_mean_value_dow(mesh, f, NULL, NULL, FILL_NOTHING, fh, quad, mean);
}

__FLATTEN_ATTRIBUTE__
const REAL *mean_value_loc_dow(REAL_D mean,
			       MESH *mesh,
			       LOC_FCT_D_AT_QP f_loc, void *fd,
			       FLAGS fill_flags,
			       const DOF_REAL_VEC_D *fh,
			       const QUAD *quad)
{
  return _AI_mean_value_dow(mesh, NULL, f_loc, fd, fill_flags, fh, quad, mean);
}

typedef struct robin_ass_data {
  struct robin_ass_data *next;
  const REAL            *dets;
  BNDRY_FLAGS           bndry_seg;
  REAL                  factor;
  REAL                  exponent;
} ROBIN_ASS_DATA;

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

  switch(dim) {
  case 0:
    return 1.0;
  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 */
  }
}

/* Implementation of Robin boundary conditions */
static bool param_robin_bndry_init_element(const EL_INFO *el_info, int wall,
					   const WALL_QUAD *quad[3], void *vd)
{
  ROBIN_ASS_DATA *data = (ROBIN_ASS_DATA *)vd;
  PARAMETRIC *parametric = el_info->mesh->parametric;
  int is_parametric = false;
  const EL_GEOM_CACHE *elgc;
  const QUAD_EL_CACHE *qelc;
  REAL area = 0.0;

  is_parametric = parametric->init_element(el_info, parametric);

  if (is_parametric) {
    int iq;
    INIT_ELEMENT(el_info, &quad[0]->quad[wall]);
    qelc = fill_quad_el_cache(
      el_info, &quad[0]->quad[wall], FILL_EL_QUAD_WALL_DET);
    data->dets = qelc->param.wall_det;
    if (data->exponent > 0.0) {
      area = 0.0;
      for (iq = 0; iq < quad[0]->quad[wall].n_points; ++iq) {
	area += quad[0]->quad[wall].w[iq] * data->dets[iq];
      }
    }
  } else {
    elgc = fill_el_geom_cache(el_info, FILL_EL_WALL_DET(wall));
    data->dets = &elgc->wall_det[wall];
    area = *data->dets;
  }

  if (data->exponent > 0.0) {
    data->factor =
      pow(h2_from_det(el_info->mesh->dim - 1, area), -0.5 * data->exponent);
  } else {
    data->factor = 1.0;
  }

  return is_parametric;
}

static bool robin_bndry_init_element(const EL_INFO *el_info, int wall,
				     const WALL_QUAD *quad[3], void *vd)
{
  ROBIN_ASS_DATA *data = (ROBIN_ASS_DATA *)vd;
  const EL_GEOM_CACHE *elgc;
  
  elgc = fill_el_geom_cache(el_info, FILL_EL_WALL_DET(wall));
  data->dets = &elgc->wall_det[wall];

  if (data->exponent > 0.0) {
    data->factor = pow(
      h2_from_det(el_info->mesh->dim - 1, *data->dets), -0.5 * data->exponent);
  } else {
    data->factor = 1.0;
  }

  return false;
}

static REAL robin_bndry_c(const EL_INFO *el_info,
			  const QUAD *quad, int iq, void *vd)
{
  ROBIN_ASS_DATA *data = (ROBIN_ASS_DATA *)vd;
  
  /* iq will never be != 0 for pw constant and non-param */
  return data->factor * data->dets[iq];
}

/* Add Robin boundary condition to a DOF-matrix. */
void robin_bound_matrix_info(EL_MATRIX_INFO *robin_info,
			     const FE_SPACE *row_fe_space,
			     const FE_SPACE *col_fe_space,
			     const BNDRY_FLAGS robin_segment,
			     REAL alpha_r,
			     const WALL_QUAD *wall_quad,
			     REAL exponent)
{
  MESH           *mesh;
  const FE_SPACE *fe_space;
  const BAS_FCTS *bas_fcts;
  BNDRY_OPERATOR_INFO oinfo = { NULL, };
  static ROBIN_ASS_DATA *first_data;
  ROBIN_ASS_DATA *data;
  BNDRY_FLAGS segment;

  if (robin_segment == NULL) {
    BNDRY_FLAGS_ALL(segment);
  } else {
    BNDRY_FLAGS_CPY(segment, robin_segment);
  }

  for (data = first_data; data != NULL; data = data->next) {
    if (data->factor == alpha_r &&
	data->exponent == exponent &&
	BNDRY_FLAGS_CMP(data->bndry_seg, segment)) {
      break;
    }
  }
  if (data == NULL) {
    data = MEM_CALLOC(1, ROBIN_ASS_DATA);
    data->next = first_data;
    first_data = data;
    BNDRY_FLAGS_CPY(data->bndry_seg, robin_segment);
    BNDRY_FLAGS_MARK_BNDRY(data->bndry_seg);
    data->factor   = alpha_r;
    data->exponent = exponent;
  }

  fe_space = row_fe_space;
  mesh     = fe_space->mesh;
  bas_fcts = fe_space->bas_fcts;

  if (wall_quad == NULL) {
    wall_quad = get_wall_quad(mesh->dim, 2*bas_fcts->degree);
  }

  oinfo.row_fe_space  = row_fe_space;
  oinfo.col_fe_space  = col_fe_space;
  oinfo.quad[0]       = wall_quad;
  if (mesh->parametric) {
    oinfo.init_element = param_robin_bndry_init_element;
  } else {
    oinfo.init_element = robin_bndry_init_element;
  }
  oinfo.c.real        = robin_bndry_c;
  oinfo.c_pw_const    = true;
  BNDRY_FLAGS_CPY(oinfo.bndry_type, data->bndry_seg);
  oinfo.user_data     = data;
  oinfo.fill_flag     = FILL_COORDS|CALL_LEAF_EL;
  fill_matrix_info_ext(robin_info, NULL, &oinfo, NULL);
  robin_info->factor = alpha_r;
}

/* Add Robin boundary condition to a DOF-matrix. */
void robin_bound(DOF_MATRIX *matrix,
		 const BNDRY_FLAGS robin_segment,
		 REAL alpha_r,
		 const WALL_QUAD *wall_quad,
		 REAL exponent)
{
  EL_MATRIX_INFO robin_info;

  if (alpha_r == 0.0 || matrix == NULL) { 
    return;
  }

  robin_bound_matrix_info(&robin_info,
			  matrix->row_fe_space,
			  matrix->col_fe_space
			  ? matrix->col_fe_space : matrix->row_fe_space,
			  robin_segment,
			  alpha_r,
			  wall_quad,
			  exponent);

  update_matrix(matrix, &robin_info, NoTranspose);
}

static REAL one(const REAL_D x)
{
  return 1.0;
}

static const REAL *one_d(const REAL_D x, REAL_D result)
{
  static REAL_D space;
  
  if (result == NULL) {
    result = space;
  }

  SET_DOW(1.0, result);

  return result;
}

/* One more convenience function: implement Dirichlet and
 * Neumann/Robin boundary conditions. If we have pure Neumann boundary
 * conditions, we also perform a mean-value correction of the RHS;
 * otherwise the compatibility condition for the RHS may not be
 * satisfied (because of quadrature errors).
 */
static bool _AI_boundary_conditions(DOF_MATRIX *matrix,
				    DOF_REAL_VEC *fh,
				    DOF_REAL_VEC *uh,
				    DOF_SCHAR_VEC *bound,
				    const BNDRY_FLAGS dirichlet_segment,
				    FCT_AT_X g,
				    REAL (*gn)(const REAL_D x,
					       const REAL_D normal),
				    LOC_FCT_AT_QP g_loc,
				    LOC_FCT_AT_QP gn_loc,
				    void *fd, FLAGS fill_flag,
				    REAL alpha_r,
				    const WALL_QUAD *wall_quad)
{
  FUNCNAME("boundary_conditions");
  bool not_all_neumann = false;
  BNDRY_FLAGS non_dirichlet, dirichlet;

  BNDRY_FLAGS_ALL(non_dirichlet);
  if (dirichlet_segment) {
    BNDRY_FLAGS_XOR(non_dirichlet, dirichlet_segment);
    BNDRY_FLAGS_MARK_BNDRY(non_dirichlet);    
  } else {
    BNDRY_FLAGS_INIT(dirichlet);
    dirichlet_segment = dirichlet;
  }
  
  if (fh && (gn || gn_loc)) {
    not_all_neumann =
      _AI_bndry_L2scp_fct_bas(fh, gn_loc, fd, fill_flag, gn,
			      non_dirichlet, wall_quad);
  }
  if (alpha_r > 0.0 && matrix) {
    robin_bound(matrix, non_dirichlet, alpha_r, wall_quad, 0.0);
    not_all_neumann = true;
  }
  if (((g || g_loc) && (fh || uh)) || bound) {
    if (g_loc) {
      not_all_neumann =
	dirichlet_bound_loc(fh, uh, bound, dirichlet_segment,
			    g_loc, fd, fill_flag) || not_all_neumann;
    } else {
      not_all_neumann =
	dirichlet_bound(fh, uh, bound, dirichlet_segment, g) || not_all_neumann;
    }
  }

  /* do a mean-value correction for the rhs if we have pure Neumann
   * boundary-conditions. We use the combination "bndry_type ==
   * NEUMANN && alpha_r == -1.0" to flag the request for automatic
   * mean-value adjustment.
   */
  if (!not_all_neumann && fh && alpha_r < 0.0) {
    const DOF_ADMIN *admin = fh->fe_space->admin;
    const BAS_FCTS *bas_fcts = fh->fe_space->bas_fcts;
    REAL mv;
    int dim    = bas_fcts->unchained->dim;
    int degree = bas_fcts->unchained->degree;

    if (bas_fcts->unchained == get_lagrange(dim, degree)
	||
	bas_fcts->unchained == get_discontinuous_lagrange(dim, degree)) {
    
      mv = 0.0;
      FOR_ALL_DOFS(admin, mv += fh->vec[dof]);

      if (fabs(mv) > REAL_EPSILON) {
	MSG("Mean-value adjustment by %e\n", mv);
	mv /= (REAL)admin->used_count;
	FOR_ALL_DOFS(admin, fh->vec[dof] -= mv);
      }
    } else {
      /* More work to do. The code below works iff the interpolation
       * operator preserves polynomials and if the constant 1 function
       * belongs to the finite element space.
       */
      DOF_REAL_VEC *one_h = get_dof_real_vec("one", fh->fe_space);
      REAL mv, weight;

      interpol(one, one_h);
      weight = mv = 0.0;
      FOR_ALL_DOFS(admin, if (fabs(one_h->vec[dof]) > 100*REAL_EPSILON) {
		     weight += one_h->vec[dof];
		     mv     += fh->vec[dof] * one_h->vec[dof];
		   } else {
		     one_h->vec[dof] = 0.0;
		   });
      if (fabs(mv) > REAL_EPSILON) {
	MSG("Mean-value adjustment by %e\n", mv);
	mv /= weight;
	FOR_ALL_DOFS(admin, if (one_h->vec[dof] != 0.0) {
		       fh->vec[dof] -= mv;
		     });
      }
      free_dof_real_vec(one_h);
    }
  }

  return not_all_neumann;
}

bool boundary_conditions(DOF_MATRIX *matrix,
			 DOF_REAL_VEC *fh,
			 DOF_REAL_VEC *uh,
			 DOF_SCHAR_VEC *bound,
			 const BNDRY_FLAGS dirichlet_segment,
			 FCT_AT_X g,
			 REAL (*gn)(const REAL_D x, const REAL_D normal),
			 REAL alpha_r,
			 const WALL_QUAD *wall_quad)
{
  return _AI_boundary_conditions(matrix, fh, uh, bound,
				 dirichlet_segment,
				 g, gn,
				 NULL, NULL, NULL, FILL_NOTHING,
				 alpha_r, wall_quad);
}

bool boundary_conditions_loc(DOF_MATRIX *matrix,
			     DOF_REAL_VEC *fh,
			     DOF_REAL_VEC *uh,
			     DOF_SCHAR_VEC *bound,
			     const BNDRY_FLAGS dirichlet_segment,
			     LOC_FCT_AT_QP g_loc,
			     LOC_FCT_AT_QP gn_loc,
			     void *fd, FLAGS fill_flag,
			     REAL alpha_r,
			     const WALL_QUAD *wall_quad)
{
  return _AI_boundary_conditions(matrix, fh, uh, bound,
				 dirichlet_segment,
				 NULL, NULL,
				 g_loc, gn_loc, fd, fill_flag,
				 alpha_r, wall_quad);
}

static bool
_AI_boundary_conditions_dow(DOF_MATRIX *matrix,
			    DOF_REAL_VEC_D *fh,
			    DOF_REAL_VEC_D *uh,
			    DOF_SCHAR_VEC *bound,
			    const BNDRY_FLAGS dirichlet_segment,
			    FCT_D_AT_X g,
			    const REAL *(*gn)(const REAL_D x,
					      const REAL_D normal,
					      REAL_D res),
			    LOC_FCT_D_AT_QP g_loc,
			    LOC_FCT_D_AT_QP gn_loc, void *fd, FLAGS fill_flag,
			    REAL alpha_r,
			    const WALL_QUAD *wall_quad)
{
  FUNCNAME("boundary_conditions_dow");
  bool not_all_neumann = false;
  BNDRY_FLAGS non_dirichlet, dirichlet;

  BNDRY_FLAGS_ALL(non_dirichlet);
  if (dirichlet_segment) {
    BNDRY_FLAGS_XOR(non_dirichlet, dirichlet_segment);
    BNDRY_FLAGS_MARK_BNDRY(non_dirichlet);    
  } else {
    BNDRY_FLAGS_INIT(dirichlet);
    dirichlet_segment = dirichlet;
  }

  if (fh && (gn || gn_loc)) {
    not_all_neumann =
      _AI_bndry_L2scp_fct_bas_dow(fh, gn_loc, fd, fill_flag, gn,
				  non_dirichlet, wall_quad);
  }
  if (alpha_r > 0.0 && matrix) {
    robin_bound(matrix, non_dirichlet, alpha_r, wall_quad, 0.0);
    not_all_neumann = true;
  }
  if (((g && g_loc) && (fh || uh)) || bound) {
    if (g_loc) {
      not_all_neumann =
	dirichlet_bound_loc_dow(fh, uh, bound, dirichlet_segment,
				g_loc, fd, fill_flag)
	||
	not_all_neumann;
    } else {
      not_all_neumann =
	dirichlet_bound_dow(fh, uh, bound, dirichlet_segment, g)
	||
	not_all_neumann;
    }
  }
  /* do a mean-value correction for the rhs if we have pure Neumann
   * boundary-conditions. We use the combination "bndry_type ==
   * NEUMANN && alpha_r == -1.0" to flag the request for automatic
   * mean-value adjustment.
   */
  if (!not_all_neumann && fh && alpha_r < 0.0) {
    /* do a mean-value correction for the rhs if we have pure Neumann
     * boundary-conditions. Hope that the first component of a direct
     * sum corresponds to the Lagrange basis functions.
     */
    const DOF_ADMIN *admin    = fh->fe_space->admin;
    const BAS_FCTS  *bas_fcts = fh->fe_space->bas_fcts;
    DOF_REAL_D_VEC  *fhd      = (DOF_REAL_D_VEC *)fh;
    REAL_D mv;
    int dim    = bas_fcts->unchained->dim;
    int degree = bas_fcts->unchained->degree;

    if (bas_fcts->unchained == get_lagrange(dim, degree)
	||
	bas_fcts->unchained == get_discontinuous_lagrange(dim, degree))  {

      SET_DOW(0.0, mv);
      FOR_ALL_DOFS(admin, AXPY_DOW(1.0, fhd->vec[dof], mv));
      if (NORM_DOW(mv) > REAL_EPSILON) {
	MSG("Mean-value adjustment by %e\n", NORM_DOW(mv));
      }
      SCAL_DOW(1.0/(REAL)admin->used_count, mv);
      FOR_ALL_DOFS(admin, AXPY_DOW(-1.0, mv, fhd->vec[dof]));
    } else if (fh->stride == DIM_OF_WORLD) {
      /* More work to do. The code below works iff the interpolation
       * operator preserves polynomials and if the constant 1 function
       * belongs to the finite element space.
       */
      DOF_REAL_D_VEC *one_h =
	(DOF_REAL_D_VEC *)get_dof_real_vec_d("one", fhd->fe_space);
      REAL_D weight;
      int i;

      interpol_d(one_d, one_h);
      SET_DOW(0.0, weight);
      SET_DOW(0.0, mv);
      FOR_ALL_DOFS(admin, if (NORM8_DOW(one_h->vec[dof]) > 100*REAL_EPSILON) {
		     AXPY_DOW(1.0, one_h->vec[dof], weight);
		     for (i = 0; i < DIM_OF_WORLD; i++) {
		       mv[i] += one_h->vec[dof][i] * fhd->vec[dof][i];
		     }
		   } else {
		     SET_DOW(0.0, one_h->vec[dof]);
		   });
      if (NORM8_DOW(mv) > REAL_EPSILON) {
	MSG("Mean-value adjustment by "FORMAT_DOW"\n", EXPAND_DOW(mv));
	for (i = 0; i < DIM_OF_WORLD; i++) {
	  mv[i] /= weight[i];
	}
	FOR_ALL_DOFS(admin, if (one_h->vec[dof][0] != 0.0) {
		       AXPY_DOW(-1.0, mv, fhd->vec[dof]);
		     });
      }
      free_dof_real_d_vec(one_h);
    } else {
      ERROR_EXIT("Sorry, mean-value correction "
		 "not implemented for exotic finite element spaces.\n");
    }
  }

  return not_all_neumann;
}

bool boundary_conditions_dow(DOF_MATRIX *matrix,
			     DOF_REAL_VEC_D *fh,
			     DOF_REAL_VEC_D *uh,
			     DOF_SCHAR_VEC *bound,
			     const BNDRY_FLAGS dirichlet_segment,
			     FCT_D_AT_X g,
			     const REAL *(*gn)(const REAL_D x,
					       const REAL_D normal,
					       REAL_D res),
			     REAL alpha_r,
			     const WALL_QUAD *wall_quad)
{
  return _AI_boundary_conditions_dow(matrix, fh, uh, bound,
				     dirichlet_segment,
				     g, gn, 
				     NULL, NULL, NULL, FILL_NOTHING,
				     alpha_r, wall_quad);
}

bool boundary_conditions_loc_dow(DOF_MATRIX *matrix,
				 DOF_REAL_VEC_D *fh,
				 DOF_REAL_VEC_D *uh,
				 DOF_SCHAR_VEC *bound,
				 const BNDRY_FLAGS dirichlet_segment,
				 LOC_FCT_D_AT_QP g_loc,
				 LOC_FCT_D_AT_QP gn_loc,
				 void *fd, FLAGS fill_flag,
				 REAL alpha_r,
				 const WALL_QUAD *wall_quad)
{
  return _AI_boundary_conditions_dow(matrix, fh, uh, bound,
				     dirichlet_segment,
				     NULL, NULL,
				     g_loc, gn_loc, fd, fill_flag,
				     alpha_r, wall_quad);
}


