/*******************************************************************************
 *
 * ALBERTA:  an Adaptive multi Level finite element toolbox  using
 *           Bisectioning refinement and Error control by Residual
 *           Techniques
 *
 * File:     stokes.c
 *
 * Description:  solver for a simple stationary Stokes problem:
 *
 *                 -\Delta u + \nabla p = f  in \Omega
 *                        \nabla\cdot u = 0  in \Omega
 *                                    u = g  on \partial \Omega
 *
 ******************************************************************************
 *
 *  author:     Claus-Justus Heine
 *              Abteilung fuer Angewandte Mathematik
 *              Albert-Ludwigs-Universitaet Freiburg
 *              Hermann-Herder-Str. 10
 *              79104 Freiburg
 *              Germany
 *              claus@mathematik.uni-freiburg.de
 *
 *  http://www.mathematik.uni-freiburg.de/IAM/ALBERTA
 *
 *  (c) by C.-J. Heine (2006-2007)
 *
 ******************************************************************************/

#include <alberta/alberta.h>

#include <alberta/albas.h>

#include "alberta-demo.h"
#include <oem_block_solve.h>



//#define BLOCK 1
#define PRINT 0
#define PRECTYPE 1

static bool 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) */

#if BLOCK
static BLOCK_DOF_VEC		*up_h			= NULL;
static BLOCK_DOF_VEC		*load_vector	= NULL;
static BLOCK_DOF_SCHAR_VEC	*block_bound	= NULL;
static BLOCK_DOF_MATRIX     *system_matrix	= NULL;
#endif

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 */
#if !BLOCK
static DOF_MATRIX     *Yproj;      /* projection/precon matrix for B^\ast */
#endif


static BNDRY_FLAGS dirichlet_mask; /* bit-mask of Dirichlet segments */

static int          write_fe_data = 0;
static char         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) = \frac{x}{|x|^d} (make sure 0 lives outside of the domain ...
 */
#define U_SHIFT 0.4

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

  SET_DOW(U_SHIFT, res);
  AXPY_DOW(1.0, x, 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)])
 */
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;

  SET_DOW(U_SHIFT, x);
  AXPY_DOW(1.0, _x, 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;
}

#define P_AMPL 10.0
#define P_SHIFT -0.5

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

  SET_DOW(P_SHIFT, x);
  AXPY_DOW(1.0, _x, x);

  return exp(-P_AMPL*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;

  SET_DOW(P_SHIFT, x);
  AXPY_DOW(1.0, _x, x);

  AXEY_DOW(-2.0*P_AMPL*p(_x), x, res);

  return res;
}

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

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

/* -Delta u + \nabla p, not optional */

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

  if (!res)
    res = space;

  grd_p(_x, 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_data: structure for passing information from init_element() to
 *                 LALt()
 *
 * 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()
 *
 * LALt():         implementation of -Lambda id Lambda^t for -Delta u,
 *                 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
 *
 ******************************************************************************/

struct op_data
{
  REAL_BD Lambda;  /*  the gradient of the barycentric coordinates */
  REAL    det;     /*  |det D F_S| */
};

static bool init_element(const EL_INFO *el_info, const QUAD *quad[3], void *ud)
{
  struct op_data *info = (struct op_data *)ud;

  info->det = el_grd_lambda_0cd(el_info, info->Lambda);

  return false; /* Not parametric. Here: never */
}

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

  for (i = 0; i < N_VERTICES(dim); i++) {
    LALt[i][i] = info->det*SCP_DOW(info->Lambda[i], info->Lambda[i]);
    for (j = i+1; j < N_VERTICES(dim); j++) {
      LALt[i][j] = SCP_DOW(info->Lambda[i], info->Lambda[j]);
      LALt[i][j] *= info->det;
      LALt[j][i] = LALt[i][j];
    }
  }

  return (const REAL_B *)LALt;
}

/* 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)
{
  struct op_data *info = (struct 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;
}

#if !BLOCK
static REAL c(const EL_INFO *el_info, const QUAD *quad, int iq, void *ud)
{
  struct op_data *info = (struct op_data *)ud;

  return info->det;
}
#endif

static void build(MESH *mesh, U_CHAR flag)
{
  FUNCNAME("build");
  
  static const EL_MATRIX_INFO *matrix_info;
#if !BLOCK
  static const EL_MATRIX_INFO *Yproj_minfo;
#endif
  static EL_MATRIX_INFO       B_minfo;
  static struct op_data       op_uinfo;
  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);

  if (!matrix_info) {         /* information for matrix assembling */
    OPERATOR_INFO o_info = { NULL, };
    OPERATOR_INFO B_oinfo = { NULL, };
#if !BLOCK
    OPERATOR_INFO Yproj_oinfo = {NULL, };
#endif

    o_info.row_fe_space   = o_info.col_fe_space = u_fe_space;
    o_info.init_element   = init_element;
    o_info.user_data      = &op_uinfo; /* user data! */
    o_info.LALt.real      = LALt;
    o_info.LALt_pw_const  = true;         /* pw const. assemblage is faster */
    o_info.LALt_symmetric = true;         /* symmetric assemblage is faster */
    BNDRY_FLAGS_CPY(o_info.dirichlet_bndry,
		    dirichlet_mask); /* Dirichlet boundary conditions. */
    o_info.fill_flag      = CALL_LEAF_EL|FILL_COORDS;
    matrix_info = fill_matrix_info(&o_info, NULL);

    /* Operator-info for divergence constraint, first the B operator */
    B_oinfo.row_fe_space = u_fe_space;
    B_oinfo.col_fe_space = p_fe_space;
    B_oinfo.init_element = init_element;
    B_oinfo.user_data    = o_info.user_data;
    B_oinfo.Lb1.real_d   = B_Lb1;
    B_oinfo.Lb1_pw_const = true;
    B_oinfo.Lb_type      = MATENT_REAL_D; /* rectangular matrix */
    B_oinfo.fill_flag    = CALL_LEAF_EL|FILL_COORDS;
    fill_matrix_info(&B_oinfo, &B_minfo);

#if !BLOCK
    Yproj_oinfo.row_fe_space = Yproj_oinfo.col_fe_space = p_fe_space;
    Yproj_oinfo.init_element = 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);
#endif
  }

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

  dirichlet_bound_dow(f_h, u_h, bound, dirichlet_mask, g); /* boundary values */

  /* Now go for the divergence constraint */

  /* First for B */
  clear_dof_matrix(B);
  BNDRY_FLAGS_CPY(B_minfo.dirichlet_bndry, dirichlet_mask);
  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); /* no Dirichlet b.c. for B^t */
  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);

#if !BLOCK
  /* 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);

  /* Pre-conditioner for a pure Stokes-problem would be again the mass-matrix.
   * But that is applied anyway (as projection to the pressure space).
   */
#endif
}

/*******************************************************************************
 * solve(): solve the linear system, called by adapt_method_stat()
 ******************************************************************************/
#if BLOCK
static void solve(MESH *mesh)
{
  FUNCNAME("solve");	 
  static REAL       tol = 1.e-8;
  static int        max_iter = 1000, info = 2, restart = 0;
  static OEM_SOLVER solver = NoSolver;
  const PRECON *precon = NULL;
  static BLOCK_PRECON_TYPE block_prec_type;

  if (solver == NoSolver) {
    tol = 1.e-8;
    GET_PARAMETER(1, "solver", "%d", &solver);
    GET_PARAMETER(1, "solver tolerance", "%f", &tol);
    GET_PARAMETER(1, "solver max iteration", "%d", &max_iter);
    GET_PARAMETER(1, "solver info", "%d", &info);
    if (solver == GMRes)
      GET_PARAMETER(1, "solver restart", "%d", &restart);
	    
    block_prec_type.block_type = NoPrecon;
    GET_PARAMETER(1, "block precon", "%d", &block_prec_type.block_type);
    switch (block_prec_type.block_type) {

    case BlkSSORPrecon:
      GET_PARAMETER(1, "block omega", "%f", &block_prec_type.block_omega);
      GET_PARAMETER(1, "block n_iter", "%d", &block_prec_type.block_n_iter);
    case BlkDiagPrecon:
      block_prec_type.precon_type[0].type = BlkDiagPrecon;
      block_prec_type.precon_type[0].param.BlkDiag.precon[0].type = DiagPrecon;
      block_prec_type.precon_type[0].param.BlkDiag.precon[1].type = DiagPrecon;
      block_prec_type.precon_type[1].type = NoPrecon;
      MSG("\n\n block_precon = %d\n\n", block_prec_type.block_type);
      break;
    default:
      precon = NULL;
      break;
    }
    
    GET_PARAMETER(1, "A_mat precon", "%d", &block_prec_type.precon_type[0].type);

  }
  if (block_prec_type.block_type != NoPrecon)
    precon = init_oem_block_precon(system_matrix, NULL/*block_bound*/, info, &block_prec_type);
  oem_block_solve(system_matrix, NULL /*block_bound*/, load_vector, up_h,
		  solver, tol, precon, restart, max_iter, info);

}
#endif

#if !BLOCK
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, A_icon;
  static int        Yproj_miter, Yproj_icon /*, Yprec_miter */;
  const PRECON *A_prec=NULL, *Yproj_prec /*, Yprec_prec */;


  if (solver == NoSolver) {
    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", &A_icon);

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

#if 0 /* not for a pure Stokes problem */
    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_icon);
#endif

  }

#if PRECTYPE
  
  PRECON_TYPE prec_type;
  prec_type.type = BlkDiagPrecon;
  prec_type.param.BlkDiag.precon[0].type = A_icon;
  prec_type.param.BlkDiag.precon[1].type = DiagPrecon;
  
  A_prec	 = init_precon_from_type(A, NULL, MAX(0, info-3), &prec_type);

#else
    
  A_prec     = init_oem_precon(A, NULL /* bound */, MAX(0, info-3),
			       BlkDiagPrecon,
			       A_icon, DiagPrecon, DiagPrecon);

#endif
  

  
  Yproj_prec = init_oem_precon(Yproj, NULL /* bound */, MAX(0, info-3),
			       Yproj_icon);
  /* Yprec_prec = ... */
  

  
  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,
		       NULL, NoSolver, -1, NULL /* precon */,
		       1.0 /* Yproj_frac */, 0.0 /* Yprec_frac */,
		       f_h, g_h, u_h, p_h);
  
  
}

#endif

/*******************************************************************************
 * Functions for error estimate:
 * estimate():   calculates error estimate via ellipt_est()
 *               calculates exact error also (only for test purpose),
 *               called by adapt_method_stat()
 * 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()
 ******************************************************************************/

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 const 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;
  }

  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 (el != el_info->el) {
    el = el_info->el;
    ph_loc = fill_el_real_vec(NULL, 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);

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

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

static REAL estimate(MESH *mesh, ADAPT_STAT *adapt)
{
  FUNCNAME("estimate");

  static bool       init_done;
  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;
  const void        *est_handle;
  FLAGS             fill_flags;


  if (!init_done) {
    init_done = true;
    
    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] = 1.0;
  }

  /*********************** 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,
				   false /* !sym_grad */,
				   dirichlet_mask,
				   r, INIT_GRD_UH,
				   NULL /* inhomog. Neumann res. */, 0);
  
  fill_flags = FILL_NEIGH|FILL_COORDS|FILL_OPP_COORDS|FILL_BOUND|CALL_LEAF_EL;
  fill_flags |= u_fe_space->bas_fcts->fill_flags;
  fill_flags |= p_fe_space->bas_fcts->fill_flags;  
  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;

  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 */, true /* 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 (write_fe_data) {
    static int step;
    const char *fn;
    
    fn= generate_filename(path, "mesh", step);
    write_mesh_xdr(mesh, fn, HUGE_VAL);
    fn= generate_filename(path, "p_h", step);
    write_dof_real_vec_xdr(p_h, fn);
    fn= generate_filename(path, "u_h", step);
    write_dof_real_vec_d_xdr(u_h, fn);
    step ++;
  }

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

  return adapt->err_sum;
}

/*******************************************************************************
 * main program
 ******************************************************************************/

int main(int argc, char **argv)
{
  FUNCNAME("main");

  MACRO_DATA     *data;
  MESH           *mesh;
  int            n_refine = 0, dim, v_degree = 2;
  ADAPT_STAT     *adapt;
  char stokes_name[256];
  char filename[PATH_MAX];
  STOKES_PAIR stokes;

  /*****************************************************************************
   * first of all, initialize the access to parameters of the init file
   ****************************************************************************/
  parse_parameters(argc, argv, "INIT/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, "velocity degree", "%d", &v_degree);
  GET_PARAMETER(1, "stokes pair", "%s", stokes_name);
  GET_PARAMETER(1, "write finite element data", "%d", &write_fe_data);
  GET_PARAMETER(1, "data path", "%s", path);

  /*****************************************************************************
   *  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 fe-spaces
   ****************************************************************************/
    
  stokes = stokes_pair(stokes_name, dim, v_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().
   ****************************************************************************/
#if BLOCK
  load_vector	 = get_block_dof_vec("load_vector", 2, u_fe_space, p_fe_space);
  f_h		 = load_vector->dof_vec[0];
  g_h		 = (DOF_REAL_VEC *)load_vector->dof_vec[1];
   
  up_h		 = get_block_dof_vec("up_h", 2, u_fe_space, p_fe_space);
  u_h		 = up_h->dof_vec[0];
  p_h		 = (DOF_REAL_VEC *)up_h->dof_vec[1];
   
  block_bound	 = get_block_dof_schar_vec("block_bound", 1, u_fe_space);
  bound		 = block_bound->schar_vec[0];
  block_bound->n_components = 2;

  system_matrix	 = get_block_dof_matrix("system_matrix", 2, 2, Full,
					u_fe_space, u_fe_space,
					p_fe_space, p_fe_space);
  A		 = system_matrix->dof_mat[0][0];
  B		 = system_matrix->dof_mat[0][1];
  Bt		 = system_matrix->dof_mat[1][0];
  /* D_matrix		 = */system_matrix->dof_mat[1][1] = NULL;
#endif
  
#if !BLOCK
  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);
#endif
//  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;
  
  set_refine_inter_dow(u_h);
  set_coarse_inter_dow(u_h);
  
#if !BLOCK
  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);
#endif
  p_h->refine_interpol = p_fe_space->bas_fcts->real_refine_inter;
  p_h->coarse_restrict = p_fe_space->bas_fcts->real_coarse_inter;
#if !BLOCK
  g_h = get_dof_real_vec("g_h", p_fe_space);

  Yproj = get_dof_matrix("Yproj", p_fe_space, NULL);
  bound = get_dof_schar_vec("bound", u_fe_space);    
#endif
  

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

  BNDRY_FLAGS_ALL(dirichlet_mask); /* Only Dirichlet boundary. */ // BNDRY_FLAGS_ALL

  /*****************************************************************************
   *  init the adapt structure and start adaptive method
   ****************************************************************************/
  adapt = get_adapt_stat(mesh->dim, "ellipt", "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);

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

  WAIT_REALLY;

  return 0;
}
