// 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:     23-Feb-96 at 10:02:19 by Prud'homme Christophe
//
// DESCRIPTION:  
// DESCRIP-END.
//


#define dwya(i,k) (-(q[me[k][next[i]]].x-q[me[k][next[i+1]]].x)/2)	/* area * ¦w^i/¦x|_T^k */
#define dwxa(i,k) ((q[me[k][next[i]]].y-q[me[k][next[i+1]]].y)/2)	/* area * ¦w^i/¦y|_T^k */
#define dwy(i,k) (dwya(i,k)/area[k])	/* ¦w^i/¦x|_T^k */
#define dwx(i,k) (dwxa(i,k)/area[k])	/* ¦w^i/¦y|_T^k */

#define abss(a)(a < 0 ? -(a) : a)

#define penal (float)1.0e10
#define nhowmax 20
#define sqr(x) ((x)*(x))

#include <stdio.h>
#include <stdlib.h>
#include <math.h>

#include "opclass.h"
#include "triangul.h"
#include "lexical.h"
#include "syntaxic.h"
#include "disk.h"
#include "rgraph.h"
#include "fem.h"
#include "fem1.h"
#include "fem1c.h"

typedef creal  *cmatptr;
typedef float  *matptr;

extern char    errbuf[];
//extern fcts    *param;
extern drapeaux flag;
extern creal    sqrtofminus1;
extern int      N;

int              ns, nt;
rpoint     *q;
triangle  *me;
int            *ng;
int            *ngt;
float        *normlx, *normly;

int             bug = 0;
int             nhow = 0;
int             nhow1 = 0;
int             nhow2 = 0;
struct
   {
     int             N;
     int             nhow;
   }
whatmat[nhowmax];
float          *area;
int             next[5] =
{1, 2, 0, 1, 2};
AAcmat          a2;
creal          *a1c[nhowmax];
creal          *gconvect;
int             rhsQuadra = 0;
float          *a1[nhowmax];
int            *triauptr;
int            *triaunb;
long            bdth;

int            *Tleft;
int            *Tright;
int            *lowV;
int            *highV;
int            *listHead;
triangle       *edgeT;
int             ne;

int doedge (void);
int Tconvect (int k, double u1k, double u2k, double x, double y, double *mu, double *nu);
int xtoX (int quadra, creal * u1, creal * u2, float *dt, float *x, float *y, int *k);
int barycoor (float x, float y, int k, float *xl0, float *xl1, float *xl2);
void rhsPDE (int quadra, Acvect & fw, Acvect & f, Acvect & g);
int buildarea (int quadra);
void pdemat (int quadra, Acmat & a, Acmat & alpha,
	Acmat & rho11, Acmat & rho12, Acmat & rho21, Acmat & rho22,
	Acmat & u1, Acmat & u2, Acmat & beta);
float gaussband (Acmat & a, Acvect & x, long n, long bdth, int first, float eps);
void connectiv (void);
float pdeian (Acmat & a, Acvect & u, Acvect & f, Acvect & g, Acvect & u0,
  Acmat & alpha, Acmat & rho11, Acmat & rho12, Acmat & rho21, Acmat & rho22,
	Acmat & u1, Acmat & u2, Acmat & beta, int quadra, int factorize);
creal
binteg_t (int k, int ref1, int ref2, int ref3, creal* f, creal* g, int quadra);
creal
binteg (int ref1, int ref2, int ref3, creal* f, creal* g, int quadra, int ksolv);
creal
binteg (int ref1, int ref2, int ref3, creal* f, creal* g, int quadra, int ksolv);
creal
ginteg_t (int k, creal* f, creal* g, int quadra);


float
norm (const float x, const float y)
{
  return (float)sqrt (ssqr (x) + ssqr (y));
}

int
doedge (void)
/*-----------
  Give an index to each edge and build: Tleft,Tright,lowV,highV,edgeT
  INPUT ns,nt, me,ng          (me numbered counterclockwise)
  OUTPUT
    ne =ns+nt- nbHoles      total nb of edges 
    lowV[ne], highV[ne]       start and end vertex of each edge 
    Tleft[ne], Tright[ne]     left and right triangle indices for each edge  
    edgeT[nt][3]        numbers of the 3 edges of each triangle  
    listHead          one triangle to which a vertex belongs 
  AUXILIARIES         edgeT[k][j] is on the other side of vertex me[k][j] 
    list            list of indices related to triangles  
*/
{
  int             found, i, k, j, l, lp, low, high, ip;
  int            *list = NULL;
  ne = -1;
  list =new int[ 5 + ns + nt];  /* local array : deleted at the end of the routine */

  lowV = new int[ 50 + ns + nt];
  highV = new int[ 50 + ns + nt];
  Tleft = new int[ 50 + ns + nt];
  Tright = new int[ 50 + ns + nt];
  edgeT = new triangle[nt];
  listHead = new int[ns];
  
  memset (listHead, 0, ns*sizeof(int)); // set listHead to 0

  for (k = 0; k < nt + ns + 50; k++)
     {
       Tright[k] = Tleft[k] = -1;
     }
  for (k = 0; k < nt; k++)
    for (l = 0; l <= 2; l++)
       {
	 lp = next[l];
	 i = me[k][lp];		/*     first vertex of edge  */
	 j = me[k][next[lp]];	/*      second vertex of edge  */
	 low = mmin (i, j);	/*     low vertex nb  */
	 high = mmax (i, j);
	 ip = listHead[low];	/*     beginning of edge list  */
	 found = 0;
	 while ((ip != 0) && (!found))
	    {
	      if (ip > 49 + ns + nt)
		erreur ("bug in do edge");
	      if ((high == highV[ip]) && (low == lowV[ip]))
		 {		/*    edge exists already            */
		   edgeT[k][l] = ip;	/*    store edge number  */
		   if (low == i)
		     Tleft[ip] = k;
		   else
		     Tright[ip] = k;	/*    triangle to the right of ip  */
		   found = 1;
		 }
	      ip = list[ip];	/*    take next edge in list  */
	    }
	 if (!found)		/*    got a new edge  */
	    {
	      lowV[++ne] = low;	/*    Store low end vertex  */
	      highV[ne] = high;	/*    store high end vertex  */
	      list[ne] = listHead[low];		/*    build list  */
	      listHead[low] = ne;	/*    and listHead  */
	      if (low == i)
		Tleft[ne] = k;	/*    left triangle  */
	      else
		Tright[ne] = k;
	      edgeT[k][l] = ne;
	    }
       }
  for (k = 0; k < nt; k++)
    for (i = 0; i <= 2; i++)
      listHead[me[k][i]] = k;	/*    vertex j belongs to triangle listHead[j]*/
  delete [] list; 
  return 0;
}

int
Tconvect (int k, double u1k, double u2k, double x, double y, double *mu, double *nu)
// ---------- finds exit point z=(x,y) in direction -uk by intersection in T_k of
//z(mu)= z0 + mu * uk = z(nu) = q^j + nu * (q^next(j) - q^j)  returns j or -1 on error
{
  int             i, inext, j = 0;
  double          dx1, dx2, dq1, dq2, w0;

  do
     {				// get mu & nu with x + mu * u = q^i + nu * (q^{i+}-q^i) 

       i = me[k][j];
       inext = me[k][next[j]];
       dx1 = x - q[i].x;
       dx2 = y - q[i].y;
       dq1 = q[inext].x - q[i].x;
       dq2 = q[inext].y - q[i].y;
       w0 = (u2k * dq1 - u1k * dq2);
       if (w0 > 0)
	  {
	    *nu = (u2k * dx1 - u1k * dx2) / w0;
	    *mu = (dq2 * dx1 - dq1 * dx2) / w0;
	  }
       else
	 *nu = 1000;		// wrong direction 

     }
  while ((j++ < 2) && ((*nu < 0) || (*nu > 1) || (*mu > 0)));

  if ((*nu >= 0) && (*nu <= 1) && (*mu <= 0))
    return --j;
  else
    return -1;			// could not compute intersection  with edges   

}


int
xtoX (int quadra, creal * u1, creal * u2, float *dt, float *x, float *y, int *k)
// Solves X' = -u, X(0)=x from t=0 to dt
//   x is triangle k and on output X is in new k 
//   ERROR code: <=0: noErr, 

{
  int             j, kold = *k, kl, k0, k1, k2, k3;
  int             count = 0;
  int             next[3] ={1, 2, 0};
  double          u1k, u2k, nu, mu, eps = 1.0e-10, xd = *x, yd = *y;

  while ((*dt > eps) && (*k >= 0) && (count++ <= 50))
     {
       if ((*k >= nt) || (*k < 0))
	 erreur ("bug in xoX");
       if (quadra)
	  {
	    k3 = *k * 3;
	    k0 = k3;
	    k1 = k3 + 1;
	    k2 = k3 + 2;
	  }
       else
	  {
	    k0 = me[*k][0];
	    k1 = me[*k][1];
	    k2 = me[*k][2];
	  }
       u1k = realpart ((u1[k0] + u1[k1] + u1[k2])) / 3;
       u2k = realpart ((u2[k0] + u2[k1] + u2[k2])) / 3;
       if (u1k * u1k + u2k * u2k < eps)
	 return -2;		// velocity too small 

       if (j = Tconvect (*k, u1k, u2k, xd, yd, &mu, &nu), j == -1)
	 return 1;		// could not compute intersection  with edges 

       else
	  {
	    if (-mu > *dt)
	       {
		 mu = -*dt;
		 *dt = 0.F;
	       }
	    else
	      *dt += (float)mu;
	    xd += mu * u1k;
	    yd += mu * u2k;
	    kl = Tleft[j = edgeT[*k][next[next[j]]]];

	    kold = *k;
	    *k = (*k == kl) ? Tright[j] : kl;
	  }
     }
  *k = kold;
  *x = (float)xd;
  *y = (float)yd;
  if (count >= 50)
    return 2;			// trapped in a black hole and playing tennis there 

  return 0;
}

int
barycoor (float x, float y, int k, float *xl0, float *xl1, float *xl2)
//  ---------- gets barcentric coor of (x,y) in triangle k 
//  returns err=1 if x,y not in T_k, 0 otherwise 
{
  int             i0 = me[k][0];
  int             i1 = me[k][1];
  int             i2 = me[k][2];
  float           det;

  det = (q[i1].x - q[i0].x) * (q[i2].y - q[i0].y)
    - (q[i1].y - q[i0].y) * (q[i2].x - q[i0].x);
  *xl0 = ((q[i1].x - x) * (q[i2].y - y)
	  - (q[i1].y - y) * (q[i2].x - x)) / det;
  *xl2 = ((q[i1].x - q[i0].x) * (y - q[i0].y)
	  - (q[i1].y - q[i0].y) * (x - q[i0].x)) / det;
  *xl1 = ((x - q[i0].x) * (q[i2].y - q[i0].y)
	  - (y - q[i0].y) * (q[i2].x - q[i0].x)) / det;
  if ((*xl0 > 1.0001) || (*xl0 < -0.0001)
      || (*xl1 > 1.0001) || (*xl1 < -0.0001)
      || (*xl2 > 1.0001) || (*xl2 < -0.0001)
      || (fabs (*xl0 + *xl1 + *xl2 - 1) > 1e-5))
    return 1;
  else
    return 0;
}

creal
convect (creal * f, creal * u1, creal * u2, float dt, int i1, int quadra)	// computes foX(i)  = f(X(q^i)) where Y'=u(Y), Y(0)= q^i, X(q^i)= Y(-dt) 
//  This means that a poor quadrature is used for the method of characteristics 
 {
  int             j, j1, k, k1, iloc, err = 0;
  float           dt1, xl0, xl1, xl2, x, y, qcx, qcy;

  if (!quadra)
     {
       k = listHead[i1];
       j = i1;
       if (k <= 0)
	 return f[i1];
       else
	  {
	    qcx = (q[me[k][0]].x + q[me[k][1]].x + q[me[k][2]].x) / 3;
	    x = qcx + 0.99F * (q[j].x - qcx);
	    qcy = (q[me[k][0]].y + q[me[k][1]].y + q[me[k][2]].y) / 3;
	    y = qcy + 0.99F * (q[j].y - qcy);
	    dt1 = dt;
	    k1 = k;
	    if (0 < xtoX (quadra, u1, u2, &dt1, &x, &y, &k1))
	      err++;
	    if (barycoor (x, y, k1, &xl0, &xl1, &xl2))
	      err += 3;
	    return f[me[k1][0]] * xl0 + f[me[k1][1]] * xl1 + f[me[k1][2]] * xl2;
	  }
     }
  else				//quadra==1

     {
       if (i1 == 3 * nt - 1)
	  {
	    creal           aux = gconvect[i1];
	    delete [] gconvect; gconvect = NULL;
	    return aux;
	  }
       else if (i1 > 0)
	 return gconvect[i1];
       else			// i1==0

	  {
	    creal           gloc[3];

	    gconvect = new creal[3*nt];
	    for (k = 0; k < nt; k++)
	       {
		 qcx = (q[me[k][0]].x + q[me[k][1]].x + q[me[k][2]].x) / 3;
		 qcy = (q[me[k][0]].y + q[me[k][1]].y + q[me[k][2]].y) / 3;
		 for (iloc = 0; iloc < 3; iloc++)
		    {
		      j = me[k][iloc];
		      j1 = me[k][next[iloc]];
		      x = qcx + 0.999F * ((q[j].x + q[j1].x) / 2 - qcx);
		      y = qcy + 0.999F * ((q[j].y + q[j1].y) / 2 - qcy);
		      dt1 = dt;
		      k1 = k;
		      if (0 < xtoX (quadra, u1, u2, &dt1, &x, &y, &k1))
			err++;
		      if (barycoor (x, y, k1, &xl0, &xl1, &xl2))
			err += 3;
		      gloc[next[iloc + 1]] = f[3 * k1] * xl0 + f[3 * k1 + 1] * xl1 + f[3 * k1 + 2] * xl2;
		    }
		 for (iloc = 0; iloc < 3; iloc++)
		   gconvect[3 * k + iloc] = gloc[next[iloc]] + gloc[next[iloc + 1]] - gloc[iloc];
	       }
	    return gconvect[0];
	  }
     }
}

creal
rhsConvect (creal * f, creal * u1, creal * u2, float dt, int i1, int quadra)	// computes foX(i)  = f(X(q^i)) where Y'=u(Y), Y(0)= q^i, X(q^i)= Y(-dt) 
//  This means that a poor quadrature is used for the method of characteristics 
 {
  int             j, j1, k, k1, ke, iloc, err = 0;
  float           dt1, xl0, xl1, xl2, x, y, qcx, qcy, airne;
  creal           gconvectke;

  if (!quadra)
     {
       if (i1 == ns)
	  {
	    creal           aux = gconvect[i1];

	    delete [] gconvect;gconvect = NULL;
	    return aux;
	  }
       else if (i1 > 0)
	 return gconvect[i1];
       else			// i1==0
	  {
	    gconvect = new creal[ns];
	    rhsQuadra = 1;
	    for (ke = 0; ke < ne; ke++)
	       {
		 airne = 0.F;
		 if (k1 = Tleft[ke], k1 >= 0)
		   airne += area[k1];
		 if (k = Tright[ke], k >= 0)
		   airne += area[k];
		 else
		   k = k1;
		 qcx = (q[me[k][0]].x + q[me[k][1]].x + q[me[k][2]].x) / 3;
		 qcy = (q[me[k][0]].y + q[me[k][1]].y + q[me[k][2]].y) / 3;
		 j = lowV[ke];
		 j1 = highV[ke];
		 x = qcx + 0.999F * ((q[j].x + q[j1].x) / 2 - qcx);
		 y = qcy + 0.999F * ((q[j].y + q[j1].y) / 2 - qcy);
		 dt1 = dt;
		 k1 = k;
		 if (0 < xtoX (quadra, u1, u2, &dt1, &x, &y, &k1))
		   err++;
		 if (barycoor (x, y, k1, &xl0, &xl1, &xl2))
		   err += 3;
		 gconvectke = f[me[k1][0]] * xl0 + f[me[k1][1]] * xl1 + f[me[k1][2]] * xl2;
		 gconvect[lowV[ke]] += airne * gconvectke / 6.F;
		 gconvect[highV[ke]] += airne * gconvectke / 6.F;
	       }
	    return gconvect[0];
	  }
     }
  else				//quadra==1

     {
       if (i1 == 3 * nt - 1)
	  {
	    creal           aux = gconvect[i1];

	    delete [] gconvect;gconvect = NULL;
	    return aux;
	  }
       else if (i1 > 0)
	 return gconvect[i1];
       else			// i1==0

	  {
	    creal           gloc[3];

	    gconvect = new creal[ns];
	    for (k = 0; k < nt; k++)
	       {
		 qcx = (q[me[k][0]].x + q[me[k][1]].x + q[me[k][2]].x) / 3;
		 qcy = (q[me[k][0]].y + q[me[k][1]].y + q[me[k][2]].y) / 3;
		 for (iloc = 0; iloc < 3; iloc++)
		    {
		      j = me[k][iloc];
		      j1 = me[k][next[iloc]];
		      x = qcx + 0.999F * ((q[j].x + q[j1].x) / 2 - qcx);
		      y = qcy + 0.999F * ((q[j].y + q[j1].y) / 2 - qcy);
		      dt1 = dt;
		      k1 = k;
		      if (0 < xtoX (quadra, u1, u2, &dt1, &x, &y, &k1))
			err++;
		      if (barycoor (x, y, k1, &xl0, &xl1, &xl2))
			err += 3;
		      gloc[next[iloc + 1]] = f[3 * k1] * xl0 + f[3 * k1 + 1] * xl1 + f[3 * k1 + 2] * xl2;
		    }
		 for (iloc = 0; iloc < 3; iloc++)
		   gconvect[3 * k + iloc] = gloc[next[iloc]] + gloc[next[iloc + 1]] - gloc[iloc];
	       }
	    return gconvect[0];
	  }
     }
}

creal
prodscalar (creal * f, creal * g, int quadra)
{
  creal           prod = 0.F;
  int             i1, i2;

  for (int k = 0; k < nt; k++)
    for (int iloc = 0; iloc < 3; iloc++)
       {
	 if (quadra)
	    {
	      i1 = 3 * k + iloc;
	      i2 = 3 * k + next[iloc];
	    }
	 else
	    {
	      i1 = me[k][iloc];
	      i2 = me[k][next[iloc]];
	    }
	 prod += (f[i1] + f[i2]) * (g[i1].conjug() + g[i2].conjug()) * area[k];
       }
  return prod / 12.F;
}

creal
fctval (creal * f, float x, float y, int quadra)
/*  --------  returns the value of f at (x,y) */
{
  int             j, k, kmin, count = 0, notok;
  float           xc, yc, dist, xl0, xl1, xl2, distmin = (float)1e10;
  float           x3 = 3 * x;
  float           y3 = 3 * y;
  double          mu, nu, xcx, ycy;

  for (k = 0; k < nt; k++)
     {
       xc = (q[me[k][0]].x + q[me[k][1]].x + q[me[k][2]].x);
       yc = (q[me[k][0]].y + q[me[k][1]].y + q[me[k][2]].y);
       dist = (float)(fabs (xc - x3) + fabs (yc - y3));
       if (dist < distmin)
	  {
	    kmin = k;
	    distmin = dist;
	  }
     }
  xc = (q[me[kmin][0]].x + q[me[kmin][1]].x + q[me[kmin][2]].x) / 3;
  yc = (q[me[kmin][0]].y + q[me[kmin][1]].y + q[me[kmin][2]].y) / 3;
  while ((count++ < 20) && (notok = barycoor (x, y, kmin, &xl0, &xl1, &xl2), notok))
     {
       xcx = xc - x;
       ycy = yc - y;
       j = Tconvect (kmin, xcx, ycy, xc, yc, &mu, &nu);
       if (j >= 0)
	  {
	    kmin = (kmin == Tleft[j = edgeT[kmin][next[next[j]]]]) ? Tright[j] : Tleft[j];
	    xc += (float)(mu = mmax (mu, -1.0)) * (xc - x);
	    yc += (float)mu * (yc - y);
	  }
       else
	 count = 200;
     }
  if (!notok)
     {
       if (quadra)
	 return f[3 * kmin] * xl0 + f[3 * kmin + 1] * xl1 + f[3 * kmin + 2] * xl2;
       else
	 return f[me[kmin][0]] * xl0 + f[me[kmin][1]] * xl1 + f[me[kmin][2]] * xl2;
     }
  else
    return (float)2e30;
}

void
rhsPDE (int quadra, Acvect & fw, Acvect & f, Acvect & g)
/* ------------------------------------------
   Computes the right hand side of the linear system of the Laplace equation
   $fw(j)=\int_\Omega f w^j + \int_{ng<>0} g w^j + penal|_{u0!=0} u0^j$ 
   if quadra = i then f is P^i, i=0 or 1
   OTHER INPUT next,area,q,me,ng,nt,penal
 */
{
  int             j, k, k0, k1, k2, k3, ir, ir1, ir2, meirk, meirknext;
  cvect           x1, x2;
  float           aux;

  for (j = 0; j < ns; j++)
    fw[j] = 0.F;

  if (rhsQuadra)
     {
       rhsQuadra = 0;
       for (j = 0; j < ns; j++)
	 fw[j] = f[j];
     }
  else
    for (k = 0; k < nt; k++)
      for (ir = 0; ir <= 2; ir++)
	 {
	   k3 = 3 * k;
	   ir1 = next[ir];
	   ir2 = next[ir1];
	   meirk = me[k][ir];
	   meirknext = me[k][ir1];
	   if (quadra)
	      {
		k0 = k3 + ir;
		k1 = k3 + ir1;
		k2 = k3 + ir2;
	      }
	   else
	      {
		k0 = me[k][ir];
		k1 = me[k][ir1];
		k2 = me[k][ir2];
	      }
	   x1 = 2.F * f[k0];
	   x1 += f[k1];
	   x1 += f[k2];
	   x1 *= area[k] / 12.F;
	   fw[meirk] += x1;
	 }
  for (k = 0; k < nt; k++)
    for (ir = 0; ir <= 2; ir++)
       {
	 k3 = 3 * k;
	 ir1 = next[ir];
	 ir2 = next[ir1];
	 meirk = me[k][ir];
	 meirknext = me[k][ir1];
	 if ((ng[meirk] != 0) && (ng[meirknext] != 0))
	    {
	      if (quadra)
		 {
		   k0 = k3 + ir;
		   k1 = k3 + ir1;
		   k2 = k3 + ir2;
		 }
	      else
		 {
		   k0 = me[k][ir];
		   k1 = me[k][ir1];
		   k2 = me[k][ir2];
		 }
	      aux = norm (q[meirk].x - q[meirknext].x, q[meirk].y - q[meirknext].y) / 6;
	      x1 = g[k0];
	      x2 = g[k1];
	      x1 *= aux;
	      x2 *= aux;
	      fw[meirk] += 2.F * x1 + x2;
	      fw[meirknext] += x1 + 2.F * x2;
	    }
       }
}


int
buildarea (int quadra)
/*-------------------------------------------
  computes the area of each triangle & the normal to the bdy
  INPUT the triangulation ns,nt,me,q
  RETURNS 1 if one area is negative, 0 otherwise
*/
{
  int             i, k, ir, ir1, i1, nquad = quadra ? 3 * nt : ns;
  int             err = 0;
  float           qq[2][3], norml;

  for (k = 0; k < nt; k++)
     {
       for (ir = 0; ir <= 2; ir++)
	  {
	    i = me[k][ir];
	    qq[0][ir] = q[i].x;
	    qq[1][ir] = q[i].y;
	    ir1 = next[ir];
	    i1 = me[k][ir1];
	    if (ng[i] && ng[i1])
	      if (quadra)
		 {
		   normly[3 * k + ir1] = normly[3 * k + ir] = -q[i1].x + q[i].x;
		   normlx[3 * k + ir1] = normlx[3 * k + ir] = q[i1].y - q[i].y;
		 }
	      else
		 {
		   normly[i1] += -q[i1].x + q[i].x;
		   normlx[i1] += q[i1].y - q[i].y;
		   normly[i] += -q[i1].x + q[i].x;
		   normlx[i] += q[i1].y - q[i].y;
		   
		 }
	  }
       area[k] = ((qq[0][1] - qq[0][0]) * (qq[1][2] - qq[1][0])
		  - (qq[1][1] - qq[1][0]) * (qq[0][2] - qq[0][0])) / 2;
       err = (area[k] < 0);
     }
  for (k = 0; k < nquad; k++)
    if (norml = (float)sqrt (normlx[k] * normlx[k] + normly[k] * normly[k]),
	norml > 1.0e-7)
       {
	 normlx[k] /= norml;
	 normly[k] /= norml;
       }
  return err;
}

void
pdemat (int quadra, Acmat & a, Acmat & alpha,
	Acmat & rho11, Acmat & rho12, Acmat & rho21, Acmat & rho22,
	Acmat & u1, Acmat & u2, Acmat & beta)
/* ------------------------------------------------ */
{
  long            ai, k, i, j, ip, ipp, mejk, meik, k0, k1, k2, k3;
  long            nsl = ns;
  cmat            rhomean[2][2], alphamean, x1, x2, x3, x4;
  long            nsbdt = (2 * bdth + 1) * nsl;
  float           aux, isii;

  for (i = 0; i < nsbdt; i++)
    a[i] = 0.F;
  for (k = 0; k < nt; k++)
    for (i = 0; i <= 2; i++)
       {
	 meik = me[k][i];
	 ip = me[k][next[i]];
	 ipp = me[k][next[i + 1]];
	 if (quadra)
	    {
	      k3 = 3 * k;
	      k0 = k3 + i;
	      k1 = k3 + next[i];
	      k2 = k3 + next[i + 1];
	    }
	 else
	    {
	      k0 = meik;
	      k1 = ip;
	      k2 = ipp;
	    }
	 x1 = rho11[k0];
	 x2 = rho11[k1];
	 x3 = rho11[k2];
	 rhomean[0][0] = (x1 + x2 + x3) / 3.F;
	 x1 = rho12[k0];
	 x2 = rho12[k1];
	 x3 = rho12[k2];
	 rhomean[0][1] = (x1 + x2 + x3) / 3.F;
	 x1 = rho21[k0];
	 x2 = rho21[k1];
	 x3 = rho21[k2];
	 rhomean[1][0] = (x1 + x2 + x3) / 3.F;
	 x1 = rho22[k0];
	 x2 = rho22[k1];
	 x3 = rho22[k2];
	 rhomean[1][1] = (x1 + x2 + x3) / 3.F;
	 x1 = alpha[k0];
	 x2 = alpha[k1];
	 x3 = alpha[k2];
	 alphamean = (x1 + x2 + x3) / 3.F;
	 for (j = 0; j <= 2; j++)
	    {
	      mejk = me[k][j];
	      isii = i == j ? 1.F / 6.F : 1.F / 12.F;
	      ai = nsl * (meik - mejk + bdth) + mejk;
	      aux = dwxa (i, k) * dwx (j, k);
	      x1 = rhomean[0][0] * aux;
	      aux = dwya (i, k) * dwx (j, k);
	      x2 = rhomean[1][0] * aux;
	      aux = dwxa (i, k) * dwy (j, k);
	      x3 = rhomean[0][1] * aux;
	      aux = dwya (i, k) * dwy (j, k);
	      x4 = rhomean[1][1] * aux;
	      a[ai] += x1 + x2 + x3 + x4;
	      x1 = u1[k0];
	      x2 = u1[k1];
	      x3 = u1[k2];
	      a[ai] += (2.F * x1 + x2 + x3) * dwxa (j, k) / 12.F;
	      x1 = u2[k0];
	      x2 = u2[k1];
	      x3 = u2[k2];
	      a[ai] += (2.F * x1 + x2 + x3) * dwya (j, k) / 12.F
		+ alphamean * area[k] * isii;
	      if ((ng[meik] != 0) && (ng[mejk] != 0) && (meik < mejk))
		 {
		   if (quadra)
		      {
			k0 = k3 + i;
			k1 = k3 + j;
		      }
		   else
		      {
			k0 = meik;
			k1 = mejk;
		      }
		   x1 = beta[k0];
		   x2 = beta[k1];
		   x1 = (x1 + x2) * norm (q[meik].x - q[mejk].x, q[meik].y - q[mejk].y) / 2.F;
		   a[ai] += x1 / 6.F;
		   ai = nsl * bdth + mejk;
		   a[ai] += x1 / 3.F;
		   ai = nsl * bdth + meik;
		   a[ai] += x1 / 3.F;
		 }
	    }
       }
}

/*----------------------------------------------------*/
float
gaussband (Acmat & a, Acvect & x, long n, long bdth, int first, float eps)
/*----------------------------------------------------*/
/* Factorise (first!=0) and/or solve  Ay = x  with result in x */
/* LU is stored in A ; returns the value of the smallest pivot  */
/*  all pivots less than eps are put to eps */
/*  a[i][j] is stored in a[i-j+bdth][j]=a[n*(i-j+bdth)+j) */
/*  where -bdwth <= i-j <= bdth */
{
  long            i, j, k;
  cmat            x1, x2, s, s1;
  cvect           y1, s2, one (1.F);
  float           smin = (float)1e9;

  if (first)			/* factorization */
    for (i = 0; i < n; i++)
       {
	 for (j = mmax (i - bdth, 0); j <= i; j++)
	    {
	      s = 0.F;
	      for (k = mmax (i - bdth, 0); k < j; k++)
		 {
		   x1 = a[n * (i - k + bdth) + k];
		   x2 = a[n * (k - j + bdth) + j];
		   s += x1 * x2;
		 }
	      a[n * (i - j + bdth) + j] -= s;
	    }
	 for (j = i + 1; j <= mmin (n - 1, i + bdth); j++)
	    {
	      s = 0.F;
	      for (k = mmax (j - bdth, 0); k < i; k++)
		 {
		   x1 = a[n * (i - k + bdth) + k];
		   x2 = a[n * (k - j + bdth) + j];
		   s += x1 * x2;
		 }
	      s1 = a[n * bdth + i];
	      smin = mmin (smin, norm2 (s1));
	      if (smin < eps)
		 {
		   s1 = id (one) * eps;
		 }
	      x1 = a[n * (i - j + bdth) + j];
	      a[n * (i - j + bdth) + j] = (x1 - s) / s1;
	    }
       }
  for (i = 0; i < n; i++)	/*  resolution */
     {
       s2 = 0.F;
       for (k = mmax (i - bdth, 0); k < i; k++)
	  {
	    x1 = a[n * (i - k + bdth) + k];
	    y1 = x[k];
	    s2 += x1 * y1;
	  }
       y1 = x[i] - s2;
       x1 = a[n * bdth + i];
       x[i] = y1 / x1;
     }
  for (i = n - 1; i >= 0; i--)
     {
       s2 = 0.F;
       for (k = i + 1; k <= mmin (n - 1, i + bdth); k++)
	  {
	    x1 = a[n * (i - k + bdth) + k];
	    y1 = x[k];
	    s2 += x1 * y1;
	  }
       x[i] -= s2;
     }
  return smin;
}

void
connectiv (void)
/* builds connectivity array triaunb which contains all the  triangle numbers
   having i for vertex in triaunb[triauptr[i]...triauptr[i+1]-1]  */
{
  long            i, j, k;
  float           aux1, aux2 = 0.F;

  triauptr = new int[ns+1];
  triaunb = new int[3*nt];

  memset (triauptr, 0, (ns+1)*sizeof(int)); // set triauptr to 0
  
  for (k = 0; k < nt; k++)
    for (j = 0; j <= 2; j++)
      triauptr[me[k][j]] += 1;
  for (i = 1; i <= ns; i++)
     {
       aux1 = (float)triauptr[i];
       triauptr[i] = (int) aux2 + triauptr[i - 1];
       aux2 = aux1;
     }
  triauptr[0] = 0;

  for (k = 0; k < nt; k++)
    for (j = 0; j <= 2; j++)
      if (i = triauptr[me[k][j]], i >= 3 * nt)
	erreur ("bug in connectiv");
      else
	triaunb[triauptr[me[k][j]]++] = k;

  for (i = ns; i > 0; i--)
    triauptr[i] = triauptr[i - 1];
  triauptr[0] = 0;
}

int
initFEM (triangulation * t, int quadra)
{
  int             i, k, baux, nquad;

  ns = t->np;
  nt = t->nt;
  q = t->rp;
  me = t->tr;
  ng = t->ng;
  ngt = t->ngt;
  bdth = 0;
  nquad = quadra ? 3 * nt : ns;
  for (k = 0; k < nt; k++)
    for (i = 0; i <= 2; i++)
       {
	 baux = abss ((me[k][i] - me[k][next[i]]));
	 bdth = (bdth > baux) ? bdth : baux;
       }
  a2.destroy();
  a2.init (nhowmax);
  area = new float[nt];
  normlx = new float[nquad];
  normly = new float[nquad];
  for (i = 0;i < nquad;i++)
    {
      normlx[i] = 0.F;
      normly[i] = 0.F;
    } 
  nhow1 = 0;
  nhow2 = 0;
  connectiv ();
  flag.fem = 1;
  doedge ();
  return buildarea (quadra);
}

float
pdeian (Acmat & a, Acvect & u, Acvect & f, Acvect & g, Acvect & u0,
  Acmat & alpha, Acmat & rho11, Acmat & rho12, Acmat & rho21, Acmat & rho22,
	Acmat & u1, Acmat & u2, Acmat & beta, int quadra, int factorize)
/*-----------
Solves  alpha u + (u1,u2)grad u- div(mat[rho] grad u) = f in ã, 
         u|_{ng<0} = u0, 
         beta u + mat[rho]¦u/¦n|_{ng<>0} = g
where f is P^quadra (quadra=0 or 1) 
*/
{
  long            i, nsl = ns;
  int             j, mekj, k, nquad = quadra ? 3 * nt : ns;

  if (factorize)
    pdemat (quadra, a, alpha, rho11, rho12, rho21, rho22, u1, u2, beta);
  rhsPDE (quadra, u, f, g);
  for (i = 0; i < nquad; i++)
    if (norm2 (u0[i]) != 0)
       {
	 if (quadra)
	    {
	      k = i / 3;
	      j = i - 3 * k;
	      mekj = me[k][j];
	    }
	 else
	   mekj = i;
	 u[mekj] += u0[i] * penal;
	 if (factorize)
	   a[nsl * bdth + mekj] += id (u0[i]) * penal;
       }
  return gaussband (a, u, nsl, bdth, factorize, 1.F / penal);
}

float
solvePDE (fcts * param, int how, int quadra)
{
  long            nsl = ((long) ns) * (2 * ((long) bdth) + 1);
  int             factorize = 1;

  if (how > nhowmax)
    erreur ("Too many linear systems");
  if (how < 0)
     {
       factorize = 0;
       how = -how;
       if (((how > nhow1) && (N == 1)) || ((how > nhow2) && (N == 2)))
	  {
	    sprintf (errbuf, "solve(..,'-%d') refers to an inexistant system", how);
	    erreur (errbuf);
	  }
     }
  if (((how > nhow1) && (N == 1)) || ((how > nhow2) && (N == 2)))
     {
       switch (N)
	  {
	  case 1:
	    if (flag.complexe)
	      a1c[nhow1++] = new creal[nsl];
	    else
	      a1[nhow1++] = new float[nsl];

	    break;
	  case 2:
	    a2[nhow2++].init (nsl);
	    break;
	  }
     }
  if (flag.complexe)
     {
       if (N == 1)
	 return pdeian (a1c[how - 1], param->sol1c, param->f1c, param->g1c, param->p1c, param->b1c,
			param->nuxx1c, param->nuxy1c, param->nuyx1c, param->nuyy1c, param->a11c, param->a21c, param->c1c, quadra, factorize);
       else if (N == 2)
	 return pdeian (a2[how - 1], param->sol2, param->f2, param->g2, param->p2, param->b2,
			param->nuxx2, param->nuxy2, param->nuyx2, param->nuyy2, param->a12, param->a22, param->c2, quadra, factorize);
       else
	 return -1.F;

     }
  else
     {
       if (N == 1)
	 return pdeian (a1[how - 1], param->sol1, param->f1, param->g1, param->p1, param->b1,
			param->nuxx1, param->nuxy1, param->nuyx1, param->nuyy1, param->a11, param->a21, param->c1, quadra, factorize);
       else if (N == 2)
	 return pdeian (a2[how - 1], param->sol2, param->f2, param->g2, param->p2, param->b2,
			param->nuxx2, param->nuxy2, param->nuyx2, param->nuyy2, param->a12, param->a22, param->c2, quadra, factorize);
       else
	 return -1.F;
     }
}

creal
P1ctoP1 (creal * f, int i)
{
  long            j, k, l;
  creal           meanf = 0.F;

  for (l = triauptr[i]; l <= triauptr[i + 1] - 1; l++)
     {
       k = triaunb[l];
       for (j = 0; j <= 2; j++)
	 if (i == me[k][j])
	   meanf += f[3 * k + j];
     }
  return meanf / (float)(triauptr[i + 1] - triauptr[i]);
}
creal
binteg_t (int k, int ref1, int ref2, int ref3, creal* f,creal* g,  int quadra)
{ 
  creal tmp = 0.F;
  int i, i1, j1, next[3] = {1,2,0};
  int onbdy,onbdy1,onbdy2, onbdy3;

  for (i = 0;i < 3;i++)
    {
      if (quadra)
        {
          i1 = 3*k+i;
          j1 = 3*k+next[i];
        }
      else
        {
          i1 = me[k][i];
          j1 = me[k][next[i]];
        }
      if(ng[i1] && ng[j1])
      {
	      onbdy1 = (ng[i1] == ref1);
	      onbdy2 = (ref2 && (ng[i1] == ref2));
	      onbdy3 = (ref3 && (ng[i1] == ref3));
	      onbdy = onbdy1 || onbdy2 || onbdy3;
	      if (onbdy) 
	        	if(g) tmp += ((float)sqrt(sqr(q[i1].x-q[j1].x)+
	                     sqr(q[i1].y-q[j1].y))
	                *(f[i1] + f[j1])*(g[i1] + g[j1])/4.F);
	        	else tmp += ((float)sqrt(sqr(q[i1].x-q[j1].x)+
	                     sqr(q[i1].y-q[j1].y))
	                *(f[i1] + f[j1])/2.F);
	      else
	      {
		      onbdy1 = (ng[j1] == ref1);
		      onbdy2 = (ref2 && (ng[j1] == ref2));
		      onbdy3 = (ref3 && (ng[j1] == ref3));
		      onbdy = onbdy1 || onbdy2 || onbdy3;
		      if(onbdy)
		        	if(g) tmp += ((float)sqrt(sqr(q[i1].x-q[j1].x)+
		                     sqr(q[i1].y-q[j1].y))
		                *(f[i1] + f[j1])*(g[i1] + g[j1])/4.F);
		        	else tmp += ((float)sqrt(sqr(q[i1].x-q[j1].x)+
		                     sqr(q[i1].y-q[j1].y))
		                *(f[i1] + f[j1])/2.F);
	      }
       }
    }
  return tmp;
}
//
// ginteg : calcul de l'integrale global, ou par sous domaine(ref1,ref2,ref3)
//          de la fonction f.
// ref{1,2,3} : references des sous domaines. Si pour tout i refi = 0 alors 
//              on calcule l'integrale globale
//
creal
binteg (int ref1, int ref2, int ref3, creal* f, creal* g, int quadra, int ksolv)
{  // computes a boundary integral, global if ksolv=1, on one T if ksolv>1
  long k;
  creal integrale = 0.F, sigma = 0.F, tmp = 0.F;
  int next[3] = {1,2,0};

  if(ksolv>1)
 	integrale = binteg_t(ksolv-2, ref1, ref2, ref3, f, g, quadra);  
  else 
  for (k = 0;k < nt;k++)
    integrale += binteg_t(k, ref1, ref2, ref3, f, g, quadra);
  
  return integrale;
}
creal
ginteg_t (int k, creal* f, creal* g, int quadra)
{
  creal tmp = 0.F;
  int i, next[3]={1,2,0};
  
  if (quadra)
    {
      if(g)
      		for (i = 0;i < 3;i++)
        		tmp += (f[3*k+i]+f[3*k+next[i]])*(g[3*k+i]+g[3*k+next[i]])/2.F;
        else 
        	for (i = 0;i < 3;i++)
        		tmp += (f[3*k+i]+f[3*k+next[i]]);
      return tmp*area[k]/6.F;
    }
  else
    {
      if(g)
      	for (i = 0;i < 3;i++)
        	tmp += (f[me[k][i]] + f[me[k][next[i]]])*(g[me[k][i]] + g[me[k][next[i]]])/2.F;
        else 
      	for (i = 0;i < 3;i++)
        	tmp += (f[me[k][i]] + f[me[k][next[i]]]);
      return tmp*area[k]/6.F;
    }
}
//
// ginteg : calcul de l'integrale global, ou par sous domaine(ref1,ref2,ref3)
//          de la fonction f.
// ref{1,2,3} : references des sous domaines. Si pour tout i refi = 0 alors 
//              on calcule l'integrale globale
//
creal
ginteg (int ref1, int ref2, int ref3, creal* f, creal* g, int quadra, int ksolv)
{// computes a volume integral, global if ksolv=1, on one T if ksolv>1
  long k;
  creal integrale = 0.F, sigma = 0.F, tmp = 0.F;
  int next[3] = {1,2,0};

  if(ksolv>1)
  {
	    k=ksolv-2;
	    if (ref1 == 0)
	      integrale += ginteg_t(k, f, g, quadra);
	  	else if (ref2 == 0)
	      {
	        if (ngt[k] == ref1)
	          integrale += ginteg_t(k, f, g, quadra);
	      }
	 	else if (ref3 == 0)
	    {
	        if (ngt[k] == ref1 || ngt[k] == ref2)
	          integrale += ginteg_t(k, f, g, quadra);
	    }
	  	else
	      if (ngt[k] == ref1 || ngt[k] == ref2 || ngt[k] == ref3)
	        integrale += ginteg_t(k, f, g, quadra);	  
  		return integrale;
  }
  if (ref1 == 0)
    for (k = 0;k < nt;k++)
      integrale += ginteg_t(k, f, g, quadra);
  else if (ref2 == 0)
    for (k = 0;k < nt;k++)
      {
        if (ngt[k] == ref1)
          integrale += ginteg_t(k, f, g, quadra);
      }
  else if (ref3 == 0)
    {
      for (k = 0;k < nt;k++)
        if (ngt[k] == ref1 || ngt[k] == ref2)
          integrale += ginteg_t(k, f, g, quadra);
    }
  else
    for (k = 0;k < nt;k++)
      if (ngt[k] == ref1 || ngt[k] == ref2 || ngt[k] == ref3)
        integrale += ginteg_t(k, f, g, quadra);
  
  return integrale;
}

creal
deriv (int m, creal * f, int ksolv, int i, int quadra)
/*    ----------   dfx = partial f / partial x_m averaged at vertex i */
{
  long            j, k, l;
  creal           dfxk = 0.F;
  creal           sigma = 0.F;

  if(ksolv>1)
  {
  		k = ksolv - 2;
       for (j = 0; j <= 2; j++)
	 if (m == 0)
	   dfxk += dwx (j, k) * f[me[k][j]];
	 else
	   dfxk += dwy (j, k) * f[me[k][j]];
       return dfxk;  	
  }
  	if (quadra)
     {
       k = i / 3;
       for (j = 0; j <= 2; j++)
	 if (m == 0)
	   dfxk += dwx (j, k) * f[3 * k + j];
	 else
	   dfxk += dwy (j, k) * f[3 * k + j];
       return dfxk;
     }
  else
     {
       for (l = triauptr[i]; l <= triauptr[i + 1] - 1; l++)
	 sigma += area[triaunb[l]];
       for (l = triauptr[i]; l <= triauptr[i + 1] - 1; l++)
	  {
	    k = triaunb[l];
	    for (j = 0; j <= 2; j++)
	      if (m == 0)
		dfxk += dwxa (j, k) * f[me[k][j]];
	      else
		dfxk += dwya (j, k) * f[me[k][j]];
	  }
       return dfxk / sigma;
     }
}

void
libereFEM (void)
{
  int             i;

  if (flag.fem)
     {
       for (i = 0; i < nhow2; i++)
	 a2[i].destroy ();
       if (a1[0] != NULL)
	 {
	   for (i = 0; i < nhow1; i++)
             {
               delete [] a1[i];
               a1[i]=NULL;
             }
	 }
       if (a1c[0] != NULL)
	 {
	   for (i = 0; i < nhow1; i++)
             {
               delete [] a1c[i];
               a1c[i]=NULL;
             }
	 }

       a2.destroy ();
//    a1.destroy();
       delete [] area; area = NULL;
       delete [] normlx; normlx = NULL;
       delete [] normly; normly = NULL;
       delete [] triauptr; triauptr = NULL;
       delete [] triaunb; triaunb = NULL;
       delete [] lowV; lowV = NULL;
       delete [] highV; highV = NULL;
       delete [] Tleft; Tleft = NULL;
       delete [] Tright; Tright = NULL;
       delete [] edgeT; edgeT = NULL;
       delete [] listHead; listHead = NULL;
    
       flag.fem = 0;
       nhow = 0;
       nhow1 = 0;
       nhow2 = 0;
     }
}

int
getregion (triangulation * t, int i)
/* ------------ returns the ngt of a triangle to which belongs vertex i */
{
  return t->ngt[listHead[i]];	/* COULD BE IMPROVED */


}

creal
gfemuser (creal what, creal * f, int j)
{				// solves A_0 f = A_1 f

  int             i, k;
  float           s;

  if (j == 0)
     {
       float          *ff;
       ff = new float [ns];

       for (i = 0; i < ns; i++)
	 ff[i] = realpart (f[i]);
       for (i = 0; i < ns; i++)
	  {
	    s = ff[i];
	    for (k = i + 1; k <= mmin (ns - 1, i + bdth); k++)
	      s += a1[1][ns * (i - k + bdth) + k] * ff[k];
	    ff[i] = s;
	  }
       for (i = ns - 1; i >= 0; i--)
	  {
	    s = 0.F;
	    for (k = mmax (i - bdth, 0); k <= i; k++)
	      s += a1[1][ns * (i - k + bdth) + k] * ff[k];
	    ff[i] = s;
	  }
       gaussband (a1[0], ff, ns, bdth, 0, 1.F / penal);
       for (i = 0; i < ns; i++)
	 f[i] = ff[i];
       delete [] ff; ff = NULL;
     }
  return f[j];
}

void
initvarmat ( int how, int flagcomplexe,int N, fcts* param)
{
  long            nsl = ((long) ns) * (2 * ((long) bdth) + 1);
  long             i;
  int factorize = (how>0);

  if (how > nhowmax)
    erreur ("Too many linear systems");
  if((N==1)&&(how >nhow1+1)) erreur ("Linear systems number must be created in the natural order");
  if((N==2)&&(how >nhow2+1)) erreur ("Linear systems number must be created in the natural order");
  if (how < 0)
     {
       how = -how;
       if (((how > nhow1) && (N == 1)) || ((how > nhow2) && (N == 2)))
	  {
	    sprintf (errbuf, "solve(..,'-%d') refers to an inexistant system", how);
	    erreur (errbuf);
	  }
     }
     switch (N)
	  {
	  case 1:
	    if (flag.complexe)
	    {  if (how > nhow1) {   a1c[nhow1] = new creal[nsl]; nhow1++; }
  		   if(factorize) for (i = 0; i < nsl; i++)  a1c[how-1][i] = 0.F;  		  	
  		}
	    else
	    {  if (how > nhow1) { a1[nhow1] = new float[nsl]; nhow1++; }
		   if(factorize) for (i = 0; i < nsl; i++)  a1[how-1][i] = 0.F;
  		   for (i = 0; i < ns; i++) param->sol1[i] = 0.F;
  		}
	    break;
	  case 2:
	    if (how > nhow2) { a2[nhow2].init(nsl); nhow2++;}
  		if(factorize)  for (i = 0; i < nsl; i++)  
			a2[how-1][i] = 0.F;  		  
  		for (i = 0; i < ns; i++) param->sol2[i] = 0.F;
	    break;
	  }
}  

void
assemble ( int how, int flagcomplexe, int N, int k, creal* a, creal* b, fcts* param)
{
	int i,j,in,jn, jglob;
	long nsl = ns;
       switch (N)
	  {
	  case 1:
	    if (!flagcomplexe)
	    	for(j=0;j<3;j++)
			{  	jglob = me[k][j];
				param->sol1[jglob] -= realpart(b[j]);
	    		if(how>0)
	    		for(i=0;i<3;i++) 
	    		 a1[how-1][nsl*(me[k][i]-jglob+bdth)+jglob] 
	    		 		+= realpart(a[i*3+j]);
  			}
	    break;
	  case 2:
	    	for(j=0;j<3;j++)
			{  	jglob = me[k][j];
				for(jn=0;jn<N;jn++)
				{	param->sol2[jglob][jn] -= realpart(b[3*jn+j]);
	    			if(how>0)
	    			for(i=0;i<3;i++) 
	    			for(in=0;in<N;in++)
	    			 	a2[how-1][nsl*(me[k][i]-jglob+bdth)+jglob][in*2+jn] 
	    		 			+= realpart(a[18*in+9*jn+i*3+j]);
	    		}
  			}
	    break;
	  }

}	

void
solvevarpde(int N,  fcts* param, int how)
{
	long nsl = ns;
  	int i, factorize = (how>0);
	long mekj, nquad = ns;//quadra ? 3 * nt : ns;
	if(how<0)how = -how;
    if(N==1)
    {
  		for (i = 0; i < nquad; i++)
    	if (norm2 (param->p1[i]) != 0)
       {
	 /* if (quadra)
	    {
	      k = i / 3;
	      j = i - 3 * k;
	      mekj = me[k][j];
	    }
	 else*/
	 		mekj = i;
	 		param->sol1[mekj] += param->p1[i] * penal;
	 		if (factorize)
	   			a1[how-1][nsl * bdth + mekj] 
					+= id (param->p1[i]) * penal;
       }
  		gaussband (a1[how-1], param->sol1, nsl, bdth, factorize, (float)(1.0 / penal));
	  }
	  else if(N==2)
	  {
  		for (i = 0; i < nquad; i++)
    	if (norm2 (param->p2[i]) != 0)
       {
	 		param->sol2[i] += param->p2[i] * penal;
	 		if (factorize)
	   			a2[how-1][nsl * bdth + i] += id (param->p2[i]) * penal;
       }
  		gaussband (a2[how-1], param->sol2, nsl, bdth, factorize, (float)(1.0 / penal));
	 }
}
