/*******************************************************************************
 *
 * ALBERTA:  an Adaptive multi Level finite element toolbox  using
 *           Bisectioning refinement and Error control by Residual
 *           Techniques
 *
 * www.alberta-fem.de
 *
 * File:     ellipt-torus.c
 *
 * Description:  solver for a simple Poisson equation on an embedded torus:
 *
 *                 -\Delta_\Gamma u = f
 *                                u = g  on \partial\Gamma
 *
 * The computational domain is a torus embedded into \R^n, n = 2,3,4,
 * the mesh itself is periodic with periodic co-ordinate information,
 * the parameterisation is stored in the vertices of the mesh in
 * non-periodic linear FE-functions (the resulting parameterisation
 * is, of course, not linear).
 *
 ******************************************************************************
 *
 * 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
 *
 * (c) by C.-J. Heine (2006-2007)
 *
 * Based on the famous ellipt.c demo-program by K.G. Siebert and A. Schmidt.
 *
 ******************************************************************************/

#include "alberta-demo.h" /* proto-types for some helper functions */

static bool do_graphics = true;

#ifndef MESH_DIM
# define MESH_DIM MIN(DIM_OF_WORLD-1, DIM_MAX)
#endif

/* Enable extra code for testing IO for parametric meshes */
#define TEST_RW_MESH 0

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

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 torus. 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;
static REAL radius[MESH_DIM] = {
  1.0,
#if MESH_DIM > 1
  0.5,
#endif
#if MESH_DIM > 2
  0.25
#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]);
    }
    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 for an embedded torus.
 ******************************************************************************/

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

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

static REAL K_NR[MESH_DIM] = {
  K_X,
#if MESH_DIM > 1
  K_Y,
#endif
#if MESH_DIM > 2
  K_Z
#endif
};

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

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

/* periodic function on the torus, defined over the parameter domain
 * (variable s). Each component of s ranges between 0 and 2\pi.
 */
static REAL u(const REAL s[MESH_DIM])
{
  REAL result;
  int i;

  result = sin(K_NR[0]*s[0]+PHASE_OFFSET*K_NR[0]);
  for (i = 1; i < MESH_DIM; i++) {
    result *= sin(K_NR[i]*s[i]+PHASE_OFFSET*K_NR[i]);
  }
  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);
}

/* Derivatives w.r.t. to the parameterisation */
static const REAL *grd_u(const REAL s[MESH_DIM], REAL grd[MESH_DIM])
{
  static REAL_B _grd;
  REAL phase;
  int i;
  
  if (!grd) {
    grd = _grd;
  }

  phase = PHASE_OFFSET * K_NR[0];
  grd[0] = K_NR[0]*cos(K_NR[0]*s[0] + phase);
  for (i = 1; i < MESH_DIM; i++) {
    phase = PHASE_OFFSET * K_NR[i];
    grd[0] *= sin(K_NR[i]*s[i] + phase);
  }
  for (i = 1; i < MESH_DIM; i++) {
    phase = PHASE_OFFSET * K_NR[i];
    grd[i] = K_NR[i]*cos(K_NR[i]*s[i] + phase);
    phase = PHASE_OFFSET * K_NR[0];
    grd[i] *= sin(K_NR[0]*s[0] + phase);
#if MESH_DIM > 2
    phase = PHASE_OFFSET * K_NR[3-i];
    grd[i] *= sin(K_NR[3-i]*s[3-i] + phase);
#endif
  }

  return grd;
}

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, grd_bar;
  REAL   s[MESH_DIM];
  REAL   grd[MESH_DIM];
  
  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], quad->lambda[iq]);
  }

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

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

/* f is not so easy, unluckily:
 *
 * \Delta_\Gamma u(s, t)
 * =
 * \frac1{\sqrt{|g|}}\partial_i(\sqrt{|g|}g^{ij}\partial_j u)
 *
 * The metric tensor of the torus in the given parameterisation is,
 * however, quite simple and given by the following diagonal matrix
 * (3d case):
 *
 * g_{0,0} = (R_0 + (R_1 + R_2 cos(s_2)) cos(s_1))^2,
 * g_{1,1} = (R_1 + R_2 cos(s_2))^2,
 * g_{2,2} = R_2^2
 */
static REAL f(const REAL s[MESH_DIM])
{
  REAL result;
  REAL gg[MESH_DIM] = { 0.0, }; /* sqrt{g_{ii}} */
#if MESH_DIM > 1
  REAL Dgg[MESH_DIM][MESH_DIM] = { {0.0, }, };
#endif
  REAL g;
  REAL Du[MESH_DIM], D2u[MESH_DIM];
  int i, j;

  for (i = MESH_DIM-1; i >= 0; --i) {
    gg[i] += radius[i];
    for (j = 0; j < i; j++) {
      gg[j] += radius[i];
      gg[j] *= cos(s[i]);
    }
  }
  /* just too lazy to wrap it into a loop ... */
#if MESH_DIM > 2
  Dgg[2][1] = - radius[2] * sin(s[2]);
  Dgg[2][0] = Dgg[2][1] * cos(s[1]);
#endif
#if MESH_DIM > 1
  Dgg[1][0] = - gg[1] * sin(s[1]);
#endif

  g = gg[0];
  for (i = 1; i < MESH_DIM; i++) {
    g *= gg[i];
  }

  grd_u(s, Du);

  D2u[0] = -SQR(K_NR[0]) * sin(K_NR[0]*s[0]+PHASE_OFFSET*K_NR[0]);
  for (i = 1; i < MESH_DIM; i++) {
    D2u[0] *= sin(K_NR[i]*s[i]+PHASE_OFFSET*K_NR[i]);
  }
  for (i = 1; i < MESH_DIM; i++) {
    D2u[i]  = -SQR(K_NR[i]) * sin(K_NR[i]*s[i]+PHASE_OFFSET*K_NR[i]);
    D2u[i] *= sin(K_NR[0]*s[0]+PHASE_OFFSET*K_NR[0]);
#if MESH_DIM > 2
    D2u[i] *= sin(K_NR[3-i]*s[3-i]+PHASE_OFFSET*K_NR[3-i]);
#endif
  }

  /* g does not depend on s_0: */
  result  = D2u[0]/SQR(gg[0]);
#if MESH_DIM > 1
  result += D2u[1]/SQR(gg[1]);
  result += Dgg[1][0]/gg[0]/SQR(gg[1])*Du[1];
#endif
#if MESH_DIM > 2
  result += D2u[2]/SQR(gg[2]);
  result += Dgg[2][0]/gg[0]/SQR(gg[2])*Du[2];
  result += Dgg[2][1]/gg[1]/SQR(gg[2])*Du[2];
#endif

  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").
 *
 * 1d: x = R \cos(\phi)
 *     y = R \sin(\phi)
 *
 * 2d: x = (R + r \cos(\psi)) \cos(\phi)
 *     y = (R + r \cos(\psi)) \sin(\phi)
 *     z =      r \sin(\psi)
 *
 * 3d: x = (R + (r + s\cos(\theta)) \cos(\psi))\cos(\phi)
 *     y = (R + (r + s\cos(\theta)) \cos(\psi))\sin(\phi)
 *     z =      (r + s\cos(\theta)) \sin(\psi)
 *     w =           s\sin(\theta)
 *
 ******************************************************************************/
static void torus_proj_func(REAL_D vertex,
			    const EL_INFO *el_info,
			    const REAL_B lambda)
{
  int i, j;
  REAL_B *param_v;
  REAL   param[MESH_DIM];

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

  /* ... then compute the parameterisation of the torus. */
  SET_DOW(0.0, vertex);

  for (i = MESH_DIM; i > 0; i--) {
    vertex[i] += radius[i-1];
    vertex[i] *= sin(param[i-1]);
    
    for (j = 0; j < i; j++) {
      vertex[j] += radius[i-1];
      vertex[j] *= cos(param[i-1]);
    }
  }
}

/* init_node_projection() for the macro nodes. 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 = { torus_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
 * torus here.
 *
 ******************************************************************************/
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_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()
 *
 ******************************************************************************/

struct op_data
{
  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_data *info = (struct op_data *)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 {
    /* This is the case where either the "new_coord()" componenent of
     * the mesh-elements is used to store the parametric co-ordinates,
     * or we use a linear finite element function to store the
     * co-ordinates at the vertices of the triangulation. In either
     * case we can use the ordinary el_grd_lambda() function because
     * parametric-init_element() is required to fill el_info->coord
     * for affine elements.
     */
    *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_data *info = (struct op_data *)ud;
  int            i, j;
  static REAL_BB LALt;

  /* We always use det[iq], Lambda[iq], though in the case of a
   * p.w. linear parameterisation det[iq] and Lambda[iq] are note
   * initialized for "iq > 0". This is safe, because the assemble
   * machinery only calls us with "iq == 0" in the p.w. linear case.
   */
  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;
  static const QUAD           *quad;

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

  /* initialize information for matrix assembling */
  if (!matrix_info) {
    static struct op_data user_data; /* storage for det and Lambda */
    OPERATOR_INFO  o_info = { NULL, };

    if (mesh->parametric && !mesh->parametric->not_all) {
      quad = get_quadrature(MESH_DIM, 2*fe_space->bas_fcts->degree + 2);
    } else {
      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 = (void *)&user_data; /* user data */

    /* We set "pw_const" in the case of a p.w. linear
     * parameterisation. This also makes sure that in this case
     * LALt(..., iq, ...) is only called with iq == 0.
     */
    o_info.LALt_pw_const =
      (mesh->parametric == NULL) || mesh->parametric->not_all;

    /* only FILL_BOUND is added automatically. */
    o_info.fill_flag = CALL_LEAF_EL|FILL_COORDS;

    matrix_info = fill_matrix_info(&o_info, NULL);
  }

  /* assembling of matrix */
  clear_dof_matrix(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

  /* assembling of load vector */
  dof_set(0.0, f_h);
  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 */);
  
#if 1
  {
    REAL volume = 0.0;
    REAL det[quad->n_points_max];
    REAL_BD Lambda[quad->n_points_max];    
    PARAMETRIC *parametric = fe_space->mesh->parametric;
    int i;

    TRAVERSE_FIRST(fe_space->mesh, -1, FILL_COORDS|CALL_LEAF_EL) {
      
      parametric->init_element(el_info, parametric);
  
      parametric->grd_lambda(el_info, quad, 0, NULL, Lambda, NULL, det);

      for (i = 0; i < quad->n_points; i++) {
	volume += quad->w[i]*det[i];
      }

    } TRAVERSE_NEXT();

    MSG("Volume: %e.\n", volume);
  }
#endif
}

/*******************************************************************************
 * 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, ilu_k = 8;
  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);
    if (icon == __SSORPrecon) {
    	GET_PARAMETER(1, "precon ssor omega", "%f", &ssor_omega);
    	GET_PARAMETER(1, "precon ssor iter", "%d", &ssor_iter);
    }
    if (icon == ILUkPrecon)
        GET_PARAMETER(1, "precon ilu(k)", "%d", &ilu_k);
    if (solver == GMRes) {
      GET_PARAMETER(1, "solver restart", "%d", &restart);
    }
  }
  
  if (icon == ILUkPrecon)
	  precon = init_oem_precon(matrix, NULL, info, ILUkPrecon, ilu_k);
  else
	  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);
}

/*******************************************************************************
 * 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 r(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 = 0;  /* = (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;
    }

    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,
		   r, 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 original macro
 * triangulation is just h in direction of the smallest generating
 * circle of the torus; this is not enough to resolve the geometry of
 * the torus in the sense that the resulting mesh is even only an
 * immersed C^{0,1} manifold.
 *
 * Therefore: 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 an embedded 3-torus (with diameter ratios
 * of 1:2:4).
 ******************************************************************************/
static MESH *make_mesh(const char *macro_name, int param_degree)
{
#if DEBUG_MESH_GENERATION
  FUNCNAME("make_mesh");
#endif
  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      
      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) * 2.0 * M_PI;
#elif MESH_DIM == 1
      param[0]->vec[dof[j]] = (REAL)(v_nr % 2) * 2.0 * 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 torus.  The initial mesh has just diameter h in direction of
   * the smallest 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);
  free_fe_space(fe_space); /* kill the fe-space (no longer needed), the
			    * corresponding admin is "sticky" and will survive
			    */

  /* 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.
   */
  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;
  const BAS_FCTS *lagrange;
  int            n_refine = 0, dim = MESH_DIM, degree = 1, param_degree = -1;
  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-torus.dat");

  /*****************************************************************************
   * then read some basic parameters
   ****************************************************************************/
  GET_PARAMETER(1, "mesh dimension", "%d", &dim);
  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 torus. Then
   *  we refine the mesh two times globally. This yields a
   *  non-degenerated mesh with diameter 4*h in direction of the
   *  smallest circle. 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 TEST_RW_MESH
  write_mesh_xdr(mesh, "foobar.mesh", HUGE_VAL);
  free_mesh(mesh);
  free_fe_space(fe_space);
  mesh = read_mesh_xdr("foobar.mesh", NULL,
		       NULL /* init_node_projection() */, NULL /* master */);
  init_leaf_data(mesh, sizeof(struct ellipt_leaf_data),
		 NULL /* refine_leaf_data() */,
		 NULL /* coarsen_leaf_data() */);
  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);
#endif

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

#if TEST_RW_MESH
  return 0;
#endif

  /*****************************************************************************
   *  initialize the global variables shared across build(), solve()
   *  and estimate().
   ****************************************************************************/
  matrix = get_dof_matrix("A", fe_space, NULL /* col_fe_space */);
  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);      /* initialize u_h */

  /*****************************************************************************
   *  init the adapt structure and start adaptive method
   ****************************************************************************/

  adapt = get_adapt_stat(mesh->dim, "ellipt", "adapt", 2,
			 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);

  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_REALLY; /* should we? */

  return 0;
}
