/*--------------------------------------------------------------------------*/
/* ALBERTA:  an Adaptive multi Level finite element toolbox using           */
/*           Bisectioning refinement and Error control by Residual          */
/*           Techniques for scientific Applications                         */
/*                                                                          */
/* file:     dof_admin.c                                                    */
/*                                                                          */
/* description:  implementation of the administration of DOFs               */
/*                                                                          */
/*--------------------------------------------------------------------------*/
/*                                                                          */
/*  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                                    */
/*                                                                          */
/*             Daniel Koester                                               */
/*             Institut fuer Mathematik                                     */
/*             Universitaet Augsburg                                        */
/*             Universitaetsstr. 14                                         */
/*             D-86159 Augsburg, Germany                                    */
/*                                                                          */
/*             Claus-Justus Heine                                           */
/*             Abteilung fuer Angewandte Mathematik                          */
/*             Universitaet Freiburg                                         */
/*             Hermann-Herder-Strasse 10                                     */
/*             79104 Freiburg, Germany                                      */
/*                                                                          */
/*  http://www.alberta-fem.de                                               */
/*                                                                          */
/*  (c) by A. Schmidt and K.G. Siebert (1996-2003)                          */
/*         D. Koester (2002-2007???),                                       */
/*         C.-J. Heine (2002-2007).                                         */
/*                                                                          */
/*                                                                          */
/*--------------------------------------------------------------------------*/

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

/*--------------------------------------------------------------------------*/
/*      use a bit vector to indicate used/unused dofs			    */
/*      storage needed: one bit per dof                     		    */
/*--------------------------------------------------------------------------*/

#include "dof_free_bit.h"

/* We use this in get_dof_index(). Even without assembler stuff this
 * version is O(log(DOF_FREE_SIZE)) instead of O(DOF_FREE_SIZE) which
 * is the effort of the naive linear-search effort.
 */
static inline int ffs_dfu(DOF_FREE_UNIT unit)
{
#if USE_ASSEMBLER &&							\
  !HAVE_FFS_DFU && SIZEOF_DOF_FREE_UNIT == SIZEOF_LONG && __GNUC__ && __amd64
# define HAVE_FFS_DFU 1
  DOF_FREE_UNIT result;
  
  __asm__("bsfq\t%1,%0\n\t"
	  "jnz\t1f\n\t"
	  "mov\t$-1,%0\n"
	  "1:"
	  :"=r" (result)
	  :"rm" (unit));
  return result;
#endif
#if USE_ASSEMBLER &&							\
  !HAVE_FFS_DFU && SIZEOF_DOF_FREE_UNIT == SIZEOF_LONG && __GNUC__ && __i386
# define HAVE_FFS_DFU 1
  DOF_FREE_UNIT result;
  
  __asm__("bsfl\t%1,%0\n\t"
	  "jnz\t1f\n\t"
	  "mov\t$-1,%0\n"
	  "1:"
	  :"=r" (result)
	  :"rm" (unit));
  return result;
#endif
/* You are invited to add more stuff here! */
#if !HAVE_FFS_DFU && SIZEOF_DOF_FREE_UNIT == SIZEOF_LONG && HAVE_FFSL
# define HAVE_FFS_DFU 1
# if !HAVE_DECL_FFSL
  extern int ffsl(long int i);
# endif
  return ffsl(unit)-1;
#endif
#if !HAVE_FFS_DFU
# define HAVE_FFS_DFU 1
  int r = 0;

  if (!unit) {
    return -1;
  }

# if SIZEOF_DOF_FREE_UNIT >= 16
  if (!(x & 0xFFFFFFFFFFFFFFFF)) {
    unit >>= 64;
    r += 64;
  }
# endif
# if SIZEOF_DOF_FREE_UNIT >= 8
  if (!(unit & 0xFFFFFFFF)) {
    unit >>= 32;
    r += 32;
  }
# endif
# if SIZEOF_DOF_FREE_UNIT >= 4
  if (!(unit & 0xFFFF)) {
    unit >>= 16;
    r += 16;
  }
# endif
#  if SIZEOF_DOF_FREE_UNIT >= 2
  if (!(unit & 0xFF)) {
    unit >>= 8;
    r += 8;
  }
# endif
# if SIZEOF_DOF_FREE_UNIT >= 1
  if (!(unit & 0xF)) {
    unit >>= 4;
    r += 4;
  }
  if (!(unit & 0x3)) {
    unit >>= 2;
    r += 2;
  }
  if (!(unit & 0x1)) {
    unit >>= 1;
    r += 1;
  }
# endif
  return r;
#endif
}

/*--------------------------------------------------------------------------*/
/*  SIZE_INCREMENT:                                                         */
/*  default increment for DOF_VECs etc. in enlarge_dof_lists                */
/*--------------------------------------------------------------------------*/

#define SIZE_INCREMENT (DOF_FREE_SIZE * 32)

/*--------------------------------------------------------------------------*/

void free_dof_index(DOF_ADMIN  *admin, int dof)
{
  FUNCNAME("free_dof_index");
#if 0
  int          i, j;
  int          col, col2;
#endif
  unsigned int iunit, ibit;
  DOF_MATRIX   *matrix;
  MATRIX_ROW   *row, *row2;

  DEBUG_TEST_EXIT(admin, "no admin\n");
  DEBUG_TEST_EXIT(admin->used_count > 0, "no dofss sin use\n");
  DEBUG_TEST_EXIT((dof >= 0) && (dof < admin->size),
		  "invalid DOF index %d!\n",dof);

  iunit = dof / DOF_FREE_SIZE;
  ibit  = dof % DOF_FREE_SIZE;
  if ((admin->dof_free[iunit] & dof_free_bit[ibit]) != 0) {
    /* unused DOF, probably a double free of a periodic DOF index */
    ERROR_EXIT("Double free of DOF index.\n");
  }

  for (matrix = admin->dof_matrix; matrix; matrix = matrix->next) {
    if (matrix->matrix_row == NULL) {
      continue;
    }
    if ((row = matrix->matrix_row[dof])) {
      do
      {
#if 0
/* This operation is expensive - and leads to wrong results, if fe_space    */
/* and col_fe_space don't match! (DK)                                       */
/* Besides, this sort of cleanup is not done for vectors either.            */
	for (i=0; i<ROW_LENGTH; i++)
	{
	  col = row->col[i];
	  if (ENTRY_USED(col))
	  {
	    /* remove symmetric entry if exists */
	    if (matrix->col_fe_space->admin == admin && col != dof)
	    {
	      row2 = matrix->matrix_row[col];
	      while (row2)
	      {
		for (j=0; j<ROW_LENGTH; j++)
		{
		  col2 = row2->col[j];
		  if (col2 == dof) 
		  {
		    row2->col[j] = UNUSED_ENTRY;
		  }
		  else if (col2 == NO_MORE_ENTRIES)
		  {
		    break;
		  }
		}
		row2 = row2->next;
	      };
	    }
	  }
	  else if (col == NO_MORE_ENTRIES)
	  {
	    break;
	  }
	}
#endif
	row2 = row;
	row = row->next;
	free_matrix_row(matrix->row_fe_space, row2);
	
      } while(row);

      matrix->matrix_row[dof] = NULL;
    }
  }

  iunit = dof / DOF_FREE_SIZE;
  ibit  = dof % DOF_FREE_SIZE;
  admin->dof_free[iunit] |= dof_free_bit[ibit];
  if (admin->first_hole > iunit) {
    admin->first_hole = iunit;
  }

  admin->used_count--;
  admin->hole_count++;
}

/*--------------------------------------------------------------------------*/

DOF get_dof_index(DOF_ADMIN *admin)
{
  FUNCNAME("get_dof_index");
  DOF       dof = 0, i, ibit;

  DEBUG_TEST_EXIT(admin, "no admin\n");

#if 1
  if (admin->first_hole < admin->dof_free_size) {
    ibit = ffs_dfu(admin->dof_free[admin->first_hole]);
    DEBUG_TEST_EXIT(ibit < DOF_FREE_SIZE, "no free bit in first_hole ?\n");
    admin->dof_free[admin->first_hole] &= ~(1UL << ibit);
    dof = DOF_FREE_SIZE * admin->first_hole + ibit;
    if (admin->dof_free[admin->first_hole] == 0) {
      for (i = admin->first_hole+1; i < (int)admin->dof_free_size; i++) {
	if (admin->dof_free[i]) {
	  break;
	}
      }
      admin->first_hole = i;
    }
  }
#else
  if (admin->first_hole < admin->dof_free_size) {
    for (ibit = 0; ibit < DOF_FREE_SIZE; ibit++) {
      if (admin->dof_free[admin->first_hole] & dof_free_bit[ibit]) {
	admin->dof_free[admin->first_hole] ^= dof_free_bit[ibit];
	dof = DOF_FREE_SIZE * admin->first_hole + ibit;
	if (admin->dof_free[admin->first_hole] == 0) {
	  for (i = admin->first_hole+1; i < admin->dof_free_size; i++) {
	    if (admin->dof_free[i]) {
	      break;
	    }
	  }
	  admin->first_hole = i;
	}
	break;
      }
    }
    DEBUG_TEST_EXIT(ibit < DOF_FREE_SIZE, "no free bit in first_hole ?\n");
  }
#endif
  else {
    enlarge_dof_lists(admin, 0);
    DEBUG_TEST_EXIT(admin->first_hole < admin->dof_free_size,
		    "no free entry after enlarge_dof_lists\n");
    DEBUG_TEST_EXIT(admin->dof_free[admin->first_hole] & dof_free_bit[0],
		    "no free bit 0\n");
    admin->dof_free[admin->first_hole] ^= dof_free_bit[0];
    dof = DOF_FREE_SIZE * admin->first_hole;
  }

  admin->used_count++;
  if (admin->hole_count > 0) admin->hole_count--;
  admin->size_used = MAX(admin->size_used, dof+1);

  return(dof);
}

/* Unconditionally set the number of used DOFs to used_count, and make
 * sure that admin->dof_free[] has these DOFs allocated; the resulting
 * DOF_ADMIN has no holes.
 */
void _AI_allocate_n_dofs(DOF_ADMIN *admin, int used_count)
{
  int i;
  
  enlarge_dof_lists(admin, used_count);
  for (i = 0; i < used_count / DOF_FREE_SIZE; i++) {
    admin->dof_free[i] = ~DOF_UNIT_ALL_FREE;
  }
  admin->dof_free[i++] = DOF_UNIT_ALL_FREE << (used_count % DOF_FREE_SIZE);
  admin->used_count = used_count;
  admin->size_used  = used_count;
  admin->hole_count = 0;
  admin->first_hole = used_count / DOF_FREE_SIZE;
}

/*--------------------------------------------------------------------------*/

void enlarge_dof_lists(DOF_ADMIN *admin, int minsize)
{
  FUNCNAME("enlarge_dof_lists");
  int              old_size, new_size, i, new_free_size;
  DOF_INT_VEC      *iv;
  DOF_DOF_VEC      *dv;
  DOF_UCHAR_VEC    *uv;
  DOF_SCHAR_VEC    *sv;
  DOF_REAL_VEC     *rv;
  DOF_REAL_D_VEC   *rdv;
  DOF_REAL_DD_VEC  *rddv;
  DOF_PTR_VEC      *pv;
  DOF_MATRIX       *mat;

  DEBUG_TEST_EXIT(admin, "no admin\n");

  old_size = admin->size;
  if (minsize > 0) {
    if (old_size > minsize) return;
  }

  new_size = MAX(minsize, admin->size + SIZE_INCREMENT);

  new_size += (DOF_FREE_SIZE - (new_size % DOF_FREE_SIZE)) % DOF_FREE_SIZE;
  admin->size = new_size;

  new_free_size = new_size / DOF_FREE_SIZE;
  admin->dof_free = MEM_REALLOC(admin->dof_free, admin->dof_free_size,
				new_free_size, DOF_FREE_UNIT);
  for (i = admin->dof_free_size; i < new_free_size; i++)
    admin->dof_free[i] = DOF_UNIT_ALL_FREE;
  admin->first_hole = admin->dof_free_size;
  admin->dof_free_size = new_free_size;

  /* enlarge all vectors and matrices          */
  /* but int_dof_vecs don't have to be changed */

  for (iv = admin->dof_int_vec; iv; iv = iv->next) {
    if (iv->size < new_size) {
      iv->vec = MEM_REALLOC(iv->vec, iv->size, new_size, int);
      for (i = iv->size; i < new_size; i++) iv->vec[i] = 0;
      iv->size   = new_size;
    }
  }

  for (dv = admin->dof_dof_vec; dv; dv = dv->next) {
    if (dv->size < new_size) {
      dv->vec = MEM_REALLOC(dv->vec, dv->size, new_size, DOF);
      for (i = dv->size; i < new_size; i++) dv->vec[i] = -1;
      dv->size = new_size;
    }
  }

  for (uv = admin->dof_uchar_vec; uv; uv = uv->next) {
    if (uv->size < new_size) {
      uv->vec = MEM_REALLOC(uv->vec, uv->size, new_size, U_CHAR);
      for (i = uv->size; i < new_size; i++) uv->vec[i] = 0;
      uv->size   = new_size;
    }
  }

  for (sv = admin->dof_schar_vec; sv; sv = sv->next) {
    if (sv->size < new_size) {
      sv->vec = MEM_REALLOC(sv->vec, old_size, new_size, S_CHAR);
      for (i = sv->size; i < new_size; i++) sv->vec[i] = 0;
      sv->size   = new_size;
    }
  }

  for (rv = admin->dof_real_vec; rv; rv = rv->next) {
    if (rv->size < new_size) {
      rv->vec = MEM_REALLOC(rv->vec, rv->size, new_size, REAL);
      for (i = rv->size; i < new_size; i++) rv->vec[i] = 0.0;
      rv->size = new_size;
    }
  }

  for (rdv = admin->dof_real_d_vec; rdv; rdv = rdv->next) {
    if (rdv->size < new_size) {
      rdv->vec = MEM_REALLOC(rdv->vec, rdv->size, new_size, REAL_D);
      for (i = rdv->size; i < new_size; i++)
	SET_DOW(0.0, rdv->vec[i]);
      rdv->size = new_size;
    }
  }

  for (rddv = admin->dof_real_dd_vec; rddv; rddv = rddv->next) {
    if (rddv->size < new_size) {
      rddv->vec = MEM_REALLOC(rddv->vec, rddv->size, new_size, REAL_DD);
      for (i = rddv->size; i < new_size; i++)
	MSET_DOW(0.0, rddv->vec[i]);
      rddv->size = new_size;
    }
  }

  for (pv = admin->dof_ptr_vec; pv; pv = pv->next) {
    if (pv->size < new_size) {
      pv->vec = MEM_REALLOC(pv->vec, pv->size, new_size, void *);
      for (i = pv->size; i < new_size; i++) pv->vec[i] = NULL;
      pv->size = new_size;
    }
  }

  for (mat = admin->dof_matrix; mat; mat = mat->next) {
    if (!mat->is_diagonal) {
      if (mat->size < new_size) {
	mat->matrix_row = MEM_REALLOC(mat->matrix_row, mat->size, new_size,
				      MATRIX_ROW *);
	for (i = mat->size; i < new_size; i++) {
	  mat->matrix_row[i] = NULL;
	}
	mat->size = new_size;
      }
    } else {
      mat->size = new_size;      
    }
  }

}


/*--------------------------------------------------------------------------*/
/*  dof_compress: remove holes in dof vectors                               */
/*--------------------------------------------------------------------------*/

typedef struct dof_admin_traverse_data1 {
  int       *new_dof;
  int       *g_n_dof;
  int       *g_n0_dof;
  int       *g_node;
} DOF_ADMIN_TRAVERSE_DATA1;

/*--------------------------------------------------------------------------*/
/*  ATTENTION:                                                              */
/*  new_dof_fct() destroys new_dof !!!!!!!!!!                               */
/*  should be used only at the end of dof_compress()!!!!!                   */
/*--------------------------------------------------------------------------*/

/* CHANGE_DOFS_1 changes old dofs to NEGATIVE new dofs. The index is shifted */
/* by - 2 so that unused element DOFs (-1) are preserved.                    */

#define CHANGE_DOFS_1(el)						\
  dof0 = el->dof[n0+i];							\
  dof = dof0 + nd0;							\
  if(dof0)								\
    for (j = 0; j < nd; j++)						\
      if ((k = dof[j]) >= 0)						\
	/* do it only once! (dofs are visited more than once) */	\
	dof[j] = - ud->new_dof[k] - 2;

/* CHANGE_DOFS_2 changes NEGATIVE new dofs to POSITIVE. The index shift above*/
/* is undone.                                                                */

#define CHANGE_DOFS_2(el)						\
  dof0 = el->dof[n0+i];							\
  dof = dof0 + nd0;							\
  if(dof0)								\
    for (j = 0; j < nd; j++)						\
      if ((k = dof[j]) < -1)						\
	/* do it only once! (dofs are visited more than once) */	\
	dof[j] = - k - 2; 

static inline void new_dof_fct1(const EL_INFO *el_info, void *data)
{
  DOF_ADMIN_TRAVERSE_DATA1 *ud = (DOF_ADMIN_TRAVERSE_DATA1 *)data;
  EL      *el = el_info->el;
  int     i, j, k, n0, nd, nd0;
  int     dim = el_info->mesh->dim;
  DOF     *dof0, *dof;
  
  if ((nd = ud->g_n_dof[VERTEX]))  {
    nd0 = ud->g_n0_dof[VERTEX];
    n0 = ud->g_node[VERTEX];
    for (i = 0; i < N_VERTICES(dim); i++) {
      CHANGE_DOFS_1(el);
    }
  }

  if(dim > 1 && (nd = ud->g_n_dof[EDGE])) {
    nd0 = ud->g_n0_dof[EDGE];
    n0 = ud->g_node[EDGE];
    for (i = 0; i < N_EDGES(dim); i++) {
      CHANGE_DOFS_1(el);
    }
  }
  
  if(dim == 3 && (nd = ud->g_n_dof[FACE]))  {
    nd0 = ud->g_n0_dof[FACE];
    n0 = ud->g_node[FACE];
    for (i = 0; i < N_FACES_3D; i++) {
      CHANGE_DOFS_1(el);
    }
  }
  
  if ((nd = ud->g_n_dof[CENTER]))  {
    nd0 = ud->g_n0_dof[CENTER];
    n0 = ud->g_node[CENTER];
    i = 0;          /* only one center */
    CHANGE_DOFS_1(el);
  }

  return;
}


static inline void new_dof_fct2(const EL_INFO *el_info, void *data)
{
  DOF_ADMIN_TRAVERSE_DATA1 *ud = (DOF_ADMIN_TRAVERSE_DATA1 *)data;
  EL      *el = el_info->el;
  int     i, j, k, n0, nd, nd0;
  int     dim = el_info->mesh->dim;
  DOF     *dof0, *dof;
  
  if ((nd = ud->g_n_dof[VERTEX]))  {
    nd0 = ud->g_n0_dof[VERTEX];
    n0 = ud->g_node[VERTEX];
    for (i = 0; i < N_VERTICES(dim); i++) {
      CHANGE_DOFS_2(el);
    }
  }

  if(dim > 1 && (nd = ud->g_n_dof[EDGE])) {
    nd0 = ud->g_n0_dof[EDGE];
    n0 = ud->g_node[EDGE];
    for (i = 0; i < N_EDGES(dim); i++) 
    {
      CHANGE_DOFS_2(el);
    }
  }
  
  if(dim == 3 && (nd = ud->g_n_dof[FACE]))  {
    nd0 = ud->g_n0_dof[FACE];
    n0 = ud->g_node[FACE];
    for (i = 0; i < N_FACES_3D; i++) {
      CHANGE_DOFS_2(el);
    }
  }
  
  if ((nd = ud->g_n_dof[CENTER]))  {
    nd0 = ud->g_n0_dof[CENTER];
    n0 = ud->g_node[CENTER];
    i = 0;          /* only one center */
    CHANGE_DOFS_2(el);
  }

  return;
}

#undef CHANGE_DOFS_1
#undef CHANGE_DOFS_2

/*--------------------------------------------------------------------------*/

void dof_compress(MESH *mesh)
{
  FUNCNAME("dof_compress");
  DOF_ADMIN_TRAVERSE_DATA1 td[1] = {{0}};
  DOF_ADMIN       *compress_admin, *search_admin;
  int             i, j, k, n_rows, size, first, last=0, col, iadmin, jadmin;
  FLAGS           fill_flag;
  DOF_INT_VEC     *div;
  DOF_DOF_VEC     *ddv;
  DOF_UCHAR_VEC   *duv;
  DOF_SCHAR_VEC   *dsv;
  DOF_REAL_D_VEC  *drdv;
  DOF_REAL_DD_VEC *drddv;
  DOF_REAL_VEC    *drv;
  DOF_PTR_VEC     *dpv;
  DOF_MATRIX      *dm;
  MATRIX_ROW      *row, *row_next;
  DBL_LIST_NODE   *pos;
  MESH_MEM_INFO   *minfo;
  bool            did_compress = false;

  TEST_EXIT(mesh, "No mesh given!\n");

  td->g_node = mesh->node;

  for (iadmin = 0; iadmin < mesh->n_dof_admin; iadmin++)
  {
    compress_admin = mesh->dof_admin[iadmin];

    DEBUG_TEST_EXIT(compress_admin, "no dof_admin[%d] in mesh\n", iadmin);

    if ((size = compress_admin->size) < 1) continue;
    if (compress_admin->used_count < 1)    continue;
    if (compress_admin->hole_count < 1)    continue;

    did_compress = true;
    
    td->g_n_dof = compress_admin->n_dof;
    td->g_n0_dof = compress_admin->n0_dof;

    td->new_dof = MEM_ALLOC(size, int);
    for (i = 0; i < size; i++) {             /* mark everything unused */
      td->new_dof[i] = -1;
    }

    FOR_ALL_DOFS(compress_admin, td->new_dof[dof] = 1);

    n_rows = 0;
    for (i = 0; i < size; i++) {             /* create a MONOTONE compress */
      if (td->new_dof[i] == 1) {
	td->new_dof[i] = n_rows++;
	last = i;
      }
    }

    DEBUG_TEST_EXIT(n_rows == compress_admin->used_count,
		    "count %d != used_count %d\n",
		    n_rows, compress_admin->used_count);

    {
      int n1 = n_rows / DOF_FREE_SIZE;

      for (i = 0; i < n1; i++)
	compress_admin->dof_free[i] = 0;
      if (n1 < (int)compress_admin->dof_free_size)
	compress_admin->dof_free[n1] = (~0UL) << (n_rows % DOF_FREE_SIZE);      
      for (i = n1+1; i < (int)compress_admin->dof_free_size; i++)
	compress_admin->dof_free[i] = DOF_UNIT_ALL_FREE;
      compress_admin->first_hole = n1;
    }

    compress_admin->hole_count = 0;
    compress_admin->size_used  = n_rows;

    first = 0;
    for (i=0; i<size; i++) {
      if ((td->new_dof[i] < i) && (td->new_dof[i] >= 0)) {
	first = i;
	break;
      }
    }
    if (last >= first) {
      last++;   /* for (i = first; i < last; i++) ... */

      /* compress all vectors associated to admin */

      for (div = compress_admin->dof_int_vec; div; div = div->next) {
	for (i=first; i<last; i++) {
	  if ((k = td->new_dof[i]) >= 0)
	    div->vec[k] = div->vec[i];
	}
      }
  
      for (ddv = compress_admin->dof_dof_vec; ddv; ddv = ddv->next) {
	for (i=first; i<last; i++) {
	  if ((k = td->new_dof[i]) >= 0)
	    ddv->vec[k] = ddv->vec[i];
	}
	for (i=0; i < n_rows; i++) {
	  if ((k = td->new_dof[ddv->vec[i]]) >= 0)
	    ddv->vec[i] = k;
	}
      }
  
      for (ddv = compress_admin->int_dof_vec; ddv; ddv = ddv->next) {
	for (i=0; i < ddv->size; i++) {
	  if (ddv->vec[i] >= 0) 
	    if ((k = td->new_dof[ddv->vec[i]]) >= 0)
	      ddv->vec[i] = k;
	}
      }
  
      for (duv = compress_admin->dof_uchar_vec; duv; duv = duv->next) {
	for (i=first; i<last; i++) {
	  if ((k = td->new_dof[i]) >= 0)
	    duv->vec[k] = duv->vec[i];
	}
      }
  
      for (dsv = compress_admin->dof_schar_vec; dsv; dsv = dsv->next) {
	for (i=first; i<last; i++) {
	  if ((k = td->new_dof[i]) >= 0)
	    dsv->vec[k] = dsv->vec[i];
	}
      }
  
      for (drv = compress_admin->dof_real_vec; drv; drv = drv->next) {
	for (i=first; i<last; i++) {
	  if ((k = td->new_dof[i]) >= 0)
	    drv->vec[k] = drv->vec[i];
	}
      }
  
      for (drdv = compress_admin->dof_real_d_vec; drdv; drdv = drdv->next) {
	for (i=first; i<last; i++) {
	  if ((k = td->new_dof[i]) >= 0)
	    COPY_DOW(drdv->vec[i], drdv->vec[k]);
	}
      }

      for (drddv = compress_admin->dof_real_dd_vec;
	   drddv; drddv = drddv->next) {
	for (i = first; i < last; i++) {
	  if ((k = td->new_dof[i]) >= 0)
	    MCOPY_DOW((const REAL_D *)drddv->vec[i], drddv->vec[k]);
	}
      }

      for (dpv = compress_admin->dof_ptr_vec; dpv; dpv = dpv->next) {
	for (i=first; i<last; i++) {
	  if ((k = td->new_dof[i]) >= 0)
	    dpv->vec[k] = dpv->vec[i];
	}
      }

      /* Row corrections */  
      for (dm = compress_admin->dof_matrix; dm; dm = dm->next) {
	if (dm->is_diagonal) {
	  /* probably a diagonal matrix, the row/column corrections
	   * already have been performed on the vector holding the
	   * diagonal entries.
	   */
	  continue;
	}
	for (i = first; i < last; i++) {
	  if ((k = td->new_dof[i]) >= 0) {
	    /* free dm->matrix_row[k]; */
	    for (row = dm->matrix_row[k]; row; row = row_next) {
	      /* Should this really happen ???? */
	      row_next = row->next;
	      free_matrix_row(dm->row_fe_space, row);
	    }
	    dm->matrix_row[k] = dm->matrix_row[i];
	    dm->matrix_row[i] = NULL;
	  }
	}
      }

      /* Column corrections, we search all matrices for ones with */
      /* col_fe_space->admin == compress_admin.                   */

      for (jadmin = 0; jadmin < mesh->n_dof_admin; jadmin++) {
	search_admin = mesh->dof_admin[jadmin];
	
	DEBUG_TEST_EXIT(search_admin,
			"no dof_admin[%d] in mesh\n", jadmin);
	
	for (dm = search_admin->dof_matrix; dm; dm = dm->next) {
	  if ((dm->col_fe_space == NULL &&
	       dm->row_fe_space->admin == compress_admin) ||
	      (dm->col_fe_space != NULL &&
	       dm->col_fe_space->admin == compress_admin)) {
	    int n_rows = dm->row_fe_space->admin->size_used;
	    if (dm->is_diagonal) {
	      /* probably a diagonal matrix, correct the column indices */
	      for (i=0; i < n_rows; i++) { /* change columns */
		DOF col_dof = dm->diag_cols->vec[i];
		if (ENTRY_USED(col_dof)) {
		  dm->diag_cols->vec[i] = td->new_dof[col_dof];
		}
	      }
	    } else {	      
	      for (i=0; i < n_rows; i++) { /* change columns */
		for (row = dm->matrix_row[i]; row; row = row->next) {
		  for (j=0; j<ROW_LENGTH; j++) {
		    col = row->col[j];
		    if (ENTRY_USED(col)) row->col[j] = td->new_dof[col];
		  }
		}
	      }
	    }
	  }
	}
      }
      

      /* Call custom compress hooks */
      for (pos = compress_admin->compress_hooks.next;
	   pos != &compress_admin->compress_hooks;
	   pos = pos->next) {
	DOF_COMP_HOOK *hook = dbl_list_entry(pos, DOF_COMP_HOOK, node);
	hook->handler(first, last, td->new_dof, hook->application_data);
      }
      
      /* now, change dofs in MESH's nodes */
      /* new_dof_fct destroys new_dof[] !!! */

      fill_flag = CALL_EVERY_EL_PREORDER | FILL_NOTHING;

      TRAVERSE_FIRST(mesh, -1, fill_flag) {
	new_dof_fct1(el_info, td);
      } TRAVERSE_NEXT();      
      TRAVERSE_FIRST(mesh, -1, fill_flag) {
	new_dof_fct2(el_info, td);
      } TRAVERSE_NEXT();      
    }

    MEM_FREE(td->new_dof, size, int);
    td->new_dof = NULL;
  }

  mesh->cookie += did_compress;

  minfo = (MESH_MEM_INFO *)mesh->mem_info;
  for (i = 0; i < minfo->n_slaves; i++) {
    dof_compress(minfo->slaves[i]);
  }
}

void add_dof_compress_hook(const DOF_ADMIN *admin, DOF_COMP_HOOK *hook)
{
  dbl_list_add_head((DBL_LIST_NODE *)&admin->compress_hooks, &hook->node);
}

void del_dof_compress_hook(DOF_COMP_HOOK *hook)
{
  dbl_list_del(&hook->node);
}

/*--------------------------------------------------------------------------*/
/*  matrix administration                            			    */
/*--------------------------------------------------------------------------*/
/*  AI_add_dof_matrix_to_admin():       enter new matrix to DOF_ADMIN list  */
/*                                   (re)alloc matrix_row, el_* if necessary*/
/*  AI_add_dof_int_vec_to_admin():      enter new vec to DOF_ADMIN list     */
/*  AI_add_int_dof_vec_to_admin():      enter new vec to DOF_ADMIN list     */
/*  AI_add_dof_dof_vec_to_admin():      enter new vec to DOF_ADMIN list     */
/*  AI_add_dof_uchar_vec_to_admin():    enter new vec to DOF_ADMIN list     */
/*  AI_add_dof_schar_vec_to_admin():    enter new vec to DOF_ADMIN list     */
/*  AI_add_dof_real_vec_to_admin():     enter new vec to DOF_ADMIN list     */
/*  AI_add_dof_real_d_vec_to_admin():   enter new vec to DOF_ADMIN list     */
/*  AI_add_dof_real_dd_vec_to_admin():  enter new vec to DOF_ADMIN list     */
/*  AI_add_dof_ptr_vec_to_admin():      enter new vec to DOF_ADMIN list     */
/*                                     (re)alloc vector if necessary        */
/*                                                                          */
/*  update_dof_matrix():             add/substract el_mat to/from matrix    */
/*--------------------------------------------------------------------------*/

#define CHECK_IF_PRESENT(admin, TYPE, list, vec)		\
  {								\
    TYPE *v;							\
    for (v=admin->list; v; v = v->next)				\
      if (v==vec) {						\
	ERROR_EXIT("dof_vec %s already associated to admin %s\n",	\
	      NAME(vec), NAME(admin));				\
	return;							\
      }								\
  }


#define DEFUN_ADD_DOF_OBJ_TO_ADMIN(TYPE, list, enlarge)		\
  void add_##list##_to_admin(TYPE *obj, DOF_ADMIN *admin)	\
  {								\
    FUNCNAME("add_"#list"_to_admin");				\
								\
    if (!obj) {							\
      MSG("no obj\n");						\
      return;							\
    }								\
								\
    CHECK_IF_PRESENT(admin, TYPE, list, obj);			\
								\
    if (obj->size < admin->size) {				\
      enlarge;							\
      obj->size = admin->size;					\
    }								\
								\
    obj->next = admin->list;					\
    admin->list = obj;						\
    /* obj->admin = admin; */					\
  }								\
  struct _AI_semicolon_dummy

#define DEFUN_ADD_DOF_VEC_TO_ADMIN(TYPE, type, list)			\
  DEFUN_ADD_DOF_OBJ_TO_ADMIN(TYPE, list, {				\
      obj->vec = MEM_REALLOC(obj->vec, obj->size, admin->size, type);	\
    })

static void refine_diag_cols(DOF_INT_VEC *vec, RC_LIST_EL *rclist, int n);

#define DEFUN_ADD_DOF_MAT_TO_ADMIN(TYPE, type, list)		\
  DEFUN_ADD_DOF_OBJ_TO_ADMIN(TYPE, list, {			\
      if (!obj->is_diagonal) {					\
	int i;							\
      								\
	obj->matrix_row = MEM_REALLOC(obj->matrix_row, obj->size,	\
				      admin->size, type *);		\
	for (i = obj->size; i < admin->size; i++) {			\
	  obj->matrix_row[i] = NULL;					\
	}								\
      } else {								\
	obj->diag_cols = get_dof_int_vec(				\
	  "diag cols", obj->row_fe_space->unchained);			\
	obj->diag_cols->refine_interpol = refine_diag_cols;		\
	FOR_ALL_DOFS(admin, obj->diag_cols->vec[dof] = UNUSED_ENTRY);	\
      }									\
      obj->size = admin->size;						\
    })

#define DEFUN_REMOVE_DOF_OBJ_FROM_ADMIN(TYPE, list)			\
  void remove_##list##_from_admin(TYPE *obj)				\
  {									\
    FUNCNAME("remove_"#list"_from_admin");				\
    DOF_ADMIN    *admin;						\
    TYPE         *obj_last;						\
									\
    if (obj->fe_space && (admin = (DOF_ADMIN *)obj->fe_space->admin)) {	\
      if (admin->list == obj) {						\
	admin->list = obj->next;					\
      } else {								\
	obj_last = admin->list;						\
	while (obj_last &&  obj_last->next != obj)			\
	  obj_last = obj_last->next;					\
									\
	if (!obj_last) {						\
	  ERROR_EXIT(""#list" %s not in list of dof admin %s found\n",	\
		NAME(obj), NAME(admin));				\
	} else {							\
	  obj_last->next = obj->next;					\
	}								\
      }									\
    }									\
  }									\
  struct _AI_semicolon_dummy

DEFUN_ADD_DOF_VEC_TO_ADMIN(DOF_INT_VEC, int, dof_int_vec);
DEFUN_REMOVE_DOF_OBJ_FROM_ADMIN(DOF_INT_VEC, dof_int_vec);

DEFUN_ADD_DOF_VEC_TO_ADMIN(DOF_DOF_VEC, DOF, dof_dof_vec);
DEFUN_REMOVE_DOF_OBJ_FROM_ADMIN(DOF_DOF_VEC, dof_dof_vec);

DEFUN_ADD_DOF_VEC_TO_ADMIN(DOF_DOF_VEC, DOF, int_dof_vec);
DEFUN_REMOVE_DOF_OBJ_FROM_ADMIN(DOF_DOF_VEC, int_dof_vec);

DEFUN_ADD_DOF_VEC_TO_ADMIN(DOF_UCHAR_VEC, U_CHAR, dof_uchar_vec);
DEFUN_REMOVE_DOF_OBJ_FROM_ADMIN(DOF_UCHAR_VEC, dof_uchar_vec);

DEFUN_ADD_DOF_VEC_TO_ADMIN(DOF_SCHAR_VEC, S_CHAR, dof_schar_vec);
DEFUN_REMOVE_DOF_OBJ_FROM_ADMIN(DOF_SCHAR_VEC, dof_schar_vec);

DEFUN_ADD_DOF_VEC_TO_ADMIN(DOF_REAL_VEC, REAL, dof_real_vec);
DEFUN_REMOVE_DOF_OBJ_FROM_ADMIN(DOF_REAL_VEC, dof_real_vec);

DEFUN_ADD_DOF_VEC_TO_ADMIN(DOF_REAL_D_VEC, REAL_D, dof_real_d_vec);
DEFUN_REMOVE_DOF_OBJ_FROM_ADMIN(DOF_REAL_D_VEC, dof_real_d_vec);

DEFUN_ADD_DOF_VEC_TO_ADMIN(DOF_REAL_DD_VEC, REAL_DD, dof_real_dd_vec);
DEFUN_REMOVE_DOF_OBJ_FROM_ADMIN(DOF_REAL_DD_VEC, dof_real_dd_vec);

DEFUN_ADD_DOF_VEC_TO_ADMIN(DOF_PTR_VEC, void *, dof_ptr_vec);
DEFUN_REMOVE_DOF_OBJ_FROM_ADMIN(DOF_PTR_VEC, dof_ptr_vec);

#define fe_space row_fe_space
DEFUN_ADD_DOF_MAT_TO_ADMIN(DOF_MATRIX, MATRIX_ROW, dof_matrix);
DEFUN_REMOVE_DOF_OBJ_FROM_ADMIN(DOF_MATRIX, dof_matrix);
#undef fe_space

#undef CHECK_IF_PRESENT
#undef DEFUN_ADD_DOF_OBJ_TO_ADMIN
#undef DEFUN_ADD_DOF_VEC_TO_ADMIN
#undef DEFUN_ADD_DOF_MAT_TO_ADMIN
#undef DEFUN_REMOVE_DOF_OBJ_FROM_ADMIN

/*--------------------------------------------------------------------------*/
/* some BLAS level 1 routines:                                              */
/* ---------------------------                                              */
/*   dof_asum:  asum = ||X||_l1                                             */
/*   dof_nrm2:  nrm2 = ||X||_l2                                             */
/*   dof_set:   X = alpha                                                   */
/*   dof_scal:  X = alpha * X                                               */
/*   dof_copy:  Y = X                                                       */
/*   dof_dot:   dot = X . Y                                                 */
/*   dof_axpy:  Y = Y + alpha * X                                           */
/*                                                                          */
/* some BLAS level 2 routines:                                              */
/* ---------------------------                                              */
/*   dof_gemv:  y = alpha*A*x + beta*y   or   y = alpha*A'*x + beta*y       */
/*                                                                          */
/* some non-BLAS level 2 routines:                                          */
/* ---------------------------                                              */
/*   dof_mv:    y = A*x   or   y = A'*x                                     */
/*   dof_min:   min of x                                                    */
/*   dof_max:   max of x                                                    */
/*--------------------------------------------------------------------------*/

static inline
REAL __dof_nrm2(const DOF_REAL_VEC *x)
{
  FUNCNAME("dof_nrm2");
  REAL nrm;
  const DOF_ADMIN *admin = NULL;

  TEST_EXIT(x && x->fe_space && (admin = x->fe_space->admin),
	    "pointer is NULL: %p, %p\n", x, admin);
  TEST_EXIT(x->size >= admin->size_used,
	    "x->size = %d too small: admin->size_used = %d\n", x->size,
	    admin->size_used);

  nrm = 0.0;
  FOR_ALL_DOFS(admin, nrm += x->vec[dof] * x->vec[dof] );

  return nrm;
}

static inline
REAL __dof_asum(const DOF_REAL_VEC *x)
{
  FUNCNAME("dof_asum");
  REAL    nrm;
  const DOF_ADMIN *admin = NULL;

  TEST_EXIT(x && x->fe_space && (admin = x->fe_space->admin),
	    "pointer is NULL: %p, %p\n", x, admin);
  TEST_EXIT(x->size >= admin->size_used,
	    "x->size = %d too small: admin->size_used = %d\n", x->size, 
	    admin->size_used);

  nrm = 0.0;
  FOR_ALL_DOFS(admin, nrm += ABS(x->vec[dof]) );

  return(nrm);
}

static inline
void __dof_set(REAL alpha, DOF_REAL_VEC *x)
{
  FUNCNAME("dof_set");
  const DOF_ADMIN *admin = NULL;

  TEST_EXIT(x && x->fe_space && (admin = x->fe_space->admin),
	    "pointer is NULL: %p, %p\n", x, admin);
  TEST_EXIT(x->size >= admin->size_used,
	    "x->size = %d too small: admin->size_used = %d\n", x->size,
	    admin->size_used);

  FOR_ALL_DOFS(admin, x->vec[dof] = alpha );
}

static inline
void __dof_scal(REAL alpha, DOF_REAL_VEC *x)
{
  FUNCNAME("dof_scal");
  const DOF_ADMIN *admin = NULL;

  TEST_EXIT(x && x->fe_space && (admin = x->fe_space->admin),
	    "pointer is NULL: %p, %p\n", x, admin);
  TEST_EXIT(x->size >= admin->size_used,
	    "x->size = %d too small: admin->size_used = %d\n", x->size, 
	    admin->size_used);

  FOR_ALL_DOFS(admin, x->vec[dof] *= alpha);
}

static inline
REAL __dof_dot(const DOF_REAL_VEC *x, const DOF_REAL_VEC *y)
{
  FUNCNAME("dof_dot");
  REAL      dot;
  const DOF_ADMIN *admin = NULL;

  TEST_EXIT(x && y, "pointer is NULL: %p, %p\n", x,y);
  TEST_EXIT(x->fe_space && y->fe_space,
	    "fe_space is NULL: %p, %p\n", x->fe_space,y->fe_space);
  TEST_EXIT((admin = x->fe_space->admin) && (admin == y->fe_space->admin),
	    "no admin or different admins: %p, %p\n",
	    x->fe_space->admin, y->fe_space->admin);
  TEST_EXIT(x->size >= admin->size_used,
	    "x->size = %d too small: admin->size_used = %d\n", x->size, 
	    admin->size_used);
  TEST_EXIT(y->size >= admin->size_used,
	    "y->size = %d too small: admin->size_used = %d\n", y->size, 
	    admin->size_used);

  dot = 0.0;
  FOR_ALL_DOFS(admin, dot += x->vec[dof] * y->vec[dof]);

  return dot;
}

static inline
void __dof_copy(const DOF_REAL_VEC *x, DOF_REAL_VEC *y)
{
  FUNCNAME("dof_copy");
  REAL      *xvec, *yvec;
  const DOF_ADMIN *admin = NULL;

  TEST_EXIT(x && y, "pointer is NULL: %p, %p\n", x,y);
  TEST_EXIT(x->fe_space && y->fe_space,
	    "fe_space is NULL: %p, %p\n", x->fe_space,y->fe_space);
  TEST_EXIT((admin = x->fe_space->admin) && (admin == y->fe_space->admin),
	    "no admin or different admins: %p, %p\n",
	    x->fe_space->admin, y->fe_space->admin);
  TEST_EXIT(x->size >= admin->size_used,
	    "x->size = %d too small: admin->size_used = %d\n", x->size, 
	    admin->size_used);
  TEST_EXIT(y->size >= admin->size_used,
	    "y->size = %d too small: admin->size_used = %d\n", y->size, 
	    admin->size_used);
  xvec = x->vec;
  yvec = y->vec;

  FOR_ALL_DOFS(admin, yvec[dof] = xvec[dof]);
}

static inline
void __dof_axpy(REAL alpha, const DOF_REAL_VEC *x, DOF_REAL_VEC *y)
{
  FUNCNAME("dof_axpy");
  REAL      *xvec, *yvec;
  const DOF_ADMIN *admin;

  TEST_EXIT(x && y, "pointer is NULL: %p, %p\n", x,y);
  TEST_EXIT(x->fe_space && y->fe_space,
	    "fe_space is NULL: %p, %p\n", x->fe_space,y->fe_space);
  TEST_EXIT((admin = x->fe_space->admin) && (admin == y->fe_space->admin),
	    "no admin or different admins: %p, %p\n",
	    x->fe_space->admin, y->fe_space->admin);
  TEST_EXIT(x->size >= admin->size_used,
	    "x->size = %d too small: admin->size = %d\n",
	    x->size, admin->size_used);
  TEST_EXIT(y->size >= admin->size_used,
	    "y->size = %d too small: admin->size = %d\n",
	    y->size, admin->size_used);

  xvec = x->vec;
  yvec = y->vec;

  FOR_ALL_DOFS(admin, yvec[dof] += alpha * xvec[dof]);
}

static inline
void __dof_xpay(REAL alpha, const DOF_REAL_VEC *x, DOF_REAL_VEC *y)
{
  FUNCNAME("dof_axpy");
  REAL      *xvec, *yvec;
  const DOF_ADMIN *admin;

  TEST_EXIT(x && y, "pointer is NULL: %p, %p\n", x,y);
  TEST_EXIT(x->fe_space && y->fe_space,
	    "fe_space is NULL: %p, %p\n", x->fe_space,y->fe_space);
  TEST_EXIT((admin = x->fe_space->admin) && (admin == y->fe_space->admin),
	    "no admin or different admins: %p, %p\n",
	    x->fe_space->admin, y->fe_space->admin);
  TEST_EXIT(x->size >= admin->size_used,
	    "x->size = %d too small: admin->size_used = %d\n",
	    x->size, admin->size_used);
  TEST_EXIT(y->size >= admin->size_used,
	    "y->size = %d too small: admin->size_used = %d\n", 
	    y->size, admin->size_used);

  xvec = x->vec;
  yvec = y->vec;

  FOR_ALL_DOFS(admin, yvec[dof] = xvec[dof] + alpha*yvec[dof]);
}

static inline
REAL __dof_min(const DOF_REAL_VEC *x)
{
  FUNCNAME("dof_min");
  REAL m;
  const DOF_ADMIN *admin = NULL;

  TEST_EXIT(x && x->fe_space && (admin = x->fe_space->admin),
	    "pointer is NULL: %p, %p\n", x, admin);
  TEST_EXIT(x->size >= admin->size_used,
	    "x->size = %d too small: admin->size_used = %d\n", x->size, 
	    admin->size_used);

  m = REAL_MAX;
  FOR_ALL_DOFS(admin, m = MIN(m, x->vec[dof]));

  return m;
}

static inline
REAL __dof_max(const DOF_REAL_VEC *x)
{
  FUNCNAME("dof_max");
  REAL m;
  const DOF_ADMIN *admin = NULL;

  TEST_EXIT(x && x->fe_space && (admin = x->fe_space->admin),
	    "pointer is NULL: %p, %p\n", x, admin);
  TEST_EXIT(x->size >= admin->size_used,
	    "x->size = %d too small: admin->size_used = %d\n", x->size, 
	    admin->size_used);

  m = REAL_MIN;
  FOR_ALL_DOFS(admin, m = MAX(m, x->vec[dof]));

  return m;
}

REAL dof_nrm2(const DOF_REAL_VEC *x)
{
  REAL nrm2 = 0.0;

  CHAIN_DO(x, const DOF_REAL_VEC) {
    nrm2 += __dof_nrm2(x);
  } CHAIN_WHILE(x, const DOF_REAL_VEC);

  return sqrt(nrm2);
}

REAL dof_asum(const DOF_REAL_VEC *x)
{
  REAL asum = 0.0;

  CHAIN_DO(x, const DOF_REAL_VEC) {
    asum += __dof_asum(x);
  } CHAIN_WHILE(x, const DOF_REAL_VEC);

  return asum;
}

void dof_set(REAL alpha, DOF_REAL_VEC *x)
{
  CHAIN_DO(x, DOF_REAL_VEC) {
    __dof_set(alpha, x);
  } CHAIN_WHILE(x, DOF_REAL_VEC);
}

void dof_scal(REAL alpha, DOF_REAL_VEC *x)
{
  CHAIN_DO(x, DOF_REAL_VEC) {
    __dof_scal(alpha, x);
  } CHAIN_WHILE(x, DOF_REAL_VEC);
}

REAL dof_dot(const DOF_REAL_VEC *x, const DOF_REAL_VEC *y)
{
  REAL dot = 0.0;
  
  CHAIN_DO(x, const DOF_REAL_VEC) {
    dot += __dof_dot(x, y);
    y = CHAIN_NEXT(y, const DOF_REAL_VEC);
  } CHAIN_WHILE(x, const DOF_REAL_VEC);
  
  return dot;
}

void dof_copy(const DOF_REAL_VEC *x, DOF_REAL_VEC *y)
{
  CHAIN_DO(x, const DOF_REAL_VEC) {
    __dof_copy(x, y);
    y = CHAIN_NEXT(y, DOF_REAL_VEC);
  } CHAIN_WHILE(x, const DOF_REAL_VEC);
}

void dof_axpy(REAL alpha, const DOF_REAL_VEC *x, DOF_REAL_VEC *y)
{
  CHAIN_DO(x, const DOF_REAL_VEC) {
    __dof_axpy(alpha, x, y);
    y = CHAIN_NEXT(y, DOF_REAL_VEC);
  } CHAIN_WHILE(x, const DOF_REAL_VEC);
}

void dof_xpay(REAL alpha, const DOF_REAL_VEC *x, DOF_REAL_VEC *y)
{
  CHAIN_DO(x, const DOF_REAL_VEC) {
    __dof_xpay(alpha, x, y);
    y = CHAIN_NEXT(y, DOF_REAL_VEC);
  } CHAIN_WHILE(x, const DOF_REAL_VEC);
}

REAL dof_min(const DOF_REAL_VEC *x)
{
  REAL m = REAL_MAX, m2;
  CHAIN_DO(x, const DOF_REAL_VEC) {
    m2 = __dof_min(x);
    m = MIN(m, m2);
  } CHAIN_WHILE(x, const DOF_REAL_VEC);
  return m;
}

REAL dof_max(const DOF_REAL_VEC *x)
{
  REAL m = REAL_MIN, m2;
  CHAIN_DO(x, const DOF_REAL_VEC) {
    m2 = __dof_max(x);
    m = MAX(m, m2);
  } CHAIN_WHILE(x, const DOF_REAL_VEC);

  return m;
}

/*--------------------------------------------------------------------------*/
/*   now the same routines for REAL_D vectors                               */
/*--------------------------------------------------------------------------*/

static inline
void __dof_set_d(REAL alpha, DOF_REAL_D_VEC *x)
{
  FUNCNAME("dof_set_d");
  const DOF_ADMIN *admin = NULL;

  TEST_EXIT(x && x->fe_space  &&  (admin = x->fe_space->admin),
	    "pointer is NULL: x: %p, x->fe_space: %p, x->fe_space->admin :%p\n",
	    x, x->fe_space, admin);
  TEST_EXIT(x->size >= admin->size_used,
	    "x->size = %d too small: admin->size_used = %d\n", 
	    x->size, admin->size_used);

  FOR_ALL_DOFS(admin, SET_DOW(alpha, x->vec[dof]));
}

static inline
void __dof_scal_d(REAL alpha, DOF_REAL_D_VEC *x)
{
  FUNCNAME("dof_scal_d");
  const DOF_ADMIN *admin = NULL;

  TEST_EXIT(x && x->fe_space  &&  (admin = x->fe_space->admin),
	    "pointer is NULL: x: %p, x->fe_space: %p, x->fe_space->admin :%p\n",
	    x, admin);
  TEST_EXIT(x->size >= admin->size_used,
	    "x->size = %d too small: admin->size_used = %d\n", 
	    x->size, admin->size_used);

  FOR_ALL_DOFS(admin, SCAL_DOW(alpha, x->vec[dof]));
}

static inline
REAL __dof_dot_d(const DOF_REAL_D_VEC *x, const DOF_REAL_D_VEC *y)
{
  FUNCNAME("dof_dot_d");
  REAL            dot;
  const DOF_ADMIN *admin = NULL;

  TEST_EXIT(x && y,
	    "pointer to DOF_REAL_D_VEC is NULL: x: %p, y: %p\n",
	    x, y);
  TEST_EXIT(x->fe_space && y->fe_space,
	    "pointer to FE_SPACE is NULL: x->fe_space: %p, y->fe_space: %p\n",
	    x->fe_space, y->fe_space);
  
  TEST_EXIT((admin = x->fe_space->admin) && (admin == y->fe_space->admin),
	    "no admin or admins: x->fe_space->admin: %p, y->fe_space->admin: %p\n",
	    x->fe_space->admin, y->fe_space->admin);

  TEST_EXIT(x->size >= admin->size_used,
	    "x->size = %d too small: admin->size_used = %d\n",
	    x->size, admin->size_used);
  TEST_EXIT(y->size >= admin->size_used,
	    "y->size = %d too small: admin->size_used = %d\n",
	    y->size, admin->size_used);

  dot = 0.0;
  FOR_ALL_DOFS(admin, dot += SCP_DOW(x->vec[dof], y->vec[dof]));

  return(dot);
}

static inline
void __dof_copy_d(const DOF_REAL_D_VEC *x, DOF_REAL_D_VEC *y)
{
  FUNCNAME("dof_copy_d");
  const DOF_ADMIN *admin = NULL;

  TEST_EXIT(x && y,"pointer to DOF_REAL_D_VEC is NULL: x: %p, y: %p\n",
	    x, y);
  TEST_EXIT(x->fe_space && y->fe_space,
	    "pointer to FE_SPACE is NULL: x->fe_space: %p, y->fe_space: %p\n",
	    x->fe_space, y->fe_space);

  TEST_EXIT((admin = x->fe_space->admin) && (admin == y->fe_space->admin),
	    "admin == NULL or admins differ: "
	    "x->fe_space->admin: %p, y->fe_space->admin: %p\n",
	    x->fe_space->admin, y->fe_space->admin);
  TEST_EXIT(x->size >= admin->size_used,
	    "x->size = %d too small: admin->size_used = %d\n",
	    x->size, admin->size_used);
  TEST_EXIT(y->size >= admin->size_used,
	    "y->size = %d too small: admin->size_used = %d\n",
	    y->size, admin->size_used);

  FOR_ALL_DOFS(admin, COPY_DOW(x->vec[dof], y->vec[dof]));

}

static inline
void __dof_axpy_d(REAL alpha, const DOF_REAL_D_VEC *x, DOF_REAL_D_VEC *y)
{
  FUNCNAME("dof_axpy_d");
  const DOF_ADMIN *admin;

  TEST_EXIT(x && y,"pointer to DOF_REAL_D_VEC is NULL: x: %p, y: %p\n",
	    x, y);
  TEST_EXIT(x->fe_space && y->fe_space,
	    "pointer to FE_SPACE is NULL: x->fe_space: %p, y->fe_space: %p\n",
	    x->fe_space, y->fe_space);
  
  TEST_EXIT((admin = x->fe_space->admin) && (admin == y->fe_space->admin),
	    "no admin or admins: x->fe_space->admin: %p, y->fe_space->admin: %p\n",
	    x->fe_space->admin, y->fe_space->admin);
  TEST_EXIT(x->size >= admin->size_used,
	    "x->size = %d too small: admin->size_used = %d\n",
	    x->size, admin->size_used);
  TEST_EXIT(y->size >= admin->size_used,
	    "y->size = %d too small: admin->size_used = %d\n",
	    y->size, admin->size_used);

  FOR_ALL_DOFS(admin, AXPY_DOW(alpha, x->vec[dof], y->vec[dof]));
}

static inline
REAL __dof_nrm2_d(const DOF_REAL_D_VEC *x)
{
  FUNCNAME("dof_nrm2_d");
  REAL            nrm;
  const DOF_ADMIN *admin = NULL;

  TEST_EXIT(x && x->fe_space && (admin = x->fe_space->admin),
	    "pointer is NULL: %p, %p\n", x, admin);
  TEST_EXIT(x->size >= admin->size_used,
	    "x->size = %d too small: admin->size_used = %d\n", x->size, 
	    admin->size_used);

  nrm = 0.0;
  FOR_ALL_DOFS(admin, nrm += NRM2_DOW(x->vec[dof]));

  return(sqrt(nrm));
}

static inline
REAL __dof_asum_d(const DOF_REAL_D_VEC *x)
{
  FUNCNAME("dof_nrm2_d");
  REAL            nrm;
  const DOF_ADMIN *admin = NULL;

  TEST_EXIT(x && x->fe_space && (admin = x->fe_space->admin),
	    "pointer is NULL: %p, %p\n", x, admin);
  TEST_EXIT(x->size >= admin->size_used,
	    "x->size = %d too small: admin->size_used = %d\n", x->size, 
	    admin->size_used);

  nrm = 0.0;
  FOR_ALL_DOFS(admin, nrm += NORM1_DOW(x->vec[dof]));

  return nrm;
}


static inline
void __dof_xpay_d(REAL alpha, const DOF_REAL_D_VEC *x, DOF_REAL_D_VEC *y)
{
  FUNCNAME("dof_xpay_d");
  const DOF_ADMIN *admin;
  int             n;

  TEST_EXIT(x && y,"pointer to DOF_REAL_D_VEC is NULL: x: %p, y: %p\n",
	    x, y);
  TEST_EXIT(x->fe_space && y->fe_space,
	    "pointer to FE_SPACE is NULL: x->fe_space: %p, y->fe_space: %p\n",
	    x->fe_space, y->fe_space);
  
  TEST_EXIT((admin = x->fe_space->admin) && (admin == y->fe_space->admin),
	    "no admin or admins: x->fe_space->admin: %p, y->fe_space->admin: %p\n",
	    x->fe_space->admin, y->fe_space->admin);
  TEST_EXIT(x->size >= admin->size_used,
	    "x->size = %d too small: admin->size_used = %d\n",
	    x->size, admin->size_used);
  TEST_EXIT(y->size >= admin->size_used,
	    "y->size = %d too small: admin->size_used = %d\n",
	    y->size, admin->size_used);

  FOR_ALL_DOFS(admin, 
	       for (n = 0; n < DIM_OF_WORLD; n++)
		 y->vec[dof][n] = x->vec[dof][n] + alpha*y->vec[dof][n]);
}

static inline
REAL __dof_min_d(const DOF_REAL_D_VEC *x)
{
  FUNCNAME("dof_min_d");
  REAL m, norm;
  const DOF_ADMIN *admin = NULL;

  TEST_EXIT(x && x->fe_space && (admin = x->fe_space->admin),
	    "pointer is NULL: %p, %p\n", x, admin);
  TEST_EXIT(x->size >= admin->size_used,
	    "x->size = %d too small: admin->size_used = %d\n", x->size, 
	    admin->size_used);

  m = 1.0E30;
  FOR_ALL_DOFS(admin, 
	       norm = NORM_DOW(x->vec[dof]);
	       m = MIN(m, norm));

  return(m);
}

static inline
REAL __dof_max_d(const DOF_REAL_D_VEC *x)
{
  FUNCNAME("dof_max_d");
  REAL m, norm;
  const DOF_ADMIN *admin = NULL;

  TEST_EXIT(x && x->fe_space && (admin = x->fe_space->admin),
	    "pointer is NULL: %p, %p\n", x, admin);
  TEST_EXIT(x->size >= admin->size_used,
	    "x->size = %d too small: admin->size_used = %d\n", x->size, 
	    admin->size_used);

  m = 0.0;
  FOR_ALL_DOFS(admin, 
	       norm = NORM_DOW(x->vec[dof]);
	       m = MAX(m, norm));

  return(m);
}

REAL dof_nrm2_d(const DOF_REAL_D_VEC *x)
{
  REAL nrm2 = 0.0;

  CHAIN_DO(x, const DOF_REAL_D_VEC) {
    nrm2 += __dof_nrm2_d(x);
  } CHAIN_WHILE(x, const DOF_REAL_D_VEC);

  return sqrt(nrm2);
}

REAL dof_asum_d(const DOF_REAL_D_VEC *x)
{
  REAL asum = 0.0;
  CHAIN_DO(x, const DOF_REAL_D_VEC) {
    asum += __dof_asum_d(x);
  } CHAIN_WHILE(x, const DOF_REAL_D_VEC);

  return asum;
}

void dof_set_d(REAL alpha, DOF_REAL_D_VEC *x)
{
  CHAIN_DO(x, DOF_REAL_D_VEC) {
    __dof_set_d(alpha, x);
  } CHAIN_WHILE(x, DOF_REAL_D_VEC);
}

void dof_scal_d(REAL alpha, DOF_REAL_D_VEC *x)
{
  CHAIN_DO(x, DOF_REAL_D_VEC) {
    __dof_scal_d(alpha, x);
  } CHAIN_WHILE(x, DOF_REAL_D_VEC);
}

REAL dof_dot_d(const DOF_REAL_D_VEC *x, const DOF_REAL_D_VEC *y)
{
  REAL dot = 0.0;
  
  CHAIN_DO(x, const DOF_REAL_D_VEC) {
    dot += __dof_dot_d(x, y);
    y = CHAIN_NEXT(y, const DOF_REAL_D_VEC);
  } CHAIN_WHILE(x, const DOF_REAL_D_VEC);
  
  return dot;
}

void dof_copy_d(const DOF_REAL_D_VEC *x, DOF_REAL_D_VEC *y)
{
  CHAIN_DO(x, const DOF_REAL_D_VEC) {
    __dof_copy_d(x, y);
    y = CHAIN_NEXT(y, DOF_REAL_D_VEC);
  } CHAIN_WHILE(x, const DOF_REAL_D_VEC);
}

void dof_axpy_d(REAL alpha, const DOF_REAL_D_VEC *x, DOF_REAL_D_VEC *y)
{
  CHAIN_DO(x, const DOF_REAL_D_VEC) {
    __dof_axpy_d(alpha, x, y);
    y = CHAIN_NEXT(y, DOF_REAL_D_VEC);
  } CHAIN_WHILE(x, const DOF_REAL_D_VEC);
}

void dof_xpay_d(REAL alpha, const DOF_REAL_D_VEC *x, DOF_REAL_D_VEC *y)
{
  CHAIN_DO(x, const DOF_REAL_D_VEC) {
    __dof_xpay_d(alpha, x, y);
    y = CHAIN_NEXT(y, DOF_REAL_D_VEC);
  } CHAIN_WHILE(x, const DOF_REAL_D_VEC);
}

REAL dof_min_d(const DOF_REAL_D_VEC *x)
{
  REAL m = REAL_MAX, m2;
  CHAIN_DO(x, const DOF_REAL_D_VEC) {
    m2 = __dof_min_d(x);
    m = MIN(m, m2);
  } CHAIN_WHILE(x, const DOF_REAL_D_VEC);
  return m;
}

REAL dof_max_d(const DOF_REAL_D_VEC *x)
{
  REAL m = REAL_MIN, m2;
  CHAIN_DO(x, const DOF_REAL_D_VEC) {
    m2 = __dof_max_d(x);
    m = MAX(m, m2);
  } CHAIN_WHILE(x, const DOF_REAL_D_VEC);

  return m;
}

/*******************************************************************************
 *
 * now the same routines for REAL_DDD vectors
 *
 ******************************************************************************/

static inline
void __dof_set_dd(REAL alpha, DOF_REAL_DD_VEC *x)
{
  FUNCNAME("dof_set_d");
  const DOF_ADMIN *admin = NULL;

  TEST_EXIT(x && x->fe_space  &&  (admin = x->fe_space->admin),
	    "pointer is NULL: x: %p, x->fe_space: %p, x->fe_space->admin :%p\n",
	    x, x->fe_space, admin);
  TEST_EXIT(x->size >= admin->size_used,
	    "x->size = %d too small: admin->size_used = %d\n", 
	    x->size, admin->size_used);

  FOR_ALL_DOFS(admin, MSET_DOW(alpha, x->vec[dof]));
}

static inline
void __dof_scal_dd(REAL alpha, DOF_REAL_DD_VEC *x)
{
  FUNCNAME("dof_scal_d");
  const DOF_ADMIN *admin = NULL;

  TEST_EXIT(x && x->fe_space  &&  (admin = x->fe_space->admin),
	    "pointer is NULL: x: %p, x->fe_space: %p, x->fe_space->admin :%p\n",
	    x, admin);
  TEST_EXIT(x->size >= admin->size_used,
	    "x->size = %d too small: admin->size_used = %d\n", 
	    x->size, admin->size_used);

  FOR_ALL_DOFS(admin, MSCAL_DOW(alpha, x->vec[dof]));
}

static inline
REAL __dof_dot_dd(const DOF_REAL_DD_VEC *x, const DOF_REAL_DD_VEC *y)
{
  FUNCNAME("dof_dot_d");
  REAL            dot;
  const DOF_ADMIN *admin = NULL;

  TEST_EXIT(x && y,
	    "pointer to DOF_REAL_DD_VEC is NULL: x: %p, y: %p\n",
	    x, y);
  TEST_EXIT(x->fe_space && y->fe_space,
	    "pointer to FE_SPACE is NULL: x->fe_space: %p, y->fe_space: %p\n",
	    x->fe_space, y->fe_space);
  
  TEST_EXIT((admin = x->fe_space->admin) && (admin == y->fe_space->admin),
	    "no admin or admins: x->fe_space->admin: %p, y->fe_space->admin: %p\n",
	    x->fe_space->admin, y->fe_space->admin);

  TEST_EXIT(x->size >= admin->size_used,
	    "x->size = %d too small: admin->size_used = %d\n",
	    x->size, admin->size_used);
  TEST_EXIT(y->size >= admin->size_used,
	    "y->size = %d too small: admin->size_used = %d\n",
	    y->size, admin->size_used);

  dot = 0.0;
  FOR_ALL_DOFS(admin, dot += MSCP_DOW((const REAL_D *)x->vec[dof],
				      (const REAL_D *)y->vec[dof]));

  return dot;
}

static inline
void __dof_copy_dd(const DOF_REAL_DD_VEC *x, DOF_REAL_DD_VEC *y)
{
  FUNCNAME("dof_copy_d");
  const DOF_ADMIN *admin = NULL;

  TEST_EXIT(x && y,"pointer to DOF_REAL_DD_VEC is NULL: x: %p, y: %p\n",
	    x, y);
  TEST_EXIT(x->fe_space && y->fe_space,
	    "pointer to FE_SPACE is NULL: x->fe_space: %p, y->fe_space: %p\n",
	    x->fe_space, y->fe_space);

  TEST_EXIT((admin = x->fe_space->admin) && (admin == y->fe_space->admin),
	    "admin == NULL or admins differ: "
	    "x->fe_space->admin: %p, y->fe_space->admin: %p\n",
	    x->fe_space->admin, y->fe_space->admin);
  TEST_EXIT(x->size >= admin->size_used,
	    "x->size = %d too small: admin->size_used = %d\n",
	    x->size, admin->size_used);
  TEST_EXIT(y->size >= admin->size_used,
	    "y->size = %d too small: admin->size_used = %d\n",
	    y->size, admin->size_used);

  FOR_ALL_DOFS(admin, MCOPY_DOW((const REAL_D *)x->vec[dof], y->vec[dof]));

}

static inline
void __dof_axpy_dd(REAL alpha, const DOF_REAL_DD_VEC *x, DOF_REAL_DD_VEC *y)
{
  FUNCNAME("dof_axpy_d");
  const DOF_ADMIN *admin;

  TEST_EXIT(x && y,"pointer to DOF_REAL_DD_VEC is NULL: x: %p, y: %p\n",
	    x, y);
  TEST_EXIT(x->fe_space && y->fe_space,
	    "pointer to FE_SPACE is NULL: x->fe_space: %p, y->fe_space: %p\n",
	    x->fe_space, y->fe_space);
  
  TEST_EXIT((admin = x->fe_space->admin) && (admin == y->fe_space->admin),
	    "no admin or admins: x->fe_space->admin: %p, y->fe_space->admin: %p\n",
	    x->fe_space->admin, y->fe_space->admin);
  TEST_EXIT(x->size >= admin->size_used,
	    "x->size = %d too small: admin->size_used = %d\n",
	    x->size, admin->size_used);
  TEST_EXIT(y->size >= admin->size_used,
	    "y->size = %d too small: admin->size_used = %d\n",
	    y->size, admin->size_used);

  FOR_ALL_DOFS(admin,
	       MAXPY_DOW(alpha, (const REAL_D *)x->vec[dof], y->vec[dof]));
}

static inline
REAL __dof_nrm2_dd(const DOF_REAL_DD_VEC *x)
{
  FUNCNAME("dof_nrm2_d");
  REAL            nrm;
  const DOF_ADMIN *admin = NULL;

  TEST_EXIT(x && x->fe_space && (admin = x->fe_space->admin),
	    "pointer is NULL: %p, %p\n", x, admin);
  TEST_EXIT(x->size >= admin->size_used,
	    "x->size = %d too small: admin->size_used = %d\n", x->size, 
	    admin->size_used);

  nrm = 0.0;
  FOR_ALL_DOFS(admin, nrm += MNRM2_DOW((const REAL_D *)x->vec[dof]));

  return sqrt(nrm);
}

static inline
REAL __dof_asum_dd(const DOF_REAL_DD_VEC *x)
{
  FUNCNAME("dof_nrm2_d");
  REAL nrm;
  const DOF_ADMIN *admin = NULL;

  TEST_EXIT(x && x->fe_space && (admin = x->fe_space->admin),
	    "pointer is NULL: %p, %p\n", x, admin);
  TEST_EXIT(x->size >= admin->size_used,
	    "x->size = %d too small: admin->size_used = %d\n", x->size, 
	    admin->size_used);

  nrm = 0.0;
  FOR_ALL_DOFS(admin, nrm += MNORM1_DOW((const REAL_D *)x->vec[dof]));

  return nrm;
}


static inline
void __dof_xpay_dd(REAL alpha, const DOF_REAL_DD_VEC *x, DOF_REAL_DD_VEC *y)
{
  FUNCNAME("dof_xpay_d");
  const DOF_ADMIN *admin;

  TEST_EXIT(x && y,"pointer to DOF_REAL_DD_VEC is NULL: x: %p, y: %p\n",
	    x, y);
  TEST_EXIT(x->fe_space && y->fe_space,
	    "pointer to FE_SPACE is NULL: x->fe_space: %p, y->fe_space: %p\n",
	    x->fe_space, y->fe_space);
  
  TEST_EXIT((admin = x->fe_space->admin) && (admin == y->fe_space->admin),
	    "no admin or admins: x->fe_space->admin: %p, y->fe_space->admin: %p\n",
	    x->fe_space->admin, y->fe_space->admin);
  TEST_EXIT(x->size >= admin->size_used,
	    "x->size = %d too small: admin->size_used = %d\n",
	    x->size, admin->size_used);
  TEST_EXIT(y->size >= admin->size_used,
	    "y->size = %d too small: admin->size_used = %d\n",
	    y->size, admin->size_used);

  FOR_ALL_DOFS(admin, 
	       MAXPBY_DOW(1.0, (const REAL_D *)x->vec[dof],
			  alpha, (const REAL_D *)y->vec[dof], y->vec[dof]));
}

static inline
REAL __dof_min_dd(const DOF_REAL_DD_VEC *x)
{
  FUNCNAME("dof_min_d");
  REAL m, norm;
  const DOF_ADMIN *admin = NULL;

  TEST_EXIT(x && x->fe_space && (admin = x->fe_space->admin),
	    "pointer is NULL: %p, %p\n", x, admin);
  TEST_EXIT(x->size >= admin->size_used,
	    "x->size = %d too small: admin->size_used = %d\n", x->size, 
	    admin->size_used);

  m = 1.0E30;
  FOR_ALL_DOFS(admin, 
	       norm = MNORM8_DOW((const REAL_D *)x->vec[dof]);
	       m = MIN(m, norm));

  return m;
}

static inline
REAL __dof_max_dd(const DOF_REAL_DD_VEC *x)
{
  FUNCNAME("dof_max_d");
  REAL m, norm;
  const DOF_ADMIN *admin = NULL;

  TEST_EXIT(x && x->fe_space && (admin = x->fe_space->admin),
	    "pointer is NULL: %p, %p\n", x, admin);
  TEST_EXIT(x->size >= admin->size_used,
	    "x->size = %d too small: admin->size_used = %d\n", x->size, 
	    admin->size_used);

  m = 0.0;
  FOR_ALL_DOFS(admin, 
	       norm = MNORM8_DOW((const REAL_D *)x->vec[dof]);
	       m = MAX(m, norm));

  return(m);
}

REAL dof_nrm2_dd(const DOF_REAL_DD_VEC *x)
{
  REAL nrm2 = 0.0;

  CHAIN_DO(x, const DOF_REAL_DD_VEC) {
    nrm2 += __dof_nrm2_dd(x);
  } CHAIN_WHILE(x, const DOF_REAL_DD_VEC);

  return sqrt(nrm2);
}

REAL dof_asum_dd(const DOF_REAL_DD_VEC *x)
{
  REAL asum = 0.0;
  CHAIN_DO(x, const DOF_REAL_DD_VEC) {
    asum += __dof_asum_dd(x);
  } CHAIN_WHILE(x, const DOF_REAL_DD_VEC);

  return asum;
}

void dof_set_dd(REAL alpha, DOF_REAL_DD_VEC *x)
{
  CHAIN_DO(x, DOF_REAL_DD_VEC) {
    __dof_set_dd(alpha, x);
  } CHAIN_WHILE(x, DOF_REAL_DD_VEC);
}

void dof_scal_dd(REAL alpha, DOF_REAL_DD_VEC *x)
{
  CHAIN_DO(x, DOF_REAL_DD_VEC) {
    __dof_scal_dd(alpha, x);
  } CHAIN_WHILE(x, DOF_REAL_DD_VEC);
}

REAL dof_dot_dd(const DOF_REAL_DD_VEC *x, const DOF_REAL_DD_VEC *y)
{
  REAL dot = 0.0;
  
  CHAIN_DO(x, const DOF_REAL_DD_VEC) {
    dot += __dof_dot_dd(x, y);
    y = CHAIN_NEXT(y, const DOF_REAL_DD_VEC);
  } CHAIN_WHILE(x, const DOF_REAL_DD_VEC);
  
  return dot;
}

void dof_copy_dd(const DOF_REAL_DD_VEC *x, DOF_REAL_DD_VEC *y)
{
  CHAIN_DO(x, const DOF_REAL_DD_VEC) {
    __dof_copy_dd(x, y);
    y = CHAIN_NEXT(y, DOF_REAL_DD_VEC);
  } CHAIN_WHILE(x, const DOF_REAL_DD_VEC);
}

void dof_axpy_dd(REAL alpha, const DOF_REAL_DD_VEC *x, DOF_REAL_DD_VEC *y)
{
  CHAIN_DO(x, const DOF_REAL_DD_VEC) {
    __dof_axpy_dd(alpha, x, y);
    y = CHAIN_NEXT(y, DOF_REAL_DD_VEC);
  } CHAIN_WHILE(x, const DOF_REAL_DD_VEC);
}

void dof_xpay_dd(REAL alpha, const DOF_REAL_DD_VEC *x, DOF_REAL_DD_VEC *y)
{
  CHAIN_DO(x, const DOF_REAL_DD_VEC) {
    __dof_xpay_dd(alpha, x, y);
    y = CHAIN_NEXT(y, DOF_REAL_DD_VEC);
  } CHAIN_WHILE(x, const DOF_REAL_DD_VEC);
}

REAL dof_min_dd(const DOF_REAL_DD_VEC *x)
{
  REAL m = REAL_MAX, m2;
  CHAIN_DO(x, const DOF_REAL_DD_VEC) {
    m2 = __dof_min_dd(x);
    m = MIN(m, m2);
  } CHAIN_WHILE(x, const DOF_REAL_DD_VEC);
  return m;
}

REAL dof_max_dd(const DOF_REAL_DD_VEC *x)
{
  REAL m = REAL_MIN, m2;
  CHAIN_DO(x, const DOF_REAL_DD_VEC) {
    m2 = __dof_max_dd(x);
    m = MAX(m, m2);
  } CHAIN_WHILE(x, const DOF_REAL_DD_VEC);

  return m;
}

/* DOF_REAL_VEC_D versions (vector valued basis functions) */

#define __DRV  DOF_REAL_VEC
#define __DRDV DOF_REAL_D_VEC

REAL dof_nrm2_dow(const DOF_REAL_VEC_D *x)
{
  REAL nrm2 = 0.0;

  CHAIN_DO(x, const DOF_REAL_VEC_D) {
    nrm2 += x->stride != 1 ? __dof_nrm2_d((__DRDV *)x) : __dof_nrm2((__DRV *)x);
  } CHAIN_WHILE(x, const DOF_REAL_VEC_D);

  return sqrt(nrm2);
}

REAL dof_asum_dow(const DOF_REAL_VEC_D *x)
{
  REAL asum = 0.0;

  CHAIN_DO(x, const DOF_REAL_VEC_D) {
    asum += x->stride != 1 ? __dof_asum_d((__DRDV *)x) : __dof_asum((__DRV *)x);
  } CHAIN_WHILE(x, const DOF_REAL_VEC_D);

  return asum;
}

void dof_set_dow(REAL alpha, DOF_REAL_VEC_D *x)
{
  CHAIN_DO(x, DOF_REAL_VEC_D) {
    if (x->stride != 1) {
      __dof_set_d(alpha, (__DRDV *)x);
    } else {
      __dof_set(alpha, (__DRV *)x);
    }
  } CHAIN_WHILE(x, DOF_REAL_VEC_D);
}

void dof_scal_dow(REAL alpha, DOF_REAL_VEC_D *x)
{
  CHAIN_DO(x, DOF_REAL_VEC_D) {
    if (x->stride != 1) {
      __dof_scal_d(alpha, (__DRDV *)x);
    } else {
      __dof_scal(alpha, (__DRV *)x);
    }
  } CHAIN_WHILE(x, DOF_REAL_VEC_D);
}

REAL dof_dot_dow(const DOF_REAL_VEC_D *x, const DOF_REAL_VEC_D *y)
{
  REAL dot = 0.0;
  
  CHAIN_DO(x, const DOF_REAL_VEC_D) {
    if (x->stride != 1) {
      dot += __dof_dot_d((__DRDV *)x, (__DRDV *)y);
    } else {
      dot += __dof_dot((__DRV *)x, (__DRV *)y);
    }
    y = CHAIN_NEXT(y, const DOF_REAL_VEC_D);
  } CHAIN_WHILE(x, const DOF_REAL_VEC_D);
  
  return dot;
}

void dof_copy_dow(const DOF_REAL_VEC_D *x, DOF_REAL_VEC_D *y)
{
  CHAIN_DO(x, const DOF_REAL_VEC_D) {
    if (x->stride != 1) {
      __dof_copy_d((__DRDV *)x, (__DRDV *)y);
    } else {
      __dof_copy((__DRV *)x, (__DRV *)y);
    }
    y = CHAIN_NEXT(y, DOF_REAL_VEC_D);
  } CHAIN_WHILE(x, const DOF_REAL_VEC_D);
}

void dof_axpy_dow(REAL alpha, const DOF_REAL_VEC_D *x, DOF_REAL_VEC_D *y)
{
  CHAIN_DO(x, const DOF_REAL_VEC_D) {
    if (x->stride != 1) {
      __dof_axpy_d(alpha, (__DRDV *)x, (__DRDV *)y);
    } else {
      __dof_axpy(alpha, (__DRV *)x, (__DRV *)y);
    }
    y = CHAIN_NEXT(y, DOF_REAL_VEC_D);
  } CHAIN_WHILE(x, const DOF_REAL_VEC_D);
}

void dof_xpay_dow(REAL alpha, const DOF_REAL_VEC_D *x, DOF_REAL_VEC_D *y)
{
  CHAIN_DO(x, const DOF_REAL_VEC_D) {
    if (x->stride != 1) {
      __dof_xpay_d(alpha, (__DRDV *)x, (__DRDV *)y);
    } else {
      __dof_xpay(alpha, (__DRV *)x, (__DRV *)y);
    }
    y = CHAIN_NEXT(y, DOF_REAL_VEC_D);
  } CHAIN_WHILE(x, const DOF_REAL_VEC_D);
}

REAL dof_min_dow(const DOF_REAL_VEC_D *x)
{
  REAL m = REAL_MAX, m2;
  CHAIN_DO(x, const DOF_REAL_VEC_D) {
    if (x->stride != 1) {
      m2 = __dof_min_d((__DRDV *)x);
    } else {
      m2 = __dof_min((__DRV *)x);
    }
    m = MIN(m, m2);
  } CHAIN_WHILE(x, const DOF_REAL_VEC_D);
  return m;
}

REAL dof_max_dow(const DOF_REAL_VEC_D *x)
{
  REAL m = REAL_MIN, m2;
  CHAIN_DO(x, const DOF_REAL_VEC_D) {
    if (x->stride != 1) {
      m2 = __dof_max_d((__DRDV *)x);
    } else {
      m2 = __dof_max((__DRV *)x);
    }
    m = MAX(m, m2);
  } CHAIN_WHILE(x, const DOF_REAL_VEC_D);

  return m;
}

#undef __DRV
#undef __DRDV

/* Copy one DOF_MATRIX to another, e.g. to speed up the assembly for
 * operator splitting schemes.
 */
static inline
void _AI_matrix_row_copy_single(MATRIX_ROW *dst, const MATRIX_ROW *src) 
{
  MATRIX_ROW *dst_next = dst->next;

  DEBUG_TEST_EXIT(dst->type == src->type, "matrix types do not match");

  switch (dst->type) {
  case MATENT_REAL:
    memcpy(dst, src, sizeof(MATRIX_ROW_REAL));
    break;
  case MATENT_REAL_D:
    memcpy(dst, src, sizeof(MATRIX_ROW_REAL_D));
    break;
  case MATENT_REAL_DD:
    memcpy(dst, src, sizeof(MATRIX_ROW_REAL_DD));
    break;
  case MATENT_NONE:
    ERROR_EXIT("Uninitialized DOF_MATRIX.\n");
  }
  dst->next = dst_next;
}

static inline void _AI_clear_dof_matrix_single(DOF_MATRIX *matrix);

FLATTEN_ATTR
static inline
void _AI_dof_matrix_copy_single(DOF_MATRIX *dst, const DOF_MATRIX *src)
{
  const FE_SPACE *row_fe_space = dst->row_fe_space;
  const DOF_ADMIN *m_admin = row_fe_space->admin;
  int dof;

#if ALBERTA_DEBUG
  const FE_SPACE *col_fe_space =
    dst->col_fe_space ? dst->col_fe_space : row_fe_space;
  DEBUG_TEST_EXIT(dst->row_fe_space->admin == src->row_fe_space->admin &&
		  (src->col_fe_space == NULL ||
		   col_fe_space->admin == src->col_fe_space->admin),
		  "Attempt to copy onto incompatible DOF_MATRIX.\n");
  
#endif

  if (dst->type != src->type) {
    _AI_clear_dof_matrix_single(dst);
    dst->type = src->type;
  }
  BNDRY_FLAGS_CPY(dst->dirichlet_bndry, src->dirichlet_bndry);
  /* remaining stuff has to be handled by calling function */

  if (src->is_diagonal) {
    dof_matrix_set_diagonal(dst, true);
    FOR_ALL_DOFS(src->row_fe_space->admin,
		 dst->diag_cols->vec[dof] = src->diag_cols->vec[dof]);
    switch (src->type) {
    case MATENT_REAL:
      if (dst->diagonal.real == NULL) {
	dst->diagonal.real =
	  get_dof_real_vec("matrix diagonal", dst->row_fe_space->unchained);
      }
      dof_copy(src->diagonal.real, dst->diagonal.real);
      break;
    case MATENT_REAL_D:
      if (dst->diagonal.real_d == NULL) {
	dst->diagonal.real_d =
	  get_dof_real_d_vec("matrix diagonal", dst->row_fe_space->unchained);
      }
      dof_copy_d(src->diagonal.real_d, dst->diagonal.real_d);
      break;
    case MATENT_REAL_DD:
      if (dst->diagonal.real_dd == NULL) {
	dst->diagonal.real_dd =
	  get_dof_real_dd_vec("matrix diagonal", dst->row_fe_space->unchained);
      }
      dof_copy_dd(src->diagonal.real_dd, dst->diagonal.real_dd);
      break;
    default:
      break;
    }
  } else {
    dof_matrix_set_diagonal(dst, false);
    for (dof = 0; dof < m_admin->size_used; ++dof) {
      MATRIX_ROW *src_row, **dst_row_ptr, *dst_row;
    
      for (src_row = src->matrix_row[dof],
	     dst_row_ptr = &dst->matrix_row[dof];
	   src_row != NULL;
	   src_row = src_row->next, dst_row_ptr = &(*dst_row_ptr)->next) {
	if (*dst_row_ptr == NULL) {
	  *dst_row_ptr = get_matrix_row(row_fe_space, dst->type);
	}
	_AI_matrix_row_copy_single(*dst_row_ptr, src_row);
      }
      /* zap remaining part of row */
      dst_row = *dst_row_ptr;
      *dst_row_ptr = NULL;
      while (dst_row) {
	MATRIX_ROW *free_row = dst_row;
	dst_row = free_row->next;
	free_matrix_row(row_fe_space, free_row);
      }
    }
  }
}

FLATTEN_ATTR
void dof_matrix_copy(DOF_MATRIX *dst, const DOF_MATRIX *src) 
{
  DEBUG_TEST_EXIT(fe_space_is_eq(dst->row_fe_space, src->row_fe_space) &&
		  (dst->col_fe_space == NULL ||
		   fe_space_is_eq(dst->col_fe_space,
				  src->col_fe_space == NULL
				  ? src->row_fe_space : src->col_fe_space)),
		  "Attempt to copy onto incompatible DOF_MATRIX\n");
  ROW_CHAIN_DO(dst, DOF_MATRIX) {
    COL_CHAIN_DO(dst, DOF_MATRIX) {
      _AI_dof_matrix_copy_single(dst, src);
      src = COL_CHAIN_NEXT(src, const DOF_MATRIX);
    } COL_CHAIN_WHILE(dst, DOF_MATRIX);
    src = ROW_CHAIN_NEXT(src, const DOF_MATRIX);
  } ROW_CHAIN_WHILE(dst, DOF_MATRIX);
}

/* dof_mv() and friends:
 *
 * matrix type    domain type range type interpretation        function
 * ============== =========== ========== ==============        ========= 
 * MATENT_REAL    REAL_VEC    REAL_VEC   ordinary matrix       dof_mv()
 * MATENT_REAL    REAL_D_VEC  REAL_VEC   1xDOW (scalar blocks) dof_mv_rrd()
 * MATENT_REAL    REAL_VEC    REAL_D_VEC DOWx1 (scalar blocks) dof_mv_rdr()
 * MATENT_REAL    REAL_D_VEC  REAL_D_VEC scalar matrix blocks  dof_mv_d()
 * MATENT_REAL_D  REAL_D_VEC  REAL_VEC   1xDOW rectangular     dof_mv_rrd()
 * MATENT_REAL_D  REAL_VEC    REAL_D_VEC DOWx1 rectangular     dof_mv_rdr()
 * MATENT_REAL_D  REAL_D_VEC  REAL_D_VEC diagonal matrix (?)   dof_mv_d()
 * MATENT_REAL_DD REAL_VEC    ---------- does not make sense   --------
 * MATENT_REAL_DD REAL_D_VEC  REAL_D_VEC DOWxDOW square blocks dof_mv_d()
 *
 * The suffix codes the type of the domain and range vectors. "rdr"
 * "REAL_D x REAL" and "rrd" means "REAL x REAL_D". We do not need
 * _dowb() versions any longer, at least.
 */

/* Used in all mv routines: */
#define MV_TEST_AND_GET_ADMINS(m, x, y, m_admin, x_admin, y_admin)	\
  {									\
    DEBUG_TEST_EXIT(m && x && y,"pointer is NULL: %p, %p, %p\n", m, x, y); \
									\
    DEBUG_TEST_EXIT(m->row_fe_space && m->col_fe_space &&		\
		    x->fe_space && y->fe_space,				\
		    "fe_space is NULL: %p, %p, %p, %p\n",		\
		    m->row_fe_space, m->col_fe_space,			\
		    x->fe_space, y->fe_space);				\
    									\
    m_admin = m->row_fe_space->admin;					\
    DEBUG_TEST_EXIT(m_admin != NULL,					\
		    "no matrix row-admin: %p.\n", m->row_fe_space->admin); \
    x_admin = x->fe_space->admin;					\
    DEBUG_TEST_EXIT(x_admin != NULL,					\
		    "no admin for x: %p.\n", x->fe_space->admin);	\
    y_admin = y->fe_space->admin;					\
    DEBUG_TEST_EXIT(y_admin != NULL,					\
	      "no admin for y: %p.\n", y->fe_space->admin);		\
									\
    DEBUG_TEST_EXIT(x->size >= x_admin->size_used,			\
		    "x->size = %d too small: admin->size_used = %d\n",	\
		    x->size, x_admin->size_used);			\
    DEBUG_TEST_EXIT(y->size >= y_admin->size_used,			\
		    "y->size = %d too small: admin->size_used = %d\n",	\
		    y->size, y_admin->size_used);			\
    DEBUG_TEST_EXIT(a->size >= m_admin->size_used,			\
		    "a->size = %d too small: admin->size_used = %d\n",	\
		    a->size, m_admin->size_used);			\
  }

/* <<< REAL x REAL */

FORCE_INLINE_ATTR
static inline
void __dof_gemv(MatrixTranspose transpose, REAL alpha,
		const DOF_MATRIX *a, const DOF_SCHAR_VEC *mask,
		const DOF_REAL_VEC *x, REAL beta, DOF_REAL_VEC *y)
{
  FUNCNAME("dof_gemv");
  int  ysize, dof;
  REAL sum, ax;
  REAL *xvec, *yvec;
  const DOF_ADMIN *m_admin, *y_admin, *x_admin;

  MV_TEST_AND_GET_ADMINS(a, x, y, m_admin, x_admin, y_admin);

  DEBUG_TEST_EXIT(a->type == MATENT_REAL, "incompatible block-matrix type");

  xvec = x->vec;
  yvec = y->vec;

  ysize = y->size;

  FOR_ALL_FREE_DOFS(y_admin, if (dof < ysize) yvec[dof] = 0.0);

  if (a->is_diagonal) {
    if (x_admin == y_admin) {
      FOR_ALL_DOFS(m_admin, {
	  if (mask == NULL || mask->vec[dof] < DIRICHLET) {
	    yvec[dof] =
	      beta * yvec[dof] + alpha * a->diagonal.real->vec[dof] * xvec[dof];
	  } else {
	    yvec[dof] *= beta;
	  }
	});
    } else if (transpose == NoTranspose) {
      DOF *col_dofs = a->diag_cols->vec;
      FOR_ALL_DOFS(m_admin, {
	  DOF col_dof = col_dofs[dof];
	  if (ENTRY_USED(col_dof) &&
	      (mask == NULL || mask->vec[dof] < DIRICHLET)) {
	    yvec[dof] =
	      beta * yvec[dof]
	      +
	      alpha * a->diagonal.real->vec[dof] * xvec[col_dof];
	  } else {
	    yvec[dof] *= beta;
	  }
	});
    } else {
      DOF *col_dofs = a->diag_cols->vec;
      FOR_ALL_DOFS(m_admin, {
	  DOF col_dof = col_dofs[dof];
	  if (ENTRY_USED(col_dof) &&
	      (mask == NULL || mask->vec[col_dof] < DIRICHLET)) {
	    yvec[col_dof] =
	      beta * yvec[col_dof]
	      +
	      alpha * a->diagonal.real->vec[dof] * xvec[dof];
	  } else {
	    yvec[dof] *= beta;
	  }
	});
    }
  } else if (transpose == NoTranspose) { // not diagonal

    DEBUG_TEST_EXIT(m_admin == y_admin,
		    "matrix- and y-admins do not match: %p %p.\n",
		    m_admin, y_admin);

    for (dof = 0; dof < m_admin->size_used; dof++) {
      sum = 0.0;
      if (mask == NULL || mask->vec[dof] < DIRICHLET) {
	FOR_ALL_MAT_COLS(REAL, a->matrix_row[dof],
			 sum += row->entry[col_idx] * xvec[col_dof]);
      }
      yvec[dof] = beta * yvec[dof] + alpha * sum;
    }
  } else if (transpose == Transpose) {

    TEST_EXIT(m_admin == x_admin,
	      "matrix- and x-admins do not match: %p %p.\n",
	      m_admin, x_admin);

    FOR_ALL_DOFS(y_admin, yvec[dof] *= beta);
    for (dof = 0; dof < m_admin->size_used; dof++) {
      ax = alpha * xvec[dof];
      FOR_ALL_MAT_COLS(REAL, a->matrix_row[dof],
		       if (mask == NULL || mask->vec[col_dof] < DIRICHLET) {
			 yvec[col_dof] += ax * row->entry[col_idx];
		       });
    }
  } else {
    ERROR_EXIT("transpose=%d\n", transpose);
  }
}

FLATTEN_ATTR
void dof_gemv(MatrixTranspose transpose, REAL alpha,
	      const DOF_MATRIX *A, const DOF_SCHAR_VEC *mask,
	      const DOF_REAL_VEC *x,
	      REAL beta, DOF_REAL_VEC *y)
{
  const DOF_MATRIX *A_chain;

  if (transpose == NoTranspose) {
    COL_CHAIN_DO(A, const DOF_MATRIX) {
      if (mask) {
	__dof_gemv(transpose, alpha, A, mask, x, beta, y);
      } else {
	__dof_gemv(transpose, alpha, A, NULL, x, beta, y);
      }
      ROW_CHAIN_FOREACH(A_chain, A, const DOF_MATRIX) {
	x = CHAIN_NEXT(x, const DOF_REAL_VEC);
	if (mask) {
	  __dof_gemv(transpose, alpha, A_chain, mask, x, 1.0, y);
	} else {
	  __dof_gemv(transpose, alpha, A_chain, NULL, x, 1.0, y);
	}
      }
      x = CHAIN_NEXT(x, const DOF_REAL_VEC);
      y = CHAIN_NEXT(y, DOF_REAL_VEC);
      mask = mask ? CHAIN_NEXT(mask, DOF_SCHAR_VEC) : NULL;
    } COL_CHAIN_WHILE(A, const DOF_MATRIX);
  } else {
    ROW_CHAIN_DO(A, const DOF_MATRIX) {
      if (mask) {
	__dof_gemv(transpose, alpha, A, mask, x, beta, y);
      } else {
	__dof_gemv(transpose, alpha, A, NULL, x, beta, y);
      }
      COL_CHAIN_FOREACH(A_chain, A, const DOF_MATRIX) {
	x = CHAIN_NEXT(x, const DOF_REAL_VEC);
	if (mask) {
	  __dof_gemv(transpose, alpha, A_chain, mask, x, 1.0, y);
	} else {
	  __dof_gemv(transpose, alpha, A_chain, NULL, x, 1.0, y);
	}
      }
      x = CHAIN_NEXT(x, const DOF_REAL_VEC);
      y = CHAIN_NEXT(y, DOF_REAL_VEC);
      mask = mask ? CHAIN_NEXT(mask, DOF_SCHAR_VEC) : NULL;
    } ROW_CHAIN_WHILE(A, const DOF_MATRIX);
  }
}

/*--------------------------------------------------------------------------*/

FORCE_INLINE_ATTR
static inline
void __dof_mv(MatrixTranspose transpose,
	      const DOF_MATRIX *a, const DOF_SCHAR_VEC *mask,
	      const DOF_REAL_VEC *x, DOF_REAL_VEC *y)
{
  FUNCNAME("dof_mv");
  REAL          sum, ax, *xvec, *yvec;
  const DOF_ADMIN *m_admin, *y_admin, *x_admin;
  int dof, ysize;

  MV_TEST_AND_GET_ADMINS(a, x, y, m_admin, x_admin, y_admin);

  DEBUG_TEST_EXIT(a->type == MATENT_REAL, "incompatible block-matrix type");

  xvec = x->vec;
  yvec = y->vec;

  ysize = y->size;
  FOR_ALL_FREE_DOFS(y_admin, if (dof < ysize) yvec[dof] = 0.0);

  if (a->is_diagonal) {
    if (x_admin == y_admin) {
      FOR_ALL_DOFS(m_admin, {
	  if (mask == NULL || mask->vec[dof] < DIRICHLET) {
	    yvec[dof] = a->diagonal.real->vec[dof] * xvec[dof];
	  }
	});
    } else if (transpose == NoTranspose) {
      DOF *col_dofs = a->diag_cols->vec;
      FOR_ALL_DOFS(m_admin, {
	  if (ENTRY_USED(col_dofs[dof]) &&
	      (mask == NULL || mask->vec[dof] < DIRICHLET)) {
	    yvec[dof] = a->diagonal.real->vec[dof] * xvec[col_dofs[dof]];
	  }
	});
    } else {
      DOF *col_dofs = a->diag_cols->vec;
      FOR_ALL_DOFS(m_admin, {
	  if (ENTRY_USED(col_dofs[dof]) &&
	      (mask == NULL || mask->vec[col_dofs[dof]] < DIRICHLET)) {
	    yvec[col_dofs[dof]] = a->diagonal.real->vec[dof] * xvec[dof];
	  }
	});
    }
  } else if (transpose == NoTranspose) {

    DEBUG_TEST_EXIT(m_admin == y_admin,
		    "matrix- and y-admins do not match: %p %p.\n",
		    m_admin, y_admin);

    for (dof = 0; dof < m_admin->size_used; dof++) {
      sum = 0.0;
      if (mask == NULL || mask->vec[dof] < DIRICHLET) {
	FOR_ALL_MAT_COLS(REAL, a->matrix_row[dof],
			 sum += row->entry[col_idx] * xvec[col_dof]);
      }
      yvec[dof] = sum;
    }
  } else if (transpose == Transpose) {
    
    DEBUG_TEST_EXIT(m_admin == x_admin,
		    "matrix- and x-admins do not match: %p %p.\n",
		    m_admin, x_admin);

    FOR_ALL_DOFS(y_admin, yvec[dof] = 0.0);

    for (dof = 0; dof < m_admin->size_used; dof++) {
      ax = xvec[dof];
      FOR_ALL_MAT_COLS(REAL, a->matrix_row[dof],
		       if (mask == NULL || mask->vec[col_dof] < DIRICHLET) {
			 yvec[col_dof] += ax * row->entry[col_idx];
		       });
    }
  } else {
    ERROR_EXIT("transpose=%d\n", transpose);
  }
}

FLATTEN_ATTR
void dof_mv(MatrixTranspose transpose,
	    const DOF_MATRIX *A, const DOF_SCHAR_VEC *mask,
	    const DOF_REAL_VEC *x, DOF_REAL_VEC *y)
{
  const DOF_MATRIX *A_chain;

  if (transpose == NoTranspose) {
    COL_CHAIN_DO(A, const DOF_MATRIX) {
      if (mask) {
	__dof_mv(transpose, A, mask, x, y);
      } else {
	__dof_mv(transpose, A, NULL, x, y);
      }
      ROW_CHAIN_FOREACH(A_chain, A, const DOF_MATRIX) {
	x = CHAIN_NEXT(x, const DOF_REAL_VEC);
	if (mask) {
	  __dof_gemv(transpose, 1.0, A_chain, mask, x, 1.0, y);
	} else {
	  __dof_gemv(transpose, 1.0, A_chain, NULL, x, 1.0, y);
	}
      }
      x = CHAIN_NEXT(x, const DOF_REAL_VEC);
      y = CHAIN_NEXT(y, DOF_REAL_VEC);
      mask = mask ? CHAIN_NEXT(mask, DOF_SCHAR_VEC) : NULL;
    } COL_CHAIN_WHILE(A, const DOF_MATRIX);
  } else {
    ROW_CHAIN_DO(A, const DOF_MATRIX) {
      if (mask) {
	__dof_mv(transpose, A, mask, x, y);
      } else {
	__dof_mv(transpose, A, NULL, x, y);
      }
      COL_CHAIN_FOREACH(A_chain, A, const DOF_MATRIX) {
	x = CHAIN_NEXT(x, const DOF_REAL_VEC);
	if (mask) {
	  __dof_gemv(transpose, 1.0, A_chain, mask, x, 1.0, y);
	} else {
	  __dof_gemv(transpose, 1.0, A_chain, NULL, x, 1.0, y);
	}
      }
      x = CHAIN_NEXT(x, const DOF_REAL_VEC);
      y = CHAIN_NEXT(y, DOF_REAL_VEC);
      mask = mask ? CHAIN_NEXT(mask, DOF_SCHAR_VEC) : NULL;
    } ROW_CHAIN_WHILE(A, const DOF_MATRIX);
  }
}

/* >>> */

/* <<< REAL_D x REAL */

/* <<< fixed stride */

/* Matrix-Vector for DOF_RDR_MATRIX matrices. */
FORCE_INLINE_ATTR
static inline
void __dof_gemv_rdr(MatrixTranspose transpose,
		    REAL alpha,
		    const DOF_MATRIX *a, const DOF_SCHAR_VEC *mask,
		    const DOF_REAL_VEC *x, REAL beta, DOF_REAL_D_VEC *y)
{
  FUNCNAME("dof_gemv_rdr");
  int            ysize, dof;
  REAL_D         sum;
  REAL           *xvec;
  REAL_D         *yvec;
  const DOF_ADMIN *m_admin, *y_admin, *x_admin;

  MV_TEST_AND_GET_ADMINS(a, x, y, m_admin, x_admin, y_admin);

  DEBUG_TEST_EXIT(a->type == MATENT_REAL || a->type == MATENT_REAL_D,
		  "incompatible block-matrix type");

  xvec = x->vec;
  yvec = y->vec;

  ysize = y->size;

  FOR_ALL_FREE_DOFS(y_admin,
		    if (dof < ysize) {
		      SET_DOW(0.0, yvec[dof]);
		    });

  if (a->is_diagonal) {
    if (a->type == MATENT_REAL_D) {
      if (x_admin == y_admin) {
	FOR_ALL_DOFS(m_admin, {
	    if (mask == NULL || mask->vec[dof] < DIRICHLET) {
	      AXPBY_DOW(beta, yvec[dof],
			alpha * xvec[dof], a->diagonal.real_d->vec[dof], yvec[dof]);
	    } else {
	      SCAL_DOW(beta, yvec[dof]);
	    }
	  });
      } else if (transpose == NoTranspose) {
	DOF *col_dofs = a->diag_cols->vec;
	FOR_ALL_DOFS(m_admin, {
	    DOF col_dof = col_dofs[dof];
	    if (ENTRY_USED(col_dof) &&
		(mask == NULL || mask->vec[dof] < DIRICHLET)) {
	      AXPBY_DOW(beta, yvec[dof],
			alpha * xvec[col_dof],  a->diagonal.real_d->vec[dof], yvec[dof]);
	    } else {
	      SCAL_DOW(beta, yvec[dof]);
	    }
	  });
      } else {
	DOF *col_dofs = a->diag_cols->vec;
	FOR_ALL_DOFS(m_admin, {
	    DOF col_dof = col_dofs[dof];
	    if (ENTRY_USED(col_dof) &&
		(mask == NULL || mask->vec[col_dof] < DIRICHLET)) {
	      AXPBY_DOW(beta, yvec[col_dof],
			alpha * xvec[dof],  a->diagonal.real_d->vec[dof], yvec[col_dof]);
	    } else {
	      SCAL_DOW(beta, yvec[col_dof]);
	    }
	  });
      }
    } else {
      // Matrix has REAL entries, a block-wise scalar matrix
      if (x_admin == y_admin) {
	FOR_ALL_DOFS(m_admin, {
	    if (mask == NULL || mask->vec[dof] < DIRICHLET) {
	      DMDMSCMAXPBY_DOW(beta, yvec[dof],
			       alpha * xvec[dof], a->diagonal.real->vec[dof],
			       yvec[dof]);
	    } else {
	      SCAL_DOW(beta, yvec[dof]);
	    }
	  });
      } else if (transpose == NoTranspose) {
	DOF *col_dofs = a->diag_cols->vec;
	FOR_ALL_DOFS(m_admin, {
	    DOF col_dof = col_dofs[dof];
	    if (ENTRY_USED(col_dof) &&
		(mask == NULL || mask->vec[dof] < DIRICHLET)) {
	      DMDMSCMAXPBY_DOW(beta, yvec[dof],
			       alpha * xvec[col_dof], a->diagonal.real->vec[dof],
			       yvec[dof]);
	    } else {
	      SCAL_DOW(beta, yvec[dof]);
	    }
	  });
      } else {
	DOF *col_dofs = a->diag_cols->vec;
	FOR_ALL_DOFS(m_admin, {
	    DOF col_dof = col_dofs[dof];
	    if (ENTRY_USED(col_dof) &&
		(mask == NULL || mask->vec[col_dof] < DIRICHLET)) {
	      DMDMSCMAXPBY_DOW(beta, yvec[col_dof],
			       alpha * xvec[dof], a->diagonal.real->vec[dof],
			       yvec[col_dof]);
	    } else {
	      SCAL_DOW(beta, yvec[col_dof]);
	    }
	  });
      }
    }
  } else if (transpose == NoTranspose) {
    TEST_EXIT(m_admin == y_admin,
	      "matrix- and y-admins do not match: %p %p.\n",
	      m_admin, y_admin);
		    
    /* Handle some very special cases efficiently (s.t. the compiler
     * can optimize them).
     */
#define RDR_GEMV_LOOP(mat_type, mat_pfx, add_insn)			\
    for (dof = 0; dof < m_admin->size_used; dof++) {			\
      SET_DOW(0.0, sum);						\
      if (mask == NULL || mask->vec[dof] < DIRICHLET) {			\
	FOR_ALL_MAT_COLS(mat_type, a->matrix_row[dof],			\
			 DM##mat_pfx##AXPY_DOW(xvec[col_dof],		\
					       row->entry[col_idx], sum)); \
      }									\
      add_insn;								\
    }
#define RDR_GEMV_CASES(type, pfx)					\
    if (beta == 0.0) {							\
      if (alpha == 1.0) {						\
	RDR_GEMV_LOOP(type, pfx, COPY_DOW(sum, yvec[dof]));		\
      } else {								\
	RDR_GEMV_LOOP(type, pfx, AXEY_DOW(alpha, sum, yvec[dof]));	\
      }									\
    } else if (beta == 1.0) {						\
      if (alpha == 1.0) {						\
	RDR_GEMV_LOOP(type, pfx, AXPY_DOW(1.0, sum, yvec[dof]));	\
      } else {								\
	RDR_GEMV_LOOP(type, pfx, AXPY_DOW(alpha, sum, yvec[dof]));	\
      }									\
    } else {								\
      if (alpha == 1.0) {						\
	RDR_GEMV_LOOP(type, pfx,					\
		      AXPBY_DOW(beta, yvec[dof], 1.0, sum, yvec[dof]));	\
      } else {								\
	RDR_GEMV_LOOP(type, pfx,					\
		      AXPBY_DOW(beta, yvec[dof], alpha, sum, yvec[dof])); \
      }									\
    }

    if (a->type == MATENT_REAL_D) {
      RDR_GEMV_CASES(REAL_D, DM);
    } else {
      RDR_GEMV_CASES(REAL, SCM);
    }
#undef RDR_GEMV_LOOP
#undef RDR_GEMV_CASES
  } else { /* Transposed operation */
    TEST_EXIT(m_admin == x_admin,
	      "matrix- and x-admins do not match: %p %p (Transpose).\n",
	      m_admin, x_admin);
    
#define RDR_GEMV_LOOP(mat_type, mat_pfx, add_insn)			\
    for (dof = 0; dof < m_admin->size_used; dof++) {			\
      REAL xval = xvec[dof];						\
      FOR_ALL_MAT_COLS(mat_type, a->matrix_row[dof],			\
		       if (mask == NULL || mask->vec[col_dof] < DIRICHLET) { \
			 DM##mat_pfx##add_insn;				\
		       });						\
    }
#define RDR_GEMV_CASES(type, pfx)					\
    if (beta == 1.0) {							\
      /* y is unchanged, just add to it */				\
    } else if (beta == 0.0) {						\
      FOR_ALL_DOFS(y_admin, SET_DOW(0.0, yvec[dof]));			\
    } else {								\
      FOR_ALL_DOFS(y_admin, SCAL_DOW(beta, yvec[dof]));			\
    }									\
    if (alpha == 1.0) {							\
      RDR_GEMV_LOOP(type, pfx,						\
		    AXPY_DOW(xval, row->entry[col_idx], yvec[col_dof])); \
    } else {								\
      RDR_GEMV_LOOP(type, pfx,						\
		    AXPY_DOW(alpha*xval, row->entry[col_idx],		\
			     yvec[col_dof]));				\
    }

    if (a->type == MATENT_REAL_D) {
      RDR_GEMV_CASES(REAL_D, DM);
    } else {
      RDR_GEMV_CASES(REAL, SCM);
    }
#undef RDR_GEMV_LOOP
#undef RDR_GEMV_CASES
  }
}

FLATTEN_ATTR
void dof_gemv_rdr(MatrixTranspose transpose,
		  REAL alpha,
		  const DOF_MATRIX *A, const DOF_SCHAR_VEC *mask,
		  const DOF_REAL_VEC *x, REAL beta, DOF_REAL_D_VEC *y)
{
  const DOF_MATRIX *A_chain;

  if (transpose == NoTranspose) {
    COL_CHAIN_DO(A, const DOF_MATRIX) {
      if (mask) {
	__dof_gemv_rdr(transpose, alpha, A, mask, x, beta, y);
      } else {
	__dof_gemv_rdr(transpose, alpha, A, NULL, x, beta, y);
      }
      ROW_CHAIN_FOREACH(A_chain, A, const DOF_MATRIX) {
	x = CHAIN_NEXT(x, const DOF_REAL_VEC);
	if (mask) {
	  __dof_gemv_rdr(transpose, alpha, A_chain, mask, x, 1.0, y);
	} else {
	  __dof_gemv_rdr(transpose, alpha, A_chain, NULL, x, 1.0, y);
	}
      }
      x = CHAIN_NEXT(x, const DOF_REAL_VEC);
      y = CHAIN_NEXT(y, DOF_REAL_D_VEC);
      mask = mask ? CHAIN_NEXT(mask, DOF_SCHAR_VEC) : NULL;
    } COL_CHAIN_WHILE(A, const DOF_MATRIX);
  } else {
    ROW_CHAIN_DO(A, const DOF_MATRIX) {
      if (mask) {
	__dof_gemv_rdr(transpose, alpha, A, mask, x, beta, y);
      } else {
	__dof_gemv_rdr(transpose, alpha, A, NULL, x, beta, y);
      }
      COL_CHAIN_FOREACH(A_chain, A, const DOF_MATRIX) {
	x = CHAIN_NEXT(x, const DOF_REAL_VEC);
	if (mask) {
	  __dof_gemv_rdr(transpose, alpha, A_chain, mask, x, 1.0, y);
	} else {
	  __dof_gemv_rdr(transpose, alpha, A_chain, NULL, x, 1.0, y);
	}
      }
      x = CHAIN_NEXT(x, const DOF_REAL_VEC);
      y = CHAIN_NEXT(y, DOF_REAL_D_VEC);
      mask = mask ? CHAIN_NEXT(mask, DOF_SCHAR_VEC) : NULL;
    } ROW_CHAIN_WHILE(A, const DOF_MATRIX);
  }
}

FORCE_INLINE_ATTR
static inline
void __dof_mv_rdr(MatrixTranspose transpose,
		  const DOF_MATRIX *a, const DOF_SCHAR_VEC *mask,
		  const DOF_REAL_VEC *x,
		  DOF_REAL_D_VEC *y)
{
  /* The compiler should be clever enough now ... (see abbove) */
  __dof_gemv_rdr(transpose, 1.0, a, mask, x, 0.0, y);
}

FLATTEN_ATTR
void dof_mv_rdr(MatrixTranspose transpose,
		const DOF_MATRIX *a, const DOF_SCHAR_VEC *mask,
		const DOF_REAL_VEC *x, DOF_REAL_D_VEC *y)
{
  /* The compiler should be clever enough now ... (see abbove) */
  dof_gemv_rdr(transpose, 1.0, a, mask, x, 0.0, y);
}

/* >>> */

/* <<< variable stride */

FORCE_INLINE_ATTR
static inline
void __dof_gemv_dow_scl(MatrixTranspose transpose, REAL alpha,
			const DOF_MATRIX *a, const DOF_SCHAR_VEC *mask,
			const DOF_REAL_VEC *x, REAL beta, DOF_REAL_VEC_D *y)
{
  if (y->stride != 1) {
    __dof_gemv_rdr(transpose, alpha, a, mask, x, beta, (DOF_REAL_D_VEC *)y);
  } else {
    __dof_gemv(transpose, alpha, a, mask, x, beta, (DOF_REAL_VEC *)y);
  }
}

FLATTEN_ATTR
void dof_gemv_dow_scl(MatrixTranspose transpose, REAL alpha,
		      const DOF_MATRIX *A, const DOF_SCHAR_VEC *mask,
		      const DOF_REAL_VEC *x,
		      REAL beta, DOF_REAL_VEC_D *y)
{
  const DOF_MATRIX *A_chain;

  if (transpose == NoTranspose) {
    COL_CHAIN_DO(A, const DOF_MATRIX) {
      if (mask) {
	__dof_gemv_dow_scl(transpose, alpha, A, mask, x, beta, y);
      } else {
	__dof_gemv_dow_scl(transpose, alpha, A, NULL, x, beta, y);
      }
      ROW_CHAIN_FOREACH(A_chain, A, const DOF_MATRIX) {
	x = CHAIN_NEXT(x, const DOF_REAL_VEC);
	if (mask) {
	  __dof_gemv_dow_scl(transpose, alpha, A_chain, mask, x, 1.0, y);
	} else {
	  __dof_gemv_dow_scl(transpose, alpha, A_chain, NULL, x, 1.0, y);
	}
      }
      x = CHAIN_NEXT(x, const DOF_REAL_VEC);
      y = CHAIN_NEXT(y, DOF_REAL_VEC_D);
      mask = mask ? CHAIN_NEXT(mask, DOF_SCHAR_VEC) : NULL;
    } COL_CHAIN_WHILE(A, const DOF_MATRIX);
  } else {
    ROW_CHAIN_DO(A, const DOF_MATRIX) {
      if (mask) {
	__dof_gemv_dow_scl(transpose, alpha, A, mask, x, beta, y);
      } else {
	__dof_gemv_dow_scl(transpose, alpha, A, NULL, x, beta, y);
      }
      COL_CHAIN_FOREACH(A_chain, A, const DOF_MATRIX) {
	x = CHAIN_NEXT(x, const DOF_REAL_VEC);
	if (mask) {
	  __dof_gemv_dow_scl(transpose, alpha, A_chain, mask, x, 1.0, y);
	} else {
	  __dof_gemv_dow_scl(transpose, alpha, A_chain, NULL, x, 1.0, y);
	}
      }
      x = CHAIN_NEXT(x, const DOF_REAL_VEC);
      y = CHAIN_NEXT(y, DOF_REAL_VEC_D);
      mask = mask ? CHAIN_NEXT(mask, DOF_SCHAR_VEC) : NULL;
    } ROW_CHAIN_WHILE(A, const DOF_MATRIX);
  }
}

FORCE_INLINE_ATTR
static inline
void __dof_mv_dow_scl(MatrixTranspose transpose,
		      const DOF_MATRIX *a, const DOF_SCHAR_VEC *mask,
		      const DOF_REAL_VEC *x,
		      DOF_REAL_VEC_D *y)
{
  if (y->stride != 1) {
    __dof_mv_rdr(transpose, a, mask, x, (DOF_REAL_D_VEC *)y);
  } else {
    __dof_mv(transpose, a, mask, x, (DOF_REAL_VEC *)y);
  }
}

FLATTEN_ATTR
void dof_mv_dow_scl(MatrixTranspose transpose,
		    const DOF_MATRIX *A, const DOF_SCHAR_VEC *mask,
		    const DOF_REAL_VEC *x, DOF_REAL_VEC_D *y)
{
  const DOF_MATRIX *A_chain;

  if (transpose == NoTranspose) {
    COL_CHAIN_DO(A, const DOF_MATRIX) {
      if (mask) {
	__dof_mv_dow_scl(transpose, A, mask, x, y);
      } else {
	__dof_mv_dow_scl(transpose, A, NULL, x, y);
      }
      ROW_CHAIN_FOREACH(A_chain, A, const DOF_MATRIX) {
	x = CHAIN_NEXT(x, const DOF_REAL_VEC);
	if (mask) {
	  __dof_gemv_dow_scl(transpose, 1.0, A_chain, mask, x, 1.0, y);
	} else {
	  __dof_gemv_dow_scl(transpose, 1.0, A_chain, NULL, x, 1.0, y);
	}
      }
      x = CHAIN_NEXT(x, const DOF_REAL_VEC);
      y = CHAIN_NEXT(y, DOF_REAL_VEC_D);
      mask = mask ? CHAIN_NEXT(mask, DOF_SCHAR_VEC) : NULL;
    } COL_CHAIN_WHILE(A, const DOF_MATRIX);
  } else {
    ROW_CHAIN_DO(A, const DOF_MATRIX) {
      if (mask) {
	__dof_mv_dow_scl(transpose, A, mask, x, y);
      } else {
	__dof_mv_dow_scl(transpose, A, NULL, x, y);
      }
      COL_CHAIN_FOREACH(A_chain, A, const DOF_MATRIX) {
	x = CHAIN_NEXT(x, const DOF_REAL_VEC);
	if (mask) {
	  __dof_gemv_dow_scl(transpose, 1.0, A_chain, mask, x, 1.0, y);
	} else {
	  __dof_gemv_dow_scl(transpose, 1.0, A_chain, NULL, x, 1.0, y);
	}
      }
      x = CHAIN_NEXT(x, const DOF_REAL_VEC);
      y = CHAIN_NEXT(y, DOF_REAL_VEC_D);
      mask = mask ? CHAIN_NEXT(mask, DOF_SCHAR_VEC) : NULL;
    } ROW_CHAIN_WHILE(A, const DOF_MATRIX);
  }
}

/* >>> */

/* >>> */

/* <<< REAL x REAL_D */

/* <<< fixed stride */

FORCE_INLINE_ATTR
static inline
void __dof_gemv_rrd(MatrixTranspose transpose, REAL alpha,
		    const DOF_MATRIX *a, const DOF_SCHAR_VEC *mask,
		    const DOF_REAL_D_VEC *x, REAL beta, DOF_REAL_VEC *y)
{
  FUNCNAME("dof_gemv_rrd");
  int            ysize, dof;
  REAL           sum;
  REAL_D         *xvec;
  REAL           *yvec;
  const DOF_ADMIN *m_admin, *y_admin, *x_admin;

  MV_TEST_AND_GET_ADMINS(a, x, y, m_admin, x_admin, y_admin);

  DEBUG_TEST_EXIT(a->type == MATENT_REAL || a->type == MATENT_REAL_D,
		  "incompatible block-matrix type");

  xvec = x->vec;
  yvec = y->vec;

  ysize = y->size;

  FOR_ALL_FREE_DOFS(y_admin, if (dof < ysize) yvec[dof] = 0.0);

  if (a->is_diagonal) {
    if (a->type == MATENT_REAL_D) {
      if (x_admin == y_admin) {
	FOR_ALL_DOFS(m_admin, {
	    if (mask == NULL || mask->vec[dof] < DIRICHLET) {
	      yvec[dof] =
		beta * yvec[dof] + alpha * SCP_DOW(a->diagonal.real_d->vec[dof], xvec[dof]);
	    } else {
	      yvec[dof] *= beta;
	    }
	  });
      } else if (transpose == NoTranspose) {
	DOF *col_dofs = a->diag_cols->vec;
	FOR_ALL_DOFS(m_admin, {
	    DOF col_dof = col_dofs[dof];
	    if (ENTRY_USED(col_dof) &&
		(mask == NULL || mask->vec[dof] < DIRICHLET)) {
	      yvec[dof] =
		beta * yvec[dof]
		+
		alpha * SCP_DOW(a->diagonal.real_d->vec[dof], xvec[col_dof]);
	    } else {
	      yvec[dof] *= beta;
	    }
	  });
      } else {
	DOF *col_dofs = a->diag_cols->vec;
	FOR_ALL_DOFS(m_admin, {
	    DOF col_dof = col_dofs[dof];
	    if (ENTRY_USED(col_dof) &&
		(mask == NULL || mask->vec[col_dof] < DIRICHLET)) {
	      yvec[col_dof] =
		beta * yvec[col_dof]
		+
		alpha * SCP_DOW(a->diagonal.real_d->vec[dof], xvec[dof]);
	    } else {
	      yvec[dof] *= beta;
	    }
	  });
      }
    } else {
      // Matrix is block-wise scalar
      if (x_admin == y_admin) {
	FOR_ALL_DOFS(m_admin, {
	    if (mask == NULL || mask->vec[dof] < DIRICHLET) {
	      yvec[dof] =
		beta * yvec[dof] + alpha * a->diagonal.real->vec[dof] * SUM_DOW(xvec[dof]);
	    } else {
	      yvec[dof] *= beta;
	    }
	  });
      } else if (transpose == NoTranspose) {
	DOF *col_dofs = a->diag_cols->vec;
	FOR_ALL_DOFS(m_admin, {
	    DOF col_dof = col_dofs[dof];
	    if (ENTRY_USED(col_dof) &&
		(mask == NULL || mask->vec[dof] < DIRICHLET)) {
	      yvec[dof] =
		beta * yvec[dof]
		+
		alpha * a->diagonal.real->vec[dof] * SUM_DOW(xvec[col_dof]);
	    } else {
	      yvec[dof] *= beta;
	    }
	  });
      } else {
	DOF *col_dofs = a->diag_cols->vec;
	FOR_ALL_DOFS(m_admin, {
	    DOF col_dof = col_dofs[dof];
	    if (ENTRY_USED(col_dof) &&
		(mask == NULL || mask->vec[col_dof] < DIRICHLET)) {
	      yvec[col_dof] =
		beta * yvec[col_dof]
		+
		alpha * a->diagonal.real->vec[dof] * SUM_DOW(xvec[dof]);
	    } else {
	      yvec[dof] *= beta;
	    }
	  });
      }
    }
  } else if (transpose == NoTranspose) { // not diagonal
    
    TEST_EXIT(m_admin == y_admin,
	      "matrix- and y-admins do not match: %p %p.\n",
	      m_admin, y_admin);

    /* Handle some very special cases efficiently (s.t. the compiler can
     * optimize them).
     */
#define RRD_GEMV_LOOP(mat_type, MV_INSN, ADD_INSN)		\
    for (dof = 0; dof < m_admin->size_used; dof++) {		\
      sum = 0.0;						\
      if (mask == NULL || mask->vec[dof] < DIRICHLET) {		\
	FOR_ALL_MAT_COLS(mat_type, a->matrix_row[dof],		\
			 sum += MV_INSN(row->entry[col_idx],	\
					xvec[col_dof]));	\
      }								\
      ADD_INSN;							\
    }
#define RRD_GEMV_CASES(mat_type, MV_INSN)				\
    if (beta == 0.0) {							\
      if (alpha == 1.0) {						\
	RRD_GEMV_LOOP(mat_type, MV_INSN, yvec[dof] = sum);		\
      } else {								\
	RRD_GEMV_LOOP(mat_type, MV_INSN, yvec[dof] = alpha*sum);	\
      }									\
    } else if (beta == 1.0) {						\
      if (alpha == 1.0) {						\
	RRD_GEMV_LOOP(mat_type, MV_INSN, yvec[dof] += sum);		\
      } else {								\
	RRD_GEMV_LOOP(mat_type, MV_INSN, yvec[dof] += alpha*sum);	\
      }									\
    } else {								\
      if (alpha == 1.0) {						\
	RRD_GEMV_LOOP(mat_type, MV_INSN, yvec[dof] = beta * yvec[dof] + sum); \
      } else {								\
	RRD_GEMV_LOOP(mat_type, MV_INSN,				\
		      yvec[dof] = beta * yvec[dof] + alpha * sum);	\
      }									\
    }

    if (a->type == MATENT_REAL_D) {
      RRD_GEMV_CASES(REAL_D, SCP_DOW);
    } else {
#define MV_INSN(a, b) a * SUM_DOW(b)
      RRD_GEMV_CASES(REAL, MV_INSN);
#undef MV_INSN
    }
#undef RRD_GEMV_LOOP
#undef RRD_GEMV_CASES
  } else { /* transposed matrix operation */
    TEST_EXIT(m_admin == x_admin,
	      "matrix- and x-admins do not match: %p %p (Transpose).\n",
	      m_admin, x_admin);

#define RRD_GEMV_LOOP(mat_type, MV_INSN, ADD_INSN)			\
    for (dof = 0; dof < m_admin->size_used; dof++) {			\
      REAL *xval = xvec[dof];						\
      REAL Mx;								\
      FOR_ALL_MAT_COLS(mat_type, a->matrix_row[dof],			\
		       if (mask == NULL || mask->vec[col_dof] < DIRICHLET) { \
			 Mx = MV_INSN(row->entry[col_idx], xval);	\
			 ADD_INSN;					\
		       });						\
    }
#define RRD_GEMV_CASES(mat_type, MV_INSN)				\
    if (beta == 1.0) {							\
      /* y is unchanged */						\
    } else if (beta == 0.0) {						\
      FOR_ALL_DOFS(y_admin, yvec[dof] = 0.0);				\
    } else {								\
      FOR_ALL_DOFS(y_admin, yvec[dof] *= beta);				\
    }									\
    if (alpha == 1.0) {							\
      RRD_GEMV_LOOP(mat_type, MV_INSN, yvec[col_dof] += Mx);		\
    } else {								\
      RRD_GEMV_LOOP(mat_type, MV_INSN, yvec[col_dof] += alpha*Mx);	\
    }

    if (a->type == MATENT_REAL_D) {
      RRD_GEMV_CASES(REAL_D, SCP_DOW);
    } else {
#define MV_INSN(a, b) a * SUM_DOW(b)
      RRD_GEMV_CASES(REAL, MV_INSN);
#undef MV_INSN
    }
#undef RRD_GEMV_LOOP
#undef RRD_GEMV_CASES
  }
}

FLATTEN_ATTR
void dof_gemv_rrd(MatrixTranspose transpose, REAL alpha,
		  const DOF_MATRIX *A, const DOF_SCHAR_VEC *mask,
		  const DOF_REAL_D_VEC *x, REAL beta, DOF_REAL_VEC *y)
{
  const DOF_MATRIX *A_chain;
  
  if (transpose == NoTranspose) {
    COL_CHAIN_DO(A, const DOF_MATRIX) {
      if (mask) {
	__dof_gemv_rrd(transpose, alpha, A, mask, x, beta, y);
      } else {
	__dof_gemv_rrd(transpose, alpha, A, NULL, x, beta, y);
      }
      ROW_CHAIN_FOREACH(A_chain, A, const DOF_MATRIX) {
	x = CHAIN_NEXT(x, const DOF_REAL_D_VEC);
	if (mask) {
	  __dof_gemv_rrd(transpose, alpha, A_chain, mask, x, 1.0, y);
	} else {
	  __dof_gemv_rrd(transpose, alpha, A_chain, NULL, x, 1.0, y);
	}
      }
      x = CHAIN_NEXT(x, const DOF_REAL_D_VEC);
      y = CHAIN_NEXT(y, DOF_REAL_VEC);
    } COL_CHAIN_WHILE(A, const DOF_MATRIX);
  } else {
    ROW_CHAIN_DO(A, const DOF_MATRIX) {
      if (mask) {
	__dof_gemv_rrd(transpose, alpha, A, mask, x, beta, y);
      } else {
	__dof_gemv_rrd(transpose, alpha, A, NULL, x, beta, y);
      }
      COL_CHAIN_FOREACH(A_chain, A, const DOF_MATRIX) {
	x = CHAIN_NEXT(x, const DOF_REAL_D_VEC);
	if (mask) {
	  __dof_gemv_rrd(transpose, alpha, A_chain, mask, x, 1.0, y);
	} else {
	  __dof_gemv_rrd(transpose, alpha, A_chain, NULL, x, 1.0, y);
	}
      }
      x = CHAIN_NEXT(x, const DOF_REAL_D_VEC);
      y = CHAIN_NEXT(y, DOF_REAL_VEC);
    } ROW_CHAIN_WHILE(A, const DOF_MATRIX);
  }
}

FORCE_INLINE_ATTR
static inline
void __dof_mv_rrd(MatrixTranspose transpose,
		  const DOF_MATRIX *a, const DOF_SCHAR_VEC *mask,
		  const DOF_REAL_D_VEC *x,
		  DOF_REAL_VEC *y)
{
  /* The compiler should be clever enough now ... (see abbove) */
  __dof_gemv_rrd(transpose, 1.0, a, mask, x, 0.0, y);
}

FLATTEN_ATTR
void dof_mv_rrd(MatrixTranspose transpose,
		const DOF_MATRIX *a, const DOF_SCHAR_VEC *mask,
		const DOF_REAL_D_VEC *x, DOF_REAL_VEC *y)
{
  /* The compiler should be clever enough now ... (see abbove) */
  dof_gemv_rrd(transpose, 1.0, a, mask, x, 0.0, y);
}

/* >>> */

/* <<< variable stride */

FORCE_INLINE_ATTR
static inline
void __dof_gemv_scl_dow(MatrixTranspose transpose, REAL alpha,
			const DOF_MATRIX *a, const DOF_SCHAR_VEC *mask,
			const DOF_REAL_VEC_D *x,
			REAL beta, DOF_REAL_VEC *y)
{
  if (x->stride != 1) {
    __dof_gemv_rrd(transpose,
		   alpha, a, mask, (const DOF_REAL_D_VEC *)x, beta, y);
  } else {
    __dof_gemv(transpose,
	       alpha, a, mask, (const DOF_REAL_VEC *)x, beta, y);
  }
}

FLATTEN_ATTR
void dof_gemv_scl_dow(MatrixTranspose transpose, REAL alpha,
		      const DOF_MATRIX *A, const DOF_SCHAR_VEC *mask,
		      const DOF_REAL_VEC_D *x, REAL beta, DOF_REAL_VEC *y)
{
  const DOF_MATRIX *A_chain;
  
  if (transpose == NoTranspose) {
    COL_CHAIN_DO(A, const DOF_MATRIX) {
      if (mask) {
	__dof_gemv_scl_dow(transpose, alpha, A, mask, x, beta, y);
      } else {
	__dof_gemv_scl_dow(transpose, alpha, A, NULL, x, beta, y);
      }
      ROW_CHAIN_FOREACH(A_chain, A, const DOF_MATRIX) {
	x = CHAIN_NEXT(x, const DOF_REAL_VEC_D);
	if (mask) {
	  __dof_gemv_scl_dow(transpose, alpha, A_chain, mask, x, 1.0, y);
	} else {
	  __dof_gemv_scl_dow(transpose, alpha, A_chain, NULL, x, 1.0, y);
	}
      }
      x = CHAIN_NEXT(x, const DOF_REAL_VEC_D);
      y = CHAIN_NEXT(y, DOF_REAL_VEC);
      mask = mask ? CHAIN_NEXT(mask, DOF_SCHAR_VEC) : NULL;
    } COL_CHAIN_WHILE(A, const DOF_MATRIX);
  } else {
    ROW_CHAIN_DO(A, const DOF_MATRIX) {
      if (mask) {
	__dof_gemv_scl_dow(transpose, alpha, A, mask, x, beta, y);
      } else {
	__dof_gemv_scl_dow(transpose, alpha, A, NULL, x, beta, y);
      }
      COL_CHAIN_FOREACH(A_chain, A, const DOF_MATRIX) {
	x = CHAIN_NEXT(x, const DOF_REAL_VEC_D);
	if (mask) {
	  __dof_gemv_scl_dow(transpose, alpha, A_chain, mask, x, 1.0, y);
	} else {
	  __dof_gemv_scl_dow(transpose, alpha, A_chain, NULL, x, 1.0, y);
	}
      }
      x = CHAIN_NEXT(x, const DOF_REAL_VEC_D);
      y = CHAIN_NEXT(y, DOF_REAL_VEC);
      mask = mask ? CHAIN_NEXT(mask, DOF_SCHAR_VEC) : NULL;
    } ROW_CHAIN_WHILE(A, const DOF_MATRIX);
  }
}

FORCE_INLINE_ATTR
static inline
void __dof_mv_scl_dow(MatrixTranspose transpose,
		      const DOF_MATRIX *a, const DOF_SCHAR_VEC *mask,
		      const DOF_REAL_VEC_D *x, DOF_REAL_VEC *y)
{
  if (x->stride != 1) {
    __dof_mv_rrd(transpose, a, mask, (const DOF_REAL_D_VEC *)x, y);
  } else {
    __dof_mv(transpose, a, mask, (const DOF_REAL_VEC *)x, y);
  }
}

FLATTEN_ATTR
void dof_mv_scl_dow(MatrixTranspose transpose,
		    const DOF_MATRIX *A, const DOF_SCHAR_VEC *mask,
		    const DOF_REAL_VEC_D *x, DOF_REAL_VEC *y)
{
  const DOF_MATRIX *A_chain;
  
  if (transpose == NoTranspose) {
    COL_CHAIN_DO(A, const DOF_MATRIX) {
      if (mask) {
	__dof_mv_scl_dow(transpose, A, mask, x, y);
      } else {
	__dof_mv_scl_dow(transpose, A, NULL, x, y);
      }
      ROW_CHAIN_FOREACH(A_chain, A, const DOF_MATRIX) {
	x = CHAIN_NEXT(x, const DOF_REAL_VEC_D);
	if (mask) {
	  __dof_gemv_scl_dow(transpose, 1.0, A_chain, mask, x, 1.0, y);
	} else {
	  __dof_gemv_scl_dow(transpose, 1.0, A_chain, NULL, x, 1.0, y);
	}
      }
      x = CHAIN_NEXT(x, const DOF_REAL_VEC_D);
      y = CHAIN_NEXT(y, DOF_REAL_VEC);
      mask = mask ? CHAIN_NEXT(mask, DOF_SCHAR_VEC) : NULL;
    } COL_CHAIN_WHILE(A, const DOF_MATRIX);
  } else {
    ROW_CHAIN_DO(A, const DOF_MATRIX) {
      if (mask) {
	__dof_mv_scl_dow(transpose, A, mask, x, y);
      } else {
	__dof_mv_scl_dow(transpose, A, NULL, x, y);
      }
      COL_CHAIN_FOREACH(A_chain, A, const DOF_MATRIX) {
	x = CHAIN_NEXT(x, const DOF_REAL_VEC_D);
	if (mask) {
	  __dof_gemv_scl_dow(transpose, 1.0, A_chain, mask, x, 1.0, y);
	} else {
	  __dof_gemv_scl_dow(transpose, 1.0, A_chain, NULL, x, 1.0, y);
	}
      }
      x = CHAIN_NEXT(x, const DOF_REAL_VEC_D);
      y = CHAIN_NEXT(y, DOF_REAL_VEC);
      mask = mask ? CHAIN_NEXT(mask, DOF_SCHAR_VEC) : NULL;
    } ROW_CHAIN_WHILE(A, const DOF_MATRIX);
  }
}

/* >>> */

/* >>> */

/* <<< REAL_D x REAL_D */

/* <<< fixed stride */

FORCE_INLINE_ATTR
static inline
void __dof_gemv_d(MatrixTranspose transpose, REAL alpha,
		  const DOF_MATRIX *a, const DOF_SCHAR_VEC *mask,
		  const DOF_REAL_D_VEC *x, REAL beta, DOF_REAL_D_VEC *y)
{
  FUNCNAME("dof_gemv_d");
  int             dof, ysize;
  REAL_D          sum, ax;
  REAL_D          *xvec, *yvec;
  const DOF_ADMIN *m_admin, *y_admin, *x_admin;

  MV_TEST_AND_GET_ADMINS(a, x, y, m_admin, x_admin, y_admin);

  xvec = x->vec;
  yvec = y->vec;

  ysize = y->size;
  FOR_ALL_FREE_DOFS(y_admin, if (dof < ysize) SET_DOW(0.0, yvec[dof]));

  if (a->is_diagonal) {
    switch (a->type) {
    case MATENT_REAL:
      if (x_admin == y_admin) {
	FOR_ALL_DOFS(m_admin, {
	    if (mask == NULL || mask->vec[dof] < DIRICHLET) {
	      SCMGEMV_DOW(alpha, a->diagonal.real->vec[dof], xvec[dof],
			 beta, yvec[dof]);
	    } else {
	      SCAL_DOW(beta, yvec[dof]);
	    }
	  });
      } else if (transpose == NoTranspose) {
	DOF *col_dofs = a->diag_cols->vec;
	FOR_ALL_DOFS(m_admin, {
	    DOF col_dof = col_dofs[dof];
	    if (ENTRY_USED(col_dof) &&
		(mask == NULL || mask->vec[dof] < DIRICHLET)) {
	      SCMGEMV_DOW(alpha, a->diagonal.real->vec[dof], xvec[col_dof],
			 beta, yvec[dof]);
	    } else {
	      SCAL_DOW(beta, yvec[dof]);
	    }
	  });
      } else {
	DOF *col_dofs = a->diag_cols->vec;
	FOR_ALL_DOFS(m_admin, {
	    DOF col_dof = col_dofs[dof];
	    if (ENTRY_USED(col_dof) &&
		(mask == NULL || mask->vec[col_dof] < DIRICHLET)) {
	      SCMGEMV_DOW(alpha, a->diagonal.real->vec[dof], xvec[dof],
			 beta, yvec[col_dof]);
	    } else {
	      SCAL_DOW(beta, yvec[col_dof]);
	    }
	  });
      }
      break;
    case MATENT_REAL_D:
      if (x_admin == y_admin) {
	FOR_ALL_DOFS(m_admin, {
	    if (mask == NULL || mask->vec[dof] < DIRICHLET) {
	      DMGEMV_DOW(alpha, a->diagonal.real_d->vec[dof], xvec[dof],
			 beta, yvec[dof]);
	    } else {
	      SCAL_DOW(beta, yvec[dof]);
	    }
	  });
      } else if (transpose == NoTranspose) {
	DOF *col_dofs = a->diag_cols->vec;
	FOR_ALL_DOFS(m_admin, {
	    DOF col_dof = col_dofs[dof];
	    if (ENTRY_USED(col_dof) &&
		(mask == NULL || mask->vec[dof] < DIRICHLET)) {
	      DMGEMV_DOW(alpha,
			 a->diagonal.real_d->vec[dof], xvec[col_dof],
			 beta, yvec[dof]);
	    } else {
	      SCAL_DOW(beta, yvec[dof]);
	    }
	  });
      } else {
	DOF *col_dofs = a->diag_cols->vec;
	FOR_ALL_DOFS(m_admin, {
	    DOF col_dof = col_dofs[dof];
	    if (ENTRY_USED(col_dof) &&
		(mask == NULL || mask->vec[col_dof] < DIRICHLET)) {
	      DMGEMV_DOW(alpha,
			 a->diagonal.real_d->vec[dof], xvec[dof],
			 beta, yvec[col_dof]);
	    } else {
	      SCAL_DOW(beta, yvec[col_dof]);
	    }
	  });
      }
      break;
    case MATENT_REAL_DD:
      if (x_admin == y_admin) {
	if (transpose == NoTranspose) {
	  FOR_ALL_DOFS(m_admin, {
	      if (mask == NULL || mask->vec[dof] < DIRICHLET) {
		MGEMV_DOW(alpha, (const REAL_D *)a->diagonal.real_dd->vec[dof],
			  xvec[dof], beta, yvec[dof]);
	      } else {
		SCAL_DOW(beta, yvec[dof]);
	      }
	    });
	} else {
	  FOR_ALL_DOFS(m_admin, {
	      if (mask == NULL || mask->vec[dof] < DIRICHLET) {
		MGEMTV_DOW(alpha, (const REAL_D *)a->diagonal.real_dd->vec[dof],
			   xvec[dof], beta, yvec[dof]);
	      } else {
		SCAL_DOW(beta, yvec[dof]);
	      }
	    });
	}
      } else { /* x_admin != y_admin */
	DOF *col_dofs = a->diag_cols->vec;
	if (transpose == NoTranspose) {
	  FOR_ALL_DOFS(m_admin, {
	      DOF col_dof = col_dofs[dof];
	      if (ENTRY_USED(col_dof) &&
		  (mask == NULL || mask->vec[dof] < DIRICHLET)) {
		MGEMV_DOW(
		  alpha, (const REAL_D *)a->diagonal.real_dd->vec[dof],
		  xvec[col_dof], beta, yvec[dof]);
	      } else {
		SCAL_DOW(beta, yvec[dof]);
	      }
	    });
	} else {
	  FOR_ALL_DOFS(m_admin, {
	      DOF col_dof = col_dofs[dof];
	      if (ENTRY_USED(col_dof) &&
		  (mask == NULL || mask->vec[col_dof] < DIRICHLET)) {
		MGEMTV_DOW(alpha, (const REAL_D *)a->diagonal.real_dd->vec[dof],
			   xvec[dof], beta, yvec[col_dof]);
	      } else {
		SCAL_DOW(beta, yvec[col_dof]);
	      }
	    });
	}
      }
      break;
    default:
      break;
    }
  } else if (transpose == NoTranspose) {

    TEST_EXIT(m_admin == y_admin,
	      "matrix- and y-admins do not match: %p %p.\n",
	      m_admin, y_admin);

#undef MAT_BODY
#define MAT_BODY(F, CC, C, S, TYPE)				\
    for (dof = 0; dof < m_admin->size_used; dof++) {		\
      SET_DOW(0.0, sum);					\
      if (mask == NULL || mask->vec[dof] < DIRICHLET) {		\
	FOR_ALL_MAT_COLS(TYPE, a->matrix_row[dof],		\
			 F##V_DOW(CC row->entry[col_idx],	\
				  xvec[col_dof], sum));		\
      }								\
      AXPBY_DOW(alpha, sum, beta, yvec[dof], yvec[dof]);	\
    }
    MAT_EMIT_BODY_SWITCH(a->type);
    
  } else if (transpose == Transpose) {

    TEST_EXIT(m_admin == x_admin,
	      "matrix- and x-admins do not match: %p %p.\n",
	      m_admin, x_admin);

    FOR_ALL_DOFS(y_admin, AX_DOW(beta, yvec[dof]));

#undef MAT_BODY
#define MAT_BODY(F, CC, C, S, TYPE)					\
    for (dof = 0; dof < m_admin->size_used; dof++) {			\
      COPY_DOW(xvec[dof], ax); AX_DOW(alpha, ax);			\
      FOR_ALL_MAT_COLS(TYPE, a->matrix_row[dof],			\
		       if (mask == NULL || mask->vec[col_dof] < DIRICHLET) { \
			 F##TV_DOW(CC row->entry[col_idx], ax, yvec[col_dof]); \
		       });						\
    }
    MAT_EMIT_BODY_SWITCH(a->type);
  }
  else {
    ERROR_EXIT("transpose=%d\n", transpose);
  }
}

FLATTEN_ATTR
void dof_gemv_d(MatrixTranspose transpose, REAL alpha,
		const DOF_MATRIX *A, const DOF_SCHAR_VEC *mask,
		const DOF_REAL_D_VEC *x, REAL beta, DOF_REAL_D_VEC *y)
{
  const DOF_MATRIX *A_chain;

  if (transpose == NoTranspose) {
    COL_CHAIN_DO(A, const DOF_MATRIX) {
      if (mask) {
	__dof_gemv_d(transpose, alpha, A, mask, x, beta, y);
      } else {
	__dof_gemv_d(transpose, alpha, A, NULL, x, beta, y);
      }
      ROW_CHAIN_FOREACH(A_chain, A, const DOF_MATRIX) {
	x = CHAIN_NEXT(x, const DOF_REAL_D_VEC);
	if (mask) {
	  __dof_gemv_d(transpose, alpha, A_chain, mask, x, 1.0, y);
	} else {
	  __dof_gemv_d(transpose, alpha, A_chain, NULL, x, 1.0, y);
	}
      }
      x = CHAIN_NEXT(x, const DOF_REAL_D_VEC);
      y = CHAIN_NEXT(y, DOF_REAL_D_VEC);
      mask = mask ? CHAIN_NEXT(mask, DOF_SCHAR_VEC) : NULL;
    } COL_CHAIN_WHILE(A, const DOF_MATRIX);
  } else {
    ROW_CHAIN_DO(A, const DOF_MATRIX) {
      if (mask) {
	__dof_gemv_d(transpose, alpha, A, mask, x, beta, y);
      } else {
	__dof_gemv_d(transpose, alpha, A, NULL, x, beta, y);
      }
      COL_CHAIN_FOREACH(A_chain, A, const DOF_MATRIX) {
	x = CHAIN_NEXT(x, const DOF_REAL_D_VEC);
	if (mask) {
	  __dof_gemv_d(transpose, alpha, A_chain, mask, x, 1.0, y);
	} else {
	  __dof_gemv_d(transpose, alpha, A_chain, NULL, x, 1.0, y);
	}
      }
      x = CHAIN_NEXT(x, const DOF_REAL_D_VEC);
      y = CHAIN_NEXT(y, DOF_REAL_D_VEC);
      mask = mask ? CHAIN_NEXT(mask, DOF_SCHAR_VEC) : NULL;
    } ROW_CHAIN_WHILE(A, const DOF_MATRIX);
  }
}

/* Multiply a DOF_REAL_D_VEC with a DOF_MATRIX, which may consist of
 * scalar, diagonal or DOWxDOW blocks.
 */
FORCE_INLINE_ATTR
static inline
void __dof_mv_d(MatrixTranspose transpose,
		const DOF_MATRIX *a, const DOF_SCHAR_VEC *mask,
		const DOF_REAL_D_VEC *x, DOF_REAL_D_VEC *y)
{
  FUNCNAME("dof_mv_d");
  int             j, dof;
  REAL_D          sum;
  REAL_D          *xvec, *yvec;
  const DOF_ADMIN *m_admin, *y_admin, *x_admin;

  MV_TEST_AND_GET_ADMINS(a, x, y, m_admin, x_admin, y_admin);

  xvec = x->vec;
  yvec = y->vec;

  if (a->is_diagonal) {
    switch (a->type) {
    case MATENT_REAL:
      if (x_admin == y_admin) {
	FOR_ALL_DOFS(m_admin, {
	    if (mask == NULL || mask->vec[dof] < DIRICHLET) {
	      SCMVEQ_DOW(a->diagonal.real->vec[dof], xvec[dof], yvec[dof]);
	    }
	  });
      } else if (transpose == NoTranspose) {
	DOF *col_dofs = a->diag_cols->vec;
	FOR_ALL_DOFS(m_admin, {
	    DOF col_dof = col_dofs[dof];
	    if (ENTRY_USED(col_dof) &&
		(mask == NULL || mask->vec[dof] < DIRICHLET)) {
	      SCMVEQ_DOW(a->diagonal.real->vec[dof], xvec[col_dof], yvec[dof]);
	    }
	  });
      } else {	
	DOF *col_dofs = a->diag_cols->vec;
	FOR_ALL_DOFS(m_admin, {
	    DOF col_dof = col_dofs[dof];
	    if (ENTRY_USED(col_dof) &&
		(mask == NULL || mask->vec[col_dof] < DIRICHLET)) {
	      SCMVEQ_DOW(a->diagonal.real->vec[dof], xvec[dof], yvec[col_dof]);
	    }
	  });
      }
      break;
    case MATENT_REAL_D:
      if (x_admin == y_admin) {
	FOR_ALL_DOFS(m_admin, {
	    if (mask == NULL || mask->vec[dof] < DIRICHLET) {
	      DMVEQ_DOW(a->diagonal.real_d->vec[dof], xvec[dof], yvec[dof]);
	    }
	  });
      } else if (transpose == NoTranspose) {
	DOF *col_dofs = a->diag_cols->vec;
	FOR_ALL_DOFS(m_admin, {
	    DOF col_dof = col_dofs[dof];
	    if (ENTRY_USED(col_dof) &&
		(mask == NULL || mask->vec[dof] < DIRICHLET)) {
	      DMVEQ_DOW(a->diagonal.real_d->vec[dof], xvec[col_dof], yvec[dof]);
	    }
	  });
      } else {
	DOF *col_dofs = a->diag_cols->vec;
	FOR_ALL_DOFS(m_admin, {
	    DOF col_dof = col_dofs[dof];
	    if (ENTRY_USED(col_dof) &&
		(mask == NULL || mask->vec[col_dof] < DIRICHLET)) {
	      DMVEQ_DOW(a->diagonal.real_d->vec[dof], xvec[dof], yvec[col_dof]);
	    }
	  });
      }
      break;
    case MATENT_REAL_DD:
      if (x_admin == y_admin) {
	if (transpose == NoTranspose) {
	  FOR_ALL_DOFS(m_admin, {
	      if (mask == NULL || mask->vec[dof] < DIRICHLET) {
		MVEQ_DOW((const REAL_D *)a->diagonal.real_dd->vec[dof],
			 xvec[dof], yvec[dof]);
	      }
	    });
	} else {
	  FOR_ALL_DOFS(m_admin, {
	      if (mask == NULL || mask->vec[dof] < DIRICHLET) {
		MTVEQ_DOW((const REAL_D *)a->diagonal.real_dd->vec[dof],
			  xvec[dof], yvec[dof]);
	      }
	    });
	}
      } else {
	DOF *col_dofs = a->diag_cols->vec;
	if (transpose == NoTranspose) {
	  FOR_ALL_DOFS(m_admin, {
	      DOF col_dof = col_dofs[dof];
	      if (ENTRY_USED(col_dof) &&
		  (mask == NULL || mask->vec[dof] < DIRICHLET)) {
		MVEQ_DOW((const REAL_D *)a->diagonal.real_dd->vec[dof],
			 xvec[col_dof], yvec[dof]);
	      }
	    });
	} else {
	  FOR_ALL_DOFS(m_admin, {	
	      DOF col_dof = col_dofs[dof];
	      if (ENTRY_USED(col_dof) &&
		  (mask == NULL || mask->vec[col_dof] < DIRICHLET)) {
		MTVEQ_DOW((const REAL_D *)a->diagonal.real_dd->vec[dof],
			  xvec[dof], yvec[col_dof]);
	      }
	    });
	}
      }
      break;
    default:
      break;
    }
  } else if (transpose == NoTranspose) {
    int ysize = y->size;

    TEST_EXIT(m_admin == y_admin,
	      "matrix- and y-admins do not match: %p %p.\n",
	      m_admin, y_admin);

    FOR_ALL_FREE_DOFS(y_admin, if (dof < ysize) SET_DOW(0.0, yvec[dof]));

#undef MAT_BODY
#define MAT_BODY(F, CC, C, S, TYPE)				\
    for (dof = 0; dof < m_admin->size_used; dof++) {		\
      SET_DOW(0.0, sum);					\
      if (mask == NULL || mask->vec[dof] < DIRICHLET) {		\
	FOR_ALL_MAT_COLS(TYPE, a->matrix_row[dof],		\
			 F##V_DOW(CC row->entry[col_idx],	\
				  xvec[col_dof], sum));		\
      }								\
      COPY_DOW(sum, yvec[dof]);					\
    }
    MAT_EMIT_BODY_SWITCH(a->type);
  } else if (transpose == Transpose) {

    TEST_EXIT(m_admin == x_admin,
	      "matrix- and x-admins do not match: %p %p.\n",
	      m_admin, x_admin);

    for (j = 0; j < y_admin->size_used; j++) {
      SET_DOW(0.0, yvec[j]);
    }

#undef MAT_BODY	
#define MAT_BODY(F, CC, C, S, TYPE)					\
    for (dof = 0; dof < m_admin->size_used; dof++) {			\
      FOR_ALL_MAT_COLS(TYPE, a->matrix_row[dof],			\
		       if (mask == NULL || mask->vec[col_dof] < DIRICHLET) { \
			 F##TV_DOW(CC row->entry[col_idx],		\
				   xvec[dof],				\
				   yvec[col_dof]);			\
		       });						\
    }
    MAT_EMIT_BODY_SWITCH(a->type);
  } else {
    ERROR_EXIT("transpose=%d\n", transpose);
  }
}

FLATTEN_ATTR
void dof_mv_d(MatrixTranspose transpose,
	      const DOF_MATRIX *A, const DOF_SCHAR_VEC *mask,
	      const DOF_REAL_D_VEC *x, DOF_REAL_D_VEC *y)
{
  const DOF_MATRIX *A_chain;

  if (transpose == NoTranspose) {
    COL_CHAIN_DO(A, const DOF_MATRIX) {
      if (mask) {
	__dof_mv_d(transpose, A, mask, x, y);
      } else {
	__dof_mv_d(transpose, A, NULL, x, y);
      }
      ROW_CHAIN_FOREACH(A_chain, A, const DOF_MATRIX) {
	x = CHAIN_NEXT(x, const DOF_REAL_D_VEC);
	if (mask) {
	  __dof_gemv_d(transpose, 1.0, A, mask, x, 1.0, y);
	} else {
	  __dof_gemv_d(transpose, 1.0, A, NULL, x, 1.0, y);
	}
      }
      x = CHAIN_NEXT(x, const DOF_REAL_D_VEC);
      y = CHAIN_NEXT(y, DOF_REAL_D_VEC);
      mask = mask ? CHAIN_NEXT(mask, DOF_SCHAR_VEC) : NULL;
    } COL_CHAIN_WHILE(A, const DOF_MATRIX);
  } else {
    ROW_CHAIN_DO(A, const DOF_MATRIX) {
      if (mask) {
	__dof_mv_d(transpose, A, mask, x, y);
      } else {
	__dof_mv_d(transpose, A, NULL, x, y);
      }
      COL_CHAIN_FOREACH(A_chain, A, const DOF_MATRIX) {
	x = CHAIN_NEXT(x, const DOF_REAL_D_VEC);
	if (mask) {
	  __dof_gemv_d(transpose, 1.0, A_chain, mask, x, 1.0, y);
	} else {
	  __dof_gemv_d(transpose, 1.0, A_chain, NULL, x, 1.0, y);
	}
      }
      x = CHAIN_NEXT(x, const DOF_REAL_D_VEC);
      y = CHAIN_NEXT(y, DOF_REAL_D_VEC);
      mask = mask ? CHAIN_NEXT(mask, DOF_SCHAR_VEC) : NULL;
    } ROW_CHAIN_WHILE(A, const DOF_MATRIX);
  }
}

/* >>> */

/* <<< variable stride */

FORCE_INLINE_ATTR
static inline
void __dof_gemv_dow(MatrixTranspose transpose, REAL alpha,
		    const DOF_MATRIX *a, const DOF_SCHAR_VEC *mask,
		    const DOF_REAL_VEC_D *x, REAL beta, DOF_REAL_VEC_D *y)
{
  if (y->stride == 1) {
    __dof_gemv_scl_dow(transpose, alpha, a, mask, x, beta, (DOF_REAL_VEC *)y);
  } else if (x->stride == 1) {
    __dof_gemv_dow_scl(transpose, alpha, a, mask, (const DOF_REAL_VEC *)x,
		       beta, y);
  } else {
    __dof_gemv_d(transpose, alpha, a, mask, (const DOF_REAL_D_VEC *)x,
		 beta, (DOF_REAL_D_VEC *)y);
  }
}

FLATTEN_ATTR
void dof_gemv_dow(MatrixTranspose transpose, REAL alpha,
		  const DOF_MATRIX *A, const DOF_SCHAR_VEC *mask,
		  const DOF_REAL_VEC_D *x, REAL beta, DOF_REAL_VEC_D *y)
{
  const DOF_MATRIX *A_chain;

  if (transpose == NoTranspose) {
    COL_CHAIN_DO(A, const DOF_MATRIX) {
      if (mask) {
	__dof_gemv_dow(transpose, alpha, A, mask, x, beta, y);
      } else {
	__dof_gemv_dow(transpose, alpha, A, NULL, x, beta, y);
      }
      ROW_CHAIN_FOREACH(A_chain, A, const DOF_MATRIX) {
	x = CHAIN_NEXT(x, const DOF_REAL_VEC_D);
	if (mask) {
	  __dof_gemv_dow(transpose, alpha, A_chain, mask, x, 1.0, y);
	} else {
	  __dof_gemv_dow(transpose, alpha, A_chain, NULL, x, 1.0, y);
	}
      }
      x = CHAIN_NEXT(x, const DOF_REAL_VEC_D);
      y = CHAIN_NEXT(y, DOF_REAL_VEC_D);
      mask = mask ? CHAIN_NEXT(mask, DOF_SCHAR_VEC) : NULL;
    } COL_CHAIN_WHILE(A, const DOF_MATRIX);
  } else {
    ROW_CHAIN_DO(A, const DOF_MATRIX) {
      if (mask) {
	__dof_gemv_dow(transpose, alpha, A, mask, x, beta, y);
      } else {
	__dof_gemv_dow(transpose, alpha, A, NULL, x, beta, y);
      }
      COL_CHAIN_FOREACH(A_chain, A, const DOF_MATRIX) {
	x = CHAIN_NEXT(x, const DOF_REAL_VEC_D);
	if (mask) {
	  __dof_gemv_dow(transpose, alpha, A_chain, mask, x, 1.0, y);
	} else {
	  __dof_gemv_dow(transpose, alpha, A_chain, NULL, x, 1.0, y);
	}
      }
      x = CHAIN_NEXT(x, const DOF_REAL_VEC_D);
      y = CHAIN_NEXT(y, DOF_REAL_VEC_D);
      mask = mask ? CHAIN_NEXT(mask, DOF_SCHAR_VEC) : NULL;
    } ROW_CHAIN_WHILE(A, const DOF_MATRIX);
  }
}

FORCE_INLINE_ATTR
static inline
void __dof_mv_dow(MatrixTranspose transpose,
		  const DOF_MATRIX *a, const DOF_SCHAR_VEC *mask,
		  const DOF_REAL_VEC_D *x, DOF_REAL_VEC_D *y)
{
  if (y->stride == 1) {
    __dof_mv_scl_dow(transpose, a, mask, x, (DOF_REAL_VEC *)y);
  } else if (x->stride == 1) {
    __dof_mv_dow_scl(transpose, a, mask, (const DOF_REAL_VEC *)x, y);
  } else {
    __dof_mv_d(transpose, a, mask,
	       (const DOF_REAL_D_VEC *)x, (DOF_REAL_D_VEC *)y);
  }
}

FLATTEN_ATTR
void dof_mv_dow(MatrixTranspose transpose,
		const DOF_MATRIX *A, const DOF_SCHAR_VEC *mask,
		const DOF_REAL_VEC_D *x, DOF_REAL_VEC_D *y)
{
  const DOF_MATRIX *A_chain;
  
  if (transpose == NoTranspose) {
    COL_CHAIN_DO(A, const DOF_MATRIX) {
      if (mask) {
	__dof_mv_dow(transpose, A, mask, x, y);
      } else {
	__dof_mv_dow(transpose, A, NULL, x, y);
      }
      ROW_CHAIN_FOREACH(A_chain, A, const DOF_MATRIX) {
      	x = CHAIN_NEXT(x, const DOF_REAL_VEC_D);
	if (mask) {
	  __dof_gemv_dow(transpose, 1.0, A_chain, mask, x, 1.0, y);
	} else {
	  __dof_gemv_dow(transpose, 1.0, A_chain, NULL, x, 1.0, y);
	}
      }
      x = CHAIN_NEXT(x, const DOF_REAL_VEC_D);
      y = CHAIN_NEXT(y, DOF_REAL_VEC_D);
      mask = mask ? CHAIN_NEXT(mask, DOF_SCHAR_VEC) : NULL;
    } COL_CHAIN_WHILE(A, const DOF_MATRIX);
  } else {
    ROW_CHAIN_DO(A, const DOF_MATRIX) {
      if (mask) {
	__dof_mv_dow(transpose, A, mask, x, y);
      } else {
	__dof_mv_dow(transpose, A, NULL, x, y);
      }
      COL_CHAIN_FOREACH(A_chain, A, const DOF_MATRIX) {
	x = CHAIN_NEXT(x, const DOF_REAL_VEC_D);
	if (mask) {
	  __dof_gemv_dow(transpose, 1.0, A_chain, mask, x, 1.0, y);
	} else {
	  __dof_gemv_dow(transpose, 1.0, A_chain, NULL, x, 1.0, y);
	}
      }
      x = CHAIN_NEXT(x, const DOF_REAL_VEC_D);
      y = CHAIN_NEXT(y, DOF_REAL_VEC_D);
      mask = mask ? CHAIN_NEXT(mask, DOF_SCHAR_VEC) : NULL;
    } ROW_CHAIN_WHILE(A, const DOF_MATRIX);
  }
}

/* >>> */

/* >>> */

/*--------------------------------------------------------------------------*/

/*--------------------------------------------------------------------------*/
/*  print_dof_matrix: print matrix in compressed format                     */
/*--------------------------------------------------------------------------*/

static inline
void __print_dof_matrix_row_real(const DOF_MATRIX *matrix, int i)
{
  FUNCNAME("print_dof_matrix");
  int  j, jcol;
  MATRIX_ROW *row;
  
  if (matrix->is_diagonal) {
    if (i < matrix->diagonal.real->size) {
      MSG("row %3d: (%d, %.8e)", i, i, matrix->diagonal.real->vec[i]);
    }
    return;
  }
  for (row = matrix->matrix_row[i]; row; row = row->next) {
    MSG("row %3d:", i);
    for (j=0; j<ROW_LENGTH; j++) {
      jcol = row->col[j];
      if (ENTRY_USED(jcol)) {
	print_msg(" (%3d, %.8e)", jcol, row->entry.real[j]);
      } else if (jcol == NO_MORE_ENTRIES) {
	break;
      }
    }
    print_msg("\n");
    if (jcol == NO_MORE_ENTRIES) {
      break;
    }
  }
}

static inline
void __print_dof_matrix_real(const DOF_MATRIX *matrix)
{
  FUNCNAME("print_dof_matrix");
  int  i;

  if (matrix->is_diagonal) {
    print_dof_real_vec(matrix->diagonal.real);
  } else for (i = 0; i < matrix->size; i++) {
    __print_dof_matrix_row_real(matrix, i);
  }
}

static inline
void __print_dof_matrix_row_real_d(const DOF_MATRIX *matrix, int i)
{
  FUNCNAME("print_dof_rdr_matrix");
  int  j, jcol;
  MATRIX_ROW *row;

  if (matrix->is_diagonal) {
    if (i < matrix->diagonal.real_d->size) {
      MSG("row %3d: (%d, "FORMAT_DOW")\n",
	  i, i, EXPAND_DOW(matrix->diagonal.real_d->vec[i]));
    }
  } else for (row = matrix->matrix_row[i]; row; row = row->next) {
    MSG("row %3d:",i);
    for (j=0; j<ROW_LENGTH; j++) {
      jcol = row->col[j];
      if (ENTRY_USED(jcol)) {
	print_msg(" (%3d, "FORMAT_DOW")",
		    jcol, EXPAND_DOW(row->entry.real_d[j]));
      } else if (jcol == NO_MORE_ENTRIES) {
	break;
      }
    }
    print_msg("\n");
    if (jcol == NO_MORE_ENTRIES) {
      break;
    }
  }
}

static inline
void __print_dof_matrix_real_d(const DOF_MATRIX *matrix)
{
  FUNCNAME("print_dof_rdr_matrix");
  int  i;

  if (matrix->is_diagonal) {
    print_dof_real_d_vec(matrix->diagonal.real_d);
  } else for (i= 0; i < matrix->size; i++) { 
    __print_dof_matrix_row_real_d(matrix, i);
  }
}

static inline
void __print_dof_matrix_row_real_dd(const DOF_MATRIX *matrix, int i)
{
  FUNCNAME("print_dof_matrix");
  int  j, jcol, n, m;
  MATRIX_ROW *row;

  if (matrix->is_diagonal) {
    if (i < matrix->diagonal.real_d->size) {
      MSG("row %3d: (%d, "MFORMAT_DOW")\n",
	  i, i, MEXPAND_DOW(matrix->diagonal.real_dd->vec[i]));
    }
  } else if (matrix->matrix_row[i]) {
    for (n = 0; n < DIM_OF_WORLD; n++) {
      if (n == 0) {
	MSG("row %3d:",i);
      } else {
	MSG("        ");
      }
      for (row = matrix->matrix_row[i]; row; row = row->next) {
	for (j=0; j<ROW_LENGTH; j++) {
	  jcol = row->col[j];
	  if (ENTRY_USED(jcol)) {
	    if (n == 0) {
	      print_msg(" |%3d", jcol);
	    } else {
	      print_msg(" |   ");
	    }
	    for (m = 0; m < DIM_OF_WORLD; m++) {
	      print_msg(" % .2e", row->entry.real_dd[j][n][m]);
	    }
	  } else if (jcol == NO_MORE_ENTRIES) {
	    break;
	  }
	}
	if (jcol == NO_MORE_ENTRIES) {
	  break;
	}
      }
      print_msg("\n");
    }
  }
}

static inline
void __print_dof_matrix_real_dd(const DOF_MATRIX *matrix)
{
  FUNCNAME("print_dof_matrix");
  int  i;

  if (matrix->is_diagonal) {
    print_dof_real_dd_vec(matrix->diagonal.real_dd);
  } else for (i= 0 ; i < matrix->size; i++) { 
    __print_dof_matrix_row_real_dd(matrix, i);
  }
}

static inline
void __print_dof_matrix_row(const DOF_MATRIX *matrix, int row)
{
  FUNCNAME("print_dof_matrix");
  
  switch (matrix->type) {
  case MATENT_REAL:
    __print_dof_matrix_row_real(matrix, row); break;
  case MATENT_REAL_D:
    __print_dof_matrix_row_real_d(matrix, row); break;
  case MATENT_REAL_DD:
    __print_dof_matrix_row_real_dd(matrix, row); break;
  case MATENT_NONE:
    MSG("Attempt to print uninitialized dof-matrix.");
    break;
  default:
    ERROR_EXIT("Unknown MATENT_TYPE: %d\n", matrix->type);
    break;
  }
}

static inline
void __print_dof_matrix(const DOF_MATRIX *matrix)
{
  FUNCNAME("print_dof_matrix");
  
  switch (matrix->type) {
  case MATENT_REAL:
    __print_dof_matrix_real(matrix); break;
  case MATENT_REAL_D:
    __print_dof_matrix_real_d(matrix); break;
  case MATENT_REAL_DD:
    __print_dof_matrix_real_dd(matrix); break;
  case MATENT_NONE:
    MSG("Attempt to print uninitialized dof-matrix.");
    break;
  default:
    ERROR_EXIT("Unknown MATENT_TYPE: %d\n", matrix->type);
    break;
  }
}

void print_dof_matrix(const DOF_MATRIX *matrix)
{
  FUNCNAME("print_dof_matrix");
  int i, j;

  i = 0;
  COL_CHAIN_DO(matrix, const DOF_MATRIX) {
    j = 0;
    ROW_CHAIN_DO(matrix, const DOF_MATRIX) {
      if (!COL_CHAIN_SINGLE(matrix) || !ROW_CHAIN_SINGLE(matrix)) {
	MSG("BLOCK(%d,%d):\n", i , j);
      }
      __print_dof_matrix(matrix);
      ++j;
    } ROW_CHAIN_WHILE(matrix, const DOF_MATRIX);
    ++i;
  } COL_CHAIN_WHILE(matrix, const DOF_MATRIX);
}

void print_dof_matrix_row(const DOF_MATRIX *matrix, int i)
{
  FUNCNAME("print_dof_matrix_row");
  int j;

  j = 0;
  ROW_CHAIN_DO(matrix, const DOF_MATRIX) {
    if (!COL_CHAIN_SINGLE(matrix) || !ROW_CHAIN_SINGLE(matrix)) {
      MSG("BLOCK(%d):\n", j);
    }
    __print_dof_matrix_row(matrix, i);
    ++j;
  } ROW_CHAIN_WHILE(matrix, const DOF_MATRIX);
}

static inline
void __print_dof_real_vec(const DOF_REAL_VEC *drv)
{
  FUNCNAME("print_dof_real_vec");
  int  i, j;
  const DOF_ADMIN *admin = NULL;
  const char *format;

  if (drv->fe_space) admin = drv->fe_space->admin;

  MSG("Vec `%s':\n", drv->name);
  j = 0;
  if (admin)
  {
    if (admin->size_used > 100)
      format = "%s(%3d,%10.5le)";
    else if (admin->size_used > 10)
      format = "%s(%2d,%10.5le)";
    else
      format = "%s(%1d,%10.5le)";

    FOR_ALL_DOFS(admin,
		 if ((j % 3) == 0) {
                   if (j) print_msg("\n");
		   MSG(format, "", dof, drv->vec[dof]);
                 }
		 else 
		   print_msg(format, " ", dof, drv->vec[dof]);
		 j++;
      );
    print_msg("\n");
  }
  else
  {
    MSG("no DOF_ADMIN, print whole vector.\n");
    
    for (i = 0; i < drv->size; i++) {
      if ((j % 3) == 0)
      {
	if (j) print_msg("\n");
	MSG("(%d,%10.5le)",i,drv->vec[i]);
      }
      else 
	print_msg(" (%d,%10.5le)",i,drv->vec[i]);
      j++;
    }
    print_msg("\n");
  }
  return;
}

void print_dof_real_vec(const DOF_REAL_VEC *vec)
{
  FUNCNAME("print_dof_real_vec");
  int i;
  
  i = 0;
  CHAIN_DO(vec, const DOF_REAL_VEC) {
    if (!CHAIN_SINGLE(vec)) {
      MSG("BLOCK(%d):\n", i);
    }
    __print_dof_real_vec(vec);
    ++i;
  } CHAIN_WHILE(vec, const DOF_REAL_VEC);
}

static inline
void __print_dof_real_d_vec(const DOF_REAL_D_VEC *drdv)
{
  FUNCNAME("print_dof_real_d_vec");
  int         i, j, k;
  const DOF_ADMIN   *admin = NULL;
#if DIM_OF_WORLD < 2
  static int  per_line = 4;
#elif DIM_OF_WORLD < 4
  static int  per_line = 2;
#else
  static int  per_line = 1;
#endif

  if (drdv->fe_space) admin = drdv->fe_space->admin;

  MSG("Vec `%s':\n", drdv->name);
  j = 0;
  if (admin)
  {
    FOR_ALL_DOFS(admin,
		 if ((j % per_line) == 0) {
		   if (j) print_msg("\n");
		   MSG("(%3d:",dof);
                 }
		 else 
		   print_msg(" (%3d:", dof);
		 for (k=0; k<DIM_OF_WORLD; k++)
		   print_msg("%c%10.5le", (k > 0 ? ',':' '), drdv->vec[dof][k]);
		 print_msg(")");
		 j++;
      );	 
    print_msg("\n");
  }
  else
  {
    MSG("no DOF_ADMIN, print whole vector.\n");
    
    for (i = 0; i < drdv->size; i++) {
      if ((j % per_line) == 0)
      {
	if (j) print_msg("\n");
	MSG("(%3d:",i);
      }
      else 
	print_msg(" (%3d:", i);
      for (k=0; k<DIM_OF_WORLD; k++)
	print_msg("%c%10.5le", (k > 0 ? ',':' '), drdv->vec[i][k]);
      print_msg(")");
    }
    print_msg("\n");
  }
  return;
}

void print_dof_real_d_vec(const DOF_REAL_D_VEC *vec)
{
  
  FUNCNAME("print_dof_real_d_vec");
  int i;
  
  i = 0;
  CHAIN_DO(vec, const DOF_REAL_D_VEC) {
    if (!CHAIN_SINGLE(vec)) {
      MSG("BLOCK(%d):\n", i);
    }
    __print_dof_real_d_vec(vec);
    ++i;
  } CHAIN_WHILE(vec, const DOF_REAL_D_VEC);
}

void print_dof_real_vec_dow(const DOF_REAL_VEC_D *vec)
{
  FUNCNAME("print_dof_real_vec_dow");
  int i;
  
  i = 0;
  CHAIN_DO(vec, const DOF_REAL_VEC_D) {
    if (!CHAIN_SINGLE(vec)) {
      MSG("BLOCK(%d):\n", i);
    }
    if (vec->stride != 1) {
      __print_dof_real_d_vec((const DOF_REAL_D_VEC *)vec);
    } else{
      __print_dof_real_vec((const DOF_REAL_VEC *)vec);
    }
    ++i;
  } CHAIN_WHILE(vec, const DOF_REAL_VEC_D);
}

static inline
void __print_dof_real_dd_vec(const DOF_REAL_DD_VEC *drdv)
{
  FUNCNAME("print_dof_real_dd_vec");
  int i;
  const DOF_ADMIN *admin = NULL;

  if (drdv->fe_space) admin = drdv->fe_space->admin;

  MSG("Vec `%s':\n", drdv->name);
  if (admin) {
    FOR_ALL_DOFS(admin, {
	MSG("(%3d: "MFORMAT_DOW")\n", dof, MEXPAND_DOW(drdv->vec[dof]));
      });
  } else {
    MSG("no DOF_ADMIN, print whole vector.\n");
    
    for (i = 0; i < drdv->size; i++) {
      MSG("(%3d: "MFORMAT_DOW")\n", i, MEXPAND_DOW(drdv->vec[i]));
    }
  }
}

void print_dof_real_dd_vec(const DOF_REAL_DD_VEC *vec)
{
  FUNCNAME("print_dof_real_dd_vec");
  int i;
  
  i = 0;
  CHAIN_DO(vec, const DOF_REAL_DD_VEC) {
    if (!CHAIN_SINGLE(vec)) {
      MSG("BLOCK(%d):\n", i);
    }
    __print_dof_real_dd_vec(vec);
    ++i;
  } CHAIN_WHILE(vec, const DOF_REAL_DD_VEC);
}

void print_real_vec_maple(REAL *vector, int size, const char *vec_name)
{
  fprint_real_vec_maple(stdout, vector, size, vec_name);
}

void print_dof_real_vec_maple(const DOF_REAL_VEC *vec, const char *vec_name)
{
  if (vec_name == NULL)
    vec_name = vec->name;
	
  fprint_dof_real_vec_maple(stdout, vec, vec_name);
}

void print_dof_real_d_vec_maple(const DOF_REAL_D_VEC *vec, const char *vec_name)
{
  if (vec_name == NULL)
    vec_name = vec->name;
	
  fprint_dof_real_d_vec_maple(stdout, vec, vec_name);
}

void print_dof_real_vec_dow_maple(const DOF_REAL_VEC_D *vec, const char *vec_name)
{
  if (vec_name == NULL)
    vec_name = vec->name;
	
  fprint_dof_real_vec_dow_maple(stdout, vec, vec_name);
}

void print_dof_matrix_maple(const DOF_MATRIX *matrix, const char *matrix_name)
{
  if (matrix_name == NULL)
    matrix_name = matrix->name;
	
  fprint_dof_matrix_maple(stdout, matrix, matrix_name);
}


void fprint_real_vec_maple(FILE *fp, REAL *vector, int size, const char *vec_name)
{	
  int i;
  char _vec_name[24];
	

  if (vec_name == NULL) {
    sprintf(_vec_name, "REAL_VEC");
    vec_name = _vec_name;
  }

  fprintf(fp, "\n#REAL_VEC \"%s\" in maple-format:\n\n", vec_name);
  fflush(fp);

  fprintf(fp, "%s:=Vector(%d,proc(i) 0 end):\n\n", vec_name, size);
  fflush(fp);
	
  for (i = 0; i < size; i++)
  {
    fprintf(fp, "   %s[%d]:=%.17e:\n", vec_name, i+1, vector[i]);
    fflush(fp);
  }
  fprintf(fp, "\n%s:=Vector([%s]);\n\n\n\n\n", vec_name, vec_name);
  fflush(fp);
}

void fprint_dof_real_vec_maple(FILE *fp, const DOF_REAL_VEC *vec, const char *vec_name)
{
  fprint_dof_real_vec_dow_maple(fp, (const DOF_REAL_VEC_D *)vec, vec_name);
}

void fprint_dof_real_d_vec_maple(FILE *fp, const DOF_REAL_D_VEC *vec, const char *vec_name)
{
  fprint_dof_real_vec_dow_maple(fp, (const DOF_REAL_VEC_D *)vec, vec_name);
}

void fprint_dof_real_vec_dow_maple(FILE *fp,
				   const DOF_REAL_VEC_D *_vec,
				   const char *vec_name)
{
  char Chain_name[24];
	
  int i, k, bdim = 0;
  if (vec_name == NULL)
    vec_name = _vec->name;

  fprintf(fp, "\n#DOF_REAL_VEC_D %s in maple-format:\n\n", vec_name);
  fflush(fp);

	  
  i = 0;
  CHAIN_DO(_vec, const DOF_REAL_VEC_D) {
    int count = 0;
    int dim = 0;
    fprintf(fp, "%s", vec_name);
    fflush(fp);
    *Chain_name = '\0';
    if (!CHAIN_SINGLE(_vec))
      sprintf(Chain_name,"_Chain%d", i);
    if (_vec->stride != 1) {
      const DOF_REAL_D_VEC *vec = (const DOF_REAL_D_VEC *)_vec;
      dim = DIM_OF_WORLD*vec->fe_space->admin->size_used;
      fprintf(fp, "%s", Chain_name);
      fprintf(fp, ":=Vector(%d,proc(i) 0 end):\n\n", dim);
      fflush(fp);
	    	
      FOR_ALL_DOFS(vec->fe_space->admin,
		   for (k = 0; k < DIM_OF_WORLD; k++) {
		     fprintf(fp, "   ");
		     fprintf(fp, "%s", vec_name);
		     fprintf(fp, "%s", Chain_name);
		     fprintf(fp, "[%d]:=%.17e:\n", count+1, vec->vec[dof][k]);
	    		    	
		     count++;
		   }
		   fflush(fp);
	);
      fprintf(fp, "\n\n\n\n");
      fflush(fp);
    } else {
      const DOF_REAL_VEC *vec = (const DOF_REAL_VEC *)_vec;
      dim = vec->fe_space->admin->size_used;
      fprintf(fp, "%s", Chain_name);
      fprintf(fp, ":=Vector(%d,proc(i) 0 end):\n\n", dim);
      fflush(fp);
	    	
      FOR_ALL_DOFS(vec->fe_space->admin,
		   fprintf(fp, "   ");
		   fprintf(fp, "%s", vec_name);
		   fprintf(fp, "%s", Chain_name);
		   fprintf(fp, "[%d]:=%.17e:\n", dof+1, vec->vec[dof]);
		   fflush(fp);
	);

      fprintf(fp, "\n\n\n\n");
      fflush(fp);
    }
    ++i;
    bdim += dim;
  } CHAIN_WHILE(_vec, const DOF_REAL_VEC_D);
	  
  /* output as blockvector */
  fprintf(fp, "%s", vec_name);
  fprintf(fp, ":=Vector([");
  for (k = 0; k < i; k++) {
    if (k != 0)
      fprintf(fp, ",");
    fprintf(fp, "%s", vec_name);
    if (i >= 2)
      fprintf(fp, "_Chain%d", k);
  }
  fprintf(fp, "]);\n");
  fprintf(fp, "\n\n\n\n\n");
  fflush(fp);

}


void fprint_dof_matrix_maple(FILE *fp, const DOF_MATRIX *matrix, const char *matrix_name)
{
  FUNCNAME("fprint_dof_matrix_maple");


  if (matrix_name == NULL)
    matrix_name = matrix->name;

	

  fprintf(fp, "\n");
  fprintf(fp, "#DOF_MATRIX ");
  fprintf(fp, "%s", matrix_name);
  fprintf(fp, " in maple-format:\n\n");
  fflush(fp);
	
	

	
  int  i, j, k, l, n, m, row_shift, col_shift;
  n = 0;
  COL_CHAIN_DO(matrix, const DOF_MATRIX) {
    m = 0;
    ROW_CHAIN_DO(matrix, const DOF_MATRIX) {

      int row_dim = matrix->row_fe_space->admin->size_used;
      int col_dim = matrix->col_fe_space->admin->size_used;

      switch (matrix->type) {
      case MATENT_REAL:
	if ((matrix->row_fe_space->rdim == DIM_OF_WORLD) && (matrix->col_fe_space->rdim == DIM_OF_WORLD) &&
	    (matrix->row_fe_space->bas_fcts->rdim == 1) && (matrix->col_fe_space->bas_fcts->rdim == 1))
	{
	  if (matrix->row_fe_space == matrix->col_fe_space) {
	    fprintf(fp, "%s", matrix_name);
	    	    		
	    if (!COL_CHAIN_SINGLE(matrix) || !ROW_CHAIN_SINGLE(matrix))
	      fprintf(fp, "_Chain%d%d", n, m);
	    fprintf(fp, ":=Matrix(%d,%d,proc(i,j) if i<>j then 0; else 1; end; end):\n\n",
		    DIM_OF_WORLD*row_dim, DIM_OF_WORLD*col_dim);
	    fflush(fp);
	  } else {
	    fprintf(fp, "%s", matrix_name);
	    	    		
	    if (!COL_CHAIN_SINGLE(matrix) || !ROW_CHAIN_SINGLE(matrix)) {
	      fprintf(fp, "_Chain%d%d", n, m);
	    }
	    fprintf(fp, ":=Matrix(%d,%d,proc(i,j) 0 end):\n\n",
		    DIM_OF_WORLD*row_dim, DIM_OF_WORLD*col_dim);
	    fflush(fp);
	  }
	  row_shift = 0;

          if (matrix->is_diagonal) {
            for (i = 0; i < matrix->row_fe_space->admin->size_used; i++) {
              row_shift = i*DIM_OF_WORLD;
              col_shift = row_shift;
              fprintf(fp, "   ");
              fprintf(fp, "%s", matrix_name);
              if (!COL_CHAIN_SINGLE(matrix) || !ROW_CHAIN_SINGLE(matrix))
                fprintf(fp, "_Chain%d%d", n, m);
              fprintf(fp, "[%d,%d]:=%.17e:\n", j + row_shift + 1, j + col_shift + 1, matrix->diagonal.real->vec[i]);
              fflush(fp);
              fprintf(fp, "\n");
              fflush(fp);
            }
          } else {            
            for (i = 0; i < matrix->size; i++) {
              row_shift = i*DIM_OF_WORLD;
              FOR_ALL_MAT_COLS(REAL, matrix->matrix_row[i], {
                  col_shift = col_dof*DIM_OF_WORLD;
                  for (j = 0; j < DIM_OF_WORLD; j++){
                    fprintf(fp, "   ");
                    fprintf(fp, "%s", matrix_name);
                    if (!COL_CHAIN_SINGLE(matrix) || !ROW_CHAIN_SINGLE(matrix))
                      fprintf(fp, "_Chain%d%d", n, m);
                    fprintf(fp, "[%d,%d]:=%.17e:\n", j + row_shift + 1, j + col_shift + 1, row->entry[col_idx]);
                  }
                  fflush(fp);
                });
              if (matrix->matrix_row[i] != NULL) {
                fprintf(fp, "\n");
                fflush(fp);
              }
            }
          }
	} else {
	  if (matrix->row_fe_space == matrix->col_fe_space) {
	    fprintf(fp, "%s", matrix_name);
	    if (!COL_CHAIN_SINGLE(matrix) || !ROW_CHAIN_SINGLE(matrix))
	      fprintf(fp, "_Chain%d%d", n, m);
	    fprintf(fp, ":=Matrix(%d,%d,proc(i,j) if i<>j then 0; else 1; end; end):\n\n",
		    row_dim, col_dim);
	    fflush(fp);
	  } else {
	    fprintf(fp, "%s", matrix_name);
	    if (!COL_CHAIN_SINGLE(matrix) || !ROW_CHAIN_SINGLE(matrix))
	      fprintf(fp, "_Chain%d%d", n, m);
	    fprintf(fp, ":=Matrix(%d,%d,proc(i,j) 0 end):\n\n",
		    row_dim, col_dim);
	    fflush(fp);
	  }
          if (matrix->is_diagonal) {
            for (i = 0; i < matrix->row_fe_space->admin->size_used; i++) {
              fprintf(fp, "   ");
              fprintf(fp, "%s", matrix_name);
              if (!COL_CHAIN_SINGLE(matrix) || !ROW_CHAIN_SINGLE(matrix))
                fprintf(fp, "_Chain%d%d", n, m);
              fprintf(fp, "[%d,%d]:=%.17e:\n", i+1, i+1, matrix->diagonal.real->vec[i]);
              fflush(fp);
              fprintf(fp, "\n");
              fflush(fp);
            }
          } else {
            for (i = 0; i < matrix->size; i++) {
              FOR_ALL_MAT_COLS(REAL, matrix->matrix_row[i], {
                  fprintf(fp, "   ");
                  fprintf(fp, "%s", matrix_name);
                  if (!COL_CHAIN_SINGLE(matrix) || !ROW_CHAIN_SINGLE(matrix))
                    fprintf(fp, "_Chain%d%d", n, m);
                  fprintf(fp, "[%d,%d]:=%.17e:\n", i+1, col_dof+1, row->entry[col_idx]);
                  fflush(fp);
                });
              if (matrix->matrix_row[i] != NULL) {
                fprintf(fp, "\n");
                fflush(fp);
              }
            }
          }
	}
	break;
      case MATENT_REAL_D:
	if ((matrix->row_fe_space->rdim == DIM_OF_WORLD &&
	     matrix->col_fe_space->rdim == 1)
	    ||
	    (matrix->row_fe_space->rdim == DIM_OF_WORLD &&
	     matrix->col_fe_space->rdim == DIM_OF_WORLD &&
	     matrix->col_fe_space->bas_fcts->rdim == DIM_OF_WORLD)) {
	  fprintf(fp, "%s", matrix_name);
	  if (!COL_CHAIN_SINGLE(matrix) || !ROW_CHAIN_SINGLE(matrix))
	    fprintf(fp, "_Chain%d%d", n, m);
	  fprintf(fp, ":=Matrix(%d,%d,proc(i,j) 0 end):\n\n",
		  DIM_OF_WORLD*row_dim, col_dim);
	  fflush(fp);
          if (matrix->is_diagonal) {
            for (i = 0; i < matrix->row_fe_space->admin->size_used; i++) {
              for (k = 0; k < DIM_OF_WORLD; k++) {
                fprintf(fp, "   ");
                fprintf(fp, "%s", matrix_name);
                if (!COL_CHAIN_SINGLE(matrix) || !ROW_CHAIN_SINGLE(matrix))
                  fprintf(fp, "_Chain%d%d", n, m);
                fprintf(fp, "[%d,%d]:=%.17e:\n",
                        i*DIM_OF_WORLD+1+k, i+1, matrix->diagonal.real_d->vec[i][k]);
              }
              fprintf(fp, "\n");
              fflush(fp);
            }
          } else {
            for (i = 0; i < matrix->size; i++) {
              FOR_ALL_MAT_COLS(REAL_D, matrix->matrix_row[i], {
                  for (k = 0; k < DIM_OF_WORLD; k++) {
                    fprintf(fp, "   ");
                    fprintf(fp, "%s", matrix_name);
                    if (!COL_CHAIN_SINGLE(matrix) || !ROW_CHAIN_SINGLE(matrix))
                      fprintf(fp, "_Chain%d%d", n, m);
                    fprintf(fp, "[%d,%d]:=%.17e:\n",
                            i*DIM_OF_WORLD+1+k, col_dof+1, row->entry[col_idx][k]);
                  }
                  fflush(fp);
                });
              if (matrix->matrix_row[i] != NULL) {
                fprintf(fp, "\n");
                fflush(fp);
              }
            }
	  }
	} else if ((matrix->row_fe_space->rdim == 1 &&
		    matrix->col_fe_space->rdim == DIM_OF_WORLD)
		   ||
		   (matrix->row_fe_space->rdim == DIM_OF_WORLD &&
		    matrix->row_fe_space->bas_fcts->rdim == DIM_OF_WORLD &&
		    matrix->col_fe_space->rdim == DIM_OF_WORLD)) {
	  fprintf(fp, "%s", matrix_name);
	  if (!COL_CHAIN_SINGLE(matrix) || !ROW_CHAIN_SINGLE(matrix))
	    fprintf(fp, "_Chain%d%d", n, m);
	  fprintf(fp, ":=Matrix(%d,%d,proc(i,j) 0 end):\n\n",
		  row_dim, col_dim*DIM_OF_WORLD);
	  fflush(fp);
          if (matrix->is_diagonal) {
            for (i = 0; i < matrix->row_fe_space->admin->size_used; i++) {
              for (k = 0; k < DIM_OF_WORLD; k++) {
                fprintf(fp, "   ");
                fprintf(fp, "%s", matrix_name);
                if (!COL_CHAIN_SINGLE(matrix) || !ROW_CHAIN_SINGLE(matrix))
                  fprintf(fp, "_Chain%d%d", n, m);
                fprintf(fp, "[%d,%d]:=%.17e:\n",
                        i+1, i*DIM_OF_WORLD+1+k, matrix->diagonal.real_d->vec[i][k]);
              }
              fprintf(fp, "\n");
              fflush(fp);
            }
          } else {
            for (i = 0; i < matrix->size; i++) {
              FOR_ALL_MAT_COLS(REAL_D, matrix->matrix_row[i], {
                  for (k = 0; k < DIM_OF_WORLD; k++) {
                    fprintf(fp, "   ");
                    fprintf(fp, "%s", matrix_name);
                    if (!COL_CHAIN_SINGLE(matrix) || !ROW_CHAIN_SINGLE(matrix))
                      fprintf(fp, "_Chain%d%d", n, m);
                    fprintf(fp, "[%d,%d]:=%.17e:\n",
                            i+1, col_dof*DIM_OF_WORLD+1+k, row->entry[col_idx][k]);
                  }
                  fflush(fp);
                });
              if (matrix->matrix_row[i] != NULL) {
                fprintf(fp, "\n");
                fflush(fp);
              }
            }
          }
	}
	break;
      case MATENT_REAL_DD:
	fprintf(fp, "%s", matrix_name);
	if (!COL_CHAIN_SINGLE(matrix) || !ROW_CHAIN_SINGLE(matrix))
	  fprintf(fp, "_Chain%d%d", n, m);
	fprintf(fp, ":=Matrix(%d,%d,proc(i,j) 0 end):\n\n",
		row_dim*DIM_OF_WORLD, col_dim*DIM_OF_WORLD);
	fflush(fp);
        if (matrix->is_diagonal) {
          for (i = 0; i < matrix->row_fe_space->admin->size_used; i++) {
            for (k = 0; k < DIM_OF_WORLD; k++) {
              for (l = 0; l < DIM_OF_WORLD; l++) {
                fprintf(fp, "   ");
                fprintf(fp, "%s", matrix_name);
                if (!COL_CHAIN_SINGLE(matrix) || !ROW_CHAIN_SINGLE(matrix))
                  fprintf(fp, "_Chain%d%d", n, m);
                fprintf(fp, "[%d,%d]:=%.17e:\n",
                        i*DIM_OF_WORLD+1+k, i*DIM_OF_WORLD+1+l, matrix->diagonal.real_dd->vec[i][k][l]);
              }
            }
            fprintf(fp, "\n");
            fflush(fp);
          }
        } else {
          for (i = 0; i < matrix->size; i++) {
            FOR_ALL_MAT_COLS(REAL_DD, matrix->matrix_row[i], {
                for (k = 0; k < DIM_OF_WORLD; k++) {
                  for (l = 0; l < DIM_OF_WORLD; l++) {
                    fprintf(fp, "   ");
                    fprintf(fp, "%s", matrix_name);
                    if (!COL_CHAIN_SINGLE(matrix) || !ROW_CHAIN_SINGLE(matrix))
                      fprintf(fp, "_Chain%d%d", n, m);
                    fprintf(fp, "[%d,%d]:=%.17e:\n",
                            i*DIM_OF_WORLD+1+k, col_dof*DIM_OF_WORLD+1+l,
                            row->entry[col_idx][k][l]);
                  }
                }
                fflush(fp);
              });
            if (matrix->matrix_row[i] != NULL) {
              fprintf(fp, "\n");
              fflush(fp);
            }
          }
	}
	break;
      default:
	ERROR("Unknown matrix type: %d\n", matrix->type);
      }
      fprintf(fp, "\n");
      fflush(fp);
	  
      ++m;
    } ROW_CHAIN_WHILE(matrix, const DOF_MATRIX);
    ++n;
  } COL_CHAIN_WHILE(matrix, const DOF_MATRIX);
	  
  /* output as blockmatrix */
  fprintf(fp, "%s", matrix_name);
  fprintf(fp, ":=Matrix([");
  for (i = 0; i < n; i++) {
    if (i != 0)
      fprintf(fp, ",");
    fprintf(fp, "[");
    for (j = 0; j < m; j++) {
      if (j != 0)
	fprintf(fp, ",");
      fprintf(fp, "evalm(");
      fprintf(fp, "%s", matrix_name);
      if ((n >= 2)||(m >= 2))
	fprintf(fp, "_Chain%d%d", i, j);
      fprintf(fp, ")");
    }
    fprintf(fp, "]");
  }
  fprintf(fp, "]);\n");
  fprintf(fp, "\n\n\n\n\n");
  fflush(fp);

}


void file_print_real_vec_maple(const char *file_name,
			       const char *mode,
			       REAL *vector, int size, const char *vec_name)
{
  FILE *fp;

  fp = fopen(file_name, mode);
  fprint_real_vec_maple(fp, vector, size, vec_name);
  fclose(fp);
}

void file_print_dof_real_vec_maple(const char *file_name,
				   const char *mode,
				   const DOF_REAL_VEC *vec,
				   const char *vec_name)
{
  if (vec_name == NULL)
    vec_name = vec->name;
	
  FILE *fp;

  fp = fopen(file_name, mode);
  fprint_dof_real_vec_maple(fp, vec, vec_name);
  fclose(fp);
}

void file_print_dof_real_d_vec_maple(const char *file_name,
				     const char *mode,
				     const DOF_REAL_D_VEC *vec,
				     const char *vec_name)
{
  if (vec_name == NULL)
    vec_name = vec->name;
	
  FILE *fp;

  fp = fopen(file_name, mode);
  fprint_dof_real_d_vec_maple(fp, vec, vec_name);
  fclose(fp);
}

void file_print_dof_real_vec_dow_maple(const char *file_name,
				       const char *mode,
				       const DOF_REAL_VEC_D *vec,
				       const char *vec_name)
{
  if (vec_name == NULL)
    vec_name = vec->name;
	
  FILE *fp;

  fp = fopen(file_name, mode);
  fprint_dof_real_vec_dow_maple(fp, vec, vec_name);
  fclose(fp);
}

void file_print_dof_matrix_maple(const char *file_name,
				 const char *mode,
				 const DOF_MATRIX *matrix,
				 const char *matrix_name)
{
  if (matrix_name == NULL)
    matrix_name = matrix->name;
	
  FILE *fp;

  fp = fopen(file_name, mode);
  fprint_dof_matrix_maple(fp, matrix, matrix_name);
  fclose(fp);
}


static inline
void __print_dof_ptr_vec(const DOF_PTR_VEC *dpv)
{
  FUNCNAME("print_dof_ptr_vec");
  int       i, j;
  const DOF_ADMIN *admin = NULL;
  const char *format;

  if (dpv->fe_space) admin = dpv->fe_space->admin;

  MSG("Vector `%s':\n", dpv->name);
  j = 0;


  if (admin) {
    if (admin->size_used > 100)
      format = "%s(%3d,%p)";
    else if (admin->size_used > 10)
      format = "%s(%2d,%p)";
    else
      format = "%s(%1d,%p)";

    FOR_ALL_DOFS(admin,
		 if ((j % 5) == 0)
		 {
		   if (j) print_msg("\n");
		   MSG(format, "", dof,dpv->vec[dof]);
		 }
		 else 
		   print_msg(format, " ",dof,dpv->vec[dof]);
		 j++;
      );
    print_msg("\n");
  }
  else {
    if (dpv->size > 100)
      format = "%s(%3d,%p)";
    else if (dpv->size > 10)
      format = "%s(%2d,%p)";
    else
      format = "%s(%1d,%p)";

    for (i = 0; i < dpv->size; i++) {
      if ((j % 5) == 0)
      {
	if (j) print_msg("\n");
	MSG(format, "", i, dpv->vec[i]);
      }
      else 
	print_msg(format, " ", i, dpv->vec[i]);
      j++;
    }
    print_msg("\n");
  }
  return;
}

void print_dof_ptr_vec(const DOF_PTR_VEC *vec)
{
  
  FUNCNAME("print_dof_ptr_vec");
  int i;
  
  i = 0;
  CHAIN_DO(vec, const DOF_PTR_VEC) {
    if (!CHAIN_SINGLE(vec)) {
      MSG("BLOCK(%d):\n", i);
    }
    __print_dof_ptr_vec(vec);
    ++i;
  } CHAIN_WHILE(vec, const DOF_PTR_VEC);
}

static inline
void __print_dof_int_vec(const DOF_INT_VEC *div)
{
  FUNCNAME("print_dof_int_vec");
  int       i, j;
  const DOF_ADMIN *admin = NULL;
  const char *format;

  if (div->fe_space) admin = div->fe_space->admin;

  MSG("Vector `%s':\n", div->name);
  j = 0;
  if (admin) {
    if (admin->size_used > 100)
      format = "%s(%3d,%3d)";
    else if (admin->size_used > 10)
      format = "%s(%2d,%3d)";
    else
      format = "%s(%1d,%3d)";

    FOR_ALL_DOFS(admin,
		 if ((j % 5) == 0)
		 {
		   if (j) print_msg("\n");
		   MSG(format, "", dof,div->vec[dof]);
		 }
	         else 
		   print_msg(format, " ", dof, div->vec[dof]);
	         j++;
      );
    print_msg("\n");
  }
  else {
    if (div->size > 100)
      format = "%s(%3d,%3d)";
    else if (div->size > 10)
      format = "%s(%2d,%3d)";
    else
      format = "%s(%1d,%3d)";

    for (i = 0; i < div->size; i++) {
      if ((j % 5) == 0)
      {
	if (j) print_msg("\n");
	MSG(format, "", i, div->vec[i]);
      }
      else 
	print_msg(format, " ", i, div->vec[i]);
      j++;
    }
    print_msg("\n");
  }
  return;
}

void print_dof_int_vec(const DOF_INT_VEC *vec)
{
  
  FUNCNAME("print_dof_int_vec");
  int i;
  
  i = 0;
  CHAIN_DO(vec, const DOF_INT_VEC) {
    if (!CHAIN_SINGLE(vec)) {
      MSG("BLOCK(%d):\n", i);
    }
    __print_dof_int_vec(vec);
    ++i;
  } CHAIN_WHILE(vec, const DOF_INT_VEC);
}

static inline
void __print_dof_uchar_vec(const DOF_UCHAR_VEC *duv)
{
  FUNCNAME("print_dof_uchar_vec");
  int  i, j;
  const DOF_ADMIN *admin = NULL;
  const char *format;

  if (duv->fe_space) admin = duv->fe_space->admin;

  MSG("Vector `%s':\n", duv->name);
  j = 0;

  if (admin) {
    if (admin->size_used > 100)
      format = "%s(%3d,0x%02X)";
    else if (admin->size_used > 10)
      format = "%s(%2d,0x%02X)";
    else
      format = "%s(%1d,0x%02X)";

    FOR_ALL_DOFS(admin,
		 if ((j % 5) == 0) {
		   if (j) print_msg("\n");
		   MSG(format, "", dof, duv->vec[dof]);
		 }
		 else 
		   print_msg(format, " ", dof, duv->vec[dof]);
		 j++;
      );
    print_msg("\n");
  }
  else {
    if (duv->size > 100)
      format = "%s(%3d,0x%20X)";
    else if (duv->size > 10)
      format = "%s(%2d,0x%02X)";
    else
      format = "%s(%1d,0x%02X)";

    for (i = 0; i < duv->size; i++) {
      if ((j % 5) == 0)
      {
	if (j) print_msg("\n");
	MSG(format, "", i, duv->vec[i]);
      }
      else 
	print_msg(format, " ", i, duv->vec[i]);
      j++;
    }
    print_msg("\n");
  }
  return;
}

void print_dof_uchar_vec(const DOF_UCHAR_VEC *vec)
{
  
  FUNCNAME("print_dof_uchar_vec");
  int i;
  
  i = 0;
  CHAIN_DO(vec, const DOF_UCHAR_VEC) {
    if (!CHAIN_SINGLE(vec)) {
      MSG("BLOCK(%d):\n", i);
    }
    __print_dof_uchar_vec(vec);
    ++i;
  } CHAIN_WHILE(vec, const DOF_UCHAR_VEC);
}

static inline
void __print_dof_schar_vec(const DOF_SCHAR_VEC *dsv)
{
  FUNCNAME("print_dof_schar_vec");
  int       i, j;
  const DOF_ADMIN *admin = NULL;
  const char *format;

  if (dsv->fe_space) admin = dsv->fe_space->admin;

  MSG("Vector `%s':\n", dsv->name);
  j = 0;


  if (admin) {
    if (admin->size_used > 100)
      format = "%s(%3d,0x%02X)";
    else if (admin->size_used > 10)
      format = "%s(%2d,0x%02X)";
    else
      format = "%s(%1d,0x%02X)";

    FOR_ALL_DOFS(admin,
		 if ((j % 5) == 0)
		 {
		   if (j) print_msg("\n");
		   MSG(format, "", dof, dsv->vec[dof] & 0xFF);
		 }
		 else 
		   print_msg(format, " ", dof, dsv->vec[dof]  & 0xFF);
		 j++;
      );
    print_msg("\n");
  }
  else {
    if (dsv->size > 100)
      format = "%s(%3d,0x%02X)";
    else if (dsv->size > 10)
      format = "%s(%2d,0x%02X)";
    else
      format = "%s(%1d,0x%02X)";

    for (i = 0; i < dsv->size; i++) {
      if ((j % 5) == 0)
      {
	if (j) print_msg("\n");
	MSG(format, "", i, dsv->vec[i]  & 0xFF);
      }
      else 
	print_msg(format, " ", i, dsv->vec[i] & 0xFF);
      j++;
    }
    print_msg("\n");
  }
  return;
}

void print_dof_schar_vec(const DOF_SCHAR_VEC *vec)
{
  
  FUNCNAME("print_dof_schar_vec");
  int i;
  
  i = 0;
  CHAIN_DO(vec, const DOF_SCHAR_VEC) {
    if (!CHAIN_SINGLE(vec)) {
      MSG("BLOCK(%d):\n", i);
    }
    __print_dof_schar_vec(vec);
    ++i;
  } CHAIN_WHILE(vec, const DOF_SCHAR_VEC);
}

/*--------------------------------------------------------------------------*/
/*  clear_dof_matrix: remove all entries from dof_matrix                    */
/*--------------------------------------------------------------------------*/

static inline void _AI_clear_dof_matrix_single(DOF_MATRIX *matrix)
{
  int        i;
  MATRIX_ROW *row, *next;

  if (!matrix->is_diagonal) {
    if (matrix->matrix_row) {
      for (i=0; i < matrix->size; i++) {
	for (row = matrix->matrix_row[i]; row; row = next) {
	  next = row->next;
	  free_matrix_row(matrix->row_fe_space, row);
	}
	matrix->matrix_row[i] = NULL;
      }
    }
  } else {
    if (matrix->diagonal.real) {
      MAT_SWITCH_TYPE(matrix->type,
		      free_dof_real_dd_vec(matrix->diagonal.real_dd),
		      free_dof_real_d_vec(matrix->diagonal.real_d),
		      free_dof_real_vec(matrix->diagonal.real));
      matrix->diagonal.real = NULL;
      if (matrix->unchained) {
	((DOF_MATRIX *)matrix->unchained)->diagonal.real = NULL;
      }
    }
    if (matrix->inv_diag.real) {
      MAT_SWITCH_TYPE(matrix->type,
		      free_dof_real_dd_vec(matrix->inv_diag.real_dd),
		      free_dof_real_d_vec(matrix->inv_diag.real_d),
		      free_dof_real_vec(matrix->inv_diag.real));
      matrix->inv_diag.real = NULL;
      if (matrix->unchained) {
	((DOF_MATRIX *)matrix->unchained)->inv_diag.real = NULL;
      }
    }
    FOR_ALL_DOFS(matrix->row_fe_space->admin,
		 matrix->diag_cols->vec[dof] = UNUSED_ENTRY);
  }
  matrix->type = MATENT_NONE; /* set by add_element_matrix() as required */
  matrix->n_entries = 0;
}

void clear_dof_matrix(DOF_MATRIX *matrix)
{
  COL_CHAIN_DO(matrix, DOF_MATRIX) {
    ROW_CHAIN_DO(matrix, DOF_MATRIX) {
      _AI_clear_dof_matrix_single(matrix);
    } ROW_CHAIN_WHILE(matrix, DOF_MATRIX);
  } COL_CHAIN_WHILE(matrix, DOF_MATRIX);
}

/* Initialize new DOFs to UNUSED_ENTRY, and also mark the (now unused)
 * parental DOF as UNUSED_ENTRY.
 */
static void refine_diag_cols(DOF_INT_VEC *vec, RC_LIST_EL *rclist, int n)
{
  const DOF_ADMIN *admin = vec->fe_space->admin;
  int n0, node, n_dofs;
  int i;

  node   = admin->mesh->node[CENTER];
  n0     = admin->n0_dof[CENTER];
  n_dofs = admin->n_dof[CENTER];

  for (i = 0; i < n; i++) {
    int j, k;
    EL *ch, *el;
    el = rclist[i].el_info.el;
    for (j = 0; j < 2; j++) {
      ch = el->child[j];
      for (k = 0; k < n_dofs; k++) {
	DOF dof = ch->dof[node][n0+k];
	vec->vec[dof] = UNUSED_ENTRY;
      }
    }
    for (k = 0; k < n_dofs; k++) {
      DOF dof = el->dof[node][n0+k];
      vec->vec[dof] = UNUSED_ENTRY;
    }
  }
}

void dof_matrix_set_diagonal(DOF_MATRIX *matrix, bool diag)
{
  matrix->is_diagonal = diag;
  if (matrix->is_diagonal) {
    if (matrix->matrix_row) {
      MEM_FREE(matrix->matrix_row, matrix->size, MATRIX_ROW *);
      matrix->matrix_row = NULL;
    }
    if (matrix->diag_cols == NULL) {
      matrix->diag_cols = get_dof_int_vec("diag cols", matrix->row_fe_space);
      matrix->diag_cols->refine_interpol = refine_diag_cols;
      FOR_ALL_DOFS(matrix->row_fe_space->admin,
		   matrix->diag_cols->vec[dof] = UNUSED_ENTRY);
    }
  } else {
    if (matrix->matrix_row == NULL) {
      matrix->matrix_row = MEM_CALLOC(matrix->size, MATRIX_ROW *);
    }
    if (matrix->diag_cols) {
      free_dof_int_vec(matrix->diag_cols);
      matrix->diag_cols = NULL;
    }
  }
}

/* Set parts of a DOF_MATRIX chain to "diagonal", if the undlerlying
 * spaces have exactly one DOF per element which belongs to the
 * interior.
 */
void dof_matrix_try_diagonal(DOF_MATRIX *matrix)
{
  COL_CHAIN_DO(matrix, DOF_MATRIX) {
    ROW_CHAIN_DO(matrix, DOF_MATRIX) {
      const FE_SPACE *row_fe_space = matrix->row_fe_space;
      const FE_SPACE *col_fe_space = matrix->col_fe_space;
      if (row_fe_space->admin->n_dof[CENTER] == 1 &&
          row_fe_space->admin->n_dof[VERTEX] == 0 &&
          row_fe_space->admin->n_dof[EDGE] == 0 &&
          row_fe_space->admin->n_dof[FACE] == 0 &&
          (col_fe_space == NULL ||
           (col_fe_space->admin->n_dof[CENTER] == 1 &&
            col_fe_space->admin->n_dof[VERTEX] == 0 &&
            col_fe_space->admin->n_dof[EDGE] == 0 &&
            col_fe_space->admin->n_dof[FACE] == 0))) {
        dof_matrix_set_diagonal(matrix, true);
      }
    } ROW_CHAIN_WHILE(matrix, DOF_MATRIX);
  } COL_CHAIN_WHILE(matrix, DOF_MATRIX);  
}

/*--------------------------------------------------------------------------*/
/*  test_dof_matrix                                                         */
/*--------------------------------------------------------------------------*/

void test_dof_matrix(DOF_MATRIX *matrix)
{
  FUNCNAME("test_dof_matrix");
  int  i, j, jcol, k,kcol;
  MATRIX_ROW  *row, *row2;
  int         non_symmetric, found;
  MATENT_TYPE type = matrix->type;
  REAL sum;

  /* test symmetry */
  non_symmetric = 0;
  for (i=0; i<matrix->size; i++) { 
    sum = 0.0;
    for (row = matrix->matrix_row[i]; row; row = row->next) {
      for (j=0; j<ROW_LENGTH; j++) {
	jcol = row->col[j];
	if (ENTRY_USED(jcol)) {
	  found = 0;
	  for (row2 = matrix->matrix_row[jcol]; row2;
	       row2 = row2 ? row2->next : NULL) {
	    for (k=0; k<ROW_LENGTH; k++) {
	      kcol = row2->col[k];
	      if (ENTRY_USED(kcol)) {
		if (kcol==i) {
		  found = 1;
		  switch (type) {
		  case MATENT_REAL_DD:
		    if (MDST2_DOW((const REAL_D *)row2->entry.real_dd[k],
				  (const REAL_D *)row->entry.real_dd[j])
			> 1.E-10) {
		      non_symmetric = 1;
		      MSG("mat[%d,%d]="MFORMAT_DOW \
			  " != mat[%d,%d]="MFORMAT_DOW"\n",
			  i, jcol, MEXPAND_DOW(row->entry.real_dd[j]),
			  jcol, i, MEXPAND_DOW(row2->entry.real_dd[k]));
		    }
		    row2 = NULL;
		    break;
		  case MATENT_REAL_D:
		    if (DST2_DOW(row2->entry.real_d[k],
				 row->entry.real_d[j]) > 1.E-10) {
		      non_symmetric = 1;
		      MSG("mat[%d,%d]="DMFORMAT_DOW \
			  " != mat[%d,%d]="DMFORMAT_DOW"\n",
			  i, jcol, DMEXPAND_DOW(row->entry.real_d[j]),
			  jcol, i, DMEXPAND_DOW(row2->entry.real_d[k]));
		    }
		    row2 = NULL;
		    break;
		  case MATENT_REAL:
		    if (fabs(row2->entry.real[k]
			     -
			     row->entry.real[j]) > 1.E-10) {
		      non_symmetric = 1;
		      MSG("mat[%d,%d]="SCMFORMAT_DOW \
			  " != mat[%d,%d]="SCMFORMAT_DOW"\n",
			  i, jcol, SCMEXPAND_DOW(row->entry.real[j]),
			  jcol, i, SCMEXPAND_DOW(row2->entry.real[k]));
		    }
		    row2 = NULL;
		    break;
		  default:
		    ERROR_EXIT("Unknown or invalid MATENT_TYPE: %d\n",
			       matrix->type);
		  }
		  if (row2 == NULL) {
		    break;
		  }
		}
	      }
	    }
	  }
	  if (!found) {
	    non_symmetric = 1;
	    MSG("mat[%d,%d] not found\n",jcol,i);
	  }
	}
      }
      if (ABS(sum) > 1.E-5) {
	MSG("Row sum[%d] = %10.5le\n", i, sum);
      }
    }
  }
  if (non_symmetric) {
    MSG("matrix `%s' not symmetric.\n",matrix->name);
    WAIT;
  }
  else {
    MSG("matrix `%s' is symmetric.\n",matrix->name);
  }
  return;
}

/*--------------------------------------------------------------------------*/
/*   the new update routines:                                               */
/*--------------------------------------------------------------------------*/

FORCE_INLINE_ATTR
static inline void _AI_add_element_matrix(DOF_MATRIX *matrix,
					  MATENT_TYPE mat_type,
					  REAL factor,
					  const EL_MATRIX *el_matrix,
					  MATENT_TYPE elm_type,
					  bool transpose,
					  const EL_DOF_VEC *row_dof,
					  const EL_DOF_VEC *col_dof,
					  const EL_SCHAR_VEC *bound);

FORCE_INLINE_ATTR
static inline bool __AI_check_matrix_types(MATENT_TYPE mat_type,
					   MATENT_TYPE elm_type)
{
  FUNCNAME("add_element_matrix");
  bool result = false;
  
  if (mat_type == MATENT_NONE) {
    return true;
  }

  switch (mat_type) {
  case MATENT_REAL:
    result = (elm_type == MATENT_REAL);
    DEBUG_TEST_EXIT(result,
		    "Trying to add non-scalar element matrix "
		    "to scalar DOF_MATRIX\n");
    break;
  case MATENT_REAL_D:
    result = (elm_type == MATENT_REAL_D || elm_type == MATENT_REAL);
    DEBUG_TEST_EXIT(result,
		    "Trying to add REAL_DD element matrix to non-REAL_DD "
		    "DOF_MATRIX\n");
    break;
  case MATENT_REAL_DD:
    result = (elm_type == MATENT_REAL ||
	      elm_type == MATENT_REAL_D ||
	      elm_type == MATENT_REAL_DD);
    if (!result) {
      ERROR_EXIT("Unsupported MATENT-type %d in element matrix\n",
		 elm_type);
    }
    break;
  default:
    ERROR_EXIT("Unsupported MATENT-type %d in DOF_MATRIX\n", mat_type);
    break;
  }
  return result;
}

bool _AI_check_matrix_types(MATENT_TYPE mat_type, MATENT_TYPE elm_type)
{
  return __AI_check_matrix_types(mat_type, elm_type);
}

FORCE_INLINE_ATTR
static inline void
_AI_add_element_matrix_single(DOF_MATRIX *matrix,
			      REAL factor,
			      const EL_MATRIX *el_matrix,
			      MatrixTranspose transpose,
			      const EL_DOF_VEC   *row_dof,
			      const EL_DOF_VEC   *col_dof,
			      const EL_SCHAR_VEC *bound)
{
  FUNCNAME("add_element_matrix_single");
  bool tr = (transpose == Transpose);

  if (matrix->type == MATENT_NONE) {
    matrix->type = el_matrix->type;
  }

  if (!__AI_check_matrix_types(matrix->type, el_matrix->type)) {
    ERROR_EXIT("Non-matching matrix/element-matrix type");
  }

  switch (matrix->type) {
  case MATENT_REAL:
    _AI_add_element_matrix(matrix, MATENT_REAL,
			   factor, el_matrix, MATENT_REAL, tr,
			   row_dof, col_dof, bound);
    break;
  case MATENT_REAL_D:
    if (el_matrix->type == MATENT_REAL) {
      _AI_add_element_matrix(matrix, MATENT_REAL_D,
			     factor, el_matrix, MATENT_REAL, tr,
			     row_dof, col_dof, bound);
    } else {
      _AI_add_element_matrix(matrix, MATENT_REAL_D,
			     factor, el_matrix, MATENT_REAL_D, tr,
			     row_dof, col_dof, bound);
    }
    break;
  case MATENT_REAL_DD:
    switch (el_matrix->type) {
    case MATENT_REAL:
      _AI_add_element_matrix(matrix, MATENT_REAL_DD,
			     factor, el_matrix, MATENT_REAL, tr,
			     row_dof, col_dof, bound);
      break;
    case MATENT_REAL_D:
      _AI_add_element_matrix(matrix, MATENT_REAL_DD,
			     factor, el_matrix, MATENT_REAL_D, tr,
			     row_dof, col_dof, bound);
      break;
    case MATENT_REAL_DD:
      _AI_add_element_matrix(matrix, MATENT_REAL_DD,
			     factor, el_matrix, MATENT_REAL_DD, tr,
			     row_dof, col_dof, bound);
      break;
    default:
      break;
    }
  default:
    break;
  }
}

FORCE_INLINE_ATTR
static inline void _AI_add_element_matrix(DOF_MATRIX *matrix,
					  MATENT_TYPE mat_type,
					  REAL factor,
					  const EL_MATRIX *el_mat,
					  MATENT_TYPE elm_type,
					  bool transpose,
					  const EL_DOF_VEC *row_dof_vec,
					  const EL_DOF_VEC *col_dof_vec,
					  const EL_SCHAR_VEC *bound_vec)
{
  FUNCNAME("_AI_add_element_matrix");
  DOF           i, j, I, J, k, irow, jcol;
  int           free_col = 0, n_row, n_col;
  REAL_DD       *const*el_mat_dd = el_mat->data.real_dd;
  REAL_D        *const*el_mat_d  = el_mat->data.real_d;
  REAL          *const*el_mat_s  = el_mat->data.real;
  const DOF     *row_dof;
  const DOF     *col_dof;
  const S_CHAR  *bound;
  MATRIX_ROW    *row, *free_row;
  bool          same_space = false;

  DEBUG_TEST_EXIT(matrix, "no matrix\n");

  if (transpose) {
    n_row = el_mat->n_col;
    n_col = el_mat->n_row;
  } else {
    n_row = el_mat->n_row;
    n_col = el_mat->n_col;
  }

  if (n_col == 0 || n_row == 0) {
    return;
  }

  row_dof = row_dof_vec->vec;
  bound   = bound_vec ? bound_vec->vec : NULL;

  if (!col_dof_vec || n_col < 0) {
    col_dof = row_dof;
    n_col = n_row;
    same_space = true;
  } else {
    col_dof = col_dof_vec->vec;
    same_space = (row_dof_vec == col_dof_vec);
  }

  if (matrix->is_diagonal) {
#if 0
    DEBUG_TEST_EXIT(matrix->col_fe_space == NULL ||
		    fe_space_is_eq(matrix->row_fe_space, matrix->col_fe_space),
		    "Diagonal matrices are only supported if "
		    "row_fe_space == col_fe_space.\n");
#else
    DEBUG_TEST_EXIT(matrix->row_fe_space->admin->n_dof[CENTER] == 1 &&
		    matrix->row_fe_space->admin->n_dof[VERTEX] == 0 &&
		    matrix->row_fe_space->admin->n_dof[EDGE] == 0 &&
		    matrix->row_fe_space->admin->n_dof[FACE] == 0 &&
		    (matrix->col_fe_space == NULL ||
		     (matrix->col_fe_space->admin->n_dof[CENTER] == 1 &&
		      matrix->col_fe_space->admin->n_dof[VERTEX] == 0 &&
		      matrix->col_fe_space->admin->n_dof[EDGE] == 0 &&
		      matrix->col_fe_space->admin->n_dof[FACE] == 0)),
		    "Incompatible FE-space for diagonal matrix.\n");
#endif
    DEBUG_TEST_EXIT(n_col == 1 && n_row == 1,
		    "This matrix \"%s\" is structurally non-diagonal\n",
                    matrix->name);

    if (matrix->diagonal.real == NULL) {
      switch (mat_type) {
      case MATENT_REAL:
	matrix->diagonal.real = get_dof_real_vec(
	  "matrix diagonal", matrix->row_fe_space->unchained);
	dof_set(0.0, matrix->diagonal.real);
	break;
      case MATENT_REAL_D:
	matrix->diagonal.real_d = get_dof_real_d_vec(
	  "matrix diagonal", matrix->row_fe_space->unchained);
	dof_set_d(0.0, matrix->diagonal.real_d);
	break;
      case MATENT_REAL_DD:
	matrix->diagonal.real_dd = get_dof_real_dd_vec(
	  "matrix diagonal", matrix->row_fe_space->unchained);
	dof_set_dd(0.0, matrix->diagonal.real_dd);
	break;
      default:
	break;
      }
      if (matrix->unchained) {
	((DOF_MATRIX *)matrix->unchained)->diagonal.real =
	  matrix->diagonal.real;
      }
      matrix->n_entries = matrix->row_fe_space->admin->used_count;
    }
    
    irow = row_dof[0];
    jcol = col_dof[0];

    matrix->diag_cols->vec[irow] = jcol;
      
    if (bound && bound[0] >= DIRICHLET) {
      switch (mat_type) {
      case MATENT_REAL:
	matrix->diagonal.real->vec[irow] = 1.0;
	break;
      case MATENT_REAL_D:
	DMSET_DOW(1.0, matrix->diagonal.real_d->vec[irow]);
	break;
      case MATENT_REAL_DD:
	DMSET_DOW(1.0, matrix->diagonal.real_d->vec[irow]);
	break;
      default:
	break;
      }
      return;
    }

    if (factor == 0.0) {
      return;
    }

    switch (mat_type) {
    case MATENT_REAL:
      switch (elm_type) {
      case MATENT_REAL:
	matrix->diagonal.real->vec[irow] += factor * el_mat->data.real[0][0];
	break;
      default:
	ERROR_EXIT("Unknown or invalid MATENT_TYPE (%d)\n", elm_type);
	break;
      }	
      break;
    case MATENT_REAL_D:
      switch (elm_type) {
      case MATENT_REAL:
	DMSCMAXPY_DOW(factor, el_mat->data.real[0][0],
		      matrix->diagonal.real_d->vec[irow]);
	break;
      case MATENT_REAL_D:
	AXPY_DOW(factor, el_mat->data.real_d[0][0],
		 matrix->diagonal.real_d->vec[irow]);
	break;
      default:
	ERROR_EXIT("Unknown or invalid MATENT_TYPE (%d)\n", elm_type);
	break;
      }
      break;
    case MATENT_REAL_DD:
      switch (elm_type) {
      case MATENT_REAL_DD:
	if (transpose) {
	  MMAXTPY_DOW(factor, (const REAL_D *)el_mat->data.real_dd[0][0],
		      matrix->diagonal.real_dd->vec[irow]);
	} else {	
	  MMAXPY_DOW(factor, (const REAL_D *)el_mat->data.real_dd[0][0],
		     matrix->diagonal.real_dd->vec[irow]);
	}
	break;
      case MATENT_REAL_D:
	MDMAXPY_DOW(factor, (const REAL *)el_mat->data.real_d[0][0],
		    matrix->diagonal.real_dd->vec[irow]);
	break;
      case MATENT_REAL:
	MSCMAXPY_DOW(factor, el_mat->data.real[0][0],
		     matrix->diagonal.real_dd->vec[irow]);
	break;
      default:
	ERROR_EXIT("Unknown or invalid MATENT_TYPE (%d)\n", elm_type);
	break;
      }
      break;
    default:
      break;
    }

    return;
  }

  /* NOTE: if row_dof != col_dof DIRICHLET rows are simply skipped.
   */
    
  for (i = 0; i < n_row; i++) {
    irow = row_dof[i];

    if (matrix->matrix_row[irow] == NULL) {
      if (same_space) {
	row = matrix->matrix_row[irow] =
	  get_matrix_row(matrix->row_fe_space, mat_type);
	row->col[0] = irow;           /* first entry is diagonal element */
	++matrix->n_entries;
	if (bound && bound[i] >= DIRICHLET) {
#undef MAT_BODY
#define MAT_BODY(F, CC, C, S, TYPE) F##SET_DOW(1.0, row->entry.S[0])
	  MAT_EMIT_BODY_SWITCH(mat_type);
	  continue; /* done with this row */
	} else {
#undef MAT_BODY
#define MAT_BODY(F, CC, C, S, TYPE) F##SET_DOW(0.0, row->entry.S[0])
	  MAT_EMIT_BODY_SWITCH(mat_type);
	}
      } else {
	if (bound && bound[i] >= DIRICHLET) {
	  continue;
	}
	row = matrix->matrix_row[irow] =
	  get_matrix_row(matrix->row_fe_space, mat_type);
	row->col[0] = UNUSED_ENTRY;
      }
    } else if (bound && bound[i] >= DIRICHLET) {
      continue;
    }

    if (factor == 0.0) {
      continue;
    }

    for (j = 0; j < n_col; j++) {

      if (transpose) {
	I = j; J = i;
      } else {
	I = i; J = j;
      }

#if 1
      /* Omit zero entries (???) Should we? */
# undef MAT_BODY
# define MAT_BODY(F, CC, C, S, TYPE)			\
      if (F##CMP_DOW(0.0, CC el_mat->data.S[I][J])) {	\
	continue;					\
      }
      MAT_EMIT_BODY_SWITCH(elm_type);
#endif

      jcol = col_dof[j];
      row = matrix->matrix_row[irow];
      free_row = NULL;
      do {
	/* <<< add entries */
	for (k=0; k < ROW_LENGTH; k++) {
	  if (row->col[k] == jcol) {
	    switch(mat_type) {
	    case MATENT_REAL_DD:
	      switch (elm_type) {
	      case MATENT_REAL_DD:
		if (transpose) { /* don't forget to transpose the blocks */
		  MMAXTPY_DOW(factor, (const REAL_D *)el_mat_dd[I][J],
			      row->entry.real_dd[k]);
		} else {
		  MMAXPY_DOW(factor, (const REAL_D *)el_mat_dd[I][J],
			     row->entry.real_dd[k]);
		}
		break;
	      case MATENT_REAL_D:
		MDMAXPY_DOW(factor, el_mat_d[I][J], row->entry.real_dd[k]);
		break;
	      case MATENT_REAL:
		MSCMAXPY_DOW(factor, el_mat_s[I][J], row->entry.real_dd[k]);
		break;
	      default:
		ERROR_EXIT("Unknown MATENT_TYPE (%d)\n", elm_type);
		break;
	      }
	      break;
	    case MATENT_REAL_D:
	      switch (elm_type) {
	      case MATENT_REAL_D:
		DMDMAXPY_DOW(factor, el_mat_d[I][J], row->entry.real_d[k]);
		break;
	      case MATENT_REAL:
		DMSCMAXPY_DOW(factor, el_mat_s[I][J], row->entry.real_d[k]);
		break;
	      default:
		ERROR_EXIT("Unknown or invalid MATENT_TYPE (%d)\n", elm_type);
		break;
	      }
	      break;
	    case MATENT_REAL:
	      SCMSCMAXPY_DOW(factor, el_mat_s[I][J], row->entry.real[k]);
	      break;
	    default:
	      ERROR_EXIT("Unknown or invalid MATENT_TYPE (%d)\n", elm_type);
	      break;
	    }
	    break; /* for-loop break */
	  }
	  if (ENTRY_NOT_USED(row->col[k])) {
	    free_col = k;
	    free_row = row;
	    if (row->col[k] == NO_MORE_ENTRIES) {
	      k = ROW_LENGTH;
	      break;
	    }
	  }
	}
	/* >>> */
	if (k < ROW_LENGTH) { /* done? */
	  break;
	}
	/* <<< allocate memory if necessary */
	if (row->next || free_row) {
	  row = row->next;
	} else {
	  free_row =
	    row->next = get_matrix_row(matrix->row_fe_space, mat_type);
	  free_col = 0;
	  row = NULL;
	}
	/* >>> */
      } while (row);
      
      if (k >= ROW_LENGTH) { /* not done? */
	/* <<< occupy new column slot */
	free_row->col[free_col] = jcol;
	++matrix->n_entries;
	switch (mat_type) {
	case MATENT_REAL_DD:
	  switch (elm_type) {
	  case MATENT_REAL_DD:
	    MMAXEY_DOW(factor, (const REAL_D *)el_mat_dd[I][J],
		       free_row->entry.real_dd[free_col]);
	    break;
	  case MATENT_REAL_D:
	    MDMAXEY_DOW(factor, el_mat_d[I][J],
			free_row->entry.real_dd[free_col]);
	    break;
	  case MATENT_REAL:
	    MSCMAXEY_DOW(factor, el_mat_s[I][J],
			 free_row->entry.real_dd[free_col]);
	    break;
	  default:
	    ERROR_EXIT("Unknown MATENT_TYPE (%d)\n", elm_type);
	    break;
	  }
	  break;
	case MATENT_REAL_D:
	  switch (elm_type) {
	  case MATENT_REAL_D:
	    DMDMAXEY_DOW(factor, el_mat_d[I][J],
			 free_row->entry.real_d[free_col]);
	    break;
	  case MATENT_REAL:
	    DMSCMAXEY_DOW(factor, el_mat_s[I][J],
			  free_row->entry.real_d[free_col]);
	    break;
	  default:
	    ERROR_EXIT("Unknown or invalid MATENT_TYPE (%d)\n", elm_type);
	    break;
	  }
	  break;
	case MATENT_REAL:
	  SCMSCMAXEY_DOW(factor, el_mat_s[I][J],
			 free_row->entry.real[free_col]);
	  break;
	default:
	  ERROR_EXIT("Unknown or invalid MATENT_TYPE (%d)\n", elm_type);
	  break;
	}
	/* >>> */
      }
    }
  }
}

/* Careful: when adding element-matrices in transpose-mode, we must
 * also transpose the block-structure.
 *
 * TRANSPOSE only refers to the element matrix; row_dof and col_dof
 * are relative to the row- and column fe-spaces of the matrix (row ==
 * range fe-space, col == domain fe-space).
 */
FLATTEN_ATTR
void add_element_matrix(DOF_MATRIX *matrix,
			REAL factor,
			const EL_MATRIX *el_matrix,
			MatrixTranspose transpose,
			const EL_DOF_VEC *row_dof,
			const EL_DOF_VEC *col_dof,
			const EL_SCHAR_VEC *bound)
{
  if (transpose == NoTranspose) {
    COL_CHAIN_DO(matrix, DOF_MATRIX) {
      ROW_CHAIN_DO(matrix, DOF_MATRIX) {
	_AI_add_element_matrix_single(matrix, factor, el_matrix, NoTranspose,
				      row_dof, col_dof, bound);
	col_dof   = CHAIN_NEXT(col_dof, const EL_DOF_VEC);
	el_matrix = ROW_CHAIN_NEXT(el_matrix, const EL_MATRIX);
      } ROW_CHAIN_WHILE(matrix, DOF_MATRIX);
      row_dof   = CHAIN_NEXT(row_dof, const EL_DOF_VEC);
      el_matrix = COL_CHAIN_NEXT(el_matrix, const EL_MATRIX);
      bound     = bound != NULL ? CHAIN_NEXT(bound, EL_SCHAR_VEC) : NULL;
    } COL_CHAIN_WHILE(matrix, DOF_MATRIX);
  } else {
    COL_CHAIN_DO(matrix, DOF_MATRIX) {
      ROW_CHAIN_DO(matrix, DOF_MATRIX) {
	_AI_add_element_matrix_single(matrix, factor, el_matrix, Transpose,
				      row_dof, col_dof, bound);
	col_dof   = CHAIN_NEXT(col_dof, const EL_DOF_VEC);
	el_matrix = COL_CHAIN_NEXT(el_matrix, const EL_MATRIX);
      } ROW_CHAIN_WHILE(matrix, DOF_MATRIX);
      row_dof   = CHAIN_NEXT(row_dof, const EL_DOF_VEC);
      el_matrix = ROW_CHAIN_NEXT(el_matrix, const EL_MATRIX);
      bound     = bound != NULL ? CHAIN_NEXT(bound, EL_SCHAR_VEC) : NULL;
    } COL_CHAIN_WHILE(matrix, DOF_MATRIX);
  }
}

static inline void
_AI_add_element_vec_single(DOF_REAL_VEC *drv, REAL factor,
			   const EL_REAL_VEC *el_vec,
			   const EL_DOF_VEC *dof,
			   const EL_SCHAR_VEC *bound)
{
  int i;

  if (bound) {
    for (i = 0; i < el_vec->n_components; i++) {
      if (bound->vec[i] < DIRICHLET) {
	drv->vec[dof->vec[i]] += factor*el_vec->vec[i];
      }
    }
  } else {
    for (i = 0; i < el_vec->n_components; i++) {
      drv->vec[dof->vec[i]] += factor*el_vec->vec[i];
    }
  }
}

static inline void
_AI_add_element_d_vec_single(DOF_REAL_D_VEC *drdv, REAL factor,
			     const EL_REAL_D_VEC *el_vec,
			     const EL_DOF_VEC *dof,
			     const EL_SCHAR_VEC *bound)
{
  int i;

  if (bound) {
    for (i = 0; i < el_vec->n_components; i++) {
      if (bound->vec[i] < DIRICHLET) {
	AXPY_DOW(factor, el_vec->vec[i], drdv->vec[dof->vec[i]]);
      }
    }
  } else {
    for (i = 0; i < el_vec->n_components; i++) {
      AXPY_DOW(factor, el_vec->vec[i], drdv->vec[dof->vec[i]]);
    }
  }
}

static inline void
_AI_add_element_vec_dow_single(DOF_REAL_VEC_D *drv, REAL factor,
			       const EL_REAL_VEC_D *el_vec,
			       const EL_DOF_VEC *dof,
			       const EL_SCHAR_VEC *bound)
{
  if (drv->stride != 1) {
    _AI_add_element_d_vec_single(
      (DOF_REAL_D_VEC *)drv, factor, (const EL_REAL_D_VEC *)el_vec, dof, bound);
  } else {
    _AI_add_element_vec_single(
      (DOF_REAL_VEC *)drv, factor, (const EL_REAL_VEC *)el_vec, dof, bound);
  }
}

void add_element_vec(DOF_REAL_VEC *drv, REAL factor,
		     const EL_REAL_VEC *el_vec,
		     const EL_DOF_VEC *dof,
		     const EL_SCHAR_VEC *bound)
{
  CHAIN_DO(el_vec, const EL_REAL_VEC) {
    _AI_add_element_vec_single(drv, factor, el_vec, dof, bound);
    drv   = CHAIN_NEXT(drv, DOF_REAL_VEC);
    dof   = CHAIN_NEXT(dof, EL_DOF_VEC);
    bound = bound ? CHAIN_NEXT(bound, EL_SCHAR_VEC) : NULL;
  } CHAIN_WHILE(el_vec, const EL_REAL_VEC);
}

void add_element_d_vec(DOF_REAL_D_VEC *drv, REAL factor,
		       const EL_REAL_D_VEC *el_vec,
		       const EL_DOF_VEC *dof,
		       const EL_SCHAR_VEC *bound)
{
  CHAIN_DO(el_vec, const EL_REAL_D_VEC) {
    _AI_add_element_d_vec_single(drv, factor, el_vec, dof, bound);
    drv   = CHAIN_NEXT(drv, DOF_REAL_D_VEC);
    dof   = CHAIN_NEXT(dof, EL_DOF_VEC);
    bound = bound ? CHAIN_NEXT(bound, EL_SCHAR_VEC) : NULL;
  } CHAIN_WHILE(el_vec, const EL_REAL_D_VEC);
}

void add_element_vec_dow(DOF_REAL_VEC_D *drv, REAL factor,
			 const EL_REAL_VEC_D *el_vec,
			 const EL_DOF_VEC *dof,
			 const EL_SCHAR_VEC *bound)
{
  CHAIN_DO(el_vec, cosnt EL_REAL_VEC_D) {
    _AI_add_element_vec_dow_single(drv, factor, el_vec, dof, bound);
    drv   = CHAIN_NEXT(drv, DOF_REAL_VEC_D);
    dof   = CHAIN_NEXT(dof, EL_DOF_VEC);
    bound = bound ? CHAIN_NEXT(bound, EL_SCHAR_VEC) : NULL;
  } CHAIN_WHILE(el_vec, const EL_REAL_VEC_D);
}

void update_matrix(DOF_MATRIX *dof_matrix,
		   const EL_MATRIX_INFO *minfo,
		   MatrixTranspose transpose)
{
  FUNCNAME("update_matrix");
  MESH *mesh;
  const FE_SPACE *row_fe_space, *col_fe_space, *neigh_fe_space = NULL;
  const BAS_FCTS *row_bfcts, *col_bfcts, *neigh_bfcts;
  const DOF_ADMIN *row_admin;
  bool use_get_bound;
  int dim;
  EL_DOF_VEC *row_dof, *col_dof, *neigh_dof = NULL;
  EL_SCHAR_VEC *bound = NULL;
  EL_BNDRY_VEC *bndry_bits = NULL;
  FLAGS fill_flag;

  TEST_EXIT(minfo, "no EL_MATRIX_INFO\n");
  TEST_EXIT(minfo->el_matrix_fct, "no el_matrix_fct in EL_MATRIX_INFO\n");
  TEST_EXIT(dof_matrix, "no DOF_MATRIX\n");

  mesh = minfo->row_fe_space->mesh;
  
  COL_CHAIN_DO(dof_matrix, DOF_MATRIX) {
    ROW_CHAIN_DO(dof_matrix, DOF_MATRIX) {
      BNDRY_FLAGS_CPY(dof_matrix->dirichlet_bndry, minfo->dirichlet_bndry);
    } ROW_CHAIN_WHILE(dof_matrix, DOF_MATRIX);
  } COL_CHAIN_WHILE(dof_matrix, DOF_MATRIX);

  col_fe_space = NULL;
  if (transpose == NoTranspose) {
    row_fe_space = minfo->row_fe_space;
    if (minfo->col_fe_space && minfo->col_fe_space != row_fe_space) {
      col_fe_space = minfo->col_fe_space;
    }
  } else {
    if (minfo->col_fe_space && minfo->col_fe_space != minfo->row_fe_space) {
      row_fe_space = minfo->col_fe_space;
      col_fe_space = minfo->row_fe_space;
    } else {
      row_fe_space = minfo->col_fe_space;
    }
  }

  row_bfcts = row_fe_space->bas_fcts;
  row_admin = row_fe_space->admin;

  if (col_fe_space) {
    col_bfcts = col_fe_space->bas_fcts;
  } else {
    col_bfcts = NULL;
  }

  use_get_bound = !BNDRY_FLAGS_IS_INTERIOR(dof_matrix->dirichlet_bndry);
  if (use_get_bound) {
    fill_flag = minfo->fill_flag|FILL_BOUND;
    if (mesh->is_periodic && !(row_admin->flags & ADM_PERIODIC)) {
      fill_flag |= FILL_NON_PERIODIC;
    }
  } else {
    fill_flag = minfo->fill_flag;
  }

  minfo->el_matrix_fct(NULL, minfo->fill_info);

  row_dof = get_el_dof_vec(row_bfcts);
  if (use_get_bound) {
    bound      = get_el_schar_vec(row_bfcts);
    bndry_bits = get_el_bndry_vec(row_bfcts);
  }

  if (col_bfcts) {
    col_dof = get_el_dof_vec(col_bfcts);
  } else {
    col_dof = row_dof;
  }

  if (minfo->neigh_el_mat_fcts) {
    neigh_fe_space = col_fe_space ? col_fe_space : row_fe_space;
    neigh_bfcts    = neigh_fe_space->bas_fcts;
    neigh_dof      = get_el_dof_vec(neigh_bfcts);
  }

  dim = mesh->dim;
  TRAVERSE_FIRST(mesh, -1, fill_flag) {
    const EL_MATRIX *mat;
    const EL     *el = el_info->el;

    if ((mat = minfo->el_matrix_fct(el_info, minfo->fill_info)) == NULL) {
      continue;
    }
      
    get_dof_indices(row_dof, row_fe_space, el);
    if (col_bfcts) {
      get_dof_indices(col_dof, col_fe_space, el);
    }
    if (use_get_bound) {
      get_bound(bndry_bits, row_bfcts, el_info);
      dirichlet_map(bound, bndry_bits, dof_matrix->dirichlet_bndry);
    }
    add_element_matrix(dof_matrix, minfo->factor, mat, transpose,
		       row_dof, col_dof, use_get_bound ? bound : NULL);

    if (minfo->neigh_el_mat_fcts) {
      /* Possibly a DG-discretisation, add jump contributions */
      int wall;
      for (wall = 0; wall < N_WALLS(dim); wall++) {
	mat = minfo->neigh_el_mat_fcts[wall](el_info, minfo->neigh_fill_info);
	if (mat == NULL) {
	  continue;
	}
	/* It is always the space of _ANSATZ_ functions which belongs
	 * to the neighbour element, so we need the col-DOFs on the
	 * respective neighbour elements.
	 */
	DEBUG_TEST_EXIT(el_info->neigh[wall] != NULL,
			"Jump contribution, but no neighbour????\n");
	
	get_dof_indices(neigh_dof, neigh_fe_space, el_info->neigh[wall]);
	add_element_matrix(dof_matrix, minfo->factor, mat, transpose,
			   row_dof, neigh_dof, use_get_bound ? bound : NULL);
      }
    }

  } TRAVERSE_NEXT();

  free_el_dof_vec(row_dof);
  if (col_bfcts) {
    free_el_dof_vec(col_dof);
  }
  if (minfo->neigh_el_mat_fcts) {
    free_el_dof_vec(neigh_dof);
  }

  if (use_get_bound) {
    free_el_schar_vec(bound);
    free_el_bndry_vec(bndry_bits);
  }
  
}

void update_real_vec(DOF_REAL_VEC *drv, const EL_VEC_INFO *vec_info)
{
  FUNCNAME("update_real_vec");
  MESH            *mesh;
  const BAS_FCTS  *bfcts;
  const FE_SPACE  *fe_space;
  const DOF_ADMIN *admin;
  bool use_get_bound;
  EL_DOF_VEC *dof;
  EL_SCHAR_VEC *bound = NULL;
  EL_BNDRY_VEC *bndry_bits = NULL;
  FLAGS fill_flag;
  
  TEST_EXIT(vec_info,"no EL_VEC_INFO\n");
  TEST_EXIT(vec_info->el_vec_fct,"no el_vec_fct in EL_VEC_INFO\n");
  TEST_EXIT(drv,"no DOF_REAL_VEC\n");

  fe_space = vec_info->fe_space;
  mesh     = fe_space->mesh;
  bfcts    = fe_space->bas_fcts;
  admin    = fe_space->admin;

  use_get_bound = !BNDRY_FLAGS_IS_INTERIOR(vec_info->dirichlet_bndry);
  if (use_get_bound) {
    fill_flag = vec_info->fill_flag|FILL_BOUND;
    if (mesh->is_periodic && !(admin->flags & ADM_PERIODIC))
      fill_flag |= FILL_NON_PERIODIC;
  } else {
    fill_flag = vec_info->fill_flag;
  }

  vec_info->el_vec_fct(NULL, vec_info->fill_info);

  dof = get_el_dof_vec(bfcts);
  if (use_get_bound) {
    bound = get_el_schar_vec(bfcts);
    bndry_bits = get_el_bndry_vec(bfcts);
  }

  TRAVERSE_FIRST(mesh, -1, fill_flag) {
    const EL_REAL_VEC *vec;

    vec = vec_info->el_vec_fct(el_info, vec_info->fill_info);
    if (vec == NULL) {
      continue;
    }

    get_dof_indices(dof, fe_space, el_info->el);
    if (use_get_bound) {
      get_bound(bndry_bits, bfcts, el_info);
      dirichlet_map(bound, bndry_bits, vec_info->dirichlet_bndry);
    }

    add_element_vec(drv, vec_info->factor, vec, dof, 
		    use_get_bound ? bound : NULL);
  } TRAVERSE_NEXT();

  free_el_dof_vec(dof);
  if (use_get_bound) {
    free_el_schar_vec(bound);
    free_el_bndry_vec(bndry_bits);
  }

}

void update_real_d_vec(DOF_REAL_D_VEC *drdv, const EL_VEC_D_INFO *vec_info)
{
  FUNCNAME("update_real_d_vec");
  MESH            *mesh;
  const BAS_FCTS  *bfcts;
  const FE_SPACE  *fe_space;
  const DOF_ADMIN *admin;
  bool use_get_bound;
  EL_DOF_VEC   *dof;
  EL_SCHAR_VEC *bound = NULL;
  EL_BNDRY_VEC *bndry_bits = NULL;
  FLAGS fill_flag;

  TEST_EXIT(vec_info,"no EL_VEC_D_INFO\n");
  TEST_EXIT(vec_info->el_vec_fct,"no el_vec_fct in EL_VEC_D_INFO\n");
  TEST_EXIT(drdv,"no DOF_REAL_D_VEC\n");


  fe_space = vec_info->fe_space;
  mesh     = fe_space->mesh;
  bfcts    = fe_space->bas_fcts;
  admin    = fe_space->admin;

  use_get_bound = !BNDRY_FLAGS_IS_INTERIOR(vec_info->dirichlet_bndry);
  if (use_get_bound) {
    fill_flag = vec_info->fill_flag|FILL_BOUND;
    if (mesh->is_periodic && !(admin->flags & ADM_PERIODIC)) {
      fill_flag |= FILL_NON_PERIODIC;
    }
  } else {
    fill_flag = vec_info->fill_flag;
  }

  vec_info->el_vec_fct(NULL, vec_info->fill_info);

  dof = get_el_dof_vec(bfcts);
  if (use_get_bound) {
    bound = get_el_schar_vec(bfcts);
    bndry_bits = get_el_bndry_vec(bfcts);
  }
  
  TRAVERSE_FIRST(mesh, -1, fill_flag) {
    const EL_REAL_D_VEC *vec;

    vec = vec_info->el_vec_fct(el_info, vec_info->fill_info);
    if (vec == NULL) {
      continue;
    }

    get_dof_indices(dof, fe_space, el_info->el);
    if (use_get_bound) {
      get_bound(bndry_bits, bfcts, el_info);
      dirichlet_map(bound, bndry_bits, vec_info->dirichlet_bndry);
    }

    add_element_d_vec(drdv, vec_info->factor, vec, dof, 
		      use_get_bound ? bound : NULL);
      
  } TRAVERSE_NEXT();

  free_el_dof_vec(dof);
  if (use_get_bound) {
    free_el_schar_vec(bound);
    free_el_bndry_vec(bndry_bits);
  }
}

void update_real_vec_dow(DOF_REAL_VEC_D *drdv, const EL_VEC_INFO_D *vec_info)
{
  FUNCNAME("update_real_vec_dow");
  MESH            *mesh;
  const BAS_FCTS  *bfcts;
  const FE_SPACE  *fe_space;
  const DOF_ADMIN *admin;
  bool use_get_bound;
  EL_DOF_VEC   *dof;
  EL_SCHAR_VEC *bound = NULL;
  EL_BNDRY_VEC *bndry_bits = NULL;
  FLAGS fill_flag;

  TEST_EXIT(vec_info, "no EL_VEC_INFO_D\n");
  TEST_EXIT(vec_info->el_vec_fct, "no el_vec_fct in EL_VEC_INFO_D\n");
  TEST_EXIT(drdv, "no DOF_REAL_VEC_D\n");


  fe_space = vec_info->fe_space;
  mesh     = fe_space->mesh;
  bfcts    = fe_space->bas_fcts;
  admin    = fe_space->admin;

  use_get_bound = !BNDRY_FLAGS_IS_INTERIOR(vec_info->dirichlet_bndry);
  if (use_get_bound) {
    fill_flag = vec_info->fill_flag|FILL_BOUND;
    if (mesh->is_periodic && !(admin->flags & ADM_PERIODIC)) {
      fill_flag |= FILL_NON_PERIODIC;
    }
  } else {
    fill_flag = vec_info->fill_flag;
  }

  vec_info->el_vec_fct(NULL, vec_info->fill_info);

  dof = get_el_dof_vec(bfcts);
  if (use_get_bound) {
    bound = get_el_schar_vec(bfcts);
    bndry_bits = get_el_bndry_vec(bfcts);
  }
  
  TRAVERSE_FIRST(mesh, -1, fill_flag) {
    const EL_REAL_VEC_D *vec;

    vec = vec_info->el_vec_fct(el_info, vec_info->fill_info);
    if (vec == NULL) {
      continue;
    }

    get_dof_indices(dof, fe_space, el_info->el);
    if (use_get_bound) {
      get_bound(bndry_bits, bfcts, el_info);
      dirichlet_map(bound, bndry_bits, vec_info->dirichlet_bndry);
    }

    add_element_vec_dow(drdv, vec_info->factor, vec, dof, 
			use_get_bound ? bound : NULL);
      
  } TRAVERSE_NEXT();

  free_el_dof_vec(dof);
  if (use_get_bound) {
    free_el_schar_vec(bound);
    free_el_bndry_vec(bndry_bits);
  }
}

/*--------------------------------------------------------------------------*/
/* attempt to find a DOF_ADMIN structure which stores vertex DOFs           */
/*--------------------------------------------------------------------------*/

const DOF_ADMIN *get_vertex_admin(MESH *mesh, FLAGS flags)
{
  int       i, n_admin = mesh->n_dof_admin;
  DOF_ADMIN **admins = mesh->dof_admin;
  const DOF_ADMIN *admin = NULL;

  if (!mesh->is_periodic) {
    flags &= ~ADM_PERIODIC;
  }

  for (i = 0; i < n_admin; i++) {
    if (admins[i]->n_dof[VERTEX] && (admins[i]->flags == flags)) {
      if (!admin)
	admin = admins[i];
      else if (admins[i]->used_count < admin->used_count)
	admin = admins[i];
    }
  }

  if(!admin) {
    const int n_dof[N_NODE_TYPES] = {1, 0, 0, 0};
    const FE_SPACE *fe_space;

    fe_space = get_dof_space(mesh, "Vertex DOF admin", n_dof, flags);

    admin = fe_space->admin;

    free_fe_space(fe_space);
  }

  return admin;
}

/* attempt to find a minimal admin with admin->n_dof[type] >= n_dof[type] */
const DOF_ADMIN *
get_minimal_admin(MESH *mesh, const int n_dof[N_NODE_TYPES], FLAGS flags)
{
  int       i, j, n_admin = mesh->n_dof_admin;
  DOF_ADMIN **admins = mesh->dof_admin;
  const DOF_ADMIN *admin = NULL;

  if (!mesh->is_periodic) {
    flags &= ~ADM_PERIODIC;
  }

  for (i = 0; i < n_admin; i++) {
    if (admins[i]->flags != flags) {
      continue;
    }
    for (j = 0; j < N_NODE_TYPES && admins[i]->n_dof[j] >= n_dof[j]; j++);
    if (j < N_NODE_TYPES) {
      continue;
    }
    if (admin == NULL) {
      admin = admins[i];
    } else if (admins[i]->used_count < admin->used_count) {
      admin = admins[i];
    }
  }

  if (admin == NULL) {
    const FE_SPACE *fe_space;

    fe_space = get_dof_space(mesh, "minimal admin", n_dof, flags);

    admin = fe_space->admin;

    free_fe_space(fe_space);
  }

  return admin;
}

/* Give a summary about the number of currently attached objects
 * (matrices and vectors).
 */
void summarize_dof_admin(const DOF_ADMIN *admin) 
{
  FUNCNAME("summarize_dof_admin");
  unsigned cnt;
  DOF_INT_VEC     *dof_int_vec;           /* linked list of int vectors */
  DOF_DOF_VEC     *dof_dof_vec;           /* linked list of dof vectors */
  DOF_DOF_VEC     *int_dof_vec;           /* linked list of dof vectors */
  DOF_UCHAR_VEC   *dof_uchar_vec;         /* linked list of u_char vectors */
  DOF_SCHAR_VEC   *dof_schar_vec;         /* linked list of s_char vectors */
  DOF_REAL_VEC    *dof_real_vec;          /* linked list of real vectors   */
  DOF_REAL_D_VEC  *dof_real_d_vec;        /* linked list of real_d vectors */
  DOF_PTR_VEC     *dof_ptr_vec;           /* linked list of void * vectors */
  DOF_MATRIX      *dof_matrix;            /* linked list of matrices */

  MSG("DOF_ADMIN \"%s@%s\"\n", admin->name, admin->mesh->name);
  MSG("size      : %d\n", admin->size);
  MSG("used_count: %d\n", admin->used_count);
  MSG("size_used : %d\n", admin->size_used);
  MSG("hole_count: %d\n", admin->hole_count);
#ifdef COUNT_OBJECTS
# undef COUNT_OBJECTS
#endif
#define COUNT_OBJECTS(name)						\
  for (cnt = 0, name = admin->name; name != NULL; name = name->next, ++cnt); \
  if (cnt > 0) {							\
    MSG(#name": %d\n", cnt);						\
  }

  COUNT_OBJECTS(dof_int_vec);
  COUNT_OBJECTS(dof_dof_vec);
  COUNT_OBJECTS(int_dof_vec);
  COUNT_OBJECTS(dof_uchar_vec);
  COUNT_OBJECTS(dof_schar_vec);
  COUNT_OBJECTS(dof_real_vec);
  COUNT_OBJECTS(dof_real_d_vec);
  COUNT_OBJECTS(dof_ptr_vec);
  COUNT_OBJECTS(dof_matrix);
}

void summarize_all_admins(MESH *mesh)
{
  FUNCNAME("summarize_all_admins");
  int i;
  
  MSG("******************** Admins@%s ************** \n", mesh->name);
  for (i = 0; i < mesh->n_dof_admin; ++i) {
    summarize_dof_admin(mesh->dof_admin[i]);
    MSG("\n");
  }
}
