/*******************************************************************************
 *
 * ALBERTA:  an Adaptive multi Level finite element toolbox  using
 *           Bisectioning refinement and Error control by Residual
 *           Techniques
 *
 * File:     stokes.c
 *
 * Description:  solver for a simple stationary Stokes problem:
 *
 *                 -\Delta u + \nabla p = f  in \Omega
 *                        \nabla\cdot u = 0  in \Omega
 *                                    u = g  on \partial \Omega
 *
 ******************************************************************************
 *
 *  author:     Claus-Justus Heine
 *              Abteilung fuer Angewandte Mathematik
 *              Albert-Ludwigs-Universitaet Freiburg
 *              Hermann-Herder-Str. 10
 *              79104 Freiburg
 *              Germany
 *              claus@mathematik.uni-freiburg.de
 *
 *  http://www.mathematik.uni-freiburg.de/IAM/ALBERTA
 *
 *  (c) by C.-J. Heine (2006-2007)
 *
 ******************************************************************************/

#include <alberta/alberta.h>

#include "alberta-demo.h"

static bool do_graphics = true;

/*******************************************************************************
 * global variables: finite element space, discrete solution
 *                   load vector and system matrix
 *
 * These variables are kept global because they are shared across build(),
 * solve() and estimate().
 ******************************************************************************/

static const FE_SPACE *u_fe_space; /* velocity FE-space */
static DOF_REAL_VEC *u_h;        /* discrete velocity */

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

#define GAUSS_SCALE 10.0

#if 1
static REAL u(const REAL_D x)
{
  return(exp(-GAUSS_SCALE*SCP_DOW(x,x)));
}

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

  if (!grd) {
    grd = buffer;
  }

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

  return(grd);
}
#endif

#if 0
#define U_SHIFT 0.4

static const REAL *u(const REAL_D x, REAL_D res)
{
  REAL r;
  static REAL_D space;  
  
  if (!res)
    res = space;

  SET_DOW(U_SHIFT, res);
  AXPY_DOW(1.0, x, res);

  r = NORM_DOW(res);

  SCAL_DOW(1.0/POW_DOW(r), res);
  
  return res;
}

/*
 * [(r^2-x^2*d)*r^(-d-2), -d*x*y*r^(-d-2), -d*x*z*r^(-d-2)])
 */
static const REAL_D *grd_u(const REAL_D _x, REAL_DD res)
{
  static REAL_DD space;
  REAL_D x;
  REAL r;
  int i;

  if (!res)
    res = space;

  SET_DOW(U_SHIFT, x);
  AXPY_DOW(1.0, _x, x);
  
  r = NORM_DOW(x);

  for (i = 0; i < DIM_OF_WORLD; i++) {
    AXEY_DOW(-(REAL)DIM_OF_WORLD*x[i], x, res[i]);
    res[i][i] += SQR(r);
    SCAL_DOW(pow(r, (REAL)(-DIM_OF_WORLD - 2)), res[i]);
  }
  return (const REAL_D *)res;
}
#endif

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

int main(int argc, char **argv)
{
  FUNCNAME("main");
  const BAS_FCTS *bas_fcts;
  MACRO_DATA     *data;
  MESH           *mesh;
  FLAGS          fill_flag;
  const QUAD_FAST *quad_fast;
  const QUAD *quad;
  
  REAL err_L2 = 0.0, err_H1 = 0.0, err_L2_old = 0.0, err_H1_old = 0.0;
  int            n_refine = 0, dim, v_degree = 2, ausreichend_platz = 30;
  int            interpol_degree = 0, iter;

  char filename[PATH_MAX];
  char buffer[ausreichend_platz];
  
  /*****************************************************************************
   * first of all, initialize the access to parameters of the init file
   ****************************************************************************/
  parse_parameters(argc, argv, "INIT/stokes_bubble_test.dat");

  /*****************************************************************************
   * then read some basic parameters
   ****************************************************************************/
  GET_PARAMETER(1, "mesh dimension", "%d", &dim);
  GET_PARAMETER(1, "macro file name", "%s", filename);
  GET_PARAMETER(1, "global refinements", "%d", &n_refine);
  GET_PARAMETER(1, "velocity degree", "%d", &v_degree);
  GET_PARAMETER(1, "interpol degree", "%d", &interpol_degree);
  GET_PARAMETER(1, "online graphics", "%d", &do_graphics);

  /*****************************************************************************
  *  get a mesh, and read the macro triangulation from file
  ****************************************************************************/
  data = read_macro(filename);
  mesh = GET_MESH(dim, "ALBERTA mesh", data, NULL, NULL);
  free_macro_data(data);
 // init_leaf_data(mesh, sizeof(struct ellipt_leaf_data), NULL, NULL);
  
  /*****************************************************************************
   * aquire velocity and pressure fe-spaces
   ****************************************************************************/

  sprintf(buffer, "lagrange1#Bubble_I%d", interpol_degree);
  
  bas_fcts = get_bas_fcts(dim, buffer);
  
  u_fe_space = get_fe_space(mesh, "velocity", bas_fcts, DIM_OF_WORLD,
			    ADM_FLAGS_DFLT);
  
  /*****************************************************************************
   * Globally refine the mesh a little bit. Maybe do some graphics
   * output to amuse the spectators.
   ****************************************************************************/
  
  for(iter = 0; iter< n_refine; iter++) {
    int element = 0, iq = 0;
    REAL bubble_err, bubble_err_max=0;


    global_refine(mesh, mesh->dim, FILL_NOTHING);
    if (do_graphics) {
      graphics_d(mesh, NULL, NULL, NULL, NULL, HUGE_VAL /* time */);
    }

   /****************************************************************************
    *  initialize the global variables shared across build(), solve()
    *  and estimate().
    ***************************************************************************/
    u_h = get_dof_real_vec("u_h", u_fe_space);
    dof_set(0.0, u_h);
    interpol(u, u_h);
    
    fill_flag = CALL_LEAF_EL|FILL_COORDS|FILL_BOUND;
    
    quad = get_quadrature(dim, interpol_degree+2);
    quad_fast = get_quad_fast(u_h->fe_space->bas_fcts, quad, INIT_PHI);
    
    TRAVERSE_FIRST(u_h->fe_space->mesh, -1, fill_flag) {
      const EL_REAL_VEC  *u_h_loc;
      REAL_D x;
      

      u_h_loc    = fill_el_real_vec(NULL, el_info->el, u_h);
      bubble_err = 0;
      
      for (iq = 0; iq < quad->n_points; iq++) {
	coord_to_world(el_info, quad->lambda[iq], x); 
     	bubble_err += quad->w[iq] * (u(x)
				     -
				     eval_uh_fast(u_h_loc, quad_fast, iq));
      }
      bubble_err = fabs(bubble_err);
      if(bubble_err > bubble_err_max)
	  bubble_err_max = bubble_err;
      element += 1;
      
    } TRAVERSE_NEXT();

    MSG("\nMax Error (interpol) = %.8le  @ %d global refinements,\
 interpol_deg = %d\n" ,
	bubble_err_max, iter, interpol_degree);
    err_L2_old = err_L2;
    err_L2 = L2_err(u, u_h, NULL /* quad */,
               false /* relative error*/,
               false /* mean-value adjust */,
               NULL /* rw_err_el()*/, NULL /* max_err_el2 */);
    MSG("||u-uh|| = %.8le  in L2 @ %d global refinements\n" , err_L2, iter);
    if(err_L2_old != 0.0)
      MSG("EOC = %.8le       in L2 @ %d global refinements\n\n" ,
	   EOC(err_L2, err_L2_old), iter);

    err_H1_old = err_H1;
    err_H1 = H1_err(grd_u, u_h, NULL /* quad */,
                 false /* relative error*/,
                 NULL /* rw_err_el()*/, NULL /* max_err_eH1 */);
    MSG("||u-uh|| = %.8le  in H1 @ %d global refinements\n" , err_H1, iter);
    if(err_H1_old != 0.0)
      MSG("EOC = %.8le       in H1 @ %d global refinements\n\n" ,
	   EOC(err_H1, err_H1_old), iter);
  }

  if (do_graphics) {
    graphics(mesh, u_h, NULL, u, HUGE_VAL /* time */);
  }

  WAIT_REALLY;

  return 0;
}
