/*--------------------------------------------------------------------------*/
/* ALBERTA:  an Adaptive multi Level finite element toolbox using           */
/*           Bisectioning refinement and Error control by Residual          */
/*           Techniques for scientific Applications                         */
/*                                                                          */
/* file:     Common/adapt.cc                                                */
/*                                                                          */
/* description:  adaptive procedures for stationary and instationary        */
/*               problems                                                   */
/*                                                                          */
/*--------------------------------------------------------------------------*/
/*                                                                          */
/*  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>
#if (defined(ALBERTA_VER) && (ALBERTA_VER==2))
# include <alberta_inlines.h>
//#include <alberta_util_inlines.h>
# include "alberta1_wrapper.h"
#endif

#include <time.h>
#define TIME_USED(f,s) ((double)((s)-(f))/(double)CLOCKS_PER_SEC)
#define LOCALDEBUG 1
#include "newalberta.hh" 
#include "do_on_el.hh" 
#include "traverse.hh" 
// nur wegen extern int print_depth=10;
//oder newalberta.h einbinden, oder das alles in alberta_util machen, oder was weissich

/*--------------------------------------------------------------------------*/
/* adapt_mesh:   call marking(), refine(), and coarsen()                    */
/*--------------------------------------------------------------------------*/

// TM,EP
static S_CHAR   g_mark_refine = 0;
static S_CHAR   g_mark_coarse = -DIM; //0;21.12.06 das erste clear erfolgt naemlich vor
										//der eigentlichen initialisierung
static REAL     err_max, err_sum;
static REAL     mark_r_limit, mark_c_limit;
static int      el_mark, el_mark_c;

class set_coarse_mark: public do_on_el
{
  void el_fct(const EL_INFO* el_info) 
	{ 
	  el_info->el->mark = g_mark_coarse;
//  el_mark_c++;
	};
};


class clear_mark: public  do_on_el
{
  void el_fct(const EL_INFO* el_info) 
	{ 
	  el_info->el->mark = 0;
	};
};

static U_CHAR adapt_mesh(MESH *mesh, ADAPT_STAT *adapt)
{
  FUNCNAME("adapt_mesh");
  print_depth++;		//13.3
  U_CHAR   flag = 0;
  U_CHAR   mark_flag;
  int      n_elements, iadmin;
  clock_t  first = clock();
  
  TEST_EXIT(adapt,"no ADAPT_STAT\n");
// if adapt->method== 2 ,3
//  el_mark=0; el_mark_c=0;
	set_coarse_mark* set_coarse = new set_coarse_mark;
  traverse(mesh, -1, CALL_LEAF_EL, set_coarse); 
	delete set_coarse;

/*Baustelle - meins - ermoeglicht Schaetzungen
				mehrerer Schaetzer zu beruecksichtigen. 
 Initialisiert, da mark nicht mehr ueberschrieben
wird.*/

//else mesh_traverse(mesh, -1, CALL_LEAF_EL, clear_mark);
  if(adapt->marking) 
    mark_flag = adapt->marking(mesh, adapt);
  else 
  {
    TEST_EXIT(adapt->marking,"no marking() supplied\n");
//    merk_flag = marking(mesh, adapt);
  }

  if ((!adapt->coarsen_allowed))
    mark_flag &= MESH_REFINED;                    /* use refine mark only */

  if (adapt->build_before_refine)
    adapt->build_before_refine(mesh, mark_flag);

  n_elements = mesh->n_elements;

  if (mark_flag & MESH_REFINED)
    flag = refine(mesh);

  if (flag & MESH_REFINED)
  {//sone dusslige Rechnung!
    n_elements = mesh->n_elements - n_elements;
    INFO(adapt->info,8,
      "%d element%s refined, giving %d element%s\n",
       n_elements, n_elements > 1 ? "s" : "",
       mesh->n_elements, mesh->n_elements > 1 ? "s" : "");
    for (iadmin = 0; iadmin < mesh->n_dof_admin; iadmin++)
      INFO(adapt->info,7,"%d DOFs of admin <%s>\n", 
			  mesh->dof_admin[iadmin]->used_count, 
			  NAME(mesh->dof_admin[iadmin]));
  }
  else
    INFO(adapt->info,8,"no element refined\n");


  if (adapt->build_before_coarsen)
    adapt->build_before_coarsen(mesh, mark_flag);

  n_elements = mesh->n_elements;

  if (mark_flag & MESH_COARSENED)
    flag |= coarsen(mesh);

  if (flag & MESH_COARSENED)
  {
    n_elements -= mesh->n_elements;
    INFO(adapt->info,8,
      "%d element%s coarsened, giving %d element%s\n",
       n_elements, n_elements > 1 ? "s" : "",
       mesh->n_elements, mesh->n_elements > 1 ? "s" : "");
    for (iadmin = 0; iadmin < mesh->n_dof_admin; iadmin++)
      INFO(adapt->info,7,"%d DOFs of dof_admin <%s>\n", 
			  mesh->dof_admin[iadmin]->used_count,
			  NAME(mesh->dof_admin[iadmin]));
  }
  else
    INFO(adapt->info,8,"no element coarsened\n");


  if (adapt->build_after_coarsen)
    adapt->build_after_coarsen(mesh, flag);

  INFO(adapt->info,6,"adapting mesh and build needed %.5lg seconds\n",
		      TIME_USED(first,clock()));

  print_depth--;		//13.3
  return(flag);
}

/*--------------------------------------------------------------------------*/
/* adapt_method_stat: adapt for stationary problems                         */
/*--------------------------------------------------------------------------*/


void adapt_method_stat(MESH *mesh, ADAPT_STAT *adapt)
{
  FUNCNAME("adapt_method_stat");
  print_depth++;		//13.3
  int      iter;
  REAL     est;
  clock_t  first;

  TEST_EXIT(mesh,"no MESH\n");
  TEST_EXIT(adapt,"no ADAPT_STAT\n");

  /* get solution on initial mesh */
  if (adapt->build_before_refine)  adapt->build_before_refine(mesh, 0);
  if (adapt->build_before_coarsen) adapt->build_before_coarsen(mesh, 0);
  if (adapt->build_after_coarsen)  adapt->build_after_coarsen(mesh, 0);
  if (adapt->solve)
  {
    first = clock();
    adapt->solve(mesh);
    INFO(adapt->info,8,"solution of discrete system needed %.5lg seconds\n",
			TIME_USED(first,clock()));
  }

  first = clock();
  est = adapt->estimate ? adapt->estimate(mesh, adapt) : 0.0;
  INFO(adapt->info,8,"estimation of the error needed %.5lg seconds\n",
		      TIME_USED(first,clock()));

  for (iter = 0;
       (est > adapt->tolerance) &&
	 ((adapt->max_iteration <= 0) || (iter < adapt->max_iteration));
       iter++)
  {
    if (adapt_mesh(mesh, adapt))
    {
      if (adapt->solve)
      {
	first = clock();
	adapt->solve(mesh);
	INFO(adapt->info,8,
	  "solution of discrete system needed %.5lg seconds\n", 
	   TIME_USED(first,clock()));
      }
      first = clock();
      est = adapt->estimate ? adapt->estimate(mesh, adapt) : 0.0;
      INFO(adapt->info,8,"estimation of the error needed %.5lg seconds\n",
			  TIME_USED(first,clock()));
    }
    else
    {
      ERROR("no mesh adaption, but estimate above tolerance ???\n");
      break;
    }
    INFO(adapt->info, 4,"iter: %d", iter+1);
    PRINT_INFO(adapt->info, 4,", tol = %.4le", adapt->tolerance);
    PRINT_INFO(adapt->info, 4,", estimate = %.4le\n", est);
  }

  if ((iter > adapt->max_iteration) && (adapt->max_iteration > 0))
  {
    MSG("max_iterations REACHED: %d\n", adapt->max_iteration);
    MSG("prescribed tolerance    %le\n", adapt->tolerance);
    MSG("finished with estimate  %le\n", est);
  }
  else
  {
    INFO(adapt->info, 2,"no of iterations:       %d\n", iter);
    INFO(adapt->info, 2,"prescribed tolerance    %.4le\n", adapt->tolerance);
    INFO(adapt->info, 2,"finished with estimate  %.4le\n", est);
  }
  print_depth--;		//13.3
  return;
}

/*--------------------------------------------------------------------------*/
/* adapt_method_instat():  adapt for timedependent problems                 */
/*--------------------------------------------------------------------------*/

static int explicit_time_strategy(MESH *mesh, ADAPT_INSTAT *adapt)
{
  FUNCNAME("explicit_time_strategy");
  ADAPT_STAT *adapt_s = adapt->adapt_space;
  print_depth++;		//13.3

  /* first estimate must be computed before adapt_mesh() is called */
  if (adapt->time <= adapt->start_time) {
    if (adapt_s->estimate)
      adapt_s->estimate(mesh, adapt_s);
  }

  adapt->time += adapt->timestep;
  if (adapt->set_time)
    adapt->set_time(mesh, adapt);

  INFO(adapt->info,6,"time = %.4le, timestep = %.4le\n", 
		      adapt->time, adapt->timestep);

  adapt_mesh(mesh, adapt_s);

  if (adapt_s->solve)
    adapt_s->solve(mesh);

  if (adapt_s->estimate)
    adapt_s->estimate(mesh, adapt_s);           /* return value is not used */
  print_depth--;		//13.3

  return 0;
}


static int implicit_time_strategy(MESH *mesh, ADAPT_INSTAT *adapt)
{
  FUNCNAME("implicit_time_strategy");
  print_depth++;		//13.3
  int     iter, iter_s;
  ADAPT_STAT *adapt_s = adapt->adapt_space;
  REAL    err_space, err_time, space_err_limit, time_err_limit, time_err_low;

  space_err_limit = adapt->tolerance * adapt->rel_space_error;
  time_err_limit  = adapt->tolerance * adapt->rel_time_error
                     * adapt->time_theta_1;
  time_err_low    = adapt->tolerance * adapt->rel_time_error
                     * adapt->time_theta_2;
  iter = iter_s = 0;
  err_time = 0.0;

  do
  {
    adapt->time += adapt->timestep;
    if (adapt->set_time)
      adapt->set_time(mesh, adapt);

    INFO(adapt->info,6,"time = %.4le, try timestep = %.4le\n",
			adapt->time, adapt->timestep);

    if (adapt_s->build_before_refine)  adapt_s->build_before_refine(mesh, 0);
    if (adapt_s->build_before_coarsen) adapt_s->build_before_coarsen(mesh, 0);
    if (adapt_s->build_after_coarsen)  adapt_s->build_after_coarsen(mesh, 0);
    if (adapt_s->solve)                adapt_s->solve(mesh);
    err_space = adapt_s->estimate ? adapt_s->estimate(mesh, adapt_s) : 0.0;
    if (adapt->get_time_est)
      err_time  = adapt->get_time_est(mesh, adapt);
//das Feld muss eigentlich REAL time_est sein. Son Unfug hier.
    iter++;
    INFO(adapt->info,8,"iter = %d, timestep = %.6lg, err_time = %.6lg,  with tolerance %lg\n",
			iter, adapt->timestep, err_time, time_err_limit);
    if (iter > adapt->max_iteration) break;/* keine Raumverfeinerung, falls keine Reduzierung des
							Zeitfehlers???*/

    if (err_time > time_err_limit)
    {
      adapt->time -= adapt->timestep;
      adapt->timestep *= adapt->time_delta_1;
      continue;
    }

    print_depth++;		//13.3
    do
    {
      if (adapt_mesh(mesh, adapt_s))
      {
	adapt_s->solve(mesh);
	err_space = adapt_s->estimate ? adapt_s->estimate(mesh, adapt_s) : 0.0;
	if (adapt->get_time_est) {
	  err_time  = adapt->get_time_est(mesh, adapt);
	  if (err_time > time_err_limit)
	  {
	    adapt->time -= adapt->timestep;
	    adapt->timestep *= adapt->time_delta_1;
	    break;
	  }
	}
      }
      /* Hier ists richtig, iter_s++ ist aus vorherigem Loop heraus  */
      iter_s++;
      if (iter_s > adapt_s->max_iteration) break;

    } while(err_space > space_err_limit);
  print_depth--;		//13.3

  } while(err_time > time_err_limit);

  if (adapt->get_time_est)
    if (err_time <= time_err_low)
    {
      adapt->timestep *= adapt->time_delta_2;
    }
  print_depth--;		//13.3
  return iter;
}

static int prophylactic_time_strategy(MESH *mesh, ADAPT_INSTAT *adapt)
{
  FUNCNAME("prophylactic_time_strategy");
  print_depth++;		//13.3
  int     iter, iter_s, t_int_order=1;
  ADAPT_STAT *adapt_s = adapt->adapt_space;
  REAL    err_space, err_time, space_err_limit, time_err_limit, time_err_low;
 GET_PARAMETER(2,"time integration order","%d", &t_int_order);
 		//dont see a better way now...
  TEST_EXIT(adapt->get_time_est, "Doesnot work without get_time_est.\n");
  space_err_limit = adapt->tolerance * adapt->rel_space_error;
  time_err_limit  = adapt->tolerance * adapt->rel_time_error
                     * adapt->time_theta_1;
  time_err_low    = adapt->tolerance * adapt->rel_time_error
                     * adapt->time_theta_2;
  iter = iter_s = 0;
  err_time = 0.0;

  do
  {
    adapt->time += adapt->timestep;
    if (adapt->set_time)
      adapt->set_time(mesh, adapt);

    INFO(adapt->info,6,"time = %.4le, try timestep = %.4le\n",
			adapt->time, adapt->timestep);

    if (adapt_s->build_before_refine)  adapt_s->build_before_refine(mesh, 0);
    if (adapt_s->build_before_coarsen) adapt_s->build_before_coarsen(mesh, 0);
    if (adapt_s->build_after_coarsen)  adapt_s->build_after_coarsen(mesh, 0);
    if (adapt_s->solve)                adapt_s->solve(mesh);
    err_space = adapt_s->estimate ? adapt_s->estimate(mesh, adapt_s) : 0.0;
    err_time  = adapt->get_time_est(mesh, adapt);
//das Feld muss eigentlich REAL time_est sein. Son Unfug hier.
    iter++;
    INFO(adapt->info,8,"iter = %d, timestep = %.6lg, err_time = %.6lg, t-err_limit = %lg\n",
			iter,adapt->timestep, err_time, time_err_limit);
    if (iter > adapt->max_iteration)
    {
    	ERROR("time tol not reached after %d iterations. Trying space adaption\n", iter);
    } 
    else //Zeitschrittweitenadaption
    {
	    adapt->time -= adapt->timestep;
	    adapt->timestep *= MIN(adapt->time_delta_2,
    			pow(adapt->time_delta_1*time_err_limit/err_time,    1.0/(t_int_order+1.0))) ;
/*D+H schlagen Faktor <1 vor.
Wir deuten time_delta_1 um: es gibt nun an, auf welchen Anteil der Toleranz der Algorithmus
zielt. Relativ weit darunter zu zielen schadet bei uns nix, denn umso weniger muessen wir
wegschmeissen.
Ist die Wurzel gross, verfeinert er hier langsamer.Genaue Kenntnis der Ordnung waere gut.
	Nur naechster Versuch bei*/

    	if (err_time > time_err_limit)
    	{
    	  continue;
    	}
//dont forget:
	    adapt->time += adapt->timestep;
	    print_depth++;		//13.3
    }
    do
    {
      if (adapt_mesh(mesh, adapt_s))
      {
	adapt_s->solve(mesh);
	err_space = adapt_s->estimate ? adapt_s->estimate(mesh, adapt_s) : 0.0;
	 err_time  	= adapt->get_time_est(mesh, adapt);
	 adapt->time 	-= adapt->timestep;
      	 adapt->timestep *= MIN(adapt->time_delta_2
	 			,pow(adapt->time_delta_1*time_err_limit/err_time, 1.0/(t_int_order+1.0))) ;
    	 INFO(adapt->info,8," adapted  timestep = %.6lg, err_time = %.6lg\n",
			adapt->timestep, err_time);
	 if (err_time > time_err_limit)
	 {
 	    	break;
	 }
    	adapt->time += adapt->timestep;
	//der neue wieder dazu. nach break, d.h. falls es weitergeht
       }
      /* Hier ists richtig, iter_s++ ist aus vorherigem Loop heraus  */
       iter_s++;
       if (iter_s > adapt_s->max_iteration) break;

     } while(err_space > space_err_limit);
  print_depth--;		//13.3

  } while(err_time > time_err_limit);

//  if (err_time <= time_err_low)...schon geschehen
  print_depth--;		//13.3
  return iter;
}



static int adaptive_adaption_time_strategy(MESH *mesh, ADAPT_INSTAT *adapt)
{
  FUNCNAME("adaptive_adaption_time_strategy");
  print_depth++;		//13.3
  int     iter, iter_s, t_int_order=1;
  ADAPT_STAT *adapt_s = adapt->adapt_space;
  REAL    err_space, err_time, space_err_limit, time_err_limit, time_err_low;
 GET_PARAMETER(2,"time integration order","%d", &t_int_order);
 		//dont see a better way now...

  space_err_limit = adapt->tolerance * adapt->rel_space_error;
  time_err_limit  = adapt->tolerance * adapt->rel_time_error
                     * adapt->time_theta_1;
  time_err_low    = adapt->tolerance * adapt->rel_time_error
                     * adapt->time_theta_2;
  iter = iter_s = 0;
  err_time = 0.0;

  do
  {
    adapt->time += adapt->timestep;
    if (adapt->set_time)
      adapt->set_time(mesh, adapt);

    INFO(adapt->info,6,"time = %.4le, try timestep = %.4le\n",
			adapt->time, adapt->timestep);

    if (adapt_s->build_before_refine)  adapt_s->build_before_refine(mesh, 0);
    if (adapt_s->build_before_coarsen) adapt_s->build_before_coarsen(mesh, 0);
    if (adapt_s->build_after_coarsen)  adapt_s->build_after_coarsen(mesh, 0);
    if (adapt_s->solve)                adapt_s->solve(mesh);
    err_space = adapt_s->estimate ? adapt_s->estimate(mesh, adapt_s) : 0.0;
    if (adapt->get_time_est)
      err_time  = adapt->get_time_est(mesh, adapt);
//das Feld muss eigentlich REAL time_est sein. Son Unfug hier.
    iter++;
    INFO(adapt->info,8,"iter = %d, timestep = %.6lg, err_time = %.6lg,  t-err_limit =  %lg\n",
			iter,adapt->timestep, err_time, time_err_limit);
    if (iter > adapt->max_iteration) break;/* keine Raumverfeinerung, falls keine Reduzierung des
							Zeitfehlers???*/

    if (err_time > time_err_limit)
    {
      adapt->time -= adapt->timestep;
//      adapt->timestep *= adapt->time_delta_1;
      adapt->timestep *= pow(0.95*time_err_limit/err_time, 1.0/(t_int_order+1.0)) ;
/*D+H schlagen Faktor <1 vor, doch beim Verfeinern muss man doch nicht vorsichtig sein?
Ist die Wurzel gross, verfeinert er hier langsamer.Genaue Kenntnis der Ordnung waere gut.*/
      continue;
    }

    print_depth++;		//13.3
    do
    {
      if (adapt_mesh(mesh, adapt_s))
      {
	adapt_s->solve(mesh);
	err_space = adapt_s->estimate ? adapt_s->estimate(mesh, adapt_s) : 0.0;
	if (adapt->get_time_est) 
	{
	  err_time  = adapt->get_time_est(mesh, adapt);
	  if (err_time > time_err_limit)
	  {
	    adapt->time -= adapt->timestep;
//	    adapt->timestep *= adapt->time_delta_1;
      		adapt->timestep *= pow(0.95*time_err_limit/err_time, 1.0/(t_int_order+1.0)) ;
    		INFO(adapt->info,8,"adapted timestep = %.6lg, err_time = %.6lg\n",
			adapt->timestep, err_time);
//		dies hier vielleicht raus aus dem if?
 	    break;
	  }
	}
      }
      /* Hier ists richtig, iter_s++ ist aus vorherigem Loop heraus  */
      iter_s++;
      if (iter_s > adapt_s->max_iteration) break;

    } while(err_space > space_err_limit);
  print_depth--;		//13.3

  } while(err_time > time_err_limit);

  if (adapt->get_time_est)
  {
    if (err_time <= time_err_low)
    {
//      adapt->timestep *= adapt->time_delta_2;
      adapt->timestep *= pow(0.95*time_err_limit/err_time, 1.0/(t_int_order+1.0)) ;
//	Prophylaxe ist das noch nicht. nur adaptive adaption 
    }
  }
  print_depth--;		//13.3
  return iter;
}

static void one_timestep(MESH *mesh, ADAPT_INSTAT *adapt)
{
  FUNCNAME("one_timestep");
  int iter=0;
  static FILE *f=nil;
  
  switch(adapt->strategy)
  {
  case 0:
    iter = explicit_time_strategy(mesh, adapt);
    break;

  case 1:
    iter = implicit_time_strategy(mesh, adapt);
    break;
  case 2:
    iter = adaptive_adaption_time_strategy(mesh, adapt);
    break;
  case 3:
    iter = prophylactic_time_strategy(mesh, adapt);
    break;

  default:
    MSG("unknown adapt->strategy = %d; use explicit strategy\n");
    explicit_time_strategy(mesh, adapt);
  }
  if(adapt->info>7)
  {
    if (!f) { if((f=fopen("iter.xg","w"))) { perror("iter.xg"); } }
    fprintf(f,"%d\n",iter);
  }
  return;
}

/*--------------------------------------------------------------------------*/

void adapt_method_instat(MESH *mesh, ADAPT_INSTAT *adapt)
{
  FUNCNAME("adapt_method_instat");

  TEST_EXIT(adapt,"no ADAPT_INSTAT\n");

/*--------------------------------------------------------------------------*/
/*  adaptation of the initial grid: done by adapt_method_stat               */
/*--------------------------------------------------------------------------*/

  adapt->time = adapt->start_time;
  if (adapt->set_time) adapt->set_time(mesh, adapt);

  adapt->adapt_initial->tolerance
    = adapt->tolerance * adapt->rel_initial_error;
  adapt->adapt_space->tolerance
    = adapt->tolerance * adapt->rel_space_error;

  adapt_method_stat(mesh, adapt->adapt_initial);
  if (adapt->close_timestep)
    adapt->close_timestep(mesh, adapt);

/*--------------------------------------------------------------------------*/
/*  adaptation of timestepsize and mesh: done by one_timestep               */
/*--------------------------------------------------------------------------*/

  while (adapt->time < adapt->end_time)
  {
#if LOCALDEBUG
    MSG("mesh->parametric: %d\n",mesh->parametric);
#endif
    if (adapt->init_timestep)
      adapt->init_timestep(mesh, adapt);
#if LOCALDEBUG
    MSG("mesh->parametric: %d\n",mesh->parametric);
#endif
    if (adapt->one_timestep)
      adapt->one_timestep(mesh, adapt);
    else
      one_timestep(mesh, adapt);

    if (adapt->close_timestep)
      adapt->close_timestep(mesh, adapt);
  }
}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/
/*   marking functions!!!                                                   */
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

static REAL       (*get_el_est)(EL *el);
static REAL       (*get_el_estc)(EL *el);

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/
/****  marking functions for several adaptive strategies                 ****/
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/



class marking_1:  public  do_on_el
{
  void	el_fct(const EL_INFO *el_info)
	{
	  el_info->el->mark = g_mark_refine;
	  el_mark++;
	  return;
	};
};

// element marker fuer MS und ES, multiple schaetzer
// coarsening und noop sind noch nicht ganz gruen
// da kein unterschied zw. uninitialisierte marker
// und noop marker (0) besteht
// marking_limits siehe unten
class marking_23:  public do_on_el
{
  void	el_fct(const EL_INFO *el_info)
	{
 //  FUNCNAME("marking_fct");
  //fuer default =g_mark_coarse
  	REAL   error = get_el_est(el_info->el);
  	int    mark, oldmark=el_info->el->mark;
//Werden das so machen: mark nach dem Fehler setzten, Zaehlen auch nach dem Fehler, 
// und dann   el_info->el->mark = MAX(mark, old_mark);
	  if(oldmark <= 0)
	  {
	    if ((get_el_estc? error + get_el_estc(el_info->el) : error) > mark_c_limit) // nicht vergroebern
	    	{
//1.2.			if (oldmark<0) el_mark_c++;//	el_mark_c--;
			if (error > mark_r_limit)// verfeinern
				{mark = g_mark_refine;
		      	el_mark++;
    			} 
      		else mark = 0; 
        	el_info->el->mark = mark;
    		}
		else	//1.Februar. error< mark_c_limit & ...
			{if (oldmark<0) el_mark_c++; //	die jetzt noch zu vergroebernden Elemente;
			}
	  }
  //  MSG("error %g, tol %g tol_c %g oldmark %d mark %d\n",error,mark_r_limit,mark_c_limit, oldmark, mark);
   	 return;
	};
};

#if 0
static void marking_fct_23(const EL_INFO *el_info)
{
  //  FUNCNAME("marking_fct");
  //fuer default =g_mark_coarse
  REAL   error = get_el_est(el_info->el);
  int    mark, oldmark=el_info->el->mark;
  
  // falls nicht markiert fuers verfeinern
  if(oldmark <= 0)
  {
    if ((get_el_estc? error + get_el_estc(el_info->el) : error) > mark_c_limit) // verfeinern
    	{
falsch!			el_mark_c--;
			if (error > mark_r_limit)
				{mark = g_mark_refine;
      		el_mark++;
    			} 
      	else mark = 0; 
    	}
    el_info->el->mark = mark;
  }
  
  //  MSG("error %g, tol %g tol_c %g oldmark %d mark %d\n",error,mark_r_limit,mark_c_limit, oldmark, mark);
  
  return;
}
// alte version von oben
static void marking_fct_23(const EL_INFO *el_info)
{
  //  FUNCNAME("marking_fct");
  
  REAL   error = get_el_est(el_info->el);
  int    mark, oldmark=el_info->el->mark;
  
  // falls nicht markiert fuers verfeinern
  if(oldmark <= 0)
  {
    //    if (oldmark<0) el_mark_c--;  

    if (error > mark_r_limit) // verfeinern
    {
      mark = g_mark_refine;
      el_mark++;
    } 
    else if(error>mark_c_limit) // keine aenderung
    {
      // coarsen flag loeschen: alle marker (BUG: die letzten) 
      // muessen sich fuer c. entscheiden damit es erhalten bleibt     
      mark=0;
    }
    else  // if (error <= mark_c_limit) 
    {
      if (!get_el_estc || (error + get_el_estc(el_info->el) <= mark_c_limit))
      {
        mark = g_mark_coarse;
        el_mark_c++;
      }
      else mark = 0; 
    }
  // coarsen counter korrigieren
    if (oldmark<0 && mark>=0) el_mark_c--;  
    
    el_info->el->mark = mark;
  }
  
  //  MSG("error %g, tol %g tol_c %g oldmark %d mark %d\n",error,mark_r_limit,mark_c_limit, oldmark, mark);
  
  return;
}
static void marking_fct_3(const EL_INFO *el_info)
{
  REAL   error = get_el_est(el_info->el);

  if (error > mark_r_limit)
  {
    el_info->el->mark = g_mark_refine;
    el_mark++;
  } 
  else if ((error <= mark_c_limit) && (el_info->el->mark <= 0)) /* TM*/
  {
    if (!get_el_estc || (error + get_el_estc(el_info->el) <= mark_c_limit))
    {
      el_info->el->mark = g_mark_coarse;
      el_mark_c++;
    }
  }
  return;
}
#endif


static REAL GERS_sum;

class marking_4:  public do_on_el
{
  void el_fct(const EL_INFO *el_info)
  {
  	REAL   error = get_el_est(el_info->el);

  	if (error > mark_r_limit)
  	{
  	  GERS_sum += error;
  	  el_info->el->mark = g_mark_refine;
  	  el_mark++;
  	}
  return;
 };
};
class marking_4c:  public do_on_el
{
 void el_fct(const EL_INFO *el_info)
  {
  REAL   error;

  if (el_info->el->mark <= 0)
  {
    error = get_el_est(el_info->el);
    if (get_el_estc) error += get_el_estc(el_info->el);

    if (error <= mark_c_limit) 
    {
      GERS_sum += error;
      el_info->el->mark = g_mark_coarse;
      el_mark_c++;
    }
    else
      el_info->el->mark = 0;
   }
  return;
  };
};

/*--------------------------------------------------------------------------*/
/* no marking strategy */
U_CHAR nomarking(MESH *mesh, ADAPT_STAT *adapt)
{
 return 0;
}
/* Wrapper for wrong type in the docs*/
U_CHAR okmarking(MESH *mesh, ADAPT_STAT *adapt)
{
 return U_CHAR(marking(mesh,adapt));
}


int marking(MESH *mesh, ADAPT_STAT *adapt)
{
  FUNCNAME("marking");
  print_depth++;		//13.3
  static REAL old_err_sum = 0.0;
  REAL        improv, Ltheta, redfac, wanted;
  REAL        eps_p, ES_theta_p,ES_theta_c_p;
  REAL        MS_gamma_p, MS_gamma_c_p, GERS_gamma;
  int  mark_flag;

  TEST_EXIT(adapt,"no adapt_stat\n");
  if(adapt->strategy > 1)
  {
    TEST_EXIT((get_el_est = adapt->get_el_est),"no adapt->get_el_est\n");
  }
  TEST_EXIT(adapt->p >= 1.0,"ADAPT_STAT->p < 1\n");
  
  MSG("for %s\n",adapt->name? adapt->name :"(unnamed)");
// BAUSTELLE 
  get_el_estc = nil; // adapt->get_el_estc;
  g_mark_refine = adapt->refine_bisections;
  g_mark_coarse = -adapt->coarse_bisections;

// sollten von adapt_mesh() gesetzt werden (??) global vs. lokalen zaehler
  el_mark =  0;
//  el_mark_c = mesh->n_elements;
/*also fuer jede Groesse nochmal gezaehlt. Hab umgedacht, sollten fuer alle Probleme zusammen
zaehlen. Grund: el_mark_c tut das so wie eben gemacht sowieso, aber el_mark nicht.
oder halt el_mark_c mit null initialisieren und ++ zaehlen.*/
  el_mark_c = 0; // mesh->n_elements;
  eps_p = pow(adapt->tolerance, adapt->p);
  err_sum = pow(adapt->err_sum, adapt->p);

  err_max = adapt->err_max;

  switch(adapt->strategy)
  {
  case 1:
    if (adapt->err_sum > adapt->tolerance)
    {marking_1  marking_1;
      traverse(mesh, -1, CALL_LEAF_EL,  &marking_1);
    }
    break;
//macht bei zeitabhaengigen sich langsam entwickelnden Problemen keinen Sinn, da immer die
//schlechtesten Elemente verfeinert werden, auch wenn die Toleranz schon erreicht ist.
  case 2:
    MS_gamma_p = pow(adapt->MS_gamma, adapt->p);
    if (adapt->coarsen_allowed)
      MS_gamma_c_p = pow(adapt->MS_gamma_c, adapt->p);
    else
      MS_gamma_c_p = -1.0;

    mark_r_limit = MS_gamma_p * err_max;
    if (adapt->coarsen_allowed)
      mark_c_limit = MS_gamma_c_p * err_max;
	  {
     marking_23  marking_23;
    traverse(mesh, -1, CALL_LEAF_EL, &marking_23);
	}
    break;

  case 3:
    ES_theta_p = pow(adapt->ES_theta, adapt->p);
    mark_r_limit = ES_theta_p * eps_p / mesh->n_elements;
    if (adapt->coarsen_allowed)
    {
      ES_theta_c_p = pow(adapt->ES_theta_c, adapt->p);
      mark_c_limit = ES_theta_c_p * eps_p / mesh->n_elements;
    }
    else
      mark_c_limit = -1.0;

    INFO(adapt->info, 4,
      "start mark_limits: %.3le %.3le n_elements = %d\n",
       mark_r_limit, mark_c_limit, mesh->n_elements);
	   	{
		marking_23 marking_23;
    	traverse(mesh, -1, CALL_LEAF_EL, &marking_23);
		}
    break;

  case 4:
/*--------------------------------------------------------------------------*/
/*  Graranteed error reduction strategy                                     */
/*  using extrapolation for theta                                           */
/*--------------------------------------------------------------------------*/

    Ltheta= pow(1.0 - adapt->GERS_theta_star, adapt->p);

    if (err_sum < old_err_sum) 
    {
      improv = err_sum/old_err_sum;
      wanted = 0.8 * eps_p /err_sum;
      redfac = MIN((1.0-wanted)/(1.0-improv),1.0);
      redfac = MAX(redfac, 0.0);

      if (redfac < 1.0) 
      {
	Ltheta = Ltheta*redfac;
	INFO(adapt->info, 2,
	  "GERS: use extrapolated theta_star = %.3lf\n",
	   pow(Ltheta, 1.0/adapt->p));
      }
    }
    old_err_sum = err_sum;

    GERS_gamma = 1.0;

    if (Ltheta > 0)
    {
		marking_4 marking_4;
       do
      {
		GERS_sum = 0.0;
		GERS_gamma -= adapt->GERS_nu;
		mark_r_limit = GERS_gamma * err_max;
		traverse(mesh, -1, CALL_LEAF_EL, &marking_4);
      }
      while ((GERS_gamma > 0) && (GERS_sum < Ltheta * err_sum));
    }

    INFO(adapt->info, 4,
      "GERS refinement with gamma = %.3lf\n", GERS_gamma);

    if (adapt->coarsen_allowed)
    {
      GERS_gamma = 0.3;
      Ltheta = adapt->GERS_theta_c * eps_p;
	  marking_4c marking_4c;
 
      do
      {
	GERS_sum = 0.0;
	GERS_gamma -= adapt->GERS_nu;
	mark_c_limit = GERS_gamma * err_max;
	traverse(mesh, -1, CALL_LEAF_EL, &marking_4c);

	INFO(adapt->info, 6,
	  "coarse loop: gamma = %.3e, sum = %.3e, limit = %.3e\n",
	   GERS_gamma, GERS_sum, Ltheta);
      }
      while (GERS_sum > Ltheta);

      INFO(adapt->info, 4,
	"GERS coarsening with gamma = %.3lf\n", GERS_gamma);
    }
    break;
  }

  INFO(adapt->info, 4,
    "extra %d elements marked for refinement\n", el_mark);
  INFO(adapt->info, 4,
    "still %d elements marked for coarsening\n", el_mark_c);

  mark_flag = 0;
  if (el_mark) mark_flag = MESH_REFINED;
  if (el_mark_c) mark_flag |= MESH_COARSENED;
  print_depth--;		//13.3

  return(mark_flag); 
}

/*--------------------------------------------------------------------------*/


/*--------------------------------------------------------------------------*/
/*  get_adapt_stat(name, prefix, info, adapt_stat):                         */
/*                                                                          */
/*  if adapt_stat is non nil:                                               */
/*  allocates a new adpat_stat structure adapt and predefines the           */
/*  parameter entries of this structure;                                    */
/*  if name is non nil adpat->name = name                                   */
/*                                                                          */
/*  Now, either for adapt_stat or the newly allocated adapt_stat the        */
/*  parameter entries of the structures are initialized by GET_PARAMETER()  */
/*  if prefix is non nil                                                    */
/*  the info parameter is the the first argument of GET_PARAMETER()         */
/*                                                                          */
/*  the return value is a pointer to the initialized adapt_stat structure   */
/*                                                                          */
/*  for the initialization of entry we use the call                         */
/*    GET_PARAMETER(info, "prefix->entry", "%{d,f}", &adapt->entry          */
/*  !! You do not have to define all parameters in your init file !!        */
/*     entries that are not defined in the init file have so standard value */
/*                                                                          */
/* !!!  before a call of get_adapt_stat() with non nil second argument  !!! */
/* !!!  you have to initialize your parameters via init_parameters()    !!! */
/*--------------------------------------------------------------------------*/
#if 0

static void init_strategy(const char *funcName, const char *prefix, int info, 
			  ADAPT_STAT *adapt)
{
  char  key[1024];

  sprintf(key, "%s->strategy", prefix);
  GET_PARAMETER(info, key, "%d", &adapt->strategy);

  switch (adapt->strategy)
  {
  case 2:
    sprintf(key, "%s->MS_gamma", prefix);
    GET_PARAMETER(info, key, "%f", &adapt->MS_gamma);
    if (adapt->coarsen_allowed)
    {
      sprintf(key, "%s->MS_gamma_c", prefix);
      GET_PARAMETER(info, key, "%f", &adapt->MS_gamma_c);
    }
    break;
  case 3:
    sprintf(key, "%s->ES_theta", prefix);
    GET_PARAMETER(info, key, "%f", &adapt->ES_theta);
    if (adapt->coarsen_allowed)
    {
      sprintf(key, "%s->ES_theta_c", prefix);
      GET_PARAMETER(info-1, key, "%f", &adapt->ES_theta_c);
    }
    break;
  case 4:
    sprintf(key, "%s->GERS_theta_star", prefix);
    GET_PARAMETER(info, key, "%f", &adapt->GERS_theta_star);
    sprintf(key, "%s->GERS_nu", prefix);
    GET_PARAMETER(info, key, "%f", &adapt->GERS_nu);
    if (adapt->coarsen_allowed)
    {
      sprintf(key, "%s->GERS_theta_c", prefix);
      GET_PARAMETER(info, key, "%f", &adapt->GERS_theta_c);
    }
    break;
  }
  return;
}
ADAPT_STAT *get_adapt_stat(const char *name, const char *prefix, int info,
			   ADAPT_STAT *adapt_stat)
{
  FUNCNAME("get_adapt_stat");
  ADAPT_STAT  adapt_stand = {nil, 1.0, 2, 30, 2, nil, nil, nil, nil,
                             nil, 0.0, 0.0, nil, nil, nil, nil,
                             DIM, 0, DIM, 1, 0.5, 0.1, 0.9, 0.2,
			     0.6, 0.1, 0.1 };
  char  key[1024];
  ADAPT_STAT *adapt;

  if (adapt_stat)
  {
    adapt = adapt_stat;
  }
  else
  {
    adapt = MEM_ALLOC(1, ADAPT_STAT);
    *adapt = adapt_stand;
    if (name)
      adapt->name = strdup(name);
    if (!adapt->name  && prefix)
      adapt->name = strdup(prefix);
  }

  if (!prefix)
    return(adapt);

  sprintf(key, "%s->tolerance", prefix);
  GET_PARAMETER(info-1, key, "%f", &adapt->tolerance);
  sprintf(key, "%s->p", prefix);
  GET_PARAMETER(info-2, key, "%f", &adapt->p);
  sprintf(key, "%s->max_iteration", prefix);
  GET_PARAMETER(info-1, key, "%d", &adapt->max_iteration);
  sprintf(key, "%s->info", prefix);
  GET_PARAMETER(info-1, key, "%d", &adapt->info);

  sprintf(key, "%s->refine_bisections", prefix);
  GET_PARAMETER(info-2, key, "%d", &adapt->refine_bisections);
  sprintf(key, "%s->coarsen_allowed", prefix);
  GET_PARAMETER(info-2, key, "%d", &adapt->coarsen_allowed);
  if (adapt->coarsen_allowed)
  {
    sprintf(key, "%s->coarse_bisections", prefix);
    GET_PARAMETER(info-2, key, "%d", &adapt->coarse_bisections);
  }

  init_strategy(funcName, prefix, info-1, adapt);

  return(adapt);
}
#endif
/*--------------------------------------------------------------------------*/
/*  get_adapt_instat(name, prefix, info, adapt_instat):                     */
/*                                                                          */
/*  if adapt_instat is non nil:                                             */
/*  allocates a new adpat_instat structure adapt and predefines the         */
/*  parameter entries of this structure;                                    */
/*  if name is non nil adpat->name = name                                   */
/*                                                                          */
/*  Now, either for adapt_instat or the newly allocated adapt_instat the    */
/*  parameter entries of the structures are initialized by GET_PARAMETER()  */
/*  if prefix is non nil                                                    */
/*  the info parameter is the the first argument of GET_PARAMETER()         */
/*                                                                          */
/*  the return value is a pointer to the initialized adapt_stat structure   */
/*                                                                          */
/*  for the initialization of entry we use the call                         */
/*    GET_PARAMETER(info, "prefix->entry", "%{d,f}", &adapt->entry)         */
/*  sub-structures adapt_initial/adapt_space are initialized with prefix    */
/*  prefix->initial resp. prefix->space                                     */
/*                                                                          */
/*  !! You do not have to define all parameters in your init file !!        */
/*     entries that are not defined in the init file have so standard value */
/*                                                                          */
/* !!!  before a call of get_adapt_stat() with non nil second argument  !!! */
/* !!!  you have to initialize your parameters via init_parameters()    !!! */
/*--------------------------------------------------------------------------*/
#if 0
ADAPT_INSTAT *get_adapt_instat(const char *name, const char *prefix, int info,
			       ADAPT_INSTAT *adapt_instat)
{
  FUNCNAME("get_adapt_instat");
  ADAPT_INSTAT adapt_stand = {nil,
			      {{nil,
			       1.0, 2.0, 1, -1, nil, nil, nil, nil,
			       nil, 0.0, 0.0, nil, nil, nil, nil,
			       DIM, 0, DIM, 2, 0.5, 0.1, 0.9, 0.2,
			       0.6, 0.1, 0.1}},
			      {{nil,
			       1.0, 2.0, 1, -1, nil, nil, nil, nil,
			       nil, 0.0, 0.0, nil, nil, nil, nil,
			       DIM, 1, DIM, 2, 0.5, 0.1, 0.9, 0.2,
			       0.6, 0.1, 0.1}},
			      0.0, 0.0, 1.0, 0.01, nil, nil, nil, nil, nil,
			      0, 0, 1.0, 0.1, 0.4, 0.4, 1.0, 0.3, 
			      0.7071, 1.4142, 8};
  char  key[1024];
  ADAPT_INSTAT *adapt;

  if (adapt_instat)
  {
    adapt = adapt_instat;
  }
  else
  {
    adapt = MEM_ALLOC(1, ADAPT_INSTAT);
    *adapt = adapt_stand;
    if (name)
      adapt->name = strdup(name);
    if (!adapt->name  && prefix)
      adapt->name = strdup(prefix);
  }

  if (!prefix)
    return(adapt);

  sprintf(key, "%s initial", adapt->name);
  adapt->adapt_initial->name = strdup(key);
  sprintf(key, "%s space", adapt->name);
  adapt->adapt_space->name = strdup(key);

/*---8<---------------------------------------------------------------------*/
/*---   and now, all other entries                                       ---*/
/*--------------------------------------------------------------------->8---*/

  sprintf(key, "%s->start_time", prefix);
  GET_PARAMETER(info-1, key, "%f", &adapt->start_time);
  adapt->time = adapt->start_time;
  sprintf(key, "%s->end_time", prefix);
  GET_PARAMETER(info-1, key, "%f", &adapt->end_time);
  sprintf(key, "%s->timestep", prefix);
  GET_PARAMETER(info-1, key, "%f", &adapt->timestep);
  sprintf(key, "%s->strategy", prefix);
  GET_PARAMETER(info-1, key, "%d", &adapt->strategy);
  sprintf(key, "%s->max_iteration", prefix);
  GET_PARAMETER(info-1, key, "%d", &adapt->max_iteration);
  sprintf(key, "%s->tolerance", prefix);
  GET_PARAMETER(info-1, key, "%f", &adapt->tolerance);
  sprintf(key, "%s->rel_initial_error", prefix);
  GET_PARAMETER(info-1, key, "%f", &adapt->rel_initial_error);
  sprintf(key, "%s->rel_space_error", prefix);
  GET_PARAMETER(info-1, key, "%f", &adapt->rel_space_error);
  sprintf(key, "%s->rel_time_error", prefix);
  GET_PARAMETER(info-1, key, "%f", &adapt->rel_time_error);
  sprintf(key, "%s->time_theta_1", prefix);
  GET_PARAMETER(info-2, key, "%f", &adapt->time_theta_1);
  sprintf(key, "%s->time_theta_2", prefix);
  GET_PARAMETER(info-2, key, "%f", &adapt->time_theta_2);
  sprintf(key, "%s->time_delta_1", prefix);
  GET_PARAMETER(info-2, key, "%f", &adapt->time_delta_1);
  sprintf(key, "%s->time_delta_2", prefix);
  GET_PARAMETER(info-2, key, "%f", &adapt->time_delta_2);
  sprintf(key, "%s->info", prefix);
  GET_PARAMETER(info-1, key, "%d", &adapt->info);

/*---8<---------------------------------------------------------------------*/
/*---  initialization of the adapt_stat for the initial grid             ---*/
/*--------------------------------------------------------------------->8---*/

/*---  tolerance does not have to be initialized, is set!                ---*/
  adapt->adapt_initial->tolerance = adapt->tolerance*adapt->rel_initial_error;
  sprintf(key, "%s->initial->p", prefix);
  GET_PARAMETER(info-2, key, "%f", &adapt->adapt_initial->p);
  sprintf(key, "%s->initial->max_iteration", prefix);
  GET_PARAMETER(info-1, key, "%d", &adapt->adapt_initial->max_iteration);
  sprintf(key, "%s->initial->info", prefix);
  GET_PARAMETER(info-2, key, "%d", &adapt->adapt_initial->info);
  if (adapt->adapt_initial->info < 0)
    adapt->adapt_initial->info = adapt->info-2;

  sprintf(key, "%s->initial->refine_bisections", prefix);
  GET_PARAMETER(info-2, key, "%d", &adapt->adapt_initial->refine_bisections);
  sprintf(key, "%s->initial->coarsen_allowed", prefix);
  GET_PARAMETER(info-2, key, "%d", &adapt->adapt_initial->coarsen_allowed);
  if (adapt->adapt_initial->coarsen_allowed)
  {
    sprintf(key, "%s->initial->coarse_bisections", prefix);
    GET_PARAMETER(info-2, key, "%d", &adapt->adapt_initial->coarse_bisections);
  }
  sprintf(key, "%s->initial", prefix);
  init_strategy(funcName, key, info-1, adapt->adapt_initial);


/*---8<---------------------------------------------------------------------*/
/*---  initialization of the adapt_stat for the time-step iteration      ---*/
/*--------------------------------------------------------------------->8---*/

/*---  tolerance does not have to be initialized, is set!                ---*/
  adapt->adapt_space->tolerance   = adapt->tolerance*adapt->rel_space_error;
  sprintf(key, "%s->space->p", prefix);
  GET_PARAMETER(info-2, key, "%f", &adapt->adapt_space->p);
  sprintf(key, "%s->space->max_iteration", prefix);
  GET_PARAMETER(info-1, key, "%d", &adapt->adapt_space->max_iteration);
  sprintf(key, "%s->space->info", prefix);
  GET_PARAMETER(info-2, key, "%d", &adapt->adapt_space->info);
  if (adapt->adapt_space->info < 0)
    adapt->adapt_space->info = adapt->info-2;

  sprintf(key, "%s->space->refine_bisections", prefix);
  GET_PARAMETER(info-2, key, "%d", &adapt->adapt_space->refine_bisections);
  sprintf(key, "%s->space->coarsen_allowed", prefix);
  GET_PARAMETER(info-2, key, "%d", &adapt->adapt_space->coarsen_allowed);
  if (adapt->adapt_space->coarsen_allowed)
  {
    sprintf(key, "%s->space->coarse_bisections", prefix);
    GET_PARAMETER(info-2, key, "%d", &adapt->adapt_space->coarse_bisections);
  }
  sprintf(key, "%s->space", prefix);
  init_strategy(funcName, key, info-1, adapt->adapt_space);

  return(adapt);
}
#endif
