/*******************************************************************************
 *
 * ALBERTA:  an Adaptive multi Level finite element toolbox  using
 *           Bisectioning refinement and Error control by Residual
 *           Techniques
 *
 * www.alberta-fem.de
 *
 * File:     ellipt-periodic.c
 *
 * Description:  solver for a simple Poisson equation on a periodic domain:
 *
 *                 -\Delta_\Gamma u = f
 *                                u = g  on \partial\Gamma
 *
 * The computational domain is either a topological torus or a
 * topological Klein's bottle (or whatever the name of it may be in
 * 3d).
 *
 ******************************************************************************
 *
 * this file's 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/alberta.h>

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

static bool do_graphics = true; /* global graphics "kill-switch" */

/* Enable extra code for testing sub-meshes of periodic meshes */
#define TEST_PERIODIC_SUBMESHES 0
/* Enable extra code for testing IO for periodic meshes */
#define TEST_RW_MESH 1

#define MESH_DIM MIN(DIM_OF_WORLD, 3)

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

/* Just to be able to switch problems dynamically */
struct problem 
{
  /* exact solution */
  REAL (*u)(const REAL_D x);
  /* its gradient */
  const REAL *(*grd_u)(const REAL_D x, REAL_D result);
  /* the boundary values (blah. that's just a duplicate of u() here) */
  REAL (*g)(const REAL_D x);
  /* the right hand side, i.e. -Delta u() */
  REAL (*f)(const REAL_D x);
  /* the wall transformations */
  AFF_TRAFO *wall_trafos;
};
static const struct problem *problem;

/*******************************************************************************
 * 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: either for a topological torus or a Klein's bottle
 ******************************************************************************/

/* The affine transformations that map the fundamental domain to its
 * periodic neighbour across a certain wall. init_wall_trafos() (just
 * in front of main(), see below) will invert these transformations as
 * needed.
 */
static AFF_TRAFO torus_wall_trafos[DIM_OF_WORLD] = {
#if DIM_OF_WORLD == 1
    { {{1.0}}, {2.0} },
#endif
#if DIM_OF_WORLD == 2
    { {{1.0, 0.0},
       {0.0, 1.0}}, {2.0, 0.0} },
    { {{1.0, 0.0},
       {0.0, 1.0}}, {0.0, 2.0} },
#endif
#if DIM_OF_WORLD == 3
    { {{1.0, 0.0, 0.0},
       {0.0, 1.0, 0.0},
       {0.0, 0.0, 1.0}}, {2.0, 0.0, 0.0} },
    { {{1.0, 0.0, 0.0},
       {0.0, 1.0, 0.0},
       {0.0, 0.0, 1.0}}, {0.0, 2.0, 0.0} },
    { {{1.0, 0.0, 0.0},
       {0.0, 1.0, 0.0},
       {0.0, 0.0, 1.0}}, {0.0, 0.0, 2.0} },
#endif
};

static AFF_TRAFO kleinsbottle_wall_trafos[DIM_OF_WORLD] = {
#if DIM_OF_WORLD == 1
  { {{1.0}}, {2.0} } /* not really a Klein's bottle ... */
#endif
#if DIM_OF_WORLD == 2
  { {{ 1.0, 0.0}, /* identify left and right edges */
     { 0.0, 1.0}},
    {2.0, 0.0} },
  { {{ -1.0, 0.0}, /* identify flipped top and bottom edges */
     { 0.0, 1.0}},
    {0.0, 2.0} },
#endif
#if DIM_OF_WORLD == 3
  { {{ 1.0, 0.0, 0.0},
     { 0.0, 1.0, 0.0},
     { 0.0, 0.0, 1.0}}, {2.0, 0.0, 0.0} },
  { {{ 1.0, 0.0, 0.0},
     { 0.0, 1.0, 0.0},
     { 0.0, 0.0, 1.0}}, {0.0, 2.0, 0.0} },
  { {{-1.0, 0.0, 0.0}, /* indentify reflected top and bottom */
     { 0.0, 1.0, 0.0},
     { 0.0, 0.0, 1.0}}, {0.0, 0.0, 2.0} }
#endif
};

/* 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_D K_NR = {
  K_X,
#if DIM_OF_WORLD > 1
  K_Y,
#endif
#if DIM_OF_WORLD > 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 a torus */
static REAL u_torus(const REAL_D x)
{
  REAL result;
  int i;

  result = sin(M_PI*K_NR[0]*x[0]+M_PI*PHASE_OFFSET*K_NR[0]);
  for (i = 1; i < DIM_OF_WORLD; i++) {
    result *= sin(M_PI*K_NR[i]*x[i]+M_PI*PHASE_OFFSET*K_NR[i]);
  }
  return result;
}

static const REAL *grd_u_torus(const REAL_D x, REAL_D grd)
{
  static REAL_D buffer; /* result space */
  REAL phase;
  int i;


  if (!grd) {
    grd = buffer;
  }

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

  return grd;
}

/* periodic function on a Klein's bottle */
static REAL u_kleinsbottle(const REAL_D x)
{
  REAL result;
#if DIM_OF_WORLD > 1
  int i;
  REAL k, phase;
#endif

  /* no phase-offset in x[0] direction */
  result = sin(M_PI*K_NR[0]*x[0]);
#if DIM_OF_WORLD > 1
  i     = DIM_OF_WORLD-1;
  k     = 2.0*K_NR[i]-1.0;
  phase = M_PI_2 * PHASE_OFFSET * k;
  result *= sin(M_PI_2*k*x[i] + phase);
#endif
#if DIM_OF_WORLD > 2
  result *= sin(M_PI*K_NR[1]*x[1] + M_PI*PHASE_OFFSET*K_NR[1]);
#endif

  return result;
}

static const REAL *grd_u_kleinsbottle(const REAL_D x, REAL_D grd)
{
  static REAL_D buffer; /* result space */
#if DIM_OF_WORLD > 1
  int i;
  REAL k, phase;
#endif

  if (!grd) {
    grd = buffer;
  }

  grd[0] = M_PI*K_NR[0]*cos(M_PI*K_NR[0]*x[0]);
#if DIM_OF_WORLD > 1
  i     = DIM_OF_WORLD-1;
  k     = (2*K_NR[i]-1.0);
  phase = M_PI_2 * PHASE_OFFSET * k;
  grd[0] *= sin(M_PI_2*(2*K_NR[i]-1.0)*x[i] + phase);
#endif
#if DIM_OF_WORLD > 2
  grd[0] *= sin(M_PI*K_NR[1]*x[1] + M_PI*PHASE_OFFSET*K_NR[1]);
#endif

#if DIM_OF_WORLD > 1
  i = DIM_OF_WORLD - 1;
  k     = (2*K_NR[i]-1.0);
  phase = M_PI_2 * PHASE_OFFSET * k;
  grd[i] = M_PI_2*k*cos(M_PI_2 * k * x[i] + phase);
  grd[i] *= sin(M_PI*K_NR[0]*x[0]);
#if DIM_OF_WORLD > 2
  grd[i] *= sin(M_PI*K_NR[1]*x[1] + M_PI*PHASE_OFFSET*K_NR[1]);
#endif
#endif

#if DIM_OF_WORLD > 2
  grd[1] =
    M_PI*K_NR[1]
    *
    cos(M_PI*K_NR[1]*x[1] + M_PI*PHASE_OFFSET*K_NR[1]);
  grd[1] *= sin(M_PI*K_NR[0]*x[0]);
  i     = DIM_OF_WORLD-1;
  k     = (2*K_NR[i]-1.0);
  phase = M_PI_2 * PHASE_OFFSET * k;
  grd[1] *= sin(M_PI_2*k*x[i] + phase);
#endif

  return grd;
}

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

static REAL f_torus(const REAL_D x) /* -Delta u, not optional */
{
  REAL result;
  int i;
  
  result = 0.0;
  for (i = 0; i < DIM_OF_WORLD; i++) {
    result += SQR(M_PI*K_NR[i]);
  }
  result *= u_torus(x);

  return result;
}

static REAL f_kleinsbottle(const REAL_D x) /* -Delta u, not optional */
{
  REAL result;
#if DIM_OF_WORLD > 1
  REAL k /* , phase */;
  int i;
#endif

  result = SQR(M_PI*K_NR[0]);
#if DIM_OF_WORLD > 1
  i     = DIM_OF_WORLD-1;
  k     = (2*K_NR[i]-1.0);
  /*phase = M_PI_2 * PHASE_OFFSET * k; not needed here */
  result += SQR(M_PI_2*k);
#endif
#if DIM_OF_WORLD > 2
  result += SQR(M_PI*K_NR[1]);
#endif

  result *= u_kleinsbottle(x);

  return result;
}

/* Just to be able to switch problems dynamically */
static const struct problem problems[] = {
  {
    u_torus, grd_u_torus, u_torus, f_torus,
    torus_wall_trafos
  },
  {
    u_kleinsbottle, grd_u_kleinsbottle, u_kleinsbottle, f_kleinsbottle,
    kleinsbottle_wall_trafos
  }
};

/*******************************************************************************
 * 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() ("operator data").
 * init_element(): initialization on the element; calculates the
 *                 coordinates and |det DF_S| used by LALt; passes these
 *                 values to LALt via op_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; /*  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;

  /* ..._0cd: co-dimension 0 version of el_grd_lambda(dim, ...) */
  info->det = el_grd_lambda_0cd(el_info, info->Lambda);

  return false; /* not parametric */
}

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

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

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

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

    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_pw_const  = true;        /* pw const. assemblage is faster */
    o_info.LALt_symmetric = true;        /* symmetric assemblage is faster */
    o_info.user_data = (void *)&op_data; /* application data */
    o_info.fill_flag = CALL_LEAF_EL|FILL_COORDS; /* only FILL_BOUND is added
						  * automatically.
						  */

    matrix_info = fill_matrix_info(&o_info, NULL);
  }

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

  /* assembling of load vector */
  dof_set(0.0, f_h);
  quad = get_quadrature(mesh->dim, 2*fe_space->bas_fcts->degree - 2);
  L2scp_fct_bas(problem->f, quad, f_h);

  /* 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.
   *
   * We have no real boundary; it would be, of course, possible to
   * combine ordinary and periodic boundary conditions (e.g. periodic
   * in one direction, Dirichlet b.c. on the remaining boundaries).
   */
  boundary_conditions(NULL /* matrix, only for Robin */,
		      f_h, u_h, NULL /* bound */,
		      NULL /* Dirichlet mask */,
		      NULL /* g, inhomogeneous Dirichlet conditions */,
		      NULL /* gn, inhomogeneous Neumann conditions */,
		      -1.0 /* alpha_r, Robin b.c. */,
		      NULL /* bndry_quad, for gn (Robin/Neumann) */);
}


/*******************************************************************************
 * 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);
  
  if (do_graphics) {
    graphics(mesh, u_h, NULL /* get_el_est() */, problem->u, HUGE_VAL);
  }
}


/*******************************************************************************
 * 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)
{
  REAL_D      x;

  coord_to_world(el_info, quad->lambda[iq], x);
  return -problem->f(x);
}

#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     degree, 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() */
  REAL_DD        A = {{0.0}};
  int            n;
  const QUAD     *quad;

  for (n = 0; n < DIM_OF_WORLD; n++)
    A[n][n] = 1.0;   /* set diogonal of A; all other elements are zero */

  if (norm < 0)
  {
    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]);
  }
  degree = 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 /* Dirichlet mask */,
		   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;

  quad = get_quadrature(mesh->dim, degree);
  if (norm == L2_NORM)
    err = L2_err(problem->u, u_h, quad,
		 false /* relative error*/,
		 true /* mean-value adjust */,
		 NULL /* rw_err_el()*/, NULL /* max_err_el2 */);
  else
    err = H1_err(problem->grd_u, u_h, quad, false /* relative error */,
		 NULL /* rw_err_el()*/, NULL /* max_err_el2 */);

  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) {
    graphics(mesh, NULL /* u_h */, get_el_est, NULL /* u_exact() */, HUGE_VAL);
  }
  
  return adapt->err_sum;
}

#if 0
/*******************************************************************************
 * initialization of wall-transformations.
 *
 * The wall (face) transformations can also be specified in the macro
 * macro-triangulation; hence the "#if 0".
 ******************************************************************************/

static AFF_TRAFO *init_wall_trafos(MESH *mesh, MACRO_EL *mel, int wall)
{
  static AFF_TRAFO inverse_wall_trafos[DIM_OF_WORLD];
  static int init_done;
  
  if (!init_done) {
    int i, j, k;

    init_done = true;

    /* ALBERTA does not invert the wall-transformation by itself, so
     * we have to do that ourselves here. This piece of code is, of
     * course, overly complicated for our simple case. But this is the
     * way a general case could be handled. Wall-transformation MUST
     * BE isometries, i.e. the inverse of the matrix is just its
     * transpose, the translation is transformed by the transpose of
     * the matrix and negated.
     */
    for (i = 0; i < DIM_OF_WORLD; i++) {
      for (j = 0; j < DIM_OF_WORLD; j++) {
	inverse_wall_trafos[i].t[j] = 0.0;
	for (k = 0; k < DIM_OF_WORLD; k++) {
	  inverse_wall_trafos[i].M[j][k] = problem->wall_trafos[i].M[k][j];
	  inverse_wall_trafos[i].t[j] -=
	  problem->wall_trafos[i].M[k][j] * problem->wall_trafos[i].t[k];
	}
      }
    }
  }

  switch (mel->wall_bound[wall]) {
  case 1: /* translation in x[0] direction */
    if (mel->coord[(wall+1) % N_VERTICES(MESH_DIM)][0] > 0.0) {
      /* actually == 1.0 */
      return &problem->wall_trafos[0];
    } else {
      return &inverse_wall_trafos[0];
    }
  case 2: /* translation in x[1] direction (+ possible reflection) */
    if (mel->coord[(wall+1) % N_VERTICES(MESH_DIM)][1] > 0.0) {
      /* actually == 1.0 */
      return &problem->wall_trafos[1];
    } else {
      return &inverse_wall_trafos[1];
    }
  case 3: /* translation in x[2] + reflection about x[0] == 0 */
    if (mel->coord[(wall+1) % N_VERTICES(MESH_DIM)][2] > 0.0) {
      /* actually == 1.0 */
      return &problem->wall_trafos[2];
    } else {
      return &inverse_wall_trafos[2];
    }
  }

  return NULL;
}
#endif

#if TEST_PERIODIC_SUBMESHES
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);

/* The submesh is spanned by all peridic boundary simplexes; it should
 * inherit part of the periodic structure of the master-mesh.
 *
 * Note, however, that a submesh of a periodic master-mesh must not
 * contain simplexes which are mapped to each other by the
 * wall-transformations of the master mesh.
 *
 * The example below chooses just one periodic wall as sub-mesh, which
 * then again a topological torus or a Klein's bottle.
 */
static int periodic_bndry_binding_method(MESH *master,
					 MACRO_EL *mel, int face, void *ud)
{
  if (mel->wall_bound[face] == master->dim &&
      mel->coord[(face + 1) % N_VERTICES(master->dim)][DIM_OF_WORLD-1] == -1.0) {
    return true;
  } else {
    return false;
  }
}
#endif

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

int main(int argc, char **argv)
{
  FUNCNAME("main");
  MACRO_DATA     *data;
  MESH           *mesh;
  int            n_refine = 0, dim, degree = 1;
  unsigned int   probnr = 0;
  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-periodic.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, "online graphics", "%d", &do_graphics);
  
  /*****************************************************************************
   * initialize the test-problem
   ****************************************************************************/
  GET_PARAMETER(1, "problem number", "%d", &probnr);

  TEST_EXIT(probnr < sizeof(problems)/sizeof(*problems),
	    "Not so many test-problems: %d (only %d)\n",
	    probnr, sizeof(problems)/sizeof(*problems));
  problem = &problems[probnr];

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

  init_leaf_data(mesh, sizeof(struct ellipt_leaf_data),
		 NULL /* refine_leaf_data() */,
		 NULL /* coarsen_leaf_data() */);

  /*****************************************************************************
   * periodic boundary conditions are implemented by really
   * identifying DOFs; all what the application needs to do is to pass
   * the "ADM_PERIODIC" flag to get_fe_space(). The hard work is
   * hidden in ALBERTA's internals -- and of course in the proper
   * definition of the periodic mesh by defining consistent wall
   * transformations.
   ****************************************************************************/
  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);

  global_refine(mesh, n_refine * mesh->dim, 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) {
    graphics(mesh, NULL /* u_h */, NULL /* get_est()*/ , NULL /* u_exact() */,
	     HUGE_VAL /* time */);
  }

  /*****************************************************************************
   *  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 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 TEST_PERIODIC_SUBMESHES
  {
    MESH *slave;
    const FE_SPACE *s_fe_space;
    DOF_REAL_VEC *uh_trace;

    MSG("Proceeding with a test for periodic sub-meshes.\n");
    WAIT_REALLY;

    slave = get_submesh(mesh, "periodic slave-mesh",
			periodic_bndry_binding_method, NULL);

    s_fe_space = get_fe_space(slave,
			      lagrange->trace_bas_fcts->name,
			      lagrange->trace_bas_fcts, 1, ADM_PERIODIC);
    uh_trace = get_dof_real_vec("trace u_h", s_fe_space);
    trace_dof_real_vec(uh_trace, u_h);

    togeomview(slave,
	       uh_trace, 1.0, 0.0,
	       NULL, 0.0, 0.0,
	       NULL, NULL, 0, 0.0, 0.0);
  }
#endif

  WAIT_REALLY;
    
  return 0;
}
