// Emacs will be in -*- Mode: c++ -*-
//
// ********** DO NOT REMOVE THIS BANNER **********
//
// SUMMARY: Language for a Finite Element Method
// RELEASE: 2.0     
// USAGE  : You may copy freely these files and use it for    
//          teaching or research. These or part of these may   
//          not be sold or used for a commercial purpose with- 
//          out our consent : fax (33)1 44 27 44 11        
//
// AUTHORS:  D. Bernardi, Y. Darmaillac F. Hecht,    
//           P. Parole O. Pironneau C. Prud'homme
// ORG    :          
// E-MAIL :   pironneau@ann.jussieu.fr     
//
// ORIG-DATE:     June-94
// LAST-MOD:     20-Sep-97 at 12:21:48 by Christophe Prud'homme
//
// DESCRIPTION:  
// DESCRIP-END.
//

#include <math.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <iostream.h>
#include <fstream.h>

#include <triangul.h>
#include <opclass.h> 
#include <lexical.h> 
#include <syntaxic.h> 
#include <rgraph.h> 
#include <ugraph.h> 
#include <disk.h> 
#include <fem.h> 


/* adaptation includes */

// uncomment this line to enable the mesh adaptation features 
// for the mac                      
//#define ADAPT 1
#if defined(ADAPT)
# include <header.hxx>
# include <params.hxx>
# include <triangl.hxx>
# include <m_t0.hxx>
# include <cad.hxx>

parameter adapt_param;	
#endif /* ADAPT */

#if defined(XGFEM)
# include <comm.hxx>
comm slave;
extern void SlaveConnect (char *&, parameter&);
extern void SlaveDeconnect ();
extern void SlaveSendMesh (triangulation& t);
extern void SlaveSendFunction(int, char *, float *);
#endif /* XGFEM */

#define sqr(x) ((x)*(x))
#define Mini(x, y) (x) < (y) ? (x) : (y)
#define Maxi(x, y)  (x) > (y) ? (x) : (y)
#define MAXSD 200
#define MAXTREENODES 2000	/* of analyser */
#define MAXBDYVERTEX 3000	/* of contour */
#define MAXSYS 100		/* nb of equations in systems */

/* 
 * IMPORTANT REMARK.
 *   refbdy is also defined in syntaxic.cxx. 
 *   ATTENTION: if you change it
 */
#define refbdy 60

#define penal (float)1.e-14
#define xi1 1/sqrt(3)
#define xi2 1/sqrt(3)
extern int      bug;
extern creal    sqrtofminus1;
extern float   *normlx, *normly;	// the normal to the bdy

int             OPTION, i123;
int             N = 1;
int             N2 = 1;		// nb of variables of system 

ident          *systable[MAXSYS];	// table of pointers to variables of the system
int             imdnu, thesgndnu;	// carries info on sign of dnu(u) and address of u
char           *saveallname;	// file name for saveall
int             ihowsyst;	// matrix identifyer for the system
char           *pt = NULL;
fcts            param;
int             cursloc, cursom, numnoeuds;
long            nbsd = 0;
long            nbs, nba;

arbre          *noeuds;
long           *sd;
long           *arete;
int            *ngbdy;
float          *cr;
float          *hh;
int            tabref[refbdy][refbdy];

triangulation   t;


#ifdef NOXGFEM
# include <function.hxx> // include declaration of functions routines
#endif /* NOXGFEM */
int NumOfIterations; // used to store the number of iterations (for xgfem)
int Iter = 1; // Iteration numero

char           errbuf[1024]; // 1024 seems to be big enough to hold the messages
var             variables;
int             waitm = 1;
char           *mesg[102] =
{"'('", "')'", "'{'", "'}'", "'constant'",
 "'new variable'", "'old variable'", "'+'",
 "'-'", "'*'", "'/'", "'%'","'<'", "'<='", "'>'", "'>='",
 "'=='", "'!='", "','", "';'", "'sin'", "'cos'",
 "'log'", "'exp'", "'sqrt'", "'abs'", "'^'", "'acos'",
 "'asin'", "'tan'", "'and'", "'cosh'", "sinh'", "'tanh'",
 "'or'", "'min'", "'max'", "'dx'", "'dy'", "'if'",
 "'then'", "'else'", "'iter'", "'error'", "'final'", "':='",
 "'fonction'", "'bdy'", "'buildmesh'", "'atan'", "'='",
 "'solve'", "'id'", "'dnu'", "'id'", "'laplace'", "'div'",
 "'plot'", "'changewait'", "'plot3d'", "'''", "'save'", "'load'",
 "'savemesh'", "'loadmesh'", "'halt'", "'include'", "'dx'",
 "'dy'", "'convect'", "'evalfct'", "'exec'", "'saveall'",
 "'user'", "'Re'", "'Im'", "'system'", "'pde'", "'id_bdy'",
 "'dnu_bdy'", "'dxx'", "'dyy'", "'dxy'", "'dyx'", "'complex'", "'precise'"
 ,"'scal'", "'nx'", "'ny'", "'one'", "'wait'", "'nowait'", "'rhsconvect'",
 "'adaptmesh'","'polygon'","'intt'","'int'","']'","'['", "'varsolve'","'penal'","':'"};

/* syntaxic.c prototypes for routines not used elsewhere */
void            plante (arbre *, Symbol, creal, long, ident *, char *, noeud *, noeud *, noeud *, noeud *);
void            match (Symbol);
arbre           facteur ();
arbre           terme ();
arbre           exprarith ();
arbre           exprcomp ();
arbre           expr ();
arbre           fctfileproc ();
arbre           symb_bdyproc ();
arbre           symb_dchproc ();
arbre           symb_solvproc ();
arbre           diskmshproc ();
arbre 			preparesolve ();
arbre		 	prepvarsolve ();
arbre 			symb_pdeproc ();
void			edp (arbre s);
void 			defbdybypoint (arbre s);
void            defbdy (arbre);
void            build (arbre);
void            maketable (arbre);
void            conddch (arbre);
void            condfrr (arbre);
void            solve (arbre);
void            oppde (arbre);
void            sauvefct (arbre);
void            chargfct (arbre);
void            plot (arbre);
void            plot3d (arbre);
void            chartrig (arbre);
void            sauvtrig (arbre);
void            showident (ident *);
void            showtreeaux (int, arbre);
void            adapt(arbre);
void            reinitialize ();
int 			setgeom (int cursloc, int iloc, int precise);
void			varpde(arbre s);
void			doconddch(int i, int cursloc,int iloc,int* ib,arbre s);
void 			opcondlim (arbre s);
/*
 * parse the buffer
 */
void
parse (const char *buffer)
{
  arbre tree;

#if defined(XGFEM)
  SlaveConnect (buffer, adapt_param);
#endif /* XGFEM */
  
  initlex (buffer);
  initsyntax ();
  tree = instruction ();
  chvar ();

  initgraphique ();
  
  eval (tree);
  bucheron (tree);
  libere ();
  
  closegraphique ();

#if defined(XGFEM)
  SlaveDeconnect ();
#endif /* XGFEM */
}

void 
chvar ()
{
  int             i;
  char           *c;
  Complex I(0,1);

  for (i = 0; i < numidents; i++)
     {
       c = idents[i].name;
       if (!strcmp (c, "x"))
	 variables.x = idents + i;
       if (!strcmp (c, "y"))
	 variables.y = idents + i;
       if (!strcmp (c, "t"))
	 variables.t = idents + i;
       if (!strcmp (c, "ib"))
	 variables.ng = idents + i;
       if (!strcmp (c, "region"))
	 variables.region = idents + i;
       if (!strcmp (c, "iv"))
	 variables.cursom = idents + i;
       if (!strcmp (c, "nx"))
	 variables.nx = idents + i;
       if (!strcmp (c, "ny"))
	 variables.ny = idents + i;
       if (!strcmp (c, "nexist"))
	 variables.ne = idents + i;
       if (!strcmp (c, "I"))
	 variables.I = idents + i;
       if (!strcmp (c, "pi"))
	 variables.pi = idents + i;
     }
  (variables.I)->value = I;
  (variables.pi)->value = 4.0F * atan (1.0F);
}

void 
plante (arbre * res, Symbol s, creal v, long j, ident * n, char *pt,
	noeud * L1, noeud * L2, noeud * L3, noeud * L4)
{
  arbre p = new noeud;
  
  if (numnoeuds == MAXTREENODES)
    erreur ("Tree is too big...");
  p->symb = s;
  p->value = v;
  p->junk = j;
  p->name = n;
  p->l1 = L1;
  p->l2 = L2;
  p->l3 = L3;
  p->l4 = L4;
  if (pt)
     {
       p->path = new char[(strlen (pt) + 1)];
       strcpy (p->path,pt);
     }
  else
    p->path = NULL;
  *res = noeuds[numnoeuds++] = p;
}


void 
initsyntax ()
{
  numnoeuds = 0;
  waitm = 1;
  pt = NULL;
  noeuds = new arbre[MAXTREENODES];
  sd = new long[2*MAXSD];
  arete = new long[2 * MAXBDYVERTEX];
  ngbdy = new int[MAXBDYVERTEX];
  cr = new float[2*MAXBDYVERTEX+1];
  hh = new float[MAXBDYVERTEX];
  memset (hh, 0, MAXBDYVERTEX*sizeof(float));
  flag.si = 0;
  flag.syst = 0;
  flag.param = 0;
  flag.complexe = 0;
  flag.precise = 0;
}


void 
match (Symbol s)
{
  if (s == cursym)
    nextsym ();
  else
     {
       sprintf (errbuf, "line %d: Unexpected symbol: %s Instead of %s",
		numligne, mesg[cursym], mesg[s]);
       erreur (errbuf);
     }
}

arbre           expr ();

arbre 
facteur ()
{
  Symbol          thesym = cursym;
  ident          *theid = curident;
  arbre           l1, l2, l3, l4, res = NULL,l[5]={NULL,NULL,NULL,NULL,NULL};
  int count;

  switch (thesym)
     {
     case lpar:
       nextsym ();
       res = expr ();
       match (rpar);
       break;

     case symb_user:
       nextsym ();
       match (lpar);
       l1 = expr ();
       if (cursym == comma)
	  {
	    nextsym ();
	    l2 = expr ();
	  }
       else
	 l2 = NULL;
       plante (&res, thesym, 0.F, 0, NULL, pt, l1, l2, NULL, NULL);
       match (rpar);
       break;

     case one:
     case sine:
     case cosine:
     case atane:
     case exponential:
     case logarithm:
     case absolute:
     case root:
     case acose:
     case asine:
     case tane:
     case coshe:
     case sinhe:
     case tanhe:
     case partreal:
     case partimag:
     case partial_x:
     case partial_y:
     case penall:
       nextsym ();
       match (lpar);
       if ((cursym != fdecl) && ((thesym == partial_x) || (thesym == partial_y)))
	  {
	    sprintf (errbuf, "Line %d : Array-function name expected", numligne);
	    erreur (errbuf);
	  }
       l1 = expr ();
       plante (&res, thesym, 0.F, 0, NULL, pt, l1, NULL, NULL, NULL);
       match (rpar);
       break;
     case gint:
     case bint:
       if (cursym == bint)
         {
           /*
            * integrale de bord: il faut specifier au moins un bord
            */
           nextsym();
           match (lpar);
         }
       else
         {
           /*
            * integrale globale: si on ne specifie pas de sous domaines on
            *                    fait l'integrale sur tout le domaine
            */
           nextsym();
           if (cursym == lpar) nextsym();
         }
       if (cursym != bracketl)
         {
           count = 0;
           while (cursym != rpar)
             {
               if (count == 3)
                 {
                   sprintf (errbuf, "Line %d : More than 3 boundaries.", numligne);
                   erreur (errbuf);
                 }
               l[count++] = expr();
               if (cursym == comma) nextsym ();
             }
           if (count == 0 && cursym == bint)
             {
               sprintf (errbuf, "Line %d : at least one bdy ref is expected.", numligne);
               erreur (errbuf);
             }
           nextsym();
         }
       match (bracketl);
       if (cursym != fdecl)
         	{
           		sprintf (errbuf, "Line %d : Array-function name expected", numligne);
           		erreur (errbuf);
         	}
        l[3] = expr();
       	theid = NULL;
       	if (cursym == comma) 
       		{
       			nextsym ();
       		    if (cursym != fdecl)
         		{
           			sprintf (errbuf, "Line %d : Array-function name expected", numligne);
           			erreur (errbuf);
         		}
         		theid=curident;
         		nextsym();
         	}	
       plante (&res, thesym, 0.F, 0, theid, pt, l[0], l[1], l[2], l[3]);
       match (bracketr);
       break;
     case mini:
     case maxi:
     case prodscal:
       nextsym ();
       match (lpar);
       if ((thesym == prodscal) && (cursym != fdecl))
	  {
	    sprintf (errbuf, "Line %d : Array-function name expected", numligne);
	    erreur (errbuf);
	  }
       l1 = expr ();
       match (comma);
       if ((thesym == prodscal) && (cursym != fdecl))
	  {
	    sprintf (errbuf, "Line %d : Array-function name expected", numligne);
	    erreur (errbuf);
	  }
       l2 = expr ();
       plante (&res, thesym, 0.F, 0, NULL, pt, l1, l2, NULL, NULL);
       match (rpar);
       break;

     case symb_convect:
     case rhsconvect:
       nextsym ();
       match (lpar);
       if (cursym != fdecl)
	  {
	    sprintf (errbuf, "Line %d : Array-function name expected", numligne);
	    erreur (errbuf);
	  }
       l1 = expr ();
       match (comma);
       if (cursym != fdecl)
	  {
	    sprintf (errbuf, "Line %d : Array-function name expected", numligne);
	    erreur (errbuf);
	  }
       l2 = expr ();
       match (comma);
       if (cursym != fdecl)
	  {
	    sprintf (errbuf, "Line %d : Array-function name expected", numligne);
	    erreur (errbuf);
	  }
       l3 = expr ();
       match (comma);
       l4 = expr ();
       plante (&res, thesym, 0.F, 0, NULL, pt, l1, l2, l3, l4);
       match (rpar);
       break;

     case cste:
       plante (&res, thesym, curcst, 0, NULL, pt, NULL, NULL, NULL, NULL);
       nextsym ();
       break;

     case newvar:
       match (oldvar);
     case oldvar:
       plante (&res, thesym, 0.F, 0, curident, pt, NULL, NULL, NULL, NULL);
       nextsym ();
       break;

     case fdecl:
       nextsym ();
       if (cursym == lpar)	/* for f(x,y) */
	  {
	    match (lpar);
	    l1 = expr ();
	    match (comma);
	    l2 = expr ();
	    plante (&res, evalfct, 0.F, 0, theid, pt, l1, l2, NULL, NULL);
	    match (rpar);
	  }
       else if (!flag.si)
	 plante (&res, thesym, 0.F, 0, theid, pt, NULL, NULL, NULL, NULL);
       else
	  {
	    sprintf (errbuf, "line %d: Array-functions are not allowed in the logical expression of an if statement(use max,min...)", numligne);
	    erreur (errbuf);
	  }
       break;
     default :
       break;
     }
  if (cursym == expo)
     {
       nextsym ();
       l2 = facteur ();
       plante (&res, expo, 0.F, 0, NULL, pt, res, l2, NULL, NULL);
     }
  return res;
}

arbre 
terme ()
{
  arbre           l2, res = facteur ();

  while ((cursym == star) || (cursym == slash) || (cursym == modulo))
     {
       Symbol          thesym = cursym;

       nextsym ();
       l2 = facteur ();
       plante (&res, thesym, 0.F, 0, NULL, pt, res, l2, NULL, NULL);
     }
  return res;
}


arbre 
exprarith ()
{
  arbre           l2, res;

  switch (cursym)
     {
     case plus:
       nextsym ();
       res = terme ();
       break;
     case minus:
       nextsym ();
       l2 = terme ();
       plante (&res, minus, 0.F, 0, NULL, pt, NULL, l2, NULL, NULL);
       break;

     default:
       res = terme ();
     }
  while ((cursym == plus) || (cursym == minus))
     {
       Symbol          thesym = cursym;

       nextsym ();
       l2 = terme ();
       plante (&res, thesym, 0.F, 0, NULL, pt, res, l2, NULL, NULL);
     }
  return res;
}


arbre 
exprcomp ()
{
  arbre           l2, res = exprarith ();

  while ((cursym >= lt) && (cursym <= neq))
     {
       Symbol          thesym = cursym;

       nextsym ();
       l2 = exprarith ();
       plante (&res, thesym, 0.F, 0, NULL, pt, res, l2, NULL, NULL);
     }
  return res;
}


arbre 
expr ()
{
  arbre           l2, res = exprcomp ();

  while ((cursym == et) || (cursym == ou))
     {
       Symbol          thesym = cursym;

       nextsym ();
       l2 = exprcomp ();
       plante (&res, thesym, 0.F, 0, NULL, pt, res, l2, NULL, NULL);
     }
  return res;
}

arbre 
fctfileproc ()
{
  char           *s = NULL;
  arbre           res = NULL;
  arbre           l1 = NULL;
  float           thecst=0.F;
  char           *thechaine = NULL;

  nextsym ();
  match (lpar);
  thechaine = curchaine;
  match (chaine);
  while (cursym == comma)
     {
       nextsym ();
       switch (cursym)
	  {
	  case oldvar:
	  case newvar:
	  case fdecl:
	    break;

	  default:
	    sprintf (errbuf, "line %d: variable declaration expected", numligne);
	    erreur (errbuf);
	  }
       nextsym ();
     }
  match (rpar);
  s = readprog (thechaine);
  //thecst = readprog (thechaine, &s); CP
/*  if (thecst <= 0)
     {
     l1 = NULL;
     if (thecst == -1)
     sprintf (errbuf, "cant find file");
     else if (OPTION)
     {
     sprintf (errbuf, "file not found");
     erreur (errbuf);
     }
     }
  else
  {*/
  programme      *tmpprog = new programme;
  
  tmpprog->thestring = thestring;
  tmpprog->curchar = curchar;
  tmpprog->sym = cursym;
  tmpprog->numligne = numligne;
  tmpprog->pere = curprog;
  curprog = tmpprog;
  curchar = thestring = new char[strlen(s)];
  
  numligne = 0;
  strcpy (thestring, s);
  nextsym ();
  l1 = instruction ();
  delete [] thestring; thestring = NULL;
  thestring = curprog->thestring;
  curchar = curprog->curchar;
  cursym = curprog->sym;
  numligne = curprog->numligne;
  tmpprog = curprog->pere;
  delete [] thestring; thestring = NULL;
  delete curprog;curprog = NULL;
  curprog = tmpprog;
  /*}*/
  delete [] s;
  plante (&res, fctfile, thecst, 0, NULL, pt, l1, NULL, NULL, NULL);
  return res;
}

arbre 
symb_bdyproc ()
{
  arbre           l1 = NULL, l2 = NULL, l3 = NULL, l4 = NULL, res = NULL;
  float           thecst;
  int             refb = 0;
  char           *thechaine = "";
  Symbol          thesym;
  if (!flag.bdy)
     {
       sprintf (errbuf, "line %d: expecting symbol 'bdy'", numligne);
       erreur (errbuf);
     }
  flag.bdy = 0;
  flag.build = 0;
  thesym = cursym;
  nextsym ();
  match (lpar);
  thecst = curcst;
  if (thecst < 0)
     {
       sprintf (errbuf, "line %d: invalid bdy number (ng): <0", numligne);
       erreur (errbuf);
     }
  match (cste);
  match (comma);
 
  if(thesym==polygon)
  {
  	thechaine = curchaine;
  	match (chaine);
  	if(cursym==comma)
  	{
  		nextsym();  l1 = expr ();
  	} 
  	match (rpar);
  	plante (&res, polygon, thecst, refb, NULL, thechaine, l1, NULL, NULL, NULL); 
  }	
  else{
  	l1 = expr ();
  	match (comma);
  	l2 = expr ();
  	match (comma);
  	l3 = expr ();
	if (cursym == comma)
	  {
	    nextsym ();
	    refb = int(curcst);
	    if (thecst < 0)
	      {
		sprintf (errbuf, "line %d: invalid bdy number (ng): <0", numligne);
		erreur (errbuf);
	      }
	    nextsym();
	  }
	match (rpar);
	l4 = instruction ();
	plante (&res, symb_bdy, thecst, refb, NULL, pt, l1, l2, l3, l4);
  }
  flag.bdy = 1;
  flag.build = 1;
  return res;
}


arbre 
preparesolve ()
{
  arbre           l3 = NULL, res = NULL;
  Symbol          whatsym = cursym;
  char           *thechaine = NULL;

  l3 = NULL;
  nextsym ();
  match (lpar);
  N = 0;
  if (cursym == chaine)
     {
       if (whatsym == sauvetout)
	  {
	    thechaine = curchaine;
	    match (chaine);
	    match (comma);
	  }
     }
  if (!((cursym == newvar) || (cursym == fdecl)))
     {
       sprintf (errbuf, "line %d: Expecting a function\n", numligne);
       erreur (errbuf);
     }
  while ((cursym == newvar) || (cursym == fdecl))
     {
       curident->value = N++;
       curident->symb = fdecl;
       plante (&res, symb_system, 0.F, -N, curident, NULL, res, NULL, NULL, NULL);
       if (N > MAXSYS)
	  {
	    sprintf (errbuf, "line %d: Systems bigger than 2 not yet implemented\n", numligne);
	    erreur (errbuf);
	  }
       nextsym ();
       if (cursym == comma)
	 nextsym ();
     }
  if (cursym != rpar)
    l3 = expr ();
  plante (&res, symb_system, 0.F, N, curident, thechaine, res, NULL, l3, NULL);
  match (rpar);
  return res;
}

arbre
  prepvarsolve ()
{
  arbre           l3 = NULL, res = NULL;
  Symbol          whatsym = cursym;
  char           *thechaine = NULL;
  int 			  varswitch=0;

  l3 = NULL;
  nextsym ();
  match (lpar);
  N = 0;
  if (cursym == chaine)
     {
       if (whatsym == sauvetout)
	  {
	    thechaine = curchaine;
	    match (chaine);
	    match (comma);
	  }
     }
  if (!((cursym == newvar) || (cursym == fdecl)))
     {
       sprintf (errbuf, "line %d: Expecting a function\n", numligne);
       erreur (errbuf);
     }
  while ((cursym == newvar) || (cursym == fdecl))
     {
       curident->value = N++;
       curident->symb = fdecl;
       plante (&res, varsolve, (creal)varswitch, -N, curident, NULL, res, NULL, NULL, NULL);
       nextsym ();
       if (cursym == comma)  nextsym ();
	   else if (cursym==semicolon){ varswitch = N; nextsym();}
     }
  if (cursym != rpar)
    l3 = expr ();  //linear system indicator
  if(N != 2*varswitch) 
     {
       sprintf (errbuf, "line %d: nb of test & unknown functions dont match\n", numligne);
       erreur (errbuf);
     }
  N = varswitch;
  plante (&res, varsolve, 0.F, N, curident, thechaine, res, NULL, l3, NULL);
  match (rpar);
  return res;
}

arbre 
symb_dchproc ()
{
  arbre           l1 = NULL, l2 = NULL, res = NULL;
  float           thecst = 0.F;
  int             im, jm, thesgn, firstsgn = 1;
  Symbol          thesym;
  char           *pt = NULL;

  if (!flag.onbdy)
     {
       sprintf (errbuf, "line %d: expecting symbol 'onbdy'\n", numligne);
       erreur (errbuf);
     }
  nextsym ();
  match (lpar);
  do
     {
       if (cursym == comma)
	 nextsym ();
       thecst = thecst * 100 + curcst;	//code all boundaries: ib<100 else trouble

       match (cste);
     }
  while (cursym == comma);
  match (rpar);
  if ((cursym == newvar) || (cursym == fdecl))	// Dirichlet

     {
       nextsym ();
       im = (int) realpart (curident->value);
       match (fctdef);
       l1 = expr ();
       plante (&res, symb_dch, thecst, im, NULL, pt, l1, NULL, NULL, NULL);
       flag.onbdy = 1;
       return res;
     }
  do
     {				// Robin - Fourier

       thesgn = 1;
       pt = NULL;
       l2 = NULL;
       switch (cursym)
	  {
	  case minus:
	    thesgn = -1;
	  case plus:
	    nextsym ();
	  default:
	    break;
	  }
       if ((thesgn == -1) && (cursym == symb_frr))
	 firstsgn = -1;
//          { sprintf(errbuf, "line %d: Cannot have '-' in front of dnu()", numligne);   erreur(errbuf);}
       if (!((cursym == symb_id) || (cursym == symb_frr)))
	  {
	    sprintf (errbuf, "line %d: Expecting id() or dnu(). Found : %s", numligne, mesg[cursym]);
	    erreur (errbuf);
	  }
       if ((cursym == symb_frr) && (flag.onbdy == 2))
	  {
	    sprintf (errbuf, "line %d: Only one dnu() allowed per statement", numligne);
	    erreur (errbuf);
	  }
       if (cursym == symb_id)
	 thesym = id_bdy;
       else
	  {
	    flag.onbdy = 2;
	    thesym = cursym;
	  }
       nextsym ();
       match (lpar);
       jm = (int) realpart (curident->value);
       if (cursym != newvar)
	 match (fdecl);
       match (rpar);
       if (thesym == id_bdy)
	  {
	    if ((cursym == slash) || (cursym == star) || (cursym == modulo))
	       {
		 if (cursym == slash)
		   pt = "a";
		 nextsym ();
		 l2 = terme ();
	       }
	    else
	      plante (&l2, cste, 1.F, 0, NULL, NULL, NULL, NULL, NULL, NULL);
	    plante (&res, id_bdy, thesgn * thecst, jm, NULL, pt, res, l2, NULL, NULL);
	  }
       else
	 im = jm;
     }
  while (cursym == minus || cursym == plus);
  flag.onbdy = 1;
  match (fctdef);
  l2 = expr ();
  plante (&res, symb_frr, firstsgn * thecst, im, NULL, NULL, res, l2, NULL, NULL);
  return res;
}

arbre 
symb_pdeproc ()
{
  arbre           l1 = NULL, l2 = NULL, l3 = NULL, res = NULL;
  ident          *theid = NULL;
  Symbol          thesym;
  char           *thechaine = "";
  char           *pt = NULL;
  int             im, jm;
  float           thesgn = 1.F;

  nextsym ();
  match (lpar);
  theid = curident;
  im = (int) realpart (curident->value);
  if (cursym == newvar)
     {
       theid->symb = fdecl;
       nextsym ();
     }
  else
    match (fdecl);
  match (rpar);
  do
     {
       thesgn = 1.F;
       pt = NULL;
       l1 = NULL;
       switch (cursym)
	  {
	  case minus:
	    thesgn = -1.F;
	  case plus:
	    nextsym ();
	  default:
	    break;
	  }
       switch (cursym)
	  {
	  case symb_id:
	  case symb_lapl:
	  case d_xx:
	  case d_xy:
	  case d_yx:
	  case d_yy:
	  case partial_x:
	  case partial_y:
	    thesym = cursym;
	    if (thesym == partial_x)
	      thesym = div_x;
	    if (thesym == partial_y)
	      thesym = div_y;
	    nextsym ();
	    match (lpar);
	    jm = (int) realpart (curident->value);
	    match (fdecl);
	    match (rpar);
	    if ((cursym == slash) || (cursym == star))
	       {
		 if (cursym == slash)
		   pt = "a";
		 nextsym ();
		 l1 = terme ();
	       }
	    else
	      plante (&l1, cste, 1.F, 0, NULL, NULL, NULL, NULL, NULL, NULL);
	    plante (&res, thesym, thesgn, im * 100 + jm, NULL, pt, res, l1, NULL, NULL);
	    break;
	  default:
	    sprintf (errbuf, "line %d: Unexpected symbol : %s", numligne, mesg[cursym]);
	    erreur (errbuf);
	  }
     }
  while (cursym == minus || cursym == plus);
  match (fctdef);
  l2 = expr ();
  plante (&res, symb_pde, 0.F, im, theid, thechaine, res, l2, l3, NULL);
  return res;
}

arbre 
diskmshproc ()
{
  arbre           res = NULL, l1 = NULL;
  Symbol          thesym = cursym;
  char           *thechaine = NULL;

  if (cursym != chargmsh)
     {
       if (!flag.fct)
	  {
	    sprintf (errbuf, "line %d: illegal use of symbol %s", numligne,
		     mesg[cursym]);
	    erreur (errbuf);
	  }
     }
  nextsym ();
  match (lpar);
  thechaine = curchaine;
  match (chaine);
  if (cursym == comma)
    {
      nextsym();
      l1 = expr();
    }
  match (rpar);
  plante (&res, thesym, 0.F, 0, NULL, thechaine, l1, NULL, NULL, NULL);
  if (thesym == chargmsh)
     {
       if (OPTION)
	  {
	    flag.build = 0;
	    flag.bdy = 0;
	  }
       flag.fct = 1;
       flag.onbdy = 1;
       flag.solv = 1;
     }
  return res;
}

arbre 
instruction ()
{
  arbre           l1 = NULL, l2 = NULL, l3 = NULL, res = NULL;
  Symbol          thesym;
  ident          *theid = NULL;
  float           thecst;
  char           *thechaine;

  switch (cursym)
     {
     case si:
       nextsym ();
       flag.si = 1;		/* this forbids vectors in logical expression in if then else statements */
       l1 = expr ();
       flag.si = 0;
       match (alors);
       l2 = instruction ();
       if (cursym == autrement)
	  {
	    nextsym ();
	    l3 = instruction ();
	  }
       else
	 l3 = NULL;
       plante (&res, si, 0.F, 0, NULL, pt, l1, l2, l3, NULL);
       break;

     case loop:
       nextsym ();
       match (lpar);
       thecst = curcst;
       match (cste);
       match (rpar);
       l1 = instruction ();
       plante (&res, loop, thecst, 0, NULL, pt, l1, NULL, NULL, NULL);
       break;

     case newvar:
     case oldvar:
     case fdecl:
       theid = curident;
       nextsym ();
       if (cursym == fctdef)
	  {
  		if (strcmp(theid->name,"x")&&strcmp(theid->name,"y")) // moving the mesh
	    	theid->symb = fdecl;
	    if (!flag.fct)
	      match (becomes);
	    match (fctdef);
	    l1 = expr ();
	    plante (&res, fctdef, 0.F, 0, theid, pt, l1, NULL, NULL, NULL);
	  }
       else
	  {
	    if (theid->symb == fdecl)
	      theid->symb = oldvar;
	    match (becomes);
	    l1 = expr ();
	    plante (&res, becomes, 0.F, 0, theid, pt, l1, NULL, NULL, NULL);
	  }
       break;

     case fctfile:		/* when part of the program is stored (not documented) */
       res = fctfileproc ();
       break;

     case symb_bdy:
     case polygon:
       res = symb_bdyproc ();
       break;

     case symb_build:
       if (!flag.build)
	  {
	    sprintf (errbuf, "line %d: Illegal use of symbol 'buildmesh'", numligne);
	    erreur (errbuf);
	  }
       nba = 0;
       nbsd = 0;
       nbs = 0;
       nextsym ();
       match (lpar);
       l1 = expr ();
       if(cursym==comma) {nextsym(); l2 = expr();} else l2=NULL;
       plante (&res, symb_build, 0.F, 0, NULL, pt, l1, l2, NULL, NULL);
       match (rpar);
       flag.build = 0;
       flag.bdy = 0;
       flag.fct = 1;
       flag.onbdy = 1;
       flag.solv = 1;
       break;

     case chargmsh:
     case sauvmsh:
     case symb_exec:
       res = diskmshproc ();
       break;

     case charge:
       if (!flag.fct)
	  {
	    sprintf (errbuf, "Illegal use of symbol %s\n", mesg[cursym]);
	    erreur (errbuf);
	  }
       thesym = cursym;
       nextsym ();
       match (lpar);
       thechaine = curchaine;
       nextsym ();
       match (comma);
       theid = curident;
       switch (theid->symb)
	  {
	  case newvar:
	  case oldvar:
	    theid->symb = fdecl;
	    nextsym ();
	    break;

	  default:
	    match (fdecl);
	  }
       if (cursym == comma)
	 {
	   nextsym();
	   l1 = expr();
	 }
       match (rpar);
       plante (&res, thesym, 0.F, 0, theid, thechaine, l1, NULL, NULL, NULL);
       break;

     case sauve:
       if (!flag.fct)
	  {
	    sprintf (errbuf, "line %d: Unexpected symbol %s\n", numligne, mesg[cursym]);
	    erreur (errbuf);
	  }
       thesym = cursym;
       nextsym ();
       match (lpar);
       thechaine = curchaine;
       nextsym ();
       match (comma);
       if (cursym == oldvar)
	  {
	    thecst = 1.F;
	    ofstream        file (thechaine);

	    file << ' ' << endl;
	    file.close ();
	  }			// clean the file
       else
	 thecst = 0.F;
       l1 = expr ();
       if (cursym == comma)
	 {
	   nextsym();
	   l2 = expr();
	 }
       match (rpar);
       plante (&res, thesym, thecst, 0, NULL, thechaine, l1, l2, NULL, NULL);
       break;

     case trace:
     case trace3d:
       if (!flag.fct)
	  {
	    sprintf (errbuf, "line %d: Unexpected symbol %s\n", numligne, mesg[cursym]);
	    erreur (errbuf);
	  }
       thesym = cursym;
       nextsym ();
       match (lpar);
       l1 = expr ();
       plante (&res, thesym, 0.F, 0, NULL, pt, l1, NULL, NULL, NULL);
       match (rpar);
       break;

     case adaptmesh:
       {
         int i = 0;
       arbre li[4] = {NULL,NULL,NULL,NULL};
       nextsym ();
       match (lpar);
       li[i++] = expr ();
       while (cursym == comma)
         {
           nextsym();
           li[i] = expr();
           i++;
         }
       plante (&res, adaptmesh, 0.F, 0, NULL, pt, li[0], li[1], li[2], li[3]);
       match (rpar);
       }
       break;
       
     case symb_dch:
       if (flag.syst)
	 res = symb_dchproc ();
       else
	  {
	    sprintf (errbuf, "line %d: onbdy must be nested within solve(){...}\n", numligne);
	    erreur (errbuf);
	  }
       break;


     case symb_pde:
       res = symb_pdeproc ();
       break;

     case symb_solv:
     case sauvetout:
       thesym = cursym;
       if (flag.syst)
	 		erreur ("Embedded solvers are not allowed");
       flag.syst = 1;
       res = preparesolve ();
       l2 = instruction ();
       plante (&res, thesym, 0.F, N, NULL, NULL, res, l2, NULL, NULL);
       flag.syst = 0;
       N = 1;
       break;

     case varsolve:
     //case sauvetout:
       thesym = cursym;
       if (flag.syst)
	 		erreur ("Embedded solvers are not allowed");
       flag.syst = 1;
       res = prepvarsolve ();
       l2 = instruction ();
       match(colon);
       l3 = expr();
       plante (&res, colon, 0.F, N, NULL, NULL, res, l2, l3, NULL);
       flag.syst = 0;
       N = 1;
       break;

     case arret:
     case changewait:
     case wait_state:
     case nowait:
     case symb_complex:
     case symb_precise:
       plante (&res, cursym, 0.F, 0, NULL, pt, NULL, NULL, NULL, NULL);
       nextsym ();
       break;

     case lbrace:
       do
	  {
	    nextsym ();
	    l1 = instruction ();
	    if (res == NULL)
	      res = l1;
	    else if (l1)
	      plante (&res, lbrace, 0.F, 0, NULL, pt, res, l1, NULL, NULL);
	  }
       while (cursym == semicolon);
       match (rbrace);
       break;

     case semicolon:
       nextsym ();
     case rbrace:
     case _end:
       break;

     default:
       sprintf (errbuf, "line %d: Cannot use this symbol to begin an expression: %s",
		numligne, mesg[cursym]);
       erreur (errbuf);
     }
  return res;
}

void 
defbdy (arbre s)
{
  int             i, j, j0=0, j1=0; 
  float           gch, dte, dcr;
  static int      refl0 = 0,refl1,refs;
  static int      first=0;
  
  if (first==0) {
    first=1;
    for (i = 0;i < refbdy;i++)
      for (j = 0;j < refbdy;j++)
        tabref[i][j]  = 0;
  }
  
  gch = realpart (eval (s->l1));
  dte = realpart (eval (s->l2));
  dcr = realpart (eval (s->l3)) - 1;
  (variables.ng)->value = (int) (realpart (s->value));
  refl1 =  int(realpart ((variables.ng)->value));
  refs  = int(s->junk);
  if (refl0 != 0 && refs != 0)
    tabref[refl0][refs] = refl0;
  if (refl1 !=0 && refs != 0)
    tabref[refs][refl1] = refl1;
  for (i = 0; i <= dcr; i++)
     {
       (variables.t)->value = gch + i * (dte - gch) / dcr;
       eval (s->l4);
       cr[2 * nbs] = realpart ((variables.x)->value);
       cr[2 * nbs + 1] = realpart ((variables.y)->value);
       if (i == 0 && nbs == 0 && int(s->junk) > 0)
	 ngbdy[nbs] = int(s->junk);
       else
	 ngbdy[nbs] = (int) realpart ((variables.ng)->value);
       if (j1 = verifietr (cr, nbs), j1 == -1)
	 j1 = nbs++;
       else 
	 if (i!=0)
	   tabref[refl1][ngbdy[j1]]=refl1;
       if (i == 0 && j1 != -1 && nbs != 1 && int(s->junk) > 0)
	 ngbdy[j1] = int(s->junk);
       if (i != 0)
	  {
	    arete[2 * nba] = j0;
	    arete[2 * nba + 1] = j1;
	    nba++;
	    hh[j0] = 0.66F * (float)sqrt (pow (cr[2 * j1] - cr[2 * j0], 2) + pow (cr[2 * j1 + 1] - cr[2 * j0 + 1], 2));
	  }
       j0 = j1;
     }
  hh[j1] = hh[j0];
  sd[2 * nbsd] = nba - 1;
  sd[2 * nbsd + 1] = nbsd + 1;
  nbsd++;
  refl0 = refl1;
}

void 
defbdybypoint (arbre s)
{
  int  dte, i, j0=0, j1=0;
  int   ngb = (int) (realpart (s->value)); 
  float xl;
  float* cr1 = new float[2*MAXBDYVERTEX+1];
  float* cr2 = new float[2*MAXBDYVERTEX+1];
  int dcr=readpoints(s->path, cr1, MAXBDYVERTEX);
  if( dcr <=0 )       
  {
    if(dcr<0) 
      sprintf (errbuf, "Too many points in file %s ", s->path); 
    else 
      sprintf (errbuf, "Could not read points from file %s ", s->path); 
    erreur (errbuf);
  } 
  if(!(s->l1))
    dte = 0; 
  else
    dte = (int)(realpart (eval (s->l1)));
  dcr--;
  for(j1=0; j1<dcr;j1++)
  	for(j0=1;j0<=dte+1;j0++)
	{ 
		i=j0+ (dte+1)*j1;
		xl = 1.0F - (j0-1.0F)/(dte+1.0F);
		cr2[2*i-2] = cr1[2*j1]*xl + (1.0F-xl)*cr1[2*j1+2];
		cr2[2*i-1] = cr1[2*j1+1]*xl + (1.0F-xl)*cr1[2*j1+3];
	}
  cr2[2*i] = cr1[2*dcr]; cr2[2*i+1] = cr1[2*dcr+1];
  for (i = 0; i <= (1+dte)*dcr; i++)
     {
       (variables.ng)->value = ngb;
       cr[2 * nbs] = cr2[2*i];
       cr[2 * nbs + 1] = cr2[2*i + 1];
       ngbdy[nbs] = ngb;
       if (j1 = verifietr (cr, nbs), j1 == -1)  j1 = nbs++;
       if (i != 0)
	  {
	    arete[2 * nba] = j0;
	    arete[2 * nba + 1] = j1;
	    nba++;
	    hh[j0] = 0.66F * (float)sqrt ( (cr[2 * j1] - cr[2 * j0]) * (cr[2 * j1] - cr[2 * j0]) 
	    				+  (cr[2 * j1 + 1] - cr[2 * j0 + 1]) *  (cr[2 * j1 + 1] - cr[2 * j0 + 1]));
	  }
       j0 = j1;
     }
  hh[j1] = hh[j0];
  sd[2 * nbsd] = nba - 1;
  sd[2 * nbsd + 1] = nbsd + 1;
  nbsd++;
  delete [] cr1;
  delete [] cr2;
}

void 
initparam ()
{
  long            tnp = flag.precise ? 3 * (long) t.nt : (long) t.np;

  
  if (flag.param == 0)
    initFEM (&t, flag.precise);

  if (flag.complexe)
     {
       if ((N == 1) && ((flag.param == 0) || (flag.param == 2)))
	  {
	    param.p1c = new creal[tnp];
	    param.c1c = new creal[tnp];
	    param.g1c = new creal[tnp];
	    param.f1c = new creal[tnp];
	    param.b1c = new creal[tnp];
	    param.nuyx1c = new creal[tnp];
	    param.nuxx1c = new creal[tnp];
	    param.nuxy1c = new creal[tnp];
	    param.nuyy1c = new creal[tnp];
	    param.a11c = new creal[tnp];
	    param.a21c = new creal[tnp];
	    param.sol1c = new creal[tnp];
            if (param.fplot)
              {delete [] param.fplot;param.fplot = NULL;}
            param.fplot = new float[tnp];
            
	    for (int i = 0; i < tnp; i++)
	       {
		 param.p1c[i] = 0;
		 param.c1c[i] = 0;
		 param.g1c[i] = 0;
		 param.f1c[i] = 0;
		 param.b1c[i] = 0;
		 param.nuyx1c[i] = 0;
		 param.a11c[i] = 0;
		 param.a21c[i] = 0;
		 param.nuxx1c[i] = 0;
		 param.nuxy1c[i] = 0;
		 param.nuyy1c[i] = 0;
		 param.sol1c[i] = 0;
	       }
	    flag.param += N;
	  }
     }
  else if ((N == 1) && ((flag.param == 0) || (flag.param == 2)))
     {
       param.p1 = new float[tnp];
       param.c1 = new float[tnp];
       param.g1 = new float[tnp];
       param.f1 = new float[tnp];
       param.b1 = new float[tnp];
       param.nuyx1 = new float[tnp];
       param.nuxx1 = new float[tnp];
       param.nuxy1 = new float[tnp];
       param.nuyy1 = new float[tnp];
       param.a11 = new float[tnp];
       param.a21 = new float[tnp];
       param.sol1 = new float[tnp];
       if (param.fplot)
         delete [] param.fplot;
       param.fplot = new float[tnp];
       for (int i = 0; i < tnp; i++)
	  {
	    param.p1[i] = 0.F;
	    param.c1[i] = 0.F;
	    param.g1[i] = 0.F;
	    param.f1[i] = 0.F;
	    param.b1[i] = 0.F;
	    param.nuyx1[i] = 0.F;
	    param.a11[i] = 0.F;
	    param.a21[i] = 0.F;
	    param.nuxx1[i] = 0.F;
	    param.nuxy1[i] = 0.F;
	    param.nuyy1[i] = 0.F;
	    param.sol1[i] = 0.F;
	  }
       flag.param += N;
     }
  else if ((N == 2) && (flag.param < 2))
     {
       param.p2.init (tnp);	//= new cvect[tnp];//(cvect*)safecalloc(tnp,sizecvect);
       param.c2.init (tnp);	//= new cmat[tnp];//(cmat*)safecalloc(tnp,sizecmat);
       param.g2.init (tnp);	//=new cvect[tnp];//(cvect*)safecalloc(tnp,sizecvect);
       param.f2.init (tnp);	//=new cvect[tnp];//(cvect*)safecalloc(tnp,sizecvect);
       param.b2.init (tnp);	//=new cmat[tnp];//(cmat*)safecalloc(tnp,sizecmat);
       param.nuyx2.init (tnp);	//=new cmat[tnp];//(cmat*)safecalloc(tnp,sizecmat);
       param.nuxx2.init (tnp);	//=new cmat[tnp];//(cmat*)safecalloc(tnp,sizecmat);
       param.nuxy2.init (tnp);	//=new cmat[tnp];//(cmat*)safecalloc(tnp,sizecmat);
       param.nuyy2.init (tnp);	//=new cmat[tnp];//(cmat*)safecalloc(tnp,sizecmat);
       param.a12.init (tnp);	//=new cmat[tnp];//(cmat*)safecalloc(tnp,sizecmat);
       param.a22.init (tnp);	//=new cmat[tnp];//(cmat*)safecalloc(tnp,sizecmat);
       param.sol2.init (tnp);	//=new cvect[tnp];//(cvect*)safecalloc(tnp,sizecvect);
       if (param.fplot)
         delete [] param.fplot;
       param.fplot = new float[tnp];
       for (int i = 0; i < tnp; i++)
	  {
	    param.p2[i] = 0.F;
	    param.c2[i] = 0.F;
	    param.g2[i] = 0.F;
	    param.f2[i] = 0.F;
	    param.b2[i] = 0.F;
	    param.nuyx2[i] = 0.F;
	    param.a12[i] = 0.F;
	    param.a22[i] = 0.F;
	    param.nuxx2[i] = 0.F;
	    param.nuxy2[i] = 0.F;
	    param.nuyy2[i] = 0.F;
	    param.sol2[i] = 0.F;
          }
       flag.param += N;
     }
}

void 
build (arbre s)
{
  int  err, buildflag= s->l2 ? (int) realpart (eval (s->l2)) : 0;

  showbdy (nbs, cr, nba, arete, hh, waitm);
  
  if (err = (int)MakeTriangulation (&t, nbs, (long) realpart (eval (s->l1)), nba, cr, hh,
			       arete, ngbdy, sd, nbsd, &(flag.t), buildflag), err)
    if (err)
      switch (err)
	 {
	 case -1:
	   erreur ("Out of memory");
	 case 1:
	   erreur ("Too few or too many bdy points");
	 case 2:
	   erreur ("Two or more points are identical");
	 case 3:
	   erreur ("All points are aligned");
	 case 7:
	   erreur ("Can't identify bdy:  internal bug");
	 case 8:
	   erreur ("You gave an edge which is too long");
	 case 9:
	   erreur ("The bdy is shaped like a 8");
	 case 10:
	   erreur ("One given point is in a given edge");
	 case 11:
	   erreur ("One subdomain is not referenced");
	 case 20:
	   erreur ("3 points are identical (internal bug)");
	 case 21:
	   erreur ("mshptg stack is too small (internal bug)");
	 }
    else
      flag.t = 1;

  showtriangulation (waitm);

#if defined(XGFEM)
  SlaveSendMesh (t);
#endif /* XGFEM */
  if (flag.param)
    libereparam ();
  initparam ();
}

int 
setgeom (int cursloc, int iloc, int precise)
{
  int             iglob;

  if (precise)
     {
       cursom = 3 * cursloc + iloc;
       iglob = t.tr[cursloc][iloc];
       (variables.x)->value = 0.999 * t.rp[iglob].x + 0.001 * (t.rp[t.tr[cursloc][0]].x
		 + t.rp[t.tr[cursloc][1]].x + t.rp[t.tr[cursloc][2]].x) / 3;
       (variables.y)->value = 0.999 * t.rp[iglob].y + 0.001 * (t.rp[t.tr[cursloc][0]].y
		 + t.rp[t.tr[cursloc][1]].y + t.rp[t.tr[cursloc][2]].y) / 3;
       (variables.region)->value = t.ngt[cursloc];
     }
  else
     {
       iglob = cursom = cursloc;
       (variables.x)->value = t.rp[iglob].x;
       (variables.y)->value = t.rp[iglob].y;
       (variables.region)->value = getregion (&t, iglob);
     }
  (variables.cursom)->value = cursom;
  (variables.ng)->value = t.ng[iglob];
  (variables.nx)->value = normlx[cursom];
  (variables.ny)->value = normly[cursom];
  return iglob;
}

void 
maketable (arbre s)
{
  int             i,iloc, nloc = 1 + flag.precise * 2;
  int             nquad = flag.precise ? 3 * t.nt : t.np;
  //  rpoint         *curpoint = NULL;

  if (strcmp((s->name)->name,"x")==0)  //move triangulation
  	for(i=0;i<t.np;i++) 
  	{
  		setgeom (i, 0, flag.precise);
		t.rp[i].x = realpart(eval(s->l1));  
	}
  if (strcmp((s->name)->name,"y")==0)
  	for(i=0;i<t.np;i++) 
  	{
  		setgeom (i, 0, flag.precise);
		t.rp[i].y = realpart(eval(s->l1));  
	}
  
  if (!(s->name)->table)
    (s->name)->table = new creal [nquad];
  if(flag.solv>1) //local table with triangle nb in flag.solv-2
  for (iloc = 0; iloc < 3; iloc++)
		 {
			cursloc = t.tr[flag.solv-2][iloc];
			setgeom (cursloc, iloc, flag.precise);
	        ((s->name)->table)[cursloc] = eval (s->l1);
       }
  else{
	  nquad = flag.precise ? t.nt : t.np;
	  for (cursloc = 0; cursloc < nquad; cursloc++)
	    for (iloc = 0; iloc < nloc; iloc++)
			 {
				setgeom (cursloc, iloc, flag.precise);
		      ((s->name)->table)[cursom] = eval (s->l1);
	       }
       }
}


void
doconddch(int i, int cursloc,int iloc,int* ib,arbre s)
{
  int             thisbdy = 0, j;
  long            im = s->junk;
  creal           aux, aux2;
  float           aux1;
  int             iglob;

	 iglob = flag.precise ? t.tr[cursloc][iloc] : cursloc;
	 for (j = 0; j < i; j++)
	   thisbdy = thisbdy || (t.ng[iglob] == ib[j]);
	 if (thisbdy)
	    {
	      setgeom (cursloc, iloc, flag.precise);
	      aux = eval (s->l1);
	      aux1 = norm2 (aux);
	      aux2 = (1.F + sqrtofminus1) * penal;
	      aux = (aux1 == 0) ? aux2 : aux;
	      if (flag.complexe)
		 {
		   if (N == 1)
		     (param.p1c)[cursom] = aux;
		 }
	      else
		 {
		   if (N == 1)
		     (param.p1)[cursom] = realpart (aux);
		   else if (N == 2)
		     (param.p2)[cursom][im] = realpart (aux);
		 }
	    }
} 
       
void 
conddch (arbre s)
{
  long            ibv, ibb = (long) (realpart (s->value));
  int             ib[100];
  int             i=0, iloc, nloc = 1 + flag.precise * 2;
  int             nquad = flag.precise ? t.nt : t.np;

  while (ibb > 0)
     {
       ibv = ibb / 100;
       ib[i++] = ibb - ibv * 100;
       ibb = ibv;		// decodage

     }
  if(flag.solv>1) //local table with triangle nb in flag.solv-2
  for (iloc = 0; iloc < 3; iloc++)
		{
			cursloc = t.tr[flag.solv-2][iloc];
			doconddch(i,cursloc,iloc,ib,s);
		}
  else
  for (cursloc = 0; cursloc < nquad; cursloc++)
    for (iloc = 0; iloc < nloc; iloc++)
       doconddch(i,cursloc,iloc,ib,s);
}


void 
condfrr (arbre s)
{
  long            ibv, ibb = (long) (realpart (s->value));
  int             thesgn = 1, thisbdy, j, i = 0, ib[100];
  long            im = s->junk;
  int             iglob, iloc, nloc = 1 + flag.precise * 2;
  int             nquad = flag.precise ? t.nt : t.np;

  if (ibb < 0)
     {
       ibb = -ibb;
       thesgn = -1;
     }
  imdnu = im;			// used by l1 in opcondlim

  thesgndnu = thesgn;
  while (ibb > 0)
     {
       ibv = ibb / 100;
       ib[i++] = ibb - ibv * 100;
       ibb = ibv;		// decodage

     }
  if (s->l1)
    eval (s->l1);
  for (cursloc = 0; cursloc < nquad; cursloc++)
    for (iloc = 0; iloc < nloc; iloc++)
       {
	 iglob = flag.precise ? t.tr[cursloc][iloc] : cursloc;
	 thisbdy = 0;
	 for (j = 0; j < i; j++)
	   thisbdy = thisbdy || (t.ng[iglob] == ib[j]);
	 if (thisbdy)
	    {
	      setgeom (cursloc, iloc, flag.precise);
	      if (flag.complexe)
		 {
		   if (N == 1)
		     (param.g1c)[cursom] = (float)thesgn * eval (s->l2);
		 }
	      else
		 {
		   if (N == 1)
		     (param.g1)[cursom] = (float)thesgn * realpart (eval (s->l2));
		   if (N == 2)
		     (param.g2)[cursom][im] = (float)thesgn * realpart (eval (s->l2));
		 }
	    }
       }
}

void
edp (arbre s)
{
  long            im = s->junk;
  int             iloc, nloc = 1 + flag.precise * 2;
  int             nquad = flag.precise ? t.nt : t.np;

  eval (s->l1);
  for (cursloc = 0; cursloc < nquad; cursloc++)
    for (iloc = 0; iloc < nloc; iloc++)
       {	 setgeom (cursloc, iloc, flag.precise);
	 		if (flag.complexe)
		 	{	if (N == 1)
					(param.f1c)[cursom] = eval (s->l2);
		 	}else{
				if (N == 1)
					(param.f1)[cursom] = realpart (eval (s->l2));
				if (N == 2)
					(param.f2)[cursom][im] = realpart (eval (s->l2));
		 	}
		 }
}

void
varpde(arbre s)
{
  int   i,j,k, iloc, jloc;
  creal a[36], b[6]; //N<3
 
 initvarmat ( ihowsyst, flag.complexe, N, &param);
 for(k=0;k<t.np;k++)
 for(i=0;i<2*N;i++)
	  	systable[i]->table[k] = 0;
 for(k=0;k<t.nt;k++)
 {
  flag.solv = 2+k; //used by all global instructions
  for(jloc=0;jloc<3;jloc++)
  for(j=0; j<N; j++)
  	{ 
	  	systable[N+j]->table[t.tr[k][jloc]] = 1;
	  	eval(s->l2);
	  	b[3*j+jloc] = eval (s->l3);
	  if(ihowsyst>0)
	  for(iloc=0;iloc<3;iloc++)
	  for(i=0;i<N;i++)
	  	{ 
		  	systable[i]->table[t.tr[k][iloc]] = 1;
		  	eval(s->l2); 
		  	a[18*i+9*j+iloc*3+jloc] = eval (s->l3) - b[3*j+jloc];
		  	systable[i]->table[t.tr[k][iloc]] = 0;
		 }
		systable[N+j]->table[t.tr[k][jloc]] = 0;
	}
     assemble(ihowsyst,flag.complexe,N,k,a,b, &param);
  }
  flag.solv = 1;
  solvevarpde(N, &param, ihowsyst);
  for(k=0;k<t.np;k++)
  	if(N==1)
  		systable[0]->table[k] = param.sol1[k];
  	else 
  	for(i=0;i<N;i++)
  		systable[i]->table[k] = param.sol2[k][i];
}

void
solve (arbre s)
{
  int             i, k;
  int             nquad = flag.precise ? 3 * t.nt : t.np;
  float           err;

  eval (s->l1);
  eval (s->l2);
  if (s->symb == symb_solv)
     {
       err = solvePDE (&param, ihowsyst, flag.precise);
       if (fabs (err + 1) <= 1.0e-20)
	 erreur ("Wrong matrix number or singular matrix");
     }
  else if (s->symb == sauvetout)
    if (saveparam (&param, &t, saveallname, N))
      erreur ("Please check; disk is full or locked");
  for (cursloc = 0; cursloc < nquad; cursloc++)
    if (flag.complexe)
       {
	 if (N == 1)
	    {
	      (param.nuyx1c)[cursloc] = 0;	/* prepare them for next PDE */
	      (param.nuxx1c)[cursloc] = 0;
	      (param.nuxy1c)[cursloc] = 0;
	      (param.nuyy1c)[cursloc] = 0;
	      (param.a11c)[cursloc] = 0;
	      (param.a21c)[cursloc] = 0;
	      (param.b1c)[cursloc] = 0;
	      (param.c1c)[cursloc] = 0;
	      (param.f1c)[cursloc] = 0;
	      (param.p1c)[cursloc] = 0;
	      (param.g1c)[cursloc] = 0;
	      if (!flag.precise)
		systable[0]->table[cursloc] = param.sol1c[cursloc];
	      else
		 {
		   k = cursloc / 3;
		   i = cursloc - 3 * k;
		   systable[0]->table[cursloc] = param.sol1c[t.tr[k][i]];
		 }
	    }
	 else if (N == 2)
	    {
/*      (param.nuyx2)[cursloc] = 0;  
   (param.nuxx2)[cursloc] = 0;
   (param.nuxy2)[cursloc] = 0;
   (param.nuyy2)[cursloc] = 0;
   (param.a12)[cursloc] = 0;
   (param.a22)[cursloc] = 0;
   (param.b2)[cursloc] = 0;
   (param.c2)[cursloc] = 0;
   (param.f2)[cursloc] = 0;
   (param.p2)[cursloc] = 0;
   (param.g2)[cursloc] = 0;
   for(i=0;i<N;i++)
   systable[i]->table[cursloc] = param.sol2[cursloc][i];
 */ 
	    }
       }
    else
       {
	 if (N == 1)
	    {
	      (param.nuyx1)[cursloc] = 0.F;	/* prepare them for next PDE */
	      (param.nuxx1)[cursloc] = 0.F;
	      (param.nuxy1)[cursloc] = 0.F;
	      (param.nuyy1)[cursloc] = 0.F;
	      (param.a11)[cursloc] = 0.F;
	      (param.a21)[cursloc] = 0.F;
	      (param.b1)[cursloc] = 0.F;
	      (param.c1)[cursloc] = 0.F;
	      (param.f1)[cursloc] = 0.F;
	      (param.p1)[cursloc] = 0.F;
	      (param.g1)[cursloc] = 0.F;
	      if (!flag.precise)
		systable[0]->table[cursloc] = param.sol1[cursloc];
	      else
		 {
		   k = cursloc / 3;
		   i = cursloc - 3 * k;
		   systable[0]->table[cursloc] = param.sol1[t.tr[k][i]];
		 }
	    }
	 else if (N == 2)
	    {
	      (param.nuyx2)[cursloc] = 0.F;	/* prepare them for next PDE */
	      (param.nuxx2)[cursloc] = 0.F;
	      (param.nuxy2)[cursloc] = 0.F;
	      (param.nuyy2)[cursloc] = 0.F;
	      (param.a12)[cursloc] = 0.F;
	      (param.a22)[cursloc] = 0.F;
	      (param.b2)[cursloc] = 0.F;
	      (param.c2)[cursloc] = 0.F;
	      (param.f2)[cursloc] = 0.F;
	      (param.p2)[cursloc] = 0.F;
	      (param.g2)[cursloc] = 0.F;
	      for (i = 0; i < N; i++)
		if (!flag.precise)
		  systable[i]->table[cursloc] = param.sol2[cursloc][i];
		else
		   {
		     k = cursloc / 3;
		     systable[i]->table[cursloc] = param.sol2[t.tr[k][cursloc - 3 * k]][i];
		   }
	    }
       }
  N = 1;
  N2 = 1;
  flag.syst = 0;
}

void 
opcondlim (arbre s)
{
  long            jm = s->junk;
  long            im = imdnu;
  long            ibv, ibb = (long) (realpart (s->value));
  int             oper = 1, thisbdy, j, ib[100];
  int             i = 0, iglob, iloc, nloc = 1 + flag.precise * 2;
  int             nquad = flag.precise ? t.nt : t.np;

  if (ibb < 0)
     {
       oper = -1;
       ibb = -ibb;
     }
  if (s->l1 != NULL)
    eval (s->l1);
  while (ibb > 0)
     {
       ibv = ibb / 100;
       ib[i++] = ibb - ibv * 100;
       ibb = ibv;		// decodage

     }
  for (cursloc = 0; cursloc < nquad; cursloc++)
    for (iloc = 0; iloc < nloc; iloc++)
       {
	 iglob = flag.precise ? t.tr[cursloc][iloc] : cursloc;
	 thisbdy = 0;
	 for (j = 0; j < i; j++)
	   thisbdy = thisbdy || (t.ng[iglob] == ib[j]);
	 if (thisbdy)
	    {
	      setgeom (cursloc, iloc, flag.precise);
	      if (flag.complexe)
		 {
		   if (N == 1)
		     if (!s->path)
		       (param.c1c)[cursom] = (float)thesgndnu * oper * eval (s->l2);
		     else
		       (param.c1c)[cursom] = (float)thesgndnu * oper / eval (s->l2);
/*    if(N==2)
   if(!s->path) (param.c2)[cursloc](im,jm)= thesgndnu * oper * eval(s->l2);
   else     (param.c2)[cursloc](im,jm)= thesgndnu * oper / eval(s->l2);
 */ 
		 }
	      else
		 {
		   if (N == 1)
		     if (!s->path)
		       (param.c1)[cursom] = thesgndnu * oper * realpart (eval (s->l2));
		     else
		       (param.c1)[cursom] = thesgndnu * oper / realpart (eval (s->l2));
		   if (N == 2)
		     if (!s->path)
		       (param.c2)[cursom] (im, jm) = thesgndnu * oper * realpart (eval (s->l2));
		     else
		       (param.c2)[cursom] (im, jm) = thesgndnu * oper / realpart (eval (s->l2));
		 }
	    }
       }
}
void 
oppde (arbre s)
{
  Symbol          thesym = s->symb;
  //  rpoint         *curpoint = t.rp;
  int             im, jm, oper = (long) (realpart (s->value));
  long            ofset = s->junk;
  int             iloc, nloc = 1 + flag.precise * 2;
  int             nquad = flag.precise ? t.nt : t.np;

  im = ofset / 100;
  jm = ofset - 100 * im;
  if (oper > 0)
	 oper = 1;
  else
	 oper = -1;
  if (s->l1 != NULL)
	 eval (s->l1);
  for (cursloc = 0; cursloc < nquad; cursloc++)
	 for (iloc = 0; iloc < nloc; iloc++)
		 {
	 setgeom (cursloc, iloc, flag.precise);
	 if (flag.complexe)
	    {
	      if (N == 1)
		switch (thesym)
		   {
			case symb_lapl:
		     if (!s->path)
			{
			  (param.nuxx1c)[cursom] += -(float)oper * eval (s->l2);
			  (param.nuyy1c)[cursom] += -(float)oper * eval (s->l2);
			}
		     else
			{
			  (param.nuxx1c)[cursom] += -(float)oper / eval (s->l2);
			  (param.nuyy1c)[cursom] += -(float)oper / eval (s->l2);
			}
		     break;
		   case div_x:
		     if (!s->path)
		       (param.a11c)[cursom] += (float)oper * (eval (s->l2));
		     else
		       (param.a11c)[cursom] += (float)oper / (eval (s->l2));
		     break;
		   case div_y:
		     if (!s->path)
		       (param.a21c)[cursom] += (float)oper * (eval (s->l2));
		     else
		       (param.a21c)[cursom] += (float)oper / (eval (s->l2));
		     break;
		   case d_xx:
			  if (!s->path)
		       (param.nuxx1c)[cursom] += -(float)oper * (eval (s->l2));
		     else
		       (param.nuxx1c)[cursom] += -(float)oper / (eval (s->l2));
		     break;
		   case d_xy:
		     if (!s->path)
		       (param.nuxy1c)[cursom] += -(float)oper * (eval (s->l2));
		     else
		       (param.nuxy1c)[cursom] += -(float)oper / (eval (s->l2));
		     break;
		   case d_yx:
		     if (!s->path)
		       (param.nuyx1c)[cursom] += -(float)oper * (eval (s->l2));
		     else
		       (param.nuyx1c)[cursom] += -(float)oper / (eval (s->l2));
		     break;
		   case d_yy:
		     if (!s->path)
		       (param.nuyy1c)[cursom] += -(float)oper * (eval (s->l2));
		     else
		       (param.nuyy1c)[cursom] += -(float)oper / (eval (s->l2));
		     break;
		   case symb_id:
		     if (!s->path)
				 (param.b1c)[cursom] += (float)oper * eval (s->l2);
		     else
		       (param.b1c)[cursom] += (float)oper / eval (s->l2);
		     break;
		   default:
		     break;
		   }
/*  if(N==2)
   switch(thesym)
   {
   case symb_lapl:
   if(!s->path){
   (param.nuxx2)[cursloc](im,jm) += - oper * eval(s->l2);
   (param.nuyy2)[cursloc](im,jm) += - oper * eval(s->l2);
   }
   else    {
   (param.nuxx2)[cursloc](im,jm) += - oper / eval(s->l2);
   (param.nuyy2)[cursloc](im,jm) += - oper / eval(s->l2);
   }
   break;
   case div_x:
   if(!s->path) (param.a12)[cursloc](im,jm)+= oper * (eval(s->l2));
   else     (param.a12)[cursloc](im,jm)+= oper / (eval(s->l2));
   break;
   case div_y:
	if(!s->path) (param.a22)[cursloc](im,jm)+= oper *  (eval(s->l2));
   else     (param.a22)[cursloc](im,jm)+= oper /  (eval(s->l2)); 
   break;
   case d_xx:
   if(!s->path) (param.nuxx2)[cursloc](im,jm) += -oper *  (eval(s->l2)); 
   else     (param.nuxx2)[cursloc](im,jm) += -oper /  (eval(s->l2)); 
   break;
   case d_xy:
   if(!s->path) (param.nuxy2)[cursloc](im,jm)+= -oper *  (eval(s->l2)); 
   else     (param.nuxy2)[cursloc](im,jm)+= -oper /  (eval(s->l2)); 
   break;
   case d_yx:
   if(!s->path) (param.nuyx2)[cursloc](im,jm)+= -oper *  (eval(s->l2)); 
   else     (param.nuyx2)[cursloc](im,jm)+= -oper /  (eval(s->l2)); 
   break;
   case d_yy:
   if(!s->path) (param.nuyy2)[cursloc](im,jm) += -oper *  (eval(s->l2)); 
   else     (param.nuyy2)[cursloc](im,jm) += -oper /  (eval(s->l2)); 
   break;
   case symb_id:
   if(!s->path) (param.b2)[cursloc](im,jm)+= oper * eval(s->l2);
   else     (param.b2)[cursloc](im,jm)+= oper / eval(s->l2);
   break;
   }
 */ 
		 }
	 else
	    {
	      if (N == 1)
		switch (thesym)
		   {
		   case symb_lapl:
		     if (!s->path)
			{
			  (param.nuxx1)[cursom] += -(float)oper * realpart (eval (s->l2));
			  (param.nuyy1)[cursom] += -(float)oper * realpart (eval (s->l2));
			}
		     else
			{
			  (param.nuxx1)[cursom] += -(float)oper / realpart (eval (s->l2));
			  (param.nuyy1)[cursom] += -(float)oper / realpart (eval (s->l2));
			}
		     break;
		   case div_x:
		     if (!s->path)
		       (param.a11)[cursom] += (float)oper * (realpart (eval (s->l2)));
		     else
		       (param.a11)[cursom] += (float)oper / (realpart (eval (s->l2)));
		     break;
		   case div_y:
			  if (!s->path)
		       (param.a21)[cursom] += (float)oper * (realpart (eval (s->l2)));
		     else
		       (param.a21)[cursom] += (float)oper / (realpart (eval (s->l2)));
		     break;					  
		   case d_xx:
		     if (!s->path)
		       (param.nuxx1)[cursom] += -(float)oper * (realpart (eval (s->l2)));
		     else
		       (param.nuxx1)[cursom] += -(float)oper / (realpart (eval (s->l2)));
		     break;
		   case d_xy:
		     if (!s->path)
		       (param.nuxy1)[cursom] += -(float)oper * (realpart (eval (s->l2)));
		     else
		       (param.nuxy1)[cursom] += -(float)oper / (realpart (eval (s->l2)));
		     break;
		   case d_yx:
		     if (!s->path)
		       (param.nuyx1)[cursom] += -(float)oper * (realpart (eval (s->l2)));
		     else
		       (param.nuyx1)[cursom] += -(float)oper / (realpart (eval (s->l2)));
		     break;
		   case d_yy:
		     if (!s->path)
				 (param.nuyy1)[cursom] += -(float)oper * (realpart (eval (s->l2)));
		     else
		       (param.nuyy1)[cursom] += -(float)oper / (realpart (eval (s->l2)));
		     break;
		   case symb_id:
		     if (!s->path)
		       (param.b1)[cursom] += (float)oper * realpart (eval (s->l2));
		     else
		       (param.b1)[cursom] += (float)oper / realpart (eval (s->l2));
		     break;
		   default:
		     break;
		   }
	      if (N == 2)
		switch (thesym)
		   {
		   case symb_lapl:
		     if (!s->path)
			{
			  (param.nuxx2)[cursom] (im, jm) += -(float)oper * realpart (eval (s->l2));
			  (param.nuyy2)[cursom] (im, jm) += -(float)oper * realpart (eval (s->l2));
			}
		     else
			{
			  (param.nuxx2)[cursom] (im, jm) += -(float)oper / realpart (eval (s->l2));
			  (param.nuyy2)[cursom] (im, jm) += -(float)oper / realpart (eval (s->l2));
			}
		     break;
		   case div_x:
		     if (!s->path)
		       (param.a12)[cursom] (im, jm) += (float)oper * (realpart (eval (s->l2)));
		     else
		       (param.a12)[cursom] (im, jm) += (float)oper / (realpart (eval (s->l2)));
		     break;
		   case div_y:
		     if (!s->path)
		       (param.a22)[cursom] (im, jm) += (float)oper * (realpart (eval (s->l2)));
		     else
		       (param.a22)[cursom] (im, jm) += (float)oper / (realpart (eval (s->l2)));
		     break;
		   case d_xx:
		     if (!s->path)
		       (param.nuxx2)[cursom] (im, jm) += -(float)oper * (realpart (eval (s->l2)));
		     else
		       (param.nuxx2)[cursom] (im, jm) += -(float)oper / (realpart (eval (s->l2)));
		     break;
		   case d_xy:
		     if (!s->path)
		       (param.nuxy2)[cursom] (im, jm) += -(float)oper * (realpart (eval (s->l2)));
		     else
				 (param.nuxy2)[cursom] (im, jm) += -(float)oper / (realpart (eval (s->l2)));
			  break;
			case d_yx:
			  if (!s->path)
				 (param.nuyx2)[cursom] (im, jm) += -(float)oper * (realpart (eval (s->l2)));
			  else
				 (param.nuyx2)[cursom] (im, jm) += -(float)oper / (realpart (eval (s->l2)));
			  break;
			case d_yy:
			  if (!s->path)
				 (param.nuyy2)[cursom] (im, jm) += -(float)oper * (realpart (eval (s->l2)));
			  else
				 (param.nuyy2)[cursom] (im, jm) += -(float)oper / (realpart (eval (s->l2)));
			  break;
			case symb_id:
			  if (!s->path)
				 (param.b2)[cursom] (im, jm) += (float)oper * realpart (eval (s->l2));
			  else
				 (param.b2)[cursom] (im, jm) += (float)oper / realpart (eval (s->l2));
			  break;
			default:
		     break;
		   }
	    }
       }
}

void 
sauvefct (arbre s)
{
  creal          *f = NULL, *g = NULL;
  int             iglob, iloc, nloc = 1 + flag.precise * 2;
  int             nquad = flag.precise ? t.nt : t.np;

  //  rpoint         *curpoint = t.rp;

  char buffer[256];

  if (s->l2 != NULL)
    sprintf(buffer, "%s-%d", s->path, int(realpart(eval(s->l2))));
  else
    sprintf(buffer, "%s", s->path);

  if (realpart (s->value) > 0)
    saveconst (eval (s->l1), buffer);
  else
     {
       f = new creal[nquad*nloc];
       if (flag.precise)
	 g = new creal[t.np];
       for (cursloc = 0; cursloc < nquad; cursloc++)
	 for (iloc = 0; iloc < nloc; iloc++)
	    {
	      iglob = setgeom (cursloc, iloc, flag.precise);
	      f[cursom] = eval (s->l1);
	    }
       if (flag.precise)
	  {
	    for (cursloc = 0; cursloc < t.np; cursloc++)
	      g[cursloc] = P1ctoP1 (f, cursloc);
	    for (cursloc = 0; cursloc < t.np; cursloc++)
	      f[cursloc] = g[cursloc];
	  }
       if (savefct (f, t.np, buffer))
	  {
	    sprintf (errbuf, "Disk is full\n");
	    erreur (errbuf);
	  }
       delete [] f;f = NULL;
       if (flag.precise)
	 delete [] g;g =  NULL;
     }
}


void 
chargfct (arbre s)
{
  int             ret;
  char buffer[256];

  if (s->l1 != NULL)
    sprintf(buffer, "%s-%d", s->path, int(realpart(eval(s->l1))));
  else
    sprintf(buffer, "%s", s->path);
  (s->name)->table = new creal[t.np];
  switch (ret = loadfct ((s->name)->table, t.np, buffer), ret)
     {
     case 2:
       if (OPTION)
	  {
	    sprintf (errbuf, "Not enough memory\n");
	    erreur (errbuf);
	  }
       (variables.ne)->value = 1;
       break;

     case 0:
       //if (OPTION)
	  {
	    sprintf (errbuf, "Can't find file: %s",buffer," \n");
	    erreur (errbuf);
	  }
       (variables.ne)->value = 1;
       break;

     default:
       (variables.ne)->value = 0;
     }
}

void 
plot (arbre s)
{
  int             iglob, iloc, nloc = 1 + flag.precise * 2;
  int             nquad = (flag.precise ? t.nt : t.np);

#ifdef NOXGFEM
  /* record the name of the (new) function */
  FunctionRecord (nquad, &s->l1->name->name); 
#endif /* NOXGFEM */
  for (cursloc = 0; cursloc < nquad; cursloc++)
    for (iloc = 0; iloc < nloc; iloc++)
       {
         iglob = setgeom (cursloc, iloc, flag.precise);
         param.fplot[iglob] = realpart (eval (s->l1));
#ifdef NOXGFEM
         /* copy the value  of the current function the function array */
         FunctionCopyValue (iglob, param.fplot[iglob]); 
#endif /* NOXGFEM */
       }
#if defined(XGFEM)
  SlaveSendFunction(nquad, s->l1->name->name, param.fplot);
#endif /* XGFEM */

#ifdef  NOXGFEM
  /* update the function array */
  FunctionUpdate (); 
#endif /* NOXGFEM */
  
  // graphics for freeFEM
  equpot (t.ng, param.fplot, 20, waitm);
}


void 
plot3d (arbre s)
{
  int             iglob, iloc, nloc = 1 + flag.precise * 2;
  int             nquad = flag.precise ? t.nt : t.np;

#ifdef NOXGFEM
  /* record the name of the (new) function */
  FunctionRecord (nquad, &s->l1->name->name); 
#endif /* NOXGFEM */
  
  for (cursloc = 0; cursloc < nquad; cursloc++)
    for (iloc = 0; iloc < nloc; iloc++)
       {
         iglob = setgeom (cursloc, iloc, flag.precise);
         param.fplot[iglob] = realpart (eval (s->l1));
#ifdef NOXGFEM
         /* copy the value  of the current function the function array */
         FunctionCopyValue (iglob, realpart (eval (s->l1))); 
#endif /* NOXGFEM */
       }
#if defined(XGFEM)
  SlaveSendFunction(nquad, s->l1->name->name, param.fplot);
#endif /* XGFEM */

#ifdef  NOXGFEM
   /* update the function array */
  FunctionUpdate (); 
#endif /* not NOXGFEM */

  // graphics for FreeFEM
  graph3d (param.fplot, waitm);
}

void 
chartrig (arbre s)
{
  char buffer[256];
  if (s->l1 != NULL)
    sprintf(buffer, "%s-%d", s->path, int(realpart(eval(s->l1))));
  else
    sprintf(buffer, "%s", s->path);
  switch (loadtriangulation (&t, buffer))
     {
     case 1:
       if (OPTION)
	  {
	    sprintf (errbuf, "This file does not exist\n");
	    erreur (errbuf);
	  }
       (variables.ne)->value = 1;
       break;

     case 2:
       sprintf (errbuf, "Not enough memory\n");
       erreur (errbuf);
       break;

     default:
       (variables.ne)->value = 0;
       
       showtriangulation (waitm);
#if defined(XGFEM)
       SlaveSendMesh (t);
#endif /* XGFEM */
     }
  if (flag.param)
    libereparam ();
  initparam ();
}


void 
sauvtrig (arbre s)
{
  char buffer[256];
  if (s->l1 != NULL)
    sprintf(buffer, "%s-%d", s->path, int(realpart(eval(s->l1))));
  else
    sprintf(buffer, "%s", s->path);
  if (savetriangulation (&t, buffer))
     {
       sprintf (errbuf, "Not enough disk space\n");
       erreur (errbuf);
     }
}

/*
 * adapt : adaptation routine
 *  - l1,l2... : functions which are used to adapt the mesh
 *
 * note : these functions must be concatened in one array
 *
 * aniso : anisotropic mesh (0 or 1)
 * c0 : error tolerance
 * lmin,lmax : min-max edge length
 * refwall, hwall : reference on the wall + h on the wall
 * Fluid_NS : Navier-Stokes equations (strong imposition)
 *********** Advanced parameters
 * nit = numbre of iterations during the adaptation process
 * securite : save mesh after each loop (0 or 1)
 * sol_interp : name of the file which contains the interpolated functions
 * angulo :angle
 * reg_ini : initial regularisation = swapping
 * reg_fin : final regularisation = filtre
 * rel_mtr : metric relaxation
 *
 */
void
adapt (arbre tree)
{
#if defined(ADAPT)
  Scalar *solution, *func, *interp_func;
  Scalar **sol_interp ;

  Mallado_T0* malla;
  Triangulation* t_fin,*t_cad;
  CAD *cad;
  int s,i,j,k,nsol,nfunc;
  double *tiempo,axmin,axmax,aymin,aymax,length;
  int err;
  float h1,hmin = 1.0e10,hmax = 0.0;

  arbre l1 = tree->l1,l2 = tree->l2,l3 = tree->l3,l4 = tree->l4;
  int iglob;

  /* declaration of external functions */
  extern Scalar* read_param(Triangulation*,Triangulation*,parameter&);
  extern int lecmtr (Metrica*,char*,Scalar,int);
  extern void cal_metrica(Mallado_T0*, Scalar*, Metrica*,Boolean,Scalar,Scalar,
                   Scalar,int,int,Scalar,Scalar,int);
  extern void escmtr2D(char*,Metrica*,int,Scalar);
  extern void escsol(int,int,char*,Scalar*);
  Triangulation*
    regenera_malla(Mallado_T0*,Scalar*,char*,int,int,char*,int,int,Boolean,double*,Boolean,Boolean, Boolean,Boolean,Scalar,int,CAD*,int,Scalar**, Scalar *, int, Scalar**);
  
  extern void the_clock(double *);
  
  

#if DEBUG
  cerr << "adaptation process called" << endl;
#endif

  nsol = 4;
  if (l1 == NULL) // must have at least one function : error
    return;
  else if (l2 == NULL) 
    nsol = 1;
  else if (l3 == NULL) 
    nsol = 2;
  else if (l4 == NULL) 
    nsol = 3;

#if DEBUG
  cerr << " nsol = " << nsol << endl;
#endif /* DEBUG */

  /*
   * Default values for 
   * the parameters
   */
 
  adapt_param.sol=1;
  adapt_param.nsol=nsol;
  strcpy(adapt_param.timesh,"output");
  strcpy(adapt_param.timtr,"metric.mtr");
  strcpy(adapt_param.sol_interp,"sol_fin");

  adapt_param.nbt_max= Mini(4*t.nt,5000);

#if XGFEM
  adapt_param.nbt_max= Mini(4*t.nt,9000);
#endif /* XGFEM */

  axmin = 1.0e30;
  axmax = 0.0;
  aymin = 1.0e30;
  aymax = 0.0;
  for(k=0;k<t.nt;k++) 
    for(j=0;j<3;j++) 
      {
        int j1 = j==2 ? 0: j+1;
        h1 = sqr(t.rp[t.tr[k][j]].x - t.rp[t.tr[k][j1]].x) +
          sqr(t.rp[t.tr[k][j]].y - t.rp[t.tr[k][j1]].y); 	
        if(h1> hmax) hmax=h1;
        if(h1<hmin) hmin = h1;
	axmin = Mini(axmin,t.rp[t.tr[k][j]].x);
	axmax = Maxi(axmax,t.rp[t.tr[k][j]].x);
	aymin = Mini(aymin,t.rp[t.tr[k][j]].y);
	aymax = Maxi(aymax,t.rp[t.tr[k][j]].y);
      }
  hmin=Maxi(1e-5,sqrt(hmin));
  length = Maxi(axmax-axmin,aymax-aymin);
  adapt_param.lmax= Mini(sqrt(hmax)*3,length);
  //adapt_param.lmax= Mini(adapt_param.lmax,0.02);
  adapt_param.lmin= 0.25*sqrt(hmin);
  if (adapt_param.lmax/adapt_param.lmin>1e+4) 
    adapt_param.lmax=1e+4*adapt_param.lmin;
  
#ifndef NOXGFEM
  adapt_param.tinterp=1;
  adapt_param.err0=0.01;
  adapt_param.aniso=1;
  adapt_param.hwall=0.0;
  adapt_param.refwall=3;
  adapt_param.angulo=10;
  adapt_param.nit=0;
  adapt_param.segur=0;
  adapt_param.reg_ini=1;
  adapt_param.reg_fin=1;
  adapt_param.rel_mtr=0;
  adapt_param.fluid_NS=0;
#endif /* not NOXGFEM */
  
#ifdef DEBUG
  cout<<adapt_param<<endl;
#endif /* DEBUG */
#if DEBUG
  cerr << "creating the solution" << endl;
#endif /* DEBUG */
  solution = new Scalar[nsol*t.np];
  for (s = 1;s <= nsol;s++)
    if (s == 1)
      for(i = 0;i < t.np;i++)
	{
	  iglob = setgeom (i, 1, flag.precise);
	  solution[nsol*iglob] = realpart (eval(l1));
	}
    else if (s == 2)
      for(i = 0;i < t.np;i++)
	{
	  iglob = setgeom (i, 1, flag.precise);
	  solution[nsol*iglob+1] = realpart (eval(l2));
	}
    else if (s == 3)
      for(i = 0;i < t.np;i++)
	{
	  iglob = setgeom (i, 1, flag.precise);
	  solution[nsol*iglob+2] = realpart (eval(l3));
	}
    else if (s == 4)
      for(i = 0;i < t.np;i++)
	{
	  iglob = setgeom (i, 1, flag.precise);
	  solution[nsol*iglob+3] = realpart (eval(l4));
	}
#if DEBUG
  cerr << "Done" << endl;
#endif /* DEBUG */
  
#if DEBUG
  ofstream fsol("sol.bb");
  fsol << 3 << " " << nsol << " " << t.np << " " << 2 << endl;
  for (i = 0;i < t.np;i++)
    {
      fsol << solution[nsol*i] << " ";
      if (nsol == 2)
	fsol << solution[nsol*i+1] << " ";
      if (nsol == 3)
	fsol << solution[nsol*i+2] << " ";
      if (nsol == 4)
	fsol << solution[nsol*i+3];
      fsol << endl;
    }
  fsol.close ();
#endif /* DEBUG */


/*
 *   ********************************************************
 *                         ADAPT2D
 *   ********************************************************
*/
  malla=new Mallado_T0;
  t_cad=new Triangulation;
  sol_interp=new Scalar*;
  if (sol_interp==NIL) ERROR();
  if (malla==NIL || t_cad==NIL) ERROR();
  /*
   *       ATTENTION, IMPOSING NGT[I]=0
   */
#if DEBUG
  cout<<"===================================================="<<endl;
  cout<<"                 IMPOSING NGT[I]=0"<<endl;
  cout<<"===================================================="<<endl;
#endif /* DEBUG */
  for (i=0;i<t.nt; i++) {t.ngt[i]=0;};

  t_cad->build(t.np,t.nt,t.rp,t.ng,t.tr,t.ngt);
  malla->build(int(t.np),int(t.nt),t.rp,t.ng,t.tr,t.ngt);
  adapt_param.change(malla->factr());


/*
 *       Metric generation from the solution using
 *                metrics intersection.
 *
 *     Also a boundary correction can be imposed when
 *              solving NS equations.
 * 
 *             Metric = |Hess solution|     
 * 
 */

  tiempo=new double;
  *tiempo = 0.0;
  if (tiempo==NIL) ERROR();
  the_clock(tiempo);
#ifdef DEBUG
  cout<<"================================================="<<endl;
  cout<<"               METRIC COMPUTATION"<<endl;
  cout<<"================================================="<<endl;
#endif 
  if (adapt_param.sol==1) {
    cal_metrica(malla,solution,malla->m,adapt_param.aniso,adapt_param.err0,adapt_param.lmax,adapt_param.lmin,adapt_param.nsol,adapt_param.refwall,adapt_param.hwall,malla->factr(),adapt_param.nbt_max);
#ifdef DEBUG_FILE
    escmtr2D(adapt_param.timtr,malla->m,malla->nbss(),malla->factr());
#endif /* DEBUG_FILE */
  }
  else {
    err=lecmtr(malla->m,adapt_param.timtr,malla->factr(),malla->nbss());
  }
#ifdef DEBUG
  the_clock(tiempo);
  cout<<"--------------------------------------------------------"<<endl;
  cout<<"Metric computation time :"<<*tiempo<<endl;
  cout<<"--------------------------------------------------------"<<endl;
#endif /* DEBUG */

  // CAD definition from t.
#if DEBUG
  cerr << "adapt angulo:" << adapt_param.angulo  << endl
       << "factor: " << malla->factr() << endl;
#endif /* DEBUG */  
  cad=build(t_cad,adapt_param.angulo,malla->factr());
  delete t_cad;
  /*
   * build the array of functions to be interpolated over the new mesh
   */
  nfunc = 0;
  for (i = 0; i < numidents; i++)
     {
       if (idents[i].symb == fdecl && idents[i].table != NULL)
         nfunc++;
     }
  if (nfunc > 0)
    {
      func = new Scalar[nfunc*t.np];
      for (i = 0,k = 0;i < numidents && k < nfunc;i++)
        {
          if (idents[i].symb == fdecl)
            {
              for (j = 0;j < t.np;j++)
                func[nfunc*j+k] = idents[i].table[j].real();
              k++;
            }
        }
    }

#ifdef DEBUG
  cout<<"================================================="<<endl;
  cout<<"                MESH ADAPTATION"<<endl;
  cout<<"================================================="<<endl;
#endif /* DEBUG */
  t_fin=regenera_malla(malla,solution,adapt_param.timesh,adapt_param.sol,adapt_param.nsol,adapt_param.sol_interp,adapt_param.angulo,adapt_param.nit,adapt_param.segur,tiempo,adapt_param.reg_ini,adapt_param.reg_fin,adapt_param.rel_mtr,adapt_param.fluid_NS,adapt_param.hwall,adapt_param.refwall,cad,adapt_param.tinterp,sol_interp, func, nfunc, &interp_func);
  
  the_clock(tiempo);
#ifdef DEBUG
  cout<<"------------------------------------------------------------"<<endl;
  cout<<"Global time: Metric computation+mesh adaptation:"<<*tiempo<<endl;
  cout<<"------------------------------------------------------------"<<endl;
#endif /* DEBUG */
  delete tiempo;

#ifdef DEBUG
  cout<<"============================================================="<<endl;
  cout<<"              TRIANGULATION ACTUALIZATION"<<endl;
  cout<<"============================================================="<<endl;
#endif /* DEBUG */
  t.np=t_fin->np;
  t.nt=t_fin->nt;
  delete[] t.rp;
  delete[] t.tr;
  delete[] t.ng;
  delete[] t.ngt;
  t.rp=new rpoint[int(t.np)];
  t.tr=new triangle[int(t.nt)];
  t.ng=new int[int(t.np)];
  t.ngt=new int[int(t.nt)];

  for (i = 0; i<t.np; i++) 
    {
      t.rp[i].x=t_fin->rp[i].x;
      t.rp[i].y=t_fin->rp[i].y;
      t.ng[i]=t_fin->ng[i];
    }
  for (i=0; i<t.nt; i++) 
    {
      t.ngt[i]=t_fin->ngt[i];
      for (j=0; j<3; j++) 
	t.tr[i][j]=t_fin->tr[i][j];
    }
  removeBdyT (&t);

#if DEBUG
  cerr << "Done" << endl;
#endif /* DEBUG */

   /*
    * reintialize arrays before continuing evaluating the tree
    */ 
  reinitialize ();

  /*
   * Update the table of functions
   */
#if DEBUG
  cerr << "Updating the table of functions:" << t.np << endl;
#endif /* DEBUG */
  if (nfunc > 0)
    {
      delete[] func;
      for (i = 0,k = 0;i < numidents && k < nfunc;i++)
        {
          if (idents[i].symb == fdecl)
            {
	      if (idents[i].table != NULL)
		delete[] idents[i].table;
              idents[i].table = new creal[t.np];
              for (j = 0;j < t.np;j++)
                idents[i].table[j] = interp_func[nfunc*j+k];
              k++;
            }
        }
      delete [] interp_func;
    }
#if DEBUG
  cerr << "Done update function table" << endl;
#endif /* DEBUG */
  
  delete t_fin;
  delete [] solution;
  delete malla;
  delete sol_interp;
  delete cad;
  
#if DEBUG
  cerr << "Done adaptation" << endl;
#endif /* DEBUG */
  
#endif /* ADAPT */
  showtriangulation (waitm);
#if defined(XGFEM)
  SlaveSendMesh (t);
#endif /* XGFEM */
}


creal 
eval (arbre s)
{
  static creal    temp = 0.F;
  int k;
  creal* tableaddr;
  
  if (s == NULL)
    return 0.F;
  switch (s->symb)
     {
     case adaptmesh:
       adapt (s); /* call adaptation routine */
       break;
       
     case polygon:
       defbdybypoint (s);
       break;
       
     case symb_bdy:
       defbdy (s);
       break;

     case symb_build:
       build (s);
       break;

     case symb_dch:
       conddch (s);
       break;

     case symb_frr:
       condfrr (s);
       break;

     case sauvmsh:
       sauvtrig (s);
       break;

     case chargmsh:
       chartrig (s);
       break;

     case symb_exec:
       execute (s->path);
       break;

     case varsolve:  //from prepvarsolve
       eval (s->l1);
       if (s->l3)
         ihowsyst = (int) (realpart (eval (s->l3)));
       else
         ihowsyst = 1;
       saveallname = s->path;
       if (s->junk <= 0)
         {
           if (!((s->name)->table))
           {  if (flag.precise)
              { (s->name)->table = new creal[3*t.nt];
                for( k =0; k<3*t.nt;k++)  (s->name)->table[k] = 0;
              }
             else
             {  (s->name)->table = new creal[t.np];
                for( k =0; k<t.np;k++)  (s->name)->table[k] = 0;
             }
            }
           systable[-1 - (s->junk) ] = s->name;
         }
       else
         {
           N = s->junk;
           N2 = N * N;
           if ((flag.complexe) && (N > 1))
             erreur (" Complex system not implemented");
           flag.syst = 1;
           initparam ();
		  }
       break;
     
     case colon:
       eval (s->l1);
       varpde(s);
       break;

     case symb_system:
       eval (s->l1);
       if (s->l3)
         ihowsyst = (int) (realpart (eval (s->l3)));
       else
         ihowsyst = 1;
       saveallname = s->path;
       if (s->junk <= 0)
         {
           if (!((s->name)->table))
             if (flag.precise)
               (s->name)->table = new creal[3*t.nt];
             else
               (s->name)->table = new creal[t.np];
           systable[-1 - (s->junk)] = s->name;
         }
       else
         {
           N = s->junk;
           N2 = N * N;
           flag.syst = 1;
           if ((flag.complexe) && (N > 1))
             erreur (" Complex system not implemented");
           initparam ();
         }
       break;

     case symb_pde:
       edp (s);
       break;

     case symb_solv:
     case sauvetout:
       solve (s);
       break;

     case id_bdy:
       opcondlim (s);
       break;

     case symb_lapl:
     case d_xx:
     case d_xy:
     case d_yx:
     case d_yy:
     case div_x:
     case div_y:
     case symb_id:
       oppde (s);
       break;

     case bint:
       if(s->name) tableaddr = s->name->table; else tableaddr = NULL;
       if (s->l2 == NULL)
         return binteg((int)realpart(eval(s->l1)),
                       0,
                       0,
                       s->l4->name->table,
                       tableaddr,
                       flag.precise,flag.solv);
       else if (s->l3 == NULL)
         return binteg((int)realpart(eval(s->l1)),
                       (int)realpart(eval(s->l2)),
                       0,
                       s->l4->name->table,
                       tableaddr,
                       flag.precise,flag.solv);
       else
         return binteg((int)realpart(eval(s->l1)),
                       (int)realpart(eval(s->l2)),
                       (int)realpart(eval(s->l3)),
                       s->l4->name->table,
                       tableaddr,
                       flag.precise,flag.solv);
       break;
     case gint:
       if(s->name) tableaddr = s->name->table; else tableaddr = NULL;
       if (s->l1 == NULL)
         return ginteg(0,
                       0,
                       0,
                       s->l4->name->table,
                       tableaddr,
                       flag.precise,flag.solv);
       else if (s->l2 == NULL)
         return ginteg((int)realpart(eval(s->l1)),
                       0,
                       0,
                       s->l4->name->table,
                       tableaddr,
                       flag.precise,flag.solv);
       else if (s->l3 == NULL)
         return ginteg((int)realpart(eval(s->l1)),
                       (int)realpart(eval(s->l2)),
                       0,
                       s->l4->name->table,
                       tableaddr,
                       flag.precise,flag.solv);
       else
         return ginteg((int)realpart(eval(s->l1)),
                       (int)realpart(eval(s->l2)),
                       (int)realpart(eval(s->l3)),
                       s->l4->name->table,
                       tableaddr,
                       flag.precise,flag.solv);
       break;
     case partial_x:
       return deriv (0, s->l1->name->table,flag.solv, (int) realpart ((variables.cursom)->value), flag.precise);

	  case partial_y:
		 return deriv (1, s->l1->name->table, flag.solv, (int) realpart ((variables.cursom)->value), flag.precise);

	  case symb_user:
		 return gfemuser (eval (s->l2), s->l1->name->table, (int) realpart ((variables.cursom)->value));

	  case evalfct:
		 return fctval (s->name->table, realpart (eval (s->l1)), realpart (eval (s->l2)), flag.precise);

	  case prodscal:
		 return prodscalar (s->l1->name->table, s->l2->name->table, flag.precise);

	  case symb_convect:
		 return convect (s->l1->name->table,
				 s->l2->name->table, s->l3->name->table,
	 realpart (eval (s->l4)), (int) realpart ((variables.cursom)->value)
		       ,flag.precise);

	  case rhsconvect:
		 return rhsConvect (s->l1->name->table,
			  s->l2->name->table, s->l3->name->table,
	 realpart (eval (s->l4)), (int) realpart ((variables.cursom)->value)
			  ,flag.precise);

	  case fctdef:
		 maketable (s);
		 break;

     case sauve:
       sauvefct (s);
       break;

     case charge:
       chargfct (s);
       break;

     case trace:
       plot (s);
       break;

     case trace3d:
       plot3d (s);
       break;

     case fdecl:
       return (s->name)->table[cursom];

     case cste:
       return s->value;

     case becomes:
       (s->name)->value = eval (s->l1);

     case newvar:
     case oldvar:
       return (s->name)->value;

     case fctfile:
       (variables.ne)->value = s->value;
       if (!realpart (s->value))
	 return eval (s->l1);
       break;

     case plus:
       return eval (s->l1) + eval (s->l2);

     case minus:
       if (s->l1 == NULL)
	 return -eval (s->l2);
       else
	 return eval (s->l1) - eval (s->l2);

     case star:
       return eval (s->l1) * eval (s->l2);

     case slash:
       return eval (s->l1) / eval (s->l2);
       
     case modulo:
       return int(realpart(eval(s->l1))) % int(realpart(eval (s->l2)));
       
     case lt:
       return (float)(realpart (eval (s->l1) - eval (s->l2)) < 0.F);

     case le:
       return (float)(realpart (eval (s->l1) - eval (s->l2)) <= 0.F);

     case gt:
       return (float)(realpart (eval (s->l1) - eval (s->l2)) > 0.F);

     case ge:
       return (float)(realpart (eval (s->l1) - eval (s->l2)) >= 0.F);

     case eq:
       return (float)(realpart (eval (s->l1) - eval (s->l2)) == 0.F);

     case neq:
       return (float)(realpart (eval (s->l1) - eval (s->l2)) != 0.F);

     case et:
       return (float)(realpart (eval (s->l1)) && realpart (eval (s->l2)));

     case ou:
       return (float)(realpart (eval (s->l1)) || realpart (eval (s->l2)));

     case sine:
       return (float)sin (eval (s->l1));

     case one:
       return fabs (realpart (eval (s->l1))) < (float)1.e-6 ? 0.F : 1.F;

     case cosine:
       return (float)cos (eval (s->l1));

     case atane:
       return (float)atan (realpart (eval (s->l1)));

     case exponential:
       return (float)exp (realpart (eval (s->l1)));

     case expo:
       return pow (eval (s->l1), realpart(eval (s->l2)));
       //return (float)pow (realpart (eval (s->l1)), realpart (eval (s->l2)));

     case logarithm:
       return (float)log (realpart (eval (s->l1)));

     case mini:
       return Mini (realpart (eval (s->l1)), realpart (eval (s->l2)));

     case maxi:
       return Maxi (realpart (eval (s->l1)), realpart (eval (s->l2)));

     case absolute:
       return (float)fabs (realpart (eval (s->l1)));


     case root:
       return (float)sqrt (realpart (eval (s->l1)));

     case acose:
       return (float)acos (realpart (eval (s->l1)));

     case asine:
       return (float)asin (realpart (eval (s->l1)));

     case tane:
       return (float)tan (realpart (eval (s->l1)));

     case coshe:
       return (float)cosh (realpart (eval (s->l1)));

     case sinhe:
       return (float)sinh (realpart (eval (s->l1)));

     case tanhe:
       return (float)tanh (realpart (eval (s->l1)));

     case partreal:
       return realpart (eval (s->l1));

     case partimag:
       return imagpart (eval (s->l1));

     case penall:
        if((int)realpart (eval (s->l1))==(int) realpart ((variables.ng)->value))
        	 return 1.F/penal;
        else return 0.F;

     case si:
       if (s->l3 == NULL)
	 return realpart (eval (s->l1)) ? eval (s->l2) : temp;
       else
	 return realpart (eval (s->l1)) ? eval (s->l2) : eval (s->l3);

     case loop:
       {
         int             i;
         NumOfIterations = (int)realpart (s->value); // for xgfem
         for (i = 1; i <= realpart (s->value); i++)
	   {
	     Iter = i;
	     eval (s->l1);
	   }
       }
       break;

     case lbrace:
       eval (s->l1);
       return eval (s->l2);

     case arret:
       closegraphique ();
       sprintf (errbuf, " interpretor stopped");
       erreur (errbuf);
       break;
     case changewait:
       waitm = !waitm;
       break;
     case wait_state:
       waitm = 1;
       break;
     case nowait:
       waitm = 0;
       break;
     case symb_complex:
	 	flag.complexe = 1;
        if (flag.param)
	  	{
	    	libereparam ();
	    	initparam ();
	  	}
       break;
     case symb_precise:
       flag.precise = 1;
       if (flag.param)
	  {
	    libereparam ();
	    initparam ();
	  }
       break;

     default:
       sprintf (errbuf, "illegal symbol met in function eval: %s", mesg[s->symb]);
       erreur (errbuf);
     }
  return 0.F;			/* pour eviter un warning idiot... */
}


void 
bucheron (arbre s)
{
  if (s->path != NULL)
    delete [] s->path;
  if (s->l1)
    bucheron (s->l1);
  if (s->l2)
    bucheron (s->l2);
  if (s->l3)
    bucheron (s->l3);
  if (s->l4)
    bucheron (s->l4);
  delete s;
  s = NULL;
}


void 
libereparam ()		/* use after bucheron */
{
  param.p2.destroy ();
  param.c2.destroy ();
  param.g2.destroy ();
  param.f2.destroy ();
  param.b2.destroy ();
  param.nuyx2.destroy ();
  param.nuxx2.destroy ();
  param.nuxy2.destroy ();
  param.nuyy2.destroy ();
  param.a12.destroy ();
  param.a22.destroy ();
  param.sol2.destroy ();
  
  if (param.fplot)
    {delete [] param.fplot;param.fplot = NULL;}
  if (param.p1)
    {delete [] param.p1;param.p1 = NULL;}
  if (param.c1)
    {delete [] param.c1;param.c1 = NULL;}
  if (param.g1)
    {delete [] param.g1;param.g1 = NULL;}
  if (param.f1)
    {delete [] param.f1;param.f1 = NULL;}
  if (param.b1)
    {delete [] param.b1;param.b1 = NULL;}
  if (param.nuyx1)
    {delete [] param.nuyx1;param.nuyx1 = NULL;}
  if (param.nuxx1)
    {delete []param.nuxx1;param.nuxx1 = NULL;}
  if (param.nuxy1)
    {delete [] param.nuxy1;param.nuxy1 = NULL;}
  if (param.nuyy1)
    {delete [] param.nuyy1;param.nuyy1 = NULL;}
  if (param.a11)
    {delete [] param.a11;param.a11 = NULL;}
  if (param.a21)
    {delete [] param.a21;param.a21 = NULL;}
  if (param.sol1)
    {delete [] param.sol1;param.sol1 = NULL;}
  if (param.p1c)
    {delete [] param.p1c;param.p1c = NULL;}
  if (param.c1c)
    {delete []param.c1c;param.c1c = NULL;}
  if (param.g1c)
    {delete []param.g1c;param.g1c = NULL;}
  if (param.f1c)
    {delete []param.f1c;param.f1c = NULL;}
  if (param.b1c)
    {delete []param.b1c;param.b1c= NULL;}
  if (param.nuyx1c)
    {delete []param.nuyx1c;param.nuyx1c = NULL;}
  if (param.nuxy1c)
    {delete []param.nuxx1c;param.nuxx1c = NULL;}
  if (param.p1)
    {delete []param.nuxy1c;param.nuxy1c=  NULL;}
  if (param.nuyy1c)
    {delete []param.nuyy1c;param.nuyy1c = NULL;}
  if (param.a11c)
    {delete []param.a11c; param.a11c = NULL;}
  if (param.a21c)
    {delete []param.a21c;param.a21c = NULL;}
  if (param.sol1c)
    {delete []param.sol1c;param.sol1c = NULL;}
  
  libereFEM ();
  flag.param = 0;
}

void 
reinitialize ()
{
  delete []arete;arete = NULL;
  delete []hh;hh = NULL;
  delete []cr;cr = NULL;
  delete []ngbdy;ngbdy = NULL;
  delete []noeuds;noeuds = NULL;
  delete []sd;sd= NULL;
  
  delete []thestring; 
  thestring = NULL;
  if (flag.param)
    libereparam ();
 
  initparam ();
}
void 
libere ()
{
  int             i;

  delete []arete;arete = NULL;
  delete []hh;hh = NULL;
  delete []cr;cr = NULL;
  delete []ngbdy;ngbdy = NULL;
  delete []noeuds;noeuds = NULL;
  delete []sd;sd= NULL;

  for (i = 0; i < numidents; i++)
    {
      delete [] idents[i].name;
      idents[i].name=  NULL;
      if (idents[i].symb == fdecl)
	delete [] idents[i].table; idents[i].table = NULL;
    }
  delete []thestring; 
  thestring = NULL;
  if (flag.param)
    libereparam ();
}

void 
showident (ident * i)
{
  cerr << i->name << "\n";
}

void 
showtreeaux (int level, arbre t)
{
//  blanks (level);
  cerr << mesg[t->symb] << " " << (int)t->symb << "\n";
  if (realpart (t->value))
     {
//       blanks (level + 1);
       cerr << realpart (t->value) << "\n";
     }
  if (t->name)
     {
//       blanks (level + 1);
       showident (t->name);
     }
  if (t->l1)
    showtreeaux (level + 1, t->l1);
  if (t->l2)
    showtreeaux (level + 1, t->l2);
  if (t->l3)
    showtreeaux (level + 1, t->l3);
  if (t->l4)
    showtreeaux (level + 1, t->l4);
}

void 
showtree (arbre f)
{
  showtreeaux (0, f);
}
