/*******************************************************************************
 *
 * ALBERTA:  an Adaptive multi Level finite element toolbox  using
 *           Bisectioning refinement and Error control by Residual
 *           Techniques
 *
 * www.alberta-fem.de
 *
 ******************************************************************************
 *
 * File:     ellipt-isoparam.c
 *
 * Description: solver for an elliptic model problem                      
 *
 *                      -\Delta u = f  in \Omega                         
 *                              u = g  on \partial \Omega                
 *                                                                      
 * This example application demonstrates the use of iso-parametric
 * elements on a domain where parts of the boundary is curved. This
 * file is based on the original ellipt.c demo-program, just with the
 * necessary additions for the curved boundary.
 *
 ******************************************************************************
 *
 * 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 (2007)
 *
 * Based on the famous ellipt.c demo-program by K.G. Siebert and A. Schmidt.
 *
 ******************************************************************************/

#include <alberta/alberta.h>

#include "alberta-demo.h"

static bool do_graphics = true;
static bool debug_isoparametric = false;

#if DIM_OF_WORLD > DIM_MAX
# error This demo-program is only meant for co-dimension 0.
#endif

#define MESH_DIM DIM_OF_WORLD /* used in some places below */

#define GEOMVIEW 1 /* Favour Geomview over gltools for now */

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

/*******************************************************************************
 * 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;      /* finite element space */
static DOF_REAL_VEC   *u_h = NULL;    /* discrete solution */
static DOF_REAL_VEC   *f_h = NULL;    /* "right-hand side" */
static DOF_MATRIX     *matrix = NULL; /* stiffness matrix */

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

struct ellipt_leaf_data
{
  REAL estimate; /*  one real for the estimate */
};

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

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

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

#define GAUSS_SCALE 10.0
static const REAL_D gauss_trans = { 0.0, 1.0 };

static REAL gauss(REAL r2)
{
  return exp(-GAUSS_SCALE*r2);
}

static REAL u(const REAL_D _x)
{
  REAL_D x;
  
  AXPBY_DOW(-1.0, gauss_trans, 1.0, _x, x);

  return gauss(NRM2_DOW(x));  
}

#if GEOMVIEW
static REAL u_loc(const EL_INFO *el_info,
		  const REAL_B lambda,
		  void *ud)
{
  REAL_D x;
  
  if (el_info->fill_flag & FILL_COORDS) {
    coord_to_world(el_info, lambda, x);
  } else {
    const PARAMETRIC *parametric = el_info->mesh->parametric;
    parametric->coord_to_world(el_info, NULL, 1,
			       (const REAL_B *)lambda,
			       (REAL_D *)x);
  }
  return u(x);
}
#endif

static const REAL *grd_u(const REAL_D _x, REAL_D result)
{
  static REAL_D buffer;
  REAL_D x;

  if (!result)
    result = buffer;

  AXPBY_DOW(-1.0, gauss_trans, 1.0, _x, x);

  AXEY_DOW(-2.0*GAUSS_SCALE*gauss(NRM2_DOW(x)), x, result);

  return result;
}

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

/* BIG FAT NOTE: we project the bounadary points to the real boundary
 * (i.e. the unit-sphere); otherwise variational crimes like using
 * low-degree boundary approximation would be hidden. There are two
 * effects when using iso-parametric boundary approximation: you have
 * to decide what to do with the center nodes (see Lenoir's paper,
 * handled by ALBERTA, only for high-degree, i.e. > 2) and you have to
 * take the difference between the discrete and the continuous domain
 * into acocunt. The code below is correct in the sense that it will
 * punish those "variational crimes". Due to super-convergence effects
 * caused by the unrivaled symmetry of the sphere you will experience
 * the following EOCs (asymptocially, make sure your machine has
 * infinite memory and you have unlimited time :)
 *
 * isoparam-degree  || degree of Ansatz-space || EOC (H1-half norm)
 * ================================================================
 *        1         ||           1            ||         1
 *        1         ||          > 1           ||         1.5
 *  > 1; < k        ||           k            ||         k-0.5
 *        k         ||           k            ||         k
 *
 * FIXME. This test program really should not use a sphere as
 * computational domain. Super-convergence effects may even yield
 * EOCs of k+0.5, depending on the computational domain and the
 * quality of the triangulation. There may also be other strange
 * super-convergence effects. The important point, however, is that it
 * works not worse than expected when using the correct order for the
 * boundary approximation.
 *
 * For production purposes you would want to use the normal g(x) =
 * u(x) procedure (see ellipt.c, for example).
 */
static REAL g_loc(const EL_INFO *el_info, const QUAD *quad, int iq, void *ud)
{
  const PARAMETRIC *parametric = el_info->mesh->parametric;
  int wall;
  bool do_scale;
  REAL_D x;

  TEST_EXIT(quad->codim == 1, "Not a boundary quadarture.\n");
  
  wall = quad->subsplx;

  do_scale = wall_bound(el_info, wall) == 2;

  if ((el_info->fill_flag & FILL_COORDS) == 0) {
    parametric->coord_to_world(el_info, NULL, 1,
			       (const REAL_B *)quad->lambda[iq], (REAL_D *)x);
  } else {
    coord_to_world(el_info, quad->lambda[iq], x);
  }

  /* Make sure that the continuous solution is really evaluated at the
   * continuous boundary.
   */
  if (do_scale) {
    REAL s = 1.0/NORM_DOW(x);
    SCAL_DOW(s, x);
  }

  return u(x);
}

/* -Delta u, not optional */
static REAL f(const REAL_D _x)
{
  REAL_D x;
  REAL r2;
  REAL ux;

  AXPBY_DOW(-1.0, gauss_trans, 1.0, _x, x);

  r2 = SCP_DOW(x,x);
  ux = gauss(r2);

  return -(4.0*SQR(GAUSS_SCALE)*r2 - 2.0*GAUSS_SCALE*(REAL)MESH_DIM)*ux;
}

/*******************************************************************************
 * 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_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 {
    *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;

  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;
  static struct op_data opi_ud; /* Operator-Info User-Data */
 
  dof_compress(mesh);
  MSG("%d DOFs for %s\n", fe_space->admin->size_used, fe_space->name);

  /* Information for matrix assembling. Note that we use LALt_pw_const
   * even though some elements will be parametric. The assemble
   * frame-work will recognize affine elements and optimize
   * accordingly.
   */
  if (!matrix_info) {
    OPERATOR_INFO o_info = { NULL, };
    int quad_deg = 2*fe_space->bas_fcts->degree-2;
    
    if(mesh->parametric) {
      quad_deg += fe_space->bas_fcts->degree; /* increase the quadrature degree somewhat. FIXME. Even needed?? */
    }
    o_info.quad[2] = quad = get_quadrature(fe_space->mesh->dim, quad_deg);

    opi_ud.Lambda = MEM_ALLOC(quad->n_points, REAL_BD);
    opi_ud.det    = MEM_ALLOC(quad->n_points, REAL);
 
    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 */
    BNDRY_FLAGS_CPY(o_info.dirichlet_bndry,
		    dirichlet_mask); /* Dirichlet bndry conditions */
    o_info.user_data = &opi_ud;   /* application data */

    /* At least higher degree parameterizations are not p.w. constant */
    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 the matrix */
  clear_dof_matrix(matrix);
  update_matrix(matrix, matrix_info, NoTranspose);

  /* assembling of the load vector */
  dof_set(0.0, f_h);
  L2scp_fct_bas(f, quad, f_h);

  /* Dirichlet boundary values. Have a look at ellipt.c on how to
   * implmement more complicated boundary conditions.
   */
  dirichlet_bound_loc(f_h, u_h, NULL,
		      dirichlet_mask, g_loc, NULL, FILL_COORDS);

  /* Check whether the higher derivatives of the reference mapping
   * have sufficient decay.
   */
  if (debug_isoparametric) {
    int param_degree = -1;

    GET_PARAMETER(1, "parametric degree", "%d", &param_degree);

    if (param_degree >= 2) {
      DOF_REAL_D_VEC *coords = get_lagrange_coords(mesh);
#if MESH_DIM == 3
      REAL P[N_LAMBDA_MAX][N_LAMBDA_MAX-1] = {
        { -1, -1, -1 }, {  1,  0,  0 }, {  0,  1,  0 }, {  0,  0,  1 }
      };
#elif MESH_DIM == 2
      REAL P[N_LAMBDA_MAX][N_LAMBDA_MAX-1] = {
        { -1, -1 }, {  1,  0 }, {  0,  1 }
      };
#endif
      REAL_B dummy = INIT_BARY_MAX(1, 1, 1, 1);
      SCAL_BAR(MESH_DIM, 1.0/(REAL)mesh->dim, dummy);

      REAL max_der[5] = { 0.0, };
      static REAL max_der_old[5] = { -1.0, -1.0, -1.0, -1.0, -1.0 };
      TRAVERSE_FIRST(mesh, -1, FILL_COORDS|CALL_LEAF_EL) {
        const EL_REAL_D_VEC *coords_el = fill_el_real_d_vec(NULL, el_info->el, coords);
	int b, d, i, j, k, l, alpha, beta, gamma, delta;

        if (param_degree >= 1) {
          REAL_DB D1_el = { { 0.0, } };

          for (b = 0; b < coords_el->n_components; b++) {
            const REAL *D1bfct = GRD_PHI(coords->fe_space->bas_fcts, b, dummy);
            REAL D1tan[N_LAMBDA_MAX-1] = { 0.0, };

            for (i = 0; i < N_LAMBDA_MAX-1; i++) {
              for (alpha = 0; alpha < N_LAMBDA_MAX; alpha++) {
                D1tan[i] += D1bfct[alpha] * P[alpha][i];
              }
            }
          
            for (d = 0; d < DIM_OF_WORLD; d++) {
              for (i = 0; i < N_LAMBDA_MAX-1; i++) {
                D1_el[d][i] += coords_el->vec[b][d] * D1tan[i];
              }
            }
          }
          REAL max_el = 0.0;
          for (d = 0; d < DIM_OF_WORLD; d++) {
            for (i = 0; i < N_LAMBDA_MAX; i++) {
              max_el = MAX(max_el, fabs(D1_el[d][i]));
            }
          }
          max_der[1] = MAX(max_der[1], max_el);
        }
        if (param_degree >= 2) {
          REAL_DBB D2_el = { { { 0.0, } } };

          for (b = 0; b < coords_el->n_components; b++) {
            const REAL_B *D2bfct = D2_PHI(coords->fe_space->bas_fcts, b, dummy);
            REAL D2tan[N_LAMBDA_MAX-1][N_LAMBDA_MAX-1] = { { 0.0, } };

            for (i = 0; i < N_LAMBDA_MAX-1; i++) {
              for (j = 0; j < N_LAMBDA_MAX-1; j++) {

                for (alpha = 0; alpha < N_LAMBDA_MAX; alpha++) {
                  for (beta = 0; beta < N_LAMBDA_MAX; beta++) {

                    D2tan[i][j] += D2bfct[alpha][beta] * P[alpha][i] * P[beta][j];
                  }
                }
              }
            }
          
            for (d = 0; d < DIM_OF_WORLD; d++) {
              for (i = 0; i < N_LAMBDA_MAX-1; i++) {
                for (j = 0; j < N_LAMBDA_MAX-1; j++) {
                  D2_el[d][i][j] += coords_el->vec[b][d] * D2tan[i][j];
                }
              }
            }
          }
          REAL max_el = 0.0;
          for (d = 0; d < DIM_OF_WORLD; d++) {
            for (i = 0; i < N_LAMBDA_MAX; i++) {
              for (j = 0; j < N_LAMBDA_MAX; j++) {
                max_el = MAX(max_el, fabs(D2_el[d][i][j]));
              }
            }
          }
          max_der[2] = MAX(max_der[2], max_el);
          *rw_el_est(el_info->el) = max_el;
        }
        if (param_degree >= 3) {
          REAL_DBBB D3_el = { { { { 0.0, } } } };

          for (b = 0; b < coords_el->n_components; b++) {
            const REAL_BB *D3bfct = D3_PHI(coords->fe_space->bas_fcts, b, dummy);
            REAL D3tan[N_LAMBDA_MAX-1][N_LAMBDA_MAX-1][N_LAMBDA_MAX-1] = { { { 0.0, } } };

            for (i = 0; i < N_LAMBDA_MAX-1; i++) {
              for (j = 0; j < N_LAMBDA_MAX-1; j++) {
                for (k = 0; k < N_LAMBDA_MAX-1; k++) {

                  for (alpha = 0; alpha < N_LAMBDA_MAX; alpha++) {
                    for (beta = 0; beta < N_LAMBDA_MAX; beta++) {
                      for (gamma = 0; gamma < N_LAMBDA_MAX; gamma++) {

                        D3tan[i][j][k] += D3bfct[alpha][beta][gamma]
                          * P[alpha][i]
                          * P[beta][j]
                          * P[gamma][k];
                      }
                    }
                  }
                }
              }
            }
          
            for (d = 0; d < DIM_OF_WORLD; d++) {
              for (i = 0; i < N_LAMBDA_MAX-1; i++) {
                for (j = 0; j < N_LAMBDA_MAX-1; j++) {
                  for (k = 0; k < N_LAMBDA_MAX-1; k++) {
                    D3_el[d][i][j][k] += coords_el->vec[b][d] * D3tan[i][j][k];
                  }
                }
              }
            }
          }
          REAL max_el = 0.0;
          for (d = 0; d < DIM_OF_WORLD; d++) {
            for (i = 0; i < N_LAMBDA_MAX; i++) {
              for (j = 0; j < N_LAMBDA_MAX; j++) {
                for (k = 0; k < N_LAMBDA_MAX; k++) {
                  max_el = MAX(max_el, fabs(D3_el[d][i][j][k]));
                }
              }
            }
          }
          max_der[3] = MAX(max_der[3], max_el);
          *rw_el_est(el_info->el) = max_el;
        }
        if (param_degree >= 4) {
          REAL_DBBBB D4_el = { { { { { 0.0, } } } } };

          for (b = 0; b < coords_el->n_components; b++) {
            const REAL_BBB *D4bfct = D4_PHI(coords->fe_space->bas_fcts, b, dummy);
            REAL D4tan[N_LAMBDA_MAX-1][N_LAMBDA_MAX-1][N_LAMBDA_MAX-1][N_LAMBDA_MAX-1] = { { { { 0.0, } } } };

            for (i = 0; i < N_LAMBDA_MAX-1; i++) {
              for (j = 0; j < N_LAMBDA_MAX-1; j++) {
                for (k = 0; k < N_LAMBDA_MAX-1; k++) {
                  for (l = 0; l < N_LAMBDA_MAX-1; l++) {

                    for (alpha = 0; alpha < N_LAMBDA_MAX; alpha++) {
                      for (beta = 0; beta < N_LAMBDA_MAX; beta++) {
                        for (gamma = 0; gamma < N_LAMBDA_MAX; gamma++) {
                          for (delta = 0; delta < N_LAMBDA_MAX; delta++) {

                            D4tan[i][j][k][l] += D4bfct[alpha][beta][gamma][delta]
                              * P[alpha][i]
                              * P[beta][j]
                              * P[gamma][k]
                              * P[delta][l];
                          }
                        }
                      }
                    }
                  }
                }
              }
            }
          
            for (d = 0; d < DIM_OF_WORLD; d++) {
              for (i = 0; i < N_LAMBDA_MAX-1; i++) {
                for (j = 0; j < N_LAMBDA_MAX-1; j++) {
                  for (k = 0; k < N_LAMBDA_MAX-1; k++) {
                    for (l = 0; l < N_LAMBDA_MAX-1; l++) {
                    
                      D4_el[d][i][j][k][l] += coords_el->vec[b][d] * D4tan[i][j][k][l];
                    }
                  }
                }
              }
            }
          }
          REAL max_el = 0.0;
          for (d = 0; d < DIM_OF_WORLD; d++) {
            for (i = 0; i < N_LAMBDA_MAX; i++) {
              for (j = 0; j < N_LAMBDA_MAX; j++) {
                for (k = 0; k < N_LAMBDA_MAX; k++) {
                  for (l = 0; l < N_LAMBDA_MAX; l++) {
                    max_el = MAX(max_el, fabs(D4_el[d][i][j][k][l]));
                  }
                }
              }
            }
          }
          max_der[4] = MAX(max_der[4], max_el);
          *rw_el_est(el_info->el) = max_el;
        }
      } TRAVERSE_NEXT();

      if (param_degree >= 1) {
        MSG("Max D^1 F_ref: %.8le", max_der[1]);
        if (max_der_old[1] >= 0) {
          print_msg(", EOC: %.2lf\n", EOC(max_der[1], max_der_old[1]));
        } else {
          print_msg("\n");
        }
        max_der_old[1] = max_der[1];
      }
      if (param_degree >= 2) {
        MSG("Max D^2 F_ref: %.8le", max_der[2]);
        if (max_der_old[2] >= 0) {
          print_msg(", EOC: %.2lf\n", EOC(max_der[2], max_der_old[2]));
        } else {
          print_msg("\n");
        }
        max_der_old[2] = max_der[2];
      }
      if (param_degree >= 3) {
        MSG("Max D^3 F_ref: %.8le", max_der[3]);
        if (max_der_old[3] >= 0) {
          print_msg(", EOC: %.2lf\n", EOC(max_der[3], max_der_old[3]));
        } else {
          print_msg("\n");
        }
        max_der_old[3] = max_der[3];
      }
      if (param_degree >= 4) {
        MSG("Max D^4 F_ref: %.8le", max_der[4]);
        if (max_der_old[4] >= 0) {
          print_msg(", EOC: %.2lf\n", EOC(max_der[4], max_der_old[4]));
        } else {
          print_msg("\n");
        }
        max_der_old[4] = max_der[4];
      }

      if (do_graphics) {
        togeomview(mesh,
                   NULL /* u_h */, 1.0, -1.0,
                   get_el_est, 1.0, -1.0,
                   NULL /*u_loc*/, NULL /* u_data */, FILL_NOTHING, 1.0, -1.0);
        WAIT;
      }
    }
  }
}


/*******************************************************************************
 * 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) {
    MSG("Displaying u_h, u and (u_h-u).\n");
#if !GEOMVIEW
    graphics(mesh, u_h, NULL, u, HUGE_VAL);
#else
    togeomview(NULL /* mesh */,
	       u_h, 1.0, -1.0,
	       NULL /* get_el_est */, 1.0, -1.0,
	       u_loc, NULL /* u_data */, FILL_COORDS, 1.0, -1.0);
    /*WAIT;*/
#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 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;

  if (!(el_info->fill_flag & FILL_COORDS)) {
    el_info->mesh->parametric->coord_to_world(el_info, NULL, 1,
					      (const REAL_B *)quad->lambda[iq],
					      (REAL_D *)x);
  } else {
    coord_to_world(el_info, quad->lambda[iq], x);
  }

  return -f(x);
}

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; /* = (INIT_UH | INIT_GRD_UH),  if needed by r() */
  static REAL_DD A;
  static const QUAD *quad;

  if (norm < 0) {
    int n;

    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 (n = 0; n < DIM_OF_WORLD; n++) {
      A[n][n] = 1.0;   /* set diagonal of A; all other elements are zero */
    }

    degree = 3*u_h->fe_space->bas_fcts->degree;
    quad = get_quadrature(mesh->dim, degree);
  }

  est = ellipt_est(u_h, adapt, rw_el_est, NULL /* rw_est_c() */,
		   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(u, u_h, quad,
		 false /* relative error*/,
		 false /* mean-value adjust */,
		 NULL /* rw_err_el()*/, NULL /* max_err_el2 */);
  } else {
    err = H1_err(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) {
    MSG("Displaying the estimate.\n");
#if !GEOMVIEW
    graphics(mesh, NULL /* u_h */, get_el_est, NULL /* u_exact() */, HUGE_VAL);
#else
    togeomview(mesh,
	       NULL /* u_h */, 1.0, -1.0,
	       get_el_est, 1.0, -1.0,
	       NULL /*u_loc*/, NULL /* u_data */, FILL_NOTHING, 1.0, -1.0);
    WAIT;
#endif
  }

  return adapt->err_sum;
}

/*******************************************************************************
 *
 * Stuff for the curved boundary.
 *
 ******************************************************************************/

/* x is the point to project, and the return space, el_info the
 * current elements info-record and lambda are the barycentric
 * coordinates of x w.r.t. el_info.
 */
static void ball_proj_func(REAL_D x,
			   const EL_INFO *el_info, const REAL_B lambda)
{
  SCAL_DOW(1.0/NORM_DOW(x), x);
}

/* One of the more obscure features is that NODE_PROJECTION is a
 * structure with a single entry, the function-pointer to the
 * function which does the actual work ... :)
 */
static NODE_PROJECTION ball_proj = { ball_proj_func };

/* init_node_projection() is passed to GET_MESH() to initialize the
 * projection of boundary 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 project boundary-walls with boundary-type 2 to the boundary of
 * the unit-sphere.
 */
static NODE_PROJECTION *init_node_proj(MESH *mesh, MACRO_EL *mel, int c)
{
  if (c > 0 && mel->wall_bound[c-1] == 2) {
    return &ball_proj;
  } else {
    return NULL;
  }
}

/*******************************************************************************
 * The main program.
 ******************************************************************************/

int main(int argc, char **argv)
{
  FUNCNAME("main");
  MACRO_DATA        *data;
  MESH              *mesh;
  int               n_refine = 0, dim, degree = 1, param_degree = -1;
  PARAM_STRATEGY    param_strategy = PARAM_STRAIGHT_CHILDS;
  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-isoparam.dat");

  /*****************************************************************************
   * then read some basic parameters
   ****************************************************************************/
  GET_PARAMETER(1, "mesh dimension", "%d", &dim);
  if (dim == 2) {
    strcpy(filename, "Macro/macro-34circ.amc");
  } else if (dim == 3) {
    strcpy(filename, "Macro/halfsphere.amc");
  }
  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, "parametric strategy", "%d", &param_strategy);
  GET_PARAMETER(1, "online graphics", "%B", &do_graphics);
  GET_PARAMETER(1, "debug isoparametric", "%B", &debug_isoparametric);

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

  /*****************************************************************************
   * Initialize the iso-parametric parameterisation of the boundary,
   * if necessary. For a linear "parametrization" this is not
   * necessary. The convention is: param_degree > 0 means to use the
   * Lagrange-parametric frame-work, even when param_degree ==
   * 1. Otherwise stick to a normal mesh (only new vertex nodes are
   * projected to the boundary).
   *
   * PARAM_XXX_CHILDS means that only the children of parametric
   * elements are parametric, and only if one of their walls is
   * subject to a projection function. XXX can be one of "STRAIGHT" or
   * "CURVED". It controls whether parametric elements are bisected by
   * straight lines (or planes) or by the non-linear surface with
   * {\lambda_0 == \lambda_1}.
   *
   * ALBERTA takes care of adjusting the interior nodes of parametric
   * boundary elements to obtain the optimal convergence rates.
   ****************************************************************************/
  if (param_degree > 0) {
    use_lagrange_parametric(mesh, param_degree,
			    &ball_proj, param_strategy);
  }

  /* initialize our private leaf-data structure; we store the values
   * of the estimator in the leaf-elements of the mesh.
   */
  init_leaf_data(mesh, sizeof(struct ellipt_leaf_data),
		 NULL /* refine_leaf_data() */,
		 NULL /* coarsen_leaf_data() */);

  /*****************************************************************************
   * Allocate the finite-element space here, before calling
   * global_refine(). Not really necessary, but saves a little bit of
   * computation time, adding fe-space on refined meshes requires some
   * work.
   ****************************************************************************/
  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);

  global_refine(mesh, n_refine * mesh->dim, FILL_NOTHING);

  if (do_graphics) {
    MSG("Displaying the mesh.\n");
#if !GEOMVIEW
    graphics(mesh, NULL, NULL, NULL, HUGE_VAL);
#else
    togeomview(mesh,
	       NULL /* u_h */, 1.0, -1.0,
	       NULL /* get_el_est */, 1.0, -1.0,
	       NULL /*u_loc*/, NULL/* data */, FILL_NOTHING, 1.0, -1.0);
    WAIT;
#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, do not forget */

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

  /*****************************************************************************
   *  init adapt structure and start adaptive method
   ****************************************************************************/
  adapt = get_adapt_stat(mesh->dim, "ellipt-isoparam", "adapt", 2,
			 NULL /* ADAPT_STAT storage area, optional */);
  adapt->refine_bisections = mesh->dim;
  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) {
    MSG("Displaying u_h, u, (u_h-u) and the final estimate.\n");
#if !GEOMVIEW
    graphics(mesh, u_h, get_el_est, u, HUGE_VAL);
#else
    togeomview(mesh,
	       u_h, 1.0, -1.0,
	       get_el_est, 1.0, -1.0,
	       u_loc, NULL /* data */, FILL_COORDS, 1.0, -1.0);
    WAIT;
#endif
  }
  
  WAIT_REALLY;

  return 0;
}
