/*--------------------------------------------------------------------------*/
/* ALBERTA:  an Adaptive multi Level finite element toolbox using           */
/*           Bisectioning refinement and Error control by Residual          */
/*           Techniques for scientific Applications                         */
/*                                                                          */
/* file:     sor.c                                                          */
/*                                                                          */
/* description:  SSOR-method for scalar and decoupled vector valued         */
/*               problems                                                   */
/*                                                                          */
/*--------------------------------------------------------------------------*/
/*                                                                          */
/*  authors:   Alfred Schmidt                                               */
/*             Zentrum fuer Technomathematik                                */
/*             Fachbereich 3 Mathematik/Informatik                          */
/*             Univesitaet Bremen                                           */
/*             Bibliothekstr. 2                                             */
/*             D-28359 Bremen, Germany                                      */
/*                                                                          */
/*             Kunibert G. Siebert                                          */
/*             Institut fuer Mathematik                                     */
/*             Universitaet Augsburg                                        */
/*             Universitaetsstr. 14                                         */
/*             D-86159 Augsburg, Germany                                    */
/*                                                                          */
/*             Claus-Justus Heine                                           */
/*             Abteilung fuer Angewandte Mathematik                         */
/*             Alberta-Ludwigs-Universitaet Freiburg                         */
/*             Hermann-Herder-Str. 10                                       */
/*             D-79104 Freiburg im Breisgau, Germany                        */
/*                                                                          */
/*  http://www.mathematik.uni-freiburg.de/IAM/ALBERTA                       */
/*                                                                          */
/*  (c) by A. Schmidt and K.G. Siebert (1996-2003)                          */
/*                                                                          */
/*--------------------------------------------------------------------------*/

#include "alberta.h"

int ssor_s(DOF_MATRIX *a, const DOF_REAL_VEC *f, const DOF_SCHAR_VEC *bound,
	   DOF_REAL_VEC *u, REAL omega, REAL tol, int max_iter, int info)
{
  FUNCNAME("ssor_s");
  const REAL *fvec;
  REAL       *uvec;
  S_CHAR     *bvec;
  REAL       max = 0.0, omega1, accu, unew;
  int        i, iter, dim;
  MATRIX_ROW *row;

  fvec = f->vec;
  uvec = u->vec;
  bvec = bound ? bound->vec : NULL;

  TEST_EXIT(a->row_fe_space->admin == a->col_fe_space->admin,
	    "Row and column FE_SPACEs don't match!\n");

  if (a->row_fe_space->admin->hole_count > 0)
    dof_compress(a->row_fe_space->mesh);

  if (omega <= 0  ||  omega > 2)
  {
    ERROR("omega %le not in (0,2], setting omega = 1.0\n", omega);
    omega = 1.0;
  }
  omega1   = 1.0 - omega;

  if (info >= 2)
  {
    MSG("omega = %.3lf, tol = %.3le, max_iter = %d\n",
	omega, tol, max_iter);
  }

  for (iter = 0; iter < max_iter; iter++)
  {
    max =  0.0;
    dim = u->fe_space->admin->size_used; 

    for (i = 0; i < dim; i++) 
    {
      if (!bvec || bvec[i] < DIRICHLET)
      {
	if (a->matrix_row[i])
	{
	  accu = 0.0;
	  FOR_ALL_MAT_COLS(REAL, a->matrix_row[i], {
	      accu += row->entry[col_idx] * uvec[col_dof];
	    });
	  if ((row = a->matrix_row[i])) {
	    unew =
	      omega1 * uvec[i] + omega * (fvec[i] - accu) / row->entry.real[0];
	  } else {
	    unew = 0.0;
	  }
	  max = MAX(max, ABS(uvec[i] - unew));
	  uvec[i] = unew;
	}
      }
    }

    for (i = dim-1; i >= 0; i--) 
    {
      if (!bvec || bvec[i] < DIRICHLET)
      {
	if (a->matrix_row[i])
	{
	  accu = 0.0;
	  FOR_ALL_MAT_COLS(REAL, a->matrix_row[i], {
	      accu += row->entry[col_idx] * uvec[col_dof];
	    });
	  if ((row = a->matrix_row[i])) {
	    unew =
	      omega1 * uvec[i]
	      +
	      omega * (fvec[i] - accu) / row->entry.real[0];
	  } else {
	    unew = 0.0;
	  }
	  max = MAX(max, ABS(uvec[i] - unew));
	  uvec[i] = unew;
	}
      }
    }
    if (info >= 4)
      MSG("iter %3d: max = %.3le\n",iter,max);
    
    if (max < tol) break;
  }
  
  if (info >= 2)
  {
    if (iter < max_iter)
      MSG("convergence after iter %3d: max = %.3le\n", iter, max);
    else
      MSG("NO CONVERGENCE after iter %3d: max = %.3le\n", iter, max);
  }
  return(iter);
}

int ssor_d(DOF_MATRIX *a,
	   const DOF_REAL_D_VEC *f, const DOF_SCHAR_VEC *bound,
	   DOF_REAL_D_VEC *u, REAL omega, REAL tol, int max_iter, int info)
{
  FUNCNAME("ssor_d");
  const REAL_D *fvec;
  REAL_D       *uvec;
  S_CHAR       *bvec;
  REAL         max = 0.0, omega1;
  REAL_D       accu, unew;
  int          n, i, iter = 0, dim;
  MATRIX_ROW   *row;

  fvec = (const REAL_D *) f->vec;
  uvec = u->vec;
  bvec = bound ? bound->vec : NULL;

  TEST_EXIT(a->row_fe_space->admin == a->col_fe_space->admin,
	    "Row and column FE_SPACEs don't match!\n");

  if (a->row_fe_space->admin->hole_count > 0)
    dof_compress(a->row_fe_space->mesh);

  if (omega <= 0  ||  omega > 2) {
    WARNING("omega %le not in (0,2], setting omega = 1.0\n", omega);
    omega = 1.0;
  }
  omega1   = 1.0 - omega;

  if (info >= 2) {
    MSG("omega = %.3lf, tol = %.3le, max_iter = %d\n",
	omega, tol, max_iter);
  }

#undef MAT_BODY
#define MAT_BODY(F, CC, C, S, TYPE)					\
  for (iter = 0; iter < max_iter; iter++)				\
  {									\
    max =  0.0;								\
    dim = u->fe_space->admin->size_used; 				\
									\
    for (i = 0; i < dim; i++) {						\
      if ((row = a->matrix_row[i]) == NULL) {                           \
        continue;                                                       \
      }                                                                 \
                                                                        \
      if (!bvec || bvec[i] < DIRICHLET) {				\
        COPY_DOW(fvec[i], accu);                                        \
                                                                        \
        FOR_ALL_MAT_COLS(TYPE, a->matrix_row[i], {                      \
            if (col_dof != i) {                                         \
              F##GEMV_DOW(-1.0, CC row->entry[col_idx], uvec[col_dof],  \
                          1.0, accu);                                   \
            } else {                                                    \
              F##GEMV_ND_DOW(-1.0, CC row->entry[col_idx], uvec[col_dof], \
                             1.0, accu);                                \
            }                                                           \
          });                                                           \
        F##DIV_DOW(CC row->entry.S[0], accu, accu);                     \
        AXPBY_DOW(omega, accu, omega1, uvec[i], unew);                  \
                                                                        \
        for (n = 0; n < DIM_OF_WORLD; n++) {				\
          max = MAX(max, ABS(uvec[i][n] - unew[n]));			\
          uvec[i][n] = unew[n];                                         \
        }								\
      }									\
    }									\
    									\
    for (i = dim-1; i >= 0; i--)  {                                     \
      if ((row = a->matrix_row[i]) == NULL) {                           \
        continue;                                                       \
      }                                                                 \
                                                                        \
      if (!bvec || bvec[i] < DIRICHLET) {                               \
        COPY_DOW(fvec[i], accu);                                        \
                                                                        \
        FOR_ALL_MAT_COLS(TYPE, a->matrix_row[i], {                      \
            if (col_dof != i) {                                       \
              F##GEMV_DOW(-1.0, CC row->entry[col_idx], uvec[col_dof],  \
                          1.0, accu);                                   \
            } else {                                                    \
              F##GEMV_ND_DOW(-1.0, CC row->entry[col_idx], uvec[col_dof], \
                             1.0, accu);                                \
            }                                                           \
          });								\
        F##DIV_DOW(CC row->entry.S[0], accu, accu);                     \
        AXPBY_DOW(omega, accu, omega1, uvec[i], unew);                  \
                                                                        \
        for (n = 0; n < DIM_OF_WORLD; n++) {				\
          max = MAX(max, ABS(uvec[i][n] - unew[n]));			\
          uvec[i][n] = unew[n];                                         \
	}								\
      }									\
    }									\
    if (info >= 4)							\
      MSG("iter %3d: max = %.3le\n",iter,max);				\
    									\
    if (max < tol) break;						\
  }

  MAT_EMIT_BODY_SWITCH(a->type);

  if (info >= 2) {
    if (iter < max_iter)
      MSG("convergence after iter %3d: max = %.3le\n", iter, max);
    else
      MSG("NO CONVERGENCE after iter %3d: max = %.3le\n", iter, max);
  }
  return iter;
}
