/*--------------------------------------------------------------------------*/
/* ALBERTA:  an Adaptive multi Level finite element toolbox using           */
/*           Bisectioning refinement and Error control by Residual          */
/*           Techniques for scientific Applications                         */
/*                                                                          */
/*--------------------------------------------------------------------------*/
/*                                                                          */
/* file:     ellipt.c                                                       */
/*                                                                          */
/* description:  solver for an elliptic model problem                       */
/*                                                                          */
/*                        -\Delta u = f  in \Omega                          */
/*                                u = g  on \partial \Omega                 */
/*                                                                          */
/*--------------------------------------------------------------------------*/
/*                                                                          */
/*  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 <alberta.h>

/*--------------------------------------------------------------------------*/
/*  function for displaying mesh, discrete solution, and/or estimate        */
/*  defined in graphics.c                                                   */
/*--------------------------------------------------------------------------*/
void graphics(MESH *mesh, DOF_REAL_VEC *u_h, REAL (*get_est)(EL *el));

/*--------------------------------------------------------------------------*/
/* global variables: finite element space, discrete solution                */
/*                   load vector and system matrix                          */
/*--------------------------------------------------------------------------*/

static const FE_SPACE *fe_space;         /* initialized by init_dof_admin() */
static DOF_REAL_VEC   *u_h = nil;        /* initialized by build()          */
static DOF_REAL_VEC   *f_h = nil;        /* initialized by build()          */
static DOF_MATRIX     *matrix = nil;     /* initialized by build()          */

/*--------------------------------------------------------------------------*/
/* init_dof_admin(): init DOFs for Lagrange elements of order               */
/*                   <polynomial degree>, called by GET_MESH()              */
/*--------------------------------------------------------------------------*/

void init_dof_admin(MESH *mesh)
{
  FUNCNAME("init_dof_admin");
  int             degree = 1;
  const BAS_FCTS  *lagrange;

  GET_PARAMETER(1, "polynomial degree", "%d", &degree);
  lagrange = get_lagrange(degree);
  TEST_EXIT(lagrange)("no lagrange BAS_FCTS\n");
  fe_space = get_fe_space(mesh, lagrange->name, nil, lagrange);
  return;
}


/*--------------------------------------------------------------------------*/
/* struct ellipt_leaf_data: structure for storing one REAL value on each    */
/*                          leaf element as LEAF_DATA                       */
/* init_leaf_data(): initialization of leaf data, called by GET_MESH()      */
/* rw_el_est():  return a pointer to the memory for storing the element     */
/*               estimate (stored as LEAF_DATA), called by ellipt_est()     */
/* get_el_est(): return the value of the element estimates (from LEAF_DATA),*/
/*               called by adapt_method_stat() and graphics()               */
/*--------------------------------------------------------------------------*/

struct ellipt_leaf_data
{
  REAL estimate;            /*  one real for the estimate                   */
};

void init_leaf_data(LEAF_DATA_INFO *leaf_data_info)
{
  leaf_data_info->leaf_data_size = sizeof(struct ellipt_leaf_data);
  leaf_data_info->coarsen_leaf_data = nil; /* no transformation             */
  leaf_data_info->refine_leaf_data = nil;  /* no transformation             */
  return;
}

static REAL *rw_el_est(EL *el)
{
  if (IS_LEAF_EL(el))
    return(&((struct ellipt_leaf_data *)LEAF_DATA(el))->estimate);
  else
    return(nil);
}

static REAL get_el_est(EL *el)
{
  if (IS_LEAF_EL(el))
    return(((struct ellipt_leaf_data *)LEAF_DATA(el))->estimate);
  else
    return(0.0);
}

/*--------------------------------------------------------------------------*/
/* For test purposes: exact solution and its gradient (optional)            */
/*--------------------------------------------------------------------------*/

static REAL u(const REAL_D x)
{
  return(exp(-10.0*SCP_DOW(x,x)));
}

static const REAL *grd_u(const REAL_D x)
{
  static REAL_D grd;
  REAL          ux = exp(-10.0*SCP_DOW(x,x));
  int           n;

  for (n = 0;  n < DIM_OF_WORLD; n++)
    grd[n] = -20.0*x[n]*ux;

  return(grd);
}

/*--------------------------------------------------------------------------*/
/* problem data: right hand side, boundary values                           */
/*--------------------------------------------------------------------------*/

static REAL g(const REAL_D x)              /* boundary values, not optional */
{
  return(u(x));
}

static REAL f(const REAL_D x)              /* -Delta u, not optional        */
{
  REAL  r2 = SCP_DOW(x,x), ux  = exp(-10.0*r2);
  return(-(400.0*r2 - 20.0*DIM)*ux);
}


/*--------------------------------------------------------------------------*/
/* build(): assemblage of the linear system: matrix, load vector,           */
/*          boundary values, called by adapt_method_stat()                  */
/*          on the first call initialize u_h, f_h, matrix and information   */
/*          for assembling the system matrix                                */
/*                                                                          */
/* struct op_info: structure for passing information from init_element() to */
/*                 LALt()                                                   */
/* init_element(): initialization on the element; calculates the            */
/*                 coordinates and |det DF_S| used by LALt; passes these    */
/*                 values to LALt via user_data,                            */
/*                 called on each element by update_matrix()                */
/* LALt():         implementation of -Lambda id Lambda^t for -Delta u,      */
/*                 called by update_matrix() after init_element()           */
/*--------------------------------------------------------------------------*/

struct op_info
{
  REAL_D  Lambda[DIM+1];    /*  the gradient of the barycentric coordinates */
  REAL    det;              /*  |det D F_S|                                 */
};

static void init_element(const EL_INFO *el_info, const QUAD *quad[3], void *ud)
{
  struct op_info *info = ud;

  info->det = el_grd_lambda(el_info, info->Lambda);
  return;
}

const REAL (*LALt(const EL_INFO *el_info, const QUAD *quad, 
		  int iq, void *ud))[DIM+1]
{
  struct op_info *info = ud;
  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] *= info->det;
      LALt[j][i] = LALt[i][j];
    }

  return((const REAL (*)[DIM+1]) LALt);
}

static void build(MESH *mesh, U_CHAR flag)
{
  FUNCNAME("build");
  static const EL_MATRIX_INFO *matrix_info = nil;
  const QUAD                  *quad;

  dof_compress(mesh);
  MSG("%d DOFs for %s\n", fe_space->admin->size_used, fe_space->name);

  if (!u_h)                 /*  access matrix and vector for linear system */
  {
    matrix = get_dof_matrix("A", fe_space);
    f_h    = get_dof_real_vec("f_h", fe_space);
    u_h    = get_dof_real_vec("u_h", fe_space);
    u_h->refine_interpol = fe_space->bas_fcts->real_refine_inter;
    u_h->coarse_restrict = fe_space->bas_fcts->real_coarse_inter;
    dof_set(0.0, u_h);      /*  initialize u_h  !                          */
  }

  if (!matrix_info)           /* information for matrix assembling         */
  {
    OPERATOR_INFO  o_info = {nil};

    o_info.row_fe_space   = o_info.col_fe_space = fe_space;
    o_info.init_element   = init_element;
    o_info.LALt           = LALt;
    o_info.LALt_pw_const  = true;        /* pw const. assemblage is faster */
    o_info.LALt_symmetric = true;        /* symmetric assemblage is faster */
    o_info.use_get_bound  = true;        /* Dirichlet boundary conditions! */
    o_info.user_data = MEM_ALLOC(1, struct op_info);         /* user data! */
    o_info.fill_flag = CALL_LEAF_EL|FILL_COORDS;

    matrix_info = fill_matrix_info(&o_info, nil);
  }

  clear_dof_matrix(matrix);                /* assembling of matrix         */
  update_matrix(matrix, matrix_info);

  dof_set(0.0, f_h);                       /* assembling of load vector    */
  quad = get_quadrature(DIM, 2*fe_space->bas_fcts->degree - 2);
  L2scp_fct_bas(f, quad, f_h);

  dirichlet_bound(g, f_h, u_h, nil);           /*  boundary values         */
  return;
}


/*--------------------------------------------------------------------------*/
/* solve(): solve the linear system, called by adapt_method_stat()          */
/*--------------------------------------------------------------------------*/

static void solve(MESH *mesh)
{
  FUNCNAME("solve");
  static REAL       tol = 1.e-8;
  static int        miter = 1000, info = 2, icon = 1, restart = 0;
  static OEM_SOLVER solver = NoSolver;

  if (solver == NoSolver)
  {
    tol = 1.e-8;
    GET_PARAMETER(1, "solver", "%d", &solver);
    GET_PARAMETER(1, "solver tolerance", "%f", &tol);
    GET_PARAMETER(1, "solver precon", "%d", &icon);
    GET_PARAMETER(1, "solver max iteration", "%d", &miter);
    GET_PARAMETER(1, "solver info", "%d", &info);
    if (solver == GMRes)
      GET_PARAMETER(1, "solver restart", "%d", &restart);
  }
  oem_solve_s(matrix, f_h, u_h, solver, tol, icon, restart, miter, info);

  graphics(mesh, u_h, nil);
  return;
}

/*--------------------------------------------------------------------------*/
/* Functions for error estimate:                                            */
/* estimate():   calculates error estimate via ellipt_est()                 */
/*               calculates exact error also (only for test purpose),       */
/*               called by adapt_method_stat()                              */
/* r():          calculates the lower order terms of the element residual   */
/*               on each element at the quadrature node iq of quad          */
/*               argument to ellipt_est() and called by ellipt_est()        */
/*--------------------------------------------------------------------------*/

static REAL r(const EL_INFO *el_info, const QUAD *quad, int iq, REAL uh_iq, 
              const REAL_D grd_uh_iq)
{
  REAL_D      x;
  coord_to_world(el_info, quad->lambda[iq], x);
  return(-f(x));
}

#define EOC(e,eo) log(eo/MAX(e,1.0e-15))/M_LN2

static REAL estimate(MESH *mesh, ADAPT_STAT *adapt)
{
  FUNCNAME("estimate");
  static int     degree, norm = -1;
  static REAL    C[3] = {1.0, 1.0, 0.0};
  static REAL    est, est_old = -1.0, err, err_old = -1.0;
  static FLAGS r_flag = 0;  /* = (INIT_UH | INIT_GRD_UH),  if needed by r() */
  REAL_DD        A = {{0.0}};
  int            n;
  const QUAD     *quad;

  for (n = 0; n < DIM_OF_WORLD; n++)
    A[n][n] = 1.0;   /* set diogonal of A; all other elements are zero      */

  if (norm < 0)
  {
    norm = H1_NORM;
    GET_PARAMETER(1, "error norm", "%d", &norm);
    GET_PARAMETER(1, "estimator C0", "%f", &C[0]);
    GET_PARAMETER(1, "estimator C1", "%f", &C[1]);
    GET_PARAMETER(1, "estimator C2", "%f", &C[2]);
  }
  degree = 2*u_h->fe_space->bas_fcts->degree;
  est = ellipt_est(u_h, adapt, rw_el_est, nil, degree, norm, C, 
		   (const REAL_D *) A, r, r_flag);

  MSG("estimate   = %.8le", est);
  if (est_old >= 0)
    print_msg(", EOC: %.2lf\n", EOC(est,est_old));
  else
    print_msg("\n");
  est_old = est;

  quad = get_quadrature(DIM, degree);
  if (norm == L2_NORM)
    err = L2_err(u, u_h, quad, 0, nil, nil);
  else
    err = H1_err(grd_u, u_h, quad, 0, nil, nil);

  MSG("||u-uh||%s = %.8le", norm == L2_NORM ? "L2" : "H1", err);
  if (err_old >= 0)
    print_msg(", EOC: %.2lf\n", EOC(err,err_old));
  else
    print_msg("\n");
  err_old = err;
  MSG("||u-uh||%s/estimate = %.2lf\n", norm == L2_NORM ? "L2" : "H1",
      err/MAX(est,1.e-15));

  graphics(mesh, nil, get_el_est);
  return(adapt->err_sum);
}

/*--------------------------------------------------------------------------*/
/* main program                                                             */
/*--------------------------------------------------------------------------*/

int main(int argc, char **argv)
{
  FUNCNAME("main");
  MESH   *mesh;
  int    n_refine = 0;
  static ADAPT_STAT *adapt;
  char   filename[100];

/*--------------------------------------------------------------------------*/
/*  first of all, init parameters of the init file                          */
/*--------------------------------------------------------------------------*/

  init_parameters(0, "INIT/ellipt.dat");
  
/*--------------------------------------------------------------------------*/
/*  get a mesh, and read the macro triangulation from file                  */
/*--------------------------------------------------------------------------*/

  mesh = GET_MESH("ALBERTA mesh", init_dof_admin, init_leaf_data);
  GET_PARAMETER(1, "macro file name", "%s", filename);
  read_macro(mesh, filename, nil);
  GET_PARAMETER(1, "global refinements", "%d", &n_refine);
  global_refine(mesh, n_refine*DIM);
  graphics(mesh, nil, nil);

/*--------------------------------------------------------------------------*/
/*  init adapt structure and start adaptive method                          */
/*--------------------------------------------------------------------------*/

  adapt = get_adapt_stat("ellipt", "adapt", 2, nil);
  adapt->estimate = estimate;
  adapt->get_el_est = get_el_est;
  adapt->build_after_coarsen = build;
  adapt->solve = solve;

  adapt_method_stat(mesh, adapt);
  WAIT_REALLY;
  return(0);
}
