/* ALBERTA:  an Adaptive multi Level finite element toolbox  using
 *           Bisectioning refinement and Error control by Residual
 *           Techniques
 *
 * www.alberta-fem.de
 *
 ******************************************************************************
 *
 * File:     matrix-condition.c
 *
 * Description: compute the spectral condition of a given matrix by computing
 *              its smallest and largest eigen-value by means of an (inverse)
 *              vector iteration.
 *
 ******************************************************************************
 *
 *  author:     Claus-Justus Heine
 *              Abteilung fuer Angewandte Mathematik
 *              Albert-Ludwigs-Universitaet Freiburg
 *              Hermann-Herder-Str. 10
 *              79104 Freiburg
 *              Germany
 *              Claus.Heine@Mathematik.Uni-Freiburg.DE
 *
 *  (c) by C.-J. Heine (2006)
 *
 */

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

#include "alberta_util.h"

REAL vector_iteration(OEM_MV_FCT Av, void *Av_data,
		      REAL *x0, const REAL **kernel, int ker_dim,
		      int dim, REAL tol, int max_iter, int info)
{
  FUNCNAME("vector_iteration");
  REAL *x1 = MEM_CALLOC(dim, REAL), *alloc_x1 = x1; /* use calloc()! */
  REAL *swap;
  REAL lambda_max = 0.0, lambda_old = 0.0;
  REAL nrm_x0, nrm2_kern = 0.0;
  REAL thresh = 1.0/sqrt((REAL)dim)-DBL_EPSILON;
  int iter, i0, i1, nnz;

  if (kernel) {
    /* no scp() here; this is dual-pairing */
    for(i1 = 0; i1 < ker_dim; i1++)  {
      nrm2_kern = ddot(dim, kernel[i1], 1, kernel[i1], 1);
      daxpy(dim, -ddot(dim, x0, 1, kernel[i1], 1)/nrm2_kern, kernel[i1], 1, x0, 1);
    }
  }

  nrm_x0 = sqrt(ddot(dim, x0, 1, x0, 1));
  dscal(dim, 1.0/nrm_x0, x0, 1);

  /* search for "large" non-zero component */
  for (i0 = 0, nnz = 0; i0 < dim; i0++) {
    if (x0[i0] != 0.0) { /* real bit-wise equality */
      nnz++;
    }
  }
  thresh = 1.0/sqrt((REAL)nnz)-DBL_EPSILON;

  for (i0 = 0; i0 < dim && fabs(x0[i0]) < thresh; i0++);
  DEBUG_TEST_EXIT(i0 < dim,
	     "|x0| == 1, but no component larger than 1/sqrt(dim)?\n");

  /* Vector iteration starts here, we must first iterate one time to
   * get an initial guess for lambda_max.
   */
  for (iter = 0; iter < max_iter; iter++) {
    Av(Av_data, dim, x0, x1);
    if (kernel) {
      for(i1 = 0; i1 < ker_dim; i1++) {
	daxpy(dim, -ddot(dim, x1, 1, kernel[i1], 1)/nrm2_kern, kernel[i1], 1, x1, 1);
      }
    }
    lambda_max = x1[i0]/x0[i0];
#if ALBERTA_DEBUG
    if (!isfinite(x1[i0])) {
      ERROR_EXIT("x1[%d] not finite.\n", i0);
    }
#endif
    if (iter > 0 && fabs(lambda_max/lambda_old - 1.0) < tol) {
      INFO(info, 2,
	   "\"Convergence\" after %d iterations, lambda_max = %e\n",
	   iter, lambda_max);
      INFO(info, 3, "lambda_max/lambda_old - 1.0 = %e.\n",
	   lambda_max / lambda_old - 1.0);
      break;
    }
    INFO(info, 4, "lambda_max = %e, lambda_max/lambda_old - 1.0 = %e.\n",
	 lambda_max, lambda_max / lambda_old - 1.0);
    if (info >= 3) {
      if (iter == 0) {
	MSG(".");
      } else {
	print_msg(".");
      }
      fflush(stdout);
    }
    swap = x0; x0 = x1; x1 = swap;
    nrm_x0 = sqrt(ddot(dim, x0, 1, x0, 1));
    dscal(dim, 1.0/nrm_x0, x0, 1);
    if (fabs(x0[i0]) < thresh) {
      for (i0 = 0; i0 < dim && fabs(x0[i0]) < thresh; i0++);
      DEBUG_TEST_EXIT(i0 < dim,
		      "|x0| == 1, but no component larger than 1/sqrt(dim)?\n");
    }
    lambda_old = lambda_max;
  }
  if (iter == max_iter) {
    INFO(info, 2,
	 "*** NO *** \"Convergence\" after %d iterations, lambda_max = %e\n",
	 iter, lambda_max);
    INFO(info, 3, "lambda_max/lambda_old - 1.0 = %e.\n",
	 lambda_max / lambda_old - 1.0);
    lambda_max = HUGE_VAL;
  }
  
  MEM_FREE(alloc_x1, dim, REAL);

  return lambda_max;
}

/* We assume that AIv_data->mat_vec() contains the correct A*v
 * product, while AIv implements the inverse.
 */
REAL matrix_condition(OEM_MV_FCT AIv, OEM_DATA *AIv_data,
		      const REAL **kernel, int ker_dim, int dim,
		      REAL tol, int max_iter, int info)
{
  REAL lambda_max, lambda_min, result = HUGE_VAL;
  REAL *x0 = MEM_ALLOC(dim, REAL);
  REAL *x1 = MEM_ALLOC(dim, REAL);
 
  /* generate start value, first transform x0 one time to determine
   * possible "holes" in the index range; mat_vec() may operate as zero
   * mapping on a subset of the indices.
   */
  drandn(dim, x1, 1);
  AIv_data->mat_vec(AIv_data->mat_vec_data, dim, x1, x0);
  lambda_max = vector_iteration(AIv_data->mat_vec, AIv_data->mat_vec_data,
				x0, NULL, 0, dim, tol, max_iter, info);

  if (isfinite(lambda_max)) {

    drandn(dim, x1, 1);
    AIv_data->mat_vec(AIv_data->mat_vec_data, dim, x1, x0);
    lambda_min = vector_iteration(AIv, AIv_data,
				  x0, kernel, ker_dim, dim, tol, max_iter, info);

    if (isfinite(lambda_min) && lambda_min > DBL_EPSILON) {
      result = lambda_max*lambda_min;
    }
  }

  MEM_FREE(x0, dim, REAL);
  MEM_FREE(x1, dim, REAL);

  return result;
}

