/*******************************************************************************
 *
 * ALBERTA:  an Adaptive multi Level finite element toolbox  using
 *           Bisectioning refinement and Error control by Residual
 *           Techniques
 *
 * www.alberta-fem.de
 *
 * File:     stokes.c
 *
 * Description:  solver for a simple Poisson equation on a Moebius strip:
 *
 *                 -\Delta_\Gamma u = f
 *                                u = g  on \partial\Gamma
 *
 ******************************************************************************
 *
 * 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 "../Common/alberta-demo.h"

#if DIM_OF_WORLD != 3
# error This is a test program for a Moebius strip, embedded into 3d
#endif

#define MESH_DIM 2 /* To avoid a literal 2 */

static int do_graphics = true;

/*******************************************************************************
 * global variables: finite element space, discrete solution
 *                   load vector and system matrix
 *
 * These variables are kept global because they are shared across build(),
 * solve() and estimate().
 ******************************************************************************/

static const FE_SPACE *fe_space;         /* initialized by main()           */
static DOF_REAL_VEC   *u_h = NULL;        /* initialized by build()          */
static DOF_REAL_VEC   *f_h = NULL;        /* initialized by build()          */
static DOF_MATRIX     *matrix = NULL;     /* initialized by build()          */

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

/*******************************************************************************
 * 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()
 *
 * We also (mis-) use the leaf-data to store the parameter values of
 * the parameterisation of the Moebius strip at the vertices of each
 * triangle. This can be done more elegantly by using non-periodic
 * finite element functions on a periodic mesh, see
 * src/Common/ellipt-torus.c, src/4d/ellipt-klein-bottle.c,
 * src/5d/ellipt-klein-3-bottle.c
 *
 * The way it is done here also serves as a test-case for the
 * refine_leaf_data(), coarsen_leaf_data() hooks which can be
 * installed into the mesh. See below.
 *
 ******************************************************************************/

struct moebius_leaf_data
{
  /* one real for the estimate, keep this as first element */
  REAL estimate;

  /* Keep the parameter values for the vertices in order to define the
   * projections
   */
  REAL theta[N_VERTICES_2D], t[N_VERTICES_2D];
};

/* We use an explicit parameterisation of the Moebius-strip. To do
 * this efficiently, we store the values of the parameterisation of
 * the vertices in the leaf-data.
 *
 * We need to propagate this information to the children during
 * mesh-refinement ...
 */
static void moebius_refine_ld(EL *parent, EL *child[2])
{
  struct moebius_leaf_data *pld = LEAF_DATA(parent);
  struct moebius_leaf_data *cld[2] = {
    LEAF_DATA(child[0]), LEAF_DATA(child[1]) 
  };

  cld[0]->theta[0] = cld[1]->theta[1] = pld->theta[2];
  cld[0]->theta[1] = pld->theta[0];
  cld[1]->theta[0] = pld->theta[1];
  cld[0]->theta[2] = cld[1]->theta[2] = 0.5 * (pld->theta[0] + pld->theta[1]);

  cld[0]->t[0] = cld[1]->t[1] = pld->t[2];
  cld[0]->t[1] = pld->t[0];
  cld[1]->t[0] = pld->t[1];
  cld[0]->t[2] = cld[1]->t[2] = 0.5 * (pld->t[0] + pld->t[1]);
}

/* ... and to the parents during coarsening. 
 *
 * moebius_refine|coarsen_ld() are passed as refine- and coarsen-hooks
 * to ALBERTA's init_leaf_data() function, see main().
 */
void moebius_coarsen_ld(EL *parent, EL *child[2])
{
  struct moebius_leaf_data *pld = LEAF_DATA(parent);
  struct moebius_leaf_data *cld[2] = {
    LEAF_DATA(child[0]), LEAF_DATA(child[1]) 
  };

  pld->theta[0] = cld[0]->theta[1];
  pld->theta[1] = cld[1]->theta[0];
  pld->theta[2] = cld[0]->theta[0];

  pld->t[0] = cld[0]->t[1];
  pld->t[1] = cld[1]->t[0];
  pld->t[2] = cld[0]->t[0];
}

static REAL *rw_el_est(EL *el)
{
  if (IS_LEAF_EL(el))
    return &((struct moebius_leaf_data *)LEAF_DATA(el))->estimate;
  else
    return NULL;
}

static REAL get_el_est(EL *el)
{
  if (IS_LEAF_EL(el))
    return ((struct moebius_leaf_data *)LEAF_DATA(el))->estimate;
  else
    return 0.0;
}

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

/* u() in terms of the parameter values */
static REAL u(REAL theta, REAL t)
{
  return sin(4.0*theta)*exp(-10.0*SQR(t));
}

/* u() as it is passed to H1/L2_error_loc(). u_loc() first extracts
 * the parameter values at the vertices out of the leaf-data of the
 * given element, and then interpolates the parameters linearly
 * according to the barycentric co-ordinates "lambda". Finally the
 * interpolated parameter values are fed into u(theta, t).
 */
static REAL u_loc(const EL_INFO *el_info, const REAL_B lambda, void *ud)
{
  struct moebius_leaf_data *mld = LEAF_DATA(el_info->el);
  REAL theta, t;
  
  theta = SCP_BAR(MESH_DIM-1, mld->theta, lambda);
  t     = SCP_BAR(MESH_DIM-1, mld->t, lambda);

  return u(theta, t);
}

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.
 */
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;
  struct moebius_leaf_data *mld = LEAF_DATA(el_info->el);
  REAL theta, t, u_t, u_th;
  REAL_B grd_bar;
  int i;
  const REAL *lambda = quad->lambda[iq];
  
  theta = SCP_BAR(MESH_DIM-1, mld->theta, lambda);
  t     = SCP_BAR(MESH_DIM-1, mld->t, lambda);

  if (!result) {
    result = _result;
  }

  u_th = 4.0*cos(4.0*theta)*exp(-10.0*SQR(t));
  u_t  = -20.0*t*u(theta, t);

  for (i = 0; i < N_VERTICES(MESH_DIM); i++) {
    grd_bar[i] = mld->theta[i] * u_th + mld->t[i] * u_t;
  }
  for (; i < N_VERTICES(DIM_OF_WORLD); i++) {
    grd_bar[i] = 0.0;
  }

  GRAD_DOW(MESH_DIM, Lambda, grd_bar, result);

  return result;
}

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

/* Boundary values: */
static REAL g_at_qp(const EL_INFO *el_info, const QUAD *quad, int iq, void *ud)
{
  return u_at_qp(el_info, quad, iq, ud);
}

/* The "right hand side" f is not so easy, unluckily. We have to
 * apply the Laplace-Beltrami operator to u:
 *
 * \Delta_\Gamma u(theta, t)
 * =
 * \frac1{\sqrt{|g|}}\partial_i(\sqrt{|g|}g^{ij}\partial_j u)
 * =
 * \frac1{|g|}\partial_\theta^2 u + \partial_t^2 u
 * +
 * \frac1{|g|}(t/4+\cos(\theta/2)\,(1+t\,\cos(\theta/2)))\partial_t u
 * +
 * \frac1{|g|^2}(\frac12\sin(\theta/2)\,(1+t\,\cos(\theta/2)))\partial_\theta u
 *
 * |g|=(1+t\,\cos(\theta/2))^2
 *
 * First f() in terms of the parameter values ...
 */
static REAL f(REAL theta, REAL t)
{
  REAL uval = u(theta, t);
  REAL u_tt, u_thth, u_t, u_th, detg;

  u_t    = -20.0*t*uval;
  u_th   = 4.0*cos(4.0*theta)*exp(-10.0*SQR(t));
  u_tt   = (400.0*SQR(t)-20.0)*uval;
  u_thth = -16.0*uval;
  detg   = SQR(t)/4.0 + SQR(1.0+t*cos(theta/2.0));
  
  return -(u_tt+u_thth/detg
	   +
	   1.0/detg*(t/4.0+cos(theta/2.0)*(1.0+t*cos(theta/2.0)))*u_t
	   +
	   1.0/SQR(detg)*(0.5*t*sin(theta/2.0)*(1.0+t*cos(theta/2.0)))*u_th);
}

/* ... and then the function f_loc() which is passed to
 * l2scp_loc(). f_loc() first fetches the parameter values at the
 * vertices out of the leaf-data the element, interpolates them
 * linearly according to "lambda" and then calls f().
 */
static REAL f_loc(const EL_INFO *el_info, const QUAD *quad, int iq, void *ud)
{
  struct moebius_leaf_data *mld = LEAF_DATA(el_info->el);
  REAL theta, t;
  
  theta = SCP_BAR(MESH_DIM-1, mld->theta, quad->lambda[iq]);
  t     = SCP_BAR(MESH_DIM-1, mld->t, quad->lambda[iq]);

  return f(theta, t);
}

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

/* 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").
 *
 * We use the following parameterisation:
 *
 * x_0 = \cos(\theta) + t*\cos(\theta/2)*\cos(\theta)
 * x_1 = \sin(\theta) + t*\cos(\theta/2)*\sin(\theta)
 * x_2 =                t*\sin(\theta/2)
 *
 */
static void moebius_proj_func(REAL_D vertex,
			      const EL_INFO *eli, 
			      const REAL_B lambda)
{
  REAL t, theta, costh, sinth, costh2, sinth2;

  /* Note: during refinement we may be called without leaf-data; in
   * that case we have to use the child's leaf-data and transform the
   * barycentric coordinates.
   */
  if (eli->el->child[0]) {
    struct moebius_leaf_data *mld;
    REAL_B clambda;

    if (lambda[0] > lambda[1]) {
      mld = LEAF_DATA(eli->el->child[0]);

      clambda[0] = lambda[2];
      clambda[1] = 1.0 * lambda[0] - 1.0*lambda[1];
      clambda[2] = 2.0 * lambda[1];
    } else {
      mld = LEAF_DATA(eli->el->child[1]);

      clambda[1] = lambda[2];
      clambda[0] = 1.0 * lambda[1] - 1.0*lambda[0];
      clambda[2] = 2.0 * lambda[0];
    }
    theta = SCP_BAR(MESH_DIM-1, mld->theta, clambda);
    t     = SCP_BAR(MESH_DIM-1, mld->t, clambda);
  } else {
    struct moebius_leaf_data *mld = LEAF_DATA(eli->el);

    theta = SCP_BAR(MESH_DIM-1, mld->theta, lambda);
    t     = SCP_BAR(MESH_DIM-1, mld->t, lambda);
  }
  costh  = cos(theta);
  sinth  = sin(theta);
  costh2 = cos(theta/2);
  sinth2 = sin(theta/2);
  
  vertex[0] = costh + t*costh2*costh;
  vertex[1] = sinth + t*costh2*sinth;
  vertex[2] = 0.0   + t*sinth2;
}

/* 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.
 *
 * We only care about the case "c == 0" because the entire surface can
 * be parameterised by a single global parameterisation.
 */
static NODE_PROJECTION moebius_proj = { moebius_proj_func };

static NODE_PROJECTION *init_node_proj(MESH *mesh, MACRO_EL *mel, int c)
{
  /* FUNCNAME("init_node_proj"); */
  if (c == 0) {
    return &moebius_proj;
  }

  return NULL;
}

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

static bool init_element(const EL_INFO *el_info, const QUAD *quad[3], void *ud)
{
  /* FUNCNAME("init_element"); */
  struct op_data *info = (struct op_data *)ud;
  PARAMETRIC     *parametric = el_info->mesh->parametric;

  if (parametric && 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 = NULL;
  static const QUAD           *quad = NULL;

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

  /* 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) {
      quad = get_quadrature(2, 2*fe_space->bas_fcts->degree + 2);
    } else {
      quad = get_quadrature(2, 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 */
    BNDRY_FLAGS_CPY(o_info.dirichlet_bndry,
		    dirichlet_mask); /* Dirichlet boundary conditions. */
    o_info.user_data = (void *)&user_data; /* application 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);

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

  /* boundary values */
  dirichlet_bound_loc(f_h, u_h, NULL,
		      dirichlet_mask, g_at_qp, NULL, FILL_NOTHING);
}


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


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

  /* Error estimation is not yet implemented for parametric meshes.         */
  est = ellipt_est(u_h, adapt, rw_el_est, NULL /* rw_est_c() */,
		   -1 /* quad_degree */, norm, C, 
		   (const REAL_D *) A, 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;

  if (norm == L2_NORM) {
    err = L2_err_loc(u_at_qp, NULL, 0, u_h, quad, 0, 0, NULL, NULL);
  } else {
    err = H1_err_loc(grd_u_at_qp, NULL, 0, u_h, quad, 0, NULL, NULL);
  }

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

  return adapt->err_sum;
}

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

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

  /*****************************************************************************
   * first of all, initialize the access to parameters of the init file
   ****************************************************************************/
  parse_parameters(argc, argv, "INIT/ellipt-moebius.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", &parm_degree);
  GET_PARAMETER(1, "online graphics", "%d", &do_graphics);

  /*****************************************************************************
   *  get a mesh, and read the macro triangulation from file
   ****************************************************************************/
  data = read_macro(filename);
  mesh = GET_MESH(MESH_DIM, "Moebius-Strip", data, init_node_proj, NULL);
  free_macro_data(data);
  init_leaf_data(mesh, sizeof(struct moebius_leaf_data),
		 moebius_refine_ld,
		 moebius_coarsen_ld);

  /*****************************************************************************
   * Initialize the parameterisation of the vertex nodes At this point
   * we assume that we have 2*n macro elements, that all nodes belong
   * to the boundary, and that the (local) vertices 0 and 2 of the
   * even numbered elements belong to the boundary with t = +0.5,
   * while the vertices 0 and 2 of the odd numbered elements belong to
   * the part of the boundary with t = -0.5
   ****************************************************************************/
  theta_step = 2.0*M_PI / (REAL)( mesh->n_vertices/2);
  for (i = 0; i < mesh->n_macro_el; i++) {
    MACRO_EL *mel = &mesh->macro_els[i];
    struct moebius_leaf_data *mld = LEAF_DATA(mel->el);

    if ((i & 1) == 0) {
      mld->t[0] = mld->t[2] = 0.5;
      mld->t[1] = -0.5;

      mld->theta[1] = mld->theta[2] = (REAL)(i/2) * theta_step;
      mld->theta[0] = (REAL)(i/2+1) * theta_step;
      
    } else {
      mld->t[0] = mld->t[2] = -0.5;
      mld->t[1] = 0.5;

      mld->theta[0] = (REAL)(i/2) * theta_step;
      mld->theta[1] = mld->theta[2] = (REAL)(i/2+1) * theta_step;
    } 
  }

  /*****************************************************************************
   * Tell ALBERTA to use a parameterisation of p.w. degree
   * "param_degree". Per convention if "param_degree < 1" we use the
   * "new_coords" component of the EL structure to store the
   * parametric co-ordinates. In resulting parameterisation is
   * p.w. linear.
   ****************************************************************************/
  if (parm_degree > 0) {
    use_lagrange_parametric(mesh, parm_degree, &moebius_proj, PARAM_ALL);
  }

  /*****************************************************************************
   * Aquire the finite element space used for the computations. We do
   * this before calling global_refine() because adding finite element
   * spaces is somewhat time-consuming.
   ****************************************************************************/
  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_FLAGS_DFLT);

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

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

  /*****************************************************************************
   *  init the adapt structure and start adaptive method
   ****************************************************************************/
  adapt =
    get_adapt_stat(MESH_DIM, "ellipt-moebius", "adapt", 2 /* info */, NULL);
  adapt->estimate = estimate;
  adapt->get_el_est = get_el_est;
  adapt->build_after_coarsen = build;
  adapt->solve = solve;

  adapt_method_stat(mesh, adapt); /* GO! */

  WAIT_REALLY;

  return 0;
}

