/*******************************************************************************
 *
 * ALBERTA:  an Adaptive multi Level finite element toolbox  using
 *           Bisectioning refinement and Error control by Residual
 *           Techniques
 *
 * www.alberta-fem.de
 *
 ******************************************************************************
 *
 * File:     mini-quasi-stokes.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
 *                       \sigma(u, p) n = F 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.
 *
 *
 *         with static condensation, as an example how to use 
 *         the functions 'condense_mini_spp_dd()' and 'expand_mini_spp_dd()'.
 *
 *
 * 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
 *            Abteilung fuer Angewandte Mathematik
 *            Albert-Ludwigs-Universitaet Freiburg
 *            Hermann-Herder-Str. 10
 *            79104 Freiburg
 *            Germany
 *            Claus.Heine@Mathematik.Uni-Freiburg.DE
 *
 *            Rebecca Stotz
 *            Abteilung fuer Angewandte Mathematik
 *            Albert-Ludwigs-Universitaet Freiburg
 *            Hermann-Herder-Str. 10
 *            79104 Freiburg
 *            Germany
 *
 *
 * (c) by C.-J. Heine (2007), R. Stotz (2009)
 *
 ******************************************************************************/

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

#include "alberta-demo.h"

#include <oem_block_solve.h>
#include <sys/times.h>
#include <unistd.h>

#include "static-condensation.h"

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

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 */

static const EL_MATRIX_INFO *matrix_info;
static EL_MATRIX_INFO       B_minfo;

/********** "static condensation"  ************/
static const FE_SPACE *u_fsp_single;

static DOF_MATRIX     *A_single;
static DOF_MATRIX     *B_single;
static DOF_MATRIX     *Bt_single;
static DOF_MATRIX     *C_single;

static DOF_REAL_D_VEC *fh_single;
static DOF_REAL_VEC_D *uh_single;
static DOF_REAL_VEC   *ph_single;
static DOF_REAL_VEC   *gh_single;
static DOF_REAL_VEC_D *uh;

static BLOCK_DOF_VEC	*up_h = NULL;
static BLOCK_DOF_VEC	*load_vector = NULL;
static BLOCK_DOF_MATRIX *system_matrix = NULL;
/**********************************************/

/* 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   gauss_bell = 10.0; /* factor for the pressure */
static REAL_D p_shift;           /* translation for the pressure */
static REAL_D v_shift;           /* translation for the velocity */

static BNDRY_FLAGS dirichlet_bndry; /* Dirichlet part of the bndry, if any. */
static BNDRY_FLAGS stress_bndry;    /* Complement of dirichlet_mask. */

static REAL ticks_per_second;


/*******************************************************************************
 * 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) = \frac{x}{|x|^d} (make sure 0 lives outside of the domain ...
 */
static const REAL *u(const REAL_D _x, REAL_D res)
{
  static REAL_D space;  
  REAL r;
  
  if (!res) {
    res = space;
  }

  AXPBY_DOW(1.0, _x, -1.0, v_shift, res);

  r = NORM_DOW(res);

  SCAL_DOW(1.0/POW_DOW(r), 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;
  REAL_D x;
  REAL r;
  int i;

  if (!res) {
    res = space;
  }
  
  AXPBY_DOW(1.0, _x, -1.0, v_shift, x);
  
  r = NORM_DOW(x);

  for (i = 0; i < DIM_OF_WORLD; i++) {
    AXEY_DOW(-(REAL)DIM_OF_WORLD*x[i], x, res[i]);
    res[i][i] += SQR(r);
    SCAL_DOW(pow(r, (REAL)(-DIM_OF_WORLD - 2)), res[i]);
  }
  return (const REAL_D *)res;
}

static REAL p(const REAL_D _x)
{
  REAL_D x;

  AXPBY_DOW(1.0, _x, -1.0, p_shift, x);

  return exp(-gauss_bell*SCP_DOW(x,x));
}

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

  if (!res) {
    res = space;
  }

  AXPBY_DOW(1.0, _x, -1.0, p_shift, x);

  AXEY_DOW(-2.0*gauss_bell*p(_x), x, 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);
}

/* \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
 *
 ******************************************************************************/

typedef struct op_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];
} OP_DATA;

static bool u_init_element(const EL_INFO *el_info,
			   const QUAD *quad[3],
			   void *ud)
{
  OP_DATA *data = (OP_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)
{
  OP_DATA *data = (OP_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)
{
  OP_DATA *info = (OP_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)
{
  OP_DATA *info = (OP_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)
{
  OP_DATA *info = (OP_DATA *)ud;
  
  info->c_factor = -info->wall_det[wall];

  return false;
}

static const REAL_B *LALt(const EL_INFO *el_info,
			  const QUAD *quad, int iq, void *ud)
{
  OP_DATA *data = (OP_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 1
static const REAL_BDD *LDDLt(const EL_INFO *el_info, const QUAD *quad, 
			     int iq, void *ud)
{
  static REAL_BBDD LDDLt;
  OP_DATA *info = (OP_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;
  struct op_info *info = (struct op_info *)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][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)
{
  OP_DATA *info = (OP_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)
{
  OP_DATA *info = (OP_DATA *)ud;

  return info->c_factor;
}


static void build(MESH *mesh, U_CHAR flag)
{
  FUNCNAME("build");
/*  static const EL_MATRIX_INFO *matrix_info;   
    static EL_MATRIX_INFO       B_minfo;
    'matrix_info' and 'B_minfo' are now global variables.  */

  static const EL_MATRIX_INFO *Yproj_minfo;
  static const EL_MATRIX_INFO *Yprec_minfo;

  static OP_DATA              opi_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 (!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      = &opi_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,
		    dirichlet_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);
    }
  }

  /* 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".
   */
  boundary_conditions_dow(NULL /* matrix */, f_h, u_h, bound,
			  dirichlet_bndry,
			  g, g_stress,
			  mu == 0.0 ? -1.0 : 0.0 /* robin_alpha */,
			  NULL);

  /* Now go for the divergence constraint */

  /* First for B */
  clear_dof_matrix(B);
  BNDRY_FLAGS_CPY(B_minfo.dirichlet_bndry, dirichlet_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);

  /* 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);
  flux = sp_dirichlet_bound_dow_scl(NoTranspose, Bt, bound, u_h, g_h);

  MSG("Total flux-excess: %e\n", flux);

/********************************************************************
 ************* condensed-version ************************************
 ********************************************************************/
  clear_block_dof_matrix(system_matrix);
#if 0 
  clear_dof_matrix(A_single);
  clear_dof_matrix(B_single);  
  clear_dof_matrix(Bt_single);
  clear_dof_matrix(C_single);
#endif
  dof_set_d(0.0, fh_single);
  
  condense_mini_spp_dd(u_h, f_h, g_h, dirichlet_bndry, 
		       (EL_MATRIX_INFO *)matrix_info, &B_minfo,
		       system_matrix, up_h, load_vector);
/*******************************************************************
 *******************************************************************/

  /* 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);
  robin_bound(Yprec, stress_bndry, alpha_robin, NULL /* bndry_quad */, 1.0);

  /* That's it */
}


/******************************************************************************
 * 'block_solve' is the solve-function of the version with static condensation,
 * the variable 'norm_res' is needed to compare the lengths of time of
 * the two different versions
 *****************************************************************************/
static void block_solve(MESH *mesh, REAL norm_res)
{
  FUNCNAME("block_solve");

  
  static REAL       tol = 3.125e-10, ssor_omega = 1.0;
  static int        max_iter = 1000, info = 2, restart = 0, ssor_iter = 1;
  static OEM_SOLVER solver = NoSolver;

/*  static OEM_PRECON icon = DiagPrecon;
    static BLOCK_PRECON_TYPE block_icon = {  BlkDiagPrecon,{ { DiagPrecon, },{ DiagPrecon, },}};*/

  static DOF_REAL_VEC *res;
  static REAL         norm_block_res, seconds, init_tol = 0;
  static int          i, reach_tol = 20;
  static clock_t      time_block, time_block_solve;
  struct tms          tms;

  const PRECON *precon;
  static BLOCK_PRECON_TYPE block_prec_type;  

  block_prec_type.block_type = BlkDiagPrecon;
  block_prec_type.precon_type[0].type = HBPrecon;
  /*block_prec_type.precon_type[0].type = ILUkPrecon; 
    block_prec_type.precon_type[0].param.ILUk.level = 2;*/

  block_prec_type.precon_type[1].type = DiagPrecon;

/*  block_prec_type.precon_type[0].param.BlkDiag.precon[1].type = DiagPrecon;*/
  
  if (solver == NoSolver)
  {
    tol = 1.e-8;
    GET_PARAMETER(1, "block->solver", "%d", &solver);
    GET_PARAMETER(1, "block->solver tolerance", "%f", &tol);
    /*GET_PARAMETER(1, "block->solver precon", "%d", &block_icon.type);*/
    GET_PARAMETER(1, "block->solver max iteration", "%d", &max_iter);
    GET_PARAMETER(1, "block->solver info", "%d", &info);
    GET_PARAMETER(1, "block->precon ssor omega", "%f", &ssor_omega);
    GET_PARAMETER(1, "block->precon ssor iter", "%d", &ssor_iter);
    if (solver == GMRes)
      GET_PARAMETER(1, "block->solver restart", "%d", &restart);
  }
  
  res = get_dof_real_vec("res", p_fe_space);
  
  if(init_tol == 0.0) {
    init_tol = tol;
  }

  for (i = 0; i < reach_tol; i++) {
    dof_copy_dow((const DOF_REAL_VEC_D *)load_vector->dof_vec[0],
		 up_h->dof_vec[0]);
    dof_scal(0.0, (DOF_REAL_VEC *)up_h->dof_vec[1]);
    
    times(&tms);
    time_block = tms.tms_utime;
    precon = init_oem_block_precon(system_matrix, NULL, info, 
				   &block_prec_type);
    oem_block_solve(system_matrix, NULL /* bound */, load_vector, up_h,
		    solver, tol, precon /* precon */, 
		    restart, max_iter, info); 

    dof_mv_scl_dow(NoTranspose, system_matrix->dof_mat[1][0], NULL,
		   up_h->dof_vec[0], res);
    dof_gemv(NoTranspose, 1.0, system_matrix->dof_mat[1][1], NULL, 
	     (const DOF_REAL_VEC *)up_h->dof_vec[1], 1.0, res);
    dof_axpy(-1.0, (const DOF_REAL_VEC *)load_vector->dof_vec[1], res);
    norm_block_res = dof_nrm2(res);
    
    MSG("\n Block-tolerance =  %.8e\n", tol);
    if(norm_block_res > norm_res) {
      tol = tol/sqrt(2);
    } else {
      i = reach_tol;
      tol = init_tol;
    }
    MSG("\n B*_single uh + C_single ph - gh = %.8e \n\n", norm_block_res); 
    times(&tms);
    time_block_solve = tms.tms_utime;
    seconds = ((REAL )(time_block_solve - time_block))/ ticks_per_second;
    
    MSG("\n ********* Block-solver-time: %f sec *******************\n\n", 
	seconds);
  }

  expand_mini_spp_dd(up_h, f_h, uh, dirichlet_bndry,
		     (EL_MATRIX_INFO *)matrix_info, &B_minfo);

  dof_copy(g_h, res);
  dof_gemv_scl_dow(NoTranspose, 1.0, Bt, NULL, uh, -1.0, res);
  norm_block_res = dof_nrm2(res);
  MSG("\n B*u_h - g_h = %.8e \n\n", norm_block_res);

  free_dof_real_vec(res);
  
}

/******************************************************************************
 * solve(): solve the linear system, called by adapt_method_stat()
 *****************************************************************************/

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, A_solver = NoSolver;
  static OEM_SOLVER Yproj_solver = NoSolver, Yprec_solver = NoSolver;
  static int        A_miter, A_restart;
  static int        Yproj_miter, Yprec_miter;
  const PRECON      *A_prec, *Yproj_prec, *Yprec_prec;
  clock_t           time, time_solve;
  struct tms        tms;
  REAL              norm_res, seconds;
  static DOF_REAL_VEC *res;
  static PRECON_TYPE A_prec_type = {
    BlkDiagPrecon,
  };
  static PRECON_TYPE Yprec_prec_type = {
    DiagPrecon,
  };
  static PRECON_TYPE Yproj_prec_type = {
    DiagPrecon,
  };

  if (solver == NoSolver) {
    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);
    struct __precon_type *first = &A_prec_type.param.BlkDiag.precon[0];
    GET_PARAMETER(1, "sp->Auf precon", "%d", &first->type);
    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);
    } else if (first->type == ILUkPrecon) {
      GET_PARAMETER(1, "sp->Auf precon ilu(k)", "%d",
                    &first->param.ILUk.level);
    }
    for (i = 1; i < N_BLOCK_PRECON_MAX; ++i) {
      A_prec_type.param.BlkDiag.precon[i].type = DiagPrecon;
    }


    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);
    } else 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);
    } else if (Yprec_prec_type.type == ILUkPrecon) {
      GET_PARAMETER(1, "sp->Yprec precon ilu(k)", "%d",
                    &Yprec_prec_type.param.ILUk.level);
    }
  }
  dof_copy_dow(f_h, u_h);
  dof_set(0.0, p_h);
  
  times(&tms);
  time = tms.tms_utime;

  A_prec     = init_precon_from_type(A, NULL /* bound */, MAX(0, info-3),
                                     &A_prec_type);
  Yproj_prec = init_precon_from_type(Yproj, NULL /* bound */, MAX(0, info-3),
                                     &Yproj_prec_type);
  if (mu > 0) {
    Yprec_prec = init_precon_from_type(Yprec, NULL /* bound */, MAX(0, info-3),
					&Yprec_prec_type);
  }
  Yprec_prec = init_precon_from_type(Yprec, NULL /* bound */, MAX(0, info-3),
				     &Yprec_prec_type);
  oem_sp_solve_dow_scl(solver, tol, tol_incr, miter, info,
		       A, NULL /* bound */, A_solver, A_miter, A_prec,
		       B, Bt,
		       Yproj, Yproj_solver, Yproj_miter, Yproj_prec,
		       mu > 0 ? Yprec : NULL, Yprec_solver, Yprec_miter, 
		       Yprec_prec,
		       nu /* Yproj_frac */, mu /* Yprec_frac */,
		       f_h, g_h, u_h, p_h);

  res = get_dof_real_vec("res", p_fe_space);
  dof_copy(g_h, res);
  dof_gemv_scl_dow(NoTranspose, 1.0, Bt, NULL, u_h, -1.0, res);
  norm_res = dof_nrm2(res);
  MSG("\n CG-tolerance =  %.8e\n", tol);
  MSG("\n B*u_h - g_h = %.8e \n", norm_res);

  times(&tms);
  time_solve = tms.tms_utime;
  seconds = ((REAL )(time_solve - time))/ ticks_per_second;
  MSG("\n *************** Solver-time: %f sec *******************\n\n", 
      seconds);

  block_solve(mesh, norm_res);

  free_dof_real_vec(res);

}

/*******************************************************************************
 * 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 EL_REAL_VEC *ph_loc;
  REAL_D x;
  REAL p_val;

  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) {
    el = el_info->el;
    fill_el_real_vec(ph_loc, el, p_h);
    INIT_ELEMENT(el_info, qfast);
  }

  p_val = eval_uh_fast(ph_loc, qfast, qp);

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

  g_stress(x, normal, result);
  AXPY_DOW(p_val, normal, result); /* "+" is correct here, the
				    * estimator only computes the
				    * (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;
  REAL        est, u_err, p_err;
  FLAGS       fill_flags;
  const void  *est_handle;

  static REAL       usingle_err_old = -1.0, psingle_err_old = -1.0;
  static REAL       uerr_old = -1.0;
  REAL              usingle_err, psingle_err, uerr;

  if (!init_done) {
    init_done = true;

    /* Determine whether the pressure is determined only up to a
     * constant.
     */
    only_dirichlet = true;
    FOR_ALL_DOFS(bound->fe_space->admin,
		 if (bound->vec[dof] == NEUMANN) {
		   only_dirichlet = false;
		 }
      );
		 
    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 */,
				   dirichlet_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));



  /****** u_h_single & p_h and uh_bubble ************/
  usingle_err = H1_err_dow(grd_u, uh_single, quad, 0, NULL, NULL);
  MSG("version of static condensation:\n");
  MSG("||u-uh||H1 = %.8le", usingle_err);
  if (usingle_err_old >= 0) {
    print_msg(", EOC: %.2lf\n", EOC(usingle_err, usingle_err_old));
  } else {
    print_msg("\n");
  }
  usingle_err_old = usingle_err;

  psingle_err = L2_err(p, ph_single, quad, 
		       false /* rel_error */, true /* mean-value*/,
		       NULL, NULL);

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

  MSG("uh_single & uh_bubble: \n");
  uerr = H1_err_dow(grd_u, uh, quad, 0, NULL, NULL);
  MSG("||u-uh||H1 = %.8le", uerr);
  if (uerr_old >= 0) {
    print_msg(", EOC: %.2lf\n", EOC(uerr, uerr_old));
  } else {
    print_msg("\n");
  }
  uerr_old = uerr;
/*******************************************************************/

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

  return adapt->err_sum;
}

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

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

  ticks_per_second = (REAL)sysconf(_SC_CLK_TCK);

  /*****************************************************************************
   * first of all, initialize the access to parameters of the init file
   ****************************************************************************/
  parse_parameters(argc, argv, "INIT/mini-quasi-stokes.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", "%d", &do_graphics);
  GET_PARAMETER(1, "dirichlet boundary", "%i", &dirichlet_mask);

  /* Boundary classifiction */
  BNDRY_FLAGS_ALL(stress_bndry);
  if (dirichlet_mask > 0) {
    dirichlet_bndry[0] = dirichlet_mask | 1;
    /*BNDRY_FLAGS_SET(dirichlet_bndry, dirichlet_bit);*/
    BNDRY_FLAGS_XOR(stress_bndry, dirichlet_bndry);
    stress_bndry[0] |= 1;
  }

  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);

  GET_PARAMETER(1, "velocity translation",
		SCAN_FORMAT_DOW, SCAN_EXPAND_DOW(v_shift));
  GET_PARAMETER(1, "pressure translation",
		SCAN_FORMAT_DOW, SCAN_EXPAND_DOW(p_shift));

  if (mu > 0) {
    alpha_robin = 1.0/mu;
  } else {
    alpha_robin = 0.0;
  }
  

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

  /*****************************************************************************
   * aquire velocity and pressure space finite element spaces
   ****************************************************************************/
  stokes = stokes_pair(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);

  /*****************************************************************************
   * 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);
  f_h = get_dof_real_vec_d("f_h", u_fe_space);
  u_h = get_dof_real_vec_d("u_h", u_fe_space);
  u_h->refine_interpol = u_fe_space->bas_fcts->real_refine_inter_d;
  u_h->coarse_restrict = u_fe_space->bas_fcts->real_coarse_inter_d;

  B = get_dof_matrix("B", u_fe_space, p_fe_space);
  Bt = get_dof_matrix("Bt", p_fe_space, u_fe_space);
  p_h = get_dof_real_vec("p_h", p_fe_space);
  p_h->refine_interpol = p_fe_space->bas_fcts->real_refine_inter;
  p_h->coarse_restrict = p_fe_space->bas_fcts->real_coarse_inter;
  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);
  Yprec = get_dof_matrix("Yprec", p_fe_space, NULL);

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


/**** BLOCK_DOF_* for the static condensation  *******************/

  u_fsp_single = u_fe_space->unchained;

  load_vector = get_block_dof_vec("load_vector", 2,
				  u_fsp_single, p_fe_space);
  fh_single = (DOF_REAL_D_VEC*)load_vector->dof_vec[0];
  gh_single = (DOF_REAL_VEC *)load_vector->dof_vec[1];
  
  up_h = get_block_dof_vec("up_h", 2, u_fsp_single, p_fe_space);
  uh_single = (DOF_REAL_VEC_D *)up_h->dof_vec[0];
  ph_single = (DOF_REAL_VEC *)up_h->dof_vec[1];
  
  system_matrix	 = get_block_dof_matrix("system_matrix", 
					2, 2, Full,
					u_fsp_single, u_fsp_single, 
					p_fe_space, p_fe_space);

  A_single  = system_matrix->dof_mat[0][0];
  B_single  = system_matrix->dof_mat[0][1];
  Bt_single = system_matrix->dof_mat[1][0];
  C_single  = system_matrix->dof_mat[1][1];

  uh = get_dof_real_vec_d("uh", u_fe_space);

  set_refine_inter_dow(uh);
  set_coarse_inter_dow(uh);

  set_refine_inter_dow(uh_single);
  set_coarse_inter_dow(uh_single);

  ph_single->refine_interpol = p_fe_space->bas_fcts->real_refine_inter;
  ph_single->coarse_restrict = p_fe_space->bas_fcts->real_coarse_inter;

  dof_set_dow(0.0, uh_single);
  dof_set(0.0, ph_single);

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

  /*****************************************************************************
   *  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;
}
