/*--------------------------------------------------------------------------*/
/* ALBERTA:  an Adaptive multi Level finite element toolbox using           */
/*           Bisectioning refinement and Error control by Residual          */
/*           Techniques for scientific Applications                         */
/*                                                                          */
/*--------------------------------------------------------------------------*/
/*                                                                          */
/* file:     nlsolve.c                                                      */
/*                                                                          */
/* description:  solver for an nonlinear elliptic model problem             */
/*                                                                          */
/*               -k \Delta u + \sigma u^4 = f  in \Omega                    */
/*                                      u = g  on \partial \Omega           */
/*                                                                          */
/*               implementation of the nonlinear solver by a                */
/*               Newton method                                              */
/*                                                                          */
/*--------------------------------------------------------------------------*/
/*                                                                          */
/*  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.alberta-fem.de/                                               */
/*                                                                          */
/*--------------------------------------------------------------------------*/
/*  (c) by A. Schmidt and K.G. Siebert (1996-2004)                          */
/*                                                                          */
/*     This program is free software; you can redistribute it and/or modify */
/*     it under the terms of the GNU General Public License as published by */
/*     the Free Software Foundation; either version 2 of the License, or    */
/*     any later version.                                                   */
/*                                                                          */
/*     This program is distributed in the hope that it will be useful,      */
/*     but WITHOUT ANY WARRANTY; without even the implied warranty of       */
/*     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the        */
/*     GNU General Public License for more details.                         */
/*--------------------------------------------------------------------------*/

#include "nonlin.h"

/*--------------------------------------------------------------------------*/
/*  data structure for the assembling of the linearized system              */
/*--------------------------------------------------------------------------*/
struct op_info
{
  REAL_D  Lambda[DIM+1];    /*  the gradient of the barycentric coordinates */
  REAL    det;              /*  |det D F_S|                                 */

  REAL    k, sigma;         /*  diffusion and reaction coefficient          */

  const QUAD_FAST *quad_fast;  /*  quad_fast for the zero order term        */
  const REAL      *v_qp;       /*  v at all quadrature nodes of quad_fast   */
};

/*--------------------------------------------------------------------------*/
/*  data structure for passing information from the newton solver to the    */
/*  the function for assembling, solving and norm calculation               */
/*--------------------------------------------------------------------------*/
typedef struct newton_data NEWTON_DATA;
struct newton_data
{
  const FE_SPACE   *fe_space;     /* used finite element space              */

  REAL       k;                   /* diffusion coefficient                  */
  REAL       sigma;               /* reaction coefficient                   */
  REAL       (*f)(const REAL_D);  /* for evaluation f + sigma u_ext^4       */

  DOF_MATRIX *DF;                 /* pointer to system matrix               */

/*---  parameters for the linear solver  -----------------------------------*/
  OEM_SOLVER solver;              /* used solver: CG (v >= 0) else BiCGStab */
  REAL       tolerance;
  int        max_iter;
  int        icon;
  int        restart;
  int        info;
};

static const REAL (*LALt(const EL_INFO *el_info, const QUAD *quad, 
			 int iq, void *ud))[DIM+1]
{
  struct op_info *info = ud;
  REAL           fac = info->k*info->det;
  int            i, j, k;
  static REAL    LALt[DIM+1][DIM+1];

  for (i = 0; i <= DIM; i++)
  {
    for (j = i; j <= DIM; j++)
    {
      for (LALt[i][j] = k = 0; k < DIM_OF_WORLD; k++)
	LALt[i][j] += info->Lambda[i][k]*info->Lambda[j][k];
      LALt[i][j] *= fac;
      LALt[j][i] = LALt[i][j];
    }
  }
  return((const REAL (*)[DIM+1]) LALt);
}

static REAL c(const EL_INFO *el_info, const QUAD *quad, int iq, void *ud)
{
  struct op_info *info = ud;
  REAL  v3;

  TEST_EXIT(info->quad_fast->quad == quad)("quads differ\n");

  v3 = info->v_qp[iq]*info->v_qp[iq]*info->v_qp[iq];

  return(info->sigma*info->det*v3);
}

static void update(void *ud, int dim, const REAL *v, int up_DF, REAL *F)
{
  FUNCNAME("update");
  static struct op_info *op_info = nil;
  static const REAL     **(*fill_a)(const EL_INFO *, void *) = nil;
  static void           *a_info = nil;
  static const REAL     **(*fill_c)(const EL_INFO *, void *) = nil;
  static void           *c_info = nil;

  static const DOF_ADMIN *admin = nil;
  static int             n_phi;
  static const REAL   *(*get_v_loc)(const EL *, const DOF_REAL_VEC *, REAL *);
  static const DOF    *(*get_dof)(const EL *, const DOF_ADMIN *, DOF *);
  static const S_CHAR *(*get_bound)(const EL_INFO *, S_CHAR *);

  NEWTON_DATA    *data = ud;
  TRAVERSE_STACK *stack = get_traverse_stack();
  const EL_INFO  *el_info;
  FLAGS          fill_flag;
  DOF_REAL_VEC   dof_v = {nil, nil, "v"};
  DOF_REAL_VEC   dof_F = {nil, nil, "F(v)"};

/*--------------------------------------------------------------------------*/
/*  init functions for assembling DF(v) and F(v)                            */
/*--------------------------------------------------------------------------*/

  if (admin != data->fe_space->admin)
  {
    OPERATOR_INFO          o_info2 = {nil}, o_info0 = {nil};
    const EL_MATRIX_INFO   *matrix_info;
    const BAS_FCTS         *bas_fcts = data->fe_space->bas_fcts;
    const QUAD             *quad = get_quadrature(DIM, 2*bas_fcts->degree-2);

    admin = data->fe_space->admin;
    n_phi      = bas_fcts->n_bas_fcts;
    get_dof    = bas_fcts->get_dof_indices;
    get_bound  = bas_fcts->get_bound;
    get_v_loc = bas_fcts->get_real_vec;;

    if (!op_info) op_info = MEM_ALLOC(1, struct op_info);

    o_info2.row_fe_space = o_info2.col_fe_space = data->fe_space;

    o_info2.quad[2]        = quad;
    o_info2.LALt           = LALt;
    o_info2.LALt_pw_const  = true;
    o_info2.LALt_symmetric = true;
    o_info2.user_data      = op_info;

    matrix_info = fill_matrix_info(&o_info2, nil);
    fill_a = matrix_info->el_matrix_fct;
    a_info = matrix_info->fill_info;

    o_info0.row_fe_space = o_info0.col_fe_space = data->fe_space;

    o_info0.quad[0]        = quad;
    o_info0.c              = c;
    o_info0.c_pw_const     = false;
    o_info0.user_data      = op_info;

    op_info->quad_fast = get_quad_fast(bas_fcts, quad, INIT_PHI);

    matrix_info = fill_matrix_info(&o_info0, nil);
    fill_c = matrix_info->el_matrix_fct;
    c_info = matrix_info->fill_info;
  }

/*--------------------------------------------------------------------------*/
/*  make a DOF vector from input vector v_vec                               */
/*--------------------------------------------------------------------------*/
  dof_v.fe_space = data->fe_space;
  dof_v.size     = dim;
  dof_v.vec      = (REAL *) v; /* cast needed; dof_v.vec isn't const REAL * */
                               /* nevertheless, values are NOT changed      */

/*--------------------------------------------------------------------------*/
/*  make a DOF vector from F, if not nil                                    */
/*--------------------------------------------------------------------------*/
  if (F)
  {
    dof_F.fe_space = data->fe_space;
    dof_F.size     = dim;
    dof_F.vec      = F;
  }

/*--------------------------------------------------------------------------*/
/*  and now assemble DF(v) and/or F(v)                                      */
/*--------------------------------------------------------------------------*/
  op_info->k     = data->k;
  op_info->sigma = data->sigma;

  if (up_DF)
  {
/*--- if v_vec[i] >= 0 for all i => matrix is positive definite (p=1)  ----*/
    data->solver = dof_min(&dof_v) >= 0 ? CG : BiCGStab;
    clear_dof_matrix(data->DF);
  }

  if (F)
  {
    dof_set(0.0, &dof_F);
    L2scp_fct_bas(data->f, op_info->quad_fast->quad, &dof_F);
    dof_scal(-1.0, &dof_F);
  }

  fill_flag = CALL_LEAF_EL|FILL_COORDS|FILL_BOUND;
  el_info = traverse_first(stack, data->fe_space->mesh, -1, fill_flag);
  while (el_info)
  {
    const REAL   *v_loc = (*get_v_loc)(el_info->el, &dof_v, nil);
    const DOF    *dof   = (*get_dof)(el_info->el, admin, nil);
    const S_CHAR *bound = (*get_bound)(el_info, nil);
    const REAL   **a_mat, **c_mat;

/*--------------------------------------------------------------------------*/
/* initialization of values used by LALt and c                              */
/*--------------------------------------------------------------------------*/
    op_info->det   = el_grd_lambda(el_info, op_info->Lambda);
    op_info->v_qp = uh_at_qp(op_info->quad_fast, v_loc, nil);

    a_mat = fill_a(el_info, a_info);
    c_mat = fill_c(el_info, c_info);

    if (up_DF)  /*---  add element contribution to matrix DF(v)  ----------*/
    {
/*--------------------------------------------------------------------------*/
/*  add a(phi_i,phi_j) + 4*m(u^3*phi_i,phi_j) to matrix                     */
/*--------------------------------------------------------------------------*/
      add_element_matrix(data->DF, 1.0, n_phi, n_phi, dof, dof, a_mat, bound);
      add_element_matrix(data->DF, 4.0, n_phi, n_phi, dof, dof, c_mat, bound);
    }

    if (F)     /*---  add element contribution to F(v)  --------------------*/
    {
      int   i, j;
/*--------------------------------------------------------------------------*/
/*  F(v) += a(v, phi_i) + m(v^4, phi_i)                                     */
/*--------------------------------------------------------------------------*/
      for (i = 0; i < n_phi; i++)
      {
	if (bound[i] < DIRICHLET)
	{
	  REAL val = 0.0;
	  for (j = 0; j < n_phi; j++)
	    val += (a_mat[i][j] + c_mat[i][j])*v_loc[j];
	  F[dof[i]] += val;
	}
	else
	  F[dof[i]] = 0.0;  /*--- zero Dirichlet boundary conditions! ------*/
      }
    }

    el_info = traverse_next(stack, el_info);
  }

  free_traverse_stack(stack);

  return;
}

static int solve(void *ud, int dim, const REAL *F, REAL *d)
{
  NEWTON_DATA   *data = ud;
  int           iter;
  DOF_REAL_VEC  dof_F = {nil, nil, "F"};
  DOF_REAL_VEC  dof_d = {nil, nil, "d"};
  
/*--------------------------------------------------------------------------*/
/*  make DOF vectors from F and d                                           */
/*--------------------------------------------------------------------------*/
  dof_F.fe_space = dof_d.fe_space = data->fe_space;
  dof_F.size     = dof_d.size     = dim;
  dof_F.vec      = (REAL *) F; /* cast needed ...  */
  dof_d.vec      = d;

  iter = oem_solve_s(data->DF, &dof_F, &dof_d, data->solver, 
		     data->tolerance, data->icon, data->restart, 
		     data->max_iter, data->info);

  return(iter);
}

static REAL norm(void *ud, int dim, const REAL *v)
{
  NEWTON_DATA   *data = ud;
  DOF_REAL_VEC  dof_v = {nil, nil, "v"};
  
  dof_v.fe_space = data->fe_space;
  dof_v.size     = dim;
  dof_v.vec      = (REAL *) v;  /* cast needed ... */

  return(H1_norm_uh(nil, &dof_v));
}

#include <nls.h>

int nlsolve(DOF_REAL_VEC *u0, REAL k, REAL sigma, REAL (*f)(const REAL_D))
{
  FUNCNAME("nlsolve");
  static NEWTON_DATA  data = {nil, 0, 0, nil, nil, CG, 0, 500, 2, 10, 1};
  static NLS_DATA     nls_data = {nil};
  int                 iter, dim = u0->fe_space->admin->size_used;

  if (!data.fe_space)
  {
/*--------------------------------------------------------------------------*/
/*--  init parameters for newton  ------------------------------------------*/
/*--------------------------------------------------------------------------*/
    nls_data.update      = update; 
    nls_data.update_data = &data;
    nls_data.solve       = solve;
    nls_data.solve_data  = &data;
    nls_data.norm        = norm;
    nls_data.norm_data   = &data;

    nls_data.tolerance = 1.e-4;
    GET_PARAMETER(1, "newton tolerance", "%e", &nls_data.tolerance);
    nls_data.max_iter = 50;
    GET_PARAMETER(1, "newton max. iter", "%d", &nls_data.max_iter);
    nls_data.info = 8;
    GET_PARAMETER(1, "newton info", "%d", &nls_data.info);
    nls_data.restart = 0;
    GET_PARAMETER(1, "newton restart", "%d", &nls_data.restart);

/*--------------------------------------------------------------------------*/
/*--  init data for update and solve  --------------------------------------*/
/*--------------------------------------------------------------------------*/

    data.fe_space = u0->fe_space;
    data.DF       = get_dof_matrix("DF(v)", u0->fe_space);

    data.tolerance = 1.e-2*nls_data.tolerance;
    GET_PARAMETER(1, "linear solver tolerance", "%f", &data.tolerance);
    GET_PARAMETER(1, "linear solver max iteration", "%d", &data.max_iter);
    GET_PARAMETER(1, "linear solver info", "%d", &data.info);
    GET_PARAMETER(1, "linear solver precon", "%d", &data.icon);
    GET_PARAMETER(1, "linear solver restart", "%d", &data.restart);
  }
  TEST_EXIT(data.fe_space == u0->fe_space)("can't change f.e. spaces\n");

/*--------------------------------------------------------------------------*/
/*--  init problem dependent parameters  -----------------------------------*/
/*--------------------------------------------------------------------------*/
  data.k     = k;
  data.sigma = sigma;
  data.f     = f;

/*--------------------------------------------------------------------------*/
/*--  enlarge workspace used by newton(_fs), and solve by Newton  ----------*/
/*--------------------------------------------------------------------------*/
  if (nls_data.restart)
  {
    nls_data.ws = REALLOC_WORKSPACE(nls_data.ws, 4*dim*sizeof(REAL));
    iter = nls_newton_fs(&nls_data, dim, u0->vec);
  }
  else
  {
    nls_data.ws = REALLOC_WORKSPACE(nls_data.ws, 2*dim*sizeof(REAL));
    iter = nls_newton(&nls_data, dim, u0->vec);
  }

  return(iter);
}
