/*--------------------------------------------------------------------------*/
/* ALBERTA:  an Adaptive multi Level finite element toolbox using           */
/*           Bisectioning refinement and Error control by Residual          */
/*           Techniques for scientific Applications                         */
/*                                                                          */
/* file:     memory.c                                                       */
/*                                                                          */
/* description:  routines for memory handling                               */
/*                                                                          */
/*--------------------------------------------------------------------------*/
/*                                                                          */
/*  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                                     */
/*             Albert-Ludwigs-Universitaet Freiburg                         */
/*             Hermann-Herder-Str. 10                                       */
/*             D-79104 Freiburg                                             */
/*                                                                          */
/*             Claus-Justus Heine                                           */
/*             Abteilung fuer Angewandte Mathematik                         */
/*             Albert-Ludwigs-Universitaet Freiburg                         */
/*             Hermann-Herder-Str. 10                                       */
/*             D-79104 Freiburg im Breisgau, Germany                        */
/*                                                                          */
/*  http://www.alberta-fem.de                                               */
/*                                                                          */
/*  (c) by A. Schmidt and K.G. Siebert (1996-2003)                          */
/*         D. Koester (2005),                                               */
/*         C.-J. Heine (2006-2007)                                          */
/*                                                                          */
/*--------------------------------------------------------------------------*/

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

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

/*--------------------------------------------------------------------------*/
/*  some routines for allocation and deallocation                           */
/*--------------------------------------------------------------------------*/

#define ALBERTA_DEBUG_MEMORY 0

/* #define ALBERTA_USE_MALLOC 1 */

#ifndef ALBERTA_USE_MALLOC
# define ALBERTA_USE_MALLOC					\
  (!ALBERTA_DEBUG_MEMORY && ALBERTA_DEBUG && ALBERTA_ALLOC_RECORD)
#endif

#if ALBERTA_DEBUG_MEMORY
# define MEMMAGIC "ABMM"
#endif

/* default value for increasing size of memory in an memoryadmin.  see
 * also setCapacityIncrement().
 */
#if ALBERTA_DEBUG_MEMORY > 1
# define DEFAULTCAPACITYINCREMENT 5
#else
# define DEFAULTCAPACITYINCREMENT 1000
#endif


/* Alignment by integer division and multiplication */
#define ALIGNMEM(size, align) \
  (((size_t)(size) + (size_t)(align) - 1) / (size_t)(align) * (size_t)(align))

#if ALBERTA_DEBUG_MEMORY
/* During memory debugging every memory block also either belongs to a
 * second doubly linked free-list, or to a doubly link alloc-list. We
 * maintain additionally a status flags (allocated or not), and a 4
 * byte magic number just below and above the memory block to catch
 * array bound violation.
 */
typedef enum MemoryStatusEnum {
  MemFree = 1,
  MemAllocated = 2,
  MemChecked = 4, /* used to tag list members while performing sanity checks */
} MEMORY_STATUS;

typedef struct MemoryInfo MEMORY_INFO;
struct MemoryInfo
{
  MEMORY_INFO   *prev;
  MEMORY_INFO   *next;
  void          *admin;
  MEMORY_STATUS status;
};

/* Two global lists for all memory blocks */
static struct {
  MEMORY_INFO *next;
  MEMORY_INFO *prev;
} freeList = { (void *)&freeList, (void *)&freeList };

static struct {
  MEMORY_INFO *next;
  MEMORY_INFO *prev;
} allocList = { (void *)&allocList, (void *)&allocList };

#endif

/* Linked list of free memory blocks of size
 * "MEMORYADMIN->objectsSize". The list pointer "next" occupies the
 * first sizeof(void *) bytes of an allocated block (so it is
 * destroyed during allocation).
 */
typedef struct FreeMemory FREEMEMORY;
struct FreeMemory
{
  FREEMEMORY *next;
};

/* Linked list of blocks. "next" and "end" are in front of the actual
 * memory region which starts just behing "&end". "end" itself is the
 * address just after the memory region attached behing "&end".
 */
typedef struct Block BLOCK;
struct Block
{
  BLOCK  *next;
  void   *start; /* The actual start of the _aligned_ data area */
  void   *end;   /* Points past the end of the data area. */
  size_t size;   /* The acutal _UNaligned_ size */
};

/* The free-lits "freeMem" may contain blocks from different
 * memory-block regions.
 */
typedef struct MemoryAdmin MEMORYADMIN;
struct MemoryAdmin
{
  const char *name;
  unsigned int capacity;
  unsigned int capacityIncrement;
  size_t   alignment;  /* the alignment of each object */
  size_t   objectSize; /* the aligned size of each object */
#if ALBERTA_DEBUG_MEMORY
  size_t   prefixSize;     /* aligned size of data stored in front */
  size_t   suffixOffset;   /* offset to trailing data */
#endif
  BLOCK *blocks;
  FREEMEMORY *freeMem;
};

#if ALBERTA_DEBUG_MEMORY
static void memListAdd(MEMORY_INFO *head, MEMORY_INFO *new)
{
  head->next->prev = new;
  new->next        = head->next;
  new->prev        = head;
  head->next       = new;
}

static void memListDel(MEMORY_INFO *old)
{
  old->prev->next = old->next;
  old->next->prev = old->prev;
}

static void adminDelFromMemList(MEMORY_INFO *head, MEMORYADMIN *adm)
{
  MEMORY_INFO *memInfo;

  for (memInfo = head->next; memInfo != head; memInfo = memInfo->next) {
    if (memInfo->admin == adm) {
      memListDel(memInfo);
    }
  }
}

void _AI_memListCheck(MEMORY_INFO *head,
		      MEMORY_STATUS status)
{
  FUNCNAME("_AI_memListCheck");
  MEMORY_INFO *memInfo;
  MEMORYADMIN *adm;
  int garbled = 0;

  for (memInfo = head->next; memInfo != head; memInfo = memInfo->next) {
    adm = memInfo->admin;
    if (memInfo->status != status) {
      MSG("Block: %p (%p): Wrong status: %d, should be %d.\n",
	  memInfo, (char *)memInfo + adm->prefixSize,
	  memInfo->status, status);
      garbled = 1;
    }
    if (memcmp((char *)memInfo + adm->prefixSize - strlen(MEMMAGIC),
	       MEMMAGIC, strlen(MEMMAGIC)) != 0) {
      MSG("Block: %p (%p): Wrong magic in front of data area.\n",
	  memInfo, (char *)memInfo + adm->prefixSize);
      garbled = 1;
    }
    if (memcmp((char *)memInfo + adm->suffixOffset,
	       MEMMAGIC, strlen(MEMMAGIC)) != 0) {
      MSG("Block: %p (%p): Wrong magic after data area.\n",
	  memInfo, (char *)memInfo + adm->prefixSize);
      garbled = 1;
    }
    if (status == MemFree) {
      FREEMEMORY *freeMem = (FREEMEMORY *)((char *)memInfo + adm->prefixSize);
      FREEMEMORY *pos;

      for (pos = adm->freeMem; pos; pos = pos->next) {
	if (pos == freeMem) {
	  break;
	}
      }
      if (pos == NULL) {
	MSG("Block: %p (%p): Free block not on admin's free-list.\n",
	    memInfo, (char *)memInfo + adm->prefixSize);
	garbled = 1;
      }
    }
    if (garbled) {
      ERROR_EXIT("Memory management has been garbled.\n");
    }
  }
}

void _AI_freeListCheck(void)
{
  _AI_memListCheck((void *)&freeList, MemFree);
}
void _AI_allocListCheck(void)
{
  _AI_memListCheck((void *)&allocList, MemAllocated);
}

#endif

static int newBlock(MEMORYADMIN* ma, unsigned int capacityIncrement)
{
  FUNCNAME("newBlock");
#if ALBERTA_DEBUG_MEMORY
  char *thisChunk;
#endif
  BLOCK *block;
  FREEMEMORY *freeMem;
  int i;

#if ALBERTA_DEBUG_MEMORY
  _AI_freeListCheck();
  _AI_allocListCheck();
#endif

  /* In the worst case we need ma->alignment-1 additional bytes to
   * satisfy the memery alignment requirement.
   */
  block =
    (BLOCK *)alberta_alloc(sizeof(BLOCK) +
			   ma->alignment - 1 +
			   capacityIncrement * ma->objectSize,
			   funcName, __FILE__, __LINE__);

  /* compute the bounds for the _aligned_ data region */
  block->size  =
    sizeof(BLOCK) + ma->alignment - 1 + capacityIncrement * ma->objectSize;
  block->start = (void *)ALIGNMEM(block+1, ma->alignment);
  block->end   =
    (void *)((char *)block->start + capacityIncrement * ma->objectSize);

  /* now build up the free-list */
#if !ALBERTA_DEBUG_MEMORY
  for (freeMem = (FREEMEMORY *)block->start, i = 0;
       i < (int)(capacityIncrement - 1);
       freeMem = (FREEMEMORY *)((char *)freeMem + ma->objectSize), i++) {
    freeMem->next = (FREEMEMORY *)((char *)freeMem + ma->objectSize);
  }
  freeMem->next = ma->freeMem;
  ma->freeMem = (FREEMEMORY *)block->start;
#else
  /* build up the doubly linked free-mem list */
  for (thisChunk = block->start;
       thisChunk < (char *)block->end;
       thisChunk += ma->objectSize) {
    MEMORY_INFO *memInfo;

    memInfo = (MEMORY_INFO *)thisChunk;
    memInfo->admin  = (void *)ma;
    memInfo->status = MemFree;

    /* add the magic numbers in front and after the data region */
    memcpy(thisChunk + ma->prefixSize - strlen(MEMMAGIC),
	   MEMMAGIC, strlen(MEMMAGIC));
    memcpy(thisChunk + ma->suffixOffset, MEMMAGIC, strlen(MEMMAGIC));

    memListAdd((void *)&freeList, memInfo);
  }

  /* build up the ordinary singly linked list */
  for (freeMem = (FREEMEMORY *)((char *)block->start + ma->prefixSize), i = 0;
       i < capacityIncrement - 1;
       freeMem = (FREEMEMORY *)((char *)freeMem + ma->objectSize), i++) {
    freeMem->next = (FREEMEMORY *)((char *)freeMem + ma->objectSize);
  }
  freeMem->next = ma->freeMem;
  ma->freeMem = (FREEMEMORY *)((char *)block->start + ma->prefixSize);

  _AI_freeListCheck();
  _AI_allocListCheck();
#endif

  /* hook the new block into the block list of the memory admin */
  ma->capacity += capacityIncrement;
  block->next = ma->blocks;
  ma->blocks = block;

  return 0;
}

/*
 * newObject(..) returns a void-pointer to a memoryadmin for objects of size
 * objectSize. Use the returned value as parameter for getMemory.
 */
static void *_newObject(size_t objectSize,
			size_t alignment,
			unsigned int initialCapacity,
			const char *name)
{
  FUNCNAME("newObject");
  MEMORYADMIN *ma;

  TEST_EXIT(objectSize, "Attempted to allocate a zero length object!\n");

  ma = (MEMORYADMIN *)alberta_alloc(sizeof(MEMORYADMIN),
				    funcName, __FILE__, __LINE__);

  ma->name = name ? strdup(name) : NULL;

  ma->capacity = 0;
  ma->capacityIncrement =
    (initialCapacity ? initialCapacity : DEFAULTCAPACITYINCREMENT);
  ma->alignment = (alignment ? alignment : objectSize);

  if (ma->alignment > 2*sizeof(REAL)) {
    WARNING("large alignment %d requested.\n", ma->alignment);
  }

  /* Need at least space for one pointer ... better do not allocate
   * integers with this structure ...
   */
  objectSize = MAX(sizeof(FREEMEMORY), objectSize);
#if !ALBERTA_DEBUG_MEMORY
  ma->objectSize = ALIGNMEM(objectSize, ma->alignment);
#else
  /* allocate enough space to include that magic suffix */
  ma->objectSize = ALIGNMEM(objectSize+strlen(MEMMAGIC), ma->alignment);

  /* data stored in front of each object */
  ma->prefixSize = ALIGNMEM(sizeof(MEMORY_INFO) + strlen(MEMMAGIC),
			    ma->alignment);
  ma->objectSize += ma->prefixSize;
  ma->suffixOffset = ma->prefixSize + objectSize;
#endif
  ma->blocks = NULL;
  ma->freeMem = NULL;

  if(initialCapacity) {
    newBlock(ma, initialCapacity);
  }

  return ma;
}

/* Default case: the required alignment is the object size if <
 * sizeof(void *), otherwise it is the sizeof(void *).
 */
static void *newObject(size_t objectSize, unsigned int initialCapacity,
		       const char *name)
{
  return _newObject(objectSize,
		    objectSize < sizeof(void *) ? objectSize : sizeof(void *),
		    initialCapacity, name);
}

/* returns a pointer to an object of size objectsize given by creating the
 * memoryadmin.
 */
static void* getMemory(void* memoryAdmin)
{
#if ALBERTA_DEBUG_MEMORY
  FUNCNAME("getMemory");
  MEMORY_INFO *memInfo;
  char        *thisChunk;
#endif
  MEMORYADMIN *admin;
  FREEMEMORY  *tmp;

  admin = (MEMORYADMIN *)memoryAdmin;

#if ALBERTA_USE_MALLOC
  return malloc(admin->objectSize);
#endif

  while(admin->capacity <= 0)
    newBlock(admin, admin->capacityIncrement);

#if ALBERTA_DEBUG_MEMORY
  /* Check the magic numbers, check the status, remove the block
   * from the additional freeList and hook it in to the allocList,
   * change its status.
   */
  thisChunk = (char *)admin->freeMem - admin->prefixSize;
  memInfo = (MEMORY_INFO *)thisChunk;
  TEST_EXIT(memInfo->next != memInfo->prev,
	    "Unconnected free block.\n");
  TEST_EXIT(memInfo->admin == admin,
	    "memInfo->admin != admin.\n");
  TEST_EXIT(memInfo->status == MemFree,
	    "Status %d != MemFree (= %d).\n", memInfo->status, MemFree);
  TEST_EXIT(memcmp(thisChunk + admin->prefixSize - strlen(MEMMAGIC),
		   MEMMAGIC, strlen(MEMMAGIC)) == 0,
	    "Wrong magic in front of free block.\n");
  TEST_EXIT(memcmp(thisChunk + admin->suffixOffset,
		   MEMMAGIC, strlen(MEMMAGIC)) == 0,
	    "Wrong magic after free block.\n");

  /* remove block from freeList */
  memListDel(memInfo);
  memListAdd((void *)&allocList, memInfo);
  memInfo->status = MemAllocated;
#endif

  tmp = admin->freeMem;
  admin->freeMem = admin->freeMem->next;

  admin->capacity--;

#ifdef __GNUC__
  /* gcc has a bug when run with -O3 and the i386 default target; so
   * insert an optimization barrier here :(
   */
  __asm__ __volatile__("" ::: "memory");
#endif

  return (void *)tmp;
}

/* returns memory at *object to memoryadmin. !!! object must be the
 * result of an call of getMemory(...) with the same memoryadmin. !!!
 */
static void freeMemory(void *object, void *memoryAdmin)
{
#if ALBERTA_DEBUG_MEMORY
  FUNCNAME("freeMemory");
  MEMORY_INFO *memInfo;
  char        *thisChunk;
#endif
  MEMORYADMIN *memadm  = (MEMORYADMIN *)memoryAdmin;
  FREEMEMORY  *freemem = (FREEMEMORY *)object;

#if ALBERTA_USE_MALLOC
  free(object);
  return;
#endif

#if ALBERTA_DEBUG_MEMORY
  _AI_freeListCheck();
  _AI_allocListCheck();

  thisChunk = (char *)object - memadm->prefixSize;
  memInfo = (MEMORY_INFO *)thisChunk;

  TEST_EXIT(memInfo->next != memInfo->prev,
	    "Unconnected allocated block.\n");
  TEST_EXIT(memInfo->admin == memadm,
	    "memInfo->admin != memadm.\n");
  TEST_EXIT(memInfo->status == MemAllocated,
	    "Status %d != MemAllocated (= %d).\n",
	    memInfo->status, MemAllocated);
  TEST_EXIT(memcmp(thisChunk + memadm->prefixSize - 4,
		   MEMMAGIC, strlen(MEMMAGIC)) == 0,
	    "Wrong magic in front of allocated block.\n");
  TEST_EXIT(memcmp(thisChunk + memadm->suffixOffset,
		   MEMMAGIC, strlen(MEMMAGIC)) == 0,
	    "Wrong magic after allocated block.\n");

  memListDel(memInfo);
  memListAdd((void *)&freeList, memInfo);
  memInfo->status = MemFree;
#endif

  freemem->next = memadm->freeMem;
  memadm->freeMem = freemem;
  memadm->capacity ++;
}

/* the counterpart to newObject, frees all memory allocated with the given
 * memoryadmin.
 */
static void deleteObject(void* memoryAdmin)
{
#if ALBERTA_DEBUG_MEMORY
  FUNCNAME("deleteObject");
#endif
  BLOCK *b, *tmp;
  MEMORYADMIN *adm = (MEMORYADMIN *)memoryAdmin;
  size_t size;

  DEBUG_TEST_EXIT(memoryAdmin, "memoryAdmin == NULL\n");

#if ALBERTA_DEBUG_MEMORY
  /* inefficient like hell, but this is debug code anyway ... */
  adminDelFromMemList((void *)&freeList, adm);
  _AI_freeListCheck();
  adminDelFromMemList((void *)&allocList, adm);
  _AI_allocListCheck();
#endif

  b = adm->blocks;
  while(b != NULL) {
    tmp = b->next;
    size = b->size;
#if ALBERTA_DEBUG_MEMORY
    memset(b, -1, size);
#endif
    alberta_free(b, size);
    b = tmp;
  }
  if (adm->name)
    free((char *)adm->name);
  alberta_free(adm, sizeof(MEMORYADMIN));
}

typedef struct dof_admin_mem_info DOF_ADMIN_MEM_INFO;
struct dof_admin_mem_info
{
  void *dof_matrix;
  void *real_matrix_row;
  void *real_d_matrix_row;
  void *real_dd_matrix_row;
  void *dof_int_vec;
  void *dof_dof_vec;
  void *int_dof_vec;
  void *dof_uchar_vec;
  void *dof_schar_vec;
  void *dof_real_vec;
  void *dof_real_d_vec;
  void *dof_real_dd_vec;
  void *dof_ptr_vec;
};


/*--------------------------------------------------------------------------*/
/*  memory management for DOF admin structures                              */
/*--------------------------------------------------------------------------*/

static void add_dof_admin_to_mesh(DOF_ADMIN *admin, MESH *mesh)
{
  FUNCNAME("add_dof_admin_to_mesh");
  int i, n, dim = mesh->dim;

  admin->mesh = mesh;
  n = mesh->n_dof_admin;
  if ((n > 0) && (mesh->dof_admin == NULL))
    ERROR_EXIT("no mesh->dof_admin but n_dof_admin=%d\n", n);
  if ((n <= 0) && (mesh->dof_admin != NULL))
    ERROR_EXIT("found mesh->dof_admin but n_dof_admin=%d\n", n);

  for (i = 0; i < n; i++)
    if (mesh->dof_admin[i] == admin)
      ERROR_EXIT("admin %s is already associated to mesh %s\n",
		 NAME(admin), NAME(mesh));

  mesh->dof_admin = MEM_REALLOC(mesh->dof_admin, n, n+1, DOF_ADMIN *);
  n++;

  mesh->dof_admin[n-1] = admin;
  mesh->n_dof_admin = n;

  mesh->n_dof_el = 0;

  admin->n0_dof[VERTEX] = mesh->n_dof[VERTEX];
  mesh->n_dof[VERTEX]  += admin->n_dof[VERTEX];
  mesh->n_dof_el += N_VERTICES(dim) * mesh->n_dof[VERTEX];

  admin->n0_dof[CENTER] = mesh->n_dof[CENTER];
  mesh->n_dof[CENTER]  += admin->n_dof[CENTER];
  mesh->n_dof_el += mesh->n_dof[CENTER];

  if(dim > 1) {
    admin->n0_dof[EDGE]   = mesh->n_dof[EDGE];
    mesh->n_dof[EDGE]    += admin->n_dof[EDGE];
    mesh->n_dof_el += N_EDGES(dim) * mesh->n_dof[EDGE];
  }

  if(dim == 3) {
    admin->n0_dof[FACE] = mesh->n_dof[FACE];
    mesh->n_dof[FACE]  += admin->n_dof[FACE];
    mesh->n_dof_el     += N_FACES_3D * mesh->n_dof[FACE];
  }

#define REALLY_DONT_USE_THIS_CODE true
#if !REALLY_DONT_USE_THIS_CODE
  /* It is not so easy: the ordering of the node-types in the
   * DOF-pointers in the elements (i.e. el->dof[][][]) is still the
   * same as before, so: first come the vertexc nodes, then come the
   * edge nodes, then the face nodes and last the center node.
   */
  mesh->n_node_el = 0;
  for (i = 0; i < N_NODE_TYPES; i++) {
    mesh->node[i] = mesh->n_node_el;
    if (mesh->n_dof[i] > 0) {
      mesh->n_node_el += n_nodes[i];
    }
  }
#else
  mesh->node[VERTEX]  = 0;
  if (mesh->n_dof[VERTEX] > 0) {
    mesh->n_node_el = N_VERTICES(dim);
  } else {
    mesh->n_node_el = 0;
  }
    
  if(dim > 1) {
    mesh->node[EDGE]    = mesh->n_node_el;
    if (mesh->n_dof[EDGE] > 0) mesh->n_node_el += N_EDGES(dim);
  }

  if (dim == 3) {
    mesh->node[FACE]    = mesh->n_node_el;
    if (mesh->n_dof[FACE] > 0) mesh->n_node_el += N_FACES_3D;
  }

  mesh->node[CENTER]    = mesh->n_node_el;
  if (mesh->n_dof[CENTER] > 0) mesh->n_node_el += 1;
#endif
}

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

DOF_ADMIN *AI_get_dof_admin(MESH *mesh, const char *name,
			    const int n_dof[N_NODE_TYPES])
{
  FUNCNAME("AI_get_dof_admin");
  DOF_ADMIN         *admin;
  int               i;
  DOF_ADMIN_MEM_INFO *mem_info;

  admin = MEM_CALLOC(1, DOF_ADMIN);
  admin->mesh = mesh;
  admin->name = name ? strdup(name) : NULL;

  admin->dof_free         = NULL;
  admin->dof_free_size    = admin->first_hole     = 0;

  TEST_EXIT((mesh->dim > 1) || (n_dof[EDGE]==0),
    "EDGE DOFs only make sense for mesh->dim > 1!\n");

  TEST_EXIT((mesh->dim == 3) || (n_dof[FACE]==0),
    "FACE DOFs only make sense for mesh->dim == 3!\n");

  for (i = 0; i < N_NODE_TYPES; i++) admin->n_dof[i] = n_dof[i];

  mem_info = (DOF_ADMIN_MEM_INFO *)
    (admin->mem_info = MEM_ALLOC(1, DOF_ADMIN_MEM_INFO));

  mem_info->dof_matrix = newObject(sizeof(DOF_MATRIX), 10, "dof_matrix");
  mem_info->real_matrix_row =
    newObject(sizeof(MATRIX_ROW_REAL), 0, "real_matrix_row");
  mem_info->real_d_matrix_row =
    newObject(sizeof(MATRIX_ROW_REAL_D), 0, "real_d_matrix_row");
  mem_info->real_dd_matrix_row =
    newObject(sizeof(MATRIX_ROW_REAL_DD), 0, "real_dd_matrix_row");

  mem_info->dof_int_vec = newObject(sizeof(DOF_INT_VEC), 10,
				    "dof_int_vec");
  mem_info->dof_dof_vec = newObject(sizeof(DOF_DOF_VEC), 10,
				    "dof_dof_vec");
  mem_info->int_dof_vec = newObject(sizeof(DOF_DOF_VEC), 10,
				    "int_dof_vec");
  mem_info->dof_uchar_vec = newObject(sizeof(DOF_UCHAR_VEC), 10,
				      "dof_uchar_vec");
  mem_info->dof_schar_vec = newObject(sizeof(DOF_SCHAR_VEC), 10,
				      "dof_schar_vec");
  mem_info->dof_real_vec = newObject(sizeof(DOF_REAL_VEC), 10,
				     "dof_real_vec");
  mem_info->dof_real_d_vec = newObject(sizeof(DOF_REAL_D_VEC), 10,
				       "dof_real_d_vec");
  mem_info->dof_real_dd_vec = newObject(sizeof(DOF_REAL_DD_VEC), 10,
					"dof_real_dd_vec");
  mem_info->dof_ptr_vec = newObject(sizeof(DOF_PTR_VEC), 10,
				    "dof_ptr_vec");

  admin->compress_hooks.next =
    admin->compress_hooks.prev =
    &admin->compress_hooks;

  add_dof_admin_to_mesh(admin, mesh);

  return admin;
}


/*--------------------------------------------------------------------------*/
/*  Free all DOF_ADMINs in a rather brutal way, only makes sense when       */
/*  freeing an entire mesh.                                                 */
/*--------------------------------------------------------------------------*/

static void free_dof_admins(MESH *mesh)
{
  FUNCNAME("free_dof_admins");

  DOF_ADMIN **admin = mesh->dof_admin;
  DOF_ADMIN_MEM_INFO *admmeminfo;
  int i, n;
  DOF_MATRIX       *dof_matrix,      *dof_matrix_next;
  DOF_INT_VEC      *dof_int_vec,     *dof_int_vec_next;
  DOF_DOF_VEC      *dof_dof_vec,     *dof_dof_vec_next;
  DOF_DOF_VEC      *int_dof_vec,     *int_dof_vec_next;
  DOF_UCHAR_VEC    *dof_uchar_vec,   *dof_uchar_vec_next;
  DOF_SCHAR_VEC    *dof_schar_vec,   *dof_schar_vec_next;
  DOF_REAL_VEC     *dof_real_vec,    *dof_real_vec_next; 
  DOF_REAL_D_VEC   *dof_real_d_vec,  *dof_real_d_vec_next;
  DOF_REAL_DD_VEC  *dof_real_dd_vec, *dof_real_dd_vec_next;
  DOF_PTR_VEC      *dof_ptr_vec,     *dof_ptr_vec_next;

  n = mesh->n_dof_admin;
  if ((n > 0) && !admin)
    ERROR_EXIT("no mesh->dof_admin but n_dof_admin=%d\n", n);
  if ((n <= 0) && admin)
    ERROR_EXIT("found mesh->dof_admin but n_dof_admin=%d\n", n);

  for(i = 0; i < n; i++) {
#define FREE_DOF_OBJ(admin, obj)			\
    for(obj = admin[i]->obj; obj; obj = obj##_next) {	\
      obj##_next = obj->next;				\
      free_##obj(obj);					\
    }
    FREE_DOF_OBJ(admin, dof_matrix);
    FREE_DOF_OBJ(admin, dof_int_vec);
    FREE_DOF_OBJ(admin, dof_dof_vec);
    FREE_DOF_OBJ(admin, int_dof_vec);
    FREE_DOF_OBJ(admin, dof_uchar_vec);
    FREE_DOF_OBJ(admin, dof_schar_vec);
    FREE_DOF_OBJ(admin, dof_real_vec);
    FREE_DOF_OBJ(admin, dof_real_d_vec);
    FREE_DOF_OBJ(admin, dof_real_dd_vec);
    FREE_DOF_OBJ(admin, dof_ptr_vec);

    admmeminfo = (DOF_ADMIN_MEM_INFO *)admin[i]->mem_info;

    deleteObject(admmeminfo->dof_matrix);
    deleteObject(admmeminfo->real_matrix_row);
    deleteObject(admmeminfo->real_d_matrix_row);
    deleteObject(admmeminfo->real_dd_matrix_row);
    deleteObject(admmeminfo->dof_int_vec);
    deleteObject(admmeminfo->dof_dof_vec);
    deleteObject(admmeminfo->int_dof_vec);
    deleteObject(admmeminfo->dof_uchar_vec);
    deleteObject(admmeminfo->dof_schar_vec);
    deleteObject(admmeminfo->dof_real_vec);
    deleteObject(admmeminfo->dof_real_d_vec);
    deleteObject(admmeminfo->dof_real_dd_vec);
    deleteObject(admmeminfo->dof_ptr_vec);

    MEM_FREE(admin[i]->mem_info, 1, DOF_ADMIN_MEM_INFO);
    MEM_FREE(admin[i]->dof_free, admin[i]->dof_free_size, DOF_FREE_UNIT);
  }

  return;
}


/*--------------------------------------------------------------------------*/
/*  allocate memory for a new mesh, and build a simply linked list of these */
/*--------------------------------------------------------------------------*/

void AI_advance_cookies_rec(MESH *mesh)
{
  FUNCNAME("AI_advance_cookies_rec");
  int i;
  MESH_MEM_INFO *mem_info;

  TEST_EXIT(mesh,"Oops, did not get a mesh!\n");
  mem_info = (MESH_MEM_INFO *)mesh->mem_info;

  mesh->cookie += 1;

  for(i = 0; i < mem_info->n_slaves; i++)
    AI_advance_cookies_rec(mem_info->slaves[i]);

  return;
}

MESH *
_AI_get_mesh(int dim, const char *name,
	     const MACRO_DATA *macro_data,
	     NODE_PROJECTION *(*init_node_proj)(MESH *, MACRO_EL *, int),
	     AFF_TRAFO *(*init_wall_trafos)(MESH *, MACRO_EL *, int wall),
	     bool strict_periodic)
{
  FUNCNAME("get_mesh");
  MESH            *mesh;
  MESH_MEM_INFO   *mem_info;

  mesh =     MEM_CALLOC(1,MESH);

  mesh->dim  = dim;
  mesh->name = name ? strdup(name) : NULL;

  mem_info = (MESH_MEM_INFO *)
    (mesh->mem_info = MEM_CALLOC(1, MESH_MEM_INFO));

  mem_info->element = newObject(sizeof(EL), 0, "element");

  if(mesh->dim == 3)
    mem_info->rc_list = NULL;

  mem_info->real_d = _newObject(sizeof(REAL_D), sizeof(REAL), 0, "real_d");

  mem_info->leaf_data = NULL;

  mem_info->next_trace_id = 0;

  /* Flags them as invalid, originally */
  mesh->n_vertices =
    mesh->n_edges =
    mesh->n_faces =
    mesh->per_n_vertices =
    mesh->per_n_edges =
    mesh->per_n_faces = -1;
  
  if (macro_data) {
    _AI_macro_data2mesh(mesh, macro_data,
			init_node_proj, init_wall_trafos, strict_periodic);
  }

#if ALBERTA_DEBUG
  srand(13);
#else
  srand((unsigned int) time(NULL));
#endif

  mesh->cookie = rand();

  mesh->trace_id = -1;

  check_mesh(mesh);

  return mesh;
}

void free_mesh(MESH *mesh)
{
  FUNCNAME("free_mesh");
  MESH_MEM_INFO *mem_info;
  int i;

  if (!mesh) {
    ERROR("No mesh specified!\n");
    return;
  }

  mem_info = (MESH_MEM_INFO *)mesh->mem_info;

/* If this mesh is itself a slave mesh, then unchain it first.              */
  if(mem_info->master) unchain_submesh(mesh);
/* Free all slave meshes...                                                 */

  for (i = 0; i < mem_info->n_slaves; i++) {
    unchain_submesh(mem_info->slaves[i]);
  }

  /* free all elements/dofs/... */
  if (mem_info->dof_ptrs) {
    deleteObject(mem_info->dof_ptrs);
  }

  for (i = 0; i < N_NODE_TYPES; i++) {
    if (mem_info->dofs[i]) {
      deleteObject(mem_info->dofs[i]);
    }
  }

  deleteObject(mem_info->element);
  if (mem_info->rc_list)
    free_rc_list(mesh, (RC_LIST_EL *)mem_info->rc_list);

  deleteObject(mem_info->real_d);

  if (mem_info->leaf_data) {
    deleteObject(mem_info->leaf_data);
  }

  AI_free_dof_vec_list(mesh);
  if (mesh->is_periodic) {
    AI_free_dof_vec_list_np(mesh);
  }

  MEM_FREE(mem_info->coords, mem_info->count, REAL_D);

  MEM_FREE(mem_info, 1, MESH_MEM_INFO);

  MEM_FREE(mesh->macro_els, mesh->n_macro_el, MACRO_EL);

  free_dof_admins(mesh);

  MEM_FREE(mesh->dof_admin, mesh->n_dof_admin, DOF_ADMIN);

  if(mesh->name) free((char *)mesh->name);

  if (mesh->is_periodic) {
    if (mesh->n_wall_trafos) {
      MEM_FREE(mesh->wall_trafos,
	       mesh->n_wall_trafos*(sizeof(AFF_TRAFO *)+sizeof(AFF_TRAFO)),
	       char);
    }
  }

  MEM_FREE(mesh, 1, MESH);

  return;
}


MESH *
check_and_get_mesh(int dim, int dow, int debug,
		   const char *version, const char *name,
		   const MACRO_DATA *macro_data,
		   NODE_PROJECTION *(*init_node_proj)(MESH *, MACRO_EL *, int),
		   AFF_TRAFO *(*init_wall_trafos)(MESH *, MACRO_EL *, int wall))
{
  FUNCNAME("check_and_get_mesh");
  int      error = 0;

  if (dow != DIM_OF_WORLD)
  {
    ERROR("%s = %d, but you are using a lib with %s = %d\n",
	  "DIM_OF_WORLD", dow, "DIM_OF_WORLD", DIM_OF_WORLD);
    error++;
  }
  if (dim > DIM_MAX)
  {
    ERROR("dim == %d > %d == DIM_MAX!\n", dim, DIM_MAX);
    error++;
  }
  if (debug != ALBERTA_DEBUG)
  {
    ERROR("%s = %d, but you are using a lib with %s = %d\n",
	  "DEBUG", debug, "DEBUG", ALBERTA_DEBUG);
    error++;
  }
  if (strcmp(version,ALBERTA_VERSION))
  {
    ERROR("you are using %s but a lib with %s\n", version, ALBERTA_VERSION);
    error++;
  }
  if (error) ERROR_EXIT("Bye!\n");

  return _AI_get_mesh(dim, name, macro_data,
		      init_node_proj, init_wall_trafos, false);
}


/*--------------------------------------------------------------------------*/
/*  memory management for DOF pointers                                      */
/*--------------------------------------------------------------------------*/

#if ALBERTA_DEBUG
static const int max_dof_ptrs[4] = {1, 3, 7, 15};
#endif

static DOF **get_dof_ptrs(MESH *mesh)
{
  FUNCNAME("get_dof_ptrs");
  int i, n;
  DOF **ptrs;
  MESH_MEM_INFO *mem_info;

  DEBUG_TEST_EXIT(mesh, "mesh=NULL\n");
  DEBUG_TEST_EXIT(mesh->mem_info, "mesh \"%s\": mesh->mem_info=NULL\n",
		  mesh->name);
  mem_info = (MESH_MEM_INFO*)(mesh->mem_info);
  n = mesh->n_node_el;
  if (n <= 0)
    return(NULL);

  DEBUG_TEST_EXIT(n <= max_dof_ptrs[mesh->dim],
		  "mesh \"%s\": too many nodes: %d > %d\n",
		  mesh->name, n, max_dof_ptrs[mesh->dim]);
  DEBUG_TEST_EXIT(mem_info->dof_ptrs,
		  "mesh \"%s\": mesh->mem_info->dof_ptrs=NULL\n", mesh->name);

  ptrs = (DOF **)getMemory(mem_info->dof_ptrs);
  for (i = 0; i < n; i++)
    ptrs[i] = NULL;

  return(ptrs);
}


static void free_dof_ptrs(DOF **ptrs, MESH *mesh)
{
  FUNCNAME("free_dof_ptrs");
  int      n;
  MESH_MEM_INFO *mem_info;

  DEBUG_TEST_EXIT(ptrs,"ptrs=NULL\n");
  DEBUG_TEST_EXIT(mesh, "mesh=NULL\n");
  DEBUG_TEST_EXIT(mesh->mem_info,
		  "mesh \"%s\": mesh->mem_info=NULL\n", mesh->name);
  n = mesh->n_node_el;
  if (n <= 0)
    return;

  DEBUG_TEST_EXIT(n <= max_dof_ptrs[mesh->dim],
		  "mesh \"%s\": too many nodes: %d > %d\n",
		  mesh->name, n, max_dof_ptrs[mesh->dim]);

  mem_info = (MESH_MEM_INFO*)(mesh->mem_info);

  DEBUG_TEST_EXIT(mem_info->dof_ptrs,
		  "mesh \"%s\": mesh->mem_info->dof_ptrs=NULL\n", mesh->name);

  freeMemory((void *)ptrs, mem_info->dof_ptrs);
  return;
}

void AI_get_dof_ptr_list(MESH *mesh)
{
  FUNCNAME("AI_get_dof_ptr_list");
  MESH_MEM_INFO *mem_info;

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

  if (mesh->n_node_el == 0) {
    return;
  }

  mem_info = (MESH_MEM_INFO*)mesh->mem_info;
  DEBUG_TEST_EXIT(mem_info, "No mesh memory info structure present!\n");

  mem_info->dof_ptrs = newObject(mesh->n_node_el * sizeof(DOF*), 1000,
				 "dof_ptrs");
}

/*--------------------------------------------------------------------------*/
/*  memory management for DOFs                                              */
/*--------------------------------------------------------------------------*/

#define DOF_BLOCK 1000

/****************************************************************************/
/* AI_reactivate_dof(mesh, el):                                             */
/* When coarsening the mesh, we must replace all -1 settings with new DOF   */
/* indices. We no longer allocate new memory for DOF pointers in the        */
/* el->dof[] vector - this memory was also freed in old versions depending  */
/* on the "mesh->preserve_coarse_dofs" setting.                             */
/****************************************************************************/

void AI_reactivate_dof(MESH *mesh, const EL *el,
		       DOF **edge_twins, DOF **face_twins)
{
  FUNCNAME("AI_reactivate_dof");
  DOF_ADMIN *admin;
  int       i, j, n, n0, node;

  DEBUG_TEST_EXIT(mesh,"mesh=NULL\n");
  DEBUG_TEST_EXIT(el, "el=NULL\n");

  for (i = 0; i < mesh->n_dof_admin; i++) {
    admin = mesh->dof_admin[i];
    DEBUG_TEST_EXIT(admin, "mesh \"%s\": no dof_admin[%d]\n", mesh->name, i);

    if(mesh->n_dof[CENTER]) {
      node = mesh->node[CENTER];
      n = admin->n_dof[CENTER];

      if(n) {
	n0 = admin->n0_dof[CENTER];

	DEBUG_TEST_EXIT(n+n0 <= mesh->n_dof[CENTER],
	  "dof_admin \"%s\": n=%d, n0=%d too large: ndof[CENTER]=%d\n",
	   admin->name, n, n0, mesh->n_dof[CENTER]);

	if(el->dof[node][n0] == -1)
	  for (j = 0; j < n; j++)
	    el->dof[node][n0+j] = get_dof_index(admin);
      }
    }

#if DIM_MAX > 1
    if(mesh->n_dof[EDGE]) {
      int dim = mesh->dim;
      int k;

      for(k = 0; k < N_EDGES(dim); k++) {
	node = mesh->node[EDGE] + k;
	n = admin->n_dof[EDGE];

	if(n) {
	  n0 = admin->n0_dof[EDGE];

	  DEBUG_TEST_EXIT(n+n0 <= mesh->n_dof[EDGE],
	    "dof_admin \"%s\": n=%d, n0=%d too large: ndof[EDGE]=%d\n",
	     admin->name, n, n0, mesh->n_dof[EDGE]);

	  if(el->dof[node][n0] == -1) {
	    if ((admin->flags & ADM_PERIODIC) &&
		edge_twins && edge_twins[k] && edge_twins[k][n0] != -1) {
	      for (j = 0; j < n; j++)
		el->dof[node][n0+j] = edge_twins[k][n0+j];
	    } else {
	      for (j = 0; j < n; j++)
		el->dof[node][n0+j] = get_dof_index(admin);
	    }
	  }
	}
      }
    }

#if DIM_MAX > 2
    if(mesh->n_dof[FACE]) {
      int k;
      for(k = 0; k < N_FACES_3D; k++) {
	node = mesh->node[FACE] + k;
	n = admin->n_dof[FACE];

	if(n) {
	  n0 = admin->n0_dof[FACE];

	  DEBUG_TEST_EXIT(n+n0 <= mesh->n_dof[FACE],
	    "dof_admin \"%s\": n=%d, n0=%d too large: ndof[FACE]=%d\n",
	     admin->name, n, n0, mesh->n_dof[FACE]);

	  if(el->dof[node][n0] == -1) {
	    if ((admin->flags & ADM_PERIODIC) &&
		face_twins && face_twins[k] && face_twins[k][n0] != -1) {
	      for (j = 0; j < n; j++)
		el->dof[node][n0+j] = face_twins[k][n0+j];
	    } else {
	      for (j = 0; j < n; j++)
		el->dof[node][n0+j] = get_dof_index(admin);
	    }
	  }
	}
      }
    }
#endif
#endif
  }

  return;
}

DOF *AI_get_dof_memory(MESH *mesh, int position)
{
  FUNCNAME("AI_get_dof_memory");
  MESH_MEM_INFO *mem_info;


  DEBUG_TEST_EXIT(mesh, "mesh=NULL\n");
  mem_info = (MESH_MEM_INFO *)mesh->mem_info;
  DEBUG_TEST_EXIT(mem_info, "mesh \"%s\": mesh->mem_info=NULL\n", mesh->name);

  DEBUG_TEST_EXIT(position >= 0 && position < N_NODE_TYPES,
    "mesh \"%s\": unknown position %d\n", mesh->name, position);

  DEBUG_TEST_EXIT(mesh->n_dof[position], "mesh->n_dof[%d] == 0!\n", position);

  return (DOF *)getMemory(mem_info->dofs[position]);
}

void AI_free_dof_memory(DOF *dof, MESH *mesh, int position)
{
  FUNCNAME("AI_get_dof_memory");
  MESH_MEM_INFO *mem_info;


  DEBUG_TEST_EXIT(mesh, "mesh=NULL\n");
  mem_info = (MESH_MEM_INFO *)mesh->mem_info;
  DEBUG_TEST_EXIT(mem_info, "mesh \"%s\": mesh->mem_info=NULL\n", mesh->name);

  DEBUG_TEST_EXIT(position >= 0 && position < N_NODE_TYPES,
    "mesh \"%s\": unknown position %d\n", mesh->name, position);

  DEBUG_TEST_EXIT(mesh->n_dof[position], "mesh->n_dof[%d] == 0!\n", position);

  freeMemory((void *)dof, mem_info->dofs[position]);
}

DOF *_AI_get_dof(MESH *mesh, int position, bool alloc_index)
{
  FUNCNAME("get_dof");
  DOF_ADMIN *admin;
  DOF     *dof;
  int     i, j, n, n0, ndof;

  ndof = mesh->n_dof[position];
  if (ndof <= 0) return(NULL);

  dof = AI_get_dof_memory(mesh, position);

  for (i = 0; i < mesh->n_dof_admin; i++) {
    admin = mesh->dof_admin[i];
    DEBUG_TEST_EXIT(admin, "mesh \"%s\": no dof_admin[%d]\n", mesh->name, i);

    n  = admin->n_dof[position];
    n0 = admin->n0_dof[position];

    DEBUG_TEST_EXIT(n+n0 <= ndof,
		"dof_admin \"%s\": n=%d, n0=%d too large: ndof=%d\n",
		admin->name, n, n0, ndof);

    if (alloc_index) {
      for (j = 0; j < n; j++) {
	dof[n0+j] = get_dof_index(admin);
      }
    }
  }

  return dof;
}

DOF *get_dof(MESH *mesh, int position)
{
  return _AI_get_dof(mesh, position, true);
}

/* Get a "periodic copy" of "twin" where some DOF_ADMINs are periodic,
 * others aren't.
 */
DOF *get_periodic_dof(MESH *mesh, int position, const DOF *twin)
{
  FUNCNAME("get_dof");
  DOF_ADMIN *admin;
  DOF     *dof;
  int     i, j, n, n0, ndof;

  ndof = mesh->n_dof[position];
  if (ndof <= 0) return(NULL);

  dof = AI_get_dof_memory(mesh, position);

  for (i = 0; i < mesh->n_dof_admin; i++) {
    admin = mesh->dof_admin[i];
    DEBUG_TEST_EXIT(admin, "mesh \"%s\": no dof_admin[%d]\n", mesh->name, i);

    n  = admin->n_dof[position];
    n0 = admin->n0_dof[position];

    DEBUG_TEST_EXIT(n+n0 <= ndof,
		"dof_admin \"%s\": n=%d, n0=%d too large: ndof=%d\n",
		admin->name, n, n0, ndof);

    if (twin && (admin->flags & ADM_PERIODIC)) {
      for (j = 0; j < n; j++)
	dof[n0+j] = twin[n0+j];
    } else {
      for (j = 0; j < n; j++)
	dof[n0+j] = get_dof_index(admin);
    }
  }

  return(dof);
}

/* "flags" can take the same values as DOF_ADMIN->flags:
 * ADM_PRESERVE_COARSE_DOFS: dof index is not freed if this admin
 * preserves coarse DOFs. The DOF memory is also not freed.
 * ADM_PERIODIC: dof index is not freed if the admin is periodic.
 */
void free_dof(DOF *dof, MESH *mesh, int position, FLAGS flags)
{
  FUNCNAME("free_dof");
  DOF_ADMIN *admin;
  int     i, j, n, n0, ndof;
  MESH_MEM_INFO *mem_info;
  FLAGS admflags;

  DEBUG_TEST_EXIT(mesh, "mesh=NULL\n");
  mem_info = (MESH_MEM_INFO*)mesh->mem_info;
  DEBUG_TEST_EXIT(mem_info,"mesh \"%s\": mesh->mem_info=NULL\n", mesh->name);

  DEBUG_TEST_EXIT(position >= 0 && position < N_NODE_TYPES,
	      "mesh \"%s\": unknown position %d\n",mesh->name, position);

  ndof = mesh->n_dof[position];
  (void)ndof;

  DEBUG_TEST_EXIT(!ndof || dof,
	      "dof = NULL, but ndof=%d\n", ndof);
  DEBUG_TEST_EXIT(ndof || !dof,
	      "dof != NULL, but ndof=0\n");

  DEBUG_TEST_EXIT(mem_info->dofs[position],
	      "mesh \"%s\": no memory management present for %d DOFs.",
	      mesh->name, position);

  for (i = 0; i < mesh->n_dof_admin; i++) {
    admin = mesh->dof_admin[i];
    DEBUG_TEST_EXIT(admin, "mesh \"%s\": no dof_admin[%d]\n", mesh->name, i);

    admflags = flags & admin->flags;

    n0 = admin->n0_dof[position];

#if 0
    if (admin->stride) {
      n = admin->n_dof_stride[position];
      if ((admflags & ADM_PRESERVE_COARSE_DOFS) == 0) {
	for (j = 0; j < n; j++) {
	  if (!(admflags & ADM_PERIODIC)) {
	    free_dof_index(admin, dof[n0+j], true);
	  }
	  /* Mark this DOF as unused! For stride DOFs only one index
	   * is stored in the mesh.
	   */
	  dof[n0+j] = -1;
	}
      }
      n0 += n;
      n = admin->n_dof[position] - n;
    } else
#endif
      n = admin->n_dof[position];

    DEBUG_TEST_EXIT(n+n0 <= ndof,
		"dof_admin \"%s\": n=%d, n0=%d too large: ndof=%d\n",
		admin, n, n0, ndof);

    if ((admflags & ADM_PRESERVE_COARSE_DOFS) == 0) {
      for (j = 0; j < n; j++) {
	if (!(admflags & ADM_PERIODIC)) {
	  free_dof_index(admin, dof[n0+j]);
	}
	dof[n0+j] = DOF_UNUSED;  /* Mark this DOF as unused! */
      }
    }
  }
 
  if ((flags & ADM_PRESERVE_COARSE_DOFS) == 0) {
    /* Also free the DOF memory. */
    freeMemory((void *)dof, mem_info->dofs[position]);
  }

  return;
}

/****************************************************************************/
/* AI_get_dof_list(mesh, position):                                         */
/* Allocate a memory management object to administrate DOFs. The el->dof[]  */
/* entries will point into this memory space. Please note that we will also */
/* allocate space for freed coarse DOFs - the allocated DOFs will have value*/
/* -1 to show that they are no longer being used.                           */
/*                                                                          */
/* This routine is also called from read_mesh.c.                            */
/****************************************************************************/

void AI_get_dof_list(MESH *mesh, int position)
{
  FUNCNAME("AI_get_dof_list");
  MESH_MEM_INFO *mem_info;

  DEBUG_TEST_EXIT(mesh, "No mesh given!\n");
  DEBUG_TEST_EXIT(position >=0 && position < N_NODE_TYPES,
	      "Illegal position %d!\n", position);
  DEBUG_TEST_EXIT(mesh->n_dof[position],
		  "Mesh has no DOFs on this position!\n");

  mem_info = (MESH_MEM_INFO*)mesh->mem_info;

  DEBUG_TEST_EXIT(mem_info, "No mesh memory info structure found!\n");

  mem_info->dofs[position] =
    newObject(sizeof(DOF)*mesh->n_dof[position], DOF_BLOCK, "dof[pos]");

  return;
}


/*--------------------------------------------------------------------------*/
/*  memory management for FE_SPACE and DOF_ADMIN structures                 */
/*--------------------------------------------------------------------------*/

/* transfer_dofs(mesh, new_admin, old_dof, position,
 *               is_coarse_dof, periodic_twin):
 *
 * We allocate and return memory for a new dof pointer in an el->dof[]
 * entry. The field is filled either with new DOF indices for each
 * admin or with -1 to mark it as unused. If "periodic_twin" != NULL
 * and (new_admin->flags & ADM_PERIODIC), then dof indices will not be
 * allocated but copied over from periodic_twin.
 */
static DOF *transfer_dofs(MESH *mesh, DOF_ADMIN *new_admin,
			  DOF *old_dof, int position,
			  bool is_coarse_dof, const DOF *periodic_twin)
{
  /* FUNCNAME("transfer_dofs"); */
  DOF_ADMIN *admin;
  DOF       *new_dof = NULL;
  int       i, j, n, n0, ndof = mesh->n_dof[position];

  if (ndof <= 0) return NULL;

  new_dof = AI_get_dof_memory(mesh, position);

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

    n  = admin->n_dof[position];
    n0 = admin->n0_dof[position];

    for (j = 0; j < n; j++) {
      if (admin == new_admin) {
	if ((admin->flags & ADM_PERIODIC) && periodic_twin) {
	  new_dof[n0+j] = periodic_twin[n0+j];
	} else if (!is_coarse_dof ||
		   (admin->flags & ADM_PRESERVE_COARSE_DOFS)) {
	  new_dof[n0+j] = get_dof_index(admin);
	} else {
	  new_dof[n0+j] = -1;
	}
      } else {
	if(old_dof) {
	  new_dof[n0+j] = old_dof[n0 + j];
	} else {
	  new_dof[n0+j] = -1;
	}
      }
    }
  }

  return new_dof;
}


#include "memory_0d.c"
#include "memory_1d.c"
#if DIM_MAX > 1
#include "memory_2d.c"
#if DIM_MAX > 2
#include "memory_3d.c"
#endif
#endif

static inline int fe_space_ref(const FE_SPACE *fe_space)
{
  FE_SPACE *mutable = (FE_SPACE *)fe_space;
  
  return ++mutable->ref_cnt;
}

static inline int fe_space_unref(const FE_SPACE *fe_space)
{
  FE_SPACE *mutable = (FE_SPACE *)fe_space;
  
  return --mutable->ref_cnt;
}

const FE_SPACE *copy_fe_space(const FE_SPACE *fe_space)
{
#if 0
  FE_SPACE *clone;

  if (fe_space->bas_fcts == NULL) {
    clone = (FE_SPACE *)get_dof_space(fe_space->mesh,
				      fe_space->name,
				      fe_space->admin->n_dof,
				      fe_space->admin->flags);
  } else if (fe_space->admin) {
    clone = (FE_SPACE *)get_fe_space(fe_space->mesh,
				     fe_space->name,
				     fe_space->bas_fcts,
				     fe_space->rdim,
				     fe_space->admin->flags);
  } else {
    clone       = MEM_CALLOC(1, FE_SPACE);
    *clone      = *fe_space;
    clone->name = fe_space->name ? strdup(fe_space->name) : NULL;
    CHAIN_INIT(clone);
  }

  return clone;
#else
  if (fe_space) {
    CHAIN_DO(fe_space, const FE_SPACE) {
      fe_space_ref(fe_space);
      fe_space_ref(fe_space->unchained);
    } CHAIN_WHILE(fe_space, const FE_SPACE);
  }

  return fe_space;
#endif
}

/* Same as copy_fe_space(), but with a potentially different range dimension. */
const FE_SPACE *clone_fe_space(const FE_SPACE *fe_space, int rdim)
{
  if (fe_space->bas_fcts == NULL || fe_space->rdim == rdim) {
    return copy_fe_space(fe_space);
  } else {
    return get_fe_space(fe_space->mesh,
                        fe_space->name,
                        fe_space->bas_fcts,
                        rdim,
                        fe_space->admin->flags);
  }
}


/*
 * get_fe_space(mesh, name, n_dof, bas_fcts, flags):
 *
 * Unlike in older versions of ALBERTA, this routine can be called at
 * any time, even after mesh refinement. As this is implemented at the
 * price of temporary memory usage and CPU time, it should still be
 * avoided. DK.
 *
 * Actually, extra temporary memory usage and computing power is only
 * need when the underlying DOF_ADMIN does not exist yet. cH.
 */
const FE_SPACE *get_fe_space(MESH *mesh,
			     const char *name,
			     const BAS_FCTS *bas_fcts,
			     int rdim,
			     FLAGS adm_flags)
{
  FUNCNAME("get_fe_space");
  FE_SPACE *fe_space, *fe_space_chain, *fesp;
  BAS_FCTS *bfcts_chain;
  char fe_name[1024];
  const char *oname = name;
  int maxdim;

  TEST_EXIT(bas_fcts->dim == mesh->dim,
	    "Dimension of basis functions %d "
	    "does not match mesh dimension %d!\n",
	    bas_fcts->dim, mesh->dim);

  if (oname && oname != bas_fcts->name) {
    snprintf(fe_name, sizeof(fe_name), "%s (@%s)", oname, bas_fcts->name);
    name = fe_name;
  } else {
    name = bas_fcts->name;
  }
  if (bas_fcts->trace_admin >= 0) {
    MESH *trace_mesh = lookup_submesh_by_id(mesh, bas_fcts->trace_admin);
    TEST_EXIT(trace_mesh != NULL,
	      "Required trace-mesh with id %d not found.\n",
	      bas_fcts->trace_admin);
    fe_space =
      (FE_SPACE *)get_dof_space(trace_mesh, name, bas_fcts->n_dof, adm_flags);
    fe_space->mesh = mesh; /* but the admin keeps the trace-mesh */
  } else {
    fe_space =
      (FE_SPACE *)get_dof_space(mesh, name, bas_fcts->n_dof, adm_flags);
  }
  fe_space->bas_fcts = bas_fcts;
  fe_space->rdim     = rdim;

  if (CHAIN_SINGLE(bas_fcts)) {
    fe_space->unchained = fe_space;
  } else {
    /* make a flat copy */
    fe_space->unchained = (fesp = MEM_ALLOC(1, FE_SPACE));
    --fe_space->ref_cnt; /* unchained has been deleted here */
    *fesp = *fe_space;
    CHAIN_INIT(fesp);
    fesp->bas_fcts = bas_fcts->unchained;
    if (fesp->name) {
      fesp->name = strdup(fesp->name);
    }
  }

  /* If bas_fcts is a direct sum, then aquire an fe-space for each
   * component and chain the fe-spaces together.
   */
  maxdim = bas_fcts->rdim;
  CHAIN_FOREACH(bfcts_chain, bas_fcts, BAS_FCTS) {
    if (oname && oname != bas_fcts->name) {
      snprintf(fe_name, sizeof(fe_name), "%s (@%s)", oname, bfcts_chain->name);
    } else {
      name = bfcts_chain->name;
    }
    if (bfcts_chain->trace_admin >= 0) {
      MESH *trace_mesh = lookup_submesh_by_id(mesh, bfcts_chain->trace_admin);
      TEST_EXIT(trace_mesh != NULL,
		"Required trace-mesh with id %d not found.\n",
		bfcts_chain->trace_admin);
      fe_space_chain = (FE_SPACE *)get_dof_space(
	trace_mesh, name, bfcts_chain->n_dof, adm_flags);
      fe_space_chain->mesh = mesh; /* but the admin keeps the trace-mesh */
    } else {
      fe_space_chain =
	(FE_SPACE *)get_dof_space(mesh, name, bfcts_chain->n_dof, adm_flags);
    }
    fe_space_chain->bas_fcts = bfcts_chain;
    fe_space_chain->rdim     = rdim;
    maxdim = MAX(bfcts_chain->rdim, maxdim);

    fe_space_chain->unchained = (fesp = MEM_ALLOC(1, FE_SPACE));
    --fe_space_chain->ref_cnt; /* unchained has been deleted here */
    *fesp = *fe_space_chain;
    CHAIN_INIT(fesp);
    fesp->bas_fcts = bfcts_chain->unchained;
    if (fesp->name) {
      fesp->name = strdup(fesp->name);
    }
    CHAIN_ADD_TAIL(fe_space, fe_space_chain);
  }
  if (rdim != -1 && maxdim > rdim) {
    WARNING("%d dimensional range requested < "
	    "range dimension %d of basis functions",
	    rdim, maxdim);
  }

  TEST_EXIT(VECTOR_BASIS_FUNCTIONS || maxdim == 1,
	    "DIM_OF_WORLD-valued basis functions not supported in this "
	    "version of ALBERTA. re-configure and re-compile the library "
	    "without \"--disable-vector-basis-functions\".\n");
  
  return fe_space;
}

const FE_SPACE *get_dof_space(MESH *mesh, 
			      const char *name,
			      const int n_dof[N_NODE_TYPES],
			      FLAGS flags)
{
  FUNCNAME("get_dof_space");
  DOF_ADMIN         *admin = NULL;
  FE_SPACE          *fe_space;
  int               i, j, good_admin;

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

  fe_space = MEM_CALLOC(1, FE_SPACE);
  fe_space->name = name ? strdup(name) : NULL;

/****************************************************************************/
/* Search for a fitting DOF_ADMIN to serve the required n_dof field and     */
/* preserve_coarse_dofs status. Both have to match exactly!                 */
/****************************************************************************/
    for (i = 0; i < mesh->n_dof_admin; i++) {
      admin = mesh->dof_admin[i];
      good_admin = true;

      for (j = 0; j < N_NODE_TYPES; j++) {
	if (admin->n_dof[j] != n_dof[j]) {
	  good_admin = false;
	  break;
	}
      }
      if (admin->flags != flags)
	good_admin = false;

      if(good_admin == true) break;

      admin = NULL;
    }

    if (!admin) {
/****************************************************************************/
/* We did not find a fitting admin. In this case, we must adjust the        */
/* mem_info->dof_ptrs and mem_info->dofs[i] fields.                         */
/****************************************************************************/
      int            old_n_node_el;
      int            old_n_dof[N_NODE_TYPES];
      int            old_node[N_NODE_TYPES];
      void          *old_dof_ptrs;
      void          *old_dofs[N_NODE_TYPES];
      MESH_MEM_INFO *mem_info = (MESH_MEM_INFO *)mesh->mem_info;

      if (!mesh->n_dof[VERTEX] &&
	  (!n_dof[VERTEX] ||
	   (!(flags & ADM_PERIODIC) && mesh->is_periodic))) {
	/* The first DOF_ADMIN with vertex DOFs is used to determine
	 * things like the relative orientation of elements etc. On
	 * periodic meshes this should be a periodic DOF_ADMIN, so we
	 * make sure that this is the case.
	 *
	 * get_vertex_admin() will re-enter get_fe_space() (this
	 * function), but this is ok, it will not enter this
	 * if-clause.
	 */
	(void)get_vertex_admin(mesh, ADM_PERIODIC);
      }

      old_n_node_el            = mesh->n_node_el;
      old_dof_ptrs             = mem_info->dof_ptrs;
      for(i = 0; i < N_NODE_TYPES; i++) {
	old_n_dof[i] = mesh->n_dof[i];
	old_node[i]  = mesh->node[i];
	old_dofs[i]  = mem_info->dofs[i];
      }

      admin = AI_get_dof_admin(mesh, name, n_dof);
      admin->flags = flags;

/* We must now adjust the mem_info->dofs[i] memory management object.       */
      for(i = 0; i < N_NODE_TYPES; i++)
	if(n_dof[i])
	  AI_get_dof_list(mesh, i);

/* Did mesh->n_node_el change while adding the new admin? If so, we have to */
/* adjust the mem_info->dof_ptrs memory management object.                  */
      if(old_n_node_el < mesh->n_node_el)
	AI_get_dof_ptr_list(mesh);

/* Now we magically adjust all pointers by traversing the mesh. :-)         */

      switch(mesh->dim) {
      case 0:
	adjust_dofs_and_dof_ptrs_0d(mesh, admin,
				    old_n_node_el, old_n_dof, old_node);
	break;
      case 1:
	adjust_dofs_and_dof_ptrs_1d(mesh, admin,
				    old_n_node_el, old_n_dof, old_node);
	break;
#if DIM_MAX > 1
      case 2:
	adjust_dofs_and_dof_ptrs_2d(mesh, admin,
				    old_n_node_el, old_n_dof, old_node);
	break;
#if DIM_MAX >= 3
      case 3:
	adjust_dofs_and_dof_ptrs_3d(mesh, admin,
				    old_n_node_el, old_n_dof, old_node);
	break;
#endif
#endif
      default:
	ERROR_EXIT("Illegal mesh dimension!\n");
      }
/* Release old memory management objects.                                   */

      if(old_n_node_el < mesh->n_node_el && old_dof_ptrs)
	deleteObject(old_dof_ptrs);

      for(i = 0; i < N_NODE_TYPES; i++)
	if(n_dof[i] && old_dofs[i])
	  deleteObject(old_dofs[i]);
    }

    fe_space->admin     = admin;
    fe_space->bas_fcts  = NULL;
    fe_space->mesh      = mesh;
    fe_space->unchained = fe_space;
    fe_space->rdim      = -1;
    fe_space->ref_cnt   = 2; /* unchained counts twice */

    CHAIN_INIT(fe_space);

    return fe_space;
}

void free_fe_space(const FE_SPACE *fe_space)
{
  FUNCNAME("free_fe_space");
  DBL_LIST_NODE *next;
  const FE_SPACE *chain;
  bool destruction = false;
  bool direct_sum  = false;

  (void)destruction;
  (void)direct_sum;

  if (fe_space == NULL) {
    ERROR("No fe_space specified!\n");
    return;
  }

  CHAIN_FOREACH_SAFE(chain, next, fe_space, const FE_SPACE) {
    direct_sum = true;

    fe_space_unref(chain);
    fe_space_unref(chain->unchained);

    DEBUG_TEST_EXIT(chain->ref_cnt >= 0 && chain->unchained->ref_cnt >= 0,
		    "Negative reference counts.\n");

    if (chain->unchained != chain && chain->unchained->ref_cnt == 0) {
      if (chain->unchained->name != NULL) {
	free((void *)chain->unchained->name);
      }
      MEM_FREE(chain->unchained, 1, FE_SPACE);
    }

    if (chain->ref_cnt == 0) {
      if(chain->name) {
	free((char *)chain->name);
      }
      MEM_FREE(chain, 1, FE_SPACE);
      destruction = true;
    }
  }

  fe_space_unref(fe_space);
  fe_space_unref(fe_space->unchained);

  DEBUG_TEST_EXIT(fe_space->ref_cnt >= 0 && fe_space->unchained->ref_cnt >= 0,
		  "Negative reference counts.\n");

  if (fe_space->unchained != fe_space && fe_space->unchained->ref_cnt == 0) {
    if (fe_space->unchained->name != NULL) {
      free((void *)fe_space->unchained->name);
    }
    MEM_FREE(fe_space->unchained, 1, FE_SPACE);
  }

  DEBUG_TEST_EXIT(!direct_sum || destruction == (fe_space->ref_cnt == 0),
		  "Reference counts are inconsistent within different "
		  "members of a direct sum.\n");

  if (fe_space->ref_cnt == 0) {
    if(fe_space->name) {
      free((char *)fe_space->name);
    }
    MEM_FREE(fe_space, 1, FE_SPACE);
  }
}


/****************************************************************************/
/* AI_fill_missing_dofs(mesh):                                              */
/* This routine allocates currently unused element DOF pointers since this  */
/* is not done during read_mesh(). These corresponding values pointed to    */
/* will be -1. The reason: write_mesh() does not save these pointers in     */
/* the file, since this information is unnecessary to recreate DOF_ADMINs.  */
/*                                                                          */
/* called by read_mesh().                                                   */
/****************************************************************************/

void AI_fill_missing_dofs(MESH *mesh)
{
  FUNCNAME("AI_fill_missing_dofs");

  DEBUG_TEST_EXIT(mesh, "Did not supply a mesh!\n");

  switch(mesh->dim) {
  case 0:
    break;
  case 1:
    fill_missing_dofs_1d(mesh);
    break;
#if DIM_MAX > 1
  case 2:
    fill_missing_dofs_2d(mesh);
    break;
#if DIM_MAX >= 3
  case 3:
    fill_missing_dofs_3d(mesh);
    break;
#endif
#endif
  default:
    ERROR_EXIT("Illegal mesh dimension!\n");
  }

  return;
}


/*--------------------------------------------------------------------------*/
/*  memory management for leaf_data                                         */
/*--------------------------------------------------------------------------*/

#define LEAF_DATA_BLOCK  1000

void *AI_get_leaf_data(MESH *mesh)
{
  FUNCNAME("AI_get_leaf_data");
  MEMORYADMIN  *ldbi;

  DEBUG_TEST_EXIT(mesh, "pointer to mesh = NULL\n");

  ldbi = (MEMORYADMIN *)((MESH_MEM_INFO*)(mesh->mem_info))->leaf_data;

  if (ldbi)
    return(getMemory(ldbi));
  else
    return(NULL);
}

void AI_free_leaf_data(void *leaf_data, MESH *mesh)
{
    FUNCNAME("AI_free_leaf_data");
    MEMORYADMIN  *ldbi;

    if (!leaf_data)  return;

    DEBUG_TEST_EXIT(mesh, "pointer to mesh = NULL\n");
    ldbi = (MEMORYADMIN *) ((MESH_MEM_INFO*)(mesh->mem_info))->leaf_data;

    if (!ldbi) return;

    freeMemory((void *)leaf_data, ldbi);
    return;
}


/****************************************************************************/
/* init_leaf_data(mesh, name, size, rld, cld):                              */
/* Initialize leaf data on the mesh.                                        */
/****************************************************************************/

size_t init_leaf_data(MESH *mesh, size_t size,
		      void (*refine_leaf_data)(EL *parent, EL *child[2]),
		      void (*coarsen_leaf_data)(EL *parent, EL *child[2]))
{
  MESH_MEM_INFO    *mem_info;
  size_t            new_size;
  TRAVERSE_STACK   *stack = get_traverse_stack();
  const EL_INFO    *el_info = NULL;

  TEST_EXIT(mesh, "No mesh specified!\n");
  TEST_EXIT(size, "size must be > 0!\n");
  TEST_EXIT(mesh->mem_info, "No memory management present for mesh!\n");

  mem_info = (MESH_MEM_INFO *)mesh->mem_info;

  TEST_EXIT(!mem_info->leaf_data, "Leaf data was already initialized!\n");

  new_size = ALIGNMEM(size, sizeof(void *));

  if (new_size != size)
    WARNING("installing leafdata of size %d with aligned size %d\n",
	    size, new_size);

  mem_info->leaf_data_info->leaf_data_size    = new_size;
  mem_info->leaf_data_info->refine_leaf_data  = refine_leaf_data;
  mem_info->leaf_data_info->coarsen_leaf_data = coarsen_leaf_data;

  mem_info->leaf_data = newObject(new_size, 0, "leaf_data");

  el_info = traverse_first(stack, mesh, -1, CALL_LEAF_EL);

  while (el_info) {
    el_info->el->child[1] = (EL *) AI_get_leaf_data(mesh);

    el_info = traverse_next(stack, el_info);
  }

  free_traverse_stack(stack);

  return new_size;
}


#if 0  /*  not used at the moment              */
/*--------------------------------------------------------------------------*/
/*  memory management for quadratures                                       */
/*--------------------------------------------------------------------------*/

#define QUAD_VEC_BLOCK  100
#define MAX_QUAD_INFO     3

static MEM_BLOCK_INFO *quad_vec_block_infos;

REAL *get_quad_vec(const QUAD *quad)
{
    FUNCNAME("get_quad_vec");
    REAL           *quad_vec;
    MEM_BLOCK_INFO *qvbi;
    int            qvbi_idx;

    DEBUG_TEST_EXIT(dim >= 1  &&  dim  <= 3, "dim = %d not allowed\n");

    qvbi_idx = quad->n_points / 16;

    qvbi = quad_vec_block_infos[dim];

    if (!gvbi)
    {
	gvbi = MEM_ALLOC(1, MEM_BLOCK_INFO);
	gvbi->free       = NULL;
	gvbi->info       = NULL;
	gvbi->free_count = 0;
	gvbi->used_count = 0;
	gvbi->unit_size  = get_max_no_quad_point(dim)*sizeof(REAL);
	gvbi->block_size = QUAD_VEC_BLOCK;

	quad_vec_block_infos[dim] = gvbi;
    }

    quad_vec = (REAL *) get_mem(gvbi);

    return(quad_vec);
}

void free_quad_vec(REAL *quad_vec, int dim)
{
    FUNCNAME("free_quad_vec");
    int             n;
    MEM_BLOCK_INFO  *gvbi;

    if (!quad_vec)  return;

    DEBUG_TEST_EXIT(dim >= 1  &&  dim  <= 3, "dim = %d not allowed\n");

    gvbi = quad_vec_block_infos[dim];

    if (!gvbi) return;

    free_mem((void *) quad_vec, gvbi);
    return;
}

static MEM_BLOCK_INFO *quad_vec_d_block_infos[MAX_QUAD_INFO+1];

REAL_D *get_quad_vec_d(int dim)
{
    FUNCNAME("get_quad_vec_d");
    int      i, n;
    REAL_D          *quad_vec_d;
    MEM_BLOCK_INFO  *gvdbi;

    DEBUG_TEST_EXIT(dim >= 1  &&  dim  <= 3, "dim = %d not allowed\n");

    gvdbi = quad_vec_d_block_infos[dim];

    if (!gvdbi)
    {
	gvdbi = MEM_ALLOC(1, MEM_BLOCK_INFO);
	gvdbi->free       = NULL;
	gvdbi->info       = NULL;
	gvdbi->free_count = 0;
	gvdbi->used_count = 0;
	gvdbi->unit_size  = get_max_no_quad_point(dim)*sizeof(REAL_D);
	gvdbi->block_size = QUAD_VEC_BLOCK;

	quad_vec_d_block_infos[dim] = gvdbi;
    }

    quad_vec_d = (REAL_D *) get_mem(gvdbi);

    return(quad_vec_d);
}

void free_quad_vec_d(REAL_D *quad_vec_d, int dim)
{
    FUNCNAME("free_quad_vec_d");
    int             n;
    MEM_BLOCK_INFO  *gvdbi;

    if (!quad_vec_d)  return;

    DEBUG_TEST_EXIT(dim >= 1  &&  dim  <= 3, "dim = %d not allowed\n");

    gvdbi = quad_vec_d_block_infos[dim];

    if (!gvdbi) return;

    free_mem((void *) quad_vec_d, gvdbi);
    return;
}
#endif

/*--------------------------------------------------------------------------*/
/*  memory management for elements                                          */
/*--------------------------------------------------------------------------*/

#define EL_BLOCK   1000

EL *get_element(MESH *mesh)
{
  FUNCNAME("get_element");
  EL *el;
#if ALBERTA_DEBUG
static int el_index = 0;
#endif

  DEBUG_TEST_EXIT(mesh, "mesh == NULL\n");
  DEBUG_TEST_EXIT(mesh->mem_info,
    "mesh \"%s\": no memory management present.\n", mesh->name);

  el = (EL *)getMemory(((MESH_MEM_INFO*)(mesh->mem_info))->element);
  el->child[0]  = NULL;
  el->child[1]  = (EL *) AI_get_leaf_data(mesh);
  el->dof       = get_dof_ptrs(mesh);
#if ALBERTA_DEBUG
  el->index     = el_index++;
#endif
  el->mark      = 0;
  el->new_coord = NULL;

  return el;
}

void free_element(EL *el, MESH *mesh)
{
    free_dof_ptrs(el->dof, mesh);
    if(mesh->dim > 1 && el->new_coord) {
      free_real_d(mesh, el->new_coord);
      el->new_coord = NULL;
    }

    if (el->child[1]) AI_free_leaf_data((void *) el->child[1], mesh);

    freeMemory(el, ((MESH_MEM_INFO*)(mesh->mem_info))->element);
}


/*--------------------------------------------------------------------------*/
/*  some routines for allocation and deallocation of list for collecting    */
/*  neighbours at the refinement edge in 3 dimensions                       */
/*--------------------------------------------------------------------------*/

#define LIST_BLOCK 20

/* static MEM_BLOCK_INFO rc_list_block_info = {NULL, NULL, 0, 0,  0, LIST_BLOCK}; */

RC_LIST_EL *get_rc_list(MESH *mesh)
{
  FUNCNAME("get_rc_list");
  MESH_MEM_INFO *mem_info = (MESH_MEM_INFO *)mesh->mem_info;
  int n_elem =
    mesh->is_periodic ? 2*mesh->max_edge_neigh : mesh->max_edge_neigh;

  if (!mem_info->rc_list) {
    mem_info->rc_list =
      newObject(n_elem * sizeof(RC_LIST_EL), LIST_BLOCK, "rc_list");
  } else {
    DEBUG_TEST_EXIT(
      ((MEMORYADMIN *)mem_info->rc_list)->objectSize
      >=
      n_elem * sizeof(RC_LIST_EL),
      "mesh \"%s\": mesh->max_edge_neigh changed\n", mesh->name);
  }

  return (RC_LIST_EL *)getMemory(mem_info->rc_list);
}

void free_rc_list(MESH *mesh, RC_LIST_EL *list)
{
    freeMemory((void *)list, ((MESH_MEM_INFO *)(mesh->mem_info))->rc_list);
}

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

REAL *get_real_d(MESH *mesh)
{
    FUNCNAME("get_real_d");

    DEBUG_TEST_EXIT(mesh, "mesh==NULL\n");
    return (REAL *)getMemory(((MESH_MEM_INFO*)(mesh->mem_info))->real_d);
}

void free_real_d(MESH *mesh, REAL *ptr)
{
    FUNCNAME("free_real_d");

    DEBUG_TEST_EXIT(mesh, "mesh==NULL\n");
    freeMemory((void *)ptr, ((MESH_MEM_INFO*)(mesh->mem_info))->real_d);
    return;
}

/*--------------------------------------------------------------------------*/
/*  memory management for matrix rows                                       */
/*  matrix rows not connected to a FE_SPACE, e.g. in multigrid.c are        */
/*  treated specially. Others are fixed to a FE_SPACE and thus to a unique  */
/*  DOF_ADMIN and MESH.                                                     */
/*--------------------------------------------------------------------------*/

static void *unconnected_real_rows = NULL;

static MATRIX_ROW_REAL *get_matrix_row_real(const FE_SPACE *fe_space)
{
  MATRIX_ROW_REAL *row;
  void *matrix_row_real_info;
  int j;

  if (!fe_space || !fe_space->admin) {
    if (!unconnected_real_rows) {      
      unconnected_real_rows = newObject(sizeof(MATRIX_ROW_REAL), 100,
					"unconnected rows");
    }
    matrix_row_real_info = unconnected_real_rows;
  } else {
    matrix_row_real_info =
      ((DOF_ADMIN_MEM_INFO *)fe_space->admin->mem_info)->real_matrix_row;
  }
  row = (MATRIX_ROW_REAL *)getMemory(matrix_row_real_info);
  row->type = MATENT_REAL;
  row->next = NULL;
  for (j = 0; j < ROW_LENGTH; j++) {
    row->col[j] = NO_MORE_ENTRIES;
  }

  return row;
}

static void free_matrix_row_real(const FE_SPACE *fe_space, MATRIX_ROW_REAL *row)
{
  void *matrix_row_info = NULL;

  if (!fe_space || !fe_space->admin) {
    matrix_row_info = unconnected_real_rows;
  } else {
    matrix_row_info =
      ((DOF_ADMIN_MEM_INFO *)fe_space->admin->mem_info)->real_matrix_row;
  }
  freeMemory((void *)row, matrix_row_info);
}

ALBERTA_DEFUNUSED(static void delete_unconnected_real_rows(void))
{
  if (unconnected_real_rows) {
    deleteObject(unconnected_real_rows);
  }
  unconnected_real_rows = NULL;
}

static void *unconnected_real_d_rows = NULL;

static MATRIX_ROW_REAL_D *get_matrix_row_real_d(const FE_SPACE *fe_space)
{
  MATRIX_ROW_REAL_D *row;
  void *matrix_row_real_d_info;
  int j;

  if (!fe_space || !fe_space->admin) {
    if (!unconnected_real_d_rows) {      
      unconnected_real_d_rows = newObject(sizeof(MATRIX_ROW_REAL_D), 100,
					"unconnected rows");
    }
    matrix_row_real_d_info = unconnected_real_d_rows;
  } else {
    matrix_row_real_d_info =
      ((DOF_ADMIN_MEM_INFO *)fe_space->admin->mem_info)->real_d_matrix_row;
  }
  row = (MATRIX_ROW_REAL_D *)getMemory(matrix_row_real_d_info);
  row->type = MATENT_REAL_D;
  row->next = NULL;
  for (j=0; j<ROW_LENGTH; j++) {
    row->col[j] = NO_MORE_ENTRIES;
  }

  return row;
}

static void
free_matrix_row_real_d(const FE_SPACE *fe_space, MATRIX_ROW_REAL_D *row)
{
  void *matrix_row_info = NULL;

  if (!fe_space || !fe_space->admin) {
    matrix_row_info = unconnected_real_d_rows;
  } else {
    matrix_row_info =
      ((DOF_ADMIN_MEM_INFO *)fe_space->admin->mem_info)->real_d_matrix_row;
  }
  freeMemory((void *)row, matrix_row_info);
}

ALBERTA_DEFUNUSED(static void delete_unconnected_real_d_rows(void))
{
  if (unconnected_real_d_rows) {
    deleteObject(unconnected_real_d_rows);  
  }
  unconnected_real_d_rows = NULL;
}

static void *unconnected_real_dd_rows = NULL;

static MATRIX_ROW_REAL_DD *get_matrix_row_real_dd(const FE_SPACE *fe_space)
{
  MATRIX_ROW_REAL_DD *row;
  void *matrix_row_real_dd_info;
  int j;

  if (!fe_space || !fe_space->admin) {
    if (!unconnected_real_dd_rows) {      
      unconnected_real_dd_rows = newObject(sizeof(MATRIX_ROW_REAL_DD), 100,
					"unconnected rows");
    }
    matrix_row_real_dd_info = unconnected_real_dd_rows;
  } else {
    matrix_row_real_dd_info =
      ((DOF_ADMIN_MEM_INFO *)fe_space->admin->mem_info)->real_dd_matrix_row;
  }
  row = (MATRIX_ROW_REAL_DD *)getMemory(matrix_row_real_dd_info);
  row->type = MATENT_REAL_DD;
  row->next = NULL;
  for (j=0; j<ROW_LENGTH; j++) {
    row->col[j] = NO_MORE_ENTRIES;
  }

  return row;
}

static void
free_matrix_row_real_dd(const FE_SPACE *fe_space, MATRIX_ROW_REAL_DD *row)
{
  void *matrix_row_info = NULL;

  if (!fe_space || !fe_space->admin) {
    matrix_row_info = unconnected_real_dd_rows;
  } else {
    matrix_row_info =
      ((DOF_ADMIN_MEM_INFO *)fe_space->admin->mem_info)->real_dd_matrix_row;
  }
  freeMemory((void *)row, matrix_row_info);
}

ALBERTA_DEFUNUSED(static void delete_unconnected_real_dd_rows(void))
{
  if (unconnected_real_dd_rows) {
    deleteObject(unconnected_real_dd_rows);
  }
  unconnected_real_dd_rows = NULL;
}

MATRIX_ROW *get_matrix_row(const FE_SPACE *fe_space, MATENT_TYPE type)
{
  FUNCNAME("get_matrix_row");
  switch (type) {
  case MATENT_REAL:
    return (MATRIX_ROW *)get_matrix_row_real(fe_space);
  case MATENT_REAL_D:
    return (MATRIX_ROW *)get_matrix_row_real_d(fe_space);
  case MATENT_REAL_DD:
    return (MATRIX_ROW *)get_matrix_row_real_dd(fe_space);
  default:
    ERROR_EXIT("Unsupported MATENT_TYPE: %d\n", type);
  }
  return NULL;
}

void free_matrix_row(const FE_SPACE *fe_space, MATRIX_ROW *row) 
{
  FUNCNAME("free_matrix_row");
  switch (row->type) {
  case MATENT_REAL:
    free_matrix_row_real(fe_space, (MATRIX_ROW_REAL *)row);
    break;
  case MATENT_REAL_D:
    free_matrix_row_real_d(fe_space, (MATRIX_ROW_REAL_D *)row);
    break;
  case MATENT_REAL_DD:
    free_matrix_row_real_dd(fe_space, (MATRIX_ROW_REAL_DD *)row);
    break;
  default:
    ERROR_EXIT("Unsupported MATENT_TYPE: %d\n", row->type);
    break;
  }
}

/*--------------------------------------------------------------------------*/
/*  memory management for matrices                                          */
/*  unconnected_matrices: see unconnected rows above...                     */
/*--------------------------------------------------------------------------*/

static void *unconnected_matrices = NULL;

static inline DOF_MATRIX *_AI_get_dof_matrix(const char *name,
					     const FE_SPACE *row_fe_space,
					     const FE_SPACE *col_fe_space)
{
  DOF_MATRIX *mat;
  void *matrix_info = NULL;

  if (!row_fe_space || !row_fe_space->admin) {
    if (!unconnected_matrices) {
      unconnected_matrices = newObject(sizeof(DOF_MATRIX), 10,
				       "unconnected matrices");
    }
    matrix_info = unconnected_matrices;
  } else {
    matrix_info =
      ((DOF_ADMIN_MEM_INFO *)row_fe_space->admin->mem_info)->dof_matrix;
  }
  
  mat = (DOF_MATRIX *)getMemory(matrix_info);

  /* This is not timing critical in general, so we waste some CPU time
   * here and simply zap the entire matrix structure.
   */
  memset(mat, 0, sizeof(*mat));

  mat->next          = NULL;
  mat->row_fe_space  = row_fe_space;
  mat->col_fe_space  = col_fe_space;
  mat->name          = name ? strdup(name) : NULL;
  mat->matrix_row    = NULL;
  mat->size          = 0;
  mat->type          = MATENT_NONE;
  mat->n_entries     = 0;
  mat->is_diagonal   = false;
  mat->diagonal.real = NULL;
  mat->diag_cols     = NULL;
  mat->inv_diag.real = NULL;
  mat->unchained     = NULL;
  ROW_CHAIN_INIT(mat);
  COL_CHAIN_INIT(mat);

  mat->refine_interpol = mat->coarse_restrict = NULL;

  mat->mem_info = matrix_info;

  if (row_fe_space && row_fe_space->admin) {
#if 0
    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))) {
      mat->is_diagonal = true; /* e.g. element bubbles */
    }
#endif
    add_dof_matrix_to_admin(mat, (DOF_ADMIN *)row_fe_space->admin);
  }

  return mat;
}

static inline void _AI_free_dof_matrix(DOF_MATRIX *mat)
{
  if (mat->row_fe_space && mat->row_fe_space->admin) {
    remove_dof_matrix_from_admin(mat);
  }

  clear_dof_matrix(mat);  /* free all matrix_rows */

  if (mat->matrix_row) {
    MEM_FREE(mat->matrix_row, mat->size, MATRIX_ROW *);
    mat->matrix_row = NULL;
  }
  if (mat->diag_cols) {
    free_dof_int_vec(mat->diag_cols);
  }
  mat->size = 0;

  if (mat->name) {
    free((void *)mat->name);
  }

  if (mat->mem_info) {
    freeMemory((void *)mat, mat->mem_info);
  } else {
    memset(mat, 0, sizeof(*mat));
  }
}

/* Allocate a (possibly: bock-matrix), according to the structure of
 * row_fe_space and col_fe_space
 */
DOF_MATRIX *get_dof_matrix(const char *name,
			   const FE_SPACE *row_fe_space,
			   const FE_SPACE *col_fe_space)
{
  DOF_MATRIX *mat, *row_chain, *col_chain;
  const FE_SPACE *row_fesp, *col_fesp;

  if (col_fe_space == NULL) {
    col_fe_space = row_fe_space;
  }
  row_fe_space = copy_fe_space(row_fe_space);
  col_fe_space = copy_fe_space(col_fe_space);

  mat = _AI_get_dof_matrix(name, row_fe_space, col_fe_space);

  if (row_fe_space) {
    /* Must be a call from MG-code if row_fe_space == NULL */

    /* generate the first row */
    col_fe_space = mat->col_fe_space;
    CHAIN_FOREACH(col_fesp, col_fe_space, const FE_SPACE) {
      row_chain = _AI_get_dof_matrix(name, row_fe_space, col_fesp);
      ROW_CHAIN_ADD_TAIL(mat, row_chain);
    }
    CHAIN_FOREACH(row_fesp, row_fe_space, const FE_SPACE) {
      col_chain = _AI_get_dof_matrix(name, row_fesp, col_fe_space);
      COL_CHAIN_ADD_TAIL(mat, col_chain);
      CHAIN_FOREACH(col_fesp, col_fe_space, const FE_SPACE) {
	row_chain = _AI_get_dof_matrix(name, row_fesp, col_fesp);
	ROW_CHAIN_ADD_TAIL(col_chain, row_chain);
	mat = ROW_CHAIN_NEXT(mat, DOF_MATRIX);
	COL_CHAIN_ADD_TAIL(mat, row_chain);
      }
      mat = ROW_CHAIN_NEXT(mat, DOF_MATRIX); /* roll-over to the list head. */
    }
  }

  return mat;
}

void free_dof_matrix(DOF_MATRIX *mat)
{
  DBL_LIST_NODE *row_next, *col_next;
  DOF_MATRIX *row_chain, *col_chain;

  if (mat->row_fe_space) {
    free_fe_space(mat->row_fe_space);
    free_fe_space(mat->col_fe_space);
  }

  /* delete all columns, safe the first one */
  ROW_CHAIN_FOREACH_SAFE(row_chain, row_next, mat, DOF_MATRIX) {
    /* delete the column down to the pre-last entry */
    COL_CHAIN_FOREACH_SAFE(col_chain, col_next, row_chain, DOF_MATRIX) {
      ROW_CHAIN_DEL(col_chain);
      COL_CHAIN_DEL(col_chain);
      _AI_free_dof_matrix(col_chain);
    }
    /* delete the first entry in the column */
    ROW_CHAIN_DEL(row_chain); /* col_chain is empty */
    _AI_free_dof_matrix(row_chain);
  }
  /* delete the first column */
  COL_CHAIN_FOREACH_SAFE(col_chain, col_next, mat, DOF_MATRIX) {
    COL_CHAIN_DEL(col_chain);
    _AI_free_dof_matrix(col_chain);
  }
  /* finally, delete the (1,1)-entry */
  _AI_free_dof_matrix(mat);
}


ALBERTA_DEFUNUSED(static void delete_unconnected_matrices(void))
{
  if(unconnected_matrices) deleteObject(unconnected_matrices);
  unconnected_matrices = NULL;
}

/*--------------------------------------------------------------------------*/
/*  memory management for dof_vectors                                       */
/*  unconnected dof_vectors are handled as above                            */
/*--------------------------------------------------------------------------*/

#define DEFUN_ALLOC_DOF_VEC(TYPE, typename)				\
static void *unconnected_##typename##_vecs = NULL;			\
									\
static inline DOF_##TYPE##_VEC *					\
_AI_get_##typename##_vec(const char *name, const FE_SPACE *fe_space)	\
{									\
  DOF_##TYPE##_VEC *vec;						\
  static void *vec_info = NULL;						\
									\
  if(!fe_space || !fe_space->admin) {					\
    if(!unconnected_##typename##_vecs) {				\
      unconnected_##typename##_vecs =					\
	newObject(sizeof(DOF_##TYPE##_VEC), 10,				\
		  "unconnected "#typename" vecs");			\
      vec_info = unconnected_##typename##_vecs;				\
    }									\
  } else {								\
    DOF_ADMIN_MEM_INFO *mem_info =					\
      (DOF_ADMIN_MEM_INFO *)fe_space->admin->mem_info;			\
									\
    vec_info = mem_info->typename##_vec;				\
  }									\
									\
  vec = (DOF_##TYPE##_VEC *)getMemory(vec_info);			\
									\
  vec->next  = NULL;							\
  vec->fe_space = fe_space;						\
  vec->name  = name ? strdup(name): NULL;				\
  vec->size  = 0;							\
  vec->reserved =							\
    ((sizeof(TYPE##_VEC_TYPE) + sizeof(REAL) - 1) / sizeof(REAL));	\
  vec->vec   = NULL;							\
  vec->refine_interpol =						\
    vec->coarse_restrict = NULL;					\
  vec->user_data = NULL;						\
  vec->vec_loc = NULL;							\
  vec->mem_info = vec_info;						\
  CHAIN_INIT(vec);							\
  vec->unchained = NULL; /* for now */					\
									\
  if (fe_space && fe_space->admin) {					\
    add_##typename##_vec_to_admin(vec, (DOF_ADMIN *)fe_space->admin);	\
  }									\
									\
  return vec;								\
}									\
struct _AI_semicolon_dummy

#define DEFUN_FREE_DOF_VEC(TYPE, type, typename)			\
static inline void _AI_free_##typename##_vec(DOF_##TYPE##_VEC *vec)	\
{									\
  if (vec->fe_space && vec->fe_space->admin) {				\
    remove_##typename##_vec_from_admin(vec);				\
  }									\
									\
  MEM_FREE(vec->vec, vec->size, type);					\
  if (vec->name) {							\
    free((char *)vec->name);						\
  }									\
									\
  if (vec->mem_info) {							\
    freeMemory((void *)vec, vec->mem_info);				\
  } else {								\
    memset(vec, 0, sizeof(*vec));					\
  }									\
}									\
									\
ALBERTA_DEFUNUSED(static void delete_unconnected_##typename##_vecs(void)) \
{									\
  if(unconnected_##typename##_vecs) {					\
    deleteObject(unconnected_##typename##_vecs);			\
  }									\
  unconnected_##typename##_vecs = NULL;					\
}									\
struct _AI_semicolon_dummy


#define DEFUN_ALLOC_DOF_VEC_STD(TYPE, type, typename)			\
DOF_##TYPE##_VEC *							\
get_##typename##_vec(const char *name, const FE_SPACE *fe_space)	\
{									\
  DOF_##TYPE##_VEC *vec, *vec_chain;					\
  const FE_SPACE *fe_chain;						\
  EL_##TYPE##_VEC *vec_loc = NULL;					\
									\
  vec = _AI_get_##typename##_vec(name, fe_space);			\
  if (fe_space != NULL) {						\
    fe_space = copy_fe_space(fe_space);					\
    vec->fe_space = fe_space;						\
    if (fe_space->bas_fcts) {						\
      vec->vec_loc = vec_loc = get_el_##type##_vec(fe_space->bas_fcts); \
    }									\
    CHAIN_FOREACH(fe_chain, fe_space, const FE_SPACE) {			\
      vec_chain = _AI_get_##typename##_vec(name, fe_chain);		\
      CHAIN_ADD_TAIL(vec, vec_chain);					\
      if (vec_loc) {							\
	vec_loc = CHAIN_NEXT(vec_loc, EL_##TYPE##_VEC);			\
	vec_chain->vec_loc = vec_loc;					\
      }									\
    }									\
  }									\
  									\
  return vec;								\
}									\
struct _AI_semicolon_dummy


#define DEFUN_FREE_DOF_VEC_STD(TYPE, type, typename)		\
void free_##typename##_vec(DOF_##TYPE##_VEC *vec)		\
{								\
  DOF_##TYPE##_VEC *vec_chain;					\
  DBL_LIST_NODE *next;						\
  const FE_SPACE *fe_space = vec->fe_space;			\
								\
  if (vec->vec_loc) {						\
    free_el_##type##_vec(vec->vec_loc);				\
  }								\
  CHAIN_FOREACH_SAFE(vec_chain, next, vec, DOF_##TYPE##_VEC) {	\
    _AI_free_##typename##_vec(vec_chain);			\
  }								\
  _AI_free_##typename##_vec(vec);				\
  if (fe_space) {						\
    free_fe_space(fe_space);					\
  }								\
}								\
struct _AI_semicolon_dummy

DEFUN_ALLOC_DOF_VEC(INT, dof_int);
DEFUN_FREE_DOF_VEC(INT, int, dof_int);
DEFUN_ALLOC_DOF_VEC_STD(INT, int, dof_int);
DEFUN_FREE_DOF_VEC_STD(INT, int, dof_int);

DEFUN_ALLOC_DOF_VEC(DOF, dof_dof);
DEFUN_FREE_DOF_VEC(DOF, DOF, dof_dof);
DEFUN_ALLOC_DOF_VEC_STD(DOF, dof, dof_dof);
DEFUN_FREE_DOF_VEC_STD(DOF, dof, dof_dof);

DEFUN_ALLOC_DOF_VEC(DOF, int_dof);
DEFUN_FREE_DOF_VEC(DOF, DOF, int_dof);
DEFUN_ALLOC_DOF_VEC_STD(DOF, dof, int_dof);
DEFUN_FREE_DOF_VEC_STD(DOF, dof, int_dof);

DEFUN_ALLOC_DOF_VEC(UCHAR, dof_uchar);
DEFUN_FREE_DOF_VEC(UCHAR, U_CHAR, dof_uchar);
DEFUN_ALLOC_DOF_VEC_STD(UCHAR, uchar, dof_uchar);
DEFUN_FREE_DOF_VEC_STD(UCHAR, uchar, dof_uchar);

DEFUN_ALLOC_DOF_VEC(SCHAR, dof_schar);
DEFUN_FREE_DOF_VEC(SCHAR, S_CHAR, dof_schar);
DEFUN_ALLOC_DOF_VEC_STD(SCHAR, schar, dof_schar);
DEFUN_FREE_DOF_VEC_STD(SCHAR, schar, dof_schar);

DEFUN_ALLOC_DOF_VEC(PTR, dof_ptr);
DEFUN_FREE_DOF_VEC(PTR, void *, dof_ptr);
DEFUN_ALLOC_DOF_VEC_STD(PTR, ptr, dof_ptr);
DEFUN_FREE_DOF_VEC_STD(PTR, ptr, dof_ptr);

DEFUN_ALLOC_DOF_VEC(REAL, dof_real);
DEFUN_FREE_DOF_VEC(REAL, REAL, dof_real);
DEFUN_ALLOC_DOF_VEC_STD(REAL, real, dof_real);
DEFUN_FREE_DOF_VEC_STD(REAL, real, dof_real);

DEFUN_ALLOC_DOF_VEC(REAL_D, dof_real_d);
DEFUN_FREE_DOF_VEC(REAL_D, REAL_D, dof_real_d);
DEFUN_ALLOC_DOF_VEC_STD(REAL_D, real_d, dof_real_d);
DEFUN_FREE_DOF_VEC_STD(REAL_D, real_d, dof_real_d);

DEFUN_ALLOC_DOF_VEC(REAL_DD, dof_real_dd);
DEFUN_FREE_DOF_VEC(REAL_DD, REAL_DD, dof_real_dd);
DEFUN_ALLOC_DOF_VEC_STD(REAL_DD, real_dd, dof_real_dd);
DEFUN_FREE_DOF_VEC_STD(REAL_DD, real_dd, dof_real_dd);

/* The DOF_REAL_VEC_D is special, it serves to encapsulate discrete
 * functions -- possibly living on a chain of FE-spaces -- which may
 * or may not be vector-valued. We look at BAS_FCTS::rdim and
 * FE_SPACE::rdim to decide this:
 *
 * - BAS_FCTS::rdim == DIM_OF_WORLD (== FE_SPACE::rdim)
 *   allocate an ordinary DOF_REAL_VEC
 * - BAS_FCTS::rdim == 1 == FE_SPACE::rdim
 *   allocate an ordinary DOF_REAL_VEC
 * - BAS_FCTS::rdim == 1, FE_SPACE::rdim == DIM_OF_WORLD
 *   Allocate a DOF_REAL_D_VEC. This happens when chaining a Cartesian
 *   product space with "really" vector-valued basis functions.
 */
DOF_REAL_VEC_D *
get_dof_real_vec_d(const char *name, const FE_SPACE *fe_space)
{
  FUNCNAME("get_dof_real_vec_d");
  DOF_REAL_VEC_D *vec, *vec_chain;
  const FE_SPACE *fe_chain;
  EL_REAL_VEC_D *vec_loc;

  fe_space = copy_fe_space(fe_space);
  if (fe_space->rdim == DIM_OF_WORLD &&
      fe_space->bas_fcts->rdim == DIM_OF_WORLD) {
    vec = (DOF_REAL_VEC_D *)_AI_get_dof_real_vec(name, fe_space);  
  } else if (fe_space->bas_fcts->rdim == 1 && fe_space->rdim == DIM_OF_WORLD) {
    vec = (DOF_REAL_VEC_D *)_AI_get_dof_real_d_vec(name, fe_space);
  } else {
    ERROR_EXIT("The combination FE_SPACE::rdim == %d and "
	       "FE_SPACE::BAS_FCTS::rdim == %d does not make sense\n",
	       fe_space->rdim , fe_space->bas_fcts->rdim);
    vec_chain = vec = NULL; /* not reached */
  }
  vec->vec_loc = vec_loc = get_el_real_vec_d(fe_space->bas_fcts);
  CHAIN_FOREACH(fe_chain, fe_space, const FE_SPACE) {
    if (fe_chain->rdim == fe_chain->bas_fcts->rdim) {
      vec_chain = (DOF_REAL_VEC_D *)_AI_get_dof_real_vec(name, fe_chain);
    } else if (fe_chain->bas_fcts->rdim == 1 &&
	       fe_chain->rdim == DIM_OF_WORLD) {
      vec_chain = (DOF_REAL_VEC_D *)_AI_get_dof_real_d_vec(name, fe_chain);
    } else {
      ERROR_EXIT("The combination FE_SPACE::rdim == %d and "
		 "FE_SPACE::BAS_FCTS::rdim == %d does not make sense\n",
		 fe_chain->rdim , fe_chain->bas_fcts->rdim);
    }
    CHAIN_ADD_TAIL(vec, vec_chain);
    if (vec_loc) {
      vec_loc = CHAIN_NEXT(vec_loc, EL_REAL_VEC_D);
      vec_chain->vec_loc = vec_loc;
    }
  }
  return vec;
}

void free_dof_real_vec_d(DOF_REAL_VEC_D *vec)
{
  FUNCNAME("free_dof_real_vec_d");
  DOF_REAL_VEC_D *vec_chain;
  DBL_LIST_NODE  *next;
  const FE_SPACE *fe_space;
  const BAS_FCTS *bas_fcts;

  if (vec->vec_loc) {
    free_el_real_vec_d(vec->vec_loc);
  }
  CHAIN_FOREACH_SAFE(vec_chain, next, vec, DOF_REAL_VEC_D) {
    fe_space = vec_chain->fe_space;
    bas_fcts = fe_space->bas_fcts;
    if (vec_chain->stride == 1) {
      _AI_free_dof_real_vec((DOF_REAL_VEC *)vec_chain);
    } else if (vec_chain->stride == DIM_OF_WORLD) {
      _AI_free_dof_real_d_vec((DOF_REAL_D_VEC *)vec_chain);
    } else {
      ERROR_EXIT("The combination FE_SPACE::rdim == %d and "
		 "FE_SPACE::BAS_FCTS::rdim == %d and "
		 "EL_REAL_VEC::stride == %d does not make sense\n",
		 fe_space->rdim , bas_fcts->rdim, vec_chain->stride);
    }
  }
  fe_space = vec->fe_space;
  bas_fcts = fe_space->bas_fcts;
  if (vec->stride == 1) {
    _AI_free_dof_real_vec((DOF_REAL_VEC *)vec);
  } else if (vec->stride == DIM_OF_WORLD) {
      _AI_free_dof_real_d_vec((DOF_REAL_D_VEC *)vec);
  } else {
    ERROR_EXIT("The combination FE_SPACE::rdim == %d and "
	       "FE_SPACE::BAS_FCTS::rdim == %d and "
	       "EL_REAL_VEC::stride == %d does not make sense\n",
	       fe_space->rdim , bas_fcts->rdim, vec->stride);
  }
  free_fe_space(fe_space);
}

#define DEFUN_ALLOC_EL_VEC(VECNAME, vecname, vectype)			\
  static inline EL_##VECNAME##_VEC *					\
  _AI_get_el_##vecname##_vec(const BAS_FCTS *bas_fcts)			\
  {									\
    EL_##VECNAME##_VEC *el_vec;						\
									\
    el_vec = (EL_##VECNAME##_VEC *)					\
      MEM_CALLOC(sizeof(EL_##VECNAME##_VEC)				\
		 + (bas_fcts->n_bas_fcts_max - 1) * sizeof(vectype),	\
		 char);							\
    el_vec->n_components     = bas_fcts->n_bas_fcts;			\
    el_vec->n_components_max = bas_fcts->n_bas_fcts_max;		\
    el_vec->reserved =							\
      ((sizeof(EL_##VECNAME##_VEC_TYPE) + sizeof(REAL) - 1) / sizeof(REAL)); \
    CHAIN_INIT(el_vec);							\
									\
    return el_vec;							\
  }									\
  struct _AI_semicolon_dummy

#define DEFUN_ALLOC_EL_VEC_STD(VECNAME, vecname, vectype)		\
  EL_##VECNAME##_VEC *get_el_##vecname##_vec(const BAS_FCTS *bas_fcts)	\
  {									\
    const BAS_FCTS *bf_chain;						\
    EL_##VECNAME##_VEC *el_vec, *el_vec_chain;				\
									\
    el_vec = _AI_get_el_##vecname##_vec(bas_fcts);			\
    CHAIN_FOREACH(bf_chain, bas_fcts, const BAS_FCTS) {			\
      el_vec_chain = _AI_get_el_##vecname##_vec(bf_chain);		\
      CHAIN_ADD_TAIL(el_vec, el_vec_chain);				\
    }									\
									\
    return el_vec;							\
  }									\
  struct _AI_semicolon_dummy

#define DEFUN_FREE_EL_VEC(VECNAME, vecname, vectype)			\
  void free_el_##vecname##_vec(EL_##VECNAME##_VEC *el_vec)		\
  {									\
    EL_##VECNAME##_VEC *el_vec_chain;					\
    DBL_LIST_NODE *next;						\
									\
    if (el_vec == NULL) {						\
      return;								\
    }									\
    CHAIN_FOREACH_SAFE(el_vec_chain, next, el_vec, EL_##VECNAME##_VEC) { \
      CHAIN_DEL(el_vec_chain);						\
      MEM_FREE(el_vec_chain,						\
	       (el_vec_chain->n_components_max - 1) * sizeof(vectype)	\
	       +							\
	       sizeof(EL_##VECNAME##_VEC), char);			\
    }									\
    MEM_FREE(el_vec,							\
	     (el_vec->n_components_max - 1) * sizeof(vectype)		\
	     +								\
	     sizeof(EL_##VECNAME##_VEC), char);				\
  }									\
  struct _AI_semicolon_dummy

DEFUN_ALLOC_EL_VEC(INT, int, int);
DEFUN_FREE_EL_VEC(INT, int, int);
DEFUN_ALLOC_EL_VEC_STD(INT, int, int);

DEFUN_ALLOC_EL_VEC(DOF, dof, DOF);
DEFUN_FREE_EL_VEC(DOF, dof, DOF);
DEFUN_ALLOC_EL_VEC_STD(DOF, dof, DOF);

DEFUN_ALLOC_EL_VEC(UCHAR, uchar, U_CHAR);
DEFUN_FREE_EL_VEC(UCHAR, uchar, U_CHAR);
DEFUN_ALLOC_EL_VEC_STD(UCHAR, uchar, U_CHAR);

DEFUN_ALLOC_EL_VEC(SCHAR, schar, S_CHAR);
DEFUN_FREE_EL_VEC(SCHAR, schar, S_CHAR);
DEFUN_ALLOC_EL_VEC_STD(SCHAR, schar, S_CHAR);

DEFUN_ALLOC_EL_VEC(PTR, ptr, void *);
DEFUN_FREE_EL_VEC(PTR, ptr, void *);
DEFUN_ALLOC_EL_VEC_STD(PTR, ptr, void *);

DEFUN_ALLOC_EL_VEC(REAL, real, REAL);
DEFUN_FREE_EL_VEC(REAL, real, REAL);
DEFUN_ALLOC_EL_VEC_STD(REAL, real, REAL);

DEFUN_ALLOC_EL_VEC(REAL_D, real_d, REAL_D);
DEFUN_FREE_EL_VEC(REAL_D, real_d, REAL_D);
DEFUN_ALLOC_EL_VEC_STD(REAL_D, real_d, REAL_D);

DEFUN_ALLOC_EL_VEC(REAL_DD, real_dd, REAL_DD);
DEFUN_FREE_EL_VEC(REAL_DD, real_dd, REAL_DD);
DEFUN_ALLOC_EL_VEC_STD(REAL_DD, real_dd, REAL_DD);

DEFUN_ALLOC_EL_VEC(BNDRY, bndry, BNDRY_FLAGS);
DEFUN_FREE_EL_VEC(BNDRY, bndry, BNDRY_FLAGS);
DEFUN_ALLOC_EL_VEC_STD(BNDRY, bndry, BNDRY_FLAGS);

EL_REAL_VEC_D *get_el_real_vec_d(const BAS_FCTS *bas_fcts)
{
  FUNCNAME("get_el_real_vec_d");
  EL_REAL_VEC_D *el_vec, *el_vec_chain;
  const BAS_FCTS *bfcts_chain;

  if (bas_fcts->rdim == DIM_OF_WORLD) {
    el_vec = (EL_REAL_VEC_D *)_AI_get_el_real_vec(bas_fcts);
  } else if (bas_fcts->rdim == 1) {
    el_vec = (EL_REAL_VEC_D *)_AI_get_el_real_d_vec(bas_fcts);
    el_vec->stride = DIM_OF_WORLD;
  } else {
    ERROR_EXIT("BAS_FCTS::rdim %d not in { 1, DIM_OF_WORLD = %d }.\n",
	       bas_fcts->rdim, DIM_OF_WORLD);
    el_vec = NULL; /* not reached */
  }
  CHAIN_FOREACH(bfcts_chain, bas_fcts, const BAS_FCTS) {
    if (bfcts_chain->rdim == DIM_OF_WORLD) {
      el_vec_chain = (EL_REAL_VEC_D *)_AI_get_el_real_vec(bfcts_chain);
    } else if (bfcts_chain->rdim == 1) {
      el_vec_chain = (EL_REAL_VEC_D *)_AI_get_el_real_d_vec(bfcts_chain);
      el_vec_chain->stride = DIM_OF_WORLD;
    } else {
      ERROR_EXIT("BAS_FCTS::rdim %d not in { 1, DIM_OF_WORLD = %d }.\n",
		 bfcts_chain->rdim, DIM_OF_WORLD);
    }
    CHAIN_ADD_TAIL(el_vec, el_vec_chain);
  }
  
  return el_vec;
}

void free_el_real_vec_d(EL_REAL_VEC_D *el_vec)
{
  EL_REAL_VEC_D *el_vec_chain;
  DBL_LIST_NODE *next;

  if (el_vec == NULL) {
    return;
  }

  CHAIN_FOREACH_SAFE(el_vec_chain, next, el_vec, EL_REAL_VEC_D) {
    CHAIN_DEL(el_vec_chain);
    MEM_FREE(el_vec_chain,
	     (el_vec_chain->n_components_max - 1)
	     *
	     el_vec_chain->stride * sizeof(REAL)
	     +
	     sizeof(EL_REAL_VEC), char);
  }
  MEM_FREE(el_vec,
	   (el_vec->n_components_max - 1)
	   *
	   el_vec->stride * sizeof(REAL)
	   +
	   sizeof(EL_REAL_VEC), char);
}

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

/* allocation of element matrices */
static inline EL_MATRIX *
_AI_get_el_matrix_single(const FE_SPACE *row_fe_space,
			 const FE_SPACE *col_fe_space,
			 MATENT_TYPE operator_type)
{
  EL_MATRIX *el_mat;
  const BAS_FCTS *row_bfcts, *col_bfcts;
  
  row_bfcts = row_fe_space->bas_fcts;
  col_bfcts = col_fe_space->bas_fcts;
  
  el_mat = MEM_ALLOC(1, EL_MATRIX);
  el_mat->type = matent_type(row_fe_space, col_fe_space, operator_type);

  el_mat->n_row     = row_bfcts->n_bas_fcts;
  el_mat->n_col     = col_bfcts->n_bas_fcts;
  el_mat->n_row_max = row_bfcts->n_bas_fcts_max;
  el_mat->n_col_max = col_bfcts->n_bas_fcts_max;

  ROW_CHAIN_INIT(el_mat);
  COL_CHAIN_INIT(el_mat);

#undef MAT_BODY
#define MAT_BODY(F, CC, C, S, TYPE)					\
  el_mat->data.S = (TYPE *const*)					\
    MAT_ALLOC(el_mat->n_row_max, el_mat->n_col_max, TYPE)
  MAT_EMIT_BODY_SWITCH(el_mat->type);

  return el_mat;
}

EL_MATRIX *get_el_matrix(const FE_SPACE *row_fe_space,
			 const FE_SPACE *col_fe_space,
			 MATENT_TYPE op_type)
{
  EL_MATRIX *el_mat, *row_chain, *col_chain;
  const FE_SPACE *row_fesp, *col_fesp;

  if (col_fe_space == NULL) {
    col_fe_space = row_fe_space;
  }
  /* generate the first row */
  el_mat = _AI_get_el_matrix_single(row_fe_space, col_fe_space, op_type);
  CHAIN_FOREACH(col_fesp, col_fe_space, const FE_SPACE) {
    row_chain = _AI_get_el_matrix_single(row_fe_space, col_fesp, op_type);
    ROW_CHAIN_ADD_TAIL(el_mat, row_chain);
  }
  /* Then generate all following rows */
  CHAIN_FOREACH(row_fesp, row_fe_space, const FE_SPACE) {
    col_chain = _AI_get_el_matrix_single(row_fesp, col_fe_space, op_type);
    COL_CHAIN_ADD_TAIL(el_mat, col_chain);
    CHAIN_FOREACH(col_fesp, col_fe_space, const FE_SPACE) {
      row_chain = _AI_get_el_matrix_single(row_fesp, col_fesp, op_type);
      ROW_CHAIN_ADD_TAIL(col_chain, row_chain);
      el_mat = ROW_CHAIN_NEXT(el_mat, EL_MATRIX);
      COL_CHAIN_ADD_TAIL(el_mat, row_chain);
    }
    el_mat = ROW_CHAIN_NEXT(el_mat, EL_MATRIX); /* roll over to first element */
  }
  return el_mat;
}

static inline void _AI_free_el_matrix_single(EL_MATRIX *el_mat)
{
#undef MAT_BODY
#define MAT_BODY(F, CC, C, S, TYPE)					\
	MAT_FREE(el_mat->data.S,					\
		 el_mat->n_row_max, el_mat->n_col_max, TYPE)
  MAT_EMIT_BODY_SWITCH(el_mat->type);
  MEM_FREE(el_mat, 1, EL_MATRIX);
}

void free_el_matrix(EL_MATRIX *el_mat)
{
  DBL_LIST_NODE *row_next, *col_next;
  EL_MATRIX *row_chain, *col_chain;

  /* delete all columns, safe the first one */
  ROW_CHAIN_FOREACH_SAFE(row_chain, row_next, el_mat, EL_MATRIX) {
    /* delete the column down to the pre-last entry */
    COL_CHAIN_FOREACH_SAFE(col_chain, col_next, row_chain, EL_MATRIX) {
      ROW_CHAIN_DEL(col_chain);
      COL_CHAIN_DEL(col_chain);
      _AI_free_el_matrix_single(col_chain);
    }
    /* delete the first entry in the column */
    ROW_CHAIN_DEL(row_chain); /* col_chain is empty */
    _AI_free_el_matrix_single(row_chain);
  }
  /* delete the first column */
  COL_CHAIN_FOREACH_SAFE(col_chain, col_next, el_mat, EL_MATRIX) {
    COL_CHAIN_DEL(col_chain);
    _AI_free_el_matrix_single(col_chain);
  }
  /* finally, delete the (1,1)-entry */
  _AI_free_el_matrix_single(el_mat);
}

static inline
void __print_el_matrix(const EL_MATRIX *el_mat)
{
  FUNCNAME("print_el_matrix");
  int i, j, k;

  switch (el_mat->type) {
  case MATENT_REAL:
    for (i = 0; i < el_mat->n_row; i++) {
      MSG("%2d: ", i);
      for (j = 0; j < el_mat->n_col; j++) {
	print_msg(" %.8e", el_mat->data.real[i][j]);
      }
      print_msg("\n");
    }
    break;
  case MATENT_REAL_D:
    for (i = 0; i < el_mat->n_row; i++) {
      MSG("%2d: ", i);
      for (j = 0; j < el_mat->n_col; j++) {
	print_msg(" "FORMAT_DOW, EXPAND_DOW(el_mat->data.real_d[i][j]));
      }
      print_msg("\n");
    }
    break;
  case MATENT_REAL_DD:
    for (i = 0; i < el_mat->n_row; i++) {
      for (k = 0; k < DIM_OF_WORLD; k++) {
	if (k == 0) {
	  MSG("%2d: ", i);
	} else {
	  MSG("    ");
	}
	for (j = 0; j < el_mat->n_col; j++) {
	  print_msg(" "FORMAT_DOW, EXPAND_DOW(el_mat->data.real_dd[i][j][k]));
	/*  break;  this "break" caused errors */
	}
	print_msg("\n");
      }
      print_msg("\n");
    }
    break;
  case MATENT_NONE:
  default:
    ERROR_EXIT("Unknown or invalid block-matrix type: %d\n", el_mat->type);
    break;
  }
}

void print_el_matrix(const EL_MATRIX *el_mat)
{
  FUNCNAME("print_el_matrix");
  int i, j;
  
  i = 0;
  COL_CHAIN_DO(el_mat, const EL_MATRIX) {
    j = 0;
    ROW_CHAIN_DO(el_mat, const EL_MATRIX) {
      if (!COL_CHAIN_SINGLE(el_mat) || !ROW_CHAIN_SINGLE(el_mat)) {
	MSG("BLOCK(%d,%d):\n", i, j);
      }
      __print_el_matrix(el_mat);
      ++j;
    } ROW_CHAIN_WHILE(el_mat, const EL_MATRIX);
    ++i;
  } COL_CHAIN_WHILE(el_mat, const EL_MATRIX);
}


static inline
void __print_el_real_vec(const EL_REAL_VEC *el_vec)
{
  int i;
  for(i = 0; i < el_vec->n_components; i++)
  {
    print_msg(" %.8e", el_vec->vec[i]);
  }
  print_msg("\n");
}

/* copy of print_dof_real_vec */
void print_el_real_vec(const EL_REAL_VEC *vec)
{
  FUNCNAME("print_el_real_vec");
  int i;
  i = 0;

  CHAIN_DO(vec, const EL_REAL_VEC) {
    if (!CHAIN_SINGLE(vec)) {
      MSG("BLOCK(%d):\n", i);
    }
    __print_el_real_vec(vec);
    ++i;
  } CHAIN_WHILE(vec, const EL_REAL_VEC);
}

static inline
void __print_el_real_d_vec(const EL_REAL_D_VEC *el_vec)
{
  int i;

  for(i = 0; i < el_vec->n_components; i++)
  {
    print_msg(" "FORMAT_DOW, EXPAND_DOW(el_vec->vec[i]));
  }
  print_msg("\n");
}

void print_el_real_d_vec(const EL_REAL_D_VEC *vec)
{
  FUNCNAME("print_el_real_d_vec");
  int i;

  i = 0;
  CHAIN_DO(vec, const EL_REAL_D_VEC) {
    if (!CHAIN_SINGLE(vec)) {
      MSG("BLOCK(%d):\n", i);
    }
    __print_el_real_d_vec(vec);
    ++i;
  } CHAIN_WHILE(vec, const EL_REAL_D_VEC);
}

void print_el_real_vec_d(const EL_REAL_VEC_D *vec)
{
  FUNCNAME("print_el_real_d_vec");
  int i;
  i = 0;

  CHAIN_DO(vec, const EL_REAL_VEC_D) {
    if (!CHAIN_SINGLE(vec)) {
      MSG("BLOCK(%d):\n", i);
    }
    if (vec->stride != 1){
      __print_el_real_d_vec((const EL_REAL_D_VEC *) vec);
    } else {
      __print_el_real_vec((const EL_REAL_VEC *) vec);
    }
    ++i;
  } CHAIN_WHILE(vec, const EL_REAL_VEC_D);
}

static inline
void __print_el_dof_vec(const EL_DOF_VEC *el_vec)
{
  int i;
  for(i = 0; i < el_vec->n_components; i++) {
    print_msg(" %d", el_vec->vec[i]);
  }
  print_msg("\n");
}

/* copy of print_dof_real_vec */
void print_el_dof_vec(const EL_DOF_VEC *vec)
{
  FUNCNAME("print_el_dof_vec");
  int i;
  i = 0;

  CHAIN_DO(vec, const EL_DOF_VEC) {
    if (!CHAIN_SINGLE(vec)) {
      MSG("BLOCK(%d): ", i);
    }
    __print_el_dof_vec(vec);
    ++i;
  } CHAIN_WHILE(vec, const EL_DOF_VEC);
}

static inline
void __print_el_schar_vec(const EL_SCHAR_VEC *el_vec)
{
  int i;
  for(i = 0; i < el_vec->n_components; i++) {
    print_msg(" %02x", (int)el_vec->vec[i]);
  }
  print_msg("\n");
}

/* copy of print_schar_real_vec */
void print_el_schar_vec(const EL_SCHAR_VEC *vec)
{
  FUNCNAME("print_el_schar_vec");
  int i;
  i = 0;

  CHAIN_DO(vec, const EL_SCHAR_VEC) {
    if (!CHAIN_SINGLE(vec)) {
      MSG("BLOCK(%d): ", i);
    }
    __print_el_schar_vec(vec);
    ++i;
  } CHAIN_WHILE(vec, const EL_SCHAR_VEC);
}

static inline
void __print_el_bndry_vec(const EL_BNDRY_VEC *el_vec)
{
  int i, j;
  for(i = 0; i < el_vec->n_components; i++) {
    for (j = 0; j < 4; j++) {
      print_msg("%lx", (long)el_vec->vec[i][j]);
    }
    print_msg(" ");
  }
  print_msg("\n");
}

/* copy of print_bndry_real_vec */
void print_el_bndry_vec(const EL_BNDRY_VEC *vec)
{
  FUNCNAME("print_el_bndry_vec");
  int i;
  i = 0;

  CHAIN_DO(vec, const EL_BNDRY_VEC) {
    if (!CHAIN_SINGLE(vec)) {
      MSG("BLOCK(%d): ", i);
    }
    __print_el_bndry_vec(vec);
    ++i;
  } CHAIN_WHILE(vec, const EL_BNDRY_VEC);
}
