/*******************************************************************/
/*******************************************************************/
/*                                                                 */
/*               SUBFIELDS OF A NUMBER FIELD                       */
/*                                                                 */
/*   J. Klueners and M. Pohst, J. Symb. Comp. (1996), vol. 11      */
/*                                                                 */
/*******************************************************************/
/*******************************************************************/
/* $Id: subfields.c,v 2.0.0.2 1997/12/14 20:11:49 karim Exp karim $ */
#include "genpari.h"

static long TR; /* nombre de changements de polynomes (degre fixe) */
static GEN FACTORDL; /* factorisation of |disc(L)| */

static GEN print_block_system(long N,GEN Y,long d);
static GEN compute_data(GEN nf,GEN ff,GEN p,long m);

/* Computation of potential block systems of given size d associated to a
 * rational prime p: give a row vector of row vectors containing the
 * potential block systems of imprimitivity; a potential block system is a
 * vector of row vectors (enumeration of the roots). Give also as a pointer
 * the factorization mod p of the polynomial nf[1]
 */
static GEN
calc_block(long N,GEN Z,long d,GEN Y,GEN vbs)
{
  long av,tetpil,r,lK,i,j,k,t,tp,T,lpn,u,nn,nZ,lY,lZp,nd,le;
  GEN K,Zp,Zpp,Yp, n,non,pn,pnon,e;

  if (DEBUGLEVEL>3)
  {
    fprintferr("avma = %ld\n",avma);
    fprintferr("Z = "); outerr(Z);
    fprintferr("Y = "); outerr(Y);
    fprintferr("vbs = "); outerr(vbs);
  }
  r=lg(Z)-1; n=cgeti(r+1); non=cgeti(r+1);
  pnon=cgeti(r+1); pn=cgeti(r+1);
  for (i=1; i<=r; i++) { pn[i]= 0; n[i] = lg(Z[i])-1; }

  K=divisors(stoi(n[1])); lK=lg(K)-1;
  for (i=1; i<=lK; i++)
  {
    k = itos((GEN)K[i]); for (j=1; j<=r; j++) pnon[j]=0;
    lpn=0;
    for (j=2; j<=r; j++)
      if (n[j]%k == 0) { lpn++; pn[lpn]=n[j]; pnon[lpn]=j; }
    if (lpn>31) err(talker,"overflow in calc_block");
    if (!lpn)
    {
      if (d*k-n[1] != 0 ) T=0;
      else
      {
	e=cgeti(2); T=1; le=1;
      }
    }
    else
    {
      e=cgeti(lpn+1); T = 1 << lpn; le = lpn;
    }
    for (t=0; t<T; t++)
    {
      for (j=1; j<=r; j++) non[j]=0;
      nd=0; tp=t;
      for (u=1; u<=le; u++)
        if (tp&1) { nd++; e[u]=1; tp>>=1; } else { e[u]=0; tp>>=1; }
      nn=n[1];
      for (u=1; u<=le; u++) 
        if (e[u]) nn += pn[u];
      if (d*k-nn == 0)
      {
	lZp=nd+1; Zp=cgetg(lZp+1,t_VEC); Zp[1]=Z[1];
        non[1]=1; nZ=1;
	for (j=1; j<=le; j++)
	  if (e[j]) { nZ++; Zp[nZ]=Z[pnon[j]]; non[pnon[j]]=1; }
	lY=lg(Y)-1; Yp=cgetg(lY+2,t_VEC);
	for (j=1; j<=lY; j++) Yp[j]=Y[j];
	Yp[lY+1]=(long)Zp; av=avma;
	if (gegal(Z,Zp))
	  vbs = concatsp(vbs, print_block_system(N,Yp,d));
	else
	{
	  Zpp = cgetg(r-lZp+1,t_VEC); u=0;
	  for (j=1; j<=r; j++)
	    if (!non[j]) { u++; Zpp[u]=Z[j]; }
	  vbs = calc_block(N,Zpp,d,Yp,vbs);
	}
        tetpil=avma; vbs = gerepile(av,tetpil,gcopy(vbs));
      }
    }
  }
  return vbs;
}

static GEN
potential_block_systems(long N, long d,GEN ff,long *n)
{
  long av=avma,tetpil,r,i,j,k;
  GEN p1,p2,Y,Z,vbs;

  vbs=cgetg(1,t_VEC); r=lg(ff)-1;
  Z=cgetg(r+1,t_VEC); k=0;
  for (i=1; i<=r; i++)
  { 
    Z[i]=lgetg(n[i]+1,t_VEC); p1=(GEN)Z[i];
    for (j=1; j<=n[i]; j++) p1[j]=lstoi(k+j);
    k += n[i];
  }
  Y=cgetg(1,t_VEC); p2=calc_block(N,Z,d,Y,vbs);
  tetpil=avma; return gerepile(av,tetpil,gcopy(p2));
}

/* product of permutations. Put the result in perm1. */
static void
perm_mul(GEN perm1,GEN perm2)
{
  long av = avma,i, N = lg(perm1)-1;
  GEN perm=cgeti(N+1);
  for (i=1; i<=N; i++) perm[i]=perm1[perm2[i]];
  for (i=1; i<=N; i++) perm1[i]=perm[i];
  avma=av;
}

/* transforme le cycle cy en une permutation */
static GEN
one_cycle_to_perm(long N, GEN cy)
{
  long i,a,b, lcy = lg(cy)-1;
  GEN perm = cgeti(N+1);

  b = itos((GEN)cy[1]);
  for (i=1; i<=N; i++) perm[i] = i;
  for (i=1; i<lcy; i++)         
  {
    a = b; b = itos((GEN)cy[i+1]); perm[a] = b;
  }
  perm[b] = itos((GEN)cy[1]); return perm;
}

/* cy est un cycle; transforme cy^l en une permutation */
static GEN
cycle_power_to_perm(GEN perm,GEN cy,long l)
{
  long av,lp,i,j,N = lg(perm)-1;
  GEN p1;

  lp = l % (lg(cy)-1);
  if (!lp)
  { 
    for (i=1; i<=N; i++) perm[i] = i;
    return perm;
  }
  av=avma; p1 = one_cycle_to_perm(N,cy);
  for (i=1; i<=N; i++) perm[i]=p1[i];
  for (j=2; j<=lp; j++) perm_mul(perm,p1);
  avma=av; return perm;
}

/* image du block system D par la permutation perm */
static GEN
im_block_by_perm(GEN D,GEN perm)
{
  long i,j,lb,lcy;
  GEN Dn,cy,p1;

  lb=lg(D)-1; Dn=cgetg(lb+1,t_VEC);
  for (i=1; i<=lb; i++)
  {
    cy=(GEN)D[i]; lcy=lg(cy)-1;
    Dn[i]=lgetg(lcy+1,t_VEC); p1=(GEN)Dn[i];
    for (j=1; j<=lcy; j++) 
      p1[j] = lstoi(perm[itos((GEN)cy[j])]);
  }
  return Dn;
}

/* cy est un cycle; renvoie l'image de l'entier in par la permutation cy^l */
static GEN
im_by_perm(GEN in,GEN cy,long l)
{
  long lcc,lp,k,kp;

  lcc=lg(cy)-1; lp=l%lcc; k=1;
  while (k<=lcc && cmpii(in,(GEN)cy[k])) k++;
  if (k>lcc) return in;

  kp=(k+lp)%lcc; if (!kp) kp=lcc;
  return (GEN)cy[kp];
}

/* renvoie 0 si l'un des coefficients de g est de module > M; 1 sinon */
static long
test_coefficients(GEN g,GEN M)
{
  long av=avma,i,lg;

  lg=lgef(g)-2; M=gmul2n(M,1);
  for (i=1; i<=lg; i++)
    if (gcmp(gabs((GEN)g[i+1],3),M)>0) break;
  avma=av; return (i>lg);
}

static GEN
print_block_system(long N,GEN Y,long d)
{
  long i,j,l,ll,r,*s,*k,*kk,*n,lp,**e,u,v,*t,ns,ls;
  GEN D,De,Yi,Z,a,vaa,cyperm,perm,vbs,Dn,p1,empty;

  if (DEBUGLEVEL>3) { fprintferr("Y = "); outerr(Y); }
  r=lg(Y)-1; D=cgetg(1,t_VEC);
  k=cgeti(r+1); s=cgeti(r+1); ll=1;
  for (i=1; i<=r; i++) { l = lg(Y[i])-1; s[i]=l; if (ll<l) ll=l; }
  n = cgeti(ll); vaa=cgetg(2,t_VEC); empty = cgetg(1,t_VEC);
  for (i=1; i<=r; i++)
  {
    Yi=(GEN)Y[i];
    for (j=1; j<=s[i]; j++) n[j]=lg(Yi[j])-1;
    k[i] = n[1]; for (j=2; j<=s[i]; j++) k[i] += n[j]; 
    k[i] = k[i]/d;
    De=cgetg(k[i]+1,t_VEC); a=cgetg(s[i]+1,t_VEC);
    for (j=1; j<=k[i]; j++) De[j]=(long)empty;
    for (j=1; j<=s[i]; j++) a[j]=mael(Yi,j,1);
    for (j=1; j<=s[i]; j++)
      for (l=1; l<=n[j]; l++)
      {
	vaa[1] = (long)im_by_perm((GEN)a[j],(GEN)Yi[j],l);
	lp=l%k[i]; if (!lp) lp=k[i];
        De[lp] = (long)concatsp((GEN)De[lp],vaa);
      }
    D=concatsp(D,De);
  }
  if (DEBUGLEVEL>3)
  {
    fprintferr("D = "); outerr(D);
    for (i=1; i<=r; i++) fprintferr("s[%ld] = %ld , ",i,s[i]);
    fprintferr("\n");
    for (i=1; i<=r; i++) fprintferr("k[%ld] = %ld , ",i,k[i]);
    fprintferr("\n"); flusherr();
  }
  vbs=empty; ns=0;
  for (i=1; i<=r; i++)
    if (s[i]>1 && k[i]>1) ns++;
  if (DEBUGLEVEL>3) { fprintferr("ns = %ld\n",ns); flusherr(); }
  if (!ns) { vaa[1]=(long)D; return concatsp(vbs,vaa); }

  t=cgeti(ns+1); kk=cgeti(ns+1); Z=cgetg(ns+1,t_VEC); ls=0;
  for (i=1; i<=r; i++)
    if (s[i]>1 && k[i]>1)
    {
      ls++; t[ls]=s[i]-1; kk[ls]=k[i];
      Z[ls]=lgetg(s[i],t_VEC); p1=(GEN)Z[ls];
      for (j=2; j<=s[i]; j++) p1[j-1]=mael(Y,i,j);
    }
  if (DEBUGLEVEL>3)
  {
    fprintferr("Z = "); outerr(Z);
    for (i=1; i<=ns; i++) fprintferr("t[%ld] = %ld , ",i,t[i]);
    fprintferr("\n");
    for (i=1; i<=ns; i++) fprintferr("kk[%ld] = %ld , ",i,kk[i]);
    fprintferr("\n"); flusherr();
  }
  e=(long**)cgeti(ns+1);
  for (i=1; i<=ns; i++)
  { 
    e[i]=cgeti(t[i]+1);
    for (j=1; j<=t[i]; j++) e[i][j]=0; 
  }
  i=ns; perm=cgetg(N+1,t_VEC); cyperm=cgetg(N+1,t_VEC);
  do
  {
    if (DEBUGLEVEL>3)
    {
      for (l=1; l<=ns; l++)
      {
	for (ll=1; ll<=t[l]; ll++)
	  fprintferr("e[%ld][%ld] = %ld, ",l,ll,e[l][ll]);
	fprintferr("\n");
      }
      fprintferr("\n"); flusherr();
    }
    for (u=1; u<=N; u++) perm[u]=u;
    for (u=1; u<=ns; u++)
      for (v=1; v<=t[u]; v++)
	perm_mul(perm, cycle_power_to_perm(cyperm,gmael(Z,u,v),e[u][v]));

    Dn=im_block_by_perm(D,perm); vaa[1]=(long)Dn;
    if (DEBUGLEVEL>3) { fprintferr("Dn = "); outerr(Dn); }
    vbs = concatsp(vbs,vaa);

    e[ns][t[ns]]++;
    if (e[ns][t[ns]] >= kk[ns])
    {
      j=t[ns]-1;
      while (j>=1 && e[ns][j] == kk[ns]-1) j--;
      if (j>=1) { e[ns][j]++; for (l=j+1; l<=t[ns]; l++) e[ns][l]=0; }
      else
      {
	i=ns-1;
	while (i>=1)
	{
	  j=t[i];
	  while (j>=1 && e[i][j] == kk[i]-1) j--;
	  if (j<1) i--;
          else
	  {
	    e[i][j]++;
	    for (l=j+1; l<=t[i]; l++) e[i][l]=0;
	    for (ll=i+1; ll<=ns; ll++)
              for (l=1; l<=t[ll]; l++) e[ll][l]=0;
            break;
	  }
	}
      }
    }
  }
  while (i>=1);
  return vbs;
}

/* rend le numero du cycle dans le support duquel se trouve a */
static long
in_what_cycle(GEN a,GEN cys)
{
  long lcys,i,k,nk;

  lcys=lg(cys)-1;
  for (k=1; k<=lcys; k++)
  {
    nk = lg(cys[k]);
    for (i=1; i<nk; i++)
      if (gegal(a,gmael(cys,k,i))) return k;
  }
  err(talker,"impossible to find the integer in in_what_cycle");
  return 0; /* not reached */
}

static long
what_number(GEN a,GEN cy)
/* si cy=(a_1,a_2,...,a_s) est un cycle, et a un entier, renvoie i t.q. a_i=a */
{
  long i,lcy=lg(cy)-1;
  for (i=1; i<=lcy; i++)
    if (!cmpii(a,(GEN)cy[i])) return i;
  err(talker,"integer not found in what_number");
  return 0; /* not reached */
}

/* Rend les facteurs communs a |d(K)| et |d(g)| et s la partie premiere a
 * d(K) de d(g)
 */
static GEN
commonfactor(GEN FACTORDL,GEN dg)
{
  long av,tetpil,lff,i,a;
  GEN y,dga,ff1,p1,p2,s;

  av=avma; dga=absi(dg);
  ff1=(GEN)FACTORDL[1]; lff=lg(ff1)-1;
  y=cgetg(3,t_MAT); p1=cgetg(lff+2,t_COL); p2=cgetg(lff+2,t_COL);
  y[1]=(long)p1; y[2]=(long)p2; s=dga;
  for (i=1; i<=lff; i++)
  {
    p1[i]=ff1[i];
    a=ggval(dga,(GEN)ff1[i]); s=gdiv(s,gpuigs((GEN)ff1[i],a));
    p2[i]=lstoi(a);
  }
  p1[lff+1]=(long)s; p2[lff+1]=un;
  tetpil=avma; return gerepile(av,tetpil,gcopy(y));
}

/* Renvoie un polynome g definissant un sous-corps potentiel, ou
 * 0: si le polynome trouve n'est pas separable,
 * 1: si les coefficients du polynome trouve sont plus grands que la borne M,
 * 2: si p divise le discriminant de g,
 * 3: si le discriminant de g est nul,
 * 4: si la partie s de d(g) premiere avec d(L) n'est pas un carre,
 * 5: si s est un carre et si un des facteurs premiers communs a d(g) et d(L)
 *    a un exposant impair dans d(g) et un exposant plus petit que d dans d(L),
 * 6: si le discriminant du corps defini par g a la puissance d ne divise pas
 *        le discriminant du corps nf (soit L).
 */
static GEN
cand_for_subfields(GEN A,GEN DATA,GEN *ptdelta,GEN *ptrootsA)
{
  long av=avma,N,m,r,i,j,l,**no_cy,**no_roots,d,*n,e,lf;
  GEN p,pol,cys,p1,Ai,a,tabroots,fhk,delta,g,dg,unmodpe,tabrA;
  GEN factcommon,sqs,s,ff1,ff2;
  GEN *gptr[3];

  pol=(GEN)DATA[1]; N=lgef(pol)-3; m=lg(A)-1;
  p=(GEN)DATA[2];
  if (N%m) err(talker,"incompatible block system in cand_for_subfields");
  d=N/m; r=itos((GEN)DATA[3]);
  n=cgeti(r+1); for (j=1; j<=r; j++) n[j]=itos(gmael(DATA,5,j));
  cys=(GEN)DATA[7];

  no_cy=(long**) cgeti(m+1);
  no_roots=(long**) cgeti(m+1);
  for (i=1; i<=m; i++)
  {
    no_cy[i]=cgeti(d+1); no_roots[i]=cgeti(d+1); Ai=(GEN)A[i];
    for (j=1; j<=d; j++)
    {
      a=(GEN)Ai[j]; l=in_what_cycle(a,cys);
      no_cy[i][j]=l;
      no_roots[i][j] = what_number(a,(GEN)cys[l]);
    }
  }
  e=itos((GEN)DATA[11]); unmodpe=gmodulsg(1,gpuigs(p,e));
  fhk=(GEN)DATA[12];
  tabroots=cgetg(r+1,t_VEC); l=0;
  for (j=1; j<=r; j++)
  {
    tabroots[j]=lgetg(n[j]+1,t_VEC); p1=(GEN)tabroots[j];
    for (i=1; i<=n[j]; i++)
      { l++; p1[i] = lneg(compo((GEN)fhk[l],1)); }
  }
  if (DEBUGLEVEL>2)
    for (i=1; i<=r; i++)
      for (j=1; j<=n[i]; j++)
      { fprintferr("tabroots[%ld][%ld] = ",i,j); outerr(gmael(tabroots,i,j)); }
  delta=cgetg(m+1,t_VEC);
  for (i=1; i<=m; i++)
  {
    delta[i]=(long)unmodpe;
    for (j=1; j<=d; j++)
    {
      delta[i]= lmul((GEN)delta[i],
                      gmael(tabroots, no_cy[i][j], no_roots[i][j]));
    }
    p1=gmael(delta,i,1);
    delta[i] = lmodulcp(lift_intern(lift_intern((GEN)delta[i])),p1);
  }
  if (DEBUGLEVEL>2)
    for (i=1; i<=m; i++)
    {
      fprintferr("delta[%ld] = ",i); outerr((GEN)delta[i]);
    }
  for (i=1; i<=m; i++)
    for (j=i+1; j<=m; j++)
      if (gegal((GEN)delta[i],(GEN)delta[j])) { avma=av;  return gzero; }
  tabrA=cgetg(m+1,t_VEC);
  for (i=1; i<=m; i++)
  {
    tabrA[i]=lgetg(d+1,t_VEC); p1=(GEN)tabrA[i];
    for (j=1; j<=d; j++)
      p1[j] = mael(tabroots, no_cy[i][j], no_roots[i][j]);
  }
  g=unmodpe; for (i=1; i<=m; i++) g=gmul(g,gsub(polx[0],(GEN)delta[i]));
  g=simplify(centerlift(lift(g)));
  if (DEBUGLEVEL>2) { fprintferr("pol. found = "); outerr(g); }
  if (!test_coefficients(g,(GEN)DATA[10])) return gun;
  dg=discsr(g);
  if (gdivise(dg,p)) return gdeux;
  if (gcmp0(dg)) return stoi(3);
  factcommon=commonfactor(FACTORDL,dg);
  ff1=(GEN)factcommon[1]; ff2=(GEN)factcommon[2];
  lf=lg(ff1)-1; s=(GEN)ff1[lf];
  if (!carrecomplet(s,&sqs)) return stoi(4);
  for (i=1; i<lf; i++)
    if (mod2((GEN)ff2[i]) && itos(gmael(FACTORDL,2,i)) < d) return stoi(5);

  *ptdelta=delta; *ptrootsA=tabrA;
  gptr[0]=&g; gptr[1]=ptdelta; gptr[2]=ptrootsA;
  gerepilemany(av,gptr,3); return g;
}

/* a partir d'un polynome h(x) dont les coefficients sont definis mod p^k,
   et d'un corps de nombres nf, on construit un polynome a coefficients dans Q
   dont les coefficients ont pour approximation p-adique les coefficients de h */
static GEN
retrieve_p_adique_polynomial_in_Q(GEN nf,GEN h)
{
  long av,tetpil,i,deg;
  GEN v,ind;

  av=avma; ind=(GEN)nf[4]; deg=lgef(h)-3; v=cgetg(deg+2,t_VEC);
  for (i=1; i<=deg+1; i++)
    v[i]=ldiv(centerlift(gmul(ind,compo(h,deg+2-i))),ind);
  tetpil=avma; return gerepile(av,tetpil,gtopoly(v,0));
}

/* polynome d'interpolation de Lagrange P(x) a coefficients dans Z tel que
   P(T[i]) congru a delta[i] mod p pour tout i */
static GEN
interpolation_polynomial_mod_p(GEN T,GEN delta,GEN p)
{
  long i,j,d;
  GEN T1,delta1,P,p1,p2,unmodp;

  unmodp=gmodulsg(1,p); d=lg(T)-1; P=gzero;
  T1=gmul(unmodp,T); delta1=gmul(unmodp,delta);
  for (i=1; i<=d; i++)
  {
    p1=gun;
    for (j=1; j<=i-1; j++) p1=gmul(p1,gsub(polx[0],(GEN)T1[j]));
    for (j=i+1; j<=d; j++) p1=gmul(p1,gsub(polx[0],(GEN)T1[j]));
    p2=gun;
    for (j=1; j<=i-1; j++) p2=gmul(p2,gsub((GEN)T1[i],(GEN)T1[j]));
    for (j=i+1; j<=d; j++) p2=gmul(p2,gsub((GEN)T1[i],(GEN)T1[j]));
    P=gadd(P,gmul((GEN)delta1[i],gdiv(p1,p2)));
  }
  return lift_intern(lift_intern(P));
}

/* Etant donne un polynome g de Z[x], de derivee gp, un nombre entier pp,
   et un couple wh0=[w0,h0] de polynomes dans Z[x] tels que
   h0(x).gp(w0(x)) congru a 1 et g(w0(x)) congru a 0 (mod f,mod pp),
   on renvoie un couple wh1=[w1,h1] de polynomes dans Z[x] satisfaisant
   les memes conditions en remplacant pp par pp^2, avec de plus
   w1 congru a w0 et h1 congru a h0 (mod pp)
   (cf. J. D. Dixon, J. Austral. Math. Soc., Series A, vol.49, 1990, p.445) */
static GEN
newton_lift(GEN f,GEN g,GEN gp,GEN wh0,GEN pp)
{
  GEN w0,h0,w1,h1,wh1,unmodpp,ppp,p1;
  long av=avma,tetpil;

  ppp=gsqr(pp); unmodpp=gmodulsg(1,ppp);
  w0=(GEN)wh0[1]; h0=(GEN)wh0[2];
  p1=gsub(w0,gmul(h0,gsubst(g,varn(g),w0)));
  w1=lift(lift(gmodulcp(gmul(unmodpp,p1),f)));
  p1=gmul(h0,gsub(gdeux,gmul(h0,gsubst(gp,varn(gp),w1))));
  h1=lift(lift(gmodulcp(gmul(unmodpp,p1),f)));
  wh1=cgetg(3,t_VEC); wh1[1]=(long)w1; wh1[2]=(long)h1;
  tetpil=avma; return gerepile(av,tetpil,gcopy(wh1));
} 

/* nf est le corps de nombres, g un polynome de Z[x] candidat
 * pour definir un sous-corps, p le nombre premier ayant servi a definir le
 * potential block system rootsA donne par les racines avec une approximation
 * convenable, e est la precision p-adique des elements de rootsA et delta la
 * liste des racines de g dans une extension convenable en precision p^e.
 * Renvoie un polynome h de Q[x] tel que f divise g o h et donc tel que le
 * couple (g,h) definisse un sous-corps, ou bien gzero si rootsA n'est pas un
 * block system
 */
static GEN
embedding_of_potential_subfields(GEN nf,GEN g,GEN DATA,GEN rootsA,GEN delta)
{
  long av,tetpil,m,d,i,j,k,N;
  GEN wh0,wh1,w0,w1,h0,gp,pp,p1,p2,p3,Delta,f,rA,unmodp,p;

  av=avma; m=lg(rootsA)-1; d=lg(rootsA[1])-1; f=(GEN)nf[1]; N=m*d;
  p=(GEN)DATA[2];
  gp=deriv(g,varn(g)); unmodp=gmodulsg(1,p);
  Delta=cgetg(N+1,t_VEC); k=0;
  for (j=1; j<=m; j++)
    for (i=1; i<=d; i++) { k++; Delta[k]=delta[j]; }
  rA=cgetg(N+1,t_VEC); k=0;
  for (j=1; j<=m; j++)
    for (i=1; i<=d; i++) { k++; rA[k]=((GEN)rootsA[j])[i]; }
  w0=simplify(interpolation_polynomial_mod_p(rA,Delta,p));
  p1=vecbezout(gmul(unmodp,gsubst(gp,varn(gp),w0)),gmul(unmodp,f));
  h0=simplify(lift_intern((GEN)p1[1]));
  wh0=cgetg(3,t_VEC); wh0[1]=(long)w0; wh0[2]=(long)h0;
  if (DEBUGLEVEL>2)
  {
    fprintferr("w = "); outerr(w0);
    fprintferr("h = "); outerr(h0);
  }
  pp=p;
  for(;;)
  {
    wh1=newton_lift(f,g,gp,wh0,pp);
    w1=(GEN)wh1[1]; w0=(GEN)wh0[1];
    if (DEBUGLEVEL>2)
    {
      fprintferr("w = "); outerr(w1);
      fprintferr("h = "); outerr((GEN)wh1[2]);
    }
    p3=retrieve_p_adique_polynomial_in_Q(nf,gmul(w0,gmodulsg(1,pp)));
    p2=retrieve_p_adique_polynomial_in_Q(nf,gmul(w1,gmodulsg(1,gsqr(pp))));
    if (DEBUGLEVEL>2)
    {
      fprintferr("Old Q-polynomial = "); outerr(p3);
      fprintferr("New Q-polynomial = "); outerr(p2);
    }
    if (gegal(p2,p3)) break;
    if (!test_coefficients(p2,(GEN)DATA[15])) {avma=av; return gzero;}
    pp=gsqr(pp); wh0=wh1;
  }
  p3=gsubst(g,varn(g),p3);
  if (!gdivise(p3,f)) { avma=av; return gzero; }
  p1=gadd(polx[0],stoi(TR)); tetpil=avma;
  return gerepile(av,tetpil,gsubst(p2,varn(p2),p1));
}

static GEN
choose_prime(GEN nf,GEN dpol,long lowerp,long d,GEN *ptff,GEN *ptlistpotbl)
{
  long av,j,k,pp,oldllist,llist,r,nn,oldnn,*n,N;
  GEN p,listpotbl,oldlistpotbl,ff,oldff,p3,*gptr[2];
  byteptr di=diffptr;

  av=avma; di++; p=stoi(2); N=lgef(nf[1])-3;
  while (p[2]<=lowerp || !smodis(dpol,p[2])) p[2] += *di++;
  oldllist = -1; n = cgeti(N+1);
  for (k=1; k<11; k++)
  {
    setrand(1);
    ff=(GEN)factmod((GEN)nf[1],p)[1]; r=lg(ff)-1;
    if (r>1 && r<N)
    {
      for (j=1; j<=r; j++) n[j]=lgef(ff[j])-3;
      p3=stoi(n[1]);
      for (j=2; j<=r; j++) p3=glcm(p3,stoi(n[j]));
      nn=itos(p3);
      listpotbl=potential_block_systems(N,d,ff,n);
      llist=lg(listpotbl)-1;
      if (DEBUGLEVEL>0)
      {
	fprintferr("p = %ld, r = %ld, nn = %ld, #p.b.s = %ld\n",
                    p[2],r,nn,llist);
	flusherr();
      }
      if (oldllist==-1 || nn<oldnn || (nn==oldnn && llist<=oldllist))
      { 
	oldllist=llist; oldlistpotbl=listpotbl;
	pp=p[2]; oldff=ff; oldnn=nn;
      }
    }
    do  p[2] += *di++; while (!smodis(dpol,p[2]));
  }
  if (DEBUGLEVEL>0)
  {
    fprintferr("Nombre premier choisi: p = %ld\n",pp);
    if (DEBUGLEVEL>2)
    {
      fprintferr("Liste des potential block systems de taille %ld:\n",d);
      for (k=1; k<=oldllist; k++) outerr((GEN)oldlistpotbl[k]);
      fprintferr("\n");
    } 
    flusherr();
  }
  *ptlistpotbl=oldlistpotbl; *ptff=oldff;
  gptr[0]=ptlistpotbl; gptr[1]=ptff;
  gerepilemany(av,gptr,2); return stoi(pp);
}

static GEN
small_initalg(GEN nf,GEN newf)
{
  long av=avma,tetpil,i,ll;
  GEN y,p1,p2;

  y=cgetg(10,t_VEC);
  y[1]=(long)newf;
  y[2]=nf[2]; 
  y[3]=nf[3]; p1=discsr(newf);
  y[4]=(long)racine(gdiv(p1,(GEN)y[3]));
  y[5]=zero; ll=lg(nf[6])-1; p1=cgetg(ll+1,t_VEC); 
  y[6]=(long)p1; p2=(GEN)nf[6];
  for (i=1; i<=ll; i++) p1[i]=ladd(gun,(GEN)p2[i]);
  y[7]=zero;
  y[8]=zero;
  y[9]=zero; tetpil=avma; return gerepile(av,tetpil,gcopy(y));
}

static GEN
bound_for_coeff(long m,GEN rr)
{
  long av=avma,lrr,i;
  GEN c1,c2,b,M;

  lrr=lg(rr)-1; b=gmax(gun,(GEN)rr[1]);
  for (i=2; i<=lrr; i++) b=gmul(b,gmax(gun,(GEN)rr[i]));
  if (m&1){ c1=binome(stoi(m-1),m>>1); c2=binome(stoi(m-1),(m>>1)-1); }
  else{ c1=binome(stoi(m-1),m>>1); c2=binome(stoi(m-1),m>>1); }
  M=ground(gadd(gmul(c1,b),c2)); return gerepileupto(av,M);
}

/* liste des sous corps de degre d du corps de nombres nf */
static GEN
subfields_of_given_degree(GEN nf,GEN dpol,long d)
{
  long av,av2,tetpil,pp,llist,j,lowerp,N,r;
  GEN listpotbl,p,ff,A,delta,rootsA,CSF,ESF,p1,p2,LSB;
  GEN newf,DATA;

  N=lgef(nf[1])-3; lowerp=N;
LAB1: 
  av=avma; LSB=cgetg(1,t_VEC); p1=setrand(1);
  p=choose_prime(nf,dpol,lowerp,N/d,&ff,&listpotbl);
  llist=lg(listpotbl)-1; pp=itos(p);
  DATA=compute_data(nf,ff,p,d);
  for (j=1; j<=llist; j++)
  {
    av2=avma; A=(GEN)listpotbl[j];
    if (DEBUGLEVEL>0)
    {
      fprintferr("\n* Potential block # %ld: ",j); outerr(A);
    }
    CSF=cand_for_subfields(A,DATA,&delta,&rootsA);
    if (DEBUGLEVEL>0)
    {
      if (typ(CSF)!=t_INT) { fprintferr("candidate = "); outerr(CSF); }
      else
      {
        switch(itos(CSF))
        {
          case 0:
            fprintferr("non separable pol. g(x) in cand_for_subfields: ");
            fprintferr("changing polynomial f(x) ...\n"); break;
          case 1:
            fprintferr("too big coeff for pol g(x) in cand_for_subfields\n");
            break;
          case 2:
            fprintferr("the prime p divides the discriminant of g(x): ");
            fprintferr("changing the prime p ...\n");
            break;
          case 3: fprintferr("non irreducible polynomial g(x)\n"); break;
          case 4: fprintferr("prime to d(L) part of d(g) not a square\n");
            break;
          case 5: fprintferr("too small exponent of a prime factor in d(L)\n");
            break;
          case 6: fprintferr("the d-th power of d(K) does not divide d(L)\n");
        }
        flusherr();
      }
    }
    if (typ(CSF)==t_INT)
    {
      r = itos(CSF);
      if (r==0)
      {
        TR++; newf=gsubst((GEN)nf[1],varn(nf[1]),gsub(polx[0],gun));
        if (DEBUGLEVEL>0) { fprintferr("new f = "); outerr(newf); }
        nf=small_initalg(nf,newf); dpol=discsr(newf); lowerp++;
        goto LAB1;
      }
      if (r==2) { lowerp=pp+1; avma=av; goto LAB1; }
      avma=av2;
    }
    else
    {
      ESF=embedding_of_potential_subfields(nf,CSF,DATA,rootsA,delta);
      if (DEBUGLEVEL>0) { fprintferr("embedding = "); outerr(ESF); }
      if (gcmp0(ESF)) avma=av2;
      else
      {
	p1=cgetg(3,t_VEC);
        p1[1]=(long)CSF;
        p1[2]=(long)ESF; p2=cgetg(2,t_VEC); p2[1]=(long)p1;
	LSB=concatsp(LSB,p2); tetpil=avma;
        LSB=gerepile(av2,tetpil,gcopy(LSB));
      }
    }
  }
  tetpil=avma; return gerepile(av,tetpil,gcopy(LSB));
}

GEN
subfields(GEN nf,GEN d)
{
  long av=avma,di,N,v0,lp1,i;
  GEN dpol,p1,LSB,p2;

  nf=checknf(nf); v0=varn(nf[1]); N=lgef(nf[1])-3; di=itos(d);
  if (di==N)
  {
    LSB=cgetg(2,t_VEC); p1=cgetg(3,t_VEC); LSB[1]=(long)p1;
    p1[1]=lcopy((GEN)nf[1]); p1[2]=lpolx[v0]; return LSB;
  }
  if (di==1)
  {
    LSB=cgetg(2,t_VEC); p1=cgetg(3,t_VEC); LSB[1]=(long)p1;
    p1[1]=lpolx[v0]; p1[2]=lcopy((GEN)nf[1]); return LSB;
  }
  if (di<=0 || di>N || N%di) return cgetg(1,t_VEC);

  TR=0; dpol=gmul((GEN)nf[3],gmul((GEN)nf[4],(GEN)nf[4]));
  if (v0) nf=gsubst(nf,v0,polx[0]);
  FACTORDL=factor(absi((GEN)nf[3]));
  p1=subfields_of_given_degree(nf,dpol,di); lp1=lg(p1)-1;
  if (v0)
    for (i=1; i<=lp1; i++)
      { p2=(GEN)p1[i]; setvarn(p2[1],v0); setvarn(p2[2],v0); }
  return gerepileupto(av,p1);
}

static GEN
subfieldsall(GEN nf)
{
  long av=avma,av1,tetpil,N,ld,d,i,j,lNLSB,v0,lp1;
  GEN dpol,dg,LSB,NLSB,p1,p2;

  nf=checknf(nf); v0=varn(nf[1]); N=lgef(nf[1])-3;
  if (isprime(stoi(N)))
  {
    LSB=cgetg(3,t_VEC); LSB[1]=lgetg(3,t_VEC); LSB[2]=lgetg(3,t_VEC);
    p1=(GEN)LSB[1]; p1[1]=nf[1]; p1[2]=(long)polx[v0];
    p1=(GEN)LSB[2]; p1[1]=(long)polx[v0]; p1[2]=nf[1];
    tetpil=avma; return gerepile(av,tetpil,gcopy(LSB));
  }
  FACTORDL=factor(absi((GEN)nf[3])); dg=divisors(stoi(N));
  dpol=mulii(sqri((GEN)nf[4]),(GEN)nf[3]);
  if (DEBUGLEVEL>0)
  {
    fprintferr("\n***** Entree dans subfields\n\n");
    fprintferr("pol = "); outerr((GEN)nf[1]);
    fprintferr("dpol = "); outerr(dpol);
    fprintferr("divisors = "); outerr(dg);
  }
  ld=lg(dg)-1; LSB=cgetg(2,t_VEC); LSB[1]=lgetg(3,t_VEC);
  p1=(GEN)LSB[1]; p1[1]=nf[1]; p1[2]=(long)polx[0];
  for (i=2; i<ld; i++)
  {
    p1=setrand(1); if (v0) nf=gsubst(nf,v0,polx[0]);
    TR=0; av1=avma; d=itos((GEN)dg[i]);
    if (DEBUGLEVEL>0)
    { 
      fprintferr("\n*** Recherche des sous-corps de degre %ld\n\n",N/d);
      flusherr();
    }
    NLSB=subfields_of_given_degree(nf,dpol,N/d);
    if (DEBUGLEVEL>0)
    {
      fprintferr("\nListe des sous-corps de degre %ld:\n",N/d);
      lNLSB=lg(NLSB)-1;
      for (j=1; j<=lNLSB; j++) outerr((GEN)NLSB[j]);
    }
    if (lg(NLSB)>1) LSB = concatsp(LSB,NLSB); else avma=av1;
  }
  p1=cgetg(2,t_VEC); p1[1]=lgetg(3,t_VEC); p2=(GEN)p1[1];
  p2[1]=(long)polx[0]; p2[2]=nf[1]; LSB=concatsp(LSB,p1); lp1=lg(LSB)-1;
  if (v0)
    for (i=1; i<=lp1; i++)
      { p2=(GEN)LSB[i]; setvarn(p2[1],v0); setvarn(p2[2],v0); }
  if (DEBUGLEVEL>0) fprintferr("\n***** Sortie de subfields\n\n"); flusherr();
  tetpil=avma; return gerepile(av,tetpil,gcopy(LSB));
}

GEN
subfields0(GEN nf,GEN d)
{
  return gcmp0(d)? subfieldsall(nf): subfields(nf,d);
}

/* polynome unitaire irreductible de degre n sur F_p[v] */
GEN
ffinit(GEN p,long n,long v)
{
  long av,av1,tetpil,i,*a,j,l,pp;
  GEN pol,vc,unmodp,fpol;

  if (n<=0) err(talker,"non positive degree in ffinit");
  av=avma; pp=itos(p); unmodp=gmodulss(1,pp);
  if (n==1)
  { 
    pol=gadd(polx[v],gun); tetpil=avma;
    return gerepile(av,tetpil,gmul(unmodp,pol));
  }
  a=cgeti(n+2); av1=avma;
  a[1]=1; for (i=2; i<=n+1; i++) a[i]=0;
  for(;;)
  {
    a[n+1]++;
    if (a[n+1]>=pp)
    {
      j=n; while (j>=2 && a[j]==pp-1) j--;
      if (j>=2) { a[j]++; for (l=j+1; l<=n+1; l++) a[l]=0; }
    }
    vc=cgetg(n+2,t_VEC); vc[1]=un;
    for (i=2; i<=n+1; i++) vc[i]=lstoi(a[i]);
    pol=gtopoly(vc,v); setrand(1); fpol=simplefactmod(pol,p);
    if (lg(fpol[1])==2 && gcmp1(gmael(fpol,2,1))) break;
    avma=av1;
  }
  tetpil=avma; return gerepile(av,tetpil,gmul(unmodp,pol));
}

/* a est un polynome en x dont les coefficients sont des polynomes modulo fq
 * dont les coefficients sont des entiers modulo p (y compris les
 * coefficients de fq. Renvoie a sous la forme d'un polynome en x dont les
 * coefficients sont des polynomes modulo fq dont les coefficients sont 
 * dans Z
 */
static GEN
special_lift(GEN a,GEN fq)
{
  long tb,lb,i;
  GEN fqp,b,c;

  fqp=lift(fq); b=lift(lift(a)); tb=typ(b);
  if (tb==t_INT) return gmodulcp(b,fqp);
  if (tb==t_POL)
  {
    lb=lgef(b); c=cgetg(lb,tb); c[1]=b[1];
    for (i=2; i<lb; i++) c[i]=lmodulcp((GEN)b[i],fqp);
    return c;
  }
  err(talker,"wrong type in special_lift");
  return NULL; /* not reached */
}

/* Algorithmes 3.5.5. H. Cohen page 137 (1995): renvoie [A1,B1,U1,V1] */
static GEN
hensel_lift_one_step_for_two(GEN C,GEN A,GEN B,GEN U,GEN V,GEN fkk,GEN p)
{
  GEN unmodp,p1,p2,f,t,A0,B0,A1,B1,g,U0,V0,U1,V1,x;

  unmodp=gmodulsg(1,p);
  p1=gdiv(gsub(C,gmul(A,B)),p); f=gmul(p1,unmodp);
  p2=gdiventres(gmul(V,f),A); t=(GEN)p2[1];
  A0=special_lift((GEN)p2[2],fkk);
  B0=special_lift(gadd(gmul(U,f),gmul(B,t)),fkk);
  A1=gadd(A,gmul(A0,p)); B1=gadd(B,gmul(B0,p));
  p1=gdiv(gsub(gun,gadd(gmul(U,A1),gmul(V,B1))),p); g=gmul(p1,unmodp);
  p2=gdiventres(gmul(V,g),A1); t=(GEN)p2[1];
  U0=special_lift(gadd(gmul(U,g),gmul(B1,t)),fkk);
  V0=special_lift((GEN)p2[2],fkk);
  U1=gadd(U,gmul(U0,p)); V1=gadd(V,gmul(V0,p));
  x=cgetg(5,t_VEC); x[1]=(long)A1; x[2]=(long)B1; x[3]=(long)U1; x[4]=(long)V1;
  return x;
}

/* renvoie [Ae,Be,Ue,Ve] */
static GEN
hensel_lift_for_two(GEN C,GEN A,GEN B,GEN U,GEN V,GEN fkk,GEN p,long e)
{
  long av,tetpil,ex;
  GEN p1,pp,Ap,Bp,Up,Vp;

  av=avma; pp=p; Ap=A; Bp=B; Up=U,Vp=V; ex=1;
  for(;;)
  {
    p1=hensel_lift_one_step_for_two(C,Ap,Bp,Up,Vp,fkk,pp);
    ex<<=1; if (ex>=e) break;
    pp=gsqr(pp);
    Ap=(GEN)p1[1]; Bp=(GEN)p1[2];
    Up=(GEN)p1[3]; Vp=(GEN)p1[4];
  }
  tetpil=avma; return gerepile(av,tetpil,gcopy(p1));
}

/* lift de Hensel: fk est la factorisation (vecteur des facteurs) du
 * polynome pol en x dans le corps fini defini par le polynome en y fkk
 * (polynomes en x dont les coefficients sont des polynomes modulo fkk, dont
 * les coefficients sont des entiers modulo p); (les coefficients de fkk sont
 * aussi des entiers modulo p); on releve cette factorisation a la precision
 * p^e. Cela est equivalent a travailler a la precision P^e dans l'extension
 * non ramifiee de Q_p definie par le polynome fkk. Renvoie [R_1,...,R_r] les
 * facteurs liftes
 */
GEN
hensel_lift(GEN pol,GEN fk,GEN fkk,GEN p,long e)
{
  long av,tetpil,r,i,j;
  GEN p1,B0,A,C1,A1,B1,U1,V1,B,R;

  av=avma; C1=pol; r=lg(fk)-1; A=cgetg(r+1,t_VEC);
  for (i=1; i<=r; i++) A[i]=(long)special_lift((GEN)fk[i],fkk);
  R=cgetg(r+1,t_VEC);
  for (i=1; i<r; i++)
  {
    A1=(GEN)A[i]; B1=(GEN)A[i+1];
    for (j=i+2; j<=r; j++) B1=gmul(B1,(GEN)A[j]);
    B0=(GEN)fk[i+1]; for (j=i+2; j<=r; j++) B0=gmul(B0,(GEN)fk[j]);
    p1=vecbezout((GEN)fk[i],B0);
    U1=special_lift((GEN)p1[1],fkk); V1=special_lift((GEN)p1[2],fkk);
    B=hensel_lift_for_two(C1,A1,B1,U1,V1,fkk,p,e);
    R[i]=B[1]; C1=(GEN)B[2]; if (i==(r-1)) R[r]=B[2];
  }
  tetpil=avma; return gerepile(av,tetpil,gcopy(R));
}

/* etant donne nf et p et la factorisation de nf[1] mod p, et le degre m des
 * sous corps cherches, cree un vecteur ligne a 12 composantes:
 * 1 : le polynome nf[1],
 * 2 : le premier p,
 * 3 : le nombre de facteurs de ff,
 * 4 : la factorisation ff,
 * 5 : la longeur des cycles associes (n_1,...,n_r),
 * 6 : le ppcm q des (n_i),
 * 7 : les cycles associes,
 * 8 : le corps F_(p^q),
 * 9 : les racines de f dans F_(p^q) par facteur de ff,
 * 10: la borne M pour les sous-corps,
 * 11: l'exposant e telle que la precision des lifts soit p^e>2.M,
 * 12: le lift de Hensel a la precision p^e de la factorisation en facteurs 
 *     lineaires de nf[1] dans F_(p^q),
 * 13: les valeurs absolues des racines de nf[1],
 * 14: le max des valeurs absolues des racines de nf[1],
 * 15: la borne de Hadamard pour les coefficients de h(x) tel que g o h = 0 
 *     mod nf[1].
 * ces donnees sont valides pour nf, p et m (d) donnes...
 */
static GEN
compute_data(GEN nf,GEN ff,GEN p,long m)
{
  long av,tetpil,i,j,l,r,*n,e,N,pp,d,r1,r2;
  GEN DATA,p1,p2,p3,cys,bigfq,tabroots,MM,fk,rr,dpol;

  if (DEBUGLEVEL>4)
    { fprintferr("Entree dans compute_data()\n\n"); flusherr(); }
  av=avma; DATA=cgetg(16,t_VEC); DATA[1]=nf[1]; DATA[2]=(long)p; r=lg(ff)-1;
  DATA[3]=lstoi(r);
  DATA[4]=(long)ff;
  n=cgeti(r+1); for (j=1; j<=r; j++) n[j]=lgef(ff[j])-3;
  DATA[5]=lgetg(r+1,t_VEC); p1=(GEN)DATA[5];
  for (j=1; j<=r; j++) p1[j]=lstoi(n[j]);
  p1=stoi(n[1]);
  for (i=2; i<=r; i++) p1=glcm(p1,stoi(n[i]));
  DATA[6]=(long)p1;
  cys=cgetg(r+1,t_VEC); l=0;
  for (i=1; i<=r; i++)
  { 
    cys[i]=lgetg(n[i]+1,t_VEC); p1=(GEN)cys[i];
    for (j=1; j<=n[i]; j++) p1[j]=lstoi(l+j); l+=n[i];
  }
  DATA[7]=(long)cys;
  bigfq=ffinit(p,itos((GEN)DATA[6]),0);
  DATA[8]=lsubst(bigfq,varn(bigfq),polx[MAXVARN]);
  tabroots=cgetg(r+1,t_VEC); pp=itos(p);
  for (j=1; j<=r; j++)
  {
    p1=setrand(1);
    p1=(GEN)factmod9((GEN)ff[j],p,(GEN)DATA[8])[1];
    tabroots[j]=lgetg(n[j]+1,t_VEC);
    p2=(GEN)tabroots[j]; p2[1]=lneg(compo((GEN)p1[1],1));
    for (i=2; i<=n[j]; i++) p2[i]=lpuigs((GEN)p2[i-1],pp);
  }
  DATA[9]=(long)tabroots;
  p1=(GEN)nf[6]; N=lgef(nf[1])-3;
  r1=itos(gmael(nf,2,1)); r2=itos(gmael(nf,2,2));
  rr=cgetg(N+1,t_VEC);
  for (i=1; i<=r1+r2; i++) rr[i]=p1[i];
  for ( ; i<=N; i++) rr[i]=p1[i-r2];
  rr=gabs(rr,4);
  DATA[10]=(long)bound_for_coeff(m,rr);
  MM=shifti((GEN)DATA[10],1); e=1;
  while (cmpii(gpuigs(p,e),MM)<0) e++;
  DATA[11]=lstoi(e); fk=cgetg(N+1,t_VEC); l=0;
  for (j=1; j<=r; j++)
    for (i=1; i<=n[j]; i++)
      { l++; fk[l]=lsub(polx[0],gmael(tabroots,j,i)); }
  DATA[12]=(long)hensel_lift((GEN)nf[1],fk,(GEN)DATA[8],p,e);
  DATA[13]=(long)rr; p3=(GEN)rr[1];
  for (i=2; i<=N; i++) p3=gmax(p3,(GEN)rr[i]);
  DATA[14]=(long)p3;
  d=N/m; p1=gmul(stoi(N),gsqrt(gpuigs(stoi(N-1),N-1),4));
  p2=gmul(gpuigs((GEN)DATA[14],d),gsqrt(gpuigs((GEN)DATA[14],N*(N-1)),4));
  dpol=gmul(gmul((GEN)nf[4],(GEN)nf[4]),(GEN)nf[3]);
  DATA[15]=ldiv(gmul(p1,p2),gsqrt(absi(dpol),4));
  if (DEBUGLEVEL>1)
  {
    fprintferr("DATA =\n");
    fprintferr("f = "); outerr((GEN)DATA[1]);
    fprintferr("p = "); outerr((GEN)DATA[2]);
    fprintferr("r = "); outerr((GEN)DATA[3]);
    fprintferr("ff = "); outerr((GEN)DATA[4]);
    fprintferr("lcy = "); outerr((GEN)DATA[5]);
    fprintferr("ppcm = "); outerr((GEN)DATA[6]);
    fprintferr("cys = "); outerr((GEN)DATA[7]);
    fprintferr("bigfq = "); outerr((GEN)DATA[8]);
    fprintferr("roots = "); outerr((GEN)DATA[9]);
    fprintferr("M = "); outerr((GEN)DATA[10]);
    fprintferr("e = "); outerr((GEN)DATA[11]);
    fprintferr("hensel = "); outerr((GEN)DATA[12]);
    fprintferr("|rr| = "); outerr((GEN)DATA[13]);
    fprintferr("max|rr| = "); outerr((GEN)DATA[14]);
    fprintferr("hadamard bound = "); outerr((GEN)DATA[15]);
    if (DEBUGLEVEL>4)
      { fprintferr("Sortie de compute_data()\n\n"); flusherr(); }
  }
  tetpil=avma; return gerepile(av,tetpil,gcopy(DATA));
}

/*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/
/*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/
/*                                                                 */
/*               AUTOMORPHISMS OF AN ABELIAN NUMBER FIELD          */
/*                                                                 */
/*               V. Acciaro and J. Klueners (1996)                 */
/*                                                                 */
/*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/
/*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/

/* calcul du frobenius en p pour le corps abelien defini par le polynome pol,
 * par relevement de hensel du frobenius frobp de l'extension des corps
 * residuels (frobp est un polynome mod pol a coefficients dans F_p)
 */
static GEN
frobenius(GEN pol,GEN frobp,GEN p,GEN B,GEN d)
{
  long av=avma,v0,deg,i,depas;
  GEN b0,b1,pold,polp,poldp,w0,w1,g0,g1,unmodp,polpp,v,pp,unmodpp,poldpp,bl0,bl1;

  v0=varn(pol); unmodp=gmodulsg(1,p); pold=deriv(pol,v0);
  b0=frobp; polp=gmul(unmodp,pol);
  poldp=gsubst(deriv(polp,v0),v0,frobp);
  w0=ginv(poldp);
  bl0=lift(b0); deg=lgef(bl0)-3;
  v=cgetg(deg+2,t_VEC);
  for (i=1; i<=deg+1; i++)
    v[i]=ldiv(centerlift(gmul(d,compo(bl0,deg+2-i))),d);
  g0=gtopoly(v,v0);
  if (DEBUGLEVEL>2)
  {
    fprintferr("val. initiales:\n");
    fprintferr("b0 = "); outerr(b0);
    fprintferr("w0 = "); outerr(w0);
    fprintferr("g0 = "); outerr(g0);
  }
  depas=1; pp=gsqr(p);
  for(;;)
  {
    if (gcmp(pp,B)>0) depas=0;
    unmodpp=gmodulsg(1,pp);
    polpp=gmul(unmodpp,pol); poldpp=gmul(unmodpp,pold);
    b0=gmodulcp(gmul(unmodpp,lift_intern(lift_intern(b0))),polpp);
    w0=gmodulcp(gmul(unmodpp,lift_intern(lift_intern(w0))),polpp);
    b1=gsub(b0,gmul(w0,gsubst(polpp,v0,b0)));
    w1=gmul(w0,gsub(gdeux,gmul(w0,gsubst(poldpp,v0,b1))));
    bl1=lift(b1); deg=lgef(bl1)-3;
    v=cgetg(deg+2,t_VEC);
    for (i=1; i<=deg+1; i++)
      v[i]=ldiv(centerlift(gmul(d,compo(bl1,deg+2-i))),d);
    g1=gtopoly(v,v0);
    if (DEBUGLEVEL>2)
    {
      fprintferr("pp = "); outerr(pp);
      fprintferr("b1 = "); outerr(b1);
      fprintferr("w1 = "); outerr(w1);
      fprintferr("g1 = "); outerr(g1);
    }
    if (gegal(g0,g1)) return gerepileupto(av,g1);
    pp=gsqr(pp); b0=b1; w0=w1; g0=g1;
    if (!depas) err(talker,"the number field is not an Abelian number field");
  }
}

static GEN
compute_denom(GEN dpol)
{
  long av=avma,lf,i,a;
  GEN ff,ff1,ff2,d;

  ff=factor(dpol); d=gun;
  ff1=(GEN)ff[1]; ff2=(GEN)ff[2]; lf=lg(ff1)-1;
  for (i=1; i<=lf; i++)
  { 
    a= itos((GEN)ff2[i]) >> 1;
    d = gmul(d,gpuigs((GEN)ff1[i],a));
  }
  return gerepileupto(av,d);
}

static GEN
compute_bound_for_lift(GEN pol,GEN dpol,GEN d)
{
  long av=avma,n,i;
  GEN p1,p2,B;

  n=lgef(pol)-3;
  p1=gdiv(gmul(stoi(n),gpui(stoi(n-1),gdivgs(stoi(n-1),2),4)),gsqrt(dpol,4));
  p2=gzero;
  for (i=2; i<=n+2; i++) p2=gadd(p2,gsqr((GEN)pol[i]));
  p2=gpuigs(gsqrt(p2,4),n-1);
  p1=gmul(p1,p2); p2=gzero;
  for (i=2; i<=n+2; i++)
    if (gcmp(gabs((GEN)pol[i],4),p2)>0) p2=gabs((GEN)pol[i],4);
  p2=gmul(d,gadd(gun,p2));
  B=gmul2n(gsqr(gmul(p1,p2)),1);
  return gerepileupto(av,B);

/* Borne heuristique de P. S. Wang, Math. Comp. 30, 1976, p. 332
  p2=gzero; for (i=2; i<=n+2; i++) p2=gadd(p2,gsqr((GEN)pol[i]));
  p1=gzero;
  for (i=2; i<=n+2; i++){ if (gcmp(gabs((GEN)pol[i],4),p1)>0) p1=gabs((GEN)pol[i],4); }
  if (gcmp(p2,p1)>0) p1=p2;
  p2=gmul(gdiv(mpfactr(n,4),gsqr(mpfactr(n/2,4))),d);
  B=gmul(p1,p2);
  tetpil=avma; return gerepile(av,tetpil,gcopy(B));
*/
}

static long
isinlist(GEN T,long longT,GEN x)
{
  long i;
  for (i=1; i<=longT; i++)
    if (gegal(x,(GEN)T[i])) return i; 
  return 0;
}

/* renvoie 0 si frobp n'est pas dans la liste T; sinon le no de frobp dans T */
static long
isinlistmodp(GEN T,long longT,GEN frobp,GEN p)
{
  long av=avma,i;
  GEN p1,p2,modunp;

  p1=lift_intern(lift_intern(frobp)); modunp=gmodulsg(1,p);
  for (i=1; i<=longT; i++)
  { 
    p2=lift_intern(gmul(modunp,(GEN)T[i]));
    if (gegal(p2,p1)) { avma=av; return i; } 
  }
  avma=av; return 0;
}

/* renvoie le plus petit f tel que frobp^f est dans la liste T */
static long
minimalexponent(GEN T,long longT,GEN frobp,GEN p,long N)
{
  long av=avma,i;
  GEN p2;

  p2=frobp;
  for (i=1; i<=N; i++)
  {
    if (isinlistmodp(T,longT,p2,p)) {avma=av; return i;}
    p2=gpui(p2,p,4);
  }
  err(talker,"power of a frobenius not founded in minimalexponent");
  return 0; /* not reached */
}


/* Computation of all the automorphisms of the abelian number field
   defined by the monic irreducible polynomial pol with integral coefficients */
GEN
conjugates(GEN pol)
{
  long av,tetpil,N,i,j,pp,bound_primes,nbprimes,longT,v0,flL,f,longTnew,*tab,nop,flnf;
  GEN T,S,p1,p2,p,dpol,modunp,polp,xbar,frobp,frob,d,B,nf;
  byteptr di;

  if (DEBUGLEVEL>2){ fprintferr("** Entree dans conjugates\n"); flusherr(); }
  flnf=0; if (typ(pol)!=t_POL){ nf=checknf(pol); flnf=1; pol=(GEN)nf[1]; }
  av=avma; N=lgef(pol)-3; v0=varn(pol); setrand(1);
  if (N==1) { S=cgetg(2,t_VEC); S[1]=(long)polx[v0]; return S; }
  if (N==2)
  {
    S=cgetg(3,t_VEC); S[1]=(long)polx[v0];
    S[2]=lsub(gneg(polx[v0]),(GEN)pol[3]);
    tetpil=avma; return gerepile(av,tetpil,gcopy(S));
  }
  dpol=absi(discsr(pol));
  if (DEBUGLEVEL>2) 
    { fprintferr("discriminant du polynome: "); outerr(dpol); }
  d = flnf? (GEN)nf[4]: compute_denom(dpol);
  if (DEBUGLEVEL>2)
    { fprintferr("facteur carre du discriminant: "); outerr(d); }
  B=compute_bound_for_lift(pol,dpol,d);
  if (DEBUGLEVEL>2) { fprintferr("borne pour les lifts: "); outerr(B); }
  p1=gfloor(glog(dpol,4)); /* sous GRH il faut en fait 3.47*log(dpol) */
  bound_primes=itos(p1);
  if (DEBUGLEVEL>2)
  { fprintferr("borne pour les premiers: %ld\n",bound_primes); flusherr(); }
  nbprimes=itos(gfloor(gmul(dbltor(1.25506),gdiv(p1,glog(p1,4)))));
  if (DEBUGLEVEL>2)
  { fprintferr("borne pour le nombre de premiers: %ld\n",nbprimes); flusherr(); }
  S=cgetg(nbprimes+1,t_VEC);
  di=diffptr; pp=*di; i=0;
  while (pp<=bound_primes)
  { 
    if (smodis(dpol,pp)) { i++; S[i]=lstoi(pp); }
    pp = pp + (*(++di));
  }
  for (j=i+1; j<=nbprimes; j++) S[j]=zero;
  nbprimes=i; tab=cgeti(nbprimes+1);
  for (i=1; i<=nbprimes; i++) tab[i]=0;
  if (DEBUGLEVEL>2)
  {
    fprintferr("nombre de premiers: %ld\n",nbprimes);
    fprintferr("table des premiers: "); outerr(S);
  }
  T=cgetg(N+1,t_VEC); T[1]=(long)polx[v0];
  for (i=2; i<=N; i++) T[i]=zero; longT=1;
  if (DEBUGLEVEL>2) { fprintferr("table initiale: "); outerr(T); }
  for(;;)
  {
    do
    {
      do
      { 
        nop = 1+itos(shifti(mulss(mymyrand(),nbprimes),-(BITS_IN_RANDOM-1)));
      }
      while (tab[nop]);
      tab[nop]=1; p=(GEN)S[nop];
      if (DEBUGLEVEL>2) { fprintferr("\nnombre premier: "); outerr(p); }
      modunp=gmodulsg(1,p);
      polp=gmul(modunp,pol);
      xbar=gmodulcp(gmul(polx[v0],modunp),polp);
      frobp=gpui(xbar,p,4);
      if (DEBUGLEVEL>2) { fprintferr("frobenius mod p: "); outerr(frobp); }
      flL=isinlistmodp(T,longT,frobp,p);
      if (DEBUGLEVEL>2){ fprintferr("flL : %ld\n",flL); flusherr(); }
    }
    while (flL);
    f=minimalexponent(T,longT,frobp,p,N);
    if (DEBUGLEVEL>2){ fprintferr("exposant minimum: %ld\n",f); flusherr(); }
    frob=frobenius(pol,frobp,p,B,d);
    if (DEBUGLEVEL>2) { fprintferr("frobenius: "); outerr(frob); }
/* Ce passage n'est vrai que si le corps est abelien !! */
    longTnew=longT;
    p2=gmodulcp(frob,pol);
    for (i=1; i<=longTnew; i++)
      for (j=1; j<f; j++)
      {
	p1=lift(gsubst((GEN)T[i],v0,gpuigs(p2,j)));
	if (DEBUGLEVEL>2)
	{
	  fprintferr("test de la puissance (%ld,%ld): ",i,j); outerr(p1);
	}
	if (!isinlist(T,longTnew,p1))
	{
	  longT++; T[longT]=(long)p1;
	  if (longT==N)
          {
            if (DEBUGLEVEL>2)
              { fprintferr("** Sortie de conjugates\n"); flusherr(); }
            tetpil=avma; return gerepile(av,tetpil,gcopy(T));
          }
	}
      }
    if (DEBUGLEVEL>2) { fprintferr("nouvelle table: "); outerr(T); }
  }
}

