/*--------------------------------------------------------------------------*/
/* ALBERTA:  an Adaptive multi Level finite element toolbox using           */
/*           Bisectioning refinement and Error control by Residual          */
/*           Techniques for scientific Applications                         */
/*                                                                          */
/*--------------------------------------------------------------------------*/
/*                                                                          */
/* file:     heat.c                                                         */
/*                                                                          */
/* description:  solver for parabolic model problem                         */
/*                                                                          */
/*                   u,t - \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.                         */
/*--------------------------------------------------------------------------*/

/*--------------------------------------------------------------------------*/
/*  function for displaying mesh, discrete solution, and/or estimate        */
/*  defined in graphics.c                                                   */
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/
/* init_dof_admin(): init DOFs for Lagrange elements of order               */
/*                   <polynomial degree>, called by GET_MESH()              */
/*--------------------------------------------------------------------------*/


/*--------------------------------------------------------------------------*/
/* struct heat_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 heat_est()       */
/* get_el_est(): return the value of the element estimates (from LEAF_DATA),*/
/*               called by adapt_method_stat() and graphics()               */
/*--------------------------------------------------------------------------*/


/*--------------------------------------------------------------------------*/
/* For test purposes: exact solution and its gradient (optional)            */
/*--------------------------------------------------------------------------*/
static REAL u(const REAL_D x)
{FUNCNAME("u");
//MSG("eval_time_u: %f\n",eval_time_u);
  return(sin(M_PI*eval_time_u)*exp(-10.0*SCP_DOW(x,x)));
}

static REAL eval_time_u0 = 0.0;
static REAL u0(const REAL_D x)
{
  eval_time_u = eval_time_u0;
  return(u(x));
}

static REAL eval_time_grd_u = 0.0;
static  REAL *grd_u(const REAL_D x)
{
  static REAL_D grd;
  REAL          ux = sin(M_PI*eval_time_grd_u)*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 eval_time_g = 0.0;
static REAL g(const REAL_D x)              /* boundary values, not optional */
{
  eval_time_u = eval_time_g;
  return(u(x));
}

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


/*---8<---------------------------------------------------------------------*/
/*---  write error and estimator data to files                           ---*/
/*--------------------------------------------------------------------->8---*/

static void write_statistics(const char *path, ADAPT_INSTAT *adapt, int n_dof,
			     REAL space_est, REAL time_est, REAL err_L2)
{
  static FILE *file_ndof = nil, *file_tau = nil;
  static FILE *file_space_est = nil, *file_time_est = nil, *file_L2_err = nil;
  const char  *name = fe_space->bas_fcts->name;
  REAL        time = adapt->time;
  char        filename[1024];

  if (!file_ndof)
  {
    sprintf(filename, "%s/n_dof-%s.agr", path ? path : ".", name);
    file_ndof = fopen(filename, "w");
  }

  if (!file_tau)
  {
    sprintf(filename, "%s/tau-%s.agr", path ? path : ".", name);
    file_tau       = fopen(filename, "w");
  }

  if (!file_space_est)
  {
    sprintf(filename, "%s/space_est-%s.agr", path ? path : ".", name);
    file_space_est = fopen(filename, "w");
  }

  if (!file_time_est)
  {
    sprintf(filename, "%s/time_est-%s.agr", path ? path : ".", name);
    file_time_est  = fopen(filename, "w");
  }

  if (!file_L2_err)
  {
    sprintf(filename, "%s/L2_err-%s.agr", path ? path : ".", name);
    file_L2_err    = fopen(filename, "w");
  }

  if (file_ndof) 
    fprintf(file_ndof, "%.6e %d\n", time, n_dof);

/*---  don't print zeros, zeros do not allow log display of estimate ---*/
  if (file_space_est)
    fprintf(file_space_est, "%.6e %.6e\n", time, MAX(space_est,1.e-20));

  if (time > adapt->start_time)
  {
    if (file_tau)
    {
      fprintf(file_tau, "%.6e %.6e\n", time, adapt->timestep);
    }
/*---  don't print zeros, zeros do not allow log display of estimate ---*/
    if (file_time_est)
      fprintf(file_time_est, "%.6e %.6e\n", time, MAX(time_est,1.e-20));
  }

/*---  don't print zeros, zeros do not allow log display of error    ---*/
  if (file_L2_err) 
    fprintf(file_L2_err, "%.6e %.6e\n", time, MAX(err_L2,1.e-20));

  if (time >= adapt->end_time)
  {
    if (file_ndof)      fclose(file_ndof);
    if (file_tau)       fclose(file_tau);
    if (file_space_est) fclose(file_space_est);
    if (file_time_est)  fclose(file_time_est);
    if (file_L2_err)    fclose(file_L2_err);
  }
  else
  {
    fflush(nil);
  }

  return;
}

/*static REAL time_est;*/
static REAL get_el_est(EL *el);

static void close_timestep(MESH *mesh, ADAPT_INSTAT *adapt)
{
  FUNCNAME("close_timestep");
  static REAL err_max = 0.0;                     /* max space-time error    */
  static REAL est_max = 0.0;                     /* max space-time estimate */
  static int  write_fe_data = 0, write_stat_data = 0;
  static int  step = 0;
  static char path[256] = "./";

  REAL        space_est = adapt->adapt_space->err_sum;
  REAL        tolerance = adapt->rel_time_error*adapt->tolerance;

  err_max = MAX(err_max, err_L2);
  est_max = MAX(est_max, space_est + time_est);
#if (defined(ALBERTA_VER) && (ALBERTA_VER==2))

  INFO(adapt->info,1,
    "---8<---------------------------------------------------\n");

  if (adapt->time == adapt->start_time)
  {
    tolerance = adapt->adapt_initial->tolerance;
    INFO(adapt->info,1, "start time: %.4le\n", adapt->time);
  }
  else
  {
    tolerance += adapt->adapt_space->tolerance;
    INFO(adapt->info,1, "timestep for (%.4le %.4le), tau = %.4le\n",
			adapt->time-adapt->timestep, adapt->time, 
			adapt->timestep);
  }
  INFO(adapt->info,2, "max. est.  = %.4le, tolerance = %.4le\n", 
		      est_max, tolerance);
  INFO(adapt->info,2, "max. error = %.4le, ratio = %.2lf\n", 
		      err_max, err_max/MAX(est_max,1.0e-20));

  if (!step)
  {
    GET_PARAMETER(1, "write finite element data", "%d", &write_fe_data);
    GET_PARAMETER(1, "write statistical data", "%d", &write_stat_data);
    GET_PARAMETER(1, "data path", "%s", path);
  }
 #else
 #endif
//    print_dof_real_vec(u_h);

//    print_dof_real_vec(f_h);

/*---8<---------------------------------------------------------------------*/
/*---   write mesh and discrete solution to file for post-processing     ---*/
/*--------------------------------------------------------------------->8---*/

  if (write_fe_data)
  {
    const char *fn;
    
    fn= generate_filename(path, "mesh", step);
    write_mesh_xdr(mesh, fn, adapt->time);
    fn= generate_filename(path, "u_h", step);
    write_dof_real_vec(u_h, fn);
  }

  step++;

/*---8<---------------------------------------------------------------------*/
/*---  write data about estimate, error, time step size, etc.            ---*/
/*--------------------------------------------------------------------->8---*/

  if (write_stat_data)
  {
    int n_dof = fe_space->admin->size_used;
    write_statistics(path, adapt, n_dof, space_est, time_est, err_L2);
  }

  graphics(mesh, u_h, adapt->adapt_space->get_el_est, nil, adapt->time);

  return;
}




#ifdef __newalberta_hh__
//#include "heat_problem.hh"
static PROB_DATA_DIFF* prob_data;

class heatsrc : public elfunc
{ public:
	int set_at_el(const EL_INFO * const elem_info, REAL eval_time);
	REAL calc(const REAL* const lambda);
   private:
	REAL heatsource(const EL_INFO * const el_info, const REAL* const lambda,
						const REAL eval_time);
	~heatsrc(){};
	const EL_INFO * el_info;
	REAL eval_time; 
	};

 REAL heatsrc::heatsource(const EL_INFO * const el_info, const REAL* const lambda,
					const REAL eval_time)
{ 
//  FUNCNAME("heatsource");
	 REAL_D world;
	 coord_to_world(el_info, lambda,world); 
	eval_time_f=eval_time;
	return(f(world)); 

}

int heatsrc::set_at_el(const EL_INFO * const elem_info, REAL new_eval_time)
	{
	eval_time = new_eval_time;
	el_info=elem_info;
	return(0);
	}
	
REAL heatsrc::calc(const REAL* const lambda)
{
	 REAL coeff = heatsource(el_info, lambda,  eval_time);
	return(coeff);
}


static REAL gth_Demo(const REAL_D x, REAL t)
{
  eval_time_u = t;
return(u(x));
}
 
static REAL* wrap_grad_u(const REAL_D x, REAL t)
{return(grd_u(x));
}

static PROB_DATA_DIFF prob_data_demo = 
        {
        nil/*spaeter in init_problem!*/, nil, nil
	,DIFFMAT_PW_CONST|DIFFMAT_ISOTROP|MASS_CONST,        
	{0.0, 0.077, 0.084,/*latent_heat pearl, Martensit*/ 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0}, //phys. konstanten. Feld is eher f. phase gedacht  
         nil, u0,gth_Demo


, nil,
        	u , wrap_grad_u              /* th_ex, grd_th_ex */
        };

//  		sol_0             temperature initial data    */
//  		REAL (*g_Dirich)(const REAL_D x, REAL t);  	 Dirichlet bdry values temp  */
//  		REAL (*g_Neumann)(const REAL_D x, REAL t, S_CHAR); Neumann bdry values th*/
// 		 REAL (*sol_ex)(const REAL_D x);   			 known temperature soln      */
//  		REAL *(*grd_sol_ex)(const REAL_D x, REAL t);	  known temperature grad   */



PROB_DATA_DIFF *init_problem(/*PROB_DATA_DIFF *data*/)
{
  FUNCNAME("init_problem");
  int     n_refine;
 prob_data = &prob_data_demo;

 prob_data->diffmat = new constmat(1.0);
 prob_data->f_sources = new heatsrc();//weiss noch nich
 prob_data->massfunc =  new constfunc(1.0);
  GET_PARAMETER(1, "global refinements", "%d", &n_refine);

  MSG("Diffusion Coeff Heat = %e,  l\n", prob_data->diffmat->getcomp(0,0));

  return(prob_data);
}
#endif
