/*******************************************************************************
 *
 * 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 = false;

/*******************************************************************************
 * 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_D *u_h;        /* discrete velocity */


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

#define GAUSS_SCALE 10.0

#if 0
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 1
#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 WALL_QUAD_FAST *wquad_fast;
  const WALL_QUAD *wquad;

  
  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;
  int i=0;
  
  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_wall_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);
  do_graphics = false;
  
 /*****************************************************************************
  *  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#WallBubbles_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++)
//  iter = 4;
  {
    int element = 0, iq = 0;
    REAL bubble_err = 0;
    REAL 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_d("u_h", u_fe_space);
    dof_set_dow(0.0, u_h);
    interpol_dow(u, u_h);
    
    fill_flag = CALL_LEAF_EL|FILL_COORDS|FILL_BOUND;
    fill_flag |= bas_fcts->fill_flags;
    
    wquad      = get_wall_quad(dim, interpol_degree+2);
    wquad_fast = get_wall_quad_fast(u_h->fe_space->bas_fcts, wquad, INIT_PHI);
    
    TRAVERSE_FIRST(u_h->fe_space->mesh, -1, fill_flag) {
      const EL_REAL_VEC_D  *u_h_loc;
      REAL_D x;
      REAL_D val_uh;
      REAL_D wall_normal;
      REAL det, accu;
      
      INIT_ELEMENT(el_info, wquad_fast);
      
      u_h_loc    = fill_el_real_vec_d(NULL, el_info->el, u_h);
//      SET_DOW(0., bubble_err);
      
      for(i=0; i< N_WALLS(u_h->fe_space->bas_fcts->dim); i++) {
	det = get_wall_normal(el_info, i, wall_normal);
	accu=0;
	for (iq = 0; iq < wquad->quad[i].n_points; iq++) {
	  eval_uh_dow_fast(val_uh, u_h_loc, wquad_fast->quad_fast[i], iq);
	  coord_to_world(el_info, wquad->quad[i].lambda[iq], x); 
	  
	  accu += (wquad->quad[i].w[iq]
		   *
		   (SCP_DOW(u(x, NULL), wall_normal)
		    -
		    SCP_DOW(val_uh,     wall_normal)));
	}
	bubble_err += fabs(det*accu);
      }
      if(bubble_err > bubble_err_max)
	  bubble_err_max = bubble_err;
      
      element += 1;
    } TRAVERSE_NEXT();
    
//    MSG("\n***********  start output        ***********\n");
    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_dow(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_dow(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);
  }
  
//  MSG("\n***********  do graphics         ***********\n");
  if (do_graphics) {
    graphics_d(mesh,(DOF_REAL_VEC_D*) u_h, NULL, NULL, u, HUGE_VAL /* time */);
  }

  WAIT_REALLY;

  return 0;
}
