/*******************************************************************************
 *
 * ALBERTA:  an Adaptive multi Level finite element toolbox  using
 *           Bisectioning refinement and Error control by Residual
 *           Techniques
 *
 * www.alberta-fem.de
 *
 ******************************************************************************
 *
 * File:     quasi-stokes-slip.c
 *
 * Description:  solver for a simple Quasi-Stokes problem:
 *
 *       \mu u - \nu\Delta u + \nabla p = f  in \Omega
 *                        \nabla\cdot u = 0  in \Omega
 *                            u\cdot\nu = g  on \partial \Omega
 *                      P\sigma(u, p) n = 0 on \partial \Omega
 *
 * with \sigma(u, p) = \nu D(u) - I p, D(u) = \nabla u + (\nable u)^t,
 * n is the outer normal to \partial\Omega., P the projection to the
 * tangential space to \partial\Omega
 *
 * To incorporate the stress boundary-conditions it is necessary to
 * use the symmetric gradient in the distributional formulation, the
 * resulting stiffness-matrix is a DIM_OF_WORLD x DIM_OF_WORLD block
 * matrix. The physical meaning of the boundary conditions is that the
 * intrinsic stresses of the fluid are counter-balanced by the
 * force-density F on the boundary.
 *
 * The code below can actually also be used to solve a Quasi-Stokes
 * problem with Dirichlet boundary conditions; there is a
 * corresponding parameter in the init-file.
 *
 ******************************************************************************
 *
 * author(s): Claus-Justus Heine
 *            Institut fuer angewandte Analysis und Numerische Simulation IANS
 *            Lehrstuhl Numerik fuer Hoechstleistungsrechner NMH
 *            Universitaet Stuttgart
 *            Pfaffenwaldring 57
 *            70569 Stuttgart
 *            Germany
 *            Claus-Justus.Heine@IANS.Uni-Stuttgart.DE
 *
 * (c) by C.-J. Heine (2007-2013)
 *
 ******************************************************************************/

#include <alberta/alberta.h>
#include <alberta/albas.h>

#include "alberta-demo.h"

//#define dof_matrix_try_diagonal(M) do { /**/ } while (false)

static int do_graphics = true;

/*******************************************************************************
 * global variables: finite element space, discrete solution
 *                   load vector and system matrix
 *
 * These variables are kept global because they are shared across build(),
 * solve() and estimate().
 ******************************************************************************/

/* Finite element spaces and vectors needed to formulate a quasi-Stokes problem */

static const FE_SPACE *u_fe_space; /* velocity FE-space */
static const FE_SPACE *p_fe_space; /* pressure FE-space */
static DOF_REAL_VEC_D *u_h;        /* discrete velocity */
static DOF_REAL_VEC   *p_h;        /* discrete pressure */

static DOF_REAL_VEC_D *f_h;       /* RHS for velocity */
static DOF_REAL_VEC   *g_h;       /* RHS for pressure (if necessary) */
static DOF_SCHAR_VEC  *bound;     /* boundary vector */
static DOF_MATRIX     *A;         /* system matrix */

static DOF_MATRIX     *B;         /* discrete pressure gradient */
static DOF_MATRIX     *Bt;        /* discrete velocity divergence */
static DOF_MATRIX     *Yproj;     /* projection/precon matrix for B^\ast */
static DOF_MATRIX     *Yprec;     /* projection/precon matrix for B^\ast */

/* addional discrete spaces needed to formulate slip boundary
 * conditions in a weak saddle-point formulation.
 */
static MESH           *slip_mesh;
static const FE_SPACE *slip_space;
static const FE_SPACE *slip_u_space;
static DOF_REAL_VEC   *slip_stress;
static DOF_REAL_VEC   *slip_load;
static DOF_MATRIX     *slip_B;
static DOF_MATRIX     *slip_Bt;
static DOF_MATRIX     *slip_Yproj;
static DOF_MATRIX     *slip_overlap;


/* Quasi-Stokes parameters */
static REAL mu          = 1.0;
static REAL nu          = 1.0;
static REAL alpha_robin = 1.0;

/* Parameters for the exact "solution" */
static REAL_D u_value;
static REAL_D gravity;

/* Bit-mask mapping boundary segments to specific boundary conditions. */
static BNDRY_FLAGS noslip_bndry; /* No-slip boundary. */
static BNDRY_FLAGS slip_bndry;   /* Slip boundary (not yet). */
static BNDRY_FLAGS stress_bndry; /* Stress boundary. */

/* Write FEM data for offline analysis */
static int write_fem_data = false;
static char fem_path[PATH_MAX];

/*******************************************************************************
 * struct ellipt_leaf_data: structure for storing one REAL value on each
 *                          leaf element as LEAF_DATA
 * rw_el_est():  return a pointer to the memory for storing the element
 *               estimate (stored as LEAF_DATA), called by ellipt_est()
 * get_el_est(): return the value of the element estimates (from LEAF_DATA),
 *               called by adapt_method_stat() and graphics()
 ******************************************************************************/

struct ellipt_leaf_data
{
  REAL estimate;             /* one real for the estimate */
};

static REAL *rw_el_est(EL *el)
{
  if (IS_LEAF_EL(el))
    return &((struct ellipt_leaf_data *)LEAF_DATA(el))->estimate;  
  else
    return NULL;
}

static REAL get_el_est(EL *el)
{
  if (IS_LEAF_EL(el))
    return ((struct ellipt_leaf_data *)LEAF_DATA(el))->estimate;
  else
    return 0.0;
}

/*******************************************************************************
 * For test purposes: exact solution and its gradient (optional)
 ******************************************************************************/

/*
 * u(x) = const
 */
static const REAL *u(const REAL_D _x, REAL_D res)
{
  static REAL_D space;  
  
  if (!res) {
    res = space;
  }

  COPY_DOW(u_value, res);
  
  return res;
}

/*
 * [(r^2-x^2*d)*r^(-d-2), -d*x*y*r^(-d-2), -d*x*z*r^(-d-2)]
 * etc.
 */
static const REAL_D *grd_u(const REAL_D _x, REAL_DD res)
{
  static REAL_DD space;

  if (!res) {
    res = space;
  }
  
  MSET_DOW(0.0, res);

  return (const REAL_D *)res;
}

/* Pressure grows linearily in direction of gravity. */
static REAL p(const REAL_D x)
{
  return SCP_DOW(gravity, x);
}

static const REAL *grd_p(const REAL_D x, REAL_D res)
{
  static REAL_D space;

  if (!res) {
    res = space;
  }

  COPY_DOW(gravity, res);

  return res;
}

/*******************************************************************************
 * problem data: right hand side, boundary values
 ******************************************************************************/

/* Dirichlet boundary values */
static const REAL *g(const REAL_D x, REAL_D res)
{
  return u(x, res);
}

/* slip boundary conditions, i.e. the normal component of the "exact"
 * solution at the boundary.
 */
static REAL g_slip(const REAL_D x)
{
  REAL_D tmp, normal;

#if DIM_OF_WORLD == 2
  AXEY_DOW(1.0/NORM_DOW(x), x, normal);
#elif DIM_OF_WORLD == 3
  normal[2] = 0.0;
  REAL r = sqrt(SQR(x[0]) + SQR(x[1]));
  normal[0] = x[0] / r;
  normal[1] = x[1] / r;
#else
# error DIM_OF_WORLD 2 or 3 supported
#endif

  return -SCP_DOW(u(x, tmp), normal);
}

/* \mu u - \nu \Delta u + \nabla p */
static const REAL *f(const REAL_D _x, REAL_D res)
{
  static REAL_D space;
  REAL_D u_val;

  if (!res) {
    res = space;
  }

  /* u is harmonic */
  AXPY_DOW(mu, u(_x, u_val), (REAL *)grd_p(_x, res));

  return res;  
}

/* stress tensor on the boundary, needed for non-zero stress boundary
 * conditions.
 */
static const REAL *g_stress(const REAL_D x,
			    const REAL_D normal,
			    REAL_D res)
{
  static REAL_D space;
  int i;
  REAL_DD Dv;
  REAL    p_val;

  if (!res) {
    res = space;
  }

  grd_u(x, Dv); /* in our example grd_u is already symmetric */
  p_val = p(x);
  MSCAL_DOW(2.0*nu, Dv);
  for (i = 0; i < DIM_OF_WORLD; i++) {
    Dv[i][i] -= p_val;
  }

  SET_DOW(0.0, res);
  MV_DOW((const REAL_D *)Dv, normal, res);

  return res;
}

/*******************************************************************************
 * build(): assemblage of the linear system: matrix, load vector,
 *          boundary values, called by adapt_method_stat()
 *          on the first call initialize u_h, f_h, matrix and information
 *          for assembling the system matrix
 *
 * struct op_info: structure for passing information from init_element() to
 *                 LALt()
 *
 * u_init_element(), p_init_element():
 *                 initialization on the element; calculates the
 *                 coordinates and |det DF_S| used by LALt; passes these
 *                 values to LALt via user_data,
 *                 called on each element by update_matrix()
 *
 * LDDLt():        implementation of Lambda DD Lambda^t for the -Delta v
 *                 term in the stress-tensor formulation
 *
 * LALt():         implementation of Lambda id Lambda^t for -Delta p,
 *                 called by update_matrix() after init_element()
 *
 * B_Lb1():        operator kernel (just Lambda) for \phi\nabla\psi
 *
 * c():            mass matrix for the projection to the pressure space
 *
 ******************************************************************************/

/* Application data. Through this structure the application (this
 * program) passes information through the general assemble interface
 * of ALBERTA down to functions below which define the various
 * operators.
 */
typedef struct app_data
{
  REAL_BD Lambda;      /*  the gradient of the barycentric coordinates */
  REAL    det;         /*  |det D F_S| */
  REAL    LALt_factor; /*  a factor for the 2nd order element matrices */
  REAL    c_factor;    /*  a factor for the 0th order element matrices */
  REAL    wall_det[N_WALLS_MAX];
  REAL_D  outer_normal;
} APP_DATA;

static bool u_init_element(const EL_INFO *el_info,
			   const QUAD *quad[3],
			   void *ud)
{
  APP_DATA *data = (APP_DATA *)ud;

  data->det = el_grd_lambda(el_info, data->Lambda);

  data->LALt_factor = data->det * nu;
  data->c_factor    = data->det * mu;

  /* Return false, i.e. not parametric */
  return false;
}

static bool p_init_element(const EL_INFO *el_info,
			   const QUAD *quad[3],
			   void *ud)
{
  APP_DATA *data = (APP_DATA *)ud;

  data->det = el_grd_lambda(el_info, data->Lambda);

  data->LALt_factor = data->det;
  data->c_factor    = data->det;

  return 0;
}

static bool dg_wall_init_element(const EL_INFO *el_info, int wall,
				 const WALL_QUAD *quad[3], void *ud)
{
  APP_DATA *info = (APP_DATA *)ud;

  info->wall_det[wall] = 1e3;

  info->c_factor = info->wall_det[wall];

  return false;
}

static bool fv_wall_init_element(const EL_INFO *el_info, int wall,
				 const WALL_QUAD *quad[3], void *ud)
{
  APP_DATA *info = (APP_DATA *)ud;
  REAL det = get_wall_normal(el_info, wall, NULL);
    /* Use a very simplistic finite-volume method */
#define VAL (1.0/(REAL)N_LAMBDA_MAX)
  const REAL_B c_b = INIT_BARY_MAX(VAL, VAL, VAL, VAL);
#undef VAL
  EL_INFO neigh_info[1];
  const EL_GEOM_CACHE *elgc =
    fill_el_geom_cache(el_info, FILL_EL_WALL_REL_ORIENTATION(wall));
  REAL_D c, cn;
  REAL delta;

  fill_neigh_el_info(neigh_info, el_info, wall, elgc->rel_orientation[wall]);
  
  coord_to_world(el_info, c_b, c);
  coord_to_world(neigh_info, c_b, cn);
  delta = DIST_DOW(c, cn);

  info->c_factor = info->wall_det[wall] = det / delta;
  
  return false;
}

static bool dg_fv_neigh_init_element(const EL_INFO *el_info, int wall,
				     const WALL_QUAD *quad[3], void *ud)
{
  APP_DATA *info = (APP_DATA *)ud;
  
  info->c_factor = -info->wall_det[wall];

  return false;
}

static bool slip_proj_init_element(const EL_INFO *el_info,
				   const QUAD *quad[3],
				   void *ud)
{
  APP_DATA *data = (APP_DATA *)ud;

  data->c_factor = el_det(el_info);

  return false;
}

static bool slip_Bt_init_element(const EL_INFO *el_info,
				 const QUAD *quad[3],
				 void *ud)
{
  APP_DATA *data = (APP_DATA *)ud;
  EL_INFO mst_info;

  fill_master_el_info(&mst_info, el_info, FILL_COORDS);
  
  /* Compute the wall-normal of our master element, for the correct wall */
  data->det = get_wall_normal(
    &mst_info, el_info->master.opp_vertex, data->outer_normal);

  return false;
}

static const REAL_B *LALt(const EL_INFO *el_info,
			  const QUAD *quad, int iq, void *ud)
{
  APP_DATA *data = (APP_DATA *)ud;
  int         i, j, dim = el_info->mesh->dim;
  static REAL_BB LALt;

  for (i = 0; i <= dim; i++) {
    for (j = i; j <= dim; j++) {
      LALt[j][i] = LALt[i][j] =
	data->LALt_factor*SCP_DOW(data->Lambda[i], data->Lambda[j]);
    }
  }
  
  return (const REAL_B *)LALt;
}

/* Deformation tensor. This is 1/2 D(\phi^l_k):D(\phi^n_m) transformed
 * to the reference element, where the components of the vector-valued
 * test functions are given by (\phi^l_k)_j = \delta_{kj}\phi^l for an
 * "ordinary" scalar basis function.
 *
 * We have to assemble the block-matrices
 * ${{\cal B}^{\alpha\beta}}\in\R^{d\times d}$:
 * 
 * ({{\cal B}^{\alpha\beta}})_{km}
 * =
 * \delta_{km}\,\Lambda^{\alpha r}\,\Lambda^{\beta r}
 * +
 * \Lambda^{\alpha m}\,\Lambda^{\beta k}.
 */
#if 0
static const REAL_BDD *LDDLt(const EL_INFO *el_info, const QUAD *quad, 
			     int iq, void *ud)
{
  static REAL_BBDD LDDLt;
  APP_DATA *info = (APP_DATA *)ud;
  int m, n, i, j, dim = el_info->mesh->dim;
  REAL factor = info->LALt_factor;

  for (m = 0; m < DIM_OF_WORLD; m++)
    for (n = 0; n < DIM_OF_WORLD; n++)
      for (i = 0; i <= dim; i++)
	for (j = 0; j <= dim; j++) {
	  LDDLt[i][j][m][n] = 0.0;

	  if(m == n) {
	    LDDLt[i][j][m][m] += SCP_DOW(info->Lambda[i], info->Lambda[j]);
	  }

	  LDDLt[i][j][m][n] += info->Lambda[i][n] * info->Lambda[j][m];
	  LDDLt[i][j][m][n] *= factor;
	}
  return (const REAL_BDD *)LDDLt;
}
#else
static const REAL_BDD *LDDLt(const EL_INFO *el_info,
			     const QUAD *quad, int iq, void *ud)
{
  static REAL_BBDD LDDLt;
  APP_DATA *info = (APP_DATA *)ud;
  REAL value;
  int alpha, beta, k, m;
  int dim = el_info->mesh->dim;
  REAL factor = info->LALt_factor;

  for (alpha = 0; alpha < N_VERTICES(dim); alpha++) {
    /* The first part is just LLt reordered such that it matches the
     * block-matrix conventions
     */
    MSET_DOW(0.0, LDDLt[alpha][alpha]);
    value = factor*SCP_DOW(info->Lambda[alpha], info->Lambda[alpha]);
    MSCMAXPY_DOW(1.0, value, LDDLt[alpha][alpha]);
    for (beta = alpha+1; beta < N_VERTICES(dim); beta++) {
      MSET_DOW(0.0, LDDLt[alpha][beta]);
      MSET_DOW(0.0, LDDLt[beta][alpha]);
      value = factor*SCP_DOW(info->Lambda[alpha], info->Lambda[beta]);
      MSCMAXPY_DOW(1.0, value, LDDLt[alpha][beta]);
      MSCMAXPY_DOW(1.0, value, LDDLt[beta][alpha]);
    }

    /* The second part is symmtric w.r.t. to the exchange of index
     * pairs. We do loop unrolling here to reduce the number of loads
     * required to store stuff into the 4 dimensional array.
     */
    for (m = 0; m < DIM_OF_WORLD; m++) {
      /* (alpha, m, alpha, m) */
      value = factor*SQR(info->Lambda[alpha][m]);
      LDDLt[alpha][alpha][m][m] += value;
      for (k = m+1; k < DIM_OF_WORLD; k++) {
	/* (alpha, m, alpha, k)
	 * (alpha, k, alpha, m)
	 */
	value = factor*info->Lambda[alpha][m]*info->Lambda[alpha][k];
	LDDLt[alpha][alpha][m][k] += value;
	LDDLt[alpha][alpha][k][m] += value;
      }
      for (beta = alpha+1; beta < N_VERTICES(dim); beta++) {
	/* (alpha, m, beta, m)
	 * (beta, m, alpha, m)
	 */
	value = factor*info->Lambda[alpha][m]*info->Lambda[beta][m];
	LDDLt[alpha][beta][m][m] += value;
	LDDLt[beta][alpha][m][m] += value;
	for (k = m+1; k < DIM_OF_WORLD; k++) {
	  /* (alpha, m, beta, k)
	   * (beta, k, alpha, m)
	   */
	  value = factor*info->Lambda[alpha][m]*info->Lambda[beta][k];
	  LDDLt[alpha][beta][k][m] += value;
	  LDDLt[beta][alpha][m][k] += value;
	  value = factor*info->Lambda[alpha][k]*info->Lambda[beta][m];
	  LDDLt[alpha][beta][m][k] += value;
	  LDDLt[beta][alpha][k][m] += value;
	}
      }
    }
  }
  return (const REAL_BDD *)LDDLt;
}
#endif

/* The first order term for the divergence constraint */
const REAL_D *B_Lb1(const EL_INFO *el_info, const QUAD *quad, int iq, void *ud)
{
  APP_DATA *info = (APP_DATA *)ud;
  static REAL_BD B_Lb1;
  int i;
  
  for (i = 0; i < N_VERTICES(el_info->mesh->dim); i++) {
    AXEY_DOW(-info->det, info->Lambda[i], B_Lb1[i]);
  }

  return (const REAL_D *)B_Lb1;
}

static REAL c(const EL_INFO *el_info, const QUAD *quad, int iq, void *ud)
{
  APP_DATA *info = (APP_DATA *)ud;

  return info->c_factor;
}

static REAL slip_overlap_c(const EL_INFO *el_info,
			   const QUAD *quad, int iq, void *ud)
{
  APP_DATA *info = (APP_DATA *)ud;

  (void)info;
  
  return info->c_factor;
}

static const REAL *slip_c(const EL_INFO *el_info,
			  const QUAD *quad, int iq, void *ud)
{
  static REAL_D result;
  APP_DATA *data = (APP_DATA *)ud;

  AXEY_DOW(-data->det, data->outer_normal, result);
    
  return result;
}

static void build(MESH *mesh, U_CHAR flag)
{
  FUNCNAME("build");
  static const EL_MATRIX_INFO *matrix_info;
  static const EL_MATRIX_INFO *Yproj_minfo;
  static const EL_MATRIX_INFO *Yprec_minfo;
  static const EL_MATRIX_INFO *slip_Yproj_minfo;
  static EL_MATRIX_INFO       B_minfo;
  static EL_MATRIX_INFO       slip_Bt_minfo;
  static EL_MATRIX_INFO       slip_overlap_minfo;
  static APP_DATA             app_udata;

  const QUAD *quad;
  REAL flux;

  dof_compress(mesh);
  MSG("%d DOFs for %s\n", dof_real_vec_d_length(u_fe_space), u_fe_space->name);
  MSG("%d DOFs for %s\n", p_fe_space->admin->size_used, p_fe_space->name);
  if (slip_space) {
    MSG("%d DOFs for %s\n", slip_space->admin->size_used, slip_space->name);
  }

  if (!matrix_info) { /* information for matrix assembling */
    OPERATOR_INFO o_info      = { NULL, };
    OPERATOR_INFO B_oinfo     = { NULL, };
    OPERATOR_INFO Yproj_oinfo = { NULL, };
    OPERATOR_INFO Yprec_oinfo = { NULL, };
    bool p_disc;

    o_info.row_fe_space   = o_info.col_fe_space = u_fe_space;
    o_info.init_element   = u_init_element;
    o_info.user_data      = &app_udata;
    o_info.LALt.real_dd   = LDDLt;
    o_info.LALt_type      = MATENT_REAL_DD;
    o_info.LALt_pw_const  = true; /* pw const. assemblage is faster */
    o_info.LALt_symmetric = false /*true*/; /* symmetric assemblage is faster */
    o_info.c.real         = c;
    o_info.c_type         = MATENT_REAL;
    o_info.c_pw_const     = true;
    BNDRY_FLAGS_CPY(o_info.dirichlet_bndry,
		    noslip_bndry); /* Dirichlet bc on part of the bndry? */
    o_info.fill_flag      = CALL_LEAF_EL|FILL_COORDS;
    matrix_info = fill_matrix_info(&o_info, NULL);

    /* Operator-info for divergence constraint, only the B operator,
     * B^\ast will be generated by transposition of B and projection
     * to the pressure space.
     */
    B_oinfo.row_fe_space = u_fe_space;
    B_oinfo.col_fe_space = p_fe_space;
    B_oinfo.init_element = p_init_element;
    B_oinfo.user_data    = o_info.user_data;
    B_oinfo.Lb1.real_d   = B_Lb1;
    B_oinfo.Lb_type      = MATENT_REAL_D;
    B_oinfo.Lb1_pw_const = true;
    B_oinfo.fill_flag    = CALL_LEAF_EL|FILL_COORDS;
    fill_matrix_info(&B_oinfo, &B_minfo);

    /* Projection to the pressure space: B^\ast = Pr_Y \circ B^{tr} */
    Yproj_oinfo.row_fe_space = Yproj_oinfo.col_fe_space = p_fe_space;
    Yproj_oinfo.init_element = p_init_element;
    Yproj_oinfo.user_data    = o_info.user_data;
    Yproj_oinfo.c.real       = c;
    Yproj_oinfo.c_pw_const   = true;
    Yproj_oinfo.fill_flag    = CALL_LEAF_EL|FILL_COORDS;
    Yproj_minfo              = fill_matrix_info(&Yproj_oinfo, NULL);

    /* (Part of) the preconditioner for the Schur-Complement operator;
     * the Poissoin-part of the pre-conditioner corresponds to the
     * mass-part of the Quasi-Stokes operator.
     */
    Yprec_oinfo.row_fe_space   = Yprec_oinfo.col_fe_space = p_fe_space;
    Yprec_oinfo.init_element   = p_init_element;
    Yprec_oinfo.user_data      = o_info.user_data;
    Yprec_oinfo.LALt.real      = LALt;
    Yprec_oinfo.LALt_symmetric = true;
    Yprec_oinfo.LALt_pw_const  = true;
    Yprec_oinfo.fill_flag      = CALL_LEAF_EL|FILL_COORDS;

    p_disc =
      p_fe_space->bas_fcts->n_dof[CENTER] == p_fe_space->bas_fcts->n_bas_fcts;
    if (!p_disc) {
      Yprec_minfo = fill_matrix_info(&Yprec_oinfo, NULL);
    } else {
      /* Discontinuous pressure, use a finite volume (degree == 0) or
       * DG method (degree > 0) to solve the Poisson problem.
       */
      BNDRY_OPERATOR_INFO el_bop_info = { NULL, };
      BNDRY_OPERATOR_INFO neigh_bop_info = { NULL, };
      bool do_fv = p_fe_space->bas_fcts->degree == 0;

      /* ALBERTA requires that the boundary contributions are split
       * into one part which is assembled using only the current's
       * element local basis functions, and a second part which pairs
       * the given element with its neighbour. In our case both
       * contributions are simple mass-matrices
       */
      el_bop_info.row_fe_space = p_fe_space;
      el_bop_info.init_element =
	do_fv ? fv_wall_init_element : dg_wall_init_element;
      el_bop_info.c.real       = c;
      el_bop_info.c_pw_const   = true;
      el_bop_info.user_data    = o_info.user_data;
      BNDRY_FLAGS_INIT(el_bop_info.bndry_type); /* all interior edges */
    
      el_bop_info.fill_flag = CALL_LEAF_EL|FILL_COORDS|FILL_OPP_COORDS;

      /* The contribution of the pairing with the neighbouring basis
       * functions is almost the same:
       */
      neigh_bop_info = el_bop_info;
      neigh_bop_info.init_element = dg_fv_neigh_init_element;
      neigh_bop_info.discontinuous = true;

      Yprec_minfo = fill_matrix_info_ext(
	NULL, do_fv ? NULL : &Yprec_oinfo, &el_bop_info, &neigh_bop_info, NULL);
    }

    /* Additional stuff for the slip b.c., formulated weakly s a
     * saddle-point problem to cope with curved boundaries.
     */
    if (!BNDRY_FLAGS_IS_INTERIOR(slip_bndry)) {
      OPERATOR_INFO slip_Yproj_oinfo   = { NULL, };
      OPERATOR_INFO slip_Bt_oinfo      = { NULL, };
      OPERATOR_INFO slip_overlap_oinfo = { NULL, };
      const FE_SPACE *slip_p_space;

      slip_stress = get_dof_real_vec("slip stress", slip_space);
      slip_load   = get_dof_real_vec("slip load", slip_space);

      set_refine_inter(slip_stress);
      set_coarse_inter(slip_stress);
      dof_set(0.0, slip_stress);

      slip_Yproj   = get_dof_matrix("slip Yproj", slip_space, slip_space);
      dof_matrix_try_diagonal(slip_Yproj);
      slip_B       = get_dof_matrix("slip B", u_fe_space, slip_space);
      slip_Bt      = get_dof_matrix("slip Bt", slip_space, u_fe_space);
      slip_overlap = get_dof_matrix("slip overlap", slip_space, p_fe_space);
      dof_matrix_try_diagonal(slip_overlap);

      slip_u_space = get_fe_space(
	slip_mesh, "velocity trace space",
	u_fe_space->bas_fcts->trace_bas_fcts, DIM_OF_WORLD, ADM_FLAGS_DFLT);

      slip_Yproj_oinfo.row_fe_space = slip_space;
      slip_Yproj_oinfo.init_element = slip_proj_init_element;
      slip_Yproj_oinfo.user_data    = o_info.user_data;
      slip_Yproj_oinfo.c.real       = c;
      slip_Yproj_oinfo.c_pw_const   = true;
      slip_Yproj_oinfo.fill_flag    = CALL_LEAF_EL|FILL_COORDS;
    
      slip_Yproj_minfo = fill_matrix_info(&slip_Yproj_oinfo, NULL);

      slip_Bt_oinfo.row_fe_space = slip_space;
      slip_Bt_oinfo.col_fe_space = slip_u_space;
      slip_Bt_oinfo.init_element = slip_Bt_init_element;
      slip_Bt_oinfo.user_data    = o_info.user_data;
      slip_Bt_oinfo.c.real_d     = slip_c;
      slip_Bt_oinfo.c_type       = MATENT_REAL_D;
      slip_Bt_oinfo.c_pw_const   = true;
      slip_Bt_oinfo.fill_flag    = CALL_LEAF_EL|FILL_COORDS|FILL_MASTER_INFO;
    
      fill_matrix_info(&slip_Bt_oinfo, &slip_Bt_minfo);

      slip_p_space = get_fe_space(
	slip_mesh, "pressure trace space",
	p_fe_space->bas_fcts->trace_bas_fcts, 1, ADM_FLAGS_DFLT);

      slip_overlap_oinfo.row_fe_space = slip_space;
      slip_overlap_oinfo.col_fe_space = slip_p_space;
      slip_overlap_oinfo.init_element = slip_proj_init_element;
      slip_overlap_oinfo.user_data    = o_info.user_data;
      slip_overlap_oinfo.c.real       = slip_overlap_c;
      slip_overlap_oinfo.c_pw_const   = true;
      slip_overlap_oinfo.fill_flag    =
	CALL_LEAF_EL|FILL_COORDS|FILL_MASTER_INFO;
    
      fill_matrix_info(&slip_overlap_oinfo, &slip_overlap_minfo);
      slip_overlap_minfo.factor = 1.0;

      free_fe_space(slip_p_space);
    }
  }

  /* assembling of matrix */
  clear_dof_matrix(A);
  update_matrix(A, matrix_info, NoTranspose);

  /* assembling of load vector */
  dof_set_dow(0.0, f_h);
  quad = get_quadrature(mesh->dim, 2*u_fe_space->bas_fcts->degree - 2);
  L2scp_fct_bas_dow(f, quad, f_h);

  /* boundary values, we have to fill in the "bound" vector for
   * sp_dirichlet_bound_sd() below, and add a boundary integral for
   * inhomogeneous stress boundary conditions.
   *
   * For a pure Stokes problem (mu == 0.0) we also request an
   * automatic mean-value correction of the right-hand side; this is
   * triggered by "bndry_type == NEUMANN && robin_alpha < 0.0".
   */
  if (!BNDRY_FLAGS_IS_INTERIOR(noslip_bndry)) {
    boundary_conditions_dow(NULL /* matrix */, f_h, u_h, bound,
                            noslip_bndry,
                            g, NULL,
                            mu == 0.0 ? -1.0 : 0.0 /* robin_alpha */,
                            NULL);
  } else {
    /* Note: calling boundary_conditions_dow() with empty Dirichlet
     * boundary would also work, but require a mesh-traversal.
     */
    FOREACH_DOF(u_fe_space,
		bound->vec[dof] = INTERIOR,
		bound = CHAIN_NEXT(bound, DOF_SCHAR_VEC));
  }

  /* If we have (inhomogeneous) stress boundary conditions, then we
   * need to assemble a right-hand-side for this.
   */
  if (!BNDRY_FLAGS_IS_INTERIOR(stress_bndry)) {
    bndry_L2scp_fct_bas_dow(f_h, g_stress, stress_bndry, NULL /* quad */);
  }

  /* Now go for the divergence constraint */

  /* First for B */
  clear_dof_matrix(B);
  BNDRY_FLAGS_CPY(B_minfo.dirichlet_bndry, noslip_bndry);
  update_matrix(B, &B_minfo, NoTranspose);

  /* Then for Bt. Ideally, one would loop just once over the mesh
   * and assemble both matrices together.
   */
  clear_dof_matrix(Bt);
  BNDRY_FLAGS_INIT(B_minfo.dirichlet_bndry);
  update_matrix(Bt, &B_minfo, Transpose);

  /* Finally the projection/preconditioner for the pressure space */

  /* Assemble the projection; at the same time the part of the
   * preconditioner "responsible" for the 2nd-order part of the
   * Quasi-Stokes operator.
   */
  clear_dof_matrix(Yproj);
  update_matrix(Yproj, Yproj_minfo, NoTranspose);

  /* Assemble the part of the preconditiner "responsible" for the
   * 0th-order part of the Quasi-Stokes operator. We need Robin
   * boundary conditions because of the Neumann-style boundary
   * conditions in the velocity space.
   */
  clear_dof_matrix(Yprec);
  update_matrix(Yprec, Yprec_minfo, NoTranspose);

  if (!BNDRY_FLAGS_IS_INTERIOR(stress_bndry)) {
    robin_bound(Yprec, stress_bndry, alpha_robin, NULL /* bndry_quad */, 1.0);
  }

  /* Assemble the additional "stuff" for the saddle-point formulation
   * of the slip b.c.
   */
  flux = 0.0;
  if (!BNDRY_FLAGS_IS_INTERIOR(slip_bndry)) {
    /* slip constraint: */
    dof_set(0.0, slip_load);
    L2scp_fct_bas(g_slip, NULL, slip_load);

    FOR_ALL_DOFS(slip_load->fe_space->admin, {
	flux += slip_load->vec[dof];
      });
    MSG("Slip Flux: %e\n", flux);

    clear_dof_matrix(slip_Yproj);
    update_matrix(slip_Yproj, slip_Yproj_minfo, NoTranspose);

    clear_dof_matrix(slip_B);
    BNDRY_FLAGS_CPY(slip_Bt_minfo.dirichlet_bndry, noslip_bndry);
    update_master_matrix(slip_B, &slip_Bt_minfo, Transpose);

    clear_dof_matrix(slip_Bt);
    BNDRY_FLAGS_INIT(slip_Bt_minfo.dirichlet_bndry);
    update_master_matrix(slip_Bt, &slip_Bt_minfo, NoTranspose);

    clear_dof_matrix(slip_overlap);
    update_master_matrix(slip_overlap, &slip_overlap_minfo, NoTranspose);
  }

  /* In order to have compatible boundary conditions on the discrete
   * level we have to make sure that either the boundary integral over
   * the boundary values vanishes (discretely), or we have to perturb
   * the RHS for the pressure, i.e. solve a (slightly) inhomogeneous
   * saddle-point problem. This is what we are doing here because it
   * is conceptual simpler.
   */
  dof_set(0.0, g_h);
  bool do_adjust = BNDRY_FLAGS_IS_INTERIOR(stress_bndry);
  flux = sp_flux_adjust_dow_scl(NoTranspose, Bt, bound, u_h, g_h, flux, do_adjust);
  MSG("Total flux-excess: %e\n", flux);

  /* That's it */
}

/*******************************************************************************
 * solve(): solve the linear system, called by adapt_method_stat()
 *
 * This is slightly more involved than solving the quasi-Stokes
 * problem as we have to incorporate the additional slip-constraint.
 *
 ******************************************************************************/
static void solve(MESH *mesh)
{
  FUNCNAME("solve");
  static REAL       tol = 1.e-8, tol_incr = 1e2;
  static int        miter = 1000, info = 2, restart = 0;
  static OEM_SOLVER solver = NoSolver;
  static OEM_SOLVER A_solver = NoSolver;
  static OEM_SOLVER Yproj_solver = NoSolver;
  static OEM_SOLVER Yprec_solver = NoSolver;
  static OEM_SOLVER slip_Yproj_solver = NoSolver;
  static int        A_miter, A_restart;
  static int        Yproj_miter, Yprec_miter, slip_Yproj_miter;
  const PRECON *A_prec, *Yproj_prec, *Yprec_prec, *slip_Yproj_prec;
  static PRECON_TYPE A_prec_type = {
    BlkDiagPrecon,
  };
  static PRECON_TYPE Yproj_prec_type = {
    DiagPrecon,
  };
  static PRECON_TYPE Yprec_prec_type = {
    DiagPrecon,
  };
  static PRECON_TYPE slip_Yproj_prec_type = {
    DiagPrecon,
  };
  SP_CONSTRAINT *div_constraint;
  SP_CONSTRAINT *slip_constraint = NULL;
  OEM_DATA      *A_oem;
  REAL sub_tol;
  int sub_info;

#if 0
  /* debugging, if wanted */
  file_print_dof_matrix_maple("matA", "w", A, A->name);
  file_print_dof_matrix_maple("matB", "w", B, B->name);
  file_print_dof_matrix_maple("matBt", "w", Bt, Bt->name);
  file_print_dof_matrix_maple("matYproj", "w", Yproj, "blah");
  file_print_dof_matrix_maple("matYprec", "w", Yprec, "blah");
  file_print_dof_matrix_maple("matslipB", "w", slip_B, slip_B->name);
  file_print_dof_matrix_maple("matslipBt", "w", slip_Bt, slip_Bt->name);
  file_print_dof_matrix_maple("matslipYproj", "w", slip_Yproj, "blah");
  file_print_dof_matrix_maple("matslipoverlap", "w", slip_overlap, "blah");
#endif

  if (solver == NoSolver) {
    struct __precon_type *first = &A_prec_type.param.BlkDiag.precon[0];
    int i;

    GET_PARAMETER(1, "sp->solver", "%d", &solver);
    GET_PARAMETER(1, "sp->solver tolerance", "%f", &tol);
    GET_PARAMETER(1, "sp->solver tol incr", "%f", &tol_incr);
    GET_PARAMETER(1, "sp->solver max iteration", "%d", &miter);
    GET_PARAMETER(1, "sp->solver info", "%d", &info);
    if (solver == GMRes) {
      GET_PARAMETER(1, "sp->solver restart", "%d", &restart);
    }

    GET_PARAMETER(1, "sp->Auf solver", "%d", &A_solver);
    GET_PARAMETER(1, "sp->Auf max iteration", "%d", &A_miter);
    GET_PARAMETER(1, "sp->Auf precon", "%d", &first->type);
    for (i = 1; i < N_BLOCK_PRECON_MAX; ++i) {
      A_prec_type.param.BlkDiag.precon[i].type = DiagPrecon;
    }

    if (first->type == __SSORPrecon) {
      GET_PARAMETER(1, "sp->Auf precon ssor omega", "%f",
                    &first->param.__SSOR.omega);
      GET_PARAMETER(1, "sp->Auf precon ssor iter", "%d",
                    &first->param.__SSOR.n_iter);
    }
    if (first->type == ILUkPrecon) {
      GET_PARAMETER(1, "sp->Auf precon ilu(k)", "%d",
                    &first->param.ILUk.level);
    }

    if (A_solver == GMRes) {
      GET_PARAMETER(1, "sp->Auf restart", "%d", &A_restart);
    }

    GET_PARAMETER(1, "sp->Yproj solver", "%d", &Yproj_solver);
    GET_PARAMETER(1, "sp->Yproj max iteration", "%d", &Yproj_miter);
    GET_PARAMETER(1, "sp->Yproj precon", "%d", &Yproj_prec_type.type);
    if (Yproj_prec_type.type == __SSORPrecon) {
      GET_PARAMETER(1, "sp->Yproj precon ssor omega", "%f",
                    &Yproj_prec_type.param.__SSOR.omega);
      GET_PARAMETER(1, "sp->Yproj precon ssor iter", "%d",
                    &Yproj_prec_type.param.__SSOR.n_iter);
    }
    if (Yproj_prec_type.type == ILUkPrecon)
      GET_PARAMETER(1, "sp->Yproj precon ilu(k)", "%d",
                    &Yproj_prec_type.param.ILUk.level);

    GET_PARAMETER(1, "sp->Yprec solver", "%d", &Yprec_solver);
    GET_PARAMETER(1, "sp->Yprec max iteration", "%d", &Yprec_miter);
    GET_PARAMETER(1, "sp->Yprec precon", "%d", &Yprec_prec_type.type);
    if (Yprec_prec_type.type == __SSORPrecon) {
      GET_PARAMETER(1, "sp->Yprec precon ssor omega", "%f",
                    &Yprec_prec_type.param.__SSOR.omega);
      GET_PARAMETER(1, "sp->Yprec precon ssor iter", "%d",
                    &Yprec_prec_type.param.__SSOR.n_iter);
    }
    if (Yprec_prec_type.type == ILUkPrecon)
      GET_PARAMETER(1, "sp->Yprec precon ilu(k)", "%d",
                    &Yprec_prec_type.param.ILUk.level);

    GET_PARAMETER(1, "sp->slip->Yproj solver", "%d", &slip_Yproj_solver);
    GET_PARAMETER(1, "sp->slip->Yproj max iteration", "%d",
                  &slip_Yproj_miter);
    GET_PARAMETER(1, "sp->slip->Yproj precon", "%d",
                  &slip_Yproj_prec_type.type);
    if (slip_Yproj_prec_type.type == __SSORPrecon) {
      GET_PARAMETER(1, "sp->slip->Yproj precon ssor omega", "%f",
                    &slip_Yproj_prec_type.param.__SSOR.omega);
      GET_PARAMETER(1, "sp->slip->Yproj precon ssor iter", "%d",
                    &slip_Yproj_prec_type.param.__SSOR.n_iter);
    }
    if (slip_Yproj_prec_type.type == ILUkPrecon)
      GET_PARAMETER(1, "sp->slip->Yproj precon ilu(k)", "%d",
                    &slip_Yproj_prec_type.param.ILUk.level);
  }

  sub_tol = tol / tol_incr;
  sub_info = MAX(0, info - 3);

  A_prec = init_precon_from_type(A, bound, MAX(0, info-3), &A_prec_type);
  A_oem  = init_oem_solve(A, NULL, sub_tol, A_prec, -1, A_miter, sub_info);

  Yproj_prec = init_precon_from_type(Yproj, NULL /* bound */, MAX(0, info-3),
                                     &Yproj_prec_type);
  Yprec_prec = init_precon_from_type(Yprec, NULL /* bound */, MAX(0, info-3),
                                     &Yprec_prec_type);

  div_constraint =
    init_sp_constraint(B, Bt, NULL, sub_tol, sub_info,
                       Yproj, Yproj_solver, Yproj_miter, Yproj_prec,
                       mu > 0.0 ? Yprec : NULL,
                       Yprec_solver, Yprec_miter, Yprec_prec,
                       nu, mu);

  if (!BNDRY_FLAGS_IS_INTERIOR(slip_bndry)) {
    slip_Yproj_prec = init_precon_from_type(
      slip_Yproj, NULL /* bound */, sub_info, &slip_Yproj_prec_type);
    slip_constraint = 
      init_sp_constraint(slip_B, slip_Bt, NULL, sub_tol, sub_info,
                         slip_Yproj, slip_Yproj_solver,
                         slip_Yproj_miter, slip_Yproj_prec,
                         NULL, NoSolver, -1, NULL,
                         nu*mu, -mu);
  }

  oem_sp_schur_solve(solver, tol, miter, info,
                     get_oem_solver(A_solver), A_oem,
                     f_h, u_h,
                     div_constraint, g_h, p_h,
                     BNDRY_FLAGS_IS_INTERIOR(slip_bndry)
                     ? NULL : slip_constraint,
                     slip_load,  slip_stress,
                     slip_overlap, NULL);

  if (!BNDRY_FLAGS_IS_INTERIOR(slip_bndry)) {
    release_sp_constraint(slip_constraint);
  }
  release_sp_constraint(div_constraint);
  release_oem_solve(A_oem);
}

/*******************************************************************************
 * Functions for error estimate:
 *
 * estimate(): compute a residual error estimate and the exact error
 * (the latter for testing purposes). The estimate is performed for
 * the velocity only, the pressure enters as lower-order term on the
 * RHS.
 *
 * r(): calculates the lower order terms of the element residual on
 * each element at the quadrature node iq of quad argument to
 * ellipt_est() and called by ellipt_est()
 *
 * stress_res(): residual of the stress boundary conditions.
 ******************************************************************************/

/* Lower order terms: right-hand side, the 0th order term, the
 * gradient of the discrete pressure.
 */
static const REAL *r(REAL_D fx,
		     const EL_INFO *el_info,
		     const QUAD *quad,
		     int iq,
		     const REAL_D uh_at_qp, const REAL_DD grd_uh_at_qp)
{
  static REAL_D space;
  static const QUAD_FAST *qfast;
  static EL *el;
  static EL_REAL_VEC *ph_loc;
  static const EL_GEOM_CACHE *elgc;
  static const QUAD_EL_CACHE *qelc;
  REAL_D grd_ph;

  if (!fx) {
    fx = space;
  }

  /* pressure stuff */
  if (!qfast ||
      qfast->bas_fcts != p_fe_space->bas_fcts || qfast->quad != quad) {
    /* Aquire a QUAD_FAST structure for the evaluation of the gradient
     * of the discrete pressure.
     */
    qfast = get_quad_fast(p_fe_space->bas_fcts, quad, INIT_GRD_PHI);

    if (ph_loc) {
      free_el_real_vec(ph_loc);
    }
    ph_loc = get_el_real_vec(p_fe_space->bas_fcts);
  }

  if (el != el_info->el) {
    el = el_info->el;
    fill_el_real_vec(ph_loc, el, p_h);
    if (!(el_info->fill_flag & FILL_COORDS)) {
      qelc = fill_quad_el_cache(el_info, quad,
				FILL_EL_QUAD_WORLD|FILL_EL_QUAD_LAMBDA);
    } else {
      elgc = fill_el_geom_cache(el_info, FILL_EL_LAMBDA);
      qelc = fill_quad_el_cache(el_info, quad, FILL_EL_QUAD_WORLD);
    }
  }

  f(qelc->world[iq], fx);
  SCAL_DOW(-1.0, fx);

  /* 0-th order term */
  AXPY_DOW(mu, uh_at_qp, fx);

  if (!(el_info->fill_flag & FILL_COORDS)) {
    eval_grd_uh_fast(grd_ph, 
		     (const REAL_D *)qelc->param.Lambda[iq], ph_loc, qfast, iq);
  } else {
    eval_grd_uh_fast(grd_ph,
		     (const REAL_D *)elgc->Lambda, ph_loc, qfast, iq);
  }

  AXPY_DOW(1.0, grd_ph, fx);
  
  return (const REAL *)fx;
}

/* Compute the residual for the stress boundary conditions.
 * 
 * We need to compute (\nu D(u) - p I) n - g_{stress}.
 */
static const REAL *stress_res(REAL_D result,
			      const EL_INFO *el_info,
			      const QUAD *quad, int qp,
			      const REAL_D uh_qp,
			      const REAL_D normal)
{
  static REAL_D space;
  static const QUAD_FAST *qfast;
  static EL *el;
  static int subsplx = -1;
  static EL_REAL_VEC *ph_loc;
  static const EL_REAL_VEC *slip_stress_loc;
  static EL_INFO slip_el_info;
  REAL_D x;
  REAL p_val, slip_stress_val;
  REAL_B slip_qp;
  static bool do_slip = false;

  if (!result) {
    result = space;
  }

  /* pressure stuff */
  if (!qfast || qfast->quad != quad ||
      qfast->bas_fcts != p_fe_space->bas_fcts) {
    /* Aquire a QUAD_FAST structure for the evaluation of the gradient
     * of the discrete pressure.
     */
    qfast = get_quad_fast(p_fe_space->bas_fcts, quad, INIT_PHI);
    if (ph_loc) {
      free_el_real_vec(ph_loc);
    }
    ph_loc = get_el_real_vec(p_fe_space->bas_fcts);
  }

  if (el != el_info->el || subsplx != quad->subsplx) {
    /* We are either on a slip or a stress boundary here and assume
     * that each mesh element has at most one boundary facet.
     */
    do_slip = BNDRY_FLAGS_IS_AT_BNDRY(slip_bndry, wall_bound(el_info, quad->subsplx));

    el = el_info->el;
    subsplx = quad->subsplx;

    fill_el_real_vec(ph_loc, el, p_h);
    INIT_ELEMENT(el_info, qfast);

    if (do_slip) {
      fill_slave_el_info(&slip_el_info, el_info, quad->subsplx, slip_mesh);
      slip_stress_loc = fill_el_real_vec(NULL, slip_el_info.el, slip_stress);
    }
  }

  coord_to_world(el_info, quad->lambda[qp], x);

  if (do_slip) {
    /* quad->lambda lives on the bulk mesh, we need the corresponding
     * value for the trace mesh.
     */
    bulk_to_trace_coords(slip_qp, quad->lambda[qp], &slip_el_info);
    slip_stress_val = eval_uh(slip_qp, slip_stress_loc, slip_space->bas_fcts);

    AXEY_DOW(slip_stress_val, normal, result);
  } else {
    g_stress(x, normal, result);
  }

  p_val = eval_uh_fast(ph_loc, qfast, qp);
  AXPY_DOW(p_val, normal, result); /* "+" is correct here, the
				    * estimator only computes
				    * (A\nabla u_h + (A\nabla u_h)^t)
				    */

  return result;
}

#define EOC(e, eo) log(eo/MAX(e, 1.0e-15))/M_LN2

static REAL estimate(MESH *mesh, ADAPT_STAT *adapt)
{
  FUNCNAME("estimate");
  static int  init_done, only_dirichlet;
  static REAL C[4] = { 1.0, 1.0, 0.0, 1.0 };
  static REAL est_old = -1.0, u_err_old = -1.0, p_err_old = -1.0;
  static REAL_DD A;
  static const QUAD *quad;
  static REAL        est, u_err, p_err;
  FLAGS       fill_flags;
  const void  *est_handle;

  if (!init_done) {
    init_done = true;

    /* Determine whether the pressure is determined only up to a
     * constant.
     */
#if 1
    only_dirichlet = BNDRY_FLAGS_IS_INTERIOR(stress_bndry);
#else
    FOR_ALL_DOFS(bound->fe_space->admin,
		 if (bound->vec[dof] == NEUMANN) {
		   only_dirichlet = false;
		 }
      );
#endif
		 
    GET_PARAMETER(1, "estimator C0", "%f", &C[0]);
    GET_PARAMETER(1, "estimator C1", "%f", &C[1]);
    GET_PARAMETER(1, "estimator C2", "%f", &C[2]);
    GET_PARAMETER(1, "estimator C3", "%f", &C[3]);

    quad = get_quadrature(mesh->dim, 2*u_fe_space->bas_fcts->degree);

    A[0][0] = nu;
  }

  /* We use the standard error estimator for elliptic problems, but
   * optionally add the L2-norm of the divergence of u_h, controlled
   * by C[3].
   */

  /*********************** start of modified estimator ***********************/
  est_handle = ellipt_est_dow_init(u_h, adapt, rw_el_est, NULL /* rw_estc */,
				   quad, NULL /* wall_quad */,
				   H1_NORM, C,
				   A, MATENT_REAL, MATENT_REAL,
				   true /* sym_grad */,
				   noslip_bndry,
				   r, INIT_GRD_UH|(mu != 0.0 ? INIT_UH : 0),
				   stress_res, 0);

  fill_flags = FILL_NEIGH|FILL_COORDS|FILL_OPP_COORDS|FILL_BOUND|CALL_LEAF_EL;
  TRAVERSE_FIRST(mesh, -1, fill_flags) {
    const EL_GEOM_CACHE *elgc;
    const QUAD_EL_CACHE *qelc;
    REAL est_el;

    est_el = element_est_d(el_info, est_handle);

    if (C[3]) {
      REAL div_uh_el, div_uh_qp;
      const REAL_DD *grd_uh_qp;
      int qp, i;

      grd_uh_qp = element_est_grd_uh_d(est_handle);
      div_uh_el = 0.0;
      if (!(el_info->fill_flag & FILL_COORDS)) {
	qelc = fill_quad_el_cache(el_info, quad, FILL_EL_QUAD_DET);

	for (qp = 0; qp < quad->n_points; qp++) {
	  div_uh_qp = 0;
	  for (i = 0; i < DIM_OF_WORLD; i++) {
	    div_uh_qp += grd_uh_qp[qp][i][i];
	  }
	  div_uh_el += qelc->param.det[qp]*quad->w[qp]*SQR(div_uh_qp);
	}
      } else {
	elgc = fill_el_geom_cache(el_info, FILL_EL_DET);

	for (qp = 0; qp < quad->n_points; qp++) {
	  div_uh_qp = 0;
	  for (i = 0; i < DIM_OF_WORLD; i++) {
	    div_uh_qp += grd_uh_qp[qp][i][i];
	  }
	  div_uh_el += quad->w[qp]*SQR(div_uh_qp);
	}
	div_uh_el *= elgc->det;
      }

      est_el += C[3] /* h2 */ * div_uh_el;
    }

    element_est_d_finish(el_info, est_el, est_handle);    
  } TRAVERSE_NEXT();
  est = ellipt_est_d_finish(adapt, est_handle);
  /***********************  end of modified estimator  ***********************/

  MSG("estimate   = %.8le", est);
  if (est_old >= 0) {
    print_msg(", EOC: %.2lf\n", EOC(est,est_old));
  } else {
    print_msg("\n");
  }
  est_old = est;

  quad = get_quadrature(mesh->dim, 2*(u_h->fe_space->bas_fcts->degree - 1));

  u_err = H1_err_dow(grd_u, u_h, quad, 0, NULL, NULL);

  MSG("||u-uh||H1 = %.8le", u_err);
  if (u_err_old >= 0) {
    print_msg(", EOC: %.2lf\n", EOC(u_err, u_err_old));
  } else {
    print_msg("\n");
  }
  u_err_old = u_err;

  p_err = L2_err(p, p_h, quad, false /* rel_error */,
		 only_dirichlet /* mean-value*/,
		 NULL, NULL);

  MSG("||p-ph||L2 = %.8le", p_err);
  if (p_err_old >= 0) {
    print_msg(", EOC: %.2lf\n", EOC(p_err, p_err_old));
  } else {
    print_msg("\n");
  }
  p_err_old = p_err;

  MSG("(||u-uh||H1 + ||p-p_h||L2)/estimate = %.2lf\n",
      (u_err + p_err)/MAX(est,1.e-15));

  if (do_graphics) {
    graphics_d(mesh, u_h, p_h, get_el_est, u, HUGE_VAL /* time */);
  }

  if (write_fem_data) {
    static int step;
    const char *fn;

    fn = generate_filename(fem_path, "bulk-mesh", step);
    write_mesh_xdr(mesh, fn, HUGE_VAL);

    fn = generate_filename(fem_path, "bulk-velo", step);
    write_dof_real_vec_d_xdr(u_h, fn);

    fn = generate_filename(fem_path, "bulk-pressure", step);
    write_dof_real_vec_xdr(p_h, fn);

    if (!BNDRY_FLAGS_IS_INTERIOR(slip_bndry)) {
      fn = generate_filename(fem_path, "slip-mesh", step);
      write_mesh_xdr(slip_mesh, fn, HUGE_VAL);

      fn = generate_filename(fem_path, "slip-stess", step);
      write_dof_real_vec_xdr(slip_stress, fn);
    }
    ++step;
  }

  fflush(stdout);


  return adapt->err_sum;
}

/******************************************************************************
 * Use a round cylinder to test convergence of slip b.c.
 *****************************************************************************/

#define CYLINDER_R 2.0

static void cylinder_proj_func(REAL_D x,
			       const EL_INFO *el_info, const REAL_B lambda)
{
  REAL r_inv = 1.0 / sqrt(SQR(x[0]) + SQR(x[1]));
  
  x[0] *= r_inv * CYLINDER_R;
  x[1] *= r_inv * CYLINDER_R;
}

static NODE_PROJECTION cylinder_proj = { cylinder_proj_func, };

static NODE_PROJECTION *init_node_proj(MESH *mesh, MACRO_EL *mel, int c)
{
  if (c > 0 && mel->wall_bound[c-1] >= 1 && mel->wall_bound[c-1] <= 4) {
    return &cylinder_proj;
  } else {
    return NULL;
  }
}

/*******************************************************************************
 * The main program.
 ******************************************************************************/

int main(int argc, char **argv)
{
  FUNCNAME("main");
  MACRO_DATA     *data;
  MESH           *mesh;
  int            n_refine = 0, dim, u_degree = 2;
  int            do_projection = true;
  unsigned int   noslip_bound, slip_bound, stress_bound;
  ADAPT_STAT     *adapt;
  STOKES_PAIR    stokes;
  char stokes_name[256];
  char filename[PATH_MAX];

  /*****************************************************************************
   * first of all, initialize the access to parameters of the init file
   ****************************************************************************/
  parse_parameters(argc, argv, "INIT/quasi-stokes-slip.dat");

  /*****************************************************************************
   * then read some basic parameters
   ****************************************************************************/
  GET_PARAMETER(1, "mesh dimension", "%d", &dim);
  GET_PARAMETER(1, "macro file name", "%s", filename);
  GET_PARAMETER(1, "global refinements", "%d", &n_refine);
  GET_PARAMETER(1, "online graphics", "%B", &do_graphics);
  GET_PARAMETER(1, "parametric", "%B", &do_projection);

  GET_PARAMETER(1, "stokes pair", "%s", stokes_name);
  GET_PARAMETER(1, "velocity degree", "%d", &u_degree);

  GET_PARAMETER(1, "QS mu", "%f", &mu);
  GET_PARAMETER(1, "QS nu", "%f", &nu);

  gravity[DIM_OF_WORLD-1] = -1.0;
  GET_PARAMETER(1, "gravity", SCAN_FORMAT_DOW, SCAN_EXPAND_DOW(gravity));
  GET_PARAMETER(1, "velocity value",
		SCAN_FORMAT_DOW, SCAN_EXPAND_DOW(u_value));

  GET_PARAMETER(1, "write fem data", "%B", &write_fem_data);
  GET_PARAMETER(1, "fem data path", "%s", fem_path);

  /* Boundary classifiction */
  GET_PARAMETER(1, "noslip boundary", "%i", &noslip_bound);
  BNDRY_FLAGS_INIT(noslip_bndry);
  if (noslip_bound) {
    noslip_bndry[0] = noslip_bound;
    BNDRY_FLAGS_MARK_BNDRY(noslip_bndry);
  }
  GET_PARAMETER(1, "slip boundary", "%i", &slip_bound);
  BNDRY_FLAGS_INIT(slip_bndry);
  if (slip_bound) {
    slip_bndry[0] = slip_bound;
    BNDRY_FLAGS_MARK_BNDRY(slip_bndry);
  }
  GET_PARAMETER(1, "stress boundary", "%i", &stress_bound);
  BNDRY_FLAGS_INIT(stress_bndry);
  if (stress_bound) {
    stress_bndry[0] = stress_bound;
    BNDRY_FLAGS_MARK_BNDRY(stress_bndry);
  }

  alpha_robin = mu; /* black magic, should probably be weighted by
		     * some power of h
		     */

  /*****************************************************************************
  *  get a mesh, and read the macro triangulation from file
  ****************************************************************************/
  data = read_macro(filename);
  mesh = GET_MESH(dim, "ALBERTA mesh", data,
                  do_projection ? init_node_proj : NULL,
                  NULL /* perdioc face transformations */);
  free_macro_data(data);
  init_leaf_data(mesh, sizeof(struct ellipt_leaf_data), NULL, NULL);

  if (!BNDRY_FLAGS_IS_INTERIOR(slip_bndry)) {
    slip_mesh = get_bndry_submesh_by_segment(mesh, "slip mesh", slip_bndry);
  }

  /*****************************************************************************
   * aquire velocity and pressure space finite element spaces
   ****************************************************************************/
  stokes = stokes_triple(stokes_name, dim, u_degree);
  u_fe_space = get_fe_space(mesh, "velocity", stokes.velocity, DIM_OF_WORLD,
			    ADM_FLAGS_DFLT);
  p_fe_space = get_fe_space(mesh, "pressure", stokes.pressure, 1,
			    ADM_FLAGS_DFLT);

  if (!BNDRY_FLAGS_IS_INTERIOR(slip_bndry)) {
    TEST_EXIT(stokes.slip_stress != NULL,
              "Your choice \"%s\" of the Stokes-triple does not allow for slip-stresses",
              stokes_name);
    
    slip_space = get_fe_space(slip_mesh, "normal stress space", stokes.slip_stress, 1,
                              ADM_FLAGS_DFLT);
  }

  /*****************************************************************************
   * Globally refine the mesh a little bit. Maybe do some graphics
   * output to amuse the spectators.
   ****************************************************************************/
  global_refine(mesh, n_refine * mesh->dim, FILL_NOTHING);

  if (do_graphics) {
    graphics_d(mesh, NULL, NULL, NULL, NULL, HUGE_VAL /* time */);
  }

  /*****************************************************************************
   *  initialize the global variables shared across build(), solve()
   *  and estimate().
   ****************************************************************************/
  A   = get_dof_matrix("A", u_fe_space, NULL);
  dof_matrix_try_diagonal(A); /* partly diagonalize, e.g. for Mini */
  f_h = get_dof_real_vec_d("f_h", u_fe_space);
  u_h = get_dof_real_vec_d("u_h", u_fe_space);
  set_refine_inter_dow(u_h);
  set_coarse_inter_dow(u_h);

  B = get_dof_matrix("B", u_fe_space, p_fe_space);
  dof_matrix_try_diagonal(B);
  Bt = get_dof_matrix("Bt", p_fe_space, u_fe_space);
  dof_matrix_try_diagonal(Bt);
  p_h = get_dof_real_vec("p_h", p_fe_space);
  set_refine_inter(p_h);
  set_coarse_inter(p_h);

  g_h = get_dof_real_vec("g_h", p_fe_space);
  bound = get_dof_schar_vec("bound", u_fe_space);

  Yproj = get_dof_matrix("Yproj", p_fe_space, NULL);
  dof_matrix_try_diagonal(Yproj);
  Yprec = get_dof_matrix("Yprec", p_fe_space, NULL);
  // Nope, Yprec is never structurally diagonal

  /* Do not forget to initialize u_h and p_h */
  dof_set_dow(0.0, u_h);
  dof_set(0.0, p_h);

  /*****************************************************************************
   *  init the adapt structure and start adaptive method
   ****************************************************************************/
  adapt = get_adapt_stat(mesh->dim, "Quasi-Stokes", "adapt", 2, NULL);
  adapt->estimate = estimate;
  adapt->get_el_est = get_el_est;
  adapt->build_after_coarsen = build;
  adapt->solve = solve;

  adapt_method_stat(mesh, adapt);

  WAIT_REALLY;

  return 0;
}
