/****************************************************************************/
/* ALBERTA:  an Adaptive multi Level finite element toolbox using           */
/*           Bisectioning refinement and Error control by Residual          */
/*           Techniques for scientific Applications                         */
/*                                                                          */
/* file:     HB_precon.c                                                    */
/*                                                                          */
/* description:  hierachical basis preconditioning, including higher        */
/*               order                                                      */
/*               and also the BPX preconditioner                            */
/*                                                                          */
/*--------------------------------------------------------------------------*/
/*                                                                          */
/*  authors:   Alfred Schmidt                                               */
/*             Zentrum fuer Technomathematik                                */
/*             Fachbereich 3 Mathematik/Informatik                          */
/*             Universitaet Bremen                                          */
/*             Bibliothekstr. 2                                             */
/*             D-28359 Bremen, Germany                                      */
/*                                                                          */
/*             Kunibert G. Siebert                                          */
/*             Institut fuer Mathematik                                     */
/*             Universitaet Augsburg                                        */
/*             Universitaetsstr. 14                                         */
/*             D-86159 Augsburg, Germany                                    */
/*                                                                          */
/*  http://www.mathematik.uni-freiburg.de/IAM/ALBERTA                       */
/*                                                                          */
/*  (c) by A. Schmidt and K.G. Siebert (1996-2003)                          */
/*                                                                          */
/*--------------------------------------------------------------------------*/

/*---8<---------------------------------------------------------------------*/
/*---  to do: something is wrong in BPX for p > 2                        ---*/
/*--------------------------------------------------------------------->8---*/

#ifdef HAVE_CONFIG_H
# include "config.h"
#endif

#include "alberta_intern.h"
#include "alberta.h"

typedef struct
{
  PRECON              precon;
  const DOF_MATRIX    *matrix;
  const FE_SPACE      *fe_space;
  const DOF_SCHAR_VEC *bound_dv;
  BNDRY_FLAGS         dirichlet_bndry;

  int                 info;
  bool                high_degree;
  int                 mg_levels;
  int                 size;
  U_CHAR              *dof_level;
  U_CHAR              *local_dof;
  DOF                 (*dof_parent)[N_VERTICES_MAX];
  DOF                 *sort_dof, *sort_dof_invers;
  int                 *dofs_per_level;
  const S_CHAR        *bound;
  REAL                (*ipol)[N_VERTICES_MAX]; /* for high_degree interpol. */

  /* BPX section: */
  REAL                *g;
  REAL                diam;

  /* memory stuff */
  SCRATCH_MEM         scratch;

} HB_DATA;

static void exit_HB_precon(void *precon_data);

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

typedef struct hb_traverse_data {
  int n0_vert, max_level, max_dof_level;
  const int *n_dof, *n0_dof, *node;
  int *local_dof_sort;
  HB_DATA *hb_data;
} HB_TRAVERSE_DATA;

static void max_level_fct(const EL_INFO *el_info, void *data)
{
  HB_TRAVERSE_DATA *ud = (HB_TRAVERSE_DATA *)data;
  int dof, dof0, dof1, level = (int)(el_info->level);
  int dim = el_info->mesh->dim;
  EL  *el   = el_info->el;

  ud->max_level = MAX(level, ud->max_level);

  if (!(IS_LEAF_EL(el))) {
    dof   = el->child[0]->dof[N_VERTICES(dim)-1][ud->n0_vert];
    dof0  = ud->hb_data->dof_parent[dof][0] = el->dof[0][ud->n0_vert];
    dof1  = ud->hb_data->dof_parent[dof][1] = el->dof[1][ud->n0_vert];
    level = 1 + MAX(ud->hb_data->dof_level[dof0], ud->hb_data->dof_level[dof1]);
    ud->hb_data->dof_level[dof] = level;
    ud->max_dof_level = MAX(level, ud->max_dof_level);
  }
}

/* high_degree_fct(): set level of all non-vertex dofs to highest level,  */
/*                    and save parent data                                */

static void high_degree_fct(const EL_INFO *el_info, void *data)
{
  FUNCNAME("high_degree_fct");
  HB_TRAVERSE_DATA *ud = (HB_TRAVERSE_DATA *)data;
  int  i, j, k, m, n, nod0, n0, dof;
  int  dim = el_info->mesh->dim;
  EL   *el   = el_info->el;
  DOF  vertex_dof[N_VERTICES_MAX];

  DEBUG_TEST_EXIT(IS_LEAF_EL(el), "Non-leaf element???\n");

  for (k=0; k<N_VERTICES(dim); k++)
    vertex_dof[k] = el->dof[k][ud->n0_vert];
  m = N_VERTICES(dim);

  if ((n = ud->n_dof[CENTER]) > 0) {
    nod0 = ud->node[CENTER];
    n0 = ud->n0_dof[CENTER];
    for (j=0; j<n; j++) {
      dof = el->dof[nod0][n0+j];
      /* MSG("center dof %2d: level %d\n", dof, max_dof_level); */
      ud->hb_data->dof_level[dof] = ud->max_dof_level;
      for (k=0; k<N_VERTICES(dim); k++)
	ud->hb_data->dof_parent[dof][k] = vertex_dof[k];
      ud->hb_data->local_dof[dof] = ud->local_dof_sort[m++];
    }
  }

  if(dim > 1 && (n = ud->n_dof[EDGE]) > 0) {
    nod0 = ud->node[EDGE];
    n0 = ud->n0_dof[EDGE];
    for (i=0; i<N_EDGES(dim); i++)
      for (j=0; j<n; j++) {
	dof = el->dof[nod0+i][n0+j];
	if (!ud->hb_data->local_dof[dof]) {
	  /* MSG("edge dof   %2d: level %d\n", dof, max_dof_level); */
	  ud->hb_data->dof_level[dof] = ud->max_dof_level;
	  for (k=0; k<N_VERTICES(dim); k++)
	    ud->hb_data->dof_parent[dof][k] = vertex_dof[k];
	  ud->hb_data->local_dof[dof] = ud->local_dof_sort[m];
	}
	m++;
      }

  }

#if DIM_OF_WORLD >= 3
  if (dim == 3 && (n = ud->n_dof[FACE]) > 0) {
    nod0 = ud->node[FACE];
    n0 = ud->n0_dof[FACE];
    for (i=0; i < N_FACES_3D; i++)
      for (j=0; j<n; j++) {
	dof = el->dof[nod0+i][n0+j];
	if (!ud->hb_data->local_dof[dof]) {
	  /* MSG("face dof   %2d: level %d\n", dof, max_dof_level); */
	  ud->hb_data->dof_level[dof] = ud->max_dof_level;
	  for (k=0; k < N_VERTICES_3D; k++)
	      ud->hb_data->dof_parent[dof][k] = vertex_dof[k];
	  ud->hb_data->local_dof[dof] = ud->local_dof_sort[m];
	}
	m++;
      }
  }
#endif

  DEBUG_TEST_EXIT(m == ud->hb_data->fe_space->bas_fcts->n_bas_fcts,
	      "m <> n_bas_fcts: %d  %d\n",
	      m, ud->hb_data->fe_space->bas_fcts->n_bas_fcts);

  return;
}

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

/* NOTE: This terrible hack is definitely something we could do better...   */
static DOF *el_hat_dofs[N_VERTICES_MAX+N_EDGES_MAX+N_FACES_MAX+1];

static MESH dummy_mesh[4] = {{0},{NULL,1},{NULL,2},{NULL,3}};

static EL el_hat =
  {
    {NULL, NULL},  /* children */
    el_hat_dofs,
    0    /* ... */
  };

#if DIM_MAX == 1
static const EL_INFO el_hat_info[2] = {
  { NULL, /* mesh */
    {{0.0}, {0.0}}, /* coord */
    NULL, /* macro el */
    NULL, NULL, /* el, parent */
    0, /* fill_flag */
    0, /* level */
    { 0 }  /*---  and the rest is initialized with 0s  ---*/
  },
  { dummy_mesh + 1,
    {{0.0}, {1.0}},
    NULL,
    NULL, NULL,
    FILL_COORDS,
    0,
    { 0 }  /*---  and the rest is initialized with 0s  ---*/
  }};
#elif DIM_MAX == 2
static const EL_INFO el_hat_info[3] = {
  { NULL,
    {{0.0, 0.0}, {0.0, 0.0}, {0.0, 0.0}},
    NULL,
    NULL, NULL,
    0,
    0,
    { 0 }  /*---  and the rest is initialized with 0s  ---*/
  },
  { dummy_mesh + 1,
    {{0.0, 0.0}, {1.0, 0.0}, {0.0, 0.0}},
    NULL,
    NULL, NULL,
    FILL_COORDS,
    0,
    { 0 }  /*---  and the rest is initialized with 0s  ---*/
  },
  { dummy_mesh + 2,
    { {1.0, 0.0}, {0.0, 1.0}, {0.0, 0.0}},
    NULL,
    NULL, NULL,
    FILL_COORDS,
    0,
    { 0 }  /*---  and the rest is initialized with 0s  ---*/
  }};
#elif DIM_MAX >= 3
static const EL_INFO el_hat_info[4] = {
  { NULL,
    {{0.0, 0.0, 0.0}, {0.0, 0.0, 0.0}, {0.0, 0.0, 0.0}, {0.0, 0.0, 0.0}},
    NULL,
    NULL, NULL,
    0,
    0,
    { 0 }  /*---  and the rest is initialized with 0s  ---*/
  },
  { dummy_mesh + 1,
    {{0.0, 0.0, 0.0}, {1.0, 0.0, 0.0}, {0.0, 0.0, 0.0}, {0.0, 0.0, 0.0}},
    NULL,
    NULL, NULL,
    FILL_COORDS,
    0,
    { 0 }  /*---  and the rest is initialized with 0s  ---*/
  },
  { dummy_mesh + 2,
    { {1.0, 0.0, 0.0}, {0.0, 1.0, 0.0}, {0.0, 0.0, 0.0} },
    NULL,
    NULL, NULL,
    FILL_COORDS,
    0,
    { 0 }  /*---  and the rest is initialized with 0s  ---*/
  },
  { dummy_mesh + 3,
    { {1.0, 0.0, 0.0}, {0.0, 1.0, 0.0}, {0.0, 0.0, 1.0}, {0.0, 0.0, 0.0} },
    NULL,
    NULL, NULL,
    FILL_COORDS,
    0,
    { 0 }  /*---  and the rest is initialized with 0s  ---*/
  }};
#endif

static REAL lambda_0(const EL_INFO *el_info, const QUAD *quad, int iq, void *ud)
{
  return quad->lambda[iq][0];
}
static REAL lambda_1(const EL_INFO *el_info, const QUAD *quad, int iq, void *ud)
{
#if DIM_MAX > 0
  return quad->lambda[iq][1];
#else
  return 0.0;
#endif
}
static REAL lambda_2(const EL_INFO *el_info, const QUAD *quad, int iq, void *ud)
{
#if DIM_MAX > 1
  return quad->lambda[iq][2];
#else
  return 0.0;
#endif
}
static REAL lambda_3(const EL_INFO *el_info, const QUAD *quad, int iq, void *ud)
{
#if DIM_MAX > 2
  return quad->lambda[iq][3];
#else
  return 0.0;
#endif
}
static REAL (*lambda[N_LAMBDA_LIMIT])(const EL_INFO *el_info,
				      const QUAD *quad, int iq, void *ud) = 
{
  lambda_0, lambda_1, lambda_2, lambda_3
};

/****************************************************************************/
/*  init_HB_precon(matrix, boundary, info);    initialize HB_DATA structure */
/*  fills    (void *)(HB_DATA *), if ok,                                    */
/*  returns  NULL, if anything goes wrong.                                  */
/****************************************************************************/

static bool init_HB_BPX_precon(void *precon_data, int BPX)
{
  FUNCNAME("init_HB_BPX_precon");
  static HB_TRAVERSE_DATA td[1];
  HB_DATA         *data = (HB_DATA *)precon_data;
  const FE_SPACE  *fe_space;
  const DOF_ADMIN *admin;
  int             i, j, k, m, size, info, dim, hole_count;
  int             *tmp_per_level = NULL;
  int             n_bas_fcts;
  DOF             *tmp_dofs, *tmp_dof_ptr;
  const DOF       *dof_indices;
  DOF_SCHAR_VEC   *dsv;

  if (!data) {
      ERROR("no precon_data\n");
      return false;
  }
  if (!(data->fe_space)) {
      ERROR("no precon_data->fe_space\n");
      return false;
  }

  info     = data->info;
  fe_space = data->fe_space;
  if (!fe_space || !(fe_space->admin) || !(fe_space->bas_fcts)) {
    MSG("no fe_space or admin or bas_fcts.\n");
    return false;
  }

  if (fe_space->bas_fcts->n_dof[VERTEX] != 1) {
    MSG("sorry, only for FE spaces with n_dof[VERTEX]==1.\n");
    return false;
  }

#if 0
  /* Holes are masked out by the "boundary" mask vector. */
  TEST_EXIT(fe_space->admin->hole_count == 0,
	    "HB-/BPX-precon does not works with discontiguous index ranges, "
	    "please call dof_compress() first.\n");
#endif
  
  admin = fe_space->admin;
  size  = admin->size_used;
  dim   = fe_space->mesh->dim;

  INIT_OBJECT(fe_space->bas_fcts);

  n_bas_fcts = fe_space->bas_fcts->n_bas_fcts;
  data->high_degree = (n_bas_fcts > N_VERTICES(dim));
  if (data->high_degree) {
    INFO(info, 1, "use high degree version\n");
  }

  data->mg_levels = 0;
  data->dofs_per_level = NULL;

  hole_count = 0;
  dsv = get_dof_schar_vec_skel("HB/BPX bound", data->fe_space, data->scratch);
  data->bound = dsv->vec = SCRATCH_MEM_ALLOC(data->scratch, dsv->size, S_CHAR);
  if (data->bound_dv) {
    for (i = 0; i < dsv->size; i++) {
      if (data->matrix->matrix_row[i] == NULL) {
	dsv->vec[i] = DIRICHLET;
	++hole_count;
      } else {
	dsv->vec[i] = data->bound_dv->vec[i];
      }
    }
  } else if (!BNDRY_FLAGS_IS_INTERIOR(data->matrix->dirichlet_bndry)) {
    dirichlet_bound(NULL, NULL, dsv, data->dirichlet_bndry, NULL);
    for (i = 0; i < dsv->size; i++) {
      if (data->matrix->matrix_row[i] == NULL) {
	dsv->vec[i] = DIRICHLET;
	++hole_count;
      }
    }
  } else {
    for (i = 0; i < dsv->size; i++) {
      if (data->matrix->matrix_row[i] == NULL) {
	dsv->vec[i] = DIRICHLET;
	++hole_count;
      } else {
	dsv->vec[i] = INTERIOR;
      }
    }
  }
  if (hole_count == 0 &&
      data->bound_dv == NULL &&
      BNDRY_FLAGS_IS_INTERIOR(data->matrix->dirichlet_bndry)) {
    data->bound = NULL; /* No DOF-mask needed. */
  }

  data->ipol = NULL;

  data->dof_level       = SCRATCH_MEM_ALLOC(data->scratch, 2*size, U_CHAR);
  data->local_dof       = data->dof_level       + size;

  data->sort_dof        = SCRATCH_MEM_ALLOC(data->scratch, (N_VERTICES_MAX+2)*size, DOF);
  data->sort_dof_invers = data->sort_dof        + size;
  data->dof_parent      = (DOF (*)[N_VERTICES_MAX])(data->sort_dof_invers + size);
  data->size            = size;

  FOR_ALL_DOFS(admin,
	       data->dof_level[dof] = 0;
	       for (j=0; j < N_VERTICES_MAX;j++) data->dof_parent[dof][j] = -1;
	       data->local_dof[dof] = 0;
	       );

  td->n0_vert = admin->n0_dof[VERTEX];
  td->max_level = td->max_dof_level = 0;
  td->hb_data = data;
  mesh_traverse(fe_space->mesh, -1, CALL_EVERY_EL_PREORDER, max_level_fct, td);
  data->mg_levels = (td->max_level + dim - 1) / dim + 1;

  TEST_EXIT(data->mg_levels == (td->max_dof_level+1),
	    "mg_levels %d != max_dof_level %d + 1\n",
	    data->mg_levels, td->max_dof_level);

  if (data->high_degree) {     /* add level for fine-grid non-vertex DOFs */
    DEF_EL_VEC_VAR(REAL, one_ipol, n_bas_fcts, n_bas_fcts, false);

    data->mg_levels++;
    data->ipol = (REAL (*)[N_VERTICES_MAX])
      (SCRATCH_MEM_ALLOC(data->scratch, N_VERTICES_MAX*n_bas_fcts, REAL));

    td->local_dof_sort = SCRATCH_MEM_ALLOC(data->scratch, n_bas_fcts, int);
    for (j=0; j<n_bas_fcts; j++) {
      td->local_dof_sort[j] = j;  /* ???? */
    }

    tmp_dof_ptr = tmp_dofs = SCRATCH_MEM_ALLOC(data->scratch, fe_space->mesh->n_dof_el, DOF);
    m = 0;
    for (i=0; i<N_VERTICES(dim); i++) {
      el_hat_dofs[fe_space->mesh->node[VERTEX]+i] = tmp_dof_ptr;
      for (j=0; j<admin->n_dof[VERTEX]; j++) {
	tmp_dof_ptr[admin->n0_dof[VERTEX]+j] = m++;
      }
      /* If n0_dof[VERTEX] != 0, then we should also fill
       * tmp_dof_ptr[0+j], otherwise sort_face_indices_3d() will
       * become confused.
       */
      if (admin->n0_dof[VERTEX] != 0) {
        for (j=0; j < admin->n_dof[VERTEX]; j++) {
          tmp_dof_ptr[0+j] = tmp_dof_ptr[admin->n0_dof[VERTEX]+j];
        }
      }
      tmp_dof_ptr += fe_space->mesh->n_dof[VERTEX];
    }

    if (fe_space->mesh->n_dof[CENTER]) {
      el_hat_dofs[fe_space->mesh->node[CENTER]] = tmp_dof_ptr;
      for (j=0; j<admin->n_dof[CENTER]; j++) {
	tmp_dof_ptr[admin->n0_dof[CENTER]+j] = m++;
      }
    }

    if(dim > 1 && fe_space->mesh->n_dof[EDGE])
      for (i=0; i < N_EDGES(dim); i++) {
	el_hat_dofs[fe_space->mesh->node[EDGE]+i] = tmp_dof_ptr;
	for (j=0; j<admin->n_dof[EDGE]; j++) {
	  tmp_dof_ptr[admin->n0_dof[EDGE]+j] = m++;
        }
	tmp_dof_ptr += fe_space->mesh->n_dof[EDGE];
      }

    if (dim == 3 && fe_space->mesh->n_dof[FACE])
      for (i=0; i<N_FACES_3D; i++) {
	el_hat_dofs[fe_space->mesh->node[FACE]+i] = tmp_dof_ptr;
	for (j=0; j<admin->n_dof[FACE]; j++) {
	  tmp_dof_ptr[admin->n0_dof[FACE]+j] = m++;
        }
	tmp_dof_ptr += fe_space->mesh->n_dof[FACE];
      }

    TEST_EXIT(m==n_bas_fcts,"m != n_bas_fcts: %d %d\n", m, n_bas_fcts);

    dof_indices = GET_DOF_INDICES(fe_space->bas_fcts, &el_hat, admin, NULL)->vec;
    for (i = 0; i<fe_space->bas_fcts->n_bas_fcts; i++) {
      td->local_dof_sort[dof_indices[i]] = i;
    }

#if 0
    print_int_vec("dof_indices   ", dof_indices, n_bas_fcts);
    print_int_vec("local_dof_sort", td->local_dof_sort, n_bas_fcts);
#endif

    for (i=0; i < N_VERTICES(dim); i++) {
      INTERPOL(fe_space->bas_fcts, one_ipol,
	       &(el_hat_info[dim]), -1, 0, NULL, lambda[i], NULL);
      for (j=0; j<n_bas_fcts; j++)
	data->ipol[j][i] = one_ipol->vec[j];
    }

    td->max_dof_level++;
    td->n0_dof = admin->n0_dof;
    td->n_dof  = admin->n_dof;
    td->node   = fe_space->mesh->node;

    mesh_traverse(fe_space->mesh, -1, CALL_LEAF_EL, high_degree_fct, td);

    if (info > 3)
    {
      for (i=0; i<n_bas_fcts; i++)
      {
	MSG("ipol[%2d]", i); PRINT_REAL_VEC("", data->ipol[i],N_VERTICES(dim));
      }
    }

#if 0
    FOR_ALL_DOFS(admin,
		 if (data->local_dof[dof])
		   MSG("dof %3d: local_dof=%2d\n", dof, data->local_dof[dof]);
		 );
#endif
  }

  if (data->mg_levels < 2) {
/*     exit_HB_precon(data); */
    return false;
  }

  data->dofs_per_level = SCRATCH_MEM_ALLOC(data->scratch, data->mg_levels, int);
  tmp_per_level  = SCRATCH_MEM_ALLOC(data->scratch, data->mg_levels, int);

  for (i = 0; i < data->mg_levels; i++) data->dofs_per_level[i] = 0;
  FOR_ALL_DOFS(admin, data->dofs_per_level[data->dof_level[dof]]++);
  if (info > 3) {
    MSG("dofs_per_level:");
    for (i = 0; i < data->mg_levels; i++)
      print_msg(" %d", data->dofs_per_level[i]);
    print_msg("\n");
  }
  for (i = 1; i < data->mg_levels; i++) {
    tmp_per_level[i]   = data->dofs_per_level[i-1];
    data->dofs_per_level[i] += data->dofs_per_level[i-1];
  }
  tmp_per_level[0] = 0;      /* pointers for filling the sort vectors */

  if (info > 3) {
    MSG("dofs_per_level accumulated:");
    for (i = 0; i < data->mg_levels; i++)
      print_msg(" %d", data->dofs_per_level[i]);
    print_msg("\n");
  }

#if 0
  for (i = 0; i < data->dofs_per_level[data->mg_levels-1]; i++)
    MSG("dof_parent[%3d] = (%3d,%3d,%3d), lev=%2d (%2d,%2d,%3d)\n",
	i,
	data->dof_parent[i][0], data->dof_parent[i][1], data->dof_parent[i][2],
	data->dof_level[i],
	data->dof_level[data->dof_parent[i][0]],
	data->dof_level[data->dof_parent[i][1]],
	data->dof_level[data->dof_parent[i][2]]);
#endif

/* build sort_dof[] and sort_dof_invers[] vectors                           */

  FOR_ALL_DOFS(admin,
	       j = data->dof_level[dof];
	       k = tmp_per_level[j]++;
	       data->sort_dof[k] = dof;
	       data->sort_dof_invers[dof] = k;
    );

#if 0
  for (i = 0; i < data->dofs_per_level[data->mg_levels-1]; i++)
  {
    j = data->sort_dof[i];
    MSG("sort[%3d]: dof=%3d, lev=%2d; invers[%3d]=%3d\n",
	i, j, data->dof_level[j], j, data->sort_dof_invers[j]);
  }
  /* WAIT; */
#endif

  if (BPX) {
    data->g = SCRATCH_MEM_CALLOC(data->scratch, DIM_OF_WORLD*data->size, REAL);
    data->diam = fe_space->mesh->diam[0];
    for (i=1; i<DIM_OF_WORLD; i++)
      data->diam = MAX(data->diam, fe_space->mesh->diam[i]);
  } else {
    data->g = NULL;
    data->diam = 0;
  }

  return true;
}

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

static void exit_HB_BPX_precon(void *vdata, int BPX)
{
  FUNCNAME("exit_HB_BPX_precon");
  HB_DATA *data = (HB_DATA *)vdata;

  if (!data) {
    MSG("no data ???\n");
    return;
  }

  SCRATCH_MEM_ZAP(data->scratch);
}

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

static bool init_HB_precon(void *precon_data)
{
  return init_HB_BPX_precon(precon_data, 0);
}

static void exit_HB_precon(void *precon_data)
{
  exit_HB_BPX_precon(precon_data, 0);
}

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

static void HB_precon_s(void *vdata, int n, REAL *r)
{
  FUNCNAME("HB_precon_s");
  int     i, idof, level, last, jdof, k, level1, dim;
  HB_DATA *data;

  data = (HB_DATA *)vdata;
  if (!data) {
    MSG("no data ???\n");
    return;
  }
  dim = data->fe_space->mesh->dim;

  if (n > data->size) {
    MSG("n > data->size ???\n");
    return;
  }

  if (data->mg_levels < 2)                                /* nothing to do */
  {
    return;
  }

/* transposed basis transformation (run over refined levels only)          */

  if (data->high_degree) {
    last = data->dofs_per_level[data->mg_levels - 1];
    for (i = data->dofs_per_level[data->mg_levels - 2]; i < last; i++)  {
      idof = data->sort_dof[i];
      jdof = data->local_dof[i];
      if (data->bound) {
	for (k=0; k<N_VERTICES(dim); k++) {
	  if (data->bound[data->dof_parent[idof][k]] <= INTERIOR)
	    r[data->dof_parent[idof][k]] += data->ipol[jdof][k] * r[idof];
	}
      }
      else {
	for (k=0; k<N_VERTICES(dim); k++) {
	  r[data->dof_parent[idof][k]] += data->ipol[jdof][k] * r[idof];
	}
      }
    }
    level1 = data->mg_levels - 2;
  }
  else {
    level1 = data->mg_levels - 1;
  }

  for (level = level1; level > 0; level--)
  {
    last = data->dofs_per_level[level];

    for (i = data->dofs_per_level[level-1]; i < last; i++)
    {
      idof = data->sort_dof[i];
      if (data->bound) {
	if (data->bound[data->dof_parent[idof][0]] <= INTERIOR)
	  r[data->dof_parent[idof][0]] += 0.5 * r[idof];
	if (data->bound[data->dof_parent[idof][1]] <= INTERIOR)
	  r[data->dof_parent[idof][1]] += 0.5 * r[idof];
      }
      else {
	r[data->dof_parent[idof][0]] += 0.5 * r[idof];
	r[data->dof_parent[idof][1]] += 0.5 * r[idof];
      }
    }
  }

/* basis transformation (run over refined levels only) */

  for (level = 1; level <= level1; level++)
  {
    last = data->dofs_per_level[level];

    for (i = data->dofs_per_level[level-1]; i < last; i++)
    {
      idof = data->sort_dof[i];
      if (!(data->bound && data->bound[idof] >= DIRICHLET)) {
	r[idof] += 0.5 * (r[data->dof_parent[idof][0]]
			  + r[data->dof_parent[idof][1]]);
      }
    }
  }

  if (data->high_degree) {
    last = data->dofs_per_level[data->mg_levels - 1];
    for (i = data->dofs_per_level[data->mg_levels - 2]; i < last; i++)  {
      idof = data->sort_dof[i];
      if (!(data->bound && data->bound[idof] >= DIRICHLET)) {
	jdof = data->local_dof[i];
	for (k = 0; k < N_VERTICES(dim); k++)
	  r[idof] += data->ipol[jdof][k] * r[data->dof_parent[idof][k]];
      }
    }
  }

  return;
}

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

static void HB_precon_d(void *vdata, int n, REAL *r)
{
  FUNCNAME("HB_precon_d");
  int     i, idof, level, last, jdof, k, level1, dim;
  HB_DATA *data;
  REAL_D  *rd = (REAL_D *)r;

  data = (HB_DATA *)vdata;
  if (!data) {
    MSG("no data ???\n");
    return;
  }
  dim = data->fe_space->mesh->dim;

  if (n > DIM_OF_WORLD*data->size) {
    MSG("n > DIM_OF_WORLD*data->size ???\n");
    return;
  }

  if (data->mg_levels < 2)                                /* nothing to do */
  {
    return;
  }

/* transposed basis transformation (run over refined levels only)          */

  if (data->high_degree) {
    last = data->dofs_per_level[data->mg_levels - 1];
    for (i = data->dofs_per_level[data->mg_levels - 2]; i < last; i++)  {
      idof = data->sort_dof[i];
      jdof = data->local_dof[i];
      if (data->bound) {
	for (k=0; k<N_VERTICES(dim); k++) {
	  if (data->bound[data->dof_parent[idof][k]] <= INTERIOR)
	    AXPY_DOW(data->ipol[jdof][k], rd[idof], rd[data->dof_parent[idof][k]]);
	}
      }
      else {
	for (k=0; k<N_VERTICES(dim); k++) {
	  AXPY_DOW(data->ipol[jdof][k], rd[idof],
		   rd[data->dof_parent[idof][k]]);
	}
      }
    }
    level1 = data->mg_levels - 2;
  }
  else {
    level1 = data->mg_levels - 1;
  }


  for (level = level1; level > 0; level--)
  {
    last = data->dofs_per_level[level];

    for (i = data->dofs_per_level[level-1]; i < last; i++)
    {
      idof = data->sort_dof[i];
      if (data->bound) {
	if (data->bound[data->dof_parent[idof][0]] <= INTERIOR)
	  AXPY_DOW(0.5, rd[idof], rd[data->dof_parent[idof][0]]);
	if (data->bound[data->dof_parent[idof][1]] <= INTERIOR)
	  AXPY_DOW(0.5, rd[idof], rd[data->dof_parent[idof][1]]);
      }
      else {
	AXPY_DOW(0.5, rd[idof], rd[data->dof_parent[idof][0]]);
	AXPY_DOW(0.5, rd[idof], rd[data->dof_parent[idof][1]]);
      }
    }
  }

/* basis transformation (run over refined levels only) */

  for (level = 1; level <= level1; level++)
  {
    last = data->dofs_per_level[level];

    for (i = data->dofs_per_level[level-1]; i < last; i++)
    {
      idof = data->sort_dof[i];
      if (!(data->bound && data->bound[idof] >= DIRICHLET)) {
	AXPBYP_DOW(0.5, rd[data->dof_parent[idof][0]],
		   0.5, rd[data->dof_parent[idof][1]],
		   rd[idof]);
      }
    }
  }

  if (data->high_degree) {
    last = data->dofs_per_level[data->mg_levels - 1];
    for (i = data->dofs_per_level[data->mg_levels - 2]; i < last; i++)  {
      idof = data->sort_dof[i];
      if (!(data->bound && data->bound[idof] >= DIRICHLET)) {
	jdof = data->local_dof[i];
	for (k = 0; k < N_VERTICES(dim); k++)
	  AXPY_DOW(data->ipol[jdof][k], rd[data->dof_parent[idof][k]],
		   rd[idof]);
      }
    }
  }

  return;
}

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

static const PRECON *get_HB_precon_s(const DOF_MATRIX *matrix,
				     const DOF_SCHAR_VEC *bound,
				     int info)
{
  PRECON  *precon;
  HB_DATA *data;
  SCRATCH_MEM scratch;
  const FE_SPACE *fe_space = matrix->row_fe_space;

  if (bound && !FE_SPACE_EQ_P(bound->fe_space, fe_space)) {
    ERROR("different fe spaces ?\n");
    return NULL;
  }

#if 0
  /* this stuff does not work with DOF-space holes */
  dof_compress(fe_space->mesh);
#endif

  SCRATCH_MEM_INIT(scratch);
  data = SCRATCH_MEM_CALLOC(scratch, 1, HB_DATA);
  SCRATCH_MEM_CPY(data->scratch, scratch);

  precon = &data->precon;

  data->matrix   = matrix;
  data->fe_space = fe_space;
  data->bound_dv = bound;
  BNDRY_FLAGS_CPY(data->dirichlet_bndry, data->matrix->dirichlet_bndry);

  data->info     = info;

  precon->precon_data = data;
  precon->init_precon = init_HB_precon;
  precon->precon      = HB_precon_s;
  precon->exit_precon = exit_HB_precon;

  return precon;
}

static const PRECON *get_HB_precon_d(const DOF_MATRIX *matrix,
				     const DOF_SCHAR_VEC *bound,
				     int info)
{
  PRECON  *precon;
  HB_DATA *data;
  SCRATCH_MEM scratch;
  const FE_SPACE *fe_space = matrix->row_fe_space;

  if (bound && !FE_SPACE_EQ_P(bound->fe_space, fe_space)) {
    ERROR("different fe spaces ?\n");
    return NULL;
  }

#if 0
  /* this stuff does not work with DOF-space holes */
  dof_compress(fe_space->mesh);
#endif

  SCRATCH_MEM_INIT(scratch);

  data   = SCRATCH_MEM_CALLOC(scratch, 1, HB_DATA);
  SCRATCH_MEM_CPY(data->scratch, scratch);

  precon = &data->precon;

  data->matrix   = matrix;
  data->fe_space = fe_space;
  data->bound_dv = bound;
  BNDRY_FLAGS_CPY(data->dirichlet_bndry, matrix->dirichlet_bndry);

  data->info     = info;

  precon->precon_data = data;
  precon->init_precon = init_HB_precon;
  precon->precon      = HB_precon_d;
  precon->exit_precon = exit_HB_precon;

  return precon;
}

/****************************************************************************/
/****************************************************************************/
/**   BPX  preconditioner                                                  **/
/****************************************************************************/
/****************************************************************************/

static bool init_BPX_precon(void *precon_data)
{
  return init_HB_BPX_precon(precon_data, 1);
}

static void exit_BPX_precon(void *precon_data)
{
  exit_HB_BPX_precon(precon_data, 1);
}
/****************************************************************************/

static void BPX_precon_s(void *vdata, int n, REAL *h)
{
  FUNCNAME("BPX_precon_s");
  int     i, idof, level, first = 0, last, jdof, k, level1, *dof_parent, dim;
  HB_DATA *data;
  REAL    *g, *ipol;

  data = (HB_DATA *)vdata;
  if (!data) {
    MSG("no data ???\n");
    return;
  }
  dim = data->fe_space->mesh->dim;

  if (n > data->size) {
    MSG("n > data->size ???\n");
    return;
  }

  if (data->mg_levels < 2)                                /* nothing to do */
  {
    return;
  }

  g = data->g;
  DEBUG_TEST_EXIT(g, "no g vec in HB_DATA\n");

  /* copy h to g */
  for (i=0; i<data->size; i++)  g[i] = h[i];

  /* Loop over all non-macro levels */

  if (data->high_degree) {
    last = data->dofs_per_level[data->mg_levels - 1];

    /* inverse basis transformation on high degree level for h */

    for (i = data->dofs_per_level[data->mg_levels - 2]; i < last; i++)  {
      idof = data->sort_dof[i];
      dof_parent = data->dof_parent[idof];
      jdof = data->local_dof[i];
      ipol = data->ipol[jdof];
      if (data->bound) {
	for (k=0; k<N_VERTICES(dim); k++) {
	  if (data->bound[data->dof_parent[idof][k]] <= INTERIOR)
	    h[idof] -= ipol[k] * h[dof_parent[k]];
	}
      }
      else {
	for (k=0; k<N_VERTICES(dim); k++) {
	  h[idof] -= ipol[k] * h[dof_parent[k]];
	}
      }
    }

    /* transposed basis transformation on high degree level for g */

    for (i = data->dofs_per_level[data->mg_levels - 2]; i < last; i++)  {
      idof = data->sort_dof[i];
      dof_parent = data->dof_parent[idof];
      jdof = data->local_dof[i];
      ipol = data->ipol[jdof];
      if (data->bound) {
	for (k=0; k<N_VERTICES(dim); k++) {
	  if (data->bound[dof_parent[k]] <= INTERIOR)
	    g[dof_parent[k]] += ipol[k] * g[idof];
	}
      }
      else {
	for (k=0; k<N_VERTICES(dim); k++) {
	  g[dof_parent[k]] += ipol[k] * g[idof];
	}
      }
    }

    /* add up to degree1 level */

    last = data->dofs_per_level[data->mg_levels - 2];
    if (data->bound) {
      for (i = 0; i < last; i++) {
	idof = data->sort_dof[i];
	if (data->bound[idof] <= 0)
	  h[idof] += g[idof];
      }
    } else
    {
      for (i = first; i < last; i++)
      {
	idof = data->sort_dof[i];
	h[idof] += g[idof];
      }
    }

    level1 = data->mg_levels - 2;
  } else {
    level1 = data->mg_levels - 1;
  }

  for (level = level1; level > 0; level--)
  {
    last = data->dofs_per_level[level];

    /* inverse basis transformation on level k (only) for h */
    for (i = data->dofs_per_level[level-1]; i < last; i++) {
      idof = data->sort_dof[i];
      if (!(data->bound && data->bound[idof] >= DIRICHLET)) {
	h[idof] -= 0.5 * (h[data->dof_parent[idof][0]]
			  + h[data->dof_parent[idof][1]]);
      }
    }

    /* transposed basis transformation on level k-1 for g */
    for (i = data->dofs_per_level[level-1]; i < last; i++)
    {
      idof = data->sort_dof[i];
      if (data->bound) {
	if (data->bound[data->dof_parent[idof][0]] <= INTERIOR)
	  g[data->dof_parent[idof][0]] += 0.5 * g[idof];
	if (data->bound[data->dof_parent[idof][1]] <= INTERIOR)
	  g[data->dof_parent[idof][1]] += 0.5 * g[idof];
      }
      else {
	g[data->dof_parent[idof][0]] += 0.5 * g[idof];
	g[data->dof_parent[idof][1]] += 0.5 * g[idof];
      }
    }

    /* add up to level k-1 */


    last = data->dofs_per_level[level-1];
    if (data->bound) {
      for (i = 0; i < last; i++) {
	idof = data->sort_dof[i];
	if (data->bound[idof] <= 0)
	  h[idof] += g[idof];
      }
    } else
    {
      for (i = first; i < last; i++)
      {
	idof = data->sort_dof[i];
	h[idof] += g[idof];
      }
    }
  }

  /* basis transformation (all refined levels) */

  for (level = 1; level <= level1; level++)
  {
    last = data->dofs_per_level[level];

    for (i = data->dofs_per_level[level-1]; i < last; i++)
    {
      idof = data->sort_dof[i];
      if (!(data->bound && data->bound[idof] >= DIRICHLET)) {
	h[idof] += 0.5 * (h[data->dof_parent[idof][0]]
			  + h[data->dof_parent[idof][1]]);
      }
    }
  }

  if (data->high_degree) {
    last = data->dofs_per_level[data->mg_levels - 1];
    for (i = data->dofs_per_level[data->mg_levels - 2]; i < last; i++)  {
      idof = data->sort_dof[i];
      if (!(data->bound && data->bound[idof] >= DIRICHLET)) {
	dof_parent = data->dof_parent[idof];
	jdof = data->local_dof[i];
	ipol = data->ipol[jdof];
	for (k = 0; k < N_VERTICES(dim); k++)
	  h[idof] += ipol[k] * h[dof_parent[k]];
      }
    }
  }

  return;
}

/****************************************************************************/
static void BPX_precon_d(void *vdata, int n, REAL *hh)
{
  FUNCNAME("BPX_precon_d");
  int     i, k, idof, level, first = 0, last, jdof, level1, dim;
  HB_DATA *data;
  REAL_D  *g;
  REAL_D  *h = (REAL_D *)hh;

  data = (HB_DATA *)vdata;
  if (!data) {
    MSG("no data ???\n");
    return;
  }
  dim = data->fe_space->mesh->dim;

  if (n > data->size*DIM_OF_WORLD) {
    MSG("n > data->size*DIM_OF_WORLD ???\n");
    return;
  }

  if (data->mg_levels < 2)                                /* nothing to do */
  {
    return;
  }

  g = (REAL_D *)data->g;
  DEBUG_TEST_EXIT(g, "no g vec in HB_DATA\n");

  /* copy h to g */
  for (i=0; i<data->size; i++)
    COPY_DOW(h[i], g[i]);

  /* Loop over all non-macro levels */

  if (data->high_degree) {
    last = data->dofs_per_level[data->mg_levels - 1];

    /* inverse basis transformation on high degree level for h */

    for (i = data->dofs_per_level[data->mg_levels - 2]; i < last; i++)  {
      idof = data->sort_dof[i];
      jdof = data->local_dof[i];
      if (data->bound) {
	for (k=0; k<N_VERTICES(dim); k++) {
	  if (data->bound[data->dof_parent[idof][k]] <= INTERIOR)
	    AXPY_DOW(-data->ipol[jdof][k], h[data->dof_parent[idof][k]],
		     h[idof]);
	}
      }
      else {
	for (k=0; k<N_VERTICES(dim); k++) {
	  AXPY_DOW(-data->ipol[jdof][k], h[data->dof_parent[idof][k]], h[idof]);
	}
      }
    }

    /* transposed basis transformation on high degree level for g */

    for (i = data->dofs_per_level[data->mg_levels - 2]; i < last; i++)  {
      idof = data->sort_dof[i];
      jdof = data->local_dof[i];
      if (data->bound) {
	for (k=0; k<N_VERTICES(dim); k++) {
	  if (data->bound[data->dof_parent[idof][k]] <= INTERIOR)
	    AXPY_DOW(data->ipol[jdof][k], g[idof],
		     g[data->dof_parent[idof][k]]);
	}
      }
      else {
	for (k=0; k<N_VERTICES(dim); k++) {
	  AXPY_DOW(data->ipol[jdof][k], g[idof], g[data->dof_parent[idof][k]]);
	}
      }
    }

    /* add up to degree1 level */

    last = data->dofs_per_level[data->mg_levels - 2];
    if (data->bound) {
      for (i = 0; i < last; i++) {
	idof = data->sort_dof[i];
	if (data->bound[idof] <= 0)
	  AXPY_DOW(1.0, g[idof], h[idof]);
      }
    } else {
      for (i = first; i < last; i++) {
	idof = data->sort_dof[i];
	AXPY_DOW(1.0, g[idof], h[idof]);
      }
    }

    level1 = data->mg_levels - 2;
  } else {
    level1 = data->mg_levels - 1;
  }

  for (level = level1; level > 0; level--)
  {
    last = data->dofs_per_level[level];

    /* inverse basis transformation on level k (only) for h */
    for (i = data->dofs_per_level[level-1]; i < last; i++) {
      idof = data->sort_dof[i];
      if (!(data->bound && data->bound[idof] >= DIRICHLET)) {
	AXPBYP_DOW(0.5, h[data->dof_parent[idof][0]],
		   0.5, h[data->dof_parent[idof][1]],
		   h[idof]);
      }
    }

    /* transposed basis transformation on level k-1 for g */
    for (i = data->dofs_per_level[level-1]; i < last; i++)
    {
      idof = data->sort_dof[i];
      if (data->bound) {
	if (data->bound[data->dof_parent[idof][0]] <= INTERIOR)
	  AXPY_DOW(0.5, g[idof], g[data->dof_parent[idof][0]]);
	if (data->bound[data->dof_parent[idof][1]] <= INTERIOR)
	  AXPY_DOW(0.5, g[idof], g[data->dof_parent[idof][1]]);
      }
      else {
	AXPY_DOW(0.5, g[idof], g[data->dof_parent[idof][0]]);
	AXPY_DOW(0.5, g[idof], g[data->dof_parent[idof][1]]);
      }
    }

    /* add up to level k-1 */

    last = data->dofs_per_level[level-1];
    if (data->bound) {
      for (i = 0; i < last; i++) {
	idof = data->sort_dof[i];
	if (data->bound[idof] <= 0)
	  AXPY_DOW(1.0, g[idof], h[idof]);
      }
    } else {
      for (i = first; i < last; i++) {
	idof = data->sort_dof[i];
	AXPY_DOW(1.0, g[idof], h[idof]);
      }
    }

  }

  /* basis transformation (all refined levels) */

  for (level = 1; level <= level1; level++)
  {
    last = data->dofs_per_level[level];

    for (i = data->dofs_per_level[level-1]; i < last; i++)
    {
      idof = data->sort_dof[i];
      if (!(data->bound && data->bound[idof] >= DIRICHLET)) {
	AXPBYP_DOW(0.5, h[data->dof_parent[idof][0]],
		   0.5, h[data->dof_parent[idof][1]],
		   h[idof]);
      }
    }
  }

  if (data->high_degree) {
    last = data->dofs_per_level[data->mg_levels - 1];
    for (i = data->dofs_per_level[data->mg_levels - 2]; i < last; i++)  {
      idof = data->sort_dof[i];
      if (!(data->bound && data->bound[idof] >= DIRICHLET)) {
	jdof = data->local_dof[i];
	for (k = 0; k < N_VERTICES(dim); k++)
	  AXPY_DOW(data->ipol[jdof][k], h[data->dof_parent[idof][k]], h[idof]);
      }
    }
  }
  return;
}

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

static const PRECON *get_BPX_precon_s(const DOF_MATRIX *matrix,
				      const DOF_SCHAR_VEC *bound,
				      int info)
{
  PRECON  *precon;
  HB_DATA *data;
  SCRATCH_MEM scratch;
  const FE_SPACE *fe_space = matrix->row_fe_space;

  if (bound && !FE_SPACE_EQ_P(bound->fe_space, fe_space)) {
    ERROR("different fe spaces ?\n");
    return(NULL);
  }

#if 0
  /* this stuff does not work with DOF-space holes */
  dof_compress(fe_space->mesh);
#endif

  SCRATCH_MEM_INIT(scratch);
  data = SCRATCH_MEM_CALLOC(scratch, 1, HB_DATA);
  SCRATCH_MEM_CPY(data->scratch, scratch);

  precon = &data->precon;

  data->matrix   = matrix;
  data->fe_space = fe_space;
  data->bound_dv = bound;
  BNDRY_FLAGS_CPY(data->dirichlet_bndry, matrix->dirichlet_bndry);
    
  data->info     = info;

  precon->precon_data = data;
  precon->init_precon = init_BPX_precon;
  precon->precon      = BPX_precon_s;
  precon->exit_precon = exit_BPX_precon;

  return(precon);
}

static const PRECON *get_BPX_precon_d(const DOF_MATRIX *matrix,
				      const DOF_SCHAR_VEC *bound,
				      int info)
{
  PRECON  *precon;
  HB_DATA *data;
  SCRATCH_MEM scratch;
  const FE_SPACE *fe_space = matrix->row_fe_space;

  if (bound && !FE_SPACE_EQ_P(bound->fe_space, fe_space)) {
    ERROR("different fe spaces ?\n");
    return(NULL);
  }

#if 0
  /* this stuff does not work with DOF-space holes */
  dof_compress(fe_space->mesh);
#endif
  
  SCRATCH_MEM_INIT(scratch);
  data = SCRATCH_MEM_CALLOC(scratch, 1, HB_DATA);
  SCRATCH_MEM_CPY(data->scratch, scratch);

  precon = &data->precon;

  data->matrix   = matrix;
  data->fe_space = fe_space;
  data->bound_dv = bound;
  BNDRY_FLAGS_CPY(data->dirichlet_bndry, matrix->dirichlet_bndry);

  data->info     = info;

  precon->precon_data = data;
  precon->init_precon = init_BPX_precon;
  precon->precon      = BPX_precon_d;
  precon->exit_precon = exit_BPX_precon;

  return precon;
}

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

const PRECON *get_HB_precon(const DOF_MATRIX *matrix,
			    const DOF_SCHAR_VEC *bound,
			    int info)
{
  const FE_SPACE *fe_space = matrix->row_fe_space;

  TEST_EXIT(fe_space->bas_fcts->rdim == 1,
	    "This cannot work for exotic FE-spaces.\n");
  if (fe_space->rdim == 1) {
    return get_HB_precon_s(matrix, bound, info);
  } else {
    return get_HB_precon_d(matrix, bound, info);
  }
}

const PRECON *get_BPX_precon(const DOF_MATRIX *matrix,
			     const DOF_SCHAR_VEC *bound,
			     int info)
{
  const FE_SPACE *fe_space = matrix->row_fe_space;

  TEST_EXIT(fe_space->bas_fcts->rdim == 1,
	    "This cannot work for exotic FE-spaces.\n");
  if (fe_space->rdim == 1) {
    return get_BPX_precon_s(matrix, bound, info);
  } else {
    return get_BPX_precon_d(matrix, bound, info);
  }
}


