/***********************************************************************/
/***********************************************************************/
/**                                                                   **/
/**               ARITHMETIC OPERATIONS ON POLYNOMIALS                **/
/**                         (first part)                              **/
/**                                                                   **/
/**                        copyright Babe Cool                        **/
/**                                                                   **/
/***********************************************************************/
/***********************************************************************/
/* $Id: polarit1.c,v 2.0.0.2 1997/12/14 20:11:49 karim Exp karim $ */

#include "genpari.h"

GEN make_base(long n, GEN base);
GEN bsrch(GEN p, GEN fa, long Ka, GEN eta, long Ma);
GEN eleval(GEN f,GEN h,GEN a);
GEN respm(GEN f1,GEN f2,GEN pm);
GEN setup(GEN p,GEN f,GEN theta,GEN nut, long *La, long *Ma);
GEN vstar(GEN p,GEN h);

/* see splitgen() for how to use these two */
GEN
setloop(GEN a)
{
  a=icopy(a);
  cgetg(1,t_VEC); /* dummy to get one cell of extra space */ 
  return a;
}

GEN
incloop(GEN a)
{
  long i,l=lgefint(a);

  for (i=l-1; i>1; i--)
    if (++a[i]) return a;
  i=l+1; a--; /* use the extra cell */
  a[0]=evaltyp(1) | evallg(i);
  a[1]=evalsigne(1) | evallgefint(i);
  return a;
}

/*******************************************************************/
/*                                                                 */
/*                           DIVISIBILITE                          */
/*                 Renvoie 1 si y divise x, 0 sinon .              */
/*                                                                 */
/*******************************************************************/

int
gdivise(GEN x, GEN y)
{
  long av=avma;
  x=gmod(x,y); avma=av; return gcmp0(x);
}

int
poldivis(GEN x, GEN y, GEN *z)
{
  long av=avma;
  GEN p1,p2;

  p1=poldivres(x,y,&p2);
  if (signe(p2)) { avma=av; return 0; }
  cgiv(p2); *z=p1; return 1;
}

/*******************************************************************/
/*                                                                 */
/*                          REDUCTION                              */
/*    Do the transformation t_FRACN/t_RFRACN --> t_FRAC/t_RFRAC    */
/*                                                                 */
/*******************************************************************/

/* x[1] is scalar, non-zero */
static GEN
gred_simple(GEN x)
{
  GEN p1,p2,x2,x3;

  x2=content((GEN)x[2]);
  x3=gdiv((GEN)x[1],x2);
  x2=gdiv((GEN)x[2],x2);
  p2=denom(x3);

  p1=cgetg(3,t_RFRAC);
  p1[1]=(long)numer(x3);
  p1[2]=lmul(x2,p2); return p1;
}

GEN
gred_rfrac(GEN x)
{
  GEN y,p1,x1,x2,x3,xx1,xx2;
  long tx,ty;

  if (gcmp0((GEN)x[1])) 
    return isexactzero((GEN)x[1])? gzero: gcopy((GEN)x[1]);

  tx=typ(x[1]); ty=typ(x[2]);
  if (ty!=t_POL)
  {
    if (tx!=t_POL) return gcopy(x);
    if (gvar2((GEN)x[2]) <= varn(x[1]))
      err(talker,"incompatible variables in gred");
    return gdiv((GEN)x[1],(GEN)x[2]);
  }
  if (tx!=t_POL)
  {
    if (varn(x[2]) < gvar2((GEN)x[1])) return gred_simple(x);
    err(talker,"incompatible variables in gred");
  }
  if (varn(x[2]) < varn(x[1])) return gred_simple(x);
  if (varn(x[2]) > varn(x[1])) return gdiv((GEN)x[1],(GEN)x[2]);

  /* now x[1] and x[2] are polynomials with the same variable */    
  x1=content((GEN)x[1]);
  x2=content((GEN)x[2]); x3=gdiv(x1,x2);

  x1=gdiv((GEN)x[1],x1);
  x2=gdiv((GEN)x[2],x2); y=poldivres(x1,x2,&p1);
  if (gcmp0(p1)) return gmul(x3,y);

  p1=ggcd(x1,x2);
  if (!isscalar(p1)) { x1=gdeuc(x1,p1); x2=gdeuc(x2,p1); }
  xx1=numer(x3); xx2=denom(x3);
  p1=cgetg(3,t_RFRAC);
  p1[1]=lmul(x1,xx1);
  p1[2]=lmul(x2,xx2); return p1;
}

GEN
gred(GEN x)
{
  long tx=typ(x),av=avma;
  GEN y,p1,x1,x2;

  if (is_frac_t(tx))
  {
    x1=(GEN)x[1]; x2=(GEN)x[2];
    y = dvmdii(x1,x2,&p1);
    /* gzero volontaire */
    if (p1 == gzero) return y;

    p1=mppgcd(x2,p1);
    if (gcmp1(p1)) { avma=av; return gcopy(x); }

    p1=gclone(p1); avma=av; y=cgetg(3,t_FRAC);
    y[1]=ldivii(x1,p1);
    y[2]=ldivii(x2,p1);
    killbloc(p1); return y;
  }
  if (is_rfrac_t(tx)) 
    return gerepileupto(av, gred_rfrac(x));
  return gcopy(x);
}

/*  gred IN PLACE (destroys x and, in some cases, intermediate objects).
 *  Assumption: x has been created before the components.
 */
GEN
gredsp(GEN x)
{
  long av, tx=typ(x);
  GEN y,p1,x1,x2;

  if (is_frac_t(tx))
  {
    x1=(GEN)x[1]; x2=(GEN)x[2];
    av=avma; y = dvmdii(x1,x2,&p1);
    if (p1 == gzero) return gerepile((long)(x+3),av,y);

    p1=mppgcd(x2,p1);
    if (!gcmp1(p1))
    {
      affii(divii(x1,p1), x1);
      affii(divii(x2,p1), x2);
    }
    settyp(x,t_FRAC); avma=av; return x;
  }
  if (is_rfrac_t(tx))
    return gerepileupto((long)(x+3), gred_rfrac(x));
  return x;
}

/*******************************************************************/
/*                                                                 */
/*                  POLYNOMIAL EUCLIDEAN DIVISION                  */
/*                                                                 */
/*******************************************************************/

/* Polynomial division x / y:
 *   if z = ONLY_REM  return remainder, otherwise return quotient
 *   if z != NULL set *z to remainder
 *   *z is the last object on stack (and thus can be disposed of with cgiv
 *   instead of gerepile)
 */
GEN
poldivres(GEN x, GEN y, GEN *pr)
{
  long ty=typ(y),tx,vx,vy,dx,dy,dz,i,j,av,av1,sx,lrem;
  long remainder = (pr == ONLY_REM);
  GEN z,p1,p2,rem,y_lead;

  if (is_scalar_t(ty))
  { 
    if (remainder) return gzero;
    if (pr) *pr=gzero;
    return gdiv(x,y);
  }
  tx=typ(x); vy=gvar9(y);
  if (is_scalar_t(tx) || gvar9(x)>vy)
  { 
    if (remainder) return gcopy(x);
    if (pr) *pr=gcopy(x);
    return gzero;
  }
  if (tx!=t_POL || ty!=t_POL) err(typeer,"euclidean division (poldivres)");

  vx=varn(x);
  if (vx<vy)
  {
    if (pr)
    {
      p1 = zeropol(vx); if (remainder) return p1;
      *pr = p1;
    }
    return gdiv(x,y);
  }
  if (gcmp0(y))
    err(talker,"euclidean division by zero (poldivres)");

  dy=lgef(y)-3;
  if (!dy) /* y is constant */
  {
    if (pr)
    {
      p1 = zeropol(vx); if (remainder) return p1;
      *pr = p1;
    }
    return gdiv(x,(GEN)y[2]);
  }
  dx=lgef(x)-3; 
  if (vx>vy || dx<dy)
  {
    if (pr)
    {
      p1 = gcopy(x); if (remainder) return p1;
      *pr = p1;
    }
    return zeropol(vy);
  }
  dz=dx-dy; av=avma;
  z=cgetg(dz+3,t_POL); z[1]=evalsigne(1) | evallgef(3+dz) | evalvarn(vx);

  p1 = (GEN)y[dy+2]; y_lead = gcmp1(p1)? (GEN)NULL: p1;
  p1 = (GEN)x[dx+2];
  z[dz+2]=y_lead? ldiv(p1,(GEN)y[dy+2]): lcopy(p1);
  for (i=dx-1; i>=dy; i--)
  {
    av1=avma; p1=((GEN)x[i+2]);
    for (j=i-dy+1; j<=i && j<=dz; j++)
    {
      p2 = gmul((GEN)z[j+2],(GEN)y[i-j+2]);
      p1 = gsub(p1,p2);
    }
    if (y_lead) p1 = gdiv(p1,y_lead);
    if (!remainder) p1 = gerepileupto(av1,p1);
    z[i-dy+2] = (long)p1;
  }
  if (!pr) return z;

  rem=cgetg(dx+3,t_POL); sx=1; av1=avma;
  for ( ; ; i--)
  {
    p1 = (GEN)x[i+2];
    for (j=0; j<=i && j<=dz; j++) 
    {
      /* we always go here at least once */
      p2 = gmul((GEN)z[j+2],(GEN)y[i-j+2]);
      p1 = gsub(p1,p2);
    }
    if (!gcmp0(p1)) break;
    if (!isinexactreal(p1) && !isexactzero(p1)) break;
    if (!i) { sx=0; break; } /* remainder is 0 */
    avma=av1;
  }
  rem += dx-i; lrem=i+3;
  p1 = gerepileupto((long)rem,p1);
  rem[0]=evaltyp(t_POL) | evallg(lrem);
  rem[1]=evalsigne(1) | evalvarn(vx) | evallgef(lrem);
  rem[i+2]=(long)p1; if (!sx) normalizepol(rem);
  for (i--; i>=0; i--)
  {
    av1=avma; p1 = (GEN)x[i+2];
    for (j=0; j<=i && j<=dz; j++)
    {
      p2 = gmul((GEN)z[j+2],(GEN)y[i-j+2]);
      p1 = gsub(p1,p2);
    }
    rem[i+2]=lpileupto(av1,p1);
  }
  if (remainder) return gerepileupto(av,rem);
  *pr = rem; return z;
}

/*******************************************************************/
/*                                                                 */
/*      Recherche des racines modulo p (par verif f(x)=0)          */
/*                                                                 */
/*      (retourne le vecteur horizontal dont les composantes       */
/*       sont les racines (eventuellement vecteur a 0 comp.)       */
/*                                                                 */
/*******************************************************************/

GEN
rootmod2(GEN f, GEN pp)
{
  GEN g,y,ss;
  long p,vf,av = avma,av1,deg,s,nbrac;

  if (cmpis(pp,VERYBIGINT)>0) return rootmod(f,pp);
  if (typ(f)!=t_POL || gcmp0(f)) err(factmoder);
  y=(GEN)f[2]; vf=varn(f); p=itos(pp);
  if (typ(y)!=t_INTMOD || !gegal((GEN)y[1],pp)) f = gmul(f,gmodulss(1,p));

  deg=lgef(f)-3; nbrac=0; av1=avma;
  y=(GEN)gpmalloc((deg+1)*sizeof(long));
  s=0; ss=gzero;
  do
  {
    if (gcmp0(poleval(f,ss)))
    {
      nbrac++; y[nbrac]=s;
      f=gdiv(f,gsub(polx[vf],ss));
      av1=avma;
    }
    else { avma=av1; s++; ss=stoi(s); }
  }
  while (nbrac<deg-1 && p>s);
  if (!nbrac) { avma=av; return cgetg(1,t_VEC); }
  if (nbrac == deg-1)
  { 
    nbrac++; g=gneg(gdiv((GEN)f[2],(GEN)f[3]));
    y[nbrac]=itos((GEN)g[2]);
  }
  avma=av; g=cgetg(nbrac+1,t_VEC);
  for (s=1; s<=nbrac; s++) g[s]=(long)gmodulss(y[s],p);
  free(y); return g;
}

/*******************************************************************/
/*                                                                 */
/*          Recherche intelligente des racines modulo p            */
/*                                                                 */
/*       retourne le vecteur horizontal dont les composantes       */
/*       sont les racines (eventuellement vecteur a 0 comp.)       */
/*                                                                 */
/*******************************************************************/

GEN
rootmod(GEN f, GEN p)
{
  GEN y,unmodp,pol,xun,g,a,b,d,e,u,h,q,p1;
  long av = avma,tetpil,vf,n,i,j,la,lb;

  if (typ(f)!=t_POL || gcmp0(f)) err(factmoder);
  y=(GEN)f[2]; vf=varn(f); unmodp=gmodulsg(1,p);
  if (typ(y)!=t_INTMOD || !gegal((GEN)y[1],p)) f=gmul(f,unmodp);
  if (!cmpis(p,2))
  {
    j=0; if (gcmp0((GEN)f[2])) j++;
    if (gcmp0(gsubst(f,vf,unmodp))) j+=2;
    avma=av;
    switch(j)
    {
      case 0: y=cgetg(1,t_VEC); break;
      case 1: y=cgetg(2,t_VEC); y[1]=(long)gmodulsg(0,p); break;
      case 2: y=cgetg(2,t_VEC); y[1]=(long)gmodulsg(1,p); break;
      case 3: y=cgetg(3,t_VEC);
        y[1]=(long)gmodulsg(0,p); y[2]=(long)gmodulsg(1,p); break;
    }
    return y;
  }
  if (!cmpis(p,4))
  {
    long rac[5];

    j=0; if (gcmp0((GEN)f[2])) { j++; rac[j]=0; }
    p1=unmodp;
    for (i=1; i<=3; i++)
    {
      if (gcmp0(gsubst(f,vf,p1))) { j++; rac[j]=i; }
      if (i<3) p1=gadd(p1,unmodp);
    }
    avma=av; y=cgetg(j+1,t_VEC);
    for (i=1; i<=j; i++) y[i]=(long)gmodulsg(rac[i],p);
    return y;
  }

  pol=gmul(unmodp,polx[vf]); xun=gmodulcp(pol,f);
  g=ggcd((GEN)(gsub(gpui(xun,p,0),xun))[2],f);
  n=lgef(g)-3; if (!n) { avma=av; return cgetg(1,t_VEC); }
  y=cgetg(n+1,t_VEC);
  if (gcmp0((GEN)g[2]))
  {
    y[1]=zero; g=gdiv(g,polx[vf]);
    if (lgef(g)>3) y[2]=(long)g;
    j=2;
  }
  else { y[1]=(long)g; j=1; }
  while (j<=n)
  {
    a=(GEN)y[j]; la=lgef(a)-3;
    if (la==1)
    {
      y[j]=(gneg(gdiv((GEN)a[2],(GEN)a[3])))[2]; j++;
    }
    else if (la==2)
    {
      d=gsub(gsqr((GEN)a[3]),gmul2n(gmul((GEN)a[2],(GEN)a[4]),2));
      e=gsqrt(d,0); u=ginv(gmul2n((GEN)a[4],1));
      y[j]=(gmul(u,gsub(e,(GEN)a[3])))[2];
      y[j+1]=(gmul(u,gneg(gadd(e,(GEN)a[3]))))[2];
      j+=2;
    }
    else
    {
      h=pol; q=shifti(subis(p,1),-1);
      for(;;)
      {
	p1=gmodulcp(h,a); b=ggcd((GEN)(gsub(gpui(p1,q,0),gun))[2],a);
	lb=lgef(b)-3;
	if (lb && lb<la)
	{
	  y[j]=(long)b; y[j+lb]=ldiv(a,b);
          break;
	}
	h=gadd(h,unmodp);
      }
    }
  }
  y=sort(y); tetpil=avma; return gerepile(av,tetpil,gmul(unmodp,y));
}

GEN
rootmod0(GEN f, GEN p, long flag)
{
  switch(flag)
  {
    case 0: return rootmod(f,p);
    case 1: return rootmod2(f,p);
    default: err(flagerr);
  }
  return NULL; /* not reached */
}

/*******************************************************************/
/*                                                                 */
/*                     FACTORISATION MODULO p                      */
/*                                                                 */
/*******************************************************************/
static void splitgen(GEN m, GEN *t, long d, GEN  p, GEN q);

/* factor f mod pp. If (simple) ouput only the degrees, not the factors */
static GEN
factcantor0(GEN f, GEN pp, long simple)
{
  long smallp,i,j,k,d,e,vf,expos[100],p,nbfact,tetpil,av;
  GEN y,t[100],p1,f2,g,g1,xmod,u,v,pd,q;

  if (typ(f)!=t_POL || gcmp0(f)) err(factmoder); 
  if (typ(pp)!=t_INT) err(factmoder);
  if (cmpis(pp,VERYBIGINT) > 0) p = smallp = 0;
  else { smallp = 1; p=itos(pp); }

  av = avma; f = gmul(f,gmodulsg(1,pp));
  if (!signe(f)) err(zeropoler,"factcantor");
  if (lgef(f)==3)
  { 
    avma=av; y=cgetg(3,t_MAT); y[1]=lgetg(1,t_COL);
    y[2]=lgetg(1,t_COL); return y;
  }
  vf=varn(f); e = nbfact = 1;
  for(;;)
  {
    f2=srgcd(f,deriv(f,vf)); g1=gdiv(f,f2); k=0;
    while (lgef(g1)>3)
    {
      k++; if (smallp && !(k%p)) { k++; f2=gdiv(f2,g1); }
      p1=srgcd(f2,g1); u=gdiv(g1,p1); g1=p1; f2=gdiv(f2,g1);
      if (lgef(u)>3)
      {
       /*  Ici u est square-free (produit des facteurs premiers de meme
        *  multiplicite e*k)
        */
	pd=gun; xmod=gmodulcp(polx[vf],u); v=xmod;
	for (d=1; d <= (lgef(u)-3)>>1; d++)
	{
	  pd=mulii(pd,pp); v=gpui(v,pp,0);
	  g=srgcd((GEN)gsub(v,xmod)[2],u);
      
	  if (lgef(g)>3)
	  {
	   /* Ici g est produit de pol irred ayant tous le meme degre d; */
            j=nbfact+(lgef(g)-3)/d;

            if (simple)
              for ( ; nbfact<j; nbfact++)
                { t[nbfact]=(GEN)d; expos[nbfact]=e*k; }
            else
            {
              t[nbfact]=g;
              q=shifti(subis(pd,1),-1);
             /* le premier parametre est un entier variable m qui sera
              * converti en un polynome w dont les coeff sont ses digits en
              * base p (initialement m = p --> X) pour faire pgcd de g avec
              * w^(p^d-1)/2 jusqu'a casser.
              */
              if (smallp)
                split(p,t+nbfact,d,p,q);
              else
                splitgen(pp,t+nbfact,d,pp,q);
              for (; nbfact<j; nbfact++) expos[nbfact]=e*k;
            }
	    u=gdiv(u,g); v=gmodulcp((GEN)v[2],u);
	  }
	}
	if (lgef(u)>3)
        { 
          t[nbfact]= simple? (GEN)(lgef(u)-3): u;
          expos[nbfact++]=e*k;
        }
      }
    }
    j = lgef(f2); if (j==3) break;

    e*=p; j=(j-3)/p+3; f=cgetg(j,t_POL);
    f[1] = evalsigne(1) | evallgef(j) | evalvarn(vf);
    for (i=2; i<j; i++) f[i]=f2[p*(i-2)+2];
  }
  tetpil=avma; y=cgetg(3,t_MAT);
  u=cgetg(nbfact,t_COL); y[1]=(long)u;
  v=cgetg(nbfact,t_COL); y[2]=(long)v;
  if (simple)
    for (j=1; j<nbfact; j++)
    { 
      u[j]=lstoi((long)t[j]); 
      v[j]=lstoi(expos[j]);
    }
  else
    for (j=1; j<nbfact; j++)
    {
      u[j]=ldiv(t[j],leading_term(t[j]));
      v[j]=lstoi(expos[j]);
    }
  return gerepile(av,tetpil,y);
}

GEN
factcantor(GEN f, GEN p)
{
  return factcantor0(f,p,0);
}

GEN
simplefactmod(GEN f, GEN p)
{
  return factcantor0(f,p,1);
}

GEN
factmod(GEN f, GEN pp)
{
  long i,j,k,e,vf,expos[100],p,psim2,N,nbfact,av,tetpil,l1,l2,r,kk;
  GEN y,t[100],f2,p1,p2,g1,Q,u,v,w;
  GEN col1,xmod,xmodp,polt,puix,vker,zmodp,unmodp;

  if (typ(f)!=t_POL || gcmp0(f) || typ(pp)!=t_INT) err(factmoder);
  if (!cmpis(pp,2)) return factcantor(f,pp);
  if (cmpis(pp,VERYBIGINT) > 0) return factcantor0(f,pp,0);

  p=itos(pp); av=avma;
  unmodp=gmodulss(1,p); f=gmul(f,unmodp);
  if (!signe(f)) err(zeropoler,"factmod");
  r=lgef(f)-3;
  if (!r)
  { 
    avma=av; y=cgetg(3,t_MAT); y[1]=lgetg(1,t_COL);
    y[2]=lgetg(1,t_COL); return y;
  } 

  vf=varn(f); e = nbfact = 1;
  zmodp=gmodulsg(0,pp);
  puix=cgetg(r+1,t_VEC); puix[1]=(long)polun[vf];
  for (i=1; i<r; i++) puix[i+1]=lmul((GEN)puix[i],polx[vf]);
  xmodp=cgetg(4,t_POL);
  xmodp[1]=evalsigne(1) | evalvarn(vf) | evallgef(4);
  xmodp[2]=(long)zmodp; xmodp[3]=(long)unmodp;
  xmod=cgetg(3,t_POLMOD); /* will contain x mod (p,u) */

  col1=cgetg(r+1,t_COL); col1[1]=(long)unmodp;
  for (i=2; i<=r; i++) col1[i]=(long)zmodp;
  psim2=p>>1;
  for(;;)
  {
    f2=srgcd(f,deriv(f,vf)); g1=gdiv(f,f2); k=0;
    while (lgef(g1)>3)
    {
      k++; if (!(k%p)) { k++; f2=gdiv(f2,g1); }
      p1=srgcd(f2,g1); u=gdiv(g1,p1); g1=p1; f2=gdiv(f2,g1);
      N=lgef(u)-3;
      if (N)
      {
       /*  Ici u est square-free (produit des facteurs premiers de meme
        *  multiplicite e*k)
        */
        xmod[1]=(long)u; xmod[2]=lmod(xmodp,u);

        Q=cgetg(N+1,t_MAT); Q[1]=(long)col1;
        setlg(col1,N+1); w = v = gpuigs(xmod,p);
	for (j=2; j<=N; j++)
	{
	  p1=cgetg(N+1,t_COL); Q[j]=(long)p1; 
          p2=(GEN)w[2]; r=lgef(p2)-1; p2++;
	  for (i=1; i<r ; i++) p1[i]=p2[i];
	  for (   ; i<=N; i++) p1[i]=(long)zmodp;
	  if (j<N) w=gmul(w,v);
	}
	setlg(puix,N+1); vker=gmul(puix,ker(gsub(Q,idmat(N))));
	r=lg(vker)-1; t[nbfact]=u; kk=1;
	while (kk<r)
	{
	  p1=cgetg(r+1,t_COL);
	  for (i=1; i<=r; i++) p1[i]=(long)gmodulss(mymyrand(),p);
	  polt=gmul(vker,p1);
	  for (i=1; i<=kk && kk<r; i++)
	  {
	    p1=t[nbfact+i-1]; l1=lgef(p1)-3;
	    if (l1>1)
	    {
	      p2=(GEN)gpuigs(gmodulcp(polt,p1),psim2)[2];
	      p2=ggcd(p1,gaddgs(p2,-1)); l2=lgef(p2)-3;
	      if (l2>0 && l2<l1)
	      {
		t[nbfact+i-1]=p2; kk++;
		t[nbfact+kk-1]=gdiv(p1,p2);
	      }
	    }
	  }
	}
        j=nbfact+r;
	for (; nbfact<j; nbfact++) expos[nbfact]=e*k;
      }
    }
    j=(lgef(f2)-3)/p+3; if (j==3) break;
    
    e*=p; f=cgetg(j,t_POL);
    f[1] = evalsigne(1) | evallgef(j) | evalvarn(vf);
    for (i=2; i<j; i++) f[i]=f2[p*(i-2)+2];
  }
  tetpil=avma; y=cgetg(3,t_MAT);
  u=cgetg(nbfact,t_COL); y[1]=(long)u;
  v=cgetg(nbfact,t_COL); y[2]=(long)v;
  for (j=1; j<nbfact; j++)
  {
    u[j]=ldiv(t[j],leading_term(t[j]));
    v[j]=lstoi(expos[j]);
  }
  return gerepile(av,tetpil,y);
}

/* returns a polynomial in variable v, whose coeffs are t_INTMOD modulo p,
 * corresponding to the digits of m (in base p)
 */
static GEN
stopoly(long m, long p, long v)
{
  long l=2,i,c[100];
  GEN y;

  do { c[l++]=m%p; m=m/p; } while (m);
  y=cgetg(l,t_POL); for (i=2; i<l; i++) y[i]=(long)gmodulss(c[i],p);
  y[1]=evalsigne(1)|evallgef(l)|evalvarn(v);
  return y;
}

static GEN
stopoly_gen(GEN m, GEN  p, long v)
{
  long l=2;
  GEN y;

  y=cgetg(1001,t_POL);
  do  { y[l++]=lmodii(m,p); m=divii(m,p); } while (signe(m));
  y[1]=evalsigne(1)|evallgef(l)|evalvarn(v);
  return y;
}

/* Programme recursif :
 * Entree:
 * m entier arbitraire (converti en un polynome w)
 *  p nb premier; q=(p^d-1)/2
 *  t[0] polynome de degre k*d prod de k fact de deg d.
 * Sortie:
 *  t[0],t[1]...t[k-1] contiennent les k facteurs de g
 */
void
split(long m, GEN *t, long d, long p, GEN q)
{
  long l,v,dv,av,tetpil;
  GEN w,w0,unmodp;

  dv=lgef(*t)-3; if (dv==d) return;
  v=varn(*t); unmodp=gmodulss(1,p); av=avma;
  for(;;)
  {
    if (p==2)
    {
      w0=w=gmul(gpuigs(polx[v],m-1),unmodp); m+=2;
      for (l=1; l<d; l++)
	w=gmod(gadd(w0,gsqr(w)),*t);
    }
    else
    {
      w=stopoly(m,p,v); m++;
      w=gpui(gmodulcp(w,*t),q,0);
      w=gsub((GEN)w[2],unmodp);
    }
    tetpil=avma; w=ggcd(*t,w); l=lgef(w)-3;
    if (l && l!=dv) break;
    avma=av;
  }
  w=gerepile(av,tetpil,w);
  l /= d; t[l]=gdiv(*t,w); *t=w;
  split(m,t+l,d,p,q); split(m,t,d,p,q);
}

static void
splitgen(GEN m, GEN *t, long d, GEN  p, GEN q)
{
  long l,v,dv,av,tetpil;
  GEN w,unmodp;

  dv=lgef(*t)-3; if (dv==d) return;
  v=varn(*t); m=setloop(m); m=incloop(m); 
  unmodp=gmodulsg(1,p); av=avma; 
  for(;;)
  {
    w=gmul(stopoly_gen(m,p,v),unmodp);
    w=gpui(gmodulcp(w,*t),q,0);
    w=gsub((GEN)w[2],unmodp);
    tetpil=avma; w=ggcd(*t,w); l=lgef(w)-3;
    if (l && l!=dv) break;
    avma=av; m=incloop(m);
  }
  w = gerepile(av,tetpil,w);
  l /= d; t[l]=gdiv(*t,w); *t=w;
  splitgen(m,t+l,d,p,q); splitgen(m,t,d,p,q);
}

GEN
factormod0(GEN f, GEN p, long flag)
{
  switch(flag)
  {
    case 0: return factmod(f,p);
    case 1: return simplefactmod(f,p);
    default: err(flagerr);
  }
  return NULL; /* not reached */
}

/*******************************************************************/
/*                                                                 */
/*                Recherche de racines  p-adiques                  */
/*                                                                 */
/*******************************************************************/

/* a etant un p-adique, retourne le vecteur des racines p-adiques de f
 * congrues a a modulo p dans le cas ou on suppose f(a) congru a 0 modulo p
 * (ou a 4 si p=2).
 */
#define gmaxval(x,y) (gcmp0(x)?BIGINT:ggval(x,y))
GEN
apprgen(GEN f, GEN a)
{
  GEN fp,p1,p,pro,idiot,idiot2,u,ip,quatre;
  long av=avma,tetpil,v,vv,ps,i,j,k,lu,n,fl2;

  if (typ(f)!=t_POL) err(notpoler,"apprgen");
  if (gcmp0(f)) err(zeropoler,"apprgen");
  if (typ(a) != t_PADIC) err(rootper1);
  v=varn(f); fp=deriv(f,v); p1=ggcd(f,fp);
  if (lgef(p1)>3) { f=gdiv(f,p1); fp=deriv(f,v); }
  p=(GEN)a[2]; p1=poleval(f,a); 
  vv=gmaxval(p1,p); if (vv <= 0) err(rootper2);
  fl2=gegal(p,gdeux);
  if (fl2)
  { 
    if (vv==1) err(rootper2);
    quatre=stoi(4);
  }
  vv=gmaxval(poleval(fp,a),p);
  if (!vv) /* simple zero */
  {
    while (!gcmp0(p1))
    { 
      a = gsub(a,gdiv(p1,poleval(fp,a)));
      p1 = poleval(f,a);
    }
    tetpil=avma; pro=cgetg(2,t_VEC); pro[1]=lcopy(a);
    return gerepile(av,tetpil,pro);
  }
  n=lgef(f)-3; pro=cgetg(n+1,t_VEC);
  p1=poleval(f,gadd(a,gmul(fl2?quatre:p,polx[v])));
  if (!gcmp0(p1)) p1=gdiv(p1,gpuigs(p,ggval(p1,p)));

  if (gcmpgs(p,VERYBIGINT)>0) err(impl,"apprgen for p>=2^31");
  idiot=gsub(a,a);
  if (fl2)
  {
    ps=4; idiot2=ggrandocp(p,2); p=quatre;
  }
  else
  {
    ps=itos(p); idiot2=ggrandocp(p,1);
  }
  for (j=0,i=0; i<ps; i++)
  {
    ip=stoi(i);
    if (gcmp0(poleval(p1,gadd(ip,idiot2))))
    {
      u=apprgen(p1,gadd(idiot,ip)); lu=lg(u);
      for (k=1; k<lu; k++)
      { 
	j++; pro[j]=ladd(a,gmul(p,(GEN)u[k]));
      }
    }
  }
  tetpil=avma; setlg(pro,j+1);
  return gerepile(av,tetpil,gcopy(pro));
}

/* Retourne le vecteur des racines p-adiques de f en precision r */
GEN
rootpadic(GEN f, GEN p, long r)
{
  GEN y,fp,pro,yi,p1,pr,rac;
  long v,lx,i,j,k,n,av=avma,tetpil,fl2;

  if (typ(f)!=t_POL) err(notpoler,"rootpadic");
  if (gcmp0(f)) err(zeropoler,"rootpadic");
  if (r<=0) err(rootper4);
  v=varn(f); fp=deriv(f,v); p1=ggcd(f,fp);
  if (lgef(p1)>3) { f=gdiv(f,p1); fp=deriv(f,v); }
  fl2=gegal(p,gdeux); rac=(fl2 && r>=2)? rootmod(f,stoi(4)): rootmod(f,p);
  lx=lg(rac); p=gclone(p);
  if (r==1)
  {
    tetpil=avma; y=cgetg(lx,t_COL);
    for (i=1; i<lx; i++)
    {
      p1=(GEN)rac[i]; yi=cgetg(5,t_PADIC); yi[2]=(long)p; yi[3]=(long)p;
      yi[4]=lcopy((GEN)p1[2]); yi[1]=evalprecp(1)+HIGHVALPBIT; y[i]=(long)yi;
    }
    return gerepile(av,tetpil,y);
  }
  n=lgef(f)-3; pro=cgetg(n+1,t_VEC);
  j=0; pr = NULL;
  for (i=1; i<lx; i++)
  {
    p1=gmael(rac,i,2); yi=cgetg(5,t_PADIC); yi[2]=(long)p;
    if (signe(p1))
    {
      if (!pr) pr=gpuigs(p,r);
      yi[3]=(long)pr;
      if (!fl2 || mpodd(p1))
      {
	yi[4]=(long)p1; yi[1]=HIGHVALPBIT+evalprecp(r);
      }
      else
      {
	yi[4]=un; yi[1]=HIGHVALPBIT+1+evalprecp(r);
      }
    }
    else { yi[3]=un; yi[4]=zero; yi[1]=HIGHVALPBIT+r; }
    p1=apprgen(f,yi); for (k=1; k<lg(p1); k++) pro[++j]=p1[k];
  }
  tetpil=avma; setlg(pro,j+1);
  return gerepile(av,tetpil,gcopy(pro));
}

/* a usage interne. Pas de verifs ni de gestion de pile. On suppose que f est
 * un polynome a coeffs dans Z de degre n ayant n racines distinctes mod p, et
 * p>2, r>=2. On rend les n racines p-adiques en precision r si flall>0,
 * 1 seule si flall=0
 */
GEN
rootpadicfast(GEN f, GEN p, long r, long flall)
{
  long i,e,e1,n;
  GEN fa,fp,y,yi,p1,p2;

  fa=rootmod(f,p); n=flall?lgef(f)-3:1;
  fp=deriv(f,varn(f)); y=cgetg(n+1,t_VEC);
  p=gclone(p); p2=NULL;
  for (i=1; i<=n; i++)
  {
    p1=(GEN)fa[i]; yi=cgetg(5,t_PADIC); yi[2]=(long)p;
    if (signe(p1[2]))
    { 
      if (!p2) p2=gsqr(p);
      yi[3]=(long)p2; yi[1]=HIGHVALPBIT+evalprecp(2);
    }
    else { yi[3]=un; yi[1]=evalvalp(2); }
    e=1; e1=2; yi[4]=p1[2];
    do
    {
      yi=gsub(yi,gdiv(poleval(f,yi),poleval(fp,yi)));
      e=e1; if (e<r) { e1<<=1; if (e1>r) e1=r; yi=gprec(yi,e1); }
    }
    while (e<r);
    y[i]=(long)yi;
  }
  return y;
}

static long
getprec(GEN x, long prec, GEN *p)
{
  long i,e;
  GEN p1;

  for (i = lgef(x)-1; i>1; i--)
  {
    p1=(GEN)x[i];
    if (typ(p1)==t_PADIC)
    {
      e=valp(p1); if (signe(p1[4])) e += precp(p1);
      if (e<prec) prec = e; *p = (GEN)p1[2];
    }
  }
  return prec;
}

/* a appartenant a une extension finie de Q_p, retourne le vecteur des
 * racines de f congrues a a modulo p dans le cas ou on suppose f(a) congru a
 * 0 modulo p (ou a 4 si p=2).
 */
GEN
apprgen9(GEN f, GEN a)
{
  GEN fp,p1,p,pro,idiot,idiot2,u,ip,t,vecg,quatre;
  long av=avma,tetpil,v,vv,ps_1,i,j,k,lu,n,prec,d,va,fl2;

  if (typ(f)!=t_POL) err(notpoler,"apprgen9");
  if (gcmp0(f)) err(zeropoler,"apprgen9");
  if (typ(a)==t_PADIC) return apprgen(f,a);
  if (typ(a)!=t_POLMOD || typ(a[2])!=t_POL) err(rootper1);
  v=varn(f); fp=deriv(f,v); p1=ggcd(f,fp);
  if (lgef(p1)>3) { f=gdiv(f,p1); fp=deriv(f,v); }
  t=(GEN)a[1];
  prec = getprec((GEN)a[2], BIGINT, &p);
  prec = getprec(t, prec, &p);
  if (prec==BIGINT) err(rootper1);

  p1=poleval(f,a); vv=gmaxval(lift(p1),p); if (vv<=0) err(rootper2);
  fl2=gegal(p,gdeux);
  if (fl2)
  {
    if (vv==1) err(rootper2);
    quatre=stoi(4); 
  } 
  vv=gmaxval(lift(poleval(fp,a)),p);
  if (!vv)
  {
    while (!gcmp0(p1))
    { 
      a = gsub(a,gdiv(p1,poleval(fp,a)));
      p1 = poleval(f,a);
    }
    tetpil=avma; pro=cgetg(2,t_COL); pro[1]=lcopy(a);
    return gerepile(av,tetpil,pro);
  }
  n=lgef(f)-3; pro=cgetg(n+1,t_COL); j=0;
  p1=poleval(f,gadd(a,gmul(fl2?quatre:p,polx[v])));
  if (!gcmp0(p1)) p1=gdiv(p1,gpuigs(p,ggval(p1,p)));

  if (gcmpgs(p,VERYBIGINT)>0) err(impl,"apprgen9 for p>=2^31");
  idiot=gmodulcp(ggrandocp(p,prec), t);
  if (fl2)
  {
    ps_1=3; idiot2=ggrandocp(p,2); p=quatre;
  }
  else
  {
    ps_1=itos(p)-1; idiot2=ggrandocp(p,1);
  }
  d=lgef(t)-3; vecg=cgetg(d+1,t_COL);
  for (i=1; i<=d; i++) vecg[i]=zero;
  va=varn(t);
  for(;;)
  {
    ip=gmodulcp(gtopoly(vecg,va),t);
    if (gcmp0(poleval(p1,gadd(ip,idiot2))))
    {
      u=apprgen9(p1,gadd(ip,idiot)); lu=lg(u);
      for (k=1; k<lu; k++)
      { 
        j++; pro[j]=ladd(a,gmul(p,(GEN)u[k]));
      }
    }
    i=d; while (i && !cmpis((GEN)vecg[i],ps_1)) i--;
    if (!i) break;

    vecg[i]=laddsi(1,(GEN)vecg[i]);
  }
  tetpil=avma; setlg(pro,j+1);
  return gerepile(av,tetpil,gcopy(pro));
}

/*****************************************/
/*  Factorisation p-adique d'un polynome */
/*****************************************/

/* factorise le polynome T=nf[1] dans Zp avec la precision pr */
static GEN
padicff2(GEN nf,GEN p,long pr)
{
  long N=lgef(nf[1])-3,i,j,k,dim_pke,d,l;
  GEN mat,mat_pe,mat_smith,mat_smith1,mat_smith2,facteur;
  GEN vecteur,pk,dec_p,mat_pke,mat_a,theta,mat_theta;

  pk=gpuigs(p,pr); dec_p=primedec(nf,p);
  l=lg(dec_p); facteur=cgetg(l,t_COL);
  for (i=1; i<l; i++)
  {
    vecteur=element_pow(nf,gmael(dec_p,i,2),gmael(dec_p,i,3));
    mat_pe=cgetg(N+1,t_MAT);
    for (j=1; j<=N; j++) mat_pe[j]=(long)element_mulid(nf,vecteur,j);
    mat_pe=hnfmodid(concatsp(mat_pe,gscalmat(p,N)), p);
    mat_pke=mat_pe;
    for (j=1; j<pr; j++) mat_pke=idealmul(nf,mat_pe,mat_pke);
    dim_pke=lg(mat_pke)-1;
    mat_smith=smith2(mat_pke);
    mat_smith1=(GEN)mat_smith[3]; mat_smith2=(GEN)mat_smith[1];
    j=1; while (j<dim_pke && gegal(gcoeff(mat_smith1,j,j),pk)) j++;
    if (gegal(gcoeff(mat_smith1,j,j),pk)) d=j+1; else d=j;
    mat_a=ginv(mat_smith2);
    theta=gmael(nf,8,2);
    mat=cgetg(d,t_MAT);
    for (j=1; j<d; j++)
      mat[j]=(long)element_mul(nf,theta,(GEN)mat_a[j]);
    mat=inverseimage(mat_a,mat); mat_theta=cgetg(d,t_MAT);
    for (j=1; j<d; j++)
    { 
      mat_theta[j]=lgetg(d,t_COL);
      for (k=1; k<d; k++)
	coeff(mat_theta,k,j)=coeff(mat,k,j);
    }
    facteur[i]=(long)caradj(mat_theta,0,NULL);
  }
  return facteur;
}

static GEN
padicff(GEN x,GEN p,long pr)
{
  GEN p1,p3,p5,dx,nf,mat,un_padic;
  long N=lgef(x)-3,av=avma,tetpil,i,j;

  nf=cgetg(10,t_VEC); nf[1]=(long)x; dx=discsr(x);
  mat=cgetg(3,t_MAT); mat[1]=lgetg(3,t_COL); mat[2]=lgetg(3,t_COL);
  coeff(mat,1,1)=(long)p; coeff(mat,1,2)=lstoi(ggval(dx,p));
  coeff(mat,2,1)=ldiv(dx,gpuigs(p,ggval(dx,p))); coeff(mat,2,2)=un;
  p3=allbase4(x,(long)mat,(GEN*)(nf+3),NULL);
  if (!carrecomplet(divii(dx,(GEN)nf[3]),(GEN*)(nf+4))) 
    err(bugparier,"factorpadic2 (incorect discriminant)");
  p1=make_base(N,p3);
  p5=cgetg(N*N+1,t_MAT);
  for (j=1; j<=N*N; j++)
  {
    p5[j]=lgetg(N+1,t_COL);
    for (i=1; i<=N; i++)
      coeff(p5,i,j)=(long)truecoeff(gmod(gmul((GEN)p3[(j-1)%N+1],(GEN)p3[((j-1)/N)+1]),x),i-1);
  }
  nf[7]=(long)p3;
  nf[8]=linv(p1);
  nf[9]=lmul((GEN)nf[8],p5); nf[2]=nf[5]=nf[6]=zero;
  un_padic=cgetg(5,t_PADIC); un_padic[2]=lclone(p); un_padic[3]=lpuigs(p,pr);
  un_padic[4]=un; un_padic[1]=HIGHVALPBIT+evalprecp(pr);
  p1=padicff2(nf,p,pr); tetpil=avma;
  return gerepile(av,tetpil,gmul(p1,un_padic));
}

GEN
factorpadic2(GEN x, GEN p, long r)
{
  long av=avma,av2,vv,k,i,j,i1,f,nbfac;
  GEN res,p1,p2,y,d,fa[100],a,ap,t,v,w;

  if (typ(x)!=t_POL) err(notpoler,"factorpadic2");
  if (gcmp0(x)) err(zeropoler,"factorpadic2");
  if (r<=0) err(rootper4);
  y=cgetg(3,t_MAT); 
  if (lgef(x)==3) { y[1]=lgetg(1,t_COL); y[2]=lgetg(1,t_COL); return y; }
  if (lgef(x)==4)
  {
    p1=cgetg(2,t_COL); y[1]=(long)p1; p1[1]=lcopy(x);
    p1=cgetg(2,t_COL); y[2]=(long)p1; p1[1]=un; return y;
  }
  d=content(x); vv=varn(x); a=gdiv(x,d);
  ap=deriv(a,vv); t=ggcd(a,ap); v=gdiv(a,t);
  w=gdiv(ap,t); j=0; f=1; nbfac=0;
  while (f)
  {
    j++; w=gsub(w,deriv(v,vv)); f=signe(w);
    if (f) { res=ggcd(v,w); v=gdiv(v,res); w=gdiv(w,res); }
    else res=v;
    fa[j]=(lgef(res)>3) ? padicff(res,p,r) : cgetg(1,t_COL);
    nbfac += (lg(fa[j])-1);
  }
  av2=avma; y=cgetg(3,t_MAT); p1=cgetg(nbfac+1,t_COL); y[1]=(long)p1;
  p2=cgetg(nbfac+1,t_COL); y[2]=(long)p2;
  for (i=1,k=0; i<=j; i++)
    for (i1=1; i1<lg(fa[i]); i1++)
    {
      p1[++k]=lcopy((GEN)fa[i][i1]); p2[k]=lstoi(i);
    }
  return gerepile(av,av2,y);
}

/*******************************************************************/
/*                                                                 */
/*                FACTORISATION P-adique avec ROUND 4              */
/*                                                                 */
/*******************************************************************/

static GEN
Decomppadic(GEN p,long r,GEN f,long mf,GEN theta,GEN chi,GEN nu)
{
  long valk,j,i,av=avma,tetpil, v=varn(f);
  GEN unmodp,unmodpdrp,unmodpkdr,unmodpr,unpadic;
  GEN pdr,pk,ph,pr,res,b1,b2,b3,a2,a1,e,f1,f2;

  if (DEBUGLEVEL>=3)
  {
    fprintferr(" On entre dans Decomp_padic ");
    if (DEBUGLEVEL>=4)
    {
      fprintferr(" avec les parametres suivants \n ");
      fprintferr(" p="); bruterr(p,'g',-1);
      fprintferr(" precision=%ld",r);
      fprintferr(",  f="); bruterr(f,'g',-1);
      fprintferr(",  exposant=%ld ",mf);
    }
    fprintferr("\n");
  }

  unmodp=gmodulsg(1,p); pr=gpuigs(p,r);
  unmodpr=gmodulsg(1,pr);

  pdr = respm(f, deriv(f,v), gpuigs(p,mf));
  unmodpdrp=gmodulsg(1,mulii(pdr,p));

  b1=gmul(chi,unmodp); a2=gzero; a1=gun;
  b2=unmodp; b3=gmul(nu,unmodp);
  while (lgef(b3) > 3)
  {
    b1=gdivent(b1,b3); b2=gmul(b2,b3);
    b3=lift(gbezout(b2,b1,&a1,&a2));
  }
  e=eleval(f,lift(gmul(a1,b2)),theta);

  if (1<=padicprec(e,p))
    e=gdiv(lift(gmul(gmul(pdr,e),unmodpdrp)),pdr);

  pk=p; ph=mulii(pdr, pr); valk = 1;

  /* E(t)-e(t) belongs to p^k Op, which is contained in p^(k-df)*Zp[xi] */

  while (cmpii(pk,ph)==-1)
  {
    e=gmod(gmul(e,gmul(e,gsubsg(3,gmul2n(e,1)))),f);
    pk=gsqr(pk); valk <<= 1;
    unmodpkdr=gmodulsg(1,mulii(pk,pdr));
    if (valk<=padicprec(e,p))
      e=gdiv(lift(gmul(gmul(pdr,e),unmodpkdr)),pdr);
  }
  f1=gcdpm(f,gmul(pdr,gsubsg(1,e)),mulii(pr,pdr));
  f1=lift(gmul(gmod(f1,f),unmodpr));
  f2=gdivent(f,f1); f2=lift(gmul(gmod(f2,f),unmodpr));

  if (DEBUGLEVEL>=4)
  {
    fprintferr(" Decomp : On considere deux nouveaux polynomes : ");
    fprintferr(" f1="); bruterr(f1,'g',-1);
    fprintferr(",  f2="); bruterr(f2,'g',-1);
    fprintferr("\n");
  }
  b1=factorpadic4(f1,p,r);
  b2=factorpadic4(f2,p,r);

  unpadic=cgetg(5,t_PADIC);
  setprecp(unpadic,r); setvalp(unpadic,0); unpadic[2]=(long)p;
  unpadic[3]=(long)pr; unpadic[4]=un;
  tetpil=avma; res=cgetg(3,t_MAT);
  for (j=1; j<=2; j++) { res[j]=lgetg(lg(b1[1])+lg(b2[1])-1,t_COL); }
  for (i=1; i<lg(b1[1]); i++)
  {
    coeff(res,i,1)=lmul(gcoeff(b1,i,1),unpadic);
    coeff(res,i,2)=lcopy(gcoeff(b1,i,2));
  }
  for (i=1; i<lg(b2[1]); i++)
  {
    coeff(res,i+lg(b1[1])-1,1)=lmul(gcoeff(b2,i,1),unpadic);
    coeff(res,i+lg(b1[1])-1,2)=lcopy(gcoeff(b2,i,2));
  }
  return gerepile(av,tetpil,res);
}

static GEN
nilordpadic(GEN p,long r,GEN fx,long mf,GEN gx)
{
  long Da,Na,La,Ma,first,n,v=varn(fx),av=avma,tetpil;
  GEN alpha,chi,nu,eta,w,phi,unpadic;
  GEN pmf,Dchi,unmodpmf,res;

  if (DEBUGLEVEL>=3)
  {
    fprintferr(" On entre dans Nilord_padic ");
    if (DEBUGLEVEL>=4)
    {
      fprintferr(" avec les parametres suivants \n ");
      fprintferr(" p="); bruterr(p,'g',-1);
      fprintferr(",  fx="); bruterr(fx,'g',-1);
      fprintferr(",  exposant=%ld,  gx= ",mf); bruterr(gx,'g',-1);
    }
    fprintferr("\n");
  }

  pmf=gpuigs(p,mf+1); n=lgef(fx)-3;
  alpha=polx[v]; first=1;

  unmodpmf=gmodulsg(1,pmf);
  for(;;)
  {
    if (first) { chi=fx; nu=gx; first=0; }
    else
    {
      w=factcp(p,fx,alpha);
      chi=(GEN)w[1]; nu=(GEN)w[2];
      if (cmpis((GEN)w[3],1)==1)
      {
	tetpil=avma;
	return gerepile(av,tetpil,Decomppadic(p,r,fx,mf,alpha,chi,nu));
      }
    }
    Da=lgef(nu)-3; Na=n/Da;

    if (mf+1<=padicprec(chi,p))
      Dchi=lift(gmul(discsr(lift(gmul(chi,unmodpmf))),unmodpmf));
    else
      Dchi=discsr(chi);

    if (gcmp0(Dchi)) Dchi=discsr(chi);
    if (gcmp0(Dchi))
      alpha=gadd(alpha,gmul(p,polx[v]));
    else
    {
      if (vstar(p,chi)[0] > 0)
	alpha=gadd(alpha,gun);
      else
      { 	
	eta=setup(p,chi,polx[v],nu, &La, &Ma);
	if (La>1)
	  alpha=gadd(alpha,eleval(fx,eta,alpha));
	else
	{
	  if (Ma==Na)
	  {
	    unpadic=cgetg(5,t_PADIC);
	    setprecp(unpadic,r); setvalp(unpadic,0); unpadic[2]=(long)p;
	    unpadic[3]=lpuigs(p,r); unpadic[4]=un;
	    tetpil=avma;
	    res=cgetg(3,t_MAT); res[1]=lgetg(2,t_COL); res[2]=lgetg(2,t_COL);
	    coeff(res,1,1)=lmul(fx,unpadic); coeff(res,1,2)=un;
	    if (DEBUGLEVEL>=3)
	    {
	      fprintferr(" On sort de Nilord_padic : Ce cas est fini ");
	      if (DEBUGLEVEL>=4)
	      {
		fprintferr(" avec les parametres suivants \n ");
		fprintferr(" p="); bruterr(p,'g',-1);
		fprintferr(",  fx="); bruterr(fx,'g',-1);
		fprintferr(",  alpha="); bruterr(alpha,'g',-1);
		fprintferr(",  chi="); bruterr(chi,'g',-1);
	      }
	      fprintferr("\n");
	    }
	    return gerepile(av,tetpil,res);
	  }
	  w=bsrch(p,chi,ggval(Dchi,p),eta,Ma);
	  phi=eleval(fx,(GEN)w[2],alpha);
	  if (gcmp1((GEN)w[1]))
	  {
	    tetpil=avma;
	    return gerepile(av,tetpil,
                            Decomppadic(p,r,fx,mf,phi,(GEN)w[3],(GEN)w[4]));
	  }
	  alpha=phi;
	}
      }
    }
  }
}

static GEN
squarefree(GEN f, GEN *ex)
{
  GEN T,V,W,A,B;
  long n,i,k;

  T=ggcd(deriv(f,varn(f)),f); V=gdiv(f,T);
  n=lgef(f)-2; A=cgetg(n,t_COL); B=cgetg(n,t_COL);
  k=1; i=1;
  do
  {
    W=ggcd(T,V); T=gdiv(T,W);
    if (lgef(V) != lgef(W))
    { 
      A[i]=ldiv(V,W); B[i]=k; i++;
    }
    k++; V=W;
  }
  while (lgef(V)>3);
  setlg(A,i); *ex=B; return A;
}

GEN
factorpadic4(GEN f,GEN p,long r)
{
  GEN w,g,poly,fx,resint,res,y,p1,unpadicr,ex;
  long v=varn(f),n=lgef(f)-3,av=avma,tetpil,mfx,nbpoly,i,k,j,m;

  if (typ(f)!=t_POL) err(notpoler,"factorpadic4");
  if (gcmp0(f)) err(zeropoler,"factorpadic4");
  if (r<=0) err(rootper4);

  y=cgetg(3,t_MAT);
  if (lgef(f)==3) { y[1]=lgetg(1,t_COL); y[2]=lgetg(1,t_COL); return y; }
  if (lgef(f)==4)
  {
    p1=cgetg(2,t_COL); y[1]=(long)p1; p1[1]=lcopy(f);
    p1=cgetg(2,t_COL); y[2]=(long)p1; p1[1]=un;
    return y;
  }
  j=1;
  poly=squarefree(f,&ex);
  nbpoly=lg(poly)-1;
  res=cgetg(3,t_MAT); res[1]=lgetg(n+1,t_COL); res[2]=lgetg(n+1,t_COL);
  for (i=1; i<=nbpoly; i++)
  {
    fx=(GEN)poly[i];
    mfx=ggval(discsr(fx),p);
    m=(r<=mfx)?mfx+1:r;
    w=factmod(fx,p);
    g=bestnu((GEN)w[1]);
    if (lg(w[1])==2)
      resint=nilordpadic(p,m,fx,mfx,g);
    else
      resint=Decomppadic(p,m,fx,mfx,polx[v],fx,g);
    for (k=1; k<lg(resint[1]); k++)
    {
      coeff(res,j,1)=coeff(resint,k,1);
      coeff(res,j,2)=lmulis(gcoeff(resint,k,2),ex[i]);
      j++;
    }
  }
  setlg(res[1],j); setlg(res[2],j);
  if (r==m) { tetpil=avma; y=cgetg(3,t_MAT); y[1]=lcopy((GEN)res[1]); }
  else
  {
    unpadicr=cgetg(5,t_PADIC); setprecp(unpadicr,r); setvalp(unpadicr,0);
    unpadicr[2]=(long)p; unpadicr[3]=(long)gpuigs(p,r); unpadicr[4]=un;
    tetpil=avma; y=cgetg(3,t_MAT); y[1]=lmul((GEN)res[1],unpadicr);
  }
  y[2]=lcopy((GEN)res[2]); return gerepile(av,tetpil,y);
}

GEN
factorpadic0(GEN f,GEN p,long r,long flag)
{
  switch(flag)
  {
     case 0: return factorpadic4(f,p,r);
     case 1: return factorpadic2(f,p,r);
     default: err(flagerr);
  }
  return NULL; /* not reached */
}

/*******************************************************************/
/*                                                                 */
/*                     FACTORISATION DANS F_q                      */
/*                                                                 */
/*******************************************************************/

static GEN
stopoly9s(long m, long p, long q, long v, GEN a)
{
  long c[100],d[100],l1,i,j, l=2, va=varn(a);
  GEN y,p2;

  do { c[l++] = m % q; m /= q; } while (m);
  y=cgetg(l,t_POL); y[1]=evalsigne(1) | evallgef(l) | evalvarn(v);
  for (i=2; i<l; i++)
  {
    m=c[i]; l1=2;
    do { d[l1++] = m % p; m /= p; } while (m);
    p2=cgetg(l1,t_POL); p2[1]=evalsigne(1) | evallgef(l1) | evalvarn(va);
    for (j=2; j<l1; j++) p2[j]=lstoi(d[j]);
    y[i]=lmodulcp(p2,a);
  }
  return y;
}

/* renvoie un polynome de la variable v
dont les coef sont les digits de m en base qq */
static GEN
stopoly9(GEN m, long p, GEN qq, long v, GEN a)
{
  GEN y,p1,p2,r,c[1000],d[1000];
  long l,l1,i,j,va;

  i = m[2];
  if (lgefint(m)==3 && (ulong)i < HIGHBIT)
    return stopoly9s(i,p,itos(qq),v,a);
  l=2, va=varn(a);
  do { m=dvmdii(m,qq,&r); c[l++]=r; } while (signe(m));
  y=cgetg(l,t_POL); y[1]=evalsigne(1) | evallgef(l) | evalvarn(v);
  for (i=2; i<l; i++)
  {
    p1=c[i]; l1=2;
    do { p1=dvmdis(p1,p,&r); d[l1++]=r; } while (signe(p1));
    p2=cgetg(l1,t_POL); p2[1]=evalsigne(1) | evallgef(l1) | evalvarn(va);
    for (j=2; j<l1; j++) p2[j]=(long)d[j];
    y[i]=lmodulcp(p2,a);
  }
  return y;
}

/* renvoie un polynome aleatoire de la variable v
de degre inferieur ou egal a 2*d1-1 */
static GEN
stopoly92(long d1, long v, GEN a, GEN *ptres)
{
  GEN y,p2;
  long p1,l1,i,j,d2,l,va=varn(a),c[1000],d[1000],k=lgef(a)-3,nsh;

  c[1]=1; d2=d1+d1+1;
  nsh=BITS_IN_RANDOM-1-k; if (nsh<=0) nsh=1;
  do
  {
    for (l=2; l<=d2; l++) c[l] = mymyrand() >> nsh;
    l=d2; while (!c[l]) l--;
  }
  while (l<=2);
  l++; y=cgetg(l,t_POL); c[1] = mymyrand() >> nsh;
  for (i=1; i<l; i++)
  {
    p1=c[i]; l1=2;
    do { d[l1++]=(p1&1)?un:zero; p1>>=1; } while (p1);
    p2=cgetg(l1,t_POL); p2[1]=evalsigne(1) | evallgef(l1) | evalvarn(va);
    for (j=2; j<l1; j++) p2[j]=d[j];
    y[i]=lmodulcp(p2,a);
  }
  *ptres=(GEN)y[1];
  y[1]=evalsigne(1) | evallgef(l) | evalvarn(v); return y;
}

static void
split9(GEN m, GEN *t, long d, long p, GEN q, GEN unfq, GEN qq, GEN a)
{
  long l,dv,v,av,tetpil;
  GEN w,w0,res;

  dv=lgef(*t)-3; if (dv==d) return;
  v=varn(*t); m=setloop(m); m=incloop(m); av=avma;
  for(;;)
  {
    if (p==2)
    {
      w0=w=gmul(stopoly92(d,v,a,&res),unfq);
      for (l=1; l<d; l++) w=gmod(gadd(w0,gpui(w,qq,0)),*t);
      w=gsub(w,res);
    }
    else
    {
      w=gmul(stopoly9(m,p,qq,v,a),unfq);
      w=gpui(gmodulcp(w,*t),q,0); 
      w=gsub((GEN)w[2],unfq);
    }
    tetpil=avma; w=ggcd(*t,w); l=lgef(w)-3;
    if (l && l!=dv) break;
    avma=av; if (p!=2) m=incloop(m);
  }
  w = gerepile(av,tetpil,w);
  l /= d; t[l]=gdiv(*t,w); *t=w;
  split9(m,t+l,d,p,q,unfq,qq,a); split9(m,t,d,p,q,unfq,qq,a);
}

GEN
factmod9(GEN f, GEN pp, GEN a)
{
  long p,i,j,k,d,e,vf,va,expos[100],nbfact,nbf,av,pk,tetpil;
  GEN y,t[100],f2,f3,df1,df2,g,g1;
  GEN xmod,u,v,pd,q,qq,unfp,unfq;

  if (typ(a)!=t_POL || typ(f)!=t_POL ||gcmp0(f)||gcmp0(a)) err(factmoder);
  if (lgef(f)==3)
  { 
    y=cgetg(3,t_MAT); y[1]=lgetg(1,t_COL); y[2]=lgetg(1,t_COL);
    return y;
  }
  vf=varn(f); va=varn(a);
  if (va<=vf) err(talker,"polynomial variable must be of higher priority than finite field\nvariable in factfq");
  av=avma; p=itos(pp); unfp=gmodulss(1,p);
  a=gmul(unfp,a); unfq=gmodulcp(gmul(unfp,polun[va]),a);
  f=gmul(unfq,f); qq=gpuigs(pp,lgef(a)-3);

  e = nbfact = 1; pk=1; df1=deriv(f,vf); f3=NULL;
  for(;;)
  {
    while (gcmp0(df1))
    {
      pk *= p; e=pk;
      j=(lgef(f)-3)/p+3; f2=cgetg(j,t_POL);
      f2[1] = evalsigne(1) | evallgef(j) | evalvarn(vf);
      for (i=2; i<j; i++) f2[i]=f[p*(i-2)+2];
      f=f2; df1=deriv(f,vf); f3=NULL;
    }
    f2 = f3? f3: ggcd(f,df1);
    if (lgef(f2)==3) u=f;
    else
    {
      g1=gdiv(f,f2); df2=deriv(f2,vf);
      if (gcmp0(df2)) { u=g1; f3=f2; }
      else
      {
	f3=ggcd(f2,df2);
	if (lgef(f3)==3) u=gdiv(g1,f2);
	else
	  u=gdiv(g1,gdiv(f2,f3));
      }
    }
   /*  Ici u est square-free (produit des facteurs premiers de meme
    *  multiplicite e). On cherche le produit des facteurs de meme degre d
    */
    pd=gun; xmod=gmodulcp(polx[vf],u); v=xmod;
    for (d=1; d <= (lgef(u)-3)>>1; d++)
    {
      pd=mulii(pd,qq); v=gpui(v,qq,0);
      g=ggcd((GEN)gsub(v,xmod)[2],u);
	
      if (lgef(g)>3)
      {
        /* Ici g est produit de pol irred ayant tous le meme degre d; */
	j = nbfact+(lgef(g)-3)/d;
        
        t[nbfact]=g; 
        q=shifti(subis(pd,1),-1);
       /* le premier parametre est un entier variable m qui sera
        * converti en un polynome w dont les coeff sont ses digits en
        * base p (initialement m = p --> X) pour faire pgcd de g avec
        * w^(p^d-1)/2 jusqu'a casser.
        */
	split9(qq,t+nbfact,d,p,q,unfq,qq,a);
	for (; nbfact<j; nbfact++) expos[nbfact]=e;
	u=gdiv(u,g); v=gmodulcp((GEN)v[2],u);
      }
    }
    if (lgef(u)>3) { t[nbfact]=u; expos[nbfact++]=e; }
    if (lgef(f2) == 3) break;

    f=f2; df1=df2; e += pk;
  }

  nbf=nbfact; tetpil=avma;
  for (j=1; j<nbfact; j++)
  {
    t[j]=gdiv((GEN)t[j],leading_term(t[j]));
    for (k=1; k<j; k++)
      if (expos[k] && gegal(t[j],t[k]))
      { 
        expos[k] += expos[j]; expos[j]=0;
        nbf--; break;
      }
  }
  y=cgetg(3,t_MAT);
  u=cgetg(nbf,t_COL); y[1]=(long)u;
  v=cgetg(nbf,t_COL); y[2]=(long)v;
  for (j=1,k=0; j<nbfact; j++)
    if (expos[j])
    {
      k++;
      u[k]=(long)t[j];
      v[k]=lstoi(expos[j]);
    }
  return gerepile(av,tetpil,y);
}

/* A PARTIR DE LA TOUT EST A VIRER (remplace par rootpol.c). */

/*******************************************************************/
/*                                                                 */
/*                         RACINES COMPLEXES                       */
/*        l represente la longueur voulue pour les parties         */
/*            reelles et imaginaires des racines de x              */
/*                                                                 */
/*******************************************************************/

static GEN gnorml1(GEN x, long PREC);
static GEN laguer(GEN pol,long N,GEN y0,GEN EPS,long PREC);
static GEN square_free_factorization(GEN pol);
static GEN zrhqr(GEN a,long PREC);

GEN
rootsold(GEN x, long l)
{
  long av1=avma,i,j,f,g,gg,fr,deg,l0,l1,l2,l3,l4,ln;
  long exc,expmin,m,deg0,k,ti,h,ii,e,e1,emax,v;
  GEN y,xc,xd0,xd,xdabs,p1,p2,p3,p4,p5,p6,p7,p8;
  GEN p9,p10,p11,p12,p14,p15,pa,pax,pb,pp,pq,ps;

  if (typ(x)!=t_POL) err(typeer,"rootsold");
  v=varn(x); deg0=lgef(x)-3; expmin=((2-l)<<TWOPOTBITS_IN_LONG)+12;
  if (!signe(x)) err(zeropoler,"rootsold");
  y=cgetg(deg0+1,t_COL); if (!deg0) return y;
  for (i=1; i<=deg0; i++)
  {
    p1=cgetg(3,t_COMPLEX); p1[1]=lgetr(l); p1[2]=lgetr(l); y[i]=(long)p1;
    for (j=3; j<l; j++) ((GEN)p1[2])[j]=((GEN)p1[1])[j]=0;
  }
  g=1; gg=1; f=1;
  for (i=2; i<=deg0+2; i++)
  {
    ti=typ(x[i]);
    if (ti==t_REAL) gg=0;
    else if (ti==t_QUAD)
    { 
      p2=gmael3(x,i,1,2); 
      if (gsigne(p2)>0) g=0;
    } else if (ti != t_INT && ti != t_INTMOD && !is_frac_t(ti)) g=0;
  }
  l1=avma; p2=cgetg(3,t_COMPLEX);
  p2[1]=lmppi(DEFAULTPREC); p2[2]=ldivrs((GEN)p2[1],10);
  p11=cgetg(4,t_POL); p11[1]=evalsigne(1)+evallgef(4);
  setvarn(p11,v); p11[3]=un;

  p12=cgetg(5,t_POL); p12[1]=evalsigne(1)+evallgef(5);
  setvarn(p12,v); p12[4]=un;
  for (i=2; i<=deg0+2 && gcmp0((GEN)x[i]); i++) gaffsg(0,(GEN)y[i-1]);
  k=i-2;
  if (k!=deg0)
  {
    if (k)
    {
      j=deg0+3-k; pax=cgetg(j,t_POL);
      pax[1]=evalsigne(1)+evallgef(j); setvarn(pax,v);
      for (i=2; i<j; i++) pax[i]=x[i+k];
    }
    else pax=x;
    xd0=deriv(pax,v); m=1; pa=pax;
    if (gg) { pp=ggcd(pax,xd0); h=isnonscalar(pp); if (h) pq=gdeuc(pax,pp); }
    else{ pp=gun; h=0; }
    do
    {
      if (h)
      {
        pa=pp; pb=pq; pp=ggcd(pa,deriv(pa,v)); h=isnonscalar(pp);
        if (h) pq=gdeuc(pa,pp); else pq=pa; ps=gdeuc(pb,pq);
      }
      else ps=pa;
          /* calcul des racines d'ordre exactement m */
      deg=lgef(ps)-3;
      if (deg)
      {
        l3=avma; e=gexpo((GEN)ps[deg+2]); emax=e;
        for (i=2; i<deg+2; i++)
        { 
          p3=(GEN)(ps[i]);
          e1=gexpo(p3); if (e1>emax) emax=e1;
        }
        e=emax-e; if (e<0) e=0; avma=l3; if (ps!=pax) xd0=deriv(ps,v);
        xdabs=cgetg(deg+2,t_POL); xdabs[1]=xd0[1];
        for (i=2; i<deg+2; i++)
        {
          l3=avma; p3=(GEN)xd0[i];
          p4=gabs(greal(p3),l);
          p5=gabs(gimag(p3),l); l4=avma;
          xdabs[i]=lpile(l3,l4,gadd(p4,p5));
        }
        l0=avma; xc=gcopy(ps); xd=gcopy(xd0); l2=avma;
        for (i=1; i<=deg; i++)
        {
          if (i==deg)
          {
            p1=(GEN)y[k+m*i]; gdivz(gneg((GEN)xc[2]),(GEN)xc[3],p1);
            p14=(GEN)(p1[1]); p15=(GEN)(p1[2]);
          }
          else
          {
            p3=gshift(p2,e); p4=poleval(xc,p3); p5=gnorm(p4); exc=0;
            while (exc>= -20)
            {
              p6=poleval(xd,p3); p7=gneg(gdiv(p4,p6)); f=1;
              l3=avma;
              if (gcmp0(p5)) exc= -32;
              else exc=expo(gnorm(p7))-expo(gnorm(p3));
              avma=l3;
              for (j=1; j<=10 && f; j++)
              {
                p8=gadd(p3,p7); p9=poleval(xc,p8); p10=gnorm(p9);
                f=(cmprr(p10,p5)>=0)&&(exc>= -20);
                if (f){ gshiftz(p7,-2,p7); avma=l3; }
              }
              if (f)
              {
                avma=av1;
                if (DEBUGLEVEL)
                {
                  fprintferr("too many iterations in rootsold(): ");
                  fprintferr("using roots2()\n"); flusherr();
                }
                return roots2(x,l);
              }
              else
              {
                GEN *gptr[3];
                p3=p8; p4=p9; p5=p10;
                gptr[0]=&p3; gptr[1]=&p4; gptr[2]=&p5;
                gerepilemanysp(l2,l3,gptr,3);
              }
            }
            p1=(GEN)y[k+m*i]; setlg(p1[1],3); setlg(p1[2],3); gaffect(p3,p1);
            avma=l2; p14=(GEN)(p1[1]); p15=(GEN)(p1[2]);
            for (ln=4; ln<=l; ln=(ln<<1)-2)
            {
              setlg(p14,ln); setlg(p15,ln);
              if (gcmp0(p14)) { settyp(p14,t_INT); p14[1]=2; }
              if (gcmp0(p15)) { settyp(p15,t_INT); p15[1]=2; }
              p4=poleval(xc,p1);
              p5=poleval(xd,p1); p6=gneg(gdiv(p4,p5));
              settyp(p14,t_REAL); settyp(p15,t_REAL);
              gaffect(gadd(p1,p6),p1); avma=l2;
            }
          }
          setlg(p14,l); setlg(p15,l);
          p7=gcopy(p1); p14=(GEN)(p7[1]); p15=(GEN)(p7[2]);
          setlg(p14,l+1); setlg(p15,l+1);
          if (gcmp0(p14)) { settyp(p14,t_INT); p14[1]=2; }
          if (gcmp0(p15)) { settyp(p15,t_INT); p15[1]=2; }
          for (ii=1; ii<=5; ii++)
          {
            p4=poleval(ps,p7); p5=poleval(xd0,p7);
            p6=gneg(gdiv(p4,p5)); p7=gadd(p7,p6);
            p14=(GEN)(p7[1]); p15=(GEN)(p7[2]);
            if (gcmp0(p14)) { settyp(p14,t_INT); p14[1]=2; }
            if (gcmp0(p15)) { settyp(p15,t_INT); p15[1]=2; }
          }
          gaffect(p7,p1); p4=poleval(ps,p7);
          p6=gdiv(p4,poleval(xdabs,gabs(p7,l)));
          if (gexpo(p6)>=expmin)
          {
            avma=av1;
            if (DEBUGLEVEL)
            {
              fprintferr("internal error in rootsold(): using roots2()\n");
              flusherr();
            }
            return roots2(x,l);
          }
          avma=l2;
          if (expo(p1[2])<expmin && g)
          {
            gaffect(gzero,(GEN)p1[2]);
            for (j=1; j<m; j++) gaffect(p1,(GEN)y[k+(i-1)*m+j]);
            p11[2]=lneg((GEN)p1[1]);
            l4=avma; xc=gerepile(l0,l4,gdeuc(xc,p11));
          }
          else
          {
            for (j=1; j<m; j++) gaffect(p1,(GEN)y[k+(i-1)*m+j]);
            if (g)
            {
              p1=gconj(p1);
              for (j=1; j<=m; j++) gaffect(p1,(GEN)y[k+i*m+j]);
              i++;
              p12[2]=lnorm(p1); p12[3]=lmulsg(-2,(GEN)p1[1]); l4=avma;
              xc=gerepile(l0,l4,gdeuc(xc,p12));
            }
            else
            { 
              p11[2]=lneg(p1); l4=avma;
              xc=gerepile(l0,l4,gdeuc(xc,p11));
            }
          }
          xd=deriv(xc,v); l2=avma;
        }
        k=k+deg*m;
      }
      m++;
    }
    while (k!=deg0);
  }
  avma=l1;
  if (deg0>1)
  {
    for (j=2; j<=deg0; j++)
    {
      p1=(GEN)y[j]; if (gcmp0((GEN)p1[2])) fr=0; else fr=1;
      for (k=j-1; k>=1; k--)
      {
        if (gcmp0((GEN)((GEN)y[k])[2])) f=0; else f=1;
        if (f<fr) break;
        if (f==fr && gcmp(gmael(y,k,1),(GEN)p1[1])<=0) break;
        y[k+1]=y[k];
      }
      y[k+1]=(long)p1;
    }
  }
  return y;
}

#if 0 
GEN
rootslong(GEN x, long l)
{
  long av1=avma,i,j,f,g,fr,deg,l0,l1,l2,l3,l4,ln;
  long exc,expmin,m,deg0,k,ti,h,ii,e,e1,emax,v;
  GEN y,xc,xd0,xd,xdabs,p1,p2,p3,p4,p5,p6,p7,p8;
  GEN p9,p10,p11,p12,p14,p15,pa,pax,pb,pp,pq,ps;

  if (typ(x)!=t_POL) err(typeer,"rootslong");
  v=varn(x); deg0=lgef(x)-3; expmin = -bit_accuracy(l)+12;
  if (!signe(x)) err(zeropoler,"rootslong");
  y=cgetg(deg0+1,t_COL); if (!deg0) return y;
  for (i=1; i<=deg0; i++)
  {
    p1=cgetg(3,t_COMPLEX); y[i]=(long)p1;
    p1[1]=lgetr(l); p1[2]=lgetr(l);
    for (j=3; j<l; j++) mael(p1,2,j)=mael(p1,1,j)=0;
  }
  g=1; f=1;
  for (i=2; i<=deg0+2; i++)
  {
    ti=typ(x[i]);
    if (ti==t_QUAD)
    {
      p2=gmael3(x,i,1,2);
      if (gcmpgs(p2,0)>0) g=0;
    }
    else
      if (!is_const_t(ti) || ti==t_PADIC || ti==t_COMPLEX) g=0;
  }
  l1=avma; p2=cgetg(3,t_COMPLEX);
  p2[1]=lmppi(l);
  p2[2]=ldivrs((GEN)p2[1],10);
  p11=cgetg(4,t_POL); p11[1]=evalsigne(1)+evallgef(4); setvarn(p11,v); p11[3]=un;
  p12=cgetg(5,t_POL); p12[1]=evalsigne(1)+evallgef(5); setvarn(p12,v); p12[4]=un;
  for (i=2; (i<=deg0+2)&&(gcmp0((GEN)x[i])); i++)
    gaffsg(0,(GEN)y[i-1]); k=i-2;
  if (k!=deg0)
  {
    if (k)
    {
      j=deg0+3-k; pax=cgetg(j,t_POL); pax[1]=evalsigne(1)+evallgef(j);
      setvarn(pax,v);
      for (i=2; i<j; i++)
	pax[i]=x[i+k];
    }
    else pax=x;
    xd0=deriv(pax,v); pp=ggcd(pax,xd0); m=1; pa=pax;
    h=isnonscalar(pp); if (h) pq=gdeuc(pax,pp);
    do
    {
      if (h)
      {
	pa=pp; pb=pq;
	pp=ggcd(pa,deriv(pa,v)); h=isnonscalar(pp);
	if (h) pq=gdeuc(pa,pp); else pq=pa;
	ps=gdeuc(pb,pq);
      }
      else ps=pa;
	  /* calcul des racines d'ordre exactement m */
      deg=lgef(ps)-3;
      if (deg)
      {
	l3=avma; e=gexpo((GEN)ps[deg+2]); emax=e;
	for (i=2; i<deg+2; i++)
	{
	  p3=(GEN)(ps[i]);
	  if (!gcmp0(p3))
	  {
	    e1=gexpo(p3);
	    if (e1>emax) emax=e1;
	  }
	}
	e=emax-e; if (e<0) e=0; avma=l3;
	if (ps!=pax) xd0=deriv(ps,v);
	xdabs=cgetg(deg+2,t_POL); xdabs[1]=xd0[1];
	for (i=2; i<deg+2; i++)
	{
	  l3=avma; p3=(GEN)xd0[i]; p4=gabs(greal(p3),l);
	  p5=gabs(gimag(p3),l); l4=avma;
	  xdabs[i]=lpile(l3,l4,gadd(p4,p5));
	}
	l0=avma; xc=gcopy(ps); xd=gcopy(xd0); l2=avma;
	for (i=1; i<=deg; i++)
	{
	  if (i==deg)
	  {
	    p1=(GEN)y[k+m*i];
	    gdivz(gneg((GEN)xc[2]),(GEN)xc[3],p1);
	    p14=(GEN)(p1[1]); p15=(GEN)(p1[2]);
	  }
	  else
	  {
	    p3=gshift(p2,e); p4=poleval(xc,p3);
	    p5=gnorm(p4); exc=0;
	    while (exc>= -20)
	    {
	      p6=poleval(xd,p3); p7=gneg(gdiv(p4,p6));
	      f=1; l3=avma; if (gcmp0(p5)) exc= -32;
	      else exc=expo(gnorm(p7))-expo(gnorm(p3));
	      avma=l3;
	      for (j=1; (j<=50)&&f; j++)
	      {
		p8=gadd(p3,p7); p9=poleval(xc,p8);
		p10=gnorm(p9);
		f=(cmprr(p10,p5)>=0)&&(exc>= -20);
		if (f) { gshiftz(p7,-2,p7); avma=l3; }
	      }
	      if (f) err(poler9);
	      else
	      {
		GEN *gptr[3];
		p3=p8; p4=p9; p5=p10;
		gptr[0]=&p3; gptr[1]=&p4; gptr[2]=&p5;
		gerepilemanysp(l2,l3,gptr,3);
	      }
	    }
	    p1=(GEN)y[k+m*i]; gaffect(p3,p1); avma=l2;
	    p14=(GEN)(p1[1]); p15=(GEN)(p1[2]);
	    for (ln=4; ln<=l; ln=(ln<<1)-2)
	    {
	      if (gcmp0(p14))
	      { settyp(p14,t_INT); p14[1]=2; }
	      if (gcmp0(p15))
	      { settyp(p15,t_INT); p15[1]=2; }
	      p4=poleval(xc,p1); p5=poleval(xd,p1);
	      p6=gneg(gdiv(p4,p5));
	      settyp(p14,t_REAL); settyp(p15,t_REAL);
	      gaffect(gadd(p1,p6),p1); avma=l2;
	    }
	  }
	  p7=gcopy(p1);
	  p14=(GEN)(p7[1]); p15=(GEN)(p7[2]);
	  setlg(p14,l+1); setlg(p15,l+1);
	  if (gcmp0(p14))
	  { settyp(p14,t_INT); p14[1]=2; }
	  if (gcmp0(p15))
	  { settyp(p15,t_INT); p15[1]=2; }
	  for (ii=1; ii<=max(32,((e<<TWOPOTBITS_IN_LONG)+2)); ii<<=1)
	  {
	    p4=poleval(ps,p7); p5=poleval(xd0,p7);
	    p6=gneg(gdiv(p4,p5)); p7=gadd(p7,p6);
	    p14=(GEN)(p7[1]); p15=(GEN)(p7[2]);
	    if (gcmp0(p14))
	    { settyp(p14,t_INT); p14[1]=2; }
	    if (gcmp0(p15))
	    { settyp(p15,t_INT); p15[1]=2; }
	  }
	  gaffect(p7,p1); p4=poleval(ps,p7);
	  p6=gdiv(p4,poleval(xdabs,gabs(p7,l)));
	  if ((!gcmp0(p6))&&(gexpo(p6)>=expmin))
	  {
	    avma=av1;
	    if (DEBUGLEVEL)
	    {
	      fprintferr("internal error in roots: using roots2\n"); flusherr();
	    }
	    return roots2(x,l);
	  }
	  avma=l2;
	  if ((expo(p1[2])<expmin)&&g)
	  {
	    gaffect(gzero,(GEN)p1[2]);
	    for (j=1; j<m; j++)
	      gaffect(p1,(GEN)y[k+(i-1)*m+j]);
	    p11[2]=lneg((GEN)p1[1]); l4=avma;
	    xc=gerepile(l0,l4,gdeuc(xc,p11));
	  }
	  else
	  {
	    for (j=1; j<m; j++)
	      gaffect(p1,(GEN)y[k+(i-1)*m+j]);
	    if (g)
	    {
	      p1=gconj(p1);
	      for (j=1; j<=m; j++)
		gaffect(p1,(GEN)y[k+i*m+j]); i++;
	      p12[2]=lnorm(p1);
	      p12[3]=lmulsg(-2,(GEN)p1[1]);
	      l4=avma;
	      xc=gerepile(l0,l4,gdeuc(xc,p12));
	    }
	    else
	    {
	      p11[2]=lneg(p1); l4=avma;
	      xc=gerepile(l0,l4,gdeuc(xc,p11));
	    }
	  }
	  xd=deriv(xc,v); l2=avma;
	}
	k=k+deg*m;
      }
      m++;
    }
    while (k!=deg0);
  }
  avma=l1;
  if (deg0>1)
  {
    for (j=2; j<=deg0; j++)
    {
      p1=(GEN)y[j]; if (gcmp0((GEN)p1[2])) fr=0; else fr=1;
      for (k=j-1; k>=1; k--)
      {
	if (gcmp0((GEN)((GEN)y[k])[2])) f=0; else f=1;
	if (f<fr) break;
	if ((f==fr)&&(gcmp((GEN)((GEN)y[k])[1],(GEN)p1[1])<=0)) break;
	y[k+1]=y[k];
      }
      y[k+1]=(long)p1;
    }
  }
  return y;
}
#endif

GEN
roots2(GEN pol,long PREC)
{
  long av = avma,tetpil,N,flagexactpol,flagrealpol,flagrealrac,ti,i,j;
  long nbpol,k,av1,multiqol,deg,nbroot,fr,f;
  GEN unp,p1,p2,rr,EPS,qol,qolbis,x,b,c,*ad,v,tabqol;

  if (typ(pol)!=t_POL) err(typeer,"roots2");
  if (!signe(pol)) err(zeropoler,"roots2");
  N=lgef(pol)-3;
  if (!N) return cgetg(1,t_COL);
  if (N==1)
  {
    unp=cgetr(PREC); affsr(1,unp);
    p1=gmul(unp,(GEN)pol[3]); p2=gneg(gdiv((GEN)pol[2],p1));
    tetpil=avma; return gerepile(av,tetpil,gcopy(p2));
  }
  EPS=cgetr(3); affsr(1,EPS); flagrealpol=1; flagexactpol=1;
  EPS=gmul2n(EPS,(2-PREC)*BITS_IN_LONG+12);
  for (i=2; i<=N+2; i++)
  {
    ti=typ(pol[i]);
    if (ti!=t_INT && ti!=t_INTMOD && !is_frac_t(ti))
    {
      flagexactpol=0;
      if (ti!=t_REAL) flagrealpol=0;
    }
    if (ti==t_QUAD)
    {
      p1=gmael3(pol,i,1,2);
      flagrealpol = (gsigne(p1)>0)? 0 : 1;
    }
  }
  rr=cgetg(N+1,t_COL);
  for (i=1; i<=N; i++)
  {
    rr[i]=lgetg(3,t_COMPLEX); p1=(GEN)rr[i];
    mael(rr,i,1)=lgetr(PREC); mael(rr,i,2)=lgetr(PREC);
    for (j=3; j<PREC; j++) mael(p1,2,j)=mael(p1,1,j)=0;
  }
  if (flagexactpol) tabqol=square_free_factorization(pol);
  else
  {
    tabqol=cgetg(3,t_MAT);
    tabqol[1]=lgetg(2,t_COL); mael(tabqol,1,1)=un; 
    tabqol[2]=lgetg(2,t_COL); mael(tabqol,2,1)=lcopy(pol);
  }
  nbpol=lg(tabqol[1])-1; nbroot=0;
  for (k=1; k<=nbpol; k++)
  {
    av1=avma; qol=gmael(tabqol,2,k); qolbis=gcopy(qol);
    multiqol=itos(gmael(tabqol,1,k)); deg=lgef(qol)-3;
    for (j=deg; j>=1; j--)
    {
      x=gzero; flagrealrac=0;
      if (j==1) x=gneg(gdiv((GEN)qolbis[2],(GEN)qolbis[3]));
      else
      {
	x=laguer(qolbis,j,x,EPS,PREC);
	if (x == NULL) goto RLAB;
      }
      if (flagexactpol)
      { 
	x=gprec(x,(long)((PREC-1)*pariK));
	x=laguer(qol,deg,x,gmul2n(EPS,-32),PREC+1);
      }
      else x=laguer(qol,deg,x,EPS,PREC);
      if (x == NULL) goto RLAB;

      if (typ(x)==t_COMPLEX &&
	  gcmp(gabs(gimag(x),PREC),gmul2n(gmul(EPS,gabs(greal(x),PREC)),1))<=0)
        { x[2]=zero; flagrealrac=1; }
      else if (j==1 && flagrealpol)
        { x[2]=zero; flagrealrac=1; }
      else if (typ(x)!=t_COMPLEX) flagrealrac=1;

      for (i=1; i<=multiqol; i++) gaffect(x,(GEN)rr[nbroot+i]);
      nbroot+=multiqol;
      if (!flagrealpol || flagrealrac)
      {
        ad = (GEN*) cgeti(j+1);
        for (i=0; i<=j; i++) ad[i]=(GEN)qolbis[i+2];
        b=(GEN)ad[j];
	for (i=j-1; i>=0; i--)
	{ 
          c=(GEN)ad[i]; ad[i]=b;
          b=gadd(gmul((GEN)rr[nbroot],b),c);
        }
	v=cgetg(j+1,t_VEC); for (i=1; i<=j; i++) v[i]=(long)ad[j-i];
        qolbis=gtopoly(v,varn(qolbis));
	if (flagrealpol)
	  for (i=2; i<=j+1; i++) 
            if (typ(qolbis[i])==t_COMPLEX) mael(qolbis,i,2)=zero;
      }
      else
      {
        ad = (GEN*) cgeti(j-1); ad[j-2]=(GEN)qolbis[j+2];
	p1=gmulsg(2,greal((GEN)rr[nbroot])); p2=gnorm((GEN)rr[nbroot]);
	ad[j-3]=gadd((GEN)qolbis[j+1],gmul(p1,ad[j-2]));
	for (i=j-2; i>=2; i--)
          ad[i-2] = gadd((GEN)qolbis[i+2],gsub(gmul(p1,ad[i-1]),gmul(p2,ad[i]))); 
	v=cgetg(j,t_VEC); for (i=1; i<=j-1; i++) v[i]=(long)ad[j-1-i];
	qolbis=gtopoly(v,varn(qolbis));
	for (i=2; i<=j; i++) 
	  if (typ(qolbis[i])==t_COMPLEX) mael(qolbis,i,2)=zero;
	for (i=1; i<=multiqol; i++)
          gaffect(gconj((GEN)rr[nbroot]), (GEN)rr[nbroot+i]);
	nbroot+=multiqol; j--;
      }
    }
    avma=av1;
  }
  for (j=2; j<=N; j++)
  {
    x=(GEN)rr[j]; if (gcmp0((GEN)x[2])) fr=0; else fr=1;
    for (i=j-1; i>=1; i--)
    {
      if (gcmp0(gmael(rr,i,2))) f=0; else f=1;
      if (f<fr) break;
      if (f==fr && gcmp(greal((GEN)rr[i]),greal(x)) <= 0) break;
      rr[i+1]=rr[i];
    }
    rr[i+1]=(long)x;
  }
  tetpil=avma; return gerepile(av,tetpil,gcopy(rr));

 RLAB:
  avma=av;
  for(i=2;i<=N+2;i++)
  { 
    ti=typ(pol[i]);
    if (is_intreal_t(ti) || ti==t_INTMOD) err(poler9);
  }
  if (DEBUGLEVEL)
  {
    fprintferr("too many iterations in roots2() ( laguer() ): \n");
    fprintferr("     real coefficients polynomial, using zrhqr()\n");
    flusherr();
  }
  return zrhqr(pol,PREC);
}

#define MR 8
#define MT 10

static GEN
laguer(GEN pol,long N,GEN y0,GEN EPS,long PREC)
{
  long av = avma, av1,MAXIT,iter,i,j;
  GEN rac,erre,I,x,abx,abp,abm,dx,x1,b,d,f,g,h,sq,gp,gm,g2,*ffrac;

  MAXIT=MR*MT; rac=cgetg(3,t_COMPLEX);
  rac[1]=lgetr(PREC); rac[2]=lgetr(PREC);
  av1 = avma;
  I=cgetg(3,t_COMPLEX); I[1]=un; I[2]=un; 
  ffrac=(GEN*)cgeti(MR+1); for (i=0; i<=MR; i++) ffrac[i]=cgetr(PREC);
  affrr(dbltor(0.0), ffrac[0]); affrr(dbltor(0.5), ffrac[1]);
  affrr(dbltor(0.25),ffrac[2]); affrr(dbltor(0.75),ffrac[3]);
  affrr(dbltor(0.13),ffrac[4]); affrr(dbltor(0.38),ffrac[5]);
  affrr(dbltor(0.62),ffrac[6]); affrr(dbltor(0.88),ffrac[7]);
  affrr(dbltor(1.0),ffrac[8]);
  x=y0;
  for (iter=1; iter<=MAXIT; iter++)
  {
    b=(GEN)pol[N+2]; erre=gnorml1(b,PREC);
    d=gzero; f=gzero; abx=gnorml1(x,PREC);
    for (j=N-1; j>=0; j--)
    {
      f=gadd(gmul(x,f),d); d=gadd(gmul(x,d),b);
      b=gadd(gmul(x,b),(GEN)pol[j+2]);
      erre=gadd(gnorml1(b,PREC),gmul(abx,erre));
    }
    erre=gmul(erre,EPS);
    if (gcmp(gnorml1(b,PREC),erre)<=0)
    {
      gaffect(x,rac); avma = av1; return rac;
    }
    g=gdiv(d,b); g2=gsqr(g); h=gsub(g2, gmul2n(gdiv(f,b),1));
    sq=gsqrt(gmulsg(N-1,gsub(gmulsg(N,h),g2)),PREC);
    gp=gadd(g,sq); gm=gsub(g,sq); abp=gnorm(gp); abm=gnorm(gm);
    if (gcmp(abp,abm)<0) gp=gcopy(gm);
    if (gsigne(gmax(abp,abm))==1)
      dx = gdivsg(N,gp);
    else
      dx = gmul(gadd(gun,abx),gexp(gmulgs(I,iter),PREC));
    x1=gsub(x,dx);
    if (gcmp(gnorml1(gsub(x,x1),PREC),EPS)<0)
    {
      gaffect(x,rac); avma = av1; return rac;
    }
    if (iter%MT) x=gcopy(x1); else x=gsub(x,gmul(ffrac[iter/MT],dx));
  }
  avma=av; return NULL;
}

#undef MR
#undef MT

static GEN
gnorml1(GEN x,long PREC)
{
  long av,tetpil,lx,i;
  GEN p1,p2,s;
  av=avma;
  switch(typ(x))
  {
    case t_INT: case t_REAL: case t_FRAC: case t_FRACN:
      return gabs(x,PREC);

    case t_INTMOD: case t_PADIC: case t_POLMOD: case t_POL:
    case t_SER: case t_RFRAC: case t_RFRACN: case t_QFR: case t_QFI:
      return gcopy(x);

    case t_COMPLEX:
      p1=gabs((GEN)x[1],PREC); p2=gabs((GEN)x[2],PREC); tetpil=avma;
      return gerepile(av,tetpil,gadd(p1,p2));

    case t_QUAD:
      p1=gabs((GEN)x[2],PREC); p2=gabs((GEN)x[3],PREC); tetpil=avma;
      return gerepile(av,tetpil,gadd(p1,p2));

    case t_VEC: case t_COL: case t_MAT:
      lx=lg(x); s=gzero;
      for (i=1; i<lx; i++) s=gadd(s,gnorml1((GEN)x[i],PREC)); tetpil=avma;
      return gerepile(av,tetpil,gcopy(s));
  }
  err(talker,"not a PARI object in gnorml1");
  return NULL; /* not reached */
}

/* retourne une matrice a deux colonnes: la 1ere contient les i tels que A_i
 * non constant, la deuxieme les A_i, telle que pol=A_i1^i1.A_i2^i2...A_in^in.
 * Si pol est constant, retourne la matrice vide.
 */
static GEN
square_free_factorization(GEN pol)
{
  long av,tetpil,deg,i,j,va,m;
  GEN p1,p2,x,t1,v1,t,v,*A;

  if (typ(pol)!=t_POL) err(typeer,"square_free_factorization");
  deg=lgef(pol)-3; if (deg<1) return cgetg(1,t_MAT);
  if (deg==1)
  {
    x=cgetg(3,t_MAT); x[1]=lgetg(2,t_COL); x[2]=lgetg(2,t_COL);
    p1=(GEN)x[1]; p1[1]=un; p2=(GEN)x[2]; p2[1]=lcopy(pol); return x;
  }
  av=avma; va=varn(pol); t1=ggcd(pol,deriv(pol,va));
  if (isscalar(t1))
  {
    avma=av; x=cgetg(3,t_MAT); x[1]=lgetg(2,t_COL); x[2]=lgetg(2,t_COL);
    p1=(GEN)x[1]; p1[1]=un; p2=(GEN)x[2]; p2[1]=lcopy(pol); return x;
  }
  A=(GEN*)cgeti(deg+1); v1=gdeuc(pol,t1); v=v1; i=0;
  while (lgef(v)>3)
    { v=ggcd(t1,v1); i++; A[i]=gdeuc(v1,v); t=gdeuc(t1,v); v1=v; t1=t; }
  m=0; for (j=1; j<=i; j++) if (isnonscalar(A[j])) m++;
  x=cgetg(3,t_MAT); x[1]=lgetg(m+1,t_COL); x[2]=lgetg(m+1,t_COL); m=0;
  for (j=1; j<=i; j++)
    if (isnonscalar(A[j]))
    { 
      m++; p1=(GEN)x[1]; p1[m]=lstoi(j); 
      p2=(GEN)x[2]; p2[m]=(long)A[j];
    }
  tetpil=avma; return gerepile(av,tetpil,gcopy(x));
}

/***********************************************************************/
/**                                                                   **/
/**                     RACINES D'UN POLYNOME                         **/
/**                     A COEFFICIENTS REELS                          **/
/**                                                                   **/
/***********************************************************************/

#define RADIX 1
#define COF 0.95

/* ONLY FOR REAL COEFFICIENTS MATRIX : replace the matrix x with
   a symmetric matrix a with the same eigenvalues */
static GEN
balanc(GEN x)
{
  long av,tetpil,n,last,j,i,sqrdx;
  GEN s,r,g,f,c,cofgen,a;

  av=avma; a=gcopy(x); n=lg(a)-1; sqrdx=RADIX+RADIX; last=0; cofgen=dbltor(COF);
  while (!last)
  {
    last=1;
    for (i=1; i<=n; i++)
    {
      r=c=gzero;
      for (j=1; j<=n; j++)
	if (j!=i){ c=gadd(gabs(gcoeff(a,j,i),0),c); r=gadd(gabs(gcoeff(a,i,j),0),r); }
	if ((!gcmp0(r))&&(!gcmp0(c)))
	{
	  g=gmul2n(r,-RADIX); f=gun; s=gadd(c,r);
	  while (gcmp(c,g)<0){ f=gmul2n(f,RADIX); c=gmul2n(c,sqrdx); }
	  g=gmul2n(r,RADIX);
	  while (gcmp(c,g)>0){ f=gmul2n(f,-RADIX); c=gmul2n(c,-sqrdx); }
	  if (gcmp(gdiv(gadd(c,r),f),gmul(cofgen,s))<0)
	  {
	    last=0; g=ginv(f);
	    for (j=1; j<=n; j++) coeff(a,i,j)=lmul(gcoeff(a,i,j),g);
	    for (j=1; j<=n; j++) coeff(a,j,i)=lmul(gcoeff(a,j,i),f);
	  }
	}
    }
  }
  tetpil=avma; return gerepile(av,tetpil,gcopy(a));
}

#define SIGN(a,b) ((b)>=0.0 ? fabs(a) : -fabs(a))
static GEN
hqr(GEN mat) /* find all the eigenvalues of the matrix mat */
{
  long nn,n,m,l,k,j,its,i,mmin,flj,flk;
  double **a,p,q,r,s,t,u,v,w,x,y,z,anorm,*wr,*wi,eps;
  GEN eig;

  eps=0.000001;
  n=lg(mat)-1; a=(double**)gpmalloc(sizeof(double*)*(n+1));
  for (i=1; i<=n; i++) a[i]=(double*)gpmalloc(sizeof(double)*(n+1));
  for (j=1; j<=n; j++) 
    for (i=1; i<=n; i++) a[i][j]=gtodouble((GEN)((GEN)mat[j])[i]);
  wr=(double*)gpmalloc(sizeof(double)*(n+1));
  wi=(double*)gpmalloc(sizeof(double)*(n+1));

  anorm=fabs(a[1][1]);
  for (i=2; i<=n; i++) for (j=(i-1); j<=n; j++) anorm+=fabs(a[i][j]);
  nn=n; t=0.0;
  if (DEBUGLEVEL>3)
  { fprintferr("* Finding eigenvalues\n"); flusherr(); }
  while (nn>=1)
  {
    its=0;
    do
    {
      for (l=nn; l>=2; l--)
      {
	s=fabs(a[l-1][l-1])+fabs(a[l][l]); if (s==0.0) s=anorm;
	if ((double)(fabs(a[l][l-1])+s)==s) break;
      }
      x=a[nn][nn];
      if (l==nn){ wr[nn]=x+t; wi[nn--]=0.0; }
      else
      {
	y=a[nn-1][nn-1]; w=a[nn][nn-1]*a[nn-1][nn];
	if (l==(nn-1))
	{
	  p=0.5*(y-x); q=p*p+w; z=sqrt(fabs(q)); x+=t;
	  if ((q>=0.0)||(fabs(q)<=eps))
	  {
	    z=p+SIGN(z,p); wr[nn-1]=wr[nn]=x+z;
	    if (fabs(z)>eps) wr[nn]=x-w/z;
	    wi[nn-1]=wi[nn]=0.0;
	  }
	  else{ wr[nn-1]=wr[nn]=x+p; wi[nn-1]=-(wi[nn]=z); }
	  nn-=2;
	}
	else
	{
	  if (its==30) err(talker,"too many iterations in hqr");
	  if ((its==10)||(its==20))
	  {
	    t+=x; for (i=1; i<=nn; i++) a[i][i]-=x; s=fabs(a[nn][nn-1])+fabs(a[nn-1][nn-2]);
	    y=x=0.75*s; w=-0.4375*s*s;
	  }
	  ++its;
	  for (m=(nn-2); m>=l; m--)
	  {
	    z=a[m][m]; r=x-z; s=y-z; p=(r*s-w)/a[m+1][m]+a[m][m+1]; q=a[m+1][m+1]-z-r-s;
	    r=a[m+2][m+1]; s=fabs(p)+fabs(q)+fabs(r); p/=s; q/=s; r/=s;
	    if (m==l) break;
	    u=fabs(a[m][m-1])*(fabs(q)+fabs(r));
	    v=fabs(p)*(fabs(a[m-1][m-1])+fabs(z)+fabs(a[m+1][m+1]));
	    if ((double)(u+v)==v) break;
	  }
	  for (i=m+2; i<=nn; i++){ a[i][i-2]=0.0; if (i!=(m+2)) a[i][i-3]=0.0; }
	  for (k=m; k<=nn-1; k++)
	  {
	    if (k!=m)
	    {
	      p=a[k][k-1]; q=a[k+1][k-1]; r=0.0; if (k!=(nn-1)) r=a[k+2][k-1];
	      if ((x=fabs(p)+fabs(q)+fabs(r))!=0.0){ p/=x; q/=x; r/=x; }
	    }
	    if ((s=SIGN(sqrt(p*p+q*q+r*r),p))!=0.0)
	    {
	      if (k==m){ if (l!=m) a[k][k-1]=-a[k][k-1]; }else a[k][k-1]=-s*x;
	      p+=s; x=p/s; y=q/s; z=r/s; q/=p; r/=p;
	      for (j=k; j<=nn; j++)
	      {
		p=a[k][j]+q*a[k+1][j]; if (k!=(nn-1)){ p+=r*a[k+2][j]; a[k+2][j]-=p*z; }
		a[k+1][j]-=p*y; a[k][j]-=p*x;
	      }
	      mmin=(nn<k+3) ? nn : k+3;
	      for (i=l; i<=mmin; i++)
	      {
		p=x*a[i][k]+y*a[i][k+1]; if (k!=(nn-1)){ p+=z*a[i][k+2]; a[i][k+2]-=p*r; }
		a[i][k+1]-=p*q; a[i][k]-=p;
	      }
	    }
	  }
	}
      }
    }
    while (l<nn-1);
  }
  for (j=2; j<=n; j++) /* ordering the roots */
  {
    x=wr[j]; y=wi[j]; if (y) flj=1; else flj=0;
    for (k=j-1; k>=1; k--)
    {
      if (wi[k]) flk=1; else flk=0;
      if (flk<flj) break;
      if ((!flk)&&(!flj)&&(wr[k]<=x)) break;
      if (flk&&flj&&(wr[k]<x)) break;
      if (flk&&flj&&(wr[k]==x)&&(wi[k]>0)) break;
      wr[k+1]=wr[k]; wi[k+1]=wi[k];
    }
    wr[k+1]=x; wi[k+1]=y;
  }
  if (DEBUGLEVEL>3)
  { fprintferr("* End of the computation of eigenvalues\n"); flusherr(); }
  for (i=1; i<=n; i++) free(a[i]); free(a); eig=cgetg(n+1,t_COL);
  for (i=1; i<=n; i++)
  {
    if (wi[i])
    {
      eig[i]=lgetg(3,t_COMPLEX);
      ((GEN)eig[i])[1]=(long)dbltor(wr[i]); ((GEN)eig[i])[2]=(long)dbltor(wi[i]);
    }
    else eig[i]=(long)dbltor(wr[i]);
  }
  free(wr); free(wi); return eig;
}

static GEN
zrhqr(GEN a,long PREC)
/*    ONLY FOR POLYNOMIAL WITH REAL COEFFICIENTS : give the roots of
 *  the polynomial a (first, the real roots, then the
 *  non real roots) in increasing order of their real
 *  parts MULTIPLE ROOTS ARE FORBIDDEN.
 */
{
  long av,tetpil,n,i,j,k,ti,ct,prec;
  GEN aa,b,p1,rt,rr,hess,x,dx,y,hessbis,eps,oldval,newval;

  av=avma; n=lgef(a)-3; prec=PREC;
  hess=cgetg(n+1,t_MAT); for (k=1; k<=n; k++) hess[k]=lgetg(n+1,t_COL);
  for (k=1; k<=n; k++)
  {
    p1=(GEN)hess[k]; p1[1]=lneg(gdiv((GEN)a[n-k+2],(GEN)a[n+2]));
    for (j=2; j<=n; j++){ if (j==(k+1)) p1[j]=un; else p1[j]=zero; }
  }
  rr=cgetg(n+1,t_COL);
  for (i=1; i<=n; i++)
  { rr[i]=lgetg(3,t_COMPLEX); ((GEN)rr[i])[1]=lgetr(PREC); ((GEN)rr[i])[2]=lgetr(PREC); }
  if (DEBUGLEVEL>3){ fprintferr("companion matrix = "); outerr(hess); flusherr(); }
  hessbis=balanc(hess);
  if (DEBUGLEVEL>3){ fprintferr("balanced matrix = "); outerr(hessbis); flusherr(); }
  rt=hqr(hessbis);
  if (DEBUGLEVEL>3){ fprintferr("eigenvalues = "); outerr(rt); flusherr(); }
  eps=cgetr(prec);
  p1=gpuigs(gdeux,-bit_accuracy(prec)); gaffect(p1,eps);
  prec=2*PREC; /* polishing the roots */
  aa=cgetg(n+3,t_POL); aa[1]=a[1];
  for (i=2; i<=n+2; i++){ aa[i]=lgetr(prec); gaffect((GEN)a[i],(GEN)aa[i]); }
  b=deriv(aa,varn(aa));
  for (i=1; i<=n; i++)
  {
    ct=0;
    ti=typ(rt[i]);
    if (ti==t_REAL){ x=cgetr(prec); affrr((GEN)rt[i],x); }
    else
    {
      x=cgetg(3,t_COMPLEX); x[1]=lgetr(prec); x[2]=lgetr(prec);
      affrr((GEN)((GEN)rt[i])[1],(GEN)x[1]); affrr((GEN)((GEN)rt[i])[2],(GEN)x[2]);
    }
  LAB1:
    dx=poleval(b,x);
    if (gcmp(gabs(dx,prec),eps)<=0)
      err(talker,"the polynomial has probably multiple roots in zrhqr");
    y=gsub(x,gdiv(poleval(aa,x),dx));
    newval=gabs(poleval(aa,y),prec);
    if (gcmp(newval,eps)<=0)
      gaffect(y,(GEN)rr[i]);
    else
    {
      if (!ct)
      {
	ct++;
	oldval=newval;
	x=y; goto LAB1;
      }
      else
      {
	if (gcmp(newval,oldval)<0)
	{
	  ct++;
	  oldval=newval;
	  x=y;
	  goto LAB1;
	}
	else gaffect(y,(GEN)rr[i]);
      }
    }
  }
  if (DEBUGLEVEL>3){ fprintferr("polished roots = "); outerr(rr); flusherr(); }
  tetpil=avma; return gerepile(av,tetpil,gcopy(rr));
}
