/*--------------------------------------------------------------------------*/
/*  author:    Notger Noll                                                  */
/*             Abteilung fuer angewandte Mathematik                         */
/*                                                                          */
/*             Albert Ludwigs Universitaet Freiburg                         */
/*             Herman Herder Str. 10                                        */
/*             D-79106 Freiburg, Germany                                    */
/*                                                                          */
/*  http://www.mathematik.uni-freiburg.de/IAM/ALBERTA                       */
/*                                                                          */
/*  (c) by N. Noll (2008)                                                   */
/*--------------------------------------------------------------------------*/

#ifdef HAVE_CONFIG_H
#include <config.h>
#endif

/* Define to get POSIX and XPG stuff */
#define _XOPEN_SOURCE 600

#define VERSION_2 1

#define SSOR 1

#include <stdarg.h>
#include <string.h>
#include <alberta/alberta.h>
#include "oem_block_solve.h"
/*#include "print.h"*/

/******************************************************************************
 *
 * Private data-structures ...
 */


typedef struct block_precon_node BLOCK_PRECON_NODE;
struct block_precon_node
{
  const PRECON  			*precon;
  OEM_PRECON    			type;
  size_t       			 	dim;
  DOF_MATRIX    			*dof_mat;
  DOF_SCHAR_VEC 			*mask;
  const BLOCK_DOF_MATRIX	*bmat;
  DOF_REAL_VEC_D 			*accu;  /* for BlkSSORPrecon */
  BLOCK_PRECON_NODE   		*next;
};

typedef struct block_mat_precon_data
{
  PRECON              precon;

  const BLOCK_DOF_MATRIX    *block_mat;
  const BLOCK_DOF_SCHAR_VEC *block_mask;
  size_t              dim;
  int				  n_diag_components;
  
  OEM_PRECON          block_type;  /* how to combine the individual precons */
  /* the list of the individual precons */
  BLOCK_PRECON_NODE   block_precon_node[N_OEM_BLOCKS_MAX];

  REAL                block_omega;  /* for BlkSSORPrecon */
  int                 block_n_iter; /* for BlkSSORPrecon */

  BLOCK_DOF_VEC      *rhs;    /* for BlkSSORPrecon */
  BLOCK_DOF_VEC      r_skel[1]; /* for BLKSSORPrecon */
  
  SCRATCH_MEM         scratch;
} BLOCK_MAT_PRECON_DATA;

typedef OEM_PRECON OEM_BLOCK_PRECON[N_OEM_BLOCKS_MAX];

/*
 * ... end private data-structures
 *
 ******************************************************************************/

static BLOCK_DOF_VEC *_AI_get_block_dof_vec(const char *name, int n_components,
					    const FE_SPACE **tmp_fe_spaces)
{
  int i;
  char vec_name[24];
  BLOCK_DOF_VEC *block_vec = MEM_ALLOC(1, BLOCK_DOF_VEC);
  
  block_vec->name = strdup(name);
  block_vec->n_components = n_components;
  
  for (i = 0; i < n_components; i++) {
    sprintf(vec_name, "dof_vec%d", i);
    if ( tmp_fe_spaces[i]->rdim == DIM_OF_WORLD) {
      block_vec->dof_vec[i] = get_dof_real_vec_d(vec_name, tmp_fe_spaces[i]);
    } else { /* implies rdim == 1 */
      block_vec->dof_vec[i] =
	(DOF_REAL_VEC_D *)get_dof_real_vec(vec_name, tmp_fe_spaces[i]);
    }
  }
  
  for (i = n_components; i < N_OEM_BLOCKS_MAX; i++)
    block_vec->dof_vec[i] = NULL;
  
  return block_vec;
}

static
BLOCK_DOF_SCHAR_VEC *
_AI_get_block_dof_schar_vec(const char *name, int n_components,
			    const FE_SPACE **tmp_fe_spaces)
{
  int i;
  char vec_name[24];
  BLOCK_DOF_SCHAR_VEC *block_schar_vec = MEM_ALLOC(1, BLOCK_DOF_SCHAR_VEC);
  
  block_schar_vec->name = strdup(name);
  block_schar_vec->n_components = n_components;
  
  for (i = 0; i < n_components; i++) {
    sprintf(vec_name, "schar_vec%d", i);
    block_schar_vec->schar_vec[i] =
      get_dof_schar_vec(vec_name, tmp_fe_spaces[i]);
  }
  
  for (i = n_components; i < N_OEM_BLOCKS_MAX; i++)
    block_schar_vec->schar_vec[i] = NULL;
  
  return block_schar_vec;
}


BLOCK_DOF_VEC *get_block_dof_vec(const char *name, int n_components,
				 const FE_SPACE *fe_space,...)
{
  va_list arg_pointer;
  int	i;
  const FE_SPACE *tmp_fe_spaces[N_OEM_BLOCKS_MAX];
  const FE_SPACE *last_fe_space = fe_space;

  va_start(arg_pointer, fe_space);
  
  for (i = 0; i < n_components; i++) {
    tmp_fe_spaces[i] = last_fe_space;

    /************************************************************************
     * if there are more components than fe_space-arguments, the routin will
     * take the last given fe_space for the remaining dof_*_vecs
     ***********************************************************************/
    if(fe_space != NULL) 
      fe_space = va_arg(arg_pointer, const FE_SPACE *);
    if(fe_space != NULL)
      last_fe_space = fe_space;	  
  }
  
  va_end(arg_pointer);
 
  return _AI_get_block_dof_vec(name, n_components, tmp_fe_spaces);
}

BLOCK_DOF_SCHAR_VEC *
get_block_dof_schar_vec(const char *name, int n_components,
			const FE_SPACE *fe_space, ...)
{
  va_list arg_pointer;
  int	i;
  const FE_SPACE *tmp_fe_spaces[N_OEM_BLOCKS_MAX];
  const FE_SPACE *last_fe_space = fe_space;

  va_start(arg_pointer, fe_space);
  
  for (i = 0; i < n_components; i++) {
    tmp_fe_spaces[i] = last_fe_space;

    /************************************************************************
     * if there are more components than fe_space-arguments, the routin will
     * take the last given fe_space for the remaining dof_*_vecs
     ***********************************************************************/
    if(fe_space != NULL) 
      fe_space = va_arg(arg_pointer, const FE_SPACE *);
    if(fe_space != NULL)
      last_fe_space = fe_space;	  
  }
	  
  va_end(arg_pointer);
	 
  return _AI_get_block_dof_schar_vec(name, n_components, tmp_fe_spaces);
}


#if 0	//original
BLOCK_DOF_VEC *get_block_dof_vec(BLOCK_DOF_VEC	*block_vec,
				 const char *name, int n_components,
				 const FE_SPACE *fe_space,...)
{
  va_list arg_pointer;
  int	i;
  char vec_name[24];

  const FE_SPACE *last_fe_space = fe_space;
  if (block_vec == NULL)
    block_vec = MEM_ALLOC(1, BLOCK_DOF_VEC);
  
  block_vec->name = strdup(name);
  block_vec->n_components = n_components;
/*  block_vec->dof_vec = MEM_ALLOC(n_components, DOF_REAL_D_VEC *);	*/

  va_start(arg_pointer, fe_space);
  
  for (i = 0; i < n_components; i++) {
    sprintf(vec_name, "dof_vec%d", i);
    block_vec->dof_vec[i] = get_dof_real_vec_d(vec_name, last_fe_space);

    /************************************************************************
     * if there are more components than fe_space-arguments, the routin will
     * take the last given fe_space for the remaining dof_*_vecs
     ***********************************************************************/
    if(fe_space != NULL) 
      fe_space = va_arg(arg_pointer, const FE_SPACE *);
    if(fe_space != NULL)
      last_fe_space = fe_space;	  
  }
  
  va_end(arg_pointer);
  
  for (i = n_components; i < N_OEM_BLOCKS_MAX; i++)
    block_vec->dof_vec[i] = NULL;
  
  return block_vec;
}
#endif


BLOCK_DOF_MATRIX *
get_block_dof_matrix(const char *name,
		     int n_row_components, int n_col_components,
		     MatType block_type, const FE_SPACE *fe_space,...)
{
  FUNCNAME("get_block_dof_matrix");
  va_list	arg_pointer;
  int		i, j, max_components;
  char 		matrix_name[24];
  BLOCK_DOF_MATRIX *block_mat;

  /************************************************************************
   * if there are more components than fe_space-arguments, the routine
   * will take the last given fe_space for the remaining dof_*_vecs
   ***********************************************************************/
  const FE_SPACE *last_fe_space = fe_space;
  
  block_mat = MEM_ALLOC(1, BLOCK_DOF_MATRIX);
  
  block_mat->name = strdup(name);
  block_mat->n_row_components = n_row_components;
  block_mat->n_col_components = n_col_components;
  block_mat->block_type = block_type;

  if(n_row_components >= n_col_components) {
    max_components = n_row_components;
  } else {
    max_components = n_col_components;
  }
  
  va_start(arg_pointer, fe_space);

  block_mat->row_fe_spaces[0] = fe_space;
  fe_space = va_arg(arg_pointer, const FE_SPACE *);
  if(fe_space != NULL) 
    last_fe_space = fe_space;
  block_mat->col_fe_spaces[0] = last_fe_space;
  
  for(i = 1; i < max_components; i++) {
 
    if(i < n_row_components) {
      if(fe_space != NULL) 
	fe_space = va_arg(arg_pointer, const FE_SPACE *);
      if(fe_space != NULL) 
	last_fe_space = fe_space;
      block_mat->row_fe_spaces[i] = last_fe_space;
    }
			  
    if(i < n_col_components) {
      if(fe_space != NULL) 
	fe_space = va_arg(arg_pointer, const FE_SPACE *);
      if(fe_space != NULL) 
	last_fe_space = fe_space;
      block_mat->col_fe_spaces[i] = last_fe_space;
    }
			  
  }

  va_end(arg_pointer);
  

  if (block_mat->block_type == Full)
    for (i = 0; i < n_row_components; i++)
      for (j = 0; j < n_col_components; j++) {
	sprintf(matrix_name, "dof_mat%d%d", i, j);
	block_mat->dof_mat[i][j] =
	  get_dof_matrix(matrix_name,
			 block_mat->row_fe_spaces[i],
			 block_mat->col_fe_spaces[j]);
	block_mat->transpose[i][j] = NoTranspose;
      }
  
  if (block_mat->block_type == Empty)
    for (i = 0; i < n_row_components; i++)
      for (j = 0; j < n_col_components; j++) {
	block_mat->dof_mat[i][j] = NULL;
	block_mat->transpose[i][j] = NoTranspose;
      }
  
  if (block_mat->block_type == Diag) {
    TEST_EXIT(block_mat->n_row_components == block_mat->n_col_components,
	      "n_row_components not equal n_col_components or "
	      "block_type is not 'Diag'\n");
    for(i = 0; i < n_row_components; i++) {
      sprintf(matrix_name, "dof_mat%d%d", i, i);
      block_mat->dof_mat[i][i] =
	get_dof_matrix(matrix_name,
		       block_mat->row_fe_spaces[i],
		       block_mat->col_fe_spaces[i]);
      block_mat->transpose[i][i] = NoTranspose;
      for (j = i+1; j < n_col_components; j++) {
	block_mat->dof_mat[i][j] = NULL;
	block_mat->transpose[i][j] = NoTranspose;
	block_mat->dof_mat[j][i] = NULL;
	block_mat->transpose[j][i] = NoTranspose;
      }			  
    }
  }
  
  if (block_mat->block_type == Triag)
    for(i = 0; i < n_row_components; i++) {
      sprintf(matrix_name, "dof_mat%d%d", i, i);
      block_mat->dof_mat[i][i] =
	get_dof_matrix(matrix_name,
		       block_mat->row_fe_spaces[i],
		       block_mat->col_fe_spaces[i]);
      block_mat->transpose[i][i] = NoTranspose;
      for (j = i+1; j < n_col_components; j++) {
	sprintf(matrix_name, "dof_mat%d%d", i, j);
	block_mat->dof_mat[i][j] =
	  get_dof_matrix(matrix_name,
			 block_mat->row_fe_spaces[i],
			 block_mat->col_fe_spaces[j]);
	block_mat->transpose[i][j] = NoTranspose;
	block_mat->dof_mat[j][i] = NULL;
	block_mat->transpose[j][i] = NoTranspose;
      }			  
    }

  
  if (block_mat->block_type == Symm) {
    MSG("!!!!!   block_type == Symm is not tested yet  !!!!!");
	  
    TEST_EXIT(block_mat->n_row_components == block_mat->n_col_components,
	      "n_row_components not equal n_col_components or "
	      "block_type is not 'Symm'\n");
    for(i = 0; i < n_row_components; i++) {
      TEST_EXIT(block_mat->row_fe_spaces[i] == block_mat->col_fe_spaces[i],
		"row_fe_spaces not equal col_fe_spaces or "
		"block_type is not 'Symm'\n");
      for (j = i; j < n_col_components; j++) {
	sprintf(matrix_name, "dof_mat%d%d", i, j);
	block_mat->dof_mat[i][j] =
	  get_dof_matrix(matrix_name,
			 block_mat->row_fe_spaces[i],
			 block_mat->col_fe_spaces[j]);
	block_mat->dof_mat[j][i] = block_mat->dof_mat[i][j];
	if (i != j) {
	  block_mat->transpose[i][j] = NoTranspose;
	  block_mat->transpose[j][i] = Transpose;
	} else {
	  block_mat->transpose[i][j] = NoTranspose;
	}
      }
    }
  }
  
  if (block_mat->block_type == SymmTriag) {
    MSG("!!!!!   block_type == SymmTriag in not tested   !!!!!");
	  
    TEST_EXIT(block_mat->n_row_components == block_mat->n_col_components,
	      "n_row_components not equal n_col_components or "
	      "block_type is not 'Symm'\n");
    for(i = 0; i < n_row_components; i++) {
      TEST_EXIT(block_mat->row_fe_spaces[i] == block_mat->col_fe_spaces[i],
		"row_fe_spaces not equal col_fe_spaces or "
		"block_type is not 'Symm'\n");
      for (j = i; j < n_col_components; j++) {
	if (j < (n_col_components - i))
	  block_mat->dof_mat[i][j] =
	    get_dof_matrix(name,
			   block_mat->row_fe_spaces[i],
			   block_mat->col_fe_spaces[j]);
	else
	  block_mat->dof_mat[i][j] = NULL;
			  
	block_mat->dof_mat[j][i] = block_mat->dof_mat[i][j];
	if (i != j) {
	  block_mat->transpose[i][j] = NoTranspose;
	  block_mat->transpose[j][i] = Transpose;
	} else {
	  block_mat->transpose[i][j] = NoTranspose;
	}
      }
    }
  }

  
  /* Set nonused dof_mat's to NULL */
  for (i = n_row_components; i < N_OEM_BLOCKS_MAX; i++) {
    block_mat->row_fe_spaces[i] = NULL;

    for (j = n_col_components; j < N_OEM_BLOCKS_MAX; j++) {
      block_mat->dof_mat[i][j]    = NULL;
      block_mat->transpose[i][j]  = NoTranspose;  
    }
  }
  for (j = n_col_components; j < N_OEM_BLOCKS_MAX; j++)
    block_mat->col_fe_spaces[j] = NULL;

  return block_mat;
}

void get_size_of_dof_matrix(const BLOCK_DOF_MATRIX *block_mat,
					int r, int c, int *n_rows, int *n_cols)
{
	
  const DOF_MATRIX *rmatrix = NULL;
  const DOF_MATRIX *cmatrix = NULL;
	
  int i, j;	
	  
  *n_rows = 0;
  *n_cols = 0;
	  
  /* find a filled dof-matrix in the same row */
  for (j = 0; j < block_mat->n_col_components; j++) {
    if (block_mat->dof_mat[r][j] != NULL) {
      rmatrix = block_mat->dof_mat[r][j];
      break;
    }
  }
  if (rmatrix == NULL) {
    printf("\n\n\n");
    MSG("!!!     ERROR     !!!\n");
    MSG("!!!     ERROR     !!!     "
	"Did not find any filled dof-matrix in the same row     !!!\n");
    return;
  }
		
  /* get number of rows */
  COL_CHAIN_DO(rmatrix, const DOF_MATRIX) {
    int row_dim = rmatrix->row_fe_space->admin->size_used;
    switch (rmatrix->type) {
    case MATENT_REAL:
      if ((rmatrix->row_fe_space->rdim == DIM_OF_WORLD) &&
	  (rmatrix->col_fe_space->rdim == DIM_OF_WORLD) &&
	  (rmatrix->row_fe_space->bas_fcts->rdim == 1) &&
	  (rmatrix->col_fe_space->bas_fcts->rdim == 1))
	row_dim *= DIM_OF_WORLD;
      break;
	    		
    case MATENT_REAL_D:
      if ((rmatrix->row_fe_space->rdim == DIM_OF_WORLD &&
	   rmatrix->col_fe_space->rdim == 1)
	  ||
	  (rmatrix->row_fe_space->rdim == DIM_OF_WORLD &&
	   rmatrix->col_fe_space->rdim == DIM_OF_WORLD &&
	   rmatrix->col_fe_space->bas_fcts->rdim == DIM_OF_WORLD))
	row_dim *= DIM_OF_WORLD;
      break;
	    		
    case MATENT_REAL_DD:
      row_dim *= DIM_OF_WORLD;
      break;
	    		
    default:
      ERROR("Unknown matrix type: %d\n", rmatrix->type);
    }
	    	
    *n_rows += row_dim;
			
  } COL_CHAIN_WHILE(rmatrix, const DOF_MATRIX);
		

		
  /* find a filled dof-matrix in the same col */
  for (i = 0; i < block_mat->n_row_components; i++) {
    if (block_mat->dof_mat[i][c] != NULL) {
      cmatrix = block_mat->dof_mat[i][c];
      break;
    }
  }
  if (cmatrix == NULL) {
    printf("\n\n\n");
    MSG("!!!     ERROR     !!!\n");
    MSG("!!!     ERROR     !!!     "
	"Did not find any filled dof-matrix in the same col     !!!\n");
    return;
  }
		
  /* get number of rows */
  ROW_CHAIN_DO(cmatrix, const DOF_MATRIX) {
    int col_dim = cmatrix->col_fe_space->admin->size_used;
    switch (cmatrix->type) {
    case MATENT_REAL:
      if ((cmatrix->row_fe_space->rdim == DIM_OF_WORLD) &&
	  (cmatrix->col_fe_space->rdim == DIM_OF_WORLD) &&
	  (cmatrix->row_fe_space->bas_fcts->rdim == 1) &&
	  (cmatrix->col_fe_space->bas_fcts->rdim == 1))
	col_dim *= DIM_OF_WORLD;
      break;
	    		
    case MATENT_REAL_D:
      if ((cmatrix->row_fe_space->rdim == 1 &&
	   cmatrix->col_fe_space->rdim == DIM_OF_WORLD)
	  ||
	  (cmatrix->row_fe_space->rdim == DIM_OF_WORLD &&
	   cmatrix->row_fe_space->bas_fcts->rdim == DIM_OF_WORLD &&
	   cmatrix->col_fe_space->rdim == DIM_OF_WORLD)) 
	col_dim *= DIM_OF_WORLD;
      break;
	    		
    case MATENT_REAL_DD:
      col_dim *= DIM_OF_WORLD;
      break;
	    		
    default:
      ERROR("Unknown matrix type: %d\n", cmatrix->type);
    }
	    	
    *n_cols += col_dim;
			
  } ROW_CHAIN_WHILE(cmatrix, const DOF_MATRIX);

}

void free_block_dof_vec(BLOCK_DOF_VEC *bvec)
{
  int i;
  for (i = 0; i < bvec->n_components; i++)
    free_dof_real_vec_d(bvec->dof_vec[i]);

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

  MEM_FREE(bvec, 1, BLOCK_DOF_VEC);
}

void free_block_dof_schar_vec(BLOCK_DOF_SCHAR_VEC *bvec)
{
  int i;
  for (i = 0; i < bvec->n_components; i++)
    free_dof_schar_vec(bvec->schar_vec[i]);

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

  MEM_FREE(bvec, 1, BLOCK_DOF_SCHAR_VEC);
}

void free_block_dof_matrix(BLOCK_DOF_MATRIX *bmat)
{
  int i, j;
  for (i = 0; i < bmat->n_row_components; i++)
    for (j = 0; j < bmat->n_col_components; j++)
      free_dof_matrix(bmat->dof_mat[i][j]);

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

  MEM_FREE(bmat, 1, BLOCK_DOF_MATRIX);
}

void clear_block_dof_matrix(BLOCK_DOF_MATRIX *bmat)
{
  int i, j;
  for (i = 0; i < bmat->n_row_components; i++)
    for (j = 0; j < bmat->n_col_components; j++)
      clear_dof_matrix(bmat->dof_mat[i][j]);
}

void block_dof_copy(const BLOCK_DOF_VEC *x, BLOCK_DOF_VEC *y)
{
  FUNCNAME("block_dof_copy");
	
  TEST_EXIT(x->n_components == y->n_components,
	    "can't copy BLOCK_DOF_VEC x to y "
	    "because they don't have the same number of components!!!\n");
	  
  int i;
  for (i = 0; i < x->n_components; i++)
    dof_copy_dow(x->dof_vec[i], y->dof_vec[i]);
}

void block_dof_set(REAL stotz, BLOCK_DOF_VEC *bvec)
{
  int i;
  for (i = 0; i < bvec->n_components; i++)
    dof_set_dow(stotz, bvec->dof_vec[i]);
}

/******************************************************************************
 *  and now: oem_block_solve(const BLOCK_DOF_MATRIX *A, ... )
 ******************************************************************************/


struct mat_vec_block_data
{
  const BLOCK_DOF_MATRIX    *matrix;
  MatrixTranspose           transpose;
  const BLOCK_DOF_SCHAR_VEC *mask;
  
  BLOCK_DOF_VEC		    x_skel[1];
  BLOCK_DOF_VEC      	    y_skel[1];
  
  SCRATCH_MEM               scratch;
  
  struct mat_vec_block_data *next;
};

static
int distribute_to_block_dof_vec_skel(BLOCK_DOF_VEC *skel, REAL *x)
{
  int i, size = 0, _size = 0;
  for(i = 0; i < skel->n_components; i++) {
    _size = distribute_to_dof_real_vec_d_skel(skel->dof_vec[i], x);
    x += _size;
    size += _size;
  }
  return size;
}

int copy_from_block_dof_vec(REAL *x, BLOCK_DOF_VEC *bdof)
{
  int i, size = 0, _size = 0;
  for(i = 0; i < bdof->n_components; i++) {
    _size = copy_from_dof_real_vec_d(x, bdof->dof_vec[i]);
    x += _size;
    size += _size;
  }
  return size;
}

int copy_to_block_dof_vec(BLOCK_DOF_VEC *bdof, REAL *x)
{
  int i, size = 0, _size = 0;
  for(i = 0; i < bdof->n_components; i++) {
    _size = copy_to_dof_real_vec_d(bdof->dof_vec[i], x);
    x += _size;
    size += _size;
  }
  return size;
}

int block_dof_vec_length(BLOCK_DOF_VEC *bdof)
{
  int i, dim = 0;
  for(i = 0; i < bdof->n_components; i++)
    dim += dof_real_vec_d_length(bdof->dof_vec[i]->fe_space);
		
  return dim;
}



/*---8<---------------------------------------------------------------------*/
/*---   y <- A x  or y <- A^T x                                          ---*/
/*--------------------------------------------------------------------->8---*/


int oem_block_mat_vec(void *ud, int dim, const REAL *x, REAL *y)
{
  /*FUNCNAME("oem_block_mat_vec");*/
  struct mat_vec_block_data  *data  = (struct mat_vec_block_data *)ud;
  int row, col;
	  
  BLOCK_DOF_VEC  *bdof_x = data->x_skel;
  BLOCK_DOF_VEC  *bdof_y = data->y_skel;
  data->x_skel->n_components = data->matrix->n_col_components;
  data->y_skel->n_components = data->matrix->n_row_components;
	
  distribute_to_block_dof_vec_skel(data->x_skel, (REAL *)x);
  distribute_to_block_dof_vec_skel(data->y_skel, y);
	  

  for (row = 0; row < data->matrix->n_row_components; row++) {
    dof_set_dow(0.0, bdof_y->dof_vec[row]);
    for (col = 0; col < data->matrix->n_col_components; col++) {
      if (data->matrix->dof_mat[row][col] != NULL)
	dof_gemv_dow(data->matrix->transpose[row][col],
		     1.0, data->matrix->dof_mat[row][col],
		     data->mask ? data->mask->schar_vec[row] : NULL,
		     bdof_x->dof_vec[col], 1.0, bdof_y->dof_vec[row]);
    }
  }


  return 0;
}

OEM_MV_FCT oem_init_block_mat_vec(void **datap,
				  MatrixTranspose transpose,
				  const BLOCK_DOF_MATRIX *A, 
				  const BLOCK_DOF_SCHAR_VEC *mask)
{
  /*FUNCNAME("oem_init_mat_vec");*/
  struct mat_vec_block_data *data;
  SCRATCH_MEM scrmem;

  int i, j;
  
  SCRATCH_MEM_INIT(scrmem);
  
  data = SCRATCH_MEM_ALLOC(scrmem, 1, struct mat_vec_block_data);
  memset(data, 0, sizeof(*data));
  SCRATCH_MEM_CPY(data->scratch, scrmem);

  data->matrix    = A;
  data->transpose = transpose;

  data->mask     = mask;


  for (i = 0; i < A->n_row_components; i++)
    data->y_skel->dof_vec[i] = init_dof_real_vec_d_skel(
      SCRATCH_MEM_ALLOC(scrmem,
			CHAIN_LENGTH(A->row_fe_spaces[i]), DOF_REAL_VEC_D),
      "y skel",
      A->row_fe_spaces[i]);
	  
	  
  for (j = 0; j < A->n_col_components; j++)
    data->x_skel->dof_vec[j] = init_dof_real_vec_d_skel(
      SCRATCH_MEM_ALLOC(scrmem,
			CHAIN_LENGTH(A->col_fe_spaces[j]), DOF_REAL_VEC_D),
      "x skel",
      A->col_fe_spaces[j]);


  *datap = data;
  
  return oem_block_mat_vec;
}

void oem_exit_block_mat_vec(void *vdata)
{
  struct mat_vec_block_data *data = (struct mat_vec_block_data *)vdata;
  
  SCRATCH_MEM_ZAP(data->scratch);
}




/*---8<---------------------------------------------------------------------*/
/*---   diaoganal preconditioning for decoupled vector valued  problems  ---*/
/*--------------------------------------------------------------------->8---*/
#if 0
struct precon_data
{
  PRECON              		precon;

  const BLOCK_DOF_MATRIX	*matrix;
  const DOF_SCHAR_VEC		*mask;
  int                 		dim;

  const REAL_D        		*diag_1;
  size_t              		size_diag_1;

  struct precon_data 		*next;
};
#endif

/* Simplest method: just do block-diagonal precon.
 *
 *
 * P = diag(P_1, P_2, ...) where P_1, ... are listed in precon_chain.
 * 
 * Maybe we could give block-SSOR a chance:
 *
 * A = (a_{ij}) where a_{ij} are matrices, the precons listed in
 * precon_chain serve as approximate inverse to a_{ii}
 *
 */

static void block_mat_diag_precon(void *pd, int dim, REAL *r)
{
  BLOCK_MAT_PRECON_DATA *data = (BLOCK_MAT_PRECON_DATA *)pd;
  BLOCK_PRECON_NODE *precon;
  int i;
  
  for (i = 0; i < data->n_diag_components; i++)
    /*  for (prec = data->precon_chain; prec != NULL; prec = prec->next) */{
    precon = &data->block_precon_node[i];
    if (precon->type != NoPrecon) {
      precon->precon->precon(precon->precon->precon_data, precon->dim, r);
    }
    r += precon->dim;
  }
}

static void block_mat_diag_exit_precon(void *pd)
{
  BLOCK_MAT_PRECON_DATA *data = (BLOCK_MAT_PRECON_DATA *)pd;
  BLOCK_PRECON_NODE *precon;
  int i;
  
  for (i = 0; i < data->n_diag_components; i++) {
    precon = &data->block_precon_node[i];
    if (precon->type != NoPrecon) {
      precon->precon->exit_precon(precon->precon->precon_data);
    }
  }

  /* Release all our resources. */
  SCRATCH_MEM_ZAP(data->scratch);
}

static bool block_mat_diag_init_precon(void *pd)
{
  BLOCK_MAT_PRECON_DATA *data = (BLOCK_MAT_PRECON_DATA *)pd;
  BLOCK_PRECON_NODE *precon;
  int i;
  
  for (i = 0; i < data->n_diag_components; i++) {
    precon = &data->block_precon_node[i];
    if (precon->type != NoPrecon) {
      if (!precon->precon->init_precon(precon->precon->precon_data)) {
    	return false;
      }
    }
  }
  return true;
}


#if SSOR
static void block_mat_ssor_precon(void *pd, int dim, REAL *r)
{
  BLOCK_MAT_PRECON_DATA *data = (BLOCK_MAT_PRECON_DATA *)pd;
  BLOCK_PRECON_NODE *prec;
  int iter, i, j;
  REAL *rbase = r; /* Startadresse */

  
  /* FIXME: do we need to mask out boundary DOFs? */
  distribute_to_block_dof_vec_skel(data->r_skel, r);
  block_dof_copy(data->r_skel, data->rhs);
  /* dset(dim, 0.0, r, 1); */
  
  for (iter = 0; iter < data->block_n_iter; iter++) {
    /* Forward Gauss-Seidel iteration */
    r = rbase;
    for (i = 0; i < data->block_mat->n_row_components; i++) {
      prec = &data->block_precon_node[i];
      dof_copy_dow(data->rhs->dof_vec[i], prec->accu);
      for (j = 0; j < data->block_mat->n_col_components; j++){
	if (j!=i)
	  dof_gemv_dow(NoTranspose, -1.0, prec->bmat->dof_mat[i][j], 
		       data->block_mask ? data->block_mask->schar_vec[i] : NULL,
		       data->r_skel->dof_vec[j], 1.0, prec->accu);
      }			  
      /* Pseudo-invert the diagonal block */
      if (prec->type != NoPrecon) {
	prec->precon->precon(
	  prec->precon->precon_data, prec->dim, prec->accu->vec);
      }
      /* r[idx] = omega A_diag^{-1} accu + (1-omega) r */
      dscal(prec->dim, data->block_omega, prec->accu->vec, 1);
      dxpay(prec->dim, prec->accu->vec, 1, 1.0 - data->block_omega, r, 1);
		
      r += prec->dim;
    }
    /* Backward Gauss-Seidel iteration */
    r = rbase + dim;
    for (i = data->block_mat->n_row_components - 1; i >= 0 ; i--) {
      prec = &data->block_precon_node[i];
      r -= prec->dim;
      dof_copy_dow(data->rhs->dof_vec[i], prec->accu);
      for (j = 0; j < data->block_mat->n_col_components; j++){
	if (j!=i)
	  dof_gemv_dow(NoTranspose, -1.0, prec->bmat->dof_mat[i][j], 
		       data->block_mask ? data->block_mask->schar_vec[i] : NULL,
		       data->r_skel->dof_vec[j], 1.0, prec->accu);
      }
      /* Pseudo-invert the diagonal block */
      if (prec->type != NoPrecon) {
	prec->precon->precon(
	  prec->precon->precon_data, prec->dim, prec->accu->vec);
      }
      /* r[idx] = omega A_diag^{-1} accu + (1-omega) r */
      dscal(prec->dim, data->block_omega, prec->accu->vec, 1);
      dxpay(prec->dim, prec->accu->vec, 1, 1.0 - data->block_omega, r, 1);
    }
	  
  }
}

static void block_mat_ssor_exit_precon(void *pd)
{
  BLOCK_MAT_PRECON_DATA *data = (BLOCK_MAT_PRECON_DATA *)pd;
  BLOCK_PRECON_NODE *precon;
  int i;
  
  for (i = 0; i < data->n_diag_components; i++) {
    precon = &data->block_precon_node[i];
    if (precon->type != NoPrecon) {
      precon->precon->exit_precon(precon->precon->precon_data);
    }
    free_dof_real_vec_d(precon->accu);
  }

  free_block_dof_vec(data->rhs);

  /* Release all our resources. */
  SCRATCH_MEM_ZAP(data->scratch);
}

static bool block_mat_ssor_init_precon(void *pd)
{
  return block_mat_diag_init_precon(pd);
	
	
#if 0
  BLOCK_MAT_PRECON_DATA *data = (BLOCK_MAT_PRECON_DATA *)pd;
  BLOCK_PRECON_NODE *precon;
	  
  CHAIN_FOREACH(prec, data, struct precon_node) {
    update_dof_matrix_sub_chain(precon->A);
    update_dof_matrix_sub_chain(precon->A_row);
    if (prec->mask) {
      update_dof_schar_vec_sub_chain(precon->mask);
    }
    if (!prec->precon->init_precon(precon->precon->precon_data)) {
      return false;
    }
  }
  return true;
#endif
}
#endif

const PRECON *init_oem_block_precon(const BLOCK_DOF_MATRIX *block_mat,
				    const BLOCK_DOF_SCHAR_VEC *block_mask,
				    int info,
				    const BLOCK_PRECON_TYPE *block_prec_type)
{
  FUNCNAME("init_oem_block_precon");


  if (block_prec_type->block_type == NoPrecon)
    return NULL;


  TEST_EXIT(block_mat->n_col_components == block_mat->n_row_components,
	    "Block-preconditioner "
	    "only implemented for quadratic matrizes! Very sorry.\n");
  
  BLOCK_MAT_PRECON_DATA *data;
  BLOCK_PRECON_NODE *node;
  SCRATCH_MEM scrmem;
  int i;
  
 

  SCRATCH_MEM_INIT(scrmem);
  data = SCRATCH_MEM_ALLOC(scrmem, 1, BLOCK_MAT_PRECON_DATA);
  memset(data, 0, sizeof(*data));
  SCRATCH_MEM_CPY(data->scratch, scrmem);

  data->block_mat    = block_mat;
  data->block_mask   = block_mask;
  data->n_diag_components = MIN(block_mat->n_col_components,
				block_mat->n_row_components);
  data->dim			 = 0;
  if (block_mat->n_col_components == data->n_diag_components) {
    for(i = 0; i < data->n_diag_components; i++) {
      data->block_precon_node[i].dim =
	dof_real_vec_d_length(block_mat->col_fe_spaces[i]);
      data->dim += data->block_precon_node[i].dim;
    }
  } else {
    for(i = 0; i < data->n_diag_components; i++) {
      data->block_precon_node[i].dim =
	dof_real_vec_d_length(block_mat->row_fe_spaces[i]);
      data->dim += data->block_precon_node[i].dim;
    }
  }
  data->precon.precon_data = data;
  
  switch (block_prec_type->block_type) {
  case BlkDiagPrecon:
    data->block_type = BlkDiagPrecon;
    data->precon.init_precon = block_mat_diag_init_precon;
    data->precon.exit_precon = block_mat_diag_exit_precon;
    data->precon.precon      = block_mat_diag_precon;
    break;
  case BlkSSORPrecon:
	  
#if SSOR
    data->block_type = BlkSSORPrecon;
    data->precon.init_precon = block_mat_ssor_init_precon;
    data->precon.exit_precon = block_mat_ssor_exit_precon;
    data->precon.precon      = block_mat_ssor_precon;
    data->block_omega              = block_prec_type->block_omega;
    data->block_n_iter             = block_prec_type->block_n_iter;
    const FE_SPACE *tmp_fe_spaces[N_OEM_BLOCKS_MAX];
    for (i = 0; i < N_OEM_BLOCKS_MAX; i++)
      tmp_fe_spaces[i] = data->block_mat->col_fe_spaces[i];
    data->rhs = _AI_get_block_dof_vec("SSOR rhs",
				      data->block_mat->n_col_components,
				      tmp_fe_spaces);

    data->r_skel->n_components = data->block_mat->n_col_components;
    for (i = 0; i < data->r_skel->n_components; i++)
      data->r_skel->dof_vec[i] = init_dof_real_vec_d_skel(
	SCRATCH_MEM_ALLOC(scrmem,
			  CHAIN_LENGTH(data->block_mat->col_fe_spaces[i]),
			  DOF_REAL_VEC_D),
	"SSOR r skeleton",
	data->block_mat->col_fe_spaces[i]);
    break;

  default:	/* not reachable */
    data->block_type = NoPrecon;
    return NULL;
  }

  node = data->block_precon_node;

 
  for (i = 0; i < data->n_diag_components; i++) {
    node[i].type = block_prec_type->precon_type[i].type;
    node[i].dof_mat = block_mat->dof_mat[i][i];
    node[i].bmat = block_mat;
    node[i].mask = block_mask ? block_mask->schar_vec[i] : NULL;
    if (node[i].dof_mat != NULL)
      node[i].precon =
	init_precon_from_type(node[i].dof_mat, node[i].mask,
			      info, &block_prec_type->precon_type[i]);
    if (data->block_type == BlkSSORPrecon) {
      /* We need some scratch memory for the rhs and so on. */
      if (block_mat->col_fe_spaces[i]->rdim == DIM_OF_WORLD) {
	node[i].accu = get_dof_real_vec_d("SSOR accu",
					  block_mat->col_fe_spaces[i]);
      } else { /* implies rdim == 1*/
	node[i].accu =
	  (DOF_REAL_VEC_D *)get_dof_real_vec("SSOR accu",
					     block_mat->col_fe_spaces[i]);
      }
    }
  }

  return &data->precon;
}


#endif
/*--------------------------------------------------------------------------*/
/*---  interface to oem solver for decoupled vector valued problems  -------*/
/*--------------------------------------------------------------------------*/


OEM_DATA *init_oem_block_solve(const BLOCK_DOF_MATRIX *bmat,
			       const BLOCK_DOF_SCHAR_VEC *mask,
			       REAL tol, const PRECON *precon,
			       int restart, int max_iter, int info)
{
  FUNCNAME("init_oem_block_solve");
  OEM_DATA     *oem;
  const MatrixTranspose transpose = NoTranspose;
  /* not implemented for transposed Block-Matrizes */

  
  oem = MEM_CALLOC(1, OEM_DATA); 
  oem->mat_vec =
    oem_init_block_mat_vec(&oem->mat_vec_data, transpose, bmat, mask);

  if (precon) {
    if (precon->init_precon && !(*precon->init_precon)(precon->precon_data)) {
      precon = NULL;
      MSG("init_precon() failed, disabling preconditioner!\n");
    } else {
      oem->left_precon_data = precon->precon_data;
      oem->left_precon = precon->precon;
    }
  }
  
  
  oem->ws        = NULL;
  oem->tolerance = tol;
  oem->restart   = restart;
  oem->max_iter  = max_iter;
  oem->info      = MAX(0, info);


 
  return oem;
}



int call_oem_block_solve(const OEM_DATA *_oem, OEM_SOLVER solver,
			 const BLOCK_DOF_VEC *f, BLOCK_DOF_VEC *u)
{
  int iter, restart, i, dim = 0;
  OEM_DATA *oem = (OEM_DATA *)_oem;
  
  dim = block_dof_vec_length((BLOCK_DOF_VEC *)f);
  
  REAL *u_vec;
  REAL *f_vec;
  

  for (i = 0; i < MIN(u->n_components, f->n_components); i++)
    TEST_EXIT(u->dof_vec[i]->fe_space->admin == f->dof_vec[i]->fe_space->admin,
	      "Row and column FE_SPACEs don't match!\n");

  
  u_vec = MEM_ALLOC(dim, REAL);
  f_vec = MEM_ALLOC(dim, REAL);

  copy_from_block_dof_vec(f_vec, (BLOCK_DOF_VEC *)f);
  copy_from_block_dof_vec(u_vec, (BLOCK_DOF_VEC *)u);
  
  switch (solver) {
  case BiCGStab:
    iter = oem_bicgstab(oem, dim, (REAL *) f_vec, (REAL *) u_vec);
    break;
  case CG:
    iter = oem_cg(oem, dim, (REAL *) f_vec, (REAL *) u_vec);
    break;
  case TfQMR:
    iter = oem_tfqmr(oem, dim, (REAL *) f_vec, (REAL *) u_vec);
    break;
  case GMRes:
    restart = oem->restart;
    oem->restart = MAX(0, MIN(oem->restart, dim));
    iter = oem_gmres(oem, dim, (REAL *) f_vec, (REAL *) u_vec);
    oem->restart = restart;
    break;
  case GMRes_k:
    restart = oem->restart;
    oem->restart = MAX(0, MIN(oem->restart, dim));
    iter = oem_gmres_k(oem, dim, (REAL *) f_vec, (REAL *) u_vec);
    oem->restart = restart;
    break;
  case ODir:
    iter = oem_odir(oem, dim, (REAL *) f_vec, (REAL *) u_vec);
    break;
  case ORes:
    iter = oem_ores(oem, dim, (REAL *) f_vec, (REAL *) u_vec);
    break;
  case SymmLQ:
    iter = oem_symmlq(oem, dim, (REAL *) f_vec, (REAL *) u_vec);
    break;
  default:
    iter = -1; /* make the compiler happy ... -> no-return attribute? */
    ERROR_EXIT("unknown OEM solver %d\n", (int) solver);
  }

  copy_to_block_dof_vec(u, u_vec);
  MEM_FREE(u_vec, dim, REAL);
  MEM_FREE(f_vec, dim, REAL);

  return iter;
}

void release_oem_block_solve(const OEM_DATA *_oem)
{
  OEM_DATA *oem = (OEM_DATA *)_oem;
  const PRECON *precon;
  
  oem_exit_block_mat_vec(oem->mat_vec_data);
  if ((precon = (PRECON *)oem->left_precon_data) != NULL &&
      precon && precon->exit_precon) {
    precon->exit_precon((void *)precon);
  }

  MEM_FREE(oem, 1, OEM_DATA);
}

/* release_oem_solve() is defined in oem_solve_s.c */
int oem_block_solve(const BLOCK_DOF_MATRIX *A, const BLOCK_DOF_SCHAR_VEC *mask,
		    const BLOCK_DOF_VEC *f, BLOCK_DOF_VEC *u,
		    OEM_SOLVER solver,
		    REAL tol,
		    const PRECON *precon, int restart, int max_iter, int info)
{
  const OEM_DATA *oem;
  int iter;
  
  oem = init_oem_block_solve(A, mask, tol, precon, restart, max_iter, info);
  iter = call_oem_block_solve(oem, solver, f, u);  
  release_oem_block_solve(oem);

  return iter;
}



/******************************************************************************
 *  and now: some BLOCK-specific print routines
 ******************************************************************************/


void print_block_dof_vec(BLOCK_DOF_VEC *block_vec)
{
  int i;
  printf("\n Blockvector: %s\n", block_vec->name);
  for(i = 0; i < block_vec->n_components; i++) {
    printf("\n Vector : dof_vec[%d] \n", i);
    print_dof_real_vec_dow(block_vec->dof_vec[i]);
  }
}

void print_block_dof_matrix(BLOCK_DOF_MATRIX *block_mat)
{
  int i, j;
  printf("\n Blockmatrix: %s\n", block_mat->name);
  for (i = 0; i < block_mat->n_row_components; i++)
    for (j = 0; j < block_mat->n_col_components; j++) {
      if (block_mat->dof_mat[i][j] != NULL) {
	printf("\n Matrix : dof_mat[%d][%d] \n", i, j);
	print_dof_matrix(block_mat->dof_mat[i][j]);
      }
    }
  printf("\n\n");
}


void print_block_dof_vec_maple(BLOCK_DOF_VEC *block_vec, const char *block_name)
{
  if (block_name == NULL)
    block_name = block_vec->name;
	
  fprint_block_dof_vec_maple(stdout, block_vec, block_name);
}

void print_block_dof_matrix_maple(BLOCK_DOF_MATRIX *block_mat,
				  const char *block_name)
{
  if (block_name == NULL)
    block_name = block_mat->name;
	
  fprint_block_dof_matrix_maple(stdout, block_mat, block_name);
}




void file_print_block_dof_vec_maple(const char *file_name,
				    const char fopen_options[],
				    BLOCK_DOF_VEC *block_vec,
				    const char *block_name)
{
  if (block_name == NULL)
    block_name = block_vec->name;
	
  FILE *fp;

  fp = fopen(file_name, fopen_options);
  fprint_block_dof_vec_maple(fp, block_vec, block_name);
  fclose(fp);
}

void file_print_block_dof_matrix_maple(const char *file_name,
				       const char fopen_options[],
				       BLOCK_DOF_MATRIX *block_mat,
				       const char *block_name)
{
  if (block_name == NULL)
    block_name = block_mat->name;
	
  FILE *fp;

  fp = fopen(file_name, fopen_options);
  fprint_block_dof_matrix_maple(fp, block_mat, block_name);
  fclose(fp);
}

static inline
void __fprint_null_dof_matrix_maple(FILE *fp,
				    BLOCK_DOF_MATRIX *block_mat, int r, int c)
{
  /* FUNCNAME("fprint_null_dof_matrix_maple"); */


  char matrix_name[24];
  int n_rows = 0;
  int n_cols = 0;

  sprintf(matrix_name, "NULL_dof_mat%d%d", r, c);
	
	
  fprintf(fp, "\n");
  fprintf(fp, "#DOF_MATRIX ");
  fprintf(fp, "%s", matrix_name);
  fprintf(fp, " in maple-format:\n\n");

  fflush(fp);
  

  get_size_of_dof_matrix(block_mat, r, c, &n_rows, &n_cols);

  fprintf(fp, "%s", matrix_name);
  fprintf(fp, ":=Matrix(%d,%d,proc(i,j) 0 end);\n", n_rows, n_cols);
  fprintf(fp, "\n\n\n\n\n");

  fflush(fp);

}

void fprint_block_dof_vec_maple(FILE *fp,
				BLOCK_DOF_VEC *block_vec,
				const char *block_name)
{
  /*FUNCNAME("fprint_block_dof_vec_maple");*/
  int i, r;
  const DOF_REAL_VEC_D *vec;
  char *vec_name;


  if (block_name == NULL)
    block_name = block_vec->name;


  fprintf(fp, "\n");
  fprintf(fp, "#BLOCK_DOF_VEC ");
  fprintf(fp, "%s", block_name);
  fprintf(fp, " in maple-format:\n\n");


  fflush(fp);

	
  for (r = 0; r < block_vec->n_components; r++) {
    vec_name = (char *)block_vec->dof_vec[r]->name;
    if (block_vec->dof_vec[r] != NULL) {
      vec = (const DOF_REAL_VEC_D *)block_vec->dof_vec[r];

      fprint_dof_real_vec_dow_maple(fp, vec, vec_name);
    }
  }

  /* output as blockvector */
  fprintf(fp, "%s", block_name);
  fprintf(fp, ":=Vector([");
  for (i = 0; i < r; i++) {
    vec_name = (char *)block_vec->dof_vec[i]->name;
    if (i != 0)
      fprintf(fp, ",");
    fprintf(fp, "%s", vec_name);
  }
  fprintf(fp, "]);\n");
  fprintf(fp, "\n\n\n\n\n");
  fflush(fp);

}

void fprint_block_dof_matrix_maple(FILE *fp,
				   BLOCK_DOF_MATRIX *block_mat,
				   const char *block_name)
{
  /*FUNCNAME("fprint_block_dof_matrix_maple");*/

  if (block_name == NULL)
    block_name = block_mat->name;
	
  fprintf(fp, "\n");
  fprintf(fp, "#BLOCK_DOF_MATRIX ");
  fprintf(fp, "%s", block_name);
  fprintf(fp, " in maple-format:\n\n");

  fflush(fp);


  int i, j, r, c;
  const DOF_MATRIX *matrix;
  const char *matrix_name;
	
  for (r = 0; r < block_mat->n_row_components; r++)
    for (c = 0; c < block_mat->n_col_components; c++) {
      if (block_mat->dof_mat[r][c] != NULL) {
	matrix_name = block_mat->dof_mat[r][c]->name;
	matrix = (const DOF_MATRIX *)block_mat->dof_mat[r][c];
	if (block_mat->transpose[r][c] == Transpose) {
	  fprintf(fp,
		  "#!!! ATTENTION !!!  "
		  "The following Matrix is transposed, "
		  "but this output is not transposed !!! \n\n");
	  fflush(fp);
	}

	fprint_dof_matrix_maple(fp, matrix, matrix_name);
      } else {
	__fprint_null_dof_matrix_maple(fp, block_mat, r, c);
      }
    }

  /* output as blockmatrix */
  fprintf(fp, "%s", block_name);
  fprintf(fp, ":=Matrix([");
  for (i = 0; i < r; i++) {
    if (i != 0)
      fprintf(fp, ",");
    fprintf(fp, "[");
    for (j = 0; j < c; j++) {
      if (block_mat->dof_mat[i][j] != NULL) {
	matrix_name = block_mat->dof_mat[i][j]->name;
	if (j != 0)
	  fprintf(fp, ",");
	fprintf(fp, "%s", matrix_name);	
	    			
      } else {
	char null_name[24];
	sprintf(null_name, "NULL_dof_mat%d%d", i, j);
	if (j != 0)
	  fprintf(fp, ",");
	fprintf(fp, "%s", null_name);
      }
    }
    fprintf(fp, "]");
  }
  fprintf(fp, "]);");
  fprintf(fp, "\n\n\n\n\n");
  fflush(fp);
}

