/*--------------------------------------------------------------------------*/
/* ALBERTA:  an Adaptive multi Level finite element toolbox using           */
/*           Bisectioning refinement and Error control by Residual          */
/*           Techniques for scientific Applications                         */
/*                                                                          */
/* file:     MG_s2.c                                                        */
/*                                                                          */
/* description:  multigrid method for a scalar elliptic equation            */
/*               DOF-sort-independent routines                              */
/*                                                                          */
/*--------------------------------------------------------------------------*/
/*                                                                          */
/*  authors:   Alfred Schmidt                                               */
/*             Zentrum fuer Technomathematik                                */
/*             Fachbereich 3 Mathematik/Informatik                          */
/*             Universitaet Bremen                                          */
/*             Bibliothekstr. 2                                             */
/*             D-28359 Bremen, Germany                                      */
/*                                                                          */
/*             Kunibert G. Siebert                                          */
/*             Institut fuer Mathematik                                     */
/*             Universitaet Augsburg                                        */
/*             Universitaetsstr. 14                                         */
/*             D-86159 Augsburg, Germany                                    */
/*                                                                          */
/*  http://www.mathematik.uni-freiburg.de/IAM/ALBERTA                       */
/*                                                                          */
/*  (c) by A. Schmidt and K.G. Siebert (1996-2003)                          */
/*                                                                          */
/*--------------------------------------------------------------------------*/
#include "alberta.h"
#include <time.h>
#include <string.h>

/****************************************************************************/
/*  restriction of fine-level matrix to coarser level matrices              */
/****************************************************************************/

static void add_sparse_dof_entry(DOF_MATRIX *matrix, REAL sign,
				 int irow, int jcol, REAL entry)
{
  FUNCNAME("add_sparse_dof_entry");
  int        k;
  int        free_col;
  MATRIX_ROW_REAL *row, *free_row;

  TEST_EXIT(matrix,"no matrix");
  
  TEST_EXIT(irow < matrix->size,
    "irow = %d, mat.size = %d\n", irow, matrix->size);

  if (matrix->matrix_row[irow] == NULL) {
    row = (MATRIX_ROW_REAL *)(matrix->matrix_row[irow] =
			      get_matrix_row(matrix->row_fe_space,
					     MATENT_REAL));
    
    row->col[0] = irow;           /* first entry is diagonal element */
    row->entry[0] = 0.0;
  }

  TEST_EXIT(jcol < matrix->size,
    "jcol = %d, matrix->size = %d\n", jcol, matrix->size);

  row = (MATRIX_ROW_REAL *)matrix->matrix_row[irow];
  free_row = NULL;
  free_col = 0; /* make gcc happy. Could only be uninitiazed if there were
		 * infinite row-lists.
		 */
  do {
    for (k=0; k<ROW_LENGTH; k++) {
      if (row->col[k] == jcol) {
	row->entry[k] += sign * entry;;
	break;
      }
      if (ENTRY_NOT_USED(row->col[k])) {
	free_col = k;
	free_row = row;
	if (row->col[k] == NO_MORE_ENTRIES) {
	  k = ROW_LENGTH;
	  break;
	}
      }
    }
    if (k < ROW_LENGTH) break;               /* done? */
    if (row->next || free_row) {
      row = row->next;
    }
    else {
      free_row = row->next =
	(MATRIX_ROW_REAL *)get_matrix_row(matrix->row_fe_space, MATENT_REAL);
      free_col = 0;
      row = NULL;
    }
  } while (row);

  if (k >= ROW_LENGTH) {                     /* not done? */
    TEST_EXIT(free_row,"no free_row");
    TEST_EXIT(sign > 0.0,"new entry (%d,%d) in matrix %s with sign=%lf",
			  irow, jcol, matrix->name, sign);
    free_row->col[free_col]   = jcol;
    free_row->entry[free_col] = sign * entry;
  }
}

/****************************************************************************/
/* matrix restriction for one level                                         */
/****************************************************************************/

static void restrict_mg_matrix(MG_S_INFO *mg_s_info, int fine_level)
{
  FUNCNAME("restrict_mg_matrix");
  DOF_MATRIX  *fine_mat, *coarse_mat;
  int         nfine, ncoarse, irow, i0, i1, j0, j1, l1, p1;
  int         *(dof_parent[2]);
  REAL        entry;
  S_CHAR      *sort_bound;
  static REAL one = 1.0, half = 0.5, quarter = 0.25;

  TEST_EXIT(fine_level > 0,"fine_level = %d  <= 0\n", fine_level);

  fine_mat   = mg_s_info->matrix[fine_level];
  coarse_mat = mg_s_info->matrix[fine_level - 1];
  TEST_EXIT(fine_mat && coarse_mat,
    "fine_mat or coarse_mat == NULL: %p, %p\n", fine_mat, coarse_mat);

  nfine   = mg_s_info->dofs_per_level[fine_level];
  ncoarse = mg_s_info->dofs_per_level[fine_level - 1];

  dof_parent[0]   = mg_s_info->dof_parent[0];
  dof_parent[1]   = mg_s_info->dof_parent[1];
  sort_bound      = mg_s_info->sort_bound;

  INFO(mg_s_info->mg_info->info, 2,
    "fine_level %d: nfine=%d, ncoarse=%d\n", fine_level, nfine, ncoarse);

/****************************************************************************/
/* copy coarse/coarse entries to coarse_mat,                                */
/* restrict coarse/fine entries to coarse_mat using child/parents relation  */
  for (irow = 0; irow < ncoarse; irow++)
  {
    if (sort_bound[irow] >= DIRICHLET) {
      add_sparse_dof_entry(coarse_mat, one, irow, irow, one);
    }
    else {
      FOR_ALL_MAT_COLS(REAL, fine_mat->matrix_row[irow], {
	  if (col_dof < ncoarse) {
	    add_sparse_dof_entry(coarse_mat, one,
				 irow, col_dof, row->entry[col_idx]);
	  } else {
	    entry = row->entry[col_idx];
	    j0 = dof_parent[0][col_dof];
	    j1 = dof_parent[1][col_dof];
	    add_sparse_dof_entry(coarse_mat, half, irow, j0, entry);
	    add_sparse_dof_entry(coarse_mat, half, irow, j1, entry);
	  }
	});
    }
  }

/****************************************************************************/
/* restrict fine entries to coarse_mat using child/parents relation         */

  for (irow = ncoarse; irow < nfine; irow++) {
    if (sort_bound[irow] >= DIRICHLET)
      continue;

    i0 = dof_parent[0][irow];
    i1 = dof_parent[1][irow];

    FOR_ALL_MAT_COLS(REAL, fine_mat->matrix_row[irow], {
	entry = row->entry[col_idx];
	if (irow == col_dof) {                          /* diagonal element */
	  if (sort_bound[i0] < DIRICHLET) {
	    add_sparse_dof_entry(coarse_mat, quarter, i0, i0, entry);
	    add_sparse_dof_entry(coarse_mat, quarter, i0, i1, entry);
	  }
	  if (sort_bound[i1] < DIRICHLET) {
	    add_sparse_dof_entry(coarse_mat, quarter, i1, i0, entry);
	    add_sparse_dof_entry(coarse_mat, quarter, i1, i1, entry);
	  }
	  continue;
	}
	if (col_dof < ncoarse) {
	  /* add rows */
	  if (sort_bound[i0] < DIRICHLET)
	    add_sparse_dof_entry(coarse_mat, half, i0, col_dof, entry);
	  if (sort_bound[i1] < DIRICHLET)
	    add_sparse_dof_entry(coarse_mat, half, i1, col_dof, entry);
	
	} else {
	  for (l1 = 0; l1 < 2; l1++) {            /* both parents of jcol */
	    p1 = dof_parent[l1][col_dof];
	    if (p1 < ncoarse) {
	      /* add rows */
	      if (sort_bound[i0] < DIRICHLET)
		add_sparse_dof_entry(coarse_mat, quarter, i0, p1, entry);
	      if (sort_bound[i1] < DIRICHLET)
		add_sparse_dof_entry(coarse_mat, quarter, i1, p1, entry);
	    } else {
	      ERROR("recursion 2: %d (%d %d), %d >= %d\n", col_dof,
		    dof_parent[0][col_dof], dof_parent[1][col_dof], 
		    p1, ncoarse);
	    }
	  } /* end for (l1) */
	} /* end else (jcol < ncoarse) */
      }); /* end FOR_ALL_MAT_COLS() */
  } /* end for (irow) */
}

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

void MG_s_restrict_mg_matrices(MG_S_INFO *mg_s_info)
{
  int     level;

  for (level = mg_s_info->mg_info->mg_levels - 1;
       level > mg_s_info->mg_info->exact_level; level--)
  {
    clear_dof_matrix(mg_s_info->matrix[level-1]);
    restrict_mg_matrix(mg_s_info, level);
  }

  return;
}

/****************************************************************************/
/* restrict():                                                              */
/*  calculate residual,                                                     */
/*  restrict residual to coarse grid,                                       */
/*  reset rhs on coarse grid                                                */
/****************************************************************************/

void MG_s_restrict(MULTI_GRID_INFO *mg_info, int mg_level)
{
  FUNCNAME("MG_s_restrict");
  MG_S_INFO     *mg_s_info;
  int           i, first, last, dof1, dof2, dof3;
  int           *dof_parent0, *dof_parent1;
  S_CHAR        *sort_bound;
  REAL          *fg_fct = NULL, *cg_fct = NULL;
  REAL          new_v;

  TEST_EXIT(mg_info && mg_info->data,"sorry: no mg_info or mg_s_info");

  mg_s_info = (MG_S_INFO *)(mg_info->data);
  TEST_EXIT(dof_parent0 = mg_s_info->dof_parent[0],"no dof_parent[0]\n");
  TEST_EXIT(dof_parent1 = mg_s_info->dof_parent[1],"no dof_parent[1]\n");
  TEST_EXIT(sort_bound = mg_s_info->sort_bound,"no sort_bound\n");
  TEST_EXIT(mg_s_info->dofs_per_level,"no dofs_per_level\n");

  if ((mg_level <= 0) || (mg_level <= mg_info->exact_level))
  {
    MSG("no restriction possible on coarsest/exact level\n");
    return;
  }

  MG_s_resid(mg_info, mg_level);   /* calculate residual in r_h */

  TEST_EXIT(mg_s_info->r_h  &&  (fg_fct = mg_s_info->r_h[mg_level]),
    "sorry: no fine grid function");
  TEST_EXIT(mg_s_info->f_h  &&  (cg_fct = mg_s_info->f_h[mg_level-1]),
    "sorry: no coarse grid function");


  first = mg_s_info->dofs_per_level[mg_level-1];
  last  = mg_s_info->dofs_per_level[mg_level];

  for (i = 0; i < first; i++) {
    cg_fct[i] = fg_fct[i];
  }

  for (i = first; i < last; i++)
  {
    dof1 = dof_parent0[i];
    dof2 = dof_parent1[i];
    dof3 = i;

    new_v = fg_fct[dof3] * 0.5;

    if (sort_bound[dof1] <= INTERIOR)
      cg_fct[dof1] += new_v;
    if (sort_bound[dof2] <= INTERIOR)
      cg_fct[dof2] += new_v;
  }

  if (mg_info->info > 3) {
    MSG("restricted residual on level %d:\n", mg_level-1);
    MSG("f_h=");
    for (i = 0; i < first; i++)
      print_msg(" %.3le", cg_fct[i]);
    print_msg("\n");
  }

  /* reset solution vector on coarse mesh */
  cg_fct = mg_s_info->u_h[mg_level-1];
  for (i = 0; i < first; i++)
    cg_fct[i] = 0.0;

  return;
}

/****************************************************************************/
/*  prolongation of a coarse grid function to a finer grid                  */
/****************************************************************************/

static REAL max_prolongated = 0.0;

void MG_s_prolongate(MULTI_GRID_INFO *mg_info, int mg_level)
{
  FUNCNAME("MG_s_prolongate");
  MG_S_INFO     *mg_s_info;
  int           i, first, last, dof1,dof2,dof3;
  int           *dof_parent0, *dof_parent1;
  S_CHAR        *sort_bound;
  REAL          pro, *fg_fct = NULL, *cg_fct = NULL;

  TEST_EXIT(mg_info && mg_info->data,"sorry: no mg_info or mg_s_info");

  mg_s_info = (MG_S_INFO *)(mg_info->data);
  TEST_EXIT(dof_parent0 = mg_s_info->dof_parent[0],"no dof_parent[0]\n");
  TEST_EXIT(dof_parent1 = mg_s_info->dof_parent[1],"no dof_parent[1]\n");
  TEST_EXIT(sort_bound = mg_s_info->sort_bound,"no sort_bound\n");
  TEST_EXIT(mg_s_info->dofs_per_level,"no dofs_per_level\n");

  if ((mg_level <= 0) || (mg_level <= mg_info->exact_level))
  {
    MSG("no prolongation possible to coarsest/exact level\n");
    return;
  }

  TEST_EXIT(mg_s_info->u_h  &&  (fg_fct = mg_s_info->u_h[mg_level]),
    "sorry: no fine grid function");
  TEST_EXIT(mg_s_info->u_h  &&  (cg_fct = mg_s_info->u_h[mg_level-1]),
    "sorry: no coarse grid function");

  max_prolongated = 0.0;


  first = mg_s_info->dofs_per_level[mg_level-1];
  last  = mg_s_info->dofs_per_level[mg_level];

  for (i = 0; i < first; i++)
  {
    if (sort_bound[i] >= DIRICHLET)
      continue;

    fg_fct[i] += cg_fct[i];
    max_prolongated = MAX(max_prolongated, ABS(cg_fct[i]));
  }

  for (i = first; i < last; i++)
  {
    if (sort_bound[i] >= DIRICHLET)
      continue;

    dof1 = dof_parent0[i];
    dof2 = dof_parent1[i];
    dof3 = i;

    pro = 0.5 * (cg_fct[dof1] + cg_fct[dof2]);
    fg_fct[dof3] += pro;

    max_prolongated = MAX(max_prolongated, ABS(pro));
  }

  if (mg_info->info > 4)
    MSG("level %2d: max_prolongated = %12.9lf\n", mg_level, max_prolongated);

  return;
}


/****************************************************************************/
/*  calculate residuum on level mg_level                                    */
/****************************************************************************/

REAL MG_s_resid(MULTI_GRID_INFO *mg_info, int mg_level)
{
  FUNCNAME("MG_s_resid");
  REAL    *r_h = NULL, *f_h = NULL, res;
  S_CHAR  *sort_bound;
  int     i, last;
  MG_S_INFO *mg_s_info;

  TEST_EXIT(mg_info && mg_info->data,"no mg_info or mg_s_info\n");
  mg_s_info = (MG_S_INFO *)(mg_info->data);

  TEST_EXIT(mg_level < mg_info->mg_levels,"mg_level too big\n");
  TEST_EXIT(mg_s_info->f_h && (f_h = mg_s_info->f_h[mg_level]),"no f_h\n");
  TEST_EXIT(mg_s_info->r_h && (r_h = mg_s_info->r_h[mg_level]),"no r_h\n");
  TEST_EXIT(mg_s_info->matrix && mg_s_info->matrix[mg_level],"no matrix\n");
  TEST_EXIT(sort_bound = mg_s_info->sort_bound,"no sort_bound\n");
  TEST_EXIT(mg_s_info->dofs_per_level,"no dofs_per_level\n");

  last = mg_s_info->dofs_per_level[mg_level];

  /*  r_h := f_h  */
  for (i = 0; i < last; i++)
    r_h[i] = f_h[i];

  /*  r_h := r_h - A * u_h  */
  MG_s_gemv(mg_s_info, mg_level, NoTranspose, -1.0,
	    mg_s_info->matrix[mg_level],
	    mg_s_info->u_h[mg_level], 1.0, r_h);

  res = 0.0;
  for (i = 0; i < last; i++)
  {
    if (sort_bound[i] >= DIRICHLET) {   /* no residuum at dirichlet boundary */
      r_h[i] = 0.0;
    }
    else {
      res += r_h[i]*r_h[i];
    }
  }
  
  INFO(mg_info->info, 4,"|resid| = %.3le on level %d\n", sqrt(res), mg_level);

  return(sqrt(res));
}

/****************************************************************************/
/*  smoothing of the solution on level mg_level                             */
/****************************************************************************/

static void sor_smoother(MULTI_GRID_INFO *mg_info, int mg_level, int n)
{
  FUNCNAME("sor_smoother");
  int        iter, i, size;
  REAL       sum, omega1, omega, unew, max_chg = 0.0;
  S_CHAR     *sort_bound;
  REAL       *fvec = NULL, *uvec = NULL;
  MATRIX_ROW *row, **matrix_row;
  MG_S_INFO  *mg_s_info;

  if (n <= 0)  return;

  TEST_EXIT(mg_info && mg_info->data,"no mg_info or mg_s_info\n");
  mg_s_info = (MG_S_INFO *)(mg_info->data);

  TEST_EXIT(sort_bound = mg_s_info->sort_bound,"no sort_bound\n");
  TEST_EXIT(mg_s_info->f_h && (fvec = mg_s_info->f_h[mg_level]),"no f_h\n");
  TEST_EXIT(mg_s_info->u_h && (uvec = mg_s_info->u_h[mg_level]),"no u_h\n");
  TEST_EXIT(mg_s_info->matrix && mg_s_info->matrix[mg_level],"no matrix\n");
  TEST_EXIT(matrix_row = mg_s_info->matrix[mg_level]->matrix_row,
    "no matrix_row\n");
  size = mg_s_info->dofs_per_level[mg_level];

  omega  = mg_s_info->smooth_omega;
  omega1 = 1.0 - omega;

/*   PRINT_REAL_VEC("f_h", fvec, size); */
/*   PRINT_REAL_VEC("u_h", uvec, size); */
/*   print_dof_matrix(mg_s_info->matrix[mg_level]); */

  for (iter = 0; iter < n; iter++) {
    max_chg = 0.0;
    for (i = 0; i < size; i++) {
      sum = fvec[i];
      if (sort_bound[i] < DIRICHLET) {
	FOR_ALL_MAT_COLS(REAL, matrix_row[i], {
	    if (col_dof != i)
	      sum = sum - row->entry[col_idx] * uvec[col_dof];
	  });
	if ((row = matrix_row[i])) {
	  sum = sum / row->entry.real[0];
	  DEBUG_TEST(row->col[0] == i,
		 "wrong row[%d]->col[0]: %d\n", i, row->col[0]);
	}
	unew = omega * sum + omega1 * uvec[i];
	max_chg = MAX(max_chg, ABS(uvec[i]-unew));
	uvec[i] = unew;
      } else {
	uvec[i] = sum;
      }
    }
    /* MSG("iteration %d: max_chg = %12.4le\n", iter, max_chg); */
  }

/*   PRINT_REAL_VEC("u_h", uvec, size); */
/*   WAIT; */

  INFO(mg_info->info,5,
    "%d SOR iterations with omega=%4.2lf, last max_chg = %.2le\n",
     iter, omega, max_chg);
}

static void ssor_smoother(MULTI_GRID_INFO *mg_info, int mg_level, int n)
{
  FUNCNAME("ssor_smoother");
  int        iter, i, size;
  REAL       sum, omega1, omega, unew, max_chg = 0.0;
  S_CHAR     *sort_bound;
  REAL       *fvec = NULL, *uvec = NULL;
  MATRIX_ROW *row, **matrix_row;
  MG_S_INFO  *mg_s_info;

  TEST_EXIT(mg_info && mg_info->data,"no mg_info or mg_s_info\n");
  mg_s_info = (MG_S_INFO *)(mg_info->data);

  TEST_EXIT(sort_bound = mg_s_info->sort_bound,"no sort_bound\n");
  TEST_EXIT(mg_s_info->f_h && (fvec = mg_s_info->f_h[mg_level]),"no f_h\n");
  TEST_EXIT(mg_s_info->u_h && (uvec = mg_s_info->u_h[mg_level]),"no u_h\n");
  TEST_EXIT(mg_s_info->matrix && mg_s_info->matrix[mg_level],"no matrix\n");
  TEST_EXIT(matrix_row = mg_s_info->matrix[mg_level]->matrix_row,
    "no matrix_row\n");
  size = mg_s_info->dofs_per_level[mg_level];

  omega  = mg_s_info->smooth_omega;
  omega1 = 1.0 - omega;

  for (iter = 0; iter < n; iter++) {
    max_chg = 0.0;

    for (i = 0; i < size; i++) {                         /* iterate up */
      sum = fvec[i];
      if (sort_bound[i] < DIRICHLET) {
	FOR_ALL_MAT_COLS(REAL, matrix_row[i], {
	    if (col_dof != i) sum = sum - row->entry[col_idx] * uvec[col_dof];
	  });
	if ((row = matrix_row[i])) {
	  sum = sum / row->entry.real[0];
	  DEBUG_TEST(row->col[0] == i,
		 "wrong row[%d]->col[0]: %d\n", i, row->col[0]);
	}
	unew = omega * sum + omega1 * uvec[i];
	max_chg = MAX(max_chg, ABS(uvec[i]-unew));
	uvec[i] = unew;
      }
      else {
	uvec[i] = sum;
      }
    }

    for (i = size-1; i >= 0; i--) {        /* iterate down again */
      sum = fvec[i];
      if (sort_bound[i] < DIRICHLET) {
	FOR_ALL_MAT_COLS(REAL, matrix_row[i], {
	    if (col_dof != i) sum = sum - row->entry[col_idx] * uvec[col_dof];
	  });
	if ((row = matrix_row[i])) {
	  sum = sum / row->entry.real[0];
	  DEBUG_TEST(row->col[0] == i,
		 "wrong row[%d]->col[0]: %d\n", i, row->col[0]);
	}
	unew = omega * sum + omega1 * uvec[i];
	max_chg = MAX(max_chg, ABS(uvec[i]-unew));
	uvec[i] = unew;
      }
      else {
	uvec[i] = sum;
      }
    }

    /* MSG("iteration %d: max_chg = %12.4le\n", iter, max_chg); */
  }

  INFO(mg_info->info,5,
    "%d SOR iterations with omega=%4.2lf, last max_chg = %.2le\n",
     iter, omega, max_chg);
}

void MG_s_smoother(MULTI_GRID_INFO *mg_info, int mg_level, int n)
{
  FUNCNAME("MG_s_smoother");
  MG_S_INFO  *mg_s_info;

  TEST_EXIT(mg_info && mg_info->data,"no mg_info or mg_s_info\n");
  mg_s_info = (MG_S_INFO *)(mg_info->data);
  
  switch(mg_s_info->smoother) {
  case 1:
    sor_smoother(mg_info, mg_level, n);
    break;

  case 2:
    ssor_smoother(mg_info, mg_level, n);
    break;

  default:
    ERROR("unknown smoother %d; using 1\n");
    sor_smoother(mg_info, mg_level, n);
  }

}
/****************************************************************************/
/*  "exact" solution on the coarsest level                                  */
/****************************************************************************/

void MG_s_exact_solver(MULTI_GRID_INFO *mg_info, int mg_level)
{
  FUNCNAME("MG_s_exact_solver");
  
  TEST_EXIT(mg_info,"no mg_info\n");
  TEST_EXIT(mg_level < mg_info->mg_levels,"mg_level too big");

  /* ERROR_EXIT("SPARSE_MG exact solver not yet implemented\n"); */
  MG_s_smoother(mg_info, mg_level, 10);

  return;
}

/****************************************************************************/
/* general matrix*vector routine                                            */
/*  y = alpha*A*x + beta*y   or   y = alpha*A'*x + beta*y                   */
/****************************************************************************/
void MG_s_gemv(MG_S_INFO *mg_s_info, int mg_level, MatrixTranspose transpose, 
	       REAL alpha, DOF_MATRIX *a, REAL *x, REAL beta, REAL *y)
{
  FUNCNAME("MG_s_gemv");
  int        i, last;
  REAL       sum, ax;
  
  TEST_EXIT(mg_s_info && a && x && y,"pointer is NULL: %p, %p, %p, %p",
				    mg_s_info, a,x,y);

  TEST_EXIT(mg_level < mg_s_info->mg_info->mg_levels,
    "mg_level %d >= mg_info->mg_levels %d\n",
     mg_level, mg_s_info->mg_info->mg_levels);
  last = mg_s_info->dofs_per_level[mg_level];

  TEST_EXIT(a->size >= last,
    "a->size = %d too small: dofs_per_level = %d", a->size, last);

  if (transpose == NoTranspose) {
    for (i = 0; i < last; i++) {
      sum = 0.0;
      FOR_ALL_MAT_COLS(REAL, a->matrix_row[i], {
	  sum += row->entry[col_idx] * x[col_dof];
	});
      y[i] *= beta;
      y[i] += alpha * sum;
    }
  }

  else if (transpose == Transpose) {
    for (i = 0; i < last; i++) {
      y[i] *= beta;
    }

    for (i = 0; i < last; i++) {
      ax = alpha * x[i];
      FOR_ALL_MAT_COLS(REAL, a->matrix_row[i], {
	  y[col_dof] += ax * row->entry[col_idx];
	});
    }
  }

  else {
    ERROR_EXIT("transpose=%d", transpose);
  }
}
/****************************************************************************/
