/**************************************************************/
/**************************************************************/
/*                                                            */
/*                        NUMBER FIELDS                       */
/*                                                            */
/**************************************************************/
/**************************************************************/
/* $Id: base1.c,v 2.0.0.2 1997/12/14 20:11:49 karim Exp karim $ */

#include "genpari.h"
#include "nf.h"

void
checkrnf(GEN rnf)
{
  if (typ(rnf)!=t_VEC) err(idealer1);
  if (lg(rnf)!=12) err(idealer1);
}

void
checkbnf(GEN bnf)
{
  if (typ(bnf)!=t_VEC) err(idealer1);
  if (lg(bnf)!=11)
  {
    if (lg(bnf)==10 && typ(bnf[1])==t_POL)
      err(talker,"please apply bnfinit first");
    err(idealer1);
  }
}

GEN
checknf(GEN nf)
{
  if (typ(nf)==t_POL) err(talker,"please apply nfinit first");
  if (typ(nf)!=t_VEC) err(idealer1);
  if (lg(nf)==10) return nf;
  if (lg(nf)==11) return checknf((GEN)nf[7]);
  err(idealer1);
  return NULL; /* not reached */
}

void
checkbnr(GEN bnr)
{
  if (typ(bnr)!=t_VEC || lg(bnr)!=7)
    err(talker,"incorrect bigray field");
  checkbnf((GEN)bnr[1]);
}

void
checkbnrgen(GEN bnr)
{
  checkbnr(bnr);
  if (lg(bnr[5])<=3)
    err(talker,"please apply bnrinit(,,1) and not bnrinit(,)");
}

void
checkid(GEN x, long N)
{
  if (typ(x)!=t_MAT) err(idealer2);
  if (lg(x) == 1 || lg(x[1]) != N+1)
    err(talker,"incorrect matrix for ideal");
}

void
checksqid(GEN x, long N)
{
  checkid(x,N);
  if (lg(x) != N+1)
    err(talker,"non-square matrix for ideal");
}

void
checkbid(GEN bid)
{
  if (typ(bid)!=t_VEC || lg(bid)!=6)
    err(talker,"incorrect bigideal");
}

void
checkprimeid(GEN id)
{
  if (typ(id) != t_VEC || lg(id) != 6)
    err(talker,"incorrect prime ideal");
}

GEN
get_bnf(GEN x, int *t)
{
  switch(typ(x))
  {
    case t_POL: *t = typ_POL;  return NULL;
    case t_QUAD: *t = typ_Q  ; return NULL;
    case t_VEC:
      switch(lg(x))
      {
        case 6 : *t = typ_QUA; return NULL;
        case 10: *t = typ_NF; return NULL;
        case 11: *t = typ_BNF; return x;
        case 7 : *t = typ_BNR;
          x = (GEN)x[1]; if (typ(x)!=t_VEC || lg(x)!=11) break; 
          return x;
      }
    case t_MAT:
      if (lg(x)==2)
        switch(lg(x[1]))
        {
          case 8: case 11:
            *t = typ_CLA; return NULL;
        }
  }
  *t = typ_NULL; return NULL;
}

GEN
get_nf(GEN x, int *t)
{
  switch(typ(x))
  {
    case t_POL : *t = typ_POL; return NULL;
    case t_QUAD: *t = typ_Q  ; return NULL;
    case t_VEC:
      switch(lg(x))
      {
        case 10: *t = typ_NF; return x;
        case 11: *t = typ_BNF;
          x = (GEN)x[7]; if (typ(x)!=t_VEC || lg(x)!=10) break;
          return x;
        case 7 : *t = typ_BNR;
          x = (GEN)x[1]; if (typ(x)!=t_VEC || lg(x)!=11) break; 
          x = (GEN)x[7]; if (typ(x)!=t_VEC || lg(x)!=10) break;
          return x;

        case 14: case 20:
          *t = typ_ELL; return NULL;
      }break;
    case t_MAT:
      if (lg(x)==2)
        switch(lg(x[1]))
        {
          case 8: case 11:
            *t = typ_CLA; return NULL;
        }
  }
  *t = typ_NULL; return NULL;
}

/**************************************************************/
/**                                                          **/
/**		   HERMITE NORMAL FORM REDUCTION	     **/
/**							     **/
/**************************************************************/

GEN
mathnf0(GEN x, long flag)
{
  switch(flag)
  {
    case 0: return hnf(x);
    case 1: return hnfall(x);
    case 2: return hnfhavas(x);
    case 3: return hnfperm(x);
    case 4: return hnflll(x);
    default: err(flagerr);
  }
  return NULL; /* not reached */
}

static GEN
init_hnf(GEN x, GEN *denx, long *co, long *li, long *av)
{
  if (typ(x) != t_MAT) err(typeer,"mathnf");
  *co=lg(x); if (*co==1) return NULL; /* empty matrix */
  *li=lg(x[1]); *denx=denom(x); *av=avma;

  if (gcmp1(*denx)) /* no denominator */
    { *denx = NULL; return dummycopy(x); }
  return gmul(x,*denx);
}

GEN
hnf(GEN x)
{
  long av0 = avma, s,li,co,av,tetpil,i,j,def,ldef,lim;
  GEN p1,u,v,d,denx;

  x = init_hnf(x,&denx,&co,&li,&av);
  if (!x) return cgetg(1,t_MAT);

  lim = (av+bot)>>1;
  def=co; ldef=(li>co)?li-co+1:1;
  for (i=li-1; i>=ldef; i--)
  {
    def--; j=def-1; while (j && !signe(gcoeff(x,i,j))) j--;
    while (j>1)
    {
      d=bezout(gcoeff(x,i,j),gcoeff(x,i,j-1),&u,&v);
      if (DEBUGLEVEL>5) { outerr(u); outerr(v); }
      p1=gadd(gmul(u,(GEN)x[j]),gmul(v,(GEN)x[j-1]));
      x[j]=lsub(gmul(divii(gcoeff(x,i,j),d),(GEN)x[j-1]),
                gmul(divii(gcoeff(x,i,j-1),d),(GEN)x[j]));
      x[j-1]=(long) p1;
      j--; while (j && !signe(gcoeff(x,i,j))) j--;
    }
    if (j==1)
    {
      d=bezout(gcoeff(x,i,1), gcoeff(x,i,def),&u,&v);
      if (DEBUGLEVEL>5) { outerr(u); outerr(v); }
      p1=gadd(gmul(u,(GEN)x[1]),gmul(v,(GEN)x[def]));
      x[1]=lsub(gmul(divii(gcoeff(x,i,1),d),(GEN)x[def]),
	        gmul(divii(gcoeff(x,i,def),d),(GEN)x[1]));
      x[def]=(long)p1;
    }

    p1=gcoeff(x,i,def); s=signe(p1);
    if (s)
    {
      if (s < 0) { x[def]=lneg((GEN)x[def]); p1=gcoeff(x,i,def); }
      for (j=def+1; j<co; j++)
      {
	GEN p2 = gdivent(gcoeff(x,i,j),p1);
        p2 = negi(p2);
	x[j]=ladd((GEN)x[j], gmul(p2,(GEN)x[def]));
      }
    }
    else def++;
    if (low_stack(lim, (av+bot)>>1))
    {
      if (DEBUGMEM>1) err(warnmem,"hnf");
      tetpil=avma; x=gerepile(av,tetpil,gcopy(x));
    }
  }
  /* remove null columns */
  for (i=1,j=1; j<co; j++)
    if (!gcmp0((GEN)x[j])) x[i++] = x[j];
  setlg(x,i); tetpil=avma; 
  x = denx? gdiv(x,denx): gcopy(x);
  return gerepile(av0,tetpil,x);
}

/* clean in place, i.e destroy x */
static void
cleanmod(GEN x,long lim,GEN det,GEN detsur2)
{
  long lx=lg(x),i;
  GEN p1;

  if (lim<=0 || lim>=lx) lim=lx-1;
  for (i=1; i<=lim; i++)
  {
    p1=modii((GEN)x[i],det);
    x[i]= (cmpii(p1,detsur2) > 0)? lsubii(p1,det): (long)p1;
  }
}

/* for internal use. x is square. DESTROY x */
GEN
fasthnf(GEN x,GEN detmat)
{
  long av = avma,tetpil,li,co,i,j,ii,jj,def,jm1, lim=(av+bot)>>1;
  GEN p1,p2,w,u,v,d,dms2,b;

  co=lg(x); li=lg(x[1]);
  dms2=shifti(detmat,-1); def=co;
  for (i=li-1; i>=1; i--)
  {
    def--; j=co-li; while (j && !signe(gcoeff(x,i,j))) j--;
    if (j)
    {
      ii=i-1; while (ii && !signe(gcoeff(x,ii,def))) ii--;
      if (!ii)
      {
	p1=gcoeff(x,i,def);
	if (gcmp1(p1))
	{
	  for (jj=j; jj; jj--) coeff(x,i,jj)=zero;
	  j=0;
	}
	else
	{
	  for (jj=j; jj; jj--) coeff(x,i,jj)=lmodii(gcoeff(x,i,jj),p1);
	  while (j && !signe(gcoeff(x,i,j))) j--;
	}
      }
    }
    while (j)
    {
      jm1=(j>1)?j-1:def;
      d=bezout(gcoeff(x,i,j),gcoeff(x,i,jm1),&u,&v);
      if (signe(u))
      {
        p1 = gmul(u,(GEN)x[j]);
	if (signe(v)) p1 = gadd(p1, gmul(v,(GEN)x[jm1]));
      }
      else p1=gmul(v,(GEN)x[jm1]);
      x[j]=lsub(gmul(divii(gcoeff(x,i,j),d),(GEN)x[jm1]),
	        gmul(divii(gcoeff(x,i,jm1),d),(GEN)x[j]));
      cleanmod((GEN)x[j],i,detmat,dms2);
      cleanmod(p1,i,detmat,dms2);
      x[jm1]=(long)p1;
      j--; while (j && !signe(gcoeff(x,i,j))) j--;
      if (low_stack(lim, (av+bot)>>1))
      {
	if (DEBUGMEM>1) err(warnmem,"[1]: fasthnf");
	tetpil=avma; x=gerepile(av,tetpil,gcopy(x));
      }
    }
  }
  b=detmat; w=cgetg(li,t_MAT); def--;
  for (i=li-1; i>=1; i--)
  {
    d=bezout(gcoeff(x,i,i+def),b,&u,&v); w[i]=lmod(gmul(u,(GEN)x[i+def]),b);
    if (!signe(gcoeff(w,i,i))) coeff(w,i,i)=(long)d;
    if (i>1) b=divii(b,d);
  }
  if (low_stack(lim, (av+bot)>>1))
  {
    if (DEBUGMEM>1) err(warnmem,"[2]: fasthnf");
    tetpil=avma; w=gerepile(av,tetpil,gcopy(w));
  }
  for (i=li-2; i>=1; i--)
    for (j=i+1; j<li; j++)
    {
      p2=gdivent(gcoeff(w,i,j),gcoeff(w,i,i));
      w[j]=lsub((GEN)w[j],gmul(p2,(GEN)w[i]));
    }
  tetpil=avma; return gerepile(av,tetpil,gcopy(w));
}

static GEN
allhnfmod(GEN x,GEN detmat,long flag)
{
  long li,co,av0,av,tetpil,i,j,jm1,def,ldef,lim;
  GEN b,q,w,p1,d,u,v,dms2;

  if (gcmp0(detmat)) return hnf(x);
  if (DEBUGLEVEL>6) fprintferr("entering hnfmod");

  if (typ(x)!=t_MAT) err(typeer,"allhnfmod");
  co=lg(x); if (co==1) return cgetg(1,t_MAT);
  av0=avma; lim=(av0+bot)>>1;
  li=lg(x[1]); dms2=shifti(detmat,-1); 
  
  av=avma; x=dummycopy(x);
  def=co; ldef=(li>co)?li-co+1:1;
  for (i=li-1; i>=ldef; i--)
  {
    if (DEBUGLEVEL>6) { fprintferr(" %ld",i); flusherr(); }
    def--; j=def-1; while (j && !signe(gcoeff(x,i,j))) j--;
    while (j)
    {
      if (DEBUGLEVEL>8) { fprintferr(" %ld",j); flusherr(); }
      jm1=(j>1)?j-1:def;
      d=bezout(gcoeff(x,i,j),gcoeff(x,i,jm1),&u,&v);
      if (signe(u))
      {
        p1 = gmul(u,(GEN)x[j]);
	if (signe(v)) p1 = gadd(p1, gmul(v,(GEN)x[jm1]));
      }
      else p1=gmul(v,(GEN)x[jm1]);
      x[j]=lsub(gmul(divii(gcoeff(x,i,j),d),(GEN)x[jm1]),
	        gmul(divii(gcoeff(x,i,jm1),d),(GEN)x[j]));
      cleanmod((GEN)x[j],i,detmat,dms2);
      cleanmod(p1,i,detmat,dms2);
      x[jm1]=(long)p1;

      j--; while (j && !signe(gcoeff(x,i,j))) j--;
      if (low_stack(lim, (av0+bot)>>1))
      {
        if (DEBUGMEM>1) err(warnmem,"[1]: allhnfmod");
	tetpil=avma; x=gerepile(av,tetpil,gcopy(x));
      }
    }
  }
  if (DEBUGLEVEL>6) fprintferr("\nCalcul de la diagonale:");
  b=detmat; w=cgetg(li,t_MAT); def--;
  for (i=li-1; i>=1; i--)
  {
    if (DEBUGLEVEL>6) { fprintferr(" %ld",i); flusherr(); }
    d=bezout(gcoeff(x,i,i+def),b,&u,&v); w[i]=lmod(gmul(u,(GEN)x[i+def]),b);
    if (!signe(gcoeff(w,i,i))) coeff(w,i,i)=(long)d;
    if (i>1 && flag) b=divii(b,d);
  }
  if (DEBUGLEVEL>6) { fprintferr("\nNettoyage triangle"); flusherr(); }
  for (i=li-2; i>=1; i--)
  {
    for (j=i+1; j<li; j++)
    {
      q=gdivent(gcoeff(w,i,j),gcoeff(w,i,i));
      w[j]=lsub((GEN)w[j],gmul(q,(GEN)w[i]));
    }
    if (low_stack(lim, (av0+bot)>>1))
    {
      if (DEBUGMEM>1) err(warnmem,"[2]: allhnfmod");
      tetpil=avma; w=gerepile(av,tetpil,gcopy(w));
    }
  }
  if (DEBUGLEVEL>6) { fprintferr("\nFin hnfmod\n"); flusherr(); }
  tetpil=avma; return gerepile(av0,tetpil,gcopy(w));
}

GEN
hnfmod(GEN x, GEN detmat) { return allhnfmod(x,detmat,1); }

GEN
hnfmodid(GEN x, GEN p) { return allhnfmod(x,p,0); }

/* Return [y,U,V] such that y=V.x.U, V permutation vector, U unimodular
 * matrix, and y in HNF form
 */
GEN
hnfhavas(GEN x)
{
  long av0=avma, av,av1,tetpil,li,co,i,j,k,def,ldef,lim,imin,jmin,vpk;
  long jpro,com,vi;
  GEN p1,p2,z,u,denx,vperm,mat1,col2,lil2,s,pmin,apro,bpro,cpro;

  if (DEBUGLEVEL>6)
    { fprintferr("Entering hnfhavas: AVMA = %ld\n",avma); flusherr(); }
  if (typ(x)!=t_MAT) err(typeer,"hnfhavas");
  co=lg(x); if (co==1) return cgetg(1,t_MAT);

  li=lg(x[1]); denx=denom(x);
  vperm=cgeti(li); for (i=1; i<li; i++) vperm[i]=i;

  av=avma; lim=(av+bot)>>1; u=idmat(co-1);
  x = gcmp1(denx)? dummycopy(x): gmul(denx,x);
  def=co; ldef=(li>co)?li-co+1:1;
  for (i=li-1; i>=ldef; i--)
  {
    def--; av1=avma; mat1=cgetg(def+1,t_MAT); col2=cgetg(def+1,t_COL);
    for (j=1; j<=def; j++)
    {
      p1=cgetg(i+1,t_COL); mat1[j]=(long)p1; s=gzero;
      for (k=1; k<=i; k++)
      { 
	p2=gsqr(gcoeff(x,vperm[k],j));
	p1[k]=(long)p2; s=gadd(s,p2);
      }
      col2[j]=(long)s;
    }
    lil2=cgetg(i+1,t_COL);
    for (k=1; k<=i; k++)
    {
      s=gzero;
      for (j=1; j<=def; j++) s=gadd(s,gcoeff(mat1,k,j));
      lil2[k]=(long)s;
    }

    pmin = NULL;
    for (k=i; k>=1; k--)
    {
      while (k>=1 && !signe(lil2[k])) k--;
      if (!k) goto comterm;
      vpk=vperm[k];
      if (!pmin || cmpii((GEN)lil2[k],pmin) <= 0)
      {
	j=1; while (!signe(gcoeff(x,vpk,j))) j++;
	if (!pmin)
	{
	  imin=k; jmin=j; pmin=mulii((GEN)lil2[k],(GEN)col2[j]);
	  cpro=absi(gcoeff(x,vpk,j));
	}
	jpro=j; apro=absi(gcoeff(x,vpk,j)); j++;
	for (; j<=def; j++)
	{
	  com=cmpii((GEN)col2[j],(GEN)col2[jpro]);
	  if (signe(gcoeff(x,vpk,j)) && com <=0)
	  {
	    if (com<0) { jpro=j; apro=absi(gcoeff(x,vpk,j)); }
	    else
	    {
	      bpro=absi(gcoeff(x,vpk,j));
	      if (cmpii(bpro,apro)<0) { jpro=j; apro=bpro; }
	    }
	  }
	}
	p1=mulii((GEN)lil2[k],(GEN)col2[jpro]);
	com=cmpii(p1,pmin);
	if (com<0 || (com==0 && cmpii(apro,cpro)<0))
	{
	  imin=k; jmin=jpro; pmin=p1; cpro=apro;
	}
      }
    }
    avma=av1;
    if (jmin!=def)
    {
      p1=(GEN)x[def]; x[def]=x[jmin]; x[jmin]=(long)p1;
      p1=(GEN)u[def]; u[def]=u[jmin]; u[jmin]=(long)p1;
    }
    if (imin!=i) { vpk=vperm[i]; vperm[i]=vperm[imin]; vperm[imin]=vpk; }
    vi=vperm[i];
    for(;;)
    {
      GEN p3,p12,p13;

      if (signe(gcoeff(x,vi,def))<0)
      {
	x[def]=lneg((GEN)x[def]); u[def]=lneg((GEN)u[def]);
      }
      p1=gcoeff(x,vi,def); p12=shifti(p1,-1); p13=negi(p12);
      for (j=1; j<def; j++)
      {
	p2=dvmdii(gcoeff(x,vi,j),p1,&p3);
	if (cmpii(p3,p13)<0) p2=addis(p2,-1);
	else { if (cmpii(p3,p12)>0) p2=addis(p2,1); }
	if (DEBUGLEVEL>5) outerr(p2);
        setsigne(p2,-signe(p2));
	x[j]=ladd((GEN)x[j],gmul(p2,(GEN)x[def]));
	u[j]=ladd((GEN)u[j],gmul(p2,(GEN)u[def]));
      }
      j=1; while (!signe(gcoeff(x,vi,j))) j++;
      if (j<def)
      {
	pmin=gnorml2((GEN)x[j]); jmin=j; apro=absi(gcoeff(x,vi,j));
	j++;
	for (; j<def; j++)
	{
	  if (signe(gcoeff(x,vi,j)))
	  {
	    p1=gnorml2((GEN)x[j]);
            com=cmpii(p1,pmin);
	    if (com<0)
	    {
	      pmin=p1; jmin=j;
	    }
	    else if (com==0)
	    {
	      bpro=absi(gcoeff(x,vi,j));
              if (cmpii(bpro,apro)<0)
	      {
	        pmin=p1; jmin=j; apro=bpro;
	      }
	    }
	  }
	}
	p1=(GEN)x[def]; x[def]=x[jmin]; x[jmin]=(long)p1;
	p1=(GEN)u[def]; u[def]=u[jmin]; u[jmin]=(long)p1;
      }
      else break;
    }
    vi=vperm[i]; p1=gcoeff(x,vi,def);
    for (j=def+1; j<co; j++)
    {
      p2=gdivent(gcoeff(x,vi,j),p1); setsigne(p2,-signe(p2));
      if (DEBUGLEVEL>5) outerr(p2);
      x[j]=ladd((GEN)x[j],gmul(p2,(GEN)x[def]));
      u[j]=ladd((GEN)u[j],gmul(p2,(GEN)u[def]));
    }

    if (low_stack(lim, (av+bot)>>1))
    {
      GEN *gptr[2];
      if (DEBUGMEM>1) err(warnmem,"hnfhavas");
      gptr[0]=&x; gptr[1]=&u;
      gerepilemany(av,gptr,2);
    }
  }

comterm:
  tetpil=avma; z=cgetg(4,t_VEC); p1=cgetg(co,t_MAT);
  if (gcmp1(denx))
  {
    for (j=1; j<co; j++)
    {
      p2=cgetg(li,t_COL); p1[j]=(long)p2;
      for (i=1; i<li; i++)
	p2[i] = lcopy(gcoeff(x,vperm[i],j));
    }
  }
  else
  {
    for (j=1; j<co; j++)
    {
      p2=cgetg(li,t_COL); p1[j]=(long)p2;
      for (i=1; i<li; i++)
	p2[i] = ldiv(gcoeff(x,vperm[i],j),denx);
    }
  }
  z[1]=(long)p1; z[2]=lcopy(u);
  p1=cgetg(li,t_VEC); for (i=1; i<li; i++) p1[i]=lstoi(vperm[i]);
  z[3]=(long)p1; return gerepile(av0,tetpil,z);
}

/* HNF by Bo Majewski and Allan Steele */

/* premier indice non nul de la j-eme ligne de la matrice b */
static long
depthvector(GEN b,long j)
{
  long lv = lg(b), i = 1;

  while (i<lv && gcmp0(gcoeff(b,j,i))) i++;
  return (i==lv)?-1:i;
}

static GEN
incompleteprod(GEN b,long k,long l,long deb,long fin)
{
  GEN p1 = gzero;
  long j;

  for (j=deb; j<=fin; j++)
    p1 = addii(p1,mulii(gcoeff(b,k,j),gcoeff(b,l,j)));
  return p1;
}

static void
redlll(GEN b,GEN mu,long l,long c,long k)
{
  long i,j, lb;
  GEN q, p1=gcoeff(b,l,c);

  if (signe(p1)) q=gdivround(gcoeff(b,k,c),p1); else q=ground(gcoeff(mu,k,l));
  if (signe(q))
  {
    q=negi(q); lb=lg(b);
    for (j=1; j<lb; j++)
      coeff(b,k,j) = laddii(gcoeff(b,k,j),mulii(q,gcoeff(b,l,j)));
    coeff(mu,k,l)=ladd(gcoeff(mu,k,l),q);
    for (i=1; i<l; i++)
    {
      p1=gcoeff(mu,l,i);
      if (gsigne(p1))
	coeff(mu,k,i) = ladd(gcoeff(mu,k,i),gmul(q,p1));
    }
  }
}

GEN
hnflll(GEN x)
{
  long n,m,i,j,k,ii,jj,p,c,s,av=avma,tetpil,kmax,ok;
  GEN q,qneg,p1,bnew,B,mu,mmu,cst,E,U,y,t,BB;

  if (typ(x)!=t_MAT) err(typeer,"hnflll");
  n=lg(x)-1; if (!n) return cgetg(1,t_MAT);
  cst=gdivgs(stoi(9),10);
  x=gcopy(x); n=lg(x)-1; m=lg(x[1])-1; p=n+m;
  bnew=cgetg(p+1,t_MAT);
  for (j=1; j<=n; j++) bnew[j]=x[j];
  for (j=n+1; j<=p; j++)
  {
    p1=cgetg(m+1,t_COL); bnew[j]=(long)p1;
    for (i=1; i<=m; i++) p1[i]=(i==(j-n))?un:zero;
  }
  x=bnew; c=n+1;
  for (i=1; i<=m; i++) c=min(c,depthvector(x,i));
  s=0; mu=cgetg(m+2,t_MAT);
  for (j=1; j<=m; j++) mu[j]=lgetg(m+2,t_COL); B=cgetg(m+2,t_COL);
  while (c<=n)
  {
    k=2; kmax=1;
    B[1]=(long)incompleteprod(x,1,1,c+1,p);
    while (k<=m-c+1)
    {
      if (k>kmax)
      {
	kmax=k;
	for (j=1; j<k; j++)
	{
	  mmu=incompleteprod(x,k,j,c+1,p);
	  for (i=1; i<j; i++) mmu=gsub(mmu,gmul(gcoeff(mu,j,i),gcoeff(mu,k,i)));
	  coeff(mu,k,j)=(long)mmu;
	}
	for (j=1; j<k; j++) coeff(mu,k,j)=ldiv(gcoeff(mu,k,j),(GEN)B[j]);
	B[k]=(long)incompleteprod(x,k,k,c+1,p);
	for (j=1; j<k; j++)
	  B[k]=lsub((GEN)B[k],gmul((GEN)B[j],gsqr(gcoeff(mu,k,j))));
      }
      redlll(x,mu,k-1,c,k);
      ok = (absi(gcoeff(x,k-1,c))>absi(gcoeff(x,k,c))) ||
	  (gegal(gcoeff(x,k-1,c),gcoeff(x,k,c)) &&
	    (gcmp((GEN) B[k],
	          gmul(gsub(cst,gsqr(gcoeff(mu,k,k-1))), (GEN) B[k-1])) < 0) );
      while (ok)
      {
	for (j=1; j<=p; j++)
	{
	  t=gcoeff(x,k,j); coeff(x,k,j)=coeff(x,k-1,j);
	  coeff(x,k-1,j)=(long)t;
	}
	for (j=1; j<=k-2; j++)
	{
	  t=gcoeff(mu,k,j); coeff(mu,k,j)=coeff(mu,k-1,j);
	  coeff(mu,k-1,j)=(long)t;
	}
	mmu=gcoeff(mu,k,k-1);
	BB=gadd((GEN)B[k],gmul(gmul(mmu,mmu),(GEN)B[k-1]));
	q=gdiv((GEN)B[k-1],BB);
	coeff(mu,k,k-1)=lmul(mmu,q);
	B[k]=lmul((GEN)B[k],q); B[k-1]=(long)BB;
	for (i=k+1; i<=kmax; i++)
	{
	  t=gcoeff(mu,i,k);
	  coeff(mu,i,k)=lsub(gcoeff(mu,i,k-1),gmul(mmu,t));
	  coeff(mu,i,k-1)=ladd(t,gmul(gcoeff(mu,k,k-1),gcoeff(mu,i,k)));
	}
	if (k>2) k--;
	redlll(x,mu,k-1,c,k);
        ok=(absi(gcoeff(x,k-1,c))>absi(gcoeff(x,k,c))) ||
	   (gegal(gcoeff(x,k-1,c),gcoeff(x,k,c)) &&
	     (gcmp((GEN) B[k],
	           gmul(gsub(cst,gsqr(gcoeff(mu,k,k-1))), (GEN) B[k-1])) < 0));
      }
      for (i=k-2; i; i--) redlll(x,mu,i,c,k);
      k++;
    }
    s++; c=n+1;
    for (i=1; i<=m-s; i++) c=min(c,depthvector(x,i));
  }
  s=m-s+1;
  if (signe(gcoeff(x,s,depthvector(x,s)))<0)
    for (j=1; j<=p; j++)
      coeff(x,s,j)=lnegi(gcoeff(x,s,j));
  for (i=s+1; i<=m; i++)
  {
    if (signe(gcoeff(x,i,depthvector(x,i)))<0)
      for (j=1; j<=p; j++)
	coeff(x,i,j)=lnegi(gcoeff(x,i,j));
    for (j=i-1; j>=s; j--)
    {
      k=depthvector(x,j);
      qneg=negi(gdivent(gcoeff(x,i,k),gcoeff(x,j,k)));
      for (jj=1; jj<=p; jj++)
	coeff(x,i,jj)=laddii(gcoeff(x,i,jj),mulii(qneg,gcoeff(x,j,jj)));
    }
  }
  for (k=s; k<=m; k++)
  {
    for (j=1; j<s; j++)
    {
      mmu=incompleteprod(x,k,j,n+1,p);
      for (i=1; i<j; i++) mmu=gsub(mmu,gmul(gcoeff(mu,j,i),gcoeff(mu,k,i)));
      coeff(mu,k,j)=(long)mmu;
    }
    for (j=1; j<s; j++) coeff(mu,k,j)=ldiv(gcoeff(mu,k,j),(GEN)B[j]);
    B[k]=(long)incompleteprod(x,k,k,n+1,p);
    for (j=1; j<s; j++)
      B[k]=lsub((GEN)B[k],gmul(gsqr(gcoeff(mu,k,j)),(GEN)B[j]));
    for (j=s-1; j; j--)
    {
      qneg=negi(ground(gcoeff(mu,k,j)));
      if (signe(qneg))
      {
	for (jj=1; jj<=p; jj++)
	  coeff(x,k,jj)=laddii(gcoeff(x,k,jj),mulii(qneg,gcoeff(x,j,jj)));
	for (i=1; i<j; i++)
	  if (gsigne(gcoeff(mu,j,i)))
	    coeff(mu,k,i)=ladd(gcoeff(mu,k,i),gmul(qneg,gcoeff(mu,j,i)));
      }
    }
  }
  tetpil=avma; y=cgetg(3,t_VEC);
  E=cgetg(n+1,t_MAT);
  for (i=1; i<=n; i++)
  {
    p1=cgetg(m-s+2,t_COL); E[i]=(long)p1;
    for (ii=1; ii<=m-s+1; ii++)
      p1[ii]=lcopy(gcoeff(x,m-ii+1,i));
  }
  y[1]=(long)E; U=cgetg(m+1,t_MAT);
  for (i=1; i<=m; i++)
  {
    p1=cgetg(m+1,t_COL); U[i]=(long)p1;
    for (ii=m; ii>=1; ii--)
      p1[m-ii+1]=lcopy(gcoeff(x,ii,i+n));
  }
  y[2]=(long)U; return gerepile(av,tetpil,y);
}

/* HNF avec permutations */
GEN
hnfperm(GEN a)
{
  GEN U,c,l,perm,s,d,u,v,p,q,x,y,x1,y1;
  long r,t,i,j,j1,k,m,n,av=avma,tetpil;

  if (typ(a)!=t_MAT) err(typeer,"hnfperm");
  n=lg(a)-1; if (!n) return cgetg(1,t_MAT);
  m=lg(a[1])-1;
  c=cgeti(m+1); l=cgeti(n+1); perm=cgeti(m+1);
  for (i=1; i<=m; i++) c[i]=0;
  for (j=1; j<=n; j++) l[j]=0;
  U=idmat(n); a=dummycopy(a);
/* U Matrice de Passage :  a*U=a tout au long algo */

  for (i=1; i<=m; i++) c[i]=0;
  for (r=0,k=1; k<=n; k++)
  {
    for (j=1; j<k; j++) if (l[j])
    {
      t=l[j]; y=gcoeff(a,t,k);

      if (signe(y))
      {
	p=gcoeff(a,t,j);
	d=bezout(p,y,&u,&v);
	x1=divii(p,d); y1=divii(y,d);
	for (i=1; i<=m; i++)
	{
	  x=gcoeff(a,i,j); y=gcoeff(a,i,k);
	  coeff(a,i,j)=laddii(mulii(u,x),mulii(v,y));
	  coeff(a,i,k)=lsubii(mulii(x1,y),mulii(y1,x));
	}
	for (i=1; i<=n; i++)
	{
	  x=gcoeff(U,i,j); y=gcoeff(U,i,k);
	  coeff(U,i,j)=laddii(mulii(u,x),mulii(v,y));
	  coeff(U,i,k)=lsubii(mulii(x1,y),mulii(y1,x));
	}
	for (j1=1; j1<j; j1++) if (l[j1])
	{
	  d=gcoeff(a,t,j);
	  q=dvmdii(gcoeff(a,t,j1),d,&s);
	  if (signe(s)<0) q=addsi(-1,q);
	  if (signe(q))
	  {
	    for (i=1; i<=m; i++)
	      coeff(a,i,j1)=lsubii(gcoeff(a,i,j1),mulii(q,gcoeff(a,i,j)));
	    for (i=1; i<=n; i++)
	      coeff(U,i,j1)=lsubii(gcoeff(U,i,j1),mulii(q,gcoeff(U,i,j)));
	  }
	}
      }
    }
    t=m; while (t && (c[t] || gcmp0(gcoeff(a,t,k)))) t--;
    if (t)
    {
      p=gabs(gcoeff(a,t,k),0);
      for (i=t-1; i; i--)
	if (signe(gcoeff(a,i,k)))
	  if (gcmp(p,q=gabs(gcoeff(a,i,k),0)) > 0) { p=q; t=i; }
      perm[++r]=l[k]=t; c[t]=k;
      if (signe(gcoeff(a,t,k))<0)
      {
	for (i=1; i<=m; i++) coeff(a,i,k)= lnegi(gcoeff(a,i,k));
	for (i=1; i<=n; i++) coeff(U,i,k)= lnegi(gcoeff(U,i,k));
	p=gcoeff(a,t,k);
      }
      for (j=1; j<k; j++) if (l[j])
      {
	q=dvmdii(gcoeff(a,t,j),p,&s);
	if (signe(s)<0) q=addsi(-1,q);
	if (signe(q))
	{
	  for (i=1; i<=m; i++)
	    coeff(a,i,j)=lsubii(gcoeff(a,i,j),mulii(q,gcoeff(a,i,k)));
	  for (i=1; i<=n; i++)
	    coeff(U,i,j)=lsubii(gcoeff(U,i,j),mulii(q,gcoeff(U,i,k)));
	}
      }
    }
    else l[k]=0;
  }

/* On a :    a*U=a   (matrice (m,n))
 * U  matrice (n,n) tq  |det(U)|=1    (U dans GL(n))
 * Les colonnes de a  telles que l[j]<>0: base de Im(a)  (il y en a r)
 * Les colonnes de U telles que l[j]=0  : base de Ker(a) (il y en a n-r)
 */
  tetpil=avma;
  y=cgetg(4,t_VEC);
  p=cgetg(r+1,t_MAT); u=cgetg(n+1,t_MAT);
  for (t=1,k=r,j=1; j<=n; j++)
    if (l[j])
    {
      /*  p[++k]=lcopy((GEN)a[j]);
          k=0 au depart: pour Matrice hnf lignes non permutees */
      q=cgetg(m+1,t_COL); p[k]=(long)q;
      for (i=1; i<=m; i++) q[i]=lcopy(gcoeff(a,perm[m-i+1],j));
      u[k+n-r]=lcopy((GEN)U[j]);
      k--;
    }
    else u[t++]=lcopy((GEN)U[j]);
  y[1]=(long)p; y[2]=(long)u;
  q=(GEN)(y[3]=lgetg(m+1,t_VEC));
  for (i=1; i<=m; i++) q[m-i+1]=lstoi(perm[i]);
  return gerepile(av,tetpil,y);
}

/*====================================================================
 *	    Forme Normale d'Hermite (Version par colonnes 31/01/94)
 *====================================================================*/
GEN
hnfall(GEN a)	
{
  GEN c,h,x,y,u,v,x1,y1,p,q,s,d,U,p1;
  long m,n,r,i,j,j1,k,li,ii,z,av=avma,av1,tetpil,lim;

  if (typ(a)!=t_MAT) err(typeer,"hnfall");
  n=lg(a)-1; if (!n) return cgetg(1,t_MAT);
  m=lg(a[1])-1;
  c=cgeti(m+1); h=cgeti(n+1);
  for (i=1; i<=m; i++) c[i]=0;
  for (j=1; j<=n; j++) h[j]=m;
  av1=avma; lim=(bot+av1)>>1;
  a=dummycopy(a); U=idmat(n); r=n+1;
  for (li=m; li; li--)
  {
    for (j=1; j<r; j++)
    {
      for (i=h[j]; i>li; i--)
      {
        y = gcoeff(a,i,j);
	if (signe(y))
	{
	  k=c[i]; x=gcoeff(a,i,k); /* annuler bij a l'aide de p=bik */
	  d=bezout(x,y,&u,&v);
	  if (DEBUGLEVEL>5)
            { fprintferr("(u,v) = (%Z, %Z); ",(long)u,(long)v); flusherr(); }
	  x1=divii(x,d); y1=divii(y,d);
	  for (ii=1; ii<=i; ii++)
	  {
	    x=gcoeff(a,ii,k); y=gcoeff(a,ii,j);
	    coeff(a,ii,k)=laddii(mulii(u,x),mulii(v,y));
	    coeff(a,ii,j)=lsubii(mulii(x1,y),mulii(y1,x));
	  }
	  for (ii=1; ii<=n; ii++)
	  {
	    x=gcoeff(U,ii,k); y=gcoeff(U,ii,j);
	    coeff(U,ii,k)=laddii(mulii(u,x),mulii(v,y));
	    coeff(U,ii,j)=lsubii(mulii(x1,y),mulii(y1,x));
	  }
	  for (j1=k+1; j1<=n; j1++)
	  {
            long sq;
	    q=dvmdii(gcoeff(a,i,j1),d,&s);
	    if (signe(s)<0) q=addsi(-1,q);
            sq = signe(q);
	    if (sq)
	    {
              setsigne(q,-sq);
	      for (ii=1; ii<=i; ii++)
		coeff(a,ii,j1)=laddii(gcoeff(a,ii,j1),mulii(q,gcoeff(a,ii,k)));
	      for (ii=1; ii<=n; ii++)
		coeff(U,ii,j1)=laddii(gcoeff(U,ii,j1),mulii(q,gcoeff(U,ii,k)));
              setsigne(q, sq);
	    }
	  }
	}
      }
      if (low_stack(lim, (av1+bot)>>1))
      {
	GEN *gptr[2];
	if (DEBUGMEM>1) err(warnmem,"hnfall");
	gptr[0]=&a; gptr[1]=&U; gerepilemany(av1,gptr,2);
      }	
      x=gcoeff(a,li,j);
      if (signe(x))
      {
        r--;
        if (j<r)
        {
          z=a[j]; a[j]=a[r]; a[r]=z;
          z=U[j]; U[j]=U[r]; U[r]=z;
          h[j]=h[r]; h[r]=li; c[li]=r;
        }
        if (signe(gcoeff(a,li,r))<0)
        {
          p1=(GEN)a[r]; for (i=1; i<=li; i++) p1[i]=lnegi((GEN)p1[i]);
          p1=(GEN)U[r]; for (i=1; i<=n ; i++) p1[i]=lnegi((GEN)p1[i]);
        }
        p=gcoeff(a,li,r);
        for (j=r+1; j<=n; j++)
        {
          q=dvmdii(gcoeff(a,li,j),p,&s);
          if (signe(s)<0) q=addsi(-1,q);
          if (signe(q))
          {
            for (i=1; i<=li; i++)
              coeff(a,i,j)=lsubii(gcoeff(a,i,j),mulii(q,gcoeff(a,i,r)));
            for (i=1; i<=n; i++)
              coeff(U,i,j)=lsubii(gcoeff(U,i,j),mulii(q,gcoeff(U,i,r)));
          }
        }
        break;
      } 
      h[j]=li-1;
    }
  }
  if (DEBUGLEVEL>5) fprintferr("\nhnfall, final phase: ");
  r--; /* first r cols are in the image the n-r (independent) last ones */
  for (j=1; j<=r; j++)
    for (i=h[j]; i; i--)
      if (signe(y=gcoeff(a,i,j)))
      {
	k=c[i]; x=gcoeff(a,i,k);
	d=bezout(x,y,&u,&v);
        if (DEBUGLEVEL>5)
          { fprintferr("(u,v) = (%Z, %Z); ",(long)u,(long)v); flusherr(); }
	x1=divii(x,d); y1=divii(y,d);
	for (ii=1; ii<=i; ii++)
	{
	  x=gcoeff(a,ii,k); y=gcoeff(a,ii,j);
	  coeff(a,ii,k)=laddii(mulii(u,x),mulii(v,y));
	  coeff(a,ii,j)=lsubii(mulii(x1,y),mulii(y1,x));
	}
	for (ii=1; ii<=n; ii++)
	{
	  x=gcoeff(U,ii,k); y=gcoeff(U,ii,j);
	  coeff(U,ii,k)=laddii(mulii(u,x),mulii(v,y));
	  coeff(U,ii,j)=lsubii(mulii(x1,y),mulii(y1,x));
	}
	for (j1=k+1; j1<=n; j1++)
	{
	  q=dvmdii(gcoeff(a,i,j1),d,&s);
	  if (signe(s)<0) q=addsi(-1,q);
	  if (signe(q))
	  {
	    for (ii=1; ii<=i; ii++)
	      coeff(a,ii,j1)=lsubii(gcoeff(a,ii,j1),mulii(q,gcoeff(a,ii,k)));
	    for (ii=1; ii<=n; ii++)
	      coeff(U,ii,j1)=lsubii(gcoeff(U,ii,j1),mulii(q,gcoeff(U,ii,k)));
	  }
	}
      }
  if (DEBUGLEVEL>5) fprintferr("\n");
  tetpil=avma; y=cgetg(3,t_VEC);
  /* remove the first r columns */
  a += r; a[0] = evaltyp(t_MAT) | evallg(n-r+1);
  y[1]=lcopy(a); y[2]=lcopy(U);
  return gerepile(av,tetpil,y);
}

/***************************************************************/
/**							      **/
/**      	    SMITH NORMAL FORM REDUCTION	              **/
/**							      **/
/***************************************************************/

static GEN
col_mul(GEN x, GEN c)
{
  long s = signe(x);
  GEN xc = NULL;
  if (s)
  {
    if (!is_pm1(x)) xc = gmul(x,c);
    else xc = (s>0)? c: gneg(c);
  }
  return xc;
}

static void
do_zero(GEN x)
{
  long i, lx = lg(x);
  for (i=1; i<lx; i++) x[i] = zero;
}

/* c1 <-- u.c1 + v.c2; c2 <-- a.c2 - b.c1 */
static void
update(GEN u, GEN v, GEN a, GEN b, GEN *c1, GEN *c2)
{
  GEN p1,p2;

  u = col_mul(u,*c1);
  v = col_mul(v,*c2);
  if (u) p1 = v? gadd(u,v): u;
  else   p1 = v? v: (GEN)NULL;

  a = col_mul(a,*c2);
  b = col_mul(gneg(b),*c1);
  if (a) p2 = b? gadd(a,b): a;
  else   p2 = b? b: (GEN)NULL;

  if (!p1) do_zero(*c1); else *c1 = p1;
  if (!p2) do_zero(*c2); else *c2 = p2;
}

/* Return the smith normal form d of matrix x. If all != 0 return [d,u,v],
 * where d = u.x.v
 */
static GEN
smithall(GEN x, long all)
{
  long av,tetpil,i,j,k,l,c,fl,n,s1,s2,lim;
  GEN p1,p2,p3,p4,z,b,u,v,d,ml,mr,mun,mdet,ys;

  if (typ(x)!=t_MAT) err(typeer,"smithall");
  if (DEBUGLEVEL>=9) outerr(x);
  av=avma; n=lg(x)-1;
  if (!n)
  {
    if (!all) return cgetg(1,t_VEC);
    z=cgetg(4,t_VEC);
    z[1]=lgetg(1,t_MAT);
    z[2]=lgetg(1,t_MAT);
    z[3]=lgetg(1,t_VEC); return z;
  }
  if (lg(x[1]) != n+1) err(mattype1,"smithall");
  for (i=1; i<=n; i++)
    for (j=1; j<=n; j++) 
      if (typ(coeff(x,i,j)) != t_INT)
        err(talker,"non integral matrix in smithall");

  lim = (av+bot)>>1; x=dummycopy(x); mdet=detint(x);
  if (ishnfall(x)) { if (all) { ml=idmat(n); mr=idmat(n); } }
  else
  {
    p1=hnfmod(x,mdet);
    if (all) { ml=idmat(n); mr=gauss(x,p1); }
    x=p1;
  }
  p1=cgetg(n+1,t_VEC); for (i=1; i<=n; i++) p1[i]=lnegi(gcoeff(x,i,i));
  p2=sindexsort(p1); ys=cgetg(n+1,t_MAT);
  for (j=1; j<=n; j++)
  {
    p1=cgetg(n+1,t_COL); ys[j]=(long)p1;
    for (i=1; i<=n; i++) p1[i]=coeff(x,p2[i],p2[j]);
  }
  x=ys;
  if (all)
  {
    p3=cgetg(n+1,t_MAT); p4=cgetg(n+1,t_MAT);
    for (j=1; j<=n; j++) { p3[j]=ml[p2[j]]; p4[j]=mr[p2[j]]; }
    ml=p3; mr=p4;
  }
  p1=hnfmod(x,mdet);
  if (all) mr=gmul(mr,gauss(x,p1));
  x=p1; mun = negi(gun);
  
  if (DEBUGLEVEL>=8) {fprintferr("debut de la boucle de smith");flusherr();}
  for (i=n; i>=2; i--)
  {
    if (DEBUGLEVEL>=8) {fprintferr("\ni = %ld: ",i);flusherr();}
    for(;;)
    {
      c=0;
      for (j=i-1; j>=1; j--)
      {
	if (DEBUGLEVEL>=8) {fprintferr("%ld ",j);flusherr();}
	p1=gcoeff(x,i,j); s1 = signe(p1);
	if (s1)
	{
	  p2=gcoeff(x,i,i);
          if (!absi_cmp(p1,p2))
          {
            s2=signe(p2);
            if (s1 == s2) { d=p1; u=gun; p4=gun; }
            else
	    {
              if (s2>0) { u = gun; p4 = mun; }
              else      { u = mun; p4 = gun; }
	      d=(s1>0)? p1: absi(p1);
	    }
            v = gzero; p3 = u; 
          }
          else { d=bezout(p2,p1,&u,&v); p3=divii(p2,d); p4=divii(p1,d); }
	  for (k=1; k<=i; k++)
	  {
	    b=addii(mulii(u,gcoeff(x,k,i)),mulii(v,gcoeff(x,k,j)));
	    coeff(x,k,j)=lsubii(mulii(p3,gcoeff(x,k,j)),
	                        mulii(p4,gcoeff(x,k,i)));
	    coeff(x,k,i)=(long)b;
	  }
	  if (all) update(u,v,p3,p4,(GEN*)(mr+i),(GEN*)(mr+j));
          if (low_stack(lim, (av+bot)>>1))
	  {
	    if (DEBUGMEM>1) err(warnmem,"[1]: smithall");
	    tetpil=avma;
	    if (all)
	    {
	      GEN *gptr[3];
	      gptr[0]=&x; gptr[1]=&ml; gptr[2]=&mr;
	      gerepilemany(av,gptr,3);
	    }
	    else x=gerepile(av,tetpil,gcopy(x));
	  }
	}
      }
      if (DEBUGLEVEL>=8) {fprintferr("; ");flusherr();}
      for (j=i-1; j>=1; j--)
      {
	if (DEBUGLEVEL>=8) {fprintferr("%ld ",j);flusherr();}
	p1=gcoeff(x,j,i); s1 = signe(p1);
	if (s1)
	{
	  p2=gcoeff(x,i,i);
	  if (!absi_cmp(p1,p2))
          {
            s2 = signe(p2);
            if (s1 == s2) { d=p1; u=gun; p4=gun; }
            else 
	    {
              if (s2>0) { u = gun; p4 = mun; }
              else      { u = mun; p4 = gun; }
	      d=(s1>0)? p1: absi(p1);
	    } 
            v = gzero; p3 = u;
          }
          else { d=bezout(p2,p1,&u,&v); p3=divii(p2,d); p4=divii(p1,d); }
	  for (k=1; k<=i; k++)
	  {
	    b=addii(mulii(u,gcoeff(x,i,k)),mulii(v,gcoeff(x,j,k)));
	    coeff(x,j,k)=lsubii(mulii(p3,gcoeff(x,j,k)),
	                        mulii(p4,gcoeff(x,i,k)));
	    coeff(x,i,k)=(long)b;
	  }
	  if (all) update(u,v,p3,p4,(GEN*)(ml+i),(GEN*)(ml+j));
	  c++;
	}
      }
      if (!c)
      {
	b=gcoeff(x,i,i); fl=1;
	if (signe(b))
	{
	  for (k=1; k<i && fl; k++)
	    for (l=1; l<i && fl; l++)
	      fl = !signe(resii(gcoeff(x,k,l),b));
	  if (!fl)
	  {
	    k--;
	    for (l=1; l<=i; l++)
	      coeff(x,i,l)=laddii(gcoeff(x,i,l),gcoeff(x,k,l));
	    if (all) ml[i]=ladd((GEN)ml[i],(GEN)ml[k]);
	  }
	}
        if (fl) break;
      }
      if (low_stack(lim, (av+bot)>>1))
      {
	if (DEBUGMEM>1) err(warnmem,"[2]: smithall");
	tetpil=avma;
	if (all)
	{
	  GEN *gptr[3];
	  gptr[0]=&x; gptr[1]=&ml; gptr[2]=&mr;
	  gerepilemany(av,gptr,3);
	}
	else x=gerepile(av,tetpil,gcopy(x));
      }
    }
  }
  if (DEBUGLEVEL>=8) {fprintferr("\n");flusherr();}
  if (all)
  {
    for (k=1; k<=n; k++)
      if (signe(gcoeff(x,k,k))<0)
        { mr[k]=lneg((GEN)mr[k]); coeff(x,k,k)=lnegi(gcoeff(x,k,k)); }
    ml=gtrans(ml); tetpil=avma; z=cgetg(4,t_VEC);
    z[1]=lcopy(ml); z[2]=lcopy(mr); z[3]=lcopy(x);
    return gerepile(av,tetpil,z);
  }
  tetpil=avma; z=cgetg(n+1,t_VEC); j=n;
  for (k=n; k; k--)
    if (signe(gcoeff(x,k,k))) z[j--]=labsi(gcoeff(x,k,k));
  for (   ; k; k--) z[j--]=zero;
  return gerepile(av,tetpil,z);
}

GEN
smith(GEN x)
{
  return smithall(x,0);
}

GEN
smith2(GEN x)
{
  return smithall(x,1);
}

/* Assume z was computed by smith2(). Remove the 1s on the diagonal */
GEN
smithclean(GEN z)
{
  long i,lx,c;
  GEN d,u,v,y,p1;

  if (typ(z)!=t_VEC || lg(z)!=4) err(typeer,"smithclean");
  d=(GEN)z[3]; v=(GEN)z[2]; u=(GEN)z[1]; lx = lg(d);
  for (c=1; c<lx; c++)
    if (gcmp1(gcoeff(d,c,c))) break;
  y=cgetg(4,t_VEC); p1=cgetg(lx,t_MAT);
  for (i=1; i<lx; i++)
  {
    setlg(u[i],c); p1[i]=lcopy((GEN)u[i]); setlg(u[i],lx); 
  }
  y[1]=(long)p1; setlg(v,c);
  y[2]=lcopy(v); setlg(v,lx); p1 = idmat(c-1); 
  for (i=1; i<c; i++) coeff(p1,i,i) = lcopy(gcoeff(d,i,i));
  y[3]=(long)p1; return y;
}

static GEN
gsmithall(GEN x,long all)
{
  long av = avma,tetpil,li,i,j,k,l,c,fl,n, lim = (av+bot)>>1;
  GEN p1,p2,p3,p4,z,b,u,v,d,ml,mr;

  if (typ(x)!=t_MAT) err(typeer,"gsmithall");
  n=lg(x)-1;
  if (!n)
  {
    if (!all) return cgetg(1,t_VEC);
    z=cgetg(4,t_VEC); z[1]=lgetg(1,t_MAT);
    z[2]=lgetg(1,t_MAT); z[3]=lgetg(1,t_VEC);
    return z;
  }
  li=lg(x[1])-1; x=dummycopy(x);
  if (li!=n) err(mattype1,"gsmithall");
  if (all) { ml=idmat(n); mr=idmat(n); }
  for (i=n; i>=2; i--)
  {
    do
    {
      c=0;
      for (j=i-1; j>=1; j--)
      {
	p1=gcoeff(x,i,j);
	if (signe(p1))
	{
	  p2=gcoeff(x,i,i); v=gdiventres(p1,p2);
	  if (gcmp0((GEN)v[2])) { d=p2; p4=(GEN)v[1]; v=gzero; p3=gun; u=gun; }
	  else { d=gbezout(p2,p1,&u,&v); p3=gdiv(p2,d); p4=gdiv(p1,d); }
	  for (k=1; k<=i; k++)
	  {
	    b=gadd(gmul(u,gcoeff(x,k,i)),gmul(v,gcoeff(x,k,j)));
	    coeff(x,k,j)=lsub(gmul(p3,gcoeff(x,k,j)),gmul(p4,gcoeff(x,k,i)));
	    coeff(x,k,i)=(long)b;
	  }
	  if (all)
	  {
	    b=gadd(gmul(u,(GEN)mr[i]),gmul(v,(GEN)mr[j]));
	    mr[j]=lsub(gmul(p3,(GEN)mr[j]),gmul(p4,(GEN)mr[i]));
	    mr[i]=(long)b;
	  }
	}
      }
      for (j=i-1; j>=1; j--)
      {
	p1=gcoeff(x,j,i);
	if (signe(p1))
	{
	  p2=gcoeff(x,i,i); v=gdiventres(p1,p2);
	  if (gcmp0((GEN)v[2])) { d=p2; p4=(GEN)v[1]; v=gzero; p3=gun; u=gun; }
	  else { d=gbezout(p2,p1,&u,&v); p3=gdiv(p2,d); p4=gdiv(p1,d); }
	  for (k=1; k<=i; k++)
	  {
	    b=gadd(gmul(u,gcoeff(x,i,k)),gmul(v,gcoeff(x,j,k)));
	    coeff(x,j,k)=lsub(gmul(p3,gcoeff(x,j,k)),gmul(p4,gcoeff(x,i,k)));
	    coeff(x,i,k)=(long)b;
	  }
	  if (all)
	  {
	    b=gadd(gmul(u,(GEN)ml[i]),gmul(v,(GEN)ml[j]));
	    ml[j]=lsub(gmul(p3,(GEN)ml[j]),gmul(p4,(GEN)ml[i]));
	    ml[i]=(long)b;
	  }
	  c++;
	}
      }
      if (!c)
      {
	b=gcoeff(x,i,i); fl=1;
	if (signe(b))
	{
	  for (k=1; (k<i)&&fl; k++)
	    for (l=1; (l<i)&&fl; l++)
	      fl= !signe(gmod(gcoeff(x,k,l),b));
	  if (!fl)
	  {
	    k--;
	    for (l=1; l<=i; l++)
	      coeff(x,i,l)=ladd(gcoeff(x,i,l),gcoeff(x,k,l));
	    if (all) ml[i]=ladd((GEN)ml[i],(GEN)ml[k]);
	  }
	}
      }
      if (low_stack(lim, (av+bot)>>1))
      {
	if (DEBUGMEM>1) err(warnmem,"[5]: smithall");
	tetpil=avma;
	if (all)
	{
	  GEN *gptr[3];
	  gptr[0]=&x; gptr[1]=&ml; gptr[2]=&mr;
	  gerepilemany(av,gptr,3);
	}
	else x=gerepile(av,tetpil,gcopy(x));
      }
    }
    while (c || !fl);
  }
  if (all)
  {
    for (k=1; k<=n; k++)
      if (signe(gcoeff(x,k,k))<0)
      { mr[k]=lneg((GEN)mr[k]); coeff(x,k,k)=lneg(gcoeff(x,k,k)); }
    ml=gtrans(ml); tetpil=avma; z=cgetg(4,t_VEC);
    z[3]=lcopy(x); z[1]=lcopy(ml); z[2]=lcopy(mr);
  }
  else
  {
    tetpil=avma; z=cgetg(n+1,t_VEC);
    for (j=0,k=1; k<=n; k++) if (!signe(gcoeff(x,k,k))) z[++j]=zero;
    for (k=1; k<=n; k++)
      if (signe(p1=gcoeff(x,k,k))) z[++j]=(long)gabs(p1,0);
  }
  return gerepile(av,tetpil,z);
}

GEN
matsnf0(GEN x,long flag)
{
  switch(flag)
  {
    case 0: return smithall(x,0);
    case 1: return smithall(x,1);
    case 2: return gsmithall(x,0);
    case 3: return gsmithall(x,1);
    case 4: return smithclean(x);
    default: err(flagerr);
  }
  return NULL; /* not reached */
}

GEN
gsmith(GEN x)
{
  return gsmithall(x,0);
}

GEN
gsmith2(GEN x)
{
  return gsmithall(x,1);
}

/*************************************************************************/
/**									**/
/**			       GALOIS GROUP   				**/
/**									**/
/*************************************************************************/

/* exchange elements i and j in vector x */
static GEN
transroot(GEN x, int i, int j)
{
  long k;
  x = dummycopy(x);
  k=x[i]; x[i]=x[j]; x[j]=k; return x;
}

GEN
tschirnhaus(GEN x)
{
  long av=avma,tetpil,v,n,a,b,c;
  GEN u;

  if (typ(x)!=t_POL) err(notpoler,"tschirnhaus");
  n=lgef(x)-3; if (n<=0) err(constpoler,"tschirnhaus");
  v = varn(x);
  if (v) { u=dummycopy(x); setvarn(u,0); x=u; }
  do
  {
    a = mymyrand() & 3; if (!a) a=1;
    b = mymyrand() & 7; if (b>=4) b-=8;
    c = mymyrand() & 7; if (c>=4) c-=8;
    u=gmodulcp(gaddsg(c,gmul(polx[0],gaddsg(b,gmulsg(a,polx[0])))), x);
    tetpil=avma; u=caract(u,v); a=avma;
  }
  while (lgef(srgcd(u,deriv(u,v))) >= 4);
  if (DEBUGLEVEL>1)
  {
    fprintferr("transformation de Tschirnhaus: nouveau polynome ");
    outerr(u); flusherr();
  }
  avma=a; return gerepile(av,tetpil,u);
}

int
gpolcomp(GEN p1, GEN p2)
{
  int s,j = lgef(p1)-2;

  if (lgef(p2)-2 != j)
    err(bugparier,"gpolcomp (different degrees)");
  for (; j>=2; j--)
  {
    s = absi_cmp((GEN)p1[j], (GEN)p2[j]);
    if (s) return s;
  }
  return 0;
}

/* pol is assumed to be primitive and integral */
static GEN
primitive_pol_to_monic(GEN pol, GEN *lead)
{
  long n = lgef(pol)-1;
  GEN p2,p1,res; 
  
  if (gcmp1((GEN)pol[n])) { if (lead) *lead = NULL; return pol; }
  res = cgetg(n+1,t_POL); res[1]=pol[1];
  p2 = p1 = (GEN) pol[n];
  res[n] = un;     n--;
  res[n] = pol[n]; n--;
  for (;;)
  {
    res[n] = lmulii(p2,(GEN)pol[n]);
    if (n==2) { if (lead) *lead = p1; return res; }
    p2 = mulii(p1,p2); n--;
  }
}

/* compute x1*x2^2 + x2*x3^2 + x3*x4^2 + x4*x1^2 */
static GEN
get_F4(GEN x)
{
  GEN p1=gzero;
  long i;

  for (i=1; i<=4; i++)
    p1 = gadd(p1, gmul((GEN)x[i], gsqr((GEN)x[(i&3)+1])));
  return p1;
}

GEN galoisbig(GEN x, long prec);

GEN
galois(GEN x, long prec)
{
  long av=avma,av1,i,j,k,n,f,l,l2,e,e1,pr;
  GEN x1,p1,p2,p3,p4,p5,p6,y;
  static int ind5[20]={2,5,3,4, 1,3,4,5, 1,5,2,4, 1,2,3,5, 1,4,2,3};
  static int ind6[60]={3,5,4,6, 2,6,4,5, 2,3,5,6, 2,4,3,6, 2,5,3,4,
                       1,4,5,6, 1,5,3,6, 1,6,3,4, 1,3,4,5, 1,6,2,5,
                       1,2,4,6, 1,5,2,4, 1,3,2,6, 1,2,3,5, 1,4,2,3};
  if (typ(x)!=t_POL) err(notpoler,"galois");
  n=lgef(x)-3; if (n<=0) err(constpoler,"galois");
  if (n>11) err(impl,"galois of degree higher than 11");
  x = gdiv(x,content(x));
  for (i=2; i<=n+2; i++) 
    if (typ(x[i])!=t_INT) err(polrationer,"galois");
  if (gisirreducible(x) != gun)
    err(impl,"galois of reducible polynomial");

  if (n<4)
  {
    if (n<3)
    {
      avma=av; y=cgetg(4,t_VEC);
      y[1] = (n==1)? un: deux;
      y[2]=lnegi(gun);
    }
    else /* n=3 */
    {
      f=carreparfait(discsr(x));
      avma=av; y=cgetg(4,t_VEC);
      if (f) { y[1]=lstoi(3); y[2]=un; }
      else   { y[1]=lstoi(6); y[2]=lnegi(gun); }
    }
    y[3]=un; return y;
  }
  x1 = x = primitive_pol_to_monic(x,NULL); av1=avma;
  if (n>7) return galoisbig(x,prec);
  for(;;)
  {
    switch(n)
    {
      case 4:
        for(;;)
	{
	  p1=roots(x,prec); 
          p2=p1;  p4=gsub(polx[0], get_F4(p2));  p2=transroot(p1,1,2);
	  p4=gmul(p4,gsub(polx[0], get_F4(p2))); p2=transroot(p1,1,3);
	  p4=gmul(p4,gsub(polx[0], get_F4(p2))); p2=transroot(p1,1,4);
	  p4=gmul(p4,gsub(polx[0], get_F4(p2))); p2=transroot(p1,2,3);
	  p4=gmul(p4,gsub(polx[0], get_F4(p2))); p2=transroot(p1,3,4);
	  p4=gmul(p4,gsub(polx[0], get_F4(p2)));
          p5=grndtoi(greal(p4),&e); 
          e1=gexpo(gimag(p4)); if (e1>e) e=e1;
          if (e <= -10) break;
	  prec = (prec<<1)-2;
	}
	p6=ggcd(p5,deriv(p5,0));
	if (typ(p6)==t_POL && lgef(p6)>3) goto tchi;
	p1=factor(p5); p2=(GEN)p1[1]; l=lg(p2)-1;
	switch(l)
	{
	  case 1: f=carreparfait(discsr(x)); avma=av; y=cgetg(4,t_VEC);
	    y[3]=un;
	    if (f) { y[2]=un; y[1]=lstoi(12); return y; }
	    y[2]=lnegi(gun); y[1]=lstoi(24); return y;

	  case 2: avma=av; y=cgetg(4,t_VEC);
	    y[3]=un; y[2]=lnegi(gun); y[1]=lstoi(8); return y;
	
	  case 3: avma=av; y=cgetg(4,t_VEC);
	    y[1]=lstoi(4); y[3]=un;
	    y[2] = (lgef(p2[1])==5)? un: lnegi(gun);
	    return y;

	  default: err(bugparier,"galois (bug1)");
	}

      case 5:
        for(;;)
	{
          GEN ee = cgeti(7), z = cgetg(7,t_VEC);
          for(;;)
	  {
	    p1=roots(x,prec);
	    for (l=1; l<=5; l++)
	    {
	      p2=(l==1)?p1:transroot(p1,1,l);
	      p3=gzero; k=0;
              for (i=1; i<=5; i++)
	      {
		p5=gadd(gmul((GEN)p2[ind5[k]],(GEN)p2[ind5[k+1]]),
		        gmul((GEN)p2[ind5[k+2]],(GEN)p2[ind5[k+3]]));
		p3=gadd(p3,gmul(gsqr((GEN)p2[i]),p5)); k+=4;
	      }
	      z[l]=lrndtoi(greal(p3),&e);
              e1 = gexpo(gimag(p3)); ee[l]=max(e,e1);
	      p4 = (l==1) ?gsub(polx[0],p3):gmul(p4,gsub(polx[0],p3));
	    }
	    p2=transroot(p1,2,5);
	    p3=gzero; k=0;
            for (i=1; i<=5; i++)
	    {
	      p5=gadd(gmul((GEN)p2[ind5[k]],(GEN)p2[ind5[k+1]]),
	              gmul((GEN)p2[ind5[k+2]],(GEN)p2[ind5[k+3]]));
	      p3=gadd(p3,gmul(gsqr((GEN)p2[i]),p5)); k+=4;
	    }
	    z[6]=lrndtoi(greal(p3),&e);
            e1 = gexpo(gimag(p3)); if (e1>e) e=e1;
	    ee[6]=e;
	    p4=gmul(p4,gsub(polx[0],p3));
	    p5=grndtoi(greal(p4),&e);
            e1 = gexpo(gimag(p4)); if (e1>e) e=e1;
            if (e <= -10) break;
	    prec = (prec<<1)-2;
	  }
	  p6=ggcd(p5,deriv(p5,0));
	  if (typ(p6)==t_POL && lgef(p6)>3) goto tchi;
	  p3=factor(p5); l=lg(p3[1])-1;
	  f=carreparfait(discsr(x));
	  if (l==1)
	  {
	    avma=av; y=cgetg(4,t_VEC); y[3]=un;
	    if (f) { y[2]=un; y[1]=lstoi(60); return y; }
	    else { y[2]=lneg(gun); y[1]=lstoi(120); return y; }
	  }
	  if (!f)
	  {
	    avma=av; y=cgetg(4,t_VEC);
	    y[3]=un; y[2]=lneg(gun); y[1]=lstoi(20); return y;
	  }
          pr = - (bit_accuracy(prec) >> 1);
          for (l=1; l<=6; l++)
	    if (ee[l] <= pr && gcmp0(poleval(p5,(GEN)z[l]))) break;
	  if (l>6) err(bugparier,"galois (bug4)");
	  p2=(l==6)? transroot(p1,2,5):transroot(p1,1,l);
	  p3=gzero;
	  for (i=1; i<=5; i++)
	  {
	    j=(i%5)+1;
	    p3=gadd(p3,gmul(gmul((GEN)p2[i],(GEN)p2[j]),
			    gsub((GEN)p2[j],(GEN)p2[i])));
	  }
	  p5=gsqr(p3); p4=grndtoi(greal(p5),&e);
          e1 = gexpo(gimag(p5)); if (e1>e) e=e1;
	  if (e <= -10)
	  {
	    if (gcmp0(p4)) goto tchi;
	    f=carreparfait(p4); avma=av; y=cgetg(4,t_VEC);
	    y[3]=y[2]=un; y[1]=lstoi(f?5:10);
	    return y;
	  }
	  prec=(prec<<1)-2;
	}

      case 6:
        for(;;)
	{
          for(;;)
	  {
	    p1=roots(x,prec);
	    for (l=1; l<=6; l++)
	    {
	      p2=(l==1)?p1:transroot(p1,1,l);
	      p3=gzero; k=0;
              for (i=1; i<=5; i++) for (j=i+1; j<=6; j++)
	      {
		p5=gadd(gmul((GEN)p2[ind6[k]],(GEN)p2[ind6[k+1]]),
		        gmul((GEN)p2[ind6[k+2]],(GEN)p2[ind6[k+3]]));
		p3=gadd(p3,gmul(gsqr(gmul((GEN)p2[i],(GEN)p2[j])),p5)); k+=4;
	      }
	      p4 = (l==1) ? gsub(polx[0],p3):gmul(p4,gsub(polx[0],p3));
	    }
	    p5=grndtoi(greal(p4),&e); 
            e1 = gexpo(gimag(p4)); if (e1>e) e=e1;
            if (e <= -10) break;
	    prec=(prec<<1)-2;
	  }
	  p6=ggcd(p5,deriv(p5,0));
	  if (typ(p6)==t_POL && lgef(p6)>3) goto tchi;
	  p3=factor(p5); p2=(GEN)p3[1]; l=lg(p2)-1;
	  switch(l)
	  {
	    case 1:
	      p3=gadd(gmul(gmul((GEN)p1[1],(GEN)p1[2]),(GEN)p1[3]),
	              gmul(gmul((GEN)p1[4],(GEN)p1[5]),(GEN)p1[6]));
	      p4=gsub(polx[0],p3);
	      for (i=1; i<=3; i++)
		for (j=4; j<=6; j++)
		{
		  p2=transroot(p1,i,j);
		  p3=gadd(gmul(gmul((GEN)p2[1],(GEN)p2[2]),(GEN)p2[3]),
		          gmul(gmul((GEN)p2[4],(GEN)p2[5]),(GEN)p2[6]));
		  p4=gmul(p4,gsub(polx[0],p3));
		}
	      p5=grndtoi(greal(p4),&e);
              e1 = gexpo(gimag(p4)); if (e1>e) e=e1;
	      if (e <= -10)
	      {
		p6=ggcd(p5,deriv(p5,0));
		if (typ(p6)==t_POL && lgef(p6)>3) goto tchi;
		p3=factor(p5); p2=(GEN)p3[1]; l=lg(p2)-1;
		f=carreparfait(discsr(x));
		avma=av; y=cgetg(4,t_VEC); y[3]=un;
		if (l==1)
		{
		  if (f) { y[2]=un; y[1]=lstoi(360); }
		  else { y[2]=lnegi(gun); y[1]=lstoi(720); }
		}
		else
		{
		  if (f) { y[2]=un; y[1]=lstoi(36); }
		  else { y[2]=lnegi(gun); y[1]=lstoi(72); }
		}
                return y;
	      }
	      prec=(prec<<1)-2; break;
		
	    case 2: l2=lgef(p2[1])-3; if (l2>3) l2=6-l2;
	      switch(l2)
	      {
		case 1: f=carreparfait(discsr(x));
		  avma=av; y=cgetg(4,t_VEC); y[3]=un;
		  if (f) { y[2]=un; y[1]=lstoi(60); }
		  else { y[2]=lneg(gun); y[1]=lstoi(120); }
		  return y;
		case 2: f=carreparfait(discsr(x));
		  if (f)
		  {
		    avma=av; y=cgetg(4,t_VEC);
		    y[3]=y[2]=un; y[1]=lstoi(24);
		  }
		  else
		  {
		    p3=(lgef(p2[1])==5) ? (GEN)p2[2]:(GEN)p2[1];
		    f=carreparfait(discsr(p3));
		    avma=av; y=cgetg(4,t_VEC); y[2]=lneg(gun);
		    if (f) { y[1]=lstoi(24); y[3]=deux; }
		    else { y[1]=lstoi(48); y[3]=un; }
		  }
		  return y;
		case 3: f=carreparfait(discsr((GEN)p2[1]))
		       || carreparfait(discsr((GEN)p2[2]));
		  avma=av; y=cgetg(4,t_VEC);
		  y[3]=un; y[2]=lneg(gun); y[1]=lstoi(f? 18: 36);
		  return y;
	      }
	    case 3:
	      for (l2=1; l2<=3; l2++)
		if (lgef(p2[l2])>=6) p3=(GEN)p2[l2];
	      if (lgef(p3)==6)
	      {
		f=carreparfait(discsr(p3)); avma=av; y=cgetg(4,t_VEC);
                y[2]=lneg(gun); y[1]=lstoi(f? 6: 12);
	      }
	      else
	      {
		f=carreparfait(discsr(x)); avma=av; y=cgetg(4,t_VEC);
		if (f) { y[2]=un; y[1]=lstoi(12); }
		else { y[2]=lneg(gun); y[1]=lstoi(24); }
	      }
              y[3]=un; return y;
	    case 4: avma=av; y=cgetg(4,t_VEC);
	      y[1]=lstoi(6); y[2]=lneg(gun); y[3]=deux; return y;
            default: err(bugparier,"galois (bug3)");
	  }
	}
	
      case 7:
        for(;;)
	{
	  p1=roots(x,prec); p4=gun;
	  for (i=1; i<=5; i++)
	    for (j=i+1; j<=6; j++)
            {
              p6 = gadd((GEN)p1[i],(GEN)p1[j]);
	      for (k=j+1; k<=7; k++)
		p4 = gmul(p4,gsub(polx[0], gadd(p6,(GEN)p1[k])));
            }
          p5=grndtoi(greal(p4),&e); 
          e1 = gexpo(gimag(p4)); if (e1>e) e=e1;
	  if (e <= -10) break;
          prec = (prec<<1)-2;
	}
	p6=ggcd(p5,deriv(p5,0));
	if (typ(p6)==t_POL && lgef(p6)>3) goto tchi;
	p1=factor(p5); p2=(GEN)p1[1]; l=lg(p2)-1;
	switch(l)
	{
	  case 1: f=carreparfait(discsr(x)); avma=av; y=cgetg(4,t_VEC); y[3]=un;
	    if (f) { y[2]=un; y[1]=lstoi(2520); }
	    else { y[2]=lneg(gun); y[1]=lstoi(5040); }
	    return y;
	  case 2: f=lgef(p2[1])-3; avma=av; y=cgetg(4,t_VEC); y[3]=un;
	    if (f==7 || f==28) { y[2]=un; y[1]=lstoi(168); }
	    else { y[2]=lneg(gun); y[1]=lstoi(42); }
	    return y;
	  case 3: avma=av; y=cgetg(4,t_VEC);
	    y[3]=y[2]=un; y[1]=lstoi(21); return y;
	  case 4: avma=av; y=cgetg(4,t_VEC);
	    y[3]=un; y[2]=lneg(gun); y[1]=lstoi(14); return y;
	  case 5: avma=av; y=cgetg(4,t_VEC);
	    y[3]=y[2]=un; y[1]=lstoi(7); return y;
          default: err(talker,"galois (bug2)");
	}
    }
    tchi: avma=av1; x=tschirnhaus(x1);
  }
}

/*************************************************************************/
/**									**/
/**                           GALOIS CONJUGATES        		        **/
/**									**/
/*************************************************************************/

static long
computehenselbound(GEN nf, GEN p)
{
  long n,r1,r2,ru,i,j,e,av=avma;
  GEN p1,m,mm,pt6,mi,pmax;

  r1=itos(gmael(nf,2,1)); r2=itos(gmael(nf,2,2));
  ru=r1+r2; n=lgef(nf[1])-3;
  mm=gmael(nf,5,1); m=cgetg(n+1,t_MAT);
  for (j=1; j<=n; j++)
  {
    p1=cgetg(n+1,t_COL); m[j]=(long)p1;
    for (i=1; i<=ru; i++) p1[i] = coeff(mm,i,j);
    for (   ; i<=n ; i++) p1[i] = lconj(gcoeff(mm,i-r2,j));
  }
  mi = gmul(m,gmael(nf,5,6)); pmax=gzero;
  for (j=1; j<=n; j++)
  {
    p1 = gnorml2((GEN)mi[j]);
    if (cmpii(p1,pmax) > 0) pmax = p1;
  }
  pt6=(GEN)nf[6]; p1=gzero;
  for (i=1; i<=r1; i++) p1=gadd(p1,gnorm((GEN)pt6[i]));
  for (   ; i<=ru; i++) p1=gadd(p1,gmul2n(gnorm((GEN)pt6[i]),1));
  p1=gaddsg(1,gmulsg(n,gsqr(gmul(p1,pmax))));

  e = gexpo(p1); avma=av;
  e = (e+n+1)/expi(p) + 3; /* A MODIFIER */
  if (DEBUGLEVEL>1) { fprintferr("exponent = %ld\n",e); flusherr(); }
  return e;
}

static long
is_totally_split(GEN f, long p)
{
  long av = avma, n=lgef(f);
  GEN x;
  
  if (n-3 > p) return 0;
  f = gmul(f, gmodulss(1,p));
  if (lgef(f) != n) { avma=av; return 0; }
  x = cgetg(3,t_POLMOD); x[1]=(long)f; x[2]=lpolx[varn(f)];
  x = gadd(gpuigs(x,p), gneg(x)); /* x^p-x mod (f(x),p) */
  n = gcmp0(x); avma = av; return n;
}

static GEN
check_conj(GEN p1, GEN nf, GEN pol1, GEN pol2, long n)
{
  GEN p2 = (GEN)p1[n+1];
  if (is_pm1(p2))
  { 
    setlg(p1,n+1); p1 = gmul((GEN)nf[7], p1);
    if (signe(p2) > 0) p1 = gneg(p1);
    if (gcmp0(poleval(pol1,gmodulcp(p1,pol2)))) return p1;
  }
  return NULL; /* not a conjugate */
}

/* initialize m */
static void
init_conj(GEN m, GEN nf, GEN fa, GEN pe, long v, long n)
{
  GEN a,a1,mred;
  long i;
  
  coeff(m,1,1) = (long)pe; a=gmodulcp((GEN)fa[1],pe);
  a1=centerlift(gneg(gsubst((GEN)nf[7],v,a)));
  for (i=2; i<=n; i++) coeff(m,1,i)=a1[i];
  setlg(m,n+1); mred=gmul(m,lllint(m)); setlg(m,n+2);
  for (i=1; i<=n; i++) m[i]=mred[i];
  if (DEBUGLEVEL>1) { fprintferr("initial LLL done\n"); flusherr(); }
}

/* return smallest p not dividing bad, such that x is (totally) split mod p */
static GEN
choose_p(GEN bad, GEN x)
{
  byteptr pt = diffptr;
  long p = *pt++; /* = 2 */

  for(;;)
  {
    p += *pt++; if (!*pt) err(primer1);
    if (smodis(bad,p) && is_totally_split(x,p)) break;
  }
  if (DEBUGLEVEL>1) { fprintferr("choosing p = %ld\n",p); flusherr(); }
  return stoi(p);
}

GEN
galoisconj(GEN nf)
{
  long av=avma,tetpil,i,k,n,v,e;
  GEN x,y,p1,p,m,fa,pe,mred;

  if (DEBUGLEVEL>1)
    { fprintferr("Entree dans galoisconj()\n"); flusherr(); }
  nf=checknf(nf); x=(GEN)nf[1];
  n=lgef(x)-3; if (n<=0) return cgetg(1,t_VEC);
  p1 = mulii((GEN)nf[3],(GEN)nf[4]);
  p = choose_p(p1,x); e = computehenselbound(nf,p);

  m=idmat(n+1); fa = gtrunc(rootpadicfast(x,p,e,1));
  pe=gpuigs(p,e); v=varn(x); init_conj(m,nf,fa,pe,v,n);

  y=cgetg(n+1,t_VEC); y[1]=(long)polx[v];
  for (i=2; i<=n; i++)
  {
    coeff(m,1,n+1) = (long) centerlift(gneg(gmodulcp((GEN)fa[i],pe)));
    mred = gmul(m,lllint(m));
    for (k=1; k<=n; k++)
    {
      p1 = check_conj((GEN)mred[k],nf,x,x,n);
      if (p1) { y[i]=(long)p1; break; }
    }
    if (k > n) y[i]=zero; /* conjugate not found */
  }
  tetpil=avma; return gerepile(av,tetpil,gcopy(y));
}

/* fliso = 0 test for inclusion, else for isomorphism */
GEN
isisomfastall(GEN nf1, GEN nf2, long fliso)
{
  long av=avma,tetpil,i,k,n,n1,e,count;
  GEN x1,x2,y,p1,p,m,fa1,fa2,pe,mred;

  nf1=checknf(nf1); x1=(GEN)nf1[1];
  nf2=checknf(nf2); x2=(GEN)nf2[1];
  if (fliso)
  {
    if (!gegal((GEN)nf1[2],(GEN)nf2[2])) { avma=av; return gzero; }
    if (!gegal((GEN)nf1[3],(GEN)nf2[3])) { avma=av; return gzero; }
    n1 = n = lgef(x1)-3;
    if (n<=0) err(constpoler,"isisomfastall");
  }
  else
  {
    n=lgef(x2)-3; n1=lgef(x1)-3;
    if (n<=0 || n1<=0) err(constpoler,"isisomfastall");
    if (n%n1 || !divise((GEN)nf2[3],gpuigs((GEN)nf1[3],n/n1)))
      { avma=av; return gzero; }
  }
  p1 = mulii(mulii((GEN)nf2[3],(GEN)nf1[4]),(GEN)nf2[4]);
  p = choose_p(p1,x2);
  if (!is_totally_split(x1,p[2])) { avma=av; return gzero; }

  /* A MODIFIER nf1 et nf2 doivent etre pris en compte a la fois */
  e = max(computehenselbound(nf2,p), computehenselbound(nf1,p));
  pe=gpuigs(p,e); m=idmat(n+1);
  fa1=gtrunc(rootpadicfast(x1,p,e,1));
  fa2=gtrunc(rootpadicfast(x2,p,e,0));
  init_conj(m,nf2,fa2,pe,varn(x2),n);

  y=cgetg(n1+1,t_VEC); count=1;
  for (i=1; i<=n1; i++)
  {
    coeff(m,1,n+1) = (long) centerlift(gneg(gmodulcp((GEN)fa1[i],pe)));
    mred = gmul(m,lllint(m));
    for (k=1; k<=n; k++)
    {
      p1 = check_conj((GEN)mred[k],nf2,x1,x2,n);
      if (p1) { y[count++]=(long)p1; break; }
    }
  }
  if (count==1) { avma=av; return gzero; }
  tetpil=avma; setlg(y,count);
  return gerepile(av,tetpil,gcopy(y));
}

GEN
isisomfast(GEN nf1, GEN nf2)
{
  return isisomfastall(nf1,nf2,1);
}

GEN
isinclfast(GEN nf1, GEN nf2)
{
  return isisomfastall(nf1,nf2,0);
}

/* modify polr */
static void
henselstep(GEN x, GEN polr, long e)
{
  GEN yi,xp;
  long i,n;

  n=lgef(x)-3; xp=deriv(x,varn(x));
  for (i=1; i<=n; i++)
  {
    yi = gprec((GEN)polr[i], e);
    polr[i] = lsub(yi, gdiv(poleval(x,yi),poleval(xp,yi)));
  }
}

GEN
galoisconjforce(GEN nf)
{
  long av=avma,tetpil,av1,i,n,v,e;
  GEN x,y,p1,p,m,fa,pe,mred,polr;

  if (DEBUGLEVEL>1)
    { fprintferr("Entree dans galoisconjforce()\n"); flusherr(); }
  nf=checknf(nf); x=(GEN)nf[1];
  n=lgef(x)-3; if (n<=0) return cgetg(1,t_VEC);
  
  p1 = mulii((GEN)nf[3],(GEN)nf[4]);
  p=choose_p(p1,x); e=computehenselbound(nf,p);
  polr=rootpadicfast(x,p,e,1); pe=gpuigs(p,e);
  if (DEBUGLEVEL>1) { fprintferr("p-adic roots computed\n"); flusherr(); }
  m=idmat(n+1); v=varn(x); 

  y=cgetg(n+1,t_VEC); y[1]=(long)polx[v];
  for (i=2;;)
  {
    av1=avma; fa=gtrunc(polr); init_conj(m,nf,fa,pe,v,n);
    for ( ; i<=n; i++)
    {
      coeff(m,1,n+1) = (long) centerlift(gneg(gmodulcp((GEN)fa[i],pe)));
      mred=gmul(m,lllint(m));
      if (DEBUGLEVEL>1) { fprintferr("LLL for root done\n"); flusherr(); }
      p1 = check_conj((GEN)mred[1],nf,x,x,n);
      if (p1) { y[i]=(long)p1; continue; } /* conjugate found */

      /* otherwise increase p-adic precision, re-do outermost loop */
      avma=av1; e<<=1; henselstep(x,polr,e); pe=gsqr(pe);
      if (DEBUGLEVEL>1)
        { fprintferr("doubling exponent. new e = %ld\n",e); flusherr(); }
      break;
    }
    if (i > n)
    {
      tetpil=avma; return gerepile(av,tetpil,gcopy(y));
    }
  }
}

GEN
galoisconj1(GEN nf, long prec)
{
  long av=avma,tetpil,i,j,n,r1,ru;
  GEN x,y,w,polr,p1,p2;

  if (DEBUGLEVEL>1) { fprintferr("Entree dans galoisconj1()\n"); flusherr(); }
  nf=checknf(nf); x=(GEN)nf[1];

  n=lgef(x)-3; if (n<=0) return cgetg(1,t_VEC);
  r1 = itos(gmael(nf,2,1)); p1=(GEN)nf[6]; 
  ru = (n+r1)>>1;
  polr = cgetg(n+1,t_VEC);
  for (i=1; i<=r1; i++) polr[i]=p1[i];
  for (j=i; i<=ru; i++) { polr[j++]=p1[i]; polr[j++]=lconj((GEN)p1[i]); }
  p1=(GEN)polr[1];
  p2=gmael(nf,5,1); w=cgetg(n+1,t_VEC);
  for (i=1; i<=n; i++) w[i]=coeff(p2,1,i);

  y=cgetg(n+1,t_VEC); y[1]=(long)polx[varn(x)];
  for (i=2; i<=n; i++)
  {
    y[i] = zero;
    p1 = lindep2(concatsp(w,(GEN)polr[i]), bit_accuracy(prec)<<1);
    if (signe(p1[n+1]))
    {
      setlg(p1, n+1); settyp(p1,t_COL);
      p2 = gdiv(gmul((GEN)nf[7],p1), negi((GEN)p1[n+1]));
      if (gdivise(poleval(x,p2), x)) y[i] = (long)p2;
    }
    if (DEBUGLEVEL>1) outerr((GEN)y[i]);
  }
  tetpil=avma; return gerepile(av,tetpil,gcopy(y));
}

GEN
galoisconj2(GEN x, long prec)
{
  long av=avma,tetpil,i,n,v;
  GEN y,w,polr,p1,p2;

  if (DEBUGLEVEL>1){ fprintferr("Entree dans galoisconj2()\n"); flusherr(); }
  if (typ(x)!=t_POL) return galoisconj1(x,prec);

  n=lgef(x)-3; if (n<=0) return cgetg(1,t_VEC);
  if (gisirreducible(x) == gzero) err(redpoler,"galoisconj2");
  polr=roots(x,prec); p1=(GEN)polr[1];
  w=cgetg(n+1,t_VEC); w[1]=un;
  for (i=2; i<=n; i++) w[i]=lmul(p1,(GEN)w[i-1]);

  v=varn(x); y=cgetg(n+1,t_VEC); y[1]=(long)polx[v];
  for (i=2; i<=n; i++)
  {
    y[i] = zero;
    p1 = lindep2(concatsp(w,(GEN)polr[i]), bit_accuracy(prec)<<1);
    if (signe(p1[n+1]))
    {
      p2 = gdiv(gtopoly(p1,v), negi((GEN)p1[n+1]));
      if (gdivise(poleval(x,p2), x)) y[i] = (long)p2;
    }
    if (DEBUGLEVEL>1) outerr((GEN)y[i]);
  }
  tetpil=avma; return gerepile(av,tetpil,gcopy(y));
}

GEN
galoisconj0(GEN nf,long flag, long prec)
{
  switch(flag)
  {
    case 0: return galoisconj(nf);
    case 1: return galoisconjforce(nf);
    case 2: return galoisconj1(nf,prec);
    case 3: return galoisconj2(nf,prec);
    case 4: return conjugates(nf);
    default: err(flagerr);
  }
  return NULL; /* not reached */
}

GEN
galoisapply(GEN nf, GEN aut, GEN x)
{
  long av=avma,tetpil,lx,j,N;
  GEN p1,y,pol,unmod;

  nf=checknf(nf); pol=(GEN)nf[1];
  if (typ(aut)==t_POL) aut = gmodulcp(aut,pol);
  else
  {
    if (typ(aut)!=t_POLMOD || !gegal((GEN)aut[1],pol) || gcmp0((GEN)aut[1]))
      err(talker,"incorrect galois automorphism in galoisapply");
  }
  switch(typ(x))
  {
    case t_INT: case t_INTMOD: case t_FRAC: case t_FRACN: case t_PADIC:
      avma=av; return gcopy(x);

    case t_POLMOD: x = (GEN) x[2]; /* fall through */
    case t_POL:
      tetpil=avma; p1=gsubst(x,varn(pol),aut);
      if (typ(p1)!=t_POLMOD || !gegal((GEN)p1[1],pol))
      {
	tetpil=avma; p1=gmodulcp(p1,pol);
      }
      return gerepile(av,tetpil,p1);

    case t_VEC:
      if (lg(x)==3)
      {
	tetpil=avma; y=cgetg(3,t_VEC);
	y[1]=(long)galoisapply(nf,aut,(GEN)x[1]);
	y[2]=zero; y = gerepile(av,tetpil,y);
        y[2]=lcopy((GEN)x[2]); return y;
      }
      if (lg(x)!=6) err(typeer,"galoisapply");
      y=cgetg(6,t_VEC); y[1]=x[1]; y[3]=x[3]; y[4]=x[4];
      unmod=gmodulsg(1,(GEN)x[1]);
      p1=centerlift(gmul(unmod,algtobasis(nf,galoisapply(nf,aut,(GEN)x[2]))));
      if (gcmp1((GEN)x[3]))
	if (ggval(subres(gmul((GEN)nf[7],p1),pol),(GEN)x[1]) > itos((GEN)x[4]))
	  p1[1] =  (signe(p1[1]) > 0)? lsub((GEN)p1[1],(GEN)x[1])
	                             : ladd((GEN)p1[1],(GEN)x[1]);
      y[2]=(long)p1;
      p1=centerlift(gmul(unmod,algtobasis(nf,galoisapply(nf,aut,(GEN)x[5]))));
      y[5]=(long)p1;
      tetpil=avma; return gerepile(av,tetpil,gcopy(y));

    case t_COL:
      N=lgef(pol)-3;
      if (lg(x)!=N+1) err(typeer,"galoisapply");
      p1=galoisapply(nf,aut,gmul((GEN)nf[7],x)); tetpil=avma;
      return gerepile(av,tetpil,algtobasis(nf,p1));

    case t_MAT:
      lx=lg(x); if (lx==1) return cgetg(1,t_MAT);
      N=lgef(pol)-3;
      if (lg(x[1])!=N+1) err(typeer,"galoisapply");
      tetpil=avma; p1=cgetg(lx,t_MAT);
      for (j=1; j<lx; j++) p1[j]=(long)galoisapply(nf,aut,(GEN)x[j]);
      if (lg(x)!=N+1) return gerepile(av,tetpil,p1);
      tetpil=avma; return gerepile(av,tetpil,idealhermite(nf,p1));
  }
  err(typeer,"galoisapply");
  return NULL; /* not reached */
}

/*************************************************************************/
/**									**/
/**			       INITALG					**/
/**									**/
/*************************************************************************/

/* a usage interne. Pas de verifs.
Calcule trace(gmodulcp(x,pol)), ou sym=polsym(pol,lgef(pol)-4) */
static GEN
trace9(GEN x, GEN sym)
{
  GEN p1 = gzero;
  long i;

  if (signe(x))
    for (i=2; i<lgef(x); i++)
      p1 = gadd(p1, gmul((GEN)x[i],(GEN)sym[i-1]));
  return p1;
}

GEN
make_base(long n, GEN base)
{
  GEN p1,p2, res = cgetg(n+1,t_MAT);
  long i,j,l;

  for (j=1; j<=n; j++)
  {
    p1=cgetg(n+1,t_COL); res[j]=(long)p1;
    p2=(GEN)base[j]; 
    if (typ(p2)==t_INT) { p1[1]=(long)p2; i=2; }
    else
    { 
      l=lgef(p2)-1; p2++;
      for (i=1; i<l ; i++) p1[i]=p2[i];
    }
    for (; i<=n; i++) p1[i]=zero;
  }
  return res;
}

/* Seek a new, simpler, polynomial pol defining the same number field as
 * *ptx (assumed to be monic at this point).
 * Return the integer basis expressed on the roots of the new pol.
 * *ptx   receives pol
 * *ptdx  receives disc(pol)
 * *ptp20 expresses the new root in terms of the old one.
 */
static GEN
nfinit_reduce(long flag, GEN *ptx, GEN *ptp20, GEN *ptdx,
              long n, long r1, long PRECREG, GEN base)
{
  GEN a,phimax,dxn,adx,adxn,s,sn,p1,p2,p3,p5,p6,p7,polr,ptrace;
  GEN x = *ptx, polmax, p20, dx;
  long i,j,k,imax,nmax,numb,flc,v=varn(x);

  if (r1<n)
  {
    for (k=1; ; k++)
    {
      polr=roots(x,PRECREG); p3=cgetg(n+1,t_MAT);
      for (i=1; i<=n; i++)
      {
	p1=cgetg(n+1,t_COL); p3[i]=(long)p1;
	for (j=1; j<=n; j++)
	  p1[j] = (long)poleval((GEN)base[i],(GEN)polr[j]);
      }
      p2=greal(gmul(gconj(gtrans(p3)),p3));
      p1=lllgramintern(p2,1,PRECREG);
      if (p1) break;
      if (k == MAXITERPOL) err(accurer,"nfinit_reduce");
      PRECREG = (PRECREG<<1)-2;
      if (DEBUGLEVEL) err(warnprec,"nfinit_reduce",PRECREG);
    }
    for (s=gzero,i=1; i<=n; i++) s=gadd(s,gnorm((GEN)polr[i]));
  }
  else
  {
    ptrace=cgetg(n+1,t_VEC); ptrace[1]=lstoi(n);
    for (k=1; k<n; k++)
    {
      p3=gmulsg(k,(GEN)x[n-k+2]);
      for (i=1; i<k; i++) p3=gadd(p3,gmul((GEN)x[n-i+2],(GEN)ptrace[k-i+1]));
      ptrace[k+1]=lneg(p3);
    }
    p2=cgetg(n+1,t_MAT);
    for (i=1; i<=n; i++)
    {
      p1=cgetg(n+1,t_COL); p2[i]=(long)p1;
      for (j=1; j<i ; j++) p1[j]=lcopy(gcoeff(p2,i,j));
      for (   ; j<=n; j++)
      {
	p5=gres(gmul((GEN)base[i],(GEN)base[j]),x); p6=gzero;
	for (k=0; k<=lgef(p5)-3; k++)
	  p6=gadd(p6,gmul((GEN)p5[k+2],(GEN)ptrace[k+1]));
	p1[j]=(long)p6;
      }
    }
    p1=lllgramint(p2);
    s=(n>1)?gsub(gsqr((GEN)x[n+1]),gmul2n((GEN)x[n],1)):gsqr((GEN)x[2]);
  }
  if (DEBUGLEVEL) msgtimer("matrix T2");

  dx=discsr(x); adx=absi(dx); imax=0; polmax=x;
  nmax=(flag & nf_PARTIAL)?min(n,3):n;
  a=cgetg(n+1,t_COL); for (i=1; i<=n; i++) a[i]=lmul(base,(GEN)p1[i]);
  for (numb=0,i=1; i<=nmax || !numb; i++)
  {
    if (DEBUGLEVEL>=3) { fprintferr("i = %ld\n",i); flusherr(); }
    p3=gmodulcp((GEN)a[i],x); p7=content((GEN)p3[2]);
    if (gcmp1(p7)) p3=caract(p3,v);
    else
    {
      p3=caract(gdiv(p3,p7),v);
      p3=gmul(gpuigs(p7,lgef(p3)-3),gsubst(p3,v,gdiv(polx[v],p7)));
    }
    if (DEBUGLEVEL>=4) { outerr(p3); flusherr(); }

    p5=ggcd(deriv(p3,v),p3);
    if (lgef(p5)==3)
    {
      dxn=discsr(p3); adxn=absi(dxn); flc=gcmp(adxn,adx); numb++;
      if (flc<=0)
      {
	if (r1<n)
	  for (sn=gzero,j=1; j<=n; j++)
	    sn=gadd(sn,gnorm(poleval((GEN)a[i],(GEN)polr[j])));
	else
	  sn=(n>1)? gsub(gsqr((GEN)p3[n+1]),gmul2n((GEN)p3[n],1))
	          : gsqr((GEN)p3[2]);
	if (flc<0) { dx=dxn; adx=adxn; s=sn; polmax=p3; imax=i; }
	else
	{
	  flc=gcmp(sn,s);
	  if (flc<0 || (!flc && gpolcomp(p3,polmax) < 0))
	  { 
	    dx=dxn; adx=adxn; s=sn;
	    polmax=p3; imax=i;
	  }
	}
      }
    }
  }
  if (!numb) err(talker,"you have found a counter-example to a conjecture, "
                        "please send us\nthe polynomial as soon as possible");
  phimax=imax? (GEN)a[imax]: polx[v];
  j=n+1; while (j>=2 && !signe(polmax[j])) j-=2;
  if (j>=2 && signe(polmax[j]) > 0)
  {
    if (polmax==x) polmax=gcopy(x);
    for (; j>=2; j-=2) setsigne(polmax[j],-signe(polmax[j]));
    phimax=gneg(phimax);
  }
  if (DEBUGLEVEL)
  {
    msgtimer("polmax");
    if (DEBUGLEVEL>1) { fprintferr("polmax = "); outerr(polmax); }
  }
  p2 = gmodulcp(phimax,x); p20=polymodrecip(p2);
  p2 = gcmp0(p2)? base: lift(gsubst(base,v,p20));
  p3 = make_base(n,p2);
  base=denom(p3); p1=gmul(base,p3);
  p2=gdiv(hnfmod(p1,detint(p1)),base);
  
  p3=cgetg(n+1,t_VEC);
  for (j=1; j<=n; j++)
  {
    p1=gzero;
    for (i=n; i; i--)
      p1=gadd(gcoeff(p2,i,j),gmul(p1,polx[v]));
    p3[j]=(long)p1;
  }
  *ptx=polmax; *ptp20=p20; *ptdx=dx;
  return p3;
}

/* pol belonging to Z[x], return a monic polynomial generating the same field
 * as pol (x-> ax+b)) set lead = NULL if pol was monic (after dividing
 * by the content), and to to leading coeff otherwise.
 * No garbage collecting done.
 */
GEN
pol_to_monic(GEN pol, GEN *lead)
{
  long n = lgef(pol)-1;
  GEN p1;

  if (n==1 || gcmp1((GEN)pol[n])) { *lead = NULL; return pol; }

  p1=content(pol); if (!gcmp1(p1)) pol = gdiv(pol,p1);
  return primitive_pol_to_monic(pol,lead);
}

/* basis = integer basis. roo = real part of the roots */
GEN
make_M(long n,long ru,long v,GEN basis,GEN roo)
{
  GEN p1,res = cgetg(n+1,t_MAT);
  long i,j;

  for (j=1; j<=n; j++)
  {
    p1=cgetg(ru+1,t_COL); res[j]=(long)p1;
    for (i=1; i<=ru; i++)
      p1[i]=lsubst((GEN)basis[j],v,(GEN)roo[i]);
  }
  if (DEBUGLEVEL>4) msgtimer("matrix M");
  return res;
}

GEN
make_MC(long n,long r1,long ru,GEN M)
{
  GEN p1,p2,res=cgetg(ru+1,t_MAT);
  long i,j,av,tetpil;

  for (j=1; j<=ru; j++)
  {
    p1=cgetg(n+1,t_COL); res[j]=(long)p1;
    for (i=1; i<=n; i++)
    {
      av=avma; p2=gconj(gcoeff(M,j,i)); tetpil=avma;
      p1[i] = (j<=r1)? (long)p2: lpile(av,tetpil,gmul2n(p2,1));
    }
  }
  if (DEBUGLEVEL>4) msgtimer("matrix MC");
  return res;
}

GEN
get_roots(GEN x,long r1,long ru,long prec)
{
  GEN roo = roots(x,prec);
  long i;

  for (i=1; i<=r1; i++) roo[i]=lreal((GEN)roo[i]);
  for (   ; i<=ru; i++) roo[i]=roo[(i<<1)-r1];
  settyp(roo,t_VEC); setlg(roo,ru+1); return roo;
}

/* Initialize the number field defined by the polynomial x (in variable v)
 * flag & nf_REGULAR
 *    regular behaviour (no different).
 * flag & nf_DIFFERENT
 *    compute the different.
 * flag & nf_SMALL
 *    compute only nf[1] (pol), nf[2] (signature), nf[5][3] (T2) and 
 *    nf[7] (integer basis), the other components are filled with gzero.
 * flag & nf_REDUCE
 *    try a polred first.
 * flag & nf_PARTIAL
 *    do a partial polred, not a polredabs
 * flag & nf_ORIG
 *    do a polred and return [nfinit(x),Mod(a,red)], where
 *    Mod(a,red)=Mod(v,x) (i.e return the base change).
 */

/* here x can be a polynomial, an nf or a bnf */
GEN
initalgall0(GEN x, long flag, long prec)
{
  GEN lead = NULL,y,p1,p2,p3,p4,p5,p6,p7,p10,p11,p20,fieldd,dx,index,fa,res;
  long n,i,j,av=avma,av2,av3,tetpil,k,lgp,r1,r2,ru,PRECREG;

  if (typ(x)==t_POL)
  {
    n=lgef(x)-3; if (n<=0) err(constpoler,"initalgall0");
    for (k=2; k<=n+2; k++)
      if (typ(x[k])!=t_INT) err(talker,"polynomial not in Z[X] in nfinit");

    if (!gcmp1((GEN)x[n+2]) && !(flag & nf_REDUCE))
    {
      err(warner,"non-monic polynomial. I shall transform it");
      flag = flag | nf_REDUCE | nf_ORIG;
    }

    if (DEBUGLEVEL) timer2();
    if (flag & nf_REDUCE) x = pol_to_monic(x,&lead);

    p1=factor(x);
    if (DEBUGLEVEL) msgtimer("factpol");

    if (lgef(gcoeff(p1,1,1)) != n+3) err(redpoler,"nfinit");
    p4=allbase4(x,0,&fieldd,&fa);
    if (DEBUGLEVEL) msgtimer("round4");
    if (!(flag & nf_REDUCE)) dx=discsr(x);
    r1 = sturm(x); 
  }
  else
  {
    GEN nf=checknf(x);
    p4=(GEN)nf[7]; x=(GEN)nf[1]; n=lgef(x)-3;
    p4[1]=lpolun[varn(x)]; /* it may be gun => SEGV later */
    dx=fieldd=discsr(x);
    for (j=2; j<=n; j++)
      fieldd = gmul(fieldd, gsqr(content((GEN)p4[j])));
    r1 = itos(gmael(nf,2,1));
    if (flag & nf_DIFFERENT) fa = factor(fieldd);
  }
  r2=(n-r1)>>1; ru=r1+r2;

  PRECREG = (gexpo(fieldd)>>(TWOPOTBITS_IN_LONG+1))+(long)sqrt((double)n)+3;
  PRECREG +=prec;

  if (flag & nf_REDUCE)
    p4=nfinit_reduce(flag, &x, &p20, &dx, n, r1, PRECREG, p4);
  else
    dx=discsr(x);

  if (!carrecomplet(divii(dx,fieldd),&index))
    err(talker,"nfinit (incorrect discriminant)");

  if (!(flag & nf_SMALL))
  {
    p1=make_base(n,p4);
    p5=cgetg(n*n+1,t_MAT); for (j=1; j<=n*n; j++) p5[j]=lgetg(n+1,t_COL);
    p11=cgetg(n+1,t_MAT); for (j=1; j<=n; j++) p11[j]=lgetg(n+1,t_COL);
    p3=polsym(x,lgef(x)-4);
    for (i=1; i<=n; i++)
      for (j=i; j<=n; j++)
      {
	p10=gmod(gmul((GEN)p4[j],(GEN)p4[i]),x);
        p6 = (GEN)p5[j+(i-1)*n];
        p7 = (GEN)p5[i+(j-1)*n];
	lgp=lgef(p10)-1;
	for (k=1; k<lgp; k++) p6[k] = p7[k] = p10[k+1];
	for (   ; k<=n ; k++) p6[k] = p7[k] = zero;
	coeff(p11,i,j) = coeff(p11,j,i) = (long)trace9(p10,p3);
      }
    if (DEBUGLEVEL) msgtimer("mult. table");
  }

  p2=get_roots(x,r1,ru,PRECREG);
  if (DEBUGLEVEL) msgtimer("roots");

  tetpil = avma;
  if (flag & nf_ORIG)
  { 
    if (!(flag & nf_REDUCE)) err(talker,"bad flag in initalgall0");
    res = cgetg(3,t_VEC);
  }
  y=cgetg(10,t_VEC); 
  y[1]=lcopy(x);
  p6=cgetg(3,t_VEC); p6[1]=lstoi(r1); p6[2]=lstoi(r2);
  y[2]=(long)p6;
  if (flag & nf_SMALL) y[3]=y[4]=y[6]=y[8]=y[9]=zero;
  else
  {
    y[3]=lcopy(fieldd);
    y[4]=lcopy(index);
    y[8]=linv(p1);
    y[9]=lmul((GEN)y[8],p5);
  }

  p7 = cgetg(8,t_VEC); y[5] = (long) p7;
  p10 = make_M(n,ru,varn(x),p4,p2);
  p5 = make_MC(n,r1,ru,p10);
  p7[5]=zero; /* dummy for the different */
  if (flag & nf_SMALL)
    p7[1]=p7[2]=p7[4]=p7[6]=p7[7]=zero;
  else
  {
    GEN a2,a3;
    
    p7[1]=(long)p10;
    p7[2]=(long)p5;
    p7[4]=lcopy(p11);

    av2=avma;  p1=ginv(p11); av3=avma;
    p7[6] = lpile(av2,av3,gmul(p1, fieldd));

    av2=avma; p1=content((GEN)p7[6]); a2=gdiv((GEN)p7[6],p1);
    a3=hnfmod(a2,detint(a2)); av3=avma;
    /* Ideal basis for discriminant * (inverse of different) */
    p7[7] = lpile(av2,av3,gmul(a3,p1));
  }
  if (DEBUGLEVEL>=2) msgtimer("matrices MD and D");

  av2=avma; p10=gmul(p5,p10); av3=avma;
  p7[3]=lpile(av2,av3,greal(p10));
  if (DEBUGLEVEL) msgtimer((DEBUGLEVEL>=2)? "matrix T2": "matrices");

  if (! (flag & nf_SMALL)) y[6] = lcopy(p2);
  y[7]=lcopy(p4);

  if (flag & nf_DIFFERENT)
  {
    i = (flag & nf_REDUCE)? pari_randseed: 0;
    mael(y,5,5)=(long)differente(y,fa);
    if (i) pari_randseed = i;
    if (DEBUGLEVEL) msgtimer("different");
  }
  if (! (flag & nf_ORIG)) res = y;
  else
  { 
    res[1]=(long)y;
    res[2]=lead? ldiv(p20,lead): lcopy(p20);
  }
  return gerepile(av,tetpil,res);
}

GEN
initalgred(GEN x, long prec)
{
  return initalgall0(x,nf_REDUCE|nf_DIFFERENT,prec);
}

GEN
initalgred2(GEN x, long prec)
{
  return initalgall0(x,nf_REDUCE|nf_DIFFERENT|nf_ORIG,prec);
}

GEN
nfinit0(GEN x, long flag,long prec)
{
  switch(flag)
  {
    case 0: return initalgall0(x,nf_DIFFERENT,prec);
    case 1: return initalgall0(x,nf_REGULAR,prec);
    case 2: return initalgall0(x,nf_REDUCE|nf_DIFFERENT,prec);
    case 3: return initalgall0(x,nf_REDUCE|nf_ORIG|nf_DIFFERENT,prec);
    case 4: return initalgall0(x,nf_REDUCE|nf_PARTIAL|nf_DIFFERENT,prec);
    case 5: return initalgall0(x,nf_REDUCE|nf_ORIG|nf_PARTIAL|nf_DIFFERENT,prec);
    default: err(flagerr);
  }
  return NULL; /* not reached */
}

GEN
initalg(GEN x, long prec)
{
  return initalgall0(x,nf_DIFFERENT,prec);
}

GEN
nfnewprec(GEN nf, long prec)
{
  long av=avma,i,r1,r2,ru,n,nf_small,tetpil;
  GEN y,pol,p2,p4,p5,p7,p10;

  y=cgetg(10,t_VEC);
  for (i=1; i<=4; i++) y[i]=nf[i];
  for (i=6; i<=9; i++) y[i]=nf[i];
  nf_small = gcmp0((GEN)nf[6]);
  pol=(GEN)nf[1]; n=degree(pol);
  r1=itos(gmael(nf,2,1)); r2=itos(gmael(nf,2,2)); ru=r1+r2;
  p7=cgetg(8,t_VEC); y[5]=(long)p7;
  p4=(GEN)nf[7]; p2=get_roots(pol,r1,ru,prec);
  p10 = make_M(n,ru,varn(pol),p4,p2);
  p5 = make_MC(n,r1,ru,p10);
  if (nf_small) p7[1]=p7[2]=p7[4]=p7[5]=p7[6]=p7[7]=zero;
  else
  {
    GEN matrices=(GEN)nf[5];
    y[6]=(long)p2;
    p7[1]=(long)p10;
    p7[2]=(long)p5;
    for (i=4; i<=7; i++) p7[i]=matrices[i];
  }
  p7[3]=lreal(gmul(p5,p10));
  tetpil=avma; return gerepile(av,tetpil,gcopy(y));
}

static long
nf_pm1(GEN y)
{
  long i,l;

  if (!is_pm1(y[1])) return 0;
  l = lg(y);
  for (i=2; i<l; i++)
    if (signe(y[i])) return 0;
  return signe(y[1]);

}

static GEN
is_primitive_root(GEN nf, GEN fa, GEN x, long w)
{
  GEN y, exp = stoi(2), pp = (GEN)fa[1];
  long i,p, l = lg(pp);

  for (i=1; i<l; i++)
  {
    p = itos((GEN)pp[i]);
    exp[2] = w / p; y = element_pow(nf,x,exp);
    if (nf_pm1(y) > 0) /* y = 1 */
    {
      if (p!=2 || !gcmp1(gcoeff(fa,i,2))) return NULL;
      x = gneg(x);
    }
  }
  return x;
}

GEN
rootsof1(GEN nf)
{
  long av,tetpil,N,k,i,ws,prec;
  GEN algun,p1,y,R1,d,list,w;

  y=cgetg(3,t_VEC); av=avma; nf=checknf(nf);
  R1=gmael(nf,2,1); algun=gmael(nf,8,1);
  if (signe(R1))
  {
    y[1]=deux;
    y[2]=lneg(algun); return y;
  }
  N=lgef(nf[1])-3; prec=gprecision((GEN)nf[6]);
#ifdef LONG_IS_32BIT
  if (prec < 10) prec = 10;
#else
  if (prec < 6) prec = 6;
#endif
  for (i=1; ; i++)
  {
    p1 = fincke_pohst(gmael(nf,5,3),stoi(N),stoi(1000),1,prec);
    if (p1) break;
    if (i == MAXITERPOL) err(accurer,"rootsof1");
    prec=(prec<<1)-2;
    if (DEBUGLEVEL) err(warnprec,"rootsof1",prec);
    nf=nfnewprec(nf,prec);
  }
  if (itos(ground((GEN)p1[2])) != N) err(bugparier,"rootsof1 (bug1)");
  w=(GEN)p1[1]; ws = itos(w);
  if (ws == 2)
  {
    y[1]=deux; avma=av;
    y[2]=lneg(algun); return y;
  }

  d = decomp(w); list = (GEN)p1[3]; k = lg(list);
  for (i=1; i<k; i++)
  {
    p1 = (GEN)list[i];
    p1 = is_primitive_root(nf,d,p1,ws);
    if (p1)
    {
      tetpil=avma;
      y[2]=lpile(av,tetpil,gcopy(p1));
      y[1]=lstoi(ws); return y;
    }
  }
  err(bugparier,"rootsof1");
  return NULL; /* not reached */
}

/*******************************************************************/
/*                                                                 */
/*                     DEDEKIND ZETA FUNCTION                      */
/*                                                                 */
/*******************************************************************/

ulong smulss(ulong x, ulong y, ulong *rem);

static GEN
dirzetak0(GEN nf, long N0)
{
  GEN vect,p1,pol,disc,c,c2;
  long av=avma,i,j,k,lx;
  ulong limk,q,p,rem;
  byteptr d=diffptr;
  long court[] = {evaltyp(t_INT)|evallg(3), evalsigne(1)|evallgefint(3),0};

  pol=(GEN)nf[1]; disc=(GEN)nf[4];
  c  = (GEN) gpmalloc((N0+1)*sizeof(long));
  c2 = (GEN) gpmalloc((N0+1)*sizeof(long));
  c2[0]=c[0]=evaltyp(t_VEC) | evallg(N0+1);
  c2[1]=c[1]=1; for (i=2; i<=N0; i++) c[i]=0;
  court[2] = 0;

  while (court[2]<=N0)
  {
    court[2] += *d++; if (! *d) err(primer1);
    if (smodis(disc,court[2])) /* court does not divide index */
      { vect = (GEN) simplefactmod(pol,court)[1]; lx=lg(vect); }
    else
    {
      p1=primedec(nf,court); lx=lg(p1); vect=cgetg(lx,t_COL);
      for (i=1; i<lx; i++) vect[i]=mael(p1,i,4);
    }
    for (j=1; j<lx; j++)
    {
      p1=gpuigs(court,itos((GEN)vect[j])); /* p1 = court^f */
      if (cmpis(p1,N0) <= 0)
      {
        q=p=p1[2]; limk=N0/q;
        for (k=2; k<=N0; k++) c2[k]=c[k];
        while (q<=N0)
        {
          for (k=1; k<=limk; k++) c2[k*q] += c[k];
          q = smulss(q,p,&rem); 
          if (rem) break;
          limk /= p;
        }
        p1=c; c=c2; c2=p1;
      }
    }
    avma=av;
    if (DEBUGLEVEL>6) fprintferr(" %ld",court[2]);
  }
  if (DEBUGLEVEL>6)
    { fprintferr("\n"); flusherr(); }
  free(c2); return c;
}

GEN
dirzetak(GEN nf, GEN b)
{
  GEN z,c;
  long i;

  if (typ(b)!=t_INT) err(talker,"not an integer type in dirzetak");
  if (signe(b)<=0) return cgetg(1,t_VEC);
  nf = checknf(nf);
  if (cmpsi(VERYBIGINT,b) < 0) err(talker,"too many terms in dirzetak");
  c = dirzetak0(nf,itos(b));
  i = lg(c); z=cgetg(i,t_VEC);
  for (i-- ; i; i--) z[i]=lstoi(c[i]);
  free(c); return z;
}

GEN
initzeta(GEN pol, long prec)
{
  GEN nfz,nf,alpha,beta,mu,gr1,gr2,gru,p1,p2,p3,cst,A0,c0,c1,c2,eps,coef;
  GEN limx,bnf,resi,zet,cik,coeflog,racpi,aij,tabj,colzero, *tabcstn, *tabcstni;
  GEN c_even,ck_even,c_odd,ck_odd,serie_even,serie_odd,serie_exp;
  long N0,imin,imax,r1,r2,ru,R,N,i,j,k,n, av,av2,tetpil;
  long court[] = {evaltyp(t_INT)|evallg(3), evalsigne(1)|evallgefint(3),0};
  stackzone *zone, *zone0, *zone1;

  /*************** Calcul du residu et des constantes ***************/
  eps=gmul2n(gun,-bit_accuracy(prec)-6); p1=dbltor(0.5);
  nfz=cgetg(10,t_VEC);
  bnf=buchinit(pol,p1,p1,prec+1); prec=(prec<<1)-1;
  constpi(prec); consteuler(prec); racpi=gsqrt(gpi,prec);

  /* Nb de classes et regulateur */
  nf=(GEN)bnf[7]; N=lgef(nf[1])-3;
  gr1=gmael(nf,2,1); gr2=gmael(nf,2,2);
  r1=itos(gr1); r2=itos(gr2); ru=r1+r2; R=ru+2;
  av=avma; p1=(GEN)bnf[8]; p2 = gmul(gmul2n(gmael(p1,1,1),r1), (GEN)p1[2]);
  tetpil = avma; resi=gerepile(av,tetpil,gdiv(p2, gmael(p1,4,1)));

  /* Calcul de N0 */
  cst = cgetr(prec); av = avma;
  mu = gadd(gmul2n(gr1,-1),gr2);
  alpha = gmul2n(stoi(ru+1),-1);
  beta = gpui(gdeux,gmul2n(gr1,-1),DEFAULTPREC);
  A0 = gmul2n(gpuigs(mu,R),r1);
  A0 = gmul(A0,gpuigs(gmul2n(gpi,1),1-ru));
  A0 = gsqrt(A0,DEFAULTPREC);

  c1 = gmul(mu,gpui(beta,ginv(mu),DEFAULTPREC));
  c0 = gdiv(gmul(A0,gpuigs(gmul2n(gpi,1),ru-1)),mu);
  c0 = gmul(c0,gpui(c1,gneg(alpha),DEFAULTPREC));
  c2 = gdiv(alpha,mu);

  p1 = glog(gdiv(c0,eps),DEFAULTPREC);
  limx = gdiv(gsub(glog(p1,DEFAULTPREC),glog(c1,DEFAULTPREC)),
              gadd(c2,gdiv(p1,mu)));
  limx = gmul(gpui(gdiv(c1,p1),mu,DEFAULTPREC),
              gadd(gun,gmul(alpha,limx)));
  p1 = gsqrt(absi((GEN)nf[3]),prec);
  p2 = gmul2n(gpuigs(racpi,N),r2);
  gaffect(gdiv(p1,p2), cst);

  av = avma; p1 = gfloor(gdiv(cst,limx)); N0 = p1[2];
  if (cmpsi(VERYBIGINT,p1) < 0 || N0 > 10000000)
    err(talker,"discriminant too large for initzeta, sorry");
  if (DEBUGLEVEL>=2)
    { fprintferr("\ninitzeta:\nN0 = %ld\n",N0); flusherr(); timer2(); }

  /* Calcul de imax */

  imin=1; imax=1400;
  p1 = gmul(gpuigs(gmul2n(racpi,1),r2),gpuigs(stoi(5),r1));
  p1 = gdiv(p1,gmul(gmul(gsqrt(limx,DEFAULTPREC),gmul2n(eps,4)),
                         gpuigs(racpi,3)));
  while (imax-imin >= 4)
  {
    long itest = (imax+imin)>>1;
    p2 = gmul(gpuigs(mpfactr(itest,DEFAULTPREC),r2),gpuigs(limx,itest));
    p2 = gmul(p2,gpuigs(mpfactr(itest/2,DEFAULTPREC),r1));
    if (gcmp(p2,p1) >= 0) imax=itest; else imin=itest;
  }
  imax -= (imax & 1); avma = av;
  if (DEBUGLEVEL>=2) { fprintferr("imax = %ld\n",imax); flusherr(); }

  /* Tableau des i/cst (i=1 a N0) */

  i = prec*N0;
  zone  = switch_stack(NULL,i + 2*(N0+1) + 5*prec);
  zone1 = switch_stack(NULL,i);
  zone0 = switch_stack(NULL,i);
  switch_stack(zone,1);
  tabcstn  = (GEN*) cgetg(N0+1,t_VEC);
  tabcstni = (GEN*) cgetg(N0+1,t_VEC);
  for (i=1; i<=N0; i++)
  {
    tabcstn[i]=gdivsg(i,cst); tabcstni[i]=gun;
  }
  switch_stack(zone,0);

  /********** Calcul des coefficients a(i,j) independants de s **********/

  zet=cgetg(R,t_VEC); zet[1]=(long)geuler;
  for (i=2; i<R; i++)
    zet[i]=(long)gzeta(stoi(i),prec);

  aij=cgetg(imax+1,t_VEC);
  for (i=1; i<=imax; i++)
    aij[i]=lgetg(R,t_VEC);

  affsr(1,c_even=cgetr(prec)); c_even=gmul2n(c_even,r1);
  c_odd=gmul(c_even,gpuigs(racpi,r1));
  if (ru&1) c_odd=gneg(c_odd);
  ck_even=cgetg(R,t_VEC); ck_odd=cgetg(r2+2,t_VEC);
  for (k=1; k<R; k++)
  {
    ck_even[k]=lmul((GEN)zet[k],gadd(gr2,gmul2n(gr1,-k)));
    if (k&1) ck_even[k]=lneg((GEN)ck_even[k]);
  }
  gru=stoi(ru);
  for (k=1; k<=r2+1; k++)
  {
    ck_odd[k]=lmul((GEN)zet[k],gadd(gru,gmul2n(gr1,-k)));
    if (k&1) ck_odd[k]=lneg((GEN)ck_odd[k]);
    ck_odd[k]=ladd(gru,(GEN)ck_odd[k]);
  }
  ck_odd[1]=lsub((GEN)ck_odd[1],gmul(gr1,glog(gdeux,prec)));
  serie_even =cgetg(ru+3,t_SER); serie_odd=cgetg(r2+3,t_SER);
  serie_even[1] = serie_odd[1] = evalsigne(1)+evalvalp(1);
  i=0;

  while (i<imax/2)
  {
    for (k=1; k<R; k++)
      serie_even[k+1]=ldivgs((GEN)ck_even[k],k);
    serie_exp=gmul(c_even,gexp(serie_even,0));
    p1=(GEN)aij[2*i+1];
    for (j=1; j<R; j++) p1[j]=serie_exp[ru+3-j];

    for (k=1; k<=r2+1; k++)
      serie_odd[k+1]=ldivgs((GEN)ck_odd[k],k);
    serie_exp=gmul(c_odd,gexp(serie_odd,0));
    p1=(GEN)aij[2*i+2];
    for (j=1; j<=r2+1; j++) p1[j]=serie_exp[r2+3-j];
    for (   ; j<R; j++) p1[j]=zero;
    i++;

    c_even = gdiv(c_even,gmul(gpuigs(stoi(i),ru),gpuigs(stoi(2*i-1),r2)));
    c_odd  = gdiv(c_odd, gmul(gpuigs(stoi(i),r2),gpuigs(stoi(2*i+1),ru)));
    c_even = gmul2n(c_even,-r2);
    c_odd  = gmul2n(c_odd,r1-r2);
    if (r1&1) { c_even=gneg(c_even); c_odd=gneg(c_odd); }
    p1 = gr2; p2 = gru;
    for (k=1; k<R; k++)
    {
      p1=gdivgs(p1,2*i-1); p2=gdivgs(p2,2*i);
      ck_even[k] = ladd((GEN)ck_even[k], gadd(p1,p2));
    }
    p1 = p2 = gru; p3 = gr1;
    for (k=1; k<=r2+1; k++)
    {
      p1=gdivgs(p1,2*i+1); p2=gdivgs(p2,2*i); p3=gdivgs(p3,2*i);
      ck_odd[k] = ladd((GEN)ck_odd[k], gsub(gadd(p1,p2),p3));
    }
  }
  tetpil=avma; aij=gerepile(av,tetpil,gcopy(aij));
  if (DEBUGLEVEL>=2) msgtimer("a(i,j)");
  p1=cgetg(5,t_VEC);
  p1[1]=lstoi(r1); p1[2]=lstoi(r2); p1[3]=lstoi(imax); p1[4]=(long)bnf;
  nfz[1]=(long)p1; 
  nfz[2]=(long)resi;
  nfz[5]=(long)cst;
  nfz[6]=llog(cst,prec);
  nfz[7]=(long)aij;

  /************* Calcul du nombre d'ideaux de norme donnee *************/

  coef = dirzetak0(nf,N0); tabj = cgetg(N0+1,t_MAT);
  if (DEBUGLEVEL>=2) msgtimer("coef");
  colzero=cgetg(ru+2,t_COL); for (j=1; j<=ru+1; j++) colzero[j]=zero;
  for (i=1; i<=N0; i++)
    if (coef[i])
    {
      tabj[i]=lgetg(ru+2,t_COL); /* tabj[n,j]=coef(n)*ln(c/n)^(j-1)/(j-1)! */
      av=avma; p1=negr(glog((GEN)tabcstn[i],prec));
      coeff(tabj,1,i)=un; coeff(tabj,2,i)=(long)p1;
      for (j=2; j<=ru; j++)
	coeff(tabj,j+1,i)=ldivrs(gmul(gcoeff(tabj,j,i),p1),j);
      tetpil=avma; tabj[i]=lpile(av,tetpil,gmulgs((GEN)tabj[i],coef[i]));
    }
    else tabj[i]=(long)colzero;
  if (DEBUGLEVEL>=2) msgtimer("a(n)");

  coeflog=cgetg(N0+1,t_VEC); coeflog[1]=zero;
  for (i=2; i<=N0; i++)
    if (coef[i])
    {
      court[2]=i; p1=glog(court,prec);
      setsigne(p1,-1); coeflog[i]=(long)p1;
    }
    else coeflog[i] = zero;
  if (DEBUGLEVEL>=2) msgtimer("log(n)");

  nfz[3]=(long)tabj;
  p1=cgetg(N0+1,t_VEC); 
  for (i=1; i<=N0; i++) p1[i]=lstoi(coef[i]);
  nfz[8]=(long)p1;
  nfz[9]=(long)coeflog;

  /******************** Calcul des coefficients Cik ********************/

  cik=cgetg(ru+1,t_MAT);
  for (k=1; k<=ru; k++) cik[k]=lgetg(imax+1,t_COL);
  av2 = avma;
  for (i=1; i<=imax; i++)
  {
    stackzone *z;
    for (k=1; k<=ru; k++)
    {
      p1 = NULL;
      for (n=N0; n; n--)
        if (coef[n])
          for (j=1; j<=ru-k+1; j++)
          {
            p2 = gmul(tabcstni[n], 
                      gmul(gmael(aij,i,j+k), gcoeff(tabj,j,n)));
            p1 = p1? gadd(p1,p2): p2;
          }
      coeff(cik,i,k) = p1? (long)gerepileupto(av2,p1): zero;
      av2 = avma;
    }
    /* use a parallel stack */
    z = i&1? zone1: zone0;
    switch_stack(z, 1);
    for (n=1; n<=N0; n++)
      if (coef[n]) tabcstni[n] = mpmul(tabcstni[n],tabcstn[n]);
    /* come back */
    switch_stack(z, 0);
  }
  nfz[4] = (long) cik;
  if (DEBUGLEVEL>=2) msgtimer("Cik");
  free((void*)zone); free((void*)zone1); free((void*)zone0);
  free((void*)coef); return nfz;
}

GEN
gzetakall(GEN nfz, GEN s, long flag, long prec2)
{
  GEN resi,cik,cst,cstlog,coeflog,cs,gcoef;
  GEN lambd,gammas,gammaunmoins,gammas2,gammaunmoins2,var1,var2;
  GEN p1,unmoins,gexpro,gar,val,valm,valk,valkm,val2,valm2,valk2,valkm2;
  long ts = typ(s), r1,r2,ru,imax,i,j,k,N0,sl,prec,bigprec, av = avma;

  if (typ(nfz)!=t_VEC || lg(nfz)!=10)
    err(talker,"not a zeta number field in zetakall");
  if (! is_intreal_t(ts) && ts != t_COMPLEX && ! is_frac_t(ts))
    err(typeer,"gzetakall");
  resi=(GEN)nfz[2]; cik=(GEN)nfz[4]; cst=(GEN)nfz[5];
  cstlog=(GEN)nfz[6]; gcoef=(GEN)nfz[8]; coeflog=(GEN)nfz[9];
  r1  =itos(gmael(nfz,1,1));
  r2  =itos(gmael(nfz,1,2));
  imax=itos(gmael(nfz,1,3));
  N0=lg(gcoef)-1; ru=r1+r2;
  /* from initzeta. Certainly excessive, at least if LONG_IS_64BIT */
  bigprec = min(precision(cst), (prec2<<1) - 1);
  prec = prec2+1;

  if (ts==t_REAL && !signe(gfrac(s)))
    { s=mptrunc(s); avma=av; ts = t_INT; }
  if (ts==t_INT)
  {
    sl=itos(s);
    if (sl==1) err(talker,"s = 1 is a pole (gzetakall)");
    if (sl==0)
    { 
      if (flag) err(talker,"s = 0 is a pole (gzetakall)");
      if (ru == 1)
      {
        if (r1) return gneg(ghalf);
        return gneg(resi);
      }
      return gzero;
    }
    if (sl<0 && (r2 || !odd(sl)))
    {
      if (!flag) return gzero;
      s = subsi(1,s); sl = 1-sl;
    }
    unmoins=subsi(1,s);
    lambd = gdiv(resi, mulis(s,sl-1));
    gammas2=ggamma(gmul2n(s,-1),prec);
    gar=gpuigs(gammas2,r1);
    cs=gexp(gmul(cstlog,s),prec); 	
    val=s; valm=unmoins;
    if (sl<0)
    {
      gammaunmoins2=ggamma(gmul2n(unmoins,-1),prec);
      var1=var2=gun;
      for (i=2; i<=N0; i++)
	if (signe(gcoef[i]))
	{
          gexpro=gexp(gmul((GEN)coeflog[i],s),bigprec);
	  var1=gadd(var1,gmulsg(((GEN)gcoef[i])[2],gexpro));
	  var2=gadd(var2,gdivsg(((GEN)gcoef[i])[2],gmulsg(i,gexpro)));
	}
      lambd=gadd(lambd,gmul(gmul(var1,cs),gar));
      lambd=gadd(lambd,gmul(gmul(var2,gdiv(cst,cs)),
			    gpuigs(gammaunmoins2,r1)));
      for (i=1; i<=imax; i+=2)
      {
	valk=val; valkm=valm;
	for (k=1; k<=ru; k++)	
	{
	  lambd=gsub(lambd,gdiv(gcoeff(cik,i,k),valk));
	  lambd=gsub(lambd,gdiv(gcoeff(cik,i,k),valkm));
	  valk=mulii(val,valk); valkm=mulii(valm,valkm);
	}
	val=addis(val,2); valm=addis(valm,2);
      }
    }
    else
    {
      GEN tabj=(GEN)nfz[3], aij=(GEN)nfz[7]; 

      gar = gmul(gar,gpuigs(ggamma(s,prec),r2));
      var1=var2=gzero;
      for (i=1; i<=N0; i++)
	if (signe(gcoef[i]))
	{
	  gexpro=gexp(gmul((GEN)coeflog[i],s),bigprec);
	  var1=gadd(var1,gmulsg(((GEN)gcoef[i])[2],gexpro));
          if (sl <= imax)
          {
            p1=gzero;
            for (j=1; j<=ru+1; j++)
              p1 = gadd(p1, gmul(gmael(aij,sl,j), gmael(tabj,i,j)));
            var2=gadd(var2,gdiv(p1,gmulsg(i,gexpro)));
          }
	}
      lambd=gadd(lambd,gmul(gmul(var1,cs),gar));
      lambd=gadd(lambd,gmul(var2,gdiv(cst,cs)));
      for (i=1; i<=imax; i++)
      {
	valk=val; valkm=valm;
	for (k=1; k<=ru; k++)
	{	
	  lambd=gsub(lambd,gdiv(gcoeff(cik,i,k),valk));
	  if (i!=sl)
	    lambd=gsub(lambd,gdiv(gcoeff(cik,i,k),valkm));
	  valk=mulii(val,valk); valkm=mulii(valm,valkm);
	}
	val=addis(val,1); valm=addis(valm,1);
      }
    }
  }
  else
  {
    constpi(prec);
    if (is_frac_t(ts))
    {
      p1 = cgetr(bigprec); affsr(1,p1); s=gmul(s,p1); 
    }
    else s = gprec(s, (long)((bigprec-2)*pariK));

    unmoins = gsub(gun,s);
    lambd = gdiv(resi,gmul(s,gsub(s,gun)));
    gammas = ggamma(s,prec);
    gammas2= ggamma(gmul2n(s,-1),prec);
    gar = gmul(gpuigs(gammas,r2),gpuigs(gammas2,r1));
    cs = gexp(gmul(cstlog,s),prec);
    var1 = gmul(gpi,s);
    gammaunmoins = gdiv(gpi,gmul(gsin(var1,prec),gammas));
    gammaunmoins2= gdiv(gmul(gmul(gsqrt(gpi,prec),gpui(gdeux,gsub(s,gun),prec)),
                             gammas2),
                        gmul(gcos(gmul2n(var1,-1),prec),gammas));
    var1 = var2 = gun;
    for (i=2; i<=N0; i++)
      if (signe(gcoef[i]))
      {
        gexpro = gexp(gmul((GEN)coeflog[i],s),bigprec);
	var1 = gadd(var1,gmulsg(((GEN)gcoef[i])[2], gexpro));
	var2 = gadd(var2,gdivsg(((GEN)gcoef[i])[2],gmulsg(i,gexpro)));
      }
    lambd = gadd(lambd,gmul(gmul(var1,cs),gar));
    lambd = gadd(lambd,gmul(gmul(gmul(var2,gdiv(cst,cs)),
	 		         gpuigs(gammaunmoins,r2)),
                            gpuigs(gammaunmoins2,r1)));
    val=s; valm=unmoins;
    for (i=1; i<=imax; i++)
    {
      valk=val; valkm=valm;
      for (k=1; k<=ru; k++)
      {
	lambd = gsub(lambd,gdiv(gcoeff(cik,i,k),valk));
	lambd = gsub(lambd,gdiv(gcoeff(cik,i,k),valkm));
	valk = gmul(val,valk); valkm = gmul(valm,valkm);
      }
      i++;
      if (r2)
      {
	valk2 = val2 = gadd(val,gun); 
        valkm2 = valm2 = gadd(valm,gun);
	for (k=1; k<=ru; k++)
	{
	  lambd = gsub(lambd,gdiv(gcoeff(cik,i,k),valk2));
	  lambd = gsub(lambd,gdiv(gcoeff(cik,i,k),valkm2));
	  valk2 = gmul(val2,valk2); valkm2 = gmul(valm2,valkm2);
	}
      }
      val = gadd(val,gdeux); valm = gadd(valm,gdeux);
    }
  }
  if (!flag) lambd = gdiv(lambd,gmul(gar,cs)); /* zetak */

  /* Safe: the stack is big enough */
  avma = av; return gprec(lambd, (long)((prec2-2)*pariK));
}

GEN
gzetak(GEN nfz, GEN s, long prec)
{
  return gzetakall(nfz,s,0,prec);
}

GEN
glambdak(GEN nfz, GEN s, long prec)
{
  return gzetakall(nfz,s,1,prec);
}
