/*******************************************************************************
 *
 * ALBERTA:  an Adaptive multi Level finite element toolbox  using
 *           Bisectioning refinement and Error control by Residual
 *           Techniques
 *
 * File:     ellipt-klein-3-bottle.c
 *
 * Description: solver for a simple Poisson equation on a 3d Klein's
 * bottle:
 *
 *                 -\Delta_\Gamma u = f
 *                                u = g  on \partial\Gamma
 *
 * The major difference to ../3d/ellipt_moebius.c is that in this
 * example the coordinate functions are implemented as periodic finite
 * element functions, while the (explicit) paramter values at the
 * vertices of the mesh are kept in _NON_-periodic p.w. linear finite
 * element functions on the same mesh. In contrast to this
 * ../3d/ellipt_moebius.c uses the leaf-data construct to store the
 * parameter values at the vertices of the triangulation.
 *
 ******************************************************************************
 *
 *  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.alberta-fem.de/
 *
 *  (c) by C.-J. Heine (2006)
 *
 * Based on the famous ellipt.c demo-program by K.G. Siebert and A. Schmidt.
 *
 ******************************************************************************/

#include "../Common/alberta-demo.h"

#if DIM_OF_WORLD != 5
# error This is a test program for an embedded 3d "Klein's bottle"! (DOW == 5)
#endif

#define MESH_DIM 3 /* ... just to avoid a literal 3 ... */

/* define to 1 to get some graphical feedback during mesh-generation,
 * and a dump of the intermediate refined macro-triangulation.
 */
#define DEBUG_MESH_GENERATION 0

/* whether or not to do some graphics, using geomview or whatever */
static int do_graphics = 1;

void togeomview(MESH *mesh,
		const DOF_REAL_VEC *u_h,
		REAL uh_min, REAL uh_max,
		REAL (*get_est)(EL *el),
		REAL est_min, REAL est_max,
		REAL (*u_loc)(const EL_INFO *el_info,
			      const REAL_B lambda,
			      void *ud),
		void *ud, FLAGS fill_flags,
		REAL u_min, REAL u_max);

/*******************************************************************************
 * 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 *fe_space;  /* initialized by main() */
static DOF_REAL_VEC   *u_h;       /* initialized by main() */
static DOF_REAL_VEC   *f_h;       /* initialized by main() */
static DOF_MATRIX     *matrix;    /* initialized by main() */

/* We implement the parameterisation of the mesh by an explicit
 * parameterisation of the 3-manifold. We remember the values of the
 * parameterisation at each vertex of the triangulation and
 * interpolate between them according to the baricentric coordinates
 * given by "lambda"
 */
static DOF_REAL_VEC *param[MESH_DIM];
static const BAS_FCTS *param_bfcts;

/* The radii of the generating circles */
static REAL R[MESH_DIM] = { 1.0, 0.5, 0.25 };

#if 0
/* As this program can live with one and only one macro-triangulation
 * it would maybe nice to hardcode that into the binary ...
 *
 * NOT YET.
 */
#define DEF_MACRO_DATA(mdptr, dim, nv, nel, coords, mel_v, bndry, nwt, wt) \
{									\
  static const REAL_D     _AI_coords[] = coords;			\
  static const int        _AI_mel_v[]  = mel_v;				\
  static const S_CHAR     _AI_bndry[]  = bndry;				\
  static const int        _AI_wt[][N_VERTICES(DIM_MAX-1)][2] = wt;	\
  static const MACRO_DATA _AI_mdata = {					\
    (dim),								\
    (nv),								\
    (nel),								\
    (REAL_D *)_AI_coords,						\
    (int *)_AI_melv,							\
    NULL, /* neigh */							\
    NULL, /* opp_vertex */						\
    (S_CHAR *)_AI_bndry,						\
    NULL, /* el_type */							\
    (nwt),								\
    0,									\
    (int (*)[N_VERTICES(DIM_MAX-1)][2])_AI_wt,				\
    NULL /* el_wall_trafos */						\
  };									\
									\
  (mdptr) = &_AI_mdata;							\
}
#endif

/*******************************************************************************
 * Extract the parameter values at the vertices, do some caching for
 * the sake of efficieny.
 ******************************************************************************/

static inline void get_param_at_vertex(REAL_B **param_loc, EL *el)
{
  int i;
  static EL *last_el;
  static REAL_B param_v[MESH_DIM];

  if (last_el != el) {
    for (i = 0; i < MESH_DIM; i++) {
      param_bfcts->get_real_vec(param_v[i], el, param[i]);
 /*     fill_el_real_vec(param_v[i], el, param[i]); */
    }
    last_el = el;
  }

  *param_loc = param_v;
}

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

/*******************************************************************************
 * Problem data: tuned for this particular Klein's bottle; for the
 * right hand side "f()" we need to compute the Laplace-Beltrami of
 * u(). Apart from this we use nearly the same stuff as in
 * ../Common/ellipt-periodic.c, just scaled to the parameter domain
 * (0, 2\pi)^MESH_DIM.
 ******************************************************************************/

/* various parameters to tune the test problems. */

#define K_X 1.0 /* number of periods in x direction */
#define K_Y 1.0 /* number of periods in y direction (DIM_OF_WORLD > 1) */
#define K_Z 1.0 /* number of periods in z direction (DIM_OF_WORLD > 2) */

static REAL K_NR[MESH_DIM] = { K_X, K_Y, K_Z };

/* just something to avoid zero boundary conditions */
#define PHASE_OFFSET 0.0 /*0.378*/

static REAL u(const REAL s[MESH_DIM])
{
  REAL result;
  REAL k;

  /* no phase-offset in s[1] direction */
  result  = cos(K_NR[1]*s[1]);
  k       = K_NR[0]-0.5;
  result *= sin(k*s[0] + k*PHASE_OFFSET);
  result *= sin(K_NR[2]*s[2] + PHASE_OFFSET*K_NR[2]);
  
  return result;
}

static REAL u_loc(const EL_INFO *el_info, const REAL_B lambda, void *ud)
{
  REAL_B *s_v;
  REAL   s[MESH_DIM];
  int    i;

  get_param_at_vertex(&s_v, el_info->el);
  for (i = 0; i < MESH_DIM; i++) {
    s[i] = SCP_BAR(MESH_DIM, s_v[i], lambda);
  }

  return u(s);
}

static REAL u_at_qp(const EL_INFO *el_info, const QUAD *quad, int iq, void *ud)
{
  return u_loc(el_info, quad->lambda[iq], ud);
}

/* grd_u_loc() is used for H1_error(), however, using H1_error() in
 * the context of parametric meshes is somewhat wrong: in principle we
 * would first have to lift u_h to the continuous surface, and compute
 * the tangential gradient of the lifted u_h and compare it with the
 * exact solution on \Gamma, not on \Gamma_h. Here we simply compare
 * the tangential gradient of the smooth function on \Gamma with the
 * tangential gradient of u_h on \Gamma_h; this is nonsense.
 *
 * Instead we could lift the smooth function to \Gamma_h and compute
 * the tangential gradient of the lift on \Gamma_h; this is ok as long
 * as we use iso-parametric elements because then the error from the
 * discretization of the geometry is of higher order.
 */

/* Derivatives w.r.t. to the parameterisation */
static const REAL *grd_u(const REAL s[MESH_DIM], REAL grd[MESH_DIM])
{
  static REAL _grd[MESH_DIM];
  REAL k;

  if (!grd) {
    grd = _grd;
  }

  k = K_NR[0]-0.5;
  grd[0] =
    k*cos(k*s[0]+k*PHASE_OFFSET)
    * cos(K_NR[1]*s[1])
    * sin(K_NR[2]*s[2]+PHASE_OFFSET*K_NR[2]);
  grd[1] =
    -K_NR[1]*sin(K_NR[1]*s[1])
    * sin(k*s[0]+k*PHASE_OFFSET)
    * sin(K_NR[2]*s[2]+K_NR[2]*PHASE_OFFSET);
  grd[2] =
    K_NR[2]*cos(K_NR[2]*s[2]+K_NR[2]*PHASE_OFFSET)
    * sin(k*s[0]+k*PHASE_OFFSET)
    * cos(K_NR[1]*s[1]);

  return grd;
}

/* Tangential derivatives, computed from grd_u() */
static const REAL *grd_u_at_qp(REAL_D result, const EL_INFO *el_info,
			       const REAL_BD Lambda,
			       const QUAD *quad, int iq,
			       void *ud)
{
  static REAL_D _result;
  int i;
  REAL_B *s_v;
  REAL   s[MESH_DIM];
  REAL   grd[MESH_DIM];
  REAL_B grd_bar;
  const REAL *lambda = quad->lambda[iq];
  
  if (!result) {
    result = _result;
  }

  get_param_at_vertex(&s_v, el_info->el);
  for (i = 0; i < MESH_DIM; i++) {
    s[i] = SCP_BAR(MESH_DIM, s_v[i], lambda);
  }

  grd_u(s, grd);

  AXEY_BAR(MESH_DIM, grd[0], s_v[0], grd_bar);
  for (i = 1; i < MESH_DIM; i++) {
    AXPY_BAR(MESH_DIM, grd[i], s_v[i], grd_bar);
  }

  GRAD_DOW(MESH_DIM, Lambda, grd_bar, result);

  return result;
}

/* Helper function for f: non-mixed 2nd derivatives w.r.t. the
 * parameterisation.
 */
static const REAL *D2_u(const REAL s[MESH_DIM], REAL D2u[MESH_DIM])
{
  static REAL _D2u[MESH_DIM];
  REAL k;

  if (!D2u) {
    D2u = _D2u;
  }

  k = K_NR[0]-0.5;
  D2u[0] =
    -SQR(k)*sin(k*s[0]+k*PHASE_OFFSET)
    * cos(K_NR[1]*s[1])
    * sin(K_NR[2]*s[2]+PHASE_OFFSET*K_NR[2]);
  D2u[1] =
    -SQR(K_NR[1])*cos(K_NR[1]*s[1])
    * sin(k*s[0]+k*PHASE_OFFSET)
    * sin(K_NR[2]*s[2]+K_NR[2]*PHASE_OFFSET);
  D2u[2] =
    -SQR(K_NR[2])*sin(K_NR[2]*s[2]+K_NR[2]*PHASE_OFFSET)
    * sin(k*s[0]+k*PHASE_OFFSET)
    * cos(K_NR[1]*s[1]);

  return D2u;
}

/* f is not so easy, unluckily:
 *
 * \Delta_\Gamma u(s_0, s_1, s_2)
 * =
 * \frac1{\sqrt{|g|}}\partial_i(\sqrt{|g|}g^{ij}\partial_j u)
 *
 * Luckily g ist diagonal in our example, g_{00} depends on all
 * variables, g_{11} depends only on s[2] and g_{22} is constant, so
 * we have
 *
 * \Delta_\Gamma u(s, t)
 * =
 * \frac1{\sqrt{|g|}}\partial_i(\frac{\sqrt{|g|}}{g_{ii}}\partial_i u)
 *
 * with
 *
 * \frac{\sqrt{|g|}}{g_{00}} = \sqrt{\frac{g_{11} g_{22}}{g_{00}}}
 *
 * etc.
 */
static REAL f(const REAL s[MESH_DIM])
{
  REAL g_diag[MESH_DIM];
  REAL g00, Dg00[MESH_DIM];
  REAL result;
  REAL Du[MESH_DIM], D2u[MESH_DIM];

  /* Non-zero components of the metric tensor, actually their square-roots. */
  g00 =
    5.0/4.0*SQR(cos(s[1])*(R[1]+R[2]*cos(s[2])))
    +
    2*R[0]*sin(0.5*s[0])*cos(s[1])*(R[1]+R[2]*cos(s[2]))
    -
    SQR(cos(0.5*s[0])*cos(s[1])*(R[1]+R[2]*cos(s[2])))
    +
    SQR(R[0]);
  g_diag[0] = sqrt(g00);
  g_diag[1] = R[1] + R[2]*cos(s[2]);
  g_diag[2] = R[2];

  /* compute the derivatives of g_{00} w.r.t. s_0, s_1, s_2 */
  Dg00[0] =
    cos(0.5*s[0])*cos(s[1])*(R[1]+R[2]*cos(s[2]))
    *
    (R[0] + sin(0.5*s[0])*cos(s[1])*(R[1]+R[2]*cos(s[2])));
  
  Dg00[1] =
    cos(s[1])*sin(s[1])*SQR(R[1]+R[2]*cos(s[2]))
    *
    (2.0*SQR(cos(0.5*s[0]))-2.5)
    -
    2.0*R[0]*sin(0.5*s[0])*sin(s[1])*(R[1]+R[2]*cos(s[2]));
  
  Dg00[2] =
    SQR(cos(s[1]))*(R[1]+R[2]*cos(s[2]))*R[2]*sin(s[2])
    *
    (2.0*SQR(cos(0.5*s[0]))-2.5)
    -
    2.0*R[0]*sin(0.5*s[0])*cos(s[1])*R[2]*sin(s[2]);

  /* compute the first derivatives of u */
  grd_u(s, Du);

  /* compute the non-mixed second derivatives of u */
  D2_u(s, D2u);

  /* \partial_0 \sqrt{\frac{g_{11} g_{22}}{g_{00}}}
   * =
   * -\frac12 g_{11} g_{22} \frac1{g_{00}^{3/2}} \partial_0 g_00
   */

  result  = D2u[0]/g00;
  result += -0.5/SQR(g00)*Dg00[0]*Du[0];

  result += D2u[1]/SQR(g_diag[1]);
  result += 0.5/g00/SQR(g_diag[1])*Dg00[1]*Du[1];
  
  result += D2u[2]/SQR(g_diag[2]);
  result +=
    (0.5/SQR(g_diag[2])/g00*Dg00[2]
     -
     1.0/SQR(g_diag[2])/g_diag[1]*R[2]*sin(s[2]))*Du[2];

  return -result;
}

static REAL f_loc(const EL_INFO *el_info, const QUAD *quad, int iq, void *ud)
{
  REAL_B *s_v;
  REAL   s[MESH_DIM];
  int    i;
  
  get_param_at_vertex(&s_v, el_info->el);
  for (i = 0; i < MESH_DIM; i++) {
    s[i] = SCP_BAR(MESH_DIM, s_v[i], quad->lambda[iq]);
  }

  return f(s);
}

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

/* We use the following explicit parameterisation. Change to your
 * liking (but do not forget to change f, too; the Laplace-Beltrami
 * operator will change when you change the geometry of the surface).
 * The idea is to store the values of the parameterisation at the
 * vertices and then interpolate linearly (in the parameter space)
 * between the vertices according to the barycentric coordinates
 * ("lambda").
 *
 * x_0 = (R_0 + (R_1 + R_2\cos(s_2)) \cos(s_1) \sin(s_0/2)) \cos(s_0)
 * x_1 = (R_0 + (R_1 + R_2\cos(s_2)) \cos(s_1) \sin(s_0/2)) \sin(s_0)
 * x_2 =        (R_1 + R_2\cos(s_2)) \sin(s_1)
 * x_3 =               R_2\sin(s_2)
 * x_4 =        (R_1 + R_2\cos(s_2)) \cos(s_1) \cos(s_0/2)
 *
 */
static void klein_3_bottle_proj_func(REAL_D x,
				     const EL_INFO *el_info,
				     const REAL_B lambda)
{
  int i;
  REAL_B *param_v;
  REAL   s[MESH_DIM];

  /* First compute the parameter values by linear interpolation
   * between the vertices of this tetrahedron ...
   */
  get_param_at_vertex(&param_v, el_info->el);
  for (i = 0; i < MESH_DIM; i++) {
    s[i] = SCP_BAR(MESH_DIM, param_v[i], lambda);
  }

  /* ... then compute the parameterisation of the 3d "Klein's bottle". */
  x[0] = (R[0] + (R[1] + R[2]*cos(s[2]))*cos(s[1])*sin(0.5*s[0]))*cos(s[0]);
  x[1] = (R[0] + (R[1] + R[2]*cos(s[2]))*cos(s[1])*sin(0.5*s[0]))*sin(s[0]);
  x[2] =         (R[1] + R[2]*cos(s[2]))*sin(s[1]);
  x[3] =                 R[2]*sin(s[2]);
  x[4] =         (R[1] + R[2]*cos(s[2]))*cos(s[1])*cos(0.5*s[0]);
}

/* init_node_projection(): initialize the node-projection functions
 * for the macro-triangulation. Return value != NULL for c == 0 means
 * to install a default projection for all nodes, otherwise (c-1)
 * means the number of the wall this projection is meant for.
 */
static NODE_PROJECTION *init_node_proj(MESH *mesh, MACRO_EL *mel, int c)
{
  static NODE_PROJECTION proj = { klein_3_bottle_proj_func };

  if (c == 0) {
    return &proj;
  }

  return NULL;
}

/* We define a periodic structure on the mesh by attaching face
 * transformations to the periodic faces; the transformations just
 * operate as identity because we are dealing with a real embedded
 * 3-manifold here; the periodic structure of the mesh is just used to
 * connect parameter values with coordinate information.
 */
static AFF_TRAFO *init_wall_trafos(MESH *mesh, MACRO_EL *mel, int wall)
{
  FUNCNAME("init_wall_trafos");
  /* a bunch of identity transformations */
  static AFF_TRAFO *ids;
  int wt, i;
  
  if (ids == NULL) {
    ids = MEM_CALLOC(2*(DIM_OF_WORLD-1), AFF_TRAFO);
    for (wt = 0; wt < 2*(DIM_OF_WORLD-1); wt++) {
      for (i = 0; i < DIM_OF_WORLD; i++) {
	ids[wt].M[i][i] = 1.0;
      }
    }
  }

  if ((wt = (signed char)mel->wall_bound[wall]) > 0) {
    wt = 2*(wt-1);
  } else if (wt < 0) {
    wt = 2*(-wt-1)+1;
  } else {
    return NULL;
  }

  TEST_EXIT(wt < 2*(DIM_OF_WORLD-1),
	    "not so many periodic boundaries: %d.\n", wt);

  return &ids[wt];
}

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

struct op_info
{
  REAL_BD *Lambda;
  REAL    *det;
};

/* This version of init_element() is for entirely parametric meshes,
 * i.e. for the strategy PARAM_ALL.
 */
static bool init_element(const EL_INFO *el_info, const QUAD *quad[3], void *ud)
{
  struct op_info *info = (struct op_info *)ud;
  PARAMETRIC     *parametric = el_info->mesh->parametric;
  
  if (parametric->init_element(el_info, parametric)) {
    parametric->grd_lambda(el_info, quad[2], 0, NULL,
			   info->Lambda, NULL, info->det);
    return true;
  } else {
    *info->det = el_grd_lambda(el_info, info->Lambda[0]);
    return false;
  }
}

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

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

  return (const REAL_B *)LALt;
}

static void build(MESH *mesh, U_CHAR flag)
{
  FUNCNAME("build");
  static const EL_MATRIX_INFO *matrix_info = NULL;
  static const QUAD           *quad = NULL;

  dof_compress(mesh);
  MSG("%d DOFs for %s\n", fe_space->admin->size_used, fe_space->name);

  if (!matrix_info) { /* information for matrix assembling         */
    static struct op_info user_data;
    OPERATOR_INFO         o_info = { NULL, };

    quad         = get_quadrature(MESH_DIM, 2*fe_space->bas_fcts->degree + 2);
    user_data.Lambda = MEM_ALLOC(quad->n_points, REAL_BD);
    user_data.det    = MEM_ALLOC(quad->n_points, REAL);

    o_info.quad[2]        = quad;
    o_info.row_fe_space   = o_info.col_fe_space = fe_space;
    o_info.init_element   = init_element;
    o_info.LALt.real      = LALt;
    o_info.LALt_symmetric = true;        /* symmetric assemblage is faster */
    o_info.user_data      = &user_data;  /* user data. */

    o_info.LALt_pw_const =
      (mesh->parametric == NULL) || mesh->parametric->not_all;

    o_info.fill_flag = CALL_LEAF_EL|FILL_COORDS; /* only FILL_BOUND is added
						  * automatically.
						  */
    matrix_info = fill_matrix_info(&o_info, NULL);
  }

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

#if DEBUG_MATRIX
  {
    REAL sum;
    
    sum = 0.0;
    FOR_ALL_DOFS(matrix->row_fe_space->admin,
		 FOR_ALL_MAT_COLS(REAL, matrix->matrix_row[dof],
				  sum += row->entry[col_idx]));
    MSG("Matrix sum: %e\n", sum);
  }    
#endif

  dof_set(0.0, f_h);                       /* assembling of load vector    */
  L2scp_fct_bas_loc(f_h, f_loc, NULL, 0, quad);

  /*  boundary values, the combination alpha_r < 0.0 flags automatic
   *  mean-value correction iff f_h has non-zero mean-value and no
   *  non-Neumann boundary conditions were detected during mesh
   *  traversal.
   */
  boundary_conditions_loc(NULL /* *matrix, only for Robin */,
			  f_h, u_h, NULL /* boundary-type vector */,
			  NULL /* Dirichlet bndry bit-mask */,
			  u_at_qp,
			  NULL /* gn_loc, inhomogenous Neumann conditions */,
			  NULL /* user-data */,
			  FILL_NOTHING /* fill_flags for g_loc(), gn_loc() */,
			  -1.0 /* alpha_r Robin b.c. */,
			  NULL /* bndry_quad */);

  return;
}

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

static void solve(MESH *mesh)
{
  FUNCNAME("solve");
  static REAL       tol = 1.e-8, ssor_omega = 1.0;
  static int        max_iter = 1000, info = 2, restart = 0, ssor_iter = 1;
  static OEM_PRECON icon = DiagPrecon;
  static OEM_SOLVER solver = NoSolver;
  const PRECON *precon;
  
  if (solver == NoSolver) {
    GET_PARAMETER(1, "solver", "%d", &solver);
    GET_PARAMETER(1, "solver tolerance", "%f", &tol);
    GET_PARAMETER(1, "solver precon", "%d", &icon);
    GET_PARAMETER(1, "solver max iteration", "%d", &max_iter);
    GET_PARAMETER(1, "solver info", "%d", &info);
    GET_PARAMETER(1, "precon ssor omega", "%f", &ssor_omega);
    GET_PARAMETER(1, "precon ssor iter", "%d", &ssor_iter);
    if (solver == GMRes)
      GET_PARAMETER(1, "solver restart", "%d", &restart);
  }
  precon = init_oem_precon(matrix, NULL, info, icon, ssor_omega, ssor_iter);
  oem_solve_s(matrix, NULL, f_h, u_h, solver, tol, precon, restart, max_iter, info);

  return;
}
#if 0
static void solve(MESH *mesh)
{
  FUNCNAME("solve");
  static REAL       tol = 1.e-8;
  static int        miter = 1000, info = 2, icon = 1, restart = 0;
  static OEM_SOLVER solver = NoSolver;

  if (solver == NoSolver) {
    GET_PARAMETER(1, "solver", "%d", &solver);
    GET_PARAMETER(1, "solver tolerance", "%f", &tol);
    GET_PARAMETER(1, "solver precon", "%d", &icon);
    GET_PARAMETER(1, "solver max iteration", "%d", &miter);
    GET_PARAMETER(1, "solver info", "%d", &info);
    if (solver == GMRes) {
      GET_PARAMETER(1, "solver restart", "%d", &restart);
    }
  }
  oem_solve_s(matrix, NULL, f_h, u_h, solver, tol, icon, restart, miter, info);//!!

  return;
}
#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 REAL res(const EL_INFO *el_info, const QUAD *quad, int iq,
		REAL uh_at_qp, const REAL_D grd_uh_at_qp)
{
  return -f_loc(el_info, quad, iq, NULL);
}

#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     norm = -1;
  static REAL    C[3] = {1.0, 1.0, 0.0};
  static REAL    est, est_old = -1.0, err, err_old = -1.0;
  static FLAGS   r_flag; /* = (INIT_UH | INIT_GRD_UH),  if needed by r() */
  static REAL_DD A;
  static const QUAD *quad;
  
  if (norm < 0) {
    int i;
    
    norm = H1_NORM;
    GET_PARAMETER(1, "error norm", "%d", &norm);
    GET_PARAMETER(1, "estimator C0", "%f", &C[0]);
    GET_PARAMETER(1, "estimator C1", "%f", &C[1]);
    GET_PARAMETER(1, "estimator C2", "%f", &C[2]);

    for (i = 0; i < DIM_OF_WORLD; i++) {
      A[i][i] = 1.0;
    }

    /* in principle we could leave out the following line and just
     * pass a NULL pointer to L2/H1_err_loc() below.
     */
    quad = get_quadrature(MESH_DIM, 2*u_h->fe_space->bas_fcts->degree);
  }

  est = ellipt_est(u_h, adapt, rw_el_est, NULL /* rw_est_c() */,
		   -1 /* quad_degree */,
		   norm, C,
		   (const REAL_D *) A, NULL,
		   res, r_flag, NULL /* gn() */, 0 /* gn_flag */);
  
  MSG("estimate   = %.8le", est);
  if (est_old >= 0) {
    print_msg(", EOC: %.2lf\n", EOC(est,est_old));
  } else {
    print_msg("\n");
  }
  est_old = est;

  if (norm == L2_NORM) {
    err = L2_err_loc(u_at_qp, NULL /* data */, FILL_NOTHING,
		     u_h, quad,
		     false /* rel_error */,
		     true /* mean-value correction */,
		     NULL /* rw_err_el */, NULL /* max_l2_err2 */);
  } else {
    err = H1_err_loc(grd_u_at_qp, NULL /* data */, FILL_NOTHING,
		     u_h, quad, false /* rel_error */,
		     NULL /* rw_err_el() */, NULL /* max_h1_err2 */);
  }

  MSG("||u-uh||%s = %.8le", norm == L2_NORM ? "L2" : "H1", err);
  if (err_old >= 0) {
    print_msg(", EOC: %.2lf\n", EOC(err,err_old));
  } else { 
    print_msg("\n");
  }
  err_old = err;

  MSG("||u-uh||%s/estimate = %.2lf\n", norm == L2_NORM ? "L2" : "H1",
      err/MAX(est,1.e-15));

  if (do_graphics) {
    togeomview(NULL /*mesh */,
	       u_h, 1.0, -1.0,
	       get_el_est, 1.0, -1.0,
	       u_loc, NULL, 0, 1.0, -1.0);
  }
  WAIT; /* controlled by "wait" parameter in INIT/ellipt-torus.dat */

  return adapt->err_sum;
}

/*******************************************************************************
 * Generate a mesh starting with a very coarse and degenerated
 * macro-triangulation: the diameter of the macro triangulation is
 * just h in direction of the smallest generating circle of the
 * Klein's bottle.
 *
 * We refine that initial temporay mesh two times, convert it back
 * into a macro triangulation, and use that refined macro
 * triangulation to generate the final mesh.
 *
 * A little bit complicated, but otherwise we would have to define a
 * macro triangulation with 135 vertices and 384 elements just to
 * resolve the geometry of the embedded Klein's bottle. (with diameter
 * ratios of 1:2:4).
 ******************************************************************************/
static MESH *make_mesh(const char *macro_name, int param_degree)
{
  MESH           *mesh, *mesh_tmp;
  const FE_SPACE *fe_space, *fe_space_tmp; /* for the explicit
					    * parameterisation
					    */
  const BAS_FCTS *lagrange;
  DOF_REAL_VEC   *param_tmp[MESH_DIM];
  MACRO_DATA     *data;
  MACRO_EL       *mel;
  int            i, j;

  /* read in the temporay degenerated mesh from disk */
  data = read_macro(macro_name);
  mesh_tmp = GET_MESH(MESH_DIM, "Temporary Degenerated Mesh", data,
		      init_node_proj, NULL /* init_wall_trafos */);

  /* define the parameterisation by an implicit uniform triangulation
   * of the parameter domain.
   */

  param_bfcts = get_lagrange(MESH_DIM, 1);
  fe_space_tmp = get_fe_space(mesh_tmp, param_bfcts->name,
			      param_bfcts, 1, ADM_FLAGS_DFLT);
  for (i = 0; i < MESH_DIM; i++) {
    /* actually param_tmp[], but we need param as global variable to
     * define the parameterisation.
     */
    param[i] = get_dof_real_vec("param at vertex", fe_space_tmp);
    param[i]->refine_interpol = param_bfcts->real_refine_inter;
    param[i]->coarse_restrict = param_bfcts->real_coarse_inter;
  }

  /* Assign the initial parameter values. This piece of code will
   * break if the macro triangulation is changed.
   */
  for (i = 0; i < mesh_tmp->n_macro_el; i++) {
    EL *el = mesh_tmp->macro_els[i].el;
    DOF dof[N_VERTICES(MESH_DIM)];

    GET_DOF_INDICES(param_bfcts, el, fe_space_tmp->admin, dof);
    for (j = 0; j < N_VERTICES(MESH_DIM); j++) {
      int v_nr = data->mel_vertices[i * N_VERTICES(MESH_DIM) + j];

#if MESH_DIM == 3 /* always */
      param[0]->vec[dof[j]] = (REAL)(v_nr % 5) * M_PI_2;
      param[1]->vec[dof[j]] = (REAL)((v_nr / 5) % 3) * M_PI;
      param[2]->vec[dof[j]] = (REAL)(v_nr / 15) * 2.0 * M_PI;
#elif MESH_DIM == 2
      param[0]->vec[dof[j]] = (REAL)(v_nr % 3) * M_PI;
      param[1]->vec[dof[j]] = (REAL)(v_nr / 3) * M_PI;
#elif MESH_DIM == 1
      param[0]->vec[dof[j]] = (REAL)(v_nr % 2) * M_PI;
#endif
    }
  }

  free_macro_data(data); /* no longer needed */

#if DEBUG_MESH_GENERATION
  if (do_graphics) {
    togeomview(
      mesh_tmp, NULL, 0.0, -1.0, NULL, 0.0, -1.0, NULL, NULL, 0, 0.0, -1.0);
    WAIT_REALLY;
  }
#endif

  /* Now refine the temporary mesh until it resolves the geometry of
   * the 3-manifold.  The initial mesh has just diameter h in
   * direction of the smallest generating circle, so we need to refine
   * two times; this will create a non-degenerated mesh with diameter
   * 4*h in direction of the smallest circle.
   */
  global_refine(mesh_tmp, 2 * mesh_tmp->dim, FILL_NOTHING);

#if DEBUG_MESH_GENERATION
  if (do_graphics) {
    togeomview(
      mesh_tmp, NULL, 0.0, -1.0, NULL, 0.0, -1.0, NULL, NULL, 0, 0.0, -1.0);
    WAIT_REALLY;
  }
#endif

  /* convert the beast into a macro-data structure */
  data = mesh2macro_data(mesh_tmp);

#if DEBUG_MESH_GENERATION
  write_macro(mesh_tmp, "Macro/blah.amc");
  WAIT_REALLY;  
#endif

  /* now generate the final mesh, we keep the original mesh until we
   * have copied over the parameter values at the vertices.
   *
   * This time we define a periodic structure on the mesh; the
   * parameterisation will remain non-periodic, while all
   * computational quantities (u_h, f_h, matrix) will be defined on a
   * periodic finite element space. init_wall_trafos() takes care of
   * defining the periodic structure.
   */
  mesh = GET_MESH(MESH_DIM, "ALBERTA mesh", data,
		  init_node_proj, init_wall_trafos);

  /* First allocate a standard finite element space; otherwise ALBERTA
   * will generate a periodic vertex admin per default, which would be
   * slightly inefficient for higher degree parameterisations.
   */
  lagrange = get_lagrange(MESH_DIM, param_degree);
  TEST_EXIT(lagrange, "no lagrange BAS_FCTS\n");
  fe_space = get_fe_space(mesh, lagrange->name, lagrange, 1, ADM_PERIODIC);

  /* kill the fe-space (no longer needed), the corresponding admin is
   * "sticky" and will survive
   */
  free_fe_space(fe_space);

  /* Define the new parameterisation by copying over the parameter
   * values from the temporary mesh. We exploit the feature that the
   * order of the elements of the macro triangulation coincides with
   * the ordering of elements during a leaf-level mesh-traversal of
   * the temporary mesh.
   *
   * This fe-space is non-periodic; it is used to store the paramter
   * values at the vertices.
   */
  fe_space =
    get_fe_space(mesh, param_bfcts->name, param_bfcts, 1, ADM_FLAGS_DFLT);
  for (i = 0; i < MESH_DIM; i++) {
    param_tmp[i] = param[i];
    param[i] = get_dof_real_vec("param at vertex", fe_space);
    param[i]->refine_interpol = param_bfcts->real_refine_inter;
    param[i]->coarse_restrict = param_bfcts->real_coarse_inter;
  }
  mel = mesh->macro_els;
  TRAVERSE_FIRST(mesh_tmp, -1, CALL_LEAF_EL) {
    DOF dof_tmp[N_VERTICES(MESH_DIM)];
    DOF dof[N_VERTICES(MESH_DIM)];
    EL  *el = mel->el;
    
    GET_DOF_INDICES(param_bfcts, el, fe_space->admin, dof);
    GET_DOF_INDICES(param_bfcts, el_info->el, fe_space_tmp->admin, dof_tmp);
    
    for (i = 0; i < MESH_DIM; i++) {
      for (j = 0; j < N_VERTICES(MESH_DIM); j++) {
	param[i]->vec[dof[j]] = param_tmp[i]->vec[dof_tmp[j]];
      }
    }
    
    ++mel;
    
  } TRAVERSE_NEXT();

  /* Clean-up all this temporary mess: */
  free_macro_data(data);
  for (i = 0; i < MESH_DIM; i++) {
    free_dof_real_vec(param_tmp[i]);
  }
  free_fe_space(fe_space_tmp);
  free_mesh(mesh_tmp);
  
  /* Initialize the leaf data for the storage of the estimate (why do
   * we not simply use a DOF_PTR_VEC with a center DOF-admin?)
   */
  init_leaf_data(mesh, sizeof(struct ellipt_leaf_data),
		 NULL /* refine_leaf_data */,
		 NULL /* coarsen_leaf_data */);

  /* Always use a parametric mesh, even for the linear case. Otherwise
   * we would have to use a non-periodic mesh and store the parameter
   * values of the vertices in the leaf-data structure. See
   * 3d/ellipt-moebius.c for an example.
   *
   * The coodinate functions are periodic finite element functions,
   * the parameterisation is kept in non-periodic finite element
   * functions.
   */
  use_lagrange_parametric(mesh, param_degree,
			  init_node_proj(NULL, NULL, 0),
			  PARAM_ALL|PARAM_PERIODIC_COORDS);

  return mesh;
}

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

int main(int argc, char **argv)
{
  FUNCNAME("main");
  MESH           *mesh;
  int            n_refine = 0, degree = 1, param_degree = -1;
  const BAS_FCTS *lagrange;
  ADAPT_STAT     *adapt;
  char           filename[PATH_MAX];

  /*****************************************************************************
   * first of all, initialize the access to parameters of the init file
   ****************************************************************************/
  parse_parameters(argc, argv, "INIT/ellipt-klein-3-bottle.dat");

  /*****************************************************************************
   * then read some basic parameters
   ****************************************************************************/
  GET_PARAMETER(1, "macro file name", "%s", filename);
  GET_PARAMETER(1, "polynomial degree", "%d", &degree);
  GET_PARAMETER(1, "global refinements", "%d", &n_refine);
  GET_PARAMETER(1, "parametric degree", "%d", &param_degree);
  GET_PARAMETER(1, "online graphics", "%d", &do_graphics);

  /*****************************************************************************
  *  get a mesh, and read the macro triangulation from file
  *
  *  In our case this is a two-step process: we first read in a
  *  degenerated mesh which does not resolve the embedded
  *  3-manifold. Then we refine the mesh two times globally. This
  *  yields a non-degenerated mesh with diameter 4*h in direction of
  *  the smallest generating circle of the Klein's bottle. We then
  *  convert this mesh back into a macro triangulation. From this
  *  macro triangulation we generate the final mesh. The first mesh is
  *  simply discarded. make_mesh() takes care of all this.
  *
  ****************************************************************************/
  mesh = make_mesh(filename, param_degree);

  /*****************************************************************************
   * Get the fe-space before calling global_refine() to reduce the startup-time.
   * Adding FE-spaces on refined meshes works but is somewhat inefficient.
   ****************************************************************************/
  lagrange = get_lagrange(MESH_DIM, degree);
  TEST_EXIT(lagrange, "no lagrange BAS_FCTS\n");
  fe_space = get_fe_space(mesh, lagrange->name,
			  lagrange, 1, ADM_PERIODIC);
  
  /*****************************************************************************
   * Globally refine the mesh a little bit. Maybe do some graphics
   * output to amuse the spectators.
   ****************************************************************************/
  global_refine(mesh, MESH_DIM*n_refine, FILL_NOTHING);

  if (do_graphics) {
    togeomview(
      mesh, NULL, 0.0, -1.0, NULL, 0.0, -1.0, NULL, NULL, 0, 0.0, -1.0);
    WAIT;
  }

  /*****************************************************************************
   *  initialize the global variables shared across build(), solve()
   *  and estimate().
   ****************************************************************************/
  matrix = get_dof_matrix("A", fe_space, NULL);
  f_h    = get_dof_real_vec("f_h", fe_space);
  u_h    = get_dof_real_vec("u_h", fe_space);
  u_h->refine_interpol = fe_space->bas_fcts->real_refine_inter;
  u_h->coarse_restrict = fe_space->bas_fcts->real_coarse_inter;
  dof_set(0.0, u_h);

  /*****************************************************************************
   *  init the adapt structure and start adaptive method
   ****************************************************************************/
  adapt = get_adapt_stat(MESH_DIM, "3d Klein's bottle" /* name */,
			 "adapt" /* prefix */, 2 /* info */,
			 NULL /* ADAPT_STAT storage area, optional */);
  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; /* should we? */

  return 0;
}

