/*--------------------------------------------------------------------------*/
/* ALBERTA:  an Adaptive multi Level finite element toolbox using           */
/*           Bisectioning refinement and Error control by Residual          */
/*           Techniques for scientific Applications                         */
/*                                                                          */
/* file:     adapt.c                                                        */
/*                                                                          */
/* 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.mathematik.uni-freiburg.de/IAM/ALBERTA                       */
/*                                                                          */
/*  (c) by A. Schmidt and K.G. Siebert (1996-2003)                          */
/*                                                                          */
/*--------------------------------------------------------------------------*/

#ifdef HAVE_CONFIG_H
# include "config.h"
#endif

#include "alberta.h"
#include <time.h>

#define TIME_USED(f,s) ((double)((s)-(f))/(double)CLOCKS_PER_SEC)

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

static U_CHAR adapt_mesh(MESH *mesh, ADAPT_STAT *adapt)
{
  FUNCNAME("adapt_mesh");
  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->marking)
    mark_flag = adapt->marking(mesh, adapt);
  else
    mark_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, adapt->adaptation_fill_flags);

  if (flag & MESH_REFINED)
  {
    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, adapt->adaptation_fill_flags);

  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()));

  return(flag);
}

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


void adapt_method_stat(MESH *mesh, ADAPT_STAT *adapt)
{
  FUNCNAME("adapt_method_stat");
  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);
    PRINT_INFO(adapt->info, 4,", tol = %.4le", adapt->tolerance);
    PRINT_INFO(adapt->info, 4,", estimate = %.4le\n", est);
  }

  if (est > adapt->tolerance)
  {
    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);
  }
  return;
}

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

static void explicit_time_strategy(MESH *mesh, ADAPT_INSTAT *adapt)
{
  FUNCNAME("explicit_time_strategy");
  ADAPT_STAT *adapt_s = adapt->adapt_space;

  /* 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 */

  return;
}


static void implicit_time_strategy(MESH *mesh, ADAPT_INSTAT *adapt)
{
  FUNCNAME("implicit_time_strategy");
  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;
  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);

    iter++;
    if (iter > adapt->max_iteration) break;

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

    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;
	  }
	}
      }

      iter_s++;
      if (iter_s > adapt_s->max_iteration) break;

    } while(err_space > space_err_limit);

  } while(err_time > time_err_limit);

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


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

  switch(adapt->strategy)
  {
  case 0:
    explicit_time_strategy(mesh, adapt);
    break;

  case 1:
    implicit_time_strategy(mesh, adapt);
    break;

  default:
    MSG("unknown adapt->strategy = %d; use explicit strategy\n");
    explicit_time_strategy(mesh, adapt);
  }

  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 (adapt->init_timestep)
      adapt->init_timestep(mesh, adapt);

    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!!!                                                   */
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

typedef struct adapt_traverse_data {
  REAL   (*get_el_est)(EL *el);
  REAL   (*get_el_estc)(EL *el);
  int    el_mark, el_mark_c;
  S_CHAR g_mark_refine;
  S_CHAR g_mark_coarse;
  REAL   err_max, err_sum;
  int    mark_flag;
  REAL   mark_r_limit, mark_c_limit;
  REAL   GERS_sum;
} ADAPT_TRAVERSE_DATA;

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

static void marking_fct_1(const EL_INFO *el_info, void *data)
{
  el_info->el->mark = ((ADAPT_TRAVERSE_DATA *)data)->g_mark_refine;
  ((ADAPT_TRAVERSE_DATA *)data)->mark_flag = 1;
  ((ADAPT_TRAVERSE_DATA *)data)->el_mark++;

  return;
}


static void marking_fct_2(const EL_INFO *el_info, void *data)
{
  ADAPT_TRAVERSE_DATA *ud = (ADAPT_TRAVERSE_DATA *)data;
  REAL error = ud->get_el_est(el_info->el);

  if (error > ud->mark_r_limit)
  {
    el_info->el->mark = ud->g_mark_refine;
    ud->mark_flag = 1;
    ud->el_mark++;
  }
  else if (error <= ud->mark_c_limit)
  {
    if (!ud->get_el_estc || 
	(error + ud->get_el_estc(el_info->el) <= ud->mark_c_limit))
    {
      el_info->el->mark = ud->g_mark_coarse;
      ud->mark_flag = 1;
      ud->el_mark_c++;
    }
  }
  return;
}


static void marking_fct_3(const EL_INFO *el_info, void *data)
{
  ADAPT_TRAVERSE_DATA *ud = (ADAPT_TRAVERSE_DATA *)data;
  REAL error = ud->get_el_est(el_info->el);

  if (error > ud->mark_r_limit)
  {
    el_info->el->mark = ud->g_mark_refine;
    ud->mark_flag = 1;
    ud->el_mark++;
  }
  else if (error <= ud->mark_c_limit)
  {
    if (!ud->get_el_estc || 
	(error + ud->get_el_estc(el_info->el) <= ud->mark_c_limit))
    {
      el_info->el->mark = ud->g_mark_coarse;
      ud->mark_flag = 1;
      ud->el_mark_c++;
    }
  }
  return;
}

static void marking_fct_4(const EL_INFO *el_info, void *data)
{
  ADAPT_TRAVERSE_DATA *ud = (ADAPT_TRAVERSE_DATA *)data;
  REAL error = ud->get_el_est(el_info->el);

  if (error > ud->mark_r_limit)
  {
    ud->GERS_sum += error;
    el_info->el->mark = ud->g_mark_refine;
    ud->mark_flag = 1;
    ud->el_mark++;
  }
  return;
}

static void marking_fct_4c(const EL_INFO *el_info, void *data)
{
  ADAPT_TRAVERSE_DATA *ud = (ADAPT_TRAVERSE_DATA *)data;
  REAL error;

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

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

  return;
}

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

int marking(MESH *mesh, ADAPT_STAT *adapt)
{
  FUNCNAME("marking");
  static REAL old_err_sum = 0.0;
  static ADAPT_TRAVERSE_DATA td[1];
  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;

  TEST_EXIT(adapt, "no adapt_stat\n");
  if(adapt->strategy > 1)
    TEST_EXIT(td->get_el_est = adapt->get_el_est, "no adapt->get_el_est\n");
  TEST_EXIT(adapt->p >= 1.0, "ADAPT_STAT->p < 1\n");
  
  td->get_el_estc = adapt->get_el_estc;
  td->g_mark_refine = adapt->refine_bisections;
  td->g_mark_coarse = -adapt->coarse_bisections;

  td->mark_flag = 0;
  td->el_mark = td->el_mark_c = 0;

  eps_p = pow(adapt->tolerance, adapt->p);
  td->err_sum = pow(adapt->err_sum, adapt->p);

  td->err_max = adapt->err_max;

  switch(adapt->strategy) {
  case GR:
    if (adapt->err_sum > adapt->tolerance) {
      mesh_traverse(mesh, -1, CALL_LEAF_EL, marking_fct_1, td);
    }
    break;

  case MS:
    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;

    td->mark_r_limit = MS_gamma_p * td->err_max;
    if (adapt->coarsen_allowed)
      td->mark_c_limit = MS_gamma_c_p * td->err_max;
   
    INFO(adapt->info, 4,
	 "start mark_limits: %.3le %.3le err_max = %.3le\n",
	 td->mark_r_limit, td->mark_c_limit, td->err_max);

    mesh_traverse(mesh, -1, CALL_LEAF_EL, marking_fct_2, td);
    break;

  case ES:
    ES_theta_p = pow(adapt->ES_theta, adapt->p);
    td->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);
      td->mark_c_limit = ES_theta_c_p * eps_p / mesh->n_elements;
    }
    else
      td->mark_c_limit = -1.0;

    INFO(adapt->info, 4,
	 "start mark_limits: %.3le %.3le n_elements = %d\n",
	 td->mark_r_limit, td->mark_c_limit, mesh->n_elements);

    mesh_traverse(mesh, -1, CALL_LEAF_EL, marking_fct_3, td);
    break;

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

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

    if (td->err_sum < old_err_sum) 
    {
      improv = td->err_sum/old_err_sum;
      wanted = 0.8 * eps_p /td->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 = td->err_sum;

    GERS_gamma = 1.0;

    if (Ltheta > 0)
    {
      do
      {
	td->GERS_sum = 0.0;
	GERS_gamma -= adapt->GERS_nu;
	td->mark_r_limit = GERS_gamma * td->err_max;
	mesh_traverse(mesh, -1, CALL_LEAF_EL, marking_fct_4, td);
      }
      while ((GERS_gamma > 0) && (td->GERS_sum < Ltheta * td->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;

      do
      {
	td->GERS_sum = 0.0;
	GERS_gamma -= adapt->GERS_nu;
	td->mark_c_limit = GERS_gamma * td->err_max;
	mesh_traverse(mesh, -1, CALL_LEAF_EL, marking_fct_4c, td);

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

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

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

  td->mark_flag = 0;
  if (td->el_mark) td->mark_flag = 1;
  if (td->el_mark_c) td->mark_flag |= 2;

  return(td->mark_flag); 
}

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


/*--------------------------------------------------------------------------*/
/*  get_adapt_stat(dim, name, prefix, info, adapt_stat):                    */
/*                                                                          */
/*  if adapt_stat is non NULL:                                               */
/*  allocates a new adpat_stat structure adapt and predefines the           */
/*  parameter entries of this structure;                                    */
/*  if name is non NULL 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 NULL                                                    */
/*  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 NULL second argument  !!! */
/* !!!  you have to initialize your parameters via init_parameters()    !!! */
/*--------------------------------------------------------------------------*/

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 MS:
    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);
    }
    return;
  case ES:
    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);
    }
    return;
  case GERS:
    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);
    }
    return;
  default:
    break;
  }
  return;
}

ADAPT_STAT *get_adapt_stat(int dim, const char *name, 
			   const char *prefix, int info,
			   ADAPT_STAT *adapt_stat)
{
  FUNCNAME("get_adapt_stat");
  ADAPT_STAT  adapt_stand = {NULL, 1.0, 2, 30, 2, NULL, NULL, NULL, NULL,
                             NULL, 0.0, 0.0, NULL, NULL, NULL, NULL,
                             -1 /* refine_bisections */,
			     false /* coarsen_allowed*/,
			     -1 /* coarse_bisections */,
			     FILL_NOTHING /* adaptation_fill_flags */,
			     GR /* strategy */,
			     0.5, 0.1, 0.9, 0.2,
			     0.6, 0.1, 0.1 };
  char  key[1024];
  ADAPT_STAT *adapt;

  if(dim == 0) {
    WARNING("Adaption does not make sense for dim == 0!\n");
    return NULL;
  }

  adapt_stand.refine_bisections =
    adapt_stand.coarse_bisections = dim;

  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, "%B", &adapt->coarsen_allowed);
  if (adapt->coarsen_allowed) {
    sprintf(key, "%s->coarse_bisections", prefix);
    GET_PARAMETER(info-2, key, "%d", &adapt->coarse_bisections);
  }
  sprintf(key, "%s->adaptation fill flags", prefix);
  GET_PARAMETER(info-2, key, "%i", &adapt->adaptation_fill_flags);

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

  return(adapt);
}

/*--------------------------------------------------------------------------*/
/*  get_adapt_instat(dim, name, prefix, info, adapt_instat):                */
/*                                                                          */
/*  if adapt_instat is non NULL:                                             */
/*  allocates a new adpat_instat structure adapt and predefines the         */
/*  parameter entries of this structure;                                    */
/*  if name is non NULL adapt->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 NULL                                                    */
/*  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 NULL second argument  !!! */
/* !!!  you have to initialize your parameters via init_parameters()    !!! */
/*--------------------------------------------------------------------------*/

ADAPT_INSTAT *get_adapt_instat(int dim, const char *name,
			       const char *prefix, int info,
			       ADAPT_INSTAT *adapt_instat)
{
  FUNCNAME("get_adapt_instat");
  ADAPT_INSTAT adapt_stand = {NULL,
			      {{NULL,
				1.0, 2.0, 1, -1, NULL, NULL, NULL, NULL,
				NULL, 0.0, 0.0, NULL, NULL, NULL, NULL,
				-1, 0, -1, 2, 0.5, 0.1, 0.9, 0.2,
				0.6, 0.1, 0.1}},
			      {{NULL,
				1.0, 2.0, 1, -1, NULL, NULL, NULL, NULL,
				NULL, 0.0, 0.0, NULL, NULL, NULL, NULL,
				-1, 1, -1, 2, 0.5, 0.1, 0.9, 0.2,
				0.6, 0.1, 0.1}},
			      0.0, 0.0, 1.0, 0.01, NULL, NULL, NULL, NULL, NULL,
			      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(dim == 0) {
    WARNING("Adaption does not make sense for dim == 0!\n");
    return NULL;
  }

  adapt_stand.adapt_initial->refine_bisections =
    adapt_stand.adapt_initial->coarse_bisections =
    adapt_stand.adapt_space->refine_bisections =
    adapt_stand.adapt_space->coarse_bisections = dim;

  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, "%B", &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, "%B", &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);
}
